Файловый менеджер

Файловый менеджер - Редактировать - /home/skymarketplace/public_html/uploads/src.tar

Назад
fortranobject.c��0000644��00000131672�15004413033�0007555 0��ustar�00��#define FORTRANOBJECT_C #include "fortranobject.h" #ifdef __cplusplus extern "C" { #endif #include <stdarg.h> #include <stdlib.h> #include <string.h> /* This file implements: FortranObject, array_from_pyobj, copy_ND_array Author: Pearu Peterson <pearu@cens.ioc.ee> $Revision: 1.52 $ $Date: 2005/07/11 07:44:20 $ / int F2PyDict_SetItemString(PyObject dict, char name, PyObject obj) { if (obj == NULL) { fprintf(stderr, "Error loading %s\n", name); if (PyErr_Occurred()) { PyErr_Print(); PyErr_Clear(); } return -1; } return PyDict_SetItemString(dict, name, obj); } /* * Python-only fallback for thread-local callback pointers / void F2PySwapThreadLocalCallbackPtr(char key, void ptr) { PyObject local_dict, value; void prev; local_dict = PyThreadState_GetDict(); if (local_dict == NULL) { Py_FatalError( "F2PySwapThreadLocalCallbackPtr: PyThreadState_GetDict " "failed"); } value = PyDict_GetItemString(local_dict, key); if (value != NULL) { prev = PyLong_AsVoidPtr(value); if (PyErr_Occurred()) { Py_FatalError( "F2PySwapThreadLocalCallbackPtr: PyLong_AsVoidPtr failed"); } } else { prev = NULL; } value = PyLong_FromVoidPtr((void )ptr); if (value == NULL) { Py_FatalError( "F2PySwapThreadLocalCallbackPtr: PyLong_FromVoidPtr failed"); } if (PyDict_SetItemString(local_dict, key, value) != 0) { Py_FatalError( "F2PySwapThreadLocalCallbackPtr: PyDict_SetItemString failed"); } Py_DECREF(value); return prev; } void * F2PyGetThreadLocalCallbackPtr(char key) { PyObject local_dict, value; void prev; local_dict = PyThreadState_GetDict(); if (local_dict == NULL) { Py_FatalError( "F2PyGetThreadLocalCallbackPtr: PyThreadState_GetDict failed"); } value = PyDict_GetItemString(local_dict, key); if (value != NULL) { prev = PyLong_AsVoidPtr(value); if (PyErr_Occurred()) { Py_FatalError( "F2PyGetThreadLocalCallbackPtr: PyLong_AsVoidPtr failed"); } } else { prev = NULL; } return prev; } static PyArray_Descr * get_descr_from_type_and_elsize(const int type_num, const int elsize) { PyArray_Descr * descr = PyArray_DescrFromType(type_num); if (type_num == NPY_STRING) { // PyArray_DescrFromType returns descr with elsize = 0. PyArray_DESCR_REPLACE(descr); if (descr == NULL) { return NULL; } descr->elsize = elsize; } return descr; } /*********************** FortranObject ****************************/ typedef PyObject (fortranfunc)(PyObject , PyObject , PyObject , void ); PyObject PyFortranObject_New(FortranDataDef defs, f2py_void_func init) { int i; PyFortranObject fp = NULL; PyObject v = NULL; if (init != NULL) { / Initialize F90 module objects / ((init))(); } fp = PyObject_New(PyFortranObject, &PyFortran_Type); if (fp == NULL) { return NULL; } if ((fp->dict = PyDict_New()) == NULL) { Py_DECREF(fp); return NULL; } fp->len = 0; while (defs[fp->len].name != NULL) { fp->len++; } if (fp->len == 0) { goto fail; } fp->defs = defs; for (i = 0; i < fp->len; i++) { if (fp->defs[i].rank == -1) { /* Is Fortran routine / v = PyFortranObject_NewAsAttr(&(fp->defs[i])); if (v == NULL) { goto fail; } PyDict_SetItemString(fp->dict, fp->defs[i].name, v); Py_XDECREF(v); } else if ((fp->defs[i].data) != NULL) { / Is Fortran variable or array (not allocatable) / PyArray_Descr descr = get_descr_from_type_and_elsize(fp->defs[i].type, fp->defs[i].elsize); if (descr == NULL) { goto fail; } v = PyArray_NewFromDescr(&PyArray_Type, descr, fp->defs[i].rank, fp->defs[i].dims.d, NULL, fp->defs[i].data, NPY_ARRAY_FARRAY, NULL); if (v == NULL) { Py_DECREF(descr); goto fail; } PyDict_SetItemString(fp->dict, fp->defs[i].name, v); Py_XDECREF(v); } } return (PyObject )fp; fail: Py_XDECREF(fp); return NULL; } PyObject PyFortranObject_NewAsAttr(FortranDataDef defs) { / used for calling F90 module routines / PyFortranObject fp = NULL; fp = PyObject_New(PyFortranObject, &PyFortran_Type); if (fp == NULL) return NULL; if ((fp->dict = PyDict_New()) == NULL) { PyObject_Del(fp); return NULL; } fp->len = 1; fp->defs = defs; if (defs->rank == -1) { PyDict_SetItemString(fp->dict, "__name__", PyUnicode_FromFormat("function %s", defs->name)); } else if (defs->rank == 0) { PyDict_SetItemString(fp->dict, "__name__", PyUnicode_FromFormat("scalar %s", defs->name)); } else { PyDict_SetItemString(fp->dict, "__name__", PyUnicode_FromFormat("array %s", defs->name)); } return (PyObject )fp; } / Fortran methods / static void fortran_dealloc(PyFortranObject fp) { Py_XDECREF(fp->dict); PyObject_Del(fp); } /* Returns number of bytes consumed from buf, or -1 on error. / static Py_ssize_t format_def(char buf, Py_ssize_t size, FortranDataDef def) { char p = buf; int i; npy_intp n; n = PyOS_snprintf(p, size, "array(%" NPY_INTP_FMT, def.dims.d[0]); if (n < 0 \|\| n >= size) { return -1; } p += n; size -= n; for (i = 1; i < def.rank; i++) { n = PyOS_snprintf(p, size, ",%" NPY_INTP_FMT, def.dims.d[i]); if (n < 0 \|\| n >= size) { return -1; } p += n; size -= n; } if (size <= 0) { return -1; } p++ = ')'; size--; if (def.data == NULL) { static const char notalloc[] = ", not allocated"; if ((size_t)size < sizeof(notalloc)) { return -1; } memcpy(p, notalloc, sizeof(notalloc)); p += sizeof(notalloc); size -= sizeof(notalloc); } return p - buf; } static PyObject * fortran_doc(FortranDataDef def) { char buf, p; PyObject s = NULL; Py_ssize_t n, origsize, size = 100; if (def.doc != NULL) { size += strlen(def.doc); } origsize = size; buf = p = (char )PyMem_Malloc(size); if (buf == NULL) { return PyErr_NoMemory(); } if (def.rank == -1) { if (def.doc) { n = strlen(def.doc); if (n > size) { goto fail; } memcpy(p, def.doc, n); p += n; size -= n; } else { n = PyOS_snprintf(p, size, "%s - no docs available", def.name); if (n < 0 \|\| n >= size) { goto fail; } p += n; size -= n; } } else { PyArray_Descr d = PyArray_DescrFromType(def.type); n = PyOS_snprintf(p, size, "%s : '%c'-", def.name, d->type); Py_DECREF(d); if (n < 0 \|\| n >= size) { goto fail; } p += n; size -= n; if (def.data == NULL) { n = format_def(p, size, def); if (n < 0) { goto fail; } p += n; size -= n; } else if (def.rank > 0) { n = format_def(p, size, def); if (n < 0) { goto fail; } p += n; size -= n; } else { n = strlen("scalar"); if (size < n) { goto fail; } memcpy(p, "scalar", n); p += n; size -= n; } } if (size <= 1) { goto fail; } p++ = '\n'; size--; /* p now points one beyond the last character of the string in buf / s = PyUnicode_FromStringAndSize(buf, p - buf); PyMem_Free(buf); return s; fail: fprintf(stderr, "fortranobject.c: fortran_doc: len(p)=%zd>%zd=size:" " too long docstring required, increase size\n", p - buf, origsize); PyMem_Free(buf); return NULL; } static FortranDataDef save_def; /* save pointer of an allocatable array / static void set_data(char d, npy_intp f) { / callback from Fortran / if (f) /* In fortran f=allocated(d) / save_def->data = d; else save_def->data = NULL; / printf("set_data: d=%p,f=%d\n",d,f); / } static PyObject * fortran_getattr(PyFortranObject fp, char name) { int i, j, k, flag; if (fp->dict != NULL) { PyObject v = _PyDict_GetItemStringWithError(fp->dict, name); if (v == NULL && PyErr_Occurred()) { return NULL; } else if (v != NULL) { Py_INCREF(v); return v; } } for (i = 0, j = 1; i < fp->len && (j = strcmp(name, fp->defs[i].name)); i++) ; if (j == 0) if (fp->defs[i].rank != -1) { / F90 allocatable array / if (fp->defs[i].func == NULL) return NULL; for (k = 0; k < fp->defs[i].rank; ++k) fp->defs[i].dims.d[k] = -1; save_def = &fp->defs[i]; ((fp->defs[i].func))(&fp->defs[i].rank, fp->defs[i].dims.d, set_data, &flag); if (flag == 2) k = fp->defs[i].rank + 1; else k = fp->defs[i].rank; if (fp->defs[i].data != NULL) { /* array is allocated / PyObject v = PyArray_New( &PyArray_Type, k, fp->defs[i].dims.d, fp->defs[i].type, NULL, fp->defs[i].data, 0, NPY_ARRAY_FARRAY, NULL); if (v == NULL) return NULL; /* Py_INCREF(v); / return v; } else { / array is not allocated / Py_RETURN_NONE; } } if (strcmp(name, "__dict__") == 0) { Py_INCREF(fp->dict); return fp->dict; } if (strcmp(name, "__doc__") == 0) { PyObject s = PyUnicode_FromString(""), s2, s3; for (i = 0; i < fp->len; i++) { s2 = fortran_doc(fp->defs[i]); s3 = PyUnicode_Concat(s, s2); Py_DECREF(s2); Py_DECREF(s); s = s3; } if (PyDict_SetItemString(fp->dict, name, s)) return NULL; return s; } if ((strcmp(name, "_cpointer") == 0) && (fp->len == 1)) { PyObject cobj = F2PyCapsule_FromVoidPtr((void )(fp->defs[0].data), NULL); if (PyDict_SetItemString(fp->dict, name, cobj)) return NULL; return cobj; } PyObject str, ret; str = PyUnicode_FromString(name); ret = PyObject_GenericGetAttr((PyObject )fp, str); Py_DECREF(str); return ret; } static int fortran_setattr(PyFortranObject fp, char name, PyObject v) { int i, j, flag; PyArrayObject arr = NULL; for (i = 0, j = 1; i < fp->len && (j = strcmp(name, fp->defs[i].name)); i++) ; if (j == 0) { if (fp->defs[i].rank == -1) { PyErr_SetString(PyExc_AttributeError, "over-writing fortran routine"); return -1; } if (fp->defs[i].func != NULL) { / is allocatable array / npy_intp dims[F2PY_MAX_DIMS]; int k; save_def = &fp->defs[i]; if (v != Py_None) { / set new value (reallocate if needed -- see f2py generated code for more details ) / for (k = 0; k < fp->defs[i].rank; k++) dims[k] = -1; if ((arr = array_from_pyobj(fp->defs[i].type, dims, fp->defs[i].rank, F2PY_INTENT_IN, v)) == NULL) return -1; ((fp->defs[i].func))(&fp->defs[i].rank, PyArray_DIMS(arr), set_data, &flag); } else { /* deallocate / for (k = 0; k < fp->defs[i].rank; k++) dims[k] = 0; ((fp->defs[i].func))(&fp->defs[i].rank, dims, set_data, &flag); for (k = 0; k < fp->defs[i].rank; k++) dims[k] = -1; } memcpy(fp->defs[i].dims.d, dims, fp->defs[i].rank * sizeof(npy_intp)); } else { /* not allocatable array / if ((arr = array_from_pyobj(fp->defs[i].type, fp->defs[i].dims.d, fp->defs[i].rank, F2PY_INTENT_IN, v)) == NULL) return -1; } if (fp->defs[i].data != NULL) { / copy Python object to Fortran array / npy_intp s = PyArray_MultiplyList(fp->defs[i].dims.d, PyArray_NDIM(arr)); if (s == -1) s = PyArray_MultiplyList(PyArray_DIMS(arr), PyArray_NDIM(arr)); if (s < 0 \|\| (memcpy(fp->defs[i].data, PyArray_DATA(arr), s PyArray_ITEMSIZE(arr))) == NULL) { if ((PyObject )arr != v) { Py_DECREF(arr); } return -1; } if ((PyObject )arr != v) { Py_DECREF(arr); } } else return (fp->defs[i].func == NULL ? -1 : 0); return 0; /* successful / } if (fp->dict == NULL) { fp->dict = PyDict_New(); if (fp->dict == NULL) return -1; } if (v == NULL) { int rv = PyDict_DelItemString(fp->dict, name); if (rv < 0) PyErr_SetString(PyExc_AttributeError, "delete non-existing fortran attribute"); return rv; } else return PyDict_SetItemString(fp->dict, name, v); } static PyObject fortran_call(PyFortranObject fp, PyObject arg, PyObject kw) { int i = 0; / printf("fortran call name=%s,func=%p,data=%p,%p\n",fp->defs[i].name, fp->defs[i].func,fp->defs[i].data,&fp->defs[i].data); / if (fp->defs[i].rank == -1) { / is Fortran routine / if (fp->defs[i].func == NULL) { PyErr_Format(PyExc_RuntimeError, "no function to call"); return NULL; } else if (fp->defs[i].data == NULL) / dummy routine / return (((fortranfunc)(fp->defs[i].func)))((PyObject )fp, arg, kw, NULL); else return (((fortranfunc)(fp->defs[i].func)))( (PyObject )fp, arg, kw, (void )fp->defs[i].data); } PyErr_Format(PyExc_TypeError, "this fortran object is not callable"); return NULL; } static PyObject * fortran_repr(PyFortranObject fp) { PyObject name = NULL, repr = NULL; name = PyObject_GetAttrString((PyObject )fp, "__name__"); PyErr_Clear(); if (name != NULL && PyUnicode_Check(name)) { repr = PyUnicode_FromFormat("<fortran %U>", name); } else { repr = PyUnicode_FromString("<fortran object>"); } Py_XDECREF(name); return repr; } PyTypeObject PyFortran_Type = { PyVarObject_HEAD_INIT(NULL, 0).tp_name = "fortran", .tp_basicsize = sizeof(PyFortranObject), .tp_dealloc = (destructor)fortran_dealloc, .tp_getattr = (getattrfunc)fortran_getattr, .tp_setattr = (setattrfunc)fortran_setattr, .tp_repr = (reprfunc)fortran_repr, .tp_call = (ternaryfunc)fortran_call, }; /*********************** f2py_report_atexit ****************************/ #ifdef F2PY_REPORT_ATEXIT static int passed_time = 0; static int passed_counter = 0; static int passed_call_time = 0; static struct timeb start_time; static struct timeb stop_time; static struct timeb start_call_time; static struct timeb stop_call_time; static int cb_passed_time = 0; static int cb_passed_counter = 0; static int cb_passed_call_time = 0; static struct timeb cb_start_time; static struct timeb cb_stop_time; static struct timeb cb_start_call_time; static struct timeb cb_stop_call_time; extern void f2py_start_clock(void) { ftime(&start_time); } extern void f2py_start_call_clock(void) { f2py_stop_clock(); ftime(&start_call_time); } extern void f2py_stop_clock(void) { ftime(&stop_time); passed_time += 1000 (stop_time.time - start_time.time); passed_time += stop_time.millitm - start_time.millitm; } extern void f2py_stop_call_clock(void) { ftime(&stop_call_time); passed_call_time += 1000 * (stop_call_time.time - start_call_time.time); passed_call_time += stop_call_time.millitm - start_call_time.millitm; passed_counter += 1; f2py_start_clock(); } extern void f2py_cb_start_clock(void) { ftime(&cb_start_time); } extern void f2py_cb_start_call_clock(void) { f2py_cb_stop_clock(); ftime(&cb_start_call_time); } extern void f2py_cb_stop_clock(void) { ftime(&cb_stop_time); cb_passed_time += 1000 * (cb_stop_time.time - cb_start_time.time); cb_passed_time += cb_stop_time.millitm - cb_start_time.millitm; } extern void f2py_cb_stop_call_clock(void) { ftime(&cb_stop_call_time); cb_passed_call_time += 1000 * (cb_stop_call_time.time - cb_start_call_time.time); cb_passed_call_time += cb_stop_call_time.millitm - cb_start_call_time.millitm; cb_passed_counter += 1; f2py_cb_start_clock(); } static int f2py_report_on_exit_been_here = 0; extern void f2py_report_on_exit(int exit_flag, void name) { if (f2py_report_on_exit_been_here) { fprintf(stderr, " %s\n", (char )name); return; } f2py_report_on_exit_been_here = 1; fprintf(stderr, " /-----------------------\\\n"); fprintf(stderr, " < F2PY performance report >\n"); fprintf(stderr, " \\-----------------------/\n"); fprintf(stderr, "Overall time spent in ...\n"); fprintf(stderr, "(a) wrapped (Fortran/C) functions : %8d msec\n", passed_call_time); fprintf(stderr, "(b) f2py interface, %6d calls : %8d msec\n", passed_counter, passed_time); fprintf(stderr, "(c) call-back (Python) functions : %8d msec\n", cb_passed_call_time); fprintf(stderr, "(d) f2py call-back interface, %6d calls : %8d msec\n", cb_passed_counter, cb_passed_time); fprintf(stderr, "(e) wrapped (Fortran/C) functions (actual) : %8d msec\n\n", passed_call_time - cb_passed_call_time - cb_passed_time); fprintf(stderr, "Use -DF2PY_REPORT_ATEXIT_DISABLE to disable this message.\n"); fprintf(stderr, "Exit status: %d\n", exit_flag); fprintf(stderr, "Modules : %s\n", (char )name); } #endif /******************* report on array copy *************************/ #ifdef F2PY_REPORT_ON_ARRAY_COPY static void f2py_report_on_array_copy(PyArrayObject arr) { const npy_intp arr_size = PyArray_Size((PyObject )arr); if (arr_size > F2PY_REPORT_ON_ARRAY_COPY) { fprintf(stderr, "copied an array: size=%ld, elsize=%" NPY_INTP_FMT "\n", arr_size, (npy_intp)PyArray_ITEMSIZE(arr)); } } static void f2py_report_on_array_copy_fromany(void) { fprintf(stderr, "created an array from object\n"); } #define F2PY_REPORT_ON_ARRAY_COPY_FROMARR \ f2py_report_on_array_copy((PyArrayObject )arr) #define F2PY_REPORT_ON_ARRAY_COPY_FROMANY f2py_report_on_array_copy_fromany() #else #define F2PY_REPORT_ON_ARRAY_COPY_FROMARR #define F2PY_REPORT_ON_ARRAY_COPY_FROMANY #endif /*********************** array_from_obj ****************************/ / * File: array_from_pyobj.c * * Description: * ------------ * Provides array_from_pyobj function that returns a contiguous array * object with the given dimensions and required storage order, either * in row-major (C) or column-major (Fortran) order. The function * array_from_pyobj is very flexible about its Python object argument * that can be any number, list, tuple, or array. * * array_from_pyobj is used in f2py generated Python extension * modules. * * Author: Pearu Peterson <pearu@cens.ioc.ee> * Created: 13-16 January 2002 * $Id: fortranobject.c,v 1.52 2005/07/11 07:44:20 pearu Exp $ / static int check_and_fix_dimensions(const PyArrayObject arr, const int rank, npy_intp dims, const char errmess); static int find_first_negative_dimension(const int rank, const npy_intp dims) { for (int i = 0; i < rank; ++i) { if (dims[i] < 0) { return i; } } return -1; } #ifdef DEBUG_COPY_ND_ARRAY void dump_dims(int rank, npy_intp const dims) { int i; printf("["); for (i = 0; i < rank; ++i) { printf("%3" NPY_INTP_FMT, dims[i]); } printf("]\n"); } void dump_attrs(const PyArrayObject obj) { const PyArrayObject_fields arr = (const PyArrayObject_fields )obj; int rank = PyArray_NDIM(arr); npy_intp size = PyArray_Size((PyObject )arr); printf("\trank = %d, flags = %d, size = %" NPY_INTP_FMT "\n", rank, arr->flags, size); printf("\tstrides = "); dump_dims(rank, arr->strides); printf("\tdimensions = "); dump_dims(rank, arr->dimensions); } #endif #define SWAPTYPE(a, b, t) \ { \ t c; \ c = (a); \ (a) = (b); \ (b) = c; \ } static int swap_arrays(PyArrayObject obj1, PyArrayObject obj2) { PyArrayObject_fields arr1 = (PyArrayObject_fields )obj1, arr2 = (PyArrayObject_fields )obj2; SWAPTYPE(arr1->data, arr2->data, char ); SWAPTYPE(arr1->nd, arr2->nd, int); SWAPTYPE(arr1->dimensions, arr2->dimensions, npy_intp ); SWAPTYPE(arr1->strides, arr2->strides, npy_intp ); SWAPTYPE(arr1->base, arr2->base, PyObject ); SWAPTYPE(arr1->descr, arr2->descr, PyArray_Descr ); SWAPTYPE(arr1->flags, arr2->flags, int); / SWAPTYPE(arr1->weakreflist,arr2->weakreflist,PyObject); / return 0; } #define ARRAY_ISCOMPATIBLE(arr,type_num) \ ((PyArray_ISINTEGER(arr) && PyTypeNum_ISINTEGER(type_num)) \|\| \ (PyArray_ISFLOAT(arr) && PyTypeNum_ISFLOAT(type_num)) \|\| \ (PyArray_ISCOMPLEX(arr) && PyTypeNum_ISCOMPLEX(type_num)) \|\| \ (PyArray_ISBOOL(arr) && PyTypeNum_ISBOOL(type_num)) \|\| \ (PyArray_ISSTRING(arr) && PyTypeNum_ISSTRING(type_num))) static int get_elsize(PyObject obj) { / get_elsize determines array itemsize from a Python object. Returns elsize if successful, -1 otherwise. Supported types of the input are: numpy.ndarray, bytes, str, tuple, list. / if (PyArray_Check(obj)) { return PyArray_DESCR((PyArrayObject )obj)->elsize; } else if (PyBytes_Check(obj)) { return PyBytes_GET_SIZE(obj); } else if (PyUnicode_Check(obj)) { return PyUnicode_GET_LENGTH(obj); } else if (PySequence_Check(obj)) { PyObject* fast = PySequence_Fast(obj, "f2py:fortranobject.c:get_elsize"); if (fast != NULL) { Py_ssize_t i, n = PySequence_Fast_GET_SIZE(fast); int sz, elsize = 0; for (i=0; i<n; i++) { sz = get_elsize(PySequence_Fast_GET_ITEM(fast, i) /* borrowed /); if (sz > elsize) { elsize = sz; } } Py_DECREF(fast); return elsize; } } return -1; } extern PyArrayObject ndarray_from_pyobj(const int type_num, const int elsize_, npy_intp dims, const int rank, const int intent, PyObject obj, const char errmess) { / * Return an array with given element type and shape from a Python * object while taking into account the usage intent of the array. * * - element type is defined by type_num and elsize * - shape is defined by dims and rank * * ndarray_from_pyobj is used to convert Python object arguments * to numpy ndarrays with given type and shape that data is passed * to interfaced Fortran or C functions. * * errmess (if not NULL), contains a prefix of an error message * for an exception to be triggered within this function. * * Negative elsize value means that elsize is to be determined * from the Python object in runtime. * * Note on strings * --------------- * * String type (type_num == NPY_STRING) does not have fixed * element size and, by default, the type object sets it to * 0. Therefore, for string types, one has to use elsize * argument. For other types, elsize value is ignored. * * NumPy defines the type of a fixed-width string as * dtype('S<width>'). In addition, there is also dtype('c'), that * appears as dtype('S1') (these have the same type_num value), * but is actually different (.char attribute is either 'S' or * 'c', respecitely). * * In Fortran, character arrays and strings are different * concepts. The relation between Fortran types, NumPy dtypes, * and type_num-elsize pairs, is defined as follows: * * character5 foo \| dtype('S5') \| elsize=5, shape=() character(5) foo \| dtype('S1') \| elsize=1, shape=(5) * character5 foo(n) \| dtype('S5') \| elsize=5, shape=(n,) character(5) foo(n) \| dtype('S1') \| elsize=1, shape=(5, n) * character() foo \| dtype('S') \| elsize=-1, shape=() * * Note about reference counting * ----------------------------- * * If the caller returns the array to Python, it must be done with * Py_BuildValue("N",arr). Otherwise, if obj!=arr then the caller * must call Py_DECREF(arr). * * Note on intent(cache,out,..) * ---------------------------- * Don't expect correct data when returning intent(cache) array. * / char mess[F2PY_MESSAGE_BUFFER_SIZE]; PyArrayObject arr = NULL; int elsize = (elsize_ < 0 ? get_elsize(obj) : elsize_); if (elsize < 0) { if (errmess != NULL) { strcpy(mess, errmess); } sprintf(mess + strlen(mess), " -- failed to determine element size from %s", Py_TYPE(obj)->tp_name); PyErr_SetString(PyExc_SystemError, mess); return NULL; } PyArray_Descr * descr = get_descr_from_type_and_elsize(type_num, elsize); // new reference if (descr == NULL) { return NULL; } elsize = descr->elsize; if ((intent & F2PY_INTENT_HIDE) \|\| ((intent & F2PY_INTENT_CACHE) && (obj == Py_None)) \|\| ((intent & F2PY_OPTIONAL) && (obj == Py_None)) ) { /* intent(cache), optional, intent(hide) / int ineg = find_first_negative_dimension(rank, dims); if (ineg >= 0) { int i; strcpy(mess, "failed to create intent(cache\|hide)\|optional array" "-- must have defined dimensions but got ("); for(i = 0; i < rank; ++i) sprintf(mess + strlen(mess), "%" NPY_INTP_FMT ",", dims[i]); strcat(mess, ")"); PyErr_SetString(PyExc_ValueError, mess); Py_DECREF(descr); return NULL; } arr = (PyArrayObject ) \ PyArray_NewFromDescr(&PyArray_Type, descr, rank, dims, NULL, NULL, !(intent & F2PY_INTENT_C), NULL); if (arr == NULL) { Py_DECREF(descr); return NULL; } if (PyArray_ITEMSIZE(arr) != elsize) { strcpy(mess, "failed to create intent(cache\|hide)\|optional array"); sprintf(mess+strlen(mess)," -- expected elsize=%d got %" NPY_INTP_FMT, elsize, (npy_intp)PyArray_ITEMSIZE(arr)); PyErr_SetString(PyExc_ValueError,mess); Py_DECREF(arr); return NULL; } if (!(intent & F2PY_INTENT_CACHE)) { PyArray_FILLWBYTE(arr, 0); } return arr; } if (PyArray_Check(obj)) { arr = (PyArrayObject )obj; if (intent & F2PY_INTENT_CACHE) { / intent(cache) / if (PyArray_ISONESEGMENT(arr) && PyArray_ITEMSIZE(arr) >= elsize) { if (check_and_fix_dimensions(arr, rank, dims, errmess)) { Py_DECREF(descr); return NULL; } if (intent & F2PY_INTENT_OUT) Py_INCREF(arr); Py_DECREF(descr); return arr; } strcpy(mess, "failed to initialize intent(cache) array"); if (!PyArray_ISONESEGMENT(arr)) strcat(mess, " -- input must be in one segment"); if (PyArray_ITEMSIZE(arr) < elsize) sprintf(mess + strlen(mess), " -- expected at least elsize=%d but got " "%" NPY_INTP_FMT, elsize, (npy_intp)PyArray_ITEMSIZE(arr)); PyErr_SetString(PyExc_ValueError, mess); Py_DECREF(descr); return NULL; } / here we have always intent(in) or intent(inout) or intent(inplace) / if (check_and_fix_dimensions(arr, rank, dims, errmess)) { Py_DECREF(descr); return NULL; } / printf("intent alignment=%d\n", F2PY_GET_ALIGNMENT(intent)); printf("alignment check=%d\n", F2PY_CHECK_ALIGNMENT(arr, intent)); int i; for (i=1;i<=16;i++) printf("i=%d isaligned=%d\n", i, ARRAY_ISALIGNED(arr, i)); / if ((! (intent & F2PY_INTENT_COPY)) && PyArray_ITEMSIZE(arr) == elsize && ARRAY_ISCOMPATIBLE(arr,type_num) && F2PY_CHECK_ALIGNMENT(arr, intent)) { if ((intent & F2PY_INTENT_INOUT \|\| intent & F2PY_INTENT_INPLACE) ? ((intent & F2PY_INTENT_C) ? PyArray_ISCARRAY(arr) : PyArray_ISFARRAY(arr)) : ((intent & F2PY_INTENT_C) ? PyArray_ISCARRAY_RO(arr) : PyArray_ISFARRAY_RO(arr))) { if ((intent & F2PY_INTENT_OUT)) { Py_INCREF(arr); } / Returning input array / Py_DECREF(descr); return arr; } } if (intent & F2PY_INTENT_INOUT) { strcpy(mess, "failed to initialize intent(inout) array"); / Must use PyArray_ISARRAY because intent(inout) requires writable input / if ((intent & F2PY_INTENT_C) && !PyArray_ISCARRAY(arr)) strcat(mess, " -- input not contiguous"); if (!(intent & F2PY_INTENT_C) && !PyArray_ISFARRAY(arr)) strcat(mess, " -- input not fortran contiguous"); if (PyArray_ITEMSIZE(arr) != elsize) sprintf(mess + strlen(mess), " -- expected elsize=%d but got %" NPY_INTP_FMT, elsize, (npy_intp)PyArray_ITEMSIZE(arr) ); if (!(ARRAY_ISCOMPATIBLE(arr, type_num))) { sprintf(mess + strlen(mess), " -- input '%c' not compatible to '%c'", PyArray_DESCR(arr)->type, descr->type); } if (!(F2PY_CHECK_ALIGNMENT(arr, intent))) sprintf(mess + strlen(mess), " -- input not %d-aligned", F2PY_GET_ALIGNMENT(intent)); PyErr_SetString(PyExc_ValueError, mess); Py_DECREF(descr); return NULL; } / here we have always intent(in) or intent(inplace) / { PyArrayObject retarr = (PyArrayObject ) \ PyArray_NewFromDescr(&PyArray_Type, descr, PyArray_NDIM(arr), PyArray_DIMS(arr), NULL, NULL, !(intent & F2PY_INTENT_C), NULL); if (retarr==NULL) { Py_DECREF(descr); return NULL; } F2PY_REPORT_ON_ARRAY_COPY_FROMARR; if (PyArray_CopyInto(retarr, arr)) { Py_DECREF(retarr); return NULL; } if (intent & F2PY_INTENT_INPLACE) { if (swap_arrays(arr,retarr)) { Py_DECREF(retarr); return NULL; / XXX: set exception / } Py_XDECREF(retarr); if (intent & F2PY_INTENT_OUT) Py_INCREF(arr); } else { arr = retarr; } } return arr; } if ((intent & F2PY_INTENT_INOUT) \|\| (intent & F2PY_INTENT_INPLACE) \|\| (intent & F2PY_INTENT_CACHE)) { PyErr_Format(PyExc_TypeError, "failed to initialize intent(inout\|inplace\|cache) " "array, input '%s' object is not an array", Py_TYPE(obj)->tp_name); Py_DECREF(descr); return NULL; } { F2PY_REPORT_ON_ARRAY_COPY_FROMANY; arr = (PyArrayObject )PyArray_FromAny( obj, descr, 0, 0, ((intent & F2PY_INTENT_C) ? NPY_ARRAY_CARRAY : NPY_ARRAY_FARRAY) \| NPY_ARRAY_FORCECAST, NULL); // Warning: in the case of NPY_STRING, PyArray_FromAny may // reset descr->elsize, e.g. dtype('S0') becomes dtype('S1'). if (arr == NULL) { Py_DECREF(descr); return NULL; } if (type_num != NPY_STRING && PyArray_ITEMSIZE(arr) != elsize) { // This is internal sanity tests: elsize has been set to // descr->elsize in the beginning of this function. strcpy(mess, "failed to initialize intent(in) array"); sprintf(mess + strlen(mess), " -- expected elsize=%d got %" NPY_INTP_FMT, elsize, (npy_intp)PyArray_ITEMSIZE(arr)); PyErr_SetString(PyExc_ValueError, mess); Py_DECREF(arr); return NULL; } if (check_and_fix_dimensions(arr, rank, dims, errmess)) { Py_DECREF(arr); return NULL; } return arr; } } extern PyArrayObject * array_from_pyobj(const int type_num, npy_intp dims, const int rank, const int intent, PyObject obj) { /* Same as ndarray_from_pyobj but with elsize determined from type, if possible. Provided for backward compatibility. / PyArray_Descr descr = PyArray_DescrFromType(type_num); int elsize = descr->elsize; Py_DECREF(descr); return ndarray_from_pyobj(type_num, elsize, dims, rank, intent, obj, NULL); } /****************************************/ / Helper functions for array_from_pyobj / /***************************************/ static int check_and_fix_dimensions(const PyArrayObject arr, const int rank, npy_intp dims, const char errmess) { /* * This function fills in blanks (that are -1's) in dims list using * the dimensions from arr. It also checks that non-blank dims will * match with the corresponding values in arr dimensions. * * Returns 0 if the function is successful. * * If an error condition is detected, an exception is set and 1 is * returned. / char mess[F2PY_MESSAGE_BUFFER_SIZE]; const npy_intp arr_size = (PyArray_NDIM(arr)) ? PyArray_Size((PyObject )arr) : 1; #ifdef DEBUG_COPY_ND_ARRAY dump_attrs(arr); printf("check_and_fix_dimensions:init: dims="); dump_dims(rank, dims); #endif if (rank > PyArray_NDIM(arr)) { /* [1,2] -> [[1],[2]]; 1 -> [[1]] / npy_intp new_size = 1; int free_axe = -1; int i; npy_intp d; / Fill dims where -1 or 0; check dimensions; calc new_size; / for (i = 0; i < PyArray_NDIM(arr); ++i) { d = PyArray_DIM(arr, i); if (dims[i] >= 0) { if (d > 1 && dims[i] != d) { PyErr_Format( PyExc_ValueError, "%d-th dimension must be fixed to %" NPY_INTP_FMT " but got %" NPY_INTP_FMT "\n", i, dims[i], d); return 1; } if (!dims[i]) dims[i] = 1; } else { dims[i] = d ? d : 1; } new_size = dims[i]; } for (i = PyArray_NDIM(arr); i < rank; ++i) if (dims[i] > 1) { PyErr_Format(PyExc_ValueError, "%d-th dimension must be %" NPY_INTP_FMT " but got 0 (not defined).\n", i, dims[i]); return 1; } else if (free_axe < 0) free_axe = i; else dims[i] = 1; if (free_axe >= 0) { dims[free_axe] = arr_size / new_size; new_size = dims[free_axe]; } if (new_size != arr_size) { PyErr_Format(PyExc_ValueError, "unexpected array size: new_size=%" NPY_INTP_FMT ", got array with arr_size=%" NPY_INTP_FMT " (maybe too many free indices)\n", new_size, arr_size); return 1; } } else if (rank == PyArray_NDIM(arr)) { npy_intp new_size = 1; int i; npy_intp d; for (i = 0; i < rank; ++i) { d = PyArray_DIM(arr, i); if (dims[i] >= 0) { if (d > 1 && d != dims[i]) { if (errmess != NULL) { strcpy(mess, errmess); } sprintf(mess + strlen(mess), " -- %d-th dimension must be fixed to %" NPY_INTP_FMT " but got %" NPY_INTP_FMT, i, dims[i], d); PyErr_SetString(PyExc_ValueError, mess); return 1; } if (!dims[i]) dims[i] = 1; } else dims[i] = d; new_size = dims[i]; } if (new_size != arr_size) { PyErr_Format(PyExc_ValueError, "unexpected array size: new_size=%" NPY_INTP_FMT ", got array with arr_size=%" NPY_INTP_FMT "\n", new_size, arr_size); return 1; } } else { /* [[1,2]] -> [[1],[2]] / int i, j; npy_intp d; int effrank; npy_intp size; for (i = 0, effrank = 0; i < PyArray_NDIM(arr); ++i) if (PyArray_DIM(arr, i) > 1) ++effrank; if (dims[rank - 1] >= 0) if (effrank > rank) { PyErr_Format(PyExc_ValueError, "too many axes: %d (effrank=%d), " "expected rank=%d\n", PyArray_NDIM(arr), effrank, rank); return 1; } for (i = 0, j = 0; i < rank; ++i) { while (j < PyArray_NDIM(arr) && PyArray_DIM(arr, j) < 2) ++j; if (j >= PyArray_NDIM(arr)) d = 1; else d = PyArray_DIM(arr, j++); if (dims[i] >= 0) { if (d > 1 && d != dims[i]) { if (errmess != NULL) { strcpy(mess, errmess); } sprintf(mess + strlen(mess), " -- %d-th dimension must be fixed to %" NPY_INTP_FMT " but got %" NPY_INTP_FMT " (real index=%d)\n", i, dims[i], d, j-1); PyErr_SetString(PyExc_ValueError, mess); return 1; } if (!dims[i]) dims[i] = 1; } else dims[i] = d; } for (i = rank; i < PyArray_NDIM(arr); ++i) { / [[1,2],[3,4]] -> [1,2,3,4] / while (j < PyArray_NDIM(arr) && PyArray_DIM(arr, j) < 2) ++j; if (j >= PyArray_NDIM(arr)) d = 1; else d = PyArray_DIM(arr, j++); dims[rank - 1] = d; } for (i = 0, size = 1; i < rank; ++i) size = dims[i]; if (size != arr_size) { char msg[200]; int len; snprintf(msg, sizeof(msg), "unexpected array size: size=%" NPY_INTP_FMT ", arr_size=%" NPY_INTP_FMT ", rank=%d, effrank=%d, arr.nd=%d, dims=[", size, arr_size, rank, effrank, PyArray_NDIM(arr)); for (i = 0; i < rank; ++i) { len = strlen(msg); snprintf(msg + len, sizeof(msg) - len, " %" NPY_INTP_FMT, dims[i]); } len = strlen(msg); snprintf(msg + len, sizeof(msg) - len, " ], arr.dims=["); for (i = 0; i < PyArray_NDIM(arr); ++i) { len = strlen(msg); snprintf(msg + len, sizeof(msg) - len, " %" NPY_INTP_FMT, PyArray_DIM(arr, i)); } len = strlen(msg); snprintf(msg + len, sizeof(msg) - len, " ]\n"); PyErr_SetString(PyExc_ValueError, msg); return 1; } } #ifdef DEBUG_COPY_ND_ARRAY printf("check_and_fix_dimensions:end: dims="); dump_dims(rank, dims); #endif return 0; } / End of file: array_from_pyobj.c / /********************** copy_ND_array ****************************/ extern int copy_ND_array(const PyArrayObject arr, PyArrayObject out) { F2PY_REPORT_ON_ARRAY_COPY_FROMARR; return PyArray_CopyInto(out, (PyArrayObject )arr); } /******************* Various utility functions ********************/ extern int f2py_describe(PyObject obj, char buf) { / Write the description of a Python object to buf. The caller must provide buffer with size sufficient to write the description. Return 1 on success. / char localbuf[F2PY_MESSAGE_BUFFER_SIZE]; if (PyBytes_Check(obj)) { sprintf(localbuf, "%d-%s", (npy_int)PyBytes_GET_SIZE(obj), Py_TYPE(obj)->tp_name); } else if (PyUnicode_Check(obj)) { sprintf(localbuf, "%d-%s", (npy_int)PyUnicode_GET_LENGTH(obj), Py_TYPE(obj)->tp_name); } else if (PyArray_CheckScalar(obj)) { PyArrayObject arr = (PyArrayObject)obj; sprintf(localbuf, "%c%" NPY_INTP_FMT "-%s-scalar", PyArray_DESCR(arr)->kind, PyArray_ITEMSIZE(arr), Py_TYPE(obj)->tp_name); } else if (PyArray_Check(obj)) { int i; PyArrayObject arr = (PyArrayObject)obj; strcpy(localbuf, "("); for (i=0; i<PyArray_NDIM(arr); i++) { if (i) { strcat(localbuf, " "); } sprintf(localbuf + strlen(localbuf), "%" NPY_INTP_FMT ",", PyArray_DIM(arr, i)); } sprintf(localbuf + strlen(localbuf), ")-%c%" NPY_INTP_FMT "-%s", PyArray_DESCR(arr)->kind, PyArray_ITEMSIZE(arr), Py_TYPE(obj)->tp_name); } else if (PySequence_Check(obj)) { sprintf(localbuf, "%d-%s", (npy_int)PySequence_Length(obj), Py_TYPE(obj)->tp_name); } else { sprintf(localbuf, "%s instance", Py_TYPE(obj)->tp_name); } // TODO: detect the size of buf and make sure that size(buf) >= size(localbuf). strcpy(buf, localbuf); return 1; } extern npy_intp f2py_size_impl(PyArrayObject var, ...) { npy_intp sz = 0; npy_intp dim; npy_intp rank; va_list argp; va_start(argp, var); dim = va_arg(argp, npy_int); if (dim==-1) { sz = PyArray_SIZE(var); } else { rank = PyArray_NDIM(var); if (dim>=1 && dim<=rank) sz = PyArray_DIM(var, dim-1); else fprintf(stderr, "f2py_size: 2nd argument value=%" NPY_INTP_FMT " fails to satisfy 1<=value<=%" NPY_INTP_FMT ". Result will be 0.\n", dim, rank); } va_end(argp); return sz; } /********************************************/ / Compatibility functions for Python >= 3.0 / /*******************************************/ PyObject F2PyCapsule_FromVoidPtr(void ptr, void (dtor)(PyObject )) { PyObject ret = PyCapsule_New(ptr, NULL, dtor); if (ret == NULL) { PyErr_Clear(); } return ret; } void * F2PyCapsule_AsVoidPtr(PyObject obj) { void ret = PyCapsule_GetPointer(obj, NULL); if (ret == NULL) { PyErr_Clear(); } return ret; } int F2PyCapsule_Check(PyObject ptr) { return PyCapsule_CheckExact(ptr); } #ifdef __cplusplus } #endif /********************** EOF fortranobject.c ****************************/ ��fortranobject.h��0000644��00000013313�15004413033�0007551 0��ustar�00��#ifndef Py_FORTRANOBJECT_H #define Py_FORTRANOBJECT_H #ifdef __cplusplus extern "C" { #endif #include <Python.h> #ifndef NPY_NO_DEPRECATED_API #define NPY_NO_DEPRECATED_API NPY_API_VERSION #endif #ifdef FORTRANOBJECT_C #define NO_IMPORT_ARRAY #endif #define PY_ARRAY_UNIQUE_SYMBOL _npy_f2py_ARRAY_API #include "numpy/arrayobject.h" #include "numpy/npy_3kcompat.h" #ifdef F2PY_REPORT_ATEXIT #include <sys/timeb.h> // clang-format off extern void f2py_start_clock(void); extern void f2py_stop_clock(void); extern void f2py_start_call_clock(void); extern void f2py_stop_call_clock(void); extern void f2py_cb_start_clock(void); extern void f2py_cb_stop_clock(void); extern void f2py_cb_start_call_clock(void); extern void f2py_cb_stop_call_clock(void); extern void f2py_report_on_exit(int, void ); // clang-format on #endif #ifdef DMALLOC #include "dmalloc.h" #endif /* Fortran object interface / / 123456789-123456789-123456789-123456789-123456789-123456789-123456789-12 PyFortranObject represents various Fortran objects: Fortran (module) routines, COMMON blocks, module data. Author: Pearu Peterson <pearu@cens.ioc.ee> / #define F2PY_MAX_DIMS 40 #define F2PY_MESSAGE_BUFFER_SIZE 300 // Increase on "stack smashing detected" typedef void (f2py_set_data_func)(char , npy_intp ); typedef void (f2py_void_func)(void); typedef void (f2py_init_func)(int , npy_intp , f2py_set_data_func, int ); /typedef void* (f2py_c_func)(void,...);/ typedef void (f2pycfunc)(void); typedef struct { char name; /* attribute (array\|\|routine) name / int rank; / array rank, 0 for scalar, max is F2PY_MAX_DIMS, \|\| rank=-1 for Fortran routine / struct { npy_intp d[F2PY_MAX_DIMS]; } dims; / dimensions of the array, \|\| not used / int type; / PyArray_<type> \|\| not used / int elsize; / Element size \|\| not used / char data; /* pointer to array \|\| Fortran routine / f2py_init_func func; / initialization function for allocatable arrays: func(&rank,dims,set_ptr_func,name,len(name)) \|\| C/API wrapper for Fortran routine / char doc; /* documentation string; only recommended for routines. / } FortranDataDef; typedef struct { PyObject_HEAD int len; / Number of attributes / FortranDataDef defs; /* An array of FortranDataDef's / PyObject dict; /* Fortran object attribute dictionary / } PyFortranObject; #define PyFortran_Check(op) (Py_TYPE(op) == &PyFortran_Type) #define PyFortran_Check1(op) (0 == strcmp(Py_TYPE(op)->tp_name, "fortran")) extern PyTypeObject PyFortran_Type; extern int F2PyDict_SetItemString(PyObject dict, char name, PyObject obj); extern PyObject * PyFortranObject_New(FortranDataDef defs, f2py_void_func init); extern PyObject PyFortranObject_NewAsAttr(FortranDataDef defs); PyObject F2PyCapsule_FromVoidPtr(void ptr, void (dtor)(PyObject )); void F2PyCapsule_AsVoidPtr(PyObject obj); int F2PyCapsule_Check(PyObject ptr); extern void * F2PySwapThreadLocalCallbackPtr(char key, void ptr); extern void * F2PyGetThreadLocalCallbackPtr(char key); #define ISCONTIGUOUS(m) (PyArray_FLAGS(m) & NPY_ARRAY_C_CONTIGUOUS) #define F2PY_INTENT_IN 1 #define F2PY_INTENT_INOUT 2 #define F2PY_INTENT_OUT 4 #define F2PY_INTENT_HIDE 8 #define F2PY_INTENT_CACHE 16 #define F2PY_INTENT_COPY 32 #define F2PY_INTENT_C 64 #define F2PY_OPTIONAL 128 #define F2PY_INTENT_INPLACE 256 #define F2PY_INTENT_ALIGNED4 512 #define F2PY_INTENT_ALIGNED8 1024 #define F2PY_INTENT_ALIGNED16 2048 #define ARRAY_ISALIGNED(ARR, SIZE) ((size_t)(PyArray_DATA(ARR)) % (SIZE) == 0) #define F2PY_ALIGN4(intent) (intent & F2PY_INTENT_ALIGNED4) #define F2PY_ALIGN8(intent) (intent & F2PY_INTENT_ALIGNED8) #define F2PY_ALIGN16(intent) (intent & F2PY_INTENT_ALIGNED16) #define F2PY_GET_ALIGNMENT(intent) \ (F2PY_ALIGN4(intent) \ ? 4 \ : (F2PY_ALIGN8(intent) ? 8 : (F2PY_ALIGN16(intent) ? 16 : 1))) #define F2PY_CHECK_ALIGNMENT(arr, intent) \ ARRAY_ISALIGNED(arr, F2PY_GET_ALIGNMENT(intent)) #define F2PY_ARRAY_IS_CHARACTER_COMPATIBLE(arr) ((PyArray_DESCR(arr)->type_num == NPY_STRING && PyArray_DESCR(arr)->elsize >= 1) \ \|\| PyArray_DESCR(arr)->type_num == NPY_UINT8) #define F2PY_IS_UNICODE_ARRAY(arr) (PyArray_DESCR(arr)->type_num == NPY_UNICODE) extern PyArrayObject ndarray_from_pyobj(const int type_num, const int elsize_, npy_intp dims, const int rank, const int intent, PyObject obj, const char errmess); extern PyArrayObject array_from_pyobj(const int type_num, npy_intp dims, const int rank, const int intent, PyObject obj); extern int copy_ND_array(const PyArrayObject in, PyArrayObject out); #ifdef DEBUG_COPY_ND_ARRAY extern void dump_attrs(const PyArrayObject arr); #endif extern int f2py_describe(PyObject obj, char buf); / Utility CPP macros and functions that can be used in signature file expressions. See signature-file.rst for documentation. / #define f2py_itemsize(var) (PyArray_DESCR((capi_ ## var ## _as_array))->elsize) #define f2py_size(var, ...) f2py_size_impl((PyArrayObject )(capi_ ## var ## _as_array), ## __VA_ARGS__, -1) #define f2py_rank(var) var ## _Rank #define f2py_shape(var,dim) var ## _Dims[dim] #define f2py_len(var) f2py_shape(var,0) #define f2py_fshape(var,dim) f2py_shape(var,rank(var)-dim-1) #define f2py_flen(var) f2py_fshape(var,0) #define f2py_slen(var) capi_ ## var ## _len extern npy_intp f2py_size_impl(PyArrayObject* var, ...); #ifdef __cplusplus } #endif #endif /* !Py_FORTRANOBJECT_H / ��abstract_interface/foo.f90��0000644��00000001222�15004441047�0011466 0��ustar�00��module ops_module abstract interface subroutine op(x, y, z) integer, intent(in) :: x, y integer, intent(out) :: z end subroutine end interface contains subroutine foo(x, y, r1, r2) integer, intent(in) :: x, y integer, intent(out) :: r1, r2 procedure (op) add1, add2 procedure (op), pointer::p p=>add1 call p(x, y, r1) p=>add2 call p(x, y, r2) end subroutine end module subroutine add1(x, y, z) integer, intent(in) :: x, y integer, intent(out) :: z z = x + y end subroutine subroutine add2(x, y, z) integer, intent(in) :: x, y integer, intent(out) :: z z = x + 2 y end subroutine ��abstract_interface/gh18403_mod.f90��0000644��00000000151�15004441047�0012540 0��ustar�00��module test abstract interface subroutine foo() end subroutine end interface end module test ��array_from_pyobj/wrapmodule.c��0000644��00000016203�15004441047�0012434 0��ustar�00��/* * This file was auto-generated with f2py (version:2_1330) and hand edited by * Pearu for testing purposes. Do not edit this file unless you know what you * are doing!!! / #ifdef __cplusplus extern "C" { #endif /******************** See f2py2e/cfuncs.py: includes ********************/ #define PY_SSIZE_T_CLEAN #include <Python.h> #include "fortranobject.h" #include <math.h> static PyObject wrap_error; static PyObject wrap_module; /********************************* call *********************************/ static char doc_f2py_rout_wrap_call[] = "\ Function signature:\n\ arr = call(type_num,dims,intent,obj)\n\ Required arguments:\n" " type_num : input int\n" " dims : input int-sequence\n" " intent : input int\n" " obj : input python object\n" "Return objects:\n" " arr : array"; static PyObject f2py_rout_wrap_call(PyObject capi_self, PyObject capi_args) { PyObject * volatile capi_buildvalue = NULL; int type_num = 0; int elsize = 0; npy_intp dims = NULL; PyObject dims_capi = Py_None; int rank = 0; int intent = 0; PyArrayObject capi_arr_tmp = NULL; PyObject arr_capi = Py_None; int i; if (!PyArg_ParseTuple(capi_args,"iiOiO\|:wrap.call",\ &type_num,&elsize,&dims_capi,&intent,&arr_capi)) return NULL; rank = PySequence_Length(dims_capi); dims = malloc(ranksizeof(npy_intp)); for (i=0;i<rank;++i) { PyObject tmp; tmp = PySequence_GetItem(dims_capi, i); if (tmp == NULL) { goto fail; } dims[i] = (npy_intp)PyLong_AsLong(tmp); Py_DECREF(tmp); if (dims[i] == -1 && PyErr_Occurred()) { goto fail; } } capi_arr_tmp = ndarray_from_pyobj(type_num,elsize,dims,rank,intent\|F2PY_INTENT_OUT,arr_capi,"wrap.call failed"); if (capi_arr_tmp == NULL) { free(dims); return NULL; } capi_buildvalue = Py_BuildValue("N",capi_arr_tmp); free(dims); return capi_buildvalue; fail: free(dims); return NULL; } static char doc_f2py_rout_wrap_attrs[] = "\ Function signature:\n\ arr = array_attrs(arr)\n\ Required arguments:\n" " arr : input array object\n" "Return objects:\n" " data : data address in hex\n" " nd : int\n" " dimensions : tuple\n" " strides : tuple\n" " base : python object\n" " (kind,type,type_num,elsize,alignment) : 4-tuple\n" " flags : int\n" " itemsize : int\n" ; static PyObject f2py_rout_wrap_attrs(PyObject capi_self, PyObject capi_args) { PyObject arr_capi = Py_None; PyArrayObject arr = NULL; PyObject dimensions = NULL; PyObject strides = NULL; char s[100]; int i; memset(s,0,100); if (!PyArg_ParseTuple(capi_args,"O!\|:wrap.attrs", &PyArray_Type,&arr_capi)) return NULL; arr = (PyArrayObject )arr_capi; sprintf(s,"%p",PyArray_DATA(arr)); dimensions = PyTuple_New(PyArray_NDIM(arr)); strides = PyTuple_New(PyArray_NDIM(arr)); for (i=0;i<PyArray_NDIM(arr);++i) { PyTuple_SetItem(dimensions,i,PyLong_FromLong(PyArray_DIM(arr,i))); PyTuple_SetItem(strides,i,PyLong_FromLong(PyArray_STRIDE(arr,i))); } return Py_BuildValue("siNNO(cciii)ii",s,PyArray_NDIM(arr), dimensions,strides, (PyArray_BASE(arr)==NULL?Py_None:PyArray_BASE(arr)), PyArray_DESCR(arr)->kind, PyArray_DESCR(arr)->type, PyArray_TYPE(arr), PyArray_ITEMSIZE(arr), PyArray_DESCR(arr)->alignment, PyArray_FLAGS(arr), PyArray_ITEMSIZE(arr)); } static PyMethodDef f2py_module_methods[] = { {"call",f2py_rout_wrap_call,METH_VARARGS,doc_f2py_rout_wrap_call}, {"array_attrs",f2py_rout_wrap_attrs,METH_VARARGS,doc_f2py_rout_wrap_attrs}, {NULL,NULL} }; static struct PyModuleDef moduledef = { PyModuleDef_HEAD_INIT, "test_array_from_pyobj_ext", NULL, -1, f2py_module_methods, NULL, NULL, NULL, NULL }; PyMODINIT_FUNC PyInit_test_array_from_pyobj_ext(void) { PyObject m,d, s; m = wrap_module = PyModule_Create(&moduledef); Py_SET_TYPE(&PyFortran_Type, &PyType_Type); import_array(); if (PyErr_Occurred()) Py_FatalError("can't initialize module wrap (failed to import numpy)"); d = PyModule_GetDict(m); s = PyUnicode_FromString("This module 'wrap' is auto-generated with f2py (version:2_1330).\nFunctions:\n" " arr = call(type_num,dims,intent,obj)\n" "."); PyDict_SetItemString(d, "__doc__", s); wrap_error = PyErr_NewException ("wrap.error", NULL, NULL); Py_DECREF(s); #define ADDCONST(NAME, CONST) \ s = PyLong_FromLong(CONST); \ PyDict_SetItemString(d, NAME, s); \ Py_DECREF(s) ADDCONST("F2PY_INTENT_IN", F2PY_INTENT_IN); ADDCONST("F2PY_INTENT_INOUT", F2PY_INTENT_INOUT); ADDCONST("F2PY_INTENT_OUT", F2PY_INTENT_OUT); ADDCONST("F2PY_INTENT_HIDE", F2PY_INTENT_HIDE); ADDCONST("F2PY_INTENT_CACHE", F2PY_INTENT_CACHE); ADDCONST("F2PY_INTENT_COPY", F2PY_INTENT_COPY); ADDCONST("F2PY_INTENT_C", F2PY_INTENT_C); ADDCONST("F2PY_OPTIONAL", F2PY_OPTIONAL); ADDCONST("F2PY_INTENT_INPLACE", F2PY_INTENT_INPLACE); ADDCONST("NPY_BOOL", NPY_BOOL); ADDCONST("NPY_BYTE", NPY_BYTE); ADDCONST("NPY_UBYTE", NPY_UBYTE); ADDCONST("NPY_SHORT", NPY_SHORT); ADDCONST("NPY_USHORT", NPY_USHORT); ADDCONST("NPY_INT", NPY_INT); ADDCONST("NPY_UINT", NPY_UINT); ADDCONST("NPY_INTP", NPY_INTP); ADDCONST("NPY_UINTP", NPY_UINTP); ADDCONST("NPY_LONG", NPY_LONG); ADDCONST("NPY_ULONG", NPY_ULONG); ADDCONST("NPY_LONGLONG", NPY_LONGLONG); ADDCONST("NPY_ULONGLONG", NPY_ULONGLONG); ADDCONST("NPY_FLOAT", NPY_FLOAT); ADDCONST("NPY_DOUBLE", NPY_DOUBLE); ADDCONST("NPY_LONGDOUBLE", NPY_LONGDOUBLE); ADDCONST("NPY_CFLOAT", NPY_CFLOAT); ADDCONST("NPY_CDOUBLE", NPY_CDOUBLE); ADDCONST("NPY_CLONGDOUBLE", NPY_CLONGDOUBLE); ADDCONST("NPY_OBJECT", NPY_OBJECT); ADDCONST("NPY_STRING", NPY_STRING); ADDCONST("NPY_UNICODE", NPY_UNICODE); ADDCONST("NPY_VOID", NPY_VOID); ADDCONST("NPY_NTYPES", NPY_NTYPES); ADDCONST("NPY_NOTYPE", NPY_NOTYPE); ADDCONST("NPY_USERDEF", NPY_USERDEF); ADDCONST("CONTIGUOUS", NPY_ARRAY_C_CONTIGUOUS); ADDCONST("FORTRAN", NPY_ARRAY_F_CONTIGUOUS); ADDCONST("OWNDATA", NPY_ARRAY_OWNDATA); ADDCONST("FORCECAST", NPY_ARRAY_FORCECAST); ADDCONST("ENSURECOPY", NPY_ARRAY_ENSURECOPY); ADDCONST("ENSUREARRAY", NPY_ARRAY_ENSUREARRAY); ADDCONST("ALIGNED", NPY_ARRAY_ALIGNED); ADDCONST("WRITEABLE", NPY_ARRAY_WRITEABLE); ADDCONST("WRITEBACKIFCOPY", NPY_ARRAY_WRITEBACKIFCOPY); ADDCONST("BEHAVED", NPY_ARRAY_BEHAVED); ADDCONST("BEHAVED_NS", NPY_ARRAY_BEHAVED_NS); ADDCONST("CARRAY", NPY_ARRAY_CARRAY); ADDCONST("FARRAY", NPY_ARRAY_FARRAY); ADDCONST("CARRAY_RO", NPY_ARRAY_CARRAY_RO); ADDCONST("FARRAY_RO", NPY_ARRAY_FARRAY_RO); ADDCONST("DEFAULT", NPY_ARRAY_DEFAULT); ADDCONST("UPDATE_ALL", NPY_ARRAY_UPDATE_ALL); #undef ADDCONST( if (PyErr_Occurred()) Py_FatalError("can't initialize module wrap"); #ifdef F2PY_REPORT_ATEXIT on_exit(f2py_report_on_exit,(void)"array_from_pyobj.wrap.call"); #endif return m; } #ifdef __cplusplus } #endif ��assumed_shape/.f2py_f2cmap��0000644��00000000035�15004441047�0011473 0��ustar�00��dict(real=dict(rk="double")) ��assumed_shape/foo_free.f90��0000644��00000000714�15004441047�0011472 0��ustar�00�� subroutine sum(x, res) implicit none real, intent(in) :: x(:) real, intent(out) :: res integer :: i !print , "sum: size(x) = ", size(x) res = 0.0 do i = 1, size(x) res = res + x(i) enddo end subroutine sum function fsum(x) result (res) implicit none real, intent(in) :: x(:) real :: res integer :: i !print , "fsum: size(x) = ", size(x) res = 0.0 do i = 1, size(x) res = res + x(i) enddo end function fsum ��assumed_shape/foo_mod.f90��0000644��00000000763�15004441047�0011334 0��ustar�00�� module mod contains subroutine sum(x, res) implicit none real, intent(in) :: x(:) real, intent(out) :: res integer :: i !print , "sum: size(x) = ", size(x) res = 0.0 do i = 1, size(x) res = res + x(i) enddo end subroutine sum function fsum(x) result (res) implicit none real, intent(in) :: x(:) real :: res integer :: i !print , "fsum: size(x) = ", size(x) res = 0.0 do i = 1, size(x) res = res + x(i) enddo end function fsum end module mod ��assumed_shape/foo_use.f90��0000644��00000000415�15004441047�0011343 0��ustar�00��subroutine sum_with_use(x, res) use precision implicit none real(kind=rk), intent(in) :: x(:) real(kind=rk), intent(out) :: res integer :: i !print , "size(x) = ", size(x) res = 0.0 do i = 1, size(x) res = res + x(i) enddo end subroutine ��assumed_shape/precision.f90��0000644��00000000202�15004441047�0011671 0��ustar�00��module precision integer, parameter :: rk = selected_real_kind(8) integer, parameter :: ik = selected_real_kind(4) end module ��block_docstring/foo.f��0000644��00000000141�15004441047�0010637 0��ustar�00�� SUBROUTINE FOO() INTEGER BAR(2, 3) COMMON /BLOCK/ BAR RETURN END ��callback/foo.f��0000644��00000002346�15004441047�0007236 0��ustar�00�� subroutine t(fun,a) integer a cf2py intent(out) a external fun call fun(a) end subroutine func(a) cf2py intent(in,out) a integer a a = a + 11 end subroutine func0(a) cf2py intent(out) a integer a a = 11 end subroutine t2(a) cf2py intent(callback) fun integer a cf2py intent(out) a external fun call fun(a) end subroutine string_callback(callback, a) external callback double precision callback double precision a character1 r cf2py intent(out) a r = 'r' a = callback(r) end subroutine string_callback_array(callback, cu, lencu, a) external callback integer callback integer lencu character8 cu(lencu) integer a cf2py intent(out) a a = callback(cu, lencu) end subroutine hidden_callback(a, r) external global_f cf2py intent(callback, hide) global_f integer a, r, global_f cf2py intent(out) r r = global_f(a) end subroutine hidden_callback2(a, r) external global_f integer a, r, global_f cf2py intent(out) r r = global_f(a) end ��callback/gh17797.f90��0000644��00000000224�15004441047�0007632 0��ustar�00��function gh17797(f, y) result(r) external f integer(8) :: r, f integer(8), dimension(:) :: y r = f(0) r = r + sum(y) end function gh17797 ��callback/gh18335.f90��0000644��00000000772�15004441047�0007627 0��ustar�00�� ! When gh18335_workaround is defined as an extension, ! the issue cannot be reproduced. !subroutine gh18335_workaround(f, y) ! implicit none ! external f ! integer(kind=1) :: y(1) ! call f(y) !end subroutine gh18335_workaround function gh18335(f) result (r) implicit none external f integer(kind=1) :: y(1), r y(1) = 123 call f(y) r = y(1) end function gh18335 ��cli/hi77.f��0000644��00000000107�15004441047�0006235 0��ustar�00�� SUBROUTINE HI PRINT, "HELLO WORLD" END SUBROUTINE ��cli/hiworld.f90��0000644��00000000063�15004441047�0007301 0��ustar�00��function hi() print, "Hello World" end function ��common/block.f��0000644��00000000340�15004441047�0007271 0��ustar�00�� SUBROUTINE INITCB DOUBLE PRECISION LONG CHARACTER STRING INTEGER OK COMMON /BLOCK/ LONG, STRING, OK LONG = 1.0 STRING = '2' OK = 3 RETURN END ��crackfortran/accesstype.f90��0000644��00000000320�15004441047�0011700 0��ustar�00��module foo public type, private, bind(c) :: a integer :: i end type a type, bind(c) :: b_ integer :: j end type b_ public :: b_ type :: c integer :: k end type c end module foo ��crackfortran/foo_deps.f90��0000644��00000000200�15004441047�0011330 0��ustar�00��module foo type bar character(len = 4) :: text end type bar type(bar), parameter :: abar = bar('abar') end module foo ��crackfortran/gh15035.f��0000644��00000000567�15004441047�0010375 0��ustar�00�� subroutine subb(k) real(8), intent(inout) :: k(:) k=k+1 endsubroutine subroutine subc(w,k) real(8), intent(in) :: w(:) real(8), intent(out) :: k(size(w)) k=w+1 endsubroutine function t0(value) character value character t0 t0 = value endfunction ��crackfortran/gh17859.f��0000644��00000000524�15004441047�0010406 0��ustar�00�� integer(8) function external_as_statement(fcn) implicit none external fcn integer(8) :: fcn external_as_statement = fcn(0) end integer(8) function external_as_attribute(fcn) implicit none integer(8), external :: fcn external_as_attribute = fcn(0) end ��crackfortran/gh23533.f��0000644��00000000176�15004441047�0010373 0��ustar�00�� SUBROUTINE EXAMPLE( ) IF( .TRUE. ) THEN CALL DO_SOMETHING() END IF ! * .TRUE. ** END ��crackfortran/gh23598.f90��0000644��00000000145�15004441047�0010553 0��ustar�00��integer function intproduct(a, b) result(res) integer, intent(in) :: a, b res = ab end function ��crackfortran/gh23598Warn.f90��0000644��00000000315�15004441047�0011402 0��ustar�00��module test_bug implicit none private public :: intproduct contains integer function intproduct(a, b) result(res) integer, intent(in) :: a, b res = ab end function end module ��crackfortran/gh23879.f90��0000644��00000000514�15004441047�0010555 0��ustar�00��module gh23879 implicit none private public :: foo contains subroutine foo(a, b) integer, intent(in) :: a integer, intent(out) :: b b = a call bar(b) end subroutine subroutine bar(x) integer, intent(inout) :: x x = 2x end subroutine end module gh23879 ��crackfortran/gh2848.f90��0000644��00000000432�15004441047�0010465 0��ustar�00�� subroutine gh2848( & ! first 2 parameters par1, par2,& ! last 2 parameters par3, par4) integer, intent(in) :: par1, par2 integer, intent(out) :: par3, par4 par3 = par1 par4 = par2 end subroutine gh2848 ��crackfortran/operators.f90��0000644��00000002240�15004441047�0011556 0��ustar�00��module foo type bar character(len = 32) :: item end type bar interface operator(.item.) module procedure item_int, item_real end interface operator(.item.) interface operator(==) module procedure items_are_equal end interface operator(==) interface assignment(=) module procedure get_int, get_real end interface assignment(=) contains function item_int(val) result(elem) integer, intent(in) :: val type(bar) :: elem write(elem%item, "(I32)") val end function item_int function item_real(val) result(elem) real, intent(in) :: val type(bar) :: elem write(elem%item, "(1PE32.12)") val end function item_real function items_are_equal(val1, val2) result(equal) type(bar), intent(in) :: val1, val2 logical :: equal equal = (val1%item == val2%item) end function items_are_equal subroutine get_real(rval, item) real, intent(out) :: rval type(bar), intent(in) :: item read(item%item, ) rval end subroutine get_real subroutine get_int(rval, item) integer, intent(out) :: rval type(bar), intent(in) :: item read(item%item, ) rval end subroutine get_int end module foo ��crackfortran/privatemod.f90��0000644��00000000256�15004441047�0011717 0��ustar�00��module foo private integer :: a public :: setA integer :: b contains subroutine setA(v) integer, intent(in) :: v a = v end subroutine setA end module foo ��crackfortran/publicmod.f90��0000644��00000000247�15004441047�0011523 0��ustar�00��module foo public integer, private :: a public :: setA contains subroutine setA(v) integer, intent(in) :: v a = v end subroutine setA end module foo ��crackfortran/pubprivmod.f90��0000644��00000000245�15004441047�0011732 0��ustar�00��module foo public integer, private :: a integer :: b contains subroutine setA(v) integer, intent(in) :: v a = v end subroutine setA end module foo ��crackfortran/unicode_comment.f90��0000644��00000000142�15004441047�0012707 0��ustar�00��subroutine foo(x) real(8), intent(in) :: x ! Écrit à l'écran la valeur de x end subroutine ��f2cmap/.f2py_f2cmap��0000644��00000000122�15004441047�0010017 0��ustar�00��dict(real=dict(real32='float', real64='double'), integer=dict(int64='long_long')) ��f2cmap/isoFortranEnvMap.f90��0000644��00000000452�15004441047�0011471 0��ustar�00�� subroutine func1(n, x, res) use, intrinsic :: iso_fortran_env, only: int64, real64 implicit none integer(int64), intent(in) :: n real(real64), intent(in) :: x(n) real(real64), intent(out) :: res Cf2py intent(hide) :: n res = sum(x) end ��kind/foo.f90��0000644��00000000533�15004441047�0006574 0��ustar�00�� subroutine selectedrealkind(p, r, res) implicit none integer, intent(in) :: p, r !f2py integer :: r=0 integer, intent(out) :: res res = selected_real_kind(p, r) end subroutine subroutine selectedintkind(p, res) implicit none integer, intent(in) :: p integer, intent(out) :: res res = selected_int_kind(p) end subroutine ��mixed/foo.f��0000644��00000000125�15004441047�0006601 0��ustar�00�� subroutine bar11(a) cf2py intent(out) a integer a a = 11 end ��mixed/foo_fixed.f90��0000644��00000000263�15004441047�0010134 0��ustar�00�� module foo_fixed contains subroutine bar12(a) !f2py intent(out) a integer a a = 12 end subroutine bar12 end module foo_fixed ��mixed/foo_free.f90��0000644��00000000213�15004441047�0007751 0��ustar�00��module foo_free contains subroutine bar13(a) !f2py intent(out) a integer a a = 13 end subroutine bar13 end module foo_free ��module_data/mod.mod��0000644��00000000634�15004441047�0010304 0��ustar�00��]o�0��+�]�bK��ѐa1�yE��b2%Q��篔��9��B{Bߞ��@��X��{��z��W@��:K�Y �u��i�M�4�m��~��a�p�N�I��eM(PE��,0�'.=�"�(�gq�E؄c8uP��x�(sJ�>��⩭F\|��`8��\��(� Q6�:.�Ԣz��P@�%��jEK+��tW�L��z+o��>(%��'�� t��<"n�c ��7�L�N��\J>�U�2vq��E�L�č�ju\�n��tq#[�}��Nctk�]�ҕ�a\p�F��?�5�X{e\|}�\�cr$h�)��'V��غ��s��V�IaЩ�a��n1��~�Z��module_data/module_data_docstring.f90��0000644��00000000340�15004441047�0013670 0��ustar�00��module mod integer :: i integer :: x(4) real, dimension(2,3) :: a real, allocatable, dimension(:,:) :: b contains subroutine foo integer :: k k = 1 a(1,2) = a(1,2)+3 end subroutine foo end module mod ��negative_bounds/issue_20853.f90��0000644��00000000235�15004441047�0012130 0��ustar�00��subroutine foo(is_, ie_, arr, tout) implicit none integer :: is_,ie_ real, intent(in) :: arr(is_:ie_) real, intent(out) :: tout(is_:ie_) tout = arr end ��parameter/constant_both.f90��0000644��00000003623�15004441047�0011714 0��ustar�00��! Check that parameters are correct intercepted. ! Constants with comma separations are commonly ! used, for instance Pi = 3._dp subroutine foo(x) implicit none integer, parameter :: sp = selected_real_kind(6) integer, parameter :: dp = selected_real_kind(15) integer, parameter :: ii = selected_int_kind(9) integer, parameter :: il = selected_int_kind(18) real(dp), intent(inout) :: x dimension x(3) real(sp), parameter :: three_s = 3._sp real(dp), parameter :: three_d = 3._dp integer(ii), parameter :: three_i = 3_ii integer(il), parameter :: three_l = 3_il x(1) = x(1) + x(2) three_s * three_i + x(3) * three_d * three_l x(2) = x(2) * three_s x(3) = x(3) * three_l return end subroutine subroutine foo_no(x) implicit none integer, parameter :: sp = selected_real_kind(6) integer, parameter :: dp = selected_real_kind(15) integer, parameter :: ii = selected_int_kind(9) integer, parameter :: il = selected_int_kind(18) real(dp), intent(inout) :: x dimension x(3) real(sp), parameter :: three_s = 3. real(dp), parameter :: three_d = 3. integer(ii), parameter :: three_i = 3 integer(il), parameter :: three_l = 3 x(1) = x(1) + x(2) * three_s * three_i + x(3) * three_d * three_l x(2) = x(2) * three_s x(3) = x(3) * three_l return end subroutine subroutine foo_sum(x) implicit none integer, parameter :: sp = selected_real_kind(6) integer, parameter :: dp = selected_real_kind(15) integer, parameter :: ii = selected_int_kind(9) integer, parameter :: il = selected_int_kind(18) real(dp), intent(inout) :: x dimension x(3) real(sp), parameter :: three_s = 2._sp + 1._sp real(dp), parameter :: three_d = 1._dp + 2._dp integer(ii), parameter :: three_i = 2_ii + 1_ii integer(il), parameter :: three_l = 1_il + 2_il x(1) = x(1) + x(2) * three_s * three_i + x(3) * three_d * three_l x(2) = x(2) * three_s x(3) = x(3) * three_l return end subroutine ��parameter/constant_compound.f90��0000644��00000000725�15004441047�0012604 0��ustar�00��! Check that parameters are correct intercepted. ! Constants with comma separations are commonly ! used, for instance Pi = 3._dp subroutine foo_compound_int(x) implicit none integer, parameter :: ii = selected_int_kind(9) integer(ii), intent(inout) :: x dimension x(3) integer(ii), parameter :: three = 3_ii integer(ii), parameter :: two = 2_ii integer(ii), parameter :: six = three * 1_ii * two x(1) = x(1) + x(2) + x(3) * six return end subroutine ��parameter/constant_integer.f90��0000644��00000001144�15004441047�0012411 0��ustar�00��! Check that parameters are correct intercepted. ! Constants with comma separations are commonly ! used, for instance Pi = 3._dp subroutine foo_int(x) implicit none integer, parameter :: ii = selected_int_kind(9) integer(ii), intent(inout) :: x dimension x(3) integer(ii), parameter :: three = 3_ii x(1) = x(1) + x(2) + x(3) * three return end subroutine subroutine foo_long(x) implicit none integer, parameter :: ii = selected_int_kind(18) integer(ii), intent(inout) :: x dimension x(3) integer(ii), parameter :: three = 3_ii x(1) = x(1) + x(2) + x(3) * three return end subroutine ��parameter/constant_non_compound.f90��0000644��00000001141�15004441047�0013447 0��ustar�00��! Check that parameters are correct intercepted. ! Specifically that types of constants without ! compound kind specs are correctly inferred ! adapted Gibbs iteration code from pymc ! for this test case subroutine foo_non_compound_int(x) implicit none integer, parameter :: ii = selected_int_kind(9) integer(ii) maxiterates parameter (maxiterates=2) integer(ii) maxseries parameter (maxseries=2) integer(ii) wasize parameter (wasize=maxiteratesmaxseries) integer(ii), intent(inout) :: x dimension x(wasize) x(1) = x(1) + x(2) + x(3) + x(4) wasize return end subroutine ��parameter/constant_real.f90��0000644��00000001142�15004441047�0011675 0��ustar�00��! Check that parameters are correct intercepted. ! Constants with comma separations are commonly ! used, for instance Pi = 3._dp subroutine foo_single(x) implicit none integer, parameter :: rp = selected_real_kind(6) real(rp), intent(inout) :: x dimension x(3) real(rp), parameter :: three = 3._rp x(1) = x(1) + x(2) + x(3) * three return end subroutine subroutine foo_double(x) implicit none integer, parameter :: rp = selected_real_kind(15) real(rp), intent(inout) :: x dimension x(3) real(rp), parameter :: three = 3._rp x(1) = x(1) + x(2) + x(3) * three return end subroutine ��quoted_character/foo.f��0000644��00000000742�15004441047�0011015 0��ustar�00�� SUBROUTINE FOO(OUT1, OUT2, OUT3, OUT4, OUT5, OUT6) CHARACTER SINGLE, DOUBLE, SEMICOL, EXCLA, OPENPAR, CLOSEPAR PARAMETER (SINGLE="'", DOUBLE='"', SEMICOL=';', EXCLA="!", 1 OPENPAR="(", CLOSEPAR=")") CHARACTER OUT1, OUT2, OUT3, OUT4, OUT5, OUT6 Cf2py intent(out) OUT1, OUT2, OUT3, OUT4, OUT5, OUT6 OUT1 = SINGLE OUT2 = DOUBLE OUT3 = SEMICOL OUT4 = EXCLA OUT5 = OPENPAR OUT6 = CLOSEPAR RETURN END ��regression/inout.f90��0000644��00000000425�15004441047�0010402 0��ustar�00��! Check that intent(in out) translates as intent(inout). ! The separation seems to be a common usage. subroutine foo(x) implicit none real(4), intent(in out) :: x dimension x(3) x(1) = x(1) + x(2) + x(3) return end ��return_character/foo77.f��0000644��00000001724�15004441047�0011212 0��ustar�00�� function t0(value) character value character t0 t0 = value end function t1(value) character1 value character1 t1 t1 = value end function t5(value) character5 value character5 t5 t5 = value end function ts(value) character() value character() ts ts = value end subroutine s0(t0,value) character value character t0 cf2py intent(out) t0 t0 = value end subroutine s1(t1,value) character1 value character1 t1 cf2py intent(out) t1 t1 = value end subroutine s5(t5,value) character5 value character5 t5 cf2py intent(out) t5 t5 = value end subroutine ss(ts,value) character() value character10 ts cf2py intent(out) ts ts = value end ��return_character/foo90.f90��0000644��00000002340�15004441047�0011351 0��ustar�00��module f90_return_char contains function t0(value) character :: value character :: t0 t0 = value end function t0 function t1(value) character(len=1) :: value character(len=1) :: t1 t1 = value end function t1 function t5(value) character(len=5) :: value character(len=5) :: t5 t5 = value end function t5 function ts(value) character(len=) :: value character(len=10) :: ts ts = value end function ts subroutine s0(t0,value) character :: value character :: t0 !f2py intent(out) t0 t0 = value end subroutine s0 subroutine s1(t1,value) character(len=1) :: value character(len=1) :: t1 !f2py intent(out) t1 t1 = value end subroutine s1 subroutine s5(t5,value) character(len=5) :: value character(len=5) :: t5 !f2py intent(out) t5 t5 = value end subroutine s5 subroutine ss(ts,value) character(len=) :: value character(len=10) :: ts !f2py intent(out) ts ts = value end subroutine ss end module f90_return_char ��return_complex/foo77.f��0000644��00000001715�15004441047�0010725 0��ustar�00�� function t0(value) complex value complex t0 t0 = value end function t8(value) complex8 value complex8 t8 t8 = value end function t16(value) complex16 value complex16 t16 t16 = value end function td(value) double complex value double complex td td = value end subroutine s0(t0,value) complex value complex t0 cf2py intent(out) t0 t0 = value end subroutine s8(t8,value) complex8 value complex8 t8 cf2py intent(out) t8 t8 = value end subroutine s16(t16,value) complex16 value complex16 t16 cf2py intent(out) t16 t16 = value end subroutine sd(td,value) double complex value double complex td cf2py intent(out) td td = value end ��return_complex/foo90.f90��0000644��00000002326�15004441047�0011070 0��ustar�00��module f90_return_complex contains function t0(value) complex :: value complex :: t0 t0 = value end function t0 function t8(value) complex(kind=4) :: value complex(kind=4) :: t8 t8 = value end function t8 function t16(value) complex(kind=8) :: value complex(kind=8) :: t16 t16 = value end function t16 function td(value) double complex :: value double complex :: td td = value end function td subroutine s0(t0,value) complex :: value complex :: t0 !f2py intent(out) t0 t0 = value end subroutine s0 subroutine s8(t8,value) complex(kind=4) :: value complex(kind=4) :: t8 !f2py intent(out) t8 t8 = value end subroutine s8 subroutine s16(t16,value) complex(kind=8) :: value complex(kind=8) :: t16 !f2py intent(out) t16 t16 = value end subroutine s16 subroutine sd(td,value) double complex :: value double complex :: td !f2py intent(out) td td = value end subroutine sd end module f90_return_complex ��return_integer/foo77.f��0000644��00000002232�15004441047�0010706 0��ustar�00�� function t0(value) integer value integer t0 t0 = value end function t1(value) integer1 value integer1 t1 t1 = value end function t2(value) integer2 value integer2 t2 t2 = value end function t4(value) integer4 value integer4 t4 t4 = value end function t8(value) integer8 value integer8 t8 t8 = value end subroutine s0(t0,value) integer value integer t0 cf2py intent(out) t0 t0 = value end subroutine s1(t1,value) integer1 value integer1 t1 cf2py intent(out) t1 t1 = value end subroutine s2(t2,value) integer2 value integer2 t2 cf2py intent(out) t2 t2 = value end subroutine s4(t4,value) integer4 value integer4 t4 cf2py intent(out) t4 t4 = value end subroutine s8(t8,value) integer8 value integer8 t8 cf2py intent(out) t8 t8 = value end ��return_integer/foo90.f90��0000644��00000002773�15004441047�0011064 0��ustar�00��module f90_return_integer contains function t0(value) integer :: value integer :: t0 t0 = value end function t0 function t1(value) integer(kind=1) :: value integer(kind=1) :: t1 t1 = value end function t1 function t2(value) integer(kind=2) :: value integer(kind=2) :: t2 t2 = value end function t2 function t4(value) integer(kind=4) :: value integer(kind=4) :: t4 t4 = value end function t4 function t8(value) integer(kind=8) :: value integer(kind=8) :: t8 t8 = value end function t8 subroutine s0(t0,value) integer :: value integer :: t0 !f2py intent(out) t0 t0 = value end subroutine s0 subroutine s1(t1,value) integer(kind=1) :: value integer(kind=1) :: t1 !f2py intent(out) t1 t1 = value end subroutine s1 subroutine s2(t2,value) integer(kind=2) :: value integer(kind=2) :: t2 !f2py intent(out) t2 t2 = value end subroutine s2 subroutine s4(t4,value) integer(kind=4) :: value integer(kind=4) :: t4 !f2py intent(out) t4 t4 = value end subroutine s4 subroutine s8(t8,value) integer(kind=8) :: value integer(kind=8) :: t8 !f2py intent(out) t8 t8 = value end subroutine s8 end module f90_return_integer ��return_logical/foo77.f��0000644��00000002244�15004441047�0010666 0��ustar�00�� function t0(value) logical value logical t0 t0 = value end function t1(value) logical1 value logical1 t1 t1 = value end function t2(value) logical2 value logical2 t2 t2 = value end function t4(value) logical4 value logical4 t4 t4 = value end c function t8(value) c logical8 value c logical8 t8 c t8 = value c end subroutine s0(t0,value) logical value logical t0 cf2py intent(out) t0 t0 = value end subroutine s1(t1,value) logical1 value logical1 t1 cf2py intent(out) t1 t1 = value end subroutine s2(t2,value) logical2 value logical2 t2 cf2py intent(out) t2 t2 = value end subroutine s4(t4,value) logical4 value logical4 t4 cf2py intent(out) t4 t4 = value end c subroutine s8(t8,value) c logical8 value c logical8 t8 cf2py intent(out) t8 c t8 = value c end ��return_logical/foo90.f90��0000644��00000002773�15004441047�0011041 0��ustar�00��module f90_return_logical contains function t0(value) logical :: value logical :: t0 t0 = value end function t0 function t1(value) logical(kind=1) :: value logical(kind=1) :: t1 t1 = value end function t1 function t2(value) logical(kind=2) :: value logical(kind=2) :: t2 t2 = value end function t2 function t4(value) logical(kind=4) :: value logical(kind=4) :: t4 t4 = value end function t4 function t8(value) logical(kind=8) :: value logical(kind=8) :: t8 t8 = value end function t8 subroutine s0(t0,value) logical :: value logical :: t0 !f2py intent(out) t0 t0 = value end subroutine s0 subroutine s1(t1,value) logical(kind=1) :: value logical(kind=1) :: t1 !f2py intent(out) t1 t1 = value end subroutine s1 subroutine s2(t2,value) logical(kind=2) :: value logical(kind=2) :: t2 !f2py intent(out) t2 t2 = value end subroutine s2 subroutine s4(t4,value) logical(kind=4) :: value logical(kind=4) :: t4 !f2py intent(out) t4 t4 = value end subroutine s4 subroutine s8(t8,value) logical(kind=8) :: value logical(kind=8) :: t8 !f2py intent(out) t8 t8 = value end subroutine s8 end module f90_return_logical ��return_real/foo77.f��0000644��00000001645�15004441047�0010203 0��ustar�00�� function t0(value) real value real t0 t0 = value end function t4(value) real4 value real4 t4 t4 = value end function t8(value) real8 value real8 t8 t8 = value end function td(value) double precision value double precision td td = value end subroutine s0(t0,value) real value real t0 cf2py intent(out) t0 t0 = value end subroutine s4(t4,value) real4 value real4 t4 cf2py intent(out) t4 t4 = value end subroutine s8(t8,value) real8 value real8 t8 cf2py intent(out) t8 t8 = value end subroutine sd(td,value) double precision value double precision td cf2py intent(out) td td = value end ��return_real/foo90.f90��0000644��00000002252�15004441047�0010342 0��ustar�00��module f90_return_real contains function t0(value) real :: value real :: t0 t0 = value end function t0 function t4(value) real(kind=4) :: value real(kind=4) :: t4 t4 = value end function t4 function t8(value) real(kind=8) :: value real(kind=8) :: t8 t8 = value end function t8 function td(value) double precision :: value double precision :: td td = value end function td subroutine s0(t0,value) real :: value real :: t0 !f2py intent(out) t0 t0 = value end subroutine s0 subroutine s4(t4,value) real(kind=4) :: value real(kind=4) :: t4 !f2py intent(out) t4 t4 = value end subroutine s4 subroutine s8(t8,value) real(kind=8) :: value real(kind=8) :: t8 !f2py intent(out) t8 t8 = value end subroutine s8 subroutine sd(td,value) double precision :: value double precision :: td !f2py intent(out) td td = value end subroutine sd end module f90_return_real ��size/foo.f90��0000644��00000001457�15004441047�0006627 0��ustar�00�� subroutine foo(a, n, m, b) implicit none real, intent(in) :: a(n, m) integer, intent(in) :: n, m real, intent(out) :: b(size(a, 1)) integer :: i do i = 1, size(b) b(i) = sum(a(i,:)) enddo end subroutine subroutine trans(x,y) implicit none real, intent(in), dimension(:,:) :: x real, intent(out), dimension( size(x,2), size(x,1) ) :: y integer :: N, M, i, j N = size(x,1) M = size(x,2) DO i=1,N do j=1,M y(j,i) = x(i,j) END DO END DO end subroutine trans subroutine flatten(x,y) implicit none real, intent(in), dimension(:,:) :: x real, intent(out), dimension( size(x) ) :: y integer :: N, M, i, j, k N = size(x,1) M = size(x,2) k = 1 DO i=1,N do j=1,M y(k) = x(i,j) k = k + 1 END DO END DO end subroutine flatten ��string/char.f90��0000644��00000001152�15004441047�0007305 0��ustar�00��MODULE char_test CONTAINS SUBROUTINE change_strings(strings, n_strs, out_strings) IMPLICIT NONE ! Inputs INTEGER, INTENT(IN) :: n_strs CHARACTER, INTENT(IN), DIMENSION(2,n_strs) :: strings CHARACTER, INTENT(OUT), DIMENSION(2,n_strs) :: out_strings !f2py INTEGER, INTENT(IN) :: n_strs !f2py CHARACTER, INTENT(IN), DIMENSION(2,n_strs) :: strings !f2py CHARACTER, INTENT(OUT), DIMENSION(2,n_strs) :: strings ! Misc. INTEGER4 :: j DO j=1, n_strs out_strings(1,j) = strings(1,j) out_strings(2,j) = 'A' END DO END SUBROUTINE change_strings END MODULE char_test ��string/fixed_string.f90��0000644��00000001267�15004441047�0011064 0��ustar�00��function sint(s) result(i) implicit none character(len=) :: s integer :: j, i i = 0 do j=len(s), 1, -1 if (.not.((i.eq.0).and.(s(j:j).eq.' '))) then i = i + ichar(s(j:j)) 10 ** (j - 1) endif end do return end function sint function test_in_bytes4(a) result (i) implicit none integer :: sint character(len=4) :: a integer :: i i = sint(a) a(1:1) = 'A' return end function test_in_bytes4 function test_inout_bytes4(a) result (i) implicit none integer :: sint character(len=4), intent(inout) :: a integer :: i if (a(1:1).ne.' ') then a(1:1) = 'E' endif i = sint(a) return end function test_inout_bytes4 ��string/scalar_string.f90��0000644��00000000260�15004441047�0011222 0��ustar�00��MODULE string_test character(len=8) :: string character string77 * 8 character(len=12), dimension(5,7) :: strarr character strarr77(5,7) * 12 END MODULE string_test ��string/string.f��0000644��00000000370�15004441047�0007526 0��ustar�00��C FILE: STRING.F SUBROUTINE FOO(A,B,C,D) CHARACTER5 A, B CHARACTER() C,D Cf2py intent(in) a,c Cf2py intent(inout) b,d A(1:1) = 'A' B(1:1) = 'B' C(1:1) = 'C' D(1:1) = 'D' END C END OF FILE STRING.F ��value_attrspec/gh21665.f90��0000644��00000000276�15004441047�0011113 0��ustar�00��module fortfuncs implicit none contains subroutine square(x,y) integer, intent(in), value :: x integer, intent(out) :: y y = xx end subroutine square end module fortfuncs ��

| ver. 1.4 | Github | . | PHP 8.1.31 | Генерация страницы: 0 | proxy | phpinfo | Настройка