00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050 #ifdef HAVE_CONFIG_H
00051 # include <config.h>
00052 #endif
00053
00054
00055 #if defined(__STDC__) || defined(ANSI) || defined(NRANSI)
00056
00057 #include <flames_newmatrix.h>
00058 #include <stdio.h>
00059 #include <stddef.h>
00060 #include <stdlib.h>
00061 #include <flames_midas_def.h>
00062 #include <flames_uves.h>
00063 #include <uves_error.h>
00064 #define NR_END 1
00065 #define FREE_ARG char*
00066
00067
00068
00069
00070
00071 void nrerror(const char* error_text)
00072
00073
00074 {
00075
00076
00077
00078
00079
00080
00081
00082 char output[70];
00083
00084 SCTPUT("Numerical Recipes run-time error...\n");
00085 sprintf(output, "%s\n", error_text);
00086 SCTPUT(output);
00087 SCTPUT("...now exiting to system...\n");
00088 SCSEPI();
00089
00090
00091 assure_nomsg( false, CPL_ERROR_ILLEGAL_OUTPUT );
00092 cleanup:
00093 return ;
00094 }
00095
00096 float *vector(long nl, long nh)
00097
00098 {
00099 float *v;
00100
00101 v=(float *) calloc((size_t) (nh-nl+1+NR_END), sizeof(float));
00102 if (!v) nrerror("allocation failure in vector()");
00103 return v-nl+NR_END;
00104 }
00105
00106 int *ivector(long nl, long nh)
00107
00108 {
00109 int *v;
00110
00111 v=(int *) calloc((size_t) (nh-nl+1+NR_END), sizeof(int));
00112 if (!v) nrerror("allocation failure in ivector()");
00113 return v-nl+NR_END;
00114 }
00115
00116 unsigned int *uivector(long nl, long nh)
00117
00118 {
00119 unsigned int *v;
00120
00121 v=(unsigned int *) calloc((size_t) (nh-nl+1+NR_END),
00122 sizeof(unsigned int));
00123 if (!v) nrerror("allocation failure in uivector()");
00124 return v-nl+NR_END;
00125 }
00126
00127 char *cvector(long nl, long nh)
00128
00129 {
00130 char *v;
00131
00132 v=(char *) calloc((size_t) (nh-nl+1+NR_END), sizeof(char));
00133 if (!v) nrerror("allocation failure in cvector()");
00134 return v-nl+NR_END;
00135 }
00136
00137 unsigned char *ucvector(long nl, long nh)
00138
00139 {
00140 unsigned char *v;
00141
00142 v=(unsigned char *) calloc((size_t) (nh-nl+1+NR_END),
00143 sizeof(unsigned char));
00144 if (!v) nrerror("allocation failure in ucvector()");
00145 return v-nl+NR_END;
00146 }
00147
00148 long int *lvector(long nl, long nh)
00149
00150 {
00151 long int *v;
00152
00153 v=(long int *) calloc((size_t) (nh-nl+1+NR_END), sizeof(long int));
00154 if (!v) nrerror("allocation failure in lvector()");
00155 return v-nl+NR_END;
00156 }
00157
00158 unsigned long *ulvector(long nl, long nh)
00159
00160 {
00161 unsigned long *v;
00162
00163 v=(unsigned long *) calloc((size_t) (nh-nl+1+NR_END),
00164 sizeof(unsigned long));
00165 if (!v) nrerror("allocation failure in ulvector()");
00166 return v-nl+NR_END;
00167 }
00168
00169 double *dvector(long nl, long nh)
00170
00171 {
00172 double *v;
00173
00174 v=(double *) calloc((size_t) (nh-nl+1+NR_END), sizeof(double));
00175 if (!v) nrerror("allocation failure in dvector()");
00176 return v-nl+NR_END;
00177 }
00178
00179 frame_data *fdvector(long nl, long nh)
00180
00181 {
00182 frame_data *v;
00183
00184 v=(frame_data *) calloc((size_t) (nh-nl+1+NR_END), sizeof(frame_data));
00185 if (!v) nrerror("allocation failure in fdvector()");
00186 return v-nl+NR_END;
00187 }
00188
00189 frame_mask *fmvector(long nl, long nh)
00190
00191 {
00192 frame_mask *v;
00193
00194 v=(frame_mask *) calloc((size_t) (nh-nl+1+NR_END), sizeof(frame_mask));
00195 if (!v) nrerror("allocation failure in fdvector()");
00196 return v-nl+NR_END;
00197 }
00198
00199 char **cmatrix(long nrl, long nrh, long ncl, long nch)
00200
00201 {
00202 long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
00203 char **m;
00204
00205
00206 m=(char **) calloc((size_t)(nrow+NR_END), sizeof(char*));
00207 if (!m) nrerror("allocation failure 1 in cmatrix()");
00208 m += NR_END;
00209 m -= nrl;
00210
00211
00212 m[nrl]=(char *) calloc((size_t)(nrow*ncol+NR_END), sizeof(char));
00213 if (!m[nrl]) nrerror("allocation failure 2 in cmatrix()");
00214 m[nrl] += NR_END;
00215 m[nrl] -= ncl;
00216
00217 for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
00218
00219
00220 return m;
00221 }
00222
00223 float **matrix(long nrl, long nrh, long ncl, long nch)
00224
00225 {
00226 long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
00227 float **m;
00228
00229
00230 m=(float **) calloc((size_t)(nrow+NR_END), sizeof(float*));
00231 if (!m) nrerror("allocation failure 1 in matrix()");
00232 m += NR_END;
00233 m -= nrl;
00234
00235
00236 m[nrl]=(float *) calloc((size_t)(nrow*ncol+NR_END), sizeof(float));
00237 if (!m[nrl]) nrerror("allocation failure 2 in matrix()");
00238 m[nrl] += NR_END;
00239 m[nrl] -= ncl;
00240
00241 for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
00242
00243
00244 return m;
00245 }
00246
00247 double **dmatrix(long nrl, long nrh, long ncl, long nch)
00248
00249 {
00250 long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
00251 double **m;
00252
00253
00254 m=(double **) calloc((size_t)(nrow+NR_END), sizeof(double*));
00255 if (!m) nrerror("allocation failure 1 in dmatrix()");
00256 m += NR_END;
00257 m -= nrl;
00258
00259
00260
00261
00262
00263
00264
00265 m[nrl]=(double *) calloc((size_t)(nrow*ncol+NR_END), sizeof(double));
00266
00267
00268 if (!m[nrl]) nrerror("allocation failure 2 in dmatrix()");
00269 m[nrl] += NR_END;
00270 m[nrl] -= ncl;
00271
00272 for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
00273
00274 return m;
00275 }
00276
00277 int **imatrix(long nrl, long nrh, long ncl, long nch)
00278
00279 {
00280 long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
00281 int **m;
00282
00283
00284 m=(int **) calloc((size_t)(nrow+NR_END), sizeof(int*));
00285 if (!m) nrerror("allocation failure 1 in imatrix()");
00286 m += NR_END;
00287 m -= nrl;
00288
00289
00290
00291 m[nrl]=(int *) calloc((size_t)(nrow*ncol+NR_END), sizeof(int));
00292 if (!m[nrl]) nrerror("allocation failure 2 in imatrix()");
00293 m[nrl] += NR_END;
00294 m[nrl] -= ncl;
00295
00296 for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
00297
00298
00299 return m;
00300 }
00301
00302 unsigned long int **ulmatrix(long nrl, long nrh, long ncl, long nch)
00303
00304 {
00305 long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
00306 unsigned long int **m;
00307
00308
00309 m=(unsigned long int **) calloc((size_t)(nrow+NR_END),
00310 sizeof(unsigned long int*));
00311 if (!m) nrerror("allocation failure 1 in ulmatrix()");
00312 m += NR_END;
00313 m -= nrl;
00314
00315
00316
00317 m[nrl]=(unsigned long int *) calloc((size_t)(nrow*ncol+NR_END),
00318 sizeof(unsigned long int));
00319 if (!m[nrl]) nrerror("allocation failure 2 in ulmatrix()");
00320 m[nrl] += NR_END;
00321 m[nrl] -= ncl;
00322
00323 for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
00324
00325
00326 return m;
00327 }
00328
00329 long int **lmatrix(long nrl, long nrh, long ncl, long nch)
00330
00331 {
00332 long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
00333 long int **m;
00334
00335
00336 m=(long int **) calloc((size_t)(nrow+NR_END), sizeof(long int*));
00337 if (!m) nrerror("allocation failure 1 in lmatrix()");
00338 m += NR_END;
00339 m -= nrl;
00340
00341
00342
00343 m[nrl]=(long int *) calloc((size_t)(nrow*ncol+NR_END),
00344 sizeof(long int));
00345 if (!m[nrl]) nrerror("allocation failure 2 in lmatrix()");
00346 m[nrl] += NR_END;
00347 m[nrl] -= ncl;
00348
00349 for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
00350
00351
00352 return m;
00353 }
00354
00355 frame_data **fdmatrix(long nrl, long nrh, long ncl, long nch)
00356
00357 {
00358 long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
00359 frame_data **m;
00360
00361
00362 m=(frame_data **) calloc((size_t)(nrow+NR_END), sizeof(frame_data*));
00363 if (!m) nrerror("allocation failure 1 in fdmatrix()");
00364 m += NR_END;
00365 m -= nrl;
00366
00367
00368
00369 m[nrl]=(frame_data *) calloc((size_t)(nrow*ncol+NR_END),
00370 sizeof(frame_data));
00371 if (!m[nrl]) nrerror("allocation failure 2 in fdmatrix()");
00372 m[nrl] += NR_END;
00373 m[nrl] -= ncl;
00374
00375 for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
00376
00377
00378 return m;
00379 }
00380
00381 frame_mask **fmmatrix(long nrl, long nrh, long ncl, long nch)
00382
00383 {
00384 long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
00385 frame_mask **m;
00386
00387
00388 m=(frame_mask **) calloc((size_t)(nrow+NR_END), sizeof(frame_mask*));
00389 if (!m) nrerror("allocation failure 1 in fmmatrix()");
00390 m += NR_END;
00391 m -= nrl;
00392
00393
00394
00395 m[nrl]=(frame_mask *) calloc((size_t)(nrow*ncol+NR_END),
00396 sizeof(frame_mask));
00397 if (!m[nrl]) nrerror("allocation failure 2 in fmmatrix()");
00398 m[nrl] += NR_END;
00399 m[nrl] -= ncl;
00400
00401 for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
00402
00403
00404 return m;
00405 }
00406
00407 float **submatrix(float **a, long oldrl, long oldrh, long oldcl,
00408 long newrl, long newcl)
00409
00410 {
00411 long i,j,nrow=oldrh-oldrl+1,ncol=oldcl-newcl;
00412 float **m;
00413
00414
00415 m=(float **) calloc((size_t) (nrow+NR_END), sizeof(float*));
00416 if (!m) nrerror("allocation failure in submatrix()");
00417 m += NR_END;
00418 m -= newrl;
00419
00420
00421 for(i=oldrl,j=newrl;i<=oldrh;i++,j++) m[j]=a[i]+ncol;
00422
00423
00424 return m;
00425 }
00426
00427 float **convert_matrix(float *a, long nrl, long nrh, long ncl, long nch)
00428
00429
00430
00431
00432 {
00433 long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1;
00434 float **m;
00435
00436
00437 m=(float **) calloc((size_t) (nrow+NR_END), sizeof(float*));
00438 if (!m) nrerror("allocation failure in convert_matrix()");
00439 m += NR_END;
00440 m -= nrl;
00441
00442
00443 m[nrl]=a-ncl;
00444 for(i=1,j=nrl+1;i<nrow;i++,j++) m[j]=m[j-1]+ncol;
00445
00446 return m;
00447 }
00448
00449 float ***f3tensor(long nrl, long nrh, long ncl, long nch, long ndl, long ndh)
00450
00451 {
00452 long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
00453 float ***t;
00454
00455
00456 t=(float ***) calloc((size_t)(nrow+NR_END), sizeof(float**));
00457 if (!t) nrerror("allocation failure 1 in f3tensor()");
00458 t += NR_END;
00459 t -= nrl;
00460
00461
00462 t[nrl]=(float **) calloc((size_t)(nrow*ncol+NR_END), sizeof(float*));
00463 if (!t[nrl]) nrerror("allocation failure 2 in f3tensor()");
00464 t[nrl] += NR_END;
00465 t[nrl] -= ncl;
00466
00467
00468 t[nrl][ncl]=(float *) calloc((size_t)(nrow*ncol*ndep+NR_END),
00469 sizeof(float));
00470 if (!t[nrl][ncl]) nrerror("allocation failure 3 in f3tensor()");
00471 t[nrl][ncl] += NR_END;
00472 t[nrl][ncl] -= ndl;
00473
00474 for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
00475 for(i=nrl+1;i<=nrh;i++) {
00476 t[i]=t[i-1]+ncol;
00477 t[i][ncl]=t[i-1][ncl]+ncol*ndep;
00478 for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
00479 }
00480
00481
00482 return t;
00483 }
00484
00485 double ***d3tensor(long nrl, long nrh, long ncl, long nch, long ndl, long ndh)
00486
00487 {
00488 long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
00489 double ***t;
00490
00491
00492 t=(double ***) calloc((size_t)(nrow+NR_END), sizeof(double**));
00493 if (!t) nrerror("allocation failure 1 in d3tensor()");
00494 t += NR_END;
00495 t -= nrl;
00496
00497
00498 t[nrl]=(double **) calloc((size_t)(nrow*ncol+NR_END), sizeof(double*));
00499 if (!t[nrl]) nrerror("allocation failure 2 in d3tensor()");
00500 t[nrl] += NR_END;
00501 t[nrl] -= ncl;
00502
00503
00504 t[nrl][ncl]=(double *) calloc((size_t)(nrow*ncol*ndep+NR_END),
00505 sizeof(double));
00506 if (!t[nrl][ncl]) nrerror("allocation failure 3 in d3tensor()");
00507 t[nrl][ncl] += NR_END;
00508 t[nrl][ncl] -= ndl;
00509
00510 for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
00511 for(i=nrl+1;i<=nrh;i++) {
00512 t[i]=t[i-1]+ncol;
00513 t[i][ncl]=t[i-1][ncl]+ncol*ndep;
00514 for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
00515 }
00516
00517
00518 return t;
00519 }
00520
00521 frame_data ***fd3tensor(long nrl, long nrh, long ncl, long nch, long ndl, long ndh)
00522
00523 {
00524 long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
00525 frame_data ***t;
00526
00527
00528 t=(frame_data ***) calloc((size_t)(nrow+NR_END), sizeof(frame_data**));
00529 if (!t) nrerror("allocation failure 1 in fd3tensor()");
00530 t += NR_END;
00531 t -= nrl;
00532
00533
00534 t[nrl]=(frame_data **) calloc((size_t)(nrow*ncol+NR_END),
00535 sizeof(frame_data*));
00536 if (!t[nrl]) nrerror("allocation failure 2 in fd3tensor()");
00537 t[nrl] += NR_END;
00538 t[nrl] -= ncl;
00539
00540
00541 t[nrl][ncl]=(frame_data *) calloc((size_t)(nrow*ncol*ndep+NR_END),
00542 sizeof(frame_data));
00543 if (!t[nrl][ncl]) nrerror("allocation failure 3 in fd3tensor()");
00544 t[nrl][ncl] += NR_END;
00545 t[nrl][ncl] -= ndl;
00546
00547 for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
00548 for(i=nrl+1;i<=nrh;i++) {
00549 t[i]=t[i-1]+ncol;
00550 t[i][ncl]=t[i-1][ncl]+ncol*ndep;
00551 for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
00552 }
00553
00554
00555 return t;
00556 }
00557
00558 frame_mask ***fm3tensor(long nrl, long nrh, long ncl, long nch, long ndl, long ndh)
00559
00560 {
00561 long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
00562 frame_mask ***t;
00563
00564
00565 t=(frame_mask ***) calloc((size_t)(nrow+NR_END), sizeof(frame_mask**));
00566 if (!t) nrerror("allocation failure 1 in f3tensor()");
00567 t += NR_END;
00568 t -= nrl;
00569
00570
00571 t[nrl]=(frame_mask **) calloc((size_t)(nrow*ncol+NR_END),
00572 sizeof(frame_mask*));
00573 if (!t[nrl]) nrerror("allocation failure 2 in f3tensor()");
00574 t[nrl] += NR_END;
00575 t[nrl] -= ncl;
00576
00577
00578 t[nrl][ncl]=(frame_mask *) calloc((size_t)(nrow*ncol*ndep+NR_END),
00579 sizeof(frame_mask));
00580 if (!t[nrl][ncl]) nrerror("allocation failure 3 in f3tensor()");
00581 t[nrl][ncl] += NR_END;
00582 t[nrl][ncl] -= ndl;
00583
00584 for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
00585 for(i=nrl+1;i<=nrh;i++) {
00586 t[i]=t[i-1]+ncol;
00587 t[i][ncl]=t[i-1][ncl]+ncol*ndep;
00588 for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
00589 }
00590
00591
00592 return t;
00593 }
00594
00595 unsigned long int ***ul3tensor(long nrl, long nrh, long ncl, long nch, long ndl, long ndh)
00596
00597 {
00598 long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
00599 unsigned long int ***t;
00600
00601
00602 t=(unsigned long int ***) calloc((size_t)(nrow+NR_END),
00603 sizeof(unsigned long int**));
00604 if (!t) nrerror("allocation failure 1 in f3tensor()");
00605 t += NR_END;
00606 t -= nrl;
00607
00608
00609 t[nrl]=(unsigned long int **) calloc((size_t)(nrow*ncol+NR_END),
00610 sizeof(unsigned long int*));
00611 if (!t[nrl]) nrerror("allocation failure 2 in f3tensor()");
00612 t[nrl] += NR_END;
00613 t[nrl] -= ncl;
00614
00615
00616 t[nrl][ncl]=
00617 (unsigned long int *) calloc((size_t)(nrow*ncol*ndep+NR_END),
00618 sizeof(unsigned long int));
00619 if (!t[nrl][ncl]) nrerror("allocation failure 3 in f3tensor()");
00620 t[nrl][ncl] += NR_END;
00621 t[nrl][ncl] -= ndl;
00622
00623 for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
00624 for(i=nrl+1;i<=nrh;i++) {
00625 t[i]=t[i-1]+ncol;
00626 t[i][ncl]=t[i-1][ncl]+ncol*ndep;
00627 for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
00628 }
00629
00630
00631 return t;
00632 }
00633
00634 long int ***l3tensor(long nrl, long nrh, long ncl, long nch, long ndl, long ndh)
00635
00636 {
00637 long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
00638 long int ***t;
00639
00640
00641 t=(long int ***) calloc((size_t)(nrow+NR_END), sizeof(long int**));
00642 if (!t) nrerror("allocation failure 1 in f3tensor()");
00643 t += NR_END;
00644 t -= nrl;
00645
00646
00647 t[nrl]=(long int **) calloc((size_t)(nrow*ncol+NR_END),
00648 sizeof(long int*));
00649 if (!t[nrl]) nrerror("allocation failure 2 in f3tensor()");
00650 t[nrl] += NR_END;
00651 t[nrl] -= ncl;
00652
00653
00654 t[nrl][ncl]=(long int *) calloc((size_t)(nrow*ncol*ndep+NR_END),
00655 sizeof(long int));
00656 if (!t[nrl][ncl]) nrerror("allocation failure 3 in f3tensor()");
00657 t[nrl][ncl] += NR_END;
00658 t[nrl][ncl] -= ndl;
00659
00660 for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
00661 for(i=nrl+1;i<=nrh;i++) {
00662 t[i]=t[i-1]+ncol;
00663 t[i][ncl]=t[i-1][ncl]+ncol*ndep;
00664 for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
00665 }
00666
00667
00668 return t;
00669 }
00670
00671 long int ****l4tensor(long nal, long nah, long nrl, long nrh, long ncl, long nch, long ndl, long ndh)
00672
00673 {
00674 long i,j,k,na=nah-nal+1,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
00675 long int ****t;
00676
00677
00678 t=(long int ****) calloc((size_t)(na+NR_END), sizeof(long int***));
00679 if (!t) nrerror("allocation failure 1 in l4tensor()");
00680 t += NR_END;
00681 t -= nal;
00682
00683
00684 t[nal]=(long int ***) calloc((size_t)(na*nrow+NR_END),
00685 sizeof(long int**));
00686 if (!t[nal]) nrerror("allocation failure 2 in f3tensor()");
00687 t[nal] += NR_END;
00688 t[nal] -= nrl;
00689
00690
00691 t[nal][nrl]=(long int **) calloc((size_t)(na*nrow*ncol+NR_END),
00692 sizeof(long int*));
00693 if (!t[nal][nrl]) nrerror("allocation failure 3 in f3tensor()");
00694 t[nal][nrl] += NR_END;
00695 t[nal][nrl] -= ncl;
00696
00697
00698 t[nal][nrl][ncl]=
00699 (long int *) calloc((size_t)(na*nrow*ncol*ndep+NR_END),
00700 sizeof(long int));
00701 if (!t[nal][nrl][ncl]) nrerror("allocation failure 4 in f3tensor()");
00702 t[nal][nrl][ncl] += NR_END;
00703 t[nal][nrl][ncl] -= ndl;
00704
00705 for(k=ncl+1;k<=nch;k++) t[nal][nrl][k]=t[nal][nrl][k-1]+ndep;
00706 for(j=nrl+1;j<=nrh;j++) {
00707 t[nal][j] = t[nal][j-1]+ncol;
00708 t[nal][j][ncl] = t[nal][j-1][ncl]+ncol*ndep;
00709 for(k=ncl+1;k<=nch;k++) t[nal][j][k]=t[nal][j][k-1]+ndep;
00710 }
00711 for(i=nal+1;i<=nah;i++) {
00712 t[i]=t[i-1]+nrow;
00713 t[i][nrl] = t[i-1][nrl]+nrow*ncol;
00714 t[i][nrl][ncl] = t[i-1][nrl][ncl]+nrow*ncol*ndep;
00715 for(k=ncl+1;k<=nch;k++) t[i][nrl][k]=t[i][nrl][k-1]+ndep;
00716 for(j=nrl+1;j<=nrh;j++) {
00717 t[i][j] = t[i][j-1]+ncol;
00718 t[i][j][ncl] = t[i][j-1][ncl]+ncol*ndep;
00719 for(k=ncl+1;k<=nch;k++) t[i][j][k]=t[i][j][k-1]+ndep;
00720 }
00721 }
00722
00723
00724 return t;
00725 }
00726
00727 void free_vector(float *v, long nl, long nh)
00728
00729 {
00730
00731 nh=nh;
00732 free((FREE_ARG) (v+nl-NR_END));
00733 }
00734
00735 void free_ivector(int *v, long nl, long nh)
00736
00737 {
00738
00739 nh=nh;
00740 free((FREE_ARG) (v+nl-NR_END));
00741 }
00742
00743 void free_uivector(unsigned int *v, long nl, long nh)
00744
00745 {
00746
00747 nh=nh;
00748 free((FREE_ARG) (v+nl-NR_END));
00749 }
00750
00751 void free_cvector(char *v, long nl, long nh)
00752
00753 {
00754
00755 nh=nh;
00756 free((FREE_ARG) (v+nl-NR_END));
00757 }
00758
00759 void free_ucvector(unsigned char *v, long nl, long nh)
00760
00761 {
00762
00763 nh=nh;
00764 free((FREE_ARG) (v+nl-NR_END));
00765 }
00766
00767 void free_lvector(long int *v, long nl, long nh)
00768
00769 {
00770
00771 nh=nh;
00772 free((FREE_ARG) (v+nl-NR_END));
00773 }
00774
00775 void free_ulvector(unsigned long *v, long nl, long nh)
00776
00777 {
00778
00779 nh=nh;
00780 free((FREE_ARG) (v+nl-NR_END));
00781 }
00782
00783 void free_dvector(double *v, long nl, long nh)
00784
00785 {
00786
00787 nh=nh;
00788 free((FREE_ARG) (v+nl-NR_END));
00789 }
00790
00791 void free_fdvector(frame_data *v, long nl, long nh)
00792
00793 {
00794
00795 nh=nh;
00796 free((FREE_ARG) (v+nl-NR_END));
00797 }
00798
00799 void free_fmvector(frame_mask *v, long nl, long nh)
00800
00801 {
00802
00803 nh=nh;
00804 free((FREE_ARG) (v+nl-NR_END));
00805 }
00806
00807 void free_matrix(float **m, long nrl, long nrh, long ncl, long nch)
00808
00809 {
00810
00811 nch=nch;
00812
00813 nrh=nrh;
00814 free((FREE_ARG) (m[nrl]+ncl-NR_END));
00815 free((FREE_ARG) (m+nrl-NR_END));
00816 }
00817
00818 void free_cmatrix(char **m, long nrl, long nrh, long ncl, long nch)
00819
00820 {
00821
00822 nch=nch;
00823
00824 nrh=nrh;
00825 free((FREE_ARG) (m[nrl]+ncl-NR_END));
00826 free((FREE_ARG) (m+nrl-NR_END));
00827 }
00828
00829 void free_dmatrix(double **m, long nrl, long nrh, long ncl, long nch)
00830
00831 {
00832
00833 nch=nch;
00834
00835 nrh=nrh;
00836 free((FREE_ARG) (m[nrl]+ncl-NR_END));
00837 free((FREE_ARG) (m+nrl-NR_END));
00838 }
00839
00840 void free_imatrix(int **m, long nrl, long nrh, long ncl, long nch)
00841
00842 {
00843
00844 nch=nch;
00845
00846 nrh=nrh;
00847 free((FREE_ARG) (m[nrl]+ncl-NR_END));
00848 free((FREE_ARG) (m+nrl-NR_END));
00849 }
00850
00851 void free_ulmatrix(unsigned long int **m, long nrl, long nrh, long ncl, long nch)
00852
00853 {
00854
00855 nch=nch;
00856
00857 nrh=nrh;
00858 free((FREE_ARG) (m[nrl]+ncl-NR_END));
00859 free((FREE_ARG) (m+nrl-NR_END));
00860 }
00861
00862 void free_lmatrix(long int **m, long nrl, long nrh, long ncl, long nch)
00863
00864 {
00865
00866 nch=nch;
00867
00868 nrh=nrh;
00869 free((FREE_ARG) (m[nrl]+ncl-NR_END));
00870 free((FREE_ARG) (m+nrl-NR_END));
00871 }
00872
00873 void free_fdmatrix(frame_data **m, long nrl, long nrh, long ncl, long nch)
00874
00875 {
00876
00877 nch=nch;
00878
00879 nrh=nrh;
00880 free((FREE_ARG) (m[nrl]+ncl-NR_END));
00881 free((FREE_ARG) (m+nrl-NR_END));
00882 }
00883
00884 void free_fmmatrix(frame_mask **m, long nrl, long nrh, long ncl, long nch)
00885
00886 {
00887
00888 nch=nch;
00889
00890 nrh=nrh;
00891 free((FREE_ARG) (m[nrl]+ncl-NR_END));
00892 free((FREE_ARG) (m+nrl-NR_END));
00893 }
00894
00895 void free_submatrix(float **b, long nrl, long nrh, long ncl, long nch)
00896
00897 {
00898
00899 nch=nch;
00900
00901 nrh=nrh;
00902
00903 ncl=ncl;
00904
00905 free((FREE_ARG) (b+nrl-NR_END));
00906 }
00907
00908 void free_convert_matrix(float **b, long nrl, long nrh, long ncl, long nch)
00909
00910 {
00911
00912 nch=nch;
00913
00914 nrh=nrh;
00915
00916 ncl=ncl;
00917 free((FREE_ARG) (b+nrl-NR_END));
00918 }
00919
00920 void free_f3tensor(float ***t, long nrl, long nrh, long ncl, long nch,
00921 long ndl, long ndh)
00922
00923 {
00924
00925 nrh=nrh;
00926
00927 nch=nch;
00928
00929 ndh=ndh;
00930
00931 free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
00932 free((FREE_ARG) (t[nrl]+ncl-NR_END));
00933 free((FREE_ARG) (t+nrl-NR_END));
00934 }
00935
00936 void free_d3tensor(double ***t, long nrl, long nrh, long ncl, long nch,
00937 long ndl, long ndh)
00938
00939 {
00940
00941 nrh=nrh;
00942
00943 nch=nch;
00944
00945 ndh=ndh;
00946
00947 free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
00948 free((FREE_ARG) (t[nrl]+ncl-NR_END));
00949 free((FREE_ARG) (t+nrl-NR_END));
00950 }
00951
00952 void free_fd3tensor(frame_data ***t, long nrl, long nrh, long ncl, long nch,
00953 long ndl, long ndh)
00954
00955 {
00956
00957 nrh=nrh;
00958
00959 nch=nch;
00960
00961 ndh=ndh;
00962 free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
00963 free((FREE_ARG) (t[nrl]+ncl-NR_END));
00964 free((FREE_ARG) (t+nrl-NR_END));
00965 }
00966
00967 void free_fm3tensor(frame_mask ***t, long nrl, long nrh, long ncl, long nch,
00968 long ndl, long ndh)
00969
00970 {
00971
00972 nrh=nrh;
00973
00974 nch=nch;
00975
00976 ndh=ndh;
00977 free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
00978 free((FREE_ARG) (t[nrl]+ncl-NR_END));
00979 free((FREE_ARG) (t+nrl-NR_END));
00980 }
00981
00982 void free_ul3tensor(unsigned long int ***t, long nrl, long nrh, long ncl, long nch,
00983 long ndl, long ndh)
00984
00985 {
00986
00987 nrh=nrh;
00988
00989 nch=nch;
00990
00991 ndh=ndh;
00992
00993 free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
00994 free((FREE_ARG) (t[nrl]+ncl-NR_END));
00995 free((FREE_ARG) (t+nrl-NR_END));
00996 }
00997
00998 void free_l3tensor(long int ***t, long nrl, long nrh, long ncl, long nch,
00999 long ndl, long ndh)
01000
01001 {
01002
01003 nrh=nrh;
01004
01005 nch=nch;
01006
01007 ndh=ndh;
01008 free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
01009 free((FREE_ARG) (t[nrl]+ncl-NR_END));
01010 free((FREE_ARG) (t+nrl-NR_END));
01011 }
01012
01013 void free_l4tensor(long int ****t, long nal, long nah, long nrl, long nrh,
01014 long ncl, long nch, long ndl, long ndh)
01015
01016 {
01017
01018 nah=nah;
01019
01020 nrh=nrh;
01021
01022 nch=nch;
01023
01024 ndh=ndh;
01025
01026 free((FREE_ARG) (t[nal][nrl][ncl]+ndl-NR_END));
01027 free((FREE_ARG) (t[nal][nrl]+ncl-NR_END));
01028 free((FREE_ARG) (t[nal]+nrl-NR_END));
01029 free((FREE_ARG) (t+nal-NR_END));
01030 }
01031
01032 void matrix_product(double **A, double **B, double **C, int ra, int ca, int cb)
01033 {
01034
01035
01036 int k,j,m;
01037
01038 C=dmatrix(1,ra,1,cb);
01039 if (!C)
01040 {
01041 SCTPUT("Error in matrix product");
01042 }
01043
01044 for (j=1; j<=ra; j++)
01045 {
01046 for (k=1; k<=cb; k++)
01047 {
01048 C[j][k]=0;
01049 }
01050 }
01051
01052 for (j=1; j<=ra; j++)
01053 {
01054 for (k=1; k<=cb; k++)
01055 {
01056 for (m=1; m<=ca; m++)
01057 {
01058 C[j][k] += A[j][m]*B[m][k];
01059 }
01060 }
01061 }
01062 return ;
01063 }
01064 void matrix_sum(double **A, double **B, int ra, int ca)
01065 {
01066
01067
01068 int k,j;
01069
01070 for (j=1; j<=ra; j++)
01071 {
01072 for (k=1; k<=ca; k++)
01073 {
01074 A[j][k] += B[j][k];
01075 }
01076 }
01077 return ;
01078 }
01079
01080
01081
01082 #else
01083
01084
01085 #include <stdio.h>
01086 #include <flames_uves.h>
01087 #define NR_END 1
01088 #define FREE_ARG char*
01089
01090 void nrerror(error_text)
01091 char error_text[];
01092
01093 {
01094
01095
01096
01097
01098
01099
01100
01101 void exit();
01102 char output[70];
01103
01104 SCTPUT("Numerical Recipes run-time error...\n");
01105 sprintf(output, "%s\n", error_text);
01106 SCTPUT(output);
01107 SCTPUT("...now exiting to system...\n");
01108 SCSEPI();
01109 return flames_midas_fail();
01110 }
01111
01112 float *vector(nl,nh)
01113 long nh,nl;
01114
01115 {
01116 float *v;
01117
01118 v=(float *) calloc((unsigned int) (nh-nl+1+NR_END), sizeof(float));
01119 if (!v) nrerror("allocation failure in vector()");
01120 return v-nl+NR_END;
01121 }
01122
01123 int *ivector(nl,nh)
01124 long nh,nl;
01125
01126 {
01127 int *v;
01128
01129 v=(int *) calloc((unsigned int) (nh-nl+1+NR_END), sizeof(int));
01130 if (!v) nrerror("allocation failure in ivector()");
01131 return v-nl+NR_END;
01132 }
01133
01134 unsigned int *uivector(nl,nh)
01135 long nh,nl;
01136
01137 {
01138 unsigned int *v;
01139
01140 v=(unsigned int *) calloc((unsigned int) (nh-nl+1+NR_END),
01141 sizeof(unsigned int));
01142 if (!v) nrerror("allocation failure in uivector()");
01143 return v-nl+NR_END;
01144 }
01145
01146 char *cvector(nl,nh)
01147 long nh,nl;
01148
01149 {
01150 char *v;
01151
01152 v=(char *) calloc((unsigned int) (nh-nl+1+NR_END), sizeof(char));
01153 if (!v) nrerror("allocation failure in cvector()");
01154 return v-nl+NR_END;
01155 }
01156
01157 char *ucvector(nl,nh)
01158 long nh,nl;
01159
01160 {
01161 unsigned char *v;
01162
01163 v=(unsigned char *) calloc((unsigned int) (nh-nl+1+NR_END),
01164 sizeof(unsigned char));
01165 if (!v) nrerror("allocation failure in ucvector()");
01166 return v-nl+NR_END;
01167 }
01168
01169 long int *lvector(nl,nh)
01170 long nh,nl;
01171
01172 {
01173 long int *v;
01174
01175 v=(long int *) calloc((unsigned int) (nh-nl+1+NR_END),
01176 sizeof(long int));
01177 if (!v) nrerror("allocation failure in lvector()");
01178 return v-nl+NR_END;
01179 }
01180
01181 unsigned long *ulvector(nl,nh)
01182 long nh,nl;
01183
01184 {
01185 unsigned long *v;
01186
01187 v=(unsigned long int*) calloc((unsigned int) (nh-nl+1+NR_END),
01188 sizeof(unsigned long));
01189 if (!v) nrerror("allocation failure in ulvector()");
01190 return v-nl+NR_END;
01191 }
01192
01193 double *dvector(nl,nh)
01194 long nh,nl;
01195
01196 {
01197 double *v;
01198
01199 v=(double *) calloc((unsigned int) (nh-nl+1+NR_END), sizeof(double));
01200 if (!v) nrerror("allocation failure in dvector()");
01201 return v-nl+NR_END;
01202 }
01203
01204 double *fdvector(nl,nh)
01205 long nh,nl;
01206
01207 {
01208 frame_data *v;
01209
01210 v=(frame_data *) calloc((unsigned int) (nh-nl+1+NR_END),
01211 sizeof(frame_data));
01212 if (!v) nrerror("allocation failure in dvector()");
01213 return v-nl+NR_END;
01214 }
01215
01216 double *fmvector(nl,nh)
01217 long nh,nl;
01218
01219 {
01220 frame_mask *v;
01221
01222 v=(frame_mask *) calloc((unsigned int) (nh-nl+1+NR_END),
01223 sizeof(frame_mask));
01224 if (!v) nrerror("allocation failure in dvector()");
01225 return v-nl+NR_END;
01226 }
01227
01228 float **matrix(nrl,nrh,ncl,nch)
01229 long nch,ncl,nrh,nrl;
01230
01231 {
01232 long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
01233 float **m;
01234
01235
01236 m=(float **) calloc((unsigned int)(nrow+NR_END), sizeof(float*));
01237 if (!m) nrerror("allocation failure 1 in matrix()");
01238 m += NR_END;
01239 m -= nrl;
01240
01241
01242 m[nrl]=(float *) calloc((unsigned int)(nrow*ncol+NR_END),
01243 sizeof(float));
01244 if (!m[nrl]) nrerror("allocation failure 2 in matrix()");
01245 m[nrl] += NR_END;
01246 m[nrl] -= ncl;
01247
01248 for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
01249
01250
01251 return m;
01252 }
01253
01254 char **cmatrix(nrl,nrh,ncl,nch)
01255 long nch,ncl,nrh,nrl;
01256
01257 {
01258 long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
01259 char **m;
01260
01261
01262 m=(char **) calloc((unsigned int)(nrow+NR_END), sizeof(char*));
01263 if (!m) nrerror("allocation failure 1 in cmatrix()");
01264 m += NR_END;
01265 m -= nrl;
01266
01267
01268 m[nrl]=(char *) calloc((unsigned int)(nrow*ncol+NR_END),
01269 sizeof(char));
01270 if (!m[nrl]) nrerror("allocation failure 2 in cmatrix()");
01271 m[nrl] += NR_END;
01272 m[nrl] -= ncl;
01273
01274 for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
01275
01276
01277 return m;
01278 }
01279
01280 double **dmatrix(nrl,nrh,ncl,nch)
01281 long nch,ncl,nrh,nrl;
01282
01283 {
01284 long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
01285 double **m;
01286
01287
01288 m=(double **) calloc((unsigned int)(nrow+NR_END), sizeof(double*));
01289 if (!m) nrerror("allocation failure 1 in dmatrix()");
01290 m += NR_END;
01291 m -= nrl;
01292
01293
01294 m[nrl]=(double *) calloc((unsigned int)(nrow*ncol+NR_END),
01295 sizeof(double));
01296 if (!m[nrl]) nrerror("allocation failure 2 in dmatrix()");
01297 m[nrl] += NR_END;
01298 m[nrl] -= ncl;
01299
01300 for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
01301
01302
01303 return m;
01304 }
01305
01306 int **imatrix(nrl,nrh,ncl,nch)
01307 long nch,ncl,nrh,nrl;
01308
01309 {
01310 long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
01311 int **m;
01312
01313
01314 m=(int **) calloc((unsigned int)(nrow+NR_END), sizeof(int*));
01315 if (!m) nrerror("allocation failure 1 in imatrix()");
01316 m += NR_END;
01317 m -= nrl;
01318
01319
01320
01321 m[nrl]=(int *) calloc((unsigned int)(nrow*ncol+NR_END), sizeof(int));
01322 if (!m[nrl]) nrerror("allocation failure 2 in imatrix()");
01323 m[nrl] += NR_END;
01324 m[nrl] -= ncl;
01325
01326 for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
01327
01328
01329 return m;
01330 }
01331
01332 unsigned long int **ulmatrix(nrl,nrh,ncl,nch)
01333 long nch,ncl,nrh,nrl;
01334
01335 {
01336 long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
01337 unsigned long int **m;
01338
01339
01340 m=(unsigned long int **) calloc((unsigned int)(nrow+NR_END),
01341 sizeof(unsigned long int*));
01342 if (!m) nrerror("allocation failure 1 in ulmatrix()");
01343 m += NR_END;
01344 m -= nrl;
01345
01346
01347
01348 m[nrl]=(unsigned long int *) calloc((unsigned int)(nrow*ncol+NR_END),
01349 sizeof(unsigned long int));
01350 if (!m[nrl]) nrerror("allocation failure 2 in ulmatrix()");
01351 m[nrl] += NR_END;
01352 m[nrl] -= ncl;
01353
01354 for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
01355
01356
01357 return m;
01358 }
01359
01360 long int **lmatrix(nrl,nrh,ncl,nch)
01361 long nch,ncl,nrh,nrl;
01362
01363 {
01364 long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
01365 long int **m;
01366
01367
01368 m=(long int **) calloc((unsigned int)(nrow+NR_END), sizeof(long int*));
01369 if (!m) nrerror("allocation failure 1 in lmatrix()");
01370 m += NR_END;
01371 m -= nrl;
01372
01373
01374
01375 m[nrl]=(long int *) calloc((unsigned int)(nrow*ncol+NR_END),
01376 sizeof(long int));
01377 if (!m[nrl]) nrerror("allocation failure 2 in lmatrix()");
01378 m[nrl] += NR_END;
01379 m[nrl] -= ncl;
01380
01381 for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
01382
01383
01384 return m;
01385 }
01386
01387 frame_data **fdmatrix(nrl,nrh,ncl,nch)
01388 long nch,ncl,nrh,nrl;
01389
01390 {
01391 long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
01392 frame_data **m;
01393
01394
01395 m=(frame_data **) calloc((unsigned int)(nrow+NR_END),
01396 sizeof(frame_data*));
01397 if (!m) nrerror("allocation failure 1 in fdmatrix()");
01398 m += NR_END;
01399 m -= nrl;
01400
01401
01402
01403 m[nrl]=(frame_data *) calloc((unsigned int)(nrow*ncol+NR_END),
01404 sizeof(frame_data));
01405 if (!m[nrl]) nrerror("allocation failure 2 in fdmatrix()");
01406 m[nrl] += NR_END;
01407 m[nrl] -= ncl;
01408
01409 for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
01410
01411
01412 return m;
01413 }
01414
01415 frame_mask **fmmatrix(nrl,nrh,ncl,nch)
01416 long nch,ncl,nrh,nrl;
01417
01418 {
01419 long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
01420 frame_mask **m;
01421
01422
01423 m=(frame_mask **) calloc((unsigned int)(nrow+NR_END),
01424 sizeof(frame_mask*));
01425 if (!m) nrerror("allocation failure 1 in fmmatrix()");
01426 m += NR_END;
01427 m -= nrl;
01428
01429
01430
01431 m[nrl]=(frame_mask *) calloc((unsigned int)(nrow*ncol+NR_END),
01432 sizeof(frame_mask));
01433 if (!m[nrl]) nrerror("allocation failure 2 in fmmatrix()");
01434 m[nrl] += NR_END;
01435 m[nrl] -= ncl;
01436
01437 for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol;
01438
01439
01440 return m;
01441 }
01442
01443 float **submatrix(a,oldrl,oldrh,oldcl,oldch,newrl,newcl)
01444 float **a;
01445 long newcl,newrl,oldch,oldcl,oldrh,oldrl;
01446
01447 {
01448 long i,j,nrow=oldrh-oldrl+1,ncol=oldcl-newcl;
01449 float **m;
01450
01451
01452 m=(float **) calloc((unsigned int) (nrow+NR_END), sizeof(float*));
01453 if (!m) nrerror("allocation failure in submatrix()");
01454 m += NR_END;
01455 m -= newrl;
01456
01457
01458 for(i=oldrl,j=newrl;i<=oldrh;i++,j++) m[j]=a[i]+ncol;
01459
01460
01461 return m;
01462 }
01463
01464 float **convert_matrix(a,nrl,nrh,ncl,nch)
01465 float *a;
01466 long nch,ncl,nrh,nrl;
01467
01468
01469
01470
01471 {
01472 long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1;
01473 float **m;
01474
01475
01476 m=(float **) calloc((unsigned int) (nrow+NR_END), sizeof(float*));
01477 if (!m) nrerror("allocation failure in convert_matrix()");
01478 m += NR_END;
01479 m -= nrl;
01480
01481
01482 m[nrl]=a-ncl;
01483 for(i=1,j=nrl+1;i<nrow;i++,j++) m[j]=m[j-1]+ncol;
01484
01485 return m;
01486 }
01487
01488 float ***f3tensor(nrl,nrh,ncl,nch,ndl,ndh)
01489 long nch,ncl,ndh,ndl,nrh,nrl;
01490
01491 {
01492 long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
01493 float ***t;
01494
01495
01496 t=(float ***) calloc((unsigned int)(nrow+NR_END), sizeof(float**));
01497 if (!t) nrerror("allocation failure 1 in f3tensor()");
01498 t += NR_END;
01499 t -= nrl;
01500
01501
01502 t[nrl]=(float **) calloc((unsigned int)(nrow*ncol+NR_END),
01503 sizeof(float*));
01504 if (!t[nrl]) nrerror("allocation failure 2 in f3tensor()");
01505 t[nrl] += NR_END;
01506 t[nrl] -= ncl;
01507
01508
01509 t[nrl][ncl]=(float *) calloc((unsigned int)(nrow*ncol*ndep+NR_END),
01510 sizeof(float));
01511 if (!t[nrl][ncl]) nrerror("allocation failure 3 in f3tensor()");
01512 t[nrl][ncl] += NR_END;
01513 t[nrl][ncl] -= ndl;
01514
01515 for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
01516 for(i=nrl+1;i<=nrh;i++) {
01517 t[i]=t[i-1]+ncol;
01518 t[i][ncl]=t[i-1][ncl]+ncol*ndep;
01519 for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
01520 }
01521
01522
01523 return t;
01524 }
01525
01526 frame_data ***fd3tensor(nrl,nrh,ncl,nch,ndl,ndh)
01527 long nch,ncl,ndh,ndl,nrh,nrl;
01528
01529 {
01530 long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
01531 frame_data ***t;
01532
01533
01534 t=(frame_data ***) calloc((unsigned int)(nrow+NR_END),
01535 sizeof(frame_data**));
01536 if (!t) nrerror("allocation failure 1 in fd3tensor()");
01537 t += NR_END;
01538 t -= nrl;
01539
01540
01541 t[nrl]=(frame_data **) calloc((unsigned int)(nrow*ncol+NR_END),
01542 sizeof(frame_data*));
01543 if (!t[nrl]) nrerror("allocation failure 2 in fd3tensor()");
01544 t[nrl] += NR_END;
01545 t[nrl] -= ncl;
01546
01547
01548 t[nrl][ncl]=
01549 (frame_data *) calloc((unsigned int)(nrow*ncol*ndep+NR_END),
01550 sizeof(frame_data));
01551 if (!t[nrl][ncl]) nrerror("allocation failure 3 in fd3tensor()");
01552 t[nrl][ncl] += NR_END;
01553 t[nrl][ncl] -= ndl;
01554
01555 for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
01556 for(i=nrl+1;i<=nrh;i++) {
01557 t[i]=t[i-1]+ncol;
01558 t[i][ncl]=t[i-1][ncl]+ncol*ndep;
01559 for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
01560 }
01561
01562
01563 return t;
01564 }
01565
01566 double ***d3tensor(nrl,nrh,ncl,nch,ndl,ndh)
01567 long nch,ncl,ndh,ndl,nrh,nrl;
01568
01569 {
01570 long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
01571 double ***t;
01572
01573
01574 t=(double ***) calloc((unsigned int)(nrow+NR_END), sizeof(double**));
01575 if (!t) nrerror("allocation failure 1 in d3tensor()");
01576 t += NR_END;
01577 t -= nrl;
01578
01579
01580 t[nrl]=(double **) calloc((unsigned int)(nrow*ncol+NR_END),
01581 sizeof(double*));
01582 if (!t[nrl]) nrerror("allocation failure 2 in d3tensor()");
01583 t[nrl] += NR_END;
01584 t[nrl] -= ncl;
01585
01586
01587 t[nrl][ncl]=(double *) calloc((unsigned int)(nrow*ncol*ndep+NR_END),
01588 sizeof(double));
01589 if (!t[nrl][ncl]) nrerror("allocation failure 3 in d3tensor()");
01590 t[nrl][ncl] += NR_END;
01591 t[nrl][ncl] -= ndl;
01592
01593 for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
01594 for(i=nrl+1;i<=nrh;i++) {
01595 t[i]=t[i-1]+ncol;
01596 t[i][ncl]=t[i-1][ncl]+ncol*ndep;
01597 for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
01598 }
01599
01600
01601 return t;
01602 }
01603
01604 frame_data ***fd3tensor(nrl,nrh,ncl,nch,ndl,ndh)
01605 long nch,ncl,ndh,ndl,nrh,nrl;
01606
01607 {
01608 long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
01609 frame_data ***t;
01610
01611
01612 t=(frame_data ***) calloc((unsigned int)(nrow+NR_END),
01613 sizeof(frame_data**));
01614 if (!t) nrerror("allocation failure 1 in f3tensor()");
01615 t += NR_END;
01616 t -= nrl;
01617
01618
01619 t[nrl]=(frame_data **) calloc((unsigned int)(nrow*ncol+NR_END),
01620 sizeof(frame_data*));
01621 if (!t[nrl]) nrerror("allocation failure 2 in f3tensor()");
01622 t[nrl] += NR_END;
01623 t[nrl] -= ncl;
01624
01625
01626 t[nrl][ncl]=
01627 (frame_data *) calloc((unsigned int)(nrow*ncol*ndep+NR_END),
01628 sizeof(frame_data));
01629 if (!t[nrl][ncl]) nrerror("allocation failure 3 in f3tensor()");
01630 t[nrl][ncl] += NR_END;
01631 t[nrl][ncl] -= ndl;
01632
01633 for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
01634 for(i=nrl+1;i<=nrh;i++) {
01635 t[i]=t[i-1]+ncol;
01636 t[i][ncl]=t[i-1][ncl]+ncol*ndep;
01637 for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
01638 }
01639
01640
01641 return t;
01642 }
01643
01644 frame_mask ***fm3tensor(nrl,nrh,ncl,nch,ndl,ndh)
01645 long nch,ncl,ndh,ndl,nrh,nrl;
01646
01647 {
01648 long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
01649 frame_mask ***t;
01650
01651
01652 t=(frame_mask ***) calloc((unsigned int)(nrow+NR_END),
01653 sizeof(frame_mask**));
01654 if (!t) nrerror("allocation failure 1 in f3tensor()");
01655 t += NR_END;
01656 t -= nrl;
01657
01658
01659 t[nrl]=(frame_mask **) calloc((unsigned int)(nrow*ncol+NR_END),
01660 sizeof(frame_mask*));
01661 if (!t[nrl]) nrerror("allocation failure 2 in f3tensor()");
01662 t[nrl] += NR_END;
01663 t[nrl] -= ncl;
01664
01665
01666 t[nrl][ncl]=
01667 (frame_mask *) calloc((unsigned int)(nrow*ncol*ndep+NR_END),
01668 sizeof(frame_mask));
01669 if (!t[nrl][ncl]) nrerror("allocation failure 3 in f3tensor()");
01670 t[nrl][ncl] += NR_END;
01671 t[nrl][ncl] -= ndl;
01672
01673 for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
01674 for(i=nrl+1;i<=nrh;i++) {
01675 t[i]=t[i-1]+ncol;
01676 t[i][ncl]=t[i-1][ncl]+ncol*ndep;
01677 for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
01678 }
01679
01680
01681 return t;
01682 }
01683
01684 unsigned long int ***ul3tensor(nrl,nrh,ncl,nch,ndl,ndh)
01685 long nch,ncl,ndh,ndl,nrh,nrl;
01686
01687 {
01688 long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
01689 unsigned long int ***t;
01690
01691
01692 t=(unsigned long int ***) calloc((unsigned int)(nrow+NR_END),
01693 sizeof(unsigned long int**));
01694 if (!t) nrerror("allocation failure 1 in f3tensor()");
01695 t += NR_END;
01696 t -= nrl;
01697
01698
01699 t[nrl]=(unsigned long int **) calloc((unsigned int)(nrow*ncol+NR_END),
01700 sizeof(unsigned long int*));
01701 if (!t[nrl]) nrerror("allocation failure 2 in f3tensor()");
01702 t[nrl] += NR_END;
01703 t[nrl] -= ncl;
01704
01705
01706 t[nrl][ncl]=
01707 (unsigned long int *) calloc((unsigned int)(nrow*ncol*ndep+NR_END),
01708 sizeof(unsigned long int));
01709 if (!t[nrl][ncl]) nrerror("allocation failure 3 in f3tensor()");
01710 t[nrl][ncl] += NR_END;
01711 t[nrl][ncl] -= ndl;
01712
01713 for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
01714 for(i=nrl+1;i<=nrh;i++) {
01715 t[i]=t[i-1]+ncol;
01716 t[i][ncl]=t[i-1][ncl]+ncol*ndep;
01717 for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
01718 }
01719
01720
01721 return t;
01722 }
01723
01724 long int ***l3tensor(nrl,nrh,ncl,nch,ndl,ndh)
01725 long nch,ncl,ndh,ndl,nrh,nrl;
01726
01727 {
01728 long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
01729 long int ***t;
01730
01731
01732 t=(long int ***) calloc((unsigned int)(nrow+NR_END),
01733 sizeof(long int**));
01734 if (!t) nrerror("allocation failure 1 in f3tensor()");
01735 t += NR_END;
01736 t -= nrl;
01737
01738
01739 t[nrl]=(long int **) calloc((unsigned int)(nrow*ncol+NR_END),
01740 sizeof(long int*));
01741 if (!t[nrl]) nrerror("allocation failure 2 in f3tensor()");
01742 t[nrl] += NR_END;
01743 t[nrl] -= ncl;
01744
01745
01746 t[nrl][ncl]=(long int *) calloc((unsigned int)(nrow*ncol*ndep+NR_END),
01747 sizeof(long int));
01748 if (!t[nrl][ncl]) nrerror("allocation failure 3 in f3tensor()");
01749 t[nrl][ncl] += NR_END;
01750 t[nrl][ncl] -= ndl;
01751
01752 for(j=ncl+1;j<=nch;j++) t[nrl][j]=t[nrl][j-1]+ndep;
01753 for(i=nrl+1;i<=nrh;i++) {
01754 t[i]=t[i-1]+ncol;
01755 t[i][ncl]=t[i-1][ncl]+ncol*ndep;
01756 for(j=ncl+1;j<=nch;j++) t[i][j]=t[i][j-1]+ndep;
01757 }
01758
01759
01760 return t;
01761 }
01762
01763 long int ***l4tensor(nal,nah,nrl,nrh,ncl,nch,ndl,ndh)
01764 long nch,ncl,ndh,ndl,nrh,nrl,nah,nal;
01765
01766
01767 {
01768 long i,j,k,na=nah-nal+1,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
01769 long int ****t;
01770
01771
01772 t=(long int ****) calloc((unsigned int)(na+NR_END),
01773 sizeof(long int***));
01774 if (!t) nrerror("allocation failure 1 in l4tensor()");
01775 t += NR_END;
01776 t -= nal;
01777
01778
01779 t[nal]=(long int ***) calloc((unsigned int)(na*nrow+NR_END),
01780 sizeof(long int**));
01781 if (!t[nrl]) nrerror("allocation failure 2 in l4tensor()");
01782 t[nal] += NR_END;
01783 t[nal] -= nrl;
01784
01785
01786 t[nal][nrl]=(long int **) calloc((unsigned int)(na*nrow*ncol+NR_END),
01787 sizeof(long int*));
01788 if (!t[nal][nrl]) nrerror("allocation failure 3 in l4tensor()");
01789 t[nal][nrl] += NR_END;
01790 t[nal][nrl] -= ncl;
01791
01792
01793 t[nal][nrl][ncl]=
01794 (long int *) calloc((unsigned int)(na*nrow*ncol*ndep+NR_END),
01795 sizeof(long int));
01796 if (!t[nal][nrl][ncl]) nrerror("allocation failure 4 in l4tensor()");
01797 t[nal][nrl][ncl] += NR_END;
01798 t[nal][nrl][ncl] -= ndl;
01799
01800 for(k=ncl+1;k<=nch;k++) t[nal][nrl][k]=t[nal][nrl][k-1]+ndep;
01801 for(j=nrl+1;j<=nrh;j++) {
01802 t[nal][j] = t[nal][j-1]+ncol;
01803 t[nal][j][ncl] = t[nal][j-1][ncl]+ncol*ndep;
01804 for(k=ncl+1;k<=nch;k++) t[nal][j][k]=t[nal][j][k-1]+ndep;
01805 }
01806 for(i=nal+1;i<=nah;i++) {
01807 t[i]=t[i-1]+nrow;
01808 t[i][nrl] = t[i-1][nrl]+nrow*ncol;
01809 t[i][nrl][ncl] = t[i-1][nrl][ncl]+nrow*ncol*ndep;
01810 for(k=ncl+1;k<=nch;k++) t[i][nrl][k]=t[i][nrl][k-1]+ndep;
01811 for(j=nrl+1;j<=nrh;j++) {
01812 t[i][j] = t[i][j-1]+ncol;
01813 t[i][j][ncl] = t[i][j-1][ncl]+ncol*ndep;
01814 for(k=ncl+1;k<=nch;k++) t[i][j][k]=t[i][j][k-1]+ndep;
01815 }
01816 }
01817
01818
01819 return t;
01820 }
01821
01822 void free_vector(v,nl,nh)
01823 float *v;
01824 long nh,nl;
01825
01826 {
01827 free((FREE_ARG) (v+nl-NR_END));
01828 }
01829
01830 void free_ivector(v,nl,nh)
01831 int *v;
01832 long nh,nl;
01833
01834 {
01835 free((FREE_ARG) (v+nl-NR_END));
01836 }
01837
01838 void free_uivector(v,nl,nh)
01839 unsigned int *v;
01840 long nh,nl;
01841
01842 {
01843 free((FREE_ARG) (v+nl-NR_END));
01844 }
01845
01846 void free_cvector(v,nl,nh)
01847 long nh,nl;
01848 char *v;
01849
01850 {
01851 free((FREE_ARG) (v+nl-NR_END));
01852 }
01853
01854 void free_ucvector(v,nl,nh)
01855 long nh,nl;
01856 unsigned char *v;
01857
01858 {
01859 free((FREE_ARG) (v+nl-NR_END));
01860 }
01861
01862 void free_lvector(v,nl,nh)
01863 long nh,nl;
01864 long int *v;
01865
01866 {
01867 free((FREE_ARG) (v+nl-NR_END));
01868 }
01869
01870 void free_ulvector(v,nl,nh)
01871 long nh,nl;
01872 unsigned long *v;
01873
01874 {
01875 free((FREE_ARG) (v+nl-NR_END));
01876 }
01877
01878 void free_dvector(v,nl,nh)
01879 double *v;
01880 long nh,nl;
01881
01882 {
01883 free((FREE_ARG) (v+nl-NR_END));
01884 }
01885
01886 void free_fdvector(v,nl,nh)
01887 frame_data *v;
01888 long nh,nl;
01889
01890 {
01891 free((FREE_ARG) (v+nl-NR_END));
01892 }
01893
01894 void free_fmvector(v,nl,nh)
01895 frame_mask *v;
01896 long nh,nl;
01897
01898 {
01899 free((FREE_ARG) (v+nl-NR_END));
01900 }
01901
01902 void free_matrix(m,nrl,nrh,ncl,nch)
01903 float **m;
01904 long nch,ncl,nrh,nrl;
01905
01906 {
01907 free((FREE_ARG) (m[nrl]+ncl-NR_END));
01908 free((FREE_ARG) (m+nrl-NR_END));
01909 }
01910
01911 void free_cmatrix(m,nrl,nrh,ncl,nch)
01912 char **m;
01913 long nch,ncl,nrh,nrl;
01914
01915 {
01916 free((FREE_ARG) (m[nrl]+ncl-NR_END));
01917 free((FREE_ARG) (m+nrl-NR_END));
01918 }
01919
01920 void free_dmatrix(m,nrl,nrh,ncl,nch)
01921 double **m;
01922 long nch,ncl,nrh,nrl;
01923
01924 {
01925 free((FREE_ARG) (m[nrl]+ncl-NR_END));
01926 free((FREE_ARG) (m+nrl-NR_END));
01927 }
01928
01929 void free_ulmatrix(m,nrl,nrh,ncl,nch)
01930 unsigned long int **m;
01931 long nch,ncl,nrh,nrl;
01932
01933 {
01934 free((FREE_ARG) (m[nrl]+ncl-NR_END));
01935 free((FREE_ARG) (m+nrl-NR_END));
01936 }
01937
01938 void free_lmatrix(m,nrl,nrh,ncl,nch)
01939 long int **m;
01940 long nch,ncl,nrh,nrl;
01941
01942 {
01943 free((FREE_ARG) (m[nrl]+ncl-NR_END));
01944 free((FREE_ARG) (m+nrl-NR_END));
01945 }
01946
01947 void free_imatrix(m,nrl,nrh,ncl,nch)
01948 int **m;
01949 long nch,ncl,nrh,nrl;
01950
01951 {
01952 free((FREE_ARG) (m[nrl]+ncl-NR_END));
01953 free((FREE_ARG) (m+nrl-NR_END));
01954 }
01955
01956 void free_fdmatrix(m,nrl,nrh,ncl,nch)
01957 frame_data **m;
01958 long nch,ncl,nrh,nrl;
01959
01960 {
01961 free((FREE_ARG) (m[nrl]+ncl-NR_END));
01962 free((FREE_ARG) (m+nrl-NR_END));
01963 }
01964
01965 void free_fmmatrix(m,nrl,nrh,ncl,nch)
01966 frame_mask **m;
01967 long nch,ncl,nrh,nrl;
01968
01969 {
01970 free((FREE_ARG) (m[nrl]+ncl-NR_END));
01971 free((FREE_ARG) (m+nrl-NR_END));
01972 }
01973
01974 void free_submatrix(b,nrl,nrh,ncl,nch)
01975 float **b;
01976 long nch,ncl,nrh,nrl;
01977
01978 {
01979 free((FREE_ARG) (b+nrl-NR_END));
01980 }
01981
01982 void free_convert_matrix(b,nrl,nrh,ncl,nch)
01983 float **b;
01984 long nch,ncl,nrh,nrl;
01985
01986 {
01987 free((FREE_ARG) (b+nrl-NR_END));
01988 }
01989
01990 void free_f3tensor(t,nrl,nrh,ncl,nch,ndl,ndh)
01991 float ***t;
01992 long nch,ncl,ndh,ndl,nrh,nrl;
01993
01994 {
01995 free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
01996 free((FREE_ARG) (t[nrl]+ncl-NR_END));
01997 free((FREE_ARG) (t+nrl-NR_END));
01998 }
01999
02000 void free_d3tensor(t,nrl,nrh,ncl,nch,ndl,ndh)
02001 double ***t;
02002 long nch,ncl,ndh,ndl,nrh,nrl;
02003
02004 {
02005 free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
02006 free((FREE_ARG) (t[nrl]+ncl-NR_END));
02007 free((FREE_ARG) (t+nrl-NR_END));
02008 }
02009
02010 void free_fd3tensor(t,nrl,nrh,ncl,nch,ndl,ndh)
02011 frame_data ***t;
02012 long nch,ncl,ndh,ndl,nrh,nrl;
02013
02014 {
02015 free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
02016 free((FREE_ARG) (t[nrl]+ncl-NR_END));
02017 free((FREE_ARG) (t+nrl-NR_END));
02018 }
02019
02020 void free_fm3tensor(t,nrl,nrh,ncl,nch,ndl,ndh)
02021 frame_mask ***t;
02022 long nch,ncl,ndh,ndl,nrh,nrl;
02023
02024 {
02025 free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
02026 free((FREE_ARG) (t[nrl]+ncl-NR_END));
02027 free((FREE_ARG) (t+nrl-NR_END));
02028 }
02029
02030 void free_ul3tensor(t,nrl,nrh,ncl,nch,ndl,ndh)
02031 unsigned long int ***t;
02032 long nch,ncl,ndh,ndl,nrh,nrl;
02033
02034 {
02035 free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
02036 free((FREE_ARG) (t[nrl]+ncl-NR_END));
02037 free((FREE_ARG) (t+nrl-NR_END));
02038 }
02039
02040 void free_l3tensor(t,nrl,nrh,ncl,nch,ndl,ndh)
02041 long int ***t;
02042 long nch,ncl,ndh,ndl,nrh,nrl;
02043
02044 {
02045 free((FREE_ARG) (t[nrl][ncl]+ndl-NR_END));
02046 free((FREE_ARG) (t[nrl]+ncl-NR_END));
02047 free((FREE_ARG) (t+nrl-NR_END));
02048 }
02049
02050 void free_l4tensor(t,nal,nah,nrl,nrh,ncl,nch,ndl,ndh)
02051 long int ***t;
02052 long nch,ncl,ndh,ndl,nrh,nrl,nah,nal;
02053
02054 {
02055 free((FREE_ARG) (t[nal][nrl][ncl]+ndl-NR_END));
02056 free((FREE_ARG) (t[nal][nrl]+ncl-NR_END));
02057 free((FREE_ARG) (t[nal]+nrl-NR_END));
02058 free((FREE_ARG) (t+nal-NR_END));
02059 }
02060
02061
02062 void matrix_product(A, B, C, ra, ca, cb)
02063 {
02064
02065 int k,j,m;
02066 double **A, **B, **C;
02067 int ra, ca, cb;
02068 if (C==0)
02069 {
02070 C=dmatrix(1,ra,1,cb);
02071 }
02072
02073 for (j=1; j<=ra; j++)
02074 {
02075 for (k=1; k<=cb; k++)
02076 {
02077 C[j][k]=0;
02078 }
02079 }
02080
02081 for (j=1; j<=ra; j++)
02082 {
02083 for (k=1; k<=cb; k++)
02084 {
02085 for (m=1; m<=ca; m++)
02086 {
02087 C[j][k] += A[j][m]*B[m][k];
02088 }
02089 }
02090 }
02091 return ;
02092 }
02093 void matrix_sum(A, B, ra, ca)
02094 {
02095
02096 int k,j;
02097 double **A, **B, **C;
02098 int ra, ca, cb;
02099
02100 for (j=1; j<=ra; j++)
02101 {
02102 for (k=1; k<=ca; k++)
02103 {
02104 A[j][k] += B[j][k];
02105 }
02106 }
02107 return ;
02108 }
02109
02110
02111 #endif