forked from Alsan/Post_finder
venv
This commit is contained in:
@ -0,0 +1,34 @@
|
||||
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
|
@ -0,0 +1,6 @@
|
||||
module test
|
||||
abstract interface
|
||||
subroutine foo()
|
||||
end subroutine
|
||||
end interface
|
||||
end module test
|
@ -0,0 +1,235 @@
|
||||
/*
|
||||
* 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(rank*sizeof(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),
|
||||
PyDataType_ALIGNMENT(PyArray_DESCR(arr)),
|
||||
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_LEGACY", NPY_NTYPES_LEGACY);
|
||||
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
|
||||
|
||||
#if Py_GIL_DISABLED
|
||||
// signal whether this module supports running with the GIL disabled
|
||||
PyUnstable_Module_SetGIL(m, Py_MOD_GIL_NOT_USED);
|
||||
#endif
|
||||
|
||||
return m;
|
||||
}
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
@ -0,0 +1 @@
|
||||
dict(real=dict(rk="double"))
|
@ -0,0 +1,34 @@
|
||||
|
||||
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
|
@ -0,0 +1,41 @@
|
||||
|
||||
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
|
@ -0,0 +1,19 @@
|
||||
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
|
@ -0,0 +1,4 @@
|
||||
module precision
|
||||
integer, parameter :: rk = selected_real_kind(8)
|
||||
integer, parameter :: ik = selected_real_kind(4)
|
||||
end module
|
@ -0,0 +1,6 @@
|
||||
SUBROUTINE FOO()
|
||||
INTEGER BAR(2, 3)
|
||||
|
||||
COMMON /BLOCK/ BAR
|
||||
RETURN
|
||||
END
|
@ -0,0 +1,62 @@
|
||||
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
|
||||
character*1 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
|
||||
character*8 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
|
@ -0,0 +1,7 @@
|
||||
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
|
@ -0,0 +1,17 @@
|
||||
! 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
|
@ -0,0 +1,10 @@
|
||||
SUBROUTINE FOO(FUN,R)
|
||||
EXTERNAL FUN
|
||||
INTEGER I
|
||||
REAL*8 R, FUN
|
||||
Cf2py intent(out) r
|
||||
R = 0D0
|
||||
DO I=-5,5
|
||||
R = R + FUN(I)
|
||||
ENDDO
|
||||
END
|
@ -0,0 +1,18 @@
|
||||
python module __user__routines
|
||||
interface
|
||||
function fun(i) result (r)
|
||||
integer :: i
|
||||
real*8 :: r
|
||||
end function fun
|
||||
end interface
|
||||
end python module __user__routines
|
||||
|
||||
python module callback2
|
||||
interface
|
||||
subroutine foo(f,r)
|
||||
use __user__routines, f=>fun
|
||||
external f
|
||||
real*8 intent(out) :: r
|
||||
end subroutine foo
|
||||
end interface
|
||||
end python module callback2
|
@ -0,0 +1,6 @@
|
||||
python module test_22819
|
||||
interface
|
||||
subroutine hello()
|
||||
end subroutine hello
|
||||
end interface
|
||||
end python module test_22819
|
@ -0,0 +1,3 @@
|
||||
SUBROUTINE HI
|
||||
PRINT*, "HELLO WORLD"
|
||||
END SUBROUTINE
|
@ -0,0 +1,3 @@
|
||||
function hi()
|
||||
print*, "Hello World"
|
||||
end function
|
@ -0,0 +1,11 @@
|
||||
SUBROUTINE INITCB
|
||||
DOUBLE PRECISION LONG
|
||||
CHARACTER STRING
|
||||
INTEGER OK
|
||||
|
||||
COMMON /BLOCK/ LONG, STRING, OK
|
||||
LONG = 1.0
|
||||
STRING = '2'
|
||||
OK = 3
|
||||
RETURN
|
||||
END
|
@ -0,0 +1,10 @@
|
||||
module typedefmod
|
||||
use iso_fortran_env, only: real32
|
||||
end module typedefmod
|
||||
|
||||
module data
|
||||
use typedefmod, only: real32
|
||||
implicit none
|
||||
real(kind=real32) :: x
|
||||
common/test/x
|
||||
end module data
|
@ -0,0 +1,13 @@
|
||||
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
|
@ -0,0 +1,8 @@
|
||||
BLOCK DATA PARAM_INI
|
||||
COMMON /MYCOM/ MYDATA
|
||||
DATA MYDATA /0/
|
||||
END
|
||||
SUBROUTINE SUB1
|
||||
COMMON /MYCOM/ MYDATA
|
||||
MYDATA = MYDATA + 1
|
||||
END
|
@ -0,0 +1,5 @@
|
||||
BLOCK DATA MYBLK
|
||||
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
|
||||
COMMON /MYCOM/ IVAR1, IVAR2, IVAR3, IVAR4, EVAR5
|
||||
DATA IVAR1, IVAR2, IVAR3, IVAR4, EVAR5 /2*3,2*2,0.0D0/
|
||||
END
|
@ -0,0 +1,20 @@
|
||||
! gh-23276
|
||||
module cmplxdat
|
||||
implicit none
|
||||
integer :: i, j
|
||||
real :: x, y
|
||||
real, dimension(2) :: z
|
||||
real(kind=8) :: pi
|
||||
complex(kind=8), target :: medium_ref_index
|
||||
complex(kind=8), target :: ref_index_one, ref_index_two
|
||||
complex(kind=8), dimension(2) :: my_array
|
||||
real(kind=8), dimension(3) :: my_real_array = (/1.0d0, 2.0d0, 3.0d0/)
|
||||
|
||||
data i, j / 2, 3 /
|
||||
data x, y / 1.5, 2.0 /
|
||||
data z / 3.5, 7.0 /
|
||||
data medium_ref_index / (1.d0, 0.d0) /
|
||||
data ref_index_one, ref_index_two / (13.0d0, 21.0d0), (-30.0d0, 43.0d0) /
|
||||
data my_array / (1.0d0, 2.0d0), (-3.0d0, 4.0d0) /
|
||||
data pi / 3.1415926535897932384626433832795028841971693993751058209749445923078164062d0 /
|
||||
end module cmplxdat
|
@ -0,0 +1,8 @@
|
||||
BLOCK DATA PARAM_INI
|
||||
COMMON /MYCOM/ MYTAB
|
||||
INTEGER MYTAB(3)
|
||||
DATA MYTAB/
|
||||
* 0, ! 1 and more commenty stuff
|
||||
* 4, ! 2
|
||||
* 0 /
|
||||
END
|
@ -0,0 +1,6 @@
|
||||
module foo
|
||||
type bar
|
||||
character(len = 4) :: text
|
||||
end type bar
|
||||
type(bar), parameter :: abar = bar('abar')
|
||||
end module foo
|
@ -0,0 +1,16 @@
|
||||
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
|
@ -0,0 +1,12 @@
|
||||
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
|
@ -0,0 +1,7 @@
|
||||
python module iri16py ! in
|
||||
interface ! in :iri16py
|
||||
block data ! in :iri16py:iridreg_modified.for
|
||||
COMMON /fircom/ eden,tabhe,tabla,tabmo,tabza,tabfl
|
||||
end block data
|
||||
end interface
|
||||
end python module iri16py
|
@ -0,0 +1,5 @@
|
||||
SUBROUTINE EXAMPLE( )
|
||||
IF( .TRUE. ) THEN
|
||||
CALL DO_SOMETHING()
|
||||
END IF ! ** .TRUE. **
|
||||
END
|
@ -0,0 +1,4 @@
|
||||
integer function intproduct(a, b) result(res)
|
||||
integer, intent(in) :: a, b
|
||||
res = a*b
|
||||
end function
|
@ -0,0 +1,11 @@
|
||||
module test_bug
|
||||
implicit none
|
||||
private
|
||||
public :: intproduct
|
||||
|
||||
contains
|
||||
integer function intproduct(a, b) result(res)
|
||||
integer, intent(in) :: a, b
|
||||
res = a*b
|
||||
end function
|
||||
end module
|
@ -0,0 +1,20 @@
|
||||
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 = 2*x
|
||||
end subroutine
|
||||
|
||||
end module gh23879
|
@ -0,0 +1,13 @@
|
||||
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
|
@ -0,0 +1,49 @@
|
||||
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
|
@ -0,0 +1,11 @@
|
||||
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
|
@ -0,0 +1,10 @@
|
||||
module foo
|
||||
public
|
||||
integer, private :: a
|
||||
public :: setA
|
||||
contains
|
||||
subroutine setA(v)
|
||||
integer, intent(in) :: v
|
||||
a = v
|
||||
end subroutine setA
|
||||
end module foo
|
@ -0,0 +1,10 @@
|
||||
module foo
|
||||
public
|
||||
integer, private :: a
|
||||
integer :: b
|
||||
contains
|
||||
subroutine setA(v)
|
||||
integer, intent(in) :: v
|
||||
a = v
|
||||
end subroutine setA
|
||||
end module foo
|
@ -0,0 +1,4 @@
|
||||
subroutine foo(x)
|
||||
real(8), intent(in) :: x
|
||||
! Écrit à l'écran la valeur de x
|
||||
end subroutine
|
@ -0,0 +1 @@
|
||||
dict(real=dict(real32='float', real64='double'), integer=dict(int64='long_long'))
|
@ -0,0 +1,9 @@
|
||||
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
|
||||
!f2py intent(hide) :: n
|
||||
res = sum(x)
|
||||
end
|
@ -0,0 +1,34 @@
|
||||
module coddity
|
||||
use iso_c_binding, only: c_double, c_int, c_int64_t
|
||||
implicit none
|
||||
contains
|
||||
subroutine c_add(a, b, c) bind(c, name="c_add")
|
||||
real(c_double), intent(in) :: a, b
|
||||
real(c_double), intent(out) :: c
|
||||
c = a + b
|
||||
end subroutine c_add
|
||||
! gh-9693
|
||||
function wat(x, y) result(z) bind(c)
|
||||
integer(c_int), intent(in) :: x, y
|
||||
integer(c_int) :: z
|
||||
|
||||
z = x + 7
|
||||
end function wat
|
||||
! gh-25207
|
||||
subroutine c_add_int64(a, b, c) bind(c)
|
||||
integer(c_int64_t), intent(in) :: a, b
|
||||
integer(c_int64_t), intent(out) :: c
|
||||
c = a + b
|
||||
end subroutine c_add_int64
|
||||
! gh-25207
|
||||
subroutine add_arr(A, B, C)
|
||||
integer(c_int64_t), intent(in) :: A(3)
|
||||
integer(c_int64_t), intent(in) :: B(3)
|
||||
integer(c_int64_t), intent(out) :: C(3)
|
||||
integer :: j
|
||||
|
||||
do j = 1, 3
|
||||
C(j) = A(j)+B(j)
|
||||
end do
|
||||
end subroutine
|
||||
end module coddity
|
@ -0,0 +1,20 @@
|
||||
|
||||
|
||||
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
|
@ -0,0 +1,5 @@
|
||||
subroutine bar11(a)
|
||||
cf2py intent(out) a
|
||||
integer a
|
||||
a = 11
|
||||
end
|
@ -0,0 +1,8 @@
|
||||
module foo_fixed
|
||||
contains
|
||||
subroutine bar12(a)
|
||||
!f2py intent(out) a
|
||||
integer a
|
||||
a = 12
|
||||
end subroutine bar12
|
||||
end module foo_fixed
|
@ -0,0 +1,8 @@
|
||||
module foo_free
|
||||
contains
|
||||
subroutine bar13(a)
|
||||
!f2py intent(out) a
|
||||
integer a
|
||||
a = 13
|
||||
end subroutine bar13
|
||||
end module foo_free
|
@ -0,0 +1,8 @@
|
||||
module data
|
||||
real(8) :: shift
|
||||
contains
|
||||
subroutine set_shift(in_shift)
|
||||
real(8), intent(in) :: in_shift
|
||||
shift = in_shift
|
||||
end subroutine set_shift
|
||||
end module data
|
@ -0,0 +1,6 @@
|
||||
subroutine shift_a(dim_a, a)
|
||||
use data, only: shift
|
||||
integer, intent(in) :: dim_a
|
||||
real(8), intent(inout), dimension(dim_a) :: a
|
||||
a = a + shift
|
||||
end subroutine shift_a
|
@ -0,0 +1,21 @@
|
||||
module mod2
|
||||
implicit none
|
||||
private mod2_func1
|
||||
contains
|
||||
|
||||
subroutine mod2_func1()
|
||||
print*, "mod2_func1"
|
||||
end subroutine mod2_func1
|
||||
|
||||
end module mod2
|
||||
|
||||
module mod1
|
||||
implicit none
|
||||
private :: mod1_func1
|
||||
contains
|
||||
|
||||
subroutine mod1_func1()
|
||||
print*, "mod1_func1"
|
||||
end subroutine mod1_func1
|
||||
|
||||
end module mod1
|
@ -0,0 +1,21 @@
|
||||
module mod2
|
||||
implicit none
|
||||
PUBLIC :: mod2_func1
|
||||
contains
|
||||
|
||||
subroutine mod2_func1()
|
||||
print*, "mod2_func1"
|
||||
end subroutine mod2_func1
|
||||
|
||||
end module mod2
|
||||
|
||||
module mod1
|
||||
implicit none
|
||||
PUBLIC :: mod1_func1
|
||||
contains
|
||||
|
||||
subroutine mod1_func1()
|
||||
print*, "mod1_func1"
|
||||
end subroutine mod1_func1
|
||||
|
||||
end module mod1
|
@ -0,0 +1,12 @@
|
||||
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
|
@ -0,0 +1,20 @@
|
||||
module mathops
|
||||
implicit none
|
||||
contains
|
||||
function add(a, b) result(c)
|
||||
integer, intent(in) :: a, b
|
||||
integer :: c
|
||||
c = a + b
|
||||
end function add
|
||||
end module mathops
|
||||
|
||||
module useops
|
||||
use mathops, only: add
|
||||
implicit none
|
||||
contains
|
||||
function sum_and_double(a, b) result(d)
|
||||
integer, intent(in) :: a, b
|
||||
integer :: d
|
||||
d = 2 * add(a, b)
|
||||
end function sum_and_double
|
||||
end module useops
|
@ -0,0 +1,7 @@
|
||||
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
|
@ -0,0 +1,45 @@
|
||||
! Check that parameter arrays are correctly intercepted.
|
||||
subroutine foo_array(x, y, z)
|
||||
implicit none
|
||||
integer, parameter :: dp = selected_real_kind(15)
|
||||
integer, parameter :: pa = 2
|
||||
integer, parameter :: intparamarray(2) = (/ 3, 5 /)
|
||||
integer, dimension(pa), parameter :: pb = (/ 2, 10 /)
|
||||
integer, parameter, dimension(intparamarray(1)) :: pc = (/ 2, 10, 20 /)
|
||||
real(dp), parameter :: doubleparamarray(3) = (/ 3.14_dp, 4._dp, 6.44_dp /)
|
||||
real(dp), intent(inout) :: x(intparamarray(1))
|
||||
real(dp), intent(inout) :: y(intparamarray(2))
|
||||
real(dp), intent(out) :: z
|
||||
|
||||
x = x/pb(2)
|
||||
y = y*pc(2)
|
||||
z = doubleparamarray(1)*doubleparamarray(2) + doubleparamarray(3)
|
||||
|
||||
return
|
||||
end subroutine
|
||||
|
||||
subroutine foo_array_any_index(x, y)
|
||||
implicit none
|
||||
integer, parameter :: dp = selected_real_kind(15)
|
||||
integer, parameter, dimension(-1:1) :: myparamarray = (/ 6, 3, 1 /)
|
||||
integer, parameter, dimension(2) :: nested = (/ 2, 0 /)
|
||||
integer, parameter :: dim = 2
|
||||
real(dp), intent(in) :: x(myparamarray(-1))
|
||||
real(dp), intent(out) :: y(nested(1), myparamarray(nested(dim)))
|
||||
|
||||
y = reshape(x, (/nested(1), myparamarray(nested(2))/))
|
||||
|
||||
return
|
||||
end subroutine
|
||||
|
||||
subroutine foo_array_delims(x)
|
||||
implicit none
|
||||
integer, parameter :: dp = selected_real_kind(15)
|
||||
integer, parameter, dimension(2) :: myparamarray = (/ (6), 1 /)
|
||||
integer, parameter, dimension(3) :: test = (/2, 1, (3)/)
|
||||
real(dp), intent(out) :: x
|
||||
|
||||
x = myparamarray(1)+test(3)
|
||||
|
||||
return
|
||||
end subroutine
|
@ -0,0 +1,57 @@
|
||||
! 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
|
@ -0,0 +1,15 @@
|
||||
! 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
|
@ -0,0 +1,22 @@
|
||||
! 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
|
@ -0,0 +1,23 @@
|
||||
! 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=maxiterates*maxseries)
|
||||
integer(ii), intent(inout) :: x
|
||||
dimension x(wasize)
|
||||
|
||||
x(1) = x(1) + x(2) + x(3) + x(4) * wasize
|
||||
return
|
||||
end subroutine
|
@ -0,0 +1,23 @@
|
||||
! 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
|
||||
|
@ -0,0 +1,14 @@
|
||||
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
|
@ -0,0 +1 @@
|
||||
real(8) b, n, m
|
@ -0,0 +1,26 @@
|
||||
SUBROUTINE TESTSUB(
|
||||
& INPUT1, INPUT2, !Input
|
||||
& OUTPUT1, OUTPUT2) !Output
|
||||
|
||||
IMPLICIT NONE
|
||||
INTEGER, INTENT(IN) :: INPUT1, INPUT2
|
||||
INTEGER, INTENT(OUT) :: OUTPUT1, OUTPUT2
|
||||
|
||||
OUTPUT1 = INPUT1 + INPUT2
|
||||
OUTPUT2 = INPUT1 * INPUT2
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE TESTSUB
|
||||
|
||||
SUBROUTINE TESTSUB2(OUTPUT)
|
||||
IMPLICIT NONE
|
||||
INTEGER, PARAMETER :: N = 10 ! Array dimension
|
||||
REAL, INTENT(OUT) :: OUTPUT(N)
|
||||
INTEGER :: I
|
||||
|
||||
DO I = 1, N
|
||||
OUTPUT(I) = I * 2.0
|
||||
END DO
|
||||
|
||||
RETURN
|
||||
END
|
@ -0,0 +1,5 @@
|
||||
C This is an invalid file, but it does compile with -ffixed-form
|
||||
subroutine mwe(
|
||||
& x)
|
||||
real x
|
||||
end subroutine mwe
|
@ -0,0 +1,9 @@
|
||||
SUBROUTINE TESTSUB(INPUT1, & ! Hello
|
||||
! commenty
|
||||
INPUT2, OUTPUT1, OUTPUT2) ! more comments
|
||||
INTEGER, INTENT(IN) :: INPUT1, INPUT2
|
||||
INTEGER, INTENT(OUT) :: OUTPUT1, OUTPUT2
|
||||
OUTPUT1 = INPUT1 + &
|
||||
INPUT2
|
||||
OUTPUT2 = INPUT1 * INPUT2
|
||||
END SUBROUTINE TESTSUB
|
@ -0,0 +1,5 @@
|
||||
function add(n,m) result(b)
|
||||
implicit none
|
||||
include 'AB.inc'
|
||||
b = n + m
|
||||
end function add
|
@ -0,0 +1,9 @@
|
||||
! 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
|
@ -0,0 +1,45 @@
|
||||
function t0(value)
|
||||
character value
|
||||
character t0
|
||||
t0 = value
|
||||
end
|
||||
function t1(value)
|
||||
character*1 value
|
||||
character*1 t1
|
||||
t1 = value
|
||||
end
|
||||
function t5(value)
|
||||
character*5 value
|
||||
character*5 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)
|
||||
character*1 value
|
||||
character*1 t1
|
||||
cf2py intent(out) t1
|
||||
t1 = value
|
||||
end
|
||||
subroutine s5(t5,value)
|
||||
character*5 value
|
||||
character*5 t5
|
||||
cf2py intent(out) t5
|
||||
t5 = value
|
||||
end
|
||||
subroutine ss(ts,value)
|
||||
character*(*) value
|
||||
character*10 ts
|
||||
cf2py intent(out) ts
|
||||
ts = value
|
||||
end
|
@ -0,0 +1,48 @@
|
||||
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
|
@ -0,0 +1,45 @@
|
||||
function t0(value)
|
||||
complex value
|
||||
complex t0
|
||||
t0 = value
|
||||
end
|
||||
function t8(value)
|
||||
complex*8 value
|
||||
complex*8 t8
|
||||
t8 = value
|
||||
end
|
||||
function t16(value)
|
||||
complex*16 value
|
||||
complex*16 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)
|
||||
complex*8 value
|
||||
complex*8 t8
|
||||
cf2py intent(out) t8
|
||||
t8 = value
|
||||
end
|
||||
subroutine s16(t16,value)
|
||||
complex*16 value
|
||||
complex*16 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
|
@ -0,0 +1,48 @@
|
||||
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
|
@ -0,0 +1,56 @@
|
||||
function t0(value)
|
||||
integer value
|
||||
integer t0
|
||||
t0 = value
|
||||
end
|
||||
function t1(value)
|
||||
integer*1 value
|
||||
integer*1 t1
|
||||
t1 = value
|
||||
end
|
||||
function t2(value)
|
||||
integer*2 value
|
||||
integer*2 t2
|
||||
t2 = value
|
||||
end
|
||||
function t4(value)
|
||||
integer*4 value
|
||||
integer*4 t4
|
||||
t4 = value
|
||||
end
|
||||
function t8(value)
|
||||
integer*8 value
|
||||
integer*8 t8
|
||||
t8 = value
|
||||
end
|
||||
|
||||
subroutine s0(t0,value)
|
||||
integer value
|
||||
integer t0
|
||||
cf2py intent(out) t0
|
||||
t0 = value
|
||||
end
|
||||
subroutine s1(t1,value)
|
||||
integer*1 value
|
||||
integer*1 t1
|
||||
cf2py intent(out) t1
|
||||
t1 = value
|
||||
end
|
||||
subroutine s2(t2,value)
|
||||
integer*2 value
|
||||
integer*2 t2
|
||||
cf2py intent(out) t2
|
||||
t2 = value
|
||||
end
|
||||
subroutine s4(t4,value)
|
||||
integer*4 value
|
||||
integer*4 t4
|
||||
cf2py intent(out) t4
|
||||
t4 = value
|
||||
end
|
||||
subroutine s8(t8,value)
|
||||
integer*8 value
|
||||
integer*8 t8
|
||||
cf2py intent(out) t8
|
||||
t8 = value
|
||||
end
|
@ -0,0 +1,59 @@
|
||||
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
|
@ -0,0 +1,56 @@
|
||||
function t0(value)
|
||||
logical value
|
||||
logical t0
|
||||
t0 = value
|
||||
end
|
||||
function t1(value)
|
||||
logical*1 value
|
||||
logical*1 t1
|
||||
t1 = value
|
||||
end
|
||||
function t2(value)
|
||||
logical*2 value
|
||||
logical*2 t2
|
||||
t2 = value
|
||||
end
|
||||
function t4(value)
|
||||
logical*4 value
|
||||
logical*4 t4
|
||||
t4 = value
|
||||
end
|
||||
c function t8(value)
|
||||
c logical*8 value
|
||||
c logical*8 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)
|
||||
logical*1 value
|
||||
logical*1 t1
|
||||
cf2py intent(out) t1
|
||||
t1 = value
|
||||
end
|
||||
subroutine s2(t2,value)
|
||||
logical*2 value
|
||||
logical*2 t2
|
||||
cf2py intent(out) t2
|
||||
t2 = value
|
||||
end
|
||||
subroutine s4(t4,value)
|
||||
logical*4 value
|
||||
logical*4 t4
|
||||
cf2py intent(out) t4
|
||||
t4 = value
|
||||
end
|
||||
c subroutine s8(t8,value)
|
||||
c logical*8 value
|
||||
c logical*8 t8
|
||||
cf2py intent(out) t8
|
||||
c t8 = value
|
||||
c end
|
@ -0,0 +1,59 @@
|
||||
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
|
@ -0,0 +1,45 @@
|
||||
function t0(value)
|
||||
real value
|
||||
real t0
|
||||
t0 = value
|
||||
end
|
||||
function t4(value)
|
||||
real*4 value
|
||||
real*4 t4
|
||||
t4 = value
|
||||
end
|
||||
function t8(value)
|
||||
real*8 value
|
||||
real*8 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)
|
||||
real*4 value
|
||||
real*4 t4
|
||||
cf2py intent(out) t4
|
||||
t4 = value
|
||||
end
|
||||
subroutine s8(t8,value)
|
||||
real*8 value
|
||||
real*8 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
|
@ -0,0 +1,48 @@
|
||||
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
|
@ -0,0 +1,44 @@
|
||||
|
||||
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
|
@ -0,0 +1,29 @@
|
||||
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.
|
||||
INTEGER*4 :: 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
|
||||
|
@ -0,0 +1,34 @@
|
||||
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
|
@ -0,0 +1,8 @@
|
||||
SUBROUTINE GREET(NAME, GREETING)
|
||||
CHARACTER NAME*(*), GREETING*(*)
|
||||
CHARACTER*(50) MESSAGE
|
||||
|
||||
MESSAGE = 'Hello, ' // NAME // ', ' // GREETING
|
||||
c$$$ PRINT *, MESSAGE
|
||||
|
||||
END SUBROUTINE GREET
|
@ -0,0 +1,7 @@
|
||||
subroutine string_inout_optional(output)
|
||||
implicit none
|
||||
character*(32), optional, intent(inout) :: output
|
||||
if (present(output)) then
|
||||
output="output string"
|
||||
endif
|
||||
end subroutine
|
@ -0,0 +1,14 @@
|
||||
subroutine charint(trans, info)
|
||||
character, intent(in) :: trans
|
||||
integer, intent(out) :: info
|
||||
if (trans == 'N') then
|
||||
info = 1
|
||||
else if (trans == 'T') then
|
||||
info = 2
|
||||
else if (trans == 'C') then
|
||||
info = 3
|
||||
else
|
||||
info = -1
|
||||
end if
|
||||
|
||||
end subroutine charint
|
@ -0,0 +1,12 @@
|
||||
python module _char_handling_test
|
||||
interface
|
||||
subroutine charint(trans, info)
|
||||
callstatement (*f2py_func)(&trans, &info)
|
||||
callprotoargument char*, int*
|
||||
|
||||
character, intent(in), check(trans=='N'||trans=='T'||trans=='C') :: trans = 'N'
|
||||
integer intent(out) :: info
|
||||
|
||||
end subroutine charint
|
||||
end interface
|
||||
end python module _char_handling_test
|
@ -0,0 +1,12 @@
|
||||
python module _char_handling_test
|
||||
interface
|
||||
subroutine charint(trans, info)
|
||||
callstatement (*f2py_func)(&trans, &info)
|
||||
callprotoargument char*, int*
|
||||
|
||||
character, intent(in), check(*trans=='N'||*trans=='T'||*trans=='C') :: trans = 'N'
|
||||
integer intent(out) :: info
|
||||
|
||||
end subroutine charint
|
||||
end interface
|
||||
end python module _char_handling_test
|
@ -0,0 +1,9 @@
|
||||
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
|
@ -0,0 +1,12 @@
|
||||
C FILE: STRING.F
|
||||
SUBROUTINE FOO(A,B,C,D)
|
||||
CHARACTER*5 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
|
@ -0,0 +1,9 @@
|
||||
module fortfuncs
|
||||
implicit none
|
||||
contains
|
||||
subroutine square(x,y)
|
||||
integer, intent(in), value :: x
|
||||
integer, intent(out) :: y
|
||||
y = x*x
|
||||
end subroutine square
|
||||
end module fortfuncs
|
Reference in New Issue
Block a user