← Back to branch summary

~ubuntu-branches/ubuntu/feisty/python-numpy/feisty

« back to all changes in this revision

Viewing changes to numpy/f2py/src/fortranobject.c

  • Committer: Bazaar Package Importer
  • Author(s): Matthias Klose
  • Date: 2006-07-12 10:00:24 UTC
  • Revision ID: james.westby@ubuntu.com-20060712100024-5lw9q2yczlisqcrt
Tags: upstream-0.9.8
Import upstream version 0.9.8

Show diffs side-by-side

added added

removed removed

Lines of Context:
numpy/f2py/src/fortranobject.c
 
1
#define FORTRANOBJECT_C
 
2
#include "fortranobject.h"
 
3
 
 
4
#ifdef __cplusplus
 
5
extern "C" {
 
6
#endif
 
7
/*
 
8
  This file implements: FortranObject, array_from_pyobj, copy_ND_array
 
9
 
 
10
  Author: Pearu Peterson <pearu@cens.ioc.ee>
 
11
  $Revision: 1.52 $
 
12
  $Date: 2005/07/11 07:44:20 $
 
13
*/
 
14
 
 
15
int
 
16
F2PyDict_SetItemString(PyObject *dict, char *name, PyObject *obj) 
 
17
{
 
18
        if (obj==NULL) {
 
19
                fprintf(stderr, "Error loading %s\n", name);
 
20
                if (PyErr_Occurred()) {
 
21
                        PyErr_Print();
 
22
                        PyErr_Clear();
 
23
                }
 
24
                return -1;
 
25
        }
 
26
        return PyDict_SetItemString(dict, name, obj);
 
27
}
 
28
 
 
29
/************************* FortranObject *******************************/
 
30
 
 
31
typedef PyObject *(*fortranfunc)(PyObject *,PyObject *,PyObject *,void *);
 
32
 
 
33
PyObject *
 
34
PyFortranObject_New(FortranDataDef* defs, f2py_void_func init) {
 
35
  int i;
 
36
  PyFortranObject *fp = NULL;
 
37
  PyObject *v = NULL;
 
38
  if (init!=NULL)                           /* Initialize F90 module objects */
 
39
    (*(init))();
 
40
  if ((fp = PyObject_New(PyFortranObject, &PyFortran_Type))==NULL) return NULL;
 
41
  if ((fp->dict = PyDict_New())==NULL) return NULL;
 
42
  fp->len = 0;
 
43
  while (defs[fp->len].name != NULL) fp->len++;
 
44
  if (fp->len == 0) goto fail;
 
45
  fp->defs = defs;
 
46
  for (i=0;i<fp->len;i++)
 
47
    if (fp->defs[i].rank == -1) {                      /* Is Fortran routine */
 
48
      v = PyFortranObject_NewAsAttr(&(fp->defs[i]));
 
49
      if (v==NULL) return NULL;
 
50
      PyDict_SetItemString(fp->dict,fp->defs[i].name,v);
 
51
    } else
 
52
      if ((fp->defs[i].data)!=NULL) { /* Is Fortran variable or array (not allocatable) */
 
53
        if (fp->defs[i].type == PyArray_STRING) { 
 
54
          int n = fp->defs[i].rank-1;
 
55
          v = PyArray_New(&PyArray_Type, n, fp->defs[i].dims.d,
 
56
                          PyArray_STRING, NULL, fp->defs[i].data, fp->defs[i].dims.d[n],
 
57
                          FARRAY_FLAGS, NULL);
 
58
        }
 
59
        else {
 
60
          v = PyArray_New(&PyArray_Type, fp->defs[i].rank, fp->defs[i].dims.d,
 
61
                          fp->defs[i].type, NULL, fp->defs[i].data, 0, FARRAY_FLAGS,
 
62
                          NULL);
 
63
        }
 
64
        if (v==NULL) return NULL;
 
65
        PyDict_SetItemString(fp->dict,fp->defs[i].name,v);
 
66
      }
 
67
  Py_XDECREF(v);
 
68
  return (PyObject *)fp;
 
69
 fail:
 
70
  Py_XDECREF(v);
 
71
  return NULL;
 
72
}
 
73
 
 
74
PyObject *
 
75
PyFortranObject_NewAsAttr(FortranDataDef* defs) { /* used for calling F90 module routines */
 
76
  PyFortranObject *fp = NULL;
 
77
  fp = PyObject_New(PyFortranObject, &PyFortran_Type);
 
78
  if (fp == NULL) return NULL;
 
79
  if ((fp->dict = PyDict_New())==NULL) return NULL;
 
80
  fp->len = 1;
 
81
  fp->defs = defs;
 
82
  return (PyObject *)fp;
 
83
}
 
84
 
 
85
/* Fortran methods */
 
86
 
 
87
static void
 
88
fortran_dealloc(PyFortranObject *fp) {
 
89
  Py_XDECREF(fp->dict);
 
90
  PyMem_Del(fp);
 
91
}
 
92
 
 
93
 
 
94
static PyMethodDef fortran_methods[] = {
 
95
        {NULL,          NULL}           /* sentinel */
 
96
};
 
97
 
 
98
 
 
99
static PyObject *
 
100
fortran_doc (FortranDataDef def) {
 
101
  char *p;
 
102
  PyObject *s = NULL;
 
103
  int i;
 
104
  unsigned size=100;
 
105
  if (def.doc!=NULL)
 
106
    size += strlen(def.doc);
 
107
  p = (char*)malloc (size);
 
108
  if (sprintf(p,"%s - ",def.name)==0) goto fail;
 
109
  if (def.rank==-1) {
 
110
    if (def.doc==NULL) {
 
111
      if (sprintf(p,"%sno docs available",p)==0)
 
112
        goto fail;
 
113
    } else {
 
114
      if (sprintf(p,"%s%s",p,def.doc)==0)
 
115
        goto fail;
 
116
    }
 
117
  } else {
 
118
    PyArray_Descr *d = PyArray_DescrFromType(def.type);
 
119
    if (sprintf(p,"%s'%c'-",p,d->type)==0) goto fail;
 
120
    if (def.data==NULL) {
 
121
      if (sprintf(p,"%sarray(%" INTP_FMT,p,def.dims.d[0])==0) goto fail;
 
122
      for(i=1;i<def.rank;++i)
 
123
        if (sprintf(p,"%s,%" INTP_FMT,p,def.dims.d[i])==0) goto fail;
 
124
      if (sprintf(p,"%s), not allocated",p)==0) goto fail;
 
125
    } else {
 
126
      if (def.rank>0) {
 
127
        if (sprintf(p,"%sarray(%"INTP_FMT,p,def.dims.d[0])==0) goto fail;
 
128
        for(i=1;i<def.rank;i++)
 
129
          if (sprintf(p,"%s,%" INTP_FMT,p,def.dims.d[i])==0) goto fail;
 
130
        if (sprintf(p,"%s)",p)==0) goto fail;
 
131
      } else {
 
132
        if (sprintf(p,"%sscalar",p)==0) goto fail;
 
133
      }
 
134
    }
 
135
  }
 
136
  if (sprintf(p,"%s\n",p)==0) goto fail;
 
137
  if (strlen(p)>size) {
 
138
    fprintf(stderr,"fortranobject.c:fortran_doc:len(p)=%zd>%d(size): too long doc string required, increase size\n",strlen(p),size);
 
139
    goto fail;
 
140
  }
 
141
  s = PyString_FromString(p);
 
142
 fail:
 
143
  free(p);
 
144
  return s;
 
145
}
 
146
 
 
147
static FortranDataDef *save_def; /* save pointer of an allocatable array */
 
148
static void set_data(char *d,intp *f) {  /* callback from Fortran */
 
149
  if (*f)                               /* In fortran f=allocated(d) */
 
150
    save_def->data = d;
 
151
  else
 
152
    save_def->data = NULL;
 
153
  /* printf("set_data: d=%p,f=%d\n",d,*f); */
 
154
}
 
155
 
 
156
static PyObject *
 
157
fortran_getattr(PyFortranObject *fp, char *name) {
 
158
  int i,j,k,flag;
 
159
  if (fp->dict != NULL) {
 
160
    PyObject *v = PyDict_GetItemString(fp->dict, name);
 
161
    if (v != NULL) {
 
162
      Py_INCREF(v);
 
163
      return v;
 
164
    }
 
165
  }
 
166
  for (i=0,j=1;i<fp->len && (j=strcmp(name,fp->defs[i].name));i++);
 
167
  if (j==0)
 
168
    if (fp->defs[i].rank!=-1) {                   /* F90 allocatable array */ 
 
169
      if (fp->defs[i].func==NULL) return NULL;
 
170
      for(k=0;k<fp->defs[i].rank;++k) 
 
171
        fp->defs[i].dims.d[k]=-1;
 
172
      save_def = &fp->defs[i];
 
173
      (*(fp->defs[i].func))(&fp->defs[i].rank,fp->defs[i].dims.d,set_data,&flag);
 
174
      if (flag==2)
 
175
        k = fp->defs[i].rank + 1;
 
176
      else
 
177
        k = fp->defs[i].rank;
 
178
      if (fp->defs[i].data !=NULL) {              /* array is allocated */
 
179
        PyObject *v = PyArray_New(&PyArray_Type, k, fp->defs[i].dims.d,
 
180
                        fp->defs[i].type, NULL, fp->defs[i].data, 0, FARRAY_FLAGS,
 
181
                        NULL);
 
182
        if (v==NULL) return NULL;
 
183
        /* Py_INCREF(v); */
 
184
        return v;
 
185
      } else {                                    /* array is not allocated */
 
186
        Py_INCREF(Py_None);
 
187
        return Py_None;
 
188
      }
 
189
    }
 
190
  if (strcmp(name,"__dict__")==0) {
 
191
    Py_INCREF(fp->dict);
 
192
    return fp->dict;
 
193
  }
 
194
  if (strcmp(name,"__doc__")==0) {
 
195
    PyObject *s = PyString_FromString("");
 
196
    for (i=0;i<fp->len;i++)
 
197
      PyString_ConcatAndDel(&s,fortran_doc(fp->defs[i]));
 
198
    if (PyDict_SetItemString(fp->dict, name, s))
 
199
      return NULL;
 
200
    return s;
 
201
  }
 
202
  if ((strcmp(name,"_cpointer")==0) && (fp->len==1)) {
 
203
    PyObject *cobj = PyCObject_FromVoidPtr((void *)(fp->defs[0].data),NULL);
 
204
    if (PyDict_SetItemString(fp->dict, name, cobj))
 
205
      return NULL;
 
206
    return cobj;
 
207
  }
 
208
  return Py_FindMethod(fortran_methods, (PyObject *)fp, name);
 
209
}
 
210
 
 
211
static int
 
212
fortran_setattr(PyFortranObject *fp, char *name, PyObject *v) {
 
213
  int i,j,flag;
 
214
  PyArrayObject *arr = NULL;
 
215
  for (i=0,j=1;i<fp->len && (j=strcmp(name,fp->defs[i].name));i++);
 
216
  if (j==0) {
 
217
    if (fp->defs[i].rank==-1) {
 
218
      PyErr_SetString(PyExc_AttributeError,"over-writing fortran routine");
 
219
      return -1;
 
220
    }
 
221
    if (fp->defs[i].func!=NULL) { /* is allocatable array */
 
222
      intp dims[F2PY_MAX_DIMS];
 
223
      int k;
 
224
      save_def = &fp->defs[i];
 
225
      if (v!=Py_None) {     /* set new value (reallocate if needed --
 
226
                               see f2py generated code for more
 
227
                               details ) */
 
228
        for(k=0;k<fp->defs[i].rank;k++) dims[k]=-1;
 
229
        if ((arr = array_from_pyobj(fp->defs[i].type,dims,fp->defs[i].rank,F2PY_INTENT_IN,v))==NULL)
 
230
          return -1;
 
231
        (*(fp->defs[i].func))(&fp->defs[i].rank,arr->dimensions,set_data,&flag);
 
232
      } else {             /* deallocate */
 
233
        for(k=0;k<fp->defs[i].rank;k++) dims[k]=0;
 
234
        (*(fp->defs[i].func))(&fp->defs[i].rank,dims,set_data,&flag);
 
235
        for(k=0;k<fp->defs[i].rank;k++) dims[k]=-1;
 
236
      }
 
237
      memcpy(fp->defs[i].dims.d,dims,fp->defs[i].rank*sizeof(intp));
 
238
    } else {                     /* not allocatable array */
 
239
      if ((arr = array_from_pyobj(fp->defs[i].type,fp->defs[i].dims.d,fp->defs[i].rank,F2PY_INTENT_IN,v))==NULL)
 
240
        return -1;      
 
241
    }
 
242
    if (fp->defs[i].data!=NULL) { /* copy Python object to Fortran array */
 
243
      intp s = PyArray_MultiplyList(fp->defs[i].dims.d,arr->nd);
 
244
      if (s==-1)
 
245
        s = PyArray_MultiplyList(arr->dimensions,arr->nd);
 
246
      if (s<0 ||
 
247
          (memcpy(fp->defs[i].data,arr->data,s*PyArray_ITEMSIZE(arr)))==NULL) {
 
248
        if ((PyObject*)arr!=v) {
 
249
          Py_DECREF(arr);
 
250
        }
 
251
        return -1;
 
252
      }
 
253
      if ((PyObject*)arr!=v) {
 
254
        Py_DECREF(arr);
 
255
      }
 
256
    } else return (fp->defs[i].func==NULL?-1:0);
 
257
    return 0; /* succesful */
 
258
  }
 
259
  if (fp->dict == NULL) {
 
260
    fp->dict = PyDict_New();
 
261
    if (fp->dict == NULL)
 
262
      return -1;
 
263
  }
 
264
  if (v == NULL) {
 
265
    int rv = PyDict_DelItemString(fp->dict, name);
 
266
    if (rv < 0)
 
267
      PyErr_SetString(PyExc_AttributeError,"delete non-existing fortran attribute");
 
268
    return rv;
 
269
  }
 
270
  else
 
271
    return PyDict_SetItemString(fp->dict, name, v);
 
272
}
 
273
 
 
274
static PyObject*
 
275
fortran_call(PyFortranObject *fp, PyObject *arg, PyObject *kw) {
 
276
  int i = 0;
 
277
  /*  printf("fortran call
 
278
      name=%s,func=%p,data=%p,%p\n",fp->defs[i].name,
 
279
      fp->defs[i].func,fp->defs[i].data,&fp->defs[i].data); */
 
280
  if (fp->defs[i].rank==-1) {/* is Fortran routine */
 
281
    if ((fp->defs[i].func==NULL)) {
 
282
      PyErr_Format(PyExc_RuntimeError, "no function to call");
 
283
      return NULL;
 
284
    }
 
285
    else if (fp->defs[i].data==NULL)
 
286
      /* dummy routine */
 
287
      return (*((fortranfunc)(fp->defs[i].func)))((PyObject *)fp,arg,kw,NULL);
 
288
    else
 
289
      return (*((fortranfunc)(fp->defs[i].func)))((PyObject *)fp,arg,kw,
 
290
                                                  (void *)fp->defs[i].data);
 
291
  }
 
292
  PyErr_Format(PyExc_TypeError, "this fortran object is not callable");
 
293
  return NULL;
 
294
}
 
295
 
 
296
 
 
297
PyTypeObject PyFortran_Type = {
 
298
  PyObject_HEAD_INIT(0)
 
299
  0,                    /*ob_size*/
 
300
  "fortran",                    /*tp_name*/
 
301
  sizeof(PyFortranObject),      /*tp_basicsize*/
 
302
  0,                    /*tp_itemsize*/
 
303
  /* methods */
 
304
  (destructor)fortran_dealloc, /*tp_dealloc*/
 
305
  0,                    /*tp_print*/
 
306
  (getattrfunc)fortran_getattr, /*tp_getattr*/
 
307
  (setattrfunc)fortran_setattr, /*tp_setattr*/
 
308
  0,                    /*tp_compare*/
 
309
  0,                    /*tp_repr*/
 
310
  0,                    /*tp_as_number*/
 
311
  0,                    /*tp_as_sequence*/
 
312
  0,                    /*tp_as_mapping*/
 
313
  0,                    /*tp_hash*/
 
314
  (ternaryfunc)fortran_call,                    /*tp_call*/
 
315
};
 
316
 
 
317
/************************* f2py_report_atexit *******************************/
 
318
 
 
319
#ifdef F2PY_REPORT_ATEXIT
 
320
static int passed_time = 0;
 
321
static int passed_counter = 0;
 
322
static int passed_call_time = 0;
 
323
static struct timeb start_time;
 
324
static struct timeb stop_time;
 
325
static struct timeb start_call_time;
 
326
static struct timeb stop_call_time;
 
327
static int cb_passed_time = 0;
 
328
static int cb_passed_counter = 0;
 
329
static int cb_passed_call_time = 0;
 
330
static struct timeb cb_start_time;
 
331
static struct timeb cb_stop_time;
 
332
static struct timeb cb_start_call_time;
 
333
static struct timeb cb_stop_call_time;
 
334
 
 
335
extern void f2py_start_clock(void) { ftime(&start_time); }
 
336
extern
 
337
void f2py_start_call_clock(void) {
 
338
  f2py_stop_clock();
 
339
  ftime(&start_call_time);
 
340
}
 
341
extern
 
342
void f2py_stop_clock(void) {
 
343
  ftime(&stop_time);
 
344
  passed_time += 1000*(stop_time.time - start_time.time);
 
345
  passed_time += stop_time.millitm - start_time.millitm;
 
346
}
 
347
extern
 
348
void f2py_stop_call_clock(void) {
 
349
  ftime(&stop_call_time);
 
350
  passed_call_time += 1000*(stop_call_time.time - start_call_time.time);
 
351
  passed_call_time += stop_call_time.millitm - start_call_time.millitm;
 
352
  passed_counter += 1;
 
353
  f2py_start_clock();
 
354
}
 
355
 
 
356
extern void f2py_cb_start_clock(void) { ftime(&cb_start_time); }
 
357
extern
 
358
void f2py_cb_start_call_clock(void) {
 
359
  f2py_cb_stop_clock();
 
360
  ftime(&cb_start_call_time);
 
361
}
 
362
extern
 
363
void f2py_cb_stop_clock(void) {
 
364
  ftime(&cb_stop_time);
 
365
  cb_passed_time += 1000*(cb_stop_time.time - cb_start_time.time);
 
366
  cb_passed_time += cb_stop_time.millitm - cb_start_time.millitm;
 
367
}
 
368
extern
 
369
void f2py_cb_stop_call_clock(void) {
 
370
  ftime(&cb_stop_call_time);
 
371
  cb_passed_call_time += 1000*(cb_stop_call_time.time - cb_start_call_time.time);
 
372
  cb_passed_call_time += cb_stop_call_time.millitm - cb_start_call_time.millitm;
 
373
  cb_passed_counter += 1;
 
374
  f2py_cb_start_clock();
 
375
}
 
376
 
 
377
static int f2py_report_on_exit_been_here = 0;
 
378
extern
 
379
void f2py_report_on_exit(int exit_flag,void *name) {
 
380
  if (f2py_report_on_exit_been_here) {
 
381
    fprintf(stderr,"             %s\n",(char*)name);
 
382
    return;
 
383
  }
 
384
  f2py_report_on_exit_been_here = 1;
 
385
  fprintf(stderr,"                      /-----------------------\\\n");
 
386
  fprintf(stderr,"                     < F2PY performance report >\n");
 
387
  fprintf(stderr,"                      \\-----------------------/\n");
 
388
  fprintf(stderr,"Overall time spent in ...\n");
 
389
  fprintf(stderr,"(a) wrapped (Fortran/C) functions           : %8d msec\n",
 
390
          passed_call_time);
 
391
  fprintf(stderr,"(b) f2py interface,           %6d calls  : %8d msec\n",
 
392
          passed_counter,passed_time);
 
393
  fprintf(stderr,"(c) call-back (Python) functions            : %8d msec\n",
 
394
          cb_passed_call_time);
 
395
  fprintf(stderr,"(d) f2py call-back interface, %6d calls  : %8d msec\n",
 
396
          cb_passed_counter,cb_passed_time);
 
397
  
 
398
  fprintf(stderr,"(e) wrapped (Fortran/C) functions (acctual) : %8d msec\n\n",
 
399
          passed_call_time-cb_passed_call_time-cb_passed_time);
 
400
  fprintf(stderr,"Use -DF2PY_REPORT_ATEXIT_DISABLE to disable this message.\n");
 
401
  fprintf(stderr,"Exit status: %d\n",exit_flag);
 
402
  fprintf(stderr,"Modules    : %s\n",(char*)name);
 
403
}
 
404
#endif
 
405
 
 
406
/********************** report on array copy ****************************/
 
407
 
 
408
#ifdef F2PY_REPORT_ON_ARRAY_COPY
 
409
static void f2py_report_on_array_copy(PyArrayObject* arr) {
 
410
  const long arr_size = PyArray_Size((PyObject *)arr);
 
411
  if (arr_size>F2PY_REPORT_ON_ARRAY_COPY) {
 
412
    fprintf(stderr,"copied an array: size=%ld, elsize=%d\n", 
 
413
            arr_size, PyArray_ITEMSIZE(arr));
 
414
  }
 
415
}
 
416
static void f2py_report_on_array_copy_fromany(void) {
 
417
  fprintf(stderr,"created an array from object\n");
 
418
}
 
419
 
 
420
#define F2PY_REPORT_ON_ARRAY_COPY_FROMARR f2py_report_on_array_copy((PyArrayObject *)arr)
 
421
#define F2PY_REPORT_ON_ARRAY_COPY_FROMANY f2py_report_on_array_copy_fromany()
 
422
#else
 
423
#define F2PY_REPORT_ON_ARRAY_COPY_FROMARR
 
424
#define F2PY_REPORT_ON_ARRAY_COPY_FROMANY
 
425
#endif
 
426
 
 
427
 
 
428
/************************* array_from_obj *******************************/
 
429
 
 
430
/* 
 
431
 * File: array_from_pyobj.c 
 
432
 *
 
433
 * Description:
 
434
 * ------------ 
 
435
 * Provides array_from_pyobj function that returns a contigious array
 
436
 * object with the given dimensions and required storage order, either
 
437
 * in row-major (C) or column-major (Fortran) order. The function
 
438
 * array_from_pyobj is very flexible about its Python object argument
 
439
 * that can be any number, list, tuple, or array.
 
440
 * 
 
441
 * array_from_pyobj is used in f2py generated Python extension
 
442
 * modules.
 
443
 *
 
444
 * Author: Pearu Peterson <pearu@cens.ioc.ee>
 
445
 * Created: 13-16 January 2002
 
446
 * $Id: fortranobject.c,v 1.52 2005/07/11 07:44:20 pearu Exp $
 
447
 */
 
448
 
 
449
static int 
 
450
count_nonpos(const int rank,
 
451
             const intp *dims) {
 
452
  int i=0,r=0;
 
453
  while (i<rank) {
 
454
    if (dims[i] <= 0) ++r;
 
455
    ++i;
 
456
  }
 
457
  return r;
 
458
}
 
459
 
 
460
static int check_and_fix_dimensions(const PyArrayObject* arr,
 
461
                                    const int rank,
 
462
                                    intp *dims);
 
463
 
 
464
#ifdef DEBUG_COPY_ND_ARRAY
 
465
void dump_dims(int rank, intp* dims) {
 
466
  int i;
 
467
  printf("[");
 
468
  for(i=0;i<rank;++i) {
 
469
    printf("%3" INTP_FMT, dims[i]);
 
470
  }
 
471
  printf("]\n");
 
472
}
 
473
void dump_attrs(const PyArrayObject* arr) {
 
474
  int rank = arr->nd;
 
475
  intp size = PyArray_Size((PyObject *)arr);
 
476
  printf("\trank = %d, flags = %d, size = %" INTP_FMT  "\n",
 
477
         rank,arr->flags,size);
 
478
  printf("\tstrides = ");
 
479
  dump_dims(rank,arr->strides);
 
480
  printf("\tdimensions = ");
 
481
  dump_dims(rank,arr->dimensions);
 
482
}
 
483
#endif
 
484
 
 
485
#define SWAPTYPE(a,b,t) {t c; c = (a); (a) = (b); (b) = c; }
 
486
 
 
487
static int swap_arrays(PyArrayObject* arr1, PyArrayObject* arr2) {
 
488
  SWAPTYPE(arr1->data,arr2->data,char*);
 
489
  SWAPTYPE(arr1->nd,arr2->nd,int);
 
490
  SWAPTYPE(arr1->dimensions,arr2->dimensions,intp*);
 
491
  SWAPTYPE(arr1->strides,arr2->strides,intp*);
 
492
  SWAPTYPE(arr1->base,arr2->base,PyObject*);
 
493
  SWAPTYPE(arr1->descr,arr2->descr,PyArray_Descr*);
 
494
  SWAPTYPE(arr1->flags,arr2->flags,int);
 
495
  /* SWAPTYPE(arr1->weakreflist,arr2->weakreflist,PyObject*); */
 
496
  return 0;
 
497
}
 
498
 
 
499
#define ARRAY_ISCOMPATIBLE(arr,type_num) \
 
500
(  (PyArray_ISINTEGER(arr) && PyTypeNum_ISINTEGER(type_num)) \
 
501
 ||(PyArray_ISFLOAT(arr) && PyTypeNum_ISFLOAT(type_num)) \
 
502
 ||(PyArray_ISCOMPLEX(arr) && PyTypeNum_ISCOMPLEX(type_num)) \
 
503
)
 
504
 
 
505
extern
 
506
PyArrayObject* array_from_pyobj(const int type_num,
 
507
                                intp *dims,
 
508
                                const int rank,
 
509
                                const int intent,
 
510
                                PyObject *obj) {
 
511
  /* Note about reference counting
 
512
     -----------------------------
 
513
     If the caller returns the array to Python, it must be done with
 
514
     Py_BuildValue("N",arr).
 
515
     Otherwise, if obj!=arr then the caller must call Py_DECREF(arr).
 
516
 
 
517
     Note on intent(cache,out,..)
 
518
     ---------------------
 
519
     Don't expect correct data when returning intent(cache) array.
 
520
 
 
521
  */
 
522
  char mess[200];
 
523
  PyArrayObject *arr = NULL;
 
524
  PyArray_Descr *descr = PyArray_DescrFromType(type_num);
 
525
 
 
526
  if ((intent & F2PY_INTENT_HIDE)
 
527
      || ((intent & F2PY_INTENT_CACHE) && (obj==Py_None))
 
528
      || ((intent & F2PY_OPTIONAL) && (obj==Py_None))
 
529
      ) {
 
530
    /* intent(cache), optional, intent(hide) */
 
531
    if (count_nonpos(rank,dims)) {
 
532
      int i;
 
533
      sprintf(mess,"failed to create intent(cache|hide)|optional array"
 
534
              "-- must have defined dimensions but got (");
 
535
      for(i=0;i<rank;++i)
 
536
        sprintf(mess+strlen(mess),"%" INTP_FMT ",",dims[i]);
 
537
      sprintf(mess+strlen(mess),")");
 
538
      PyErr_SetString(PyExc_ValueError,mess);
 
539
      return NULL;
 
540
    }
 
541
    arr = (PyArrayObject *)
 
542
      PyArray_New(&PyArray_Type, rank, dims, type_num,
 
543
                  NULL,NULL,0,
 
544
                  !(intent&F2PY_INTENT_C),
 
545
                  NULL);
 
546
    if (arr==NULL) return NULL;
 
547
    if (!(intent & F2PY_INTENT_CACHE))
 
548
      PyArray_FILLWBYTE(arr, 0);
 
549
    return arr;
 
550
  }
 
551
 
 
552
  if (PyArray_Check(obj)) {
 
553
    arr = (PyArrayObject *)obj;
 
554
 
 
555
    if (intent & F2PY_INTENT_CACHE) {
 
556
      /* intent(cache) */
 
557
      if (PyArray_ISONESEGMENT(obj)
 
558
          && PyArray_ITEMSIZE((PyArrayObject *)obj)>=descr->elsize) {
 
559
        if (check_and_fix_dimensions((PyArrayObject *)obj,rank,dims))
 
560
          return NULL; /*XXX: set exception */
 
561
        if (intent & F2PY_INTENT_OUT)
 
562
          Py_INCREF(obj);
 
563
        return (PyArrayObject *)obj;
 
564
      }
 
565
      sprintf(mess,"failed to initialize intent(cache) array");
 
566
      if (!PyArray_ISONESEGMENT(obj))
 
567
        sprintf(mess+strlen(mess)," -- input must be in one segment");
 
568
      if (PyArray_ITEMSIZE(arr)<descr->elsize)
 
569
        sprintf(mess+strlen(mess)," -- expected at least elsize=%d but got %d",
 
570
                descr->elsize,PyArray_ITEMSIZE(arr)
 
571
                );
 
572
      PyErr_SetString(PyExc_ValueError,mess);
 
573
      return NULL;
 
574
    }
 
575
 
 
576
    /* here we have always intent(in) or intent(inout) or intent(inplace) */
 
577
 
 
578
    if (check_and_fix_dimensions(arr,rank,dims))
 
579
      return NULL; /*XXX: set exception */
 
580
 
 
581
    if ((! (intent & F2PY_INTENT_COPY))
 
582
        && PyArray_ITEMSIZE(arr)==descr->elsize
 
583
        && ARRAY_ISCOMPATIBLE(arr,type_num)
 
584
        ) {
 
585
      if ((intent & F2PY_INTENT_C)?PyArray_ISCARRAY(arr):PyArray_ISFARRAY(arr)) {
 
586
        if ((intent & F2PY_INTENT_OUT)) {
 
587
          Py_INCREF(arr);
 
588
        }
 
589
        /* Returning input array */
 
590
        return arr;
 
591
      }
 
592
    }
 
593
 
 
594
    if (intent & F2PY_INTENT_INOUT) {
 
595
      sprintf(mess,"failed to initialize intent(inout) array");
 
596
      if ((intent & F2PY_INTENT_C) && !PyArray_ISCARRAY(arr))
 
597
        sprintf(mess+strlen(mess)," -- input not contiguous");
 
598
      if (!(intent & F2PY_INTENT_C) && !PyArray_ISFARRAY(arr))
 
599
        sprintf(mess+strlen(mess)," -- input not fortran contiguous");
 
600
      if (PyArray_ITEMSIZE(arr)!=descr->elsize)
 
601
        sprintf(mess+strlen(mess)," -- expected elsize=%d but got %d",
 
602
                descr->elsize,
 
603
                PyArray_ITEMSIZE(arr)
 
604
                );
 
605
      if (!(ARRAY_ISCOMPATIBLE(arr,type_num)))
 
606
        sprintf(mess+strlen(mess)," -- input '%c' not compatible to '%c'",
 
607
                arr->descr->type,descr->type);
 
608
      PyErr_SetString(PyExc_ValueError,mess);
 
609
      return NULL;
 
610
    }
 
611
 
 
612
    /* here we have always intent(in) or intent(inplace) */
 
613
 
 
614
    {
 
615
      PyArrayObject *retarr = (PyArrayObject *) \
 
616
        PyArray_New(&PyArray_Type, arr->nd, arr->dimensions, type_num,
 
617
                    NULL,NULL,0,
 
618
                    !(intent&F2PY_INTENT_C),
 
619
                    NULL);
 
620
      if (retarr==NULL)
 
621
        return NULL;
 
622
      F2PY_REPORT_ON_ARRAY_COPY_FROMARR;
 
623
      if (PyArray_CopyInto(retarr, arr)) {
 
624
        Py_DECREF(retarr);
 
625
        return NULL;
 
626
      }
 
627
      if (intent & F2PY_INTENT_INPLACE) {
 
628
        if (swap_arrays(arr,retarr))
 
629
          return NULL; /* XXX: set exception */
 
630
        Py_XDECREF(retarr);
 
631
        if (intent & F2PY_INTENT_OUT)
 
632
          Py_INCREF(arr);
 
633
      } else {
 
634
        arr = retarr;
 
635
      }
 
636
    }
 
637
    return arr;
 
638
  }
 
639
 
 
640
  if ((intent & F2PY_INTENT_INOUT) 
 
641
      || (intent & F2PY_INTENT_INPLACE)
 
642
      || (intent & F2PY_INTENT_CACHE)) {
 
643
    sprintf(mess,"failed to initialize intent(inout|inplace|cache) array"
 
644
            " -- input must be array but got %s",
 
645
            PyString_AsString(PyObject_Str(PyObject_Type(obj)))
 
646
            );
 
647
    PyErr_SetString(PyExc_TypeError,mess);
 
648
    return NULL;
 
649
  }
 
650
 
 
651
  {
 
652
    F2PY_REPORT_ON_ARRAY_COPY_FROMANY;
 
653
    arr = (PyArrayObject *) \
 
654
      PyArray_FromAny(obj,PyArray_DescrFromType(type_num), 0,0,
 
655
                      ((intent & F2PY_INTENT_C)?CARRAY_FLAGS:FARRAY_FLAGS) \
 
656
                      | FORCECAST, NULL);
 
657
    if (arr==NULL)
 
658
      return NULL;
 
659
    if (check_and_fix_dimensions(arr,rank,dims))
 
660
      return NULL; /*XXX: set exception */
 
661
    return arr;
 
662
  }
 
663
 
 
664
}
 
665
 
 
666
           /*****************************************/
 
667
           /* Helper functions for array_from_pyobj */
 
668
           /*****************************************/
 
669
 
 
670
static
 
671
int check_and_fix_dimensions(const PyArrayObject* arr,const int rank,intp *dims) {
 
672
  /*
 
673
    This function fills in blanks (that are -1\'s) in dims list using
 
674
    the dimensions from arr. It also checks that non-blank dims will
 
675
    match with the corresponding values in arr dimensions.
 
676
   */
 
677
  const intp arr_size = (arr->nd)?PyArray_Size((PyObject *)arr):1;
 
678
#ifdef DEBUG_COPY_ND_ARRAY
 
679
  dump_attrs(arr);
 
680
  printf("check_and_fix_dimensions:init: dims=");
 
681
  dump_dims(rank,dims);
 
682
#endif
 
683
  if (rank > arr->nd) { /* [1,2] -> [[1],[2]]; 1 -> [[1]]  */
 
684
    intp new_size = 1;
 
685
    int free_axe = -1;
 
686
    int i;
 
687
    /* Fill dims where -1 or 0; check dimensions; calc new_size; */
 
688
    for(i=0;i<arr->nd;++i) { 
 
689
      if (dims[i] >= 0) {
 
690
        if (dims[i]!=arr->dimensions[i]) {
 
691
          fprintf(stderr,"%d-th dimension must be fixed to %" INTP_FMT
 
692
                  " but got %" INTP_FMT "\n",
 
693
                  i,dims[i], arr->dimensions[i]);
 
694
          return 1;
 
695
        }
 
696
        if (!dims[i]) dims[i] = 1;
 
697
      } else {
 
698
        dims[i] = arr->dimensions[i] ? arr->dimensions[i] : 1;
 
699
      }
 
700
      new_size *= dims[i];
 
701
    }
 
702
    for(i=arr->nd;i<rank;++i)
 
703
      if (dims[i]>1) {
 
704
        fprintf(stderr,"%d-th dimension must be %" INTP_FMT
 
705
                " but got 0 (not defined).\n",
 
706
                i,dims[i]);
 
707
        return 1;
 
708
      } else if (free_axe<0)
 
709
        free_axe = i;
 
710
      else
 
711
        dims[i] = 1;
 
712
    if (free_axe>=0) {
 
713
      dims[free_axe] = arr_size/new_size;
 
714
      new_size *= dims[free_axe];
 
715
    }
 
716
    if (new_size != arr_size) {
 
717
      fprintf(stderr,"confused: new_size=%" INTP_FMT
 
718
              ", arr_size=%" INTP_FMT " (maybe too many free"
 
719
              " indices)\n", new_size,arr_size);
 
720
      return 1;
 
721
    }
 
722
  } else if (rank==arr->nd) {
 
723
    int i;
 
724
    intp d;
 
725
    for (i=0; i<rank; ++i) {
 
726
      d = arr->dimensions[i];
 
727
      if (dims[i]>=0) {
 
728
        if (d > 1 && d!=dims[i]) {
 
729
          fprintf(stderr,"%d-th dimension must be fixed to %" INTP_FMT 
 
730
                  " but got %" INTP_FMT "\n",
 
731
                  i,dims[i],d);
 
732
          return 1;       
 
733
        }
 
734
        if (!dims[i]) dims[i] = 1;
 
735
      } else dims[i] = d;
 
736
    }
 
737
  } else { /* [[1,2]] -> [[1],[2]] */
 
738
    int i,j;
 
739
    intp d;
 
740
    int effrank;
 
741
    intp size;
 
742
    for (i=0,effrank=0;i<arr->nd;++i)
 
743
      if (arr->dimensions[i]>1) ++effrank;
 
744
    if (dims[rank-1]>=0)
 
745
      if (effrank>rank) {
 
746
        fprintf(stderr,"too many axes: %d (effrank=%d), expected rank=%d\n",
 
747
                arr->nd,effrank,rank);
 
748
        return 1;
 
749
      }
 
750
 
 
751
    for (i=0,j=0;i<rank;++i) {
 
752
      while (j<arr->nd && arr->dimensions[j]<2) ++j;
 
753
      if (j>=arr->nd) d = 1;
 
754
      else d = arr->dimensions[j++];
 
755
      if (dims[i]>=0) {
 
756
        if (d>1 && d!=dims[i]) {
 
757
          fprintf(stderr,"%d-th dimension must be fixed to %" INTP_FMT 
 
758
                  " but got %" INTP_FMT " (real index=%d)\n",
 
759
                  i,dims[i],d,j-1);
 
760
          return 1;       
 
761
        }
 
762
        if (!dims[i]) dims[i] = 1;
 
763
      } else
 
764
        dims[i] = d;
 
765
    }
 
766
 
 
767
    for (i=rank;i<arr->nd;++i) { /* [[1,2],[3,4]] -> [1,2,3,4] */
 
768
      while (j<arr->nd && arr->dimensions[j]<2) ++j;
 
769
      if (j>=arr->nd) d = 1;
 
770
      else d = arr->dimensions[j++];
 
771
      dims[rank-1] *= d;
 
772
    }
 
773
    for (i=0,size=1;i<rank;++i) size *= dims[i];
 
774
    if (size != arr_size) {
 
775
      fprintf(stderr,"confused: size=%" INTP_FMT ", arr_size=%" INTP_FMT
 
776
              ", rank=%d, effrank=%d, arr.nd=%d, dims=[",
 
777
              size,arr_size,rank,effrank,arr->nd);
 
778
      for (i=0;i<rank;++i) fprintf(stderr," %" INTP_FMT,dims[i]);
 
779
      fprintf(stderr," ], arr.dims=[");
 
780
      for (i=0;i<arr->nd;++i) fprintf(stderr," %" INTP_FMT,arr->dimensions[i]);
 
781
      fprintf(stderr," ]\n");
 
782
      return 1;
 
783
    }
 
784
  }
 
785
#ifdef DEBUG_COPY_ND_ARRAY
 
786
  printf("check_and_fix_dimensions:end: dims=");
 
787
  dump_dims(rank,dims);
 
788
#endif
 
789
  return 0;
 
790
}
 
791
 
 
792
/* End of file: array_from_pyobj.c */
 
793
 
 
794
/************************* copy_ND_array *******************************/
 
795
 
 
796
extern
 
797
int copy_ND_array(const PyArrayObject *arr, PyArrayObject *out)
 
798
{
 
799
  F2PY_REPORT_ON_ARRAY_COPY_FROMARR;
 
800
  return PyArray_CopyInto(out, (PyArrayObject *)arr);
 
801
}
 
802
 
 
803
#ifdef __cplusplus
 
804
}
 
805
#endif
 
806
/************************* EOF fortranobject.c *******************************/