tomwalters@0
|
1 /*
|
tomwalters@0
|
2 Copyright (c) Applied Psychology Unit, Medical Research Council. 1988, 1989
|
tomwalters@0
|
3 ===========================================================================
|
tomwalters@0
|
4
|
tomwalters@0
|
5 Permission to use, copy, modify, and distribute this software without fee
|
tomwalters@0
|
6 is hereby granted for research purposes, provided that this copyright
|
tomwalters@0
|
7 notice appears in all copies and in all supporting documentation, and that
|
tomwalters@0
|
8 the software is not redistributed for any fee (except for a nominal shipping
|
tomwalters@0
|
9 charge). Anyone wanting to incorporate all or part of this software in a
|
tomwalters@0
|
10 commercial product must obtain a license from the Medical Research Council.
|
tomwalters@0
|
11
|
tomwalters@0
|
12 The MRC makes no representations about the suitability of this
|
tomwalters@0
|
13 software for any purpose. It is provided "as is" without express or implied
|
tomwalters@0
|
14 warranty.
|
tomwalters@0
|
15
|
tomwalters@0
|
16 THE MRC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
|
tomwalters@0
|
17 ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL THE
|
tomwalters@0
|
18 A.P.U. BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
|
tomwalters@0
|
19 DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
|
tomwalters@0
|
20 AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
tomwalters@0
|
21 OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
tomwalters@0
|
22 */
|
tomwalters@0
|
23
|
tomwalters@0
|
24 /*
|
tomwalters@0
|
25 Acknowledgment:
|
tomwalters@0
|
26 ==============
|
tomwalters@0
|
27
|
tomwalters@0
|
28 The source code provided in this file was originally developed by
|
tomwalters@0
|
29 Christian Giguere as part of a Ph.D degree at the Department of
|
tomwalters@0
|
30 Engineering of the University of Cambridge from April 1990 to
|
tomwalters@0
|
31 November 1993. The code was subsequently adapted under a grant
|
tomwalters@0
|
32 from the Hearing Research Trust for full compatibility with
|
tomwalters@0
|
33 AIM Release 6.15.
|
tomwalters@0
|
34
|
tomwalters@0
|
35 Christian Giguere 25/03/94
|
tomwalters@0
|
36
|
tomwalters@0
|
37 */
|
tomwalters@0
|
38
|
tomwalters@0
|
39 /*
|
tomwalters@0
|
40 ===========================================================
|
tomwalters@0
|
41 meddis.c
|
tomwalters@0
|
42 ===========================================================
|
tomwalters@0
|
43
|
tomwalters@0
|
44 Implementation of Ray Meddis haircell model.
|
tomwalters@0
|
45
|
tomwalters@0
|
46 Author : Christian Giguere
|
tomwalters@0
|
47 First written : 10th September, 1991
|
tomwalters@0
|
48 Last edited : 07th March, 1994
|
tomwalters@0
|
49
|
tomwalters@0
|
50 References:
|
tomwalters@0
|
51 (1) C.Giguere and P.C.Woodland (1994). JASA 95(1): 331-342.
|
tomwalters@0
|
52 (2) R.Meddis et al. (1990). JASA 87(4): 1813-1816.
|
tomwalters@0
|
53 (3) R.Meddis (1988). JASA 83(3): 1056-1063.
|
tomwalters@0
|
54
|
tomwalters@0
|
55 Note - This is a complete re-write of the original file
|
tomwalters@0
|
56 "haircell.c" Release 3 (20th September 1988) from
|
tomwalters@0
|
57 J. Holdsworth and the Applied Psychology Unit.
|
tomwalters@0
|
58 ============================================================
|
tomwalters@0
|
59 */
|
tomwalters@0
|
60
|
tomwalters@0
|
61
|
tomwalters@0
|
62 /***** includes *****/
|
tomwalters@0
|
63
|
tomwalters@0
|
64 #include <math.h>
|
tomwalters@0
|
65 #include <stdio.h>
|
tomwalters@0
|
66 #include "stitch.h"
|
tomwalters@0
|
67 #include "source.h"
|
tomwalters@0
|
68 #include "calc.h"
|
tomwalters@0
|
69 #include "calc_tl.h"
|
tomwalters@0
|
70 #include "meddis.h"
|
tomwalters@0
|
71
|
tomwalters@0
|
72
|
tomwalters@0
|
73 /***** defines *****/
|
tomwalters@0
|
74
|
tomwalters@0
|
75 #if 0
|
tomwalters@0
|
76 #define _DEBUG_
|
tomwalters@0
|
77 #define _OVERFLOW_
|
tomwalters@0
|
78 #endif
|
tomwalters@0
|
79
|
tomwalters@0
|
80 #if 1 /* define numerical implementation */
|
tomwalters@0
|
81 #define _WDF_ /* Giguere and Woodland (1994) */
|
tomwalters@0
|
82 #else
|
tomwalters@0
|
83 #define _FORWARD_DIFFERENCE_ /* Meddis et al. (1990) */
|
tomwalters@0
|
84 #endif
|
tomwalters@0
|
85
|
tomwalters@0
|
86 #if 0
|
tomwalters@0
|
87 #define _CLAMPING_ /* clamping of reservoirs */
|
tomwalters@0
|
88 #endif
|
tomwalters@0
|
89
|
tomwalters@0
|
90 #define NUMBER_OF_COEFFS ( 12 )
|
tomwalters@0
|
91 #define NUMBER_OF_STATES ( 12 )
|
tomwalters@0
|
92
|
tomwalters@0
|
93
|
tomwalters@0
|
94 /* Feedback parameter */
|
tomwalters@0
|
95
|
tomwalters@0
|
96 #define InputGain_max ( 24.0 ) /* max coupling gain in dB */
|
tomwalters@0
|
97
|
tomwalters@0
|
98
|
tomwalters@0
|
99 /* Meddis et al. (1990) model parameters */
|
tomwalters@0
|
100
|
tomwalters@0
|
101 #define A_medium ( 10.0 ) /* medium-spontaneous rate fibre */
|
tomwalters@0
|
102 #define B_medium ( 3000.0 )
|
tomwalters@0
|
103 #define g_medium ( 1000.0 )
|
tomwalters@0
|
104
|
tomwalters@0
|
105 #define A_high ( 5.0 ) /* high-spontaneous rate fibre */
|
tomwalters@0
|
106 #define B_high ( 300.0 )
|
tomwalters@0
|
107 #define g_high ( 2000.0 )
|
tomwalters@0
|
108
|
tomwalters@0
|
109 #define y_value ( 5.05 ) /* replenishment rate */
|
tomwalters@0
|
110 #define l_value ( 2500 ) /* rate of loss from the cleft */
|
tomwalters@0
|
111 #define r_value ( 6580 ) /* rate of return from the cleft */
|
tomwalters@0
|
112 #define x_value ( 66.31 ) /* rate of release from w store */
|
tomwalters@0
|
113 #define m_value ( 1.0 ) /* max number of quanta */
|
tomwalters@0
|
114 #define h_value ( 50000. ) /* firing-rate factor */
|
tomwalters@0
|
115
|
tomwalters@0
|
116
|
tomwalters@0
|
117 /***** private data structures *****/
|
tomwalters@0
|
118
|
tomwalters@0
|
119 typedef struct _haircell_info HaircellInfo ;
|
tomwalters@0
|
120 typedef struct _haircell_bank HaircellBank ;
|
tomwalters@0
|
121
|
tomwalters@0
|
122 struct _haircell_info {
|
tomwalters@0
|
123 int number_of_states ;
|
tomwalters@0
|
124 double output_gain ;
|
tomwalters@0
|
125 StateType *states ;
|
tomwalters@0
|
126 } ;
|
tomwalters@0
|
127
|
tomwalters@0
|
128 struct _haircell_bank {
|
tomwalters@0
|
129 int channels ;
|
tomwalters@0
|
130 double *inputGain_ratio ;
|
tomwalters@0
|
131 double (*update_proc)() ; /* procedure to update cells input gain */
|
tomwalters@0
|
132 int number_of_coeffs ;
|
tomwalters@0
|
133 CoeffType *coeffs ;
|
tomwalters@0
|
134 HaircellInfo **cells ;
|
tomwalters@0
|
135 } ;
|
tomwalters@0
|
136
|
tomwalters@0
|
137
|
tomwalters@0
|
138 /***** external variables *****/
|
tomwalters@0
|
139
|
tomwalters@0
|
140 double *InputGain_ratio ;
|
tomwalters@0
|
141
|
tomwalters@0
|
142
|
tomwalters@0
|
143 /***** functions *****/
|
tomwalters@0
|
144
|
tomwalters@0
|
145 /*******************************************************************************
|
tomwalters@0
|
146 * name: function:
|
tomwalters@0
|
147 *
|
tomwalters@0
|
148 * NewHaircells() Set-up function for the implementation of a bank of inner
|
tomwalters@0
|
149 * haircells based on the model of Ray Meddis. It generates the
|
tomwalters@0
|
150 * multiplier coefficients for each haircell filter and
|
tomwalters@0
|
151 * initializes the filter states. It is called by function
|
tomwalters@0
|
152 * ``Meddis()'' in file ``model.c''. It returns a pointer to a
|
tomwalters@0
|
153 * structure containing all the relevant information for the
|
tomwalters@0
|
154 * computation of the haircell filters.
|
tomwalters@0
|
155 *
|
tomwalters@0
|
156 * The choice of the haircell type (medium or high-spontaneous
|
tomwalters@0
|
157 * rate fibre) is made at run time using options ``fibre_med''.
|
tomwalters@0
|
158 *
|
tomwalters@0
|
159 * The choice of the numerical implementation (Wave Digital
|
tomwalters@0
|
160 * Filtering or Forward Difference algorithm) is made at
|
tomwalters@0
|
161 * compile time using a macro substitution ``#define'' (see above).
|
tomwalters@0
|
162 *
|
tomwalters@0
|
163 * The choice of clamping the reservoirs' contents to non-
|
tomwalters@0
|
164 * negative values is made at compile time using a macro
|
tomwalters@0
|
165 * substitution ``#define'' (see above).
|
tomwalters@0
|
166 *
|
tomwalters@0
|
167 * DoHaircells() Realization of the bank of haircell filters. It computes the
|
tomwalters@0
|
168 * output for each haircell for a specified number of input
|
tomwalters@0
|
169 * points and keeps track of the filters' states. It returns
|
tomwalters@0
|
170 * the size of the output data in bytes (per point).
|
tomwalters@0
|
171 *
|
tomwalters@0
|
172 * CloseHaircells() Deletes all private data structures and arrays of the Haircell
|
tomwalters@0
|
173 * filters upon comletion of filtering.
|
tomwalters@0
|
174 ********************************************************************************/
|
tomwalters@0
|
175
|
tomwalters@0
|
176
|
tomwalters@0
|
177 /*************************** NewHaircells() *********************************/
|
tomwalters@0
|
178
|
tomwalters@0
|
179 Pointer NewHaircells( channels, samplerate, output_gain, coupling, fibreType )
|
tomwalters@0
|
180 int channels ;
|
tomwalters@0
|
181 double samplerate, output_gain ;
|
tomwalters@0
|
182 double coupling ;
|
tomwalters@0
|
183 char *fibreType ;
|
tomwalters@0
|
184 {
|
tomwalters@0
|
185 DeclareNew( HaircellBank *, bank ) ;
|
tomwalters@0
|
186 HaircellInfo *cell_info ;
|
tomwalters@0
|
187 CoeffType *cf ;
|
tomwalters@0
|
188 StateType *st ;
|
tomwalters@0
|
189 double ydt, ldt, rdt, xdt, gdt ;
|
tomwalters@0
|
190 double kdt_init, q_init, c_init, w_init, cell_scaling ;
|
tomwalters@0
|
191 double A_value, B_value, g_value ;
|
tomwalters@0
|
192 double r1, r2, r3, r4, r03 ;
|
tomwalters@0
|
193 double update_inputGain() ;
|
tomwalters@0
|
194 int channel ;
|
tomwalters@0
|
195
|
tomwalters@0
|
196 /*** scaling of input data ***/
|
tomwalters@0
|
197 cell_scaling = coupling ;
|
tomwalters@0
|
198
|
tomwalters@0
|
199 /*** allocate fibre-dependent haircell parameters ***/
|
tomwalters@0
|
200 if( strncmp( fibreType, "high", 3 ) == 0 ) {
|
tomwalters@0
|
201 A_value = A_high ;
|
tomwalters@0
|
202 B_value = B_high ;
|
tomwalters@0
|
203 g_value = g_high ;
|
tomwalters@0
|
204 }
|
tomwalters@0
|
205 else {
|
tomwalters@0
|
206 A_value = A_medium ;
|
tomwalters@0
|
207 B_value = B_medium ;
|
tomwalters@0
|
208 g_value = g_medium ;
|
tomwalters@0
|
209 }
|
tomwalters@0
|
210
|
tomwalters@0
|
211 #ifdef _DEBUG_
|
tomwalters@0
|
212 fprintf( stderr, "Meddis Haircell fibre type=%s\n", fibreType ) ;
|
tomwalters@0
|
213 fprintf( stderr, "A=%.2f B=%.2f g=%.2f\n", A_value, B_value, g_value ) ;
|
tomwalters@0
|
214 fprintf( stderr, "Input scaling factor=%.4f\n", cell_scaling ) ;
|
tomwalters@0
|
215 #endif
|
tomwalters@0
|
216
|
tomwalters@0
|
217
|
tomwalters@0
|
218 /*** scale model parameters for difference equations ***/
|
tomwalters@0
|
219 ydt = y_value / samplerate ;
|
tomwalters@0
|
220 ldt = l_value / samplerate ;
|
tomwalters@0
|
221 rdt = r_value / samplerate ;
|
tomwalters@0
|
222 xdt = x_value / samplerate ;
|
tomwalters@0
|
223 gdt = g_value / samplerate ;
|
tomwalters@0
|
224
|
tomwalters@0
|
225
|
tomwalters@0
|
226 /*** calculate initial values for infinite history of silence ***/
|
tomwalters@0
|
227 kdt_init = gdt * A_value / ( A_value + B_value ) ;
|
tomwalters@0
|
228 q_init = m_value / ( 1. + kdt_init / ydt * ( 1. - rdt / ( ldt + rdt ) ) ) ;
|
tomwalters@0
|
229 c_init = q_init * kdt_init / ( ldt + rdt ) ;
|
tomwalters@0
|
230 w_init = rdt / xdt * c_init ;
|
tomwalters@0
|
231
|
tomwalters@0
|
232
|
tomwalters@0
|
233 /*** allocate and store multiplier coefficients ***/
|
tomwalters@0
|
234 bank->number_of_coeffs = NUMBER_OF_COEFFS ;
|
tomwalters@0
|
235 cf = bank->coeffs = NewArray( CoeffType, bank->number_of_coeffs,
|
tomwalters@0
|
236 "haircell_tl.c for coefficients" ) ;
|
tomwalters@0
|
237 #ifdef _WDF_
|
tomwalters@0
|
238 output_gain = MEDDIS_SCALE * output_gain * h_value / ( 2. * r_value ) ;
|
tomwalters@0
|
239 cf[0] = m_value * y_value * output_gain ; /* M/Zy (normalized) */
|
tomwalters@0
|
240 cf[1] = A_value / cell_scaling ;
|
tomwalters@0
|
241 cf[2] = ( A_value + B_value ) / cell_scaling ;
|
tomwalters@0
|
242 cf[3] = g_value ;
|
tomwalters@0
|
243
|
tomwalters@0
|
244 /* Adaptor B0 */
|
tomwalters@0
|
245 r1 = y_value ; /* ( 1/Zy ) */
|
tomwalters@0
|
246 r2 = 2. * samplerate ; /* ( 1/Zcq ) */
|
tomwalters@0
|
247 r3 = r03 = r1 + r2 ;
|
tomwalters@0
|
248 cf[5] = r1 / r3 ; /* gamma01 */
|
tomwalters@0
|
249 cf[4] = r3 / cf[3] ; /* needed to update gamma11 */
|
tomwalters@0
|
250
|
tomwalters@0
|
251 /* Adaptor B1*/
|
tomwalters@0
|
252 r1 = kdt_init * samplerate ; /* ( 1/Zk ) initial value only */
|
tomwalters@0
|
253 r2 = r03 ;
|
tomwalters@0
|
254 r3 = r1 + r2 ;
|
tomwalters@0
|
255 cf[6] = 2. * r1 / r3 ; /* gamma11 updated at each sample */
|
tomwalters@0
|
256
|
tomwalters@0
|
257 /* Adaptor B2 */
|
tomwalters@0
|
258 r1 = l_value ; /* ( 1/Zl ) */
|
tomwalters@0
|
259 r2 = r_value ; /* ( 1/Zr ) */
|
tomwalters@0
|
260 r3 = 2. * samplerate ; /* ( 1/Zcc ) */
|
tomwalters@0
|
261 r4 = r1 + r2 + r3 ;
|
tomwalters@0
|
262 cf[7] = r1 / r4 ; /* gamma21 */
|
tomwalters@0
|
263 cf[8] = r2 / r4 ; /* gamma22 */
|
tomwalters@0
|
264
|
tomwalters@0
|
265 /* Adaptor B3 */
|
tomwalters@0
|
266 r1 = x_value ; /* ( 1/Zx ) */
|
tomwalters@0
|
267 r2 = 2. * samplerate ; /* ( 1/Zcw ) */
|
tomwalters@0
|
268 r3 = r1 + r2 ;
|
tomwalters@0
|
269 cf[9] = 0.5 * r1 / r3 ; /* 0.5 * gamma31 */
|
tomwalters@0
|
270
|
tomwalters@0
|
271 #else
|
tomwalters@0
|
272 output_gain = MEDDIS_SCALE * output_gain * h_value ;
|
tomwalters@0
|
273 cf[0] = m_value * output_gain ;
|
tomwalters@0
|
274 cf[1] = A_value / cell_scaling ;
|
tomwalters@0
|
275 cf[2] = ( A_value + B_value ) / cell_scaling ;
|
tomwalters@0
|
276 cf[3] = gdt ;
|
tomwalters@0
|
277 cf[4] = ydt ;
|
tomwalters@0
|
278 cf[5] = ldt ;
|
tomwalters@0
|
279 cf[6] = rdt ;
|
tomwalters@0
|
280 cf[7] = xdt ;
|
tomwalters@0
|
281 #endif
|
tomwalters@0
|
282
|
tomwalters@0
|
283
|
tomwalters@0
|
284 /*** loop through each haircell ***/
|
tomwalters@0
|
285 bank->channels = channels ;
|
tomwalters@0
|
286 bank->cells = NewArray( HaircellInfo *, bank->channels, "haircell.c for cell states" ) ;
|
tomwalters@0
|
287 bank->inputGain_ratio = InputGain_ratio = NewArray( double, bank->channels,
|
tomwalters@0
|
288 "haircell_tl.c for cells input gain ratio" ) ;
|
tomwalters@0
|
289 bank->update_proc = update_inputGain ;
|
tomwalters@0
|
290
|
tomwalters@0
|
291 for( channel = 0 ; channel < bank->channels ; channel++ ) {
|
tomwalters@0
|
292 bank->inputGain_ratio[ channel ] = 0.5 ; /* in absence of feedback, Gain = 1 */
|
tomwalters@0
|
293 cell_info = bank->cells[ channel ] = New( HaircellInfo * ) ;
|
tomwalters@0
|
294
|
tomwalters@0
|
295 /*** allocate and initialise states ***/
|
tomwalters@0
|
296 cell_info->number_of_states = NUMBER_OF_STATES ;
|
tomwalters@0
|
297 st = cell_info->states = NewZeroedArray( StateType, cell_info->number_of_states,
|
tomwalters@0
|
298 "haircell_tl.c for states" ) ;
|
tomwalters@0
|
299
|
tomwalters@0
|
300 #ifdef _WDF_
|
tomwalters@0
|
301 st[1] = x_value * w_init * output_gain ; /* Ixn (normalized) */
|
tomwalters@0
|
302 st[2] = 2. * q_init * samplerate * output_gain ; /* Ixn(t-T)-b02 (normalized) */
|
tomwalters@0
|
303 st[3] = -2. * c_init * samplerate * output_gain ; /* b23 (normalized) */
|
tomwalters@0
|
304 st[4] = -2. * w_init * samplerate * output_gain ; /* b33 (normalized) */
|
tomwalters@0
|
305 cell_info->output_gain = output_gain ; /* obsolete */
|
tomwalters@0
|
306
|
tomwalters@0
|
307 #else
|
tomwalters@0
|
308 st[0] = kdt_init ;
|
tomwalters@0
|
309 st[1] = q_init * output_gain ;
|
tomwalters@0
|
310 st[2] = c_init * output_gain ;
|
tomwalters@0
|
311 st[3] = w_init * output_gain ;
|
tomwalters@0
|
312 cell_info->output_gain = output_gain ; /* obsolete */
|
tomwalters@0
|
313 #endif
|
tomwalters@0
|
314
|
tomwalters@0
|
315 }
|
tomwalters@0
|
316
|
tomwalters@0
|
317 return( ( Pointer ) bank ) ;
|
tomwalters@0
|
318 }
|
tomwalters@0
|
319
|
tomwalters@0
|
320
|
tomwalters@0
|
321 /************************** DoHaircells() *********************************/
|
tomwalters@0
|
322
|
tomwalters@0
|
323 int DoHaircells( bank_ptr, bytes, output_ptr, end_output_ptr, input_ptr )
|
tomwalters@0
|
324 Pointer *bank_ptr ;
|
tomwalters@0
|
325 ByteCount *bytes ;
|
tomwalters@0
|
326 DataType *output_ptr, *end_output_ptr, *input_ptr ;
|
tomwalters@0
|
327 {
|
tomwalters@0
|
328 register HaircellBank *bank = ( HaircellBank * ) bank_ptr ;
|
tomwalters@0
|
329 register HaircellInfo *cell_info ;
|
tomwalters@0
|
330 register DataType *input, *output ;
|
tomwalters@0
|
331 register StateType *st ;
|
tomwalters@0
|
332 register StateType in, out ;
|
tomwalters@0
|
333 register CoeffType *cf ;
|
tomwalters@0
|
334 register double inputGain ;
|
tomwalters@0
|
335 register int channel = bank->channels ;
|
tomwalters@0
|
336 register int point, npoints = ( end_output_ptr - output_ptr ) / bank->channels ;
|
tomwalters@0
|
337 #ifdef _WDF_
|
tomwalters@0
|
338 register StateType an, a0 ;
|
tomwalters@0
|
339 #else
|
tomwalters@0
|
340 register StateType replenish, eject, loss, reuptake, reprocess ;
|
tomwalters@0
|
341 #endif
|
tomwalters@0
|
342
|
tomwalters@0
|
343 /*** for all channels ***/
|
tomwalters@0
|
344
|
tomwalters@0
|
345 #ifdef _DEBUG_
|
tomwalters@0
|
346 fprintf( stderr, "DoHaircells() = %d points X %d channels\n", npoints, bank->channels ) ;
|
tomwalters@0
|
347 #endif
|
tomwalters@0
|
348
|
tomwalters@0
|
349 cf = bank->coeffs ;
|
tomwalters@0
|
350
|
tomwalters@0
|
351 while( channel-- ) {
|
tomwalters@0
|
352
|
tomwalters@0
|
353 cell_info = bank->cells[ channel ] ;
|
tomwalters@0
|
354 st = cell_info->states ;
|
tomwalters@0
|
355 input = input_ptr + channel ;
|
tomwalters@0
|
356 output = output_ptr + channel ;
|
tomwalters@0
|
357 inputGain = bank->update_proc( bank->inputGain_ratio[ channel ] ) ;
|
tomwalters@0
|
358 cf[10] = cf[1] / inputGain ; /* (A/p) */
|
tomwalters@0
|
359 cf[11] = cf[2] / inputGain ; /* (A+B)/p */
|
tomwalters@0
|
360
|
tomwalters@0
|
361 /*** for each channel ***/
|
tomwalters@0
|
362
|
tomwalters@0
|
363 point = npoints ;
|
tomwalters@0
|
364 while( point-- ) {
|
tomwalters@0
|
365
|
tomwalters@0
|
366 #ifdef _WDF_
|
tomwalters@0
|
367 /*** compute compressive permeability function k ***/
|
tomwalters@0
|
368 in = ( StateType ) *input ; /* (BM vibration) */
|
tomwalters@0
|
369 if( in > -cf[10] )
|
tomwalters@0
|
370 st[0] = ( in + cf[10] ) / ( in + cf[11] ) ; /* kn(t) / g */
|
tomwalters@0
|
371 else
|
tomwalters@0
|
372 st[0] = 0. ;
|
tomwalters@0
|
373
|
tomwalters@0
|
374 /*** update gamma11 ***/
|
tomwalters@0
|
375 cf[6] = st[0] / ( st[0] + cf[4] ) ;
|
tomwalters@0
|
376 cf[6] += cf[6] ; /* gamma11 */
|
tomwalters@0
|
377
|
tomwalters@0
|
378 /*** compute wdf ***/
|
tomwalters@0
|
379
|
tomwalters@0
|
380 /* Adaptor B0 */
|
tomwalters@0
|
381 st[5] = cf[0] + st[1] + st[2] ; /* -b03=a12 (normalized) */
|
tomwalters@0
|
382
|
tomwalters@0
|
383 /* Adaptor B1 */
|
tomwalters@0
|
384 st[6] = cf[6] * st[5] ; /* -b11=2Ikn (normalized) */
|
tomwalters@0
|
385 st[7] = st[6] - st[5] ; /* b12=-a03 (normalized) */
|
tomwalters@0
|
386
|
tomwalters@0
|
387 /* Adaptor B0 */
|
tomwalters@0
|
388 st[2] = cf[0] + st[1] - st[7] + cf[5] * ( st[7] - st[5] ) ; /* Ixn(t-T)-b02 (normalized) */
|
tomwalters@0
|
389
|
tomwalters@0
|
390 /* Adaptor B2 */
|
tomwalters@0
|
391 an = st[6] - st[3] ; /* a24 (normalized) */
|
tomwalters@0
|
392 a0 = an - st[3] ; /* a20 (normalized) */
|
tomwalters@0
|
393 st[8] = cf[8] * a0 ; /* -b22=2Irn (normalized) */
|
tomwalters@0
|
394 st[3] = cf[7] * a0 + st[8] - an ; /* b23 (normalized) */
|
tomwalters@0
|
395
|
tomwalters@0
|
396 /* Adaptor B3 */
|
tomwalters@0
|
397 an = st[8] - st[4] ; /* a33 (normalized) */
|
tomwalters@0
|
398 st[1] = cf[9] * ( an - st[4] ) ; /* Ixn(t)=-0.5*b31 (normalized) */
|
tomwalters@0
|
399 st[4] = st[1] + st[1] - an ; /* b32 (normalized) */
|
tomwalters@0
|
400
|
tomwalters@0
|
401 #ifdef _CLAMPING_
|
tomwalters@0
|
402 /*** clamping of reservoirs to non-negative quantities ***/
|
tomwalters@0
|
403 /*** not available yet ***/
|
tomwalters@0
|
404 #endif
|
tomwalters@0
|
405
|
tomwalters@0
|
406 /*** output ***/
|
tomwalters@0
|
407 out = st[8] ;
|
tomwalters@0
|
408
|
tomwalters@0
|
409 #else
|
tomwalters@0
|
410
|
tomwalters@0
|
411 /*** compute change quantities ***/
|
tomwalters@0
|
412 replenish = cf[4] * ( cf[0] - st[1] ) ; /* y(M-q) */
|
tomwalters@0
|
413 eject = st[0] * st[1] ; /* kq */
|
tomwalters@0
|
414 loss = cf[5] * st[2] ; /* lc */
|
tomwalters@0
|
415 reuptake = cf[6] * st[2] ; /* rc */
|
tomwalters@0
|
416 reprocess = cf[7] * st[3] ; /* xw */
|
tomwalters@0
|
417
|
tomwalters@0
|
418 /*** compute compressive permeability function kn_1dt ***/
|
tomwalters@0
|
419 in = ( StateType ) *input ; /* (BM vibration) */
|
tomwalters@0
|
420 if( in > -cf[10] )
|
tomwalters@0
|
421 st[0] = cf[3] * ( in + cf[10] ) / ( in + cf[11] ) ; /* kn_1(t)dt */
|
tomwalters@0
|
422 else
|
tomwalters@0
|
423 st[0] = 0. ;
|
tomwalters@0
|
424
|
tomwalters@0
|
425 /*** update reservoir quantities ***/
|
tomwalters@0
|
426 st[1] += replenish - eject + reprocess ; /* q */
|
tomwalters@0
|
427 st[2] += eject - loss - reuptake ; /* c */
|
tomwalters@0
|
428 st[3] += reuptake - reprocess ; /* w */
|
tomwalters@0
|
429
|
tomwalters@0
|
430 #ifdef _CLAMPING_
|
tomwalters@0
|
431 /*** clamping of reservoirs to non-negative quantities ***/
|
tomwalters@0
|
432 if( st[1] < 0 )
|
tomwalters@0
|
433 st[1] = 0 ;
|
tomwalters@0
|
434 if( st[2] < 0 )
|
tomwalters@0
|
435 st[2] = 0 ;
|
tomwalters@0
|
436 #endif
|
tomwalters@0
|
437
|
tomwalters@0
|
438 /*** output ***/
|
tomwalters@0
|
439 out = st[2] ;
|
tomwalters@0
|
440
|
tomwalters@0
|
441 #endif
|
tomwalters@0
|
442
|
tomwalters@0
|
443 /*** output ***/
|
tomwalters@0
|
444 #ifdef _OVERFLOW_
|
tomwalters@0
|
445 if( out > _MaxOutput_ )
|
tomwalters@0
|
446 fprintf( stderr, "Overflow error in Meddis Haircell output\%e\n", ( double ) out ) ;
|
tomwalters@0
|
447 #endif
|
tomwalters@0
|
448
|
tomwalters@0
|
449 *output = ( DataType ) out ;
|
tomwalters@0
|
450
|
tomwalters@0
|
451 output += bank->channels ;
|
tomwalters@0
|
452 input += bank->channels ;
|
tomwalters@0
|
453 }
|
tomwalters@0
|
454
|
tomwalters@0
|
455 }
|
tomwalters@0
|
456
|
tomwalters@0
|
457 return( npoints ) ;
|
tomwalters@0
|
458 }
|
tomwalters@0
|
459
|
tomwalters@0
|
460
|
tomwalters@0
|
461 /************************** CloseHaircells() *********************************/
|
tomwalters@0
|
462
|
tomwalters@0
|
463 void CloseHaircells( bank_ptr )
|
tomwalters@0
|
464 Pointer bank_ptr ;
|
tomwalters@0
|
465 {
|
tomwalters@0
|
466 HaircellBank *bank = ( HaircellBank * ) bank_ptr ;
|
tomwalters@0
|
467 HaircellInfo *cell_info ;
|
tomwalters@0
|
468 int channel ;
|
tomwalters@0
|
469
|
tomwalters@0
|
470 for( channel = 0 ; channel < bank->channels ; channel++) {
|
tomwalters@0
|
471 Delete( bank->cells[ channel ]->states ) ;
|
tomwalters@0
|
472 Delete( bank->cells[ channel ] ) ;
|
tomwalters@0
|
473 }
|
tomwalters@0
|
474
|
tomwalters@0
|
475 Delete( bank->cells ) ;
|
tomwalters@0
|
476 Delete( bank->coeffs ) ;
|
tomwalters@0
|
477 Delete( bank->inputGain_ratio ) ;
|
tomwalters@0
|
478 Delete( bank ) ;
|
tomwalters@0
|
479
|
tomwalters@0
|
480 return ;
|
tomwalters@0
|
481 }
|
tomwalters@0
|
482
|
tomwalters@0
|
483
|
tomwalters@0
|
484 /********** low level functions ************/
|
tomwalters@0
|
485
|
tomwalters@0
|
486 double update_inputGain( ratio )
|
tomwalters@0
|
487 double ratio ;
|
tomwalters@0
|
488 {
|
tomwalters@0
|
489 return( pow( 10., ( ratio - 0.5 ) * InputGain_max / 20. ) ) ;
|
tomwalters@0
|
490 }
|
tomwalters@0
|
491
|