1: ;+
2: ; NAME:
3: ; TF
4: ;
5: ; PURPOSE:
6: ; This procedure calculates the direct multitaper estimate of
7: ; the time series, TSIN, using the slepian sequences provided
8: ; by TAPERS, on a moving window, with DN points between windows.
9: ; THe estimate is padded out to NF frequency bins and FK of these
10: ; are returned. Optionally, the ftest values, FS, are returned
11: ; as are the complex line amplitudes, CHAT.
12: ;
13: ; CATEGORY:
14: ; Spectral Analysis
15: ;
16: ; CALLING SEQUENCE:
17: ; TF, tsin, tapers, spec,NF=nf,DN=dN, FK=fk, FS=fs, CHAT=chat
18: ;
19: ; INPUTS:
20: ; TSIN: An n-element vector of type integer, float or double
21: ;
22: ; TAPERS: An nw-by-k element array containing the slepian
23: ; sequences used to calculate the spectral quantities
24: ;
25: ; OUTPUTS:
26: ; SPEC: An array containing the spectral calculation for each time
27: ; window.
28: ;
29: ; KEYWORDS:
30: ; NF: Integer containing the number of frequency bins
31: ; to calculate the spectral quantities on. Default is 4*N
32: ;
33: ; FK: An integer giving the number of frequency bins to keep.
34: ; Default is NF/2
35: ;
36: ; DN: An integer giving the number of bins to step through
37: ; between windows. Default is N/5.
38: ;
39: ; FS: Contains the F-spectrum on output.
40: ;
41: ; CHAT: Contains the Chat-spectrum on output.
42: ;
43: ; EXAMPLE: [To be inserted here]
44: ;
45: ; MODIFICATION HISTORY:
46: ; Written by: Bijan Pesaran, Bell Labs, 1996
47: ; Modified by: Bijan Pesaran, Caltech, 12/97
48: ; Added multidimensionality for input arrays
49: ;
50: ;-
51:
52: pro tf, tsin, tapers, spec,NF=nf,DN=dN, FK=fk, FS=fs, CHAT=chat
53:
54: vdp=tapers
55: N=n_elements(vdp(*,0))
56: fs_chk=0
57: chat_chk=0
58: if not keyword_set(nf) then nf = 4.*N
59: if not keyword_set(dn) then dn = fix(N/5.)
60: if not keyword_set(fk) then fk = nf/2.
61: if keyword_set(fs) then fs_chk=1
62: if keyword_set(chat) then chat_chk=1
63:
64: chk=size(tsin)
65: n_chk=n_elements(chk)
66:
67: if chk(0) eq 1 then begin
68: if chk(0) eq 2 and chk(1) eq 1 then dim_chk = 0
69: endif else dim_chk=1
70:
71: if chk(0) gt 1 and dim_chk eq 1 then begin
72: dims=chk(1:chk(0))
73: narr=product(chk(1:chk(0)))/max(dims)
74: ts_arr=reform(tsin,narr,max(dims))
75: ts_arr=float(ts_arr)
76: endif
77:
78: k=n_elements(vdp(0,*))
79:
80: if dim_chk eq 1 then goto,multi_dim
81:
82: dN=long(dN)
83: ts=float(tsin)
84: nt=long(n_elements(ts))
85: ts=ts-total(ts)/float(nt)
86: nwin=long((nt-N)/dN+1)
87: ind=indgen(fix(k/2)+1)*2
88: w0=total(vdp,1)
89: w0=w0/total((w0)^2)
90: alpha=vdp#w0
91:
92: if chat_chk then chat=complexarr(nwin,fk)
93: if fs_chk then fs=fltarr(nwin,fk)
94: spec=fltarr(nwin,fk)
95: X=complexarr(fk, k)
96: tsf=fltarr(nf)
97: if k eq 1 then goto, jump1
98: W=total(vdp(*,ind),1)
99: W2=total(W^2)
100: jump1:
101: for i=0L,nwin-1L do begin
102: tmp=ts(long(i*dN):long(i*dN+N-1))
103:
104: for j=0,k-1 do begin
105: tsf(0:N-1)=tmp*vdp(*,j)
106: tmp1=1./sqrt(nf)*fft(tsf,1)
107: X(*,j)=tmp1(0:fk-1)
108: endfor
109: if k gt 1 then begin
110: spec(i,*)=total(abs(X)^2,2)
111: if fs_chk then begin
112: A=abs(X(*,ind)#W)^2
113: fs(i,*)=float(k-1)*A/(spec(i,*)*W2-A)
114: endif
115: endif
116: if k eq 1 then spec(i,*)=abs(X)^2
117: if chat_chk then begin
118: tsf(0:N-1)=tmp*alpha
119: a=nf*fft(tsf,-1)
120: chat(i,*)=a(0:fk-1)
121: endif
122: endfor
123:
124: goto, the_end
125:
126: multi_dim:
127:
128: dN=long(dN)
129: ts=float(ts_arr)
130: nt=long(n_elements(ts_arr(0,*)))
131: nwin=long((nt-N)/dN+1)
132: ind=indgen(fix(k/2)+1)*2
133: w0=total(vdp,1)
134: w0=w0/total((w0)^2)
135: alpha=vdp#w0
136:
137: if chat_chk then chat=complexarr(narr,nwin,fk)
138: if fs_chk then fs=fltarr(narr,nwin,fk)
139: spec=fltarr(narr,nwin,fk)
140:
141: for i=0,narr-1 do begin
142:
143: X=complexarr(fk, k)
144: tsf=fltarr(nf)
145: if k eq 1 then goto, jump2
146: W=total(vdp(*,ind),1)
147: W2=total(W^2)
148: ts_arr(i,*)=ts_arr(i,*)-total(float(ts_arr(i,*)))/float(nt)
149: jump2:
150: for j=0L,nwin-1L do begin
151: tmp=ts_arr(i,long(j*dN):long(j*dN+N-1))
152:
153: for jj=0,k-1 do begin
154: tsf(0:N-1)=tmp*vdp(*,jj)
155: tmp1=1./sqrt(nf)*fft(tsf,1)
156: X(*,jj)=tmp1(0:fk-1)
157: endfor
158: if k gt 1 then begin
159: spec(i,j,*)=total(abs(X)^2,2)
160: if fs_chk then begin
161: A=abs(X(*,ind)#W)^2
162: fs(i,j,*)=float(k-1)*A/(spec(i,j,*)*W2-A)
163: endif
164: endif
165: if k eq 1 then spec(i,j,*)=abs(X)^2
166: if chat_chk then begin
167: tsf(0:N-1)=tmp*alpha
168: a=nf*fft(tsf,-1)
169: chat(i,j,*)=a(0:fk-1)
170: endif
171: endfor
172:
173: endfor
174:
175: if chat_chk then begin
176: if n_elements(dims) eq 3 then chat=reform(chat,chk(1),chk(2),nwin,fk)
177: if n_elements(dims) eq 4 then chat=reform(chat,chk(1),chk(2),chk(3),nwin,fk)
178: chat=reform(chat)
179: endif
180:
181: if fs_chk then begin
182: if n_elements(dims) eq 3 then fs=reform(fs,chk(1),chk(2),nwin,fk)
183: if n_elements(dims) eq 4 then fs=reform(fs,chk(1),chk(2),chk(3),nwin,fk)
184: fs=reform(fs)
185: endif
186:
187: if n_elements(dims) eq 3 then spec=reform(spec,chk(1),chk(2),nwin,fk)
188: if n_elements(dims) eq 4 then spec=reform(spec,chk(1),chk(2),chk(3),nwin,fk)
189:
190:
191: the_end:
192:
193: end
194: