PageRenderTime 500ms CodeModel.GetById 91ms app.highlight 240ms RepoModel.GetById 112ms app.codeStats 0ms

/src/mesch/zmemory.c

https://bitbucket.org/ramcdougal/neuronrxd
C | 714 lines | 469 code | 130 blank | 115 comment | 114 complexity | a42b0b16b460c0356e8b9bcfd2df272c MD5 | raw file
  1#include <../../nrnconf.h>
  2
  3/**************************************************************************
  4**
  5** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved.
  6**
  7**			     Meschach Library
  8** 
  9** This Meschach Library is provided "as is" without any express 
 10** or implied warranty of any kind with respect to this software. 
 11** In particular the authors shall not be liable for any direct, 
 12** indirect, special, incidental or consequential damages arising 
 13** in any way from use of the software.
 14** 
 15** Everyone is granted permission to copy, modify and redistribute this
 16** Meschach Library, provided:
 17**  1.  All copies contain this copyright notice.
 18**  2.  All modified copies shall carry a notice stating who
 19**      made the last modification and the date of such modification.
 20**  3.  No charge is made for this software or works derived from it.  
 21**      This clause shall not be construed as constraining other software
 22**      distributed on the same medium as this software, nor is a
 23**      distribution fee considered a charge.
 24**
 25***************************************************************************/
 26
 27
 28/* Memory allocation and de-allocation for complex matrices and vectors */
 29
 30#include	<stdio.h>
 31#include	"zmatrix.h"
 32
 33static	char	rcsid[] = "zmemory.c,v 1.1 1997/12/04 17:56:13 hines Exp";
 34
 35
 36
 37/* zv_zero -- zeros all entries of a complex vector
 38   -- uses __zzero__() */
 39ZVEC	*zv_zero(x)
 40ZVEC	*x;
 41{
 42   if ( ! x )
 43     error(E_NULL,"zv_zero");
 44   __zzero__(x->ve,x->dim);
 45   
 46   return x;
 47}
 48
 49/* zm_zero -- zeros all entries of a complex matrix
 50   -- uses __zzero__() */
 51ZMAT	*zm_zero(A)
 52ZMAT	*A;
 53{
 54   int		i;
 55   
 56   if ( ! A )
 57     error(E_NULL,"zm_zero");
 58   for ( i = 0; i < A->m; i++ )
 59     __zzero__(A->me[i],A->n);
 60   
 61   return A;
 62}
 63
 64/* zm_get -- gets an mxn complex matrix (in ZMAT form) */
 65ZMAT	*zm_get(m,n)
 66int	m,n;
 67{
 68   ZMAT	*matrix;
 69   u_int	i;
 70   
 71   if (m < 0 || n < 0)
 72     error(E_NEG,"zm_get");
 73
 74   if ((matrix=NEW(ZMAT)) == (ZMAT *)NULL )
 75     error(E_MEM,"zm_get");
 76   else if (mem_info_is_on()) {
 77      mem_bytes(TYPE_ZMAT,0,sizeof(ZMAT));
 78      mem_numvar(TYPE_ZMAT,1);
 79   }
 80   
 81   matrix->m = m;		matrix->n = matrix->max_n = n;
 82   matrix->max_m = m;	matrix->max_size = m*n;
 83#ifndef SEGMENTED
 84   if ((matrix->base = NEW_A(m*n,complex)) == (complex *)NULL )
 85   {
 86      free(matrix);
 87      error(E_MEM,"zm_get");
 88   }
 89   else if (mem_info_is_on()) {
 90      mem_bytes(TYPE_ZMAT,0,m*n*sizeof(complex));
 91   }
 92#else
 93   matrix->base = (complex *)NULL;
 94#endif
 95   if ((matrix->me = (complex **)calloc(m,sizeof(complex *))) == 
 96       (complex **)NULL )
 97   {	free(matrix->base);	free(matrix);
 98	error(E_MEM,"zm_get");
 99     }
100   else if (mem_info_is_on()) {
101      mem_bytes(TYPE_ZMAT,0,m*sizeof(complex *));
102   }
103#ifndef SEGMENTED
104   /* set up pointers */
105   for ( i=0; i<m; i++ )
106     matrix->me[i] = &(matrix->base[i*n]);
107#else
108   for ( i = 0; i < m; i++ )
109     if ( (matrix->me[i]=NEW_A(n,complex)) == (complex *)NULL )
110       error(E_MEM,"zm_get");
111     else if (mem_info_is_on()) {
112	mem_bytes(TYPE_ZMAT,0,n*sizeof(complex));
113     }
114#endif
115   
116   return (matrix);
117}
118
119
120/* zv_get -- gets a ZVEC of dimension 'dim'
121   -- Note: initialized to zero */
122ZVEC	*zv_get(size)
123int	size;
124{
125   ZVEC	*vector;
126
127   if (size < 0)
128     error(E_NEG,"zv_get");
129
130   if ((vector=NEW(ZVEC)) == (ZVEC *)NULL )
131     error(E_MEM,"zv_get");
132   else if (mem_info_is_on()) {
133      mem_bytes(TYPE_ZVEC,0,sizeof(ZVEC));
134      mem_numvar(TYPE_ZVEC,1);
135   }
136   vector->dim = vector->max_dim = size;
137   if ((vector->ve=NEW_A(size,complex)) == (complex *)NULL )
138   {
139      free(vector);
140      error(E_MEM,"zv_get");
141   }
142   else if (mem_info_is_on()) {
143      mem_bytes(TYPE_ZVEC,0,size*sizeof(complex));
144   }
145   return (vector);
146}
147
148/* zm_free -- returns ZMAT & asoociated memory back to memory heap */
149int	zm_free(mat)
150ZMAT	*mat;
151{
152#ifdef SEGMENTED
153   int	i;
154#endif
155   
156   if ( mat==(ZMAT *)NULL || (int)(mat->m) < 0 ||
157       (int)(mat->n) < 0 )
158     /* don't trust it */
159     return (-1);
160   
161#ifndef SEGMENTED
162   if ( mat->base != (complex *)NULL ) {
163      if (mem_info_is_on()) {
164	 mem_bytes(TYPE_ZMAT,mat->max_m*mat->max_n*sizeof(complex),0);
165      }	   
166      free((char *)(mat->base));
167   }
168#else
169   for ( i = 0; i < mat->max_m; i++ )
170     if ( mat->me[i] != (complex *)NULL ) {
171	if (mem_info_is_on()) {
172	   mem_bytes(TYPE_ZMAT,mat->max_n*sizeof(complex),0);
173	}
174	free((char *)(mat->me[i]));
175     }
176#endif
177   if ( mat->me != (complex **)NULL ) {
178      if (mem_info_is_on()) {
179	 mem_bytes(TYPE_ZMAT,mat->max_m*sizeof(complex *),0);
180      }	   
181      free((char *)(mat->me));
182   }
183   
184   if (mem_info_is_on()) {
185      mem_bytes(TYPE_ZMAT,sizeof(ZMAT),0);
186      mem_numvar(TYPE_ZMAT,-1);
187   }
188   free((char *)mat);
189   
190   return (0);
191}
192
193
194/* zv_free -- returns ZVEC & asoociated memory back to memory heap */
195int	zv_free(vec)
196ZVEC	*vec;
197{
198   if ( vec==(ZVEC *)NULL || (int)(vec->dim) < 0 )
199     /* don't trust it */
200     return (-1);
201   
202   if ( vec->ve == (complex *)NULL ) {
203      if (mem_info_is_on()) {
204	 mem_bytes(TYPE_ZVEC,sizeof(ZVEC),0);
205	 mem_numvar(TYPE_ZVEC,-1);
206      }
207      free((char *)vec);
208   }
209   else
210   {
211      if (mem_info_is_on()) {
212	 mem_bytes(TYPE_ZVEC,vec->max_dim*sizeof(complex)+
213		      sizeof(ZVEC),0);
214	 mem_numvar(TYPE_ZVEC,-1);
215      }
216      
217      free((char *)vec->ve);
218      free((char *)vec);
219   }
220   
221   return (0);
222}
223
224
225/* zm_resize -- returns the matrix A of size new_m x new_n; A is zeroed
226   -- if A == NULL on entry then the effect is equivalent to m_get() */
227ZMAT	*zm_resize(A,new_m,new_n)
228ZMAT	*A;
229int	new_m, new_n;
230{
231   u_int	i, new_max_m, new_max_n, new_size, old_m, old_n;
232   
233   if (new_m < 0 || new_n < 0)
234     error(E_NEG,"zm_resize");
235
236   if ( ! A )
237     return zm_get(new_m,new_n);
238   
239   if (new_m == A->m && new_n == A->n)
240     return A;
241
242   old_m = A->m;	old_n = A->n;
243   if ( new_m > A->max_m )
244   {	/* re-allocate A->me */
245      if (mem_info_is_on()) {
246	 mem_bytes(TYPE_ZMAT,A->max_m*sizeof(complex *),
247		      new_m*sizeof(complex *));
248      }
249
250      A->me = RENEW(A->me,new_m,complex *);
251      if ( ! A->me )
252	error(E_MEM,"zm_resize");
253   }
254   new_max_m = max(new_m,A->max_m);
255   new_max_n = max(new_n,A->max_n);
256   
257#ifndef SEGMENTED
258   new_size = new_max_m*new_max_n;
259   if ( new_size > A->max_size )
260   {	/* re-allocate A->base */
261      if (mem_info_is_on()) {
262	 mem_bytes(TYPE_ZMAT,A->max_m*A->max_n*sizeof(complex),
263		new_size*sizeof(complex));      
264      }
265
266      A->base = RENEW(A->base,new_size,complex);
267      if ( ! A->base )
268	error(E_MEM,"zm_resize");
269      A->max_size = new_size;
270   }
271   
272   /* now set up A->me[i] */
273   for ( i = 0; i < new_m; i++ )
274     A->me[i] = &(A->base[i*new_n]);
275   
276   /* now shift data in matrix */
277   if ( old_n > new_n )
278   {
279      for ( i = 1; i < min(old_m,new_m); i++ )
280	MEM_COPY((char *)&(A->base[i*old_n]),
281		 (char *)&(A->base[i*new_n]),
282		 sizeof(complex)*new_n);
283   }
284   else if ( old_n < new_n )
285   {
286      for ( i = min(old_m,new_m)-1; i > 0; i-- )
287      {   /* copy & then zero extra space */
288	 MEM_COPY((char *)&(A->base[i*old_n]),
289		  (char *)&(A->base[i*new_n]),
290		  sizeof(complex)*old_n);
291	 __zzero__(&(A->base[i*new_n+old_n]),(new_n-old_n));
292      }
293      __zzero__(&(A->base[old_n]),(new_n-old_n));
294      A->max_n = new_n;
295   }
296   /* zero out the new rows.. */
297   for ( i = old_m; i < new_m; i++ )
298     __zzero__(&(A->base[i*new_n]),new_n);
299#else
300   if ( A->max_n < new_n )
301   {
302      complex	*tmp;
303      
304      for ( i = 0; i < A->max_m; i++ )
305      {
306	 if (mem_info_is_on()) {
307	    mem_bytes(TYPE_ZMAT,A->max_n*sizeof(complex),
308			 new_max_n*sizeof(complex));
309	 }
310
311	 if ( (tmp = RENEW(A->me[i],new_max_n,complex)) == NULL )
312	   error(E_MEM,"zm_resize");
313	 else {
314	    A->me[i] = tmp;
315	 }
316      }
317      for ( i = A->max_m; i < new_max_m; i++ )
318      {
319	 if ( (tmp = NEW_A(new_max_n,complex)) == NULL )
320	   error(E_MEM,"zm_resize");
321	 else {
322	    A->me[i] = tmp;
323	    if (mem_info_is_on()) {
324	       mem_bytes(TYPE_ZMAT,0,new_max_n*sizeof(complex));
325	    }
326	 }
327      }
328   }
329   else if ( A->max_m < new_m )
330   {
331      for ( i = A->max_m; i < new_m; i++ )
332	if ( (A->me[i] = NEW_A(new_max_n,complex)) == NULL )
333	  error(E_MEM,"zm_resize");
334	else if (mem_info_is_on()) {
335	   mem_bytes(TYPE_ZMAT,0,new_max_n*sizeof(complex));
336	}
337      
338   }
339   
340   if ( old_n < new_n )
341   {
342      for ( i = 0; i < old_m; i++ )
343	__zzero__(&(A->me[i][old_n]),new_n-old_n);
344   }
345   
346   /* zero out the new rows.. */
347   for ( i = old_m; i < new_m; i++ )
348     __zzero__(A->me[i],new_n);
349#endif
350   
351   A->max_m = new_max_m;
352   A->max_n = new_max_n;
353   A->max_size = A->max_m*A->max_n;
354   A->m = new_m;	A->n = new_n;
355   
356   return A;
357}
358
359
360/* zv_resize -- returns the (complex) vector x with dim new_dim
361   -- x is set to the zero vector */
362ZVEC	*zv_resize(x,new_dim)
363ZVEC	*x;
364int	new_dim;
365{
366   if (new_dim < 0)
367     error(E_NEG,"zv_resize");
368
369   if ( ! x )
370     return zv_get(new_dim);
371
372   if (new_dim == x->dim)
373     return x;
374
375   if ( x->max_dim == 0 )	/* assume that it's from sub_zvec */
376     return zv_get(new_dim);
377   
378   if ( new_dim > x->max_dim )
379   {
380      if (mem_info_is_on()) { 
381	 mem_bytes(TYPE_ZVEC,x->max_dim*sizeof(complex),
382		      new_dim*sizeof(complex));
383      }
384
385      x->ve = RENEW(x->ve,new_dim,complex);
386      if ( ! x->ve )
387	error(E_MEM,"zv_resize");
388      x->max_dim = new_dim;
389   }
390   
391   if ( new_dim > x->dim )
392     __zzero__(&(x->ve[x->dim]),new_dim - x->dim);
393   x->dim = new_dim;
394   
395   return x;
396}
397
398
399/* varying arguments */
400
401#ifdef ANSI_C
402
403#include <stdarg.h>
404
405
406/* To allocate memory to many arguments. 
407   The function should be called:
408   zv_get_vars(dim,&x,&y,&z,...,NULL);
409   where 
410     int dim;
411     ZVEC *x, *y, *z,...;
412     The last argument should be NULL ! 
413     dim is the length of vectors x,y,z,...
414     returned value is equal to the number of allocated variables
415     Other gec_... functions are similar.
416*/
417
418int zv_get_vars(int dim,...) 
419{
420   va_list ap;
421   int i=0;
422   ZVEC **par;
423   
424   va_start(ap, dim);
425   while ((par = va_arg(ap,ZVEC **))) {   /* NULL ends the list*/
426      *par = zv_get(dim);
427      i++;
428   } 
429
430   va_end(ap);
431   return i;
432}
433
434
435
436int zm_get_vars(int m,int n,...) 
437{
438   va_list ap;
439   int i=0;
440   ZMAT **par;
441   
442   va_start(ap, n);
443   while ((par = va_arg(ap,ZMAT **))) {   /* NULL ends the list*/
444      *par = zm_get(m,n);
445      i++;
446   } 
447
448   va_end(ap);
449   return i;
450}
451
452
453
454/* To resize memory for many arguments. 
455   The function should be called:
456   v_resize_vars(new_dim,&x,&y,&z,...,NULL);
457   where 
458     int new_dim;
459     ZVEC *x, *y, *z,...;
460     The last argument should be NULL ! 
461     rdim is the resized length of vectors x,y,z,...
462     returned value is equal to the number of allocated variables.
463     If one of x,y,z,.. arguments is NULL then memory is allocated to this 
464     argument. 
465     Other *_resize_list() functions are similar.
466*/
467
468int zv_resize_vars(int new_dim,...)
469{
470   va_list ap;
471   int i=0;
472   ZVEC **par;
473   
474   va_start(ap, new_dim);
475   while ((par = va_arg(ap,ZVEC **))) {   /* NULL ends the list*/
476      *par = zv_resize(*par,new_dim);
477      i++;
478   } 
479
480   va_end(ap);
481   return i;
482}
483
484
485
486int zm_resize_vars(int m,int n,...) 
487{
488   va_list ap;
489   int i=0;
490   ZMAT **par;
491   
492   va_start(ap, n);
493   while ((par = va_arg(ap,ZMAT **))) {   /* NULL ends the list*/
494      *par = zm_resize(*par,m,n);
495      i++;
496   } 
497
498   va_end(ap);
499   return i;
500}
501
502
503/* To deallocate memory for many arguments. 
504   The function should be called:
505   v_free_vars(&x,&y,&z,...,NULL);
506   where 
507     ZVEC *x, *y, *z,...;
508     The last argument should be NULL ! 
509     There must be at least one not NULL argument.
510     returned value is equal to the number of allocated variables.
511     Returned value of x,y,z,.. is VNULL.
512     Other *_free_list() functions are similar.
513*/
514
515int zv_free_vars(ZVEC **pv,...)
516{
517   va_list ap;
518   int i=1;
519   ZVEC **par;
520   
521   zv_free(*pv);
522   *pv = ZVNULL;
523   va_start(ap, pv);
524   while ((par = va_arg(ap,ZVEC **))) {   /* NULL ends the list*/
525      zv_free(*par); 
526      *par = ZVNULL;
527      i++;
528   } 
529
530   va_end(ap);
531   return i;
532}
533
534
535
536int zm_free_vars(ZMAT **va,...)
537{
538   va_list ap;
539   int i=1;
540   ZMAT **par;
541   
542   zm_free(*va);
543   *va = ZMNULL;
544   va_start(ap, va);
545   while ((par = va_arg(ap,ZMAT **))) {   /* NULL ends the list*/
546      zm_free(*par); 
547      *par = ZMNULL;
548      i++;
549   } 
550
551   va_end(ap);
552   return i;
553}
554
555
556
557#elif VARARGS
558
559#include <varargs.h>
560
561/* To allocate memory to many arguments. 
562   The function should be called:
563   v_get_vars(dim,&x,&y,&z,...,NULL);
564   where 
565     int dim;
566     ZVEC *x, *y, *z,...;
567     The last argument should be NULL ! 
568     dim is the length of vectors x,y,z,...
569     returned value is equal to the number of allocated variables
570     Other gec_... functions are similar.
571*/
572
573int zv_get_vars(va_alist) va_dcl
574{
575   va_list ap;
576   int dim,i=0;
577   ZVEC **par;
578   
579   va_start(ap);
580   dim = va_arg(ap,int);
581   while ((par = va_arg(ap,ZVEC **))) {   /* NULL ends the list*/
582      *par = zv_get(dim);
583      i++;
584   } 
585
586   va_end(ap);
587   return i;
588}
589
590
591
592int zm_get_vars(va_alist) va_dcl
593{
594   va_list ap;
595   int i=0, n, m;
596   ZMAT **par;
597   
598   va_start(ap);
599   m = va_arg(ap,int);
600   n = va_arg(ap,int);
601   while ((par = va_arg(ap,ZMAT **))) {   /* NULL ends the list*/
602      *par = zm_get(m,n);
603      i++;
604   } 
605
606   va_end(ap);
607   return i;
608}
609
610
611
612/* To resize memory for many arguments. 
613   The function should be called:
614   v_resize_vars(new_dim,&x,&y,&z,...,NULL);
615   where 
616     int new_dim;
617     ZVEC *x, *y, *z,...;
618     The last argument should be NULL ! 
619     rdim is the resized length of vectors x,y,z,...
620     returned value is equal to the number of allocated variables.
621     If one of x,y,z,.. arguments is NULL then memory is allocated to this 
622     argument. 
623     Other *_resize_list() functions are similar.
624*/
625
626int zv_resize_vars(va_alist) va_dcl
627{
628   va_list ap;
629   int i=0, new_dim;
630   ZVEC **par;
631   
632   va_start(ap);
633   new_dim = va_arg(ap,int);
634   while ((par = va_arg(ap,ZVEC **))) {   /* NULL ends the list*/
635      *par = zv_resize(*par,new_dim);
636      i++;
637   } 
638
639   va_end(ap);
640   return i;
641}
642
643
644int zm_resize_vars(va_alist) va_dcl
645{
646   va_list ap;
647   int i=0, m, n;
648   ZMAT **par;
649   
650   va_start(ap);
651   m = va_arg(ap,int);
652   n = va_arg(ap,int);
653   while ((par = va_arg(ap,ZMAT **))) {   /* NULL ends the list*/
654      *par = zm_resize(*par,m,n);
655      i++;
656   } 
657
658   va_end(ap);
659   return i;
660}
661
662
663
664/* To deallocate memory for many arguments. 
665   The function should be called:
666   v_free_vars(&x,&y,&z,...,NULL);
667   where 
668     ZVEC *x, *y, *z,...;
669     The last argument should be NULL ! 
670     There must be at least one not NULL argument.
671     returned value is equal to the number of allocated variables.
672     Returned value of x,y,z,.. is VNULL.
673     Other *_free_list() functions are similar.
674*/
675
676int zv_free_vars(va_alist) va_dcl
677{
678   va_list ap;
679   int i=0;
680   ZVEC **par;
681   
682   va_start(ap);
683   while ((par = va_arg(ap,ZVEC **))) {   /* NULL ends the list*/
684      zv_free(*par); 
685      *par = ZVNULL;
686      i++;
687   } 
688
689   va_end(ap);
690   return i;
691}
692
693
694
695int zm_free_vars(va_alist) va_dcl
696{
697   va_list ap;
698   int i=0;
699   ZMAT **par;
700   
701   va_start(ap);
702   while ((par = va_arg(ap,ZMAT **))) {   /* NULL ends the list*/
703      zm_free(*par); 
704      *par = ZMNULL;
705      i++;
706   } 
707
708   va_end(ap);
709   return i;
710}
711
712
713#endif
714