flames_newmatrix.c

00001 /*===========================================================================
00002   Copyright (C) 2001 European Southern Observatory (ESO)
00003  
00004   This program is free software; you can redistribute it and/or 
00005   modify it under the terms of the GNU General Public License as 
00006   published by the Free Software Foundation; either version 2 of 
00007   the License, or (at your option) any later version.
00008  
00009   This program is distributed in the hope that it will be useful,
00010   but WITHOUT ANY WARRANTY; without even the implied warranty of
00011   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00012   GNU General Public License for more details.
00013  
00014   You should have received a copy of the GNU General Public 
00015   License along with this program; if not, write to the Free 
00016   Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
00017   MA 02139, USA.
00018  
00019   Corresponding concerning ESO-MIDAS should be addressed as follows:
00020     Internet e-mail: midas@eso.org
00021     Postal address: European Southern Observatory
00022             Data Management Division 
00023             Karl-Schwarzschild-Strasse 2
00024             D 85748 Garching bei Muenchen 
00025             GERMANY
00026 ===========================================================================*/
00027 /* Program  : newmatrix.c                                                  */
00028 /* Author   : G. Mulas  -  ITAL_FLAMES Consortium (derived by NR)          */
00029 /* Date     :                                                              */
00030 /*                                                                         */
00031 /* Purpose  : Missing                                                      */
00032 /*                                                                         */
00033 /*                                                                         */
00034 /* Input:  see interface                                                   */ 
00035 /*                                                                      */
00036 /* Output:                                                              */
00037 /*                                                                         */
00038 /* DRS Functions called:                                                   */
00039 /* none                                                                    */ 
00040 /*                                                                         */ 
00041 /* Pseudocode:                                                             */
00042 /* Missing                                                                 */ 
00043 /*                                                                         */ 
00044 /* Version  :                                                              */
00045 /* Last modification date: 2002/08/05                                      */
00046 /* Who     When        Why                Where                            */
00047 /* AMo     02-08-05   Add header         header                            */
00048 /*-------------------------------------------------------------------------*/
00049 
00050 #ifdef HAVE_CONFIG_H
00051 #  include <config.h>
00052 #endif
00053 
00054 
00055 #if defined(__STDC__) || defined(ANSI) || defined(NRANSI) /* ANSI */
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 //jmlarsen: Maybe we should respect the fine people at NR and
00068 //          *not* steal their copyrighted code???
00069 
00070 
00071 void  nrerror(const char* error_text)
00072 /* Numerical Recipes standard error handler */
00073 
00074 {
00075   /*
00076     ---------- Let's comment out the non-MIDAS compliant items----------
00077  
00078     fprintf(stderr,"Numerical Recipes run-time error...\n");
00079     fprintf(stderr,"%s\n",error_text);
00080     fprintf(stderr,"...now exiting to system...\n");
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   //UVES error handling here
00091   assure_nomsg( false, CPL_ERROR_ILLEGAL_OUTPUT );
00092  cleanup:
00093   return ;
00094 }
00095 
00096 float *vector(long nl, long nh)
00097 /* allocate a float vector with subscript range v[nl..nh] */
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 /* allocate an int vector with subscript range v[nl..nh] */
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 /* allocate an unsigned int vector with subscript range v[nl..nh] */
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 /* allocate a char vector with subscript range v[nl..nh] */
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 /* allocate an unsigned char vector with subscript range v[nl..nh] */
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 /* allocate a long vector with subscript range v[nl..nh] */
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 /* allocate an unsigned long vector with subscript range v[nl..nh] */
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 /* allocate a double vector with subscript range v[nl..nh] */
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 /* allocate a frame_data vector with subscript range v[nl..nh] */
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 /* allocate a frame_mask vector with subscript range v[nl..nh] */
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 /* allocate a char matrix with subscript range m[nrl..nrh][ncl..nch] */
00201 {
00202   long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
00203   char **m;
00204 
00205   /* allocate pointers to rows */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
00220   return m;
00221 }
00222 
00223 float **matrix(long nrl, long nrh, long ncl, long nch)
00224 /* allocate a float matrix with subscript range m[nrl..nrh][ncl..nch] */
00225 {
00226   long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
00227   float **m;
00228 
00229   /* allocate pointers to rows */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
00244   return m;
00245 }
00246 
00247 double **dmatrix(long nrl, long nrh, long ncl, long nch)
00248 /* allocate a double matrix with subscript range m[nrl..nrh][ncl..nch] */
00249 {
00250   long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
00251   double **m;
00252 
00253   /* allocate pointers to rows */
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   /* allocate rows and set pointers to them */
00261   /*
00262     printf("nrl=%ld\n",nrl);
00263     printf("size=%ld\n",nrow*ncol+NR_END);
00264   */
00265   m[nrl]=(double *) calloc((size_t)(nrow*ncol+NR_END), sizeof(double));
00266 
00267   /* printf("allocate pointers to rows4\n"); */
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   /* return pointer to array of pointers to rows */
00274   return m;
00275 }
00276 
00277 int **imatrix(long nrl, long nrh, long ncl, long nch)
00278 /* allocate a int matrix with subscript range m[nrl..nrh][ncl..nch] */
00279 {
00280   long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
00281   int **m;
00282 
00283   /* allocate pointers to rows */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
00299   return m;
00300 }
00301 
00302 unsigned long int **ulmatrix(long nrl, long nrh, long ncl, long nch)
00303 /* allocate a int matrix with subscript range m[nrl..nrh][ncl..nch] */
00304 {
00305   long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
00306   unsigned long int **m;
00307 
00308   /* allocate pointers to rows */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
00326   return m;
00327 }
00328 
00329 long int **lmatrix(long nrl, long nrh, long ncl, long nch)
00330 /* allocate a long int matrix with subscript range m[nrl..nrh][ncl..nch] */
00331 {
00332   long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
00333   long int **m;
00334 
00335   /* allocate pointers to rows */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
00352   return m;
00353 }
00354 
00355 frame_data **fdmatrix(long nrl, long nrh, long ncl, long nch)
00356 /* allocate a frame_data matrix with subscript range m[nrl..nrh][ncl..nch] */
00357 {
00358   long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
00359   frame_data **m;
00360 
00361   /* allocate pointers to rows */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
00378   return m;
00379 }
00380 
00381 frame_mask **fmmatrix(long nrl, long nrh, long ncl, long nch)
00382 /* allocate a frame_mask matrix with subscript range m[nrl..nrh][ncl..nch] */
00383 {
00384   long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
00385   frame_mask **m;
00386 
00387   /* allocate pointers to rows */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
00404   return m;
00405 }
00406 
00407 float **submatrix(float **a, long oldrl, long oldrh, long oldcl,
00408           long newrl, long newcl)
00409 /* point a submatrix [newrl..][newcl..] to a[oldrl..oldrh][oldcl..oldch] */
00410 {
00411   long i,j,nrow=oldrh-oldrl+1,ncol=oldcl-newcl;
00412   float **m;
00413 
00414   /* allocate array of pointers to rows */
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   /* set pointers to rows */
00421   for(i=oldrl,j=newrl;i<=oldrh;i++,j++) m[j]=a[i]+ncol;
00422 
00423   /* return pointer to array of pointers to rows */
00424   return m;
00425 }
00426 
00427 float **convert_matrix(float *a, long nrl, long nrh, long ncl, long nch)
00428 /* allocate a float matrix m[nrl..nrh][ncl..nch] that points to the matrix
00429    declared in the standard C manner as a[nrow][ncol], where nrow=nrh-nrl+1
00430    and ncol=nch-ncl+1. The routine should be called with the address
00431    &a[0][0] as the first argument. */
00432 {
00433   long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1;
00434   float **m;
00435 
00436   /* allocate pointers to rows */
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   /* set pointers to rows */
00443   m[nrl]=a-ncl;
00444   for(i=1,j=nrl+1;i<nrow;i++,j++) m[j]=m[j-1]+ncol;
00445   /* return pointer to array of pointers to rows */
00446   return m;
00447 }
00448 
00449 float ***f3tensor(long nrl, long nrh, long ncl, long nch, long ndl, long ndh)
00450 /* allocate a float 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
00451 {
00452   long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
00453   float ***t;
00454 
00455   /* allocate pointers to pointers to rows */
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   /* allocate pointers to rows and set pointers to them */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
00482   return t;
00483 }
00484 
00485 double ***d3tensor(long nrl, long nrh, long ncl, long nch, long ndl, long ndh)
00486 /* allocate a float 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
00487 {
00488   long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
00489   double ***t;
00490 
00491   /* allocate pointers to pointers to rows */
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   /* allocate pointers to rows and set pointers to them */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
00518   return t;
00519 }
00520 
00521 frame_data ***fd3tensor(long nrl, long nrh, long ncl, long nch, long ndl, long ndh)
00522 /* allocate a frame_data 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
00523 {
00524   long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
00525   frame_data ***t;
00526 
00527   /* allocate pointers to pointers to rows */
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   /* allocate pointers to rows and set pointers to them */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
00555   return t;
00556 }
00557 
00558 frame_mask ***fm3tensor(long nrl, long nrh, long ncl, long nch, long ndl, long ndh)
00559 /* allocate a frame_mask 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
00560 {
00561   long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
00562   frame_mask ***t;
00563 
00564   /* allocate pointers to pointers to rows */
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   /* allocate pointers to rows and set pointers to them */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
00592   return t;
00593 }
00594 
00595 unsigned long int ***ul3tensor(long nrl, long nrh, long ncl, long nch, long ndl, long ndh)
00596 /* allocate a frame_mask 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
00597 {
00598   long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
00599   unsigned long int ***t;
00600 
00601   /* allocate pointers to pointers to rows */
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   /* allocate pointers to rows and set pointers to them */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
00631   return t;
00632 }
00633 
00634 long int ***l3tensor(long nrl, long nrh, long ncl, long nch, long ndl, long ndh)
00635 /* allocate a long int 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
00636 {
00637   long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
00638   long int ***t;
00639 
00640   /* allocate pointers to pointers to rows */
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   /* allocate pointers to rows and set pointers to them */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
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 /* allocate a long int 4tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
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   /* allocate pointers to pointers to pointers to rows */
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   /* allocate pointers to pointers to rows and set pointers to them */
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   /* allocate pointers to rows and set pointers to them */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
00724   return t;
00725 }
00726 
00727 void free_vector(float *v, long nl, long nh)
00728 /* free a float vector allocated with vector() */
00729 {
00730   //to remove comp warning: not used
00731   nh=nh;
00732   free((FREE_ARG) (v+nl-NR_END));
00733 }
00734 
00735 void free_ivector(int *v, long nl, long nh)
00736 /* free an int vector allocated with ivector() */
00737 {
00738   //to remove comp warning: not used
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 /* free an unsigned int vector allocated with uivector() */
00745 {
00746   //to remove comp warning: not used
00747   nh=nh;
00748   free((FREE_ARG) (v+nl-NR_END));
00749 }
00750 
00751 void free_cvector(char *v, long nl, long nh)
00752 /* free a char vector allocated with cvector() */
00753 {
00754   //to remove comp warning: not used
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 /* free an unsigned char vector allocated with ucvector() */
00761 {
00762   //to remove comp warning: not used
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 /* free an unsigned long vector allocated with lvector() */
00769 {
00770   //to remove comp warning: not used
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 /* free an unsigned long vector allocated with ulvector() */
00777 {
00778   //to remove comp warning: not used
00779   nh=nh;
00780   free((FREE_ARG) (v+nl-NR_END));
00781 }
00782 
00783 void free_dvector(double *v, long nl, long nh)
00784 /* free a double vector allocated with dvector() */
00785 {
00786   //to remove comp warning: not used
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 /* free a double vector allocated with dvector() */
00793 {
00794   //to remove comp warning: not used
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 /* free a double vector allocated with dvector() */
00801 {
00802   //to remove comp warning: not used
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 /* free a float matrix allocated by matrix() */
00809 { 
00810   //to remove comp warning: not used
00811   nch=nch;  
00812   //to remove comp warning: not used
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 /* free a float matrix allocated by cmatrix() */
00820 {
00821   //to remove comp warning: not used
00822   nch=nch;  
00823   //to remove comp warning: not used
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 /* free a double matrix allocated by dmatrix() */
00831 {
00832   //to remove comp warning: not used
00833   nch=nch;  
00834   //to remove comp warning: not used
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 /* free an int matrix allocated by imatrix() */
00842 {
00843   //to remove comp warning: not used
00844   nch=nch;  
00845   //to remove comp warning: not used
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 /* free an int matrix allocated by imatrix() */
00853 {
00854   //to remove comp warning: not used
00855   nch=nch;  
00856   //to remove comp warning: not used
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 /* free an int matrix allocated by imatrix() */
00864 {
00865   //to remove comp warning: not used
00866   nch=nch;  
00867   //to remove comp warning: not used
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 /* free an frame_data matrix allocated by imatrix() */
00875 {
00876   //to remove comp warning: not used
00877   nch=nch;  
00878   //to remove comp warning: not used
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 /* free an int matrix allocated by imatrix() */
00886 {
00887   //to remove comp warning: not used
00888   nch=nch;  
00889   //to remove comp warning: not used
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 /* free a submatrix allocated by submatrix() */
00897 {
00898   //to remove comp warning: not used
00899   nch=nch;  
00900   //to remove comp warning: not used
00901   nrh=nrh;
00902   //to remove comp warning: not used
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 /* free a matrix allocated by convert_matrix() */
00910 {
00911   //to remove comp warning: not used
00912   nch=nch;  
00913   //to remove comp warning: not used
00914   nrh=nrh;
00915   //to remove comp warning: not used
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 /* free a float f3tensor allocated by f3tensor() */
00923 {
00924   //to remove comp warning: not used
00925   nrh=nrh;
00926   //to remove comp warning: not used
00927   nch=nch;  
00928   //to remove comp warning: not used
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 /* free a double 3tensor allocated by d3tensor() */
00939 {
00940   //to remove comp warning: not used
00941   nrh=nrh;
00942   //to remove comp warning: not used
00943   nch=nch;  
00944   //to remove comp warning: not used
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 /* free a frame_data f3tensor allocated by f3tensor() */
00955 {
00956   //to remove comp warning: not used
00957   nrh=nrh;
00958   //to remove comp warning: not used
00959   nch=nch;  
00960   //to remove comp warning: not used
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 /* free a float f3tensor allocated by f3tensor() */
00970 {
00971   //to remove comp warning: not used
00972   nrh=nrh;
00973   //to remove comp warning: not used
00974   nch=nch;  
00975   //to remove comp warning: not used
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 /* free a float f3tensor allocated by f3tensor() */
00985 {
00986   //to remove comp warning: not used
00987   nrh=nrh;
00988   //to remove comp warning: not used
00989   nch=nch;  
00990   //to remove comp warning: not used
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 /* free a float f3tensor allocated by f3tensor() */
01001 {
01002   //to remove comp warning: not used
01003   nrh=nrh;
01004   //to remove comp warning: not used
01005   nch=nch;  
01006   //to remove comp warning: not used
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 /* free an integer l4tensor allocated by f3tensor() */
01016 {
01017   //to remove comp warning: not used
01018   nah=nah;
01019   //to remove comp warning: not used
01020   nrh=nrh;
01021   //to remove comp warning: not used
01022   nch=nch;  
01023   //to remove comp warning: not used
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   /* Put in C the matrix product of A and B (in this order please!) */ 
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   /* Put in A the matrix sum of A and B */ 
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 /* ANSI */
01083 /* traditional - K&R */
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 /* Numerical Recipes standard error handler */
01093 {
01094   /*
01095     ---------- Let's comment out the non-MIDAS compliant items----------
01096  
01097     fprintf(stderr,"Numerical Recipes run-time error...\n");
01098     fprintf(stderr,"%s\n",error_text);
01099     fprintf(stderr,"...now exiting to system...\n");
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      /* allocate a float vector with subscript range v[nl..nh] */
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      /* allocate an int vector with subscript range v[nl..nh] */
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      /* allocate an int vector with subscript range v[nl..nh] */
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      /* allocate a char vector with subscript range v[nl..nh] */
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      /* allocate an unsigned char vector with subscript range v[nl..nh] */
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      /* allocate an unsigned long vector with subscript range v[nl..nh] */
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      /* allocate an unsigned long vector with subscript range v[nl..nh] */
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      /* allocate a double vector with subscript range v[nl..nh] */
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      /* allocate a frame_data vector with subscript range v[nl..nh] */
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      /* allocate a frame_mask vector with subscript range v[nl..nh] */
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      /* allocate a float matrix with subscript range m[nrl..nrh][ncl..nch] */
01231 {
01232   long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
01233   float **m;
01234 
01235   /* allocate pointers to rows */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
01251   return m;
01252 }
01253 
01254 char **cmatrix(nrl,nrh,ncl,nch)
01255      long nch,ncl,nrh,nrl;
01256      /* allocate a float matrix with subscript range m[nrl..nrh][ncl..nch] */
01257 {
01258   long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
01259   char **m;
01260 
01261   /* allocate pointers to rows */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
01277   return m;
01278 }
01279 
01280 double **dmatrix(nrl,nrh,ncl,nch)
01281      long nch,ncl,nrh,nrl;
01282      /* allocate a double matrix with subscript range m[nrl..nrh][ncl..nch] */
01283 {
01284   long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
01285   double **m;
01286 
01287   /* allocate pointers to rows */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
01303   return m;
01304 }
01305 
01306 int **imatrix(nrl,nrh,ncl,nch)
01307      long nch,ncl,nrh,nrl;
01308      /* allocate a int matrix with subscript range m[nrl..nrh][ncl..nch] */
01309 {
01310   long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
01311   int **m;
01312 
01313   /* allocate pointers to rows */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
01329   return m;
01330 }
01331 
01332 unsigned long int **ulmatrix(nrl,nrh,ncl,nch)
01333      long nch,ncl,nrh,nrl;
01334      /* allocate a int matrix with subscript range m[nrl..nrh][ncl..nch] */
01335 {
01336   long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
01337   unsigned long int **m;
01338 
01339   /* allocate pointers to rows */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
01357   return m;
01358 }
01359 
01360 long int **lmatrix(nrl,nrh,ncl,nch)
01361      long nch,ncl,nrh,nrl;
01362      /* allocate a int matrix with subscript range m[nrl..nrh][ncl..nch] */
01363 {
01364   long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
01365   long int **m;
01366 
01367   /* allocate pointers to rows */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
01384   return m;
01385 }
01386 
01387 frame_data **fdmatrix(nrl,nrh,ncl,nch)
01388      long nch,ncl,nrh,nrl;
01389      /* allocate a frame_data matrix with subscript range m[nrl..nrh][ncl..nch] */
01390 {
01391   long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
01392   frame_data **m;
01393 
01394   /* allocate pointers to rows */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
01412   return m;
01413 }
01414 
01415 frame_mask **fmmatrix(nrl,nrh,ncl,nch)
01416      long nch,ncl,nrh,nrl;
01417      /* allocate a frame_mask matrix with subscript range m[nrl..nrh][ncl..nch] */
01418 {
01419   long i, nrow=nrh-nrl+1,ncol=nch-ncl+1;
01420   frame_mask **m;
01421 
01422   /* allocate pointers to rows */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
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      /* point a submatrix [newrl..][newcl..] to a[oldrl..oldrh][oldcl..oldch] */
01447 {
01448   long i,j,nrow=oldrh-oldrl+1,ncol=oldcl-newcl;
01449   float **m;
01450 
01451   /* allocate array of pointers to rows */
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   /* set pointers to rows */
01458   for(i=oldrl,j=newrl;i<=oldrh;i++,j++) m[j]=a[i]+ncol;
01459 
01460   /* return pointer to array of pointers to rows */
01461   return m;
01462 }
01463 
01464 float **convert_matrix(a,nrl,nrh,ncl,nch)
01465      float *a;
01466      long nch,ncl,nrh,nrl;
01467      /* allocate a float matrix m[nrl..nrh][ncl..nch] that points to the matrix
01468     declared in the standard C manner as a[nrow][ncol], where nrow=nrh-nrl+1
01469     and ncol=nch-ncl+1. The routine should be called with the address
01470     &a[0][0] as the first argument. */
01471 {
01472   long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1;
01473   float **m;
01474 
01475   /* allocate pointers to rows */
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   /* set pointers to rows */
01482   m[nrl]=a-ncl;
01483   for(i=1,j=nrl+1;i<nrow;i++,j++) m[j]=m[j-1]+ncol;
01484   /* return pointer to array of pointers to rows */
01485   return m;
01486 }
01487 
01488 float ***f3tensor(nrl,nrh,ncl,nch,ndl,ndh)
01489      long nch,ncl,ndh,ndl,nrh,nrl;
01490      /* allocate a float 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
01491 {
01492   long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
01493   float ***t;
01494 
01495   /* allocate pointers to pointers to rows */
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   /* allocate pointers to rows and set pointers to them */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
01523   return t;
01524 }
01525 
01526 frame_data ***fd3tensor(nrl,nrh,ncl,nch,ndl,ndh)
01527      long nch,ncl,ndh,ndl,nrh,nrl;
01528      /* allocate a frame_data 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
01529 {
01530   long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
01531   frame_data ***t;
01532 
01533   /* allocate pointers to pointers to rows */
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   /* allocate pointers to rows and set pointers to them */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
01563   return t;
01564 }
01565 
01566 double ***d3tensor(nrl,nrh,ncl,nch,ndl,ndh)
01567      long nch,ncl,ndh,ndl,nrh,nrl;
01568      /* allocate a double 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
01569 {
01570   long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
01571   double ***t;
01572 
01573   /* allocate pointers to pointers to rows */
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   /* allocate pointers to rows and set pointers to them */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
01601   return t;
01602 }
01603 
01604 frame_data ***fd3tensor(nrl,nrh,ncl,nch,ndl,ndh)
01605      long nch,ncl,ndh,ndl,nrh,nrl;
01606      /* allocate a frame_data 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
01607 {
01608   long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
01609   frame_data ***t;
01610 
01611   /* allocate pointers to pointers to rows */
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   /* allocate pointers to rows and set pointers to them */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
01641   return t;
01642 }
01643 
01644 frame_mask ***fm3tensor(nrl,nrh,ncl,nch,ndl,ndh)
01645      long nch,ncl,ndh,ndl,nrh,nrl;
01646      /* allocate a frame_mask 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
01647 {
01648   long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
01649   frame_mask ***t;
01650 
01651   /* allocate pointers to pointers to rows */
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   /* allocate pointers to rows and set pointers to them */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
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      /* allocate a frame_mask 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
01687 {
01688   long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
01689   unsigned long int ***t;
01690 
01691   /* allocate pointers to pointers to rows */
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   /* allocate pointers to rows and set pointers to them */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
01721   return t;
01722 }
01723 
01724 long int ***l3tensor(nrl,nrh,ncl,nch,ndl,ndh)
01725      long nch,ncl,ndh,ndl,nrh,nrl;
01726      /* allocate a long int 3tensor with range t[nrl..nrh][ncl..nch][ndl..ndh] */
01727 {
01728   long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1,ndep=ndh-ndl+1;
01729   long int ***t;
01730 
01731   /* allocate pointers to pointers to rows */
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   /* allocate pointers to rows and set pointers to them */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
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      /* allocate a long int 4tensor with range 
01766     t[nal..nah][nrl..nrh][ncl..nch][ndl..ndh] */
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   /* allocate pointers to pointers to rows */
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   /* allocate pointers to pointers to rows and set pointers to them */
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   /* allocate pointers to rows and set pointers to them */
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   /* allocate rows and set pointers to them */
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   /* return pointer to array of pointers to rows */
01819   return t;
01820 }
01821 
01822 void free_vector(v,nl,nh)
01823      float *v;
01824      long nh,nl;
01825      /* free a float vector allocated with vector() */
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      /* free an int vector allocated with ivector() */
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      /* free an int vector allocated with uivector() */
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      /* free a char vector allocated with cvector() */
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      /* free a char vector allocated with ucvector() */
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      /* free an unsigned long vector allocated with lvector() */
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      /* free an unsigned long vector allocated with ulvector() */
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      /* free a double vector allocated with dvector() */
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      /* free a frame_data vector allocated with dvector() */
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      /* free a double vector allocated with dvector() */
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      /* free a float matrix allocated by matrix() */
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      /* free a char matrix allocated by cmatrix() */
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      /* free a double matrix allocated by dmatrix() */
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      /* free an int matrix allocated by imatrix() */
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      /* free an int matrix allocated by imatrix() */
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      /* free an int matrix allocated by imatrix() */
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      /* free a frame_data matrix allocated by imatrix() */
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      /* free a frame_mask matrix allocated by imatrix() */
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      /* free a submatrix allocated by submatrix() */
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      /* free a matrix allocated by convert_matrix() */
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      /* free a float f3tensor allocated by f3tensor() */
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      /* free a double 3tensor allocated by d3tensor() */
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      /* free a frame_data f3tensor allocated by f3tensor() */
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      /* free a float f3tensor allocated by f3tensor() */
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      /* free a float f3tensor allocated by f3tensor() */
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      /* free a float f3tensor allocated by f3tensor() */
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      /* free a long l4tensor allocated by l4tensor() */
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 /* ANSI */

Generated on 9 Mar 2012 for UVES Pipeline Reference Manual by  doxygen 1.6.1