UVES Pipeline Reference Manual  5.4.0
flames_newmatrix.c
1 /*===========================================================================
2  Copyright (C) 2001 European Southern Observatory (ESO)
3 
4  This program is free software; you can redistribute it and/or
5  modify it under the terms of the GNU General Public License as
6  published by the Free Software Foundation; either version 2 of
7  the License, or (at your option) any later version.
8 
9  This program is distributed in the hope that it will be useful,
10  but WITHOUT ANY WARRANTY; without even the implied warranty of
11  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12  GNU General Public License for more details.
13 
14  You should have received a copy of the GNU General Public
15  License along with this program; if not, write to the Free
16  Software Foundation, Inc., 675 Massachusetss Ave, Cambridge,
17  MA 02139, USA.
18 
19  Corresponding concerning ESO-MIDAS should be addressed as follows:
20  Internet e-mail: midas@eso.org
21  Postal address: European Southern Observatory
22  Data Management Division
23  Karl-Schwarzschild-Strasse 2
24  D 85748 Garching bei Muenchen
25  GERMANY
26 ===========================================================================*/
27 /* Program : newmatrix.c */
28 /* Author : G. Mulas - ITAL_FLAMES Consortium (derived by NR) */
29 /* Date : */
30 /* */
31 /* Purpose : Missing */
32 /* */
33 /* */
34 /* Input: see interface */
35 /* */
36 /* Output: */
37 /* */
38 /* DRS Functions called: */
39 /* none */
40 /* */
41 /* Pseudocode: */
42 /* Missing */
43 /* */
44 /* Version : */
45 /* Last modification date: 2002/08/05 */
46 /* Who When Why Where */
47 /* AMo 02-08-05 Add header header */
48 /*-------------------------------------------------------------------------*/
49 
50 #ifdef HAVE_CONFIG_H
51 # include <config.h>
52 #endif
53 
54 
55 #if defined(__STDC__) || defined(ANSI) || defined(NRANSI) /* ANSI */
56 
57 #include <flames_newmatrix.h>
58 #include <stdio.h>
59 #include <stddef.h>
60 #include <stdlib.h>
61 #include <flames_midas_def.h>
62 #include <flames_uves.h>
63 #include <uves_error.h>
64 #define NR_END 1
65 #define FREE_ARG char*
66 
67 //jmlarsen: Maybe we should respect the fine people at NR and
68 // *not* steal their copyrighted code???
69 
70 
71 void nrerror(const char* error_text)
72 /* Numerical Recipes standard error handler */
73 
74 {
75  /*
76  ---------- Let's comment out the non-MIDAS compliant items----------
77 
78  fprintf(stderr,"Numerical Recipes run-time error...\n");
79  fprintf(stderr,"%s\n",error_text);
80  fprintf(stderr,"...now exiting to system...\n");
81  */
82  char output[70];
83 
84  SCTPUT("Numerical Recipes run-time error...\n");
85  sprintf(output, "%s\n", error_text);
86  SCTPUT(output);
87  SCTPUT("...now exiting to system...\n");
88  SCSEPI();
89 
90  //UVES error handling here
91  assure_nomsg( false, CPL_ERROR_ILLEGAL_OUTPUT );
92  cleanup:
93  return ;
94 }
95 
96 float *vector(int32_t nl, int32_t nh)
97 /* allocate a float vector with subscript range v[nl..nh] */
98 {
99  float *v;
100 
101  v=(float *) calloc((size_t) (nh-nl+1+NR_END), sizeof(float));
102  if (!v) nrerror("allocation failure in vector()");
103  return v-nl+NR_END;
104 }
105 
106 int *ivector(int32_t nl, int32_t nh)
107 /* allocate an int vector with subscript range v[nl..nh] */
108 {
109  int *v;
110 
111  v=(int *) calloc((size_t) (nh-nl+1+NR_END), sizeof(int));
112  if (!v) nrerror("allocation failure in ivector()");
113  return v-nl+NR_END;
114 }
115 
116 unsigned int *uivector(int32_t nl, int32_t nh)
117 /* allocate an unsigned int vector with subscript range v[nl..nh] */
118 {
119  unsigned int *v;
120 
121  v=(unsigned int *) calloc((size_t) (nh-nl+1+NR_END),
122  sizeof(unsigned int));
123  if (!v) nrerror("allocation failure in uivector()");
124  return v-nl+NR_END;
125 }
126 
127 char *cvector(int32_t nl, int32_t nh)
128 /* allocate a char vector with subscript range v[nl..nh] */
129 {
130  char *v;
131 
132  v=(char *) calloc((size_t) (nh-nl+1+NR_END), sizeof(char));
133  if (!v) nrerror("allocation failure in cvector()");
134  return v-nl+NR_END;
135 }
136 
137 unsigned char *ucvector(int32_t nl, int32_t nh)
138 /* allocate an unsigned char vector with subscript range v[nl..nh] */
139 {
140  unsigned char *v;
141 
142  v=(unsigned char *) calloc((size_t) (nh-nl+1+NR_END),
143  sizeof(unsigned char));
144  if (!v) nrerror("allocation failure in ucvector()");
145  return v-nl+NR_END;
146 }
147 
148 int32_t *lvector(int32_t nl, int32_t nh)
149 /* allocate a int32_t vector with subscript range v[nl..nh] */
150 {
151  int32_t *v;
152 
153  v=(int32_t *) calloc((size_t) (nh-nl+1+NR_END), sizeof(int32_t));
154  if (!v) nrerror("allocation failure in lvector()");
155  return v-nl+NR_END;
156 }
157 
158 uint32_t *ulvector(int32_t nl, int32_t nh)
159 /* allocate an uint32_t vector with subscript range v[nl..nh] */
160 {
161  uint32_t *v;
162 
163  v=(uint32_t *) calloc((size_t) (nh-nl+1+NR_END),
164  sizeof(uint32_t));
165  if (!v) nrerror("allocation failure in ulvector()");
166  return v-nl+NR_END;
167 }
168 
169 double *dvector(int32_t nl, int32_t nh)
170 /* allocate a double vector with subscript range v[nl..nh] */
171 {
172  double *v;
173 
174  v=(double *) calloc((size_t) (nh-nl+1+NR_END), sizeof(double));
175  if (!v) nrerror("allocation failure in dvector()");
176  return v-nl+NR_END;
177 }
178 
179 frame_data *fdvector(int32_t nl, int32_t nh)
180 /* allocate a frame_data vector with subscript range v[nl..nh] */
181 {
182  frame_data *v;
183 
184  v=(frame_data *) calloc((size_t) (nh-nl+1+NR_END), sizeof(frame_data));
185  if (!v) nrerror("allocation failure in fdvector()");
186  return v-nl+NR_END;
187 }
188 
189 frame_mask *fmvector(int32_t nl, int32_t nh)
190 /* allocate a frame_mask vector with subscript range v[nl..nh] */
191 {
192  frame_mask *v;
193 
194  v=(frame_mask *) calloc((size_t) (nh-nl+1+NR_END), sizeof(frame_mask));
195  if (!v) nrerror("allocation failure in fdvector()");
196  return v-nl+NR_END;
197 }
198 
199 char **cmatrix(int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch)
200 /* allocate a char matrix with subscript range m[nrl..nrh][ncl..nch] */
201 {
202  int32_t i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
203  char **m;
204 
205  /* allocate pointers to rows */
206  m=(char **) calloc((size_t)(nrow+NR_END), sizeof(char*));
207  if (!m) nrerror("allocation failure 1 in cmatrix()");
208  m += NR_END;
209  m -= nrl;
210 
211  /* allocate rows and set pointers to them */
212  m[nrl]=(char *) calloc((size_t)(nrow*ncol+NR_END), sizeof(char));
213  if (!m[nrl]) nrerror("allocation failure 2 in cmatrix()");
214  m[nrl] += NR_END;
215  m[nrl] -= ncl;
216 
217  for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
218 
219  /* return pointer to array of pointers to rows */
220  return m;
221 }
222 
223 float **matrix(int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch)
224 /* allocate a float matrix with subscript range m[nrl..nrh][ncl..nch] */
225 {
226  int32_t i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
227  float **m;
228 
229  /* allocate pointers to rows */
230  m=(float **) calloc((size_t)(nrow+NR_END), sizeof(float*));
231  if (!m) nrerror("allocation failure 1 in matrix()");
232  m += NR_END;
233  m -= nrl;
234 
235  /* allocate rows and set pointers to them */
236  m[nrl]=(float *) calloc((size_t)(nrow*ncol+NR_END), sizeof(float));
237  if (!m[nrl]) nrerror("allocation failure 2 in matrix()");
238  m[nrl] += NR_END;
239  m[nrl] -= ncl;
240 
241  for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
242 
243  /* return pointer to array of pointers to rows */
244  return m;
245 }
246 
247 double **dmatrix(int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch)
248 /* allocate a double matrix with subscript range m[nrl..nrh][ncl..nch] */
249 {
250  int32_t i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
251  double **m;
252 
253  /* allocate pointers to rows */
254  m=(double **) calloc((size_t)(nrow+NR_END), sizeof(double*));
255  if (!m) nrerror("allocation failure 1 in dmatrix()");
256  m += NR_END;
257  m -= nrl;
258 
259 
260  /* allocate rows and set pointers to them */
261  /*
262  printf("nrl=%d\n",nrl);
263  printf("size=%d\n",nrow*ncol+NR_END);
264  */
265  m[nrl]=(double *) calloc((size_t)(nrow*ncol+NR_END), sizeof(double));
266 
267  /* printf("allocate pointers to rows4\n"); */
268  if (!m[nrl]) nrerror("allocation failure 2 in dmatrix()");
269  m[nrl] += NR_END;
270  m[nrl] -= ncl;
271 
272  for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
273  /* return pointer to array of pointers to rows */
274  return m;
275 }
276 
277 int **imatrix(int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch)
278 /* allocate a int matrix with subscript range m[nrl..nrh][ncl..nch] */
279 {
280  int32_t i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
281  int **m;
282 
283  /* allocate pointers to rows */
284  m=(int **) calloc((size_t)(nrow+NR_END), sizeof(int*));
285  if (!m) nrerror("allocation failure 1 in imatrix()");
286  m += NR_END;
287  m -= nrl;
288 
289 
290  /* allocate rows and set pointers to them */
291  m[nrl]=(int *) calloc((size_t)(nrow*ncol+NR_END), sizeof(int));
292  if (!m[nrl]) nrerror("allocation failure 2 in imatrix()");
293  m[nrl] += NR_END;
294  m[nrl] -= ncl;
295 
296  for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
297 
298  /* return pointer to array of pointers to rows */
299  return m;
300 }
301 
302 uint32_t **ulmatrix(int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch)
303 /* allocate a int matrix with subscript range m[nrl..nrh][ncl..nch] */
304 {
305  int32_t i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
306  uint32_t **m;
307 
308  /* allocate pointers to rows */
309  m=(uint32_t **) calloc((size_t)(nrow+NR_END),
310  sizeof(uint32_t*));
311  if (!m) nrerror("allocation failure 1 in ulmatrix()");
312  m += NR_END;
313  m -= nrl;
314 
315 
316  /* allocate rows and set pointers to them */
317  m[nrl]=(uint32_t *) calloc((size_t)(nrow*ncol+NR_END),
318  sizeof(uint32_t));
319  if (!m[nrl]) nrerror("allocation failure 2 in ulmatrix()");
320  m[nrl] += NR_END;
321  m[nrl] -= ncl;
322 
323  for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
324 
325  /* return pointer to array of pointers to rows */
326  return m;
327 }
328 
329 int32_t **lmatrix(int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch)
330 /* allocate a int32_t matrix with subscript range m[nrl..nrh][ncl..nch] */
331 {
332  int32_t i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
333  int32_t **m;
334 
335  /* allocate pointers to rows */
336  m=(int32_t **) calloc((size_t)(nrow+NR_END), sizeof(int32_t*));
337  if (!m) nrerror("allocation failure 1 in lmatrix()");
338  m += NR_END;
339  m -= nrl;
340 
341 
342  /* allocate rows and set pointers to them */
343  m[nrl]=(int32_t *) calloc((size_t)(nrow*ncol+NR_END),
344  sizeof(int32_t));
345  if (!m[nrl]) nrerror("allocation failure 2 in lmatrix()");
346  m[nrl] += NR_END;
347  m[nrl] -= ncl;
348 
349  for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
350 
351  /* return pointer to array of pointers to rows */
352  return m;
353 }
354 
355 frame_data **fdmatrix(int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch)
356 /* allocate a frame_data matrix with subscript range m[nrl..nrh][ncl..nch] */
357 {
358  int32_t i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
359  frame_data **m;
360 
361  /* allocate pointers to rows */
362  m=(frame_data **) calloc((size_t)(nrow+NR_END), sizeof(frame_data*));
363  if (!m) nrerror("allocation failure 1 in fdmatrix()");
364  m += NR_END;
365  m -= nrl;
366 
367 
368  /* allocate rows and set pointers to them */
369  m[nrl]=(frame_data *) calloc((size_t)(nrow*ncol+NR_END),
370  sizeof(frame_data));
371  if (!m[nrl]) nrerror("allocation failure 2 in fdmatrix()");
372  m[nrl] += NR_END;
373  m[nrl] -= ncl;
374 
375  for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
376 
377  /* return pointer to array of pointers to rows */
378  return m;
379 }
380 
381 frame_mask **fmmatrix(int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch)
382 /* allocate a frame_mask matrix with subscript range m[nrl..nrh][ncl..nch] */
383 {
384  int32_t i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
385  frame_mask **m;
386 
387  /* allocate pointers to rows */
388  m=(frame_mask **) calloc((size_t)(nrow+NR_END), sizeof(frame_mask*));
389  if (!m) nrerror("allocation failure 1 in fmmatrix()");
390  m += NR_END;
391  m -= nrl;
392 
393 
394  /* allocate rows and set pointers to them */
395  m[nrl]=(frame_mask *) calloc((size_t)(nrow*ncol+NR_END),
396  sizeof(frame_mask));
397  if (!m[nrl]) nrerror("allocation failure 2 in fmmatrix()");
398  m[nrl] += NR_END;
399  m[nrl] -= ncl;
400 
401  for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
402 
403  /* return pointer to array of pointers to rows */
404  return m;
405 }
406 
407 float **submatrix(float **a, int32_t oldrl, int32_t oldrh, int32_t oldcl,
408  int32_t newrl, int32_t newcl)
409 /* point a submatrix [newrl..][newcl..] to a[oldrl..oldrh][oldcl..oldch] */
410 {
411  int32_t i,j,nrow=oldrh-oldrl+1,ncol=oldcl-newcl;
412  float **m;
413 
414  /* allocate array of pointers to rows */
415  m=(float **) calloc((size_t) (nrow+NR_END), sizeof(float*));
416  if (!m) nrerror("allocation failure in submatrix()");
417  m += NR_END;
418  m -= newrl;
419 
420  /* set pointers to rows */
421  for(i=oldrl,j=newrl;i<=oldrh;i++,j++) m[j]=a[i]+ncol;
422 
423  /* return pointer to array of pointers to rows */
424  return m;
425 }
426 
427 float **convert_matrix(float *a, int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch)
428 /* allocate a float matrix m[nrl..nrh][ncl..nch] that points to the matrix
429  declared in the standard C manner as a[nrow][ncol], where nrow=nrh-nrl+1
430  and ncol=nch-ncl+1. The routine should be called with the address
431  &a[0][0] as the first argument. */
432 {
433  int32_t i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1;
434  float **m;
435 
436  /* allocate pointers to rows */
437  m=(float **) calloc((size_t) (nrow+NR_END), sizeof(float*));
438  if (!m) nrerror("allocation failure in convert_matrix()");
439  m += NR_END;
440  m -= nrl;
441 
442  /* set pointers to rows */
443  m[nrl]=a-ncl;
444  for(i=1,j=nrl+1;i<nrow;i++,j++) m[j]=m[j-1]+ncol;
445  /* return pointer to array of pointers to rows */
446  return m;
447 }
448 
449 float ***f3tensor(int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch, int32_t ndl, int32_t ndh)
450 /* allocate a float 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
451 {
452  int32_t i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
453  float ***t;
454 
455  /* allocate pointers to pointers to rows */
456  t=(float ***) calloc((size_t)(nrow+NR_END), sizeof(float**));
457  if (!t) nrerror("allocation failure 1 in f3tensor()");
458  t += NR_END;
459  t -= nrl;
460 
461  /* allocate pointers to rows and set pointers to them */
462  t[nrl]=(float **) calloc((size_t)(nrow*ncol+NR_END), sizeof(float*));
463  if (!t[nrl]) nrerror("allocation failure 2 in f3tensor()");
464  t[nrl] += NR_END;
465  t[nrl] -= ncl;
466 
467  /* allocate rows and set pointers to them */
468  t[nrl][ncl]=(float *) calloc((size_t)(nrow*ncol*ndep+NR_END),
469  sizeof(float));
470  if (!t[nrl][ncl]) nrerror("allocation failure 3 in f3tensor()");
471  t[nrl][ncl] += NR_END;
472  t[nrl][ncl] -= ndl;
473 
474  for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
475  for(i=nrl+1;i<=nrh;i++) {
476  t[i]=t[i-1]+ncol;
477  t[i][ncl]=t[i-1][ncl]+ncol*ndep;
478  for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
479  }
480 
481  /* return pointer to array of pointers to rows */
482  return t;
483 }
484 
485 double ***d3tensor(int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch, int32_t ndl, int32_t ndh)
486 /* allocate a float 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
487 {
488  int32_t i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
489  double ***t;
490 
491  /* allocate pointers to pointers to rows */
492  t=(double ***) calloc((size_t)(nrow+NR_END), sizeof(double**));
493  if (!t) nrerror("allocation failure 1 in d3tensor()");
494  t += NR_END;
495  t -= nrl;
496 
497  /* allocate pointers to rows and set pointers to them */
498  t[nrl]=(double **) calloc((size_t)(nrow*ncol+NR_END), sizeof(double*));
499  if (!t[nrl]) nrerror("allocation failure 2 in d3tensor()");
500  t[nrl] += NR_END;
501  t[nrl] -= ncl;
502 
503  /* allocate rows and set pointers to them */
504  t[nrl][ncl]=(double *) calloc((size_t)(nrow*ncol*ndep+NR_END),
505  sizeof(double));
506  if (!t[nrl][ncl]) nrerror("allocation failure 3 in d3tensor()");
507  t[nrl][ncl] += NR_END;
508  t[nrl][ncl] -= ndl;
509 
510  for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
511  for(i=nrl+1;i<=nrh;i++) {
512  t[i]=t[i-1]+ncol;
513  t[i][ncl]=t[i-1][ncl]+ncol*ndep;
514  for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
515  }
516 
517  /* return pointer to array of pointers to rows */
518  return t;
519 }
520 
521 frame_data ***fd3tensor(int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch, int32_t ndl, int32_t ndh)
522 /* allocate a frame_data 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
523 {
524  int32_t i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
525  frame_data ***t;
526 
527  /* allocate pointers to pointers to rows */
528  t=(frame_data ***) calloc((size_t)(nrow+NR_END), sizeof(frame_data**));
529  if (!t) nrerror("allocation failure 1 in fd3tensor()");
530  t += NR_END;
531  t -= nrl;
532 
533  /* allocate pointers to rows and set pointers to them */
534  t[nrl]=(frame_data **) calloc((size_t)(nrow*ncol+NR_END),
535  sizeof(frame_data*));
536  if (!t[nrl]) nrerror("allocation failure 2 in fd3tensor()");
537  t[nrl] += NR_END;
538  t[nrl] -= ncl;
539 
540  /* allocate rows and set pointers to them */
541  t[nrl][ncl]=(frame_data *) calloc((size_t)(nrow*ncol*ndep+NR_END),
542  sizeof(frame_data));
543  if (!t[nrl][ncl]) nrerror("allocation failure 3 in fd3tensor()");
544  t[nrl][ncl] += NR_END;
545  t[nrl][ncl] -= ndl;
546 
547  for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
548  for(i=nrl+1;i<=nrh;i++) {
549  t[i]=t[i-1]+ncol;
550  t[i][ncl]=t[i-1][ncl]+ncol*ndep;
551  for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
552  }
553 
554  /* return pointer to array of pointers to rows */
555  return t;
556 }
557 
558 frame_mask ***fm3tensor(int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch, int32_t ndl, int32_t ndh)
559 /* allocate a frame_mask 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
560 {
561  int32_t i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
562  frame_mask ***t;
563 
564  /* allocate pointers to pointers to rows */
565  t=(frame_mask ***) calloc((size_t)(nrow+NR_END), sizeof(frame_mask**));
566  if (!t) nrerror("allocation failure 1 in f3tensor()");
567  t += NR_END;
568  t -= nrl;
569 
570  /* allocate pointers to rows and set pointers to them */
571  t[nrl]=(frame_mask **) calloc((size_t)(nrow*ncol+NR_END),
572  sizeof(frame_mask*));
573  if (!t[nrl]) nrerror("allocation failure 2 in f3tensor()");
574  t[nrl] += NR_END;
575  t[nrl] -= ncl;
576 
577  /* allocate rows and set pointers to them */
578  t[nrl][ncl]=(frame_mask *) calloc((size_t)(nrow*ncol*ndep+NR_END),
579  sizeof(frame_mask));
580  if (!t[nrl][ncl]) nrerror("allocation failure 3 in f3tensor()");
581  t[nrl][ncl] += NR_END;
582  t[nrl][ncl] -= ndl;
583 
584  for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
585  for(i=nrl+1;i<=nrh;i++) {
586  t[i]=t[i-1]+ncol;
587  t[i][ncl]=t[i-1][ncl]+ncol*ndep;
588  for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
589  }
590 
591  /* return pointer to array of pointers to rows */
592  return t;
593 }
594 
595 uint32_t ***ul3tensor(int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch, int32_t ndl, int32_t ndh)
596 /* allocate a frame_mask 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
597 {
598  int32_t i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
599  uint32_t ***t;
600 
601  /* allocate pointers to pointers to rows */
602  t=(uint32_t ***) calloc((size_t)(nrow+NR_END),
603  sizeof(uint32_t**));
604  if (!t) nrerror("allocation failure 1 in f3tensor()");
605  t += NR_END;
606  t -= nrl;
607 
608  /* allocate pointers to rows and set pointers to them */
609  t[nrl]=(uint32_t **) calloc((size_t)(nrow*ncol+NR_END),
610  sizeof(uint32_t*));
611  if (!t[nrl]) nrerror("allocation failure 2 in f3tensor()");
612  t[nrl] += NR_END;
613  t[nrl] -= ncl;
614 
615  /* allocate rows and set pointers to them */
616  t[nrl][ncl]=
617  (uint32_t *) calloc((size_t)(nrow*ncol*ndep+NR_END),
618  sizeof(uint32_t));
619  if (!t[nrl][ncl]) nrerror("allocation failure 3 in f3tensor()");
620  t[nrl][ncl] += NR_END;
621  t[nrl][ncl] -= ndl;
622 
623  for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
624  for(i=nrl+1;i<=nrh;i++) {
625  t[i]=t[i-1]+ncol;
626  t[i][ncl]=t[i-1][ncl]+ncol*ndep;
627  for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
628  }
629 
630  /* return pointer to array of pointers to rows */
631  return t;
632 }
633 
634 int32_t ***l3tensor(int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch, int32_t ndl, int32_t ndh)
635 /* allocate a int32_t 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
636 {
637  int32_t i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
638  int32_t ***t;
639 
640  /* allocate pointers to pointers to rows */
641  t=(int32_t ***) calloc((size_t)(nrow+NR_END), sizeof(int32_t**));
642  if (!t) nrerror("allocation failure 1 in f3tensor()");
643  t += NR_END;
644  t -= nrl;
645 
646  /* allocate pointers to rows and set pointers to them */
647  t[nrl]=(int32_t **) calloc((size_t)(nrow*ncol+NR_END),
648  sizeof(int32_t*));
649  if (!t[nrl]) nrerror("allocation failure 2 in f3tensor()");
650  t[nrl] += NR_END;
651  t[nrl] -= ncl;
652 
653  /* allocate rows and set pointers to them */
654  t[nrl][ncl]=(int32_t *) calloc((size_t)(nrow*ncol*ndep+NR_END),
655  sizeof(int32_t));
656  if (!t[nrl][ncl]) nrerror("allocation failure 3 in f3tensor()");
657  t[nrl][ncl] += NR_END;
658  t[nrl][ncl] -= ndl;
659 
660  for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
661  for(i=nrl+1;i<=nrh;i++) {
662  t[i]=t[i-1]+ncol;
663  t[i][ncl]=t[i-1][ncl]+ncol*ndep;
664  for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
665  }
666 
667  /* return pointer to array of pointers to rows */
668  return t;
669 }
670 
671 int32_t ****l4tensor(int32_t nal, int32_t nah, int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch, int32_t ndl, int32_t ndh)
672 /* allocate a int32_t 4tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
673 {
674  int32_t i,j,k,na=nah-nal+1,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
675  int32_t ****t;
676 
677  /* allocate pointers to pointers to pointers to rows */
678  t=(int32_t ****) calloc((size_t)(na+NR_END), sizeof(int32_t***));
679  if (!t) nrerror("allocation failure 1 in l4tensor()");
680  t += NR_END;
681  t -= nal;
682 
683  /* allocate pointers to pointers to rows and set pointers to them */
684  t[nal]=(int32_t ***) calloc((size_t)(na*nrow+NR_END),
685  sizeof(int32_t**));
686  if (!t[nal]) nrerror("allocation failure 2 in f3tensor()");
687  t[nal] += NR_END;
688  t[nal] -= nrl;
689 
690  /* allocate pointers to rows and set pointers to them */
691  t[nal][nrl]=(int32_t **) calloc((size_t)(na*nrow*ncol+NR_END),
692  sizeof(int32_t*));
693  if (!t[nal][nrl]) nrerror("allocation failure 3 in f3tensor()");
694  t[nal][nrl] += NR_END;
695  t[nal][nrl] -= ncl;
696 
697  /* allocate rows and set pointers to them */
698  t[nal][nrl][ncl]=
699  (int32_t *) calloc((size_t)(na*nrow*ncol*ndep+NR_END),
700  sizeof(int32_t));
701  if (!t[nal][nrl][ncl]) nrerror("allocation failure 4 in f3tensor()");
702  t[nal][nrl][ncl] += NR_END;
703  t[nal][nrl][ncl] -= ndl;
704 
705  for(k=ncl+1;k<=nch;k++) t[nal][nrl][k]=t[nal][nrl][k-1]+ndep;
706  for(j=nrl+1;j<=nrh;j++) {
707  t[nal][j] = t[nal][j-1]+ncol;
708  t[nal][j][ncl] = t[nal][j-1][ncl]+ncol*ndep;
709  for(k=ncl+1;k<=nch;k++) t[nal][j][k]=t[nal][j][k-1]+ndep;
710  }
711  for(i=nal+1;i<=nah;i++) {
712  t[i]=t[i-1]+nrow;
713  t[i][nrl] = t[i-1][nrl]+nrow*ncol;
714  t[i][nrl][ncl] = t[i-1][nrl][ncl]+nrow*ncol*ndep;
715  for(k=ncl+1;k<=nch;k++) t[i][nrl][k]=t[i][nrl][k-1]+ndep;
716  for(j=nrl+1;j<=nrh;j++) {
717  t[i][j] = t[i][j-1]+ncol;
718  t[i][j][ncl] = t[i][j-1][ncl]+ncol*ndep;
719  for(k=ncl+1;k<=nch;k++) t[i][j][k]=t[i][j][k-1]+ndep;
720  }
721  }
722 
723  /* return pointer to array of pointers to rows */
724  return t;
725 }
726 
727 void free_vector(float *v, int32_t nl, int32_t nh)
728 /* free a float vector allocated with vector() */
729 {
730  //to remove comp warning: not used
731  nh=nh;
732  free((FREE_ARG) (v+nl-NR_END));
733 }
734 
735 void free_ivector(int *v, int32_t nl, int32_t nh)
736 /* free an int vector allocated with ivector() */
737 {
738  //to remove comp warning: not used
739  nh=nh;
740  free((FREE_ARG) (v+nl-NR_END));
741 }
742 
743 void free_uivector(unsigned int *v, int32_t nl, int32_t nh)
744 /* free an unsigned int vector allocated with uivector() */
745 {
746  //to remove comp warning: not used
747  nh=nh;
748  free((FREE_ARG) (v+nl-NR_END));
749 }
750 
751 void free_cvector(char *v, int32_t nl, int32_t nh)
752 /* free a char vector allocated with cvector() */
753 {
754  //to remove comp warning: not used
755  nh=nh;
756  free((FREE_ARG) (v+nl-NR_END));
757 }
758 
759 void free_ucvector(unsigned char *v, int32_t nl, int32_t nh)
760 /* free an unsigned char vector allocated with ucvector() */
761 {
762  //to remove comp warning: not used
763  nh=nh;
764  free((FREE_ARG) (v+nl-NR_END));
765 }
766 
767 void free_lvector(int32_t *v, int32_t nl, int32_t nh)
768 /* free an uint32_t vector allocated with lvector() */
769 {
770  //to remove comp warning: not used
771  nh=nh;
772  free((FREE_ARG) (v+nl-NR_END));
773 }
774 
775 void free_ulvector(uint32_t *v, int32_t nl, int32_t nh)
776 /* free an uint32_t vector allocated with ulvector() */
777 {
778  //to remove comp warning: not used
779  nh=nh;
780  free((FREE_ARG) (v+nl-NR_END));
781 }
782 
783 void free_dvector(double *v, int32_t nl, int32_t nh)
784 /* free a double vector allocated with dvector() */
785 {
786  //to remove comp warning: not used
787  nh=nh;
788  free((FREE_ARG) (v+nl-NR_END));
789 }
790 
791 void free_fdvector(frame_data *v, int32_t nl, int32_t nh)
792 /* free a double vector allocated with dvector() */
793 {
794  //to remove comp warning: not used
795  nh=nh;
796  free((FREE_ARG) (v+nl-NR_END));
797 }
798 
799 void free_fmvector(frame_mask *v, int32_t nl, int32_t nh)
800 /* free a double vector allocated with dvector() */
801 {
802  //to remove comp warning: not used
803  nh=nh;
804  free((FREE_ARG) (v+nl-NR_END));
805 }
806 
807 void free_matrix(float **m, int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch)
808 /* free a float matrix allocated by matrix() */
809 {
810  //to remove comp warning: not used
811  nch=nch;
812  //to remove comp warning: not used
813  nrh=nrh;
814  free((FREE_ARG) (m[nrl]+ncl-NR_END));
815  free((FREE_ARG) (m+nrl-NR_END));
816 }
817 
818 void free_cmatrix(char **m, int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch)
819 /* free a float matrix allocated by cmatrix() */
820 {
821  //to remove comp warning: not used
822  nch=nch;
823  //to remove comp warning: not used
824  nrh=nrh;
825  free((FREE_ARG) (m[nrl]+ncl-NR_END));
826  free((FREE_ARG) (m+nrl-NR_END));
827 }
828 
829 void free_dmatrix(double **m, int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch)
830 /* free a double matrix allocated by dmatrix() */
831 {
832  //to remove comp warning: not used
833  nch=nch;
834  //to remove comp warning: not used
835  nrh=nrh;
836  free((FREE_ARG) (m[nrl]+ncl-NR_END));
837  free((FREE_ARG) (m+nrl-NR_END));
838 }
839 
840 void free_imatrix(int **m, int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch)
841 /* free an int matrix allocated by imatrix() */
842 {
843  //to remove comp warning: not used
844  nch=nch;
845  //to remove comp warning: not used
846  nrh=nrh;
847  free((FREE_ARG) (m[nrl]+ncl-NR_END));
848  free((FREE_ARG) (m+nrl-NR_END));
849 }
850 
851 void free_ulmatrix(uint32_t **m, int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch)
852 /* free an int matrix allocated by imatrix() */
853 {
854  //to remove comp warning: not used
855  nch=nch;
856  //to remove comp warning: not used
857  nrh=nrh;
858  free((FREE_ARG) (m[nrl]+ncl-NR_END));
859  free((FREE_ARG) (m+nrl-NR_END));
860 }
861 
862 void free_lmatrix(int32_t **m, int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch)
863 /* free an int matrix allocated by imatrix() */
864 {
865  //to remove comp warning: not used
866  nch=nch;
867  //to remove comp warning: not used
868  nrh=nrh;
869  free((FREE_ARG) (m[nrl]+ncl-NR_END));
870  free((FREE_ARG) (m+nrl-NR_END));
871 }
872 
873 void free_fdmatrix(frame_data **m, int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch)
874 /* free an frame_data matrix allocated by imatrix() */
875 {
876  //to remove comp warning: not used
877  nch=nch;
878  //to remove comp warning: not used
879  nrh=nrh;
880  free((FREE_ARG) (m[nrl]+ncl-NR_END));
881  free((FREE_ARG) (m+nrl-NR_END));
882 }
883 
884 void free_fmmatrix(frame_mask **m, int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch)
885 /* free an int matrix allocated by imatrix() */
886 {
887  //to remove comp warning: not used
888  nch=nch;
889  //to remove comp warning: not used
890  nrh=nrh;
891  free((FREE_ARG) (m[nrl]+ncl-NR_END));
892  free((FREE_ARG) (m+nrl-NR_END));
893 }
894 
895 void free_submatrix(float **b, int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch)
896 /* free a submatrix allocated by submatrix() */
897 {
898  //to remove comp warning: not used
899  nch=nch;
900  //to remove comp warning: not used
901  nrh=nrh;
902  //to remove comp warning: not used
903  ncl=ncl;
904 
905  free((FREE_ARG) (b+nrl-NR_END));
906 }
907 
908 void free_convert_matrix(float **b, int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch)
909 /* free a matrix allocated by convert_matrix() */
910 {
911  //to remove comp warning: not used
912  nch=nch;
913  //to remove comp warning: not used
914  nrh=nrh;
915  //to remove comp warning: not used
916  ncl=ncl;
917  free((FREE_ARG) (b+nrl-NR_END));
918 }
919 
920 void free_f3tensor(float ***t, int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch,
921  int32_t ndl, int32_t ndh)
922 /* free a float f3tensor allocated by f3tensor() */
923 {
924  //to remove comp warning: not used
925  nrh=nrh;
926  //to remove comp warning: not used
927  nch=nch;
928  //to remove comp warning: not used
929  ndh=ndh;
930 
931  free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
932  free((FREE_ARG) (t[nrl]+ncl-NR_END));
933  free((FREE_ARG) (t+nrl-NR_END));
934 }
935 
936 void free_d3tensor(double ***t, int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch,
937  int32_t ndl, int32_t ndh)
938 /* free a double 3tensor allocated by d3tensor() */
939 {
940  //to remove comp warning: not used
941  nrh=nrh;
942  //to remove comp warning: not used
943  nch=nch;
944  //to remove comp warning: not used
945  ndh=ndh;
946 
947  free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
948  free((FREE_ARG) (t[nrl]+ncl-NR_END));
949  free((FREE_ARG) (t+nrl-NR_END));
950 }
951 
952 void free_fd3tensor(frame_data ***t, int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch,
953  int32_t ndl, int32_t ndh)
954 /* free a frame_data f3tensor allocated by f3tensor() */
955 {
956  //to remove comp warning: not used
957  nrh=nrh;
958  //to remove comp warning: not used
959  nch=nch;
960  //to remove comp warning: not used
961  ndh=ndh;
962  free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
963  free((FREE_ARG) (t[nrl]+ncl-NR_END));
964  free((FREE_ARG) (t+nrl-NR_END));
965 }
966 
967 void free_fm3tensor(frame_mask ***t, int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch,
968  int32_t ndl, int32_t ndh)
969 /* free a float f3tensor allocated by f3tensor() */
970 {
971  //to remove comp warning: not used
972  nrh=nrh;
973  //to remove comp warning: not used
974  nch=nch;
975  //to remove comp warning: not used
976  ndh=ndh;
977  free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
978  free((FREE_ARG) (t[nrl]+ncl-NR_END));
979  free((FREE_ARG) (t+nrl-NR_END));
980 }
981 
982 void free_ul3tensor(uint32_t ***t, int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch,
983  int32_t ndl, int32_t ndh)
984 /* free a float f3tensor allocated by f3tensor() */
985 {
986  //to remove comp warning: not used
987  nrh=nrh;
988  //to remove comp warning: not used
989  nch=nch;
990  //to remove comp warning: not used
991  ndh=ndh;
992 
993  free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
994  free((FREE_ARG) (t[nrl]+ncl-NR_END));
995  free((FREE_ARG) (t+nrl-NR_END));
996 }
997 
998 void free_l3tensor(int32_t ***t, int32_t nrl, int32_t nrh, int32_t ncl, int32_t nch,
999  int32_t ndl, int32_t ndh)
1000 /* free a float f3tensor allocated by f3tensor() */
1001 {
1002  //to remove comp warning: not used
1003  nrh=nrh;
1004  //to remove comp warning: not used
1005  nch=nch;
1006  //to remove comp warning: not used
1007  ndh=ndh;
1008  free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
1009  free((FREE_ARG) (t[nrl]+ncl-NR_END));
1010  free((FREE_ARG) (t+nrl-NR_END));
1011 }
1012 
1013 void free_l4tensor(int32_t ****t, int32_t nal, int32_t nah, int32_t nrl, int32_t nrh,
1014  int32_t ncl, int32_t nch, int32_t ndl, int32_t ndh)
1015 /* free an integer l4tensor allocated by f3tensor() */
1016 {
1017  //to remove comp warning: not used
1018  nah=nah;
1019  //to remove comp warning: not used
1020  nrh=nrh;
1021  //to remove comp warning: not used
1022  nch=nch;
1023  //to remove comp warning: not used
1024  ndh=ndh;
1025 
1026  free((FREE_ARG) (t[nal][nrl][ncl]+ndl-NR_END));
1027  free((FREE_ARG) (t[nal][nrl]+ncl-NR_END));
1028  free((FREE_ARG) (t[nal]+nrl-NR_END));
1029  free((FREE_ARG) (t+nal-NR_END));
1030 }
1031 
1032 void matrix_product(double **A, double **B, double **C, int ra, int ca, int cb)
1033 {
1034  /* Put in C the matrix product of A and B (in this order please!) */
1035 
1036  int k,j,m;
1037 
1038  C=dmatrix(1,ra,1,cb);
1039  if (!C)
1040  {
1041  SCTPUT("Error in matrix product");
1042  }
1043 
1044  for (j=1; j<=ra; j++)
1045  {
1046  for (k=1; k<=cb; k++)
1047  {
1048  C[j][k]=0;
1049  }
1050  }
1051 
1052  for (j=1; j<=ra; j++)
1053  {
1054  for (k=1; k<=cb; k++)
1055  {
1056  for (m=1; m<=ca; m++)
1057  {
1058  C[j][k] += A[j][m]*B[m][k];
1059  }
1060  }
1061  }
1062  return ;
1063 }
1064 void matrix_sum(double **A, double **B, int ra, int ca)
1065 {
1066 
1067  /* Put in A the matrix sum of A and B */
1068  int k,j;
1069 
1070  for (j=1; j<=ra; j++)
1071  {
1072  for (k=1; k<=ca; k++)
1073  {
1074  A[j][k] += B[j][k];
1075  }
1076  }
1077  return ;
1078 }
1079 
1080 
1081 
1082 #else /* ANSI */
1083 /* traditional - K&R */
1084 
1085 #include <stdio.h>
1086 #include <flames_uves.h>
1087 #define NR_END 1
1088 #define FREE_ARG char*
1089 
1090 void nrerror(error_text)
1091  char error_text[];
1092 /* Numerical Recipes standard error handler */
1093 {
1094  /*
1095  ---------- Let's comment out the non-MIDAS compliant items----------
1096 
1097  fprintf(stderr,"Numerical Recipes run-time error...\n");
1098  fprintf(stderr,"%s\n",error_text);
1099  fprintf(stderr,"...now exiting to system...\n");
1100  */
1101  void exit();
1102  char output[70];
1103 
1104  SCTPUT("Numerical Recipes run-time error...\n");
1105  sprintf(output, "%s\n", error_text);
1106  SCTPUT(output);
1107  SCTPUT("...now exiting to system...\n");
1108  SCSEPI();
1109  return flames_midas_fail();
1110 }
1111 
1112 float *vector(nl,nh)
1113  int32_t nh,nl;
1114  /* allocate a float vector with subscript range v[nl..nh] */
1115 {
1116  float *v;
1117 
1118  v=(float *) calloc((unsigned int) (nh-nl+1+NR_END), sizeof(float));
1119  if (!v) nrerror("allocation failure in vector()");
1120  return v-nl+NR_END;
1121 }
1122 
1123 int *ivector(nl,nh)
1124  int32_t nh,nl;
1125  /* allocate an int vector with subscript range v[nl..nh] */
1126 {
1127  int *v;
1128 
1129  v=(int *) calloc((unsigned int) (nh-nl+1+NR_END), sizeof(int));
1130  if (!v) nrerror("allocation failure in ivector()");
1131  return v-nl+NR_END;
1132 }
1133 
1134 unsigned int *uivector(nl,nh)
1135  int32_t nh,nl;
1136  /* allocate an int vector with subscript range v[nl..nh] */
1137 {
1138  unsigned int *v;
1139 
1140  v=(unsigned int *) calloc((unsigned int) (nh-nl+1+NR_END),
1141  sizeof(unsigned int));
1142  if (!v) nrerror("allocation failure in uivector()");
1143  return v-nl+NR_END;
1144 }
1145 
1146 char *cvector(nl,nh)
1147  int32_t nh,nl;
1148  /* allocate a char vector with subscript range v[nl..nh] */
1149 {
1150  char *v;
1151 
1152  v=(char *) calloc((unsigned int) (nh-nl+1+NR_END), sizeof(char));
1153  if (!v) nrerror("allocation failure in cvector()");
1154  return v-nl+NR_END;
1155 }
1156 
1157 char *ucvector(nl,nh)
1158  int32_t nh,nl;
1159  /* allocate an unsigned char vector with subscript range v[nl..nh] */
1160 {
1161  unsigned char *v;
1162 
1163  v=(unsigned char *) calloc((unsigned int) (nh-nl+1+NR_END),
1164  sizeof(unsigned char));
1165  if (!v) nrerror("allocation failure in ucvector()");
1166  return v-nl+NR_END;
1167 }
1168 
1169 int32_t *lvector(nl,nh)
1170  int32_t nh,nl;
1171  /* allocate an uint32_t vector with subscript range v[nl..nh] */
1172 {
1173  int32_t *v;
1174 
1175  v=(int32_t *) calloc((unsigned int) (nh-nl+1+NR_END),
1176  sizeof(int32_t));
1177  if (!v) nrerror("allocation failure in lvector()");
1178  return v-nl+NR_END;
1179 }
1180 
1181 uint32_t *ulvector(nl,nh)
1182  int32_t nh,nl;
1183  /* allocate an uint32_t vector with subscript range v[nl..nh] */
1184 {
1185  uint32_t *v;
1186 
1187  v=(uint32_t*) calloc((unsigned int) (nh-nl+1+NR_END),
1188  sizeof(uint32_t));
1189  if (!v) nrerror("allocation failure in ulvector()");
1190  return v-nl+NR_END;
1191 }
1192 
1193 double *dvector(nl,nh)
1194  int32_t nh,nl;
1195  /* allocate a double vector with subscript range v[nl..nh] */
1196 {
1197  double *v;
1198 
1199  v=(double *) calloc((unsigned int) (nh-nl+1+NR_END), sizeof(double));
1200  if (!v) nrerror("allocation failure in dvector()");
1201  return v-nl+NR_END;
1202 }
1203 
1204 double *fdvector(nl,nh)
1205  int32_t nh,nl;
1206  /* allocate a frame_data vector with subscript range v[nl..nh] */
1207 {
1208  frame_data *v;
1209 
1210  v=(frame_data *) calloc((unsigned int) (nh-nl+1+NR_END),
1211  sizeof(frame_data));
1212  if (!v) nrerror("allocation failure in dvector()");
1213  return v-nl+NR_END;
1214 }
1215 
1216 double *fmvector(nl,nh)
1217  int32_t nh,nl;
1218  /* allocate a frame_mask vector with subscript range v[nl..nh] */
1219 {
1220  frame_mask *v;
1221 
1222  v=(frame_mask *) calloc((unsigned int) (nh-nl+1+NR_END),
1223  sizeof(frame_mask));
1224  if (!v) nrerror("allocation failure in dvector()");
1225  return v-nl+NR_END;
1226 }
1227 
1228 float **matrix(nrl,nrh,ncl,nch)
1229  int32_t nch,ncl,nrh,nrl;
1230  /* allocate a float matrix with subscript range m[nrl..nrh][ncl..nch] */
1231 {
1232  int32_t i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
1233  float **m;
1234 
1235  /* allocate pointers to rows */
1236  m=(float **) calloc((unsigned int)(nrow+NR_END), sizeof(float*));
1237  if (!m) nrerror("allocation failure 1 in matrix()");
1238  m += NR_END;
1239  m -= nrl;
1240 
1241  /* allocate rows and set pointers to them */
1242  m[nrl]=(float *) calloc((unsigned int)(nrow*ncol+NR_END),
1243  sizeof(float));
1244  if (!m[nrl]) nrerror("allocation failure 2 in matrix()");
1245  m[nrl] += NR_END;
1246  m[nrl] -= ncl;
1247 
1248  for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
1249 
1250  /* return pointer to array of pointers to rows */
1251  return m;
1252 }
1253 
1254 char **cmatrix(nrl,nrh,ncl,nch)
1255  int32_t nch,ncl,nrh,nrl;
1256  /* allocate a float matrix with subscript range m[nrl..nrh][ncl..nch] */
1257 {
1258  int32_t i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
1259  char **m;
1260 
1261  /* allocate pointers to rows */
1262  m=(char **) calloc((unsigned int)(nrow+NR_END), sizeof(char*));
1263  if (!m) nrerror("allocation failure 1 in cmatrix()");
1264  m += NR_END;
1265  m -= nrl;
1266 
1267  /* allocate rows and set pointers to them */
1268  m[nrl]=(char *) calloc((unsigned int)(nrow*ncol+NR_END),
1269  sizeof(char));
1270  if (!m[nrl]) nrerror("allocation failure 2 in cmatrix()");
1271  m[nrl] += NR_END;
1272  m[nrl] -= ncl;
1273 
1274  for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
1275 
1276  /* return pointer to array of pointers to rows */
1277  return m;
1278 }
1279 
1280 double **dmatrix(nrl,nrh,ncl,nch)
1281  int32_t nch,ncl,nrh,nrl;
1282  /* allocate a double matrix with subscript range m[nrl..nrh][ncl..nch] */
1283 {
1284  int32_t i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
1285  double **m;
1286 
1287  /* allocate pointers to rows */
1288  m=(double **) calloc((unsigned int)(nrow+NR_END), sizeof(double*));
1289  if (!m) nrerror("allocation failure 1 in dmatrix()");
1290  m += NR_END;
1291  m -= nrl;
1292 
1293  /* allocate rows and set pointers to them */
1294  m[nrl]=(double *) calloc((unsigned int)(nrow*ncol+NR_END),
1295  sizeof(double));
1296  if (!m[nrl]) nrerror("allocation failure 2 in dmatrix()");
1297  m[nrl] += NR_END;
1298  m[nrl] -= ncl;
1299 
1300  for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
1301 
1302  /* return pointer to array of pointers to rows */
1303  return m;
1304 }
1305 
1306 int **imatrix(nrl,nrh,ncl,nch)
1307  int32_t nch,ncl,nrh,nrl;
1308  /* allocate a int matrix with subscript range m[nrl..nrh][ncl..nch] */
1309 {
1310  int32_t i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
1311  int **m;
1312 
1313  /* allocate pointers to rows */
1314  m=(int **) calloc((unsigned int)(nrow+NR_END), sizeof(int*));
1315  if (!m) nrerror("allocation failure 1 in imatrix()");
1316  m += NR_END;
1317  m -= nrl;
1318 
1319 
1320  /* allocate rows and set pointers to them */
1321  m[nrl]=(int *) calloc((unsigned int)(nrow*ncol+NR_END), sizeof(int));
1322  if (!m[nrl]) nrerror("allocation failure 2 in imatrix()");
1323  m[nrl] += NR_END;
1324  m[nrl] -= ncl;
1325 
1326  for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
1327 
1328  /* return pointer to array of pointers to rows */
1329  return m;
1330 }
1331 
1332 uint32_t **ulmatrix(nrl,nrh,ncl,nch)
1333  int32_t nch,ncl,nrh,nrl;
1334  /* allocate a int matrix with subscript range m[nrl..nrh][ncl..nch] */
1335 {
1336  int32_t i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
1337  uint32_t **m;
1338 
1339  /* allocate pointers to rows */
1340  m=(uint32_t **) calloc((unsigned int)(nrow+NR_END),
1341  sizeof(uint32_t*));
1342  if (!m) nrerror("allocation failure 1 in ulmatrix()");
1343  m += NR_END;
1344  m -= nrl;
1345 
1346 
1347  /* allocate rows and set pointers to them */
1348  m[nrl]=(uint32_t *) calloc((unsigned int)(nrow*ncol+NR_END),
1349  sizeof(uint32_t));
1350  if (!m[nrl]) nrerror("allocation failure 2 in ulmatrix()");
1351  m[nrl] += NR_END;
1352  m[nrl] -= ncl;
1353 
1354  for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
1355 
1356  /* return pointer to array of pointers to rows */
1357  return m;
1358 }
1359 
1360 int32_t **lmatrix(nrl,nrh,ncl,nch)
1361  int32_t nch,ncl,nrh,nrl;
1362  /* allocate a int matrix with subscript range m[nrl..nrh][ncl..nch] */
1363 {
1364  int32_t i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
1365  int32_t **m;
1366 
1367  /* allocate pointers to rows */
1368  m=(int32_t **) calloc((unsigned int)(nrow+NR_END), sizeof(int32_t*));
1369  if (!m) nrerror("allocation failure 1 in lmatrix()");
1370  m += NR_END;
1371  m -= nrl;
1372 
1373 
1374  /* allocate rows and set pointers to them */
1375  m[nrl]=(int32_t *) calloc((unsigned int)(nrow*ncol+NR_END),
1376  sizeof(int32_t));
1377  if (!m[nrl]) nrerror("allocation failure 2 in lmatrix()");
1378  m[nrl] += NR_END;
1379  m[nrl] -= ncl;
1380 
1381  for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
1382 
1383  /* return pointer to array of pointers to rows */
1384  return m;
1385 }
1386 
1387 frame_data **fdmatrix(nrl,nrh,ncl,nch)
1388  int32_t nch,ncl,nrh,nrl;
1389  /* allocate a frame_data matrix with subscript range m[nrl..nrh][ncl..nch] */
1390 {
1391  int32_t i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
1392  frame_data **m;
1393 
1394  /* allocate pointers to rows */
1395  m=(frame_data **) calloc((unsigned int)(nrow+NR_END),
1396  sizeof(frame_data*));
1397  if (!m) nrerror("allocation failure 1 in fdmatrix()");
1398  m += NR_END;
1399  m -= nrl;
1400 
1401 
1402  /* allocate rows and set pointers to them */
1403  m[nrl]=(frame_data *) calloc((unsigned int)(nrow*ncol+NR_END),
1404  sizeof(frame_data));
1405  if (!m[nrl]) nrerror("allocation failure 2 in fdmatrix()");
1406  m[nrl] += NR_END;
1407  m[nrl] -= ncl;
1408 
1409  for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
1410 
1411  /* return pointer to array of pointers to rows */
1412  return m;
1413 }
1414 
1415 frame_mask **fmmatrix(nrl,nrh,ncl,nch)
1416  int32_t nch,ncl,nrh,nrl;
1417  /* allocate a frame_mask matrix with subscript range m[nrl..nrh][ncl..nch] */
1418 {
1419  int32_t i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
1420  frame_mask **m;
1421 
1422  /* allocate pointers to rows */
1423  m=(frame_mask **) calloc((unsigned int)(nrow+NR_END),
1424  sizeof(frame_mask*));
1425  if (!m) nrerror("allocation failure 1 in fmmatrix()");
1426  m += NR_END;
1427  m -= nrl;
1428 
1429 
1430  /* allocate rows and set pointers to them */
1431  m[nrl]=(frame_mask *) calloc((unsigned int)(nrow*ncol+NR_END),
1432  sizeof(frame_mask));
1433  if (!m[nrl]) nrerror("allocation failure 2 in fmmatrix()");
1434  m[nrl] += NR_END;
1435  m[nrl] -= ncl;
1436 
1437  for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
1438 
1439  /* return pointer to array of pointers to rows */
1440  return m;
1441 }
1442 
1443 float **submatrix(a,oldrl,oldrh,oldcl,oldch,newrl,newcl)
1444  float **a;
1445  int32_t newcl,newrl,oldch,oldcl,oldrh,oldrl;
1446  /* point a submatrix [newrl..][newcl..] to a[oldrl..oldrh][oldcl..oldch] */
1447 {
1448  int32_t i,j,nrow=oldrh-oldrl+1,ncol=oldcl-newcl;
1449  float **m;
1450 
1451  /* allocate array of pointers to rows */
1452  m=(float **) calloc((unsigned int) (nrow+NR_END), sizeof(float*));
1453  if (!m) nrerror("allocation failure in submatrix()");
1454  m += NR_END;
1455  m -= newrl;
1456 
1457  /* set pointers to rows */
1458  for(i=oldrl,j=newrl;i<=oldrh;i++,j++) m[j]=a[i]+ncol;
1459 
1460  /* return pointer to array of pointers to rows */
1461  return m;
1462 }
1463 
1464 float **convert_matrix(a,nrl,nrh,ncl,nch)
1465  float *a;
1466  int32_t nch,ncl,nrh,nrl;
1467  /* allocate a float matrix m[nrl..nrh][ncl..nch] that points to the matrix
1468  declared in the standard C manner as a[nrow][ncol], where nrow=nrh-nrl+1
1469  and ncol=nch-ncl+1. The routine should be called with the address
1470  &a[0][0] as the first argument. */
1471 {
1472  int32_t i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1;
1473  float **m;
1474 
1475  /* allocate pointers to rows */
1476  m=(float **) calloc((unsigned int) (nrow+NR_END), sizeof(float*));
1477  if (!m) nrerror("allocation failure in convert_matrix()");
1478  m += NR_END;
1479  m -= nrl;
1480 
1481  /* set pointers to rows */
1482  m[nrl]=a-ncl;
1483  for(i=1,j=nrl+1;i<nrow;i++,j++) m[j]=m[j-1]+ncol;
1484  /* return pointer to array of pointers to rows */
1485  return m;
1486 }
1487 
1488 float ***f3tensor(nrl,nrh,ncl,nch,ndl,ndh)
1489  int32_t nch,ncl,ndh,ndl,nrh,nrl;
1490  /* allocate a float 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
1491 {
1492  int32_t i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
1493  float ***t;
1494 
1495  /* allocate pointers to pointers to rows */
1496  t=(float ***) calloc((unsigned int)(nrow+NR_END), sizeof(float**));
1497  if (!t) nrerror("allocation failure 1 in f3tensor()");
1498  t += NR_END;
1499  t -= nrl;
1500 
1501  /* allocate pointers to rows and set pointers to them */
1502  t[nrl]=(float **) calloc((unsigned int)(nrow*ncol+NR_END),
1503  sizeof(float*));
1504  if (!t[nrl]) nrerror("allocation failure 2 in f3tensor()");
1505  t[nrl] += NR_END;
1506  t[nrl] -= ncl;
1507 
1508  /* allocate rows and set pointers to them */
1509  t[nrl][ncl]=(float *) calloc((unsigned int)(nrow*ncol*ndep+NR_END),
1510  sizeof(float));
1511  if (!t[nrl][ncl]) nrerror("allocation failure 3 in f3tensor()");
1512  t[nrl][ncl] += NR_END;
1513  t[nrl][ncl] -= ndl;
1514 
1515  for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
1516  for(i=nrl+1;i<=nrh;i++) {
1517  t[i]=t[i-1]+ncol;
1518  t[i][ncl]=t[i-1][ncl]+ncol*ndep;
1519  for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
1520  }
1521 
1522  /* return pointer to array of pointers to rows */
1523  return t;
1524 }
1525 
1526 frame_data ***fd3tensor(nrl,nrh,ncl,nch,ndl,ndh)
1527  int32_t nch,ncl,ndh,ndl,nrh,nrl;
1528  /* allocate a frame_data 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
1529 {
1530  int32_t i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
1531  frame_data ***t;
1532 
1533  /* allocate pointers to pointers to rows */
1534  t=(frame_data ***) calloc((unsigned int)(nrow+NR_END),
1535  sizeof(frame_data**));
1536  if (!t) nrerror("allocation failure 1 in fd3tensor()");
1537  t += NR_END;
1538  t -= nrl;
1539 
1540  /* allocate pointers to rows and set pointers to them */
1541  t[nrl]=(frame_data **) calloc((unsigned int)(nrow*ncol+NR_END),
1542  sizeof(frame_data*));
1543  if (!t[nrl]) nrerror("allocation failure 2 in fd3tensor()");
1544  t[nrl] += NR_END;
1545  t[nrl] -= ncl;
1546 
1547  /* allocate rows and set pointers to them */
1548  t[nrl][ncl]=
1549  (frame_data *) calloc((unsigned int)(nrow*ncol*ndep+NR_END),
1550  sizeof(frame_data));
1551  if (!t[nrl][ncl]) nrerror("allocation failure 3 in fd3tensor()");
1552  t[nrl][ncl] += NR_END;
1553  t[nrl][ncl] -= ndl;
1554 
1555  for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
1556  for(i=nrl+1;i<=nrh;i++) {
1557  t[i]=t[i-1]+ncol;
1558  t[i][ncl]=t[i-1][ncl]+ncol*ndep;
1559  for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
1560  }
1561 
1562  /* return pointer to array of pointers to rows */
1563  return t;
1564 }
1565 
1566 double ***d3tensor(nrl,nrh,ncl,nch,ndl,ndh)
1567  int32_t nch,ncl,ndh,ndl,nrh,nrl;
1568  /* allocate a double 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
1569 {
1570  int32_t i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
1571  double ***t;
1572 
1573  /* allocate pointers to pointers to rows */
1574  t=(double ***) calloc((unsigned int)(nrow+NR_END), sizeof(double**));
1575  if (!t) nrerror("allocation failure 1 in d3tensor()");
1576  t += NR_END;
1577  t -= nrl;
1578 
1579  /* allocate pointers to rows and set pointers to them */
1580  t[nrl]=(double **) calloc((unsigned int)(nrow*ncol+NR_END),
1581  sizeof(double*));
1582  if (!t[nrl]) nrerror("allocation failure 2 in d3tensor()");
1583  t[nrl] += NR_END;
1584  t[nrl] -= ncl;
1585 
1586  /* allocate rows and set pointers to them */
1587  t[nrl][ncl]=(double *) calloc((unsigned int)(nrow*ncol*ndep+NR_END),
1588  sizeof(double));
1589  if (!t[nrl][ncl]) nrerror("allocation failure 3 in d3tensor()");
1590  t[nrl][ncl] += NR_END;
1591  t[nrl][ncl] -= ndl;
1592 
1593  for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
1594  for(i=nrl+1;i<=nrh;i++) {
1595  t[i]=t[i-1]+ncol;
1596  t[i][ncl]=t[i-1][ncl]+ncol*ndep;
1597  for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
1598  }
1599 
1600  /* return pointer to array of pointers to rows */
1601  return t;
1602 }
1603 
1604 frame_data ***fd3tensor(nrl,nrh,ncl,nch,ndl,ndh)
1605  int32_t nch,ncl,ndh,ndl,nrh,nrl;
1606  /* allocate a frame_data 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
1607 {
1608  int32_t i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
1609  frame_data ***t;
1610 
1611  /* allocate pointers to pointers to rows */
1612  t=(frame_data ***) calloc((unsigned int)(nrow+NR_END),
1613  sizeof(frame_data**));
1614  if (!t) nrerror("allocation failure 1 in f3tensor()");
1615  t += NR_END;
1616  t -= nrl;
1617 
1618  /* allocate pointers to rows and set pointers to them */
1619  t[nrl]=(frame_data **) calloc((unsigned int)(nrow*ncol+NR_END),
1620  sizeof(frame_data*));
1621  if (!t[nrl]) nrerror("allocation failure 2 in f3tensor()");
1622  t[nrl] += NR_END;
1623  t[nrl] -= ncl;
1624 
1625  /* allocate rows and set pointers to them */
1626  t[nrl][ncl]=
1627  (frame_data *) calloc((unsigned int)(nrow*ncol*ndep+NR_END),
1628  sizeof(frame_data));
1629  if (!t[nrl][ncl]) nrerror("allocation failure 3 in f3tensor()");
1630  t[nrl][ncl] += NR_END;
1631  t[nrl][ncl] -= ndl;
1632 
1633  for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
1634  for(i=nrl+1;i<=nrh;i++) {
1635  t[i]=t[i-1]+ncol;
1636  t[i][ncl]=t[i-1][ncl]+ncol*ndep;
1637  for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
1638  }
1639 
1640  /* return pointer to array of pointers to rows */
1641  return t;
1642 }
1643 
1644 frame_mask ***fm3tensor(nrl,nrh,ncl,nch,ndl,ndh)
1645  int32_t nch,ncl,ndh,ndl,nrh,nrl;
1646  /* allocate a frame_mask 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
1647 {
1648  int32_t i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
1649  frame_mask ***t;
1650 
1651  /* allocate pointers to pointers to rows */
1652  t=(frame_mask ***) calloc((unsigned int)(nrow+NR_END),
1653  sizeof(frame_mask**));
1654  if (!t) nrerror("allocation failure 1 in f3tensor()");
1655  t += NR_END;
1656  t -= nrl;
1657 
1658  /* allocate pointers to rows and set pointers to them */
1659  t[nrl]=(frame_mask **) calloc((unsigned int)(nrow*ncol+NR_END),
1660  sizeof(frame_mask*));
1661  if (!t[nrl]) nrerror("allocation failure 2 in f3tensor()");
1662  t[nrl] += NR_END;
1663  t[nrl] -= ncl;
1664 
1665  /* allocate rows and set pointers to them */
1666  t[nrl][ncl]=
1667  (frame_mask *) calloc((unsigned int)(nrow*ncol*ndep+NR_END),
1668  sizeof(frame_mask));
1669  if (!t[nrl][ncl]) nrerror("allocation failure 3 in f3tensor()");
1670  t[nrl][ncl] += NR_END;
1671  t[nrl][ncl] -= ndl;
1672 
1673  for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
1674  for(i=nrl+1;i<=nrh;i++) {
1675  t[i]=t[i-1]+ncol;
1676  t[i][ncl]=t[i-1][ncl]+ncol*ndep;
1677  for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
1678  }
1679 
1680  /* return pointer to array of pointers to rows */
1681  return t;
1682 }
1683 
1684 uint32_t ***ul3tensor(nrl,nrh,ncl,nch,ndl,ndh)
1685  int32_t nch,ncl,ndh,ndl,nrh,nrl;
1686  /* allocate a frame_mask 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
1687 {
1688  int32_t i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
1689  uint32_t ***t;
1690 
1691  /* allocate pointers to pointers to rows */
1692  t=(uint32_t ***) calloc((unsigned int)(nrow+NR_END),
1693  sizeof(uint32_t**));
1694  if (!t) nrerror("allocation failure 1 in f3tensor()");
1695  t += NR_END;
1696  t -= nrl;
1697 
1698  /* allocate pointers to rows and set pointers to them */
1699  t[nrl]=(uint32_t **) calloc((unsigned int)(nrow*ncol+NR_END),
1700  sizeof(uint32_t*));
1701  if (!t[nrl]) nrerror("allocation failure 2 in f3tensor()");
1702  t[nrl] += NR_END;
1703  t[nrl] -= ncl;
1704 
1705  /* allocate rows and set pointers to them */
1706  t[nrl][ncl]=
1707  (uint32_t *) calloc((unsigned int)(nrow*ncol*ndep+NR_END),
1708  sizeof(uint32_t));
1709  if (!t[nrl][ncl]) nrerror("allocation failure 3 in f3tensor()");
1710  t[nrl][ncl] += NR_END;
1711  t[nrl][ncl] -= ndl;
1712 
1713  for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
1714  for(i=nrl+1;i<=nrh;i++) {
1715  t[i]=t[i-1]+ncol;
1716  t[i][ncl]=t[i-1][ncl]+ncol*ndep;
1717  for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
1718  }
1719 
1720  /* return pointer to array of pointers to rows */
1721  return t;
1722 }
1723 
1724 int32_t ***l3tensor(nrl,nrh,ncl,nch,ndl,ndh)
1725  int32_t nch,ncl,ndh,ndl,nrh,nrl;
1726  /* allocate a int32_t 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
1727 {
1728  int32_t i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
1729  int32_t ***t;
1730 
1731  /* allocate pointers to pointers to rows */
1732  t=(int32_t ***) calloc((unsigned int)(nrow+NR_END),
1733  sizeof(int32_t**));
1734  if (!t) nrerror("allocation failure 1 in f3tensor()");
1735  t += NR_END;
1736  t -= nrl;
1737 
1738  /* allocate pointers to rows and set pointers to them */
1739  t[nrl]=(int32_t **) calloc((unsigned int)(nrow*ncol+NR_END),
1740  sizeof(int32_t*));
1741  if (!t[nrl]) nrerror("allocation failure 2 in f3tensor()");
1742  t[nrl] += NR_END;
1743  t[nrl] -= ncl;
1744 
1745  /* allocate rows and set pointers to them */
1746  t[nrl][ncl]=(int32_t *) calloc((unsigned int)(nrow*ncol*ndep+NR_END),
1747  sizeof(int32_t));
1748  if (!t[nrl][ncl]) nrerror("allocation failure 3 in f3tensor()");
1749  t[nrl][ncl] += NR_END;
1750  t[nrl][ncl] -= ndl;
1751 
1752  for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
1753  for(i=nrl+1;i<=nrh;i++) {
1754  t[i]=t[i-1]+ncol;
1755  t[i][ncl]=t[i-1][ncl]+ncol*ndep;
1756  for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
1757  }
1758 
1759  /* return pointer to array of pointers to rows */
1760  return t;
1761 }
1762 
1763 int32_t ***l4tensor(nal,nah,nrl,nrh,ncl,nch,ndl,ndh)
1764  int32_t nch,ncl,ndh,ndl,nrh,nrl,nah,nal;
1765  /* allocate a int32_t 4tensor with range
1766  t[nal..nah][nrl..nrh][ncl..nch][ndl..ndh] */
1767 {
1768  int32_t i,j,k,na=nah-nal+1,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
1769  int32_t ****t;
1770 
1771  /* allocate pointers to pointers to rows */
1772  t=(int32_t ****) calloc((unsigned int)(na+NR_END),
1773  sizeof(int32_t***));
1774  if (!t) nrerror("allocation failure 1 in l4tensor()");
1775  t += NR_END;
1776  t -= nal;
1777 
1778  /* allocate pointers to pointers to rows and set pointers to them */
1779  t[nal]=(int32_t ***) calloc((unsigned int)(na*nrow+NR_END),
1780  sizeof(int32_t**));
1781  if (!t[nrl]) nrerror("allocation failure 2 in l4tensor()");
1782  t[nal] += NR_END;
1783  t[nal] -= nrl;
1784 
1785  /* allocate pointers to rows and set pointers to them */
1786  t[nal][nrl]=(int32_t **) calloc((unsigned int)(na*nrow*ncol+NR_END),
1787  sizeof(int32_t*));
1788  if (!t[nal][nrl]) nrerror("allocation failure 3 in l4tensor()");
1789  t[nal][nrl] += NR_END;
1790  t[nal][nrl] -= ncl;
1791 
1792  /* allocate rows and set pointers to them */
1793  t[nal][nrl][ncl]=
1794  (int32_t *) calloc((unsigned int)(na*nrow*ncol*ndep+NR_END),
1795  sizeof(int32_t));
1796  if (!t[nal][nrl][ncl]) nrerror("allocation failure 4 in l4tensor()");
1797  t[nal][nrl][ncl] += NR_END;
1798  t[nal][nrl][ncl] -= ndl;
1799 
1800  for(k=ncl+1;k<=nch;k++) t[nal][nrl][k]=t[nal][nrl][k-1]+ndep;
1801  for(j=nrl+1;j<=nrh;j++) {
1802  t[nal][j] = t[nal][j-1]+ncol;
1803  t[nal][j][ncl] = t[nal][j-1][ncl]+ncol*ndep;
1804  for(k=ncl+1;k<=nch;k++) t[nal][j][k]=t[nal][j][k-1]+ndep;
1805  }
1806  for(i=nal+1;i<=nah;i++) {
1807  t[i]=t[i-1]+nrow;
1808  t[i][nrl] = t[i-1][nrl]+nrow*ncol;
1809  t[i][nrl][ncl] = t[i-1][nrl][ncl]+nrow*ncol*ndep;
1810  for(k=ncl+1;k<=nch;k++) t[i][nrl][k]=t[i][nrl][k-1]+ndep;
1811  for(j=nrl+1;j<=nrh;j++) {
1812  t[i][j] = t[i][j-1]+ncol;
1813  t[i][j][ncl] = t[i][j-1][ncl]+ncol*ndep;
1814  for(k=ncl+1;k<=nch;k++) t[i][j][k]=t[i][j][k-1]+ndep;
1815  }
1816  }
1817 
1818  /* return pointer to array of pointers to rows */
1819  return t;
1820 }
1821 
1822 void free_vector(v,nl,nh)
1823  float *v;
1824  int32_t nh,nl;
1825  /* free a float vector allocated with vector() */
1826 {
1827  free((FREE_ARG) (v+nl-NR_END));
1828 }
1829 
1830 void free_ivector(v,nl,nh)
1831  int *v;
1832  int32_t nh,nl;
1833  /* free an int vector allocated with ivector() */
1834 {
1835  free((FREE_ARG) (v+nl-NR_END));
1836 }
1837 
1838 void free_uivector(v,nl,nh)
1839  unsigned int *v;
1840  int32_t nh,nl;
1841  /* free an int vector allocated with uivector() */
1842 {
1843  free((FREE_ARG) (v+nl-NR_END));
1844 }
1845 
1846 void free_cvector(v,nl,nh)
1847  int32_t nh,nl;
1848  char *v;
1849  /* free a char vector allocated with cvector() */
1850 {
1851  free((FREE_ARG) (v+nl-NR_END));
1852 }
1853 
1854 void free_ucvector(v,nl,nh)
1855  int32_t nh,nl;
1856  unsigned char *v;
1857  /* free a char vector allocated with ucvector() */
1858 {
1859  free((FREE_ARG) (v+nl-NR_END));
1860 }
1861 
1862 void free_lvector(v,nl,nh)
1863  int32_t nh,nl;
1864  int32_t *v;
1865  /* free an uint32_t vector allocated with lvector() */
1866 {
1867  free((FREE_ARG) (v+nl-NR_END));
1868 }
1869 
1870 void free_ulvector(v,nl,nh)
1871  int32_t nh,nl;
1872  uint32_t *v;
1873  /* free an uint32_t vector allocated with ulvector() */
1874 {
1875  free((FREE_ARG) (v+nl-NR_END));
1876 }
1877 
1878 void free_dvector(v,nl,nh)
1879  double *v;
1880  int32_t nh,nl;
1881  /* free a double vector allocated with dvector() */
1882 {
1883  free((FREE_ARG) (v+nl-NR_END));
1884 }
1885 
1886 void free_fdvector(v,nl,nh)
1887  frame_data *v;
1888  int32_t nh,nl;
1889  /* free a frame_data vector allocated with dvector() */
1890 {
1891  free((FREE_ARG) (v+nl-NR_END));
1892 }
1893 
1894 void free_fmvector(v,nl,nh)
1895  frame_mask *v;
1896  int32_t nh,nl;
1897  /* free a double vector allocated with dvector() */
1898 {
1899  free((FREE_ARG) (v+nl-NR_END));
1900 }
1901 
1902 void free_matrix(m,nrl,nrh,ncl,nch)
1903  float **m;
1904  int32_t nch,ncl,nrh,nrl;
1905  /* free a float matrix allocated by matrix() */
1906 {
1907  free((FREE_ARG) (m[nrl]+ncl-NR_END));
1908  free((FREE_ARG) (m+nrl-NR_END));
1909 }
1910 
1911 void free_cmatrix(m,nrl,nrh,ncl,nch)
1912  char **m;
1913  int32_t nch,ncl,nrh,nrl;
1914  /* free a char matrix allocated by cmatrix() */
1915 {
1916  free((FREE_ARG) (m[nrl]+ncl-NR_END));
1917  free((FREE_ARG) (m+nrl-NR_END));
1918 }
1919 
1920 void free_dmatrix(m,nrl,nrh,ncl,nch)
1921  double **m;
1922  int32_t nch,ncl,nrh,nrl;
1923  /* free a double matrix allocated by dmatrix() */
1924 {
1925  free((FREE_ARG) (m[nrl]+ncl-NR_END));
1926  free((FREE_ARG) (m+nrl-NR_END));
1927 }
1928 
1929 void free_ulmatrix(m,nrl,nrh,ncl,nch)
1930  uint32_t **m;
1931  int32_t nch,ncl,nrh,nrl;
1932  /* free an int matrix allocated by imatrix() */
1933 {
1934  free((FREE_ARG) (m[nrl]+ncl-NR_END));
1935  free((FREE_ARG) (m+nrl-NR_END));
1936 }
1937 
1938 void free_lmatrix(m,nrl,nrh,ncl,nch)
1939  int32_t **m;
1940  int32_t nch,ncl,nrh,nrl;
1941  /* free an int matrix allocated by imatrix() */
1942 {
1943  free((FREE_ARG) (m[nrl]+ncl-NR_END));
1944  free((FREE_ARG) (m+nrl-NR_END));
1945 }
1946 
1947 void free_imatrix(m,nrl,nrh,ncl,nch)
1948  int **m;
1949  int32_t nch,ncl,nrh,nrl;
1950  /* free an int matrix allocated by imatrix() */
1951 {
1952  free((FREE_ARG) (m[nrl]+ncl-NR_END));
1953  free((FREE_ARG) (m+nrl-NR_END));
1954 }
1955 
1956 void free_fdmatrix(m,nrl,nrh,ncl,nch)
1957  frame_data **m;
1958  int32_t nch,ncl,nrh,nrl;
1959  /* free a frame_data matrix allocated by imatrix() */
1960 {
1961  free((FREE_ARG) (m[nrl]+ncl-NR_END));
1962  free((FREE_ARG) (m+nrl-NR_END));
1963 }
1964 
1965 void free_fmmatrix(m,nrl,nrh,ncl,nch)
1966  frame_mask **m;
1967  int32_t nch,ncl,nrh,nrl;
1968  /* free a frame_mask matrix allocated by imatrix() */
1969 {
1970  free((FREE_ARG) (m[nrl]+ncl-NR_END));
1971  free((FREE_ARG) (m+nrl-NR_END));
1972 }
1973 
1974 void free_submatrix(b,nrl,nrh,ncl,nch)
1975  float **b;
1976  int32_t nch,ncl,nrh,nrl;
1977  /* free a submatrix allocated by submatrix() */
1978 {
1979  free((FREE_ARG) (b+nrl-NR_END));
1980 }
1981 
1982 void free_convert_matrix(b,nrl,nrh,ncl,nch)
1983  float **b;
1984  int32_t nch,ncl,nrh,nrl;
1985  /* free a matrix allocated by convert_matrix() */
1986 {
1987  free((FREE_ARG) (b+nrl-NR_END));
1988 }
1989 
1990 void free_f3tensor(t,nrl,nrh,ncl,nch,ndl,ndh)
1991  float ***t;
1992  int32_t nch,ncl,ndh,ndl,nrh,nrl;
1993  /* free a float f3tensor allocated by f3tensor() */
1994 {
1995  free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
1996  free((FREE_ARG) (t[nrl]+ncl-NR_END));
1997  free((FREE_ARG) (t+nrl-NR_END));
1998 }
1999 
2000 void free_d3tensor(t,nrl,nrh,ncl,nch,ndl,ndh)
2001  double ***t;
2002  int32_t nch,ncl,ndh,ndl,nrh,nrl;
2003  /* free a double 3tensor allocated by d3tensor() */
2004 {
2005  free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
2006  free((FREE_ARG) (t[nrl]+ncl-NR_END));
2007  free((FREE_ARG) (t+nrl-NR_END));
2008 }
2009 
2010 void free_fd3tensor(t,nrl,nrh,ncl,nch,ndl,ndh)
2011  frame_data ***t;
2012  int32_t nch,ncl,ndh,ndl,nrh,nrl;
2013  /* free a frame_data f3tensor allocated by f3tensor() */
2014 {
2015  free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
2016  free((FREE_ARG) (t[nrl]+ncl-NR_END));
2017  free((FREE_ARG) (t+nrl-NR_END));
2018 }
2019 
2020 void free_fm3tensor(t,nrl,nrh,ncl,nch,ndl,ndh)
2021  frame_mask ***t;
2022  int32_t nch,ncl,ndh,ndl,nrh,nrl;
2023  /* free a float f3tensor allocated by f3tensor() */
2024 {
2025  free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
2026  free((FREE_ARG) (t[nrl]+ncl-NR_END));
2027  free((FREE_ARG) (t+nrl-NR_END));
2028 }
2029 
2030 void free_ul3tensor(t,nrl,nrh,ncl,nch,ndl,ndh)
2031  uint32_t ***t;
2032  int32_t nch,ncl,ndh,ndl,nrh,nrl;
2033  /* free a float f3tensor allocated by f3tensor() */
2034 {
2035  free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
2036  free((FREE_ARG) (t[nrl]+ncl-NR_END));
2037  free((FREE_ARG) (t+nrl-NR_END));
2038 }
2039 
2040 void free_l3tensor(t,nrl,nrh,ncl,nch,ndl,ndh)
2041  int32_t ***t;
2042  int32_t nch,ncl,ndh,ndl,nrh,nrl;
2043  /* free a float f3tensor allocated by f3tensor() */
2044 {
2045  free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
2046  free((FREE_ARG) (t[nrl]+ncl-NR_END));
2047  free((FREE_ARG) (t+nrl-NR_END));
2048 }
2049 
2050 void free_l4tensor(t,nal,nah,nrl,nrh,ncl,nch,ndl,ndh)
2051  int32_t ***t;
2052  int32_t nch,ncl,ndh,ndl,nrh,nrl,nah,nal;
2053  /* free a int32_t l4tensor allocated by l4tensor() */
2054 {
2055  free((FREE_ARG) (t[nal][nrl][ncl]+ndl-NR_END));
2056  free((FREE_ARG) (t[nal][nrl]+ncl-NR_END));
2057  free((FREE_ARG) (t[nal]+nrl-NR_END));
2058  free((FREE_ARG) (t+nal-NR_END));
2059 }
2060 
2061 
2062 void
2063 matrix_product(double** A, double** B, double** C, int ra, int ca, int cb)
2064 {
2065 
2066  int k=0,j=0,m=0;
2067 
2068  if (C==0)
2069  {
2070  C=dmatrix(1,ra,1,cb);
2071  }
2072 
2073  for (j=1; j<=ra; j++)
2074  {
2075  for (k=1; k<=cb; k++)
2076  {
2077  C[j][k]=0;
2078  }
2079  }
2080 
2081  for (j=1; j<=ra; j++)
2082  {
2083  for (k=1; k<=cb; k++)
2084  {
2085  for (m=1; m<=ca; m++)
2086  {
2087  C[j][k] += A[j][m]*B[m][k];
2088  }
2089  }
2090  }
2091  return ;
2092 }
2093 
2094 void
2095 matrix_sum(double** A, double** B, int ra, int ca)
2096 {
2097 
2098  int k=0,j=0;
2099 
2100  for (j=1; j<=ra; j++)
2101  {
2102  for (k=1; k<=ca; k++)
2103  {
2104  A[j][k] += B[j][k];
2105  }
2106  }
2107  return ;
2108 }
2109 
2110 
2111 #endif /* ANSI */