htswanalysis/MACS/lib/gsl/gsl-1.11/vector/init_source.c

   1 /* vector/init_source.c
   2  *
   3  * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2007 Gerard Jungman, Brian Gough
   4  *
   5  * This program is free software; you can redistribute it and/or modify
   6  * it under the terms of the GNU General Public License as published by
   7  * the Free Software Foundation; either version 3 of the License, or (at
   8  * your option) any later version.
   9  *
  10  * This program is distributed in the hope that it will be useful, but
  11  * WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13  * General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License
  16  * along with this program; if not, write to the Free Software
  17  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  18  */
  19
  20 TYPE (gsl_vector) *
  21 FUNCTION (gsl_vector, alloc) (const size_t n)
  22 {
  23   TYPE (gsl_block) * block;
  24   TYPE (gsl_vector) * v;
  25
  26   if (n == 0)
  27     {
  28       GSL_ERROR_VAL ("vector length n must be positive integer",
  29                         GSL_EINVAL, 0);
  30     }
  31
  32   v = (TYPE (gsl_vector) *) malloc (sizeof (TYPE (gsl_vector)));
  33
  34   if (v == 0)
  35     {
  36       GSL_ERROR_VAL ("failed to allocate space for vector struct",
  37                         GSL_ENOMEM, 0);
  38     }
  39
  40   block = FUNCTION (gsl_block,alloc) (n);
  41
  42   if (block == 0)
  43     {
  44       free (v) ;
  45
  46       GSL_ERROR_VAL ("failed to allocate space for block",
  47                         GSL_ENOMEM, 0);
  48     }
  49
  50   v->data = block->data ;
  51   v->size = n;
  52   v->stride = 1;
  53   v->block = block;
  54   v->owner = 1;
  55
  56   return v;
  57 }
  58
  59 TYPE (gsl_vector) *
  60 FUNCTION (gsl_vector, calloc) (const size_t n)
  61 {
  62   size_t i;
  63
  64   TYPE (gsl_vector) * v = FUNCTION (gsl_vector, alloc) (n);
  65
  66   if (v == 0)
  67     return 0;
  68
  69   /* initialize vector to zero */
  70
  71   for (i = 0; i < MULTIPLICITY * n; i++)
  72     {
  73       v->data[i] = 0;
  74     }
  75
  76   return v;
  77 }
  78
  79 TYPE (gsl_vector) *
  80 FUNCTION (gsl_vector, alloc_from_block) (TYPE(gsl_block) * block,
  81                                          const size_t offset,
  82                                          const size_t n,
  83                                          const size_t stride)
  84 {
  85   TYPE (gsl_vector) * v;
  86
  87   if (n == 0)
  88     {
  89       GSL_ERROR_VAL ("vector length n must be positive integer",
  90                         GSL_EINVAL, 0);
  91     }
  92
  93   if (stride == 0)
  94     {
  95       GSL_ERROR_VAL ("stride must be positive integer", GSL_EINVAL, 0);
  96     }
  97
  98   if (block->size <= offset + (n - 1) * stride)
  99     {
 100       GSL_ERROR_VAL ("vector would extend past end of block", GSL_EINVAL, 0);
 101     }
 102
 103   v = (TYPE (gsl_vector) *) malloc (sizeof (TYPE (gsl_vector)));
 104
 105   if (v == 0)
 106     {
 107       GSL_ERROR_VAL ("failed to allocate space for vector struct",
 108                         GSL_ENOMEM, 0);
 109     }
 110
 111   v->data = block->data + MULTIPLICITY * offset ;
 112   v->size = n;
 113   v->stride = stride;
 114   v->block = block;
 115   v->owner = 0;
 116
 117   return v;
 118 }
 119
 120 TYPE (gsl_vector) *
 121 FUNCTION (gsl_vector, alloc_from_vector) (TYPE(gsl_vector) * w,
 122                                          const size_t offset,
 123                                          const size_t n,
 124                                          const size_t stride)
 125 {
 126   TYPE (gsl_vector) * v;
 127
 128   if (n == 0)
 129     {
 130       GSL_ERROR_VAL ("vector length n must be positive integer",
 131                         GSL_EINVAL, 0);
 132     }
 133
 134   if (stride == 0)
 135     {
 136       GSL_ERROR_VAL ("stride must be positive integer", GSL_EINVAL, 0);
 137     }
 138
 139   if (offset + (n - 1) * stride >= w->size)
 140     {
 141       GSL_ERROR_VAL ("vector would extend past end of block", GSL_EINVAL, 0);
 142     }
 143
 144   v = (TYPE (gsl_vector) *) malloc (sizeof (TYPE (gsl_vector)));
 145
 146   if (v == 0)
 147     {
 148       GSL_ERROR_VAL ("failed to allocate space for vector struct",
 149                         GSL_ENOMEM, 0);
 150     }
 151
 152   v->data = w->data + MULTIPLICITY * w->stride * offset ;
 153   v->size = n;
 154   v->stride = stride * w->stride;
 155   v->block = w->block;
 156   v->owner = 0;
 157
 158   return v;
 159 }
 160
 161
 162 void
 163 FUNCTION (gsl_vector, free) (TYPE (gsl_vector) * v)
 164 {
 165   if (v->owner)
 166     {
 167       FUNCTION(gsl_block, free) (v->block) ;
 168     }
 169   free (v);
 170 }
 171
 172
 173 void
 174 FUNCTION (gsl_vector, set_all) (TYPE (gsl_vector) * v, BASE x)
 175 {
 176   ATOMIC * const data = v->data;
 177   const size_t n = v->size;
 178   const size_t stride = v->stride;
 179
 180   size_t i;
 181
 182   for (i = 0; i < n; i++)
 183     {
 184       *(BASE *) (data + MULTIPLICITY * i * stride) = x;
 185     }
 186 }
 187
 188 void
 189 FUNCTION (gsl_vector, set_zero) (TYPE (gsl_vector) * v)
 190 {
 191   ATOMIC * const data = v->data;
 192   const size_t n = v->size;
 193   const size_t stride = v->stride;
 194   const BASE zero = ZERO ;
 195
 196   size_t i;
 197
 198   for (i = 0; i < n; i++)
 199     {
 200       *(BASE *) (data + MULTIPLICITY * i * stride) = zero;
 201     }
 202 }
 203
 204 int
 205 FUNCTION (gsl_vector, set_basis) (TYPE (gsl_vector) * v, size_t i)
 206 {
 207   ATOMIC * const data = v->data;
 208   const size_t n = v->size;
 209   const size_t stride = v->stride;
 210   const BASE zero = ZERO ;
 211   const BASE one = ONE;
 212
 213   size_t k;
 214
 215   if (i >= n)
 216     {
 217       GSL_ERROR ("index out of range", GSL_EINVAL);
 218     }
 219
 220   for (k = 0; k < n; k++)
 221     {
 222       *(BASE *) (data + MULTIPLICITY * k * stride) = zero;
 223     }
 224
 225   *(BASE *) (data + MULTIPLICITY * i * stride) = one;
 226
 227   return GSL_SUCCESS;
 228 }