summaryrefslogtreecommitdiff
path: root/numpy
diff options
context:
space:
mode:
Diffstat (limited to 'numpy')
-rw-r--r--numpy/__init__.py107
-rw-r--r--numpy/_import_tools.py357
-rw-r--r--numpy/add_newdocs.py1422
-rw-r--r--numpy/core/__init__.py38
-rw-r--r--numpy/core/_internal.py289
-rw-r--r--numpy/core/arrayprint.py450
-rw-r--r--numpy/core/blasdot/_dotblas.c1092
-rw-r--r--numpy/core/blasdot/cblas.h578
-rw-r--r--numpy/core/code_generators/array_api_order.txt85
-rw-r--r--numpy/core/code_generators/genapi.py295
-rw-r--r--numpy/core/code_generators/generate_array_api.py208
-rw-r--r--numpy/core/code_generators/generate_ufunc_api.py125
-rw-r--r--numpy/core/code_generators/generate_umath.py645
-rw-r--r--numpy/core/code_generators/multiarray_api_order.txt83
-rw-r--r--numpy/core/code_generators/ufunc_api_order.txt30
-rw-r--r--numpy/core/defchararray.py340
-rw-r--r--numpy/core/defmatrix.py496
-rw-r--r--numpy/core/fromnumeric.py985
-rw-r--r--numpy/core/include/numpy/arrayobject.h21
-rw-r--r--numpy/core/include/numpy/arrayscalars.h152
-rw-r--r--numpy/core/include/numpy/fenv/fenv.c38
-rw-r--r--numpy/core/include/numpy/fenv/fenv.h224
-rw-r--r--numpy/core/include/numpy/ndarrayobject.h1995
-rw-r--r--numpy/core/include/numpy/noprefix.h191
-rw-r--r--numpy/core/include/numpy/npy_interrupt.h117
-rw-r--r--numpy/core/include/numpy/old_defines.h169
-rw-r--r--numpy/core/include/numpy/oldnumeric.h23
-rw-r--r--numpy/core/include/numpy/ufuncobject.h365
-rw-r--r--numpy/core/info.py86
-rw-r--r--numpy/core/ma.py2254
-rw-r--r--numpy/core/memmap.py93
-rw-r--r--numpy/core/numeric.py1056
-rw-r--r--numpy/core/numerictypes.py486
-rw-r--r--numpy/core/records.py589
-rw-r--r--numpy/core/setup.py334
-rw-r--r--numpy/core/src/_isnan.c46
-rw-r--r--numpy/core/src/_signbit.c32
-rw-r--r--numpy/core/src/_sortmodule.c.src472
-rw-r--r--numpy/core/src/arraymethods.c1939
-rw-r--r--numpy/core/src/arrayobject.c12076
-rw-r--r--numpy/core/src/arraytypes.inc.src2461
-rw-r--r--numpy/core/src/multiarraymodule.c7604
-rw-r--r--numpy/core/src/scalarmathmodule.c.src1225
-rw-r--r--numpy/core/src/scalartypes.inc.src2742
-rw-r--r--numpy/core/src/ucsnarrow.c108
-rw-r--r--numpy/core/src/ufuncobject.c3891
-rw-r--r--numpy/core/src/umathmodule.c.src2265
-rw-r--r--numpy/core/tests/test_defmatrix.py184
-rw-r--r--numpy/core/tests/test_errstate.py62
-rw-r--r--numpy/core/tests/test_ma.py873
-rw-r--r--numpy/core/tests/test_multiarray.py430
-rw-r--r--numpy/core/tests/test_numeric.py679
-rw-r--r--numpy/core/tests/test_numerictypes.py342
-rw-r--r--numpy/core/tests/test_records.py89
-rw-r--r--numpy/core/tests/test_regression.py691
-rw-r--r--numpy/core/tests/test_scalarmath.py55
-rw-r--r--numpy/core/tests/test_umath.py198
-rw-r--r--numpy/core/tests/test_unicode.py304
-rw-r--r--numpy/core/tests/testdata.fitsbin0 -> 8640 bytes
-rw-r--r--numpy/ctypeslib.py165
-rw-r--r--numpy/distutils/__init__.py19
-rw-r--r--numpy/distutils/__version__.py4
-rw-r--r--numpy/distutils/ccompiler.py436
-rw-r--r--numpy/distutils/command/__init__.py31
-rw-r--r--numpy/distutils/command/bdist_rpm.py19
-rw-r--r--numpy/distutils/command/build.py34
-rw-r--r--numpy/distutils/command/build_clib.py250
-rw-r--r--numpy/distutils/command/build_ext.py465
-rw-r--r--numpy/distutils/command/build_py.py25
-rw-r--r--numpy/distutils/command/build_scripts.py45
-rw-r--r--numpy/distutils/command/build_src.py712
-rw-r--r--numpy/distutils/command/config.py156
-rw-r--r--numpy/distutils/command/config_compiler.py124
-rw-r--r--numpy/distutils/command/egg_info.py6
-rw-r--r--numpy/distutils/command/install.py36
-rw-r--r--numpy/distutils/command/install_data.py13
-rw-r--r--numpy/distutils/command/install_headers.py25
-rw-r--r--numpy/distutils/command/sdist.py22
-rw-r--r--numpy/distutils/conv_template.py202
-rw-r--r--numpy/distutils/core.py217
-rw-r--r--numpy/distutils/cpuinfo.py696
-rw-r--r--numpy/distutils/exec_command.py636
-rw-r--r--numpy/distutils/extension.py74
-rw-r--r--numpy/distutils/fcompiler/__init__.py825
-rw-r--r--numpy/distutils/fcompiler/absoft.py151
-rw-r--r--numpy/distutils/fcompiler/compaq.py96
-rw-r--r--numpy/distutils/fcompiler/g95.py48
-rw-r--r--numpy/distutils/fcompiler/gnu.py341
-rw-r--r--numpy/distutils/fcompiler/hpux.py41
-rw-r--r--numpy/distutils/fcompiler/ibm.py97
-rw-r--r--numpy/distutils/fcompiler/intel.py212
-rw-r--r--numpy/distutils/fcompiler/lahey.py46
-rw-r--r--numpy/distutils/fcompiler/mips.py56
-rw-r--r--numpy/distutils/fcompiler/nag.py43
-rw-r--r--numpy/distutils/fcompiler/none.py24
-rw-r--r--numpy/distutils/fcompiler/pg.py42
-rw-r--r--numpy/distutils/fcompiler/sun.py51
-rw-r--r--numpy/distutils/fcompiler/vast.py53
-rw-r--r--numpy/distutils/from_template.py256
-rw-r--r--numpy/distutils/info.py5
-rw-r--r--numpy/distutils/intelccompiler.py30
-rw-r--r--numpy/distutils/interactive.py187
-rw-r--r--numpy/distutils/lib2def.py116
-rw-r--r--numpy/distutils/line_endings.py75
-rw-r--r--numpy/distutils/log.py47
-rw-r--r--numpy/distutils/mingw32ccompiler.py227
-rw-r--r--numpy/distutils/misc_util.py1451
-rw-r--r--numpy/distutils/setup.py15
-rw-r--r--numpy/distutils/system_info.py1919
-rw-r--r--numpy/distutils/tests/f2py_ext/__init__.py0
-rw-r--r--numpy/distutils/tests/f2py_ext/setup.py11
-rw-r--r--numpy/distutils/tests/f2py_ext/src/fib1.f18
-rw-r--r--numpy/distutils/tests/f2py_ext/src/fib2.pyf9
-rw-r--r--numpy/distutils/tests/f2py_ext/tests/test_fib2.py13
-rw-r--r--numpy/distutils/tests/f2py_f90_ext/__init__.py0
-rw-r--r--numpy/distutils/tests/f2py_f90_ext/include/body.f905
-rw-r--r--numpy/distutils/tests/f2py_f90_ext/setup.py16
-rw-r--r--numpy/distutils/tests/f2py_f90_ext/src/foo_free.f906
-rw-r--r--numpy/distutils/tests/f2py_f90_ext/tests/test_foo.py13
-rw-r--r--numpy/distutils/tests/gen_ext/__init__.py0
-rw-r--r--numpy/distutils/tests/gen_ext/setup.py47
-rw-r--r--numpy/distutils/tests/gen_ext/tests/test_fib3.py13
-rw-r--r--numpy/distutils/tests/pyrex_ext/__init__.py0
-rw-r--r--numpy/distutils/tests/pyrex_ext/primes.pyx22
-rw-r--r--numpy/distutils/tests/pyrex_ext/setup.py12
-rw-r--r--numpy/distutils/tests/pyrex_ext/tests/test_primes.py13
-rw-r--r--numpy/distutils/tests/setup.py14
-rw-r--r--numpy/distutils/tests/swig_ext/__init__.py0
-rw-r--r--numpy/distutils/tests/swig_ext/setup.py18
-rw-r--r--numpy/distutils/tests/swig_ext/src/example.c14
-rw-r--r--numpy/distutils/tests/swig_ext/src/example.i14
-rw-r--r--numpy/distutils/tests/swig_ext/src/zoo.cc23
-rw-r--r--numpy/distutils/tests/swig_ext/src/zoo.h9
-rw-r--r--numpy/distutils/tests/swig_ext/src/zoo.i10
-rw-r--r--numpy/distutils/tests/swig_ext/tests/test_example.py18
-rw-r--r--numpy/distutils/tests/swig_ext/tests/test_example2.py17
-rw-r--r--numpy/distutils/tests/test_fcompiler_gnu.py52
-rw-r--r--numpy/distutils/tests/test_misc_util.py60
-rw-r--r--numpy/distutils/unixccompiler.py65
-rw-r--r--numpy/doc/CAPI.txt311
-rw-r--r--numpy/doc/DISTUTILS.txt573
-rw-r--r--numpy/doc/HOWTO_DOCUMENT.txt112
-rw-r--r--numpy/doc/README.txt15
-rw-r--r--numpy/doc/pep_buffer.txt871
-rw-r--r--numpy/doc/pyrex/MANIFEST2
-rw-r--r--numpy/doc/pyrex/Makefile9
-rw-r--r--numpy/doc/pyrex/c_numpy.pxd125
-rw-r--r--numpy/doc/pyrex/c_python.pxd20
-rw-r--r--numpy/doc/pyrex/notes3
-rw-r--r--numpy/doc/pyrex/numpyx.c1037
-rw-r--r--numpy/doc/pyrex/numpyx.pyx97
-rwxr-xr-xnumpy/doc/pyrex/run_test.py3
-rw-r--r--numpy/doc/pyrex/setup.py42
-rw-r--r--numpy/doc/records.txt86
-rw-r--r--numpy/doc/swig/Makefile62
-rw-r--r--numpy/doc/swig/Matrix.cxx112
-rw-r--r--numpy/doc/swig/Matrix.h52
-rw-r--r--numpy/doc/swig/Matrix.i45
-rw-r--r--numpy/doc/swig/README121
-rw-r--r--numpy/doc/swig/Tensor.cxx131
-rw-r--r--numpy/doc/swig/Tensor.h52
-rw-r--r--numpy/doc/swig/Tensor.i49
-rw-r--r--numpy/doc/swig/Vector.cxx100
-rw-r--r--numpy/doc/swig/Vector.h58
-rw-r--r--numpy/doc/swig/Vector.i47
-rw-r--r--numpy/doc/swig/numpy.i975
-rw-r--r--numpy/doc/swig/numpy_swig.html1061
-rw-r--r--numpy/doc/swig/numpy_swig.pdfbin0 -> 148220 bytes
-rw-r--r--numpy/doc/swig/numpy_swig.txt774
-rwxr-xr-xnumpy/doc/swig/setup.py43
-rwxr-xr-xnumpy/doc/swig/testMatrix.py365
-rwxr-xr-xnumpy/doc/swig/testTensor.py405
-rwxr-xr-xnumpy/doc/swig/testVector.py384
-rw-r--r--numpy/doc/swig/testing.html482
-rw-r--r--numpy/doc/swig/testing.pdfbin0 -> 72391 bytes
-rw-r--r--numpy/doc/swig/testing.txt173
-rw-r--r--numpy/doc/ufuncs.txt101
-rw-r--r--numpy/dual.py57
-rw-r--r--numpy/f2py/BUGS.txt55
-rw-r--r--numpy/f2py/Makefile173
-rw-r--r--numpy/f2py/NEWS.txt2
-rw-r--r--numpy/f2py/README.txt5
-rw-r--r--numpy/f2py/TODO.txt67
-rw-r--r--numpy/f2py/__init__.py42
-rw-r--r--numpy/f2py/__version__.py8
-rw-r--r--numpy/f2py/auxfuncs.py487
-rw-r--r--numpy/f2py/capi_maps.py728
-rw-r--r--numpy/f2py/cb_rules.py529
-rw-r--r--numpy/f2py/cfuncs.py1141
-rw-r--r--numpy/f2py/common_rules.py131
-rwxr-xr-xnumpy/f2py/crackfortran.py2673
-rw-r--r--numpy/f2py/diagnose.py166
-rw-r--r--numpy/f2py/doc/Makefile76
-rw-r--r--numpy/f2py/doc/Release-1.x.txt27
-rw-r--r--numpy/f2py/doc/Release-2.x.txt77
-rw-r--r--numpy/f2py/doc/Release-3.x.txt87
-rw-r--r--numpy/f2py/doc/Release-4.x.txt91
-rw-r--r--numpy/f2py/doc/apps.tex71
-rw-r--r--numpy/f2py/doc/bugs.tex109
-rwxr-xr-xnumpy/f2py/doc/collectinput.py74
-rw-r--r--numpy/f2py/doc/commands.tex20
-rw-r--r--numpy/f2py/doc/ex1/arr.f4
-rw-r--r--numpy/f2py/doc/ex1/bar.f4
-rw-r--r--numpy/f2py/doc/ex1/foo.f5
-rw-r--r--numpy/f2py/doc/ex1/foobar-smart.f9024
-rw-r--r--numpy/f2py/doc/ex1/foobar.f9016
-rw-r--r--numpy/f2py/doc/ex1/foobarmodule.tex36
-rwxr-xr-xnumpy/f2py/doc/ex1/runme18
-rw-r--r--numpy/f2py/doc/f2py2e.tex50
-rw-r--r--numpy/f2py/doc/f2python9-final/README.txt38
-rw-r--r--numpy/f2py/doc/f2python9-final/aerostructure.jpgbin0 -> 72247 bytes
-rw-r--r--numpy/f2py/doc/f2python9-final/flow.jpgbin0 -> 13266 bytes
-rwxr-xr-xnumpy/f2py/doc/f2python9-final/mk_html.sh13
-rwxr-xr-xnumpy/f2py/doc/f2python9-final/mk_pdf.sh13
-rwxr-xr-xnumpy/f2py/doc/f2python9-final/mk_ps.sh14
-rw-r--r--numpy/f2py/doc/f2python9-final/src/examples/exp1.f26
-rw-r--r--numpy/f2py/doc/f2python9-final/src/examples/exp1mess.txt17
-rw-r--r--numpy/f2py/doc/f2python9-final/src/examples/exp1session.txt20
-rw-r--r--numpy/f2py/doc/f2python9-final/src/examples/foo.pyf13
-rw-r--r--numpy/f2py/doc/f2python9-final/src/examples/foom.pyf14
-rw-r--r--numpy/f2py/doc/f2python9-final/structure.jpgbin0 -> 17860 bytes
-rw-r--r--numpy/f2py/doc/fortranobject.tex574
-rw-r--r--numpy/f2py/doc/index.html264
-rw-r--r--numpy/f2py/doc/intro.tex158
-rw-r--r--numpy/f2py/doc/multiarray/array_from_pyobj.c323
-rw-r--r--numpy/f2py/doc/multiarray/bar.c15
-rw-r--r--numpy/f2py/doc/multiarray/foo.f13
-rw-r--r--numpy/f2py/doc/multiarray/fortran_array_from_pyobj.txt284
-rw-r--r--numpy/f2py/doc/multiarray/fun.pyf89
-rw-r--r--numpy/f2py/doc/multiarray/run.pyf91
-rw-r--r--numpy/f2py/doc/multiarray/transpose.txt1127
-rw-r--r--numpy/f2py/doc/multiarrays.txt120
-rw-r--r--numpy/f2py/doc/notes.tex310
-rw-r--r--numpy/f2py/doc/oldnews.html121
-rw-r--r--numpy/f2py/doc/options.tex63
-rw-r--r--numpy/f2py/doc/python9.tex1046
-rw-r--r--numpy/f2py/doc/signaturefile.tex368
-rw-r--r--numpy/f2py/doc/using_F_compiler.txt147
-rw-r--r--numpy/f2py/doc/win32_notes.txt85
-rw-r--r--numpy/f2py/docs/FAQ.txt615
-rw-r--r--numpy/f2py/docs/HISTORY.txt1044
-rw-r--r--numpy/f2py/docs/OLDNEWS.txt63
-rw-r--r--numpy/f2py/docs/README.txt461
-rw-r--r--numpy/f2py/docs/TESTING.txt108
-rw-r--r--numpy/f2py/docs/THANKS.txt63
-rw-r--r--numpy/f2py/docs/default.css180
-rw-r--r--numpy/f2py/docs/docutils.conf16
-rw-r--r--numpy/f2py/docs/hello.f7
-rw-r--r--numpy/f2py/docs/pyforttest.pyf5
-rw-r--r--numpy/f2py/docs/pytest.py10
-rw-r--r--numpy/f2py/docs/simple.f13
-rw-r--r--numpy/f2py/docs/simple_session.dat51
-rw-r--r--numpy/f2py/docs/usersguide/allocarr.f9016
-rw-r--r--numpy/f2py/docs/usersguide/allocarr_session.dat27
-rw-r--r--numpy/f2py/docs/usersguide/array.f17
-rw-r--r--numpy/f2py/docs/usersguide/array_session.dat65
-rw-r--r--numpy/f2py/docs/usersguide/calculate.f14
-rw-r--r--numpy/f2py/docs/usersguide/calculate_session.dat6
-rw-r--r--numpy/f2py/docs/usersguide/callback.f12
-rw-r--r--numpy/f2py/docs/usersguide/callback2.pyf19
-rw-r--r--numpy/f2py/docs/usersguide/callback_session.dat23
-rw-r--r--numpy/f2py/docs/usersguide/common.f13
-rw-r--r--numpy/f2py/docs/usersguide/common_session.dat27
-rw-r--r--numpy/f2py/docs/usersguide/compile_session.dat11
-rw-r--r--numpy/f2py/docs/usersguide/default.css180
-rw-r--r--numpy/f2py/docs/usersguide/docutils.conf16
-rw-r--r--numpy/f2py/docs/usersguide/extcallback.f14
-rw-r--r--numpy/f2py/docs/usersguide/extcallback_session.dat19
-rw-r--r--numpy/f2py/docs/usersguide/fib1.f18
-rw-r--r--numpy/f2py/docs/usersguide/fib1.pyf12
-rw-r--r--numpy/f2py/docs/usersguide/fib2.pyf9
-rw-r--r--numpy/f2py/docs/usersguide/fib3.f21
-rw-r--r--numpy/f2py/docs/usersguide/ftype.f9
-rw-r--r--numpy/f2py/docs/usersguide/ftype_session.dat21
-rw-r--r--numpy/f2py/docs/usersguide/index.txt1772
-rw-r--r--numpy/f2py/docs/usersguide/moddata.f9018
-rw-r--r--numpy/f2py/docs/usersguide/moddata_session.dat23
-rw-r--r--numpy/f2py/docs/usersguide/run_main_session.dat14
-rw-r--r--numpy/f2py/docs/usersguide/scalar.f12
-rw-r--r--numpy/f2py/docs/usersguide/scalar_session.dat21
-rw-r--r--numpy/f2py/docs/usersguide/setup_example.py19
-rw-r--r--numpy/f2py/docs/usersguide/spam.pyf19
-rw-r--r--numpy/f2py/docs/usersguide/spam_session.dat5
-rw-r--r--numpy/f2py/docs/usersguide/string.f21
-rw-r--r--numpy/f2py/docs/usersguide/string_session.dat27
-rw-r--r--numpy/f2py/docs/usersguide/var.pyf11
-rw-r--r--numpy/f2py/docs/usersguide/var_session.dat3
-rw-r--r--numpy/f2py/f2py.1209
-rwxr-xr-xnumpy/f2py/f2py2e.py560
-rw-r--r--numpy/f2py/f2py_testing.py73
-rw-r--r--numpy/f2py/f90mod_rules.py240
-rw-r--r--numpy/f2py/func2subr.py165
-rw-r--r--numpy/f2py/info.py5
-rw-r--r--numpy/f2py/lib/__init__.py14
-rw-r--r--numpy/f2py/lib/api.py14
-rw-r--r--numpy/f2py/lib/main.py534
-rw-r--r--numpy/f2py/lib/nary.py32
-rw-r--r--numpy/f2py/lib/parser/Fortran2003.py5889
-rw-r--r--numpy/f2py/lib/parser/__init__.py14
-rw-r--r--numpy/f2py/lib/parser/api.py73
-rw-r--r--numpy/f2py/lib/parser/base_classes.py819
-rw-r--r--numpy/f2py/lib/parser/block_statements.py1229
-rw-r--r--numpy/f2py/lib/parser/doc.txt365
-rw-r--r--numpy/f2py/lib/parser/parsefortran.py197
-rw-r--r--numpy/f2py/lib/parser/pattern_tools.py401
-rw-r--r--numpy/f2py/lib/parser/readfortran.py857
-rw-r--r--numpy/f2py/lib/parser/sourceinfo.py81
-rw-r--r--numpy/f2py/lib/parser/splitline.py426
-rw-r--r--numpy/f2py/lib/parser/statements.py1856
-rw-r--r--numpy/f2py/lib/parser/test_Fortran2003.py2101
-rw-r--r--numpy/f2py/lib/parser/test_parser.py496
-rw-r--r--numpy/f2py/lib/parser/typedecl_statements.py563
-rw-r--r--numpy/f2py/lib/parser/utils.py177
-rw-r--r--numpy/f2py/lib/py_wrap.py128
-rw-r--r--numpy/f2py/lib/py_wrap_subprogram.py210
-rw-r--r--numpy/f2py/lib/py_wrap_type.py753
-rw-r--r--numpy/f2py/lib/setup.py12
-rw-r--r--numpy/f2py/lib/src/F_FUNC.cpp34
-rw-r--r--numpy/f2py/lib/src/pyobj_to_string_len.c11
-rw-r--r--numpy/f2py/lib/tests/test_derived_scalar.py74
-rw-r--r--numpy/f2py/lib/tests/test_module_module.py61
-rw-r--r--numpy/f2py/lib/tests/test_module_scalar.py58
-rw-r--r--numpy/f2py/lib/tests/test_scalar_function_in.py532
-rw-r--r--numpy/f2py/lib/tests/test_scalar_in_out.py529
-rw-r--r--numpy/f2py/lib/wrapper_base.py178
-rw-r--r--numpy/f2py/rules.py1344
-rw-r--r--numpy/f2py/setup.cfg3
-rwxr-xr-xnumpy/f2py/setup.py129
-rw-r--r--numpy/f2py/src/fortranobject.c815
-rw-r--r--numpy/f2py/src/fortranobject.h124
-rw-r--r--numpy/f2py/src/test/Makefile96
-rw-r--r--numpy/f2py/src/test/bar.f11
-rw-r--r--numpy/f2py/src/test/foo.f11
-rw-r--r--numpy/f2py/src/test/foo90.f9013
-rw-r--r--numpy/f2py/src/test/foomodule.c143
-rw-r--r--numpy/f2py/src/test/wrap.f70
-rw-r--r--numpy/f2py/tests/array_from_pyobj/__init__.py0
-rw-r--r--numpy/f2py/tests/array_from_pyobj/setup.py25
-rw-r--r--numpy/f2py/tests/array_from_pyobj/tests/test_array_from_pyobj.py515
-rw-r--r--numpy/f2py/tests/array_from_pyobj/wrapmodule.c196
-rw-r--r--numpy/f2py/tests/c/return_real.py107
-rw-r--r--numpy/f2py/tests/f77/callback.py98
-rw-r--r--numpy/f2py/tests/f77/return_character.py99
-rw-r--r--numpy/f2py/tests/f77/return_complex.py124
-rw-r--r--numpy/f2py/tests/f77/return_integer.py147
-rw-r--r--numpy/f2py/tests/f77/return_logical.py133
-rw-r--r--numpy/f2py/tests/f77/return_real.py126
-rw-r--r--numpy/f2py/tests/f90/return_character.py98
-rw-r--r--numpy/f2py/tests/f90/return_complex.py126
-rw-r--r--numpy/f2py/tests/f90/return_integer.py151
-rw-r--r--numpy/f2py/tests/f90/return_logical.py137
-rw-r--r--numpy/f2py/tests/f90/return_real.py129
-rw-r--r--numpy/f2py/tests/mixed/foo.f5
-rw-r--r--numpy/f2py/tests/mixed/foo_fixed.f908
-rw-r--r--numpy/f2py/tests/mixed/foo_free.f908
-rw-r--r--numpy/f2py/tests/mixed/run.py50
-rwxr-xr-xnumpy/f2py/tests/run_all.py55
-rw-r--r--numpy/f2py/use_rules.py109
-rw-r--r--numpy/fft/__init__.py9
-rw-r--r--numpy/fft/fftpack.c1501
-rw-r--r--numpy/fft/fftpack.h28
-rw-r--r--numpy/fft/fftpack.py326
-rw-r--r--numpy/fft/fftpack_litemodule.c275
-rw-r--r--numpy/fft/helper.py66
-rw-r--r--numpy/fft/info.py29
-rw-r--r--numpy/fft/setup.py19
-rw-r--r--numpy/fft/tests/test_fftpack.py12
-rw-r--r--numpy/fft/tests/test_helper.py45
-rw-r--r--numpy/lib/__init__.py35
-rw-r--r--numpy/lib/arraysetops.py327
-rw-r--r--numpy/lib/convdtype.py65
-rw-r--r--numpy/lib/function_base.py1454
-rw-r--r--numpy/lib/getlimits.py175
-rw-r--r--numpy/lib/index_tricks.py457
-rw-r--r--numpy/lib/info.py136
-rw-r--r--numpy/lib/machar.py285
-rw-r--r--numpy/lib/polynomial.py657
-rw-r--r--numpy/lib/scimath.py86
-rw-r--r--numpy/lib/setup.py21
-rw-r--r--numpy/lib/shape_base.py633
-rw-r--r--numpy/lib/src/_compiled_base.c589
-rw-r--r--numpy/lib/tests/test_arraysetops.py171
-rw-r--r--numpy/lib/tests/test_function_base.py434
-rw-r--r--numpy/lib/tests/test_getlimits.py55
-rw-r--r--numpy/lib/tests/test_index_tricks.py51
-rw-r--r--numpy/lib/tests/test_polynomial.py86
-rw-r--r--numpy/lib/tests/test_shape_base.py408
-rw-r--r--numpy/lib/tests/test_twodim_base.py187
-rw-r--r--numpy/lib/tests/test_type_check.py274
-rw-r--r--numpy/lib/tests/test_ufunclike.py66
-rw-r--r--numpy/lib/twodim_base.py184
-rw-r--r--numpy/lib/type_check.py233
-rw-r--r--numpy/lib/ufunclike.py60
-rw-r--r--numpy/lib/user_array.py217
-rw-r--r--numpy/lib/utils.py432
-rw-r--r--numpy/linalg/__init__.py8
-rw-r--r--numpy/linalg/blas_lite.c10659
-rw-r--r--numpy/linalg/dlamch.c951
-rw-r--r--numpy/linalg/dlapack_lite.c36005
-rw-r--r--numpy/linalg/f2c.h217
-rw-r--r--numpy/linalg/f2c_lite.c492
-rw-r--r--numpy/linalg/info.py25
-rw-r--r--numpy/linalg/lapack_lite/README40
-rw-r--r--numpy/linalg/lapack_lite/clapack_scrub.py276
-rw-r--r--numpy/linalg/lapack_lite/fortran.py114
-rwxr-xr-xnumpy/linalg/lapack_lite/make_lite.py264
-rw-r--r--numpy/linalg/lapack_lite/wrapped_routines19
-rw-r--r--numpy/linalg/lapack_litemodule.c836
-rw-r--r--numpy/linalg/linalg.py968
-rw-r--r--numpy/linalg/setup.py31
-rw-r--r--numpy/linalg/tests/test_linalg.py90
-rw-r--r--numpy/linalg/zlapack_lite.c26018
-rw-r--r--numpy/matlib.py65
-rw-r--r--numpy/numarray/__init__.py26
-rw-r--r--numpy/numarray/_capi.c3337
-rw-r--r--numpy/numarray/alter_code1.py265
-rw-r--r--numpy/numarray/alter_code2.py70
-rw-r--r--numpy/numarray/compat.py4
-rw-r--r--numpy/numarray/convolve.py14
-rw-r--r--numpy/numarray/fft.py7
-rw-r--r--numpy/numarray/functions.py490
-rw-r--r--numpy/numarray/image.py15
-rw-r--r--numpy/numarray/linear_algebra.py15
-rw-r--r--numpy/numarray/ma.py2
-rw-r--r--numpy/numarray/matrix.py8
-rw-r--r--numpy/numarray/mlab.py7
-rw-r--r--numpy/numarray/nd_image.py14
-rw-r--r--numpy/numarray/numerictypes.py551
-rw-r--r--numpy/numarray/numpy/arraybase.h71
-rw-r--r--numpy/numarray/numpy/cfunc.h78
-rw-r--r--numpy/numarray/numpy/ieeespecial.h124
-rw-r--r--numpy/numarray/numpy/libnumarray.h611
-rw-r--r--numpy/numarray/numpy/numcomplex.h252
-rw-r--r--numpy/numarray/numpy/nummacro.h447
-rw-r--r--numpy/numarray/random_array.py9
-rw-r--r--numpy/numarray/session.py348
-rw-r--r--numpy/numarray/setup.py17
-rw-r--r--numpy/numarray/ufuncs.py22
-rw-r--r--numpy/numarray/util.py40
-rw-r--r--numpy/oldnumeric/__init__.py41
-rw-r--r--numpy/oldnumeric/alter_code1.py240
-rw-r--r--numpy/oldnumeric/alter_code2.py146
-rw-r--r--numpy/oldnumeric/array_printer.py16
-rw-r--r--numpy/oldnumeric/arrayfns.py98
-rw-r--r--numpy/oldnumeric/compat.py66
-rw-r--r--numpy/oldnumeric/fft.py21
-rw-r--r--numpy/oldnumeric/fix_default_axis.py291
-rw-r--r--numpy/oldnumeric/functions.py124
-rw-r--r--numpy/oldnumeric/linear_algebra.py83
-rw-r--r--numpy/oldnumeric/ma.py15
-rw-r--r--numpy/oldnumeric/matrix.py68
-rw-r--r--numpy/oldnumeric/misc.py42
-rw-r--r--numpy/oldnumeric/mlab.py122
-rw-r--r--numpy/oldnumeric/precision.py169
-rw-r--r--numpy/oldnumeric/random_array.py268
-rw-r--r--numpy/oldnumeric/rng.py135
-rw-r--r--numpy/oldnumeric/rng_stats.py35
-rw-r--r--numpy/oldnumeric/setup.py8
-rw-r--r--numpy/oldnumeric/tests/test_oldnumeric.py86
-rw-r--r--numpy/oldnumeric/typeconv.py60
-rw-r--r--numpy/oldnumeric/ufuncs.py19
-rw-r--r--numpy/oldnumeric/user_array.py9
-rw-r--r--numpy/random/__init__.py18
-rw-r--r--numpy/random/info.py55
-rw-r--r--numpy/random/mtrand/Python.pxi54
-rw-r--r--numpy/random/mtrand/distributions.c852
-rw-r--r--numpy/random/mtrand/distributions.h185
-rw-r--r--numpy/random/mtrand/generate_mtrand_c.py37
-rw-r--r--numpy/random/mtrand/initarray.c136
-rw-r--r--numpy/random/mtrand/initarray.h6
-rw-r--r--numpy/random/mtrand/mtrand.c10907
-rw-r--r--numpy/random/mtrand/mtrand.pyx1724
-rw-r--r--numpy/random/mtrand/numpy.pxi133
-rw-r--r--numpy/random/mtrand/randomkit.c365
-rw-r--r--numpy/random/mtrand/randomkit.h189
-rw-r--r--numpy/random/setup.py53
-rw-r--r--numpy/setup.py29
-rw-r--r--numpy/testing/__init__.py4
-rw-r--r--numpy/testing/info.py30
-rw-r--r--numpy/testing/numpytest.py661
-rwxr-xr-xnumpy/testing/setup.py16
-rw-r--r--numpy/testing/utils.py238
-rw-r--r--numpy/tests/test_ctypeslib.py63
-rw-r--r--numpy/version.py15
484 files changed, 229568 insertions, 0 deletions
diff --git a/numpy/__init__.py b/numpy/__init__.py
new file mode 100644
index 000000000..473b8e5f0
--- /dev/null
+++ b/numpy/__init__.py
@@ -0,0 +1,107 @@
+"""\
+NumPy
+==========
+
+You can support the development of NumPy and SciPy by purchasing
+the book "Guide to NumPy" at
+
+ http://www.trelgol.com
+
+It is being distributed for a fee for only a few years to
+cover some of the costs of development. After the restriction period
+it will also be freely available.
+
+Additional documentation is available in the docstrings and at
+
+http://www.scipy.org.
+"""
+
+try:
+ from __config__ import show as show_config
+except ImportError:
+ show_config = None
+
+if show_config is None:
+ import sys as _sys
+ print >> _sys.stderr, 'Running from numpy source directory.'
+ del _sys
+else:
+ from version import version as __version__
+
+ from _import_tools import PackageLoader
+
+ def pkgload(*packages, **options):
+ loader = PackageLoader(infunc=True)
+ return loader(*packages, **options)
+
+ import testing
+ from testing import ScipyTest, NumpyTest
+ import core
+ from core import *
+ import lib
+ from lib import *
+ import linalg
+ import fft
+ import random
+ import ctypeslib
+
+ # Make these accessible from numpy name-space
+ # but not imported in from numpy import *
+ from __builtin__ import bool, int, long, float, complex, \
+ object, unicode, str
+ from core import round, abs, max, min
+
+ __all__ = ['__version__', 'pkgload', 'PackageLoader',
+ 'ScipyTest', 'NumpyTest', 'show_config']
+ __all__ += core.__all__
+ __all__ += lib.__all__
+ __all__ += ['linalg', 'fft', 'random', 'ctypeslib']
+
+ if __doc__ is not None:
+ __doc__ += """
+
+Available subpackages
+---------------------
+core --- Defines a multi-dimensional array and useful procedures
+ for Numerical computation.
+lib --- Basic functions used by several sub-packages and useful
+ to have in the main name-space.
+random --- Core Random Tools
+linalg --- Core Linear Algebra Tools
+fft --- Core FFT routines
+testing --- Numpy testing tools
+
+ These packages require explicit import
+f2py --- Fortran to Python Interface Generator.
+distutils --- Enhancements to distutils with support for
+ Fortran compilers support and more.
+
+
+Global symbols from subpackages
+-------------------------------
+core --> *
+lib --> *
+testing --> NumpyTest
+"""
+
+ def test(*args, **kw):
+ return NumpyTest().test(*args, **kw)
+ test.__doc__ = NumpyTest.test.__doc__
+
+ import add_newdocs
+
+ __all__.extend(['add_newdocs','test'])
+
+ if __doc__ is not None:
+ __doc__ += """
+
+Utility tools
+-------------
+
+ test --- Run numpy unittests
+ pkgload --- Load numpy packages
+ show_config --- Show numpy build configuration
+ dual --- Overwrite certain functions with high-performance Scipy tools
+ matlib --- Make everything matrices.
+ __version__ --- Numpy version string
+"""
diff --git a/numpy/_import_tools.py b/numpy/_import_tools.py
new file mode 100644
index 000000000..3df55c26d
--- /dev/null
+++ b/numpy/_import_tools.py
@@ -0,0 +1,357 @@
+
+import os
+import sys
+import imp
+from glob import glob
+
+__all__ = ['PackageLoader']
+
+class PackageLoader:
+ def __init__(self, verbose=False, infunc=False):
+ """ Manages loading packages.
+ """
+
+ if infunc:
+ _level = 2
+ else:
+ _level = 1
+ self.parent_frame = frame = sys._getframe(_level)
+ self.parent_name = eval('__name__',frame.f_globals,frame.f_locals)
+ parent_path = eval('__path__',frame.f_globals,frame.f_locals)
+ if isinstance(parent_path, str):
+ parent_path = [parent_path]
+ self.parent_path = parent_path
+ if not frame.f_locals.has_key('__all__'):
+ exec('__all__ = []',frame.f_globals,frame.f_locals)
+ self.parent_export_names = eval('__all__',frame.f_globals,frame.f_locals)
+
+ self.info_modules = {}
+ self.imported_packages = []
+ self.verbose = None
+
+ def _get_info_files(self, package_dir, parent_path, parent_package=None):
+ """ Return list of (package name,info.py file) from parent_path subdirectories.
+ """
+ from glob import glob
+ files = glob(os.path.join(parent_path,package_dir,'info.py'))
+ for info_file in glob(os.path.join(parent_path,package_dir,'info.pyc')):
+ if info_file[:-1] not in files:
+ files.append(info_file)
+ info_files = []
+ for info_file in files:
+ package_name = os.path.dirname(info_file[len(parent_path)+1:])\
+ .replace(os.sep,'.')
+ if parent_package:
+ package_name = parent_package + '.' + package_name
+ info_files.append((package_name,info_file))
+ info_files.extend(self._get_info_files('*',
+ os.path.dirname(info_file),
+ package_name))
+ return info_files
+
+ def _init_info_modules(self, packages=None):
+ """Initialize info_modules = {<package_name>: <package info.py module>}.
+ """
+ import imp
+ info_files = []
+ info_modules = self.info_modules
+
+ if packages is None:
+ for path in self.parent_path:
+ info_files.extend(self._get_info_files('*',path))
+ else:
+ for package_name in packages:
+ package_dir = os.path.join(*package_name.split('.'))
+ for path in self.parent_path:
+ names_files = self._get_info_files(package_dir, path)
+ if names_files:
+ info_files.extend(names_files)
+ break
+ else:
+ try:
+ exec 'import %s.info as info' % (package_name)
+ info_modules[package_name] = info
+ except ImportError, msg:
+ self.warn('No scipy-style subpackage %r found in %s. '\
+ 'Ignoring: %s'\
+ % (package_name,':'.join(self.parent_path), msg))
+
+ for package_name,info_file in info_files:
+ if info_modules.has_key(package_name):
+ continue
+ fullname = self.parent_name +'.'+ package_name
+ if info_file[-1]=='c':
+ filedescriptor = ('.pyc','rb',2)
+ else:
+ filedescriptor = ('.py','U',1)
+
+ try:
+ info_module = imp.load_module(fullname+'.info',
+ open(info_file,filedescriptor[1]),
+ info_file,
+ filedescriptor)
+ except Exception,msg:
+ self.error(msg)
+ info_module = None
+
+ if info_module is None or getattr(info_module,'ignore',False):
+ info_modules.pop(package_name,None)
+ else:
+ self._init_info_modules(getattr(info_module,'depends',[]))
+ info_modules[package_name] = info_module
+
+ return
+
+ def _get_sorted_names(self):
+ """ Return package names sorted in the order as they should be
+ imported due to dependence relations between packages.
+ """
+
+ depend_dict = {}
+ for name,info_module in self.info_modules.items():
+ depend_dict[name] = getattr(info_module,'depends',[])
+ package_names = []
+
+ for name in depend_dict.keys():
+ if not depend_dict[name]:
+ package_names.append(name)
+ del depend_dict[name]
+
+ while depend_dict:
+ for name, lst in depend_dict.items():
+ new_lst = [n for n in lst if depend_dict.has_key(n)]
+ if not new_lst:
+ package_names.append(name)
+ del depend_dict[name]
+ else:
+ depend_dict[name] = new_lst
+
+ return package_names
+
+ def __call__(self,*packages, **options):
+ """Load one or more packages into parent package top-level namespace.
+
+ Usage:
+
+ This function is intended to shorten the need to import many
+ subpackages, say of scipy, constantly with statements such as
+
+ import scipy.linalg, scipy.fftpack, scipy.etc...
+
+ Instead, you can say:
+
+ import scipy
+ scipy.pkgload('linalg','fftpack',...)
+
+ or
+
+ scipy.pkgload()
+
+ to load all of them in one call.
+
+ If a name which doesn't exist in scipy's namespace is
+ given, a warning is shown.
+
+ Inputs:
+
+ - the names (one or more strings) of all the numpy modules one
+ wishes to load into the top-level namespace.
+
+ Optional keyword inputs:
+
+ - verbose - integer specifying verbosity level [default: -1].
+ verbose=-1 will suspend also warnings.
+ - force - when True, force reloading loaded packages
+ [default: False].
+ - postpone - when True, don't load packages [default: False]
+
+ If no input arguments are given, then all of scipy's subpackages
+ are imported.
+
+ """
+ frame = self.parent_frame
+ self.info_modules = {}
+ if options.get('force',False):
+ self.imported_packages = []
+ self.verbose = verbose = options.get('verbose',-1)
+ postpone = options.get('postpone',None)
+ self._init_info_modules(packages or None)
+
+ self.log('Imports to %r namespace\n----------------------------'\
+ % self.parent_name)
+
+ for package_name in self._get_sorted_names():
+ if package_name in self.imported_packages:
+ continue
+ info_module = self.info_modules[package_name]
+ global_symbols = getattr(info_module,'global_symbols',[])
+ postpone_import = getattr(info_module,'postpone_import',False)
+ if (postpone and not global_symbols) \
+ or (postpone_import and postpone is not None):
+ self.log('__all__.append(%r)' % (package_name))
+ if '.' not in package_name:
+ self.parent_export_names.append(package_name)
+ continue
+
+ old_object = frame.f_locals.get(package_name,None)
+
+ cmdstr = 'import '+package_name
+ if self._execcmd(cmdstr):
+ continue
+ self.imported_packages.append(package_name)
+
+ if verbose!=-1:
+ new_object = frame.f_locals.get(package_name)
+ if old_object is not None and old_object is not new_object:
+ self.warn('Overwriting %s=%s (was %s)' \
+ % (package_name,self._obj2repr(new_object),
+ self._obj2repr(old_object)))
+
+ if '.' not in package_name:
+ self.parent_export_names.append(package_name)
+
+ for symbol in global_symbols:
+ if symbol=='*':
+ symbols = eval('getattr(%s,"__all__",None)'\
+ % (package_name),
+ frame.f_globals,frame.f_locals)
+ if symbols is None:
+ symbols = eval('dir(%s)' % (package_name),
+ frame.f_globals,frame.f_locals)
+ symbols = filter(lambda s:not s.startswith('_'),symbols)
+ else:
+ symbols = [symbol]
+
+ if verbose!=-1:
+ old_objects = {}
+ for s in symbols:
+ if frame.f_locals.has_key(s):
+ old_objects[s] = frame.f_locals[s]
+
+ cmdstr = 'from '+package_name+' import '+symbol
+ if self._execcmd(cmdstr):
+ continue
+
+ if verbose!=-1:
+ for s,old_object in old_objects.items():
+ new_object = frame.f_locals[s]
+ if new_object is not old_object:
+ self.warn('Overwriting %s=%s (was %s)' \
+ % (s,self._obj2repr(new_object),
+ self._obj2repr(old_object)))
+
+ if symbol=='*':
+ self.parent_export_names.extend(symbols)
+ else:
+ self.parent_export_names.append(symbol)
+
+ return
+
+ def _execcmd(self,cmdstr):
+ """ Execute command in parent_frame."""
+ frame = self.parent_frame
+ try:
+ exec (cmdstr, frame.f_globals,frame.f_locals)
+ except Exception,msg:
+ self.error('%s -> failed: %s' % (cmdstr,msg))
+ return True
+ else:
+ self.log('%s -> success' % (cmdstr))
+ return
+
+ def _obj2repr(self,obj):
+ """ Return repr(obj) with"""
+ module = getattr(obj,'__module__',None)
+ file = getattr(obj,'__file__',None)
+ if module is not None:
+ return repr(obj) + ' from ' + module
+ if file is not None:
+ return repr(obj) + ' from ' + file
+ return repr(obj)
+
+ def log(self,mess):
+ if self.verbose>1:
+ print >> sys.stderr, str(mess)
+ def warn(self,mess):
+ if self.verbose>=0:
+ print >> sys.stderr, str(mess)
+ def error(self,mess):
+ if self.verbose!=-1:
+ print >> sys.stderr, str(mess)
+
+ def _get_doc_title(self, info_module):
+ """ Get the title from a package info.py file.
+ """
+ title = getattr(info_module,'__doc_title__',None)
+ if title is not None:
+ return title
+ title = getattr(info_module,'__doc__',None)
+ if title is not None:
+ title = title.lstrip().split('\n',1)[0]
+ return title
+ return '* Not Available *'
+
+ def _format_titles(self,titles,colsep='---'):
+ display_window_width = 70 # How to determine the correct value in runtime??
+ lengths = [len(name)-name.find('.')-1 for (name,title) in titles]+[0]
+ max_length = max(lengths)
+ lines = []
+ for (name,title) in titles:
+ name = name[name.find('.')+1:]
+ w = max_length - len(name)
+ words = title.split()
+ line = '%s%s %s' % (name,w*' ',colsep)
+ tab = len(line) * ' '
+ while words:
+ word = words.pop(0)
+ if len(line)+len(word)>display_window_width:
+ lines.append(line)
+ line = tab
+ line += ' ' + word
+ else:
+ lines.append(line)
+ return '\n'.join(lines)
+
+ def get_pkgdocs(self):
+ """ Return documentation summary of subpackages.
+ """
+ import sys
+ self.info_modules = {}
+ self._init_info_modules(None)
+
+ titles = []
+ symbols = []
+ for package_name, info_module in self.info_modules.items():
+ global_symbols = getattr(info_module,'global_symbols',[])
+ fullname = self.parent_name +'.'+ package_name
+ note = ''
+ if not sys.modules.has_key(fullname):
+ note = ' [*]'
+ titles.append((fullname,self._get_doc_title(info_module) + note))
+ if global_symbols:
+ symbols.append((package_name,', '.join(global_symbols)))
+
+ retstr = self._format_titles(titles) +\
+ '\n [*] - using a package requires explicit import (see pkgload)'
+
+
+ if symbols:
+ retstr += """\n\nGlobal symbols from subpackages"""\
+ """\n-------------------------------\n""" +\
+ self._format_titles(symbols,'-->')
+
+ return retstr
+
+class PackageLoaderDebug(PackageLoader):
+ def _execcmd(self,cmdstr):
+ """ Execute command in parent_frame."""
+ frame = self.parent_frame
+ print 'Executing',`cmdstr`,'...',
+ sys.stdout.flush()
+ exec (cmdstr, frame.f_globals,frame.f_locals)
+ print 'ok'
+ sys.stdout.flush()
+ return
+
+if int(os.environ.get('NUMPY_IMPORT_DEBUG','0')):
+ PackageLoader = PackageLoaderDebug
diff --git a/numpy/add_newdocs.py b/numpy/add_newdocs.py
new file mode 100644
index 000000000..7b04ee2f4
--- /dev/null
+++ b/numpy/add_newdocs.py
@@ -0,0 +1,1422 @@
+from lib import add_newdoc
+
+add_newdoc('numpy.core','dtype',
+ [('fields', "Fields of the data-type or None if no fields"),
+ ('names', "Names of fields or None if no fields"),
+ ('alignment', "Needed alignment for this data-type"),
+ ('byteorder',
+ "Little-endian (<), big-endian (>), native (=), or "\
+ "not-applicable (|)"),
+ ('char', "Letter typecode for this data-type"),
+ ('type', "Type object associated with this data-type"),
+ ('kind', "Character giving type-family of this data-type"),
+ ('itemsize', "Size of each item"),
+ ('hasobject', "Non-zero if Python objects are in "\
+ "this data-type"),
+ ('num', "Internally-used number for builtin base"),
+ ('newbyteorder',
+"""self.newbyteorder(<endian>)
+returns a copy of the dtype object with altered byteorders.
+If <endian> is not given all byteorders are swapped.
+Otherwise endian can be '>', '<', or '=' to force a particular
+byteorder. Data-types in all fields are also updated in the
+new dtype object.
+"""),
+ ("__reduce__", "self.__reduce__() for pickling"),
+ ("__setstate__", "self.__setstate__() for pickling"),
+ ("subdtype", "A tuple of (descr, shape) or None"),
+ ("descr", "The array_interface data-type descriptor."),
+ ("str", "The array interface typestring."),
+ ("name", "The name of the true data-type"),
+ ("base", "The base data-type or self if no subdtype"),
+ ("shape", "The shape of the subdtype or (1,)"),
+ ("isbuiltin", "Is this a built-in data-type?"),
+ ("isnative", "Is the byte-order of this data-type native?")
+ ]
+ )
+
+###############################################################################
+#
+# flatiter
+#
+# flatiter needs a toplevel description
+#
+###############################################################################
+
+# attributes
+add_newdoc('numpy.core', 'flatiter', ('base',
+ """documentation needed
+
+ """))
+
+
+
+add_newdoc('numpy.core', 'flatiter', ('coords',
+ """An N-d tuple of current coordinates.
+
+ """))
+
+
+
+add_newdoc('numpy.core', 'flatiter', ('index',
+ """documentation needed
+
+ """))
+
+
+
+# functions
+add_newdoc('numpy.core', 'flatiter', ('__array__',
+ """__array__(type=None) Get array from iterator
+
+ """))
+
+
+add_newdoc('numpy.core', 'flatiter', ('copy',
+ """copy() Get a copy of the iterator as a 1-d array
+
+ """))
+
+
+###############################################################################
+#
+# broadcast
+#
+###############################################################################
+
+# attributes
+add_newdoc('numpy.core', 'broadcast', ('index',
+ """current index in broadcasted result
+
+ """))
+
+
+add_newdoc('numpy.core', 'broadcast', ('iters',
+ """tuple of individual iterators
+
+ """))
+
+
+add_newdoc('numpy.core', 'broadcast', ('nd',
+ """number of dimensions of broadcasted result
+
+ """))
+
+
+add_newdoc('numpy.core', 'broadcast', ('numiter',
+ """number of iterators
+
+ """))
+
+
+add_newdoc('numpy.core', 'broadcast', ('shape',
+ """shape of broadcasted result
+
+ """))
+
+
+add_newdoc('numpy.core', 'broadcast', ('size',
+ """total size of broadcasted result
+
+ """))
+
+
+###############################################################################
+#
+# numpy functions
+#
+###############################################################################
+
+add_newdoc('numpy.core.multiarray','array',
+ """array(object, dtype=None, copy=1,order=None, subok=0,ndmin=0)
+
+ Return an array from object with the specified date-type.
+
+ Inputs:
+ object - an array, any object exposing the array interface, any
+ object whose __array__ method returns an array, or any
+ (nested) sequence.
+ dtype - The desired data-type for the array. If not given, then
+ the type will be determined as the minimum type required
+ to hold the objects in the sequence. This argument can only
+ be used to 'upcast' the array. For downcasting, use the
+ .astype(t) method.
+ copy - If true, then force a copy. Otherwise a copy will only occur
+ if __array__ returns a copy, obj is a nested sequence, or
+ a copy is needed to satisfy any of the other requirements
+ order - Specify the order of the array. If order is 'C', then the
+ array will be in C-contiguous order (last-index varies the
+ fastest). If order is 'FORTRAN', then the returned array
+ will be in Fortran-contiguous order (first-index varies the
+ fastest). If order is None, then the returned array may
+ be in either C-, or Fortran-contiguous order or even
+ discontiguous.
+ subok - If True, then sub-classes will be passed-through, otherwise
+ the returned array will be forced to be a base-class array
+ ndmin - Specifies the minimum number of dimensions that the resulting
+ array should have. 1's will be pre-pended to the shape as
+ needed to meet this requirement.
+
+ """)
+
+add_newdoc('numpy.core.multiarray','empty',
+ """empty((d1,...,dn),dtype=float,order='C')
+
+ Return a new array of shape (d1,...,dn) and given type with all its
+ entries uninitialized. This can be faster than zeros.
+
+ """)
+
+
+add_newdoc('numpy.core.multiarray','scalar',
+ """scalar(dtype,obj)
+
+ Return a new scalar array of the given type initialized with
+ obj. Mainly for pickle support. The dtype must be a valid data-type
+ descriptor. If dtype corresponds to an OBJECT descriptor, then obj
+ can be any object, otherwise obj must be a string. If obj is not given
+ it will be interpreted as None for object type and zeros for all other
+ types.
+
+ """)
+
+add_newdoc('numpy.core.multiarray','zeros',
+ """zeros((d1,...,dn),dtype=float,order='C')
+
+ Return a new array of shape (d1,...,dn) and type typecode with all
+ it's entries initialized to zero.
+
+ """)
+
+add_newdoc('numpy.core.multiarray','set_typeDict',
+ """set_typeDict(dict)
+
+ Set the internal dictionary that can look up an array type using a
+ registered code.
+
+ """)
+
+add_newdoc('numpy.core.multiarray','fromstring',
+ """fromstring(string, dtype=float, count=-1, sep='')
+
+ Return a new 1d array initialized from the raw binary data in string.
+
+ If count is positive, the new array will have count elements, otherwise its
+ size is determined by the size of string. If sep is not empty then the
+ string is interpreted in ASCII mode and converted to the desired number type
+ using sep as the separator between elements (extra whitespace is ignored).
+
+ """)
+
+add_newdoc('numpy.core.multiarray','fromiter',
+ """fromiter(iterable, dtype, count=-1)
+
+ Return a new 1d array initialized from iterable. If count is
+ nonegative, the new array will have count elements, otherwise it's
+ size is determined by the generator.
+
+ """)
+
+add_newdoc('numpy.core.multiarray','fromfile',
+ """fromfile(file=, dtype=float, count=-1, sep='') -> array.
+
+ Required arguments:
+ file -- open file object or string containing file name.
+
+ Keyword arguments:
+ dtype -- type and order of the returned array (default float)
+ count -- number of items to input (default all)
+ sep -- separater between items if file is a text file (default "")
+
+ Return an array of the given data type from a text or binary file. The
+ 'file' argument can be an open file or a string with the name of a file to
+ read from. If 'count' == -1 the entire file is read, otherwise count is the
+ number of items of the given type to read in. If 'sep' is "" it means to
+ read binary data from the file using the specified dtype, otherwise it gives
+ the separator between elements in a text file. The 'dtype' value is also
+ used to determine the size and order of the items in binary files.
+
+
+ Data written using the tofile() method can be conveniently recovered using
+ this function.
+
+ WARNING: This function should be used sparingly as the binary files are not
+ platform independent. In particular, they contain no endianess or datatype
+ information. Nevertheless it can be useful for reading in simply formatted
+ or binary data quickly.
+
+ """)
+
+add_newdoc('numpy.core.multiarray','frombuffer',
+ """frombuffer(buffer=, dtype=float, count=-1, offset=0)
+
+ Returns a 1-d array of data type dtype from buffer. The buffer
+ argument must be an object that exposes the buffer interface. If
+ count is -1 then the entire buffer is used, otherwise, count is the
+ size of the output. If offset is given then jump that far into the
+ buffer. If the buffer has data that is out not in machine byte-order,
+ than use a propert data type descriptor. The data will not be
+ byteswapped, but the array will manage it in future operations.
+
+ """)
+
+add_newdoc('numpy.core.multiarray','concatenate',
+ """concatenate((a1, a2, ...), axis=0)
+
+ Join arrays together.
+
+ The tuple of sequences (a1, a2, ...) are joined along the given axis
+ (default is the first one) into a single numpy array.
+
+ Example:
+
+ >>> concatenate( ([0,1,2], [5,6,7]) )
+ array([0, 1, 2, 5, 6, 7])
+
+ """)
+
+add_newdoc('numpy.core.multiarray','inner',
+ """inner(a,b)
+
+ Returns the dot product of two arrays, which has shape a.shape[:-1] +
+ b.shape[:-1] with elements computed by the product of the elements
+ from the last dimensions of a and b.
+
+ """)
+
+add_newdoc('numpy.core','fastCopyAndTranspose',
+ """_fastCopyAndTranspose(a)""")
+
+add_newdoc('numpy.core.multiarray','correlate',
+ """cross_correlate(a,v, mode=0)""")
+
+add_newdoc('numpy.core.multiarray','arange',
+ """arange([start,] stop[, step,], dtype=None)
+
+ For integer arguments, just like range() except it returns an array
+ whose type can be specified by the keyword argument dtype. If dtype
+ is not specified, the type of the result is deduced from the type of
+ the arguments.
+
+ For floating point arguments, the length of the result is ceil((stop -
+ start)/step). This rule may result in the last element of the result
+ being greater than stop.
+
+ """)
+
+add_newdoc('numpy.core.multiarray','_get_ndarray_c_version',
+ """_get_ndarray_c_version()
+
+ Return the compile time NDARRAY_VERSION number.
+
+ """)
+
+add_newdoc('numpy.core.multiarray','_reconstruct',
+ """_reconstruct(subtype, shape, dtype)
+
+ Construct an empty array. Used by Pickles.
+
+ """)
+
+
+add_newdoc('numpy.core.multiarray','set_string_function',
+ """set_string_function(f, repr=1)
+
+ Set the python function f to be the function used to obtain a pretty
+ printable string version of an array whenever an array is printed.
+ f(M) should expect an array argument M, and should return a string
+ consisting of the desired representation of M for printing.
+
+ """)
+
+add_newdoc('numpy.core.multiarray','set_numeric_ops',
+ """set_numeric_ops(op=func, ...)
+
+ Set some or all of the number methods for all array objects. Do not
+ forget **dict can be used as the argument list. Return the functions
+ that were replaced, which can be stored and set later.
+
+ """)
+
+add_newdoc('numpy.core.multiarray','where',
+ """where(condition, | x, y)
+
+ The result is shaped like condition and has elements of x and y where
+ condition is respectively true or false. If x or y are not given,
+ then it is equivalent to condition.nonzero().
+
+ To group the indices by element, rather than dimension, use
+
+ transpose(where(condition, | x, y))
+
+ instead. This always results in a 2d array, with a row of indices for
+ each element that satisfies the condition.
+
+ """)
+
+
+add_newdoc('numpy.core.multiarray','lexsort',
+ """lexsort(keys=, axis=-1) -> array of indices. Argsort with list of keys.
+
+ Perform an indirect sort using a list of keys. The first key is sorted,
+ then the second, and so on through the list of keys. At each step the
+ previous order is preserved when equal keys are encountered. The result is
+ a sort on multiple keys. If the keys represented columns of a spreadsheet,
+ for example, this would sort using multiple columns (the last key being
+ used for the primary sort order, the second-to-last key for the secondary
+ sort order, and so on). The keys argument must be a sequence of things
+ that can be converted to arrays of the same shape.
+
+ :Parameters:
+
+ a : array type
+ Array containing values that the returned indices should sort.
+
+ axis : integer
+ Axis to be indirectly sorted. None indicates that the flattened
+ array should be used. Default is -1.
+
+ :Returns:
+
+ indices : integer array
+ Array of indices that sort the keys along the specified axis. The
+ array has the same shape as the keys.
+
+ :SeeAlso:
+
+ - argsort : indirect sort
+ - sort : inplace sort
+
+ """)
+
+add_newdoc('numpy.core.multiarray','can_cast',
+ """can_cast(from=d1, to=d2)
+
+ Returns True if data type d1 can be cast to data type d2 without
+ losing precision.
+
+ """)
+
+add_newdoc('numpy.core.multiarray','newbuffer',
+ """newbuffer(size)
+
+ Return a new uninitialized buffer object of size bytes
+
+ """)
+
+add_newdoc('numpy.core.multiarray','getbuffer',
+ """getbuffer(obj [,offset[, size]])
+
+ Create a buffer object from the given object referencing a slice of
+ length size starting at offset. Default is the entire buffer. A
+ read-write buffer is attempted followed by a read-only buffer.
+
+ """)
+
+##############################################################################
+#
+# Documentation for ndarray attributes and methods
+#
+##############################################################################
+
+
+##############################################################################
+#
+# ndarray object
+#
+##############################################################################
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray',
+ """An array object represents a multidimensional, homogeneous array
+ of fixed-size items. An associated data-type-descriptor object
+ details the data-type in an array (including byteorder and any
+ fields). An array can be constructed using the numpy.array
+ command. Arrays are sequence, mapping and numeric objects.
+ More information is available in the numpy module and by looking
+ at the methods and attributes of an array.
+
+ ndarray.__new__(subtype, shape=, dtype=float, buffer=None,
+ offset=0, strides=None, order=None)
+
+ There are two modes of creating an array using __new__:
+ 1) If buffer is None, then only shape, dtype, and order
+ are used
+ 2) If buffer is an object exporting the buffer interface, then
+ all keywords are interpreted.
+ The dtype parameter can be any object that can be interpreted
+ as a numpy.dtype object.
+
+ No __init__ method is needed because the array is fully
+ initialized after the __new__ method.
+
+ """)
+
+
+##############################################################################
+#
+# ndarray attributes
+#
+##############################################################################
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('__array_interface__',
+ """Array protocol: Python side."""))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('__array_finalize__',
+ """None."""))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('__array_priority__',
+ """Array priority."""))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('__array_struct__',
+ """Array protocol: C-struct side."""))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('_as_parameter_',
+ """Allow the array to be interpreted as a ctypes object by returning the
+ data-memory location as an integer
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('base',
+ """Base object if memory is from some other object.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('ctypes',
+ """A ctypes interface object.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('data',
+ """Buffer object pointing to the start of the data.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('dtype',
+ """Data-type for the array.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('imag',
+ """Imaginary part of the array.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('itemsize',
+ """Length of one element in bytes.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('flags',
+ """Special object providing array flags.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('flat',
+ """A 1-d flat iterator.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('nbytes',
+ """Number of bytes in the array.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('ndim',
+ """Number of array dimensions.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('real',
+ """Real part of the array.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('shape',
+ """Tuple of array dimensions.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('size',
+ """Number of elements in the array.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('strides',
+ """Tuple of bytes to step in each dimension.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('T',
+ """Same as self.transpose() except self is returned for self.ndim < 2.
+
+ """))
+
+
+##############################################################################
+#
+# ndarray methods
+#
+##############################################################################
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('__array__',
+ """ a.__array__(|dtype) -> reference if type unchanged, copy otherwise.
+
+ Returns either a new reference to self if dtype is not given or a new array
+ of provided data type if dtype is different from the current dtype of the
+ array.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('__array_wrap__',
+ """a.__array_wrap__(obj) -> Object of same type as a from ndarray obj.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('__copy__',
+ """a.__copy__(|order) -> copy, possibly with different order.
+
+ Return a copy of the array.
+
+ Argument:
+ order -- Order of returned copy (default 'C')
+ If order is 'C' (False) then the result is contiguous (default).
+ If order is 'Fortran' (True) then the result has fortran order.
+ If order is 'Any' (None) then the result has fortran order
+ only if m is already in fortran order.;
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('__deepcopy__',
+ """a.__deepcopy__() -> Deep copy of array.
+
+ Used if copy.deepcopy is called on an array.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('__reduce__',
+ """a.__reduce__()
+
+ For pickling.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('__setstate__',
+ """a.__setstate__(version, shape, typecode, isfortran, rawdata)
+
+ For unpickling.
+
+ Arguments:
+ version -- optional pickle version. If omitted defaults to 0.
+ shape -- a tuple giving the shape
+ typecode -- a typecode
+ isFortran -- a bool stating if Fortran or no
+ rawdata -- a binary string with the data (or a list if Object array)
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('all',
+ """ a.all(axis=None)
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('any',
+ """ a.any(axis=None, out=None)
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('argmax',
+ """ a.argmax(axis=None, out=None)
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('argmin',
+ """ a.argmin(axis=None, out=None)
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('argsort',
+ """a.argsort(axis=-1, kind='quicksort', order=None) -> indices
+
+ Perform an indirect sort along the given axis using the algorithm specified
+ by the kind keyword. It returns an array of indices of the same shape as
+ 'a' that index data along the given axis in sorted order.
+
+ :Parameters:
+
+ axis : integer
+ Axis to be indirectly sorted. None indicates that the flattened
+ array should be used. Default is -1.
+
+ kind : string
+ Sorting algorithm to use. Possible values are 'quicksort',
+ 'mergesort', or 'heapsort'. Default is 'quicksort'.
+
+ order : list type or None
+ When a is an array with fields defined, this argument specifies
+ which fields to compare first, second, etc. Not all fields need be
+ specified.
+
+ :Returns:
+
+ indices : integer array
+ Array of indices that sort 'a' along the specified axis.
+
+ :SeeAlso:
+
+ - lexsort : indirect stable sort with multiple keys
+ - sort : inplace sort
+
+ :Notes:
+ ------
+
+ The various sorts are characterized by average speed, worst case
+ performance, need for work space, and whether they are stable. A stable
+ sort keeps items with the same key in the same relative order. The three
+ available algorithms have the following properties:
+
+ |------------------------------------------------------|
+ | kind | speed | worst case | work space | stable|
+ |------------------------------------------------------|
+ |'quicksort'| 1 | O(n^2) | 0 | no |
+ |'mergesort'| 2 | O(n*log(n)) | ~n/2 | yes |
+ |'heapsort' | 3 | O(n*log(n)) | 0 | no |
+ |------------------------------------------------------|
+
+ All the sort algorithms make temporary copies of the data when the sort is not
+ along the last axis. Consequently, sorts along the last axis are faster and use
+ less space than sorts along other axis.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('astype',
+ """a.astype(t) -> Copy of array cast to type t.
+
+ Cast array m to type t. t can be either a string representing a typecode,
+ or a python type object of type int, float, or complex.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('byteswap',
+ """a.byteswap(False) -> View or copy. Swap the bytes in the array.
+
+ Swap the bytes in the array. Return the byteswapped array. If the first
+ argument is True, byteswap in-place and return a reference to self.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('choose',
+ """ a.choose(b0, b1, ..., bn, out=None, mode='raise')
+
+ Return an array that merges the b_i arrays together using 'a' as
+ the index The b_i arrays and 'a' must all be broadcastable to the
+ same shape. The output at a particular position is the input
+ array b_i at that position depending on the value of 'a' at that
+ position. Therefore, 'a' must be an integer array with entries
+ from 0 to n+1.;
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('clip',
+ """a.clip(min=, max=, out=None)
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('compress',
+ """a.compress(condition=, axis=None, out=None)
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('conj',
+ """a.conj()
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('conjugate',
+ """a.conjugate()
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('copy',
+ """a.copy(|order) -> copy, possibly with different order.
+
+ Return a copy of the array.
+
+ Argument:
+ order -- Order of returned copy (default 'C')
+ If order is 'C' (False) then the result is contiguous (default).
+ If order is 'Fortran' (True) then the result has fortran order.
+ If order is 'Any' (None) then the result has fortran order
+ only if m is already in fortran order.;
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('cumprod',
+ """a.cumprod(axis=None, dtype=None)
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('cumsum',
+ """a.cumsum(axis=None, dtype=None, out=None)
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('diagonal',
+ """a.diagonal(offset=0, axis1=0, axis2=1) -> diagonals
+
+ If a is 2-d, return the diagonal of self with the given offset, i.e., the
+ collection of elements of the form a[i,i+offset]. If a is n-d with n > 2,
+ then the axes specified by axis1 and axis2 are used to determine the 2-d
+ subarray whose diagonal is returned. The shape of the resulting array can
+ be determined by removing axis1 and axis2 and appending an index to the
+ right equal to the size of the resulting diagonals.
+
+ :Parameters:
+ offset : integer
+ Offset of the diagonal from the main diagonal. Can be both positive
+ and negative. Defaults to main diagonal.
+ axis1 : integer
+ Axis to be used as the first axis of the 2-d subarrays from which
+ the diagonals should be taken. Defaults to first index.
+ axis2 : integer
+ Axis to be used as the second axis of the 2-d subarrays from which
+ the diagonals should be taken. Defaults to second index.
+
+ :Returns:
+ array_of_diagonals : same type as original array
+ If a is 2-d, then a 1-d array containing the diagonal is returned.
+ If a is n-d, n > 2, then an array of diagonals is returned.
+
+ :SeeAlso:
+ - diag : matlab workalike for 1-d and 2-d arrays.
+ - diagflat : creates diagonal arrays
+ - trace : sum along diagonals
+
+ Examples
+ --------
+
+ >>> a = arange(4).reshape(2,2)
+ >>> a
+ array([[0, 1],
+ [2, 3]])
+ >>> a.diagonal()
+ array([0, 3])
+ >>> a.diagonal(1)
+ array([1])
+
+ >>> a = arange(8).reshape(2,2,2)
+ >>> a
+ array([[[0, 1],
+ [2, 3]],
+
+ [[4, 5],
+ [6, 7]]])
+ >>> a.diagonal(0,-2,-1)
+ array([[0, 3],
+ [4, 7]])
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('dump',
+ """a.dump(file) Dump a pickle of the array to the specified file.
+
+ The array can be read back with pickle.load or numpy.load
+
+ Arguments:
+ file -- string naming the dump file.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('dumps',
+ """a.dumps() returns the pickle of the array as a string.
+
+ pickle.loads or numpy.loads will convert the string back to an array.
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('fill',
+ """a.fill(value) -> None. Fill the array with the scalar value.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('flatten',
+ """a.flatten([fortran]) return a 1-d array (always copy)
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('getfield',
+ """a.getfield(dtype, offset) -> field of array as given type.
+
+ Returns a field of the given array as a certain type. A field is a view of
+ the array data with each itemsize determined by the given type and the
+ offset into the current array.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('item',
+ """a.item() -> copy of first array item as Python scalar.
+
+ Copy the first element of array to a standard Python scalar and return
+ it. The array must be of size one.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('max',
+ """a.max(axis=None)
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('mean',
+ """a.mean(axis=None, dtype=None, out=None) -> mean
+
+ Returns the average of the array elements. The average is taken over the
+ flattened array by default, otherwise over the specified axis.
+
+ :Parameters:
+
+ axis : integer
+ Axis along which the means are computed. The default is
+ to compute the standard deviation of the flattened array.
+
+ dtype : type
+ Type to use in computing the means. For arrays of
+ integer type the default is float32, for arrays of float types it
+ is the same as the array type.
+
+ out : ndarray
+ Alternative output array in which to place the result. It must have
+ the same shape as the expected output but the type will be cast if
+ necessary.
+
+ :Returns:
+
+ mean : The return type varies, see above.
+ A new array holding the result is returned unless out is specified,
+ in which case a reference to out is returned.
+
+ :SeeAlso:
+
+ - var : variance
+ - std : standard deviation
+
+ Notes
+ -----
+
+ The mean is the sum of the elements along the axis divided by the
+ number of elements.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('min',
+ """a.min(axis=None)
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('newbyteorder',
+ """a.newbyteorder(<byteorder>) is equivalent to
+ a.view(a.dtype.newbytorder(<byteorder>))
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('nonzero',
+ """a.nonzero() returns a tuple of arrays
+
+ Returns a tuple of arrays, one for each dimension of a,
+ containing the indices of the non-zero elements in that
+ dimension. The corresponding non-zero values can be obtained
+ with
+ a[a.nonzero()].
+
+ To group the indices by element, rather than dimension, use
+ transpose(a.nonzero())
+ instead. The result of this is always a 2d array, with a row for
+ each non-zero element.;
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('prod',
+ """a.prod(axis=None, dtype=None)
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('ptp',
+ """a.ptp(axis=None) a.max(axis)-a.min(axis)
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('put',
+ """a.put(indices, values, mode) sets a.flat[n] = values[n] for
+ each n in indices. If values is shorter than indices then it
+ will repeat.
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'putmask',
+ """putmask(a, mask, values) sets a.flat[n] = values[n] for each n where
+ mask.flat[n] is true. If values is not the same size of a and mask then
+ it will repeat. This gives different behavior than a[mask] = values.
+ """)
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('ravel',
+ """a.ravel([fortran]) return a 1-d array (copy only if needed)
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('repeat',
+ """a.repeat(repeats=, axis=none)
+
+ copy elements of a, repeats times. the repeats argument must be a sequence
+ of length a.shape[axis] or a scalar.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('reshape',
+ """a.reshape(d1, d2, ..., dn, order='c')
+
+ Return a new array from this one. The new array must have the same number
+ of elements as self. Also always returns a view or raises a ValueError if
+ that is impossible.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('resize',
+ """a.resize(new_shape, refcheck=True, order=False) -> None. Change array shape.
+
+ Change size and shape of self inplace. Array must own its own memory and
+ not be referenced by other arrays. Returns None.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('round',
+ """a.round(decimals=0, out=None) -> out (a). Rounds to 'decimals' places.
+
+ Keyword arguments:
+ decimals -- number of decimals to round to (default 0). May be negative.
+ out -- existing array to use for output (default a).
+
+ Return:
+ Reference to out, where None specifies the original array a.
+
+ Round to the specified number of decimals. When 'decimals' is negative it
+ specifies the number of positions to the left of the decimal point. The
+ real and imaginary parts of complex numbers are rounded separately. Nothing
+ is done if the array is not of float type and 'decimals' is >= 0.
+
+ The keyword 'out' may be used to specify a different array to hold the
+ result rather than the default 'a'. If the type of the array specified by
+ 'out' differs from that of 'a', the result is cast to the new type,
+ otherwise the original type is kept. Floats round to floats by default.
+
+ Numpy rounds to even. Thus 1.5 and 2.5 round to 2.0, -0.5 and 0.5 round to
+ 0.0, etc. Results may also be surprising due to the inexact representation
+ of decimal fractions in IEEE floating point and the errors introduced in
+ scaling the numbers when 'decimals' is something other than 0.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('searchsorted',
+ """a.searchsorted(v, side='left') -> index array.
+
+ Find the indices into a sorted array such that if the corresponding keys in
+ v were inserted before the indices the order of a would be preserved. If
+ side='left', then the first such index is returned. If side='right', then
+ the last such index is returned. If there is no such index because the key
+ is out of bounds, then the length of a is returned, i.e., the key would
+ need to be appended. The returned index array has the same shape as v.
+
+ :Parameters:
+
+ v : array or list type
+ Array of keys to be searched for in a.
+
+ side : string
+ Possible values are : 'left', 'right'. Default is 'left'. Return
+ the first or last index where the key could be inserted.
+
+ :Returns:
+
+ indices : integer array
+ The returned array has the same shape as v.
+
+ :SeeAlso:
+
+ - sort
+ - histogram
+
+ :Notes:
+ -------
+
+ The array a must be 1-d and is assumed to be sorted in ascending order.
+ Searchsorted uses binary search to find the required insertion points.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('setfield',
+ """m.setfield(value, dtype, offset) -> None.
+ places val into field of the given array defined by the data type and offset.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('setflags',
+ """a.setflags(write=None, align=None, uic=None)
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('sort',
+ """a.sort(axis=-1, kind='quicksort', order=None) -> None.
+
+ Perform an inplace sort along the given axis using the algorithm specified
+ by the kind keyword.
+
+ :Parameters:
+
+ axis : integer
+ Axis to be sorted along. None indicates that the flattened array
+ should be used. Default is -1.
+
+ kind : string
+ Sorting algorithm to use. Possible values are 'quicksort',
+ 'mergesort', or 'heapsort'. Default is 'quicksort'.
+
+ order : list type or None
+ When a is an array with fields defined, this argument specifies
+ which fields to compare first, second, etc. Not all fields need be
+ specified.
+
+ :Returns:
+
+ None
+
+ :SeeAlso:
+
+ - argsort : indirect sort
+ - lexsort : indirect stable sort on multiple keys
+ - searchsorted : find keys in sorted array
+
+ :Notes:
+ ------
+
+ The various sorts are characterized by average speed, worst case
+ performance, need for work space, and whether they are stable. A stable
+ sort keeps items with the same key in the same relative order. The three
+ available algorithms have the following properties:
+
+ |------------------------------------------------------|
+ | kind | speed | worst case | work space | stable|
+ |------------------------------------------------------|
+ |'quicksort'| 1 | O(n^2) | 0 | no |
+ |'mergesort'| 2 | O(n*log(n)) | ~n/2 | yes |
+ |'heapsort' | 3 | O(n*log(n)) | 0 | no |
+ |------------------------------------------------------|
+
+ All the sort algorithms make temporary copies of the data when the sort is not
+ along the last axis. Consequently, sorts along the last axis are faster and use
+ less space than sorts along other axis.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('squeeze',
+ """m.squeeze() eliminate all length-1 dimensions
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('std',
+ """a.std(axis=None, dtype=None, out=None) -> standard deviation.
+
+ Returns the standard deviation of the array elements, a measure of the
+ spread of a distribution. The standard deviation is computed for the
+ flattened array by default, otherwise over the specified axis.
+
+ :Parameters:
+
+ axis : integer
+ Axis along which the standard deviation is computed. The default is
+ to compute the standard deviation of the flattened array.
+
+ dtype : type
+ Type to use in computing the standard deviation. For arrays of
+ integer type the default is float32, for arrays of float types it
+ is the same as the array type.
+
+ out : ndarray
+ Alternative output array in which to place the result. It must have
+ the same shape as the expected output but the type will be cast if
+ necessary.
+
+ :Returns:
+
+ standard deviation : The return type varies, see above.
+ A new array holding the result is returned unless out is specified,
+ in which case a reference to out is returned.
+
+ :SeeAlso:
+
+ - var : variance
+ - mean : average
+
+ Notes
+ -----
+
+ The standard deviation is the square root of the average of the squared
+ deviations from the mean, i.e. var = sqrt(mean((x - x.mean())**2)). The
+ computed standard deviation is biased, i.e., the mean is computed by
+ dividing by the number of elements, N, rather than by N-1.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('sum',
+ """a.sum(axis=None, dtype=None) -> Sum of array over given axis.
+
+ Sum the array over the given axis. If the axis is None, sum over
+ all dimensions of the array.
+
+ The optional dtype argument is the data type for the returned
+ value and intermediate calculations. The default is to upcast
+ (promote) smaller integer types to the platform-dependent int.
+ For example, on 32-bit platforms:
+
+ a.dtype default sum dtype
+ ---------------------------------------------------
+ bool, int8, int16, int32 int32
+
+ Warning: The arithmetic is modular and no error is raised on overflow.
+
+ Examples:
+
+ >>> array([0.5, 1.5]).sum()
+ 2.0
+ >>> array([0.5, 1.5]).sum(dtype=int32)
+ 1
+ >>> array([[0, 1], [0, 5]]).sum(axis=0)
+ array([0, 6])
+ >>> array([[0, 1], [0, 5]]).sum(axis=1)
+ array([1, 5])
+ >>> ones(128, dtype=int8).sum(dtype=int8) # overflow!
+ -128
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('swapaxes',
+ """a.swapaxes(axis1, axis2) -> new view with axes swapped.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('take',
+ """a.take(indices, axis=None, out=None, mode='raise') -> new array.
+
+ The new array is formed from the elements of a indexed by indices along the
+ given axis.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('tofile',
+ """a.tofile(fid, sep="", format="%s") -> None. Write the data to a file.
+
+ Required arguments:
+ file -- an open file object or a string containing a filename
+
+ Keyword arguments:
+ sep -- separator for text output. Write binary if empty (default "")
+ format -- format string for text file output (default "%s")
+
+ A convenience function for quick storage of array data. Information on
+ endianess and precision is lost, so this method is not a good choice for
+ files intended to archive data or transport data between machines with
+ different endianess. Some of these problems can be overcome by outputting
+ the data as text files at the expense of speed and file size.
+
+ If 'sep' is empty this method is equivalent to file.write(a.tostring()). If
+ 'sep' is not empty each data item is converted to the nearest Python type
+ and formatted using "format"%item. The resulting strings are written to the
+ file separated by the contents of 'sep'. The data is always written in "C"
+ (row major) order independent of the order of 'a'.
+
+ The data produced by this method can be recovered by using the function
+ fromfile().
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('tolist',
+ """a.tolist() -> Array as hierarchical list.
+
+ Copy the data portion of the array to a hierarchical python list and return
+ that list. Data items are converted to the nearest compatible Python type.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('tostring',
+ """a.tostring(order='C') -> raw copy of array data as a Python string.
+
+ Keyword arguments:
+ order -- order of the data item in the copy {"C","F","A"} (default "C")
+
+ Construct a Python string containing the raw bytes in the array. The order
+ of the data in arrays with ndim > 1 is specified by the 'order' keyword and
+ this keyword overrides the order of the array. The
+ choices are:
+
+ "C" -- C order (row major)
+ "Fortran" -- Fortran order (column major)
+ "Any" -- Current order of array.
+ None -- Same as "Any"
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('trace',
+ """a.trace(offset=0, axis1=0, axis2=1, dtype=None, out=None)
+ return the sum along the offset diagonal of the array's indicated
+ axis1 and axis2.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('transpose',
+ """a.transpose(*axes)
+
+ Returns a view of 'a' with axes transposed. If no axes are given,
+ or None is passed, switches the order of the axes. For a 2-d
+ array, this is the usual matrix transpose. If axes are given,
+ they describe how the axes are permuted.
+
+ Example:
+ >>> a = array([[1,2],[3,4]])
+ >>> a
+ array([[1, 2],
+ [3, 4]])
+ >>> a.transpose()
+ array([[1, 3],
+ [2, 4]])
+ >>> a.transpose((1,0))
+ array([[1, 3],
+ [2, 4]])
+ >>> a.transpose(1,0)
+ array([[1, 3],
+ [2, 4]])
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('var',
+ """a.var(axis=None, dtype=None, out=None) -> variance
+
+ Returns the variance of the array elements, a measure of the spread of a
+ distribution. The variance is computed for the flattened array by default,
+ otherwise over the specified axis.
+
+ :Parameters:
+
+ axis : integer
+ Axis along which the variance is computed. The default is to
+ compute the variance of the flattened array.
+
+ dtype : type
+ Type to use in computing the variance. For arrays of integer type
+ the default is float32, for arrays of float types it is the same as
+ the array type.
+
+ out : ndarray
+ Alternative output array in which to place the result. It must have
+ the same shape as the expected output but the type will be cast if
+ necessary.
+
+ :Returns:
+
+ variance : The return type varies, see above.
+ A new array holding the result is returned unless out is specified,
+ in which case a reference to out is returned.
+
+ :SeeAlso:
+
+ - std : standard deviation
+ - mean: average
+
+ Notes
+ -----
+
+ The variance is the average of the squared deviations from the mean, i.e.
+ var = mean((x - x.mean())**2). The computed variance is biased, i.e.,
+ the mean is computed by dividing by the number of elements, N, rather
+ than by N-1.
+
+ """))
+
+
+add_newdoc('numpy.core.multiarray', 'ndarray', ('view',
+ """a.view(<type>) -> new view of array with same data.
+
+ Type can be either a new sub-type object or a data-descriptor object
+
+ """))
diff --git a/numpy/core/__init__.py b/numpy/core/__init__.py
new file mode 100644
index 000000000..4d22394d5
--- /dev/null
+++ b/numpy/core/__init__.py
@@ -0,0 +1,38 @@
+
+from info import __doc__
+from numpy.version import version as __version__
+
+import multiarray
+import umath
+import _internal # for freeze programs
+import numerictypes as nt
+multiarray.set_typeDict(nt.sctypeDict)
+import _sort
+from numeric import *
+from fromnumeric import *
+from defmatrix import *
+import ma
+import defchararray as char
+import records as rec
+from records import *
+from memmap import *
+from defchararray import *
+import scalarmath
+del nt
+
+from fromnumeric import amax as max, amin as min, \
+ round_ as round
+from numeric import absolute as abs
+
+__all__ = ['char','rec','memmap','ma']
+__all__ += numeric.__all__
+__all__ += fromnumeric.__all__
+__all__ += defmatrix.__all__
+__all__ += rec.__all__
+__all__ += char.__all__
+
+
+
+def test(level=1, verbosity=1):
+ from numpy.testing import NumpyTest
+ return NumpyTest().test(level, verbosity)
diff --git a/numpy/core/_internal.py b/numpy/core/_internal.py
new file mode 100644
index 000000000..b6e153580
--- /dev/null
+++ b/numpy/core/_internal.py
@@ -0,0 +1,289 @@
+#A place for code to be called from C-code
+# that implements more complicated stuff.
+
+import re
+import sys
+
+if (sys.byteorder == 'little'):
+ _nbo = '<'
+else:
+ _nbo = '>'
+
+def _makenames_list(adict):
+ from multiarray import dtype
+ allfields = []
+ fnames = adict.keys()
+ for fname in fnames:
+ obj = adict[fname]
+ n = len(obj)
+ if not isinstance(obj, tuple) or n not in [2,3]:
+ raise ValueError, "entry not a 2- or 3- tuple"
+ if (n > 2) and (obj[2] == fname):
+ continue
+ num = int(obj[1])
+ if (num < 0):
+ raise ValueError, "invalid offset."
+ format = dtype(obj[0])
+ if (format.itemsize == 0):
+ raise ValueError, "all itemsizes must be fixed."
+ if (n > 2):
+ title = obj[2]
+ else:
+ title = None
+ allfields.append((fname, format, num, title))
+ # sort by offsets
+ allfields.sort(lambda x,y: cmp(x[2],y[2]))
+ names = [x[0] for x in allfields]
+ formats = [x[1] for x in allfields]
+ offsets = [x[2] for x in allfields]
+ titles = [x[3] for x in allfields]
+
+ return names, formats, offsets, titles
+
+# Called in PyArray_DescrConverter function when
+# a dictionary without "names" and "formats"
+# fields is used as a data-type descriptor.
+def _usefields(adict, align):
+ from multiarray import dtype
+ try:
+ names = adict[-1]
+ except KeyError:
+ names = None
+ if names is None:
+ names, formats, offsets, titles = _makenames_list(adict)
+ else:
+ formats = []
+ offsets = []
+ titles = []
+ for name in names:
+ res = adict[name]
+ formats.append(res[0])
+ offsets.append(res[1])
+ if (len(res) > 2):
+ titles.append(res[2])
+ else:
+ titles.append(None)
+
+ return dtype({"names" : names,
+ "formats" : formats,
+ "offsets" : offsets,
+ "titles" : titles}, align)
+
+
+# construct an array_protocol descriptor list
+# from the fields attribute of a descriptor
+# This calls itself recursively but should eventually hit
+# a descriptor that has no fields and then return
+# a simple typestring
+
+def _array_descr(descriptor):
+ fields = descriptor.fields
+ if fields is None:
+ return descriptor.str
+
+ names = descriptor.names
+ ordered_fields = [fields[x] + (x,) for x in names]
+ result = []
+ offset = 0
+ for field in ordered_fields:
+ if field[1] > offset:
+ num = field[1] - offset
+ result.append(('','|V%d' % num))
+ offset += num
+ if len(field) > 3:
+ name = (field[2],field[3])
+ else:
+ name = field[2]
+ if field[0].subdtype:
+ tup = (name, _array_descr(field[0].subdtype[0]),
+ field[0].subdtype[1])
+ else:
+ tup = (name, _array_descr(field[0]))
+ offset += field[0].itemsize
+ result.append(tup)
+
+ return result
+
+# Build a new array from the information in a pickle.
+# Note that the name numpy.core._internal._reconstruct is embedded in
+# pickles of ndarrays made with NumPy before release 1.0
+# so don't remove the name here, or you'll
+# break backward compatibilty.
+def _reconstruct(subtype, shape, dtype):
+ from multiarray import ndarray
+ return ndarray.__new__(subtype, shape, dtype)
+
+
+# format_re and _split were taken from numarray by J. Todd Miller
+
+def _split(input):
+ """Split the input formats string into field formats without splitting
+ the tuple used to specify multi-dimensional arrays."""
+
+ newlist = []
+ hold = ''
+
+ listinput = input.split(',')
+ for element in listinput:
+ if hold != '':
+ item = hold + ',' + element
+ else:
+ item = element
+ left = item.count('(')
+ right = item.count(')')
+
+ # if the parenthesis is not balanced, hold the string
+ if left > right :
+ hold = item
+
+ # when balanced, append to the output list and reset the hold
+ elif left == right:
+ newlist.append(item.strip())
+ hold = ''
+
+ # too many close parenthesis is unacceptable
+ else:
+ raise SyntaxError, item
+
+ # if there is string left over in hold
+ if hold != '':
+ raise SyntaxError, hold
+
+ return newlist
+
+format_re = re.compile(r'(?P<order1>[<>|=]?)(?P<repeats> *[(]?[ ,0-9]*[)]? *)(?P<order2>[<>|=]?)(?P<dtype>[A-Za-z0-9.]*)')
+
+# astr is a string (perhaps comma separated)
+
+_convorder = {'=': _nbo,
+ '|': '|',
+ '>': '>',
+ '<': '<'}
+
+def _commastring(astr):
+ res = _split(astr)
+ if (len(res)) < 1:
+ raise ValueError, "unrecognized formant"
+ result = []
+ for k,item in enumerate(res):
+ # convert item
+ try:
+ (order1, repeats, order2, dtype) = format_re.match(item).groups()
+ except (TypeError, AttributeError):
+ raise ValueError('format %s is not recognized' % item)
+
+ if order2 == '':
+ order = order1
+ elif order1 == '':
+ order = order2
+ else:
+ order1 = _convorder[order1]
+ order2 = _convorder[order2]
+ if (order1 != order2):
+ raise ValueError('in-consistent byte-order specification %s and %s' % (order1, order2))
+ order = order1
+
+ if order in ['|', '=', _nbo]:
+ order = ''
+ dtype = '%s%s' % (order, dtype)
+ if (repeats == ''):
+ newitem = dtype
+ else:
+ newitem = (dtype, eval(repeats))
+ result.append(newitem)
+
+ return result
+
+def _getintp_ctype():
+ from multiarray import dtype
+ val = _getintp_ctype.cache
+ if val is not None:
+ return val
+ char = dtype('p').char
+ import ctypes
+ if (char == 'i'):
+ val = ctypes.c_int
+ elif char == 'l':
+ val = ctypes.c_long
+ elif char == 'q':
+ val = ctypes.c_longlong
+ else:
+ val = ctypes.c_long
+ _getintp_ctype.cache = val
+ return val
+_getintp_ctype.cache = None
+
+# Used for .ctypes attribute of ndarray
+
+class _missing_ctypes(object):
+ def cast(self, num, obj):
+ return num
+
+ def c_void_p(self, num):
+ return num
+
+class _ctypes(object):
+ def __init__(self, array, ptr=None):
+ try:
+ import ctypes
+ self._ctypes = ctypes
+ except ImportError:
+ self._ctypes = _missing_ctypes()
+ self._arr = array
+ self._data = ptr
+ if self._arr.ndim == 0:
+ self._zerod = True
+ else:
+ self._zerod = False
+
+ def data_as(self, obj):
+ return self._ctypes.cast(self._data, obj)
+
+ def shape_as(self, obj):
+ if self._zerod:
+ return None
+ return (obj*self._arr.ndim)(*self._arr.shape)
+
+ def strides_as(self, obj):
+ if self._zerod:
+ return None
+ return (obj*self._arr.ndim)(*self._arr.strides)
+
+ def get_data(self):
+ return self._data
+
+ def get_shape(self):
+ if self._zerod:
+ return None
+ return (_getintp_ctype()*self._arr.ndim)(*self._arr.shape)
+
+ def get_strides(self):
+ if self._zerod:
+ return None
+ return (_getintp_ctype()*self._arr.ndim)(*self._arr.strides)
+
+ def get_as_parameter(self):
+ return self._ctypes.c_void_p(self._data)
+
+ data = property(get_data, None, doc="c-types data")
+ shape = property(get_shape, None, doc="c-types shape")
+ strides = property(get_strides, None, doc="c-types strides")
+ _as_parameter_ = property(get_as_parameter, None, doc="_as parameter_")
+
+
+# Given a datatype and an order object
+# return a new names tuple
+# with the order indicated
+def _newnames(datatype, order):
+ oldnames = datatype.names
+ nameslist = list(oldnames)
+ if isinstance(order, str):
+ order = [order]
+ if isinstance(order, (list, tuple)):
+ for name in order:
+ try:
+ nameslist.remove(name)
+ except ValueError:
+ raise ValueError, "unknown field name: %s" % (name,)
+ return tuple(list(order) + nameslist)
+ raise ValueError, "unsupported order value: %s" % (order,)
diff --git a/numpy/core/arrayprint.py b/numpy/core/arrayprint.py
new file mode 100644
index 000000000..d47180e4f
--- /dev/null
+++ b/numpy/core/arrayprint.py
@@ -0,0 +1,450 @@
+"""Array printing function
+
+$Id: arrayprint.py,v 1.9 2005/09/13 13:58:44 teoliphant Exp $
+"""
+__all__ = ["array2string", "set_printoptions", "get_printoptions"]
+__docformat__ = 'restructuredtext'
+
+#
+# Written by Konrad Hinsen <hinsenk@ere.umontreal.ca>
+# last revision: 1996-3-13
+# modified by Jim Hugunin 1997-3-3 for repr's and str's (and other details)
+# and by Perry Greenfield 2000-4-1 for numarray
+# and by Travis Oliphant 2005-8-22 for numpy
+
+import sys
+import numeric as _gen
+import numerictypes as _nt
+import umath as _uf
+from multiarray import format_longfloat
+from fromnumeric import ravel
+_nc = _gen
+
+# The following functions are emergency substitutes for numeric functions
+# which sometimes get broken during development.
+
+def product(x, y): return x*y
+
+def _maximum_reduce(arr):
+ maximum = arr[0]
+ for i in xrange(1, arr.nelements()):
+ if arr[i] > maximum: maximum = arr[i]
+ return maximum
+
+def _minimum_reduce(arr):
+ minimum = arr[0]
+ for i in xrange(1, arr.nelements()):
+ if arr[i] < minimum: minimum = arr[i]
+ return minimum
+
+def _numeric_compress(arr):
+ nonzero = 0
+ for i in xrange(arr.nelements()):
+ if arr[i] != 0: nonzero += 1
+ retarr = _nc.zeros((nonzero,))
+ nonzero = 0
+ for i in xrange(arr.nelements()):
+ if arr[i] != 0:
+ retarr[nonzero] = abs(arr[i])
+ nonzero += 1
+ return retarr
+
+_failsafe = 0
+if _failsafe:
+ max_reduce = _maximum_reduce
+ min_reduce = _minimum_reduce
+else:
+ max_reduce = _uf.maximum.reduce
+ min_reduce = _uf.minimum.reduce
+
+_summaryEdgeItems = 3 # repr N leading and trailing items of each dimension
+_summaryThreshold = 1000 # total items > triggers array summarization
+
+_float_output_precision = 8
+_float_output_suppress_small = False
+_line_width = 75
+
+
+def set_printoptions(precision=None, threshold=None, edgeitems=None,
+ linewidth=None, suppress=None):
+ """Set options associated with printing.
+
+ :Parameters:
+ precision : int
+ Number of digits of precision for floating point output (default 8).
+ threshold : int
+ Total number of array elements which trigger summarization
+ rather than full repr (default 1000).
+ edgeitems : int
+ Number of array items in summary at beginning and end of
+ each dimension (default 3).
+ linewidth : int
+ The number of characters per line for the purpose of inserting
+ line breaks (default 75).
+ suppress : bool
+ Whether or not suppress printing of small floating point values
+ using scientific notation (default False).
+ """
+
+ global _summaryThreshold, _summaryEdgeItems, _float_output_precision, \
+ _line_width, _float_output_suppress_small
+ if (linewidth is not None):
+ _line_width = linewidth
+ if (threshold is not None):
+ _summaryThreshold = threshold
+ if (edgeitems is not None):
+ _summaryEdgeItems = edgeitems
+ if (precision is not None):
+ _float_output_precision = precision
+ if (suppress is not None):
+ _float_output_suppress_small = not not suppress
+ return
+
+def get_printoptions():
+ """Return the current print options.
+
+ :Returns:
+ precision : int
+ threshold : int
+ edgeitems : int
+ linewidth : int
+ suppress : bool
+
+ :SeeAlso:
+ - set_printoptions : parameter descriptions
+
+ """
+ return _float_output_precision, _summaryThreshold, _summaryEdgeItems, \
+ _line_width, _float_output_suppress_small
+
+
+def _leading_trailing(a):
+ if a.ndim == 1:
+ if len(a) > 2*_summaryEdgeItems:
+ b = _gen.concatenate((a[:_summaryEdgeItems],
+ a[-_summaryEdgeItems:]))
+ else:
+ b = a
+ else:
+ if len(a) > 2*_summaryEdgeItems:
+ l = [_leading_trailing(a[i]) for i in range(
+ min(len(a), _summaryEdgeItems))]
+ l.extend([_leading_trailing(a[-i]) for i in range(
+ min(len(a), _summaryEdgeItems),0,-1)])
+ else:
+ l = [_leading_trailing(a[i]) for i in range(0, len(a))]
+ b = _gen.concatenate(tuple(l))
+ return b
+
+def _boolFormatter(x):
+ if x: return ' True'
+ else: return 'False'
+
+
+def _array2string(a, max_line_width, precision, suppress_small, separator=' ',
+ prefix=""):
+
+ if max_line_width is None:
+ max_line_width = _line_width
+
+ if precision is None:
+ precision = _float_output_precision
+
+ if suppress_small is None:
+ suppress_small = _float_output_suppress_small
+
+ if a.size > _summaryThreshold:
+ summary_insert = "..., "
+ data = _leading_trailing(a)
+ else:
+ summary_insert = ""
+ data = ravel(a)
+
+ try:
+ format_function = a._format
+ except AttributeError:
+ dtypeobj = a.dtype.type
+ if issubclass(dtypeobj, _nt.bool_):
+ # make sure True and False line up.
+ format_function = _boolFormatter
+ elif issubclass(dtypeobj, _nt.integer):
+ max_str_len = max(len(str(max_reduce(data))),
+ len(str(min_reduce(data))))
+ format = '%' + str(max_str_len) + 'd'
+ format_function = lambda x: _formatInteger(x, format)
+ elif issubclass(dtypeobj, _nt.floating):
+ if issubclass(dtypeobj, _nt.longfloat):
+ format_function = _longfloatFormatter(precision)
+ else:
+ format = _floatFormat(data, precision, suppress_small)
+ format_function = lambda x: _formatFloat(x, format)
+ elif issubclass(dtypeobj, _nt.complexfloating):
+ if issubclass(dtypeobj, _nt.clongfloat):
+ format_function = _clongfloatFormatter(precision)
+ else:
+ real_format = _floatFormat(
+ data.real, precision, suppress_small, sign=0)
+ imag_format = _floatFormat(
+ data.imag, precision, suppress_small, sign=1)
+ format_function = lambda x: \
+ _formatComplex(x, real_format, imag_format)
+ elif issubclass(dtypeobj, _nt.unicode_) or \
+ issubclass(dtypeobj, _nt.string_):
+ format = "%s"
+ format_function = lambda x: repr(x)
+ else:
+ format = '%s'
+ format_function = lambda x: str(x)
+
+ next_line_prefix = " " # skip over "["
+ next_line_prefix += " "*len(prefix) # skip over array(
+
+ lst = _formatArray(a, format_function, len(a.shape), max_line_width,
+ next_line_prefix, separator,
+ _summaryEdgeItems, summary_insert)[:-1]
+
+ return lst
+
+def _convert_arrays(obj):
+ newtup = []
+ for k in obj:
+ if isinstance(k, _gen.ndarray):
+ k = k.tolist()
+ elif isinstance(k, tuple):
+ k = _convert_arrays(k)
+ newtup.append(k)
+ return tuple(newtup)
+
+
+def array2string(a, max_line_width = None, precision = None,
+ suppress_small = None, separator=' ', prefix="",
+ style=repr):
+ """Return a string representation of an array.
+
+ :Parameters:
+ a : ndarray
+ Input array.
+ max_line_width : int
+ The maximum number of columns the string should span. Newline
+ characters splits the string appropriately after array elements.
+ precision : int
+ Floating point precision.
+ suppress_small : bool
+ Represent very small numbers as zero.
+ separator : string
+ Inserted between elements.
+ prefix : string
+ An array is typically printed as
+
+ 'prefix(' + array2string(a) + ')'
+
+ The length of the prefix string is used to align the
+ output correctly.
+ style : function
+
+ Examples
+ --------
+
+ >>> x = N.array([1e-16,1,2,3])
+ >>> print array2string(x,precision=2,separator=',',suppress_small=True)
+ [ 0., 1., 2., 3.]
+
+ """
+
+ if a.shape == ():
+ x = a.item()
+ try:
+ lst = a._format(x)
+ except AttributeError:
+ if isinstance(x, tuple):
+ x = _convert_arrays(x)
+ lst = style(x)
+ elif reduce(product, a.shape) == 0:
+ # treat as a null array if any of shape elements == 0
+ lst = "[]"
+ else:
+ lst = _array2string(a, max_line_width, precision, suppress_small,
+ separator, prefix)
+ return lst
+
+def _extendLine(s, line, word, max_line_len, next_line_prefix):
+ if len(line.rstrip()) + len(word.rstrip()) >= max_line_len:
+ s += line.rstrip() + "\n"
+ line = next_line_prefix
+ line += word
+ return s, line
+
+
+def _formatArray(a, format_function, rank, max_line_len,
+ next_line_prefix, separator, edge_items, summary_insert):
+ """formatArray is designed for two modes of operation:
+
+ 1. Full output
+
+ 2. Summarized output
+
+ """
+ if rank == 0:
+ obj = a.item()
+ if isinstance(obj, tuple):
+ obj = _convert_arrays(obj)
+ return str(obj)
+
+ if summary_insert and 2*edge_items < len(a):
+ leading_items, trailing_items, summary_insert1 = \
+ edge_items, edge_items, summary_insert
+ else:
+ leading_items, trailing_items, summary_insert1 = 0, len(a), ""
+
+ if rank == 1:
+ s = ""
+ line = next_line_prefix
+ for i in xrange(leading_items):
+ word = format_function(a[i]) + separator
+ s, line = _extendLine(s, line, word, max_line_len, next_line_prefix)
+
+ if summary_insert1:
+ s, line = _extendLine(s, line, summary_insert1, max_line_len, next_line_prefix)
+
+ for i in xrange(trailing_items, 1, -1):
+ word = format_function(a[-i]) + separator
+ s, line = _extendLine(s, line, word, max_line_len, next_line_prefix)
+
+ word = format_function(a[-1])
+ s, line = _extendLine(s, line, word, max_line_len, next_line_prefix)
+ s += line + "]\n"
+ s = '[' + s[len(next_line_prefix):]
+ else:
+ s = '['
+ sep = separator.rstrip()
+ for i in xrange(leading_items):
+ if i > 0:
+ s += next_line_prefix
+ s += _formatArray(a[i], format_function, rank-1, max_line_len,
+ " " + next_line_prefix, separator, edge_items,
+ summary_insert)
+ s = s.rstrip() + sep.rstrip() + '\n'*max(rank-1,1)
+
+ if summary_insert1:
+ s += next_line_prefix + summary_insert1 + "\n"
+
+ for i in xrange(trailing_items, 1, -1):
+ if leading_items or i != trailing_items:
+ s += next_line_prefix
+ s += _formatArray(a[-i], format_function, rank-1, max_line_len,
+ " " + next_line_prefix, separator, edge_items,
+ summary_insert)
+ s = s.rstrip() + sep.rstrip() + '\n'*max(rank-1,1)
+ if leading_items or trailing_items > 1:
+ s += next_line_prefix
+ s += _formatArray(a[-1], format_function, rank-1, max_line_len,
+ " " + next_line_prefix, separator, edge_items,
+ summary_insert).rstrip()+']\n'
+ return s
+
+def _floatFormat(data, precision, suppress_small, sign = 0):
+ exp_format = 0
+ errstate = _gen.seterr(all='ignore')
+ non_zero = _uf.absolute(data.compress(_uf.not_equal(data, 0)))
+ ##non_zero = _numeric_compress(data) ##
+ if len(non_zero) == 0:
+ max_val = 0.
+ min_val = 0.
+ else:
+ max_val = max_reduce(non_zero)
+ min_val = min_reduce(non_zero)
+ if max_val >= 1.e8:
+ exp_format = 1
+ if not suppress_small and (min_val < 0.0001
+ or max_val/min_val > 1000.):
+ exp_format = 1
+ _gen.seterr(**errstate)
+ if exp_format:
+ large_exponent = 0 < min_val < 1e-99 or max_val >= 1e100
+ max_str_len = 8 + precision + large_exponent
+ if sign: format = '%+'
+ else: format = '%'
+ format = format + str(max_str_len) + '.' + str(precision) + 'e'
+ if large_exponent: format = format + '3'
+ else:
+ format = '%.' + str(precision) + 'f'
+ precision = min(precision, max([_digits(x, precision, format)
+ for x in data]))
+ max_str_len = len(str(int(max_val))) + precision + 2
+ if sign: format = '%#+'
+ else: format = '%#'
+ format = format + str(max_str_len) + '.' + str(precision) + 'f'
+ return format
+
+def _digits(x, precision, format):
+ s = format % x
+ zeros = len(s)
+ while s[zeros-1] == '0': zeros = zeros-1
+ return precision-len(s)+zeros
+
+
+_MAXINT = sys.maxint
+_MININT = -sys.maxint-1
+def _formatInteger(x, format):
+ if (x < _MAXINT) and (x > _MININT):
+ return format % x
+ else:
+ return "%s" % x
+
+def _longfloatFormatter(precision):
+ def formatter(x):
+ return format_longfloat(x, precision)
+ return formatter
+
+def _formatFloat(x, format, strip_zeros = 1):
+ if format[-1] == '3':
+ # 3-digit exponent
+ format = format[:-1]
+ s = format % x
+ third = s[-3]
+ if third == '+' or third == '-':
+ s = s[1:-2] + '0' + s[-2:]
+ elif format[-1] == 'e':
+ # 2-digit exponent
+ s = format % x
+ if s[-3] == '0':
+ s = ' ' + s[:-3] + s[-2:]
+ elif format[-1] == 'f':
+ s = format % x
+ if strip_zeros:
+ zeros = len(s)
+ while s[zeros-1] == '0': zeros = zeros-1
+ s = s[:zeros] + (len(s)-zeros)*' '
+ else:
+ s = format % x
+ return s
+
+def _clongfloatFormatter(precision):
+ def formatter(x):
+ r = format_longfloat(x.real, precision)
+ i = format_longfloat(x.imag, precision)
+ if x.imag < 0:
+ i = '-' + i
+ else:
+ i = '+' + i
+ return r + i + 'j'
+ return formatter
+
+def _formatComplex(x, real_format, imag_format):
+ r = _formatFloat(x.real, real_format)
+ i = _formatFloat(x.imag, imag_format, 0)
+ if imag_format[-1] == 'f':
+ zeros = len(i)
+ while zeros > 2 and i[zeros-1] == '0': zeros = zeros-1
+ i = i[:zeros] + 'j' + (len(i)-zeros)*' '
+ else:
+ i = i + 'j'
+ return r + i
+
+def _formatGeneral(x):
+ return str(x) + ' '
+
+if __name__ == '__main__':
+ a = _nc.arange(10)
+ print array2string(a)
+ print array2string(_nc.array([[],[]]))
diff --git a/numpy/core/blasdot/_dotblas.c b/numpy/core/blasdot/_dotblas.c
new file mode 100644
index 000000000..c2d35f594
--- /dev/null
+++ b/numpy/core/blasdot/_dotblas.c
@@ -0,0 +1,1092 @@
+static char module_doc[] =
+"This module provides a BLAS optimized\nmatrix multiply, inner product and dot for numpy arrays";
+
+#include "Python.h"
+#include "numpy/noprefix.h"
+#ifndef CBLAS_HEADER
+#define CBLAS_HEADER "cblas.h"
+#endif
+#include CBLAS_HEADER
+
+#include <stdio.h>
+
+static PyArray_DotFunc *oldFunctions[PyArray_NTYPES];
+
+static void
+FLOAT_dot(void *a, intp stridea, void *b, intp strideb, void *res,
+ intp n, void *tmp)
+{
+ register int na = stridea / sizeof(float);
+ register int nb = strideb / sizeof(float);
+
+ if ((sizeof(float) * na == stridea) &&
+ (sizeof(float) * nb == strideb))
+ *((float *)res) = cblas_sdot((int)n, (float *)a, na, (float *)b, nb);
+
+ else
+ oldFunctions[PyArray_FLOAT](a, stridea, b, strideb, res, n, tmp);
+}
+
+static void
+DOUBLE_dot(void *a, intp stridea, void *b, intp strideb, void *res,
+ intp n, void *tmp)
+{
+ register int na = stridea / sizeof(double);
+ register int nb = strideb / sizeof(double);
+
+ if ((sizeof(double) * na == stridea) &&
+ (sizeof(double) * nb == strideb))
+ *((double *)res) = cblas_ddot((int)n, (double *)a, na, (double *)b, nb);
+ else
+ oldFunctions[PyArray_DOUBLE](a, stridea, b, strideb, res, n, tmp);
+}
+
+static void
+CFLOAT_dot(void *a, intp stridea, void *b, intp strideb, void *res,
+ intp n, void *tmp)
+{
+
+ register int na = stridea / sizeof(cfloat);
+ register int nb = strideb / sizeof(cfloat);
+
+ if ((sizeof(cfloat) * na == stridea) &&
+ (sizeof(cfloat) * nb == strideb))
+ cblas_cdotu_sub((int)n, (float *)a, na, (float *)b, nb, (float *)res);
+ else
+ oldFunctions[PyArray_CFLOAT](a, stridea, b, strideb, res, n, tmp);
+}
+
+static void
+CDOUBLE_dot(void *a, intp stridea, void *b, intp strideb, void *res,
+ intp n, void *tmp)
+{
+ register int na = stridea / sizeof(cdouble);
+ register int nb = strideb / sizeof(cdouble);
+
+ if ((sizeof(cdouble) * na == stridea) &&
+ (sizeof(cdouble) * nb == strideb))
+ cblas_zdotu_sub((int)n, (double *)a, na, (double *)b, nb, (double *)res);
+ else
+ oldFunctions[PyArray_CDOUBLE](a, stridea, b, strideb, res, n, tmp);
+}
+
+
+static Bool altered=FALSE;
+
+static char doc_alterdot[] = "alterdot() changes all dot functions to use blas.";
+
+static PyObject *
+dotblas_alterdot(PyObject *dummy, PyObject *args)
+{
+ PyArray_Descr *descr;
+
+ if (!PyArg_ParseTuple(args, "")) return NULL;
+
+ /* Replace the dot functions to the ones using blas */
+
+ if (!altered) {
+ descr = PyArray_DescrFromType(PyArray_FLOAT);
+ oldFunctions[PyArray_FLOAT] = descr->f->dotfunc;
+ descr->f->dotfunc = (PyArray_DotFunc *)FLOAT_dot;
+
+ descr = PyArray_DescrFromType(PyArray_DOUBLE);
+ oldFunctions[PyArray_DOUBLE] = descr->f->dotfunc;
+ descr->f->dotfunc = (PyArray_DotFunc *)DOUBLE_dot;
+
+ descr = PyArray_DescrFromType(PyArray_CFLOAT);
+ oldFunctions[PyArray_CFLOAT] = descr->f->dotfunc;
+ descr->f->dotfunc = (PyArray_DotFunc *)CFLOAT_dot;
+
+ descr = PyArray_DescrFromType(PyArray_CDOUBLE);
+ oldFunctions[PyArray_CDOUBLE] = descr->f->dotfunc;
+ descr->f->dotfunc = (PyArray_DotFunc *)CDOUBLE_dot;
+
+ altered = TRUE;
+ }
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+static char doc_restoredot[] = "restoredot() restores dots to defaults.";
+
+static PyObject *
+dotblas_restoredot(PyObject *dummy, PyObject *args)
+{
+ PyArray_Descr *descr;
+
+ if (!PyArg_ParseTuple(args, "")) return NULL;
+
+ if (altered) {
+ descr = PyArray_DescrFromType(PyArray_FLOAT);
+ descr->f->dotfunc = oldFunctions[PyArray_FLOAT];
+ oldFunctions[PyArray_FLOAT] = NULL;
+ Py_XDECREF(descr);
+
+ descr = PyArray_DescrFromType(PyArray_DOUBLE);
+ descr->f->dotfunc = oldFunctions[PyArray_DOUBLE];
+ oldFunctions[PyArray_DOUBLE] = NULL;
+ Py_XDECREF(descr);
+
+ descr = PyArray_DescrFromType(PyArray_CFLOAT);
+ descr->f->dotfunc = oldFunctions[PyArray_CFLOAT];
+ oldFunctions[PyArray_CFLOAT] = NULL;
+ Py_XDECREF(descr);
+
+ descr = PyArray_DescrFromType(PyArray_CDOUBLE);
+ descr->f->dotfunc = oldFunctions[PyArray_CDOUBLE];
+ oldFunctions[PyArray_CDOUBLE] = NULL;
+ Py_XDECREF(descr);
+
+ altered = FALSE;
+ }
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+typedef enum {_scalar, _column, _row, _matrix} MatrixShape;
+
+static MatrixShape
+_select_matrix_shape(PyArrayObject *array)
+{
+ switch (array->nd) {
+ case 0:
+ return _scalar;
+ case 1:
+ if (array->dimensions[0] > 1)
+ return _column;
+ return _scalar;
+ case 2:
+ if (array->dimensions[0] > 1) {
+ if (array->dimensions[1] == 1)
+ return _column;
+ else
+ return _matrix;
+ }
+ if (array->dimensions[1] == 1)
+ return _scalar;
+ return _row;
+ }
+ return _matrix;
+}
+
+
+static char doc_matrixproduct[] = "dot(a,b)\nReturns the dot product of a and b for arrays of floating point types.\nLike the generic numpy equivalent the product sum is over\nthe last dimension of a and the second-to-last dimension of b.\nNB: The first argument is not conjugated.";
+
+static PyObject *
+dotblas_matrixproduct(PyObject *dummy, PyObject *args)
+{
+ PyObject *op1, *op2;
+ PyArrayObject *ap1=NULL, *ap2=NULL, *ret=NULL;
+ int j, l, lda, ldb, ldc;
+ int typenum, nd;
+ intp ap1stride=0;
+ intp dimensions[MAX_DIMS];
+ intp numbytes;
+ static const float oneF[2] = {1.0, 0.0};
+ static const float zeroF[2] = {0.0, 0.0};
+ static const double oneD[2] = {1.0, 0.0};
+ static const double zeroD[2] = {0.0, 0.0};
+ double prior1, prior2;
+ PyTypeObject *subtype;
+ PyArray_Descr *dtype;
+ MatrixShape ap1shape, ap2shape;
+
+ if (!PyArg_ParseTuple(args, "OO", &op1, &op2)) return NULL;
+
+ /*
+ * "Matrix product" using the BLAS.
+ * Only works for float double and complex types.
+ */
+
+ typenum = PyArray_ObjectType(op1, 0);
+ typenum = PyArray_ObjectType(op2, typenum);
+
+ /* This function doesn't handle other types */
+ if ((typenum != PyArray_DOUBLE && typenum != PyArray_CDOUBLE &&
+ typenum != PyArray_FLOAT && typenum != PyArray_CFLOAT)) {
+ return PyArray_Return((PyArrayObject *)PyArray_MatrixProduct(op1, op2));
+ }
+
+ dtype = PyArray_DescrFromType(typenum);
+ ap1 = (PyArrayObject *)PyArray_FromAny(op1, dtype, 0, 0, ALIGNED, NULL);
+ if (ap1 == NULL) return NULL;
+ Py_INCREF(dtype);
+ ap2 = (PyArrayObject *)PyArray_FromAny(op2, dtype, 0, 0, ALIGNED, NULL);
+ if (ap2 == NULL) goto fail;
+
+ if ((ap1->nd > 2) || (ap2->nd > 2)) {
+ /* This function doesn't handle dimensions greater than 2 -- other
+ than to ensure the dot function is altered
+ */
+ if (!altered) {
+ /* need to alter dot product */
+ PyObject *tmp1, *tmp2;
+ tmp1 = PyTuple_New(0);
+ tmp2 = dotblas_alterdot(NULL, tmp1);
+ Py_DECREF(tmp1);
+ Py_DECREF(tmp2);
+ }
+ ret = (PyArrayObject *)PyArray_MatrixProduct((PyObject *)ap1,
+ (PyObject *)ap2);
+ Py_DECREF(ap1);
+ Py_DECREF(ap2);
+ return PyArray_Return(ret);
+ }
+
+ if (!PyArray_ElementStrides((PyObject *)ap1)) {
+ op1 = PyArray_NewCopy(ap1, PyArray_ANYORDER);
+ Py_DECREF(ap1);
+ ap1 = (PyArrayObject *)op1;
+ if (ap1 == NULL) goto fail;
+ }
+ if (!PyArray_ElementStrides((PyObject *)ap2)) {
+ op2 = PyArray_NewCopy(ap2, PyArray_ANYORDER);
+ Py_DECREF(ap2);
+ ap2 = (PyArrayObject *)op2;
+ if (ap2 == NULL) goto fail;
+ }
+ ap1shape = _select_matrix_shape(ap1);
+ ap2shape = _select_matrix_shape(ap2);
+
+ if (ap1shape == _scalar || ap2shape == _scalar) {
+ PyArrayObject *oap1, *oap2;
+ oap1 = ap1; oap2 = ap2;
+ /* One of ap1 or ap2 is a scalar */
+ if (ap1shape == _scalar) { /* Make ap2 the scalar */
+ PyArrayObject *t = ap1;
+ ap1 = ap2;
+ ap2 = t;
+ ap1shape = ap2shape;
+ ap2shape = _scalar;
+ }
+
+ if (ap1shape == _row) ap1stride = ap1->strides[1];
+ else if (ap1->nd > 0) ap1stride = ap1->strides[0];
+
+ if (ap1->nd == 0 || ap2->nd == 0) {
+ intp *thisdims;
+ if (ap1->nd == 0) {
+ nd = ap2->nd;
+ thisdims = ap2->dimensions;
+ }
+ else {
+ nd = ap1->nd;
+ thisdims = ap1->dimensions;
+ }
+ l = 1;
+ for (j=0; j<nd; j++) {
+ dimensions[j] = thisdims[j];
+ l *= dimensions[j];
+ }
+ }
+ else {
+ l = oap1->dimensions[oap1->nd-1];
+
+ if (oap2->dimensions[0] != l) {
+ PyErr_SetString(PyExc_ValueError, "matrices are not aligned");
+ goto fail;
+ }
+ nd = ap1->nd + ap2->nd - 2;
+ /* nd = 0 or 1 or 2 */
+ /* If nd == 0 do nothing ... */
+ if (nd == 1) {
+ /* Either ap1->nd is 1 dim or ap2->nd is 1 dim
+ and the other is 2-dim */
+ dimensions[0] = (oap1->nd == 2) ? oap1->dimensions[0] : oap2->dimensions[1];
+ l = dimensions[0];
+ /* Fix it so that dot(shape=(N,1), shape=(1,))
+ and dot(shape=(1,), shape=(1,N)) both return
+ an (N,) array (but use the fast scalar code)
+ */
+ }
+ else if (nd == 2) {
+ dimensions[0] = oap1->dimensions[0];
+ dimensions[1] = oap2->dimensions[1];
+ /* We need to make sure that dot(shape=(1,1), shape=(1,N))
+ and dot(shape=(N,1),shape=(1,1)) uses
+ scalar multiplication appropriately
+ */
+ if (ap1shape == _row) l = dimensions[1];
+ else l = dimensions[0];
+ }
+ }
+ }
+ else { /* (ap1->nd <= 2 && ap2->nd <= 2) */
+ /* Both ap1 and ap2 are vectors or matrices */
+ l = ap1->dimensions[ap1->nd-1];
+
+ if (ap2->dimensions[0] != l) {
+ PyErr_SetString(PyExc_ValueError, "matrices are not aligned");
+ goto fail;
+ }
+ nd = ap1->nd+ap2->nd-2;
+
+ if (nd == 1)
+ dimensions[0] = (ap1->nd == 2) ? ap1->dimensions[0] : ap2->dimensions[1];
+ else if (nd == 2) {
+ dimensions[0] = ap1->dimensions[0];
+ dimensions[1] = ap2->dimensions[1];
+ }
+ }
+
+ /* Choose which subtype to return */
+ if (ap1->ob_type != ap2->ob_type) {
+ prior2 = PyArray_GetPriority((PyObject *)ap2, 0.0);
+ prior1 = PyArray_GetPriority((PyObject *)ap1, 0.0);
+ subtype = (prior2 > prior1 ? ap2->ob_type : ap1->ob_type);
+ }
+ else {
+ prior1 = prior2 = 0.0;
+ subtype = ap1->ob_type;
+ }
+
+ ret = (PyArrayObject *)PyArray_New(subtype, nd, dimensions,
+ typenum, NULL, NULL, 0, 0,
+ (PyObject *)
+ (prior2 > prior1 ? ap2 : ap1));
+
+ if (ret == NULL) goto fail;
+ numbytes = PyArray_NBYTES(ret);
+ memset(ret->data, 0, numbytes);
+ if (numbytes==0 || l == 0) {
+ Py_DECREF(ap1);
+ Py_DECREF(ap2);
+ return PyArray_Return(ret);
+ }
+
+
+ if (ap2shape == _scalar) {
+ /* Multiplication by a scalar -- Level 1 BLAS */
+ /* if ap1shape is a matrix and we are not contiguous, then we can't
+ just blast through the entire array using a single
+ striding factor */
+ NPY_BEGIN_ALLOW_THREADS
+
+ if (typenum == PyArray_DOUBLE) {
+ if (l == 1) {
+ *((double *)ret->data) = *((double *)ap2->data) * \
+ *((double *)ap1->data);
+ }
+ else if (ap1shape != _matrix) {
+ cblas_daxpy(l, *((double *)ap2->data), (double *)ap1->data,
+ ap1stride/sizeof(double), (double *)ret->data, 1);
+ }
+ else {
+ int maxind, oind, i, a1s, rets;
+ char *ptr, *rptr;
+ double val;
+ maxind = (ap1->dimensions[0] >= ap1->dimensions[1] ? 0 : 1);
+ oind = 1-maxind;
+ ptr = ap1->data;
+ rptr = ret->data;
+ l = ap1->dimensions[maxind];
+ val = *((double *)ap2->data);
+ a1s = ap1->strides[maxind] / sizeof(double);
+ rets = ret->strides[maxind] / sizeof(double);
+ for (i=0; i < ap1->dimensions[oind]; i++) {
+ cblas_daxpy(l, val, (double *)ptr, a1s,
+ (double *)rptr, rets);
+ ptr += ap1->strides[oind];
+ rptr += ret->strides[oind];
+ }
+ }
+ }
+ else if (typenum == PyArray_CDOUBLE) {
+ if (l == 1) {
+ cdouble *ptr1, *ptr2, *res;
+ ptr1 = (cdouble *)ap2->data;
+ ptr2 = (cdouble *)ap1->data;
+ res = (cdouble *)ret->data;
+ res->real = ptr1->real * ptr2->real - ptr1->imag * ptr2->imag;
+ res->imag = ptr1->real * ptr2->imag + ptr1->imag * ptr2->real;
+ }
+ else if (ap1shape != _matrix) {
+ cblas_zaxpy(l, (double *)ap2->data, (double *)ap1->data,
+ ap1stride/sizeof(cdouble), (double *)ret->data, 1);
+ }
+ else {
+ int maxind, oind, i, a1s, rets;
+ char *ptr, *rptr;
+ double *pval;
+ maxind = (ap1->dimensions[0] >= ap1->dimensions[1] ? 0 : 1);
+ oind = 1-maxind;
+ ptr = ap1->data;
+ rptr = ret->data;
+ l = ap1->dimensions[maxind];
+ pval = (double *)ap2->data;
+ a1s = ap1->strides[maxind] / sizeof(cdouble);
+ rets = ret->strides[maxind] / sizeof(cdouble);
+ for (i=0; i < ap1->dimensions[oind]; i++) {
+ cblas_zaxpy(l, pval, (double *)ptr, a1s,
+ (double *)rptr, rets);
+ ptr += ap1->strides[oind];
+ rptr += ret->strides[oind];
+ }
+ }
+ }
+ else if (typenum == PyArray_FLOAT) {
+ if (l == 1) {
+ *((float *)ret->data) = *((float *)ap2->data) * \
+ *((float *)ap1->data);
+ }
+ else if (ap1shape != _matrix) {
+ cblas_saxpy(l, *((float *)ap2->data), (float *)ap1->data,
+ ap1stride/sizeof(float), (float *)ret->data, 1);
+ }
+ else {
+ int maxind, oind, i, a1s, rets;
+ char *ptr, *rptr;
+ float val;
+ maxind = (ap1->dimensions[0] >= ap1->dimensions[1] ? 0 : 1);
+ oind = 1-maxind;
+ ptr = ap1->data;
+ rptr = ret->data;
+ l = ap1->dimensions[maxind];
+ val = *((float *)ap2->data);
+ a1s = ap1->strides[maxind] / sizeof(float);
+ rets = ret->strides[maxind] / sizeof(float);
+ for (i=0; i < ap1->dimensions[oind]; i++) {
+ cblas_saxpy(l, val, (float *)ptr, a1s,
+ (float *)rptr, rets);
+ ptr += ap1->strides[oind];
+ rptr += ret->strides[oind];
+ }
+ }
+ }
+ else if (typenum == PyArray_CFLOAT) {
+ if (l == 1) {
+ cfloat *ptr1, *ptr2, *res;
+ ptr1 = (cfloat *)ap2->data;
+ ptr2 = (cfloat *)ap1->data;
+ res = (cfloat *)ret->data;
+ res->real = ptr1->real * ptr2->real - ptr1->imag * ptr2->imag;
+ res->imag = ptr1->real * ptr2->imag + ptr1->imag * ptr2->real;
+ }
+ else if (ap1shape != _matrix) {
+ cblas_caxpy(l, (float *)ap2->data, (float *)ap1->data,
+ ap1stride/sizeof(cfloat), (float *)ret->data, 1);
+ }
+ else {
+ int maxind, oind, i, a1s, rets;
+ char *ptr, *rptr;
+ float *pval;
+ maxind = (ap1->dimensions[0] >= ap1->dimensions[1] ? 0 : 1);
+ oind = 1-maxind;
+ ptr = ap1->data;
+ rptr = ret->data;
+ l = ap1->dimensions[maxind];
+ pval = (float *)ap2->data;
+ a1s = ap1->strides[maxind] / sizeof(cfloat);
+ rets = ret->strides[maxind] / sizeof(cfloat);
+ for (i=0; i < ap1->dimensions[oind]; i++) {
+ cblas_caxpy(l, pval, (float *)ptr, a1s,
+ (float *)rptr, rets);
+ ptr += ap1->strides[oind];
+ rptr += ret->strides[oind];
+ }
+ }
+ }
+ NPY_END_ALLOW_THREADS
+ }
+ else if ((ap2shape == _column) && (ap1shape != _matrix)) {
+ int ap1s, ap2s;
+ NPY_BEGIN_ALLOW_THREADS
+
+ ap2s = ap2->strides[0] / ap2->descr->elsize;
+ if (ap1shape == _row) {
+ ap1s = ap1->strides[1] / ap1->descr->elsize;
+ }
+ else {
+ ap1s = ap1->strides[0] / ap1->descr->elsize;
+ }
+
+ /* Dot product between two vectors -- Level 1 BLAS */
+ if (typenum == PyArray_DOUBLE) {
+ double result = cblas_ddot(l, (double *)ap1->data, ap1s,
+ (double *)ap2->data, ap2s);
+ *((double *)ret->data) = result;
+ }
+ else if (typenum == PyArray_FLOAT) {
+ float result = cblas_sdot(l, (float *)ap1->data, ap1s,
+ (float *)ap2->data, ap2s);
+ *((float *)ret->data) = result;
+ }
+ else if (typenum == PyArray_CDOUBLE) {
+ cblas_zdotu_sub(l, (double *)ap1->data, ap1s,
+ (double *)ap2->data, ap2s, (double *)ret->data);
+ }
+ else if (typenum == PyArray_CFLOAT) {
+ cblas_cdotu_sub(l, (float *)ap1->data, ap1s,
+ (float *)ap2->data, ap2s, (float *)ret->data);
+ }
+ NPY_END_ALLOW_THREADS
+ }
+ else if (ap1shape == _matrix && ap2shape != _matrix) {
+ /* Matrix vector multiplication -- Level 2 BLAS */
+ /* lda must be MAX(M,1) */
+ enum CBLAS_ORDER Order;
+ int ap2s;
+
+ if (!PyArray_ISONESEGMENT(ap1)) {
+ PyObject *new;
+ new = PyArray_Copy(ap1);
+ Py_DECREF(ap1);
+ ap1 = (PyArrayObject *)new;
+ if (new == NULL) goto fail;
+ }
+ NPY_BEGIN_ALLOW_THREADS
+ if (PyArray_ISCONTIGUOUS(ap1)) {
+ Order = CblasRowMajor;
+ lda = (ap1->dimensions[1] > 1 ? ap1->dimensions[1] : 1);
+ }
+ else {
+ Order = CblasColMajor;
+ lda = (ap1->dimensions[0] > 1 ? ap1->dimensions[0] : 1);
+ }
+ ap2s = ap2->strides[0] / ap2->descr->elsize;
+ if (typenum == PyArray_DOUBLE) {
+ cblas_dgemv(Order, CblasNoTrans,
+ ap1->dimensions[0], ap1->dimensions[1],
+ 1.0, (double *)ap1->data, lda,
+ (double *)ap2->data, ap2s, 0.0, (double *)ret->data, 1);
+ }
+ else if (typenum == PyArray_FLOAT) {
+ cblas_sgemv(Order, CblasNoTrans,
+ ap1->dimensions[0], ap1->dimensions[1],
+ 1.0, (float *)ap1->data, lda,
+ (float *)ap2->data, ap2s, 0.0, (float *)ret->data, 1);
+ }
+ else if (typenum == PyArray_CDOUBLE) {
+ cblas_zgemv(Order,
+ CblasNoTrans, ap1->dimensions[0], ap1->dimensions[1],
+ oneD, (double *)ap1->data, lda,
+ (double *)ap2->data, ap2s, zeroD,
+ (double *)ret->data, 1);
+ }
+ else if (typenum == PyArray_CFLOAT) {
+ cblas_cgemv(Order,
+ CblasNoTrans, ap1->dimensions[0], ap1->dimensions[1],
+ oneF, (float *)ap1->data, lda,
+ (float *)ap2->data, ap2s, zeroF,
+ (float *)ret->data, 1);
+ }
+ NPY_END_ALLOW_THREADS
+ }
+ else if (ap1shape != _matrix && ap2shape == _matrix) {
+ /* Vector matrix multiplication -- Level 2 BLAS */
+ enum CBLAS_ORDER Order;
+ int ap1s;
+
+ if (!PyArray_ISONESEGMENT(ap2)) {
+ PyObject *new;
+ new = PyArray_Copy(ap2);
+ Py_DECREF(ap2);
+ ap2 = (PyArrayObject *)new;
+ if (new == NULL) goto fail;
+ }
+ NPY_BEGIN_ALLOW_THREADS
+ if (PyArray_ISCONTIGUOUS(ap2)) {
+ Order = CblasRowMajor;
+ lda = (ap2->dimensions[1] > 1 ? ap2->dimensions[1] : 1);
+ }
+ else {
+ Order = CblasColMajor;
+ lda = (ap2->dimensions[0] > 1 ? ap2->dimensions[0] : 1);
+ }
+ if (ap1shape == _row) {
+ ap1s = ap1->strides[1] / ap1->descr->elsize;
+ }
+ else {
+ ap1s = ap1->strides[0] / ap1->descr->elsize;
+ }
+ if (typenum == PyArray_DOUBLE) {
+ cblas_dgemv(Order,
+ CblasTrans, ap2->dimensions[0], ap2->dimensions[1],
+ 1.0, (double *)ap2->data, lda,
+ (double *)ap1->data, ap1s, 0.0, (double *)ret->data, 1);
+ }
+ else if (typenum == PyArray_FLOAT) {
+ cblas_sgemv(Order,
+ CblasTrans, ap2->dimensions[0], ap2->dimensions[1],
+ 1.0, (float *)ap2->data, lda,
+ (float *)ap1->data, ap1s, 0.0, (float *)ret->data, 1);
+ }
+ else if (typenum == PyArray_CDOUBLE) {
+ cblas_zgemv(Order,
+ CblasTrans, ap2->dimensions[0], ap2->dimensions[1],
+ oneD, (double *)ap2->data, lda,
+ (double *)ap1->data, ap1s, zeroD, (double *)ret->data, 1);
+ }
+ else if (typenum == PyArray_CFLOAT) {
+ cblas_cgemv(Order,
+ CblasTrans, ap2->dimensions[0], ap2->dimensions[1],
+ oneF, (float *)ap2->data, lda,
+ (float *)ap1->data, ap1s, zeroF, (float *)ret->data, 1);
+ }
+ NPY_END_ALLOW_THREADS
+ }
+ else { /* (ap1->nd == 2 && ap2->nd == 2) */
+ /* Matrix matrix multiplication -- Level 3 BLAS */
+ /* L x M multiplied by M x N */
+ enum CBLAS_ORDER Order;
+ enum CBLAS_TRANSPOSE Trans1, Trans2;
+ int M, N, L;
+
+ /* Optimization possible: */
+ /* We may be able to handle single-segment arrays here
+ using appropriate values of Order, Trans1, and Trans2.
+ */
+
+ if (!PyArray_ISCONTIGUOUS(ap2)) {
+ PyObject *new;
+ new = PyArray_Copy(ap2);
+ Py_DECREF(ap2);
+ ap2 = (PyArrayObject *)new;
+ if (new == NULL) goto fail;
+ }
+ if (!PyArray_ISCONTIGUOUS(ap1)) {
+ PyObject *new;
+ new = PyArray_Copy(ap1);
+ Py_DECREF(ap1);
+ ap1 = (PyArrayObject *)new;
+ if (new == NULL) goto fail;
+ }
+
+ NPY_BEGIN_ALLOW_THREADS
+
+ Order = CblasRowMajor;
+ Trans1 = CblasNoTrans;
+ Trans2 = CblasNoTrans;
+ L = ap1->dimensions[0];
+ N = ap2->dimensions[1];
+ M = ap2->dimensions[0];
+ lda = (ap1->dimensions[1] > 1 ? ap1->dimensions[1] : 1);
+ ldb = (ap2->dimensions[1] > 1 ? ap2->dimensions[1] : 1);
+ ldc = (ret->dimensions[1] > 1 ? ret->dimensions[1] : 1);
+ if (typenum == PyArray_DOUBLE) {
+ cblas_dgemm(Order, Trans1, Trans2,
+ L, N, M,
+ 1.0, (double *)ap1->data, lda,
+ (double *)ap2->data, ldb,
+ 0.0, (double *)ret->data, ldc);
+ }
+ else if (typenum == PyArray_FLOAT) {
+ cblas_sgemm(Order, Trans1, Trans2,
+ L, N, M,
+ 1.0, (float *)ap1->data, lda,
+ (float *)ap2->data, ldb,
+ 0.0, (float *)ret->data, ldc);
+ }
+ else if (typenum == PyArray_CDOUBLE) {
+ cblas_zgemm(Order, Trans1, Trans2,
+ L, N, M,
+ oneD, (double *)ap1->data, lda,
+ (double *)ap2->data, ldb,
+ zeroD, (double *)ret->data, ldc);
+ }
+ else if (typenum == PyArray_CFLOAT) {
+ cblas_cgemm(Order, Trans1, Trans2,
+ L, N, M,
+ oneF, (float *)ap1->data, lda,
+ (float *)ap2->data, ldb,
+ zeroF, (float *)ret->data, ldc);
+ }
+ NPY_END_ALLOW_THREADS
+ }
+
+
+ Py_DECREF(ap1);
+ Py_DECREF(ap2);
+ return PyArray_Return(ret);
+
+ fail:
+ Py_XDECREF(ap1);
+ Py_XDECREF(ap2);
+ Py_XDECREF(ret);
+ return NULL;
+}
+
+
+static char doc_innerproduct[] = "innerproduct(a,b)\nReturns the inner product of a and b for arrays of floating point types.\nLike the generic NumPy equivalent the product sum is over\nthe last dimension of a and b.\nNB: The first argument is not conjugated.";
+
+static PyObject *
+dotblas_innerproduct(PyObject *dummy, PyObject *args)
+{
+ PyObject *op1, *op2;
+ PyArrayObject *ap1, *ap2, *ret;
+ int j, l, lda, ldb, ldc;
+ int typenum, nd;
+ intp dimensions[MAX_DIMS];
+ static const float oneF[2] = {1.0, 0.0};
+ static const float zeroF[2] = {0.0, 0.0};
+ static const double oneD[2] = {1.0, 0.0};
+ static const double zeroD[2] = {0.0, 0.0};
+ PyTypeObject *subtype;
+ double prior1, prior2;
+
+ if (!PyArg_ParseTuple(args, "OO", &op1, &op2)) return NULL;
+
+ /*
+ * Inner product using the BLAS. The product sum is taken along the last
+ * dimensions of the two arrays.
+ * Only speeds things up for float double and complex types.
+ */
+
+
+ typenum = PyArray_ObjectType(op1, 0);
+ typenum = PyArray_ObjectType(op2, typenum);
+
+ /* This function doesn't handle other types */
+ if ((typenum != PyArray_DOUBLE && typenum != PyArray_CDOUBLE &&
+ typenum != PyArray_FLOAT && typenum != PyArray_CFLOAT)) {
+ return PyArray_Return((PyArrayObject *)PyArray_InnerProduct(op1, op2));
+ }
+
+ ret = NULL;
+ ap1 = (PyArrayObject *)PyArray_ContiguousFromObject(op1, typenum, 0, 0);
+ if (ap1 == NULL) return NULL;
+ ap2 = (PyArrayObject *)PyArray_ContiguousFromObject(op2, typenum, 0, 0);
+ if (ap2 == NULL) goto fail;
+
+ if ((ap1->nd > 2) || (ap2->nd > 2)) {
+ /* This function doesn't handle dimensions greater than 2 -- other
+ than to ensure the dot function is altered
+ */
+ if (!altered) {
+ /* need to alter dot product */
+ PyObject *tmp1, *tmp2;
+ tmp1 = PyTuple_New(0);
+ tmp2 = dotblas_alterdot(NULL, tmp1);
+ Py_DECREF(tmp1);
+ Py_DECREF(tmp2);
+ }
+ ret = (PyArrayObject *)PyArray_InnerProduct((PyObject *)ap1,
+ (PyObject *)ap2);
+ Py_DECREF(ap1);
+ Py_DECREF(ap2);
+ return PyArray_Return(ret);
+ }
+
+ if (ap1->nd == 0 || ap2->nd == 0) {
+ /* One of ap1 or ap2 is a scalar */
+ if (ap1->nd == 0) { /* Make ap2 the scalar */
+ PyArrayObject *t = ap1;
+ ap1 = ap2;
+ ap2 = t;
+ }
+ for (l = 1, j = 0; j < ap1->nd; j++) {
+ dimensions[j] = ap1->dimensions[j];
+ l *= dimensions[j];
+ }
+ nd = ap1->nd;
+ }
+ else { /* (ap1->nd <= 2 && ap2->nd <= 2) */
+ /* Both ap1 and ap2 are vectors or matrices */
+ l = ap1->dimensions[ap1->nd-1];
+
+ if (ap2->dimensions[ap2->nd-1] != l) {
+ PyErr_SetString(PyExc_ValueError, "matrices are not aligned");
+ goto fail;
+ }
+ nd = ap1->nd+ap2->nd-2;
+
+ if (nd == 1)
+ dimensions[0] = (ap1->nd == 2) ? ap1->dimensions[0] : ap2->dimensions[0];
+ else if (nd == 2) {
+ dimensions[0] = ap1->dimensions[0];
+ dimensions[1] = ap2->dimensions[0];
+ }
+ }
+
+ /* Choose which subtype to return */
+ prior2 = PyArray_GetPriority((PyObject *)ap2, 0.0);
+ prior1 = PyArray_GetPriority((PyObject *)ap1, 0.0);
+ subtype = (prior2 > prior1 ? ap2->ob_type : ap1->ob_type);
+
+ ret = (PyArrayObject *)PyArray_New(subtype, nd, dimensions,
+ typenum, NULL, NULL, 0, 0,
+ (PyObject *)\
+ (prior2 > prior1 ? ap2 : ap1));
+
+ if (ret == NULL) goto fail;
+ NPY_BEGIN_ALLOW_THREADS
+ memset(ret->data, 0, PyArray_NBYTES(ret));
+
+ if (ap2->nd == 0) {
+ /* Multiplication by a scalar -- Level 1 BLAS */
+ if (typenum == PyArray_DOUBLE) {
+ cblas_daxpy(l, *((double *)ap2->data), (double *)ap1->data, 1,
+ (double *)ret->data, 1);
+ }
+ else if (typenum == PyArray_CDOUBLE) {
+ cblas_zaxpy(l, (double *)ap2->data, (double *)ap1->data, 1,
+ (double *)ret->data, 1);
+ }
+ else if (typenum == PyArray_FLOAT) {
+ cblas_saxpy(l, *((float *)ap2->data), (float *)ap1->data, 1,
+ (float *)ret->data, 1);
+ }
+ else if (typenum == PyArray_CFLOAT) {
+ cblas_caxpy(l, (float *)ap2->data, (float *)ap1->data, 1,
+ (float *)ret->data, 1);
+ }
+ }
+ else if (ap1->nd == 1 && ap2->nd == 1) {
+ /* Dot product between two vectors -- Level 1 BLAS */
+ if (typenum == PyArray_DOUBLE) {
+ double result = cblas_ddot(l, (double *)ap1->data, 1,
+ (double *)ap2->data, 1);
+ *((double *)ret->data) = result;
+ }
+ else if (typenum == PyArray_CDOUBLE) {
+ cblas_zdotu_sub(l, (double *)ap1->data, 1,
+ (double *)ap2->data, 1, (double *)ret->data);
+ }
+ else if (typenum == PyArray_FLOAT) {
+ float result = cblas_sdot(l, (float *)ap1->data, 1,
+ (float *)ap2->data, 1);
+ *((float *)ret->data) = result;
+ }
+ else if (typenum == PyArray_CFLOAT) {
+ cblas_cdotu_sub(l, (float *)ap1->data, 1,
+ (float *)ap2->data, 1, (float *)ret->data);
+ }
+ }
+ else if (ap1->nd == 2 && ap2->nd == 1) {
+ /* Matrix-vector multiplication -- Level 2 BLAS */
+ lda = (ap1->dimensions[1] > 1 ? ap1->dimensions[1] : 1);
+ if (typenum == PyArray_DOUBLE) {
+ cblas_dgemv(CblasRowMajor,
+ CblasNoTrans, ap1->dimensions[0], ap1->dimensions[1],
+ 1.0, (double *)ap1->data, lda,
+ (double *)ap2->data, 1, 0.0, (double *)ret->data, 1);
+ }
+ else if (typenum == PyArray_CDOUBLE) {
+ cblas_zgemv(CblasRowMajor,
+ CblasNoTrans, ap1->dimensions[0], ap1->dimensions[1],
+ oneD, (double *)ap1->data, lda,
+ (double *)ap2->data, 1, zeroD, (double *)ret->data, 1);
+ }
+ else if (typenum == PyArray_FLOAT) {
+ cblas_sgemv(CblasRowMajor,
+ CblasNoTrans, ap1->dimensions[0], ap1->dimensions[1],
+ 1.0, (float *)ap1->data, lda,
+ (float *)ap2->data, 1, 0.0, (float *)ret->data, 1);
+ }
+ else if (typenum == PyArray_CFLOAT) {
+ cblas_cgemv(CblasRowMajor,
+ CblasNoTrans, ap1->dimensions[0], ap1->dimensions[1],
+ oneF, (float *)ap1->data, lda,
+ (float *)ap2->data, 1, zeroF, (float *)ret->data, 1);
+ }
+ }
+ else if (ap1->nd == 1 && ap2->nd == 2) {
+ /* Vector matrix multiplication -- Level 2 BLAS */
+ lda = (ap2->dimensions[1] > 1 ? ap2->dimensions[1] : 1);
+ if (typenum == PyArray_DOUBLE) {
+ cblas_dgemv(CblasRowMajor,
+ CblasNoTrans, ap2->dimensions[0], ap2->dimensions[1],
+ 1.0, (double *)ap2->data, lda,
+ (double *)ap1->data, 1, 0.0, (double *)ret->data, 1);
+ }
+ else if (typenum == PyArray_CDOUBLE) {
+ cblas_zgemv(CblasRowMajor,
+ CblasNoTrans, ap2->dimensions[0], ap2->dimensions[1],
+ oneD, (double *)ap2->data, lda,
+ (double *)ap1->data, 1, zeroD, (double *)ret->data, 1);
+ }
+ else if (typenum == PyArray_FLOAT) {
+ cblas_sgemv(CblasRowMajor,
+ CblasNoTrans, ap2->dimensions[0], ap2->dimensions[1],
+ 1.0, (float *)ap2->data, lda,
+ (float *)ap1->data, 1, 0.0, (float *)ret->data, 1);
+ }
+ else if (typenum == PyArray_CFLOAT) {
+ cblas_cgemv(CblasRowMajor,
+ CblasNoTrans, ap2->dimensions[0], ap2->dimensions[1],
+ oneF, (float *)ap2->data, lda,
+ (float *)ap1->data, 1, zeroF, (float *)ret->data, 1);
+ }
+ }
+ else { /* (ap1->nd == 2 && ap2->nd == 2) */
+ /* Matrix matrix multiplication -- Level 3 BLAS */
+ lda = (ap1->dimensions[1] > 1 ? ap1->dimensions[1] : 1);
+ ldb = (ap2->dimensions[1] > 1 ? ap2->dimensions[1] : 1);
+ ldc = (ret->dimensions[1] > 1 ? ret->dimensions[1] : 1);
+ if (typenum == PyArray_DOUBLE) {
+ cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasTrans,
+ ap1->dimensions[0], ap2->dimensions[0], ap1->dimensions[1],
+ 1.0, (double *)ap1->data, lda,
+ (double *)ap2->data, ldb,
+ 0.0, (double *)ret->data, ldc);
+ }
+ else if (typenum == PyArray_FLOAT) {
+ cblas_sgemm(CblasRowMajor, CblasNoTrans, CblasTrans,
+ ap1->dimensions[0], ap2->dimensions[0], ap1->dimensions[1],
+ 1.0, (float *)ap1->data, lda,
+ (float *)ap2->data, ldb,
+ 0.0, (float *)ret->data, ldc);
+ }
+ else if (typenum == PyArray_CDOUBLE) {
+ cblas_zgemm(CblasRowMajor, CblasNoTrans, CblasTrans,
+ ap1->dimensions[0], ap2->dimensions[0], ap1->dimensions[1],
+ oneD, (double *)ap1->data, lda,
+ (double *)ap2->data, ldb,
+ zeroD, (double *)ret->data, ldc);
+ }
+ else if (typenum == PyArray_CFLOAT) {
+ cblas_cgemm(CblasRowMajor, CblasNoTrans, CblasTrans,
+ ap1->dimensions[0], ap2->dimensions[0], ap1->dimensions[1],
+ oneF, (float *)ap1->data, lda,
+ (float *)ap2->data, ldb,
+ zeroF, (float *)ret->data, ldc);
+ }
+ }
+ NPY_END_ALLOW_THREADS
+ Py_DECREF(ap1);
+ Py_DECREF(ap2);
+ return PyArray_Return(ret);
+
+ fail:
+ Py_XDECREF(ap1);
+ Py_XDECREF(ap2);
+ Py_XDECREF(ret);
+ return NULL;
+}
+
+
+static char doc_vdot[] = "vdot(a,b)\nReturns the dot product of a and b for scalars and vectors\nof floating point and complex types. The first argument, a, is conjugated.";
+
+
+static PyObject *dotblas_vdot(PyObject *dummy, PyObject *args) {
+ PyObject *op1, *op2;
+ PyArrayObject *ap1=NULL, *ap2=NULL, *ret=NULL;
+ int l;
+ int typenum;
+ intp dimensions[MAX_DIMS];
+ PyArray_Descr *type;
+
+ if (!PyArg_ParseTuple(args, "OO", &op1, &op2)) return NULL;
+
+ /*
+ * Conjugating dot product using the BLAS for vectors.
+ * Multiplies op1 and op2, each of which must be vector.
+ */
+
+ typenum = PyArray_ObjectType(op1, 0);
+ typenum = PyArray_ObjectType(op2, typenum);
+
+ type = PyArray_DescrFromType(typenum);
+ Py_INCREF(type);
+ ap1 = (PyArrayObject *)PyArray_FromAny(op1, type, 0, 0, 0, NULL);
+ if (ap1==NULL) {Py_DECREF(type); goto fail;}
+ op1 = PyArray_Flatten(ap1, 0);
+ if (op1==NULL) {Py_DECREF(type); goto fail;}
+ Py_DECREF(ap1);
+ ap1 = (PyArrayObject *)op1;
+
+ ap2 = (PyArrayObject *)PyArray_FromAny(op2, type, 0, 0, 0, NULL);
+ if (ap2==NULL) goto fail;
+ op2 = PyArray_Flatten(ap2, 0);
+ if (op2 == NULL) goto fail;
+ Py_DECREF(ap2);
+ ap2 = (PyArrayObject *)op2;
+
+ if (typenum != PyArray_FLOAT && typenum != PyArray_DOUBLE &&
+ typenum != PyArray_CFLOAT && typenum != PyArray_CDOUBLE) {
+ if (!altered) {
+ /* need to alter dot product */
+ PyObject *tmp1, *tmp2;
+ tmp1 = PyTuple_New(0);
+ tmp2 = dotblas_alterdot(NULL, tmp1);
+ Py_DECREF(tmp1);
+ Py_DECREF(tmp2);
+ }
+ if (PyTypeNum_ISCOMPLEX(typenum)) {
+ op1 = PyArray_Conjugate(ap1, NULL);
+ if (op1==NULL) goto fail;
+ Py_DECREF(ap1);
+ ap1 = (PyArrayObject *)op1;
+ }
+ ret = (PyArrayObject *)PyArray_InnerProduct((PyObject *)ap1,
+ (PyObject *)ap2);
+ Py_DECREF(ap1);
+ Py_DECREF(ap2);
+ return PyArray_Return(ret);
+ }
+
+ if (ap2->dimensions[0] != ap1->dimensions[ap1->nd-1]) {
+ PyErr_SetString(PyExc_ValueError, "vectors have different lengths");
+ goto fail;
+ }
+ l = ap1->dimensions[ap1->nd-1];
+
+ ret = (PyArrayObject *)PyArray_SimpleNew(0, dimensions, typenum);
+ if (ret == NULL) goto fail;
+
+ NPY_BEGIN_ALLOW_THREADS
+
+ /* Dot product between two vectors -- Level 1 BLAS */
+ if (typenum == PyArray_DOUBLE) {
+ *((double *)ret->data) = cblas_ddot(l, (double *)ap1->data, 1,
+ (double *)ap2->data, 1);
+ }
+ else if (typenum == PyArray_FLOAT) {
+ *((float *)ret->data) = cblas_sdot(l, (float *)ap1->data, 1,
+ (float *)ap2->data, 1);
+ }
+ else if (typenum == PyArray_CDOUBLE) {
+ cblas_zdotc_sub(l, (double *)ap1->data, 1,
+ (double *)ap2->data, 1, (double *)ret->data);
+ }
+ else if (typenum == PyArray_CFLOAT) {
+ cblas_cdotc_sub(l, (float *)ap1->data, 1,
+ (float *)ap2->data, 1, (float *)ret->data);
+ }
+
+ NPY_END_ALLOW_THREADS
+
+ Py_DECREF(ap1);
+ Py_DECREF(ap2);
+ return PyArray_Return(ret);
+
+ fail:
+ Py_XDECREF(ap1);
+ Py_XDECREF(ap2);
+ Py_XDECREF(ret);
+ return NULL;
+}
+
+static struct PyMethodDef dotblas_module_methods[] = {
+ {"dot", (PyCFunction)dotblas_matrixproduct, 1, doc_matrixproduct},
+ {"inner", (PyCFunction)dotblas_innerproduct, 1, doc_innerproduct},
+ {"vdot", (PyCFunction)dotblas_vdot, 1, doc_vdot},
+ {"alterdot", (PyCFunction)dotblas_alterdot, 1, doc_alterdot},
+ {"restoredot", (PyCFunction)dotblas_restoredot, 1, doc_restoredot},
+ {NULL, NULL, 0} /* sentinel */
+};
+
+/* Initialization function for the module */
+PyMODINIT_FUNC init_dotblas(void) {
+ int i;
+ PyObject *d, *s;
+
+ /* Create the module and add the functions */
+ Py_InitModule3("_dotblas", dotblas_module_methods, module_doc);
+
+ /* Import the array object */
+ import_array();
+
+ /* Initialise the array of dot functions */
+ for (i = 0; i < PyArray_NTYPES; i++)
+ oldFunctions[i] = NULL;
+
+ /* alterdot at load */
+ d = PyTuple_New(0);
+ s = dotblas_alterdot(NULL, d);
+ Py_DECREF(d);
+ Py_DECREF(s);
+
+}
diff --git a/numpy/core/blasdot/cblas.h b/numpy/core/blasdot/cblas.h
new file mode 100644
index 000000000..25de09edf
--- /dev/null
+++ b/numpy/core/blasdot/cblas.h
@@ -0,0 +1,578 @@
+#ifndef CBLAS_H
+#define CBLAS_H
+#include <stddef.h>
+
+/* Allow the use in C++ code. */
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+
+/*
+ * Enumerated and derived types
+ */
+#define CBLAS_INDEX size_t /* this may vary between platforms */
+
+enum CBLAS_ORDER {CblasRowMajor=101, CblasColMajor=102};
+enum CBLAS_TRANSPOSE {CblasNoTrans=111, CblasTrans=112, CblasConjTrans=113};
+enum CBLAS_UPLO {CblasUpper=121, CblasLower=122};
+enum CBLAS_DIAG {CblasNonUnit=131, CblasUnit=132};
+enum CBLAS_SIDE {CblasLeft=141, CblasRight=142};
+
+/*
+ * ===========================================================================
+ * Prototypes for level 1 BLAS functions (complex are recast as routines)
+ * ===========================================================================
+ */
+float cblas_sdsdot(const int N, const float alpha, const float *X,
+ const int incX, const float *Y, const int incY);
+double cblas_dsdot(const int N, const float *X, const int incX, const float *Y,
+ const int incY);
+float cblas_sdot(const int N, const float *X, const int incX,
+ const float *Y, const int incY);
+double cblas_ddot(const int N, const double *X, const int incX,
+ const double *Y, const int incY);
+
+/*
+ * Functions having prefixes Z and C only
+ */
+void cblas_cdotu_sub(const int N, const void *X, const int incX,
+ const void *Y, const int incY, void *dotu);
+void cblas_cdotc_sub(const int N, const void *X, const int incX,
+ const void *Y, const int incY, void *dotc);
+
+void cblas_zdotu_sub(const int N, const void *X, const int incX,
+ const void *Y, const int incY, void *dotu);
+void cblas_zdotc_sub(const int N, const void *X, const int incX,
+ const void *Y, const int incY, void *dotc);
+
+
+/*
+ * Functions having prefixes S D SC DZ
+ */
+float cblas_snrm2(const int N, const float *X, const int incX);
+float cblas_sasum(const int N, const float *X, const int incX);
+
+double cblas_dnrm2(const int N, const double *X, const int incX);
+double cblas_dasum(const int N, const double *X, const int incX);
+
+float cblas_scnrm2(const int N, const void *X, const int incX);
+float cblas_scasum(const int N, const void *X, const int incX);
+
+double cblas_dznrm2(const int N, const void *X, const int incX);
+double cblas_dzasum(const int N, const void *X, const int incX);
+
+
+/*
+ * Functions having standard 4 prefixes (S D C Z)
+ */
+CBLAS_INDEX cblas_isamax(const int N, const float *X, const int incX);
+CBLAS_INDEX cblas_idamax(const int N, const double *X, const int incX);
+CBLAS_INDEX cblas_icamax(const int N, const void *X, const int incX);
+CBLAS_INDEX cblas_izamax(const int N, const void *X, const int incX);
+
+/*
+ * ===========================================================================
+ * Prototypes for level 1 BLAS routines
+ * ===========================================================================
+ */
+
+/*
+ * Routines with standard 4 prefixes (s, d, c, z)
+ */
+void cblas_sswap(const int N, float *X, const int incX,
+ float *Y, const int incY);
+void cblas_scopy(const int N, const float *X, const int incX,
+ float *Y, const int incY);
+void cblas_saxpy(const int N, const float alpha, const float *X,
+ const int incX, float *Y, const int incY);
+
+void cblas_dswap(const int N, double *X, const int incX,
+ double *Y, const int incY);
+void cblas_dcopy(const int N, const double *X, const int incX,
+ double *Y, const int incY);
+void cblas_daxpy(const int N, const double alpha, const double *X,
+ const int incX, double *Y, const int incY);
+
+void cblas_cswap(const int N, void *X, const int incX,
+ void *Y, const int incY);
+void cblas_ccopy(const int N, const void *X, const int incX,
+ void *Y, const int incY);
+void cblas_caxpy(const int N, const void *alpha, const void *X,
+ const int incX, void *Y, const int incY);
+
+void cblas_zswap(const int N, void *X, const int incX,
+ void *Y, const int incY);
+void cblas_zcopy(const int N, const void *X, const int incX,
+ void *Y, const int incY);
+void cblas_zaxpy(const int N, const void *alpha, const void *X,
+ const int incX, void *Y, const int incY);
+
+
+/*
+ * Routines with S and D prefix only
+ */
+void cblas_srotg(float *a, float *b, float *c, float *s);
+void cblas_srotmg(float *d1, float *d2, float *b1, const float b2, float *P);
+void cblas_srot(const int N, float *X, const int incX,
+ float *Y, const int incY, const float c, const float s);
+void cblas_srotm(const int N, float *X, const int incX,
+ float *Y, const int incY, const float *P);
+
+void cblas_drotg(double *a, double *b, double *c, double *s);
+void cblas_drotmg(double *d1, double *d2, double *b1, const double b2, double *P);
+void cblas_drot(const int N, double *X, const int incX,
+ double *Y, const int incY, const double c, const double s);
+void cblas_drotm(const int N, double *X, const int incX,
+ double *Y, const int incY, const double *P);
+
+
+/*
+ * Routines with S D C Z CS and ZD prefixes
+ */
+void cblas_sscal(const int N, const float alpha, float *X, const int incX);
+void cblas_dscal(const int N, const double alpha, double *X, const int incX);
+void cblas_cscal(const int N, const void *alpha, void *X, const int incX);
+void cblas_zscal(const int N, const void *alpha, void *X, const int incX);
+void cblas_csscal(const int N, const float alpha, void *X, const int incX);
+void cblas_zdscal(const int N, const double alpha, void *X, const int incX);
+
+/*
+ * ===========================================================================
+ * Prototypes for level 2 BLAS
+ * ===========================================================================
+ */
+
+/*
+ * Routines with standard 4 prefixes (S, D, C, Z)
+ */
+void cblas_sgemv(const enum CBLAS_ORDER order,
+ const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
+ const float alpha, const float *A, const int lda,
+ const float *X, const int incX, const float beta,
+ float *Y, const int incY);
+void cblas_sgbmv(const enum CBLAS_ORDER order,
+ const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
+ const int KL, const int KU, const float alpha,
+ const float *A, const int lda, const float *X,
+ const int incX, const float beta, float *Y, const int incY);
+void cblas_strmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const float *A, const int lda,
+ float *X, const int incX);
+void cblas_stbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const int K, const float *A, const int lda,
+ float *X, const int incX);
+void cblas_stpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const float *Ap, float *X, const int incX);
+void cblas_strsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const float *A, const int lda, float *X,
+ const int incX);
+void cblas_stbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const int K, const float *A, const int lda,
+ float *X, const int incX);
+void cblas_stpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const float *Ap, float *X, const int incX);
+
+void cblas_dgemv(const enum CBLAS_ORDER order,
+ const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
+ const double alpha, const double *A, const int lda,
+ const double *X, const int incX, const double beta,
+ double *Y, const int incY);
+void cblas_dgbmv(const enum CBLAS_ORDER order,
+ const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
+ const int KL, const int KU, const double alpha,
+ const double *A, const int lda, const double *X,
+ const int incX, const double beta, double *Y, const int incY);
+void cblas_dtrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const double *A, const int lda,
+ double *X, const int incX);
+void cblas_dtbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const int K, const double *A, const int lda,
+ double *X, const int incX);
+void cblas_dtpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const double *Ap, double *X, const int incX);
+void cblas_dtrsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const double *A, const int lda, double *X,
+ const int incX);
+void cblas_dtbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const int K, const double *A, const int lda,
+ double *X, const int incX);
+void cblas_dtpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const double *Ap, double *X, const int incX);
+
+void cblas_cgemv(const enum CBLAS_ORDER order,
+ const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ const void *X, const int incX, const void *beta,
+ void *Y, const int incY);
+void cblas_cgbmv(const enum CBLAS_ORDER order,
+ const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
+ const int KL, const int KU, const void *alpha,
+ const void *A, const int lda, const void *X,
+ const int incX, const void *beta, void *Y, const int incY);
+void cblas_ctrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const void *A, const int lda,
+ void *X, const int incX);
+void cblas_ctbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const int K, const void *A, const int lda,
+ void *X, const int incX);
+void cblas_ctpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const void *Ap, void *X, const int incX);
+void cblas_ctrsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const void *A, const int lda, void *X,
+ const int incX);
+void cblas_ctbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const int K, const void *A, const int lda,
+ void *X, const int incX);
+void cblas_ctpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const void *Ap, void *X, const int incX);
+
+void cblas_zgemv(const enum CBLAS_ORDER order,
+ const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ const void *X, const int incX, const void *beta,
+ void *Y, const int incY);
+void cblas_zgbmv(const enum CBLAS_ORDER order,
+ const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
+ const int KL, const int KU, const void *alpha,
+ const void *A, const int lda, const void *X,
+ const int incX, const void *beta, void *Y, const int incY);
+void cblas_ztrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const void *A, const int lda,
+ void *X, const int incX);
+void cblas_ztbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const int K, const void *A, const int lda,
+ void *X, const int incX);
+void cblas_ztpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const void *Ap, void *X, const int incX);
+void cblas_ztrsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const void *A, const int lda, void *X,
+ const int incX);
+void cblas_ztbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const int K, const void *A, const int lda,
+ void *X, const int incX);
+void cblas_ztpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
+ const int N, const void *Ap, void *X, const int incX);
+
+
+/*
+ * Routines with S and D prefixes only
+ */
+void cblas_ssymv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const float alpha, const float *A,
+ const int lda, const float *X, const int incX,
+ const float beta, float *Y, const int incY);
+void cblas_ssbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const int K, const float alpha, const float *A,
+ const int lda, const float *X, const int incX,
+ const float beta, float *Y, const int incY);
+void cblas_sspmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const float alpha, const float *Ap,
+ const float *X, const int incX,
+ const float beta, float *Y, const int incY);
+void cblas_sger(const enum CBLAS_ORDER order, const int M, const int N,
+ const float alpha, const float *X, const int incX,
+ const float *Y, const int incY, float *A, const int lda);
+void cblas_ssyr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const float alpha, const float *X,
+ const int incX, float *A, const int lda);
+void cblas_sspr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const float alpha, const float *X,
+ const int incX, float *Ap);
+void cblas_ssyr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const float alpha, const float *X,
+ const int incX, const float *Y, const int incY, float *A,
+ const int lda);
+void cblas_sspr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const float alpha, const float *X,
+ const int incX, const float *Y, const int incY, float *A);
+
+void cblas_dsymv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const double alpha, const double *A,
+ const int lda, const double *X, const int incX,
+ const double beta, double *Y, const int incY);
+void cblas_dsbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const int K, const double alpha, const double *A,
+ const int lda, const double *X, const int incX,
+ const double beta, double *Y, const int incY);
+void cblas_dspmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const double alpha, const double *Ap,
+ const double *X, const int incX,
+ const double beta, double *Y, const int incY);
+void cblas_dger(const enum CBLAS_ORDER order, const int M, const int N,
+ const double alpha, const double *X, const int incX,
+ const double *Y, const int incY, double *A, const int lda);
+void cblas_dsyr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const double alpha, const double *X,
+ const int incX, double *A, const int lda);
+void cblas_dspr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const double alpha, const double *X,
+ const int incX, double *Ap);
+void cblas_dsyr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const double alpha, const double *X,
+ const int incX, const double *Y, const int incY, double *A,
+ const int lda);
+void cblas_dspr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const double alpha, const double *X,
+ const int incX, const double *Y, const int incY, double *A);
+
+
+/*
+ * Routines with C and Z prefixes only
+ */
+void cblas_chemv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const void *alpha, const void *A,
+ const int lda, const void *X, const int incX,
+ const void *beta, void *Y, const int incY);
+void cblas_chbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const int K, const void *alpha, const void *A,
+ const int lda, const void *X, const int incX,
+ const void *beta, void *Y, const int incY);
+void cblas_chpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const void *alpha, const void *Ap,
+ const void *X, const int incX,
+ const void *beta, void *Y, const int incY);
+void cblas_cgeru(const enum CBLAS_ORDER order, const int M, const int N,
+ const void *alpha, const void *X, const int incX,
+ const void *Y, const int incY, void *A, const int lda);
+void cblas_cgerc(const enum CBLAS_ORDER order, const int M, const int N,
+ const void *alpha, const void *X, const int incX,
+ const void *Y, const int incY, void *A, const int lda);
+void cblas_cher(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const float alpha, const void *X, const int incX,
+ void *A, const int lda);
+void cblas_chpr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const float alpha, const void *X,
+ const int incX, void *A);
+void cblas_cher2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N,
+ const void *alpha, const void *X, const int incX,
+ const void *Y, const int incY, void *A, const int lda);
+void cblas_chpr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N,
+ const void *alpha, const void *X, const int incX,
+ const void *Y, const int incY, void *Ap);
+
+void cblas_zhemv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const void *alpha, const void *A,
+ const int lda, const void *X, const int incX,
+ const void *beta, void *Y, const int incY);
+void cblas_zhbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const int K, const void *alpha, const void *A,
+ const int lda, const void *X, const int incX,
+ const void *beta, void *Y, const int incY);
+void cblas_zhpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const void *alpha, const void *Ap,
+ const void *X, const int incX,
+ const void *beta, void *Y, const int incY);
+void cblas_zgeru(const enum CBLAS_ORDER order, const int M, const int N,
+ const void *alpha, const void *X, const int incX,
+ const void *Y, const int incY, void *A, const int lda);
+void cblas_zgerc(const enum CBLAS_ORDER order, const int M, const int N,
+ const void *alpha, const void *X, const int incX,
+ const void *Y, const int incY, void *A, const int lda);
+void cblas_zher(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const double alpha, const void *X, const int incX,
+ void *A, const int lda);
+void cblas_zhpr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
+ const int N, const double alpha, const void *X,
+ const int incX, void *A);
+void cblas_zher2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N,
+ const void *alpha, const void *X, const int incX,
+ const void *Y, const int incY, void *A, const int lda);
+void cblas_zhpr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, const int N,
+ const void *alpha, const void *X, const int incX,
+ const void *Y, const int incY, void *Ap);
+
+/*
+ * ===========================================================================
+ * Prototypes for level 3 BLAS
+ * ===========================================================================
+ */
+
+/*
+ * Routines with standard 4 prefixes (S, D, C, Z)
+ */
+void cblas_sgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
+ const int K, const float alpha, const float *A,
+ const int lda, const float *B, const int ldb,
+ const float beta, float *C, const int ldc);
+void cblas_ssymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const int M, const int N,
+ const float alpha, const float *A, const int lda,
+ const float *B, const int ldb, const float beta,
+ float *C, const int ldc);
+void cblas_ssyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const float alpha, const float *A, const int lda,
+ const float beta, float *C, const int ldc);
+void cblas_ssyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const float alpha, const float *A, const int lda,
+ const float *B, const int ldb, const float beta,
+ float *C, const int ldc);
+void cblas_strmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_DIAG Diag, const int M, const int N,
+ const float alpha, const float *A, const int lda,
+ float *B, const int ldb);
+void cblas_strsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_DIAG Diag, const int M, const int N,
+ const float alpha, const float *A, const int lda,
+ float *B, const int ldb);
+
+void cblas_dgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
+ const int K, const double alpha, const double *A,
+ const int lda, const double *B, const int ldb,
+ const double beta, double *C, const int ldc);
+void cblas_dsymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const int M, const int N,
+ const double alpha, const double *A, const int lda,
+ const double *B, const int ldb, const double beta,
+ double *C, const int ldc);
+void cblas_dsyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const double alpha, const double *A, const int lda,
+ const double beta, double *C, const int ldc);
+void cblas_dsyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const double alpha, const double *A, const int lda,
+ const double *B, const int ldb, const double beta,
+ double *C, const int ldc);
+void cblas_dtrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_DIAG Diag, const int M, const int N,
+ const double alpha, const double *A, const int lda,
+ double *B, const int ldb);
+void cblas_dtrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_DIAG Diag, const int M, const int N,
+ const double alpha, const double *A, const int lda,
+ double *B, const int ldb);
+
+void cblas_cgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
+ const int K, const void *alpha, const void *A,
+ const int lda, const void *B, const int ldb,
+ const void *beta, void *C, const int ldc);
+void cblas_csymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ const void *B, const int ldb, const void *beta,
+ void *C, const int ldc);
+void cblas_csyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const void *alpha, const void *A, const int lda,
+ const void *beta, void *C, const int ldc);
+void cblas_csyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const void *alpha, const void *A, const int lda,
+ const void *B, const int ldb, const void *beta,
+ void *C, const int ldc);
+void cblas_ctrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_DIAG Diag, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ void *B, const int ldb);
+void cblas_ctrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_DIAG Diag, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ void *B, const int ldb);
+
+void cblas_zgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
+ const int K, const void *alpha, const void *A,
+ const int lda, const void *B, const int ldb,
+ const void *beta, void *C, const int ldc);
+void cblas_zsymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ const void *B, const int ldb, const void *beta,
+ void *C, const int ldc);
+void cblas_zsyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const void *alpha, const void *A, const int lda,
+ const void *beta, void *C, const int ldc);
+void cblas_zsyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const void *alpha, const void *A, const int lda,
+ const void *B, const int ldb, const void *beta,
+ void *C, const int ldc);
+void cblas_ztrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_DIAG Diag, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ void *B, const int ldb);
+void cblas_ztrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
+ const enum CBLAS_DIAG Diag, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ void *B, const int ldb);
+
+
+/*
+ * Routines with prefixes C and Z only
+ */
+void cblas_chemm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ const void *B, const int ldb, const void *beta,
+ void *C, const int ldc);
+void cblas_cherk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const float alpha, const void *A, const int lda,
+ const float beta, void *C, const int ldc);
+void cblas_cher2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const void *alpha, const void *A, const int lda,
+ const void *B, const int ldb, const float beta,
+ void *C, const int ldc);
+
+void cblas_zhemm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
+ const enum CBLAS_UPLO Uplo, const int M, const int N,
+ const void *alpha, const void *A, const int lda,
+ const void *B, const int ldb, const void *beta,
+ void *C, const int ldc);
+void cblas_zherk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const double alpha, const void *A, const int lda,
+ const double beta, void *C, const int ldc);
+void cblas_zher2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
+ const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
+ const void *alpha, const void *A, const int lda,
+ const void *B, const int ldb, const double beta,
+ void *C, const int ldc);
+
+void cblas_xerbla(int p, const char *rout, const char *form, ...);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif
diff --git a/numpy/core/code_generators/array_api_order.txt b/numpy/core/code_generators/array_api_order.txt
new file mode 100644
index 000000000..858b89684
--- /dev/null
+++ b/numpy/core/code_generators/array_api_order.txt
@@ -0,0 +1,85 @@
+# The functions in the numpy_core C API
+# They are defined here so that the order is set.
+PyArray_SetNumericOps
+PyArray_GetNumericOps
+PyArray_INCREF
+PyArray_XDECREF
+PyArray_SetStringFunction
+PyArray_DescrFromType
+PyArray_TypeObjectFromType
+PyArray_Zero
+PyArray_One
+PyArray_CastToType
+PyArray_CastTo
+PyArray_CastAnyTo
+PyArray_CanCastSafely
+PyArray_CanCastTo
+PyArray_ObjectType
+PyArray_DescrFromObject
+PyArray_ConvertToCommonType
+PyArray_DescrFromScalar
+PyArray_DescrFromTypeObject
+PyArray_Size
+PyArray_Scalar
+PyArray_FromScalar
+PyArray_ScalarAsCtype
+PyArray_CastScalarToCtype
+PyArray_CastScalarDirect
+PyArray_ScalarFromObject
+PyArray_GetCastFunc
+PyArray_FromDims
+PyArray_FromDimsAndDataAndDescr
+PyArray_FromAny
+PyArray_EnsureArray
+PyArray_EnsureAnyArray
+PyArray_FromFile
+PyArray_FromString
+PyArray_FromBuffer
+PyArray_FromIter
+PyArray_Return
+PyArray_GetField
+PyArray_SetField
+PyArray_Byteswap
+PyArray_Resize
+PyArray_MoveInto
+PyArray_CopyInto
+PyArray_CopyAnyInto
+PyArray_CopyObject
+PyArray_NewCopy
+PyArray_ToList
+PyArray_ToString
+PyArray_ToFile
+PyArray_Dump
+PyArray_Dumps
+PyArray_ValidType
+PyArray_UpdateFlags
+PyArray_New
+PyArray_NewFromDescr
+PyArray_DescrNew
+PyArray_DescrNewFromType
+PyArray_GetPriority
+PyArray_IterNew
+PyArray_MultiIterNew
+PyArray_PyIntAsInt
+PyArray_PyIntAsIntp
+PyArray_Broadcast
+PyArray_FillObjectArray
+PyArray_FillWithScalar
+PyArray_CheckStrides
+PyArray_DescrNewByteorder
+PyArray_IterAllButAxis
+PyArray_CheckFromAny
+PyArray_FromArray
+PyArray_FromInterface
+PyArray_FromStructInterface
+PyArray_FromArrayAttr
+PyArray_ScalarKind
+PyArray_CanCoerceScalar
+PyArray_NewFlagsObject
+PyArray_CanCastScalar
+PyArray_CompareUCS4
+PyArray_RemoveSmallest
+PyArray_ElementStrides
+PyArray_Item_INCREF
+PyArray_Item_XDECREF
+PyArray_FieldNames
diff --git a/numpy/core/code_generators/genapi.py b/numpy/core/code_generators/genapi.py
new file mode 100644
index 000000000..6c57b6de0
--- /dev/null
+++ b/numpy/core/code_generators/genapi.py
@@ -0,0 +1,295 @@
+"""
+Get API information encoded in C files.
+
+See ``find_function`` for how functions should be formatted, and
+``read_order`` for how the order of the functions should be
+specified.
+"""
+import sys, os, re
+import md5
+import textwrap
+
+__docformat__ = 'restructuredtext'
+
+# The files under src/ that are scanned for API functions
+API_FILES = ['arraymethods.c',
+ 'arrayobject.c',
+ 'arraytypes.inc.src',
+ 'multiarraymodule.c',
+ 'scalartypes.inc.src',
+ 'ufuncobject.c',
+ ]
+THIS_DIR = os.path.dirname(__file__)
+API_FILES = [os.path.join(THIS_DIR, '..', 'src', a) for a in API_FILES]
+
+def file_in_this_dir(filename):
+ return os.path.join(THIS_DIR, filename)
+
+def remove_whitespace(s):
+ return ''.join(s.split())
+
+def _repl(str):
+ return str.replace('intp', 'npy_intp').replace('Bool','npy_bool')
+
+class Function(object):
+ def __init__(self, name, return_type, args, doc=''):
+ self.name = name
+ self.return_type = _repl(return_type)
+ self.args = args
+ self.doc = doc
+
+ def _format_arg(self, (typename, name)):
+ if typename.endswith('*'):
+ return typename + name
+ else:
+ return typename + ' ' + name
+
+ def argtypes_string(self):
+ if not self.args:
+ return 'void'
+ argstr = ', '.join([_repl(a[0]) for a in self.args])
+ return argstr
+
+ def __str__(self):
+ argstr = ', '.join([self._format_arg(a) for a in self.args])
+ if self.doc:
+ doccomment = '/* %s */\n' % self.doc
+ else:
+ doccomment = ''
+ return '%s%s %s(%s)' % (doccomment, self.return_type, self.name, argstr)
+
+ def to_ReST(self):
+ lines = ['::', '', ' ' + self.return_type]
+ argstr = ',\000'.join([self._format_arg(a) for a in self.args])
+ name = ' %s' % (self.name,)
+ s = textwrap.wrap('(%s)' % (argstr,), width=72,
+ initial_indent=name,
+ subsequent_indent=' ' * (len(name)+1),
+ break_long_words=False)
+ for l in s:
+ lines.append(l.replace('\000', ' ').rstrip())
+ lines.append('')
+ if self.doc:
+ lines.append(textwrap.dedent(self.doc))
+ return '\n'.join(lines)
+
+ def api_hash(self):
+ m = md5.new()
+ m.update(remove_whitespace(self.return_type))
+ m.update('\000')
+ m.update(self.name)
+ m.update('\000')
+ for typename, name in self.args:
+ m.update(remove_whitespace(typename))
+ m.update('\000')
+ return m.hexdigest()[:8]
+
+class ParseError(Exception):
+ def __init__(self, filename, lineno, msg):
+ self.filename = filename
+ self.lineno = lineno
+ self.msg = msg
+
+ def __str__(self):
+ return '%s:%s:%s' % (self.filename, self.lineno, self.msg)
+
+def skip_brackets(s, lbrac, rbrac):
+ count = 0
+ for i, c in enumerate(s):
+ if c == lbrac:
+ count += 1
+ elif c == rbrac:
+ count -= 1
+ if count == 0:
+ return i
+ raise ValueError("no match '%s' for '%s' (%r)" % (lbrac, rbrac, s))
+
+def split_arguments(argstr):
+ arguments = []
+ bracket_counts = {'(': 0, '[': 0}
+ current_argument = []
+ state = 0
+ i = 0
+ def finish_arg():
+ if current_argument:
+ argstr = ''.join(current_argument).strip()
+ m = re.match(r'(.*(\s+|[*]))(\w+)$', argstr)
+ if m:
+ typename = m.group(1).strip()
+ name = m.group(3)
+ else:
+ typename = argstr
+ name = ''
+ arguments.append((typename, name))
+ del current_argument[:]
+ while i < len(argstr):
+ c = argstr[i]
+ if c == ',':
+ finish_arg()
+ elif c == '(':
+ p = skip_brackets(argstr[i:], '(', ')')
+ current_argument += argstr[i:i+p]
+ i += p-1
+ else:
+ current_argument += c
+ i += 1
+ finish_arg()
+ return arguments
+
+
+def find_functions(filename, tag='API'):
+ """
+ Scan the file, looking for tagged functions.
+
+ Assuming ``tag=='API'``, a tagged function looks like::
+
+ /*API*/
+ static returntype*
+ function_name(argtype1 arg1, argtype2 arg2)
+ {
+ }
+
+ where the return type must be on a separate line, the function
+ name must start the line, and the opening ``{`` must start the line.
+
+ An optional documentation comment in ReST format may follow the tag,
+ as in::
+
+ /*API
+ This function does foo...
+ */
+ """
+ fo = open(filename, 'r')
+ functions = []
+ return_type = None
+ function_name = None
+ function_args = []
+ doclist = []
+ SCANNING, STATE_DOC, STATE_RETTYPE, STATE_NAME, STATE_ARGS = range(5)
+ state = SCANNING
+ tagcomment = '/*' + tag
+ for lineno, line in enumerate(fo):
+ try:
+ line = line.strip()
+ if state == SCANNING:
+ if line.startswith(tagcomment):
+ if line.endswith('*/'):
+ state = STATE_RETTYPE
+ else:
+ state = STATE_DOC
+ elif state == STATE_DOC:
+ if line.startswith('*/'):
+ state = STATE_RETTYPE
+ else:
+ line = line.lstrip(' *')
+ doclist.append(line)
+ elif state == STATE_RETTYPE:
+ # first line of declaration with return type
+ m = re.match(r'static\s+(.*)$', line)
+ if m:
+ line = m.group(1)
+ return_type = line
+ state = STATE_NAME
+ elif state == STATE_NAME:
+ # second line, with function name
+ m = re.match(r'(\w+)\s*\(', line)
+ if m:
+ function_name = m.group(1)
+ else:
+ raise ParseError(filename, lineno+1,
+ 'could not find function name')
+ function_args.append(line[m.end():])
+ state = STATE_ARGS
+ elif state == STATE_ARGS:
+ if line.startswith('{'):
+ # finished
+ fargs_str = ' '.join(function_args).rstrip(' )')
+ fargs = split_arguments(fargs_str)
+ f = Function(function_name, return_type, fargs,
+ '\n'.join(doclist))
+ functions.append(f)
+ return_type = None
+ function_name = None
+ function_args = []
+ doclist = []
+ state = SCANNING
+ else:
+ function_args.append(line)
+ except:
+ print filename, lineno+1
+ raise
+ fo.close()
+ return functions
+
+def read_order(order_file):
+ """
+ Read the order of the API functions from a file.
+
+ Comments can be put on lines starting with #
+ """
+ fo = open(order_file, 'r')
+ order = {}
+ i = 0
+ for line in fo:
+ line = line.strip()
+ if not line.startswith('#'):
+ order[line] = i
+ i += 1
+ fo.close()
+ return order
+
+def get_api_functions(tagname, order_file):
+ if not os.path.exists(order_file):
+ order_file = file_in_this_dir(order_file)
+ order = read_order(order_file)
+ functions = []
+ for f in API_FILES:
+ functions.extend(find_functions(f, tagname))
+ dfunctions = []
+ for func in functions:
+ o = order[func.name]
+ dfunctions.append( (o, func) )
+ dfunctions.sort()
+ return [a[1] for a in dfunctions]
+
+def add_api_list(offset, APIname, api_list,
+ module_list, extension_list, init_list):
+ """Add the API function declarations to the appropiate lists for use in
+ the headers.
+ """
+ for k, func in enumerate(api_list):
+ num = offset + k
+ astr = "static %s %s \\\n (%s);" % \
+ (func.return_type, func.name, func.argtypes_string())
+ module_list.append(astr)
+ astr = "#define %s \\\n (*(%s (*)(%s)) \\\n"\
+ " %s[%d])" % (func.name,func.return_type,
+ func.argtypes_string(), APIname, num)
+ extension_list.append(astr)
+ astr = " (void *) %s," % func.name
+ init_list.append(astr)
+
+def should_rebuild(targets, source_files):
+ from distutils.dep_util import newer_group
+ for t in targets:
+ if not os.path.exists(t):
+ return True
+ sources = API_FILES + list(source_files) + [__file__]
+ if newer_group(sources, targets[0], missing='newer'):
+ return True
+ return False
+
+def main():
+ tagname = sys.argv[1]
+ order_file = sys.argv[2]
+ functions = get_api_functions(tagname, order_file)
+ m = md5.new(tagname)
+ for func in functions:
+ print func
+ ah = func.api_hash()
+ m.update(ah)
+ print hex(int(ah,16))
+ print hex(int(m.hexdigest()[:8],16))
+
+if __name__ == '__main__':
+ main()
diff --git a/numpy/core/code_generators/generate_array_api.py b/numpy/core/code_generators/generate_array_api.py
new file mode 100644
index 000000000..c6f73c33f
--- /dev/null
+++ b/numpy/core/code_generators/generate_array_api.py
@@ -0,0 +1,208 @@
+import os
+import genapi
+
+OBJECT_API_ORDER = 'array_api_order.txt'
+MULTIARRAY_API_ORDER = 'multiarray_api_order.txt'
+
+types = ['Generic','Number','Integer','SignedInteger','UnsignedInteger',
+ 'Inexact',
+ 'Floating', 'ComplexFloating', 'Flexible', 'Character',
+ 'Byte','Short','Int', 'Long', 'LongLong', 'UByte', 'UShort',
+ 'UInt', 'ULong', 'ULongLong', 'Float', 'Double', 'LongDouble',
+ 'CFloat', 'CDouble', 'CLongDouble', 'Object', 'String', 'Unicode',
+ 'Void']
+
+h_template = r"""
+#ifdef _MULTIARRAYMODULE
+
+typedef struct {
+ PyObject_HEAD
+ npy_bool obval;
+} PyBoolScalarObject;
+
+
+static unsigned int PyArray_GetNDArrayCVersion (void);
+static PyTypeObject PyBigArray_Type;
+static PyTypeObject PyArray_Type;
+static PyTypeObject PyArrayDescr_Type;
+static PyTypeObject PyArrayFlags_Type;
+static PyTypeObject PyArrayIter_Type;
+static PyTypeObject PyArrayMapIter_Type;
+static PyTypeObject PyArrayMultiIter_Type;
+static int NPY_NUMUSERTYPES=0;
+static PyTypeObject PyBoolArrType_Type;
+static PyBoolScalarObject _PyArrayScalar_BoolValues[2];
+
+%s
+
+#else
+
+#if defined(PY_ARRAY_UNIQUE_SYMBOL)
+#define PyArray_API PY_ARRAY_UNIQUE_SYMBOL
+#endif
+
+#if defined(NO_IMPORT) || defined(NO_IMPORT_ARRAY)
+extern void **PyArray_API;
+#else
+#if defined(PY_ARRAY_UNIQUE_SYMBOL)
+void **PyArray_API;
+#else
+static void **PyArray_API=NULL;
+#endif
+#endif
+
+#define PyArray_GetNDArrayCVersion (*(unsigned int (*)(void)) PyArray_API[0])
+#define PyBigArray_Type (*(PyTypeObject *)PyArray_API[1])
+#define PyArray_Type (*(PyTypeObject *)PyArray_API[2])
+#define PyArrayDescr_Type (*(PyTypeObject *)PyArray_API[3])
+#define PyArrayFlags_Type (*(PyTypeObject *)PyArray_API[4])
+#define PyArrayIter_Type (*(PyTypeObject *)PyArray_API[5])
+#define PyArrayMultiIter_Type (*(PyTypeObject *)PyArray_API[6])
+#define NPY_NUMUSERTYPES (*(int *)PyArray_API[7])
+#define PyBoolArrType_Type (*(PyTypeObject *)PyArray_API[8])
+#define _PyArrayScalar_BoolValues ((PyBoolScalarObject *)PyArray_API[9])
+
+%s
+
+#if !defined(NO_IMPORT_ARRAY) && !defined(NO_IMPORT)
+static int
+_import_array(void)
+{
+ PyObject *numpy = PyImport_ImportModule("numpy.core.multiarray");
+ PyObject *c_api = NULL;
+ if (numpy == NULL) return -1;
+ c_api = PyObject_GetAttrString(numpy, "_ARRAY_API");
+ if (c_api == NULL) {Py_DECREF(numpy); return -1;}
+ if (PyCObject_Check(c_api)) {
+ PyArray_API = (void **)PyCObject_AsVoidPtr(c_api);
+ }
+ Py_DECREF(c_api);
+ Py_DECREF(numpy);
+ if (PyArray_API == NULL) return -1;
+ /* Perform runtime check of C API version */
+ if (NPY_VERSION != PyArray_GetNDArrayCVersion()) {
+ PyErr_Format(PyExc_RuntimeError, "module compiled against "\
+ "version %%x of C-API but this version of numpy is %%x", \
+ (int) NPY_VERSION, (int) PyArray_GetNDArrayCVersion());
+ return -1;
+ }
+ return 0;
+}
+
+#define import_array() {if (_import_array() < 0) {PyErr_Print(); PyErr_SetString(PyExc_ImportError, "numpy.core.multiarray failed to import"); return; } }
+
+#define import_array1(ret) {if (_import_array() < 0) {PyErr_Print(); PyErr_SetString(PyExc_ImportError, "numpy.core.multiarray failed to import"); return ret; } }
+
+#define import_array2(msg, ret) {if (_import_array() < 0) {PyErr_Print(); PyErr_SetString(PyExc_ImportError, msg); return ret; } }
+
+#endif
+
+#endif
+"""
+
+
+c_template = r"""
+/* These pointers will be stored in the C-object for use in other
+ extension modules
+*/
+
+void *PyArray_API[] = {
+ (void *) PyArray_GetNDArrayCVersion,
+ (void *) &PyBigArray_Type,
+ (void *) &PyArray_Type,
+ (void *) &PyArrayDescr_Type,
+ (void *) &PyArrayFlags_Type,
+ (void *) &PyArrayIter_Type,
+ (void *) &PyArrayMultiIter_Type,
+ (int *) &NPY_NUMUSERTYPES,
+ (void *) &PyBoolArrType_Type,
+ (void *) &_PyArrayScalar_BoolValues,
+%s
+};
+"""
+
+def generate_api(output_dir, force=False):
+ header_file = os.path.join(output_dir, '__multiarray_api.h')
+ c_file = os.path.join(output_dir,'__multiarray_api.c')
+ doc_file = os.path.join(output_dir, 'multiarray_api.txt')
+
+ targets = (header_file, c_file, doc_file)
+ if (not force
+ and not genapi.should_rebuild(targets,
+ [OBJECT_API_ORDER,
+ MULTIARRAY_API_ORDER,
+ __file__])):
+ return targets
+
+ objectapi_list = genapi.get_api_functions('OBJECT_API',
+ OBJECT_API_ORDER)
+ multiapi_list = genapi.get_api_functions('MULTIARRAY_API',
+ MULTIARRAY_API_ORDER)
+ # API fixes for __arrayobject_api.h
+
+ fixed = 10
+ numtypes = len(types) + fixed
+ numobject = len(objectapi_list) + numtypes
+ nummulti = len(multiapi_list)
+ numtotal = numobject + nummulti
+
+ module_list = []
+ extension_list = []
+ init_list = []
+
+ # setup types
+ for k, atype in enumerate(types):
+ num = fixed + k
+ astr = " (void *) &Py%sArrType_Type," % types[k]
+ init_list.append(astr)
+ astr = "static PyTypeObject Py%sArrType_Type;" % types[k]
+ module_list.append(astr)
+ astr = "#define Py%sArrType_Type (*(PyTypeObject *)PyArray_API[%d])" % \
+ (types[k], num)
+ extension_list.append(astr)
+
+ # set up object API
+ genapi.add_api_list(numtypes, 'PyArray_API', objectapi_list,
+ module_list, extension_list, init_list)
+
+ # set up multiarray module API
+ genapi.add_api_list(numobject, 'PyArray_API', multiapi_list,
+ module_list, extension_list, init_list)
+
+
+ # Write to header
+ fid = open(header_file, 'w')
+ s = h_template % ('\n'.join(module_list), '\n'.join(extension_list))
+ fid.write(s)
+ fid.close()
+
+ # Write to c-code
+ fid = open(c_file, 'w')
+ s = c_template % '\n'.join(init_list)
+ fid.write(s)
+ fid.close()
+
+ # write to documentation
+ fid = open(doc_file, 'w')
+ fid.write('''
+===========
+Numpy C-API
+===========
+
+Object API
+==========
+''')
+ for func in objectapi_list:
+ fid.write(func.to_ReST())
+ fid.write('\n\n')
+ fid.write('''
+
+Multiarray API
+==============
+''')
+ for func in multiapi_list:
+ fid.write(func.to_ReST())
+ fid.write('\n\n')
+ fid.close()
+
+ return targets
diff --git a/numpy/core/code_generators/generate_ufunc_api.py b/numpy/core/code_generators/generate_ufunc_api.py
new file mode 100644
index 000000000..052405892
--- /dev/null
+++ b/numpy/core/code_generators/generate_ufunc_api.py
@@ -0,0 +1,125 @@
+import os
+import genapi
+
+UFUNC_API_ORDER = 'ufunc_api_order.txt'
+
+h_template = r"""
+#ifdef _UMATHMODULE
+
+static PyTypeObject PyUFunc_Type;
+
+%s
+
+#else
+
+#if defined(PY_UFUNC_UNIQUE_SYMBOL)
+#define PyUFunc_API PY_UFUNC_UNIQUE_SYMBOL
+#endif
+
+#if defined(NO_IMPORT) || defined(NO_IMPORT_UFUNC)
+extern void **PyUFunc_API;
+#else
+#if defined(PY_UFUNC_UNIQUE_SYMBOL)
+void **PyUFunc_API;
+#else
+static void **PyUFunc_API=NULL;
+#endif
+#endif
+
+#define PyUFunc_Type (*(PyTypeObject *)PyUFunc_API[0])
+
+%s
+
+static int
+_import_umath(void)
+{
+ PyObject *numpy = PyImport_ImportModule("numpy.core.umath");
+ PyObject *c_api = NULL;
+
+ if (numpy == NULL) return -1;
+ c_api = PyObject_GetAttrString(numpy, "_UFUNC_API");
+ if (c_api == NULL) {Py_DECREF(numpy); return -1;}
+ if (PyCObject_Check(c_api)) {
+ PyUFunc_API = (void **)PyCObject_AsVoidPtr(c_api);
+ }
+ Py_DECREF(c_api);
+ Py_DECREF(numpy);
+ if (PyUFunc_API == NULL) return -1;
+ return 0;
+}
+
+#define import_umath() { if (_import_umath() < 0) {PyErr_Print(); PyErr_SetString(PyExc_ImportError, "numpy.core.umath failed to import"); return; }}
+
+#define import_umath1(ret) { if (_import_umath() < 0) {PyErr_Print(); PyErr_SetString(PyExc_ImportError, "numpy.core.umath failed to import"); return ret; }}
+
+#define import_umath2(msg, ret) { if (_import_umath() < 0) {PyErr_Print(); PyErr_SetString(PyExc_ImportError, msg); return ret; }}
+
+#define import_ufunc() { if (_import_umath() < 0) {PyErr_Print(); PyErr_SetString(PyExc_ImportError, "numpy.core.umath failed to import"); }}
+
+
+#endif
+"""
+
+c_template = r"""
+/* These pointers will be stored in the C-object for use in other
+ extension modules
+*/
+
+void *PyUFunc_API[] = {
+ (void *) &PyUFunc_Type,
+%s
+};
+"""
+
+def generate_api(output_dir, force=False):
+ header_file = os.path.join(output_dir, '__ufunc_api.h')
+ c_file = os.path.join(output_dir, '__ufunc_api.c')
+ doc_file = os.path.join(output_dir, 'ufunc_api.txt')
+
+ targets = (header_file, c_file, doc_file)
+ if (not force
+ and not genapi.should_rebuild(targets,
+ [UFUNC_API_ORDER, __file__])):
+ return targets
+
+ ufunc_api_list = genapi.get_api_functions('UFUNC_API', UFUNC_API_ORDER)
+
+ # API fixes for __arrayobject_api.h
+
+ fixed = 1
+ nummulti = len(ufunc_api_list)
+ numtotal = fixed + nummulti
+
+ module_list = []
+ extension_list = []
+ init_list = []
+
+ # set up object API
+ genapi.add_api_list(fixed, 'PyUFunc_API', ufunc_api_list,
+ module_list, extension_list, init_list)
+
+ # Write to header
+ fid = open(header_file, 'w')
+ s = h_template % ('\n'.join(module_list), '\n'.join(extension_list))
+ fid.write(s)
+ fid.close()
+
+ # Write to c-code
+ fid = open(c_file, 'w')
+ s = c_template % '\n'.join(init_list)
+ fid.write(s)
+ fid.close()
+
+ # Write to documentation
+ fid = open(doc_file, 'w')
+ fid.write('''
+=================
+Numpy Ufunc C-API
+=================
+''')
+ for func in ufunc_api_list:
+ fid.write(func.to_ReST())
+ fid.write('\n\n')
+ fid.close()
+
+ return targets
diff --git a/numpy/core/code_generators/generate_umath.py b/numpy/core/code_generators/generate_umath.py
new file mode 100644
index 000000000..26ef5218f
--- /dev/null
+++ b/numpy/core/code_generators/generate_umath.py
@@ -0,0 +1,645 @@
+import string
+import re
+
+Zero = "PyUFunc_Zero"
+One = "PyUFunc_One"
+None_ = "PyUFunc_None"
+
+class TypeDescription(object):
+ def __init__(self, type, f=None, in_=None, out=None):
+ self.type = type
+ self.func_data = f
+ if in_ is not None:
+ in_ = in_.replace('.', type)
+ self.in_ = in_
+ if out is not None:
+ out = out.replace('.', type)
+ self.out = out
+
+ def finish_signature(self, nin, nout):
+ if self.in_ is None:
+ self.in_ = self.type * nin
+ assert len(self.in_) == nin
+ if self.out is None:
+ self.out = self.type * nout
+ assert len(self.out) == nout
+
+_fdata_map = dict(f='%sf', d='%s', g='%sl',
+ F='nc_%sf', D='nc_%s', G='nc_%sl')
+def build_func_data(types, f):
+ func_data = []
+ for t in types:
+ d = _fdata_map.get(t, '%s') % (f,)
+ func_data.append(d)
+ return func_data
+
+def TD(types, f=None, in_=None, out=None):
+ if f is not None:
+ if isinstance(f, str):
+ func_data = build_func_data(types, f)
+ else:
+ assert len(f) == len(types)
+ func_data = f
+ else:
+ func_data = (None,) * len(types)
+ if isinstance(in_, str):
+ in_ = (in_,) * len(types)
+ elif in_ is None:
+ in_ = (None,) * len(types)
+ if isinstance(out, str):
+ out = (out,) * len(types)
+ elif out is None:
+ out = (None,) * len(types)
+ tds = []
+ for t, fd, i, o in zip(types, func_data, in_, out):
+ tds.append(TypeDescription(t, f=fd, in_=i, out=o))
+ return tds
+
+class Ufunc(object):
+ def __init__(self, nin, nout, identity, docstring,
+ *type_descriptions):
+ self.nin = nin
+ self.nout = nout
+ if identity is None:
+ identity = None_
+ self.identity = identity
+ self.docstring = docstring
+ self.type_descriptions = []
+ for td in type_descriptions:
+ self.type_descriptions.extend(td)
+ for td in self.type_descriptions:
+ td.finish_signature(self.nin, self.nout)
+
+#each entry in defdict is
+
+#name: [string of chars for which it is defined,
+# string of characters using func interface,
+# tuple of strings giving funcs for data,
+# (in, out), or (instr, outstr) giving the signature as character codes,
+# identity,
+# docstring,
+# output specification (optional)
+# ]
+
+all = '?bBhHiIlLqQfdgFDGO'
+O = 'O'
+M = 'M'
+ints = 'bBhHiIlLqQ'
+intsO = ints + O
+bints = '?' + ints
+bintsO = bints + O
+flts = 'fdg'
+fltsO = flts + O
+fltsM = flts + M
+cmplx = 'FDG'
+cmplxO = cmplx + O
+cmplxM = cmplx + M
+inexact = flts + cmplx
+noint = inexact+O
+nointM = inexact+M
+allM = bints+flts+cmplxM
+nobool = all[1:]
+nobool_or_obj = all[1:-1]
+intflt = ints+flts
+intfltcmplx = nobool_or_obj
+nocmplx = bints+flts
+nocmplxO = nocmplx+O
+nocmplxM = nocmplx+M
+noobj = all[:-1]
+
+defdict = {
+'add' :
+ Ufunc(2, 1, Zero,
+ 'adds the arguments elementwise.',
+ TD(noobj),
+ TD(O, f='PyNumber_Add'),
+ ),
+'subtract' :
+ Ufunc(2, 1, Zero,
+ 'subtracts the arguments elementwise.',
+ TD(noobj),
+ TD(O, f='PyNumber_Subtract'),
+ ),
+'multiply' :
+ Ufunc(2, 1, One,
+ 'multiplies the arguments elementwise.',
+ TD(noobj),
+ TD(O, f='PyNumber_Multiply'),
+ ),
+'divide' :
+ Ufunc(2, 1, One,
+ 'divides the arguments elementwise.',
+ TD(intfltcmplx),
+ TD(O, f='PyNumber_Divide'),
+ ),
+'floor_divide' :
+ Ufunc(2, 1, One,
+ 'floor divides the arguments elementwise.',
+ TD(intfltcmplx),
+ TD(O, f='PyNumber_FloorDivide'),
+ ),
+'true_divide' :
+ Ufunc(2, 1, One,
+ 'true divides the arguments elementwise.',
+ TD('bBhH', out='f'),
+ TD('iIlLqQ', out='d'),
+ TD(flts+cmplx),
+ TD(O, f='PyNumber_TrueDivide'),
+ ),
+'conjugate' :
+ Ufunc(1, 1, None,
+ 'takes the conjugate of x elementwise.',
+ TD(nobool_or_obj),
+ TD(M, f='conjugate'),
+ ),
+'fmod' :
+ Ufunc(2, 1, Zero,
+ 'computes (C-like) x1 % x2 elementwise.',
+ TD(ints),
+ TD(flts, f='fmod'),
+ TD(M, f='fmod'),
+ ),
+'square' :
+ Ufunc(1, 1, None,
+ 'compute x**2.',
+ TD(nobool_or_obj),
+ TD(O, f='Py_square'),
+ ),
+'reciprocal' :
+ Ufunc(1, 1, None,
+ 'compute 1/x',
+ TD(nobool_or_obj),
+ TD(O, f='Py_reciprocal'),
+ ),
+'ones_like' :
+ Ufunc(1, 1, None,
+ 'returns an array of ones of the shape and typecode of x.',
+ TD(nobool_or_obj),
+ TD(O, f='Py_get_one'),
+ ),
+'power' :
+ Ufunc(2, 1, One,
+ 'computes x1**x2 elementwise.',
+ TD(ints),
+ TD(inexact, f='pow'),
+ TD(O, f='PyNumber_Power'),
+ ),
+'absolute' :
+ Ufunc(1, 1, None,
+ 'takes |x| elementwise.',
+ TD(nocmplx),
+ TD(cmplx, out=('f', 'd', 'g')),
+ TD(O, f='PyNumber_Absolute'),
+ ),
+'negative' :
+ Ufunc(1, 1, None,
+ 'determines -x elementwise',
+ TD(nocmplx),
+ TD(cmplx, f='neg'),
+ TD(O, f='PyNumber_Negative'),
+ ),
+'sign' :
+ Ufunc(1, 1, None,
+ 'returns -1 if x < 0 and 0 if x==0 and 1 if x > 0',
+ TD(nobool),
+ ),
+'greater' :
+ Ufunc(2, 1, None,
+ 'returns elementwise x1 > x2 in a bool array.',
+ TD(all, out='?'),
+ ),
+'greater_equal' :
+ Ufunc(2, 1, None,
+ 'returns elementwise x1 >= x2 in a bool array.',
+ TD(all, out='?'),
+ ),
+'less' :
+ Ufunc(2, 1, None,
+ 'returns elementwise x1 < x2 in a bool array.',
+ TD(all, out='?'),
+ ),
+'less_equal' :
+ Ufunc(2, 1, None,
+ 'returns elementwise x1 <= x2 in a bool array',
+ TD(all, out='?'),
+ ),
+'equal' :
+ Ufunc(2, 1, None,
+ 'returns elementwise x1 == x2 in a bool array',
+ TD(all, out='?'),
+ ),
+'not_equal' :
+ Ufunc(2, 1, None,
+ 'returns elementwise x1 |= x2',
+ TD(all, out='?'),
+ ),
+'logical_and' :
+ Ufunc(2, 1, One,
+ 'returns x1 and x2 elementwise.',
+ TD(noobj, out='?'),
+ TD(M, f='logical_and', out='?'),
+ ),
+'logical_not' :
+ Ufunc(1, 1, None,
+ 'returns not x elementwise.',
+ TD(noobj, out='?'),
+ TD(M, f='logical_not', out='?'),
+ ),
+'logical_or' :
+ Ufunc(2, 1, Zero,
+ 'returns x1 or x2 elementwise.',
+ TD(noobj, out='?'),
+ TD(M, f='logical_or', out='?'),
+ ),
+'logical_xor' :
+ Ufunc(2, 1, None,
+ 'returns x1 xor x2 elementwise.',
+ TD(noobj, out='?'),
+ TD(M, f='logical_xor', out='?'),
+ ),
+'maximum' :
+ Ufunc(2, 1, None,
+ 'returns maximum (if x1 > x2: x1; else: x2) elementwise.',
+ TD(noobj),
+ TD(O, f='_npy_ObjectMax')
+ ),
+'minimum' :
+ Ufunc(2, 1, None,
+ 'returns minimum (if x1 < x2: x1; else: x2) elementwise',
+ TD(noobj),
+ TD(O, f='_npy_ObjectMin')
+ ),
+'bitwise_and' :
+ Ufunc(2, 1, One,
+ 'computes x1 & x2 elementwise.',
+ TD(bints),
+ TD(O, f='PyNumber_And'),
+ ),
+'bitwise_or' :
+ Ufunc(2, 1, Zero,
+ 'computes x1 | x2 elementwise.',
+ TD(bints),
+ TD(O, f='PyNumber_Or'),
+ ),
+'bitwise_xor' :
+ Ufunc(2, 1, None,
+ 'computes x1 ^ x2 elementwise.',
+ TD(bints),
+ TD(O, f='PyNumber_Xor'),
+ ),
+'invert' :
+ Ufunc(1, 1, None,
+ 'computes ~x (bit inversion) elementwise.',
+ TD(bints),
+ TD(O, f='PyNumber_Invert'),
+ ),
+'left_shift' :
+ Ufunc(2, 1, None,
+ 'computes x1 << x2 (x1 shifted to left by x2 bits) elementwise.',
+ TD(ints),
+ TD(O, f='PyNumber_Lshift'),
+ ),
+'right_shift' :
+ Ufunc(2, 1, None,
+ 'computes x1 >> x2 (x1 shifted to right by x2 bits) elementwise.',
+ TD(ints),
+ TD(O, f='PyNumber_Rshift'),
+ ),
+'arccos' :
+ Ufunc(1, 1, None,
+ 'inverse cosine elementwise.',
+ TD(inexact, f='acos'),
+ TD(M, f='arccos'),
+ ),
+'arccosh' :
+ Ufunc(1, 1, None,
+ 'inverse hyperbolic cosine elementwise.',
+ TD(inexact, f='acosh'),
+ TD(M, f='arccosh'),
+ ),
+'arcsin' :
+ Ufunc(1, 1, None,
+ 'inverse sine elementwise.',
+ TD(inexact, f='asin'),
+ TD(M, f='arcsin'),
+ ),
+'arcsinh' :
+ Ufunc(1, 1, None,
+ 'inverse hyperbolic sine elementwise.',
+ TD(inexact, f='asinh'),
+ TD(M, f='arcsinh'),
+ ),
+'arctan' :
+ Ufunc(1, 1, None,
+ 'inverse tangent elementwise.',
+ TD(inexact, f='atan'),
+ TD(M, f='arctan'),
+ ),
+'arctanh' :
+ Ufunc(1, 1, None,
+ 'inverse hyperbolic tangent elementwise.',
+ TD(inexact, f='atanh'),
+ TD(M, f='arctanh'),
+ ),
+'cos' :
+ Ufunc(1, 1, None,
+ 'cosine elementwise.',
+ TD(inexact, f='cos'),
+ TD(M, f='cos'),
+ ),
+'sin' :
+ Ufunc(1, 1, None,
+ 'sine elementwise.',
+ TD(inexact, f='sin'),
+ TD(M, f='sin'),
+ ),
+'tan' :
+ Ufunc(1, 1, None,
+ 'tangent elementwise.',
+ TD(inexact, f='tan'),
+ TD(M, f='tan'),
+ ),
+'cosh' :
+ Ufunc(1, 1, None,
+ 'hyperbolic cosine elementwise.',
+ TD(inexact, f='cosh'),
+ TD(M, f='cosh'),
+ ),
+'sinh' :
+ Ufunc(1, 1, None,
+ 'hyperbolic sine elementwise.',
+ TD(inexact, f='sinh'),
+ TD(M, f='sinh'),
+ ),
+'tanh' :
+ Ufunc(1, 1, None,
+ 'hyperbolic tangent elementwise.',
+ TD(inexact, f='tanh'),
+ TD(M, f='tanh'),
+ ),
+'exp' :
+ Ufunc(1, 1, None,
+ 'e**x elementwise.',
+ TD(inexact, f='exp'),
+ TD(M, f='exp'),
+ ),
+'expm1' :
+ Ufunc(1, 1, None,
+ 'e**x-1 elementwise.',
+ TD(inexact, f='expm1'),
+ TD(M, f='expm1'),
+ ),
+'log' :
+ Ufunc(1, 1, None,
+ 'logarithm base e elementwise.',
+ TD(inexact, f='log'),
+ TD(M, f='log'),
+ ),
+'log10' :
+ Ufunc(1, 1, None,
+ 'logarithm base 10 elementwise.',
+ TD(inexact, f='log10'),
+ TD(M, f='log10'),
+ ),
+'log1p' :
+ Ufunc(1, 1, None,
+ 'log(1+x) to base e elementwise.',
+ TD(inexact, f='log1p'),
+ TD(M, f='log1p'),
+ ),
+'sqrt' :
+ Ufunc(1, 1, None,
+ 'square-root elementwise. For real x, the domain is restricted to x>=0.',
+ TD(inexact, f='sqrt'),
+ TD(M, f='sqrt'),
+ ),
+'ceil' :
+ Ufunc(1, 1, None,
+ 'elementwise smallest integer >= x.',
+ TD(flts, f='ceil'),
+ TD(M, f='ceil'),
+ ),
+'fabs' :
+ Ufunc(1, 1, None,
+ 'absolute values.',
+ TD(flts, f='fabs'),
+ TD(M, f='fabs'),
+ ),
+'floor' :
+ Ufunc(1, 1, None,
+ 'elementwise largest integer <= x',
+ TD(flts, f='floor'),
+ TD(M, f='floor'),
+ ),
+'rint' :
+ Ufunc(1, 1, None,
+ 'round x elementwise to the nearest integer, round halfway cases away from zero',
+ TD(inexact, f='rint'),
+ TD(M, f='rint'),
+ ),
+'arctan2' :
+ Ufunc(2, 1, None,
+ 'a safe and correct arctan(x1/x2)',
+ TD(flts, f='atan2'),
+ TD(M, f='arctan2'),
+ ),
+'remainder' :
+ Ufunc(2, 1, None,
+ 'computes x1-n*x2 where n is floor(x1 / x2)',
+ TD(intflt),
+ TD(O, f='PyNumber_Remainder'),
+ ),
+'hypot' :
+ Ufunc(2, 1, None,
+ 'sqrt(x1**2 + x2**2) elementwise',
+ TD(flts, f='hypot'),
+ TD(M, f='hypot'),
+ ),
+'isnan' :
+ Ufunc(1, 1, None,
+ 'returns True where x is Not-A-Number',
+ TD(inexact, out='?'),
+ ),
+'isinf' :
+ Ufunc(1, 1, None,
+ 'returns True where x is +inf or -inf',
+ TD(inexact, out='?'),
+ ),
+'isfinite' :
+ Ufunc(1, 1, None,
+ 'returns True where x is finite',
+ TD(inexact, out='?'),
+ ),
+'signbit' :
+ Ufunc(1, 1, None,
+ 'returns True where signbit of x is set (x<0).',
+ TD(flts, out='?'),
+ ),
+'modf' :
+ Ufunc(1, 2, None,
+ 'breaks x into fractional (y1) and integral (y2) parts.\\n\\n Each output has the same sign as the input.',
+ TD(flts),
+ ),
+}
+
+def indent(st,spaces):
+ indention = ' '*spaces
+ indented = indention + string.replace(st,'\n','\n'+indention)
+ # trim off any trailing spaces
+ indented = re.sub(r' +$',r'',indented)
+ return indented
+
+chartoname = {'?': 'bool',
+ 'b': 'byte',
+ 'B': 'ubyte',
+ 'h': 'short',
+ 'H': 'ushort',
+ 'i': 'int',
+ 'I': 'uint',
+ 'l': 'long',
+ 'L': 'ulong',
+ 'q': 'longlong',
+ 'Q': 'ulonglong',
+ 'f': 'float',
+ 'd': 'double',
+ 'g': 'longdouble',
+ 'F': 'cfloat',
+ 'D': 'cdouble',
+ 'G': 'clongdouble',
+ 'O': 'OBJECT',
+ 'M': 'OBJECT',
+ }
+
+chartotype1 = {'f': 'f_f',
+ 'd': 'd_d',
+ 'g': 'g_g',
+ 'F': 'F_F',
+ 'D': 'D_D',
+ 'G': 'G_G',
+ 'O': 'O_O',
+ 'M': 'O_O_method'}
+
+chartotype2 = {'f': 'ff_f',
+ 'd': 'dd_d',
+ 'g': 'gg_g',
+ 'F': 'FF_F',
+ 'D': 'DD_D',
+ 'G': 'GG_G',
+ 'O': 'OO_O',
+ 'M': 'OO_O_method'}
+#for each name
+# 1) create functions, data, and signature
+# 2) fill in functions and data in InitOperators
+# 3) add function.
+
+def make_arrays(funcdict):
+ # functions array contains an entry for every type implemented
+ # NULL should be placed where PyUfunc_ style function will be filled in later
+ #
+ code1list = []
+ code2list = []
+ names = funcdict.keys()
+ names.sort()
+ for name in names:
+ uf = funcdict[name]
+ funclist = []
+ datalist = []
+ siglist = []
+ k = 0
+ sub = 0
+
+ if uf.nin > 1:
+ assert uf.nin == 2
+ thedict = chartotype2 # two inputs and one output
+ else:
+ thedict = chartotype1 # one input and one output
+
+ for t in uf.type_descriptions:
+ if t.func_data is not None:
+ funclist.append('NULL')
+ astr = '%s_functions[%d] = PyUFunc_%s;' % \
+ (name, k, thedict[t.type])
+ code2list.append(astr)
+ if t.type == 'O':
+ astr = '%s_data[%d] = (void *) %s;' % \
+ (name, k, t.func_data)
+ code2list.append(astr)
+ datalist.append('(void *)NULL')
+ elif t.type == 'M':
+ datalist.append('(void *)"%s"' % t.func_data)
+ else:
+ datalist.append('(void *)%s' % t.func_data)
+ sub += 1
+ else:
+ datalist.append('(void *)NULL');
+ tname = chartoname[t.type].upper()
+ funclist.append('%s_%s' % (tname, name))
+
+ for x in t.in_ + t.out:
+ siglist.append('PyArray_%s' % (chartoname[x].upper(),))
+
+ k += 1
+
+ funcnames = ', '.join(funclist)
+ signames = ', '.join(siglist)
+ datanames = ', '.join(datalist)
+ code1list.append("static PyUFuncGenericFunction %s_functions[] = { %s };" \
+ % (name, funcnames))
+ code1list.append("static void * %s_data[] = { %s };" \
+ % (name, datanames))
+ code1list.append("static char %s_signatures[] = { %s };" \
+ % (name, signames))
+ return "\n".join(code1list),"\n".join(code2list)
+
+def make_ufuncs(funcdict):
+ code3list = []
+ names = funcdict.keys()
+ names.sort()
+ for name in names:
+ uf = funcdict[name]
+ mlist = []
+ mlist.append(\
+r"""f = PyUFunc_FromFuncAndData(%s_functions, %s_data, %s_signatures, %d,
+ %d, %d, %s, "%s",
+ "%s", 0);""" % (name, name, name,
+ len(uf.type_descriptions),
+ uf.nin, uf.nout,
+ uf.identity,
+ name, uf.docstring))
+ mlist.append(r"""PyDict_SetItemString(dictionary, "%s", f);""" % name)
+ mlist.append(r"""Py_DECREF(f);""")
+ code3list.append('\n'.join(mlist))
+ return '\n'.join(code3list)
+
+
+def make_code(funcdict,filename):
+ code1, code2 = make_arrays(funcdict)
+ code3 = make_ufuncs(funcdict)
+ code2 = indent(code2,4)
+ code3 = indent(code3,4)
+ code = r"""
+
+/** Warning this file is autogenerated!!!
+
+ Please make changes to the code generator program (%s)
+**/
+
+%s
+
+static void
+InitOperators(PyObject *dictionary) {
+ PyObject *f;
+
+%s
+%s
+}
+""" % (filename, code1, code2, code3)
+ return code;
+
+
+if __name__ == "__main__":
+ filename = __file__
+ fid = open('__umath_generated.c','w')
+ code = make_code(defdict, filename)
+ fid.write(code)
+ fid.close()
diff --git a/numpy/core/code_generators/multiarray_api_order.txt b/numpy/core/code_generators/multiarray_api_order.txt
new file mode 100644
index 000000000..03a75a576
--- /dev/null
+++ b/numpy/core/code_generators/multiarray_api_order.txt
@@ -0,0 +1,83 @@
+PyArray_Transpose
+PyArray_TakeFrom
+PyArray_PutTo
+PyArray_PutMask
+PyArray_Repeat
+PyArray_Choose
+PyArray_Sort
+PyArray_ArgSort
+PyArray_SearchSorted
+PyArray_ArgMax
+PyArray_ArgMin
+PyArray_Reshape
+PyArray_Newshape
+PyArray_Squeeze
+PyArray_View
+PyArray_SwapAxes
+PyArray_Max
+PyArray_Min
+PyArray_Ptp
+PyArray_Mean
+PyArray_Trace
+PyArray_Diagonal
+PyArray_Clip
+PyArray_Conjugate
+PyArray_Nonzero
+PyArray_Std
+PyArray_Sum
+PyArray_CumSum
+PyArray_Prod
+PyArray_CumProd
+PyArray_All
+PyArray_Any
+PyArray_Compress
+PyArray_Flatten
+PyArray_Ravel
+PyArray_MultiplyList
+PyArray_MultiplyIntList
+PyArray_GetPtr
+PyArray_CompareLists
+PyArray_AsCArray
+PyArray_As1D
+PyArray_As2D
+PyArray_Free
+PyArray_Converter
+PyArray_IntpFromSequence
+PyArray_Concatenate
+PyArray_InnerProduct
+PyArray_MatrixProduct
+PyArray_CopyAndTranspose
+PyArray_Correlate
+PyArray_TypestrConvert
+PyArray_DescrConverter
+PyArray_DescrConverter2
+PyArray_IntpConverter
+PyArray_BufferConverter
+PyArray_AxisConverter
+PyArray_BoolConverter
+PyArray_ByteorderConverter
+PyArray_OrderConverter
+PyArray_EquivTypes
+PyArray_Zeros
+PyArray_Empty
+PyArray_Where
+PyArray_Arange
+PyArray_ArangeObj
+PyArray_SortkindConverter
+PyArray_LexSort
+PyArray_Round
+PyArray_EquivTypenums
+PyArray_RegisterDataType
+PyArray_RegisterCastFunc
+PyArray_RegisterCanCast
+PyArray_InitArrFuncs
+PyArray_IntTupleFromIntp
+PyArray_TypeNumFromName
+PyArray_ClipmodeConverter
+PyArray_OutputConverter
+PyArray_BroadcastToShape
+_PyArray_SigintHandler
+_PyArray_GetSigintBuf
+PyArray_DescrAlignConverter
+PyArray_DescrAlignConverter2
+PyArray_SearchsideConverter
diff --git a/numpy/core/code_generators/ufunc_api_order.txt b/numpy/core/code_generators/ufunc_api_order.txt
new file mode 100644
index 000000000..816d3121d
--- /dev/null
+++ b/numpy/core/code_generators/ufunc_api_order.txt
@@ -0,0 +1,30 @@
+PyUFunc_FromFuncAndData
+PyUFunc_RegisterLoopForType
+PyUFunc_GenericFunction
+PyUFunc_f_f_As_d_d
+PyUFunc_d_d
+PyUFunc_f_f
+PyUFunc_g_g
+PyUFunc_F_F_As_D_D
+PyUFunc_F_F
+PyUFunc_D_D
+PyUFunc_G_G
+PyUFunc_O_O
+PyUFunc_ff_f_As_dd_d
+PyUFunc_ff_f
+PyUFunc_dd_d
+PyUFunc_gg_g
+PyUFunc_FF_F_As_DD_D
+PyUFunc_DD_D
+PyUFunc_FF_F
+PyUFunc_GG_G
+PyUFunc_OO_O
+PyUFunc_O_O_method
+PyUFunc_OO_O_method
+PyUFunc_On_Om
+PyUFunc_GetPyValues
+PyUFunc_checkfperr
+PyUFunc_clearfperr
+PyUFunc_getfperr
+PyUFunc_handlefperr
+PyUFunc_ReplaceLoopBySignature \ No newline at end of file
diff --git a/numpy/core/defchararray.py b/numpy/core/defchararray.py
new file mode 100644
index 000000000..4ce06b247
--- /dev/null
+++ b/numpy/core/defchararray.py
@@ -0,0 +1,340 @@
+from numerictypes import string_, unicode_, integer, object_
+from numeric import ndarray, broadcast, empty, compare_chararrays
+from numeric import array as narray
+import sys
+
+__all__ = ['chararray']
+
+_globalvar = 0
+_unicode = unicode
+
+# special sub-class for character arrays (string_ and unicode_)
+# This adds + and * operations and methods of str and unicode types
+# which operate on an element-by-element basis
+
+# It also strips white-space on element retrieval and on
+# comparisons
+
+class chararray(ndarray):
+ def __new__(subtype, shape, itemsize=1, unicode=False, buffer=None,
+ offset=0, strides=None, order='C'):
+ global _globalvar
+
+ if unicode:
+ dtype = unicode_
+ else:
+ dtype = string_
+
+ _globalvar = 1
+ if buffer is None:
+ self = ndarray.__new__(subtype, shape, (dtype, itemsize),
+ order=order)
+ else:
+ self = ndarray.__new__(subtype, shape, (dtype, itemsize),
+ buffer=buffer,
+ offset=offset, strides=strides,
+ order=order)
+ _globalvar = 0
+ return self
+
+ def __array_finalize__(self, obj):
+ # The b is a special case because it is used for reconstructing.
+ if not _globalvar and self.dtype.char not in 'SUb':
+ raise ValueError, "Can only create a chararray from string data."
+
+ def __getitem__(self, obj):
+ val = ndarray.__getitem__(self, obj)
+ if isinstance(val, (string_, unicode_)):
+ temp = val.rstrip()
+ if len(temp) == 0:
+ val = ''
+ else:
+ val = temp
+ return val
+
+ def __eq__(self, other):
+ return compare_chararrays(self, other, '==', True)
+
+ def __ne__(self, other):
+ return compare_chararrays(self, other, '!=', True)
+
+ def __ge__(self, other):
+ return compare_chararrays(self, other, '>=', True)
+
+ def __le__(self, other):
+ return compare_chararrays(self, other, '<=', True)
+
+ def __gt__(self, other):
+ return compare_chararrays(self, other, '>', True)
+
+ def __lt__(self, other):
+ return compare_chararrays(self, other, '<', True)
+
+ def __add__(self, other):
+ b = broadcast(self, other)
+ arr = b.iters[1].base
+ outitem = self.itemsize + arr.itemsize
+ result = chararray(b.shape, outitem, self.dtype is unicode_)
+ res = result.flat
+ for k, val in enumerate(b):
+ res[k] = (val[0] + val[1])
+ return result
+
+ def __radd__(self, other):
+ b = broadcast(other, self)
+ outitem = b.iters[0].base.itemsize + \
+ b.iters[1].base.itemsize
+ result = chararray(b.shape, outitem, self.dtype is unicode_)
+ res = result.flat
+ for k, val in enumerate(b):
+ res[k] = (val[0] + val[1])
+ return result
+
+ def __mul__(self, other):
+ b = broadcast(self, other)
+ arr = b.iters[1].base
+ if not issubclass(arr.dtype.type, integer):
+ raise ValueError, "Can only multiply by integers"
+ outitem = b.iters[0].base.itemsize * arr.max()
+ result = chararray(b.shape, outitem, self.dtype is unicode_)
+ res = result.flat
+ for k, val in enumerate(b):
+ res[k] = val[0]*val[1]
+ return result
+
+ def __rmul__(self, other):
+ b = broadcast(self, other)
+ arr = b.iters[1].base
+ if not issubclass(arr.dtype.type, integer):
+ raise ValueError, "Can only multiply by integers"
+ outitem = b.iters[0].base.itemsize * arr.max()
+ result = chararray(b.shape, outitem, self.dtype is unicode_)
+ res = result.flat
+ for k, val in enumerate(b):
+ res[k] = val[0]*val[1]
+ return result
+
+ def __mod__(self, other):
+ b = broadcast(self, other)
+ res = [None]*b.size
+ maxsize = -1
+ for k,val in enumerate(b):
+ newval = val[0] % val[1]
+ maxsize = max(len(newval), maxsize)
+ res[k] = newval
+ newarr = chararray(b.shape, maxsize, self.dtype is unicode_)
+ newarr[:] = res
+ return newarr
+
+ def __rmod__(self, other):
+ return NotImplemented
+
+ def argsort(self, axis=-1, kind='quicksort', order=None):
+ return self.__array__().argsort(axis, kind, order)
+
+ def _generalmethod(self, name, myiter):
+ res = [None]*myiter.size
+ maxsize = -1
+ for k, val in enumerate(myiter):
+ newval = []
+ for chk in val[1:]:
+ if not chk or (chk.dtype is object_ and chk.item() is None):
+ break
+ newval.append(chk)
+ newitem = getattr(val[0],name)(*newval)
+ maxsize = max(len(newitem), maxsize)
+ res[k] = newitem
+ newarr = chararray(myiter.shape, maxsize, self.dtype is unicode_)
+ newarr[:] = res
+ return newarr
+
+ def _typedmethod(self, name, myiter, dtype):
+ result = empty(myiter.shape, dtype=dtype)
+ res = result.flat
+ for k, val in enumerate(myiter):
+ newval = []
+ for chk in val[1:]:
+ if not chk or (chk.dtype is object_ and chk.item() is None):
+ break
+ newval.append(chk)
+ this_str = val[0].rstrip('\x00')
+ newitem = getattr(this_str,name)(*newval)
+ res[k] = newitem
+ return result
+
+ def _samemethod(self, name):
+ result = self.copy()
+ res = result.flat
+ for k, val in enumerate(self.flat):
+ res[k] = getattr(val, name)()
+ return result
+
+ def capitalize(self):
+ return self._samemethod('capitalize')
+
+ if sys.version[:3] >= '2.4':
+ def center(self, width, fillchar=' '):
+ return self._generalmethod('center',
+ broadcast(self, width, fillchar))
+ def ljust(self, width, fillchar=' '):
+ return self._generalmethod('ljust',
+ broadcast(self, width, fillchar))
+ def rjust(self, width, fillchar=' '):
+ return self._generalmethod('rjust',
+ broadcast(self, width, fillchar))
+ def rsplit(self, sep=None, maxsplit=None):
+ return self._typedmethod('rsplit', broadcast(self, sep, maxsplit),
+ object)
+ else:
+ def ljust(self, width):
+ return self._generalmethod('ljust', broadcast(self, width))
+ def rjust(self, width):
+ return self._generalmethod('rjust', broadcast(self, width))
+ def center(self, width):
+ return self._generalmethod('center', broadcast(self, width))
+
+ def count(self, sub, start=None, end=None):
+ return self._typedmethod('count', broadcast(self, sub, start, end), int)
+
+ def decode(self,encoding=None,errors=None):
+ return self._generalmethod('decode', broadcast(self, encoding, errors))
+
+ def encode(self,encoding=None,errors=None):
+ return self._generalmethod('encode', broadcast(self, encoding, errors))
+
+ def endswith(self, suffix, start=None, end=None):
+ return self._typedmethod('endswith', broadcast(self, suffix, start, end), bool)
+
+ def expandtabs(self, tabsize=None):
+ return self._generalmethod('endswith', broadcast(self, tabsize))
+
+ def find(self, sub, start=None, end=None):
+ return self._typedmethod('find', broadcast(self, sub, start, end), int)
+
+ def index(self, sub, start=None, end=None):
+ return self._typedmethod('index', broadcast(self, sub, start, end), int)
+
+ def _ismethod(self, name):
+ result = empty(self.shape, dtype=bool)
+ res = result.flat
+ for k, val in enumerate(self.flat):
+ item = val.rstrip('\x00')
+ res[k] = getattr(item, name)()
+ return result
+
+ def isalnum(self):
+ return self._ismethod('isalnum')
+
+ def isalpha(self):
+ return self._ismethod('isalpha')
+
+ def isdigit(self):
+ return self._ismethod('isdigit')
+
+ def islower(self):
+ return self._ismethod('islower')
+
+ def isspace(self):
+ return self._ismethod('isspace')
+
+ def istitle(self):
+ return self._ismethod('istitle')
+
+ def isupper(self):
+ return self._ismethod('isupper')
+
+ def join(self, seq):
+ return self._generalmethod('join', broadcast(self, seq))
+
+ def lower(self):
+ return self._samemethod('lower')
+
+ def lstrip(self, chars):
+ return self._generalmethod('lstrip', broadcast(self, chars))
+
+ def replace(self, old, new, count=None):
+ return self._generalmethod('replace', broadcast(self, old, new, count))
+
+ def rfind(self, sub, start=None, end=None):
+ return self._typedmethod('rfind', broadcast(self, sub, start, end), int)
+
+ def rindex(self, sub, start=None, end=None):
+ return self._typedmethod('rindex', broadcast(self, sub, start, end), int)
+
+ def rstrip(self, chars=None):
+ return self._generalmethod('rstrip', broadcast(self, chars))
+
+ def split(self, sep=None, maxsplit=None):
+ return self._typedmethod('split', broadcast(self, sep, maxsplit), object)
+
+ def splitlines(self, keepends=None):
+ return self._typedmethod('splitlines', broadcast(self, keepends), object)
+
+ def startswith(self, prefix, start=None, end=None):
+ return self._typedmethod('startswith', broadcast(self, prefix, start, end), bool)
+
+ def strip(self, chars=None):
+ return self._generalmethod('strip', broadcast(self, chars))
+
+ def swapcase(self):
+ return self._samemethod('swapcase')
+
+ def title(self):
+ return self._samemethod('title')
+
+ def translate(self, table, deletechars=None):
+ if self.dtype is unicode_:
+ return self._generalmethod('translate', broadcast(self, table))
+ else:
+ return self._generalmethod('translate', broadcast(self, table, deletechars))
+
+ def upper(self):
+ return self._samemethod('upper')
+
+ def zfill(self, width):
+ return self._generalmethod('zfill', broadcast(self, width))
+
+
+def array(obj, itemsize=None, copy=True, unicode=False, order=None):
+
+ if isinstance(obj, chararray):
+ if itemsize is None:
+ itemsize = obj.itemsize
+ if copy or (itemsize != obj.itemsize) \
+ or (not unicode and obj.dtype == unicode_) \
+ or (unicode and obj.dtype == string_):
+ return obj.astype("%s%d" % (obj.dtype.char, itemsize))
+ else:
+ return obj
+
+ if isinstance(obj, ndarray) and (obj.dtype in [unicode_, string_]):
+ new = obj.view(chararray)
+ if unicode and obj.dtype == string_:
+ return new.astype((unicode_, obj.itemsize))
+ elif obj.dtype == unicode_:
+ return new.astype((string_, obj.itemsize))
+
+ if copy: return new.copy()
+ else: return new
+
+ if unicode: dtype = "U"
+ else: dtype = "S"
+
+ if itemsize is not None:
+ dtype += str(itemsize)
+
+ if isinstance(obj, (str, _unicode)):
+ if itemsize is None:
+ itemsize = len(obj)
+ shape = len(obj) / itemsize
+ return chararray(shape, itemsize=itemsize, unicode=unicode,
+ buffer=obj)
+
+ # default
+ val = narray(obj, dtype=dtype, order=order, subok=1)
+
+ return val.view(chararray)
+
+def asarray(obj, itemsize=None, unicode=False, order=None):
+ return array(obj, itemsize, copy=False,
+ unicode=unicode, order=order)
diff --git a/numpy/core/defmatrix.py b/numpy/core/defmatrix.py
new file mode 100644
index 000000000..659157d20
--- /dev/null
+++ b/numpy/core/defmatrix.py
@@ -0,0 +1,496 @@
+__all__ = ['matrix', 'bmat', 'mat', 'asmatrix']
+
+import numeric as N
+from numeric import concatenate, isscalar, binary_repr
+import string as str_
+import sys
+
+# make translation table
+_table = [None]*256
+for k in range(256):
+ _table[k] = chr(k)
+_table = ''.join(_table)
+
+_numchars = str_.digits + ".-+jeEL"
+del str_
+_todelete = []
+for k in _table:
+ if k not in _numchars:
+ _todelete.append(k)
+_todelete = ''.join(_todelete)
+del k
+
+def _eval(astr):
+ return eval(astr.translate(_table,_todelete))
+
+def _convert_from_string(data):
+ rows = data.split(';')
+ newdata = []
+ count = 0
+ for row in rows:
+ trow = row.split(',')
+ newrow = []
+ for col in trow:
+ temp = col.split()
+ newrow.extend(map(_eval,temp))
+ if count == 0:
+ Ncols = len(newrow)
+ elif len(newrow) != Ncols:
+ raise ValueError, "Rows not the same size."
+ count += 1
+ newdata.append(newrow)
+ return newdata
+
+def asmatrix(data, dtype=None):
+ """ Returns 'data' as a matrix. Unlike matrix(), no copy is performed
+ if 'data' is already a matrix or array. Equivalent to:
+ matrix(data, copy=False)
+ """
+ return matrix(data, dtype=dtype, copy=False)
+
+
+
+class matrix(N.ndarray):
+ __array_priority__ = 10.0
+ def __new__(subtype, data, dtype=None, copy=True):
+ if isinstance(data, matrix):
+ dtype2 = data.dtype
+ if (dtype is None):
+ dtype = dtype2
+ if (dtype2 == dtype) and (not copy):
+ return data
+ return data.astype(dtype)
+
+ if isinstance(data, N.ndarray):
+ if dtype is None:
+ intype = data.dtype
+ else:
+ intype = N.dtype(dtype)
+ new = data.view(subtype)
+ if intype != data.dtype:
+ return new.astype(intype)
+ if copy: return new.copy()
+ else: return new
+
+ if isinstance(data, str):
+ data = _convert_from_string(data)
+
+ # now convert data to an array
+ arr = N.array(data, dtype=dtype, copy=copy)
+ ndim = arr.ndim
+ shape = arr.shape
+ if (ndim > 2):
+ raise ValueError, "matrix must be 2-dimensional"
+ elif ndim == 0:
+ shape = (1,1)
+ elif ndim == 1:
+ shape = (1,shape[0])
+
+ order = False
+ if (ndim == 2) and arr.flags.fortran:
+ order = True
+
+ if not (order or arr.flags.contiguous):
+ arr = arr.copy()
+
+ ret = N.ndarray.__new__(subtype, shape, arr.dtype,
+ buffer=arr,
+ order=order)
+ return ret
+
+ def __array_finalize__(self, obj):
+ self._getitem = False
+ if (isinstance(obj, matrix) and obj._getitem): return
+ ndim = self.ndim
+ if (ndim == 2):
+ return
+ if (ndim > 2):
+ newshape = tuple([x for x in self.shape if x > 1])
+ ndim = len(newshape)
+ if ndim == 2:
+ self.shape = newshape
+ return
+ elif (ndim > 2):
+ raise ValueError, "shape too large to be a matrix."
+ else:
+ newshape = self.shape
+ if ndim == 0:
+ self.shape = (1,1)
+ elif ndim == 1:
+ self.shape = (1,newshape[0])
+ return
+
+ def __getitem__(self, index):
+ self._getitem = True
+ try:
+ out = N.ndarray.__getitem__(self, index)
+ finally:
+ self._getitem = False
+
+ if not isinstance(out, N.ndarray):
+ return out
+
+ if out.ndim == 0:
+ return out[()]
+ if out.ndim == 1:
+ sh = out.shape[0]
+ # Determine when we should have a column array
+ try:
+ n = len(index)
+ except:
+ n = 0
+ if n > 1 and isscalar(index[1]):
+ out.shape = (sh,1)
+ else:
+ out.shape = (1,sh)
+ return out
+
+ def _get_truendim(self):
+ shp = self.shape
+ truend = 0
+ for val in shp:
+ if (val > 1): truend += 1
+ return truend
+
+
+ def __mul__(self, other):
+ if isinstance(other,(N.ndarray, list, tuple)) :
+ # This promotes 1-D vectors to row vectors
+ return N.dot(self, asmatrix(other))
+ if N.isscalar(other) or not hasattr(other, '__rmul__') :
+ return N.dot(self, other)
+ return NotImplemented
+
+ def __rmul__(self, other):
+ return N.dot(other, self)
+
+ def __imul__(self, other):
+ self[:] = self * other
+ return self
+
+ def __pow__(self, other):
+ shape = self.shape
+ if len(shape) != 2 or shape[0] != shape[1]:
+ raise TypeError, "matrix is not square"
+ if type(other) in (type(1), type(1L)):
+ if other==0:
+ return matrix(N.identity(shape[0]))
+ if other<0:
+ x = self.I
+ other=-other
+ else:
+ x=self
+ result = x
+ if other <= 3:
+ while(other>1):
+ result=result*x
+ other=other-1
+ return result
+ # binary decomposition to reduce the number of Matrix
+ # Multiplies for other > 3.
+ beta = binary_repr(other)
+ t = len(beta)
+ Z,q = x.copy(),0
+ while beta[t-q-1] == '0':
+ Z *= Z
+ q += 1
+ result = Z.copy()
+ for k in range(q+1,t):
+ Z *= Z
+ if beta[t-k-1] == '1':
+ result *= Z
+ return result
+ else:
+ raise TypeError, "exponent must be an integer"
+
+ def __rpow__(self, other):
+ return NotImplemented
+
+ def __repr__(self):
+ s = repr(self.__array__()).replace('array', 'matrix')
+ # now, 'matrix' has 6 letters, and 'array' 5, so the columns don't
+ # line up anymore. We need to add a space.
+ l = s.splitlines()
+ for i in range(1, len(l)):
+ if l[i]:
+ l[i] = ' ' + l[i]
+ return '\n'.join(l)
+
+ def __str__(self):
+ return str(self.__array__())
+
+ def _align(self, axis):
+ """A convenience function for operations that need to preserve axis
+ orientation.
+ """
+ if axis is None:
+ return self[0,0]
+ elif axis==0:
+ return self
+ elif axis==1:
+ return self.transpose()
+ else:
+ raise ValueError, "unsupported axis"
+
+ # To preserve orientation of result...
+ def sum(self, axis=None, dtype=None, out=None):
+ """Sum the matrix over the given axis. If the axis is None, sum
+ over all dimensions. This preserves the orientation of the
+ result as a row or column.
+ """
+ return N.ndarray.sum(self, axis, dtype, out)._align(axis)
+
+ def mean(self, axis=None, out=None):
+ """Compute the mean along the specified axis.
+
+ Returns the average of the array elements. The average is taken over
+ the flattened array by default, otherwise over the specified axis.
+
+ :Parameters:
+
+ axis : integer
+ Axis along which the means are computed. The default is
+ to compute the standard deviation of the flattened array.
+
+ dtype : type
+ Type to use in computing the means. For arrays of integer type
+ the default is float32, for arrays of float types it is the
+ same as the array type.
+
+ out : ndarray
+ Alternative output array in which to place the result. It must
+ have the same shape as the expected output but the type will be
+ cast if necessary.
+
+ :Returns:
+
+ mean : The return type varies, see above.
+ A new array holding the result is returned unless out is
+ specified, in which case a reference to out is returned.
+
+ :SeeAlso:
+
+ - var : variance
+ - std : standard deviation
+
+ Notes
+ -----
+
+ The mean is the sum of the elements along the axis divided by the
+ number of elements.
+
+ """
+ return N.ndarray.mean(self, axis, out)._align(axis)
+
+ def std(self, axis=None, dtype=None, out=None):
+ """Compute the standard deviation along the specified axis.
+
+ Returns the standard deviation of the array elements, a measure of the
+ spread of a distribution. The standard deviation is computed for the
+ flattened array by default, otherwise over the specified axis.
+
+ :Parameters:
+
+ axis : integer
+ Axis along which the standard deviation is computed. The
+ default is to compute the standard deviation of the flattened
+ array.
+
+ dtype : type
+ Type to use in computing the standard deviation. For arrays of
+ integer type the default is float32, for arrays of float types
+ it is the same as the array type.
+
+ out : ndarray
+ Alternative output array in which to place the result. It must
+ have the same shape as the expected output but the type will be
+ cast if necessary.
+
+ :Returns:
+
+ standard deviation : The return type varies, see above.
+ A new array holding the result is returned unless out is
+ specified, in which case a reference to out is returned.
+
+ :SeeAlso:
+
+ - var : variance
+ - mean : average
+
+ Notes
+ -----
+
+ The standard deviation is the square root of the average of the
+ squared deviations from the mean, i.e. var = sqrt(mean((x -
+ x.mean())**2)). The computed standard deviation is biased, i.e., the
+ mean is computed by dividing by the number of elements, N, rather
+ than by N-1.
+
+ """
+ return N.ndarray.std(self, axis, dtype, out)._align(axis)
+
+ def var(self, axis=None, dtype=None, out=None):
+ """Compute the variance along the specified axis.
+
+ Returns the variance of the array elements, a measure of the spread of
+ a distribution. The variance is computed for the flattened array by
+ default, otherwise over the specified axis.
+
+ :Parameters:
+
+ axis : integer
+ Axis along which the variance is computed. The default is to
+ compute the variance of the flattened array.
+
+ dtype : type
+ Type to use in computing the variance. For arrays of integer
+ type the default is float32, for arrays of float types it is
+ the same as the array type.
+
+ out : ndarray
+ Alternative output array in which to place the result. It must
+ have the same shape as the expected output but the type will be
+ cast if necessary.
+
+ :Returns:
+
+ variance : depends, see above
+ A new array holding the result is returned unless out is
+ specified, in which case a reference to out is returned.
+
+ :SeeAlso:
+
+ - std : standard deviation
+ - mean : average
+
+ Notes
+ -----
+
+ The variance is the average of the squared deviations from the mean,
+ i.e. var = mean((x - x.mean())**2). The computed variance is
+ biased, i.e., the mean is computed by dividing by the number of
+ elements, N, rather than by N-1.
+
+ """
+ return N.ndarray.var(self, axis, dtype, out)._align(axis)
+
+ def prod(self, axis=None, dtype=None, out=None):
+ return N.ndarray.prod(self, axis, dtype, out)._align(axis)
+
+ def any(self, axis=None, out=None):
+ return N.ndarray.any(self, axis, out)._align(axis)
+
+ def all(self, axis=None, out=None):
+ return N.ndarray.all(self, axis, out)._align(axis)
+
+ def max(self, axis=None, out=None):
+ return N.ndarray.max(self, axis, out)._align(axis)
+
+ def argmax(self, axis=None, out=None):
+ return N.ndarray.argmax(self, axis, out)._align(axis)
+
+ def min(self, axis=None, out=None):
+ return N.ndarray.min(self, axis, out)._align(axis)
+
+ def argmin(self, axis=None, out=None):
+ return N.ndarray.argmin(self, axis, out)._align(axis)
+
+ def ptp(self, axis=None, out=None):
+ return N.ndarray.ptp(self, axis, out)._align(axis)
+
+ # Needed becase tolist method expects a[i]
+ # to have dimension a.ndim-1
+ def tolist(self):
+ return self.__array__().tolist()
+
+ def getI(self):
+ M,N = self.shape
+ if M == N:
+ from numpy.dual import inv as func
+ else:
+ from numpy.dual import pinv as func
+ return asmatrix(func(self))
+
+ def getA(self):
+ return self.__array__()
+
+ def getA1(self):
+ return self.__array__().ravel()
+
+ def getT(self):
+ return self.transpose()
+
+ def getH(self):
+ if issubclass(self.dtype.type, N.complexfloating):
+ return self.transpose().conjugate()
+ else:
+ return self.transpose()
+
+ T = property(getT, None, doc="transpose")
+ A = property(getA, None, doc="base array")
+ A1 = property(getA1, None, doc="1-d base array")
+ H = property(getH, None, doc="hermitian (conjugate) transpose")
+ I = property(getI, None, doc="inverse")
+
+def _from_string(str,gdict,ldict):
+ rows = str.split(';')
+ rowtup = []
+ for row in rows:
+ trow = row.split(',')
+ newrow = []
+ for x in trow:
+ newrow.extend(x.split())
+ trow = newrow
+ coltup = []
+ for col in trow:
+ col = col.strip()
+ try:
+ thismat = ldict[col]
+ except KeyError:
+ try:
+ thismat = gdict[col]
+ except KeyError:
+ raise KeyError, "%s not found" % (col,)
+
+ coltup.append(thismat)
+ rowtup.append(concatenate(coltup,axis=-1))
+ return concatenate(rowtup,axis=0)
+
+
+def bmat(obj, ldict=None, gdict=None):
+ """Build a matrix object from string, nested sequence, or array.
+
+ Ex: F = bmat('A, B; C, D')
+ F = bmat([[A,B],[C,D]])
+ F = bmat(r_[c_[A,B],c_[C,D]])
+
+ all produce the same Matrix Object [ A B ]
+ [ C D ]
+
+ if A, B, C, and D are appropriately shaped 2-d arrays.
+ """
+ if isinstance(obj, str):
+ if gdict is None:
+ # get previous frame
+ frame = sys._getframe().f_back
+ glob_dict = frame.f_globals
+ loc_dict = frame.f_locals
+ else:
+ glob_dict = gdict
+ loc_dict = ldict
+
+ return matrix(_from_string(obj, glob_dict, loc_dict))
+
+ if isinstance(obj, (tuple, list)):
+ # [[A,B],[C,D]]
+ arr_rows = []
+ for row in obj:
+ if isinstance(row, N.ndarray): # not 2-d
+ return matrix(concatenate(obj,axis=-1))
+ else:
+ arr_rows.append(concatenate(row,axis=-1))
+ return matrix(concatenate(arr_rows,axis=0))
+ if isinstance(obj, N.ndarray):
+ return matrix(obj)
+
+mat = asmatrix
diff --git a/numpy/core/fromnumeric.py b/numpy/core/fromnumeric.py
new file mode 100644
index 000000000..6fec268a4
--- /dev/null
+++ b/numpy/core/fromnumeric.py
@@ -0,0 +1,985 @@
+# Module containing non-deprecated functions borrowed from Numeric.
+__docformat__ = "restructuredtext en"
+
+# functions that are now methods
+__all__ = ['take', 'reshape', 'choose', 'repeat', 'put',
+ 'swapaxes', 'transpose', 'sort', 'argsort', 'argmax', 'argmin',
+ 'searchsorted', 'alen',
+ 'resize', 'diagonal', 'trace', 'ravel', 'nonzero', 'shape',
+ 'compress', 'clip', 'sum', 'product', 'prod', 'sometrue', 'alltrue',
+ 'any', 'all', 'cumsum', 'cumproduct', 'cumprod', 'ptp', 'ndim',
+ 'rank', 'size', 'around', 'round_', 'mean', 'std', 'var', 'squeeze',
+ 'amax', 'amin',
+ ]
+
+import multiarray as mu
+import umath as um
+import numerictypes as nt
+from numeric import asarray, array, asanyarray, concatenate
+_dt_ = nt.sctype2char
+
+import types
+
+try:
+ _gentype = types.GeneratorType
+except AttributeError:
+ _gentype = types.NoneType
+
+# save away Python sum
+_sum_ = sum
+
+# functions that are now methods
+def _wrapit(obj, method, *args, **kwds):
+ try:
+ wrap = obj.__array_wrap__
+ except AttributeError:
+ wrap = None
+ result = getattr(asarray(obj),method)(*args, **kwds)
+ if wrap and isinstance(result, mu.ndarray):
+ if not isinstance(result, mu.ndarray):
+ result = asarray(result)
+ result = wrap(result)
+ return result
+
+
+def take(a, indices, axis=None, out=None, mode='raise'):
+ """Return an array with values pulled from the given array at the given
+ indices.
+
+ This function does the same thing as "fancy" indexing; however, it can
+ be easier to use if you need to specify a given axis.
+
+ :Parameters:
+ - `a` : array
+ The source array
+ - `indices` : int array
+ The indices of the values to extract.
+ - `axis` : None or int, optional (default=None)
+ The axis over which to select values. None signifies that the
+ operation should be performed over the flattened array.
+ - `out` : array, optional
+ If provided, the result will be inserted into this array. It should
+ be of the appropriate shape and dtype.
+ - `mode` : one of 'raise', 'wrap', or 'clip', optional
+ (default='raise')
+ Specifies how out-of-bounds indices will behave.
+ - 'raise' : raise an error
+ - 'wrap' : wrap around
+ - 'clip' : clip to the range
+
+ :Returns:
+ - `subarray` : array
+
+ :See also:
+ numpy.ndarray.take() is the equivalent method.
+ """
+ try:
+ take = a.take
+ except AttributeError:
+ return _wrapit(a, 'take', indices, axis, out, mode)
+ return take(indices, axis, out, mode)
+
+
+# not deprecated --- copy if necessary, view otherwise
+def reshape(a, newshape, order='C'):
+ """Return an array that uses the data of the given array, but with a new
+ shape.
+
+ :Parameters:
+ - `a` : array
+ - `newshape` : shape tuple or int
+ The new shape should be compatible with the original shape. If an
+ integer, then the result will be a 1D array of that length.
+ - `order` : 'C' or 'FORTRAN', optional (default='C')
+ Whether the array data should be viewed as in C (row-major) order or
+ FORTRAN (column-major) order.
+
+ :Returns:
+ - `reshaped_array` : array
+ This will be a new view object if possible; otherwise, it will
+ return a copy.
+
+ :See also:
+ numpy.ndarray.reshape() is the equivalent method.
+ """
+ try:
+ reshape = a.reshape
+ except AttributeError:
+ return _wrapit(a, 'reshape', newshape, order=order)
+ return reshape(newshape, order=order)
+
+
+def choose(a, choices, out=None, mode='raise'):
+ """Use an index array to construct a new array from a set of choices.
+
+ Given an array of integers in {0, 1, ..., n-1} and a set of n choice
+ arrays, this function will create a new array that merges each of the
+ choice arrays. Where a value in `a` is i, then the new array will have
+ the value that choices[i] contains in the same place.
+
+ :Parameters:
+ - `a` : int array
+ This array must contain integers in [0, n-1], where n is the number
+ of choices.
+ - `choices` : sequence of arrays
+ Each of the choice arrays should have the same shape as the index
+ array.
+ - `out` : array, optional
+ If provided, the result will be inserted into this array. It should
+ be of the appropriate shape and dtype
+ - `mode` : one of 'raise', 'wrap', or 'clip', optional (default='raise')
+ Specifies how out-of-bounds indices will behave.
+ - 'raise' : raise an error
+ - 'wrap' : wrap around
+ - 'clip' : clip to the range
+
+ :Returns:
+ - `merged_array` : array
+
+ :See also:
+ numpy.ndarray.choose() is the equivalent method.
+
+ :Example:
+ >>> choices = [[0, 1, 2, 3], [10, 11, 12, 13],
+ ... [20, 21, 22, 23], [30, 31, 32, 33]]
+ >>> choose([2, 3, 1, 0], choices)
+ array([20, 31, 12, 3])
+ >>> choose([2, 4, 1, 0], choices, mode='clip')
+ array([20, 31, 12, 3])
+ >>> choose([2, 4, 1, 0], choices, mode='wrap')
+ array([20, 1, 12, 3])
+
+ """
+ try:
+ choose = a.choose
+ except AttributeError:
+ return _wrapit(a, 'choose', choices, out=out, mode=mode)
+ return choose(choices, out=out, mode=mode)
+
+
+def repeat(a, repeats, axis=None):
+ """Repeat elements of an array.
+
+ :Parameters:
+ - `a` : array
+ - `repeats` : int or int array
+ The number of repetitions for each element. If a plain integer, then
+ it is applied to all elements. If an array, it needs to be of the
+ same length as the chosen axis.
+ - `axis` : None or int, optional (default=None)
+ The axis along which to repeat values. If None, then this function
+ will operated on the flattened array `a` and return a similarly flat
+ result.
+
+ :Returns:
+ - `repeated_array` : array
+
+ :See also:
+ numpy.ndarray.repeat() is the equivalent method.
+
+ :Example:
+ >>> repeat([0, 1, 2], 2)
+ array([0, 0, 1, 1, 2, 2])
+ >>> repeat([0, 1, 2], [2, 3, 4])
+ array([0, 0, 1, 1, 1, 2, 2, 2, 2])
+
+ """
+ try:
+ repeat = a.repeat
+ except AttributeError:
+ return _wrapit(a, 'repeat', repeats, axis)
+ return repeat(repeats, axis)
+
+
+def put (a, ind, v, mode='raise'):
+ """put(a, ind, v) results in a[n] = v[n] for all n in ind. If v is
+ shorter than mask it will be repeated as necessary. In particular v can
+ be a scalar or length 1 array. The routine put is the equivalent of the
+ following (although the loop is in C for speed):
+
+ ind = array(indices, copy=False)
+ v = array(values, copy=False).astype(a.dtype)
+ for i in ind: a.flat[i] = v[i]
+ a must be a contiguous numpy array.
+ """
+ return a.put(ind, v, mode)
+
+
+def swapaxes(a, axis1, axis2):
+ """swapaxes(a, axis1, axis2) returns array a with axis1 and axis2
+ interchanged.
+ """
+ try:
+ swapaxes = a.swapaxes
+ except AttributeError:
+ return _wrapit(a, 'swapaxes', axis1, axis2)
+ return swapaxes(axis1, axis2)
+
+
+def transpose(a, axes=None):
+ """transpose(a, axes=None) returns a view of the array with dimensions
+ permuted according to axes. If axes is None (default) returns array
+ with dimensions reversed.
+ """
+ try:
+ transpose = a.transpose
+ except AttributeError:
+ return _wrapit(a, 'transpose', axes)
+ return transpose(axes)
+
+
+def sort(a, axis=-1, kind='quicksort', order=None):
+ """Return copy of 'a' sorted along the given axis.
+
+ *Description*
+
+ Perform an inplace sort along the given axis using the algorithm
+ specified by the kind keyword.
+
+ *Parameters*:
+
+ a : array type
+ Array to be sorted.
+
+ axis : integer
+ Axis to be sorted along. None indicates that the flattened
+ array should be used. Default is -1.
+
+ kind : string
+ Sorting algorithm to use. Possible values are 'quicksort',
+ 'mergesort', or 'heapsort'. Default is 'quicksort'.
+
+ order : list type or None
+ When a is an array with fields defined, this argument
+ specifies which fields to compare first, second, etc. Not
+ all fields need be specified.
+
+ *Returns*:
+
+ sorted_array : type is unchanged.
+
+ *SeeAlso*:
+
+ argsort
+ Indirect sort
+ lexsort
+ Indirect stable sort on multiple keys
+ searchsorted
+ Find keys in sorted array
+
+ *Notes*
+
+ The various sorts are characterized by average speed, worst case
+ performance, need for work space, and whether they are stable. A
+ stable sort keeps items with the same key in the same relative
+ order. The three available algorithms have the following
+ properties:
+
+ +-----------+-------+-------------+------------+-------+
+ | kind | speed | worst case | work space | stable|
+ +===========+=======+=============+============+=======+
+ | quicksort | 1 | O(n^2) | 0 | no |
+ +-----------+-------+-------------+------------+-------+
+ | mergesort | 2 | O(n*log(n)) | ~n/2 | yes |
+ +-----------+-------+-------------+------------+-------+
+ | heapsort | 3 | O(n*log(n)) | 0 | no |
+ +-----------+-------+-------------+------------+-------+
+
+ All the sort algorithms make temporary copies of the data when
+ the sort is not along the last axis. Consequently, sorts along
+ the last axis are faster and use less space than sorts along
+ other axis.
+
+ """
+ if axis is None:
+ a = asanyarray(a).flatten()
+ axis = 0
+ else:
+ a = asanyarray(a).copy()
+ a.sort(axis, kind, order)
+ return a
+
+
+def argsort(a, axis=-1, kind='quicksort', order=None):
+ """Returns array of indices that index 'a' in sorted order.
+
+ *Description*
+
+ Perform an indirect sort along the given axis using the algorithm
+ specified by the kind keyword. It returns an array of indices of the
+ same shape as a that index data along the given axis in sorted order.
+
+ *Parameters*:
+
+ a : array type
+ Array containing values that the returned indices should
+ sort.
+
+ axis : integer
+ Axis to be indirectly sorted. None indicates that the
+ flattened array should be used. Default is -1.
+
+ kind : string
+ Sorting algorithm to use. Possible values are 'quicksort',
+ 'mergesort', or 'heapsort'. Default is 'quicksort'.
+
+ order : list type or None
+ When a is an array with fields defined, this argument
+ specifies which fields to compare first, second, etc. Not
+ all fields need be specified.
+
+ *Returns*:
+
+ indices : integer array
+ Array of indices that sort 'a' along the specified axis.
+
+ *SeeAlso*:
+
+ lexsort
+ Indirect stable sort with multiple keys
+ sort
+ Inplace sort
+
+ *Notes*
+
+ The various sorts are characterized by average speed, worst case
+ performance, need for work space, and whether they are stable. A
+ stable sort keeps items with the same key in the same relative
+ order. The three available algorithms have the following
+ properties:
+
+ +-----------+-------+-------------+------------+-------+
+ | kind | speed | worst case | work space | stable|
+ +===========+=======+=============+============+=======+
+ | quicksort | 1 | O(n^2) | 0 | no |
+ +-----------+-------+-------------+------------+-------+
+ | mergesort | 2 | O(n*log(n)) | ~n/2 | yes |
+ +-----------+-------+-------------+------------+-------+
+ | heapsort | 3 | O(n*log(n)) | 0 | no |
+ +-----------+-------+-------------+------------+-------+
+
+ All the sort algorithms make temporary copies of the data when
+ the sort is not along the last axis. Consequently, sorts along
+ the last axis are faster and use less space than sorts along
+ other axis.
+
+ """
+ try:
+ argsort = a.argsort
+ except AttributeError:
+ return _wrapit(a, 'argsort', axis, kind, order)
+ return argsort(axis, kind, order)
+
+
+def argmax(a, axis=None):
+ """argmax(a,axis=None) returns the indices to the maximum value of the
+ 1-D arrays along the given axis.
+ """
+ try:
+ argmax = a.argmax
+ except AttributeError:
+ return _wrapit(a, 'argmax', axis)
+ return argmax(axis)
+
+
+def argmin(a, axis=None):
+ """argmin(a,axis=None) returns the indices to the minimum value of the
+ 1-D arrays along the given axis.
+ """
+ try:
+ argmin = a.argmin
+ except AttributeError:
+ return _wrapit(a, 'argmin', axis)
+ return argmin(axis)
+
+
+def searchsorted(a, v, side='left'):
+ """Returns indices where keys in v should be inserted to maintain order.
+
+ *Description*
+
+ Find the indices into a sorted array such that if the
+ corresponding keys in v were inserted before the indices the
+ order of a would be preserved. If side='left', then the first
+ such index is returned. If side='right', then the last such index
+ is returned. If there is no such index because the key is out of
+ bounds, then the length of a is returned, i.e., the key would
+ need to be appended. The returned index array has the same shape
+ as v.
+
+ *Parameters*:
+
+ a : array
+ 1-d array sorted in ascending order.
+
+ v : array or list type
+ Array of keys to be searched for in a.
+
+ side : string
+ Possible values are : 'left', 'right'. Default is 'left'.
+ Return the first or last index where the key could be
+ inserted.
+
+ *Returns*:
+
+ indices : integer array
+ Array of insertion points with the same shape as v.
+
+ *SeeAlso*:
+
+ sort
+ Inplace sort
+ histogram
+ Produce histogram from 1-d data
+
+
+ *Notes*
+
+ The array a must be 1-d and is assumed to be sorted in ascending
+ order. Searchsorted uses binary search to find the required
+ insertion points.
+
+ """
+ try:
+ searchsorted = a.searchsorted
+ except AttributeError:
+ return _wrapit(a, 'searchsorted', v, side)
+ return searchsorted(v, side)
+
+
+def resize(a, new_shape):
+ """resize(a,new_shape) returns a new array with the specified shape.
+ The original array's total size can be any size. It fills the new
+ array with repeated copies of a.
+
+ Note that a.resize(new_shape) will fill array with 0's beyond current
+ definition of a.
+ """
+
+ if isinstance(new_shape, (int, nt.integer)):
+ new_shape = (new_shape,)
+ a = ravel(a)
+ Na = len(a)
+ if not Na: return mu.zeros(new_shape, a.dtype.char)
+ total_size = um.multiply.reduce(new_shape)
+ n_copies = int(total_size / Na)
+ extra = total_size % Na
+
+ if total_size == 0:
+ return a[:0]
+
+ if extra != 0:
+ n_copies = n_copies+1
+ extra = Na-extra
+
+ a = concatenate( (a,)*n_copies)
+ if extra > 0:
+ a = a[:-extra]
+
+ return reshape(a, new_shape)
+
+
+def squeeze(a):
+ "Returns a with any ones from the shape of a removed"
+ try:
+ squeeze = a.squeeze
+ except AttributeError:
+ return _wrapit(a, 'squeeze')
+ return squeeze()
+
+
+def diagonal(a, offset=0, axis1=0, axis2=1):
+ """Return specified diagonals. Uses first two indices by default.
+
+ *Description*
+
+ If a is 2-d, returns the diagonal of self with the given offset,
+ i.e., the collection of elements of the form a[i,i+offset]. If a is
+ n-d with n > 2, then the axes specified by axis1 and axis2 are used
+ to determine the 2-d subarray whose diagonal is returned. The shape
+ of the resulting array can be determined by removing axis1 and axis2
+ and appending an index to the right equal to the size of the
+ resulting diagonals.
+
+ *Parameters*:
+
+ offset : integer
+ Offset of the diagonal from the main diagonal. Can be both
+ positive and negative. Defaults to main diagonal.
+
+ axis1 : integer
+ Axis to be used as the first axis of the 2-d subarrays from
+ which the diagonals should be taken. Defaults to first axis.
+
+ axis2 : integer
+ Axis to be used as the second axis of the 2-d subarrays from
+ which the diagonals should be taken. Defaults to second axis.
+
+ *Returns*:
+
+ array_of_diagonals : type of original array
+ If a is 2-d, then a 1-d array containing the diagonal is
+ returned.
+ If a is n-d, n > 2, then an array of diagonals is returned.
+
+ *SeeAlso*:
+
+ diag :
+ Matlab workalike for 1-d and 2-d arrays
+ diagflat :
+ creates diagonal arrays
+ trace :
+ sum along diagonals
+
+ *Examples*:
+
+ >>> a = arange(4).reshape(2,2)
+ >>> a
+ array([[0, 1],
+ [2, 3]])
+ >>> a.diagonal()
+ array([0, 3])
+ >>> a.diagonal(1)
+ array([1])
+
+ >>> a = arange(8).reshape(2,2,2)
+ >>> a
+ array([[[0, 1],
+ [2, 3]],
+ [[4, 5],
+ [6, 7]]])
+ >>> a.diagonal(0,-2,-1)
+ array([[0, 3],
+ [4, 7]])
+
+ """
+ return asarray(a).diagonal(offset, axis1, axis2)
+
+
+def trace(a, offset=0, axis1=0, axis2=1, dtype=None, out=None):
+ """trace(a,offset=0, axis1=0, axis2=1) returns the sum along diagonals
+ (defined by the last two dimenions) of the array.
+ """
+ return asarray(a).trace(offset, axis1, axis2, dtype, out)
+
+def ravel(m,order='C'):
+ """ravel(m) returns a 1d array corresponding to all the elements of
+ its argument. The new array is a view of m if possible, otherwise it
+ is a copy.
+ """
+ a = asarray(m)
+ return a.ravel(order)
+
+def nonzero(a):
+ """nonzero(a) returns the indices of the elements of a which are not zero
+ """
+ try:
+ nonzero = a.nonzero
+ except AttributeError:
+ res = _wrapit(a, 'nonzero')
+ else:
+ res = nonzero()
+ return res
+
+def shape(a):
+ """shape(a) returns the shape of a (as a function call which also
+ works on nested sequences).
+ """
+ try:
+ result = a.shape
+ except AttributeError:
+ result = asarray(a).shape
+ return result
+
+def compress(condition, m, axis=None, out=None):
+ """compress(condition, x, axis=None) = those elements of x corresponding
+ to those elements of condition that are "true". condition must be the
+ same size as the given dimension of x."""
+ try:
+ compress = m.compress
+ except AttributeError:
+ return _wrapit(m, 'compress', condition, axis, out)
+ return compress(condition, axis, out)
+
+def clip(m, m_min, m_max):
+ """clip(m, m_min, m_max) = every entry in m that is less than m_min is
+ replaced by m_min, and every entry greater than m_max is replaced by
+ m_max.
+ """
+ try:
+ clip = m.clip
+ except AttributeError:
+ return _wrapit(m, 'clip', m_min, m_max)
+ return clip(m_min, m_max)
+
+def sum(x, axis=None, dtype=None, out=None):
+ """Sum the array over the given axis. The optional dtype argument
+ is the data type for intermediate calculations.
+
+ The default is to upcast (promote) smaller integer types to the
+ platform-dependent Int. For example, on 32-bit platforms:
+
+ x.dtype default sum() dtype
+ ---------------------------------------------------
+ bool, int8, int16, int32 int32
+
+ Examples:
+ >>> N.sum([0.5, 1.5])
+ 2.0
+ >>> N.sum([0.5, 1.5], dtype=N.int32)
+ 1
+ >>> N.sum([[0, 1], [0, 5]])
+ 6
+ >>> N.sum([[0, 1], [0, 5]], axis=1)
+ array([1, 5])
+ """
+ if isinstance(x, _gentype):
+ res = _sum_(x)
+ if out is not None:
+ out[...] = res
+ return out
+ return res
+ try:
+ sum = x.sum
+ except AttributeError:
+ return _wrapit(x, 'sum', axis, dtype, out)
+ return sum(axis, dtype, out)
+
+def product (x, axis=None, dtype=None, out=None):
+ """Product of the array elements over the given axis."""
+ try:
+ prod = x.prod
+ except AttributeError:
+ return _wrapit(x, 'prod', axis, dtype, out)
+ return prod(axis, dtype, out)
+
+def sometrue (x, axis=None, out=None):
+ """Perform a logical_or over the given axis."""
+ try:
+ any = x.any
+ except AttributeError:
+ return _wrapit(x, 'any', axis, out)
+ return any(axis, out)
+
+def alltrue (x, axis=None, out=None):
+ """Perform a logical_and over the given axis."""
+ try:
+ all = x.all
+ except AttributeError:
+ return _wrapit(x, 'all', axis, out)
+ return all(axis, out)
+
+def any(x,axis=None, out=None):
+ """Return true if any elements of x are true:
+ """
+ try:
+ any = x.any
+ except AttributeError:
+ return _wrapit(x, 'any', axis, out)
+ return any(axis, out)
+
+def all(x,axis=None, out=None):
+ """Return true if all elements of x are true:
+ """
+ try:
+ all = x.all
+ except AttributeError:
+ return _wrapit(x, 'all', axis, out)
+ return all(axis, out)
+
+def cumsum (x, axis=None, dtype=None, out=None):
+ """Sum the array over the given axis."""
+ try:
+ cumsum = x.cumsum
+ except AttributeError:
+ return _wrapit(x, 'cumsum', axis, dtype, out)
+ return cumsum(axis, dtype, out)
+
+def cumproduct (x, axis=None, dtype=None, out=None):
+ """Sum the array over the given axis."""
+ try:
+ cumprod = x.cumprod
+ except AttributeError:
+ return _wrapit(x, 'cumprod', axis, dtype, out)
+ return cumprod(axis, dtype, out)
+
+def ptp(a, axis=None, out=None):
+ """Return maximum - minimum along the the given dimension
+ """
+ try:
+ ptp = a.ptp
+ except AttributeError:
+ return _wrapit(a, 'ptp', axis, out)
+ return ptp(axis, out)
+
+def amax(a, axis=None, out=None):
+ """Return the maximum of 'a' along dimension axis.
+ """
+ try:
+ amax = a.max
+ except AttributeError:
+ return _wrapit(a, 'max', axis, out)
+ return amax(axis, out)
+
+def amin(a, axis=None, out=None):
+ """Return the minimum of a along dimension axis.
+ """
+ try:
+ amin = a.min
+ except AttributeError:
+ return _wrapit(a, 'min', axis, out)
+ return amin(axis, out)
+
+def alen(a):
+ """Return the length of a Python object interpreted as an array
+ of at least 1 dimension.
+ """
+ try:
+ return len(a)
+ except TypeError:
+ return len(array(a,ndmin=1))
+
+def prod(a, axis=None, dtype=None, out=None):
+ """Return the product of the elements along the given axis
+ """
+ try:
+ prod = a.prod
+ except AttributeError:
+ return _wrapit(a, 'prod', axis, dtype, out)
+ return prod(axis, dtype, out)
+
+def cumprod(a, axis=None, dtype=None, out=None):
+ """Return the cumulative product of the elments along the given axis
+ """
+ try:
+ cumprod = a.cumprod
+ except AttributeError:
+ return _wrapit(a, 'cumprod', axis, dtype, out)
+ return cumprod(axis, dtype, out)
+
+def ndim(a):
+ try:
+ return a.ndim
+ except AttributeError:
+ return asarray(a).ndim
+
+def rank(a):
+ """Get the rank of sequence a (the number of dimensions, not a matrix rank)
+ The rank of a scalar is zero.
+ """
+ try:
+ return a.ndim
+ except AttributeError:
+ return asarray(a).ndim
+
+def size (a, axis=None):
+ "Get the number of elements in sequence a, or along a certain axis."
+ if axis is None:
+ try:
+ return a.size
+ except AttributeError:
+ return asarray(a).size
+ else:
+ try:
+ return a.shape[axis]
+ except AttributeError:
+ return asarray(a).shape[axis]
+
+def round_(a, decimals=0, out=None):
+ """Returns reference to result. Copies a and rounds to 'decimals' places.
+
+ Keyword arguments:
+ decimals -- number of decimal places to round to (default 0).
+ out -- existing array to use for output (default copy of a).
+
+ Returns:
+ Reference to out, where None specifies a copy of the original
+ array a.
+
+ Round to the specified number of decimals. When 'decimals' is
+ negative it specifies the number of positions to the left of the
+ decimal point. The real and imaginary parts of complex numbers are
+ rounded separately. Nothing is done if the array is not of float
+ type and 'decimals' is greater than or equal to 0.
+
+ The keyword 'out' may be used to specify a different array to hold
+ the result rather than the default 'a'. If the type of the array
+ specified by 'out' differs from that of 'a', the result is cast to
+ the new type, otherwise the original type is kept. Floats round to
+ floats by default.
+
+ Numpy rounds to even. Thus 1.5 and 2.5 round to 2.0, -0.5 and 0.5
+ round to 0.0, etc. Results may also be surprising due to the inexact
+ representation of decimal fractions in IEEE floating point and the
+ errors introduced in scaling the numbers when 'decimals' is something
+ other than 0.
+
+ The function around is an alias for round_.
+
+ """
+ try:
+ round = a.round
+ except AttributeError:
+ return _wrapit(a, 'round', decimals, out)
+ return round(decimals, out)
+
+around = round_
+
+def mean(a, axis=None, dtype=None, out=None):
+ """Compute the mean along the specified axis.
+
+ *Description*
+
+ Returns the average of the array elements. The average is taken
+ over the flattened array by default, otherwise over the specified
+ axis.
+
+ *Parameters*:
+
+ axis : integer
+ Axis along which the means are computed. The default is
+ to compute the standard deviation of the flattened array.
+
+ dtype : type
+ Type to use in computing the means. For arrays of integer
+ type the default is float32, for arrays of float types it is
+ the same as the array type.
+
+ out : ndarray
+ Alternative output array in which to place the result. It
+ must have the same shape as the expected output but the type
+ will be cast if necessary.
+
+ *Returns*:
+
+ mean : The return type varies, see above.
+ A new array holding the result is returned unless out is
+ specified, in which case a reference to out is returned.
+
+ *SeeAlso*:
+
+ var
+ Variance
+ std
+ Standard deviation
+
+ *Notes*
+
+ The mean is the sum of the elements along the axis divided by the
+ number of elements.
+
+ """
+ try:
+ mean = a.mean
+ except AttributeError:
+ return _wrapit(a, 'mean', axis, dtype, out)
+ return mean(axis, dtype, out)
+
+
+def std(a, axis=None, dtype=None, out=None):
+ """Compute the standard deviation along the specified axis.
+
+ *Description*
+
+ Returns the standard deviation of the array elements, a measure
+ of the spread of a distribution. The standard deviation is
+ computed for the flattened array by default, otherwise over the
+ specified axis.
+
+ *Parameters*:
+
+ axis : integer
+ Axis along which the standard deviation is computed. The
+ default is to compute the standard deviation of the flattened
+ array.
+
+ dtype : type
+ Type to use in computing the standard deviation. For arrays
+ of integer type the default is float32, for arrays of float
+ types it is the same as the array type.
+
+ out : ndarray
+ Alternative output array in which to place the result. It
+ must have the same shape as the expected output but the type
+ will be cast if necessary.
+
+ *Returns*:
+
+ standard_deviation : The return type varies, see above.
+ A new array holding the result is returned unless out is
+ specified, in which case a reference to out is returned.
+
+ *SeeAlso*:
+
+ var
+ Variance
+ mean
+ Average
+
+ *Notes*
+
+ The standard deviation is the square root of the average of the
+ squared deviations from the mean, i.e. var = sqrt(mean((x -
+ x.mean())**2)). The computed standard deviation is biased, i.e.,
+ the mean is computed by dividing by the number of elements, N,
+ rather than by N-1.
+
+ """
+ try:
+ std = a.std
+ except AttributeError:
+ return _wrapit(a, 'std', axis, dtype, out)
+ return std(axis, dtype, out)
+
+
+def var(a, axis=None, dtype=None, out=None):
+ """Compute the variance along the specified axis.
+
+ *Description*
+
+ Returns the variance of the array elements, a measure of the
+ spread of a distribution. The variance is computed for the
+ flattened array by default, otherwise over the specified axis.
+
+ *Parameters*:
+
+ axis : integer
+ Axis along which the variance is computed. The default is to
+ compute the variance of the flattened array.
+
+ dtype : type
+ Type to use in computing the variance. For arrays of integer
+ type the default is float32, for arrays of float types it is
+ the same as the array type.
+
+ out : ndarray
+ Alternative output array in which to place the result. It
+ must have the same shape as the expected output but the type
+ will be cast if necessary.
+
+ *Returns*:
+
+ variance : depends, see above
+ A new array holding the result is returned unless out is
+ specified, in which case a reference to out is returned.
+
+ *SeeAlso*:
+
+ std
+ Standard deviation
+ mean
+ Average
+
+ *Notes*
+
+ The variance is the average of the squared deviations from the
+ mean, i.e. var = mean((x - x.mean())**2). The computed variance
+ is biased, i.e., the mean is computed by dividing by the number
+ of elements, N, rather than by N-1.
+
+ """
+ try:
+ var = a.var
+ except AttributeError:
+ return _wrapit(a, 'var', axis, dtype, out)
+ return var(axis, dtype, out)
diff --git a/numpy/core/include/numpy/arrayobject.h b/numpy/core/include/numpy/arrayobject.h
new file mode 100644
index 000000000..f64d2a6c3
--- /dev/null
+++ b/numpy/core/include/numpy/arrayobject.h
@@ -0,0 +1,21 @@
+
+/* This expects the following variables to be defined (besides
+ the usual ones from pyconfig.h
+
+ SIZEOF_LONG_DOUBLE -- sizeof(long double) or sizeof(double) if no
+ long double is present on platform.
+ CHAR_BIT -- number of bits in a char (usually 8)
+ (should be in limits.h)
+
+*/
+
+#ifndef Py_ARRAYOBJECT_H
+#define Py_ARRAYOBJECT_H
+#include "ndarrayobject.h"
+#ifdef NPY_NO_PREFIX
+#include "noprefix.h"
+#endif
+
+#include "npy_interrupt.h"
+
+#endif
diff --git a/numpy/core/include/numpy/arrayscalars.h b/numpy/core/include/numpy/arrayscalars.h
new file mode 100644
index 000000000..4c1658f4c
--- /dev/null
+++ b/numpy/core/include/numpy/arrayscalars.h
@@ -0,0 +1,152 @@
+#ifndef _MULTIARRAYMODULE
+typedef struct {
+ PyObject_HEAD
+ npy_bool obval;
+} PyBoolScalarObject;
+#endif
+
+
+typedef struct {
+ PyObject_HEAD
+ signed char obval;
+} PyByteScalarObject;
+
+
+typedef struct {
+ PyObject_HEAD
+ short obval;
+} PyShortScalarObject;
+
+
+typedef struct {
+ PyObject_HEAD
+ int obval;
+} PyIntScalarObject;
+
+
+typedef struct {
+ PyObject_HEAD
+ long obval;
+} PyLongScalarObject;
+
+
+typedef struct {
+ PyObject_HEAD
+ npy_longlong obval;
+} PyLongLongScalarObject;
+
+
+typedef struct {
+ PyObject_HEAD
+ unsigned char obval;
+} PyUByteScalarObject;
+
+
+typedef struct {
+ PyObject_HEAD
+ unsigned short obval;
+} PyUShortScalarObject;
+
+
+typedef struct {
+ PyObject_HEAD
+ unsigned int obval;
+} PyUIntScalarObject;
+
+
+typedef struct {
+ PyObject_HEAD
+ unsigned long obval;
+} PyULongScalarObject;
+
+
+typedef struct {
+ PyObject_HEAD
+ npy_ulonglong obval;
+} PyULongLongScalarObject;
+
+
+typedef struct {
+ PyObject_HEAD
+ float obval;
+} PyFloatScalarObject;
+
+
+typedef struct {
+ PyObject_HEAD
+ double obval;
+} PyDoubleScalarObject;
+
+
+typedef struct {
+ PyObject_HEAD
+ npy_longdouble obval;
+} PyLongDoubleScalarObject;
+
+
+typedef struct {
+ PyObject_HEAD
+ npy_cfloat obval;
+} PyCFloatScalarObject;
+
+
+typedef struct {
+ PyObject_HEAD
+ npy_cdouble obval;
+} PyCDoubleScalarObject;
+
+
+typedef struct {
+ PyObject_HEAD
+ npy_clongdouble obval;
+} PyCLongDoubleScalarObject;
+
+
+typedef struct {
+ PyObject_HEAD
+ PyObject * obval;
+} PyObjectScalarObject;
+
+
+typedef struct {
+ PyObject_HEAD
+ char obval;
+} PyScalarObject;
+
+#define PyStringScalarObject PyStringObject
+#define PyUnicodeScalarObject PyUnicodeObject
+
+typedef struct {
+ PyObject_VAR_HEAD
+ char *obval;
+ PyArray_Descr *descr;
+ int flags;
+ PyObject *base;
+} PyVoidScalarObject;
+
+/* Macros
+ Py<Cls><bitsize>ScalarObject
+ Py<Cls><bitsize>ArrType_Type
+ are defined in ndarrayobject.h
+*/
+
+#define PyArrayScalar_False ((PyObject *)(&(_PyArrayScalar_BoolValues[0])))
+#define PyArrayScalar_True ((PyObject *)(&(_PyArrayScalar_BoolValues[1])))
+#define PyArrayScalar_FromLong(i) \
+ ((PyObject *)(&(_PyArrayScalar_BoolValues[((i)!=0)])))
+#define PyArrayScalar_RETURN_BOOL_FROM_LONG(i) \
+ return Py_INCREF(PyArrayScalar_FromLong(i)), \
+ PyArrayScalar_FromLong(i)
+#define PyArrayScalar_RETURN_FALSE \
+ return Py_INCREF(PyArrayScalar_False), \
+ PyArrayScalar_False
+#define PyArrayScalar_RETURN_TRUE \
+ return Py_INCREF(PyArrayScalar_True), \
+ PyArrayScalar_True
+
+#define PyArrayScalar_New(cls) \
+ Py##cls##ArrType_Type.tp_alloc(&Py##cls##ArrType_Type, 0)
+#define PyArrayScalar_VAL(obj, cls) \
+ ((Py##cls##ScalarObject *)obj)->obval
+#define PyArrayScalar_ASSIGN(obj, cls, val) \
+ PyArrayScalar_VAL(obj, cls) = val
diff --git a/numpy/core/include/numpy/fenv/fenv.c b/numpy/core/include/numpy/fenv/fenv.c
new file mode 100644
index 000000000..169642ce1
--- /dev/null
+++ b/numpy/core/include/numpy/fenv/fenv.c
@@ -0,0 +1,38 @@
+/*-
+ * Copyright (c) 2004 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ *
+ * $FreeBSD$
+ */
+
+#include <sys/types.h>
+#include "fenv.h"
+
+const fenv_t npy__fe_dfl_env = {
+ 0xffff0000,
+ 0xffff0000,
+ 0xffffffff,
+ { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff }
+};
diff --git a/numpy/core/include/numpy/fenv/fenv.h b/numpy/core/include/numpy/fenv/fenv.h
new file mode 100644
index 000000000..a1371770f
--- /dev/null
+++ b/numpy/core/include/numpy/fenv/fenv.h
@@ -0,0 +1,224 @@
+/*-
+ * Copyright (c) 2004 David Schultz <das@FreeBSD.ORG>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ *
+ * $FreeBSD$
+ */
+
+#ifndef _FENV_H_
+#define _FENV_H_
+
+#include <sys/cdefs.h>
+#include <sys/types.h>
+
+typedef struct {
+ __uint32_t __control;
+ __uint32_t __status;
+ __uint32_t __tag;
+ char __other[16];
+} fenv_t;
+
+typedef __uint16_t fexcept_t;
+
+/* Exception flags */
+#define FE_INVALID 0x01
+#define FE_DENORMAL 0x02
+#define FE_DIVBYZERO 0x04
+#define FE_OVERFLOW 0x08
+#define FE_UNDERFLOW 0x10
+#define FE_INEXACT 0x20
+#define FE_ALL_EXCEPT (FE_DIVBYZERO | FE_DENORMAL | FE_INEXACT | \
+ FE_INVALID | FE_OVERFLOW | FE_UNDERFLOW)
+
+/* Rounding modes */
+#define FE_TONEAREST 0x0000
+#define FE_DOWNWARD 0x0400
+#define FE_UPWARD 0x0800
+#define FE_TOWARDZERO 0x0c00
+#define _ROUND_MASK (FE_TONEAREST | FE_DOWNWARD | \
+ FE_UPWARD | FE_TOWARDZERO)
+
+__BEGIN_DECLS
+
+/* Default floating-point environment */
+extern const fenv_t npy__fe_dfl_env;
+#define FE_DFL_ENV (&npy__fe_dfl_env)
+
+#define __fldcw(__cw) __asm __volatile("fldcw %0" : : "m" (__cw))
+#define __fldenv(__env) __asm __volatile("fldenv %0" : : "m" (__env))
+#define __fnclex() __asm __volatile("fnclex")
+#define __fnstenv(__env) __asm("fnstenv %0" : "=m" (*(__env)))
+#define __fnstcw(__cw) __asm("fnstcw %0" : "=m" (*(__cw)))
+#define __fnstsw(__sw) __asm("fnstsw %0" : "=am" (*(__sw)))
+#define __fwait() __asm __volatile("fwait")
+
+static __inline int
+feclearexcept(int __excepts)
+{
+ fenv_t __env;
+
+ if (__excepts == FE_ALL_EXCEPT) {
+ __fnclex();
+ } else {
+ __fnstenv(&__env);
+ __env.__status &= ~__excepts;
+ __fldenv(__env);
+ }
+ return (0);
+}
+
+static __inline int
+fegetexceptflag(fexcept_t *__flagp, int __excepts)
+{
+ int __status;
+
+ __fnstsw(&__status);
+ *__flagp = __status & __excepts;
+ return (0);
+}
+
+static __inline int
+fesetexceptflag(const fexcept_t *__flagp, int __excepts)
+{
+ fenv_t __env;
+
+ __fnstenv(&__env);
+ __env.__status &= ~__excepts;
+ __env.__status |= *__flagp & __excepts;
+ __fldenv(__env);
+ return (0);
+}
+
+static __inline int
+feraiseexcept(int __excepts)
+{
+ fexcept_t __ex = __excepts;
+
+ fesetexceptflag(&__ex, __excepts);
+ __fwait();
+ return (0);
+}
+
+static __inline int
+fetestexcept(int __excepts)
+{
+ int __status;
+
+ __fnstsw(&__status);
+ return (__status & __excepts);
+}
+
+static __inline int
+fegetround(void)
+{
+ int __control;
+
+ __fnstcw(&__control);
+ return (__control & _ROUND_MASK);
+}
+
+static __inline int
+fesetround(int __round)
+{
+ int __control;
+
+ if (__round & ~_ROUND_MASK)
+ return (-1);
+ __fnstcw(&__control);
+ __control &= ~_ROUND_MASK;
+ __control |= __round;
+ __fldcw(__control);
+ return (0);
+}
+
+static __inline int
+fegetenv(fenv_t *__envp)
+{
+ int __control;
+
+ /*
+ * fnstenv masks all exceptions, so we need to save and
+ * restore the control word to avoid this side effect.
+ */
+ __fnstcw(&__control);
+ __fnstenv(__envp);
+ __fldcw(__control);
+ return (0);
+}
+
+static __inline int
+feholdexcept(fenv_t *__envp)
+{
+
+ __fnstenv(__envp);
+ __fnclex();
+ return (0);
+}
+
+static __inline int
+fesetenv(const fenv_t *__envp)
+{
+
+ __fldenv(*__envp);
+ return (0);
+}
+
+static __inline int
+feupdateenv(const fenv_t *__envp)
+{
+ int __status;
+
+ __fnstsw(&__status);
+ __fldenv(*__envp);
+ feraiseexcept(__status & FE_ALL_EXCEPT);
+ return (0);
+}
+
+#if __BSD_VISIBLE
+
+static __inline int
+fesetmask(int __mask)
+{
+ int __control;
+
+ __fnstcw(&__control);
+ __mask = (__control | FE_ALL_EXCEPT) & ~__mask;
+ __fldcw(__mask);
+ return (~__control & FE_ALL_EXCEPT);
+}
+
+static __inline int
+fegetmask(void)
+{
+ int __control;
+
+ __fnstcw(&__control);
+ return (~__control & FE_ALL_EXCEPT);
+}
+
+#endif /* __BSD_VISIBLE */
+
+__END_DECLS
+
+#endif /* !_FENV_H_ */
diff --git a/numpy/core/include/numpy/ndarrayobject.h b/numpy/core/include/numpy/ndarrayobject.h
new file mode 100644
index 000000000..65b2df121
--- /dev/null
+++ b/numpy/core/include/numpy/ndarrayobject.h
@@ -0,0 +1,1995 @@
+/* DON'T INCLUDE THIS DIRECTLY.
+ */
+
+#ifndef NPY_NDARRAYOBJECT_H
+#define NPY_NDARRAYOBJECT_H
+#ifdef __cplusplus
+#define CONFUSE_EMACS {
+#define CONFUSE_EMACS2 }
+extern "C" CONFUSE_EMACS
+#undef CONFUSE_EMACS
+#undef CONFUSE_EMACS2
+/* ... otherwise a semi-smart identer (like emacs) tries to indent
+ everything when you're typing */
+#endif
+/* This is auto-generated by the installer */
+#include "config.h"
+
+/* There are several places in the code where an array of dimensions is
+ * allocated statically. This is the size of that static allocation.
+ *
+ * The array creation itself could have arbitrary dimensions but
+ * all the places where static allocation is used would need to
+ * be changed to dynamic (including inside of several structures)
+ */
+
+#define NPY_MAXDIMS 32
+#define NPY_MAXARGS 32
+
+/* Used for Converter Functions "O&" code in ParseTuple */
+#define NPY_FAIL 0
+#define NPY_SUCCEED 1
+
+ /* Helpful to distinguish what is installed */
+#define NPY_VERSION 0x01000009
+
+ /* Some platforms don't define bool, long long, or long double.
+ Handle that here.
+ */
+
+#define NPY_BYTE_FMT "hhd"
+#define NPY_UBYTE_FMT "hhu"
+#define NPY_SHORT_FMT "hd"
+#define NPY_USHORT_FMT "hu"
+#define NPY_INT_FMT "d"
+#define NPY_UINT_FMT "u"
+#define NPY_LONG_FMT "ld"
+#define NPY_ULONG_FMT "lu"
+#define NPY_FLOAT_FMT "g"
+#define NPY_DOUBLE_FMT "g"
+
+#ifdef PY_LONG_LONG
+typedef PY_LONG_LONG npy_longlong;
+typedef unsigned PY_LONG_LONG npy_ulonglong;
+# ifdef _MSC_VER
+# define NPY_LONGLONG_FMT "I64d"
+# define NPY_ULONGLONG_FMT "I64u"
+# define NPY_LONGLONG_SUFFIX(x) (x##i64)
+# define NPY_ULONGLONG_SUFFIX(x) (x##Ui64)
+# else
+ /* #define LONGLONG_FMT "lld" Another possible variant
+ #define ULONGLONG_FMT "llu"
+
+ #define LONGLONG_FMT "qd" -- BSD perhaps?
+ #define ULONGLONG_FMT "qu"
+ */
+# define NPY_LONGLONG_FMT "Ld"
+# define NPY_ULONGLONG_FMT "Lu"
+# define NPY_LONGLONG_SUFFIX(x) (x##LL)
+# define NPY_ULONGLONG_SUFFIX(x) (x##ULL)
+# endif
+#else
+typedef long npy_longlong;
+typedef unsigned long npy_ulonglong;
+# define NPY_LONGLONG_SUFFIX(x) (x##L)
+# define NPY_ULONGLONG_SUFFIX(x) (x##UL)
+#endif
+
+
+typedef unsigned char npy_bool;
+#define NPY_FALSE 0
+#define NPY_TRUE 1
+
+#if SIZEOF_LONG_DOUBLE==SIZEOF_DOUBLE
+ typedef double npy_longdouble;
+ #define NPY_LONGDOUBLE_FMT "g"
+#else
+ typedef long double npy_longdouble;
+ #define NPY_LONGDOUBLE_FMT "Lg"
+#endif
+
+#ifndef Py_USING_UNICODE
+#error Must use Python with unicode enabled.
+#endif
+
+
+typedef signed char npy_byte;
+typedef unsigned char npy_ubyte;
+typedef unsigned short npy_ushort;
+typedef unsigned int npy_uint;
+typedef unsigned long npy_ulong;
+
+/* These are for completeness */
+typedef float npy_float;
+typedef double npy_double;
+typedef short npy_short;
+typedef int npy_int;
+typedef long npy_long;
+
+typedef struct { float real, imag; } npy_cfloat;
+typedef struct { double real, imag; } npy_cdouble;
+typedef struct {npy_longdouble real, imag;} npy_clongdouble;
+
+enum NPY_TYPES { NPY_BOOL=0,
+ NPY_BYTE, NPY_UBYTE,
+ NPY_SHORT, NPY_USHORT,
+ NPY_INT, NPY_UINT,
+ NPY_LONG, NPY_ULONG,
+ NPY_LONGLONG, NPY_ULONGLONG,
+ NPY_FLOAT, NPY_DOUBLE, NPY_LONGDOUBLE,
+ NPY_CFLOAT, NPY_CDOUBLE, NPY_CLONGDOUBLE,
+ NPY_OBJECT=17,
+ NPY_STRING, NPY_UNICODE,
+ NPY_VOID,
+ NPY_NTYPES,
+ NPY_NOTYPE,
+ NPY_CHAR, /* special flag */
+ NPY_USERDEF=256 /* leave room for characters */
+};
+
+/* basetype array priority */
+#define NPY_PRIORITY 0.0
+
+/* default subtype priority */
+#define NPY_SUBTYPE_PRIORITY 1.0
+
+/* default scalar priority */
+#define NPY_SCALAR_PRIORITY -1000000.0
+
+/* How many floating point types are there */
+#define NPY_NUM_FLOATTYPE 3
+
+/* We need to match npy_intp to a signed integer of the same size as
+ a pointer variable. npy_uintp to the equivalent unsigned integer
+*/
+
+
+/* These characters correspond to the array type and the
+ struct module */
+
+/* except 'p' -- signed integer for pointer type */
+
+enum NPY_TYPECHAR { NPY_BOOLLTR = '?',
+ NPY_BYTELTR = 'b',
+ NPY_UBYTELTR = 'B',
+ NPY_SHORTLTR = 'h',
+ NPY_USHORTLTR = 'H',
+ NPY_INTLTR = 'i',
+ NPY_UINTLTR = 'I',
+ NPY_LONGLTR = 'l',
+ NPY_ULONGLTR = 'L',
+ NPY_LONGLONGLTR = 'q',
+ NPY_ULONGLONGLTR = 'Q',
+ NPY_FLOATLTR = 'f',
+ NPY_DOUBLELTR = 'd',
+ NPY_LONGDOUBLELTR = 'g',
+ NPY_CFLOATLTR = 'F',
+ NPY_CDOUBLELTR = 'D',
+ NPY_CLONGDOUBLELTR = 'G',
+ NPY_OBJECTLTR = 'O',
+ NPY_STRINGLTR = 'S',
+ NPY_STRINGLTR2 = 'a',
+ NPY_UNICODELTR = 'U',
+ NPY_VOIDLTR = 'V',
+ NPY_CHARLTR = 'c',
+
+ /* No Descriptor, just a define -- this let's
+ Python users specify an array of integers
+ large enough to hold a pointer on the platform*/
+ NPY_INTPLTR = 'p',
+ NPY_UINTPLTR = 'P',
+
+ NPY_GENBOOLLTR ='b',
+ NPY_SIGNEDLTR = 'i',
+ NPY_UNSIGNEDLTR = 'u',
+ NPY_FLOATINGLTR = 'f',
+ NPY_COMPLEXLTR = 'c'
+};
+
+typedef enum {
+ NPY_QUICKSORT=0,
+ NPY_HEAPSORT=1,
+ NPY_MERGESORT=2,
+} NPY_SORTKIND;
+#define NPY_NSORTS (NPY_MERGESORT + 1)
+
+
+typedef enum {
+ NPY_SEARCHLEFT=0,
+ NPY_SEARCHRIGHT=1,
+} NPY_SEARCHSIDE;
+#define NPY_NSEARCHSIDES (NPY_SEARCHRIGHT + 1)
+
+
+typedef enum {
+ NPY_NOSCALAR=-1,
+ NPY_BOOL_SCALAR,
+ NPY_INTPOS_SCALAR,
+ NPY_INTNEG_SCALAR,
+ NPY_FLOAT_SCALAR,
+ NPY_COMPLEX_SCALAR,
+ NPY_OBJECT_SCALAR,
+} NPY_SCALARKIND;
+#define NPY_NSCALARKINDS (NPY_OBJECT_SCALAR + 1)
+
+typedef enum {
+ NPY_ANYORDER=-1,
+ NPY_CORDER=0,
+ NPY_FORTRANORDER=1
+} NPY_ORDER;
+
+
+typedef enum {
+ NPY_CLIP=0,
+ NPY_WRAP=1,
+ NPY_RAISE=2
+} NPY_CLIPMODE;
+
+ /* Define bit-width array types and typedefs */
+
+#define NPY_MAX_INT8 127
+#define NPY_MIN_INT8 -128
+#define NPY_MAX_UINT8 255
+#define NPY_MAX_INT16 32767
+#define NPY_MIN_INT16 -32768
+#define NPY_MAX_UINT16 65535
+#define NPY_MAX_INT32 2147483647
+#define NPY_MIN_INT32 (-NPY_MAX_INT32 - 1)
+#define NPY_MAX_UINT32 4294967295U
+#define NPY_MAX_INT64 NPY_LONGLONG_SUFFIX(9223372036854775807)
+#define NPY_MIN_INT64 (-NPY_MAX_INT64 - NPY_LONGLONG_SUFFIX(1))
+#define NPY_MAX_UINT64 NPY_ULONGLONG_SUFFIX(18446744073709551615)
+#define NPY_MAX_INT128 NPY_LONGLONG_SUFFIX(85070591730234615865843651857942052864)
+#define NPY_MIN_INT128 (-NPY_MAX_INT128 - NPY_LONGLONG_SUFFIX(1))
+#define NPY_MAX_UINT128 NPY_ULONGLONG_SUFFIX(170141183460469231731687303715884105728)
+#define NPY_MAX_INT256 NPY_LONGLONG_SUFFIX(57896044618658097711785492504343953926634992332820282019728792003956564819967)
+#define NPY_MIN_INT256 (-NPY_MAX_INT256 - NPY_LONGLONG_SUFFIX(1))
+#define NPY_MAX_UINT256 NPY_ULONGLONG_SUFFIX(115792089237316195423570985008687907853269984665640564039457584007913129639935)
+
+ /* Need to find the number of bits for each type and
+ make definitions accordingly.
+
+ C states that sizeof(char) == 1 by definition
+
+ So, just using the sizeof keyword won't help.
+
+ It also looks like Python itself uses sizeof(char) quite a
+ bit, which by definition should be 1 all the time.
+
+ Idea: Make Use of CHAR_BIT which should tell us how many
+ BITS per CHARACTER
+ */
+
+ /* Include platform definitions -- These are in the C89/90 standard */
+#include <limits.h>
+#define NPY_MAX_BYTE SCHAR_MAX
+#define NPY_MIN_BYTE SCHAR_MIN
+#define NPY_MAX_UBYTE UCHAR_MAX
+#define NPY_MAX_SHORT SHRT_MAX
+#define NPY_MIN_SHORT SHRT_MIN
+#define NPY_MAX_USHORT USHRT_MAX
+#define NPY_MAX_INT INT_MAX
+#ifndef INT_MIN
+#define INT_MIN (-INT_MAX - 1)
+#endif
+#define NPY_MIN_INT INT_MIN
+#define NPY_MAX_UINT UINT_MAX
+#define NPY_MAX_LONG LONG_MAX
+#define NPY_MIN_LONG LONG_MIN
+#define NPY_MAX_ULONG ULONG_MAX
+
+
+#define NPY_SIZEOF_LONG SIZEOF_LONG
+#define NPY_SIZEOF_INT SIZEOF_INT
+#define NPY_SIZEOF_SHORT SIZEOF_SHORT
+#define NPY_SIZEOF_FLOAT SIZEOF_FLOAT
+#define NPY_SIZEOF_DOUBLE SIZEOF_DOUBLE
+#define NPY_SIZEOF_LONGDOUBLE SIZEOF_LONG_DOUBLE
+#define NPY_SIZEOF_LONGLONG SIZEOF_LONG_LONG
+#define NPY_BITSOF_BOOL (sizeof(npy_bool)*CHAR_BIT)
+#define NPY_BITSOF_CHAR CHAR_BIT
+#define NPY_BITSOF_SHORT (SIZEOF_SHORT*CHAR_BIT)
+#define NPY_BITSOF_INT (SIZEOF_INT*CHAR_BIT)
+#define NPY_BITSOF_LONG (SIZEOF_LONG*CHAR_BIT)
+#define NPY_BITSOF_LONGLONG (NPY_SIZEOF_LONGLONG*CHAR_BIT)
+#define NPY_BITSOF_FLOAT (SIZEOF_FLOAT*CHAR_BIT)
+#define NPY_BITSOF_DOUBLE (SIZEOF_DOUBLE*CHAR_BIT)
+#define NPY_BITSOF_LONGDOUBLE (NPY_SIZEOF_LONGDOUBLE*CHAR_BIT)
+
+#if NPY_BITSOF_LONG == 8
+#define NPY_INT8 NPY_LONG
+#define NPY_UINT8 NPY_ULONG
+ typedef long npy_int8;
+ typedef unsigned long npy_uint8;
+#define PyInt8ScalarObject PyLongScalarObject
+#define PyInt8ArrType_Type PyLongArrType_Type
+#define PyUInt8ScalarObject PyULongScalarObject
+#define PyUInt8ArrType_Type PyULongArrType_Type
+#define NPY_INT8_FMT NPY_LONG_FMT
+#define NPY_UINT8_FMT NPY_ULONG_FMT
+#elif NPY_BITSOF_LONG == 16
+#define NPY_INT16 NPY_LONG
+#define NPY_UINT16 NPY_ULONG
+ typedef long npy_int16;
+ typedef unsigned long npy_uint16;
+#define PyInt16ScalarObject PyLongScalarObject
+#define PyInt16ArrType_Type PyLongArrType_Type
+#define PyUInt16ScalarObject PyULongScalarObject
+#define PyUInt16ArrType_Type PyULongArrType_Type
+#define NPY_INT16_FMT NPY_LONG_FMT
+#define NPY_UINT16_FMT NPY_ULONG_FMT
+#elif NPY_BITSOF_LONG == 32
+#define NPY_INT32 NPY_LONG
+#define NPY_UINT32 NPY_ULONG
+ typedef long npy_int32;
+ typedef unsigned long npy_uint32;
+ typedef unsigned long npy_ucs4;
+#define PyInt32ScalarObject PyLongScalarObject
+#define PyInt32ArrType_Type PyLongArrType_Type
+#define PyUInt32ScalarObject PyULongScalarObject
+#define PyUInt32ArrType_Type PyULongArrType_Type
+#define NPY_INT32_FMT NPY_LONG_FMT
+#define NPY_UINT32_FMT NPY_ULONG_FMT
+#elif NPY_BITSOF_LONG == 64
+#define NPY_INT64 NPY_LONG
+#define NPY_UINT64 NPY_ULONG
+ typedef long npy_int64;
+ typedef unsigned long npy_uint64;
+#define PyInt64ScalarObject PyLongScalarObject
+#define PyInt64ArrType_Type PyLongArrType_Type
+#define PyUInt64ScalarObject PyULongScalarObject
+#define PyUInt64ArrType_Type PyULongArrType_Type
+#define NPY_INT64_FMT NPY_LONG_FMT
+#define NPY_UINT64_FMT NPY_ULONG_FMT
+#elif NPY_BITSOF_LONG == 128
+#define NPY_INT128 NPY_LONG
+#define NPY_UINT128 NPY_ULONG
+ typedef long npy_int128;
+ typedef unsigned long npy_uint128;
+#define PyInt128ScalarObject PyLongScalarObject
+#define PyInt128ArrType_Type PyLongArrType_Type
+#define PyUInt128ScalarObject PyULongScalarObject
+#define PyUInt128ArrType_Type PyULongArrType_Type
+#define NPY_INT128_FMT NPY_LONG_FMT
+#define NPY_UINT128_FMT NPY_ULONG_FMT
+#endif
+
+#if NPY_BITSOF_LONGLONG == 8
+# ifndef NPY_INT8
+# define NPY_INT8 NPY_LONGLONG
+# define NPY_UINT8 NPY_ULONGLONG
+ typedef npy_longlong npy_int8;
+ typedef npy_ulonglong npy_uint8;
+# define PyInt8ScalarObject PyLongLongScalarObject
+# define PyInt8ArrType_Type PyLongLongArrType_Type
+# define PyUInt8ScalarObject PyULongLongScalarObject
+# define PyUInt8ArrType_Type PyULongLongArrType_Type
+#define NPY_INT8_FMT NPY_LONGLONG_FMT
+#define NPY_UINT8_FMT NPY_ULONGLONG_FMT
+# endif
+# define NPY_MAX_LONGLONG NPY_MAX_INT8
+# define NPY_MIN_LONGLONG NPY_MIN_INT8
+# define NPY_MAX_ULONGLONG NPY_MAX_UINT8
+#elif NPY_BITSOF_LONGLONG == 16
+# ifndef NPY_INT16
+# define NPY_INT16 NPY_LONGLONG
+# define NPY_UINT16 NPY_ULONGLONG
+ typedef npy_longlong npy_int16;
+ typedef npy_ulonglong npy_uint16;
+# define PyInt16ScalarObject PyLongLongScalarObject
+# define PyInt16ArrType_Type PyLongLongArrType_Type
+# define PyUInt16ScalarObject PyULongLongScalarObject
+# define PyUInt16ArrType_Type PyULongLongArrType_Type
+#define NPY_INT16_FMT NPY_LONGLONG_FMT
+#define NPY_UINT16_FMT NPY_ULONGLONG_FMT
+# endif
+# define NPY_MAX_LONGLONG NPY_MAX_INT16
+# define NPY_MIN_LONGLONG NPY_MIN_INT16
+# define NPY_MAX_ULONGLONG NPY_MAX_UINT16
+#elif NPY_BITSOF_LONGLONG == 32
+# ifndef NPY_INT32
+# define NPY_INT32 NPY_LONGLONG
+# define NPY_UINT32 NPY_ULONGLONG
+ typedef npy_longlong npy_int32;
+ typedef npy_ulonglong npy_uint32;
+ typedef npy_ulonglong npy_ucs4;
+# define PyInt32ScalarObject PyLongLongScalarObject
+# define PyInt32ArrType_Type PyLongLongArrType_Type
+# define PyUInt32ScalarObject PyULongLongScalarObject
+# define PyUInt32ArrType_Type PyULongLongArrType_Type
+#define NPY_INT32_FMT NPY_LONGLONG_FMT
+#define NPY_UINT32_FMT NPY_ULONGLONG_FMT
+# endif
+# define NPY_MAX_LONGLONG NPY_MAX_INT32
+# define NPY_MIN_LONGLONG NPY_MIN_INT32
+# define NPY_MAX_ULONGLONG NPY_MAX_UINT32
+#elif NPY_BITSOF_LONGLONG == 64
+# ifndef NPY_INT64
+# define NPY_INT64 NPY_LONGLONG
+# define NPY_UINT64 NPY_ULONGLONG
+ typedef npy_longlong npy_int64;
+ typedef npy_ulonglong npy_uint64;
+# define PyInt64ScalarObject PyLongLongScalarObject
+# define PyInt64ArrType_Type PyLongLongArrType_Type
+# define PyUInt64ScalarObject PyULongLongScalarObject
+# define PyUInt64ArrType_Type PyULongLongArrType_Type
+#define NPY_INT64_FMT NPY_LONGLONG_FMT
+#define NPY_UINT64_FMT NPY_ULONGLONG_FMT
+# endif
+# define NPY_MAX_LONGLONG NPY_MAX_INT64
+# define NPY_MIN_LONGLONG NPY_MIN_INT64
+# define NPY_MAX_ULONGLONG NPY_MAX_UINT64
+#elif NPY_BITSOF_LONGLONG == 128
+# ifndef NPY_INT128
+# define NPY_INT128 NPY_LONGLONG
+# define NPY_UINT128 NPY_ULONGLONG
+ typedef npy_longlong npy_int128;
+ typedef npy_ulonglong npy_uint128;
+# define PyInt128ScalarObject PyLongLongScalarObject
+# define PyInt128ArrType_Type PyLongLongArrType_Type
+# define PyUInt128ScalarObject PyULongLongScalarObject
+# define PyUInt128ArrType_Type PyULongLongArrType_Type
+#define NPY_INT128_FMT NPY_LONGLONG_FMT
+#define NPY_UINT128_FMT NPY_ULONGLONG_FMT
+# endif
+# define NPY_MAX_LONGLONG NPY_MAX_INT128
+# define NPY_MIN_LONGLONG NPY_MIN_INT128
+# define NPY_MAX_ULONGLONG NPY_MAX_UINT128
+#elif NPY_BITSOF_LONGLONG == 256
+# define NPY_INT256 NPY_LONGLONG
+# define NPY_UINT256 NPY_ULONGLONG
+ typedef npy_longlong npy_int256;
+ typedef npy_ulonglong npy_uint256;
+# define PyInt256ScalarObject PyLongLongScalarObject
+# define PyInt256ArrType_Type PyLongLongArrType_Type
+# define PyUInt256ScalarObject PyULongLongScalarObject
+# define PyUInt256ArrType_Type PyULongLongArrType_Type
+#define NPY_INT256_FMT NPY_LONGLONG_FMT
+#define NPY_UINT256_FMT NPY_ULONGLONG_FMT
+# define NPY_MAX_LONGLONG NPY_MAX_INT256
+# define NPY_MIN_LONGLONG NPY_MIN_INT256
+# define NPY_MAX_ULONGLONG NPY_MAX_UINT256
+#endif
+
+#if NPY_BITSOF_INT == 8
+#ifndef NPY_INT8
+#define NPY_INT8 NPY_INT
+#define NPY_UINT8 NPY_UINT
+ typedef int npy_int8;
+ typedef unsigned int npy_uint8;
+# define PyInt8ScalarObject PyIntScalarObject
+# define PyInt8ArrType_Type PyIntArrType_Type
+# define PyUInt8ScalarObject PyUIntScalarObject
+# define PyUInt8ArrType_Type PyUIntArrType_Type
+#define NPY_INT8_FMT NPY_INT_FMT
+#define NPY_UINT8_FMT NPY_UINT_FMT
+#endif
+#elif NPY_BITSOF_INT == 16
+#ifndef NPY_INT16
+#define NPY_INT16 NPY_INT
+#define NPY_UINT16 NPY_UINT
+ typedef int npy_int16;
+ typedef unsigned int npy_uint16;
+# define PyInt16ScalarObject PyIntScalarObject
+# define PyInt16ArrType_Type PyIntArrType_Type
+# define PyUInt16ScalarObject PyIntUScalarObject
+# define PyUInt16ArrType_Type PyIntUArrType_Type
+#define NPY_INT16_FMT NPY_INT_FMT
+#define NPY_UINT16_FMT NPY_UINT_FMT
+#endif
+#elif NPY_BITSOF_INT == 32
+#ifndef NPY_INT32
+#define NPY_INT32 NPY_INT
+#define NPY_UINT32 NPY_UINT
+ typedef int npy_int32;
+ typedef unsigned int npy_uint32;
+ typedef unsigned int npy_ucs4;
+# define PyInt32ScalarObject PyIntScalarObject
+# define PyInt32ArrType_Type PyIntArrType_Type
+# define PyUInt32ScalarObject PyUIntScalarObject
+# define PyUInt32ArrType_Type PyUIntArrType_Type
+#define NPY_INT32_FMT NPY_INT_FMT
+#define NPY_UINT32_FMT NPY_UINT_FMT
+#endif
+#elif NPY_BITSOF_INT == 64
+#ifndef NPY_INT64
+#define NPY_INT64 NPY_INT
+#define NPY_UINT64 NPY_UINT
+ typedef int npy_int64;
+ typedef unsigned int npy_uint64;
+# define PyInt64ScalarObject PyIntScalarObject
+# define PyInt64ArrType_Type PyIntArrType_Type
+# define PyUInt64ScalarObject PyUIntScalarObject
+# define PyUInt64ArrType_Type PyUIntArrType_Type
+#define NPY_INT64_FMT NPY_INT_FMT
+#define NPY_UINT64_FMT NPY_UINT_FMT
+#endif
+#elif NPY_BITSOF_INT == 128
+#ifndef NPY_INT128
+#define NPY_INT128 NPY_INT
+#define NPY_UINT128 NPY_UINT
+ typedef int npy_int128;
+ typedef unsigned int npy_uint128;
+# define PyInt128ScalarObject PyIntScalarObject
+# define PyInt128ArrType_Type PyIntArrType_Type
+# define PyUInt128ScalarObject PyUIntScalarObject
+# define PyUInt128ArrType_Type PyUIntArrType_Type
+#define NPY_INT128_FMT NPY_INT_FMT
+#define NPY_UINT128_FMT NPY_UINT_FMT
+#endif
+#endif
+
+#if NPY_BITSOF_SHORT == 8
+#ifndef NPY_INT8
+#define NPY_INT8 NPY_SHORT
+#define NPY_UINT8 NPY_USHORT
+ typedef short npy_int8;
+ typedef unsigned short npy_uint8;
+# define PyInt8ScalarObject PyShortScalarObject
+# define PyInt8ArrType_Type PyShortArrType_Type
+# define PyUInt8ScalarObject PyUShortScalarObject
+# define PyUInt8ArrType_Type PyUShortArrType_Type
+#define NPY_INT8_FMT NPY_SHORT_FMT
+#define NPY_UINT8_FMT NPY_USHORT_FMT
+#endif
+#elif NPY_BITSOF_SHORT == 16
+#ifndef NPY_INT16
+#define NPY_INT16 NPY_SHORT
+#define NPY_UINT16 NPY_USHORT
+ typedef short npy_int16;
+ typedef unsigned short npy_uint16;
+# define PyInt16ScalarObject PyShortScalarObject
+# define PyInt16ArrType_Type PyShortArrType_Type
+# define PyUInt16ScalarObject PyUShortScalarObject
+# define PyUInt16ArrType_Type PyUShortArrType_Type
+#define NPY_INT16_FMT NPY_SHORT_FMT
+#define NPY_UINT16_FMT NPY_USHORT_FMT
+#endif
+#elif NPY_BITSOF_SHORT == 32
+#ifndef NPY_INT32
+#define NPY_INT32 NPY_SHORT
+#define NPY_UINT32 NPY_USHORT
+ typedef short npy_int32;
+ typedef unsigned short npy_uint32;
+ typedef unsigned short npy_ucs4;
+# define PyInt32ScalarObject PyShortScalarObject
+# define PyInt32ArrType_Type PyShortArrType_Type
+# define PyUInt32ScalarObject PyUShortScalarObject
+# define PyUInt32ArrType_Type PyUShortArrType_Type
+#define NPY_INT32_FMT NPY_SHORT_FMT
+#define NPY_UINT32_FMT NPY_USHORT_FMT
+#endif
+#elif NPY_BITSOF_SHORT == 64
+#ifndef NPY_INT64
+#define NPY_INT64 NPY_SHORT
+#define NPY_UINT64 NPY_USHORT
+ typedef short npy_int64;
+ typedef unsigned short npy_uint64;
+# define PyInt64ScalarObject PyShortScalarObject
+# define PyInt64ArrType_Type PyShortArrType_Type
+# define PyUInt64ScalarObject PyUShortScalarObject
+# define PyUInt64ArrType_Type PyUShortArrType_Type
+#define NPY_INT64_FMT NPY_SHORT_FMT
+#define NPY_UINT64_FMT NPY_USHORT_FMT
+#endif
+#elif NPY_BITSOF_SHORT == 128
+#ifndef NPY_INT128
+#define NPY_INT128 NPY_SHORT
+#define NPY_UINT128 NPY_USHORT
+ typedef short npy_int128;
+ typedef unsigned short npy_uint128;
+# define PyInt128ScalarObject PyShortScalarObject
+# define PyInt128ArrType_Type PyShortArrType_Type
+# define PyUInt128ScalarObject PyUShortScalarObject
+# define PyUInt128ArrType_Type PyUShortArrType_Type
+#define NPY_INT128_FMT NPY_SHORT_FMT
+#define NPY_UINT128_FMT NPY_USHORT_FMT
+#endif
+#endif
+
+
+#if NPY_BITSOF_CHAR == 8
+#ifndef NPY_INT8
+#define NPY_INT8 NPY_BYTE
+#define NPY_UINT8 NPY_UBYTE
+ typedef signed char npy_int8;
+ typedef unsigned char npy_uint8;
+# define PyInt8ScalarObject PyByteScalarObject
+# define PyInt8ArrType_Type PyByteArrType_Type
+# define PyUInt8ScalarObject PyUByteScalarObject
+# define PyUInt8ArrType_Type PyUByteArrType_Type
+#define NPY_INT8_FMT NPY_BYTE_FMT
+#define NPY_UINT8_FMT NPY_UBYTE_FMT
+#endif
+#elif NPY_BITSOF_CHAR == 16
+#ifndef NPY_INT16
+#define NPY_INT16 NPY_BYTE
+#define NPY_UINT16 NPY_UBYTE
+ typedef signed char npy_int16;
+ typedef unsigned char npy_uint16;
+# define PyInt16ScalarObject PyByteScalarObject
+# define PyInt16ArrType_Type PyByteArrType_Type
+# define PyUInt16ScalarObject PyUByteScalarObject
+# define PyUInt16ArrType_Type PyUByteArrType_Type
+#define NPY_INT16_FMT NPY_BYTE_FMT
+#define NPY_UINT16_FMT NPY_UBYTE_FMT
+#endif
+#elif NPY_BITSOF_CHAR == 32
+#ifndef NPY_INT32
+#define NPY_INT32 NPY_BYTE
+#define NPY_UINT32 NPY_UBYTE
+ typedef signed char npy_int32;
+ typedef unsigned char npy_uint32;
+ typedef unsigned char npy_ucs4;
+# define PyInt32ScalarObject PyByteScalarObject
+# define PyInt32ArrType_Type PyByteArrType_Type
+# define PyUInt32ScalarObject PyUByteScalarObject
+# define PyUInt32ArrType_Type PyUByteArrType_Type
+#define NPY_INT32_FMT NPY_BYTE_FMT
+#define NPY_UINT32_FMT NPY_UBYTE_FMT
+#endif
+#elif NPY_BITSOF_CHAR == 64
+#ifndef NPY_INT64
+#define NPY_INT64 NPY_BYTE
+#define NPY_UINT64 NPY_UBYTE
+ typedef signed char npy_int64;
+ typedef unsigned char npy_uint64;
+# define PyInt64ScalarObject PyByteScalarObject
+# define PyInt64ArrType_Type PyByteArrType_Type
+# define PyUInt64ScalarObject PyUByteScalarObject
+# define PyUInt64ArrType_Type PyUByteArrType_Type
+#define NPY_INT64_FMT NPY_BYTE_FMT
+#define NPY_UINT64_FMT NPY_UBYTE_FMT
+#endif
+#elif NPY_BITSOF_CHAR == 128
+#ifndef NPY_INT128
+#define NPY_INT128 NPY_BYTE
+#define NPY_UINT128 NPY_UBYTE
+ typedef signed char npy_int128;
+ typedef unsigned char npy_uint128;
+# define PyInt128ScalarObject PyByteScalarObject
+# define PyInt128ArrType_Type PyByteArrType_Type
+# define PyUInt128ScalarObject PyUByteScalarObject
+# define PyUInt128ArrType_Type PyUByteArrType_Type
+#define NPY_INT128_FMT NPY_BYTE_FMT
+#define NPY_UINT128_FMT NPY_UBYTE_FMT
+#endif
+#endif
+
+
+
+#if NPY_BITSOF_DOUBLE == 16
+#ifndef NPY_FLOAT16
+#define NPY_FLOAT16 NPY_DOUBLE
+#define NPY_COMPLEX32 NPY_CDOUBLE
+ typedef double npy_float16;
+ typedef npy_cdouble npy_complex32;
+# define PyFloat16ScalarObject PyDoubleScalarObject
+# define PyComplex32ScalarObject PyCDoubleScalarObject
+# define PyFloat16ArrType_Type PyDoubleArrType_Type
+# define PyComplex32ArrType_Type PyCDoubleArrType_Type
+#define NPY_FLOAT16_FMT NPY_DOUBLE_FMT
+#define NPY_COMPLEX32_FMT NPY_CDOUBLE_FMT
+#endif
+#elif NPY_BITSOF_DOUBLE == 32
+#ifndef NPY_FLOAT32
+#define NPY_FLOAT32 NPY_DOUBLE
+#define NPY_COMPLEX64 NPY_CDOUBLE
+ typedef double npy_float32;
+ typedef npy_cdouble npy_complex64;
+# define PyFloat32ScalarObject PyDoubleScalarObject
+# define PyComplex64ScalarObject PyCDoubleScalarObject
+# define PyFloat32ArrType_Type PyDoubleArrType_Type
+# define PyComplex64ArrType_Type PyCDoubleArrType_Type
+#define NPY_FLOAT32_FMT NPY_DOUBLE_FMT
+#define NPY_COMPLEX64_FMT NPY_CDOUBLE_FMT
+#endif
+#elif NPY_BITSOF_DOUBLE == 64
+#ifndef NPY_FLOAT64
+#define NPY_FLOAT64 NPY_DOUBLE
+#define NPY_COMPLEX128 NPY_CDOUBLE
+ typedef double npy_float64;
+ typedef npy_cdouble npy_complex128;
+# define PyFloat64ScalarObject PyDoubleScalarObject
+# define PyComplex128ScalarObject PyCDoubleScalarObject
+# define PyFloat64ArrType_Type PyDoubleArrType_Type
+# define PyComplex128ArrType_Type PyCDoubleArrType_Type
+#define NPY_FLOAT64_FMT NPY_DOUBLE_FMT
+#define NPY_COMPLEX128_FMT NPY_CDOUBLE_FMT
+#endif
+#elif NPY_BITSOF_DOUBLE == 80
+#ifndef NPY_FLOAT80
+#define NPY_FLOAT80 NPY_DOUBLE
+#define NPY_COMPLEX160 NPY_CDOUBLE
+ typedef double npy_float80;
+ typedef npy_cdouble npy_complex160;
+# define PyFloat80ScalarObject PyDoubleScalarObject
+# define PyComplex160ScalarObject PyCDoubleScalarObject
+# define PyFloat80ArrType_Type PyDoubleArrType_Type
+# define PyComplex160ArrType_Type PyCDoubleArrType_Type
+#define NPY_FLOAT80_FMT NPY_DOUBLE_FMT
+#define NPY_COMPLEX160_FMT NPY_CDOUBLE_FMT
+#endif
+#elif NPY_BITSOF_DOUBLE == 96
+#ifndef NPY_FLOAT96
+#define NPY_FLOAT96 NPY_DOUBLE
+#define NPY_COMPLEX192 NPY_CDOUBLE
+ typedef double npy_float96;
+ typedef npy_cdouble npy_complex192;
+# define PyFloat96ScalarObject PyDoubleScalarObject
+# define PyComplex192ScalarObject PyCDoubleScalarObject
+# define PyFloat96ArrType_Type PyDoubleArrType_Type
+# define PyComplex192ArrType_Type PyCDoubleArrType_Type
+#define NPY_FLOAT96_FMT NPY_DOUBLE_FMT
+#define NPY_COMPLEX192_FMT NPY_CDOUBLE_FMT
+#endif
+#elif NPY_BITSOF_DOUBLE == 128
+#ifndef NPY_FLOAT128
+#define NPY_FLOAT128 NPY_DOUBLE
+#define NPY_COMPLEX256 NPY_CDOUBLE
+ typedef double npy_float128;
+ typedef npy_cdouble npy_complex256;
+# define PyFloat128ScalarObject PyDoubleScalarObject
+# define PyComplex256ScalarObject PyCDoubleScalarObject
+# define PyFloat128ArrType_Type PyDoubleArrType_Type
+# define PyComplex256ArrType_Type PyCDoubleArrType_Type
+#define NPY_FLOAT128_FMT NPY_DOUBLE_FMT
+#define NPY_COMPLEX256_FMT NPY_CDOUBLE_FMT
+#endif
+#endif
+
+
+
+#if NPY_BITSOF_FLOAT == 16
+#ifndef NPY_FLOAT16
+#define NPY_FLOAT16 NPY_FLOAT
+#define NPY_COMPLEX32 NPY_CFLOAT
+ typedef float npy_float16;
+ typedef npy_cfloat npy_complex32;
+# define PyFloat16ScalarObject PyFloatScalarObject
+# define PyComplex32ScalarObject PyCFloatScalarObject
+# define PyFloat16ArrType_Type PyFloatArrType_Type
+# define PyComplex32ArrType_Type PyCFloatArrType_Type
+#define NPY_FLOAT16_FMT NPY_FLOAT_FMT
+#define NPY_COMPLEX32_FMT NPY_CFLOAT_FMT
+#endif
+#elif NPY_BITSOF_FLOAT == 32
+#ifndef NPY_FLOAT32
+#define NPY_FLOAT32 NPY_FLOAT
+#define NPY_COMPLEX64 NPY_CFLOAT
+ typedef float npy_float32;
+ typedef npy_cfloat npy_complex64;
+# define PyFloat32ScalarObject PyFloatScalarObject
+# define PyComplex64ScalarObject PyCFloatScalarObject
+# define PyFloat32ArrType_Type PyFloatArrType_Type
+# define PyComplex64ArrType_Type PyCFloatArrType_Type
+#define NPY_FLOAT32_FMT NPY_FLOAT_FMT
+#define NPY_COMPLEX64_FMT NPY_CFLOAT_FMT
+#endif
+#elif NPY_BITSOF_FLOAT == 64
+#ifndef NPY_FLOAT64
+#define NPY_FLOAT64 NPY_FLOAT
+#define NPY_COMPLEX128 NPY_CFLOAT
+ typedef float npy_float64;
+ typedef npy_cfloat npy_complex128;
+# define PyFloat64ScalarObject PyFloatScalarObject
+# define PyComplex128ScalarObject PyCFloatScalarObject
+# define PyFloat64ArrType_Type PyFloatArrType_Type
+# define PyComplex128ArrType_Type PyCFloatArrType_Type
+#define NPY_FLOAT64_FMT NPY_FLOAT_FMT
+#define NPY_COMPLEX128_FMT NPY_CFLOAT_FMT
+#endif
+#elif NPY_BITSOF_FLOAT == 80
+#ifndef NPY_FLOAT80
+#define NPY_FLOAT80 NPY_FLOAT
+#define NPY_COMPLEX160 NPY_CFLOAT
+ typedef float npy_float80;
+ typedef npy_cfloat npy_complex160;
+# define PyFloat80ScalarObject PyFloatScalarObject
+# define PyComplex160ScalarObject PyCFloatScalarObject
+# define PyFloat80ArrType_Type PyFloatArrType_Type
+# define PyComplex160ArrType_Type PyCFloatArrType_Type
+#define NPY_FLOAT80_FMT NPY_FLOAT_FMT
+#define NPY_COMPLEX160_FMT NPY_CFLOAT_FMT
+#endif
+#elif NPY_BITSOF_FLOAT == 96
+#ifndef NPY_FLOAT96
+#define NPY_FLOAT96 NPY_FLOAT
+#define NPY_COMPLEX192 NPY_CFLOAT
+ typedef float npy_float96;
+ typedef npy_cfloat npy_complex192;
+# define PyFloat96ScalarObject PyFloatScalarObject
+# define PyComplex192ScalarObject PyCFloatScalarObject
+# define PyFloat96ArrType_Type PyFloatArrType_Type
+# define PyComplex192ArrType_Type PyCFloatArrType_Type
+#define NPY_FLOAT96_FMT NPY_FLOAT_FMT
+#define NPY_COMPLEX192_FMT NPY_CFLOAT_FMT
+#endif
+#elif NPY_BITSOF_FLOAT == 128
+#ifndef NPY_FLOAT128
+#define NPY_FLOAT128 NPY_FLOAT
+#define NPY_COMPLEX256 NPY_CFLOAT
+ typedef float npy_float128;
+ typedef npy_cfloat npy_complex256;
+# define PyFloat128ScalarObject PyFloatScalarObject
+# define PyComplex256ScalarObject PyCFloatScalarObject
+# define PyFloat128ArrType_Type PyFloatArrType_Type
+# define PyComplex256ArrType_Type PyCFloatArrType_Type
+#define NPY_FLOAT128_FMT NPY_FLOAT_FMT
+#define NPY_COMPLEX256_FMT NPY_CFLOAT_FMT
+#endif
+#endif
+
+
+#if NPY_BITSOF_LONGDOUBLE == 16
+#ifndef NPY_FLOAT16
+#define NPY_FLOAT16 NPY_LONGDOUBLE
+#define NPY_COMPLEX32 NPY_CLONGDOUBLE
+ typedef npy_longdouble npy_float16;
+ typedef npy_clongdouble npy_complex32;
+# define PyFloat16ScalarObject PyLongDoubleScalarObject
+# define PyComplex32ScalarObject PyCLongDoubleScalarObject
+# define PyFloat16ArrType_Type PyLongDoubleArrType_Type
+# define PyComplex32ArrType_Type PyCLongDoubleArrType_Type
+#define NPY_FLOAT16_FMT NPY_LONGDOUBLE_FMT
+#define NPY_COMPLEX32_FMT NPY_CLONGDOUBLE_FMT
+#endif
+#elif NPY_BITSOF_LONGDOUBLE == 32
+#ifndef NPY_FLOAT32
+#define NPY_FLOAT32 NPY_LONGDOUBLE
+#define NPY_COMPLEX64 NPY_CLONGDOUBLE
+ typedef npy_longdouble npy_float32;
+ typedef npy_clongdouble npy_complex64;
+# define PyFloat32ScalarObject PyLongDoubleScalarObject
+# define PyComplex64ScalarObject PyCLongDoubleScalarObject
+# define PyFloat32ArrType_Type PyLongDoubleArrType_Type
+# define PyComplex64ArrType_Type PyCLongDoubleArrType_Type
+#define NPY_FLOAT32_FMT NPY_LONGDOUBLE_FMT
+#define NPY_COMPLEX64_FMT NPY_CLONGDOUBLE_FMT
+#endif
+#elif NPY_BITSOF_LONGDOUBLE == 64
+#ifndef NPY_FLOAT64
+#define NPY_FLOAT64 NPY_LONGDOUBLE
+#define NPY_COMPLEX128 NPY_CLONGDOUBLE
+ typedef npy_longdouble npy_float64;
+ typedef npy_clongdouble npy_complex128;
+# define PyFloat64ScalarObject PyLongDoubleScalarObject
+# define PyComplex128ScalarObject PyCLongDoubleScalarObject
+# define PyFloat64ArrType_Type PyLongDoubleArrType_Type
+# define PyComplex128ArrType_Type PyCLongDoubleArrType_Type
+#define NPY_FLOAT64_FMT NPY_LONGDOUBLE_FMT
+#define NPY_COMPLEX128_FMT NPY_CLONGDOUBLE_FMT
+#endif
+#elif NPY_BITSOF_LONGDOUBLE == 80
+#ifndef NPY_FLOAT80
+#define NPY_FLOAT80 NPY_LONGDOUBLE
+#define NPY_COMPLEX160 NPY_CLONGDOUBLE
+ typedef npy_longdouble npy_float80;
+ typedef npy_clongdouble npy_complex160;
+# define PyFloat80ScalarObject PyLongDoubleScalarObject
+# define PyComplex160ScalarObject PyCLongDoubleScalarObject
+# define PyFloat80ArrType_Type PyLongDoubleArrType_Type
+# define PyComplex160ArrType_Type PyCLongDoubleArrType_Type
+#define NPY_FLOAT80_FMT NPY_LONGDOUBLE_FMT
+#define NPY_COMPLEX160_FMT NPY_CLONGDOUBLE_FMT
+#endif
+#elif NPY_BITSOF_LONGDOUBLE == 96
+#ifndef NPY_FLOAT96
+#define NPY_FLOAT96 NPY_LONGDOUBLE
+#define NPY_COMPLEX192 NPY_CLONGDOUBLE
+ typedef npy_longdouble npy_float96;
+ typedef npy_clongdouble npy_complex192;
+# define PyFloat96ScalarObject PyLongDoubleScalarObject
+# define PyComplex192ScalarObject PyCLongDoubleScalarObject
+# define PyFloat96ArrType_Type PyLongDoubleArrType_Type
+# define PyComplex192ArrType_Type PyCLongDoubleArrType_Type
+#define NPY_FLOAT96_FMT NPY_LONGDOUBLE_FMT
+#define NPY_COMPLEX192_FMT NPY_CLONGDOUBLE_FMT
+#endif
+#elif NPY_BITSOF_LONGDOUBLE == 128
+#ifndef NPY_FLOAT128
+#define NPY_FLOAT128 NPY_LONGDOUBLE
+#define NPY_COMPLEX256 NPY_CLONGDOUBLE
+ typedef npy_longdouble npy_float128;
+ typedef npy_clongdouble npy_complex256;
+# define PyFloat128ScalarObject PyLongDoubleScalarObject
+# define PyComplex256ScalarObject PyCLongDoubleScalarObject
+# define PyFloat128ArrType_Type PyLongDoubleArrType_Type
+# define PyComplex256ArrType_Type PyCLongDoubleArrType_Type
+#define NPY_FLOAT128_FMT NPY_LONGDOUBLE_FMT
+#define NPY_COMPLEX256_FMT NPY_CLONGDOUBLE_FMT
+#endif
+#elif NPY_BITSOF_LONGDOUBLE == 256
+#define NPY_FLOAT256 NPY_LONGDOUBLE
+#define NPY_COMPLEX512 NPY_CLONGDOUBLE
+ typedef npy_longdouble npy_float256;
+ typedef npy_clongdouble npy_complex512;
+# define PyFloat256ScalarObject PyLongDoubleScalarObject
+# define PyComplex512ScalarObject PyCLongDoubleScalarObject
+# define PyFloat256ArrType_Type PyLongDoubleArrType_Type
+# define PyComplex512ArrType_Type PyCLongDoubleArrType_Type
+#define NPY_FLOAT256_FMT NPY_LONGDOUBLE_FMT
+#define NPY_COMPLEX512_FMT NPY_CLONGDOUBLE_FMT
+#endif
+
+/* End of typedefs for numarray style bit-width names */
+
+/* This is to typedef npy_intp to the appropriate pointer size for this
+ * platform. Py_intptr_t, Py_uintptr_t are defined in pyport.h. */
+typedef Py_intptr_t npy_intp;
+typedef Py_uintptr_t npy_uintp;
+#define NPY_SIZEOF_INTP SIZEOF_PY_INTPTR_T
+#define NPY_SIZEOF_UINTP SIZEOF_PY_INTPTR_T
+
+#ifdef constchar
+#undef constchar
+#endif
+
+#if (PY_VERSION_HEX < 0x02050000)
+ #ifndef PY_SSIZE_T_MIN
+ typedef int Py_ssize_t;
+ #define PY_SSIZE_T_MAX INT_MAX
+ #define PY_SSIZE_T_MIN INT_MIN
+ #endif
+#define NPY_SSIZE_T_PYFMT "i"
+#undef PyIndex_Check
+#define constchar const char
+#define PyIndex_Check(op) 0
+#else
+#define NPY_SSIZE_T_PYFMT "n"
+#define constchar char
+#endif
+
+#if SIZEOF_PY_INTPTR_T == SIZEOF_INT
+ #define NPY_INTP NPY_INT
+ #define NPY_UINTP NPY_UINT
+ #define PyIntpArrType_Type PyIntArrType_Type
+ #define PyUIntpArrType_Type PyUIntArrType_Type
+ #define NPY_MAX_INTP NPY_MAX_INT
+ #define NPY_MIN_INTP NPY_MIN_INT
+ #define NPY_MAX_UINTP NPY_MAX_UINT
+ #define NPY_INTP_FMT "d"
+#elif SIZEOF_PY_INTPTR_T == SIZEOF_LONG
+ #define NPY_INTP NPY_LONG
+ #define NPY_UINTP NPY_ULONG
+ #define PyIntpArrType_Type PyLongArrType_Type
+ #define PyUIntpArrType_Type PyULongArrType_Type
+ #define NPY_MAX_INTP NPY_MAX_LONG
+ #define NPY_MIN_INTP MIN_LONG
+ #define NPY_MAX_UINTP NPY_MAX_ULONG
+ #define NPY_INTP_FMT "ld"
+#elif defined(PY_LONG_LONG) && (SIZEOF_PY_INTPTR_T == SIZEOF_LONG_LONG)
+ #define NPY_INTP NPY_LONGLONG
+ #define NPY_UINTP NPY_ULONGLONG
+ #define PyIntpArrType_Type PyLongLongArrType_Type
+ #define PyUIntpArrType_Type PyULongLongArrType_Type
+ #define NPY_MAX_INTP NPY_MAX_LONGLONG
+ #define NPY_MIN_INTP NPY_MIN_LONGLONG
+ #define NPY_MAX_UINTP NPY_MAX_ULONGLONG
+ #define NPY_INTP_FMT "Ld"
+#endif
+
+#define NPY_ERR(str) fprintf(stderr, #str); fflush(stderr);
+#define NPY_ERR2(str) fprintf(stderr, str); fflush(stderr);
+
+#define NPY_STRINGIFY(x) #x
+#define NPY_TOSTRING(x) NPY_STRINGIFY(x)
+
+ /* Macros to define how array, and dimension/strides data is
+ allocated.
+ */
+
+ /* Data buffer */
+#define PyDataMem_NEW(size) ((char *)malloc(size))
+#define PyDataMem_FREE(ptr) free(ptr)
+#define PyDataMem_RENEW(ptr,size) ((char *)realloc(ptr,size))
+
+#define NPY_USE_PYMEM 1
+
+#if NPY_USE_PYMEM == 1
+#define PyArray_malloc PyMem_Malloc
+#define PyArray_free PyMem_Free
+#define PyArray_realloc PyMem_Realloc
+#else
+#define PyArray_malloc malloc
+#define PyArray_free free
+#define PyArray_realloc realloc
+#endif
+
+/* Dimensions and strides */
+#define PyDimMem_NEW(size) \
+ ((npy_intp *)PyArray_malloc(size*sizeof(npy_intp)))
+
+#define PyDimMem_FREE(ptr) PyArray_free(ptr)
+
+#define PyDimMem_RENEW(ptr,size) \
+ ((npy_intp *)PyArray_realloc(ptr,size*sizeof(npy_intp)))
+
+/* forward declaration */
+struct _PyArray_Descr;
+
+ /* These must deal with unaligned and swapped data if necessary */
+typedef PyObject * (PyArray_GetItemFunc) (void *, void *);
+typedef int (PyArray_SetItemFunc)(PyObject *, void *, void *);
+
+typedef void (PyArray_CopySwapNFunc)(void *, npy_intp, void *, npy_intp,
+ npy_intp, int, void *);
+
+typedef void (PyArray_CopySwapFunc)(void *, void *, int, void *);
+typedef npy_bool (PyArray_NonzeroFunc)(void *, void *);
+
+
+ /* These assume aligned and notswapped data -- a buffer will be
+ used before or contiguous data will be obtained
+ */
+typedef int (PyArray_CompareFunc)(const void *, const void *, void *);
+typedef int (PyArray_ArgFunc)(void*, npy_intp, npy_intp*, void *);
+
+typedef void (PyArray_DotFunc)(void *, npy_intp, void *, npy_intp, void *,
+ npy_intp, void *);
+
+typedef void (PyArray_VectorUnaryFunc)(void *, void *, npy_intp, void *,
+ void *);
+
+/* XXX the ignore argument should be removed next time the API version
+ is bumped. It used to be the separator. */
+typedef int (PyArray_ScanFunc)(FILE *fp, void *dptr,
+ char *ignore, struct _PyArray_Descr *);
+typedef int (PyArray_FromStrFunc)(char *s, void *dptr, char **endptr,
+ struct _PyArray_Descr *);
+
+typedef int (PyArray_FillFunc)(void *, npy_intp, void *);
+
+typedef int (PyArray_SortFunc)(void *, npy_intp, void *);
+typedef int (PyArray_ArgSortFunc)(void *, npy_intp *, npy_intp, void *);
+
+typedef int (PyArray_FillWithScalarFunc)(void *, npy_intp, void *, void *);
+
+typedef int (PyArray_ScalarKindFunc)(void *);
+
+typedef void (PyArray_FastClipFunc)(void *in, npy_intp n_in, void *min,
+ void *max, void *out);
+
+typedef struct {
+ npy_intp *ptr;
+ int len;
+} PyArray_Dims;
+
+typedef struct {
+ /* Functions to cast to all other standard types*/
+ /* Can have some NULL entries */
+ PyArray_VectorUnaryFunc *cast[NPY_NTYPES];
+
+ /* The next four functions *cannot* be NULL */
+
+ /* Functions to get and set items with standard
+ Python types -- not array scalars */
+ PyArray_GetItemFunc *getitem;
+ PyArray_SetItemFunc *setitem;
+
+ /* Copy and/or swap data. Memory areas may not overlap */
+ /* Use memmove first if they might */
+ PyArray_CopySwapNFunc *copyswapn;
+ PyArray_CopySwapFunc *copyswap;
+
+ /* Function to compare items */
+ /* Can be NULL
+ */
+ PyArray_CompareFunc *compare;
+
+ /* Function to select largest
+ Can be NULL
+ */
+ PyArray_ArgFunc *argmax;
+
+ /* Function to compute dot product */
+ /* Can be NULL */
+ PyArray_DotFunc *dotfunc;
+
+ /* Function to scan an ASCII file and
+ place a single value plus possible separator
+ Can be NULL
+ */
+ PyArray_ScanFunc *scanfunc;
+
+ /* Function to read a single value from a string */
+ /* and adjust the pointer; Can be NULL */
+ PyArray_FromStrFunc *fromstr;
+
+ /* Function to determine if data is zero or not */
+ /* If NULL a default version is */
+ /* used at Registration time. */
+ PyArray_NonzeroFunc *nonzero;
+
+ /* Used for arange. Can be NULL.*/
+ PyArray_FillFunc *fill;
+
+ /* Function to fill arrays with scalar values
+ Can be NULL*/
+ PyArray_FillWithScalarFunc *fillwithscalar;
+
+ /* Sorting functions; Can be NULL*/
+ PyArray_SortFunc *sort[NPY_NSORTS];
+ PyArray_ArgSortFunc *argsort[NPY_NSORTS];
+
+ /* Dictionary of additional casting functions
+ PyArray_VectorUnaryFuncs
+ which can be populated to support casting
+ to other registered types. Can be NULL*/
+ PyObject *castdict;
+
+ /* Functions useful for generalizing
+ the casting rules. Can be NULL;
+ */
+ PyArray_ScalarKindFunc *scalarkind;
+ int **cancastscalarkindto;
+ int *cancastto;
+
+ PyArray_FastClipFunc *fastclip;
+} PyArray_ArrFuncs;
+
+#define NPY_ITEM_REFCOUNT 0x01 /* The item must be reference counted
+ when it is inserted or extracted. */
+#define NPY_ITEM_HASOBJECT 0x01 /* Same as needing REFCOUNT */
+
+#define NPY_LIST_PICKLE 0x02 /* Convert to list for pickling */
+#define NPY_ITEM_IS_POINTER 0x04 /* The item is a POINTER */
+
+#define NPY_NEEDS_INIT 0x08 /* memory needs to be initialized
+ for this data-type */
+
+#define NPY_NEEDS_PYAPI 0x10 /* operations need Python C-API
+ so don't give-up thread. */
+
+#define NPY_USE_GETITEM 0x20 /* Use f.getitem when extracting elements
+ of this data-type */
+
+#define NPY_USE_SETITEM 0x40 /* Use f.setitem when setting creating
+ 0-d array from this data-type.
+ */
+
+/* These are inherited for global data-type if any data-types in the field
+ have them */
+#define NPY_FROM_FIELDS (NPY_NEEDS_INIT | NPY_LIST_PICKLE | \
+ NPY_ITEM_REFCOUNT | NPY_NEEDS_PYAPI)
+
+#define NPY_OBJECT_DTYPE_FLAGS (NPY_LIST_PICKLE | NPY_USE_GETITEM | \
+ NPY_ITEM_IS_POINTER | NPY_ITEM_REFCOUNT | \
+ NPY_NEEDS_INIT | NPY_NEEDS_PYAPI)
+
+#define PyDataType_FLAGCHK(dtype, flag) \
+ (((dtype)->hasobject & (flag)) == (flag))
+
+#define PyDataType_REFCHK(dtype) \
+ PyDataType_FLAGCHK(dtype, NPY_ITEM_REFCOUNT)
+
+/* Change dtype hasobject to 32-bit in 1.1 and change its name */
+typedef struct _PyArray_Descr {
+ PyObject_HEAD
+ PyTypeObject *typeobj; /* the type object representing an
+ instance of this type -- should not
+ be two type_numbers with the same type
+ object. */
+ char kind; /* kind for this type */
+ char type; /* unique-character representing this type */
+ char byteorder; /* '>' (big), '<' (little), '|'
+ (not-applicable), or '=' (native). */
+ char hasobject; /* non-zero if it has object arrays
+ in fields */
+ int type_num; /* number representing this type */
+ int elsize; /* element size for this type */
+ int alignment; /* alignment needed for this type */
+ struct _arr_descr \
+ *subarray; /* Non-NULL if this type is
+ is an array (C-contiguous)
+ of some other type
+ */
+ PyObject *fields; /* The fields dictionary for this type */
+ /* For statically defined descr this
+ is always Py_None */
+
+ PyObject *names; /* An ordered tuple of field names or NULL
+ if no fields are defined */
+
+ PyArray_ArrFuncs *f; /* a table of functions specific for each
+ basic data descriptor */
+} PyArray_Descr;
+
+typedef struct _arr_descr {
+ PyArray_Descr *base;
+ PyObject *shape; /* a tuple */
+} PyArray_ArrayDescr;
+
+/*
+ The main array object structure. It is recommended to use the macros
+ defined below (PyArray_DATA and friends) access fields here, instead
+ of the members themselves.
+ */
+
+typedef struct PyArrayObject {
+ PyObject_HEAD
+ char *data; /* pointer to raw data buffer */
+ int nd; /* number of dimensions, also called ndim */
+ npy_intp *dimensions; /* size in each dimension */
+ npy_intp *strides; /* bytes to jump to get to the
+ next element in each dimension */
+ PyObject *base; /* This object should be decref'd
+ upon deletion of array */
+ /* For views it points to the original array */
+ /* For creation from buffer object it points
+ to an object that shold be decref'd on
+ deletion */
+ /* For UPDATEIFCOPY flag this is an array
+ to-be-updated upon deletion of this one */
+ PyArray_Descr *descr; /* Pointer to type structure */
+ int flags; /* Flags describing array -- see below*/
+ PyObject *weakreflist; /* For weakreferences */
+} PyArrayObject;
+
+#define NPY_AO PyArrayObject
+
+#define fortran fortran_ /* For some compilers */
+
+/* Array Flags Object */
+typedef struct PyArrayFlagsObject {
+ PyObject_HEAD
+ PyObject *arr;
+ int flags;
+} PyArrayFlagsObject;
+
+/* Mirrors buffer object to ptr */
+
+typedef struct {
+ PyObject_HEAD
+ PyObject *base;
+ void *ptr;
+ npy_intp len;
+ int flags;
+} PyArray_Chunk;
+
+typedef int (PyArray_FinalizeFunc)(PyArrayObject *, PyObject *);
+
+/* Means c-style contiguous (last index varies the fastest). The
+ data elements right after each other. */
+#define NPY_CONTIGUOUS 0x0001
+/* set if array is a contiguous Fortran array: the first index
+ varies the fastest in memory (strides array is reverse of
+ C-contiguous array)*/
+#define NPY_FORTRAN 0x0002
+
+#define NPY_C_CONTIGUOUS NPY_CONTIGUOUS
+#define NPY_F_CONTIGUOUS NPY_FORTRAN
+
+/*
+ Note: all 0-d arrays are CONTIGUOUS and FORTRAN contiguous. If a
+ 1-d array is CONTIGUOUS it is also FORTRAN contiguous
+*/
+
+/* If set, the array owns the data: it will be free'd when the array
+ is deleted. */
+#define NPY_OWNDATA 0x0004
+
+/* An array never has the next four set; they're only used as parameter
+ flags to the the various FromAny functions */
+
+/* Cause a cast to occur regardless of whether or not it is safe. */
+#define NPY_FORCECAST 0x0010
+
+/* Always copy the array. Returned arrays are always CONTIGUOUS, ALIGNED,
+ and WRITEABLE. */
+#define NPY_ENSURECOPY 0x0020
+
+/* Make sure the returned array is an ndarray or a bigndarray */
+#define NPY_ENSUREARRAY 0x0040
+
+/* Make sure that the strides are in units of the element size
+ Needed for some operations with record-arrays.
+*/
+#define NPY_ELEMENTSTRIDES 0x0080
+
+/* Array data is aligned on the appropiate memory address for the
+ type stored according to how the compiler would align things
+ (e.g., an array of integers (4 bytes each) starts on
+ a memory address that's a multiple of 4) */
+#define NPY_ALIGNED 0x0100
+/* Array data has the native endianness */
+#define NPY_NOTSWAPPED 0x0200
+/* Array data is writeable */
+#define NPY_WRITEABLE 0x0400
+/* If this flag is set, then base contains a pointer to an array of
+ the same size that should be updated with the current contents of
+ this array when this array is deallocated
+*/
+#define NPY_UPDATEIFCOPY 0x1000
+
+/* This flag is for the array interface */
+#define NPY_ARR_HAS_DESCR 0x0800
+
+
+#define NPY_BEHAVED (NPY_ALIGNED | NPY_WRITEABLE)
+#define NPY_BEHAVED_NS (NPY_ALIGNED | NPY_WRITEABLE | NPY_NOTSWAPPED)
+#define NPY_CARRAY (NPY_CONTIGUOUS | NPY_BEHAVED)
+#define NPY_CARRAY_RO (NPY_CONTIGUOUS | NPY_ALIGNED)
+#define NPY_FARRAY (NPY_FORTRAN | NPY_BEHAVED)
+#define NPY_FARRAY_RO (NPY_FORTRAN | NPY_ALIGNED)
+#define NPY_DEFAULT NPY_CARRAY
+#define NPY_IN_ARRAY NPY_CARRAY_RO
+#define NPY_OUT_ARRAY NPY_CARRAY
+#define NPY_INOUT_ARRAY (NPY_CARRAY | NPY_UPDATEIFCOPY)
+#define NPY_IN_FARRAY NPY_FARRAY_RO
+#define NPY_OUT_FARRAY NPY_FARRAY
+#define NPY_INOUT_FARRAY (NPY_FARRAY | NPY_UPDATEIFCOPY)
+
+#define NPY_UPDATE_ALL (NPY_CONTIGUOUS | NPY_FORTRAN | NPY_ALIGNED)
+
+
+/* Size of internal buffers used for alignment */
+/* Make BUFSIZE a multiple of sizeof(cdouble) -- ususally 16 */
+/* So that ufunc buffers are aligned */
+#define NPY_MIN_BUFSIZE ((int)sizeof(cdouble))
+#define NPY_MAX_BUFSIZE (((int)sizeof(cdouble))*1000000)
+#define NPY_BUFSIZE 10000
+/* #define NPY_BUFSIZE 80*/
+
+#define PyArray_MAX(a,b) (((a)>(b))?(a):(b))
+#define PyArray_MIN(a,b) (((a)<(b))?(a):(b))
+#define PyArray_CLT(p,q) ((((p).real==(q).real) ? ((p).imag < (q).imag) : \
+ ((p).real < (q).real)))
+#define PyArray_CGT(p,q) ((((p).real==(q).real) ? ((p).imag > (q).imag) : \
+ ((p).real > (q).real)))
+#define PyArray_CLE(p,q) ((((p).real==(q).real) ? ((p).imag <= (q).imag) : \
+ ((p).real <= (q).real)))
+#define PyArray_CGE(p,q) ((((p).real==(q).real) ? ((p).imag >= (q).imag) : \
+ ((p).real >= (q).real)))
+#define PyArray_CEQ(p,q) (((p).real==(q).real) && ((p).imag == (q).imag))
+#define PyArray_CNE(p,q) (((p).real!=(q).real) || ((p).imag != (q).imag))
+
+/*
+ * C API: consists of Macros and functions. The MACROS are defined here.
+ */
+
+
+#define PyArray_CHKFLAGS(m, FLAGS) \
+ ((((PyArrayObject *)(m))->flags & (FLAGS)) == (FLAGS))
+
+#define PyArray_ISCONTIGUOUS(m) PyArray_CHKFLAGS(m, NPY_CONTIGUOUS)
+#define PyArray_ISWRITEABLE(m) PyArray_CHKFLAGS(m, NPY_WRITEABLE)
+#define PyArray_ISALIGNED(m) PyArray_CHKFLAGS(m, NPY_ALIGNED)
+
+
+#if NPY_ALLOW_THREADS
+#define NPY_BEGIN_ALLOW_THREADS Py_BEGIN_ALLOW_THREADS
+#define NPY_END_ALLOW_THREADS Py_END_ALLOW_THREADS
+#define NPY_BEGIN_THREADS_DEF PyThreadState *_save=NULL;
+#define NPY_BEGIN_THREADS _save = PyEval_SaveThread();
+#define NPY_END_THREADS if (_save) PyEval_RestoreThread(_save);
+
+#define NPY_BEGIN_THREADS_DESCR(dtype) \
+ if (!(PyDataType_FLAGCHK(dtype, NPY_NEEDS_PYAPI))) \
+ NPY_BEGIN_THREADS
+
+#define NPY_END_THREADS_DESCR(dtype) \
+ if (!(PyDataType_FLAGCHK(dtype, NPY_NEEDS_PYAPI))) \
+ NPY_END_THREADS
+
+#define NPY_ALLOW_C_API_DEF PyGILState_STATE __save__;
+#define NPY_ALLOW_C_API __save__ = PyGILState_Ensure();
+#define NPY_DISABLE_C_API PyGILState_Release(__save__);
+#else
+#define NPY_BEGIN_ALLOW_THREADS
+#define NPY_END_ALLOW_THREADS
+#define NPY_BEGIN_THREADS_DEF
+#define NPY_BEGIN_THREADS
+#define NPY_END_THREADS
+#define NPY_BEGIN_THREADS_DESCR(dtype)
+#define NPY_END_THREADS_DESCR(dtype)
+#define NPY_ALLOW_C_API_DEF
+#define NPY_ALLOW_C_API
+#define NPY_DISABLE_C_API
+#endif
+
+typedef struct {
+ PyObject_HEAD
+ int nd_m1; /* number of dimensions - 1 */
+ npy_intp index, size;
+ npy_intp coordinates[NPY_MAXDIMS];/* N-dimensional loop */
+ npy_intp dims_m1[NPY_MAXDIMS]; /* ao->dimensions - 1 */
+ npy_intp strides[NPY_MAXDIMS]; /* ao->strides or fake */
+ npy_intp backstrides[NPY_MAXDIMS];/* how far to jump back */
+ npy_intp factors[NPY_MAXDIMS]; /* shape factors */
+ PyArrayObject *ao;
+ char *dataptr; /* pointer to current item*/
+ npy_bool contiguous;
+} PyArrayIterObject;
+
+
+/* Iterator API */
+#define PyArrayIter_Check(op) PyObject_TypeCheck(op, &PyArrayIter_Type)
+
+#define _PyAIT(it) ((PyArrayIterObject *)(it))
+#define PyArray_ITER_RESET(it) { \
+ _PyAIT(it)->index = 0; \
+ _PyAIT(it)->dataptr = _PyAIT(it)->ao->data; \
+ memset(_PyAIT(it)->coordinates, 0, \
+ (_PyAIT(it)->nd_m1+1)*sizeof(npy_intp)); \
+}
+
+#define _PyArray_ITER_NEXT1(it) { \
+ (it)->dataptr += _PyAIT(it)->strides[0]; \
+ (it)->coordinates[0]++; \
+}
+
+#define _PyArray_ITER_NEXT2(it) { \
+ if ((it)->coordinates[1] < (it)->dims_m1[1]) { \
+ (it)->coordinates[1]++; \
+ (it)->dataptr += (it)->strides[1]; \
+ } \
+ else { \
+ (it)->coordinates[1] = 0; \
+ (it)->coordinates[0]++; \
+ (it)->dataptr += (it)->strides[0] - \
+ (it)->backstrides[1]; \
+ } \
+}
+
+#define _PyArray_ITER_NEXT3(it) { \
+ if ((it)->coordinates[2] < (it)->dims_m1[2]) { \
+ (it)->coordinates[2]++; \
+ (it)->dataptr += (it)->strides[2]; \
+ } \
+ else { \
+ (it)->coordinates[2] = 0; \
+ (it)->dataptr -= (it)->backstrides[2]; \
+ if ((it)->coordinates[1] < (it)->dims_m1[1]) { \
+ (it)->coordinates[1]++; \
+ (it)->dataptr += (it)->strides[1]; \
+ } \
+ else { \
+ (it)->coordinates[1] = 0; \
+ (it)->coordinates[0]++; \
+ (it)->dataptr += (it)->strides[0] - \
+ (it)->backstrides[1]; \
+ } \
+ } \
+}
+
+#define PyArray_ITER_NEXT(it) { \
+ _PyAIT(it)->index++; \
+ if (_PyAIT(it)->nd_m1 == 0) { \
+ _PyArray_ITER_NEXT1(_PyAIT(it)); \
+ } \
+ else if (_PyAIT(it)->contiguous) \
+ _PyAIT(it)->dataptr += _PyAIT(it)->ao->descr->elsize; \
+ else if (_PyAIT(it)->nd_m1 == 1) { \
+ _PyArray_ITER_NEXT2(_PyAIT(it)); \
+ } \
+ else { \
+ int __npy_i; \
+ for (__npy_i=_PyAIT(it)->nd_m1; __npy_i >= 0; __npy_i--) { \
+ if (_PyAIT(it)->coordinates[__npy_i] < \
+ _PyAIT(it)->dims_m1[__npy_i]) { \
+ _PyAIT(it)->coordinates[__npy_i]++; \
+ _PyAIT(it)->dataptr += \
+ _PyAIT(it)->strides[__npy_i]; \
+ break; \
+ } \
+ else { \
+ _PyAIT(it)->coordinates[__npy_i] = 0; \
+ _PyAIT(it)->dataptr -= \
+ _PyAIT(it)->backstrides[__npy_i]; \
+ } \
+ } \
+ } \
+}
+
+#define PyArray_ITER_GOTO(it, destination) { \
+ int __npy_i; \
+ _PyAIT(it)->index = 0; \
+ _PyAIT(it)->dataptr = _PyAIT(it)->ao->data; \
+ for (__npy_i = _PyAIT(it)->nd_m1; __npy_i>=0; __npy_i--) { \
+ if (destination[__npy_i] < 0) { \
+ destination[__npy_i] += \
+ _PyAIT(it)->dims_m1[__npy_i]+1; \
+ } \
+ _PyAIT(it)->dataptr += destination[__npy_i] * \
+ _PyAIT(it)->strides[__npy_i]; \
+ _PyAIT(it)->coordinates[__npy_i] = \
+ destination[__npy_i]; \
+ _PyAIT(it)->index += destination[__npy_i] * \
+ ( __npy_i==_PyAIT(it)->nd_m1 ? 1 : \
+ _PyAIT(it)->dims_m1[__npy_i+1]+1) ; \
+ } \
+}
+
+#define PyArray_ITER_GOTO1D(it, ind) { \
+ int __npy_i; \
+ npy_intp __npy_ind = (npy_intp) (ind); \
+ if (__npy_ind < 0) __npy_ind += _PyAIT(it)->size; \
+ _PyAIT(it)->index = __npy_ind; \
+ if (_PyAIT(it)->nd_m1 == 0) { \
+ _PyAIT(it)->dataptr = _PyAIT(it)->ao->data + \
+ __npy_ind * _PyAIT(it)->strides[0]; \
+ } \
+ else if (_PyAIT(it)->contiguous) \
+ _PyAIT(it)->dataptr = _PyAIT(it)->ao->data + \
+ __npy_ind * _PyAIT(it)->ao->descr->elsize; \
+ else { \
+ _PyAIT(it)->dataptr = _PyAIT(it)->ao->data; \
+ for (__npy_i = 0; __npy_i<=_PyAIT(it)->nd_m1; \
+ __npy_i++) { \
+ _PyAIT(it)->dataptr += \
+ (__npy_ind / _PyAIT(it)->factors[__npy_i]) \
+ * _PyAIT(it)->strides[__npy_i]; \
+ __npy_ind %= _PyAIT(it)->factors[__npy_i]; \
+ } \
+ } \
+}
+
+#define PyArray_ITER_DATA(it) ((void *)(_PyAIT(it)->dataptr))
+
+#define PyArray_ITER_NOTDONE(it) (_PyAIT(it)->index < _PyAIT(it)->size)
+
+
+/*
+ Any object passed to PyArray_Broadcast must be binary compatible with
+ this structure.
+*/
+
+typedef struct {
+ PyObject_HEAD
+ int numiter; /* number of iters */
+ npy_intp size; /* broadcasted size */
+ npy_intp index; /* current index */
+ int nd; /* number of dims */
+ npy_intp dimensions[NPY_MAXDIMS]; /* dimensions */
+ PyArrayIterObject *iters[NPY_MAXARGS]; /* iterators */
+} PyArrayMultiIterObject;
+
+#define _PyMIT(m) ((PyArrayMultiIterObject *)(m))
+#define PyArray_MultiIter_RESET(multi) { \
+ int __npy_mi; \
+ _PyMIT(multi)->index = 0; \
+ for (__npy_mi=0; __npy_mi < _PyMIT(multi)->numiter; __npy_mi++) { \
+ PyArray_ITER_RESET(_PyMIT(multi)->iters[__npy_mi]); \
+ } \
+}
+
+#define PyArray_MultiIter_NEXT(multi) { \
+ int __npy_mi; \
+ _PyMIT(multi)->index++; \
+ for (__npy_mi=0; __npy_mi < _PyMIT(multi)->numiter; __npy_mi++) { \
+ PyArray_ITER_NEXT(_PyMIT(multi)->iters[__npy_mi]); \
+ } \
+}
+
+#define PyArray_MultiIter_GOTO(multi, dest) { \
+ int __npy_mi; \
+ for (__npy_mi=0; __npy_mi < _PyMIT(multi)->numiter; __npy_mi++) { \
+ PyArray_ITER_GOTO(_PyMIT(multi)->iters[__npy_mi], dest); \
+ } \
+ _PyMIT(multi)->index = _PyMIT(multi)->iters[0]->index; \
+}
+
+#define PyArray_MultiIter_GOTO1D(multi, ind) { \
+ int __npy_mi; \
+ for (__npy_mi=0; __npy_mi < _PyMIT(multi)->numiter; __npy_mi++) { \
+ PyArray_ITER_GOTO1D(_PyMIT(multi)->iters[__npy_mi], ind); \
+ } \
+ _PyMIT(multi)->index = _PyMIT(multi)->iters[0]->index; \
+}
+
+#define PyArray_MultiIter_DATA(multi, i) \
+ ((void *)(_PyMIT(multi)->iters[i]->dataptr))
+
+#define PyArray_MultiIter_NEXTi(multi, i) \
+ PyArray_ITER_NEXT(_PyMIT(multi)->iters[i])
+
+#define PyArray_MultiIter_NOTDONE(multi) \
+ (_PyMIT(multi)->index < _PyMIT(multi)->size)
+
+/* Store the information needed for fancy-indexing over an array */
+
+typedef struct {
+ PyObject_HEAD
+ /* Multi-iterator portion --- needs to be present in this order to
+ work with PyArray_Broadcast */
+
+ int numiter; /* number of index-array
+ iterators */
+ npy_intp size; /* size of broadcasted
+ result */
+ npy_intp index; /* current index */
+ int nd; /* number of dims */
+ npy_intp dimensions[NPY_MAXDIMS]; /* dimensions */
+ PyArrayIterObject *iters[NPY_MAXDIMS]; /* index object
+ iterators */
+ PyArrayIterObject *ait; /* flat Iterator for
+ underlying array */
+
+ /* flat iterator for subspace (when numiter < nd) */
+ PyArrayIterObject *subspace;
+
+ /* if subspace iteration, then this is the array of
+ axes in the underlying array represented by the
+ index objects */
+ int iteraxes[NPY_MAXDIMS];
+ /* if subspace iteration, the these are the coordinates
+ to the start of the subspace.
+ */
+ npy_intp bscoord[NPY_MAXDIMS];
+
+ PyObject *indexobj; /* creating obj */
+ int consec;
+ char *dataptr;
+
+} PyArrayMapIterObject;
+
+/* The default array type
+ */
+#define NPY_DEFAULT_TYPE NPY_DOUBLE
+#define PyArray_DEFAULT NPY_DEFAULT_TYPE
+/* All sorts of useful ways to look into a PyArrayObject.
+ These are the recommended over casting to PyArrayObject and accessing
+ the members directly.
+ */
+
+#define PyArray_NDIM(obj) (((PyArrayObject *)(obj))->nd)
+#define PyArray_ISONESEGMENT(m) (PyArray_NDIM(m) == 0 || \
+ PyArray_CHKFLAGS(m, NPY_CONTIGUOUS) || \
+ PyArray_CHKFLAGS(m, NPY_FORTRAN))
+
+#define PyArray_ISFORTRAN(m) (PyArray_CHKFLAGS(m, NPY_FORTRAN) && \
+ (PyArray_NDIM(m) > 1))
+
+#define PyArray_FORTRAN_IF(m) ((PyArray_CHKFLAGS(m, NPY_FORTRAN) ? \
+ NPY_FORTRAN : 0))
+
+#define FORTRAN_IF PyArray_FORTRAN_IF
+#define PyArray_DATA(obj) ((void *)(((PyArrayObject *)(obj))->data))
+#define PyArray_BYTES(obj) (((PyArrayObject *)(obj))->data)
+#define PyArray_DIMS(obj) (((PyArrayObject *)(obj))->dimensions)
+#define PyArray_STRIDES(obj) (((PyArrayObject *)(obj))->strides)
+#define PyArray_DIM(obj,n) (PyArray_DIMS(obj)[n])
+#define PyArray_STRIDE(obj,n) (PyArray_STRIDES(obj)[n])
+#define PyArray_BASE(obj) (((PyArrayObject *)(obj))->base)
+#define PyArray_DESCR(obj) (((PyArrayObject *)(obj))->descr)
+#define PyArray_FLAGS(obj) (((PyArrayObject *)(obj))->flags)
+#define PyArray_ITEMSIZE(obj) (((PyArrayObject *)(obj))->descr->elsize)
+#define PyArray_TYPE(obj) (((PyArrayObject *)(obj))->descr->type_num)
+
+#define PyArray_GETITEM(obj,itemptr) \
+ ((PyArrayObject *)(obj))->descr->f->getitem((char *)(itemptr), \
+ (PyArrayObject *)(obj));
+
+#define PyArray_SETITEM(obj,itemptr,v) \
+ ((PyArrayObject *)(obj))->descr->f->setitem((PyObject *)(v), \
+ (char *)(itemptr), \
+ (PyArrayObject *)(obj));
+
+
+#define PyTypeNum_ISBOOL(type) ((type) == NPY_BOOL)
+
+#define PyTypeNum_ISUNSIGNED(type) (((type) == NPY_UBYTE) || \
+ ((type) == NPY_USHORT) || \
+ ((type) == NPY_UINT) || \
+ ((type) == NPY_ULONG) || \
+ ((type) == NPY_ULONGLONG))
+
+#define PyTypeNum_ISSIGNED(type) (((type) == NPY_BYTE) || \
+ ((type) == NPY_SHORT) || \
+ ((type) == NPY_INT) || \
+ ((type) == NPY_LONG) || \
+ ((type) == NPY_LONGLONG))
+
+#define PyTypeNum_ISINTEGER(type) (((type) >= NPY_BYTE) && \
+ ((type) <= NPY_ULONGLONG))
+
+#define PyTypeNum_ISFLOAT(type) (((type) >= NPY_FLOAT) && \
+ ((type) <= NPY_LONGDOUBLE))
+
+#define PyTypeNum_ISNUMBER(type) ((type) <= NPY_CLONGDOUBLE)
+
+#define PyTypeNum_ISSTRING(type) (((type) == NPY_STRING) || \
+ ((type) == NPY_UNICODE))
+
+#define PyTypeNum_ISCOMPLEX(type) (((type) >= NPY_CFLOAT) && \
+ ((type) <= NPY_CLONGDOUBLE))
+
+#define PyTypeNum_ISPYTHON(type) (((type) == NPY_LONG) || \
+ ((type) == NPY_DOUBLE) || \
+ ((type) == NPY_CDOUBLE) || \
+ ((type) == NPY_BOOL) || \
+ ((type) == NPY_OBJECT ))
+
+#define PyTypeNum_ISFLEXIBLE(type) (((type) >=NPY_STRING) && \
+ ((type) <=NPY_VOID))
+
+#define PyTypeNum_ISUSERDEF(type) (((type) >= NPY_USERDEF) && \
+ ((type) < NPY_USERDEF+ \
+ NPY_NUMUSERTYPES))
+
+#define PyTypeNum_ISEXTENDED(type) (PyTypeNum_ISFLEXIBLE(type) || \
+ PyTypeNum_ISUSERDEF(type))
+
+#define PyTypeNum_ISOBJECT(type) ((type) == NPY_OBJECT)
+
+
+#define PyDataType_ISBOOL(obj) PyTypeNum_ISBOOL(_PyADt(obj))
+#define PyDataType_ISUNSIGNED(obj) PyTypeNum_ISUNSIGNED(((PyArray_Descr*)(obj))->type_num)
+#define PyDataType_ISSIGNED(obj) PyTypeNum_ISSIGNED(((PyArray_Descr*)(obj))->type_num)
+#define PyDataType_ISINTEGER(obj) PyTypeNum_ISINTEGER(((PyArray_Descr*)(obj))->type_num )
+#define PyDataType_ISFLOAT(obj) PyTypeNum_ISFLOAT(((PyArray_Descr*)(obj))->type_num)
+#define PyDataType_ISNUMBER(obj) PyTypeNum_ISNUMBER(((PyArray_Descr*)(obj))->type_num)
+#define PyDataType_ISSTRING(obj) PyTypeNum_ISSTRING(((PyArray_Descr*)(obj))->type_num)
+#define PyDataType_ISCOMPLEX(obj) PyTypeNum_ISCOMPLEX(((PyArray_Descr*)(obj))->type_num)
+#define PyDataType_ISPYTHON(obj) PyTypeNum_ISPYTHON(((PyArray_Descr*)(obj))->type_num)
+#define PyDataType_ISFLEXIBLE(obj) PyTypeNum_ISFLEXIBLE(((PyArray_Descr*)(obj))->type_num)
+#define PyDataType_ISUSERDEF(obj) PyTypeNum_ISUSERDEF(((PyArray_Descr*)(obj))->type_num)
+#define PyDataType_ISEXTENDED(obj) PyTypeNum_ISEXTENDED(((PyArray_Descr*)(obj))->type_num)
+#define PyDataType_ISOBJECT(obj) PyTypeNum_ISOBJECT(((PyArray_Descr*)(obj))->type_num)
+#define PyDataType_HASFIELDS(obj) (((PyArray_Descr *)(obj))->names != NULL)
+
+#define PyArray_ISBOOL(obj) PyTypeNum_ISBOOL(PyArray_TYPE(obj))
+#define PyArray_ISUNSIGNED(obj) PyTypeNum_ISUNSIGNED(PyArray_TYPE(obj))
+#define PyArray_ISSIGNED(obj) PyTypeNum_ISSIGNED(PyArray_TYPE(obj))
+#define PyArray_ISINTEGER(obj) PyTypeNum_ISINTEGER(PyArray_TYPE(obj))
+#define PyArray_ISFLOAT(obj) PyTypeNum_ISFLOAT(PyArray_TYPE(obj))
+#define PyArray_ISNUMBER(obj) PyTypeNum_ISNUMBER(PyArray_TYPE(obj))
+#define PyArray_ISSTRING(obj) PyTypeNum_ISSTRING(PyArray_TYPE(obj))
+#define PyArray_ISCOMPLEX(obj) PyTypeNum_ISCOMPLEX(PyArray_TYPE(obj))
+#define PyArray_ISPYTHON(obj) PyTypeNum_ISPYTHON(PyArray_TYPE(obj))
+#define PyArray_ISFLEXIBLE(obj) PyTypeNum_ISFLEXIBLE(PyArray_TYPE(obj))
+#define PyArray_ISUSERDEF(obj) PyTypeNum_ISUSERDEF(PyArray_TYPE(obj))
+#define PyArray_ISEXTENDED(obj) PyTypeNum_ISEXTENDED(PyArray_TYPE(obj))
+#define PyArray_ISOBJECT(obj) PyTypeNum_ISOBJECT(PyArray_TYPE(obj))
+#define PyArray_HASFIELDS(obj) PyDataType_HASFIELDS(PyArray_DESCR(obj))
+
+#define NPY_LITTLE '<'
+#define NPY_BIG '>'
+#define NPY_NATIVE '='
+#define NPY_SWAP 's'
+#define NPY_IGNORE '|'
+
+#ifdef WORDS_BIGENDIAN
+#define NPY_NATBYTE NPY_BIG
+#define NPY_OPPBYTE NPY_LITTLE
+#else
+#define NPY_NATBYTE NPY_LITTLE
+#define NPY_OPPBYTE NPY_BIG
+#endif
+
+#define PyArray_ISNBO(arg) ((arg) != NPY_OPPBYTE)
+#define PyArray_IsNativeByteOrder PyArray_ISNBO
+#define PyArray_ISNOTSWAPPED(m) PyArray_ISNBO(PyArray_DESCR(m)->byteorder)
+#define PyArray_ISBYTESWAPPED(m) (!PyArray_ISNOTSWAPPED(m))
+
+#define PyArray_FLAGSWAP(m, flags) (PyArray_CHKFLAGS(m, flags) && \
+ PyArray_ISNOTSWAPPED(m))
+
+#define PyArray_ISCARRAY(m) PyArray_FLAGSWAP(m, NPY_CARRAY)
+#define PyArray_ISCARRAY_RO(m) PyArray_FLAGSWAP(m, NPY_CARRAY_RO)
+#define PyArray_ISFARRAY(m) PyArray_FLAGSWAP(m, NPY_FARRAY)
+#define PyArray_ISFARRAY_RO(m) PyArray_FLAGSWAP(m, NPY_FARRAY_RO)
+#define PyArray_ISBEHAVED(m) PyArray_FLAGSWAP(m, NPY_BEHAVED)
+#define PyArray_ISBEHAVED_RO(m) PyArray_FLAGSWAP(m, NPY_ALIGNED)
+
+
+#define PyDataType_ISNOTSWAPPED(d) PyArray_ISNBO(((PyArray_Descr *)(d))->byteorder)
+#define PyDataType_ISBYTESWAPPED(d) (!PyDataType_ISNOTSWAPPED(d))
+
+
+/* This is the form of the struct that's returned pointed by the
+ PyCObject attribute of an array __array_struct__. See
+ http://numpy.scipy.org/array_interface.shtml for the full
+ documentation. */
+typedef struct {
+ int two; /* contains the integer 2 as a sanity check */
+ int nd; /* number of dimensions */
+ char typekind; /* kind in array --- character code of typestr */
+ int itemsize; /* size of each element */
+ int flags; /* how should be data interpreted. Valid
+ flags are CONTIGUOUS (1), FORTRAN (2),
+ ALIGNED (0x100), NOTSWAPPED (0x200), and
+ WRITEABLE (0x400).
+ ARR_HAS_DESCR (0x800) states that arrdescr
+ field is present in structure */
+ npy_intp *shape; /* A length-nd array of shape information */
+ npy_intp *strides; /* A length-nd array of stride information */
+ void *data; /* A pointer to the first element of the array */
+ PyObject *descr; /* A list of fields or NULL (ignored if flags
+ does not have ARR_HAS_DESCR flag set) */
+} PyArrayInterface;
+
+
+/* Includes the "function" C-API -- these are all stored in a
+ list of pointers --- one for each file
+ The two lists are concatenated into one in multiarray.
+
+ They are available as import_array()
+*/
+
+#include "__multiarray_api.h"
+
+
+/* C-API that requries previous API to be defined */
+
+#define PyArray_DescrCheck(op) ((op)->ob_type == &PyArrayDescr_Type)
+
+#define PyArray_Check(op) ((op)->ob_type == &PyArray_Type || \
+ PyObject_TypeCheck(op, &PyArray_Type))
+
+#define PyArray_CheckExact(op) ((op)->ob_type == &PyArray_Type)
+
+#define PyArray_HasArrayInterfaceType(op, type, context, out) \
+ ((((out)=PyArray_FromStructInterface(op)) != Py_NotImplemented) || \
+ (((out)=PyArray_FromInterface(op)) != Py_NotImplemented) || \
+ (((out)=PyArray_FromArrayAttr(op, type, context)) != \
+ Py_NotImplemented))
+
+#define PyArray_HasArrayInterface(op, out) \
+ PyArray_HasArrayInterfaceType(op, NULL, NULL, out)
+
+#define PyArray_IsZeroDim(op) (PyArray_Check(op) && (PyArray_NDIM(op) == 0))
+
+#define PyArray_IsScalar(obj, cls) \
+ (PyObject_TypeCheck(obj, &Py##cls##ArrType_Type))
+
+#define PyArray_CheckScalar(m) (PyArray_IsScalar(m, Generic) || \
+ PyArray_IsZeroDim(m))
+
+#define PyArray_IsPythonNumber(obj) \
+ (PyInt_Check(obj) || PyFloat_Check(obj) || PyComplex_Check(obj) || \
+ PyLong_Check(obj) || PyBool_Check(obj))
+
+#define PyArray_IsPythonScalar(obj) \
+ (PyArray_IsPythonNumber(obj) || PyString_Check(obj) || \
+ PyUnicode_Check(obj))
+
+#define PyArray_IsAnyScalar(obj) \
+ (PyArray_IsScalar(obj, Generic) || PyArray_IsPythonScalar(obj))
+
+#define PyArray_CheckAnyScalar(obj) (PyArray_IsPythonScalar(obj) || \
+ PyArray_CheckScalar(obj))
+
+#define PyArray_GETCONTIGUOUS(m) (PyArray_ISCONTIGUOUS(m) ? \
+ Py_INCREF(m), (m) : \
+ (PyArrayObject *)(PyArray_Copy(m)))
+
+#define PyArray_SAMESHAPE(a1,a2) ((PyArray_NDIM(a1) == PyArray_NDIM(a2)) && \
+ PyArray_CompareLists(PyArray_DIMS(a1), \
+ PyArray_DIMS(a2), \
+ PyArray_NDIM(a1)))
+
+#define PyArray_SIZE(m) PyArray_MultiplyList(PyArray_DIMS(m), PyArray_NDIM(m))
+#define PyArray_NBYTES(m) (PyArray_ITEMSIZE(m) * PyArray_SIZE(m))
+#define PyArray_FROM_O(m) PyArray_FromAny(m, NULL, 0, 0, 0, NULL)
+
+#define PyArray_FROM_OF(m,flags) PyArray_CheckFromAny(m, NULL, 0, 0, flags, \
+ NULL)
+
+#define PyArray_FROM_OT(m,type) PyArray_FromAny(m, \
+ PyArray_DescrFromType(type), 0, 0, 0, NULL);
+
+#define PyArray_FROM_OTF(m, type, flags) \
+ PyArray_FromAny(m, PyArray_DescrFromType(type), 0, 0, \
+ (((flags) & NPY_ENSURECOPY) ? \
+ ((flags) | NPY_DEFAULT) : (flags)), NULL)
+
+#define PyArray_FROMANY(m, type, min, max, flags) \
+ PyArray_FromAny(m, PyArray_DescrFromType(type), min, max, \
+ (((flags) & NPY_ENSURECOPY) ? \
+ (flags) | NPY_DEFAULT : (flags)), NULL)
+
+#define PyArray_ZEROS(m, dims, type, fortran) \
+ PyArray_Zeros(m, dims, PyArray_DescrFromType(type), fortran)
+
+#define PyArray_EMPTY(m, dims, type, fortran) \
+ PyArray_Empty(m, dims, PyArray_DescrFromType(type), fortran)
+
+#define PyArray_FILLWBYTE(obj, val) memset(PyArray_DATA(obj), val, \
+ PyArray_NBYTES(obj))
+
+#define PyArray_REFCOUNT(obj) (((PyObject *)(obj))->ob_refcnt)
+#define NPY_REFCOUNT PyArray_REFCOUNT
+#define NPY_MAX_ELSIZE (2*SIZEOF_LONGDOUBLE)
+
+#define PyArray_ContiguousFromAny(op, type, min_depth, max_depth) \
+ PyArray_FromAny(op, PyArray_DescrFromType(type), min_depth, \
+ max_depth, NPY_DEFAULT, NULL)
+
+#define PyArray_EquivArrTypes(a1, a2) \
+ PyArray_EquivTypes(PyArray_DESCR(a1), PyArray_DESCR(a2))
+
+#define PyArray_EquivByteorders(b1, b2) \
+ (((b1) == (b2)) || (PyArray_ISNBO(b1) == PyArray_ISNBO(b2)))
+
+#define PyArray_SimpleNew(nd, dims, typenum) \
+ PyArray_New(&PyArray_Type, nd, dims, typenum, NULL, NULL, 0, 0, NULL)
+
+#define PyArray_SimpleNewFromData(nd, dims, typenum, data) \
+ PyArray_New(&PyArray_Type, nd, dims, typenum, NULL, \
+ data, 0, NPY_CARRAY, NULL)
+
+#define PyArray_SimpleNewFromDescr(nd, dims, descr) \
+ PyArray_NewFromDescr(&PyArray_Type, descr, nd, dims, \
+ NULL, NULL, 0, NULL)
+
+#define PyArray_ToScalar(data, arr) \
+ PyArray_Scalar(data, PyArray_DESCR(arr), (PyObject *)arr)
+
+
+/* These might be faster without the dereferencing of obj
+ going on inside -- of course an optimizing compiler should
+ inline the constants inside a for loop making it a moot point
+*/
+
+#define PyArray_GETPTR1(obj, i) (void *)(PyArray_BYTES(obj) + \
+ (i)*PyArray_STRIDES(obj)[0])
+
+#define PyArray_GETPTR2(obj, i, j) (void *)(PyArray_BYTES(obj) + \
+ (i)*PyArray_STRIDES(obj)[0] + \
+ (j)*PyArray_STRIDES(obj)[1])
+
+#define PyArray_GETPTR3(obj, i, j, k) (void *)(PyArray_BYTES(obj) + \
+ (i)*PyArray_STRIDES(obj)[0] + \
+ (j)*PyArray_STRIDES(obj)[1] + \
+ (k)*PyArray_STRIDES(obj)[2]) \
+
+#define PyArray_GETPTR4(obj, i, j, k, l) (void *)(PyArray_BYTES(obj) + \
+ (i)*PyArray_STRIDES(obj)[0] + \
+ (j)*PyArray_STRIDES(obj)[1] + \
+ (k)*PyArray_STRIDES(obj)[2] + \
+ (l)*PyArray_STRIDES(obj)[3])
+
+#define PyArray_XDECREF_ERR(obj) \
+ if (obj && (PyArray_FLAGS(obj) & NPY_UPDATEIFCOPY)) { \
+ PyArray_FLAGS(PyArray_BASE(obj)) |= NPY_WRITEABLE; \
+ PyArray_FLAGS(obj) &= ~NPY_UPDATEIFCOPY; \
+ } \
+ Py_XDECREF(obj)
+
+#define PyArray_DESCR_REPLACE(descr) do { \
+ PyArray_Descr *_new_; \
+ _new_ = PyArray_DescrNew(descr); \
+ Py_XDECREF(descr); \
+ descr = _new_; \
+ } while(0)
+
+/* Copy should always return contiguous array */
+#define PyArray_Copy(obj) PyArray_NewCopy(obj, NPY_CORDER)
+
+#define PyArray_FromObject(op, type, min_depth, max_depth) \
+ PyArray_FromAny(op, PyArray_DescrFromType(type), min_depth, \
+ max_depth, NPY_BEHAVED | NPY_ENSUREARRAY, NULL)
+
+#define PyArray_ContiguousFromObject(op, type, min_depth, max_depth) \
+ PyArray_FromAny(op, PyArray_DescrFromType(type), min_depth, \
+ max_depth, NPY_DEFAULT | NPY_ENSUREARRAY, NULL)
+
+#define PyArray_CopyFromObject(op, type, min_depth, max_depth) \
+ PyArray_FromAny(op, PyArray_DescrFromType(type), min_depth, \
+ max_depth, NPY_ENSURECOPY | NPY_DEFAULT | \
+ NPY_ENSUREARRAY, NULL)
+
+#define PyArray_Cast(mp, type_num) \
+ PyArray_CastToType(mp, PyArray_DescrFromType(type_num), 0)
+
+#define PyArray_Take(ap, items, axis) \
+ PyArray_TakeFrom(ap, items, axis, NULL, NPY_RAISE)
+
+#define PyArray_Put(ap, items, values) \
+ PyArray_PutTo(ap, items, values, NPY_RAISE)
+
+/* Compatibility with old Numeric stuff -- don't use in new code */
+
+#define PyArray_FromDimsAndData(nd, d, type, data) \
+ PyArray_FromDimsAndDataAndDescr(nd, d, PyArray_DescrFromType(type), \
+ data)
+
+#include "old_defines.h"
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* NPY_NDARRAYOBJECT_H */
diff --git a/numpy/core/include/numpy/noprefix.h b/numpy/core/include/numpy/noprefix.h
new file mode 100644
index 000000000..dc4f71c70
--- /dev/null
+++ b/numpy/core/include/numpy/noprefix.h
@@ -0,0 +1,191 @@
+#ifndef NPY_NOPREFIX_H
+#define NPY_NOPREFIX_H
+
+/* You can directly include noprefix.h as a backward
+compatibility measure*/
+#ifndef NPY_NO_PREFIX
+#include "ndarrayobject.h"
+#endif
+
+#define MAX_DIMS NPY_MAXDIMS
+
+#define longlong npy_longlong
+#define ulonglong npy_ulonglong
+#define Bool npy_bool
+#define longdouble npy_longdouble
+#define byte npy_byte
+
+#ifndef _BSD_SOURCE
+#define ushort npy_ushort
+#define uint npy_uint
+#define ulong npy_ulong
+#endif
+
+#define ubyte npy_ubyte
+#define ushort npy_ushort
+#define uint npy_uint
+#define ulong npy_ulong
+#define cfloat npy_cfloat
+#define cdouble npy_cdouble
+#define clongdouble npy_clongdouble
+#define Int8 npy_int8
+#define UInt8 npy_uint8
+#define Int16 npy_int16
+#define UInt16 npy_uint16
+#define Int32 npy_int32
+#define UInt32 npy_uint32
+#define Int64 npy_int64
+#define UInt64 npy_uint64
+#define Int128 npy_int128
+#define UInt128 npy_uint128
+#define Int256 npy_int256
+#define UInt256 npy_uint256
+#define Float16 npy_float16
+#define Complex32 npy_complex32
+#define Float32 npy_float32
+#define Complex64 npy_complex64
+#define Float64 npy_float64
+#define Complex128 npy_complex128
+#define Float80 npy_float80
+#define Complex160 npy_complex160
+#define Float96 npy_float96
+#define Complex192 npy_complex192
+#define Float128 npy_float128
+#define Complex256 npy_complex256
+#define intp npy_intp
+#define uintp npy_uintp
+
+#define SIZEOF_INTP NPY_SIZEOF_INTP
+#define SIZEOF_UINTP NPY_SIZEOF_UINTP
+
+#define LONGLONG_FMT NPY_LONGLONG_FMT
+#define ULONGLONG_FMT NPY_ULONGLONG_FMT
+#define LONGLONG_SUFFIX NPY_LONGLONG_SUFFIX
+#define ULONGLONG_SUFFIX NPY_ULONGLONG_SUFFIX(x)
+
+#define MAX_INT8 127
+#define MIN_INT8 -128
+#define MAX_UINT8 255
+#define MAX_INT16 32767
+#define MIN_INT16 -32768
+#define MAX_UINT16 65535
+#define MAX_INT32 2147483647
+#define MIN_INT32 (-MAX_INT32 - 1)
+#define MAX_UINT32 4294967295U
+#define MAX_INT64 LONGLONG_SUFFIX(9223372036854775807)
+#define MIN_INT64 (-MAX_INT64 - LONGLONG_SUFFIX(1))
+#define MAX_UINT64 ULONGLONG_SUFFIX(18446744073709551615)
+#define MAX_INT128 LONGLONG_SUFFIX(85070591730234615865843651857942052864)
+#define MIN_INT128 (-MAX_INT128 - LONGLONG_SUFFIX(1))
+#define MAX_UINT128 ULONGLONG_SUFFIX(170141183460469231731687303715884105728)
+#define MAX_INT256 LONGLONG_SUFFIX(57896044618658097711785492504343953926634992332820282019728792003956564819967)
+#define MIN_INT256 (-MAX_INT256 - LONGLONG_SUFFIX(1))
+#define MAX_UINT256 ULONGLONG_SUFFIX(115792089237316195423570985008687907853269984665640564039457584007913129639935)
+
+#define MAX_BYTE NPY_MAX_BYTE
+#define MIN_BYTE NPY_MIN_BYTE
+#define MAX_UBYTE NPY_MAX_UBYTE
+#define MAX_SHORT NPY_MAX_SHORT
+#define MIN_SHORT NPY_MIN_SHORT
+#define MAX_USHORT NPY_MAX_USHORT
+#define MAX_INT NPY_MAX_INT
+#define MIN_INT NPY_MIN_INT
+#define MAX_UINT NPY_MAX_UINT
+#define MAX_LONG NPY_MAX_LONG
+#define MIN_LONG NPY_MIN_LONG
+#define MAX_ULONG NPY_MAX_ULONG
+#define MAX_LONGLONG NPY_MAX_LONGLONG
+#define MIN_LONGLONG NPY_MIN_LONGLONG
+#define MAX_ULONGLONG NPY_MAX_ULONGLONG
+
+#define SIZEOF_LONGDOUBLE NPY_SIZEOF_LONGDOUBLE
+#define SIZEOF_LONGLONG NPY_SIZEOF_LONGLONG
+#define BITSOF_BOOL NPY_BITSOF_BOOL
+#define BITSOF_CHAR NPY_BITSOF_CHAR
+#define BITSOF_SHORT NPY_BITSOF_SHORT
+#define BITSOF_INT NPY_BITSOF_INT
+#define BITSOF_LONG NPY_BITSOF_LONG
+#define BITSOF_LONGLONG NPY_BITSOF_LONGLONG
+#define BITSOF_FLOAT NPY_BITSOF_FLOAT
+#define BITSOF_DOUBLE NPY_BITSOF_DOUBLE
+#define BITSOF_LONGDOUBLE NPY_BITSOF_LONGDOUBLE
+
+#define PyArray_UCS4 npy_ucs4
+#define _pya_malloc PyArray_malloc
+#define _pya_free PyArray_free
+#define _pya_realloc PyArray_realloc
+
+#define BEGIN_THREADS_DEF NPY_BEGIN_THREADS_DEF
+#define BEGIN_THREADS NPY_BEGIN_THREADS
+#define END_THREADS NPY_END_THREADS
+#define ALLOW_C_API_DEF NPY_ALLOW_C_API_DEF
+#define ALLOW_C_API NPY_ALLOW_C_API
+#define DISABLE_C_API NPY_DISABLE_C_API
+
+#define PY_FAIL NPY_FAIL
+#define PY_SUCCEED NPY_SUCCEED
+
+#ifndef TRUE
+#define TRUE NPY_TRUE
+#endif
+
+#ifndef FALSE
+#define FALSE NPY_FALSE
+#endif
+
+#define LONGDOUBLE_FMT NPY_LONGDOUBLE_FMT
+
+#define CONTIGUOUS NPY_CONTIGUOUS
+#define C_CONTIGUOUS NPY_C_CONTIGUOUS
+#define FORTRAN NPY_FORTRAN
+#define F_CONTIGUOUS NPY_F_CONTIGUOUS
+#define OWNDATA NPY_OWNDATA
+#define FORCECAST NPY_FORCECAST
+#define ENSURECOPY NPY_ENSURECOPY
+#define ENSUREARRAY NPY_ENSUREARRAY
+#define ELEMENTSTRIDES NPY_ELEMENTSTRIDES
+#define ALIGNED NPY_ALIGNED
+#define NOTSWAPPED NPY_NOTSWAPPED
+#define WRITEABLE NPY_WRITEABLE
+#define UPDATEIFCOPY NPY_UPDATEIFCOPY
+#define ARR_HAS_DESCR NPY_ARR_HAS_DESCR
+#define BEHAVED NPY_BEHAVED
+#define BEHAVED_NS NPY_BEHAVED_NS
+#define CARRAY NPY_CARRAY
+#define CARRAY_RO NPY_CARRAY_RO
+#define FARRAY NPY_FARRAY
+#define FARRAY_RO NPY_FARRAY_RO
+#define DEFAULT NPY_DEFAULT
+#define IN_ARRAY NPY_IN_ARRAY
+#define OUT_ARRAY NPY_OUT_ARRAY
+#define INOUT_ARRAY NPY_INOUT_ARRAY
+#define IN_FARRAY NPY_IN_FARRAY
+#define OUT_FARRAY NPY_OUT_FARRAY
+#define INOUT_FARRAY NPY_INOUT_FARRAY
+#define UPDATE_ALL NPY_UPDATE_ALL
+
+#define OWN_DATA NPY_OWNDATA
+#define BEHAVED_FLAGS NPY_BEHAVED
+#define BEHAVED_FLAGS_NS NPY_BEHAVED_NS
+#define CARRAY_FLAGS_RO NPY_CARRAY_RO
+#define CARRAY_FLAGS NPY_CARRAY
+#define FARRAY_FLAGS NPY_FARRAY
+#define FARRAY_FLAGS_RO NPY_FARRAY_RO
+#define DEFAULT_FLAGS NPY_DEFAULT
+#define UPDATE_ALL_FLAGS NPY_UPDATE_ALL_FLAGS
+
+#ifndef MIN
+#define MIN PyArray_MIN
+#endif
+#ifndef MAX
+#define MAX PyArray_MAX
+#endif
+#define MAX_INTP NPY_MAX_INTP
+#define MIN_INTP NPY_MIN_INTP
+#define MAX_UINTP NPY_MAX_UINTP
+#define INTP_FMT NPY_INTP_FMT
+
+#define REFCOUNT PyArray_REFCOUNT
+#define MAX_ELSIZE NPY_MAX_ELSIZE
+
+#endif
diff --git a/numpy/core/include/numpy/npy_interrupt.h b/numpy/core/include/numpy/npy_interrupt.h
new file mode 100644
index 000000000..eb72fbaf0
--- /dev/null
+++ b/numpy/core/include/numpy/npy_interrupt.h
@@ -0,0 +1,117 @@
+
+/* Signal handling:
+
+This header file defines macros that allow your code to handle
+interrupts received during processing. Interrupts that
+could reasonably be handled:
+
+SIGINT, SIGABRT, SIGALRM, SIGSEGV
+
+****Warning***************
+
+Do not allow code that creates temporary memory or increases reference
+counts of Python objects to be interrupted unless you handle it
+differently.
+
+**************************
+
+The mechanism for handling interrupts is conceptually simple:
+
+ - replace the signal handler with our own home-grown version
+ and store the old one.
+ - run the code to be interrupted -- if an interrupt occurs
+ the handler should basically just cause a return to the
+ calling function for finish work.
+ - restore the old signal handler
+
+Of course, every code that allows interrupts must account for
+returning via the interrupt and handle clean-up correctly. But,
+even still, the simple paradigm is complicated by at least three
+factors.
+
+ 1) platform portability (i.e. Microsoft says not to use longjmp
+ to return from signal handling. They have a __try and __except
+ extension to C instead but what about mingw?).
+
+ 2) how to handle threads: apparently whether signals are delivered to
+ every thread of the process or the "invoking" thread is platform
+ dependent. --- we don't handle threads for now.
+
+ 3) do we need to worry about re-entrance. For now, assume the
+ code will not call-back into itself.
+
+Ideas:
+
+ 1) Start by implementing an approach that works on platforms that
+ can use setjmp and longjmp functionality and does nothing
+ on other platforms.
+
+ 2) Ignore threads --- i.e. do not mix interrupt handling and threads
+
+ 3) Add a default signal_handler function to the C-API but have the rest
+ use macros.
+
+
+Simple Interface:
+
+
+In your C-extension: around a block of code you want to be interruptable
+with a SIGINT
+
+NPY_SIGINT_ON
+[code]
+NPY_SIGINT_OFF
+
+In order for this to work correctly, the
+[code] block must not allocate any memory or alter the reference count of any
+Python objects. In other words [code] must be interruptible so that continuation
+after NPY_SIGINT_OFF will only be "missing some computations"
+
+Interrupt handling does not work well with threads.
+
+*/
+
+/* Add signal handling macros
+ Make the global variable and signal handler part of the C-API
+*/
+
+#ifndef NPY_INTERRUPT_H
+#define NPY_INTERRUPT_H
+
+#ifndef NPY_NO_SIGNAL
+
+#include <setjmp.h>
+#include <signal.h>
+
+#ifndef sigsetjmp
+
+#define SIGSETJMP(arg1, arg2) setjmp(arg1)
+#define SIGLONGJMP(arg1, arg2) longjmp(arg1, arg2)
+#define SIGJMP_BUF jmp_buf
+
+#else
+
+#define SIGSETJMP(arg1, arg2) sigsetjmp(arg1, arg2)
+#define SIGLONGJMP(arg1, arg2) siglongjmp(arg1, arg2)
+#define SIGJMP_BUF sigjmp_buf
+
+#endif
+
+# define NPY_SIGINT_ON { \
+ PyOS_sighandler_t _npy_sig_save; \
+ _npy_sig_save = PyOS_setsig(SIGINT, _PyArray_SigintHandler); \
+ if (SIGSETJMP(*((SIGJMP_BUF *)_PyArray_GetSigintBuf()), \
+ 1) == 0) { \
+
+# define NPY_SIGINT_OFF } \
+ PyOS_setsig(SIGINT, _npy_sig_save); \
+ }
+
+#else /* NPY_NO_SIGNAL */
+
+# define NPY_SIGINT_ON
+# define NPY_SIGINT_OFF
+
+#endif /* HAVE_SIGSETJMP */
+
+#endif /* NPY_INTERRUPT_H */
diff --git a/numpy/core/include/numpy/old_defines.h b/numpy/core/include/numpy/old_defines.h
new file mode 100644
index 000000000..c21665268
--- /dev/null
+++ b/numpy/core/include/numpy/old_defines.h
@@ -0,0 +1,169 @@
+#define NDARRAY_VERSION NPY_VERSION
+
+#define PyArray_MIN_BUFSIZE NPY_MIN_BUFSIZE
+#define PyArray_MAX_BUFSIZE NPY_MAX_BUFSIZE
+#define PyArray_BUFSIZE NPY_BUFSIZE
+
+#define PyArray_PRIORITY NPY_PRIORITY
+#define PyArray_SUBTYPE_PRIORITY NPY_PRIORITY
+#define PyArray_NUM_FLOATTYPE NPY_NUM_FLOATTYPE
+
+#define NPY_MAX PyArray_MAX
+#define NPY_MIN PyArray_MIN
+
+#define PyArray_TYPES NPY_TYPES
+#define PyArray_BOOL NPY_BOOL
+#define PyArray_BYTE NPY_BYTE
+#define PyArray_UBYTE NPY_UBYTE
+#define PyArray_SHORT NPY_SHORT
+#define PyArray_USHORT NPY_USHORT
+#define PyArray_INT NPY_INT
+#define PyArray_UINT NPY_UINT
+#define PyArray_LONG NPY_LONG
+#define PyArray_ULONG NPY_ULONG
+#define PyArray_LONGLONG NPY_LONGLONG
+#define PyArray_ULONGLONG NPY_ULONGLONG
+#define PyArray_FLOAT NPY_FLOAT
+#define PyArray_DOUBLE NPY_DOUBLE
+#define PyArray_LONGDOUBLE NPY_LONGDOUBLE
+#define PyArray_CFLOAT NPY_CFLOAT
+#define PyArray_CDOUBLE NPY_CDOUBLE
+#define PyArray_CLONGDOUBLE NPY_CLONGDOUBLE
+#define PyArray_OBJECT NPY_OBJECT
+#define PyArray_STRING NPY_STRING
+#define PyArray_UNICODE NPY_UNICODE
+#define PyArray_VOID NPY_VOID
+#define PyArray_NTYPES NPY_NTYPES
+#define PyArray_NOTYPE NPY_NOTYPE
+#define PyArray_CHAR NPY_CHAR
+#define PyArray_USERDEF NPY_USERDEF
+#define PyArray_NUMUSERTYPES NPY_NUMUSERTYPES
+
+#define PyArray_INTP NPY_INTP
+#define PyArray_UINTP NPY_UINTP
+
+#define PyArray_INT8 NPY_INT8
+#define PyArray_UINT8 NPY_UINT8
+#define PyArray_INT16 NPY_INT16
+#define PyArray_UINT16 NPY_UINT16
+#define PyArray_INT32 NPY_INT32
+#define PyArray_UINT32 NPY_UINT32
+
+#ifdef NPY_INT64
+#define PyArray_INT64 NPY_INT64
+#define PyArray_UINT64 NPY_UINT64
+#endif
+
+#ifdef NPY_INT128
+#define PyArray_INT128 NPY_INT128
+#define PyArray_UINT128 NPY_UINT128
+#endif
+
+#ifdef NPY_FLOAT16
+#define PyArray_FLOAT16 NPY_FLOAT16
+#define PyArray_COMPLEX32 NPY_COMPLEX32
+#endif
+
+#ifdef NPY_FLOAT80
+#define PyArray_FLOAT80 NPY_FLOAT80
+#define PyArray_COMPLEX160 NPY_COMPLEX160
+#endif
+
+#ifdef NPY_FLOAT96
+#define PyArray_FLOAT96 NPY_FLOAT96
+#define PyArray_COMPLEX192 NPY_COMPLEX192
+#endif
+
+#ifdef NPY_FLOAT128
+#define PyArray_FLOAT128 NPY_FLOAT128
+#define PyArray_COMPLEX256 NPY_COMPLEX256
+#endif
+
+#define PyArray_FLOAT32 NPY_FLOAT32
+#define PyArray_COMPLEX64 NPY_COMPLEX64
+#define PyArray_FLOAT64 NPY_FLOAT64
+#define PyArray_COMPLEX128 NPY_COMPLEX128
+
+
+#define PyArray_TYPECHAR NPY_TYPECHAR
+#define PyArray_BOOLLTR NPY_BOOLLTR
+#define PyArray_BYTELTR NPY_BYTELTR
+#define PyArray_UBYTELTR NPY_UBYTELTR
+#define PyArray_SHORTLTR NPY_SHORTLTR
+#define PyArray_USHORTLTR NPY_USHORTLTR
+#define PyArray_INTLTR NPY_INTLTR
+#define PyArray_UINTLTR NPY_UINTLTR
+#define PyArray_LONGLTR NPY_LONGLTR
+#define PyArray_ULONGLTR NPY_ULONGLTR
+#define PyArray_LONGLONGLTR NPY_LONGLONGLTR
+#define PyArray_ULONGLONGLTR NPY_ULONGLONGLTR
+#define PyArray_FLOATLTR NPY_FLOATLTR
+#define PyArray_DOUBLELTR NPY_DOUBLELTR
+#define PyArray_LONGDOUBLELTR NPY_LONGDOUBLELTR
+#define PyArray_CFLOATLTR NPY_CFLOATLTR
+#define PyArray_CDOUBLELTR NPY_CDOUBLELTR
+#define PyArray_CLONGDOUBLELTR NPY_CLONGDOUBLELTR
+#define PyArray_OBJECTLTR NPY_OBJECTLTR
+#define PyArray_STRINGLTR NPY_STRINGLTR
+#define PyArray_STRINGLTR2 NPY_STRINGLTR2
+#define PyArray_UNICODELTR NPY_UNICODELTR
+#define PyArray_VOIDLTR NPY_VOIDLTR
+#define PyArray_CHARLTR NPY_CHARLTR
+#define PyArray_INTPLTR NPY_INTPLTR
+#define PyArray_UINTPLTR NPY_UINTPLTR
+#define PyArray_GENBOOLLTR NPY_GENBOOLLTR
+#define PyArray_SIGNEDLTR NPY_SIGNEDLTR
+#define PyArray_UNSIGNEDLTR NPY_UNSIGNEDLTR
+#define PyArray_FLOATINGLTR NPY_FLOATINGLTR
+#define PyArray_COMPLEXLTR NPY_COMPLEXLTR
+
+#define PyArray_QUICKSORT NPY_QUICKSORT
+#define PyArray_HEAPSORT NPY_HEAPSORT
+#define PyArray_MERGESORT NPY_MERGESORT
+#define PyArray_SORTKIND NPY_SORTKIND
+#define PyArray_NSORTS NPY_NSORTS
+
+#define PyArray_NOSCALAR NPY_NOSCALAR
+#define PyArray_BOOL_SCALAR NPY_BOOL_SCALAR
+#define PyArray_INTPOS_SCALAR NPY_INTPOS_SCALAR
+#define PyArray_INTNEG_SCALAR NPY_INTNEG_SCALAR
+#define PyArray_FLOAT_SCALAR NPY_FLOAT_SCALAR
+#define PyArray_COMPLEX_SCALAR NPY_COMPLEX_SCALAR
+#define PyArray_OBJECT_SCALAR NPY_OBJECT_SCALAR
+#define PyArray_SCALARKIND NPY_SCALARKIND
+#define PyArray_NSCALARKINDS NPY_NSCALARKINDS
+
+#define PyArray_ANYORDER NPY_ANYORDER
+#define PyArray_CORDER NPY_CORDER
+#define PyArray_FORTRANORDER NPY_FORTRANORDER
+#define PyArray_ORDER NPY_ORDER
+
+#define PyDescr_ISBOOL PyDataType_ISBOOL
+#define PyDescr_ISUNSIGNED PyDataType_ISUNSIGNED
+#define PyDescr_ISSIGNED PyDataType_ISSIGNED
+#define PyDescr_ISINTEGER PyDataType_ISINTEGER
+#define PyDescr_ISFLOAT PyDataType_ISFLOAT
+#define PyDescr_ISNUMBER PyDataType_ISNUMBER
+#define PyDescr_ISSTRING PyDataType_ISSTRING
+#define PyDescr_ISCOMPLEX PyDataType_ISCOMPLEX
+#define PyDescr_ISPYTHON PyDataType_ISPYTHON
+#define PyDescr_ISFLEXIBLE PyDataType_ISFLEXIBLE
+#define PyDescr_ISUSERDEF PyDataType_ISUSERDEF
+#define PyDescr_ISEXTENDED PyDataType_ISEXTENDED
+#define PyDescr_ISOBJECT PyDataType_ISOBJECT
+#define PyDescr_HASFIELDS PyDataType_HASFIELDS
+
+#define PyArray_LITTLE NPY_LITTLE
+#define PyArray_BIG NPY_BIG
+#define PyArray_NATIVE NPY_NATIVE
+#define PyArray_SWAP NPY_SWAP
+#define PyArray_IGNORE NPY_IGNORE
+
+#define PyArray_NATBYTE NPY_NATBYTE
+#define PyArray_OPPBYTE NPY_OPPBYTE
+
+#define PyArray_MAX_ELSIZE NPY_MAX_ELSIZE
+
+#define PyArray_USE_PYMEM NPY_USE_PYMEM
+
+#define PyArray_RemoveLargest PyArray_RemoveSmallest
diff --git a/numpy/core/include/numpy/oldnumeric.h b/numpy/core/include/numpy/oldnumeric.h
new file mode 100644
index 000000000..51dba29cd
--- /dev/null
+++ b/numpy/core/include/numpy/oldnumeric.h
@@ -0,0 +1,23 @@
+#include "arrayobject.h"
+
+#ifndef REFCOUNT
+# define REFCOUNT NPY_REFCOUNT
+# define MAX_ELSIZE 16
+#endif
+
+#define PyArray_UNSIGNED_TYPES
+#define PyArray_SBYTE PyArray_BYTE
+#define PyArray_CopyArray PyArray_CopyInto
+#define _PyArray_multiply_list PyArray_MultiplyIntList
+#define PyArray_ISSPACESAVER(m) NPY_FALSE
+#define PyScalarArray_Check PyArray_CheckScalar
+
+#define CONTIGUOUS NPY_CONTIGUOUS
+#define OWN_DIMENSIONS 0
+#define OWN_STRIDES 0
+#define OWN_DATA NPY_OWNDATA
+#define SAVESPACE 0
+#define SAVESPACEBIT 0
+
+#undef import_array
+#define import_array() { if (_import_array() < 0) {PyErr_Print(); PyErr_SetString(PyExc_ImportError, "numpy.core.multiarray failed to import"); } }
diff --git a/numpy/core/include/numpy/ufuncobject.h b/numpy/core/include/numpy/ufuncobject.h
new file mode 100644
index 000000000..9906096e6
--- /dev/null
+++ b/numpy/core/include/numpy/ufuncobject.h
@@ -0,0 +1,365 @@
+#ifndef Py_UFUNCOBJECT_H
+#define Py_UFUNCOBJECT_H
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+typedef void (*PyUFuncGenericFunction) (char **, npy_intp *, npy_intp *, void *);
+
+typedef struct {
+ PyObject_HEAD
+ int nin, nout, nargs;
+ int identity;
+ PyUFuncGenericFunction *functions;
+ void **data;
+ int ntypes;
+ int check_return;
+ char *name, *types;
+ char *doc;
+ void *ptr;
+ PyObject *obj;
+ PyObject *userloops;
+} PyUFuncObject;
+
+#include "arrayobject.h"
+
+#define UFUNC_ERR_IGNORE 0
+#define UFUNC_ERR_WARN 1
+#define UFUNC_ERR_RAISE 2
+#define UFUNC_ERR_CALL 3
+#define UFUNC_ERR_PRINT 4
+#define UFUNC_ERR_LOG 5
+
+ /* Python side integer mask */
+
+#define UFUNC_MASK_DIVIDEBYZERO 0x07
+#define UFUNC_MASK_OVERFLOW 0x3f
+#define UFUNC_MASK_UNDERFLOW 0x1ff
+#define UFUNC_MASK_INVALID 0xfff
+
+#define UFUNC_SHIFT_DIVIDEBYZERO 0
+#define UFUNC_SHIFT_OVERFLOW 3
+#define UFUNC_SHIFT_UNDERFLOW 6
+#define UFUNC_SHIFT_INVALID 9
+
+
+/* platform-dependent code translates floating point
+ status to an integer sum of these values
+*/
+#define UFUNC_FPE_DIVIDEBYZERO 1
+#define UFUNC_FPE_OVERFLOW 2
+#define UFUNC_FPE_UNDERFLOW 4
+#define UFUNC_FPE_INVALID 8
+
+#define UFUNC_ERR_DEFAULT 0 /* Error mode that avoids look-up (no checking) */
+
+ /* Default user error mode */
+#define UFUNC_ERR_DEFAULT2 \
+ (UFUNC_ERR_PRINT << UFUNC_SHIFT_DIVIDEBYZERO) + \
+ (UFUNC_ERR_PRINT << UFUNC_SHIFT_OVERFLOW) + \
+ (UFUNC_ERR_PRINT << UFUNC_SHIFT_INVALID)
+
+ /* Only internal -- not exported, yet*/
+typedef struct {
+ /* Multi-iterator portion --- needs to be present in this order
+ to work with PyArray_Broadcast */
+ PyObject_HEAD
+ int numiter;
+ npy_intp size;
+ npy_intp index;
+ int nd;
+ npy_intp dimensions[NPY_MAXDIMS];
+ PyArrayIterObject *iters[NPY_MAXARGS];
+ /* End of Multi-iterator portion */
+
+ /* The ufunc */
+ PyUFuncObject *ufunc;
+
+ /* The error handling */
+ int errormask; /* Integer showing desired error handling */
+ PyObject *errobj; /* currently a tuple with
+ (string, func or obj with write method or None)
+ */
+ int first;
+
+ /* Specific function and data to use */
+ PyUFuncGenericFunction function;
+ void *funcdata;
+
+ /* Loop method */
+ int meth;
+
+ /* Whether we need to copy to a buffer or not.*/
+ int needbuffer[NPY_MAXARGS];
+ int leftover;
+ int ninnerloops;
+ int lastdim;
+
+ /* Whether or not to swap */
+ int swap[NPY_MAXARGS];
+
+ /* Buffers for the loop */
+ char *buffer[NPY_MAXARGS];
+ int bufsize;
+ npy_intp bufcnt;
+ char *dptr[NPY_MAXARGS];
+
+ /* For casting */
+ char *castbuf[NPY_MAXARGS];
+ PyArray_VectorUnaryFunc *cast[NPY_MAXARGS];
+
+ /* usually points to buffer but when a cast is to be
+ done it switches for that argument to castbuf.
+ */
+ char *bufptr[NPY_MAXARGS];
+
+ /* Steps filled in from iters or sizeof(item)
+ depending on loop method.
+ */
+ npy_intp steps[NPY_MAXARGS];
+
+ int obj; /* This loop uses object arrays */
+ int notimplemented; /* The loop caused notimplemented */
+ int objfunc; /* This loop calls object functions
+ (an inner-loop function with argument types */
+} PyUFuncLoopObject;
+
+/* Could make this more clever someday */
+#define UFUNC_MAXIDENTITY 32
+
+typedef struct {
+ PyObject_HEAD
+ PyArrayIterObject *it;
+ PyArrayObject *ret;
+ PyArrayIterObject *rit; /* Needed for Accumulate */
+ int outsize;
+ npy_intp index;
+ npy_intp size;
+ char idptr[UFUNC_MAXIDENTITY];
+
+ /* The ufunc */
+ PyUFuncObject *ufunc;
+
+ /* The error handling */
+ int errormask;
+ PyObject *errobj;
+ int first;
+
+ PyUFuncGenericFunction function;
+ void *funcdata;
+ int meth;
+ int swap;
+
+ char *buffer;
+ int bufsize;
+
+ char *castbuf;
+ PyArray_VectorUnaryFunc *cast;
+
+ char *bufptr[3];
+ npy_intp steps[3];
+
+ npy_intp N;
+ int instrides;
+ int insize;
+ char *inptr;
+
+ /* For copying small arrays */
+ PyObject *decref;
+
+ int obj;
+ int retbase;
+
+} PyUFuncReduceObject;
+
+
+#if NPY_ALLOW_THREADS
+#define NPY_LOOP_BEGIN_THREADS if (!(loop->obj)) {_save = PyEval_SaveThread();}
+#define NPY_LOOP_END_THREADS if (!(loop->obj)) {PyEval_RestoreThread(_save);}
+#else
+#define NPY_LOOP_BEGIN_THREADS
+#define NPY_LOOP_END_THREADS
+#endif
+
+#define PyUFunc_One 1
+#define PyUFunc_Zero 0
+#define PyUFunc_None -1
+
+#define UFUNC_REDUCE 0
+#define UFUNC_ACCUMULATE 1
+#define UFUNC_REDUCEAT 2
+#define UFUNC_OUTER 3
+
+
+typedef struct {
+ int nin;
+ int nout;
+ PyObject *callable;
+} PyUFunc_PyFuncData;
+
+/* A linked-list of function information for
+ user-defined 1-d loops.
+ */
+typedef struct _loop1d_info {
+ PyUFuncGenericFunction func;
+ void *data;
+ int *arg_types;
+ struct _loop1d_info *next;
+} PyUFunc_Loop1d;
+
+
+#include "__ufunc_api.h"
+
+#define UFUNC_PYVALS_NAME "UFUNC_PYVALS"
+
+#define UFUNC_CHECK_ERROR(arg) \
+ if (((arg)->obj && PyErr_Occurred()) || \
+ ((arg)->errormask && \
+ PyUFunc_checkfperr((arg)->errormask, \
+ (arg)->errobj, \
+ &(arg)->first))) \
+ goto fail
+
+/* This code checks the IEEE status flags in a platform-dependent way */
+/* Adapted from Numarray */
+
+/* OSF/Alpha (Tru64) ---------------------------------------------*/
+#if defined(__osf__) && defined(__alpha)
+
+#include <machine/fpu.h>
+
+#define UFUNC_CHECK_STATUS(ret) { \
+ unsigned long fpstatus; \
+ \
+ fpstatus = ieee_get_fp_control(); \
+ /* clear status bits as well as disable exception mode if on */ \
+ ieee_set_fp_control( 0 ); \
+ ret = ((IEEE_STATUS_DZE & fpstatus) ? UFUNC_FPE_DIVIDEBYZERO : 0) \
+ | ((IEEE_STATUS_OVF & fpstatus) ? UFUNC_FPE_OVERFLOW : 0) \
+ | ((IEEE_STATUS_UNF & fpstatus) ? UFUNC_FPE_UNDERFLOW : 0) \
+ | ((IEEE_STATUS_INV & fpstatus) ? UFUNC_FPE_INVALID : 0); \
+ }
+
+/* MS Windows -----------------------------------------------------*/
+#elif defined(_MSC_VER)
+
+#include <float.h>
+
+#define UFUNC_CHECK_STATUS(ret) { \
+ int fpstatus = (int) _clearfp(); \
+ \
+ ret = ((SW_ZERODIVIDE & fpstatus) ? UFUNC_FPE_DIVIDEBYZERO : 0) \
+ | ((SW_OVERFLOW & fpstatus) ? UFUNC_FPE_OVERFLOW : 0) \
+ | ((SW_UNDERFLOW & fpstatus) ? UFUNC_FPE_UNDERFLOW : 0) \
+ | ((SW_INVALID & fpstatus) ? UFUNC_FPE_INVALID : 0); \
+ }
+
+#define isnan(x) (_isnan((double)(x)))
+#define isinf(x) ((_fpclass((double)(x)) == _FPCLASS_PINF) || \
+ (_fpclass((double)(x)) == _FPCLASS_NINF))
+#define isfinite(x) (_finite((double) x))
+
+/* Solaris --------------------------------------------------------*/
+/* --------ignoring SunOS ieee_flags approach, someone else can
+** deal with that! */
+#elif defined(sun) || defined(__BSD__) || defined(__OpenBSD__) || defined(__FreeBSD__) || defined(__NetBSD__)
+#include <ieeefp.h>
+
+#define UFUNC_CHECK_STATUS(ret) { \
+ int fpstatus; \
+ \
+ fpstatus = (int) fpgetsticky(); \
+ ret = ((FP_X_DZ & fpstatus) ? UFUNC_FPE_DIVIDEBYZERO : 0) \
+ | ((FP_X_OFL & fpstatus) ? UFUNC_FPE_OVERFLOW : 0) \
+ | ((FP_X_UFL & fpstatus) ? UFUNC_FPE_UNDERFLOW : 0) \
+ | ((FP_X_INV & fpstatus) ? UFUNC_FPE_INVALID : 0); \
+ (void) fpsetsticky(0); \
+ }
+
+#elif defined(__GLIBC__) || defined(__APPLE__) || defined(__CYGWIN__) || defined(__MINGW32__)
+
+#if defined(__GLIBC__) || defined(__APPLE__) || defined(__MINGW32__)
+#include <fenv.h>
+#elif defined(__CYGWIN__)
+#include "fenv/fenv.c"
+#endif
+
+#define UFUNC_CHECK_STATUS(ret) { \
+ int fpstatus = (int) fetestexcept(FE_DIVBYZERO | FE_OVERFLOW | \
+ FE_UNDERFLOW | FE_INVALID); \
+ ret = ((FE_DIVBYZERO & fpstatus) ? UFUNC_FPE_DIVIDEBYZERO : 0) \
+ | ((FE_OVERFLOW & fpstatus) ? UFUNC_FPE_OVERFLOW : 0) \
+ | ((FE_UNDERFLOW & fpstatus) ? UFUNC_FPE_UNDERFLOW : 0) \
+ | ((FE_INVALID & fpstatus) ? UFUNC_FPE_INVALID : 0); \
+ (void) feclearexcept(FE_DIVBYZERO | FE_OVERFLOW | \
+ FE_UNDERFLOW | FE_INVALID); \
+}
+
+#define generate_divbyzero_error() feraiseexcept(FE_DIVBYZERO)
+#define generate_overflow_error() feraiseexcept(FE_OVERFLOW)
+
+#elif defined(_AIX)
+
+#include <float.h>
+#include <fpxcp.h>
+
+#define UFUNC_CHECK_STATUS(ret) { \
+ fpflag_t fpstatus; \
+ \
+ fpstatus = fp_read_flag(); \
+ ret = ((FP_DIV_BY_ZERO & fpstatus) ? UFUNC_FPE_DIVIDEBYZERO : 0) \
+ | ((FP_OVERFLOW & fpstatus) ? UFUNC_FPE_OVERFLOW : 0) \
+ | ((FP_UNDERFLOW & fpstatus) ? UFUNC_FPE_UNDERFLOW : 0) \
+ | ((FP_INVALID & fpstatus) ? UFUNC_FPE_INVALID : 0); \
+ fp_swap_flag(0); \
+}
+
+#define generate_divbyzero_error() fp_raise_xcp(FP_DIV_BY_ZERO)
+#define generate_overflow_error() fp_raise_xcp(FP_OVERFLOW)
+
+#else
+
+#define NO_FLOATING_POINT_SUPPORT
+#define UFUNC_CHECK_STATUS(ret) { \
+ ret = 0; \
+ }
+
+#endif
+
+/* These should really be altered to just set the corresponding bit
+ in the floating point status flag. Need to figure out how to do that
+ on all the platforms...
+*/
+
+#if !defined(generate_divbyzero_error)
+static int numeric_zero2 = 0;
+static void generate_divbyzero_error(void) {
+ double dummy;
+ dummy = 1./numeric_zero2;
+ if (dummy) /* to prevent optimizer from eliminating expression */
+ return;
+ else /* should never be called */
+ numeric_zero2 += 1;
+ return;
+}
+#endif
+
+#if !defined(generate_overflow_error)
+static double numeric_two = 2.0;
+static void generate_overflow_error(void) {
+ double dummy;
+ dummy = pow(numeric_two,1000);
+ if (dummy)
+ return;
+ else
+ numeric_two += 0.1;
+ return;
+ return;
+}
+#endif
+
+
+#ifdef __cplusplus
+}
+#endif
+#endif /* !Py_UFUNCOBJECT_H */
diff --git a/numpy/core/info.py b/numpy/core/info.py
new file mode 100644
index 000000000..561e171b0
--- /dev/null
+++ b/numpy/core/info.py
@@ -0,0 +1,86 @@
+__doc__ = """Defines a multi-dimensional array and useful procedures for Numerical computation.
+
+Functions
+
+- array - NumPy Array construction
+- zeros - Return an array of all zeros
+- empty - Return an unitialized array
+- shape - Return shape of sequence or array
+- rank - Return number of dimensions
+- size - Return number of elements in entire array or a
+ certain dimension
+- fromstring - Construct array from (byte) string
+- take - Select sub-arrays using sequence of indices
+- put - Set sub-arrays using sequence of 1-D indices
+- putmask - Set portion of arrays using a mask
+- reshape - Return array with new shape
+- repeat - Repeat elements of array
+- choose - Construct new array from indexed array tuple
+- correlate - Correlate two 1-d arrays
+- searchsorted - Search for element in 1-d array
+- sum - Total sum over a specified dimension
+- average - Average, possibly weighted, over axis or array.
+- cumsum - Cumulative sum over a specified dimension
+- product - Total product over a specified dimension
+- cumproduct - Cumulative product over a specified dimension
+- alltrue - Logical and over an entire axis
+- sometrue - Logical or over an entire axis
+- allclose - Tests if sequences are essentially equal
+
+More Functions:
+
+- arange - Return regularly spaced array
+- asarray - Guarantee NumPy array
+- convolve - Convolve two 1-d arrays
+- swapaxes - Exchange axes
+- concatenate - Join arrays together
+- transpose - Permute axes
+- sort - Sort elements of array
+- argsort - Indices of sorted array
+- argmax - Index of largest value
+- argmin - Index of smallest value
+- inner - Innerproduct of two arrays
+- dot - Dot product (matrix multiplication)
+- outer - Outerproduct of two arrays
+- resize - Return array with arbitrary new shape
+- indices - Tuple of indices
+- fromfunction - Construct array from universal function
+- diagonal - Return diagonal array
+- trace - Trace of array
+- dump - Dump array to file object (pickle)
+- dumps - Return pickled string representing data
+- load - Return array stored in file object
+- loads - Return array from pickled string
+- ravel - Return array as 1-D
+- nonzero - Indices of nonzero elements for 1-D array
+- shape - Shape of array
+- where - Construct array from binary result
+- compress - Elements of array where condition is true
+- clip - Clip array between two values
+- ones - Array of all ones
+- identity - 2-D identity array (matrix)
+
+(Universal) Math Functions
+
+ add logical_or exp
+ subtract logical_xor log
+ multiply logical_not log10
+ divide maximum sin
+ divide_safe minimum sinh
+ conjugate bitwise_and sqrt
+ power bitwise_or tan
+ absolute bitwise_xor tanh
+ negative invert ceil
+ greater left_shift fabs
+ greater_equal right_shift floor
+ less arccos arctan2
+ less_equal arcsin fmod
+ equal arctan hypot
+ not_equal cos around
+ logical_and cosh sign
+ arccosh arcsinh arctanh
+
+"""
+
+depends = ['testing']
+global_symbols = ['*']
diff --git a/numpy/core/ma.py b/numpy/core/ma.py
new file mode 100644
index 000000000..3feb4a7d7
--- /dev/null
+++ b/numpy/core/ma.py
@@ -0,0 +1,2254 @@
+"""MA: a facility for dealing with missing observations
+MA is generally used as a numpy.array look-alike.
+by Paul F. Dubois.
+
+Copyright 1999, 2000, 2001 Regents of the University of California.
+Released for unlimited redistribution.
+Adapted for numpy_core 2005 by Travis Oliphant and
+(mainly) Paul Dubois.
+"""
+import types, sys
+
+import umath
+import fromnumeric
+from numeric import newaxis, ndarray, inf
+from fromnumeric import amax, amin
+from numerictypes import bool_, typecodes
+import numeric
+import warnings
+
+# Ufunc domain lookup for __array_wrap__
+ufunc_domain = {}
+# Ufunc fills lookup for __array__
+ufunc_fills = {}
+
+MaskType = bool_
+nomask = MaskType(0)
+divide_tolerance = 1.e-35
+
+class MAError (Exception):
+ def __init__ (self, args=None):
+ "Create an exception"
+
+ # The .args attribute must be a tuple.
+ if not isinstance(args, tuple):
+ args = (args,)
+ self.args = args
+ def __str__(self):
+ "Calculate the string representation"
+ return str(self.args[0])
+ __repr__ = __str__
+
+class _MaskedPrintOption:
+ "One instance of this class, masked_print_option, is created."
+ def __init__ (self, display):
+ "Create the masked print option object."
+ self.set_display(display)
+ self._enabled = 1
+
+ def display (self):
+ "Show what prints for masked values."
+ return self._display
+
+ def set_display (self, s):
+ "set_display(s) sets what prints for masked values."
+ self._display = s
+
+ def enabled (self):
+ "Is the use of the display value enabled?"
+ return self._enabled
+
+ def enable(self, flag=1):
+ "Set the enabling flag to flag."
+ self._enabled = flag
+
+ def __str__ (self):
+ return str(self._display)
+
+ __repr__ = __str__
+
+#if you single index into a masked location you get this object.
+masked_print_option = _MaskedPrintOption('--')
+
+# Use single element arrays or scalars.
+default_real_fill_value = 1.e20
+default_complex_fill_value = 1.e20 + 0.0j
+default_character_fill_value = '-'
+default_integer_fill_value = 999999
+default_object_fill_value = '?'
+
+def default_fill_value (obj):
+ "Function to calculate default fill value for an object."
+ if isinstance(obj, types.FloatType):
+ return default_real_fill_value
+ elif isinstance(obj, types.IntType) or isinstance(obj, types.LongType):
+ return default_integer_fill_value
+ elif isinstance(obj, types.StringType):
+ return default_character_fill_value
+ elif isinstance(obj, types.ComplexType):
+ return default_complex_fill_value
+ elif isinstance(obj, MaskedArray) or isinstance(obj, ndarray):
+ x = obj.dtype.char
+ if x in typecodes['Float']:
+ return default_real_fill_value
+ if x in typecodes['Integer']:
+ return default_integer_fill_value
+ if x in typecodes['Complex']:
+ return default_complex_fill_value
+ if x in typecodes['Character']:
+ return default_character_fill_value
+ if x in typecodes['UnsignedInteger']:
+ return umath.absolute(default_integer_fill_value)
+ return default_object_fill_value
+ else:
+ return default_object_fill_value
+
+def minimum_fill_value (obj):
+ "Function to calculate default fill value suitable for taking minima."
+ if isinstance(obj, types.FloatType):
+ return numeric.inf
+ elif isinstance(obj, types.IntType) or isinstance(obj, types.LongType):
+ return sys.maxint
+ elif isinstance(obj, MaskedArray) or isinstance(obj, ndarray):
+ x = obj.dtype.char
+ if x in typecodes['Float']:
+ return numeric.inf
+ if x in typecodes['Integer']:
+ return sys.maxint
+ if x in typecodes['UnsignedInteger']:
+ return sys.maxint
+ else:
+ raise TypeError, 'Unsuitable type for calculating minimum.'
+
+def maximum_fill_value (obj):
+ "Function to calculate default fill value suitable for taking maxima."
+ if isinstance(obj, types.FloatType):
+ return -inf
+ elif isinstance(obj, types.IntType) or isinstance(obj, types.LongType):
+ return -sys.maxint
+ elif isinstance(obj, MaskedArray) or isinstance(obj, ndarray):
+ x = obj.dtype.char
+ if x in typecodes['Float']:
+ return -inf
+ if x in typecodes['Integer']:
+ return -sys.maxint
+ if x in typecodes['UnsignedInteger']:
+ return 0
+ else:
+ raise TypeError, 'Unsuitable type for calculating maximum.'
+
+def set_fill_value (a, fill_value):
+ "Set fill value of a if it is a masked array."
+ if isMaskedArray(a):
+ a.set_fill_value (fill_value)
+
+def getmask (a):
+ """Mask of values in a; could be nomask.
+ Returns nomask if a is not a masked array.
+ To get an array for sure use getmaskarray."""
+ if isinstance(a, MaskedArray):
+ return a.raw_mask()
+ else:
+ return nomask
+
+def getmaskarray (a):
+ """Mask of values in a; an array of zeros if mask is nomask
+ or not a masked array, and is a byte-sized integer.
+ Do not try to add up entries, for example.
+ """
+ m = getmask(a)
+ if m is nomask:
+ return make_mask_none(shape(a))
+ else:
+ return m
+
+def is_mask (m):
+ """Is m a legal mask? Does not check contents, only type.
+ """
+ try:
+ return m.dtype.type is MaskType
+ except AttributeError:
+ return False
+
+def make_mask (m, copy=0, flag=0):
+ """make_mask(m, copy=0, flag=0)
+ return m as a mask, creating a copy if necessary or requested.
+ Can accept any sequence of integers or nomask. Does not check
+ that contents must be 0s and 1s.
+ if flag, return nomask if m contains no true elements.
+ """
+ if m is nomask:
+ return nomask
+ elif isinstance(m, ndarray):
+ if m.dtype.type is MaskType:
+ if copy:
+ result = numeric.array(m, dtype=MaskType, copy=copy)
+ else:
+ result = m
+ else:
+ result = m.astype(MaskType)
+ else:
+ result = filled(m, True).astype(MaskType)
+
+ if flag and not fromnumeric.sometrue(fromnumeric.ravel(result)):
+ return nomask
+ else:
+ return result
+
+def make_mask_none (s):
+ "Return a mask of all zeros of shape s."
+ result = numeric.zeros(s, dtype=MaskType)
+ result.shape = s
+ return result
+
+def mask_or (m1, m2):
+ """Logical or of the mask candidates m1 and m2, treating nomask as false.
+ Result may equal m1 or m2 if the other is nomask.
+ """
+ if m1 is nomask: return make_mask(m2)
+ if m2 is nomask: return make_mask(m1)
+ if m1 is m2 and is_mask(m1): return m1
+ return make_mask(umath.logical_or(m1, m2))
+
+def filled (a, value = None):
+ """a as a contiguous numeric array with any masked areas replaced by value
+ if value is None or the special element "masked", get_fill_value(a)
+ is used instead.
+
+ If a is already a contiguous numeric array, a itself is returned.
+
+ filled(a) can be used to be sure that the result is numeric when
+ passing an object a to other software ignorant of MA, in particular to
+ numeric itself.
+ """
+ if isinstance(a, MaskedArray):
+ return a.filled(value)
+ elif isinstance(a, ndarray) and a.flags['CONTIGUOUS']:
+ return a
+ elif isinstance(a, types.DictType):
+ return numeric.array(a, 'O')
+ else:
+ return numeric.array(a)
+
+def get_fill_value (a):
+ """
+ The fill value of a, if it has one; otherwise, the default fill value
+ for that type.
+ """
+ if isMaskedArray(a):
+ result = a.fill_value()
+ else:
+ result = default_fill_value(a)
+ return result
+
+def common_fill_value (a, b):
+ "The common fill_value of a and b, if there is one, or None"
+ t1 = get_fill_value(a)
+ t2 = get_fill_value(b)
+ if t1 == t2: return t1
+ return None
+
+# Domain functions return 1 where the argument(s) are not in the domain.
+class domain_check_interval:
+ "domain_check_interval(a,b)(x) = true where x < a or y > b"
+ def __init__(self, y1, y2):
+ "domain_check_interval(a,b)(x) = true where x < a or y > b"
+ self.y1 = y1
+ self.y2 = y2
+
+ def __call__ (self, x):
+ "Execute the call behavior."
+ return umath.logical_or(umath.greater (x, self.y2),
+ umath.less(x, self.y1)
+ )
+
+class domain_tan:
+ "domain_tan(eps) = true where abs(cos(x)) < eps)"
+ def __init__(self, eps):
+ "domain_tan(eps) = true where abs(cos(x)) < eps)"
+ self.eps = eps
+
+ def __call__ (self, x):
+ "Execute the call behavior."
+ return umath.less(umath.absolute(umath.cos(x)), self.eps)
+
+class domain_greater:
+ "domain_greater(v)(x) = true where x <= v"
+ def __init__(self, critical_value):
+ "domain_greater(v)(x) = true where x <= v"
+ self.critical_value = critical_value
+
+ def __call__ (self, x):
+ "Execute the call behavior."
+ return umath.less_equal (x, self.critical_value)
+
+class domain_greater_equal:
+ "domain_greater_equal(v)(x) = true where x < v"
+ def __init__(self, critical_value):
+ "domain_greater_equal(v)(x) = true where x < v"
+ self.critical_value = critical_value
+
+ def __call__ (self, x):
+ "Execute the call behavior."
+ return umath.less (x, self.critical_value)
+
+class masked_unary_operation:
+ def __init__ (self, aufunc, fill=0, domain=None):
+ """ masked_unary_operation(aufunc, fill=0, domain=None)
+ aufunc(fill) must be defined
+ self(x) returns aufunc(x)
+ with masked values where domain(x) is true or getmask(x) is true.
+ """
+ self.f = aufunc
+ self.fill = fill
+ self.domain = domain
+ self.__doc__ = getattr(aufunc, "__doc__", str(aufunc))
+ self.__name__ = getattr(aufunc, "__name__", str(aufunc))
+ ufunc_domain[aufunc] = domain
+ ufunc_fills[aufunc] = fill,
+
+ def __call__ (self, a, *args, **kwargs):
+ "Execute the call behavior."
+# numeric tries to return scalars rather than arrays when given scalars.
+ m = getmask(a)
+ d1 = filled(a, self.fill)
+ if self.domain is not None:
+ m = mask_or(m, self.domain(d1))
+ result = self.f(d1, *args, **kwargs)
+ return masked_array(result, m)
+
+ def __str__ (self):
+ return "Masked version of " + str(self.f)
+
+
+class domain_safe_divide:
+ def __init__ (self, tolerance=divide_tolerance):
+ self.tolerance = tolerance
+ def __call__ (self, a, b):
+ return umath.absolute(a) * self.tolerance >= umath.absolute(b)
+
+class domained_binary_operation:
+ """Binary operations that have a domain, like divide. These are complicated
+ so they are a separate class. They have no reduce, outer or accumulate.
+ """
+ def __init__ (self, abfunc, domain, fillx=0, filly=0):
+ """abfunc(fillx, filly) must be defined.
+ abfunc(x, filly) = x for all x to enable reduce.
+ """
+ self.f = abfunc
+ self.domain = domain
+ self.fillx = fillx
+ self.filly = filly
+ self.__doc__ = getattr(abfunc, "__doc__", str(abfunc))
+ self.__name__ = getattr(abfunc, "__name__", str(abfunc))
+ ufunc_domain[abfunc] = domain
+ ufunc_fills[abfunc] = fillx, filly
+
+ def __call__(self, a, b):
+ "Execute the call behavior."
+ ma = getmask(a)
+ mb = getmask(b)
+ d1 = filled(a, self.fillx)
+ d2 = filled(b, self.filly)
+ t = self.domain(d1, d2)
+
+ if fromnumeric.sometrue(t, None):
+ d2 = where(t, self.filly, d2)
+ mb = mask_or(mb, t)
+ m = mask_or(ma, mb)
+ result = self.f(d1, d2)
+ return masked_array(result, m)
+
+ def __str__ (self):
+ return "Masked version of " + str(self.f)
+
+class masked_binary_operation:
+ def __init__ (self, abfunc, fillx=0, filly=0):
+ """abfunc(fillx, filly) must be defined.
+ abfunc(x, filly) = x for all x to enable reduce.
+ """
+ self.f = abfunc
+ self.fillx = fillx
+ self.filly = filly
+ self.__doc__ = getattr(abfunc, "__doc__", str(abfunc))
+ ufunc_domain[abfunc] = None
+ ufunc_fills[abfunc] = fillx, filly
+
+ def __call__ (self, a, b, *args, **kwargs):
+ "Execute the call behavior."
+ m = mask_or(getmask(a), getmask(b))
+ d1 = filled(a, self.fillx)
+ d2 = filled(b, self.filly)
+ result = self.f(d1, d2, *args, **kwargs)
+ if isinstance(result, ndarray) \
+ and m.ndim != 0 \
+ and m.shape != result.shape:
+ m = mask_or(getmaskarray(a), getmaskarray(b))
+ return masked_array(result, m)
+
+ def reduce (self, target, axis=0, dtype=None):
+ """Reduce target along the given axis with this function."""
+ m = getmask(target)
+ t = filled(target, self.filly)
+ if t.shape == ():
+ t = t.reshape(1)
+ if m is not nomask:
+ m = make_mask(m, copy=1)
+ m.shape = (1,)
+ if m is nomask:
+ return masked_array (self.f.reduce (t, axis))
+ else:
+ t = masked_array (t, m)
+ # XXX: "or t.dtype" below is a workaround for what appears
+ # XXX: to be a bug in reduce.
+ t = self.f.reduce(filled(t, self.filly), axis, dtype=dtype or t.dtype)
+ m = umath.logical_and.reduce(m, axis)
+ if isinstance(t, ndarray):
+ return masked_array(t, m, get_fill_value(target))
+ elif m:
+ return masked
+ else:
+ return t
+
+ def outer (self, a, b):
+ "Return the function applied to the outer product of a and b."
+ ma = getmask(a)
+ mb = getmask(b)
+ if ma is nomask and mb is nomask:
+ m = nomask
+ else:
+ ma = getmaskarray(a)
+ mb = getmaskarray(b)
+ m = logical_or.outer(ma, mb)
+ d = self.f.outer(filled(a, self.fillx), filled(b, self.filly))
+ return masked_array(d, m)
+
+ def accumulate (self, target, axis=0):
+ """Accumulate target along axis after filling with y fill value."""
+ t = filled(target, self.filly)
+ return masked_array (self.f.accumulate (t, axis))
+ def __str__ (self):
+ return "Masked version of " + str(self.f)
+
+sqrt = masked_unary_operation(umath.sqrt, 0.0, domain_greater_equal(0.0))
+log = masked_unary_operation(umath.log, 1.0, domain_greater(0.0))
+log10 = masked_unary_operation(umath.log10, 1.0, domain_greater(0.0))
+exp = masked_unary_operation(umath.exp)
+conjugate = masked_unary_operation(umath.conjugate)
+sin = masked_unary_operation(umath.sin)
+cos = masked_unary_operation(umath.cos)
+tan = masked_unary_operation(umath.tan, 0.0, domain_tan(1.e-35))
+arcsin = masked_unary_operation(umath.arcsin, 0.0, domain_check_interval(-1.0, 1.0))
+arccos = masked_unary_operation(umath.arccos, 0.0, domain_check_interval(-1.0, 1.0))
+arctan = masked_unary_operation(umath.arctan)
+# Missing from numeric
+arcsinh = masked_unary_operation(umath.arcsinh)
+arccosh = masked_unary_operation(umath.arccosh, 1.0, domain_greater_equal(1.0))
+arctanh = masked_unary_operation(umath.arctanh, 0.0, domain_check_interval(-1.0+1e-15, 1.0-1e-15))
+sinh = masked_unary_operation(umath.sinh)
+cosh = masked_unary_operation(umath.cosh)
+tanh = masked_unary_operation(umath.tanh)
+absolute = masked_unary_operation(umath.absolute)
+fabs = masked_unary_operation(umath.fabs)
+negative = masked_unary_operation(umath.negative)
+
+def nonzero(a):
+ """returns the indices of the elements of a which are not zero
+ and not masked
+ """
+ return numeric.asarray(filled(a, 0).nonzero())
+
+around = masked_unary_operation(fromnumeric.round_)
+floor = masked_unary_operation(umath.floor)
+ceil = masked_unary_operation(umath.ceil)
+logical_not = masked_unary_operation(umath.logical_not)
+
+add = masked_binary_operation(umath.add)
+subtract = masked_binary_operation(umath.subtract)
+subtract.reduce = None
+multiply = masked_binary_operation(umath.multiply, 1, 1)
+divide = domained_binary_operation(umath.divide, domain_safe_divide(), 0, 1)
+true_divide = domained_binary_operation(umath.true_divide, domain_safe_divide(), 0, 1)
+floor_divide = domained_binary_operation(umath.floor_divide, domain_safe_divide(), 0, 1)
+remainder = domained_binary_operation(umath.remainder, domain_safe_divide(), 0, 1)
+fmod = domained_binary_operation(umath.fmod, domain_safe_divide(), 0, 1)
+hypot = masked_binary_operation(umath.hypot)
+arctan2 = masked_binary_operation(umath.arctan2, 0.0, 1.0)
+arctan2.reduce = None
+equal = masked_binary_operation(umath.equal)
+equal.reduce = None
+not_equal = masked_binary_operation(umath.not_equal)
+not_equal.reduce = None
+less_equal = masked_binary_operation(umath.less_equal)
+less_equal.reduce = None
+greater_equal = masked_binary_operation(umath.greater_equal)
+greater_equal.reduce = None
+less = masked_binary_operation(umath.less)
+less.reduce = None
+greater = masked_binary_operation(umath.greater)
+greater.reduce = None
+logical_and = masked_binary_operation(umath.logical_and)
+alltrue = masked_binary_operation(umath.logical_and, 1, 1).reduce
+logical_or = masked_binary_operation(umath.logical_or)
+sometrue = logical_or.reduce
+logical_xor = masked_binary_operation(umath.logical_xor)
+bitwise_and = masked_binary_operation(umath.bitwise_and)
+bitwise_or = masked_binary_operation(umath.bitwise_or)
+bitwise_xor = masked_binary_operation(umath.bitwise_xor)
+
+def rank (object):
+ return fromnumeric.rank(filled(object))
+
+def shape (object):
+ return fromnumeric.shape(filled(object))
+
+def size (object, axis=None):
+ return fromnumeric.size(filled(object), axis)
+
+class MaskedArray (object):
+ """Arrays with possibly masked values.
+ Masked values of 1 exclude the corresponding element from
+ any computation.
+
+ Construction:
+ x = array(data, dtype=None, copy=True, order=False,
+ mask = nomask, fill_value=None)
+
+ If copy=False, every effort is made not to copy the data:
+ If data is a MaskedArray, and argument mask=nomask,
+ then the candidate data is data.data and the
+ mask used is data.mask. If data is a numeric array,
+ it is used as the candidate raw data.
+ If dtype is not None and
+ is != data.dtype.char then a data copy is required.
+ Otherwise, the candidate is used.
+
+ If a data copy is required, raw data stored is the result of:
+ numeric.array(data, dtype=dtype.char, copy=copy)
+
+ If mask is nomask there are no masked values. Otherwise mask must
+ be convertible to an array of booleans with the same shape as x.
+
+ fill_value is used to fill in masked values when necessary,
+ such as when printing and in method/function filled().
+ The fill_value is not used for computation within this module.
+ """
+ __array_priority__ = 10.1
+ def __init__(self, data, dtype=None, copy=True, order=False,
+ mask=nomask, fill_value=None):
+ """array(data, dtype=None, copy=True, order=False, mask=nomask, fill_value=None)
+ If data already a numeric array, its dtype becomes the default value of dtype.
+ """
+ if dtype is None:
+ tc = None
+ else:
+ tc = numeric.dtype(dtype)
+ need_data_copied = copy
+ if isinstance(data, MaskedArray):
+ c = data.data
+ if tc is None:
+ tc = c.dtype
+ elif tc != c.dtype:
+ need_data_copied = True
+ if mask is nomask:
+ mask = data.mask
+ elif mask is not nomask: #attempting to change the mask
+ need_data_copied = True
+
+ elif isinstance(data, ndarray):
+ c = data
+ if tc is None:
+ tc = c.dtype
+ elif tc != c.dtype:
+ need_data_copied = True
+ else:
+ need_data_copied = False #because I'll do it now
+ c = numeric.array(data, dtype=tc, copy=True, order=order)
+ tc = c.dtype
+
+ if need_data_copied:
+ if tc == c.dtype:
+ self._data = numeric.array(c, dtype=tc, copy=True, order=order)
+ else:
+ self._data = c.astype(tc)
+ else:
+ self._data = c
+
+ if mask is nomask:
+ self._mask = nomask
+ self._shared_mask = 0
+ else:
+ self._mask = make_mask (mask)
+ if self._mask is nomask:
+ self._shared_mask = 0
+ else:
+ self._shared_mask = (self._mask is mask)
+ nm = size(self._mask)
+ nd = size(self._data)
+ if nm != nd:
+ if nm == 1:
+ self._mask = fromnumeric.resize(self._mask, self._data.shape)
+ self._shared_mask = 0
+ elif nd == 1:
+ self._data = fromnumeric.resize(self._data, self._mask.shape)
+ self._data.shape = self._mask.shape
+ else:
+ raise MAError, "Mask and data not compatible."
+ elif nm == 1 and shape(self._mask) != shape(self._data):
+ self.unshare_mask()
+ self._mask.shape = self._data.shape
+
+ self.set_fill_value(fill_value)
+
+ def __array__ (self, t=None, context=None):
+ "Special hook for numeric. Converts to numeric if possible."
+ if self._mask is not nomask:
+ if fromnumeric.ravel(self._mask).any():
+ if context is None:
+ warnings.warn("Cannot automatically convert masked array to "\
+ "numeric because data\n is masked in one or "\
+ "more locations.");
+ return self._data
+ #raise MAError, \
+ # """Cannot automatically convert masked array to numeric because data
+ # is masked in one or more locations.
+ # """
+ else:
+ func, args, i = context
+ fills = ufunc_fills.get(func)
+ if fills is None:
+ raise MAError, "%s not known to ma" % func
+ return self.filled(fills[i])
+ else: # Mask is all false
+ # Optimize to avoid future invocations of this section.
+ self._mask = nomask
+ self._shared_mask = 0
+ if t:
+ return self._data.astype(t)
+ else:
+ return self._data
+
+ def __array_wrap__ (self, array, context=None):
+ """Special hook for ufuncs.
+
+ Wraps the numpy array and sets the mask according to
+ context.
+ """
+ if context is None:
+ return MaskedArray(array, copy=False, mask=nomask)
+ func, args = context[:2]
+ domain = ufunc_domain[func]
+ m = reduce(mask_or, [getmask(a) for a in args])
+ if domain is not None:
+ m = mask_or(m, domain(*[getattr(a, '_data', a)
+ for a in args]))
+ if m is not nomask:
+ try:
+ shape = array.shape
+ except AttributeError:
+ pass
+ else:
+ if m.shape != shape:
+ m = reduce(mask_or, [getmaskarray(a) for a in args])
+
+ return MaskedArray(array, copy=False, mask=m)
+
+ def _get_shape(self):
+ "Return the current shape."
+ return self._data.shape
+
+ def _set_shape (self, newshape):
+ "Set the array's shape."
+ self._data.shape = newshape
+ if self._mask is not nomask:
+ self._mask = self._mask.copy()
+ self._mask.shape = newshape
+
+ def _get_flat(self):
+ """Calculate the flat value.
+ """
+ if self._mask is nomask:
+ return masked_array(self._data.ravel(), mask=nomask,
+ fill_value = self.fill_value())
+ else:
+ return masked_array(self._data.ravel(),
+ mask=self._mask.ravel(),
+ fill_value = self.fill_value())
+
+ def _set_flat (self, value):
+ "x.flat = value"
+ y = self.ravel()
+ y[:] = value
+
+ def _get_real(self):
+ "Get the real part of a complex array."
+ if self._mask is nomask:
+ return masked_array(self._data.real, mask=nomask,
+ fill_value = self.fill_value())
+ else:
+ return masked_array(self._data.real, mask=self._mask,
+ fill_value = self.fill_value())
+
+ def _set_real (self, value):
+ "x.real = value"
+ y = self.real
+ y[...] = value
+
+ def _get_imaginary(self):
+ "Get the imaginary part of a complex array."
+ if self._mask is nomask:
+ return masked_array(self._data.imag, mask=nomask,
+ fill_value = self.fill_value())
+ else:
+ return masked_array(self._data.imag, mask=self._mask,
+ fill_value = self.fill_value())
+
+ def _set_imaginary (self, value):
+ "x.imaginary = value"
+ y = self.imaginary
+ y[...] = value
+
+ def __str__(self):
+ """Calculate the str representation, using masked for fill if
+ it is enabled. Otherwise fill with fill value.
+ """
+ if masked_print_option.enabled():
+ f = masked_print_option
+ # XXX: Without the following special case masked
+ # XXX: would print as "[--]", not "--". Can we avoid
+ # XXX: checks for masked by choosing a different value
+ # XXX: for the masked singleton? 2005-01-05 -- sasha
+ if self is masked:
+ return str(f)
+ m = self._mask
+ if m is not nomask and m.shape == () and m:
+ return str(f)
+ # convert to object array to make filled work
+ self = self.astype(object)
+ else:
+ f = self.fill_value()
+ res = self.filled(f)
+ return str(res)
+
+ def __repr__(self):
+ """Calculate the repr representation, using masked for fill if
+ it is enabled. Otherwise fill with fill value.
+ """
+ with_mask = """\
+array(data =
+ %(data)s,
+ mask =
+ %(mask)s,
+ fill_value=%(fill)s)
+"""
+ with_mask1 = """\
+array(data = %(data)s,
+ mask = %(mask)s,
+ fill_value=%(fill)s)
+"""
+ without_mask = """array(
+ %(data)s)"""
+ without_mask1 = """array(%(data)s)"""
+
+ n = len(self.shape)
+ if self._mask is nomask:
+ if n <= 1:
+ return without_mask1 % {'data':str(self.filled())}
+ return without_mask % {'data':str(self.filled())}
+ else:
+ if n <= 1:
+ return with_mask % {
+ 'data': str(self.filled()),
+ 'mask': str(self._mask),
+ 'fill': str(self.fill_value())
+ }
+ return with_mask % {
+ 'data': str(self.filled()),
+ 'mask': str(self._mask),
+ 'fill': str(self.fill_value())
+ }
+ without_mask1 = """array(%(data)s)"""
+ if self._mask is nomask:
+ return without_mask % {'data':str(self.filled())}
+ else:
+ return with_mask % {
+ 'data': str(self.filled()),
+ 'mask': str(self._mask),
+ 'fill': str(self.fill_value())
+ }
+
+ def __float__(self):
+ "Convert self to float."
+ self.unmask()
+ if self._mask is not nomask:
+ raise MAError, 'Cannot convert masked element to a Python float.'
+ return float(self.data.item())
+
+ def __int__(self):
+ "Convert self to int."
+ self.unmask()
+ if self._mask is not nomask:
+ raise MAError, 'Cannot convert masked element to a Python int.'
+ return int(self.data.item())
+
+ def __getitem__(self, i):
+ "Get item described by i. Not a copy as in previous versions."
+ self.unshare_mask()
+ m = self._mask
+ dout = self._data[i]
+ if m is nomask:
+ try:
+ if dout.size == 1:
+ return dout
+ else:
+ return masked_array(dout, fill_value=self._fill_value)
+ except AttributeError:
+ return dout
+ mi = m[i]
+ if mi.size == 1:
+ if mi:
+ return masked
+ else:
+ return dout
+ else:
+ return masked_array(dout, mi, fill_value=self._fill_value)
+
+# --------
+# setitem and setslice notes
+# note that if value is masked, it means to mask those locations.
+# setting a value changes the mask to match the value in those locations.
+
+ def __setitem__(self, index, value):
+ "Set item described by index. If value is masked, mask those locations."
+ d = self._data
+ if self is masked:
+ raise MAError, 'Cannot alter masked elements.'
+ if value is masked:
+ if self._mask is nomask:
+ self._mask = make_mask_none(d.shape)
+ self._shared_mask = False
+ else:
+ self.unshare_mask()
+ self._mask[index] = True
+ return
+ m = getmask(value)
+ value = filled(value).astype(d.dtype)
+ d[index] = value
+ if m is nomask:
+ if self._mask is not nomask:
+ self.unshare_mask()
+ self._mask[index] = False
+ else:
+ if self._mask is nomask:
+ self._mask = make_mask_none(d.shape)
+ self._shared_mask = True
+ else:
+ self.unshare_mask()
+ self._mask[index] = m
+
+ def __nonzero__(self):
+ """returns true if any element is non-zero or masked
+
+ """
+ # XXX: This changes bool conversion logic from MA.
+ # XXX: In MA bool(a) == len(a) != 0, but in numpy
+ # XXX: scalars do not have len
+ m = self._mask
+ d = self._data
+ return bool(m is not nomask and m.any()
+ or d is not nomask and d.any())
+
+ def __len__ (self):
+ """Return length of first dimension. This is weird but Python's
+ slicing behavior depends on it."""
+ return len(self._data)
+
+ def __and__(self, other):
+ "Return bitwise_and"
+ return bitwise_and(self, other)
+
+ def __or__(self, other):
+ "Return bitwise_or"
+ return bitwise_or(self, other)
+
+ def __xor__(self, other):
+ "Return bitwise_xor"
+ return bitwise_xor(self, other)
+
+ __rand__ = __and__
+ __ror__ = __or__
+ __rxor__ = __xor__
+
+ def __abs__(self):
+ "Return absolute(self)"
+ return absolute(self)
+
+ def __neg__(self):
+ "Return negative(self)"
+ return negative(self)
+
+ def __pos__(self):
+ "Return array(self)"
+ return array(self)
+
+ def __add__(self, other):
+ "Return add(self, other)"
+ return add(self, other)
+
+ __radd__ = __add__
+
+ def __mod__ (self, other):
+ "Return remainder(self, other)"
+ return remainder(self, other)
+
+ def __rmod__ (self, other):
+ "Return remainder(other, self)"
+ return remainder(other, self)
+
+ def __lshift__ (self, n):
+ return left_shift(self, n)
+
+ def __rshift__ (self, n):
+ return right_shift(self, n)
+
+ def __sub__(self, other):
+ "Return subtract(self, other)"
+ return subtract(self, other)
+
+ def __rsub__(self, other):
+ "Return subtract(other, self)"
+ return subtract(other, self)
+
+ def __mul__(self, other):
+ "Return multiply(self, other)"
+ return multiply(self, other)
+
+ __rmul__ = __mul__
+
+ def __div__(self, other):
+ "Return divide(self, other)"
+ return divide(self, other)
+
+ def __rdiv__(self, other):
+ "Return divide(other, self)"
+ return divide(other, self)
+
+ def __truediv__(self, other):
+ "Return divide(self, other)"
+ return true_divide(self, other)
+
+ def __rtruediv__(self, other):
+ "Return divide(other, self)"
+ return true_divide(other, self)
+
+ def __floordiv__(self, other):
+ "Return divide(self, other)"
+ return floor_divide(self, other)
+
+ def __rfloordiv__(self, other):
+ "Return divide(other, self)"
+ return floor_divide(other, self)
+
+ def __pow__(self, other, third=None):
+ "Return power(self, other, third)"
+ return power(self, other, third)
+
+ def __sqrt__(self):
+ "Return sqrt(self)"
+ return sqrt(self)
+
+ def __iadd__(self, other):
+ "Add other to self in place."
+ t = self._data.dtype.char
+ f = filled(other, 0)
+ t1 = f.dtype.char
+ if t == t1:
+ pass
+ elif t in typecodes['Integer']:
+ if t1 in typecodes['Integer']:
+ f = f.astype(t)
+ else:
+ raise TypeError, 'Incorrect type for in-place operation.'
+ elif t in typecodes['Float']:
+ if t1 in typecodes['Integer']:
+ f = f.astype(t)
+ elif t1 in typecodes['Float']:
+ f = f.astype(t)
+ else:
+ raise TypeError, 'Incorrect type for in-place operation.'
+ elif t in typecodes['Complex']:
+ if t1 in typecodes['Integer']:
+ f = f.astype(t)
+ elif t1 in typecodes['Float']:
+ f = f.astype(t)
+ elif t1 in typecodes['Complex']:
+ f = f.astype(t)
+ else:
+ raise TypeError, 'Incorrect type for in-place operation.'
+ else:
+ raise TypeError, 'Incorrect type for in-place operation.'
+
+ if self._mask is nomask:
+ self._data += f
+ m = getmask(other)
+ self._mask = m
+ self._shared_mask = m is not nomask
+ else:
+ result = add(self, masked_array(f, mask=getmask(other)))
+ self._data = result.data
+ self._mask = result.mask
+ self._shared_mask = 1
+ return self
+
+ def __imul__(self, other):
+ "Add other to self in place."
+ t = self._data.dtype.char
+ f = filled(other, 0)
+ t1 = f.dtype.char
+ if t == t1:
+ pass
+ elif t in typecodes['Integer']:
+ if t1 in typecodes['Integer']:
+ f = f.astype(t)
+ else:
+ raise TypeError, 'Incorrect type for in-place operation.'
+ elif t in typecodes['Float']:
+ if t1 in typecodes['Integer']:
+ f = f.astype(t)
+ elif t1 in typecodes['Float']:
+ f = f.astype(t)
+ else:
+ raise TypeError, 'Incorrect type for in-place operation.'
+ elif t in typecodes['Complex']:
+ if t1 in typecodes['Integer']:
+ f = f.astype(t)
+ elif t1 in typecodes['Float']:
+ f = f.astype(t)
+ elif t1 in typecodes['Complex']:
+ f = f.astype(t)
+ else:
+ raise TypeError, 'Incorrect type for in-place operation.'
+ else:
+ raise TypeError, 'Incorrect type for in-place operation.'
+
+ if self._mask is nomask:
+ self._data *= f
+ m = getmask(other)
+ self._mask = m
+ self._shared_mask = m is not nomask
+ else:
+ result = multiply(self, masked_array(f, mask=getmask(other)))
+ self._data = result.data
+ self._mask = result.mask
+ self._shared_mask = 1
+ return self
+
+ def __isub__(self, other):
+ "Subtract other from self in place."
+ t = self._data.dtype.char
+ f = filled(other, 0)
+ t1 = f.dtype.char
+ if t == t1:
+ pass
+ elif t in typecodes['Integer']:
+ if t1 in typecodes['Integer']:
+ f = f.astype(t)
+ else:
+ raise TypeError, 'Incorrect type for in-place operation.'
+ elif t in typecodes['Float']:
+ if t1 in typecodes['Integer']:
+ f = f.astype(t)
+ elif t1 in typecodes['Float']:
+ f = f.astype(t)
+ else:
+ raise TypeError, 'Incorrect type for in-place operation.'
+ elif t in typecodes['Complex']:
+ if t1 in typecodes['Integer']:
+ f = f.astype(t)
+ elif t1 in typecodes['Float']:
+ f = f.astype(t)
+ elif t1 in typecodes['Complex']:
+ f = f.astype(t)
+ else:
+ raise TypeError, 'Incorrect type for in-place operation.'
+ else:
+ raise TypeError, 'Incorrect type for in-place operation.'
+
+ if self._mask is nomask:
+ self._data -= f
+ m = getmask(other)
+ self._mask = m
+ self._shared_mask = m is not nomask
+ else:
+ result = subtract(self, masked_array(f, mask=getmask(other)))
+ self._data = result.data
+ self._mask = result.mask
+ self._shared_mask = 1
+ return self
+
+
+
+ def __idiv__(self, other):
+ "Divide self by other in place."
+ t = self._data.dtype.char
+ f = filled(other, 0)
+ t1 = f.dtype.char
+ if t == t1:
+ pass
+ elif t in typecodes['Integer']:
+ if t1 in typecodes['Integer']:
+ f = f.astype(t)
+ else:
+ raise TypeError, 'Incorrect type for in-place operation.'
+ elif t in typecodes['Float']:
+ if t1 in typecodes['Integer']:
+ f = f.astype(t)
+ elif t1 in typecodes['Float']:
+ f = f.astype(t)
+ else:
+ raise TypeError, 'Incorrect type for in-place operation.'
+ elif t in typecodes['Complex']:
+ if t1 in typecodes['Integer']:
+ f = f.astype(t)
+ elif t1 in typecodes['Float']:
+ f = f.astype(t)
+ elif t1 in typecodes['Complex']:
+ f = f.astype(t)
+ else:
+ raise TypeError, 'Incorrect type for in-place operation.'
+ else:
+ raise TypeError, 'Incorrect type for in-place operation.'
+ mo = getmask(other)
+ result = divide(self, masked_array(f, mask=mo))
+ self._data = result.data
+ dm = result.raw_mask()
+ if dm is not self._mask:
+ self._mask = dm
+ self._shared_mask = 1
+ return self
+
+ def __eq__(self, other):
+ return equal(self,other)
+
+ def __ne__(self, other):
+ return not_equal(self,other)
+
+ def __lt__(self, other):
+ return less(self,other)
+
+ def __le__(self, other):
+ return less_equal(self,other)
+
+ def __gt__(self, other):
+ return greater(self,other)
+
+ def __ge__(self, other):
+ return greater_equal(self,other)
+
+ def astype (self, tc):
+ "return self as array of given type."
+ d = self._data.astype(tc)
+ return array(d, mask=self._mask)
+
+ def byte_swapped(self):
+ """Returns the raw data field, byte_swapped. Included for consistency
+ with numeric but doesn't make sense in this context.
+ """
+ return self._data.byte_swapped()
+
+ def compressed (self):
+ "A 1-D array of all the non-masked data."
+ d = fromnumeric.ravel(self._data)
+ if self._mask is nomask:
+ return array(d)
+ else:
+ m = 1 - fromnumeric.ravel(self._mask)
+ c = fromnumeric.compress(m, d)
+ return array(c, copy=0)
+
+ def count (self, axis = None):
+ "Count of the non-masked elements in a, or along a certain axis."
+ m = self._mask
+ s = self._data.shape
+ ls = len(s)
+ if m is nomask:
+ if ls == 0:
+ return 1
+ if ls == 1:
+ return s[0]
+ if axis is None:
+ return reduce(lambda x, y:x*y, s)
+ else:
+ n = s[axis]
+ t = list(s)
+ del t[axis]
+ return ones(t) * n
+ if axis is None:
+ w = fromnumeric.ravel(m).astype(int)
+ n1 = size(w)
+ if n1 == 1:
+ n2 = w[0]
+ else:
+ n2 = umath.add.reduce(w)
+ return n1 - n2
+ else:
+ n1 = size(m, axis)
+ n2 = sum(m.astype(int), axis)
+ return n1 - n2
+
+ def dot (self, other):
+ "s.dot(other) = innerproduct(s, other)"
+ return innerproduct(self, other)
+
+ def fill_value(self):
+ "Get the current fill value."
+ return self._fill_value
+
+ def filled (self, fill_value=None):
+ """A numeric array with masked values filled. If fill_value is None,
+ use self.fill_value().
+
+ If mask is nomask, copy data only if not contiguous.
+ Result is always a contiguous, numeric array.
+# Is contiguous really necessary now?
+ """
+ d = self._data
+ m = self._mask
+ if m is nomask:
+ if d.flags['CONTIGUOUS']:
+ return d
+ else:
+ return d.copy()
+ else:
+ if fill_value is None:
+ value = self._fill_value
+ else:
+ value = fill_value
+
+ if self is masked:
+ result = numeric.array(value)
+ else:
+ try:
+ result = numeric.array(d, dtype=d.dtype, copy=1)
+ result[m] = value
+ except (TypeError, AttributeError):
+ #ok, can't put that value in here
+ value = numeric.array(value, dtype=object)
+ d = d.astype(object)
+ result = fromnumeric.choose(m, (d, value))
+ return result
+
+ def ids (self):
+ """Return the ids of the data and mask areas"""
+ return (id(self._data), id(self._mask))
+
+ def iscontiguous (self):
+ "Is the data contiguous?"
+ return self._data.flags['CONTIGUOUS']
+
+ def itemsize(self):
+ "Item size of each data item."
+ return self._data.itemsize
+
+
+ def outer(self, other):
+ "s.outer(other) = outerproduct(s, other)"
+ return outerproduct(self, other)
+
+ def put (self, values):
+ """Set the non-masked entries of self to filled(values).
+ No change to mask
+ """
+ iota = numeric.arange(self.size)
+ d = self._data
+ if self._mask is nomask:
+ ind = iota
+ else:
+ ind = fromnumeric.compress(1 - self._mask, iota)
+ d[ind] = filled(values).astype(d.dtype)
+
+ def putmask (self, values):
+ """Set the masked entries of self to filled(values).
+ Mask changed to nomask.
+ """
+ d = self._data
+ if self._mask is not nomask:
+ d[self._mask] = filled(values).astype(d.dtype)
+ self._shared_mask = 0
+ self._mask = nomask
+
+ def ravel (self):
+ """Return a 1-D view of self."""
+ if self._mask is nomask:
+ return masked_array(self._data.ravel())
+ else:
+ return masked_array(self._data.ravel(), self._mask.ravel())
+
+ def raw_data (self):
+ """ Obsolete; use data property instead.
+ The raw data; portions may be meaningless.
+ May be noncontiguous. Expert use only."""
+ return self._data
+ data = property(fget=raw_data,
+ doc="The data, but values at masked locations are meaningless.")
+
+ def raw_mask (self):
+ """ Obsolete; use mask property instead.
+ May be noncontiguous. Expert use only.
+ """
+ return self._mask
+ mask = property(fget=raw_mask,
+ doc="The mask, may be nomask. Values where mask true are meaningless.")
+
+ def reshape (self, *s):
+ """This array reshaped to shape s"""
+ d = self._data.reshape(*s)
+ if self._mask is nomask:
+ return masked_array(d)
+ else:
+ m = self._mask.reshape(*s)
+ return masked_array(d, m)
+
+ def set_fill_value (self, v=None):
+ "Set the fill value to v. Omit v to restore default."
+ if v is None:
+ v = default_fill_value (self.raw_data())
+ self._fill_value = v
+
+ def _get_ndim(self):
+ return self._data.ndim
+ ndim = property(_get_ndim, doc=numeric.ndarray.ndim.__doc__)
+
+ def _get_size (self):
+ return self._data.size
+ size = property(fget=_get_size, doc="Number of elements in the array.")
+## CHECK THIS: signature of numeric.array.size?
+
+ def _get_dtype(self):
+ return self._data.dtype
+ dtype = property(fget=_get_dtype, doc="type of the array elements.")
+
+ def item(self, *args):
+ "Return Python scalar if possible"
+ if self._mask is not nomask:
+ m = self._mask.item(*args)
+ try:
+ if m[0]:
+ return masked
+ except IndexError:
+ return masked
+ return self._data.item(*args)
+
+ def itemset(self, *args):
+ "Set Python scalar into array"
+ item = args[-1]
+ args = args[:-1]
+ self[args] = item
+
+ def tolist(self, fill_value=None):
+ "Convert to list"
+ return self.filled(fill_value).tolist()
+
+ def tostring(self, fill_value=None):
+ "Convert to string"
+ return self.filled(fill_value).tostring()
+
+ def unmask (self):
+ "Replace the mask by nomask if possible."
+ if self._mask is nomask: return
+ m = make_mask(self._mask, flag=1)
+ if m is nomask:
+ self._mask = nomask
+ self._shared_mask = 0
+
+ def unshare_mask (self):
+ "If currently sharing mask, make a copy."
+ if self._shared_mask:
+ self._mask = make_mask (self._mask, copy=1, flag=0)
+ self._shared_mask = 0
+
+ def _get_ctypes(self):
+ return self._data.ctypes
+
+ def _get_T(self):
+ if (self.ndim < 2):
+ return self
+ return self.transpose()
+
+ shape = property(_get_shape, _set_shape,
+ doc = 'tuple giving the shape of the array')
+
+ flat = property(_get_flat, _set_flat,
+ doc = 'Access array in flat form.')
+
+ real = property(_get_real, _set_real,
+ doc = 'Access the real part of the array')
+
+ imaginary = property(_get_imaginary, _set_imaginary,
+ doc = 'Access the imaginary part of the array')
+
+ imag = imaginary
+
+ ctypes = property(_get_ctypes, None, doc="ctypes")
+
+ T = property(_get_T, None, doc="get transpose")
+
+#end class MaskedArray
+
+array = MaskedArray
+
+def isMaskedArray (x):
+ "Is x a masked array, that is, an instance of MaskedArray?"
+ return isinstance(x, MaskedArray)
+
+isarray = isMaskedArray
+isMA = isMaskedArray #backward compatibility
+
+def allclose (a, b, fill_value=1, rtol=1.e-5, atol=1.e-8):
+ """ Returns true if all components of a and b are equal
+ subject to given tolerances.
+ If fill_value is 1, masked values considered equal.
+ If fill_value is 0, masked values considered unequal.
+ The relative error rtol should be positive and << 1.0
+ The absolute error atol comes into play for those elements
+ of b that are very small or zero; it says how small a must be also.
+ """
+ m = mask_or(getmask(a), getmask(b))
+ d1 = filled(a)
+ d2 = filled(b)
+ x = filled(array(d1, copy=0, mask=m), fill_value).astype(float)
+ y = filled(array(d2, copy=0, mask=m), 1).astype(float)
+ d = umath.less_equal(umath.absolute(x-y), atol + rtol * umath.absolute(y))
+ return fromnumeric.alltrue(fromnumeric.ravel(d))
+
+def allequal (a, b, fill_value=1):
+ """
+ True if all entries of a and b are equal, using
+ fill_value as a truth value where either or both are masked.
+ """
+ m = mask_or(getmask(a), getmask(b))
+ if m is nomask:
+ x = filled(a)
+ y = filled(b)
+ d = umath.equal(x, y)
+ return fromnumeric.alltrue(fromnumeric.ravel(d))
+ elif fill_value:
+ x = filled(a)
+ y = filled(b)
+ d = umath.equal(x, y)
+ dm = array(d, mask=m, copy=0)
+ return fromnumeric.alltrue(fromnumeric.ravel(filled(dm, 1)))
+ else:
+ return 0
+
+def masked_values (data, value, rtol=1.e-5, atol=1.e-8, copy=1):
+ """
+ masked_values(data, value, rtol=1.e-5, atol=1.e-8)
+ Create a masked array; mask is nomask if possible.
+ If copy==0, and otherwise possible, result
+ may share data values with original array.
+ Let d = filled(data, value). Returns d
+ masked where abs(data-value)<= atol + rtol * abs(value)
+ if d is of a floating point type. Otherwise returns
+ masked_object(d, value, copy)
+ """
+ abs = umath.absolute
+ d = filled(data, value)
+ if issubclass(d.dtype.type, numeric.floating):
+ m = umath.less_equal(abs(d-value), atol+rtol*abs(value))
+ m = make_mask(m, flag=1)
+ return array(d, mask = m, copy=copy,
+ fill_value=value)
+ else:
+ return masked_object(d, value, copy=copy)
+
+def masked_object (data, value, copy=1):
+ "Create array masked where exactly data equal to value"
+ d = filled(data, value)
+ dm = make_mask(umath.equal(d, value), flag=1)
+ return array(d, mask=dm, copy=copy, fill_value=value)
+
+def arange(start, stop=None, step=1, dtype=None):
+ """Just like range() except it returns a array whose type can be specified
+ by the keyword argument dtype.
+ """
+ return array(numeric.arange(start, stop, step, dtype))
+
+arrayrange = arange
+
+def fromstring (s, t):
+ "Construct a masked array from a string. Result will have no mask."
+ return masked_array(numeric.fromstring(s, t))
+
+def left_shift (a, n):
+ "Left shift n bits"
+ m = getmask(a)
+ if m is nomask:
+ d = umath.left_shift(filled(a), n)
+ return masked_array(d)
+ else:
+ d = umath.left_shift(filled(a, 0), n)
+ return masked_array(d, m)
+
+def right_shift (a, n):
+ "Right shift n bits"
+ m = getmask(a)
+ if m is nomask:
+ d = umath.right_shift(filled(a), n)
+ return masked_array(d)
+ else:
+ d = umath.right_shift(filled(a, 0), n)
+ return masked_array(d, m)
+
+def resize (a, new_shape):
+ """resize(a, new_shape) returns a new array with the specified shape.
+ The original array's total size can be any size."""
+ m = getmask(a)
+ if m is not nomask:
+ m = fromnumeric.resize(m, new_shape)
+ result = array(fromnumeric.resize(filled(a), new_shape), mask=m)
+ result.set_fill_value(get_fill_value(a))
+ return result
+
+def repeat(a, repeats, axis=None):
+ """repeat elements of a repeats times along axis
+ repeats is a sequence of length a.shape[axis]
+ telling how many times to repeat each element.
+ """
+ af = filled(a)
+ if isinstance(repeats, types.IntType):
+ if axis is None:
+ num = af.size
+ else:
+ num = af.shape[axis]
+ repeats = tuple([repeats]*num)
+
+ m = getmask(a)
+ if m is not nomask:
+ m = fromnumeric.repeat(m, repeats, axis)
+ d = fromnumeric.repeat(af, repeats, axis)
+ result = masked_array(d, m)
+ result.set_fill_value(get_fill_value(a))
+ return result
+
+def identity(n):
+ """identity(n) returns the identity matrix of shape n x n.
+ """
+ return array(numeric.identity(n))
+
+def indices (dimensions, dtype=None):
+ """indices(dimensions,dtype=None) returns an array representing a grid
+ of indices with row-only, and column-only variation.
+ """
+ return array(numeric.indices(dimensions, dtype))
+
+def zeros (shape, dtype=float):
+ """zeros(n, dtype=float) =
+ an array of all zeros of the given length or shape."""
+ return array(numeric.zeros(shape, dtype))
+
+def ones (shape, dtype=float):
+ """ones(n, dtype=float) =
+ an array of all ones of the given length or shape."""
+ return array(numeric.ones(shape, dtype))
+
+def count (a, axis = None):
+ "Count of the non-masked elements in a, or along a certain axis."
+ a = masked_array(a)
+ return a.count(axis)
+
+def power (a, b, third=None):
+ "a**b"
+ if third is not None:
+ raise MAError, "3-argument power not supported."
+ ma = getmask(a)
+ mb = getmask(b)
+ m = mask_or(ma, mb)
+ fa = filled(a, 1)
+ fb = filled(b, 1)
+ if fb.dtype.char in typecodes["Integer"]:
+ return masked_array(umath.power(fa, fb), m)
+ md = make_mask(umath.less(fa, 0), flag=1)
+ m = mask_or(m, md)
+ if m is nomask:
+ return masked_array(umath.power(fa, fb))
+ else:
+ fa = numeric.where(m, 1, fa)
+ return masked_array(umath.power(fa, fb), m)
+
+def masked_array (a, mask=nomask, fill_value=None):
+ """masked_array(a, mask=nomask) =
+ array(a, mask=mask, copy=0, fill_value=fill_value)
+ """
+ return array(a, mask=mask, copy=0, fill_value=fill_value)
+
+def sum (target, axis=None, dtype=None):
+ if axis is None:
+ target = ravel(target)
+ axis = 0
+ return add.reduce(target, axis, dtype)
+
+def product (target, axis=None, dtype=None):
+ if axis is None:
+ target = ravel(target)
+ axis = 0
+ return multiply.reduce(target, axis, dtype)
+
+def average (a, axis=None, weights=None, returned = 0):
+ """average(a, axis=None, weights=None)
+ Computes average along indicated axis.
+ If axis is None, average over the entire array
+ Inputs can be integer or floating types; result is of type float.
+
+ If weights are given, result is sum(a*weights,axis=0)/(sum(weights,axis=0)*1.0)
+ weights must have a's shape or be the 1-d with length the size
+ of a in the given axis.
+
+ If returned, return a tuple: the result and the sum of the weights
+ or count of values. Results will have the same shape.
+
+ masked values in the weights will be set to 0.0
+ """
+ a = masked_array(a)
+ mask = a.mask
+ ash = a.shape
+ if ash == ():
+ ash = (1,)
+ if axis is None:
+ if mask is nomask:
+ if weights is None:
+ n = add.reduce(a.raw_data().ravel())
+ d = reduce(lambda x, y: x * y, ash, 1.0)
+ else:
+ w = filled(weights, 0.0).ravel()
+ n = umath.add.reduce(a.raw_data().ravel() * w)
+ d = umath.add.reduce(w)
+ del w
+ else:
+ if weights is None:
+ n = add.reduce(a.ravel())
+ w = fromnumeric.choose(mask, (1.0, 0.0)).ravel()
+ d = umath.add.reduce(w)
+ del w
+ else:
+ w = array(filled(weights, 0.0), float, mask=mask).ravel()
+ n = add.reduce(a.ravel() * w)
+ d = add.reduce(w)
+ del w
+ else:
+ if mask is nomask:
+ if weights is None:
+ d = ash[axis] * 1.0
+ n = umath.add.reduce(a.raw_data(), axis)
+ else:
+ w = filled(weights, 0.0)
+ wsh = w.shape
+ if wsh == ():
+ wsh = (1,)
+ if wsh == ash:
+ w = numeric.array(w, float, copy=0)
+ n = add.reduce(a*w, axis)
+ d = add.reduce(w, axis)
+ del w
+ elif wsh == (ash[axis],):
+ r = [newaxis]*len(ash)
+ r[axis] = slice(None, None, 1)
+ w = eval ("w["+ repr(tuple(r)) + "] * ones(ash, float)")
+ n = add.reduce(a*w, axis)
+ d = add.reduce(w, axis)
+ del w, r
+ else:
+ raise ValueError, 'average: weights wrong shape.'
+ else:
+ if weights is None:
+ n = add.reduce(a, axis)
+ w = numeric.choose(mask, (1.0, 0.0))
+ d = umath.add.reduce(w, axis)
+ del w
+ else:
+ w = filled(weights, 0.0)
+ wsh = w.shape
+ if wsh == ():
+ wsh = (1,)
+ if wsh == ash:
+ w = array(w, float, mask=mask, copy=0)
+ n = add.reduce(a*w, axis)
+ d = add.reduce(w, axis)
+ elif wsh == (ash[axis],):
+ r = [newaxis]*len(ash)
+ r[axis] = slice(None, None, 1)
+ w = eval ("w["+ repr(tuple(r)) + "] * masked_array(ones(ash, float), mask)")
+ n = add.reduce(a*w, axis)
+ d = add.reduce(w, axis)
+ else:
+ raise ValueError, 'average: weights wrong shape.'
+ del w
+ #print n, d, repr(mask), repr(weights)
+ if n is masked or d is masked: return masked
+ result = divide (n, d)
+ del n
+
+ if isinstance(result, MaskedArray):
+ result.unmask()
+ if returned:
+ if not isinstance(d, MaskedArray):
+ d = masked_array(d)
+ if not d.shape == result.shape:
+ d = ones(result.shape, float) * d
+ d.unmask()
+ if returned:
+ return result, d
+ else:
+ return result
+
+def where (condition, x, y):
+ """where(condition, x, y) is x where condition is nonzero, y otherwise.
+ condition must be convertible to an integer array.
+ Answer is always the shape of condition.
+ The type depends on x and y. It is integer if both x and y are
+ the value masked.
+ """
+ fc = filled(not_equal(condition, 0), 0)
+ xv = filled(x)
+ xm = getmask(x)
+ yv = filled(y)
+ ym = getmask(y)
+ d = numeric.choose(fc, (yv, xv))
+ md = numeric.choose(fc, (ym, xm))
+ m = getmask(condition)
+ m = make_mask(mask_or(m, md), copy=0, flag=1)
+ return masked_array(d, m)
+
+def choose (indices, t, out=None, mode='raise'):
+ "Returns array shaped like indices with elements chosen from t"
+ def fmask (x):
+ if x is masked: return 1
+ return filled(x)
+ def nmask (x):
+ if x is masked: return 1
+ m = getmask(x)
+ if m is nomask: return 0
+ return m
+ c = filled(indices, 0)
+ masks = [nmask(x) for x in t]
+ a = [fmask(x) for x in t]
+ d = numeric.choose(c, a)
+ m = numeric.choose(c, masks)
+ m = make_mask(mask_or(m, getmask(indices)), copy=0, flag=1)
+ return masked_array(d, m)
+
+def masked_where(condition, x, copy=1):
+ """Return x as an array masked where condition is true.
+ Also masked where x or condition masked.
+ """
+ cm = filled(condition,1)
+ m = mask_or(getmask(x), cm)
+ return array(filled(x), copy=copy, mask=m)
+
+def masked_greater(x, value, copy=1):
+ "masked_greater(x, value) = x masked where x > value"
+ return masked_where(greater(x, value), x, copy)
+
+def masked_greater_equal(x, value, copy=1):
+ "masked_greater_equal(x, value) = x masked where x >= value"
+ return masked_where(greater_equal(x, value), x, copy)
+
+def masked_less(x, value, copy=1):
+ "masked_less(x, value) = x masked where x < value"
+ return masked_where(less(x, value), x, copy)
+
+def masked_less_equal(x, value, copy=1):
+ "masked_less_equal(x, value) = x masked where x <= value"
+ return masked_where(less_equal(x, value), x, copy)
+
+def masked_not_equal(x, value, copy=1):
+ "masked_not_equal(x, value) = x masked where x != value"
+ d = filled(x, 0)
+ c = umath.not_equal(d, value)
+ m = mask_or(c, getmask(x))
+ return array(d, mask=m, copy=copy)
+
+def masked_equal(x, value, copy=1):
+ """masked_equal(x, value) = x masked where x == value
+ For floating point consider masked_values(x, value) instead.
+ """
+ d = filled(x, 0)
+ c = umath.equal(d, value)
+ m = mask_or(c, getmask(x))
+ return array(d, mask=m, copy=copy)
+
+def masked_inside(x, v1, v2, copy=1):
+ """x with mask of all values of x that are inside [v1,v2]
+ v1 and v2 can be given in either order.
+ """
+ if v2 < v1:
+ t = v2
+ v2 = v1
+ v1 = t
+ d = filled(x, 0)
+ c = umath.logical_and(umath.less_equal(d, v2), umath.greater_equal(d, v1))
+ m = mask_or(c, getmask(x))
+ return array(d, mask = m, copy=copy)
+
+def masked_outside(x, v1, v2, copy=1):
+ """x with mask of all values of x that are outside [v1,v2]
+ v1 and v2 can be given in either order.
+ """
+ if v2 < v1:
+ t = v2
+ v2 = v1
+ v1 = t
+ d = filled(x, 0)
+ c = umath.logical_or(umath.less(d, v1), umath.greater(d, v2))
+ m = mask_or(c, getmask(x))
+ return array(d, mask = m, copy=copy)
+
+def reshape (a, *newshape):
+ "Copy of a with a new shape."
+ m = getmask(a)
+ d = filled(a).reshape(*newshape)
+ if m is nomask:
+ return masked_array(d)
+ else:
+ return masked_array(d, mask=numeric.reshape(m, *newshape))
+
+def ravel (a):
+ "a as one-dimensional, may share data and mask"
+ m = getmask(a)
+ d = fromnumeric.ravel(filled(a))
+ if m is nomask:
+ return masked_array(d)
+ else:
+ return masked_array(d, mask=numeric.ravel(m))
+
+def concatenate (arrays, axis=0):
+ "Concatenate the arrays along the given axis"
+ d = []
+ for x in arrays:
+ d.append(filled(x))
+ d = numeric.concatenate(d, axis)
+ for x in arrays:
+ if getmask(x) is not nomask: break
+ else:
+ return masked_array(d)
+ dm = []
+ for x in arrays:
+ dm.append(getmaskarray(x))
+ dm = numeric.concatenate(dm, axis)
+ return masked_array(d, mask=dm)
+
+def swapaxes (a, axis1, axis2):
+ m = getmask(a)
+ d = masked_array(a).data
+ if m is nomask:
+ return masked_array(data=numeric.swapaxes(d, axis1, axis2))
+ else:
+ return masked_array(data=numeric.swapaxes(d, axis1, axis2),
+ mask=numeric.swapaxes(m, axis1, axis2),)
+
+
+def take (a, indices, axis=None, out=None, mode='raise'):
+ "returns selection of items from a."
+ m = getmask(a)
+ # d = masked_array(a).raw_data()
+ d = masked_array(a).data
+ if m is nomask:
+ return masked_array(numeric.take(d, indices, axis))
+ else:
+ return masked_array(numeric.take(d, indices, axis),
+ mask = numeric.take(m, indices, axis))
+
+def transpose(a, axes=None):
+ "reorder dimensions per tuple axes"
+ m = getmask(a)
+ d = filled(a)
+ if m is nomask:
+ return masked_array(numeric.transpose(d, axes))
+ else:
+ return masked_array(numeric.transpose(d, axes),
+ mask = numeric.transpose(m, axes))
+
+
+def put(a, indices, values, mode='raise'):
+ """sets storage-indexed locations to corresponding values.
+
+ Values and indices are filled if necessary.
+
+ """
+ d = a.raw_data()
+ ind = filled(indices)
+ v = filled(values)
+ numeric.put (d, ind, v)
+ m = getmask(a)
+ if m is not nomask:
+ a.unshare_mask()
+ numeric.put(a.raw_mask(), ind, 0)
+
+def putmask(a, mask, values):
+ "putmask(a, mask, values) sets a where mask is true."
+ if mask is nomask:
+ return
+ numeric.putmask(a.raw_data(), mask, values)
+ m = getmask(a)
+ if m is nomask: return
+ a.unshare_mask()
+ numeric.putmask(a.raw_mask(), mask, 0)
+
+def inner(a, b):
+ """inner(a,b) returns the dot product of two arrays, which has
+ shape a.shape[:-1] + b.shape[:-1] with elements computed by summing the
+ product of the elements from the last dimensions of a and b.
+ Masked elements are replace by zeros.
+ """
+ fa = filled(a, 0)
+ fb = filled(b, 0)
+ if len(fa.shape) == 0: fa.shape = (1,)
+ if len(fb.shape) == 0: fb.shape = (1,)
+ return masked_array(numeric.inner(fa, fb))
+
+innerproduct = inner
+
+def outer(a, b):
+ """outer(a,b) = {a[i]*b[j]}, has shape (len(a),len(b))"""
+ fa = filled(a, 0).ravel()
+ fb = filled(b, 0).ravel()
+ d = numeric.outer(fa, fb)
+ ma = getmask(a)
+ mb = getmask(b)
+ if ma is nomask and mb is nomask:
+ return masked_array(d)
+ ma = getmaskarray(a)
+ mb = getmaskarray(b)
+ m = make_mask(1-numeric.outer(1-ma, 1-mb), copy=0)
+ return masked_array(d, m)
+
+outerproduct = outer
+
+def dot(a, b):
+ """dot(a,b) returns matrix-multiplication between a and b. The product-sum
+ is over the last dimension of a and the second-to-last dimension of b.
+ Masked values are replaced by zeros. See also innerproduct.
+ """
+ return innerproduct(filled(a, 0), numeric.swapaxes(filled(b, 0), -1, -2))
+
+def compress(condition, x, dimension=-1, out=None):
+ """Select those parts of x for which condition is true.
+ Masked values in condition are considered false.
+ """
+ c = filled(condition, 0)
+ m = getmask(x)
+ if m is not nomask:
+ m = numeric.compress(c, m, dimension)
+ d = numeric.compress(c, filled(x), dimension)
+ return masked_array(d, m)
+
+class _minimum_operation:
+ "Object to calculate minima"
+ def __init__ (self):
+ """minimum(a, b) or minimum(a)
+ In one argument case returns the scalar minimum.
+ """
+ pass
+
+ def __call__ (self, a, b=None):
+ "Execute the call behavior."
+ if b is None:
+ m = getmask(a)
+ if m is nomask:
+ d = amin(filled(a).ravel())
+ return d
+ ac = a.compressed()
+ if len(ac) == 0:
+ return masked
+ else:
+ return amin(ac.raw_data())
+ else:
+ return where(less(a, b), a, b)
+
+ def reduce (self, target, axis=0):
+ """Reduce target along the given axis."""
+ m = getmask(target)
+ if m is nomask:
+ t = filled(target)
+ return masked_array (umath.minimum.reduce (t, axis))
+ else:
+ t = umath.minimum.reduce(filled(target, minimum_fill_value(target)), axis)
+ m = umath.logical_and.reduce(m, axis)
+ return masked_array(t, m, get_fill_value(target))
+
+ def outer (self, a, b):
+ "Return the function applied to the outer product of a and b."
+ ma = getmask(a)
+ mb = getmask(b)
+ if ma is nomask and mb is nomask:
+ m = nomask
+ else:
+ ma = getmaskarray(a)
+ mb = getmaskarray(b)
+ m = logical_or.outer(ma, mb)
+ d = umath.minimum.outer(filled(a), filled(b))
+ return masked_array(d, m)
+
+minimum = _minimum_operation ()
+
+class _maximum_operation:
+ "Object to calculate maxima"
+ def __init__ (self):
+ """maximum(a, b) or maximum(a)
+ In one argument case returns the scalar maximum.
+ """
+ pass
+
+ def __call__ (self, a, b=None):
+ "Execute the call behavior."
+ if b is None:
+ m = getmask(a)
+ if m is nomask:
+ d = amax(filled(a).ravel())
+ return d
+ ac = a.compressed()
+ if len(ac) == 0:
+ return masked
+ else:
+ return amax(ac.raw_data())
+ else:
+ return where(greater(a, b), a, b)
+
+ def reduce (self, target, axis=0):
+ """Reduce target along the given axis."""
+ m = getmask(target)
+ if m is nomask:
+ t = filled(target)
+ return masked_array (umath.maximum.reduce (t, axis))
+ else:
+ t = umath.maximum.reduce(filled(target, maximum_fill_value(target)), axis)
+ m = umath.logical_and.reduce(m, axis)
+ return masked_array(t, m, get_fill_value(target))
+
+ def outer (self, a, b):
+ "Return the function applied to the outer product of a and b."
+ ma = getmask(a)
+ mb = getmask(b)
+ if ma is nomask and mb is nomask:
+ m = nomask
+ else:
+ ma = getmaskarray(a)
+ mb = getmaskarray(b)
+ m = logical_or.outer(ma, mb)
+ d = umath.maximum.outer(filled(a), filled(b))
+ return masked_array(d, m)
+
+maximum = _maximum_operation ()
+
+def sort (x, axis = -1, fill_value=None):
+ """If x does not have a mask, return a masked array formed from the
+ result of numeric.sort(x, axis).
+ Otherwise, fill x with fill_value. Sort it.
+ Set a mask where the result is equal to fill_value.
+ Note that this may have unintended consequences if the data contains the
+ fill value at a non-masked site.
+
+ If fill_value is not given the default fill value for x's type will be
+ used.
+ """
+ if fill_value is None:
+ fill_value = default_fill_value (x)
+ d = filled(x, fill_value)
+ s = fromnumeric.sort(d, axis)
+ if getmask(x) is nomask:
+ return masked_array(s)
+ return masked_values(s, fill_value, copy=0)
+
+def diagonal(a, k = 0, axis1=0, axis2=1):
+ """diagonal(a,k=0,axis1=0, axis2=1) = the k'th diagonal of a"""
+ d = fromnumeric.diagonal(filled(a), k, axis1, axis2)
+ m = getmask(a)
+ if m is nomask:
+ return masked_array(d, m)
+ else:
+ return masked_array(d, fromnumeric.diagonal(m, k, axis1, axis2))
+
+def trace (a, offset=0, axis1=0, axis2=1, dtype=None, out=None):
+ """trace(a,offset=0, axis1=0, axis2=1) returns the sum along diagonals
+ (defined by the last two dimenions) of the array.
+ """
+ return diagonal(a, offset, axis1, axis2).sum(dtype=dtype)
+
+def argsort (x, axis = -1, out=None, fill_value=None):
+ """Treating masked values as if they have the value fill_value,
+ return sort indices for sorting along given axis.
+ if fill_value is None, use get_fill_value(x)
+ Returns a numpy array.
+ """
+ d = filled(x, fill_value)
+ return fromnumeric.argsort(d, axis)
+
+def argmin (x, axis = -1, out=None, fill_value=None):
+ """Treating masked values as if they have the value fill_value,
+ return indices for minimum values along given axis.
+ if fill_value is None, use get_fill_value(x).
+ Returns a numpy array if x has more than one dimension.
+ Otherwise, returns a scalar index.
+ """
+ d = filled(x, fill_value)
+ return fromnumeric.argmin(d, axis)
+
+def argmax (x, axis = -1, out=None, fill_value=None):
+ """Treating masked values as if they have the value fill_value,
+ return sort indices for maximum along given axis.
+ if fill_value is None, use -get_fill_value(x) if it exists.
+ Returns a numpy array if x has more than one dimension.
+ Otherwise, returns a scalar index.
+ """
+ if fill_value is None:
+ fill_value = default_fill_value (x)
+ try:
+ fill_value = - fill_value
+ except:
+ pass
+ d = filled(x, fill_value)
+ return fromnumeric.argmax(d, axis)
+
+def fromfunction (f, s):
+ """apply f to s to create array as in umath."""
+ return masked_array(numeric.fromfunction(f, s))
+
+def asarray(data, dtype=None):
+ """asarray(data, dtype) = array(data, dtype, copy=0)
+ """
+ if isinstance(data, MaskedArray) and \
+ (dtype is None or dtype == data.dtype):
+ return data
+ return array(data, dtype=dtype, copy=0)
+
+# Add methods to support ndarray interface
+# XXX: I is better to to change the masked_*_operation adaptors
+# XXX: to wrap ndarray methods directly to create ma.array methods.
+from types import MethodType
+def _m(f):
+ return MethodType(f, None, array)
+def not_implemented(*args, **kwds):
+ raise NotImplementedError, "not yet implemented for numpy.ma arrays"
+array.all = _m(alltrue)
+array.any = _m(sometrue)
+array.argmax = _m(argmax)
+array.argmin = _m(argmin)
+array.argsort = _m(argsort)
+array.base = property(_m(not_implemented))
+array.byteswap = _m(not_implemented)
+
+def _choose(self, *args, **kwds):
+ return choose(self, args)
+array.choose = _m(_choose)
+del _choose
+
+def _clip(self,a_min,a_max,out=None):
+ return MaskedArray(data = self.data.clip(asarray(a_min).data,
+ asarray(a_max).data),
+ mask = mask_or(self.mask,
+ mask_or(getmask(a_min),getmask(a_max))))
+array.clip = _m(_clip)
+
+def _compress(self, cond, axis=None, out=None):
+ return compress(cond, self, axis)
+array.compress = _m(_compress)
+del _compress
+
+array.conj = array.conjugate = _m(conjugate)
+array.copy = _m(not_implemented)
+
+def _cumprod(self, axis=None, dtype=None, out=None):
+ m = self.mask
+ if m is not nomask:
+ m = umath.logical_or.accumulate(self.mask, axis)
+ return MaskedArray(data = self.filled(1).cumprod(axis, dtype), mask=m)
+array.cumprod = _m(_cumprod)
+
+def _cumsum(self, axis=None, dtype=None, out=None):
+ m = self.mask
+ if m is not nomask:
+ m = umath.logical_or.accumulate(self.mask, axis)
+ return MaskedArray(data=self.filled(0).cumsum(axis, dtype), mask=m)
+array.cumsum = _m(_cumsum)
+
+array.diagonal = _m(diagonal)
+array.dump = _m(not_implemented)
+array.dumps = _m(not_implemented)
+array.fill = _m(not_implemented)
+array.flags = property(_m(not_implemented))
+array.flatten = _m(ravel)
+array.getfield = _m(not_implemented)
+
+def _max(a, axis=None, out=None):
+ if out is not None:
+ raise TypeError("Output arrays Unsupported for masked arrays")
+ if axis is None:
+ return maximum(a)
+ else:
+ return maximum.reduce(a, axis)
+array.max = _m(_max)
+del _max
+def _min(a, axis=None, out=None):
+ if out is not None:
+ raise TypeError("Output arrays Unsupported for masked arrays")
+ if axis is None:
+ return minimum(a)
+ else:
+ return minimum.reduce(a, axis)
+array.min = _m(_min)
+del _min
+array.mean = _m(average)
+array.nbytes = property(_m(not_implemented))
+array.newbyteorder = _m(not_implemented)
+array.nonzero = _m(nonzero)
+array.prod = _m(product)
+
+def _ptp(a,axis=None,out=None):
+ return a.max(axis,out)-a.min(axis)
+array.ptp = _m(_ptp)
+array.repeat = _m(repeat)
+array.resize = _m(resize)
+array.searchsorted = _m(not_implemented)
+array.setfield = _m(not_implemented)
+array.setflags = _m(not_implemented)
+array.sort = _m(not_implemented) # NB: ndarray.sort is inplace
+
+def _squeeze(self):
+ try:
+ result = MaskedArray(data = self.data.squeeze(),
+ mask = self.mask.squeeze())
+ except AttributeError:
+ result = _wrapit(self, 'squeeze')
+ return result
+array.squeeze = _m(_squeeze)
+
+array.strides = property(_m(not_implemented))
+array.sum = _m(sum)
+def _swapaxes(self,axis1,axis2):
+ return MaskedArray(data = self.data.swapaxes(axis1, axis2),
+ mask = self.mask.swapaxes(axis1, axis2))
+array.swapaxes = _m(_swapaxes)
+array.take = _m(take)
+array.tofile = _m(not_implemented)
+array.trace = _m(trace)
+array.transpose = _m(transpose)
+
+def _var(self,axis=None,dtype=None, out=None):
+ if axis is None:
+ return numeric.asarray(self.compressed()).var()
+ a = self.swapaxes(axis,0)
+ a = a - a.mean(axis=0)
+ a *= a
+ a /= a.count(axis=0)
+ return a.swapaxes(0,axis).sum(axis)
+def _std(self,axis=None, dtype=None, out=None):
+ return (self.var(axis,dtype))**0.5
+array.var = _m(_var)
+array.std = _m(_std)
+
+array.view = _m(not_implemented)
+array.round = _m(around)
+del _m, MethodType, not_implemented
+
+
+masked = MaskedArray(0, int, mask=1)
diff --git a/numpy/core/memmap.py b/numpy/core/memmap.py
new file mode 100644
index 000000000..d3dbd09fb
--- /dev/null
+++ b/numpy/core/memmap.py
@@ -0,0 +1,93 @@
+__all__ = ['memmap']
+
+import mmap
+from numeric import uint8, ndarray, dtype
+
+dtypedescr = dtype
+valid_filemodes = ["r", "c", "r+", "w+"]
+writeable_filemodes = ["r+","w+"]
+
+mode_equivalents = {
+ "readonly":"r",
+ "copyonwrite":"c",
+ "readwrite":"r+",
+ "write":"w+"
+ }
+
+class memmap(ndarray):
+ __array_priority__ = -100.0
+ def __new__(subtype, name, dtype=uint8, mode='r+', offset=0,
+ shape=None, order='C'):
+ try:
+ mode = mode_equivalents[mode]
+ except KeyError:
+ if mode not in valid_filemodes:
+ raise ValueError("mode must be one of %s" % \
+ (valid_filemodes + mode_equivalents.keys()))
+
+ fid = file(name, (mode == 'c' and 'r' or mode)+'b')
+
+ if (mode == 'w+') and shape is None:
+ raise ValueError, "shape must be given"
+
+ fid.seek(0,2)
+ flen = fid.tell()
+ descr = dtypedescr(dtype)
+ _dbytes = descr.itemsize
+
+ if shape is None:
+ bytes = flen-offset
+ if (bytes % _dbytes):
+ fid.close()
+ raise ValueError, "Size of available data is not a "\
+ "multiple of data-type size."
+ size = bytes // _dbytes
+ shape = (size,)
+ else:
+ if not isinstance(shape, tuple):
+ shape = (shape,)
+ size = 1
+ for k in shape:
+ size *= k
+
+ bytes = long(offset + size*_dbytes)
+
+ if mode == 'w+' or (mode == 'r+' and flen < bytes):
+ fid.seek(bytes-1,0)
+ fid.write(chr(0))
+ fid.flush()
+
+ if mode == 'c':
+ acc = mmap.ACCESS_COPY
+ elif mode == 'r':
+ acc = mmap.ACCESS_READ
+ else:
+ acc = mmap.ACCESS_WRITE
+
+ mm = mmap.mmap(fid.fileno(), bytes, access=acc)
+
+ self = ndarray.__new__(subtype, shape, dtype=descr, buffer=mm,
+ offset=offset, order=order)
+ self._mmap = mm
+ self._offset = offset
+ self._mode = mode
+ self._size = size
+ self._name = name
+ fid.close()
+ return self
+
+ def __array_finalize__(self, obj):
+ if obj is not None and not isinstance(obj, memmap):
+ raise ValueError, "Cannot create a memmap array that way"
+ self._mmap = None
+
+ def sync(self):
+ self._mmap.flush()
+
+ def close(self):
+ self._mmap.close()
+
+ def __del__(self):
+ if self._mmap is not None:
+ self._mmap.flush()
+ del self._mmap
diff --git a/numpy/core/numeric.py b/numpy/core/numeric.py
new file mode 100644
index 000000000..b4709b392
--- /dev/null
+++ b/numpy/core/numeric.py
@@ -0,0 +1,1056 @@
+__all__ = ['newaxis', 'ndarray', 'flatiter', 'ufunc',
+ 'arange', 'array', 'zeros', 'empty', 'broadcast', 'dtype',
+ 'fromstring', 'fromfile', 'frombuffer','newbuffer',
+ 'getbuffer', 'int_asbuffer', 'where', 'argwhere',
+ 'concatenate', 'fastCopyAndTranspose', 'lexsort',
+ 'set_numeric_ops', 'can_cast',
+ 'asarray', 'asanyarray', 'ascontiguousarray', 'asfortranarray',
+ 'isfortran', 'empty_like', 'zeros_like',
+ 'correlate', 'convolve', 'inner', 'dot', 'outer', 'vdot',
+ 'alterdot', 'restoredot', 'roll', 'rollaxis', 'cross', 'tensordot',
+ 'array2string', 'get_printoptions', 'set_printoptions',
+ 'array_repr', 'array_str', 'set_string_function',
+ 'little_endian', 'require',
+ 'fromiter', 'array_equal', 'array_equiv',
+ 'indices', 'fromfunction', 'loadtxt', 'savetxt',
+ 'load', 'loads', 'isscalar', 'binary_repr', 'base_repr',
+ 'ones', 'identity', 'allclose', 'compare_chararrays', 'putmask',
+ 'seterr', 'geterr', 'setbufsize', 'getbufsize',
+ 'seterrcall', 'geterrcall', 'errstate', 'flatnonzero',
+ 'Inf', 'inf', 'infty', 'Infinity',
+ 'nan', 'NaN', 'False_', 'True_', 'bitwise_not',
+ 'CLIP', 'RAISE', 'WRAP', 'MAXDIMS', 'BUFSIZE', 'ALLOW_THREADS']
+
+import sys
+import multiarray
+import umath
+from umath import *
+import numerictypes
+from numerictypes import *
+
+bitwise_not = invert
+
+CLIP = multiarray.CLIP
+WRAP = multiarray.WRAP
+RAISE = multiarray.RAISE
+MAXDIMS = multiarray.MAXDIMS
+ALLOW_THREADS = multiarray.ALLOW_THREADS
+BUFSIZE = multiarray.BUFSIZE
+
+
+# from Fernando Perez's IPython
+def zeros_like(a):
+ """Return an array of zeros of the shape and typecode of a.
+
+ If you don't explicitly need the array to be zeroed, you should instead
+ use empty_like(), which is faster as it only allocates memory."""
+ try:
+ return zeros(a.shape, a.dtype, a.flags.fnc)
+ except AttributeError:
+ try:
+ wrap = a.__array_wrap__
+ except AttributeError:
+ wrap = None
+ a = asarray(a)
+ res = zeros(a.shape, a.dtype)
+ if wrap:
+ res = wrap(res)
+ return res
+
+def empty_like(a):
+ """Return an empty (uninitialized) array of the shape and typecode of a.
+
+ Note that this does NOT initialize the returned array. If you require
+ your array to be initialized, you should use zeros_like().
+
+ """
+ try:
+ return empty(a.shape, a.dtype, a.flags.fnc)
+ except AttributeError:
+ try:
+ wrap = a.__array_wrap__
+ except AttributeError:
+ wrap = None
+ a = asarray(a)
+ res = empty(a.shape, a.dtype)
+ if wrap:
+ res = wrap(res)
+ return res
+
+# end Fernando's utilities
+
+
+def extend_all(module):
+ adict = {}
+ for a in __all__:
+ adict[a] = 1
+ try:
+ mall = getattr(module, '__all__')
+ except AttributeError:
+ mall = [k for k in module.__dict__.keys() if not k.startswith('_')]
+ for a in mall:
+ if a not in adict:
+ __all__.append(a)
+
+extend_all(umath)
+extend_all(numerictypes)
+
+newaxis = None
+
+ndarray = multiarray.ndarray
+flatiter = multiarray.flatiter
+broadcast = multiarray.broadcast
+dtype = multiarray.dtype
+ufunc = type(sin)
+
+arange = multiarray.arange
+array = multiarray.array
+zeros = multiarray.zeros
+empty = multiarray.empty
+fromstring = multiarray.fromstring
+fromiter = multiarray.fromiter
+fromfile = multiarray.fromfile
+frombuffer = multiarray.frombuffer
+newbuffer = multiarray.newbuffer
+getbuffer = multiarray.getbuffer
+int_asbuffer = multiarray.int_asbuffer
+where = multiarray.where
+concatenate = multiarray.concatenate
+fastCopyAndTranspose = multiarray._fastCopyAndTranspose
+set_numeric_ops = multiarray.set_numeric_ops
+can_cast = multiarray.can_cast
+lexsort = multiarray.lexsort
+compare_chararrays = multiarray.compare_chararrays
+putmask = multiarray.putmask
+
+def asarray(a, dtype=None, order=None):
+ """Returns a as an array.
+
+ Unlike array(), no copy is performed if a is already an array. Subclasses
+ are converted to base class ndarray.
+ """
+ return array(a, dtype, copy=False, order=order)
+
+def asanyarray(a, dtype=None, order=None):
+ """Returns a as an array, but will pass subclasses through.
+ """
+ return array(a, dtype, copy=False, order=order, subok=1)
+
+def ascontiguousarray(a, dtype=None):
+ """Return 'a' as an array contiguous in memory (C order).
+ """
+ return array(a, dtype, copy=False, order='C', ndmin=1)
+
+def asfortranarray(a, dtype=None):
+ """Return 'a' as an array laid out in Fortran-order in memory.
+ """
+ return array(a, dtype, copy=False, order='F', ndmin=1)
+
+def require(a, dtype=None, requirements=None):
+ if requirements is None:
+ requirements = []
+ else:
+ requirements = [x.upper() for x in requirements]
+
+ if not requirements:
+ return asanyarray(a, dtype=dtype)
+
+ if 'ENSUREARRAY' in requirements or 'E' in requirements:
+ subok = 0
+ else:
+ subok = 1
+
+ arr = array(a, dtype=dtype, copy=False, subok=subok)
+
+ copychar = 'A'
+ if 'FORTRAN' in requirements or \
+ 'F_CONTIGUOUS' in requirements or \
+ 'F' in requirements:
+ copychar = 'F'
+ elif 'CONTIGUOUS' in requirements or \
+ 'C_CONTIGUOUS' in requirements or \
+ 'C' in requirements:
+ copychar = 'C'
+
+ for prop in requirements:
+ if not arr.flags[prop]:
+ arr = arr.copy(copychar)
+ break
+ return arr
+
+def isfortran(a):
+ """Returns True if 'a' is arranged in Fortran-order in memory with a.ndim > 1
+ """
+ return a.flags.fnc
+
+def argwhere(a):
+ """Return a 2-d array of shape N x a.ndim where each row
+ is a sequence of indices into a. This sequence must be
+ converted to a tuple in order to be used to index into a.
+ """
+ return asarray(a.nonzero()).T
+
+def flatnonzero(a):
+ """Return indicies that are not-zero in flattened version of a
+
+ Equivalent to a.ravel().nonzero()[0]
+ """
+ return a.ravel().nonzero()[0]
+
+_mode_from_name_dict = {'v': 0,
+ 's' : 1,
+ 'f' : 2}
+
+def _mode_from_name(mode):
+ if isinstance(mode, type("")):
+ return _mode_from_name_dict[mode.lower()[0]]
+ return mode
+
+def correlate(a,v,mode='valid'):
+ """Return the discrete, linear correlation of 1-D sequences a and v; mode
+ can be 'valid', 'same', or 'full' to specify the size of the resulting
+ sequence
+ """
+ mode = _mode_from_name(mode)
+ return multiarray.correlate(a,v,mode)
+
+
+def convolve(a,v,mode='full'):
+ """Returns the discrete, linear convolution of 1-D sequences a and v; mode
+ can be 'valid', 'same', or 'full' to specify size of the resulting sequence.
+ """
+ a,v = array(a,ndmin=1),array(v,ndmin=1)
+ if (len(v) > len(a)):
+ a, v = v, a
+ assert len(a) > 0, 'a cannot be empty'
+ assert len(v) > 0, 'v cannot be empty'
+ mode = _mode_from_name(mode)
+ return multiarray.correlate(a,asarray(v)[::-1],mode)
+
+inner = multiarray.inner
+dot = multiarray.dot
+
+def outer(a,b):
+ """Returns the outer product of two vectors.
+
+ result[i,j] = a[i]*b[j] when a and b are vectors.
+ Will accept any arguments that can be made into vectors.
+ """
+ a = asarray(a)
+ b = asarray(b)
+ return a.ravel()[:,newaxis]*b.ravel()[newaxis,:]
+
+def vdot(a, b):
+ """Returns the dot product of 2 vectors (or anything that can be made into
+ a vector).
+
+ Note: this is not the same as `dot`, as it takes the conjugate of its first
+ argument if complex and always returns a scalar."""
+ return dot(asarray(a).ravel().conj(), asarray(b).ravel())
+
+# try to import blas optimized dot if available
+try:
+ # importing this changes the dot function for basic 4 types
+ # to blas-optimized versions.
+ from _dotblas import dot, vdot, inner, alterdot, restoredot
+except ImportError:
+ def alterdot():
+ pass
+ def restoredot():
+ pass
+
+
+def tensordot(a, b, axes=2):
+ """tensordot returns the product for any (ndim >= 1) arrays.
+
+ r_{xxx, yyy} = \sum_k a_{xxx,k} b_{k,yyy} where
+
+ the axes to be summed over are given by the axes argument.
+ the first element of the sequence determines the axis or axes
+ in arr1 to sum over, and the second element in axes argument sequence
+ determines the axis or axes in arr2 to sum over.
+
+ When there is more than one axis to sum over, the corresponding
+ arguments to axes should be sequences of the same length with the first
+ axis to sum over given first in both sequences, the second axis second,
+ and so forth.
+
+ If the axes argument is an integer, N, then the last N dimensions of a
+ and first N dimensions of b are summed over.
+ """
+ try:
+ iter(axes)
+ except:
+ axes_a = range(-axes,0)
+ axes_b = range(0,axes)
+ else:
+ axes_a, axes_b = axes
+ try:
+ na = len(axes_a)
+ axes_a = list(axes_a)
+ except TypeError:
+ axes_a = [axes_a]
+ na = 1
+ try:
+ nb = len(axes_b)
+ axes_b = list(axes_b)
+ except TypeError:
+ axes_b = [axes_b]
+ nb = 1
+
+ a, b = asarray(a), asarray(b)
+ as_ = a.shape
+ nda = len(a.shape)
+ bs = b.shape
+ ndb = len(b.shape)
+ equal = 1
+ if (na != nb): equal = 0
+ else:
+ for k in xrange(na):
+ if as_[axes_a[k]] != bs[axes_b[k]]:
+ equal = 0
+ break
+ if axes_a[k] < 0:
+ axes_a[k] += nda
+ if axes_b[k] < 0:
+ axes_b[k] += ndb
+ if not equal:
+ raise ValueError, "shape-mismatch for sum"
+
+ # Move the axes to sum over to the end of "a"
+ # and to the front of "b"
+ notin = [k for k in range(nda) if k not in axes_a]
+ newaxes_a = notin + axes_a
+ N2 = 1
+ for axis in axes_a:
+ N2 *= as_[axis]
+ newshape_a = (-1, N2)
+ olda = [as_[axis] for axis in notin]
+
+ notin = [k for k in range(ndb) if k not in axes_b]
+ newaxes_b = axes_b + notin
+ N2 = 1
+ for axis in axes_b:
+ N2 *= bs[axis]
+ newshape_b = (N2, -1)
+ oldb = [bs[axis] for axis in notin]
+
+ at = a.transpose(newaxes_a).reshape(newshape_a)
+ bt = b.transpose(newaxes_b).reshape(newshape_b)
+ res = dot(at, bt)
+ return res.reshape(olda + oldb)
+
+def roll(a, shift, axis=None):
+ """Roll the elements in the array by 'shift' positions along
+ the given axis.
+ """
+ a = asanyarray(a)
+ if axis is None:
+ n = a.size
+ reshape=1
+ else:
+ n = a.shape[axis]
+ reshape=0
+ shift %= n
+ indexes = concatenate((arange(n-shift,n),arange(n-shift)))
+ res = a.take(indexes, axis)
+ if reshape:
+ return res.reshape(a.shape)
+ else:
+ return res
+
+def rollaxis(a, axis, start=0):
+ """Return transposed array so that axis is rolled before start.
+
+ if a.shape is (3,4,5,6)
+ rollaxis(a, 3, 1).shape is (3,6,4,5)
+ rollaxis(a, 2, 0).shape is (5,3,4,6)
+ rollaxis(a, 1, 3).shape is (3,5,4,6)
+ rollaxis(a, 1, 4).shape is (3,5,6,4)
+ """
+ n = a.ndim
+ if axis < 0:
+ axis += n
+ if start < 0:
+ start += n
+ msg = 'rollaxis: %s (%d) must be >=0 and < %d'
+ if not (0 <= axis < n):
+ raise ValueError, msg % ('axis', axis, n)
+ if not (0 <= start < n+1):
+ raise ValueError, msg % ('start', start, n+1)
+ if (axis < start): # it's been removed
+ start -= 1
+ if axis==start:
+ return a
+ axes = range(0,n)
+ axes.remove(axis)
+ axes.insert(start, axis)
+ return a.transpose(axes)
+
+# fix hack in scipy which imports this function
+def _move_axis_to_0(a, axis):
+ return rollaxis(a, axis, 0)
+
+def cross(a, b, axisa=-1, axisb=-1, axisc=-1, axis=None):
+ """Return the cross product of two (arrays of) vectors.
+
+ The cross product is performed over the last axis of a and b by default,
+ and can handle axes with dimensions 2 and 3. For a dimension of 2,
+ the z-component of the equivalent three-dimensional cross product is
+ returned.
+ """
+ if axis is not None:
+ axisa,axisb,axisc=(axis,)*3
+ a = asarray(a).swapaxes(axisa, 0)
+ b = asarray(b).swapaxes(axisb, 0)
+ msg = "incompatible dimensions for cross product\n"\
+ "(dimension must be 2 or 3)"
+ if (a.shape[0] not in [2,3]) or (b.shape[0] not in [2,3]):
+ raise ValueError(msg)
+ if a.shape[0] == 2:
+ if (b.shape[0] == 2):
+ cp = a[0]*b[1] - a[1]*b[0]
+ if cp.ndim == 0:
+ return cp
+ else:
+ return cp.swapaxes(0, axisc)
+ else:
+ x = a[1]*b[2]
+ y = -a[0]*b[2]
+ z = a[0]*b[1] - a[1]*b[0]
+ elif a.shape[0] == 3:
+ if (b.shape[0] == 3):
+ x = a[1]*b[2] - a[2]*b[1]
+ y = a[2]*b[0] - a[0]*b[2]
+ z = a[0]*b[1] - a[1]*b[0]
+ else:
+ x = -a[2]*b[1]
+ y = a[2]*b[0]
+ z = a[0]*b[1] - a[1]*b[0]
+ cp = array([x,y,z])
+ if cp.ndim == 1:
+ return cp
+ else:
+ return cp.swapaxes(0,axisc)
+
+
+#Use numarray's printing function
+from arrayprint import array2string, get_printoptions, set_printoptions
+
+_typelessdata = [int_, float_, complex_]
+if issubclass(intc, int):
+ _typelessdata.append(intc)
+
+if issubclass(longlong, int):
+ _typelessdata.append(longlong)
+
+def array_repr(arr, max_line_width=None, precision=None, suppress_small=None):
+ if arr.size > 0 or arr.shape==(0,):
+ lst = array2string(arr, max_line_width, precision, suppress_small,
+ ', ', "array(")
+ else: # show zero-length shape unless it is (0,)
+ lst = "[], shape=%s" % (repr(arr.shape),)
+ typeless = arr.dtype.type in _typelessdata
+
+ if arr.__class__ is not ndarray:
+ cName= arr.__class__.__name__
+ else:
+ cName = "array"
+ if typeless and arr.size:
+ return cName + "(%s)" % lst
+ else:
+ typename=arr.dtype.name
+ lf = ''
+ if issubclass(arr.dtype.type, flexible):
+ if arr.dtype.names:
+ typename = "%s" % str(arr.dtype)
+ else:
+ typename = "'%s'" % str(arr.dtype)
+ lf = '\n'+' '*len("array(")
+ return cName + "(%s, %sdtype=%s)" % (lst, lf, typename)
+
+def array_str(a, max_line_width=None, precision=None, suppress_small=None):
+ return array2string(a, max_line_width, precision, suppress_small, ' ', "", str)
+
+set_string_function = multiarray.set_string_function
+set_string_function(array_str, 0)
+set_string_function(array_repr, 1)
+
+little_endian = (sys.byteorder == 'little')
+
+
+def indices(dimensions, dtype=int):
+ """Returns an array representing a grid of indices with row-only, and
+ column-only variation.
+ """
+ dimensions = tuple(dimensions)
+ N = len(dimensions)
+ if N == 0:
+ return array([],dtype=dtype)
+ res = empty((N,)+dimensions, dtype=dtype)
+ for i, dim in enumerate(dimensions):
+ tmp = arange(dim,dtype=dtype)
+ tmp.shape = (1,)*i + (dim,)+(1,)*(N-i-1)
+ newdim = dimensions[:i] + (1,)+ dimensions[i+1:]
+ val = zeros(newdim, dtype)
+ add(tmp, val, res[i])
+ return res
+
+def fromfunction(function, shape, **kwargs):
+ """Returns an array constructed by calling a function on a tuple of number
+ grids.
+
+ The function should accept as many arguments as the length of shape and
+ work on array inputs. The shape argument is a sequence of numbers
+ indicating the length of the desired output for each axis.
+
+ The function can also accept keyword arguments (except dtype), which will
+ be passed through fromfunction to the function itself. The dtype argument
+ (default float) determines the data-type of the index grid passed to the
+ function.
+ """
+ dtype = kwargs.pop('dtype', float)
+ args = indices(shape, dtype=dtype)
+ return function(*args,**kwargs)
+
+def isscalar(num):
+ """Returns True if the type of num is a scalar type.
+ """
+ if isinstance(num, generic):
+ return True
+ else:
+ return type(num) in ScalarType
+
+_lkup = {
+ '0':'0000',
+ '1':'0001',
+ '2':'0010',
+ '3':'0011',
+ '4':'0100',
+ '5':'0101',
+ '6':'0110',
+ '7':'0111',
+ '8':'1000',
+ '9':'1001',
+ 'a':'1010',
+ 'b':'1011',
+ 'c':'1100',
+ 'd':'1101',
+ 'e':'1110',
+ 'f':'1111',
+ 'A':'1010',
+ 'B':'1011',
+ 'C':'1100',
+ 'D':'1101',
+ 'E':'1110',
+ 'F':'1111',
+ 'L':''}
+
+def binary_repr(num, width=None):
+ """Return the binary representation of the input number as a string.
+
+ This is equivalent to using base_repr with base 2, but about 25x
+ faster.
+
+ For negative numbers, if width is not given, a - sign is added to the
+ front. If width is given, the two's complement of the number is
+ returned, with respect to that width.
+ """
+ sign = ''
+ if num < 0:
+ if width is None:
+ sign = '-'
+ num = -num
+ else:
+ # replace num with its 2-complement
+ num = 2**width + num
+ elif num == 0:
+ return '0'
+ ostr = hex(num)
+ bin = ''.join([_lkup[ch] for ch in ostr[2:]])
+ bin = bin.lstrip('0')
+ if width is not None:
+ bin = bin.zfill(width)
+ return sign + bin
+
+def base_repr (number, base=2, padding=0):
+ """Return the representation of a number in the given base.
+
+ Base can't be larger than 36.
+ """
+ if number < 0:
+ raise ValueError("negative numbers not handled in base_repr")
+ if base > 36:
+ raise ValueError("bases greater than 36 not handled in base_repr")
+
+ chars = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+ import math
+ lnb = math.log(base)
+ res = padding*chars[0]
+ if number == 0:
+ return res + chars[0]
+ exponent = int (math.log (number)/lnb)
+ while(exponent >= 0):
+ term = long(base)**exponent
+ lead_digit = int(number / term)
+ res += chars[lead_digit]
+ number -= term*lead_digit
+ exponent -= 1
+ return res
+
+from cPickle import load, loads
+_cload = load
+_file = file
+
+def load(file):
+ """Wrapper around cPickle.load which accepts either a file-like object or
+ a filename.
+ """
+ if isinstance(file, type("")):
+ file = _file(file,"rb")
+ return _cload(file)
+
+# Adapted from matplotlib
+
+def _getconv(dtype):
+ typ = dtype.type
+ if issubclass(typ, bool_):
+ return lambda x: bool(int(x))
+ if issubclass(typ, integer):
+ return int
+ elif issubclass(typ, floating):
+ return float
+ elif issubclass(typ, complex):
+ return complex
+ else:
+ return str
+
+
+def _string_like(obj):
+ try: obj + ''
+ except (TypeError, ValueError): return 0
+ return 1
+
+def loadtxt(fname, dtype=float, comments='#', delimiter=None, converters=None,
+ skiprows=0, usecols=None, unpack=False):
+ """
+ Load ASCII data from fname into an array and return the array.
+
+ The data must be regular, same number of values in every row
+
+ fname can be a filename or a file handle. Support for gzipped files is
+ automatic, if the filename ends in .gz
+
+ See scipy.loadmat to read and write matfiles.
+
+ Example usage:
+
+ X = loadtxt('test.dat') # data in two columns
+ t = X[:,0]
+ y = X[:,1]
+
+ Alternatively, you can do the same with "unpack"; see below
+
+ X = loadtxt('test.dat') # a matrix of data
+ x = loadtxt('test.dat') # a single column of data
+
+
+ dtype - the data-type of the resulting array. If this is a
+ record data-type, the the resulting array will be 1-d and each row will
+ be interpreted as an element of the array. The number of columns
+ used must match the number of fields in the data-type in this case.
+
+ comments - the character used to indicate the start of a comment
+ in the file
+
+ delimiter is a string-like character used to seperate values in the
+ file. If delimiter is unspecified or none, any whitespace string is
+ a separator.
+
+ converters, if not None, is a dictionary mapping column number to
+ a function that will convert that column to a float. Eg, if
+ column 0 is a date string: converters={0:datestr2num}
+
+ skiprows is the number of rows from the top to skip
+
+ usecols, if not None, is a sequence of integer column indexes to
+ extract where 0 is the first column, eg usecols=(1,4,5) to extract
+ just the 2nd, 5th and 6th columns
+
+ unpack, if True, will transpose the matrix allowing you to unpack
+ into named arguments on the left hand side
+
+ t,y = load('test.dat', unpack=True) # for two column data
+ x,y,z = load('somefile.dat', usecols=(3,5,7), unpack=True)
+
+ """
+
+ if _string_like(fname):
+ if fname.endswith('.gz'):
+ import gzip
+ fh = gzip.open(fname)
+ else:
+ fh = file(fname)
+ elif hasattr(fname, 'seek'):
+ fh = fname
+ else:
+ raise ValueError('fname must be a string or file handle')
+ X = []
+
+ dtype = multiarray.dtype(dtype)
+ defconv = _getconv(dtype)
+ converterseq = None
+ if converters is None:
+ converters = {}
+ if dtype.names is not None:
+ converterseq = [_getconv(dtype.fields[name][0]) \
+ for name in dtype.names]
+
+ for i,line in enumerate(fh):
+ if i<skiprows: continue
+ line = line[:line.find(comments)].strip()
+ if not len(line): continue
+ vals = line.split(delimiter)
+ if converterseq is None:
+ converterseq = [converters.get(j,defconv) \
+ for j in xrange(len(vals))]
+ if usecols is not None:
+ row = [converterseq[j](vals[j]) for j in usecols]
+ else:
+ row = [converterseq[j](val) for j,val in enumerate(vals)]
+ if dtype.names is not None:
+ row = tuple(row)
+ X.append(row)
+
+ X = array(X, dtype)
+ r,c = X.shape
+ if r==1 or c==1:
+ X.shape = max([r,c]),
+ if unpack: return X.T
+ else: return X
+
+
+# adjust so that fmt can change across columns if desired.
+
+def savetxt(fname, X, fmt='%.18e',delimiter=' '):
+ """
+ Save the data in X to file fname using fmt string to convert the
+ data to strings
+
+ fname can be a filename or a file handle. If the filename ends in .gz,
+ the file is automatically saved in compressed gzip format. The load()
+ command understands gzipped files transparently.
+
+ Example usage:
+
+ save('test.out', X) # X is an array
+ save('test1.out', (x,y,z)) # x,y,z equal sized 1D arrays
+ save('test2.out', x) # x is 1D
+ save('test3.out', x, fmt='%1.4e') # use exponential notation
+
+ delimiter is used to separate the fields, eg delimiter ',' for
+ comma-separated values
+ """
+
+ if _string_like(fname):
+ if fname.endswith('.gz'):
+ import gzip
+ fh = gzip.open(fname,'wb')
+ else:
+ fh = file(fname,'w')
+ elif hasattr(fname, 'seek'):
+ fh = fname
+ else:
+ raise ValueError('fname must be a string or file handle')
+
+
+ X = asarray(X)
+ origShape = None
+ if len(X.shape)==1:
+ origShape = X.shape
+ X.shape = len(X), 1
+ for row in X:
+ fh.write(delimiter.join([fmt%val for val in row]) + '\n')
+
+ if origShape is not None:
+ X.shape = origShape
+
+
+
+
+
+
+
+# These are all essentially abbreviations
+# These might wind up in a special abbreviations module
+
+def _maketup(descr, val):
+ dt = dtype(descr)
+ # Place val in all scalar tuples:
+ fields = dt.fields
+ if fields is None:
+ return val
+ else:
+ res = [_maketup(fields[name][0],val) for name in dt.names]
+ return tuple(res)
+
+def ones(shape, dtype=None, order='C'):
+ """Returns an array of the given dimensions which is initialized to all
+ ones.
+ """
+ a = empty(shape, dtype, order)
+ try:
+ a.fill(1)
+ # Above is faster now after addition of fast loops.
+ #a = zeros(shape, dtype, order)
+ #a+=1
+ except TypeError:
+ obj = _maketup(dtype, 1)
+ a.fill(obj)
+ return a
+
+def identity(n, dtype=None):
+ """Returns the identity 2-d array of shape n x n.
+
+ identity(n)[i,j] == 1 for all i == j
+ == 0 for all i != j
+ """
+ a = array([1]+n*[0],dtype=dtype)
+ b = empty((n,n),dtype=dtype)
+
+ # Note that this assignment depends on the convention that since the a
+ # array is shorter than the flattened b array, then the a array will
+ # be repeated until it is the appropriate size. Given a's construction,
+ # this nicely sets the diagonal to all ones.
+ b.flat = a
+ return b
+
+def allclose(a, b, rtol=1.e-5, atol=1.e-8):
+ """Returns True if all components of a and b are equal subject to given
+ tolerances.
+
+ The relative error rtol must be positive and << 1.0
+ The absolute error atol usually comes into play for those elements of b that
+ are very small or zero; it says how small a must be also.
+ """
+ x = array(a, copy=False)
+ y = array(b, copy=False)
+ d1 = less_equal(absolute(x-y), atol + rtol * absolute(y))
+ xinf = isinf(x)
+ yinf = isinf(y)
+ if (not xinf.any() and not yinf.any()):
+ return d1.all()
+ d3 = (x[xinf] == y[yinf])
+ d4 = (~xinf & ~yinf)
+ if d3.size < 2:
+ if d3.size==0:
+ return False
+ return d3
+ if d3.all():
+ return d1[d4].all()
+ else:
+ return False
+
+def array_equal(a1, a2):
+ try:
+ a1, a2 = asarray(a1), asarray(a2)
+ except:
+ return 0
+ if a1.shape != a2.shape:
+ return 0
+ return logical_and.reduce(equal(a1,a2).ravel())
+
+def array_equiv(a1, a2):
+ try:
+ a1, a2 = asarray(a1), asarray(a2)
+ except:
+ return 0
+ try:
+ return logical_and.reduce(equal(a1,a2).ravel())
+ except ValueError:
+ return 0
+
+
+_errdict = {"ignore":ERR_IGNORE,
+ "warn":ERR_WARN,
+ "raise":ERR_RAISE,
+ "call":ERR_CALL,
+ "print":ERR_PRINT,
+ "log":ERR_LOG}
+
+_errdict_rev = {}
+for key in _errdict.keys():
+ _errdict_rev[_errdict[key]] = key
+del key
+
+def seterr(all=None, divide=None, over=None, under=None, invalid=None):
+ """Set how floating-point errors are handled.
+
+ Valid values for each type of error are the strings
+ "ignore", "warn", "raise", and "call". Returns the old settings.
+ If 'all' is specified, values that are not otherwise specified
+ will be set to 'all', otherwise they will retain their old
+ values.
+
+ Note that operations on integer scalar types (such as int16) are
+ handled like floating point, and are affected by these settings.
+
+ Example:
+
+ >>> seterr(over='raise') # doctest: +SKIP
+ {'over': 'ignore', 'divide': 'ignore', 'invalid': 'ignore', 'under': 'ignore'}
+
+ >>> seterr(all='warn', over='raise') # doctest: +SKIP
+ {'over': 'raise', 'divide': 'ignore', 'invalid': 'ignore', 'under': 'ignore'}
+
+ >>> int16(32000) * int16(3) # doctest: +SKIP
+ Traceback (most recent call last):
+ File "<stdin>", line 1, in ?
+ FloatingPointError: overflow encountered in short_scalars
+ >>> seterr(all='ignore') # doctest: +SKIP
+ {'over': 'ignore', 'divide': 'ignore', 'invalid': 'ignore', 'under': 'ignore'}
+
+ """
+
+ pyvals = umath.geterrobj()
+ old = geterr()
+
+ if divide is None: divide = all or old['divide']
+ if over is None: over = all or old['over']
+ if under is None: under = all or old['under']
+ if invalid is None: invalid = all or old['invalid']
+
+ maskvalue = ((_errdict[divide] << SHIFT_DIVIDEBYZERO) +
+ (_errdict[over] << SHIFT_OVERFLOW ) +
+ (_errdict[under] << SHIFT_UNDERFLOW) +
+ (_errdict[invalid] << SHIFT_INVALID))
+
+ pyvals[1] = maskvalue
+ umath.seterrobj(pyvals)
+ return old
+
+
+def geterr():
+ """Get the current way of handling floating-point errors.
+
+ Returns a dictionary with entries "divide", "over", "under", and
+ "invalid", whose values are from the strings
+ "ignore", "print", "log", "warn", "raise", and "call".
+ """
+ maskvalue = umath.geterrobj()[1]
+ mask = 7
+ res = {}
+ val = (maskvalue >> SHIFT_DIVIDEBYZERO) & mask
+ res['divide'] = _errdict_rev[val]
+ val = (maskvalue >> SHIFT_OVERFLOW) & mask
+ res['over'] = _errdict_rev[val]
+ val = (maskvalue >> SHIFT_UNDERFLOW) & mask
+ res['under'] = _errdict_rev[val]
+ val = (maskvalue >> SHIFT_INVALID) & mask
+ res['invalid'] = _errdict_rev[val]
+ return res
+
+def setbufsize(size):
+ """Set the size of the buffer used in ufuncs.
+ """
+ if size > 10e6:
+ raise ValueError, "Buffer size, %s, is too big." % size
+ if size < 5:
+ raise ValueError, "Buffer size, %s, is too small." %size
+ if size % 16 != 0:
+ raise ValueError, "Buffer size, %s, is not a multiple of 16." %size
+
+ pyvals = umath.geterrobj()
+ old = getbufsize()
+ pyvals[0] = size
+ umath.seterrobj(pyvals)
+ return old
+
+def getbufsize():
+ """Return the size of the buffer used in ufuncs.
+ """
+ return umath.geterrobj()[0]
+
+def seterrcall(func):
+ """Set the callback function used when a floating-point error handler
+ is set to 'call' or the object with a write method for use when
+ the floating-point error handler is set to 'log'
+
+ 'func' should be a function that takes two arguments. The first is
+ type of error ("divide", "over", "under", or "invalid"), and the second
+ is the status flag (= divide + 2*over + 4*under + 8*invalid).
+
+ Returns the old handler.
+ """
+ if func is not None and not callable(func):
+ if not hasattr(func, 'write') or not callable(func.write):
+ raise ValueError, "Only callable can be used as callback"
+ pyvals = umath.geterrobj()
+ old = geterrcall()
+ pyvals[2] = func
+ umath.seterrobj(pyvals)
+ return old
+
+def geterrcall():
+ """Return the current callback function used on floating-point errors.
+ """
+ return umath.geterrobj()[2]
+
+class _unspecified(object):
+ pass
+_Unspecified = _unspecified()
+
+class errstate(object):
+ """with errstate(**state): --> operations in following block use given state.
+
+ # Set error handling to known state.
+ >>> _ = seterr(invalid='raise', divide='raise', over='raise', under='ignore')
+
+ |>> a = -arange(3)
+ |>> with errstate(invalid='ignore'):
+ ... print sqrt(a)
+ [ 0. -1.#IND -1.#IND]
+ |>> print sqrt(a.astype(complex))
+ [ 0. +0.00000000e+00j 0. +1.00000000e+00j 0. +1.41421356e+00j]
+ |>> print sqrt(a)
+ Traceback (most recent call last):
+ ...
+ FloatingPointError: invalid encountered in sqrt
+ |>> with errstate(divide='ignore'):
+ ... print a/0
+ [0 0 0]
+ |>> print a/0
+ Traceback (most recent call last):
+ ...
+ FloatingPointError: divide by zero encountered in divide
+
+ """
+ # Note that we don't want to run the above doctests because they will fail
+ # without a from __future__ import with_statement
+ def __init__(self, **kwargs):
+ self.call = kwargs.pop('call',_Unspecified)
+ self.kwargs = kwargs
+ def __enter__(self):
+ self.oldstate = seterr(**self.kwargs)
+ if self.call is not _Unspecified:
+ self.oldcall = seterrcall(self.call)
+ def __exit__(self, *exc_info):
+ seterr(**self.oldstate)
+ if self.call is not _Unspecified:
+ seterrcall(self.oldcall)
+
+def _setdef():
+ defval = [UFUNC_BUFSIZE_DEFAULT, ERR_DEFAULT2, None]
+ umath.seterrobj(defval)
+
+# set the default values
+_setdef()
+
+Inf = inf = infty = Infinity = PINF
+nan = NaN = NAN
+False_ = bool_(False)
+True_ = bool_(True)
+
+import fromnumeric
+from fromnumeric import *
+extend_all(fromnumeric)
diff --git a/numpy/core/numerictypes.py b/numpy/core/numerictypes.py
new file mode 100644
index 000000000..fc18827aa
--- /dev/null
+++ b/numpy/core/numerictypes.py
@@ -0,0 +1,486 @@
+"""numerictypes: Define the numeric type objects
+
+This module is designed so 'from numerictypes import *' is safe.
+Exported symbols include:
+
+ Dictionary with all registered number types (including aliases):
+ typeDict
+
+ Type objects (not all will be available, depends on platform):
+ see variable sctypes for which ones you have
+
+ Bit-width names
+
+ int8 int16 int32 int64 int128
+ uint8 uint16 uint32 uint64 uint128
+ float16 float32 float64 float96 float128 float256
+ complex32 complex64 complex128 complex192 complex256 complex512
+
+ c-based names
+
+ bool_
+
+ object_
+
+ void, str_, unicode_
+
+ byte, ubyte,
+ short, ushort
+ intc, uintc,
+ intp, uintp,
+ int_, uint,
+ longlong, ulonglong,
+
+ single, csingle,
+ float_, complex_,
+ longfloat, clongfloat,
+
+ As part of the type-hierarchy: xx -- is bit-width
+
+ generic
+ bool_
+ number
+ integer
+ signedinteger (intxx)
+ byte
+ short
+ intc
+ intp int0
+ int_
+ longlong
+ unsignedinteger (uintxx)
+ ubyte
+ ushort
+ uintc
+ uintp uint0
+ uint_
+ ulonglong
+ floating (floatxx)
+ single
+ float_ (double)
+ longfloat
+ complexfloating (complexxx)
+ csingle
+ complex_ (cfloat, cdouble)
+ clongfloat
+
+ flexible
+ character
+ str_ (string_)
+ unicode_
+ void
+
+ object_ (not used much)
+
+$Id: numerictypes.py,v 1.17 2005/09/09 22:20:06 teoliphant Exp $
+"""
+
+# we add more at the bottom
+__all__ = ['sctypeDict', 'sctypeNA', 'typeDict', 'typeNA', 'sctypes',
+ 'ScalarType', 'obj2sctype', 'cast', 'nbytes', 'sctype2char',
+ 'maximum_sctype', 'issctype', 'typecodes']
+
+from numpy.core.multiarray import typeinfo, ndarray, array, empty, dtype
+import types as _types
+
+# we don't export these for import *, but we do want them accessible
+# as numerictypes.bool, etc.
+from __builtin__ import bool, int, long, float, complex, object, unicode, str
+
+sctypeDict = {} # Contains all leaf-node scalar types with aliases
+sctypeNA = {} # Contails all leaf-node types -> numarray type equivalences
+allTypes = {} # Collect the types we will add to the module here
+
+def _evalname(name):
+ k = 0
+ for ch in name:
+ if ch in '0123456789':
+ break
+ k += 1
+ try:
+ bits = int(name[k:])
+ except ValueError:
+ bits = 0
+ base = name[:k]
+ return base, bits
+
+def bitname(obj):
+ """Return a bit-width name for a given type object"""
+ name = obj.__name__
+ base = ''
+ char = ''
+ try:
+ if name[-1] == '_':
+ newname = name[:-1]
+ else:
+ newname = name
+ info = typeinfo[newname.upper()]
+ assert(info[-1] == obj) # sanity check
+ bits = info[2]
+
+ except KeyError: # bit-width name
+ base, bits = _evalname(name)
+ char = base[0]
+
+ if name == 'bool_':
+ char = 'b'
+ base = 'bool'
+ elif name=='string_':
+ char = 'S'
+ base = 'string'
+ elif name=='unicode_':
+ char = 'U'
+ base = 'unicode'
+ elif name=='void':
+ char = 'V'
+ base = 'void'
+ elif name=='object_':
+ char = 'O'
+ base = 'object'
+ bits = 0
+
+ bytes = bits / 8
+
+ if char != '' and bytes != 0:
+ char = "%s%d" % (char, bytes)
+
+ return base, bits, char
+
+
+def _add_types():
+ for a in typeinfo.keys():
+ name = a.lower()
+ if isinstance(typeinfo[a], tuple):
+ typeobj = typeinfo[a][-1]
+
+ # define C-name and insert typenum and typechar references also
+ allTypes[name] = typeobj
+ sctypeDict[name] = typeobj
+ sctypeDict[typeinfo[a][0]] = typeobj
+ sctypeDict[typeinfo[a][1]] = typeobj
+
+ else: # generic class
+ allTypes[name] = typeinfo[a]
+_add_types()
+
+def _add_aliases():
+ for a in typeinfo.keys():
+ name = a.lower()
+ if not isinstance(typeinfo[a], tuple):
+ continue
+ typeobj = typeinfo[a][-1]
+ # insert bit-width version for this class (if relevant)
+ base, bit, char = bitname(typeobj)
+ if base[-3:] == 'int' or char[0] in 'ui': continue
+ if base != '':
+ myname = "%s%d" % (base, bit)
+ if (name != 'longdouble' and name != 'clongdouble') or \
+ myname not in allTypes.keys():
+ allTypes[myname] = typeobj
+ sctypeDict[myname] = typeobj
+ if base == 'complex':
+ na_name = '%s%d' % (base.capitalize(), bit/2)
+ elif base == 'bool':
+ na_name = base.capitalize()
+ sctypeDict[na_name] = typeobj
+ else:
+ na_name = "%s%d" % (base.capitalize(), bit)
+ sctypeDict[na_name] = typeobj
+ sctypeNA[na_name] = typeobj
+ sctypeDict[na_name] = typeobj
+ sctypeNA[typeobj] = na_name
+ sctypeNA[typeinfo[a][0]] = na_name
+ if char != '':
+ sctypeDict[char] = typeobj
+ sctypeNA[char] = na_name
+_add_aliases()
+
+# Integers handled so that
+# The int32, int64 types should agree exactly with
+# PyArray_INT32, PyArray_INT64 in C
+# We need to enforce the same checking as is done
+# in arrayobject.h where the order of getting a
+# bit-width match is:
+# long, longlong, int, short, char
+# for int8, int16, int32, int64, int128
+
+def _add_integer_aliases():
+ _ctypes = ['LONG', 'LONGLONG', 'INT', 'SHORT', 'BYTE']
+ for ctype in _ctypes:
+ val = typeinfo[ctype]
+ bits = val[2]
+ charname = 'i%d' % (bits/8,)
+ ucharname = 'u%d' % (bits/8,)
+ intname = 'int%d' % bits
+ UIntname = 'UInt%d' % bits
+ Intname = 'Int%d' % bits
+ uval = typeinfo['U'+ctype]
+ typeobj = val[-1]
+ utypeobj = uval[-1]
+ if intname not in allTypes.keys():
+ uintname = 'uint%d' % bits
+ allTypes[intname] = typeobj
+ allTypes[uintname] = utypeobj
+ sctypeDict[intname] = typeobj
+ sctypeDict[uintname] = utypeobj
+ sctypeDict[Intname] = typeobj
+ sctypeDict[UIntname] = utypeobj
+ sctypeDict[charname] = typeobj
+ sctypeDict[ucharname] = utypeobj
+ sctypeNA[Intname] = typeobj
+ sctypeNA[UIntname] = utypeobj
+ sctypeNA[charname] = typeobj
+ sctypeNA[ucharname] = utypeobj
+ sctypeNA[typeobj] = Intname
+ sctypeNA[utypeobj] = UIntname
+ sctypeNA[val[0]] = Intname
+ sctypeNA[uval[0]] = UIntname
+_add_integer_aliases()
+
+# We use these later
+void = allTypes['void']
+generic = allTypes['generic']
+
+#
+# Rework the Python names (so that float and complex and int are consistent
+# with Python usage)
+#
+def _set_up_aliases():
+ type_pairs = [('complex_', 'cdouble'),
+ ('int0', 'intp'),
+ ('uint0', 'uintp'),
+ ('single', 'float'),
+ ('csingle', 'cfloat'),
+ ('float_', 'double'),
+ ('intc', 'int'),
+ ('uintc', 'uint'),
+ ('int_', 'long'),
+ ('uint', 'ulong'),
+ ('cfloat', 'cdouble'),
+ ('longfloat', 'longdouble'),
+ ('clongfloat', 'clongdouble'),
+ ('bool_', 'bool'),
+ ('unicode_', 'unicode'),
+ ('str_', 'string'),
+ ('string_', 'string'),
+ ('object_', 'object')]
+ for alias, t in type_pairs:
+ allTypes[alias] = allTypes[t]
+ sctypeDict[alias] = sctypeDict[t]
+ # Remove aliases overriding python types and modules
+ for t in ['ulong', 'object', 'unicode', 'int', 'long', 'float',
+ 'complex', 'bool', 'string']:
+ try:
+ del allTypes[t]
+ del sctypeDict[t]
+ except KeyError:
+ pass
+_set_up_aliases()
+
+# Now, construct dictionary to lookup character codes from types
+_sctype2char_dict = {}
+def _construct_char_code_lookup():
+ for name in typeinfo.keys():
+ tup = typeinfo[name]
+ if isinstance(tup, tuple):
+ if tup[0] not in ['p','P']:
+ _sctype2char_dict[tup[-1]] = tup[0]
+_construct_char_code_lookup()
+
+
+sctypes = {'int': [],
+ 'uint':[],
+ 'float':[],
+ 'complex':[],
+ 'others':[bool,object,str,unicode,void]}
+
+def _add_array_type(typename, bits):
+ try:
+ t = allTypes['%s%d' % (typename, bits)]
+ except KeyError:
+ pass
+ else:
+ sctypes[typename].append(t)
+
+def _set_array_types():
+ ibytes = [1, 2, 4, 8, 16, 32, 64]
+ fbytes = [2, 4, 8, 10, 12, 16, 32, 64]
+ for bytes in ibytes:
+ bits = 8*bytes
+ _add_array_type('int', bits)
+ _add_array_type('uint', bits)
+ for bytes in fbytes:
+ bits = 8*bytes
+ _add_array_type('float', bits)
+ _add_array_type('complex', 2*bits)
+ _gi = dtype('p')
+ if _gi.type not in sctypes['int']:
+ indx = 0
+ sz = _gi.itemsize
+ _lst = sctypes['int']
+ while (indx < len(_lst) and sz >= _lst[indx](0).itemsize):
+ indx += 1
+ sctypes['int'].insert(indx, _gi.type)
+ sctypes['uint'].insert(indx, dtype('P').type)
+_set_array_types()
+
+
+genericTypeRank = ['bool', 'int8', 'uint8', 'int16', 'uint16',
+ 'int32', 'uint32', 'int64', 'uint64', 'int128',
+ 'uint128', 'float16',
+ 'float32', 'float64', 'float80', 'float96', 'float128',
+ 'float256',
+ 'complex32', 'complex64', 'complex128', 'complex160',
+ 'complex192', 'complex256', 'complex512', 'object']
+
+def maximum_sctype(t):
+ """returns the sctype of highest precision of the same general kind as 't'"""
+ g = obj2sctype(t)
+ if g is None:
+ return t
+ t = g
+ name = t.__name__
+ base, bits = _evalname(name)
+ if bits == 0:
+ return t
+ else:
+ return sctypes[base][-1]
+
+_python_types = {int : 'int_',
+ float: 'float_',
+ complex: 'complex_',
+ bool: 'bool_',
+ str: 'string_',
+ unicode: 'unicode_',
+ _types.BufferType: 'void',
+ }
+def _python_type(t):
+ """returns the type corresponding to a certain Python type"""
+ if not isinstance(t, _types.TypeType):
+ t = type(t)
+ return allTypes[_python_types.get(t, 'object_')]
+
+def issctype(rep):
+ """Determines whether the given object represents
+ a numeric array type."""
+ if not isinstance(rep, (type, dtype)):
+ return False
+ try:
+ res = obj2sctype(rep)
+ if res and res != object_:
+ return True
+ return False
+ except:
+ return False
+
+def obj2sctype(rep, default=None):
+ try:
+ if issubclass(rep, generic):
+ return rep
+ except TypeError:
+ pass
+ if isinstance(rep, dtype):
+ return rep.type
+ if isinstance(rep, type):
+ return _python_type(rep)
+ if isinstance(rep, ndarray):
+ return rep.dtype.type
+ try:
+ res = dtype(rep)
+ except:
+ return default
+ return res.type
+
+
+# This dictionary allows look up based on any alias for an array data-type
+class _typedict(dict):
+ def __getitem__(self, obj):
+ return dict.__getitem__(self, obj2sctype(obj))
+
+nbytes = _typedict()
+_alignment = _typedict()
+_maxvals = _typedict()
+_minvals = _typedict()
+def _construct_lookups():
+ for name, val in typeinfo.iteritems():
+ if not isinstance(val, tuple):
+ continue
+ obj = val[-1]
+ nbytes[obj] = val[2] / 8
+ _alignment[obj] = val[3]
+ if (len(val) > 5):
+ _maxvals[obj] = val[4]
+ _minvals[obj] = val[5]
+ else:
+ _maxvals[obj] = None
+ _minvals[obj] = None
+
+_construct_lookups()
+
+def sctype2char(sctype):
+ sctype = obj2sctype(sctype)
+ if sctype is None:
+ raise ValueError, "unrecognized type"
+ return _sctype2char_dict[sctype]
+
+# Create dictionary of casting functions that wrap sequences
+# indexed by type or type character
+
+
+cast = _typedict()
+ScalarType = [_types.IntType, _types.FloatType,
+ _types.ComplexType, _types.LongType, _types.BooleanType,
+ _types.StringType, _types.UnicodeType, _types.BufferType]
+ScalarType.extend(_sctype2char_dict.keys())
+ScalarType = tuple(ScalarType)
+for key in _sctype2char_dict.keys():
+ cast[key] = lambda x, k=key : array(x, copy=False).astype(k)
+
+
+_unicodesize = array('u','U1').itemsize
+
+# Create the typestring lookup dictionary
+_typestr = _typedict()
+for key in _sctype2char_dict.keys():
+ if issubclass(key, allTypes['flexible']):
+ _typestr[key] = _sctype2char_dict[key]
+ else:
+ _typestr[key] = empty((1,),key).dtype.str[1:]
+
+# Make sure all typestrings are in sctypeDict
+for key, val in _typestr.items():
+ if val not in sctypeDict:
+ sctypeDict[val] = key
+
+# Add additional strings to the sctypeDict
+
+_toadd = ['int', 'float', 'complex', 'bool', 'object', 'string', ('str', allTypes['string_']),
+ 'unicode', 'object', ('a', allTypes['string_'])]
+
+for name in _toadd:
+ if isinstance(name, tuple):
+ sctypeDict[name[0]] = name[1]
+ else:
+ sctypeDict[name] = allTypes['%s_' % name]
+
+del _toadd, name
+
+# Now add the types we've determined to this module
+for key in allTypes:
+ globals()[key] = allTypes[key]
+ __all__.append(key)
+
+del key
+
+typecodes = {'Character':'S1',
+ 'Integer':'bhilqp',
+ 'UnsignedInteger':'BHILQP',
+ 'Float':'fdg',
+ 'Complex':'FDG',
+ 'AllInteger':'bBhHiIlLqQpP',
+ 'AllFloat':'fdgFDG',
+ 'All':'?bhilqpBHILQPfdgFDGSUVO'}
+
+# backwards compatibility --- deprecated name
+typeDict = sctypeDict
+typeNA = sctypeNA
diff --git a/numpy/core/records.py b/numpy/core/records.py
new file mode 100644
index 000000000..38d6410d1
--- /dev/null
+++ b/numpy/core/records.py
@@ -0,0 +1,589 @@
+# All of the functions allow formats to be a dtype
+__all__ = ['record', 'recarray', 'format_parser']
+
+import numeric as sb
+from defchararray import chararray
+import numerictypes as nt
+import types
+import os
+import sys
+
+ndarray = sb.ndarray
+
+_byteorderconv = {'b':'>',
+ 'l':'<',
+ 'n':'=',
+ 'B':'>',
+ 'L':'<',
+ 'N':'=',
+ 'S':'s',
+ 's':'s',
+ '>':'>',
+ '<':'<',
+ '=':'=',
+ '|':'|',
+ 'I':'|',
+ 'i':'|'}
+
+# formats regular expression
+# allows multidimension spec with a tuple syntax in front
+# of the letter code '(2,3)f4' and ' ( 2 , 3 ) f4 '
+# are equally allowed
+
+numfmt = nt.typeDict
+_typestr = nt._typestr
+
+def find_duplicate(list):
+ """Find duplication in a list, return a list of duplicated elements"""
+ dup = []
+ for i in range(len(list)):
+ if (list[i] in list[i+1:]):
+ if (list[i] not in dup):
+ dup.append(list[i])
+ return dup
+
+class format_parser:
+ def __init__(self, formats, names, titles, aligned=False, byteorder=None):
+ self._parseFormats(formats, aligned)
+ self._setfieldnames(names, titles)
+ self._createdescr(byteorder)
+
+ def _parseFormats(self, formats, aligned=0):
+ """ Parse the field formats """
+
+ if formats is None:
+ raise ValueError, "Need formats argument"
+ if isinstance(formats, list):
+ if len(formats) < 2:
+ formats.append('')
+ formats = ','.join(formats)
+ dtype = sb.dtype(formats, aligned)
+ fields = dtype.fields
+ if fields is None:
+ dtype = sb.dtype([('f1', dtype)], aligned)
+ fields = dtype.fields
+ keys = dtype.names
+ self._f_formats = [fields[key][0] for key in keys]
+ self._offsets = [fields[key][1] for key in keys]
+ self._nfields = len(keys)
+
+ def _setfieldnames(self, names, titles):
+ """convert input field names into a list and assign to the _names
+ attribute """
+
+ if (names):
+ if (type(names) in [types.ListType, types.TupleType]):
+ pass
+ elif (type(names) == types.StringType):
+ names = names.split(',')
+ else:
+ raise NameError, "illegal input names %s" % `names`
+
+ self._names = [n.strip() for n in names[:self._nfields]]
+ else:
+ self._names = []
+
+ # if the names are not specified, they will be assigned as
+ # "f0, f1, f2,..."
+ # if not enough names are specified, they will be assigned as "f[n],
+ # f[n+1],..." etc. where n is the number of specified names..."
+ self._names += ['f%d' % i for i in range(len(self._names),
+ self._nfields)]
+ # check for redundant names
+ _dup = find_duplicate(self._names)
+ if _dup:
+ raise ValueError, "Duplicate field names: %s" % _dup
+
+ if (titles):
+ self._titles = [n.strip() for n in titles[:self._nfields]]
+ else:
+ self._titles = []
+ titles = []
+
+ if (self._nfields > len(titles)):
+ self._titles += [None]*(self._nfields-len(titles))
+
+ def _createdescr(self, byteorder):
+ descr = sb.dtype({'names':self._names,
+ 'formats':self._f_formats,
+ 'offsets':self._offsets,
+ 'titles':self._titles})
+ if (byteorder is not None):
+ byteorder = _byteorderconv[byteorder[0]]
+ descr = descr.newbyteorder(byteorder)
+
+ self._descr = descr
+
+class record(nt.void):
+ def __repr__(self):
+ return self.__str__()
+
+ def __str__(self):
+ return str(self.item())
+
+ def __getattribute__(self, attr):
+ if attr in ['setfield', 'getfield', 'dtype']:
+ return nt.void.__getattribute__(self, attr)
+ try:
+ return nt.void.__getattribute__(self, attr)
+ except AttributeError:
+ pass
+ fielddict = nt.void.__getattribute__(self, 'dtype').fields
+ res = fielddict.get(attr, None)
+ if res:
+ obj = self.getfield(*res[:2])
+ # if it has fields return a recarray,
+ # if it's a string ('SU') return a chararray
+ # otherwise return the object
+ try:
+ dt = obj.dtype
+ except AttributeError:
+ return obj
+ if dt.fields:
+ return obj.view(obj.__class__)
+ if dt.char in 'SU':
+ return obj.view(chararray)
+ return obj
+ else:
+ raise AttributeError, "'record' object has no "\
+ "attribute '%s'" % attr
+
+
+ def __setattr__(self, attr, val):
+ if attr in ['setfield', 'getfield', 'dtype']:
+ raise AttributeError, "Cannot set '%s' attribute" % attr
+ try:
+ return nt.void.__setattr__(self, attr, val)
+ except AttributeError:
+ pass
+ fielddict = nt.void.__getattribute__(self, 'dtype').fields
+ res = fielddict.get(attr, None)
+ if res:
+ return self.setfield(val, *res[:2])
+ else:
+ raise AttributeError, "'record' object has no "\
+ "attribute '%s'" % attr
+
+ def pprint(self):
+ # pretty-print all fields
+ names = self.dtype.names
+ maxlen = max([len(name) for name in names])
+ rows = []
+ fmt = '%% %ds: %%s' %maxlen
+ for name in names:
+ rows.append(fmt%(name, getattr(self, name)))
+ return "\n".join(rows)
+
+# The recarray is almost identical to a standard array (which supports
+# named fields already) The biggest difference is that it can use
+# attribute-lookup to find the fields and it is constructed using
+# a record.
+
+# If byteorder is given it forces a particular byteorder on all
+# the fields (and any subfields)
+
+class recarray(ndarray):
+ def __new__(subtype, shape, dtype=None, buf=None, offset=0, strides=None,
+ formats=None, names=None, titles=None,
+ byteorder=None, aligned=False):
+
+ if dtype is not None:
+ descr = sb.dtype(dtype)
+ else:
+ descr = format_parser(formats, names, titles, aligned, byteorder)._descr
+
+ if buf is None:
+ self = ndarray.__new__(subtype, shape, (record, descr))
+ else:
+ self = ndarray.__new__(subtype, shape, (record, descr),
+ buffer=buf, offset=offset,
+ strides=strides)
+ return self
+
+ def __getattribute__(self, attr):
+ try:
+ return object.__getattribute__(self, attr)
+ except AttributeError: # attr must be a fieldname
+ pass
+ fielddict = ndarray.__getattribute__(self,'dtype').fields
+ try:
+ res = fielddict[attr][:2]
+ except (TypeError, KeyError):
+ raise AttributeError, "record array has no attribute %s" % attr
+ obj = self.getfield(*res)
+ # if it has fields return a recarray, otherwise return
+ # normal array
+ if obj.dtype.fields:
+ return obj
+ if obj.dtype.char in 'SU':
+ return obj.view(chararray)
+ return obj.view(ndarray)
+
+# Save the dictionary
+# If the attr is a field name and not in the saved dictionary
+# Undo any "setting" of the attribute and do a setfield
+# Thus, you can't create attributes on-the-fly that are field names.
+
+ def __setattr__(self, attr, val):
+ newattr = attr not in self.__dict__
+ try:
+ ret = object.__setattr__(self, attr, val)
+ except:
+ fielddict = ndarray.__getattribute__(self,'dtype').fields or {}
+ if attr not in fielddict:
+ exctype, value = sys.exc_info()[:2]
+ raise exctype, value
+ else:
+ fielddict = ndarray.__getattribute__(self,'dtype').fields or {}
+ if attr not in fielddict:
+ return ret
+ if newattr: # We just added this one
+ try: # or this setattr worked on an internal
+ # attribute.
+ object.__delattr__(self, attr)
+ except:
+ return ret
+ try:
+ res = fielddict[attr][:2]
+ except (TypeError,KeyError):
+ raise AttributeError, "record array has no attribute %s" % attr
+ return self.setfield(val, *res)
+
+ def __getitem__(self, indx):
+ obj = ndarray.__getitem__(self, indx)
+ if (isinstance(obj, ndarray) and obj.dtype.isbuiltin):
+ return obj.view(ndarray)
+ return obj
+
+ def field(self, attr, val=None):
+ if isinstance(attr, int):
+ names = ndarray.__getattribute__(self,'dtype').names
+ attr = names[attr]
+
+ fielddict = ndarray.__getattribute__(self,'dtype').fields
+
+ res = fielddict[attr][:2]
+
+ if val is None:
+ obj = self.getfield(*res)
+ if obj.dtype.fields:
+ return obj
+ if obj.dtype.char in 'SU':
+ return obj.view(chararray)
+ return obj.view(ndarray)
+ else:
+ return self.setfield(val, *res)
+
+ def view(self, obj):
+ try:
+ if issubclass(obj, ndarray):
+ return ndarray.view(self, obj)
+ except TypeError:
+ pass
+ dtype = sb.dtype(obj)
+ if dtype.fields is None:
+ return self.__array__().view(dtype)
+ return ndarray.view(self, obj)
+
+def fromarrays(arrayList, dtype=None, shape=None, formats=None,
+ names=None, titles=None, aligned=False, byteorder=None):
+ """ create a record array from a (flat) list of arrays
+
+ >>> x1=N.array([1,2,3,4])
+ >>> x2=N.array(['a','dd','xyz','12'])
+ >>> x3=N.array([1.1,2,3,4])
+ >>> r = fromarrays([x1,x2,x3],names='a,b,c')
+ >>> print r[1]
+ (2, 'dd', 2.0)
+ >>> x1[1]=34
+ >>> r.a
+ array([1, 2, 3, 4])
+ """
+
+ arrayList = [sb.asarray(x) for x in arrayList]
+
+ if shape is None or shape == 0:
+ shape = arrayList[0].shape
+
+ if isinstance(shape, int):
+ shape = (shape,)
+
+ if formats is None and dtype is None:
+ # go through each object in the list to see if it is an ndarray
+ # and determine the formats.
+ formats = ''
+ for obj in arrayList:
+ if not isinstance(obj, ndarray):
+ raise ValueError, "item in the array list must be an ndarray."
+ formats += _typestr[obj.dtype.type]
+ if issubclass(obj.dtype.type, nt.flexible):
+ formats += `obj.itemsize`
+ formats += ','
+ formats = formats[:-1]
+
+ if dtype is not None:
+ descr = sb.dtype(dtype)
+ _names = descr.names
+ else:
+ parsed = format_parser(formats, names, titles, aligned, byteorder)
+ _names = parsed._names
+ descr = parsed._descr
+
+ # Determine shape from data-type.
+ if len(descr) != len(arrayList):
+ raise ValueError, "mismatch between the number of fields "\
+ "and the number of arrays"
+
+ d0 = descr[0].shape
+ nn = len(d0)
+ if nn > 0:
+ shape = shape[:-nn]
+
+ for k, obj in enumerate(arrayList):
+ nn = len(descr[k].shape)
+ testshape = obj.shape[:len(obj.shape)-nn]
+ if testshape != shape:
+ raise ValueError, "array-shape mismatch in array %d" % k
+
+ _array = recarray(shape, descr)
+
+ # populate the record array (makes a copy)
+ for i in range(len(arrayList)):
+ _array[_names[i]] = arrayList[i]
+
+ return _array
+
+# shape must be 1-d if you use list of lists...
+def fromrecords(recList, dtype=None, shape=None, formats=None, names=None,
+ titles=None, aligned=False, byteorder=None):
+ """ create a recarray from a list of records in text form
+
+ The data in the same field can be heterogeneous, they will be promoted
+ to the highest data type. This method is intended for creating
+ smaller record arrays. If used to create large array without formats
+ defined
+
+ r=fromrecords([(2,3.,'abc')]*100000)
+
+ it can be slow.
+
+ If formats is None, then this will auto-detect formats. Use list of
+ tuples rather than list of lists for faster processing.
+
+ >>> r=fromrecords([(456,'dbe',1.2),(2,'de',1.3)],names='col1,col2,col3')
+ >>> print r[0]
+ (456, 'dbe', 1.2)
+ >>> r.col1
+ array([456, 2])
+ >>> r.col2
+ chararray(['dbe', 'de'],
+ dtype='|S3')
+ >>> import cPickle
+ >>> print cPickle.loads(cPickle.dumps(r))
+ [(456, 'dbe', 1.2) (2, 'de', 1.3)]
+ """
+
+ nfields = len(recList[0])
+ if formats is None and dtype is None: # slower
+ obj = sb.array(recList, dtype=object)
+ arrlist = [sb.array(obj[...,i].tolist()) for i in xrange(nfields)]
+ return fromarrays(arrlist, formats=formats, shape=shape, names=names,
+ titles=titles, aligned=aligned, byteorder=byteorder)
+
+ if dtype is not None:
+ descr = sb.dtype(dtype)
+ else:
+ descr = format_parser(formats, names, titles, aligned, byteorder)._descr
+
+ try:
+ retval = sb.array(recList, dtype = descr)
+ except TypeError: # list of lists instead of list of tuples
+ if (shape is None or shape == 0):
+ shape = len(recList)
+ if isinstance(shape, (int, long)):
+ shape = (shape,)
+ if len(shape) > 1:
+ raise ValueError, "Can only deal with 1-d array."
+ _array = recarray(shape, descr)
+ for k in xrange(_array.size):
+ _array[k] = tuple(recList[k])
+ return _array
+ else:
+ if shape is not None and retval.shape != shape:
+ retval.shape = shape
+
+ res = retval.view(recarray)
+
+ res.dtype = sb.dtype((record, res.dtype))
+ return res
+
+
+def fromstring(datastring, dtype=None, shape=None, offset=0, formats=None,
+ names=None, titles=None, aligned=False, byteorder=None):
+ """ create a (read-only) record array from binary data contained in
+ a string"""
+
+
+ if dtype is None and formats is None:
+ raise ValueError, "Must have dtype= or formats="
+
+ if dtype is not None:
+ descr = sb.dtype(dtype)
+ else:
+ descr = format_parser(formats, names, titles, aligned, byteorder)._descr
+
+ itemsize = descr.itemsize
+ if (shape is None or shape == 0 or shape == -1):
+ shape = (len(datastring)-offset) / itemsize
+
+ _array = recarray(shape, descr, buf=datastring, offset=offset)
+ return _array
+
+def get_remaining_size(fd):
+ try:
+ fn = fd.fileno()
+ except AttributeError:
+ return os.path.getsize(fd.name) - fd.tell()
+ st = os.fstat(fn)
+ size = st.st_size - fd.tell()
+ return size
+
+def fromfile(fd, dtype=None, shape=None, offset=0, formats=None,
+ names=None, titles=None, aligned=False, byteorder=None):
+ """Create an array from binary file data
+
+ If file is a string then that file is opened, else it is assumed
+ to be a file object.
+
+ >>> from tempfile import TemporaryFile
+ >>> a = N.empty(10,dtype='f8,i4,a5')
+ >>> a[5] = (0.5,10,'abcde')
+ >>>
+ >>> fd=TemporaryFile()
+ >>> a = a.newbyteorder('<')
+ >>> a.tofile(fd)
+ >>>
+ >>> fd.seek(0)
+ >>> r=fromfile(fd, formats='f8,i4,a5', shape=10, byteorder='<')
+ >>> print r[5]
+ (0.5, 10, 'abcde')
+ >>> r.shape
+ (10,)
+ """
+
+ if (shape is None or shape == 0):
+ shape = (-1,)
+ elif isinstance(shape, (int, long)):
+ shape = (shape,)
+
+ name = 0
+ if isinstance(fd, str):
+ name = 1
+ fd = open(fd, 'rb')
+ if (offset > 0):
+ fd.seek(offset, 1)
+ size = get_remaining_size(fd)
+
+ if dtype is not None:
+ descr = sb.dtype(dtype)
+ else:
+ descr = format_parser(formats, names, titles, aligned, byteorder)._descr
+
+ itemsize = descr.itemsize
+
+ shapeprod = sb.array(shape).prod()
+ shapesize = shapeprod*itemsize
+ if shapesize < 0:
+ shape = list(shape)
+ shape[ shape.index(-1) ] = size / -shapesize
+ shape = tuple(shape)
+ shapeprod = sb.array(shape).prod()
+
+ nbytes = shapeprod*itemsize
+
+ if nbytes > size:
+ raise ValueError(
+ "Not enough bytes left in file for specified shape and type")
+
+ # create the array
+ _array = recarray(shape, descr)
+ nbytesread = fd.readinto(_array.data)
+ if nbytesread != nbytes:
+ raise IOError("Didn't read as many bytes as expected")
+ if name:
+ fd.close()
+
+ return _array
+
+def array(obj, dtype=None, shape=None, offset=0, strides=None, formats=None,
+ names=None, titles=None, aligned=False, byteorder=None, copy=True):
+ """Construct a record array from a wide-variety of objects.
+ """
+
+ if isinstance(obj, (type(None), str, file)) and (formats is None) \
+ and (dtype is None):
+ raise ValueError("Must define formats (or dtype) if object is "\
+ "None, string, or an open file")
+
+ kwds = {}
+ if dtype is not None:
+ dtype = sb.dtype(dtype)
+ elif formats is not None:
+ dtype = format_parser(formats, names, titles,
+ aligned, byteorder)._descr
+ else:
+ kwds = {'formats': formats,
+ 'names' : names,
+ 'titles' : titles,
+ 'aligned' : aligned,
+ 'byteorder' : byteorder
+ }
+
+ if obj is None:
+ if shape is None:
+ raise ValueError("Must define a shape if obj is None")
+ return recarray(shape, dtype, buf=obj, offset=offset, strides=strides)
+ elif isinstance(obj, str):
+ return fromstring(obj, dtype, shape=shape, offset=offset, **kwds)
+
+ elif isinstance(obj, (list, tuple)):
+ if isinstance(obj[0], (tuple, list)):
+ return fromrecords(obj, dtype=dtype, shape=shape, **kwds)
+ else:
+ return fromarrays(obj, dtype=dtype, shape=shape, **kwds)
+
+ elif isinstance(obj, recarray):
+ if dtype is not None and (obj.dtype != dtype):
+ new = obj.view(dtype)
+ else:
+ new = obj
+ if copy:
+ new = new.copy()
+ return new
+
+ elif isinstance(obj, file):
+ return fromfile(obj, dtype=dtype, shape=shape, offset=offset)
+
+ elif isinstance(obj, ndarray):
+ if dtype is not None and (obj.dtype != dtype):
+ new = obj.view(dtype)
+ else:
+ new = obj
+ if copy:
+ new = new.copy()
+ res = new.view(recarray)
+ if issubclass(res.dtype.type, nt.void):
+ res.dtype = sb.dtype((record, res.dtype))
+ return res
+
+ else:
+ interface = getattr(obj, "__array_interface__", None)
+ if interface is None or not isinstance(interface, dict):
+ raise ValueError("Unknown input type")
+ obj = sb.array(obj)
+ if dtype is not None and (obj.dtype != dtype):
+ obj = obj.view(dtype)
+ res = obj.view(recarray)
+ if issubclass(res.dtype.type, nt.void):
+ res.dtype = sb.dtype((record, res.dtype))
+ return res
diff --git a/numpy/core/setup.py b/numpy/core/setup.py
new file mode 100644
index 000000000..bffd5b279
--- /dev/null
+++ b/numpy/core/setup.py
@@ -0,0 +1,334 @@
+import imp
+import os
+import sys
+from os.path import join
+from distutils.dep_util import newer
+
+FUNCTIONS_TO_CHECK = [
+ ('expl', 'HAVE_LONGDOUBLE_FUNCS'),
+ ('expf', 'HAVE_FLOAT_FUNCS'),
+ ('log1p', 'HAVE_LOG1P'),
+ ('expm1', 'HAVE_EXPM1'),
+ ('asinh', 'HAVE_INVERSE_HYPERBOLIC'),
+ ('atanhf', 'HAVE_INVERSE_HYPERBOLIC_FLOAT'),
+ ('atanhl', 'HAVE_INVERSE_HYPERBOLIC_LONGDOUBLE'),
+ ('isnan', 'HAVE_ISNAN'),
+ ('isinf', 'HAVE_ISINF'),
+ ('rint', 'HAVE_RINT'),
+ ]
+
+def configuration(parent_package='',top_path=None):
+ from numpy.distutils.misc_util import Configuration,dot_join
+ from numpy.distutils.system_info import get_info, default_lib_dirs
+
+ config = Configuration('core',parent_package,top_path)
+ local_dir = config.local_path
+ codegen_dir = join(local_dir,'code_generators')
+
+ generate_umath_py = join(codegen_dir,'generate_umath.py')
+ n = dot_join(config.name,'generate_umath')
+ generate_umath = imp.load_module('_'.join(n.split('.')),
+ open(generate_umath_py,'U'),generate_umath_py,
+ ('.py','U',1))
+
+ header_dir = 'include/numpy' # this is relative to config.path_in_package
+
+ def generate_config_h(ext, build_dir):
+ target = join(build_dir,'config.h')
+ if newer(__file__,target):
+ config_cmd = config.get_config_cmd()
+ print 'Generating',target
+ #
+ tc = generate_testcode(target)
+ from distutils import sysconfig
+ python_include = sysconfig.get_python_inc()
+ python_h = join(python_include, 'Python.h')
+ if not os.path.isfile(python_h):
+ raise SystemError,\
+ "Non-existing %s. Perhaps you need to install"\
+ " python-dev|python-devel." % (python_h)
+ result = config_cmd.try_run(tc,include_dirs=[python_include],
+ library_dirs = default_lib_dirs)
+ if not result:
+ raise SystemError,"Failed to test configuration. "\
+ "See previous error messages for more information."
+
+ # Python 2.3 causes a segfault when
+ # trying to re-acquire the thread-state
+ # which is done in error-handling
+ # ufunc code. NPY_ALLOW_C_API and friends
+ # cause the segfault. So, we disable threading
+ # for now.
+ if sys.version[:5] < '2.4.2':
+ nosmp = 1
+ else:
+ # Perhaps a fancier check is in order here.
+ # so that threads are only enabled if there
+ # are actually multiple CPUS? -- but
+ # threaded code can be nice even on a single
+ # CPU so that long-calculating code doesn't
+ # block.
+ try:
+ nosmp = os.environ['NPY_NOSMP']
+ nosmp = 1
+ except KeyError:
+ nosmp = 0
+ if nosmp: moredefs = [('NPY_ALLOW_THREADS', '0')]
+ else: moredefs = []
+ #
+ mathlibs = []
+ tc = testcode_mathlib()
+ mathlibs_choices = [[],['m'],['cpml']]
+ mathlib = os.environ.get('MATHLIB')
+ if mathlib:
+ mathlibs_choices.insert(0,mathlib.split(','))
+ for libs in mathlibs_choices:
+ if config_cmd.try_run(tc,libraries=libs):
+ mathlibs = libs
+ break
+ else:
+ raise EnvironmentError("math library missing; rerun "
+ "setup.py after setting the "
+ "MATHLIB env variable")
+ ext.libraries.extend(mathlibs)
+ moredefs.append(('MATHLIB',','.join(mathlibs)))
+
+ def check_func(func_name):
+ return config_cmd.check_func(func_name,
+ libraries=mathlibs, decl=False,
+ headers=['math.h'])
+
+ for func_name, defsymbol in FUNCTIONS_TO_CHECK:
+ if check_func(func_name):
+ moredefs.append(defsymbol)
+
+ if sys.platform == 'win32':
+ moredefs.append('NPY_NO_SIGNAL')
+
+ if sys.version[:3] < '2.4':
+ if config_cmd.check_func('strtod', decl=False,
+ headers=['stdlib.h']):
+ moredefs.append(('PyOS_ascii_strtod', 'strtod'))
+
+ target_f = open(target,'a')
+ for d in moredefs:
+ if isinstance(d,str):
+ target_f.write('#define %s\n' % (d))
+ else:
+ target_f.write('#define %s %s\n' % (d[0],d[1]))
+ if not nosmp: # default is to use WITH_THREAD
+ target_f.write('#ifdef WITH_THREAD\n#define NPY_ALLOW_THREADS 1\n#else\n#define NPY_ALLOW_THREADS 0\n#endif\n')
+ target_f.close()
+ else:
+ mathlibs = []
+ target_f = open(target)
+ for line in target_f.readlines():
+ s = '#define MATHLIB'
+ if line.startswith(s):
+ value = line[len(s):].strip()
+ if value:
+ mathlibs.extend(value.split(','))
+ target_f.close()
+
+ ext.libraries.extend(mathlibs)
+
+ incl_dir = os.path.dirname(target)
+ if incl_dir not in config.numpy_include_dirs:
+ config.numpy_include_dirs.append(incl_dir)
+
+ config.add_data_files((header_dir,target))
+ return target
+
+ def generate_api_func(module_name):
+ def generate_api(ext, build_dir):
+ script = join(codegen_dir, module_name + '.py')
+ sys.path.insert(0, codegen_dir)
+ try:
+ m = __import__(module_name)
+ print 'executing', script
+ h_file, c_file, doc_file = m.generate_api(build_dir)
+ finally:
+ del sys.path[0]
+ config.add_data_files((header_dir, h_file),
+ (header_dir, doc_file))
+ return (h_file,)
+ return generate_api
+
+ generate_array_api = generate_api_func('generate_array_api')
+ generate_ufunc_api = generate_api_func('generate_ufunc_api')
+
+ def generate_umath_c(ext,build_dir):
+ target = join(build_dir,'__umath_generated.c')
+ script = generate_umath_py
+ if newer(script,target):
+ f = open(target,'w')
+ f.write(generate_umath.make_code(generate_umath.defdict,
+ generate_umath.__file__))
+ f.close()
+ return []
+
+ config.add_data_files('include/numpy/*.h')
+ config.add_include_dirs('src')
+
+ config.numpy_include_dirs.extend(config.paths('include'))
+
+ deps = [join('src','arrayobject.c'),
+ join('src','arraymethods.c'),
+ join('src','scalartypes.inc.src'),
+ join('src','arraytypes.inc.src'),
+ join('src','_signbit.c'),
+ join('src','_isnan.c'),
+ join('src','ucsnarrow.c'),
+ join('include','numpy','*object.h'),
+ 'include/numpy/fenv/fenv.c',
+ 'include/numpy/fenv/fenv.h',
+ join(codegen_dir,'genapi.py'),
+ join(codegen_dir,'*.txt')
+ ]
+
+ # Don't install fenv unless we need them.
+ if sys.platform == 'cygwin':
+ config.add_data_dir('include/numpy/fenv')
+
+ config.add_extension('multiarray',
+ sources = [join('src','multiarraymodule.c'),
+ generate_config_h,
+ generate_array_api,
+ join('src','scalartypes.inc.src'),
+ join('src','arraytypes.inc.src'),
+ join(codegen_dir,'generate_array_api.py'),
+ join('*.py')
+ ],
+ depends = deps,
+ )
+
+ config.add_extension('umath',
+ sources = [generate_config_h,
+ join('src','umathmodule.c.src'),
+ generate_umath_c,
+ generate_ufunc_api,
+ join('src','scalartypes.inc.src'),
+ join('src','arraytypes.inc.src'),
+ ],
+ depends = [join('src','ufuncobject.c'),
+ generate_umath_py,
+ join(codegen_dir,'generate_ufunc_api.py'),
+ ]+deps,
+ )
+
+ config.add_extension('_sort',
+ sources=[join('src','_sortmodule.c.src'),
+ generate_config_h,
+ generate_array_api,
+ ],
+ )
+
+ config.add_extension('scalarmath',
+ sources=[join('src','scalarmathmodule.c.src'),
+ generate_config_h,
+ generate_array_api,
+ generate_ufunc_api],
+ )
+
+ # Configure blasdot
+ blas_info = get_info('blas_opt',0)
+ #blas_info = {}
+ def get_dotblas_sources(ext, build_dir):
+ if blas_info:
+ return ext.depends[:1]
+ return None # no extension module will be built
+
+ config.add_extension('_dotblas',
+ sources = [get_dotblas_sources],
+ depends=[join('blasdot','_dotblas.c'),
+ join('blasdot','cblas.h'),
+ ],
+ include_dirs = ['blasdot'],
+ extra_info = blas_info
+ )
+
+
+ config.add_data_dir('tests')
+ config.make_svn_version_py()
+
+ return config
+
+def testcode_mathlib():
+ return """\
+/* check whether libm is broken */
+#include <math.h>
+int main(int argc, char *argv[])
+{
+ return exp(-720.) > 1.0; /* typically an IEEE denormal */
+}
+"""
+
+import sys
+def generate_testcode(target):
+ if sys.platform == 'win32':
+ target = target.replace('\\','\\\\')
+ testcode = [r'''
+#include <Python.h>
+#include <limits.h>
+#include <stdio.h>
+
+int main(int argc, char **argv)
+{
+
+ FILE *fp;
+
+ fp = fopen("'''+target+'''","w");
+ ''']
+
+ c_size_test = r'''
+#ifndef %(sz)s
+ fprintf(fp,"#define %(sz)s %%d\n", sizeof(%(type)s));
+#else
+ fprintf(fp,"/* #define %(sz)s %%d */\n", %(sz)s);
+#endif
+'''
+ for sz, t in [('SIZEOF_SHORT', 'short'),
+ ('SIZEOF_INT', 'int'),
+ ('SIZEOF_LONG', 'long'),
+ ('SIZEOF_FLOAT', 'float'),
+ ('SIZEOF_DOUBLE', 'double'),
+ ('SIZEOF_LONG_DOUBLE', 'long double'),
+ ('SIZEOF_PY_INTPTR_T', 'Py_intptr_t'),
+ ]:
+ testcode.append(c_size_test % {'sz' : sz, 'type' : t})
+
+ testcode.append('#ifdef PY_LONG_LONG')
+ testcode.append(c_size_test % {'sz' : 'SIZEOF_LONG_LONG',
+ 'type' : 'PY_LONG_LONG'})
+ testcode.append(c_size_test % {'sz' : 'SIZEOF_PY_LONG_LONG',
+ 'type' : 'PY_LONG_LONG'})
+
+
+ testcode.append(r'''
+#else
+ fprintf(fp, "/* PY_LONG_LONG not defined */\n");
+#endif
+#ifndef CHAR_BIT
+ {
+ unsigned char var = 2;
+ int i=0;
+ while (var >= 2) {
+ var = var << 1;
+ i++;
+ }
+ fprintf(fp,"#define CHAR_BIT %d\n", i+1);
+ }
+#else
+ fprintf(fp, "/* #define CHAR_BIT %d */\n", CHAR_BIT);
+#endif
+ fclose(fp);
+ return 0;
+}
+''')
+ testcode = '\n'.join(testcode)
+ return testcode
+
+if __name__=='__main__':
+ from numpy.distutils.core import setup
+ setup(configuration=configuration)
+
diff --git a/numpy/core/src/_isnan.c b/numpy/core/src/_isnan.c
new file mode 100644
index 000000000..3257c4ef2
--- /dev/null
+++ b/numpy/core/src/_isnan.c
@@ -0,0 +1,46 @@
+/* Adapted from cephes */
+
+static int
+isnan(double x)
+{
+ union
+ {
+ double d;
+ unsigned short s[4];
+ unsigned int i[2];
+ } u;
+
+ u.d = x;
+
+#if SIZEOF_INT == 4
+
+#ifdef WORDS_BIGENDIAN /* defined in pyconfig.h */
+ if( ((u.i[0] & 0x7ff00000) == 0x7ff00000)
+ && (((u.i[0] & 0x000fffff) != 0) || (u.i[1] != 0)))
+ return 1;
+#else
+ if( ((u.i[1] & 0x7ff00000) == 0x7ff00000)
+ && (((u.i[1] & 0x000fffff) != 0) || (u.i[0] != 0)))
+ return 1;
+#endif
+
+#else /* SIZEOF_INT != 4 */
+
+#ifdef WORDS_BIGENDIAN
+ if( (u.s[0] & 0x7ff0) == 0x7ff0)
+ {
+ if( ((u.s[0] & 0x000f) | u.s[1] | u.s[2] | u.s[3]) != 0 )
+ return 1;
+ }
+#else
+ if( (u.s[3] & 0x7ff0) == 0x7ff0)
+ {
+ if( ((u.s[3] & 0x000f) | u.s[2] | u.s[1] | u.s[0]) != 0 )
+ return 1;
+ }
+#endif
+
+#endif /* SIZEOF_INT */
+
+ return 0;
+}
diff --git a/numpy/core/src/_signbit.c b/numpy/core/src/_signbit.c
new file mode 100644
index 000000000..48a808ac7
--- /dev/null
+++ b/numpy/core/src/_signbit.c
@@ -0,0 +1,32 @@
+/* Adapted from cephes */
+
+static int
+signbit(double x)
+{
+ union
+ {
+ double d;
+ short s[4];
+ int i[2];
+ } u;
+
+ u.d = x;
+
+#if SIZEOF_INT == 4
+
+#ifdef WORDS_BIGENDIAN /* defined in pyconfig.h */
+ return u.i[0] < 0;
+#else
+ return u.i[1] < 0;
+#endif
+
+#else /* SIZEOF_INT != 4 */
+
+#ifdef WORDS_BIGENDIAN
+ return u.s[0] < 0;
+#else
+ return u.s[3] < 0;
+#endif
+
+#endif /* SIZEOF_INT */
+}
diff --git a/numpy/core/src/_sortmodule.c.src b/numpy/core/src/_sortmodule.c.src
new file mode 100644
index 000000000..4aa5962ee
--- /dev/null
+++ b/numpy/core/src/_sortmodule.c.src
@@ -0,0 +1,472 @@
+/* -*- c -*- */
+
+/* The purpose of this module is to add faster sort functions
+ that are type-specific. This is done by altering the
+ function table for the builtin descriptors.
+
+ These sorting functions are copied almost directly from numarray
+ with a few modifications (complex comparisons compare the imaginary
+ part if the real parts are equal, for example), and the names
+ are changed.
+
+ The original sorting code is due to Charles R. Harris who wrote
+ it for numarray.
+*/
+
+/* Quick sort is usually the fastest, but the worst case scenario can
+ be slower than the merge and heap sorts. The merge sort requires
+ extra memory and so for large arrays may not be useful.
+
+ The merge sort is *stable*, meaning that equal components
+ are unmoved from their entry versions, so it can be used to
+ implement lexigraphic sorting on multiple keys.
+
+ The heap sort is included for completeness.
+*/
+
+
+#include "Python.h"
+#include "numpy/noprefix.h"
+
+#define PYA_QS_STACK 100
+#define SMALL_QUICKSORT 15
+#define SMALL_MERGESORT 20
+#define STDC_LT(a,b) ((a) < (b))
+#define STDC_LE(a,b) ((a) <= (b))
+#define STDC_EQ(a,b) ((a) == (b))
+#define SWAP(a,b) {SWAP_temp = (b); (b)=(a); (a) = SWAP_temp;}
+#define NUMC_LT(p,q) ((((p).real==(q).real) ? ((p).imag < (q).imag): ((p).real < (q).real)))
+#define NUMC_LE(p,q) ((((p).real==(q).real) ? ((p).imag <= (q).imag): ((p).real <= (q).real)))
+#define NUMC_EQ(p,q) (((p).real==(q).real) && ((p).imag == (q).imag))
+
+/**begin repeat
+#TYPE=BOOL,BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE,CFLOAT,CDOUBLE,CLONGDOUBLE#
+#type=Bool,byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong,float,double,longdouble,cfloat,cdouble,clongdouble#
+#lessthan=STDC_LT*14,NUMC_LT*3#
+#lessequal=STDC_LE*14,NUMC_LE*3#
+ **/
+static int
+@TYPE@_quicksort(@type@ *start, intp num, void *unused)
+{
+ @type@ *pl = start;
+ @type@ *pr = start + num - 1;
+ @type@ vp, SWAP_temp;
+ @type@ *stack[PYA_QS_STACK], **sptr = stack, *pm, *pi, *pj, *pt;
+
+ for(;;) {
+ while ((pr - pl) > SMALL_QUICKSORT) {
+ /* quicksort partition */
+ pm = pl + ((pr - pl) >> 1);
+ if (@lessthan@(*pm,*pl)) SWAP(*pm,*pl);
+ if (@lessthan@(*pr,*pm)) SWAP(*pr,*pm);
+ if (@lessthan@(*pm,*pl)) SWAP(*pm,*pl);
+ vp = *pm;
+ pi = pl;
+ pj = pr - 1;
+ SWAP(*pm,*pj);
+ for(;;) {
+ do ++pi; while (@lessthan@(*pi,vp));
+ do --pj; while (@lessthan@(vp,*pj));
+ if (pi >= pj) break;
+ SWAP(*pi,*pj);
+ }
+ SWAP(*pi,*(pr-1));
+ /* push largest partition on stack */
+ if (pi - pl < pr - pi) {
+ *sptr++ = pi + 1;
+ *sptr++ = pr;
+ pr = pi - 1;
+ }else{
+ *sptr++ = pl;
+ *sptr++ = pi - 1;
+ pl = pi + 1;
+ }
+ }
+ /* insertion sort */
+ for(pi = pl + 1; pi <= pr; ++pi) {
+ vp = *pi;
+ for(pj = pi, pt = pi - 1; \
+ pj > pl && @lessthan@(vp, *pt);) {
+ *pj-- = *pt--;
+ }
+ *pj = vp;
+ }
+ if (sptr == stack) break;
+ pr = *(--sptr);
+ pl = *(--sptr);
+ }
+ return 0;
+}
+
+static int
+@TYPE@_aquicksort(@type@ *v, intp* tosort, intp num, void *unused)
+{
+ @type@ vp;
+ intp *pl, *pr, SWAP_temp;
+ intp *stack[PYA_QS_STACK], **sptr=stack, *pm, *pi, *pj, *pt, vi;
+
+ pl = tosort;
+ pr = tosort + num - 1;
+
+ for(;;) {
+ while ((pr - pl) > SMALL_QUICKSORT) {
+ /* quicksort partition */
+ pm = pl + ((pr - pl) >> 1);
+ if (@lessthan@(v[*pm],v[*pl])) SWAP(*pm,*pl);
+ if (@lessthan@(v[*pr],v[*pm])) SWAP(*pr,*pm);
+ if (@lessthan@(v[*pm],v[*pl])) SWAP(*pm,*pl);
+ vp = v[*pm];
+ pi = pl;
+ pj = pr - 1;
+ SWAP(*pm,*pj);
+ for(;;) {
+ do ++pi; while (@lessthan@(v[*pi],vp));
+ do --pj; while (@lessthan@(vp,v[*pj]));
+ if (pi >= pj) break;
+ SWAP(*pi,*pj);
+ }
+ SWAP(*pi,*(pr-1));
+ /* push largest partition on stack */
+ if (pi - pl < pr - pi) {
+ *sptr++ = pi + 1;
+ *sptr++ = pr;
+ pr = pi - 1;
+ }else{
+ *sptr++ = pl;
+ *sptr++ = pi - 1;
+ pl = pi + 1;
+ }
+ }
+ /* insertion sort */
+ for(pi = pl + 1; pi <= pr; ++pi) {
+ vi = *pi;
+ vp = v[vi];
+ for(pj = pi, pt = pi - 1; \
+ pj > pl && @lessthan@(vp, v[*pt]);)
+ {
+ *pj-- = *pt--;
+ }
+ *pj = vi;
+ }
+ if (sptr == stack) break;
+ pr = *(--sptr);
+ pl = *(--sptr);
+ }
+ return 0;
+}
+
+
+static int
+@TYPE@_heapsort(@type@ *start, intp n, void *unused)
+{
+
+ @type@ tmp, *a;
+ intp i,j,l;
+
+ /* The array needs to be offset by one for heapsort indexing */
+ a = start - 1;
+
+ for (l = n>>1; l > 0; --l) {
+ tmp = a[l];
+ for (i = l, j = l<<1; j <= n;) {
+ if (j < n && @lessthan@(a[j], a[j+1]))
+ j += 1;
+ if (@lessthan@(tmp, a[j])) {
+ a[i] = a[j];
+ i = j;
+ j += j;
+ }else
+ break;
+ }
+ a[i] = tmp;
+ }
+
+ for (; n > 1;) {
+ tmp = a[n];
+ a[n] = a[1];
+ n -= 1;
+ for (i = 1, j = 2; j <= n;) {
+ if (j < n && @lessthan@(a[j], a[j+1]))
+ j++;
+ if (@lessthan@(tmp, a[j])) {
+ a[i] = a[j];
+ i = j;
+ j += j;
+ }else
+ break;
+ }
+ a[i] = tmp;
+ }
+ return 0;
+}
+
+static int
+@TYPE@_aheapsort(@type@ *v, intp *tosort, intp n, void *unused)
+{
+ intp *a, i,j,l, tmp;
+ /* The arrays need to be offset by one for heapsort indexing */
+ a = tosort - 1;
+
+ for (l = n>>1; l > 0; --l) {
+ tmp = a[l];
+ for (i = l, j = l<<1; j <= n;) {
+ if (j < n && @lessthan@(v[a[j]], v[a[j+1]]))
+ j += 1;
+ if (@lessthan@(v[tmp], v[a[j]])) {
+ a[i] = a[j];
+ i = j;
+ j += j;
+ }else
+ break;
+ }
+ a[i] = tmp;
+ }
+
+ for (; n > 1;) {
+ tmp = a[n];
+ a[n] = a[1];
+ n -= 1;
+ for (i = 1, j = 2; j <= n;) {
+ if (j < n && @lessthan@(v[a[j]], v[a[j+1]]))
+ j++;
+ if (@lessthan@(v[tmp], v[a[j]])) {
+ a[i] = a[j];
+ i = j;
+ j += j;
+ }else
+ break;
+ }
+ a[i] = tmp;
+ }
+
+ return 0;
+}
+
+static void
+@TYPE@_mergesort0(@type@ *pl, @type@ *pr, @type@ *pw)
+{
+ @type@ vp, *pi, *pj, *pk, *pm;
+
+ if (pr - pl > SMALL_MERGESORT) {
+ /* merge sort */
+ pm = pl + ((pr - pl + 1)>>1);
+ @TYPE@_mergesort0(pl,pm-1,pw);
+ @TYPE@_mergesort0(pm,pr,pw);
+ for(pi = pw, pj = pl; pj < pm; ++pi, ++pj) {
+ *pi = *pj;
+ }
+ for(pk = pw, pm = pl; pk < pi && pj <= pr; ++pm) {
+ if (@lessequal@(*pk,*pj)) {
+ *pm = *pk;
+ ++pk;
+ }else{
+ *pm = *pj;
+ ++pj;
+ }
+ }
+ for(; pk < pi; ++pm, ++pk) {
+ *pm = *pk;
+ }
+ }else{
+ /* insertion sort */
+ for(pi = pl + 1; pi <= pr; ++pi) {
+ vp = *pi;
+ for(pj = pi, pk = pi - 1;\
+ pj > pl && @lessthan@(vp, *pk); --pj, --pk) {
+ *pj = *pk;
+ }
+ *pj = vp;
+ }
+ }
+}
+
+static int
+@TYPE@_mergesort(@type@ *start, intp num, void *unused)
+{
+ @type@ *pl, *pr, *pw;
+
+ pl = start; pr = pl + num - 1;
+ pw = (@type@ *) PyDataMem_NEW(((1+num/2))*sizeof(@type@));
+
+ if (!pw) {
+ PyErr_NoMemory();
+ return -1;
+ }
+
+ @TYPE@_mergesort0(pl, pr, pw);
+ PyDataMem_FREE(pw);
+ return 0;
+}
+
+static void
+@TYPE@_amergesort0(intp *pl, intp *pr, @type@ *v, intp *pw)
+{
+ @type@ vp;
+ intp vi, *pi, *pj, *pk, *pm;
+
+ if (pr - pl > SMALL_MERGESORT) {
+ /* merge sort */
+ pm = pl + ((pr - pl + 1)>>1);
+ @TYPE@_amergesort0(pl,pm-1,v,pw);
+ @TYPE@_amergesort0(pm,pr,v,pw);
+ for(pi = pw, pj = pl; pj < pm; ++pi, ++pj) {
+ *pi = *pj;
+ }
+ for(pk = pw, pm = pl; pk < pi && pj <= pr; ++pm) {
+ if (@lessequal@(v[*pk],v[*pj])) {
+ *pm = *pk;
+ ++pk;
+ }else{
+ *pm = *pj;
+ ++pj;
+ }
+ }
+ for(; pk < pi; ++pm, ++pk) {
+ *pm = *pk;
+ }
+ }else{
+ /* insertion sort */
+ for(pi = pl + 1; pi <= pr; ++pi) {
+ vi = *pi;
+ vp = v[vi];
+ for(pj = pi, pk = pi - 1; \
+ pj > pl && @lessthan@(vp, v[*pk]); --pj, --pk) {
+ *pj = *pk;
+ }
+ *pj = vi;
+ }
+ }
+}
+
+static int
+@TYPE@_amergesort(@type@ *v, intp *tosort, intp num, void *unused)
+{
+ intp *pl, *pr, *pw;
+
+ pl = tosort; pr = pl + num - 1;
+ pw = PyDimMem_NEW((1+num/2));
+
+ if (!pw) {
+ PyErr_NoMemory();
+ return -1;
+ }
+
+ @TYPE@_amergesort0(pl, pr, v, pw);
+ PyDimMem_FREE(pw);
+ return 0;
+}
+/**end repeat**/
+
+/**begin repeat
+#TYPE=STRING,UNICODE#
+#comp=strncmp,PyArray_CompareUCS4#
+#type=char, PyArray_UCS4#
+*/
+static void
+@TYPE@_amergesort0(intp *pl, intp *pr, @type@ *v, intp *pw, int len)
+{
+ @type@ *vp;
+ intp vi, *pi, *pj, *pk, *pm;
+
+ if (pr - pl > SMALL_MERGESORT) {
+ /* merge sort */
+ pm = pl + ((pr - pl + 1)>>1);
+ @TYPE@_amergesort0(pl,pm-1,v,pw,len);
+ @TYPE@_amergesort0(pm,pr,v,pw,len);
+ for(pi = pw, pj = pl; pj < pm; ++pi, ++pj) {
+ *pi = *pj;
+ }
+ for(pk = pw, pm = pl; pk < pi && pj <= pr; ++pm) {
+ if (@comp@(v+(*pk)*len,v+(*pj)*len,len)<=0) {
+ *pm = *pk;
+ ++pk;
+ }else{
+ *pm = *pj;
+ ++pj;
+ }
+ }
+ for(; pk < pi; ++pm, ++pk) {
+ *pm = *pk;
+ }
+ }else{
+ /* insertion sort */
+ for(pi = pl + 1; pi <= pr; ++pi) {
+ vi = *pi;
+ vp = v + vi*len;
+ for(pj = pi, pk = pi - 1; \
+ pj > pl && (@comp@(vp, v+(*pk)*len,len)<=0); \
+ --pj, --pk) {
+ *pj = *pk;
+ }
+ *pj = vi;
+ }
+ }
+}
+
+static int
+@TYPE@_amergesort(@type@ *v, intp *tosort, intp num, PyArrayObject *arr)
+{
+ intp *pl, *pr, *pw;
+ int elsize, chars;
+
+ elsize = arr->descr->elsize;
+
+ chars = elsize / sizeof(@type@);
+
+ pl = tosort; pr = pl + num - 1;
+ pw = PyDimMem_NEW((1+num/2));
+
+ if (!pw) {
+ PyErr_NoMemory();
+ return -1;
+ }
+
+ @TYPE@_amergesort0(pl, pr, v, pw, chars);
+ PyDimMem_FREE(pw);
+ return 0;
+}
+/**end repeat**/
+
+static void
+add_sortfuncs(void)
+{
+ PyArray_Descr *descr;
+
+/**begin repeat
+#TYPE=BOOL,BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE,CFLOAT,CDOUBLE,CLONGDOUBLE#
+**/
+ descr = PyArray_DescrFromType(PyArray_@TYPE@);
+ descr->f->sort[PyArray_QUICKSORT] = \
+ (PyArray_SortFunc *)@TYPE@_quicksort;
+ descr->f->argsort[PyArray_QUICKSORT] = \
+ (PyArray_ArgSortFunc *)@TYPE@_aquicksort;
+ descr->f->sort[PyArray_HEAPSORT] = \
+ (PyArray_SortFunc *)@TYPE@_heapsort;
+ descr->f->argsort[PyArray_HEAPSORT] = \
+ (PyArray_ArgSortFunc *)@TYPE@_aheapsort;
+ descr->f->sort[PyArray_MERGESORT] = \
+ (PyArray_SortFunc *)@TYPE@_mergesort;
+ descr->f->argsort[PyArray_MERGESORT] = \
+ (PyArray_ArgSortFunc *)@TYPE@_amergesort;
+/**end repeat**/
+
+ descr = PyArray_DescrFromType(PyArray_STRING);
+ descr->f->argsort[PyArray_MERGESORT] = \
+ (PyArray_ArgSortFunc *)STRING_amergesort;
+ descr = PyArray_DescrFromType(PyArray_UNICODE);
+ descr->f->argsort[PyArray_MERGESORT] = \
+ (PyArray_ArgSortFunc *)UNICODE_amergesort;
+}
+
+static struct PyMethodDef methods[] = {
+ {NULL, NULL, 0}
+};
+
+PyMODINIT_FUNC
+init_sort(void) {
+
+ Py_InitModule("_sort", methods);
+
+ import_array();
+ add_sortfuncs();
+}
diff --git a/numpy/core/src/arraymethods.c b/numpy/core/src/arraymethods.c
new file mode 100644
index 000000000..3a1b0c37d
--- /dev/null
+++ b/numpy/core/src/arraymethods.c
@@ -0,0 +1,1939 @@
+
+/* Should only be used if x is known to be an nd-array */
+#define _ARET(x) PyArray_Return((PyArrayObject *)(x))
+
+static PyObject *
+array_take(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int dimension=MAX_DIMS;
+ PyObject *indices;
+ PyArrayObject *out=NULL;
+ NPY_CLIPMODE mode=NPY_RAISE;
+ static char *kwlist[] = {"indices", "axis", "out", "mode", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "O|O&O&O&", kwlist,
+ &indices, PyArray_AxisConverter,
+ &dimension,
+ PyArray_OutputConverter,
+ &out,
+ PyArray_ClipmodeConverter,
+ &mode))
+ return NULL;
+
+ return _ARET(PyArray_TakeFrom(self, indices, dimension, out, mode));
+}
+
+static PyObject *
+array_fill(PyArrayObject *self, PyObject *args)
+{
+ PyObject *obj;
+ if (!PyArg_ParseTuple(args, "O", &obj))
+ return NULL;
+ if (PyArray_FillWithScalar(self, obj) < 0) return NULL;
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+static PyObject *
+array_put(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ PyObject *indices, *values;
+ NPY_CLIPMODE mode=NPY_RAISE;
+ static char *kwlist[] = {"indices", "values", "mode", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "OO|O&", kwlist,
+ &indices, &values,
+ PyArray_ClipmodeConverter,
+ &mode))
+ return NULL;
+ return PyArray_PutTo(self, values, indices, mode);
+}
+
+static PyObject *
+array_reshape(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ PyArray_Dims newshape;
+ PyObject *ret;
+ PyArray_ORDER order=PyArray_CORDER;
+ int n;
+
+ if (kwds != NULL) {
+ PyObject *ref;
+ ref = PyDict_GetItemString(kwds, "order");
+ if (ref == NULL) {
+ PyErr_SetString(PyExc_TypeError,
+ "invalid keyword argument");
+ return NULL;
+ }
+ if ((PyArray_OrderConverter(ref, &order) == PY_FAIL))
+ return NULL;
+ }
+
+ n = PyTuple_Size(args);
+ if (n <= 1) {
+ if (PyTuple_GET_ITEM(args, 0) == Py_None)
+ return PyArray_View(self, NULL, NULL);
+ if (!PyArg_ParseTuple(args, "O&", PyArray_IntpConverter,
+ &newshape)) return NULL;
+ }
+ else {
+ if (!PyArray_IntpConverter(args, &newshape)) {
+ if (!PyErr_Occurred()) {
+ PyErr_SetString(PyExc_TypeError,
+ "invalid shape");
+ }
+ goto fail;
+ }
+ }
+ ret = PyArray_Newshape(self, &newshape, order);
+ PyDimMem_FREE(newshape.ptr);
+ return ret;
+
+ fail:
+ PyDimMem_FREE(newshape.ptr);
+ return NULL;
+}
+
+static PyObject *
+array_squeeze(PyArrayObject *self, PyObject *args)
+{
+ if (!PyArg_ParseTuple(args, "")) return NULL;
+ return PyArray_Squeeze(self);
+}
+
+static PyObject *
+array_view(PyArrayObject *self, PyObject *args)
+{
+ PyObject *otype=NULL;
+ PyArray_Descr *type=NULL;
+
+ if (!PyArg_ParseTuple(args, "|O", &otype)) return NULL;
+
+ if (otype) {
+ if (PyType_Check(otype) && \
+ PyType_IsSubtype((PyTypeObject *)otype,
+ &PyArray_Type)) {
+ return PyArray_View(self, NULL,
+ (PyTypeObject *)otype);
+ }
+ else {
+ if (PyArray_DescrConverter(otype, &type) == PY_FAIL)
+ return NULL;
+ }
+ }
+ return PyArray_View(self, type, NULL);
+}
+
+static PyObject *
+array_argmax(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int axis=MAX_DIMS;
+ PyArrayObject *out=NULL;
+ static char *kwlist[] = {"axis", "out", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|O&O&", kwlist,
+ PyArray_AxisConverter,
+ &axis,
+ PyArray_OutputConverter,
+ &out))
+ return NULL;
+
+ return _ARET(PyArray_ArgMax(self, axis, out));
+}
+
+static PyObject *
+array_argmin(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int axis=MAX_DIMS;
+ PyArrayObject *out=NULL;
+ static char *kwlist[] = {"axis", "out", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|O&O&", kwlist,
+ PyArray_AxisConverter,
+ &axis,
+ PyArray_OutputConverter,
+ &out))
+ return NULL;
+
+ return _ARET(PyArray_ArgMin(self, axis, out));
+}
+
+static PyObject *
+array_max(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int axis=MAX_DIMS;
+ PyArrayObject *out=NULL;
+ static char *kwlist[] = {"axis", "out", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|O&O&", kwlist,
+ PyArray_AxisConverter,
+ &axis,
+ PyArray_OutputConverter,
+ &out))
+ return NULL;
+
+ return PyArray_Max(self, axis, out);
+}
+
+static PyObject *
+array_ptp(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int axis=MAX_DIMS;
+ PyArrayObject *out=NULL;
+ static char *kwlist[] = {"axis", "out", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|O&O&", kwlist,
+ PyArray_AxisConverter,
+ &axis,
+ PyArray_OutputConverter,
+ &out))
+ return NULL;
+
+ return PyArray_Ptp(self, axis, out);
+}
+
+
+static PyObject *
+array_min(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int axis=MAX_DIMS;
+ PyArrayObject *out=NULL;
+ static char *kwlist[] = {"axis", "out", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|O&O&", kwlist,
+ PyArray_AxisConverter,
+ &axis,
+ PyArray_OutputConverter,
+ &out))
+ return NULL;
+
+ return PyArray_Min(self, axis, out);
+}
+
+static PyObject *
+array_swapaxes(PyArrayObject *self, PyObject *args)
+{
+ int axis1, axis2;
+
+ if (!PyArg_ParseTuple(args, "ii", &axis1, &axis2)) return NULL;
+
+ return PyArray_SwapAxes(self, axis1, axis2);
+}
+
+
+/* steals typed reference */
+/*OBJECT_API
+ Get a subset of bytes from each element of the array
+*/
+static PyObject *
+PyArray_GetField(PyArrayObject *self, PyArray_Descr *typed, int offset)
+{
+ PyObject *ret=NULL;
+
+ if (offset < 0 || (offset + typed->elsize) > self->descr->elsize) {
+ PyErr_Format(PyExc_ValueError,
+ "Need 0 <= offset <= %d for requested type " \
+ "but received offset = %d",
+ self->descr->elsize-typed->elsize, offset);
+ Py_DECREF(typed);
+ return NULL;
+ }
+ ret = PyArray_NewFromDescr(self->ob_type,
+ typed,
+ self->nd, self->dimensions,
+ self->strides,
+ self->data + offset,
+ self->flags, (PyObject *)self);
+ if (ret == NULL) return NULL;
+ Py_INCREF(self);
+ ((PyArrayObject *)ret)->base = (PyObject *)self;
+
+ PyArray_UpdateFlags((PyArrayObject *)ret, UPDATE_ALL);
+ return ret;
+}
+
+static PyObject *
+array_getfield(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+
+ PyArray_Descr *dtype;
+ int offset = 0;
+ static char *kwlist[] = {"dtype", "offset", 0};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "O&|i", kwlist,
+ PyArray_DescrConverter,
+ &dtype, &offset)) return NULL;
+
+ return PyArray_GetField(self, dtype, offset);
+}
+
+
+/*OBJECT_API
+ Set a subset of bytes from each element of the array
+*/
+static int
+PyArray_SetField(PyArrayObject *self, PyArray_Descr *dtype,
+ int offset, PyObject *val)
+{
+ PyObject *ret=NULL;
+ int retval = 0;
+
+ if (offset < 0 || (offset + dtype->elsize) > self->descr->elsize) {
+ PyErr_Format(PyExc_ValueError,
+ "Need 0 <= offset <= %d for requested type " \
+ "but received offset = %d",
+ self->descr->elsize-dtype->elsize, offset);
+ Py_DECREF(dtype);
+ return -1;
+ }
+ ret = PyArray_NewFromDescr(self->ob_type,
+ dtype, self->nd, self->dimensions,
+ self->strides, self->data + offset,
+ self->flags, (PyObject *)self);
+ if (ret == NULL) return -1;
+ Py_INCREF(self);
+ ((PyArrayObject *)ret)->base = (PyObject *)self;
+
+ PyArray_UpdateFlags((PyArrayObject *)ret, UPDATE_ALL);
+ retval = PyArray_CopyObject((PyArrayObject *)ret, val);
+ Py_DECREF(ret);
+ return retval;
+}
+
+static PyObject *
+array_setfield(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ PyArray_Descr *dtype;
+ int offset = 0;
+ PyObject *value;
+ static char *kwlist[] = {"value", "dtype", "offset", 0};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "OO&|i", kwlist,
+ &value, PyArray_DescrConverter,
+ &dtype, &offset)) return NULL;
+
+ if (PyArray_SetField(self, dtype, offset, value) < 0)
+ return NULL;
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+/* This doesn't change the descriptor just the actual data...
+ */
+
+/*OBJECT_API*/
+static PyObject *
+PyArray_Byteswap(PyArrayObject *self, Bool inplace)
+{
+ PyArrayObject *ret;
+ intp size;
+ PyArray_CopySwapNFunc *copyswapn;
+ PyArrayIterObject *it;
+
+ copyswapn = self->descr->f->copyswapn;
+ if (inplace) {
+ if (!PyArray_ISWRITEABLE(self)) {
+ PyErr_SetString(PyExc_RuntimeError,
+ "Cannot byte-swap in-place on a " \
+ "read-only array");
+ return NULL;
+ }
+ size = PyArray_SIZE(self);
+ if (PyArray_ISONESEGMENT(self)) {
+ copyswapn(self->data, self->descr->elsize, NULL, -1, size, 1, self);
+ }
+ else { /* Use iterator */
+ int axis = -1;
+ intp stride;
+ it = (PyArrayIterObject *) \
+ PyArray_IterAllButAxis((PyObject *)self, &axis);
+ stride = self->strides[axis];
+ size = self->dimensions[axis];
+ while (it->index < it->size) {
+ copyswapn(it->dataptr, stride, NULL, -1, size, 1, self);
+ PyArray_ITER_NEXT(it);
+ }
+ Py_DECREF(it);
+ }
+
+ Py_INCREF(self);
+ return (PyObject *)self;
+ }
+ else {
+ PyObject *new;
+ if ((ret = (PyArrayObject *)PyArray_NewCopy(self,-1)) == NULL)
+ return NULL;
+ new = PyArray_Byteswap(ret, TRUE);
+ Py_DECREF(new);
+ return (PyObject *)ret;
+ }
+}
+
+
+static PyObject *
+array_byteswap(PyArrayObject *self, PyObject *args)
+{
+ Bool inplace=FALSE;
+
+ if (!PyArg_ParseTuple(args, "|O&", PyArray_BoolConverter, &inplace))
+ return NULL;
+
+ return PyArray_Byteswap(self, inplace);
+}
+
+static PyObject *
+array_tolist(PyArrayObject *self, PyObject *args)
+{
+ if (!PyArg_ParseTuple(args, "")) return NULL;
+ return PyArray_ToList(self);
+}
+
+
+static PyObject *
+array_tostring(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ NPY_ORDER order=NPY_CORDER;
+ static char *kwlist[] = {"order", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|O&", kwlist,
+ PyArray_OrderConverter,
+ &order)) return NULL;
+ return PyArray_ToString(self, order);
+}
+
+
+/* This should grow an order= keyword to be consistent
+ */
+
+static PyObject *
+array_tofile(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int ret;
+ PyObject *file;
+ FILE *fd;
+ char *sep="";
+ char *format="";
+ static char *kwlist[] = {"file", "sep", "format", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "O|ss", kwlist,
+ &file, &sep, &format)) return NULL;
+
+ if (PyString_Check(file) || PyUnicode_Check(file)) {
+ file = PyObject_CallFunction((PyObject *)&PyFile_Type,
+ "Os", file, "wb");
+ if (file==NULL) return NULL;
+ }
+ else {
+ Py_INCREF(file);
+ }
+ fd = PyFile_AsFile(file);
+ if (fd == NULL) {
+ PyErr_SetString(PyExc_IOError, "first argument must be a " \
+ "string or open file");
+ Py_DECREF(file);
+ return NULL;
+ }
+ ret = PyArray_ToFile(self, fd, sep, format);
+ Py_DECREF(file);
+ if (ret < 0) return NULL;
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+static PyObject *
+array_toscalar(PyArrayObject *self, PyObject *args) {
+ int n, nd;
+ n = PyTuple_GET_SIZE(args);
+
+ if (n==1) {
+ PyObject *obj;
+ obj = PyTuple_GET_ITEM(args, 0);
+ if (PyTuple_Check(obj)) {
+ args = obj;
+ n = PyTuple_GET_SIZE(args);
+ }
+ }
+
+ if (n==0) {
+ if (self->nd == 0 || PyArray_SIZE(self) == 1)
+ return self->descr->f->getitem(self->data, self);
+ else {
+ PyErr_SetString(PyExc_ValueError,
+ "can only convert an array " \
+ " of size 1 to a Python scalar");
+ return NULL;
+ }
+ }
+ else if (n != self->nd && (n > 1 || self->nd==0)) {
+ PyErr_SetString(PyExc_ValueError,
+ "incorrect number of indices for " \
+ "array");
+ return NULL;
+ }
+ else if (n==1) { /* allows for flat getting as well as 1-d case */
+ intp value, loc, index, factor;
+ intp factors[MAX_DIMS];
+ value = PyArray_PyIntAsIntp(PyTuple_GET_ITEM(args, 0));
+ if (error_converting(value)) {
+ PyErr_SetString(PyExc_ValueError, "invalid integer");
+ return NULL;
+ }
+ factor = PyArray_SIZE(self);
+ if (value < 0) value += factor;
+ if ((value >= factor) || (value < 0)) {
+ PyErr_SetString(PyExc_ValueError,
+ "index out of bounds");
+ return NULL;
+ }
+ if (self->nd == 1) {
+ value *= self->strides[0];
+ return self->descr->f->getitem(self->data + value,
+ self);
+ }
+ nd = self->nd;
+ factor = 1;
+ while (nd--) {
+ factors[nd] = factor;
+ factor *= self->dimensions[nd];
+ }
+ loc = 0;
+ for (nd=0; nd < self->nd; nd++) {
+ index = value / factors[nd];
+ value = value % factors[nd];
+ loc += self->strides[nd]*index;
+ }
+
+ return self->descr->f->getitem(self->data + loc,
+ self);
+
+ }
+ else {
+ intp loc, index[MAX_DIMS];
+ nd = PyArray_IntpFromSequence(args, index, MAX_DIMS);
+ if (nd < n) return NULL;
+ loc = 0;
+ while (nd--) {
+ if (index[nd] < 0)
+ index[nd] += self->dimensions[nd];
+ if (index[nd] < 0 ||
+ index[nd] >= self->dimensions[nd]) {
+ PyErr_SetString(PyExc_ValueError,
+ "index out of bounds");
+ return NULL;
+ }
+ loc += self->strides[nd]*index[nd];
+ }
+ return self->descr->f->getitem(self->data + loc, self);
+ }
+}
+
+static PyObject *
+array_setscalar(PyArrayObject *self, PyObject *args) {
+ int n, nd;
+ int ret = -1;
+ PyObject *obj;
+ n = PyTuple_GET_SIZE(args)-1;
+
+ if (n < 0) {
+ PyErr_SetString(PyExc_ValueError,
+ "itemset must have at least one argument");
+ return NULL;
+ }
+ obj = PyTuple_GET_ITEM(args, n);
+ if (n==0) {
+ if (self->nd == 0 || PyArray_SIZE(self) == 1) {
+ ret = self->descr->f->setitem(obj, self->data, self);
+ }
+ else {
+ PyErr_SetString(PyExc_ValueError,
+ "can only place a scalar for an "
+ " array of size 1");
+ return NULL;
+ }
+ }
+ else if (n != self->nd && (n > 1 || self->nd==0)) {
+ PyErr_SetString(PyExc_ValueError,
+ "incorrect number of indices for " \
+ "array");
+ return NULL;
+ }
+ else if (n==1) { /* allows for flat setting as well as 1-d case */
+ intp value, loc, index, factor;
+ intp factors[MAX_DIMS];
+ PyObject *indobj;
+
+ indobj = PyTuple_GET_ITEM(args, 0);
+ if (PyTuple_Check(indobj)) {
+ PyObject *res;
+ PyObject *newargs;
+ PyObject *tmp;
+ int i, nn;
+ nn = PyTuple_GET_SIZE(indobj);
+ newargs = PyTuple_New(nn+1);
+ Py_INCREF(obj);
+ for (i=0; i<nn; i++) {
+ tmp = PyTuple_GET_ITEM(indobj, i);
+ Py_INCREF(tmp);
+ PyTuple_SET_ITEM(newargs, i, tmp);
+ }
+ PyTuple_SET_ITEM(newargs, nn, obj);
+ /* Call with a converted set of arguments */
+ res = array_setscalar(self, newargs);
+ Py_DECREF(newargs);
+ return res;
+ }
+ value = PyArray_PyIntAsIntp(indobj);
+ if (error_converting(value)) {
+ PyErr_SetString(PyExc_ValueError, "invalid integer");
+ return NULL;
+ }
+ if (value >= PyArray_SIZE(self)) {
+ PyErr_SetString(PyExc_ValueError,
+ "index out of bounds");
+ return NULL;
+ }
+ if (self->nd == 1) {
+ value *= self->strides[0];
+ ret = self->descr->f->setitem(obj, self->data + value,
+ self);
+ goto finish;
+ }
+ nd = self->nd;
+ factor = 1;
+ while (nd--) {
+ factors[nd] = factor;
+ factor *= self->dimensions[nd];
+ }
+ loc = 0;
+ for (nd=0; nd < self->nd; nd++) {
+ index = value / factors[nd];
+ value = value % factors[nd];
+ loc += self->strides[nd]*index;
+ }
+
+ ret = self->descr->f->setitem(obj, self->data + loc, self);
+ }
+ else {
+ intp loc, index[MAX_DIMS];
+ PyObject *tupargs;
+ tupargs = PyTuple_GetSlice(args, 0, n);
+ nd = PyArray_IntpFromSequence(tupargs, index, MAX_DIMS);
+ Py_DECREF(tupargs);
+ if (nd < n) return NULL;
+ loc = 0;
+ while (nd--) {
+ if (index[nd] < 0)
+ index[nd] += self->dimensions[nd];
+ if (index[nd] < 0 ||
+ index[nd] >= self->dimensions[nd]) {
+ PyErr_SetString(PyExc_ValueError,
+ "index out of bounds");
+ return NULL;
+ }
+ loc += self->strides[nd]*index[nd];
+ }
+ ret = self->descr->f->setitem(obj, self->data + loc, self);
+ }
+
+ finish:
+ if (ret < 0) return NULL;
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+static PyObject *
+array_cast(PyArrayObject *self, PyObject *args)
+{
+ PyArray_Descr *descr=NULL;
+ PyObject *obj;
+
+ if (!PyArg_ParseTuple(args, "O&", PyArray_DescrConverter,
+ &descr)) return NULL;
+
+ if (descr == self->descr) {
+ obj = _ARET(PyArray_NewCopy(self,NPY_ANYORDER));
+ Py_XDECREF(descr);
+ return obj;
+ }
+ if (descr->names != NULL) {
+ int flags;
+ flags = NPY_FORCECAST;
+ if (PyArray_ISFORTRAN(self)) {
+ flags |= NPY_FORTRAN;
+ }
+ return PyArray_FromArray(self, descr, flags);
+ }
+ return PyArray_CastToType(self, descr, PyArray_ISFORTRAN(self));
+}
+
+/* default sub-type implementation */
+
+
+static PyObject *
+array_wraparray(PyArrayObject *self, PyObject *args)
+{
+ PyObject *arr;
+ PyObject *ret;
+
+ if (PyTuple_Size(args) < 1) {
+ PyErr_SetString(PyExc_TypeError,
+ "only accepts 1 argument");
+ return NULL;
+ }
+ arr = PyTuple_GET_ITEM(args, 0);
+ if (!PyArray_Check(arr)) {
+ PyErr_SetString(PyExc_TypeError,
+ "can only be called with ndarray object");
+ return NULL;
+ }
+
+ Py_INCREF(PyArray_DESCR(arr));
+ ret = PyArray_NewFromDescr(self->ob_type,
+ PyArray_DESCR(arr),
+ PyArray_NDIM(arr),
+ PyArray_DIMS(arr),
+ PyArray_STRIDES(arr), PyArray_DATA(arr),
+ PyArray_FLAGS(arr), (PyObject *)self);
+ if (ret == NULL) return NULL;
+ Py_INCREF(arr);
+ PyArray_BASE(ret) = arr;
+ return ret;
+}
+
+
+static PyObject *
+array_getarray(PyArrayObject *self, PyObject *args)
+{
+ PyArray_Descr *newtype=NULL;
+ PyObject *ret;
+
+ if (!PyArg_ParseTuple(args, "|O&", PyArray_DescrConverter,
+ &newtype)) return NULL;
+
+ /* convert to PyArray_Type */
+ if (!PyArray_CheckExact(self)) {
+ PyObject *new;
+ PyTypeObject *subtype = &PyArray_Type;
+
+ if (!PyType_IsSubtype(self->ob_type, &PyArray_Type)) {
+ subtype = &PyArray_Type;
+ }
+
+ Py_INCREF(PyArray_DESCR(self));
+ new = PyArray_NewFromDescr(subtype,
+ PyArray_DESCR(self),
+ PyArray_NDIM(self),
+ PyArray_DIMS(self),
+ PyArray_STRIDES(self),
+ PyArray_DATA(self),
+ PyArray_FLAGS(self), NULL);
+ if (new == NULL) return NULL;
+ Py_INCREF(self);
+ PyArray_BASE(new) = (PyObject *)self;
+ self = (PyArrayObject *)new;
+ }
+ else {
+ Py_INCREF(self);
+ }
+
+ if ((newtype == NULL) || \
+ PyArray_EquivTypes(self->descr, newtype)) {
+ return (PyObject *)self;
+ }
+ else {
+ ret = PyArray_CastToType(self, newtype, 0);
+ Py_DECREF(self);
+ return ret;
+ }
+}
+
+
+static PyObject *
+array_copy(PyArrayObject *self, PyObject *args)
+{
+ PyArray_ORDER fortran=PyArray_CORDER;
+ if (!PyArg_ParseTuple(args, "|O&", PyArray_OrderConverter,
+ &fortran)) return NULL;
+
+ return PyArray_NewCopy(self, fortran);
+}
+
+
+static PyObject *
+array_resize(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ PyArray_Dims newshape;
+ PyObject *ret;
+ int n;
+ int refcheck = 1;
+ PyArray_ORDER fortran=PyArray_ANYORDER;
+
+ if (kwds != NULL) {
+ PyObject *ref;
+ ref = PyDict_GetItemString(kwds, "refcheck");
+ if (ref) {
+ refcheck = PyInt_AsLong(ref);
+ if (refcheck==-1 && PyErr_Occurred()) {
+ return NULL;
+ }
+ }
+ ref = PyDict_GetItemString(kwds, "order");
+ if (ref != NULL ||
+ (PyArray_OrderConverter(ref, &fortran) == PY_FAIL))
+ return NULL;
+ }
+ n = PyTuple_Size(args);
+ if (n <= 1) {
+ if (PyTuple_GET_ITEM(args, 0) == Py_None) {
+ Py_INCREF(Py_None);
+ return Py_None;
+ }
+ if (!PyArg_ParseTuple(args, "O&", PyArray_IntpConverter,
+ &newshape)) return NULL;
+ }
+ else {
+ if (!PyArray_IntpConverter(args, &newshape)) {
+ if (!PyErr_Occurred()) {
+ PyErr_SetString(PyExc_TypeError,
+ "invalid shape");
+ }
+ return NULL;
+ }
+ }
+ ret = PyArray_Resize(self, &newshape, refcheck, fortran);
+ PyDimMem_FREE(newshape.ptr);
+ if (ret == NULL) return NULL;
+ Py_DECREF(ret);
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+static PyObject *
+array_repeat(PyArrayObject *self, PyObject *args, PyObject *kwds) {
+ PyObject *repeats;
+ int axis=MAX_DIMS;
+ static char *kwlist[] = {"repeats", "axis", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "O|O&", kwlist,
+ &repeats, PyArray_AxisConverter,
+ &axis)) return NULL;
+
+ return _ARET(PyArray_Repeat(self, repeats, axis));
+}
+
+static PyObject *
+array_choose(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ PyObject *choices;
+ int n;
+ PyArrayObject *out=NULL;
+ NPY_CLIPMODE clipmode=NPY_RAISE;
+
+ n = PyTuple_Size(args);
+ if (n <= 1) {
+ if (!PyArg_ParseTuple(args, "O", &choices))
+ return NULL;
+ }
+ else {
+ choices = args;
+ }
+ if (kwds && PyDict_Check(kwds)) {
+ if (PyArray_OutputConverter(PyDict_GetItemString(kwds,
+ "out"),
+ &out) == PY_FAIL)
+ return NULL;
+ if (PyArray_ClipmodeConverter(PyDict_GetItemString(kwds,
+ "mode"),
+ &clipmode) == PY_FAIL)
+ return NULL;
+ }
+
+ return _ARET(PyArray_Choose(self, choices, out, clipmode));
+}
+
+static PyObject *
+array_sort(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int axis=-1;
+ int val;
+ PyArray_SORTKIND which=PyArray_QUICKSORT;
+ PyObject *order=NULL;
+ PyArray_Descr *saved=NULL;
+ PyArray_Descr *newd;
+ static char *kwlist[] = {"axis", "kind", "order", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|iO&O", kwlist, &axis,
+ PyArray_SortkindConverter, &which,
+ &order))
+ return NULL;
+
+ if (order == Py_None) order = NULL;
+ if (order != NULL) {
+ PyObject *new_name;
+ PyObject *_numpy_internal;
+ saved = self->descr;
+ if (saved->names == NULL) {
+ PyErr_SetString(PyExc_ValueError, "Cannot specify " \
+ "order when the array has no fields.");
+ return NULL;
+ }
+ _numpy_internal = PyImport_ImportModule("numpy.core._internal");
+ if (_numpy_internal == NULL) return NULL;
+ new_name = PyObject_CallMethod(_numpy_internal, "_newnames",
+ "OO", saved, order);
+ Py_DECREF(_numpy_internal);
+ if (new_name == NULL) return NULL;
+ newd = PyArray_DescrNew(saved);
+ newd->names = new_name;
+ self->descr = newd;
+ }
+
+ val = PyArray_Sort(self, axis, which);
+ if (order != NULL) {
+ Py_XDECREF(self->descr);
+ self->descr = saved;
+ }
+ if (val < 0) return NULL;
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+static PyObject *
+array_argsort(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int axis=-1;
+ PyArray_SORTKIND which=PyArray_QUICKSORT;
+ PyObject *order=NULL, *res;
+ PyArray_Descr *newd, *saved=NULL;
+ static char *kwlist[] = {"axis", "kind", "order", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|O&O&O", kwlist,
+ PyArray_AxisConverter, &axis,
+ PyArray_SortkindConverter, &which,
+ &order))
+ return NULL;
+
+ if (order == Py_None) order = NULL;
+ if (order != NULL) {
+ PyObject *new_name;
+ PyObject *_numpy_internal;
+ saved = self->descr;
+ if (saved->names == NULL) {
+ PyErr_SetString(PyExc_ValueError, "Cannot specify " \
+ "order when the array has no fields.");
+ return NULL;
+ }
+ _numpy_internal = PyImport_ImportModule("numpy.core._internal");
+ if (_numpy_internal == NULL) return NULL;
+ new_name = PyObject_CallMethod(_numpy_internal, "_newnames",
+ "OO", saved, order);
+ Py_DECREF(_numpy_internal);
+ if (new_name == NULL) return NULL;
+ newd = PyArray_DescrNew(saved);
+ newd->names = new_name;
+ self->descr = newd;
+ }
+
+ res = PyArray_ArgSort(self, axis, which);
+ if (order != NULL) {
+ Py_XDECREF(self->descr);
+ self->descr = saved;
+ }
+ return _ARET(res);
+}
+
+static PyObject *
+array_searchsorted(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ static char *kwlist[] = {"keys", "side", NULL};
+ PyObject *keys;
+ NPY_SEARCHSIDE side = NPY_SEARCHLEFT;
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "O|O&:searchsorted",
+ kwlist, &keys,
+ PyArray_SearchsideConverter, &side))
+ return NULL;
+
+ return _ARET(PyArray_SearchSorted(self, keys, side));
+}
+
+static void
+_deepcopy_call(char *iptr, char *optr, PyArray_Descr *dtype,
+ PyObject *deepcopy, PyObject *visit)
+{
+ if (!PyDataType_REFCHK(dtype)) return;
+ else if (PyDescr_HASFIELDS(dtype)) {
+ PyObject *key, *value, *title=NULL;
+ PyArray_Descr *new;
+ int offset;
+ Py_ssize_t pos=0;
+ while (PyDict_Next(dtype->fields, &pos, &key, &value)) {
+ if (!PyArg_ParseTuple(value, "Oi|O", &new, &offset,
+ &title)) return;
+ _deepcopy_call(iptr + offset, optr + offset, new,
+ deepcopy, visit);
+ }
+ }
+ else {
+ PyObject **itemp, **otemp;
+ PyObject *res;
+ itemp = (PyObject **)iptr;
+ otemp = (PyObject **)optr;
+ Py_XINCREF(*itemp);
+ /* call deepcopy on this argument */
+ res = PyObject_CallFunctionObjArgs(deepcopy,
+ *itemp, visit, NULL);
+ Py_XDECREF(*itemp);
+ Py_XDECREF(*otemp);
+ *otemp = res;
+ }
+
+}
+
+
+static PyObject *
+array_deepcopy(PyArrayObject *self, PyObject *args)
+{
+ PyObject* visit;
+ char *optr;
+ PyArrayIterObject *it;
+ PyObject *copy, *ret, *deepcopy;
+
+ if (!PyArg_ParseTuple(args, "O", &visit)) return NULL;
+ ret = PyArray_Copy(self);
+ if (PyDataType_REFCHK(self->descr)) {
+ copy = PyImport_ImportModule("copy");
+ if (copy == NULL) return NULL;
+ deepcopy = PyObject_GetAttrString(copy, "deepcopy");
+ Py_DECREF(copy);
+ if (deepcopy == NULL) return NULL;
+ it = (PyArrayIterObject *)PyArray_IterNew((PyObject *)self);
+ if (it == NULL) {Py_DECREF(deepcopy); return NULL;}
+ optr = PyArray_DATA(ret);
+ while(it->index < it->size) {
+ _deepcopy_call(it->dataptr, optr, self->descr,
+ deepcopy, visit);
+ optr += self->descr->elsize;
+ PyArray_ITER_NEXT(it);
+ }
+ Py_DECREF(deepcopy);
+ Py_DECREF(it);
+ }
+ return _ARET(ret);
+}
+
+/* Convert Array to flat list (using getitem) */
+static PyObject *
+_getlist_pkl(PyArrayObject *self)
+{
+ PyObject *theobject;
+ PyArrayIterObject *iter=NULL;
+ PyObject *list;
+ PyArray_GetItemFunc *getitem;
+
+ getitem = self->descr->f->getitem;
+ iter = (PyArrayIterObject *)PyArray_IterNew((PyObject *)self);
+ if (iter == NULL) return NULL;
+ list = PyList_New(iter->size);
+ if (list == NULL) {Py_DECREF(iter); return NULL;}
+ while (iter->index < iter->size) {
+ theobject = getitem(iter->dataptr, self);
+ PyList_SET_ITEM(list, (int) iter->index, theobject);
+ PyArray_ITER_NEXT(iter);
+ }
+ Py_DECREF(iter);
+ return list;
+}
+
+static int
+_setlist_pkl(PyArrayObject *self, PyObject *list)
+{
+ PyObject *theobject;
+ PyArrayIterObject *iter=NULL;
+ PyArray_SetItemFunc *setitem;
+
+ setitem = self->descr->f->setitem;
+ iter = (PyArrayIterObject *)PyArray_IterNew((PyObject *)self);
+ if (iter == NULL) return -1;
+ while(iter->index < iter->size) {
+ theobject = PyList_GET_ITEM(list, (int) iter->index);
+ setitem(theobject, iter->dataptr, self);
+ PyArray_ITER_NEXT(iter);
+ }
+ Py_XDECREF(iter);
+ return 0;
+}
+
+
+static PyObject *
+array_reduce(PyArrayObject *self, PyObject *args)
+{
+ /* version number of this pickle type. Increment if we need to
+ change the format. Be sure to handle the old versions in
+ array_setstate. */
+ const int version = 1;
+ PyObject *ret=NULL, *state=NULL, *obj=NULL, *mod=NULL;
+ PyObject *mybool, *thestr=NULL;
+ PyArray_Descr *descr;
+
+ /* Return a tuple of (callable object, arguments, object's state) */
+ /* We will put everything in the object's state, so that on UnPickle
+ it can use the string object as memory without a copy */
+
+ ret = PyTuple_New(3);
+ if (ret == NULL) return NULL;
+ mod = PyImport_ImportModule("numpy.core.multiarray");
+ if (mod == NULL) {Py_DECREF(ret); return NULL;}
+ obj = PyObject_GetAttrString(mod, "_reconstruct");
+ Py_DECREF(mod);
+ PyTuple_SET_ITEM(ret, 0, obj);
+ PyTuple_SET_ITEM(ret, 1,
+ Py_BuildValue("ONc",
+ (PyObject *)self->ob_type,
+ Py_BuildValue("(N)",
+ PyInt_FromLong(0)),
+ /* dummy data-type */
+ 'b'));
+
+ /* Now fill in object's state. This is a tuple with
+ 5 arguments
+
+ 1) an integer with the pickle version.
+ 2) a Tuple giving the shape
+ 3) a PyArray_Descr Object (with correct bytorder set)
+ 4) a Bool stating if Fortran or not
+ 5) a Python object representing the data (a string, or
+ a list or any user-defined object).
+
+ Notice because Python does not describe a mechanism to write
+ raw data to the pickle, this performs a copy to a string first
+ */
+
+ state = PyTuple_New(5);
+ if (state == NULL) {
+ Py_DECREF(ret); return NULL;
+ }
+ PyTuple_SET_ITEM(state, 0, PyInt_FromLong(version));
+ PyTuple_SET_ITEM(state, 1, PyObject_GetAttrString((PyObject *)self,
+ "shape"));
+ descr = self->descr;
+ Py_INCREF(descr);
+ PyTuple_SET_ITEM(state, 2, (PyObject *)descr);
+ mybool = (PyArray_ISFORTRAN(self) ? Py_True : Py_False);
+ Py_INCREF(mybool);
+ PyTuple_SET_ITEM(state, 3, mybool);
+ if (PyDataType_FLAGCHK(self->descr, NPY_LIST_PICKLE)) {
+ thestr = _getlist_pkl(self);
+ }
+ else {
+ thestr = PyArray_ToString(self, NPY_ANYORDER);
+ }
+ if (thestr == NULL) {
+ Py_DECREF(ret);
+ Py_DECREF(state);
+ return NULL;
+ }
+ PyTuple_SET_ITEM(state, 4, thestr);
+ PyTuple_SET_ITEM(ret, 2, state);
+ return ret;
+}
+
+
+
+static size_t _array_fill_strides(intp *, intp *, int, size_t, int, int *);
+
+static int _IsAligned(PyArrayObject *);
+
+static PyArray_Descr * _array_typedescr_fromstr(char *);
+
+static PyObject *
+array_setstate(PyArrayObject *self, PyObject *args)
+{
+ PyObject *shape;
+ PyArray_Descr *typecode;
+ int version = 1;
+ int fortran;
+ PyObject *rawdata;
+ char *datastr;
+ Py_ssize_t len;
+ intp size, dimensions[MAX_DIMS];
+ int nd;
+
+ /* This will free any memory associated with a and
+ use the string in setstate as the (writeable) memory.
+ */
+ if (!PyArg_ParseTuple(args, "(iO!O!iO)", &version, &PyTuple_Type,
+ &shape, &PyArrayDescr_Type, &typecode,
+ &fortran, &rawdata)) {
+ PyErr_Clear();
+ version = 0;
+ if (!PyArg_ParseTuple(args, "(O!O!iO)", &PyTuple_Type,
+ &shape, &PyArrayDescr_Type, &typecode,
+ &fortran, &rawdata)) {
+ return NULL;
+ }
+ }
+
+ /* If we ever need another pickle format, increment the version
+ number. But we should still be able to handle the old versions.
+ We've only got one right now. */
+ if (version != 1 && version != 0) {
+ PyErr_Format(PyExc_ValueError,
+ "can't handle version %d of numpy.ndarray pickle",
+ version);
+ return NULL;
+ }
+
+ Py_XDECREF(self->descr);
+ self->descr = typecode;
+ Py_INCREF(typecode);
+ nd = PyArray_IntpFromSequence(shape, dimensions, MAX_DIMS);
+ if (nd < 0) return NULL;
+ size = PyArray_MultiplyList(dimensions, nd);
+ if (self->descr->elsize == 0) {
+ PyErr_SetString(PyExc_ValueError, "Invalid data-type size.");
+ return NULL;
+ }
+ if (size < 0 || size > MAX_INTP / self->descr->elsize) {
+ PyErr_NoMemory();
+ return NULL;
+ }
+
+ if (PyDataType_FLAGCHK(typecode, NPY_LIST_PICKLE)) {
+ if (!PyList_Check(rawdata)) {
+ PyErr_SetString(PyExc_TypeError,
+ "object pickle not returning list");
+ return NULL;
+ }
+ }
+ else {
+ if (!PyString_Check(rawdata)) {
+ PyErr_SetString(PyExc_TypeError,
+ "pickle not returning string");
+ return NULL;
+ }
+
+ if (PyString_AsStringAndSize(rawdata, &datastr, &len))
+ return NULL;
+
+ if ((len != (self->descr->elsize * size))) {
+ PyErr_SetString(PyExc_ValueError,
+ "buffer size does not" \
+ " match array size");
+ return NULL;
+ }
+ }
+
+ if ((self->flags & OWNDATA)) {
+ if (self->data != NULL)
+ PyDataMem_FREE(self->data);
+ self->flags &= ~OWNDATA;
+ }
+ Py_XDECREF(self->base);
+
+ self->flags &= ~UPDATEIFCOPY;
+
+ if (self->dimensions != NULL) {
+ PyDimMem_FREE(self->dimensions);
+ self->dimensions = NULL;
+ }
+
+ self->flags = DEFAULT;
+
+ self->nd = nd;
+
+ if (nd > 0) {
+ self->dimensions = PyDimMem_NEW(nd * 2);
+ self->strides = self->dimensions + nd;
+ memcpy(self->dimensions, dimensions, sizeof(intp)*nd);
+ (void) _array_fill_strides(self->strides, dimensions, nd,
+ (size_t) self->descr->elsize,
+ (fortran ? FORTRAN : CONTIGUOUS),
+ &(self->flags));
+ }
+
+ if (!PyDataType_FLAGCHK(typecode, NPY_LIST_PICKLE)) {
+ int swap=!PyArray_ISNOTSWAPPED(self);
+ self->data = datastr;
+ if (!_IsAligned(self) || swap) {
+ intp num = PyArray_NBYTES(self);
+ self->data = PyDataMem_NEW(num);
+ if (self->data == NULL) {
+ self->nd = 0;
+ PyDimMem_FREE(self->dimensions);
+ return PyErr_NoMemory();
+ }
+ if (swap) { /* byte-swap on pickle-read */
+ intp numels = num / self->descr->elsize;
+ self->descr->f->copyswapn(self->data, self->descr->elsize,
+ datastr, self->descr->elsize,
+ numels, 1, self);
+ if (!PyArray_ISEXTENDED(self)) {
+ self->descr = PyArray_DescrFromType(self->descr->type_num);
+ }
+ else {
+ self->descr = PyArray_DescrNew(typecode);
+ if (self->descr->byteorder == PyArray_BIG)
+ self->descr->byteorder = PyArray_LITTLE;
+ else if (self->descr->byteorder == PyArray_LITTLE)
+ self->descr->byteorder = PyArray_BIG;
+ }
+ Py_DECREF(typecode);
+ }
+ else {
+ memcpy(self->data, datastr, num);
+ }
+ self->flags |= OWNDATA;
+ self->base = NULL;
+ }
+ else {
+ self->base = rawdata;
+ Py_INCREF(self->base);
+ }
+ }
+ else {
+ self->data = PyDataMem_NEW(PyArray_NBYTES(self));
+ if (self->data == NULL) {
+ self->nd = 0;
+ self->data = PyDataMem_NEW(self->descr->elsize);
+ if (self->dimensions) PyDimMem_FREE(self->dimensions);
+ return PyErr_NoMemory();
+ }
+ if (PyDataType_FLAGCHK(self->descr, NPY_NEEDS_INIT))
+ memset(self->data, 0, PyArray_NBYTES(self));
+ self->flags |= OWNDATA;
+ self->base = NULL;
+ if (_setlist_pkl(self, rawdata) < 0)
+ return NULL;
+ }
+
+ PyArray_UpdateFlags(self, UPDATE_ALL);
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+/*OBJECT_API*/
+static int
+PyArray_Dump(PyObject *self, PyObject *file, int protocol)
+{
+ PyObject *cpick=NULL;
+ PyObject *ret;
+ if (protocol < 0) protocol = 2;
+
+ cpick = PyImport_ImportModule("cPickle");
+ if (cpick==NULL) return -1;
+
+ if PyString_Check(file) {
+ file = PyFile_FromString(PyString_AS_STRING(file), "wb");
+ if (file==NULL) return -1;
+ }
+ else Py_INCREF(file);
+ ret = PyObject_CallMethod(cpick, "dump", "OOi", self,
+ file, protocol);
+ Py_XDECREF(ret);
+ Py_DECREF(file);
+ Py_DECREF(cpick);
+ if (PyErr_Occurred()) return -1;
+ return 0;
+}
+
+/*OBJECT_API*/
+static PyObject *
+PyArray_Dumps(PyObject *self, int protocol)
+{
+ PyObject *cpick=NULL;
+ PyObject *ret;
+ if (protocol < 0) protocol = 2;
+
+ cpick = PyImport_ImportModule("cPickle");
+ if (cpick==NULL) return NULL;
+ ret = PyObject_CallMethod(cpick, "dumps", "Oi", self, protocol);
+ Py_DECREF(cpick);
+ return ret;
+}
+
+
+static PyObject *
+array_dump(PyArrayObject *self, PyObject *args)
+{
+ PyObject *file=NULL;
+ int ret;
+
+ if (!PyArg_ParseTuple(args, "O", &file))
+ return NULL;
+ ret = PyArray_Dump((PyObject *)self, file, 2);
+ if (ret < 0) return NULL;
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+static PyObject *
+array_dumps(PyArrayObject *self, PyObject *args)
+{
+ if (!PyArg_ParseTuple(args, ""))
+ return NULL;
+ return PyArray_Dumps((PyObject *)self, 2);
+}
+
+
+static PyObject *
+array_transpose(PyArrayObject *self, PyObject *args)
+{
+ PyObject *shape=Py_None;
+ int n;
+ PyArray_Dims permute;
+ PyObject *ret;
+
+ n = PyTuple_Size(args);
+ if (n > 1) shape = args;
+ else if (n == 1) shape = PyTuple_GET_ITEM(args, 0);
+
+ if (shape == Py_None)
+ ret = PyArray_Transpose(self, NULL);
+ else {
+ if (!PyArray_IntpConverter(shape, &permute)) return NULL;
+ ret = PyArray_Transpose(self, &permute);
+ PyDimMem_FREE(permute.ptr);
+ }
+
+ return ret;
+}
+
+/* Return typenumber from dtype2 unless it is NULL, then return
+ NPY_DOUBLE if dtype1->type_num is integer or bool
+ and dtype1->type_num otherwise.
+*/
+static int
+_get_type_num_double(PyArray_Descr *dtype1, PyArray_Descr *dtype2)
+{
+ if (dtype2 != NULL)
+ return dtype2->type_num;
+
+ /* For integer or bool data-types */
+ if (dtype1->type_num < NPY_FLOAT) {
+ return NPY_DOUBLE;
+ }
+ else {
+ return dtype1->type_num;
+ }
+}
+
+#define _CHKTYPENUM(typ) ((typ) ? (typ)->type_num : PyArray_NOTYPE)
+
+static PyObject *
+array_mean(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int axis=MAX_DIMS;
+ PyArray_Descr *dtype=NULL;
+ PyArrayObject *out=NULL;
+ int num;
+ static char *kwlist[] = {"axis", "dtype", "out", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|O&O&O&", kwlist,
+ PyArray_AxisConverter,
+ &axis, PyArray_DescrConverter2,
+ &dtype,
+ PyArray_OutputConverter,
+ &out)) return NULL;
+
+ num = _get_type_num_double(self->descr, dtype);
+ return PyArray_Mean(self, axis, num, out);
+}
+
+static PyObject *
+array_sum(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int axis=MAX_DIMS;
+ PyArray_Descr *dtype=NULL;
+ PyArrayObject *out=NULL;
+ static char *kwlist[] = {"axis", "dtype", "out", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|O&O&O&", kwlist,
+ PyArray_AxisConverter,
+ &axis, PyArray_DescrConverter2,
+ &dtype,
+ PyArray_OutputConverter,
+ &out)) return NULL;
+
+ return PyArray_Sum(self, axis, _CHKTYPENUM(dtype), out);
+}
+
+
+static PyObject *
+array_cumsum(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int axis=MAX_DIMS;
+ PyArray_Descr *dtype=NULL;
+ PyArrayObject *out=NULL;
+ static char *kwlist[] = {"axis", "dtype", "out", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|O&O&O&", kwlist,
+ PyArray_AxisConverter,
+ &axis, PyArray_DescrConverter2,
+ &dtype,
+ PyArray_OutputConverter,
+ &out)) return NULL;
+
+ return PyArray_CumSum(self, axis, _CHKTYPENUM(dtype), out);
+}
+
+static PyObject *
+array_prod(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int axis=MAX_DIMS;
+ PyArray_Descr *dtype=NULL;
+ PyArrayObject *out=NULL;
+ static char *kwlist[] = {"axis", "dtype", "out", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|O&O&O&", kwlist,
+ PyArray_AxisConverter,
+ &axis, PyArray_DescrConverter2,
+ &dtype,
+ PyArray_OutputConverter,
+ &out)) return NULL;
+
+ return PyArray_Prod(self, axis, _CHKTYPENUM(dtype), out);
+}
+
+static PyObject *
+array_cumprod(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int axis=MAX_DIMS;
+ PyArray_Descr *dtype=NULL;
+ PyArrayObject *out=NULL;
+ static char *kwlist[] = {"axis", "dtype", "out", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|O&O&O&", kwlist,
+ PyArray_AxisConverter,
+ &axis, PyArray_DescrConverter2,
+ &dtype,
+ PyArray_OutputConverter,
+ &out)) return NULL;
+
+ return PyArray_CumProd(self, axis, _CHKTYPENUM(dtype), out);
+}
+
+
+static PyObject *
+array_any(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int axis=MAX_DIMS;
+ PyArrayObject *out=NULL;
+ static char *kwlist[] = {"axis", "out", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|O&O&", kwlist,
+ PyArray_AxisConverter,
+ &axis,
+ PyArray_OutputConverter,
+ &out))
+ return NULL;
+
+ return PyArray_Any(self, axis, out);
+}
+
+
+static PyObject *
+array_all(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int axis=MAX_DIMS;
+ PyArrayObject *out=NULL;
+ static char *kwlist[] = {"axis", "out", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|O&O&", kwlist,
+ PyArray_AxisConverter,
+ &axis,
+ PyArray_OutputConverter,
+ &out))
+ return NULL;
+
+ return PyArray_All(self, axis, out);
+}
+
+
+static PyObject *
+array_stddev(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int axis=MAX_DIMS;
+ PyArray_Descr *dtype=NULL;
+ PyArrayObject *out=NULL;
+ int num;
+ static char *kwlist[] = {"axis", "dtype", "out", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|O&O&O&", kwlist,
+ PyArray_AxisConverter,
+ &axis, PyArray_DescrConverter2,
+ &dtype,
+ PyArray_OutputConverter,
+ &out)) return NULL;
+
+ num = _get_type_num_double(self->descr, dtype);
+ return PyArray_Std(self, axis, num, out, 0);
+}
+
+
+static PyObject *
+array_variance(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int axis=MAX_DIMS;
+ PyArray_Descr *dtype=NULL;
+ PyArrayObject *out=NULL;
+ int num;
+ static char *kwlist[] = {"axis", "dtype", "out", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|O&O&O&", kwlist,
+ PyArray_AxisConverter,
+ &axis, PyArray_DescrConverter2,
+ &dtype,
+ PyArray_OutputConverter,
+ &out)) return NULL;
+
+ num = _get_type_num_double(self->descr, dtype);
+ return PyArray_Std(self, axis, num, out, 1);
+}
+
+
+static PyObject *
+array_compress(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int axis=MAX_DIMS;
+ PyObject *condition;
+ PyArrayObject *out=NULL;
+ static char *kwlist[] = {"condition", "axis", "out", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "O|O&O&", kwlist,
+ &condition, PyArray_AxisConverter,
+ &axis,
+ PyArray_OutputConverter,
+ &out)) return NULL;
+
+ return _ARET(PyArray_Compress(self, condition, axis, out));
+}
+
+
+static PyObject *
+array_nonzero(PyArrayObject *self, PyObject *args)
+{
+ if (!PyArg_ParseTuple(args, "")) return NULL;
+
+ return PyArray_Nonzero(self);
+}
+
+
+static PyObject *
+array_trace(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int axis1=0, axis2=1, offset=0;
+ PyArray_Descr *dtype=NULL;
+ PyArrayObject *out=NULL;
+ static char *kwlist[] = {"offset", "axis1", "axis2", "dtype", "out", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|iiiO&O&", kwlist,
+ &offset, &axis1, &axis2,
+ PyArray_DescrConverter2, &dtype,
+ PyArray_OutputConverter, &out))
+ return NULL;
+
+ return _ARET(PyArray_Trace(self, offset, axis1, axis2,
+ _CHKTYPENUM(dtype), out));
+}
+
+#undef _CHKTYPENUM
+
+
+static PyObject *
+array_clip(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ PyObject *min, *max;
+ PyArrayObject *out=NULL;
+ static char *kwlist[] = {"min", "max", "out", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "OO|O&", kwlist,
+ &min, &max,
+ PyArray_OutputConverter,
+ &out))
+ return NULL;
+
+ return _ARET(PyArray_Clip(self, min, max, out));
+}
+
+
+static PyObject *
+array_conjugate(PyArrayObject *self, PyObject *args)
+{
+
+ PyArrayObject *out=NULL;
+ if (!PyArg_ParseTuple(args, "|O&",
+ PyArray_OutputConverter,
+ &out)) return NULL;
+
+ return PyArray_Conjugate(self, out);
+}
+
+
+static PyObject *
+array_diagonal(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int axis1=0, axis2=1, offset=0;
+ static char *kwlist[] = {"offset", "axis1", "axis2", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|iii", kwlist,
+ &offset, &axis1, &axis2))
+ return NULL;
+
+ return _ARET(PyArray_Diagonal(self, offset, axis1, axis2));
+}
+
+
+static PyObject *
+array_flatten(PyArrayObject *self, PyObject *args)
+{
+ PyArray_ORDER fortran=PyArray_CORDER;
+
+ if (!PyArg_ParseTuple(args, "|O&", PyArray_OrderConverter,
+ &fortran)) return NULL;
+
+ return PyArray_Flatten(self, fortran);
+}
+
+
+static PyObject *
+array_ravel(PyArrayObject *self, PyObject *args)
+{
+ PyArray_ORDER fortran=PyArray_CORDER;
+
+ if (!PyArg_ParseTuple(args, "|O&", PyArray_OrderConverter,
+ &fortran)) return NULL;
+
+ return PyArray_Ravel(self, fortran);
+}
+
+
+static PyObject *
+array_round(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ int decimals = 0;
+ PyArrayObject *out=NULL;
+ static char *kwlist[] = {"decimals", "out", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|iO&", kwlist,
+ &decimals, PyArray_OutputConverter,
+ &out))
+ return NULL;
+
+ return _ARET(PyArray_Round(self, decimals, out));
+}
+
+
+
+static int _IsAligned(PyArrayObject *);
+static Bool _IsWriteable(PyArrayObject *);
+
+static PyObject *
+array_setflags(PyArrayObject *self, PyObject *args, PyObject *kwds)
+{
+ static char *kwlist[] = {"write", "align", "uic", NULL};
+ PyObject *write=Py_None;
+ PyObject *align=Py_None;
+ PyObject *uic=Py_None;
+ int flagback = self->flags;
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "|OOO", kwlist,
+ &write, &align, &uic))
+ return NULL;
+
+ if (align != Py_None) {
+ if (PyObject_Not(align)) self->flags &= ~ALIGNED;
+ else if (_IsAligned(self)) self->flags |= ALIGNED;
+ else {
+ PyErr_SetString(PyExc_ValueError,
+ "cannot set aligned flag of mis-"\
+ "aligned array to True");
+ return NULL;
+ }
+ }
+
+ if (uic != Py_None) {
+ if (PyObject_IsTrue(uic)) {
+ self->flags = flagback;
+ PyErr_SetString(PyExc_ValueError,
+ "cannot set UPDATEIFCOPY " \
+ "flag to True");
+ return NULL;
+ }
+ else {
+ self->flags &= ~UPDATEIFCOPY;
+ Py_XDECREF(self->base);
+ self->base = NULL;
+ }
+ }
+
+ if (write != Py_None) {
+ if (PyObject_IsTrue(write))
+ if (_IsWriteable(self)) {
+ self->flags |= WRITEABLE;
+ }
+ else {
+ self->flags = flagback;
+ PyErr_SetString(PyExc_ValueError,
+ "cannot set WRITEABLE " \
+ "flag to True of this " \
+ "array"); \
+ return NULL;
+ }
+ else
+ self->flags &= ~WRITEABLE;
+ }
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+static PyObject *
+array_newbyteorder(PyArrayObject *self, PyObject *args)
+{
+ char endian = PyArray_SWAP;
+ PyArray_Descr *new;
+
+ if (!PyArg_ParseTuple(args, "|O&", PyArray_ByteorderConverter,
+ &endian)) return NULL;
+
+ new = PyArray_DescrNewByteorder(self->descr, endian);
+ if (!new) return NULL;
+ return PyArray_View(self, new, NULL);
+
+}
+
+static PyMethodDef array_methods[] = {
+
+ /* for subtypes */
+ {"__array__", (PyCFunction)array_getarray,
+ METH_VARARGS, NULL},
+ {"__array_wrap__", (PyCFunction)array_wraparray,
+ METH_VARARGS, NULL},
+
+ /* for the copy module */
+ {"__copy__", (PyCFunction)array_copy,
+ METH_VARARGS, NULL},
+ {"__deepcopy__", (PyCFunction)array_deepcopy,
+ METH_VARARGS, NULL},
+
+ /* for Pickling */
+ {"__reduce__", (PyCFunction) array_reduce,
+ METH_VARARGS, NULL},
+ {"__setstate__", (PyCFunction) array_setstate,
+ METH_VARARGS, NULL},
+ {"dumps", (PyCFunction) array_dumps,
+ METH_VARARGS, NULL},
+ {"dump", (PyCFunction) array_dump,
+ METH_VARARGS, NULL},
+
+ /* Original and Extended methods added 2005 */
+ {"all", (PyCFunction)array_all,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"any", (PyCFunction)array_any,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"argmax", (PyCFunction)array_argmax,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"argmin", (PyCFunction)array_argmin,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"argsort", (PyCFunction)array_argsort,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"astype", (PyCFunction)array_cast,
+ METH_VARARGS, NULL},
+ {"byteswap", (PyCFunction)array_byteswap,
+ METH_VARARGS, NULL},
+ {"choose", (PyCFunction)array_choose,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"clip", (PyCFunction)array_clip,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"compress", (PyCFunction)array_compress,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"conj", (PyCFunction)array_conjugate,
+ METH_VARARGS, NULL},
+ {"conjugate", (PyCFunction)array_conjugate,
+ METH_VARARGS, NULL},
+ {"copy", (PyCFunction)array_copy,
+ METH_VARARGS, NULL},
+ {"cumprod", (PyCFunction)array_cumprod,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"cumsum", (PyCFunction)array_cumsum,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"diagonal", (PyCFunction)array_diagonal,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"fill", (PyCFunction)array_fill,
+ METH_VARARGS, NULL},
+ {"flatten", (PyCFunction)array_flatten,
+ METH_VARARGS, NULL},
+ {"getfield", (PyCFunction)array_getfield,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"item", (PyCFunction)array_toscalar,
+ METH_VARARGS, NULL},
+ {"itemset", (PyCFunction) array_setscalar,
+ METH_VARARGS, NULL},
+ {"max", (PyCFunction)array_max,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"mean", (PyCFunction)array_mean,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"min", (PyCFunction)array_min,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"newbyteorder", (PyCFunction)array_newbyteorder,
+ METH_VARARGS, NULL},
+ {"nonzero", (PyCFunction)array_nonzero,
+ METH_VARARGS, NULL},
+ {"prod", (PyCFunction)array_prod,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"ptp", (PyCFunction)array_ptp,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"put", (PyCFunction)array_put,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"ravel", (PyCFunction)array_ravel,
+ METH_VARARGS, NULL},
+ {"repeat", (PyCFunction)array_repeat,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"reshape", (PyCFunction)array_reshape,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"resize", (PyCFunction)array_resize,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"round", (PyCFunction)array_round,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"searchsorted", (PyCFunction)array_searchsorted,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"setfield", (PyCFunction)array_setfield,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"setflags", (PyCFunction)array_setflags,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"sort", (PyCFunction)array_sort,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"squeeze", (PyCFunction)array_squeeze,
+ METH_VARARGS, NULL},
+ {"std", (PyCFunction)array_stddev,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"sum", (PyCFunction)array_sum,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"swapaxes", (PyCFunction)array_swapaxes,
+ METH_VARARGS, NULL},
+ {"take", (PyCFunction)array_take,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"tofile", (PyCFunction)array_tofile,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"tolist", (PyCFunction)array_tolist,
+ METH_VARARGS, NULL},
+ {"tostring", (PyCFunction)array_tostring,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"trace", (PyCFunction)array_trace,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"transpose", (PyCFunction)array_transpose,
+ METH_VARARGS, NULL},
+ {"var", (PyCFunction)array_variance,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"view", (PyCFunction)array_view,
+ METH_VARARGS, NULL},
+ {NULL, NULL} /* sentinel */
+};
+
+#undef _ARET
diff --git a/numpy/core/src/arrayobject.c b/numpy/core/src/arrayobject.c
new file mode 100644
index 000000000..e269195cc
--- /dev/null
+++ b/numpy/core/src/arrayobject.c
@@ -0,0 +1,12076 @@
+
+/*
+ Provide multidimensional arrays as a basic object type in python.
+
+Based on Original Numeric implementation
+Copyright (c) 1995, 1996, 1997 Jim Hugunin, hugunin@mit.edu
+
+with contributions from many Numeric Python developers 1995-2004
+
+Heavily modified in 2005 with inspiration from Numarray
+
+by
+
+Travis Oliphant, oliphant@ee.byu.edu
+Brigham Young Univeristy
+
+maintainer email: oliphant.travis@ieee.org
+
+Numarray design (which provided guidance) by
+Space Science Telescope Institute
+ (J. Todd Miller, Perry Greenfield, Rick White)
+*/
+
+/*OBJECT_API
+ Get Priority from object
+*/
+static double
+PyArray_GetPriority(PyObject *obj, double default_)
+{
+ PyObject *ret;
+ double priority=PyArray_PRIORITY;
+
+ if (PyArray_CheckExact(obj))
+ return priority;
+
+ ret = PyObject_GetAttrString(obj, "__array_priority__");
+ if (ret != NULL) priority = PyFloat_AsDouble(ret);
+ if (PyErr_Occurred()) {
+ PyErr_Clear();
+ priority = default_;
+ }
+ Py_XDECREF(ret);
+ return priority;
+}
+
+static int
+_check_object_rec(PyArray_Descr *descr)
+{
+ if (PyDataType_HASFIELDS(descr) && PyDataType_REFCHK(descr)) {
+ PyErr_SetString(PyExc_TypeError, "Not supported for this data-type.");
+ return -1;
+ }
+ return 0;
+}
+
+/* Backward compatibility only */
+/* In both Zero and One
+
+ ***You must free the memory once you are done with it
+ using PyDataMem_FREE(ptr) or you create a memory leak***
+
+ If arr is an Object array you are getting a
+ BORROWED reference to Zero or One.
+ Do not DECREF.
+ Please INCREF if you will be hanging on to it.
+
+ The memory for the ptr still must be freed in any case;
+*/
+
+
+/*OBJECT_API
+ Get pointer to zero of correct type for array.
+*/
+static char *
+PyArray_Zero(PyArrayObject *arr)
+{
+ char *zeroval;
+ int ret, storeflags;
+ PyObject *obj;
+
+ if (_check_object_rec(arr->descr) < 0) return NULL;
+ zeroval = PyDataMem_NEW(arr->descr->elsize);
+ if (zeroval == NULL) {
+ PyErr_SetNone(PyExc_MemoryError);
+ return NULL;
+ }
+
+ obj=PyInt_FromLong((long) 0);
+ if (PyArray_ISOBJECT(arr)) {
+ memcpy(zeroval, &obj, sizeof(PyObject *));
+ Py_DECREF(obj);
+ return zeroval;
+ }
+ storeflags = arr->flags;
+ arr->flags |= BEHAVED;
+ ret = arr->descr->f->setitem(obj, zeroval, arr);
+ arr->flags = storeflags;
+ Py_DECREF(obj);
+ if (ret < 0) {
+ PyDataMem_FREE(zeroval);
+ return NULL;
+ }
+ return zeroval;
+}
+
+/*OBJECT_API
+ Get pointer to one of correct type for array
+*/
+static char *
+PyArray_One(PyArrayObject *arr)
+{
+ char *oneval;
+ int ret, storeflags;
+ PyObject *obj;
+
+ if (_check_object_rec(arr->descr) < 0) return NULL;
+ oneval = PyDataMem_NEW(arr->descr->elsize);
+ if (oneval == NULL) {
+ PyErr_SetNone(PyExc_MemoryError);
+ return NULL;
+ }
+
+ obj = PyInt_FromLong((long) 1);
+ if (PyArray_ISOBJECT(arr)) {
+ memcpy(oneval, &obj, sizeof(PyObject *));
+ Py_DECREF(obj);
+ return oneval;
+ }
+
+ storeflags = arr->flags;
+ arr->flags |= BEHAVED;
+ ret = arr->descr->f->setitem(obj, oneval, arr);
+ arr->flags = storeflags;
+ Py_DECREF(obj);
+ if (ret < 0) {
+ PyDataMem_FREE(oneval);
+ return NULL;
+ }
+ return oneval;
+}
+
+/* End deprecated */
+
+
+static PyObject *PyArray_New(PyTypeObject *, int nd, intp *,
+ int, intp *, void *, int, int, PyObject *);
+
+
+/* Incref all objects found at this record */
+/*OBJECT_API
+ */
+static void
+PyArray_Item_INCREF(char *data, PyArray_Descr *descr)
+{
+ PyObject **temp;
+
+ if (!PyDataType_REFCHK(descr)) return;
+
+ if (descr->type_num == PyArray_OBJECT) {
+ temp = (PyObject **)data;
+ Py_XINCREF(*temp);
+ }
+ else if (PyDescr_HASFIELDS(descr)) {
+ PyObject *key, *value, *title=NULL;
+ PyArray_Descr *new;
+ int offset;
+ Py_ssize_t pos=0;
+ while (PyDict_Next(descr->fields, &pos, &key, &value)) {
+ if (!PyArg_ParseTuple(value, "Oi|O", &new, &offset,
+ &title)) return;
+ PyArray_Item_INCREF(data + offset, new);
+ }
+ }
+ return;
+}
+
+/* XDECREF all objects found at this record */
+/*OBJECT_API
+ */
+static void
+PyArray_Item_XDECREF(char *data, PyArray_Descr *descr)
+{
+ PyObject **temp;
+
+ if (!PyDataType_REFCHK(descr)) return;
+
+ if (descr->type_num == PyArray_OBJECT) {
+ temp = (PyObject **)data;
+ Py_XDECREF(*temp);
+ }
+ else if PyDescr_HASFIELDS(descr) {
+ PyObject *key, *value, *title=NULL;
+ PyArray_Descr *new;
+ int offset;
+ Py_ssize_t pos=0;
+ while (PyDict_Next(descr->fields, &pos, &key, &value)) {
+ if (!PyArg_ParseTuple(value, "Oi|O", &new, &offset,
+ &title)) return;
+ PyArray_Item_XDECREF(data + offset, new);
+ }
+ }
+ return;
+}
+
+/* C-API functions */
+
+/* Used for arrays of python objects to increment the reference count of */
+/* every python object in the array. */
+/*OBJECT_API
+ For object arrays, increment all internal references.
+*/
+static int
+PyArray_INCREF(PyArrayObject *mp)
+{
+ intp i, n;
+ PyObject **data, **temp;
+ PyArrayIterObject *it;
+
+ if (!PyDataType_REFCHK(mp->descr)) return 0;
+
+ if (mp->descr->type_num != PyArray_OBJECT) {
+ it = (PyArrayIterObject *)PyArray_IterNew((PyObject *)mp);
+ if (it == NULL) return -1;
+ while(it->index < it->size) {
+ PyArray_Item_INCREF(it->dataptr, mp->descr);
+ PyArray_ITER_NEXT(it);
+ }
+ Py_DECREF(it);
+ return 0;
+ }
+
+ if (PyArray_ISONESEGMENT(mp)) {
+ data = (PyObject **)mp->data;
+ n = PyArray_SIZE(mp);
+ if (PyArray_ISALIGNED(mp)) {
+ for(i=0; i<n; i++, data++) Py_XINCREF(*data);
+ }
+ else {
+ for (i=0; i<n; i++, data++) {
+ temp = data;
+ Py_XINCREF(*temp);
+ }
+ }
+ }
+ else { /* handles misaligned data too */
+ it = (PyArrayIterObject *)PyArray_IterNew((PyObject *)mp);
+ if (it == NULL) return -1;
+ while(it->index < it->size) {
+ temp = (PyObject **)it->dataptr;
+ Py_XINCREF(*temp);
+ PyArray_ITER_NEXT(it);
+ }
+ Py_DECREF(it);
+ }
+ return 0;
+}
+
+/*OBJECT_API
+ Decrement all internal references for object arrays.
+ (or arrays with object fields)
+*/
+static int
+PyArray_XDECREF(PyArrayObject *mp)
+{
+ intp i, n;
+ PyObject **data;
+ PyObject **temp;
+ PyArrayIterObject *it;
+
+ if (!PyDataType_REFCHK(mp->descr)) return 0;
+
+ if (mp->descr->type_num != PyArray_OBJECT) {
+ it = (PyArrayIterObject *)PyArray_IterNew((PyObject *)mp);
+ if (it == NULL) return -1;
+ while(it->index < it->size) {
+ PyArray_Item_XDECREF(it->dataptr, mp->descr);
+ PyArray_ITER_NEXT(it);
+ }
+ Py_DECREF(it);
+ return 0;
+ }
+
+ if (PyArray_ISONESEGMENT(mp)) {
+ data = (PyObject **)mp->data;
+ n = PyArray_SIZE(mp);
+ if (PyArray_ISALIGNED(mp)) {
+ for(i=0; i<n; i++, data++) Py_XDECREF(*data);
+ }
+ else {
+ for (i=0; i<n; i++, data++) {
+ temp = data;
+ Py_XDECREF(*temp);
+ }
+ }
+ }
+ else { /* handles misaligned data too */
+ it = (PyArrayIterObject *)PyArray_IterNew((PyObject *)mp);
+ if (it == NULL) return -1;
+ while(it->index < it->size) {
+ temp = (PyObject **)it->dataptr;
+ Py_XDECREF(*temp);
+ PyArray_ITER_NEXT(it);
+ }
+ Py_DECREF(it);
+ }
+ return 0;
+}
+
+static void
+_strided_byte_copy(char *dst, intp outstrides, char *src, intp instrides,
+ intp N, int elsize)
+{
+ intp i, j;
+ char *tout = dst;
+ char *tin = src;
+
+#define _FAST_MOVE(_type_) \
+ for (i=0; i<N; i++) { \
+ ((_type_ *)tout)[0] = ((_type_ *)tin)[0]; \
+ tin += instrides; \
+ tout += outstrides; \
+ } \
+ return
+
+ switch(elsize) {
+ case 8:
+ _FAST_MOVE(Int64);
+ case 4:
+ _FAST_MOVE(Int32);
+ case 1:
+ _FAST_MOVE(Int8);
+ case 2:
+ _FAST_MOVE(Int16);
+ case 16:
+ for (i=0; i<N; i++) {
+ ((Int64 *)tout)[0] = ((Int64 *)tin)[0];
+ ((Int64 *)tout)[1] = ((Int64 *)tin)[1];
+ tin += instrides;
+ tout += outstrides;
+ }
+ return;
+ default:
+ for (i=0; i<N; i++) {
+ for (j=0; j<elsize; j++) {
+ *tout++ = *tin++;
+ }
+ tin = tin + instrides - elsize;
+ tout = tout + outstrides - elsize;
+ }
+ }
+#undef _FAST_MOVE
+
+}
+
+
+static void
+_unaligned_strided_byte_move(char *dst, intp outstrides, char *src,
+ intp instrides, intp N, int elsize)
+{
+ intp i;
+ char *tout = dst;
+ char *tin = src;
+
+
+#define _MOVE_N_SIZE(size) \
+ for (i=0; i<N; i++) { \
+ memmove(tout, tin, size); \
+ tin += instrides; \
+ tout += outstrides; \
+ } \
+ return
+
+ switch(elsize) {
+ case 8:
+ _MOVE_N_SIZE(8);
+ case 4:
+ _MOVE_N_SIZE(4);
+ case 1:
+ _MOVE_N_SIZE(1);
+ case 2:
+ _MOVE_N_SIZE(2);
+ case 16:
+ _MOVE_N_SIZE(16);
+ default:
+ _MOVE_N_SIZE(elsize);
+ }
+#undef _MOVE_N_SIZE
+
+}
+
+static void
+_unaligned_strided_byte_copy(char *dst, intp outstrides, char *src,
+ intp instrides, intp N, int elsize)
+{
+ intp i;
+ char *tout = dst;
+ char *tin = src;
+
+#define _COPY_N_SIZE(size) \
+ for (i=0; i<N; i++) { \
+ memcpy(tout, tin, size); \
+ tin += instrides; \
+ tout += outstrides; \
+ } \
+ return
+
+ switch(elsize) {
+ case 8:
+ _COPY_N_SIZE(8);
+ case 4:
+ _COPY_N_SIZE(4);
+ case 1:
+ _COPY_N_SIZE(1);
+ case 2:
+ _COPY_N_SIZE(2);
+ case 16:
+ _COPY_N_SIZE(16);
+ default:
+ _COPY_N_SIZE(elsize);
+ }
+#undef _COPY_N_SIZE
+
+}
+
+static void
+_strided_byte_swap(void *p, intp stride, intp n, int size)
+{
+ char *a, *b, c=0;
+ int j,m;
+
+ switch(size) {
+ case 1: /* no byteswap necessary */
+ break;
+ case 4:
+ for (a = (char*)p ; n > 0; n--, a += stride-1) {
+ b = a + 3;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a = *b; *b = c;
+ }
+ break;
+ case 8:
+ for (a = (char*)p ; n > 0; n--, a += stride-3) {
+ b = a + 7;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a = *b; *b = c;
+ }
+ break;
+ case 2:
+ for (a = (char*)p ; n > 0; n--, a += stride) {
+ b = a + 1;
+ c = *a; *a = *b; *b = c;
+ }
+ break;
+ default:
+ m = size / 2;
+ for (a = (char *)p ; n > 0; n--, a += stride-m) {
+ b = a + (size-1);
+ for (j=0; j<m; j++) {
+ c=*a; *a++ = *b; *b-- = c;
+ }
+ }
+ break;
+ }
+}
+
+static void
+byte_swap_vector(void *p, intp n, int size)
+{
+ _strided_byte_swap(p, (intp) size, n, size);
+ return;
+}
+
+/* If numitems > 1, then dst must be contiguous */
+static void
+copy_and_swap(void *dst, void *src, int itemsize, intp numitems,
+ intp srcstrides, int swap)
+{
+ int i;
+ char *s1 = (char *)src;
+ char *d1 = (char *)dst;
+
+
+ if ((numitems == 1) || (itemsize == srcstrides))
+ memcpy(d1, s1, itemsize*numitems);
+ else {
+ for (i = 0; i < numitems; i++) {
+ memcpy(d1, s1, itemsize);
+ d1 += itemsize;
+ s1 += srcstrides;
+ }
+ }
+
+ if (swap)
+ byte_swap_vector(d1, numitems, itemsize);
+}
+
+
+#ifndef Py_UNICODE_WIDE
+#include "ucsnarrow.c"
+#endif
+
+
+static PyArray_Descr **userdescrs=NULL;
+#define error_converting(x) (((x) == -1) && PyErr_Occurred())
+
+
+/* Computer-generated arraytype and scalartype code */
+#include "scalartypes.inc"
+#include "arraytypes.inc"
+
+
+/* Helper functions */
+
+/*OBJECT_API*/
+static intp
+PyArray_PyIntAsIntp(PyObject *o)
+{
+ longlong long_value = -1;
+ PyObject *obj;
+ static char *msg = "an integer is required";
+ PyObject *arr;
+ PyArray_Descr *descr;
+ intp ret;
+
+ if (!o) {
+ PyErr_SetString(PyExc_TypeError, msg);
+ return -1;
+ }
+
+ if (PyInt_Check(o)) {
+ long_value = (longlong) PyInt_AS_LONG(o);
+ goto finish;
+ } else if (PyLong_Check(o)) {
+ long_value = (longlong) PyLong_AsLongLong(o);
+ goto finish;
+ }
+
+#if SIZEOF_INTP == SIZEOF_LONG
+ descr = &LONG_Descr;
+#elif SIZEOF_INTP == SIZEOF_INT
+ descr = &INT_Descr;
+#else
+ descr = &LONGLONG_Descr;
+#endif
+ arr = NULL;
+
+ if (PyArray_Check(o)) {
+ if (PyArray_SIZE(o)!=1 || !PyArray_ISINTEGER(o)) {
+ PyErr_SetString(PyExc_TypeError, msg);
+ return -1;
+ }
+ Py_INCREF(descr);
+ arr = PyArray_CastToType((PyArrayObject *)o, descr, 0);
+ }
+ else if (PyArray_IsScalar(o, Integer)) {
+ Py_INCREF(descr);
+ arr = PyArray_FromScalar(o, descr);
+ }
+ if (arr != NULL) {
+ ret = *((intp *)PyArray_DATA(arr));
+ Py_DECREF(arr);
+ return ret;
+ }
+
+#if (PY_VERSION_HEX >= 0x02050000)
+ if (PyIndex_Check(o)) {
+ PyObject* value = PyNumber_Index(o);
+ if (value==NULL) {
+ return -1;
+ }
+ long_value = (longlong) PyInt_AsSsize_t(value);
+ goto finish;
+ }
+#endif
+ if (o->ob_type->tp_as_number != NULL && \
+ o->ob_type->tp_as_number->nb_long != NULL) {
+ obj = o->ob_type->tp_as_number->nb_long(o);
+ if (obj != NULL) {
+ long_value = (longlong) PyLong_AsLongLong(obj);
+ Py_DECREF(obj);
+ }
+ }
+ else if (o->ob_type->tp_as_number != NULL && \
+ o->ob_type->tp_as_number->nb_int != NULL) {
+ obj = o->ob_type->tp_as_number->nb_int(o);
+ if (obj != NULL) {
+ long_value = (longlong) PyLong_AsLongLong(obj);
+ Py_DECREF(obj);
+ }
+ }
+ else {
+ PyErr_SetString(PyExc_NotImplementedError,"");
+ }
+
+ finish:
+ if error_converting(long_value) {
+ PyErr_SetString(PyExc_TypeError, msg);
+ return -1;
+ }
+
+#if (SIZEOF_LONGLONG > SIZEOF_INTP)
+ if ((long_value < MIN_INTP) || (long_value > MAX_INTP)) {
+ PyErr_SetString(PyExc_ValueError,
+ "integer won't fit into a C intp");
+ return -1;
+ }
+#endif
+ return (intp) long_value;
+}
+
+
+static PyObject *array_int(PyArrayObject *v);
+
+/*OBJECT_API*/
+static int
+PyArray_PyIntAsInt(PyObject *o)
+{
+ long long_value = -1;
+ PyObject *obj;
+ static char *msg = "an integer is required";
+ PyObject *arr;
+ PyArray_Descr *descr;
+ int ret;
+
+
+ if (!o) {
+ PyErr_SetString(PyExc_TypeError, msg);
+ return -1;
+ }
+
+ if (PyInt_Check(o)) {
+ long_value = (long) PyInt_AS_LONG(o);
+ goto finish;
+ } else if (PyLong_Check(o)) {
+ long_value = (long) PyLong_AsLong(o);
+ goto finish;
+ }
+
+ descr = &INT_Descr;
+ arr=NULL;
+ if (PyArray_Check(o)) {
+ if (PyArray_SIZE(o)!=1 || !PyArray_ISINTEGER(o)) {
+ PyErr_SetString(PyExc_TypeError, msg);
+ return -1;
+ }
+ Py_INCREF(descr);
+ arr = PyArray_CastToType((PyArrayObject *)o, descr, 0);
+ }
+ if (PyArray_IsScalar(o, Integer)) {
+ Py_INCREF(descr);
+ arr = PyArray_FromScalar(o, descr);
+ }
+ if (arr != NULL) {
+ ret = *((int *)PyArray_DATA(arr));
+ Py_DECREF(arr);
+ return ret;
+ }
+#if (PY_VERSION_HEX >= 0x02050000)
+ if (PyIndex_Check(o)) {
+ PyObject* value = PyNumber_Index(o);
+ long_value = (longlong) PyInt_AsSsize_t(value);
+ goto finish;
+ }
+#endif
+ if (o->ob_type->tp_as_number != NULL && \
+ o->ob_type->tp_as_number->nb_int != NULL) {
+ obj = o->ob_type->tp_as_number->nb_int(o);
+ if (obj == NULL) return -1;
+ long_value = (long) PyLong_AsLong(obj);
+ Py_DECREF(obj);
+ }
+ else if (o->ob_type->tp_as_number != NULL && \
+ o->ob_type->tp_as_number->nb_long != NULL) {
+ obj = o->ob_type->tp_as_number->nb_long(o);
+ if (obj == NULL) return -1;
+ long_value = (long) PyLong_AsLong(obj);
+ Py_DECREF(obj);
+ }
+ else {
+ PyErr_SetString(PyExc_NotImplementedError,"");
+ }
+
+ finish:
+ if error_converting(long_value) {
+ PyErr_SetString(PyExc_TypeError, msg);
+ return -1;
+ }
+
+#if (SIZEOF_LONG > SIZEOF_INT)
+ if ((long_value < INT_MIN) || (long_value > INT_MAX)) {
+ PyErr_SetString(PyExc_ValueError,
+ "integer won't fit into a C int");
+ return -1;
+ }
+#endif
+ return (int) long_value;
+}
+
+static char *
+index2ptr(PyArrayObject *mp, intp i)
+{
+ intp dim0;
+ if(mp->nd == 0) {
+ PyErr_SetString(PyExc_IndexError,
+ "0-d arrays can't be indexed");
+ return NULL;
+ }
+ dim0 = mp->dimensions[0];
+ if (i<0) i += dim0;
+ if (i==0 && dim0 > 0)
+ return mp->data;
+
+ if (i>0 && i < dim0) {
+ return mp->data+i*mp->strides[0];
+ }
+ PyErr_SetString(PyExc_IndexError,"index out of bounds");
+ return NULL;
+}
+
+/*OBJECT_API
+ Compute the size of an array (in number of items)
+*/
+static intp
+PyArray_Size(PyObject *op)
+{
+ if (PyArray_Check(op)) {
+ return PyArray_SIZE((PyArrayObject *)op);
+ }
+ else {
+ return 0;
+ }
+}
+
+static int
+_copy_from0d(PyArrayObject *dest, PyArrayObject *src, int usecopy, int swap)
+{
+ char *aligned=NULL;
+ char *sptr;
+ int numcopies, nbytes;
+ void (*myfunc)(char *, intp, char *, intp, intp, int);
+ int retval=-1;
+
+ NPY_BEGIN_THREADS_DEF
+
+ numcopies = PyArray_SIZE(dest);
+ if (numcopies < 1) return 0;
+ nbytes = PyArray_ITEMSIZE(src);
+
+ if (!PyArray_ISALIGNED(src)) {
+ aligned = malloc((size_t)nbytes);
+ if (aligned == NULL) {
+ PyErr_NoMemory();
+ return -1;
+ }
+ memcpy(aligned, src->data, (size_t) nbytes);
+ usecopy = 1;
+ sptr = aligned;
+ }
+ else sptr = src->data;
+ if (PyArray_ISALIGNED(dest)) {
+ myfunc = _strided_byte_copy;
+ }
+ else if (usecopy) {
+ myfunc = _unaligned_strided_byte_copy;
+ }
+ else {
+ myfunc = _unaligned_strided_byte_move;
+ }
+
+ if ((dest->nd < 2) || PyArray_ISONESEGMENT(dest)) {
+ char *dptr;
+ intp dstride;
+
+ dptr = dest->data;
+ if (dest->nd == 1)
+ dstride = dest->strides[0];
+ else
+ dstride = nbytes;
+
+ PyArray_INCREF(src);
+ PyArray_XDECREF(dest);
+
+ NPY_BEGIN_THREADS
+
+ myfunc(dptr, dstride, sptr, 0, numcopies, (int) nbytes);
+ if (swap)
+ _strided_byte_swap(dptr, dstride, numcopies, (int) nbytes);
+
+ NPY_END_THREADS
+
+ }
+ else {
+ PyArrayIterObject *dit;
+ int axis=-1;
+ dit = (PyArrayIterObject *)\
+ PyArray_IterAllButAxis((PyObject *)dest, &axis);
+ if (dit == NULL) goto finish;
+ PyArray_INCREF(src);
+ PyArray_XDECREF(dest);
+ NPY_BEGIN_THREADS
+ while(dit->index < dit->size) {
+ myfunc(dit->dataptr, PyArray_STRIDE(dest, axis),
+ sptr, 0,
+ PyArray_DIM(dest, axis), nbytes);
+ if (swap)
+ _strided_byte_swap(dit->dataptr,
+ PyArray_STRIDE(dest, axis),
+ PyArray_DIM(dest, axis), nbytes);
+ PyArray_ITER_NEXT(dit);
+ }
+ NPY_END_THREADS
+ Py_DECREF(dit);
+ }
+ retval = 0;
+ finish:
+ if (aligned != NULL) free(aligned);
+ return retval;
+}
+
+/* Special-case of PyArray_CopyInto when dst is 1-d
+ and contiguous (and aligned).
+ PyArray_CopyInto requires broadcastable arrays while
+ this one is a flattening operation...
+ */
+int _flat_copyinto(PyObject *dst, PyObject *src, NPY_ORDER order) {
+ PyArrayIterObject *it;
+ void (*myfunc)(char *, intp, char *, intp, intp, int);
+ char *dptr;
+ int axis;
+ int elsize;
+ intp nbytes;
+ NPY_BEGIN_THREADS_DEF
+
+
+ if (PyArray_NDIM(src) == 0) {
+ PyArray_INCREF((PyArrayObject *)src);
+ PyArray_XDECREF((PyArrayObject *)dst);
+ NPY_BEGIN_THREADS
+ memcpy(PyArray_BYTES(dst), PyArray_BYTES(src),
+ PyArray_ITEMSIZE(src));
+ NPY_END_THREADS
+ return 0;
+ }
+
+ if (order == PyArray_FORTRANORDER) {
+ axis = 0;
+ }
+ else {
+ axis = PyArray_NDIM(src)-1;
+ }
+
+ it = (PyArrayIterObject *)PyArray_IterAllButAxis(src, &axis);
+ if (it == NULL) return -1;
+
+ if (PyArray_ISALIGNED(src)) {
+ myfunc = _strided_byte_copy;
+ }
+ else {
+ myfunc = _unaligned_strided_byte_copy;
+ }
+
+ dptr = PyArray_BYTES(dst);
+ elsize = PyArray_ITEMSIZE(dst);
+ nbytes = elsize * PyArray_DIM(src, axis);
+ PyArray_INCREF((PyArrayObject *)src);
+ PyArray_XDECREF((PyArrayObject *)dst);
+ NPY_BEGIN_THREADS
+ while(it->index < it->size) {
+ myfunc(dptr, elsize, it->dataptr,
+ PyArray_STRIDE(src,axis),
+ PyArray_DIM(src,axis), elsize);
+ dptr += nbytes;
+ PyArray_ITER_NEXT(it);
+ }
+ NPY_END_THREADS
+
+ Py_DECREF(it);
+ return 0;
+}
+
+
+static int
+_copy_from_same_shape(PyArrayObject *dest, PyArrayObject *src,
+ void (*myfunc)(char *, intp, char *, intp, intp, int),
+ int swap)
+{
+ int maxaxis=-1, elsize;
+ intp maxdim;
+ PyArrayIterObject *dit, *sit;
+ NPY_BEGIN_THREADS_DEF
+
+ dit = (PyArrayIterObject *) \
+ PyArray_IterAllButAxis((PyObject *)dest, &maxaxis);
+ sit = (PyArrayIterObject *) \
+ PyArray_IterAllButAxis((PyObject *)src, &maxaxis);
+
+ maxdim = dest->dimensions[maxaxis];
+
+ if ((dit == NULL) || (sit == NULL)) {
+ Py_XDECREF(dit);
+ Py_XDECREF(sit);
+ return -1;
+ }
+ elsize = PyArray_ITEMSIZE(dest);
+
+ PyArray_INCREF(src);
+ PyArray_XDECREF(dest);
+
+ NPY_BEGIN_THREADS
+ while(dit->index < dit->size) {
+ /* strided copy of elsize bytes */
+ myfunc(dit->dataptr, dest->strides[maxaxis],
+ sit->dataptr, src->strides[maxaxis],
+ maxdim, elsize);
+ if (swap) {
+ _strided_byte_swap(dit->dataptr,
+ dest->strides[maxaxis],
+ dest->dimensions[maxaxis],
+ elsize);
+ }
+ PyArray_ITER_NEXT(dit);
+ PyArray_ITER_NEXT(sit);
+ }
+ NPY_END_THREADS
+
+ Py_DECREF(sit);
+ Py_DECREF(dit);
+ return 0;
+}
+
+static int
+_broadcast_copy(PyArrayObject *dest, PyArrayObject *src,
+ void (*myfunc)(char *, intp, char *, intp, intp, int),
+ int swap)
+{
+ int elsize;
+ PyArrayMultiIterObject *multi;
+ int maxaxis; intp maxdim;
+ NPY_BEGIN_THREADS_DEF
+
+ elsize = PyArray_ITEMSIZE(dest);
+ multi = (PyArrayMultiIterObject *)PyArray_MultiIterNew(2, dest, src);
+ if (multi == NULL) return -1;
+
+ if (multi->size != PyArray_SIZE(dest)) {
+ PyErr_SetString(PyExc_ValueError,
+ "array dimensions are not "\
+ "compatible for copy");
+ Py_DECREF(multi);
+ return -1;
+ }
+
+ maxaxis = PyArray_RemoveSmallest(multi);
+ if (maxaxis < 0) { /* copy 1 0-d array to another */
+ PyArray_INCREF(src);
+ PyArray_XDECREF(dest);
+ memcpy(dest->data, src->data, elsize);
+ if (swap) byte_swap_vector(dest->data, 1, elsize);
+ return 0;
+ }
+ maxdim = multi->dimensions[maxaxis];
+
+ /* Increment the source and decrement the destination
+ reference counts
+ */
+ PyArray_INCREF(src);
+ PyArray_XDECREF(dest);
+
+ NPY_BEGIN_THREADS
+ while(multi->index < multi->size) {
+ myfunc(multi->iters[0]->dataptr,
+ multi->iters[0]->strides[maxaxis],
+ multi->iters[1]->dataptr,
+ multi->iters[1]->strides[maxaxis],
+ maxdim, elsize);
+ if (swap) {
+ _strided_byte_swap(multi->iters[0]->dataptr,
+ multi->iters[0]->strides[maxaxis],
+ maxdim, elsize);
+ }
+ PyArray_MultiIter_NEXT(multi);
+ }
+ NPY_END_THREADS
+
+ Py_DECREF(multi);
+ return 0;
+}
+
+/* If destination is not the right type, then src
+ will be cast to destination -- this requires
+ src and dest to have the same shape
+*/
+
+/* Requires arrays to have broadcastable shapes
+
+ The arrays are assumed to have the same number of elements
+ They can be different sizes and have different types however.
+*/
+
+static int
+_array_copy_into(PyArrayObject *dest, PyArrayObject *src, int usecopy)
+{
+ int swap;
+ void (*myfunc)(char *, intp, char *, intp, intp, int);
+ int simple;
+ int same;
+ NPY_BEGIN_THREADS_DEF
+
+
+ if (!PyArray_EquivArrTypes(dest, src)) {
+ return PyArray_CastTo(dest, src);
+ }
+
+ if (!PyArray_ISWRITEABLE(dest)) {
+ PyErr_SetString(PyExc_RuntimeError,
+ "cannot write to array");
+ return -1;
+ }
+
+ same = PyArray_SAMESHAPE(dest, src);
+ simple = same && ((PyArray_ISCARRAY_RO(src) && PyArray_ISCARRAY(dest)) ||
+ (PyArray_ISFARRAY_RO(src) && PyArray_ISFARRAY(dest)));
+
+ if (simple) {
+ PyArray_INCREF(src);
+ PyArray_XDECREF(dest);
+ NPY_BEGIN_THREADS
+ if (usecopy)
+ memcpy(dest->data, src->data, PyArray_NBYTES(dest));
+ else
+ memmove(dest->data, src->data, PyArray_NBYTES(dest));
+ NPY_END_THREADS
+ return 0;
+ }
+
+ swap = PyArray_ISNOTSWAPPED(dest) != PyArray_ISNOTSWAPPED(src);
+
+ if (src->nd == 0) {
+ return _copy_from0d(dest, src, usecopy, swap);
+ }
+
+ if (PyArray_ISALIGNED(dest) && PyArray_ISALIGNED(src)) {
+ myfunc = _strided_byte_copy;
+ }
+ else if (usecopy) {
+ myfunc = _unaligned_strided_byte_copy;
+ }
+ else {
+ myfunc = _unaligned_strided_byte_move;
+ }
+
+ /* Could combine these because _broadcasted_copy would work as well.
+ But, same-shape copying is so common we want to speed it up.
+ */
+ if (same) {
+ return _copy_from_same_shape(dest, src, myfunc, swap);
+ }
+ else {
+ return _broadcast_copy(dest, src, myfunc, swap);
+ }
+}
+
+/*OBJECT_API
+ Copy an Array into another array -- memory must not overlap
+ Does not require src and dest to have "broadcastable" shapes
+ (only the same number of elements).
+*/
+static int
+PyArray_CopyAnyInto(PyArrayObject *dest, PyArrayObject *src)
+{
+ int elsize, simple;
+ PyArrayIterObject *idest, *isrc;
+ void (*myfunc)(char *, intp, char *, intp, intp, int);
+ NPY_BEGIN_THREADS_DEF
+
+ if (!PyArray_EquivArrTypes(dest, src)) {
+ return PyArray_CastAnyTo(dest, src);
+ }
+
+ if (!PyArray_ISWRITEABLE(dest)) {
+ PyErr_SetString(PyExc_RuntimeError,
+ "cannot write to array");
+ return -1;
+ }
+
+ if (PyArray_SIZE(dest) != PyArray_SIZE(src)) {
+ PyErr_SetString(PyExc_ValueError,
+ "arrays must have the same number of elements"
+ " for copy");
+ return -1;
+ }
+
+ simple = ((PyArray_ISCARRAY_RO(src) && PyArray_ISCARRAY(dest)) ||
+ (PyArray_ISFARRAY_RO(src) && PyArray_ISFARRAY(dest)));
+
+ if (simple) {
+ PyArray_INCREF(src);
+ PyArray_XDECREF(dest);
+ NPY_BEGIN_THREADS
+ memcpy(dest->data, src->data, PyArray_NBYTES(dest));
+ NPY_END_THREADS
+ return 0;
+ }
+
+ if (PyArray_SAMESHAPE(dest, src)) {
+ int swap;
+ if (PyArray_ISALIGNED(dest) && PyArray_ISALIGNED(src)) {
+ myfunc = _strided_byte_copy;
+ }
+ else {
+ myfunc = _unaligned_strided_byte_copy;
+ }
+ swap = PyArray_ISNOTSWAPPED(dest) != PyArray_ISNOTSWAPPED(src);
+ return _copy_from_same_shape(dest, src, myfunc, swap);
+ }
+
+ /* Otherwise we have to do an iterator-based copy */
+ idest = (PyArrayIterObject *)PyArray_IterNew((PyObject *)dest);
+ if (idest == NULL) return -1;
+ isrc = (PyArrayIterObject *)PyArray_IterNew((PyObject *)src);
+ if (isrc == NULL) {Py_DECREF(idest); return -1;}
+ elsize = dest->descr->elsize;
+ PyArray_INCREF(src);
+ PyArray_XDECREF(dest);
+ NPY_BEGIN_THREADS
+ while(idest->index < idest->size) {
+ memcpy(idest->dataptr, isrc->dataptr, elsize);
+ PyArray_ITER_NEXT(idest);
+ PyArray_ITER_NEXT(isrc);
+ }
+ NPY_END_THREADS
+ Py_DECREF(idest);
+ Py_DECREF(isrc);
+ return 0;
+}
+
+/*OBJECT_API
+ Copy an Array into another array -- memory must not overlap.
+*/
+static int
+PyArray_CopyInto(PyArrayObject *dest, PyArrayObject *src)
+{
+ return _array_copy_into(dest, src, 1);
+}
+
+
+/*OBJECT_API
+ Move the memory of one array into another.
+*/
+static int
+PyArray_MoveInto(PyArrayObject *dest, PyArrayObject *src)
+{
+ return _array_copy_into(dest, src, 0);
+}
+
+
+/*OBJECT_API*/
+static int
+PyArray_CopyObject(PyArrayObject *dest, PyObject *src_object)
+{
+ PyArrayObject *src;
+ PyObject *r;
+ int ret;
+
+ /* Special code to mimic Numeric behavior for
+ character arrays.
+ */
+ if (dest->descr->type == PyArray_CHARLTR && dest->nd > 0 \
+ && PyString_Check(src_object)) {
+ int n_new, n_old;
+ char *new_string;
+ PyObject *tmp;
+ n_new = dest->dimensions[dest->nd-1];
+ n_old = PyString_Size(src_object);
+ if (n_new > n_old) {
+ new_string = (char *)malloc(n_new);
+ memmove(new_string,
+ PyString_AS_STRING(src_object),
+ n_old);
+ memset(new_string+n_old, ' ', n_new-n_old);
+ tmp = PyString_FromStringAndSize(new_string, n_new);
+ free(new_string);
+ src_object = tmp;
+ }
+ }
+
+ if (PyArray_Check(src_object)) {
+ src = (PyArrayObject *)src_object;
+ Py_INCREF(src);
+ }
+ else if (!PyArray_IsScalar(src_object, Generic) &&
+ PyArray_HasArrayInterface(src_object, r)) {
+ src = (PyArrayObject *)r;
+ }
+ else {
+ PyArray_Descr* dtype;
+ dtype = dest->descr;
+ Py_INCREF(dtype);
+ src = (PyArrayObject *)PyArray_FromAny(src_object, dtype, 0,
+ dest->nd,
+ FORTRAN_IF(dest),
+ NULL);
+ }
+ if (src == NULL) return -1;
+
+ ret = PyArray_MoveInto(dest, src);
+ Py_DECREF(src);
+ return ret;
+}
+
+
+/* These are also old calls (should use PyArray_NewFromDescr) */
+
+/* They all zero-out the memory as previously done */
+
+/* steals reference to descr -- and enforces native byteorder on it.*/
+/*OBJECT_API
+ Like FromDimsAndData but uses the Descr structure instead of typecode
+ as input.
+*/
+static PyObject *
+PyArray_FromDimsAndDataAndDescr(int nd, int *d,
+ PyArray_Descr *descr,
+ char *data)
+{
+ PyObject *ret;
+#if SIZEOF_INTP != SIZEOF_INT
+ int i;
+ intp newd[MAX_DIMS];
+#endif
+
+ if (!PyArray_ISNBO(descr->byteorder))
+ descr->byteorder = '=';
+
+#if SIZEOF_INTP != SIZEOF_INT
+ for (i=0; i<nd; i++) newd[i] = (intp) d[i];
+ ret = PyArray_NewFromDescr(&PyArray_Type, descr,
+ nd, newd,
+ NULL, data,
+ (data ? CARRAY : 0), NULL);
+#else
+ ret = PyArray_NewFromDescr(&PyArray_Type, descr,
+ nd, (intp *)d,
+ NULL, data,
+ (data ? CARRAY : 0), NULL);
+#endif
+ return ret;
+}
+
+/*OBJECT_API
+ Construct an empty array from dimensions and typenum
+*/
+static PyObject *
+PyArray_FromDims(int nd, int *d, int type)
+{
+ PyObject *ret;
+ ret = PyArray_FromDimsAndDataAndDescr(nd, d,
+ PyArray_DescrFromType(type),
+ NULL);
+ /* Old FromDims set memory to zero --- some algorithms
+ relied on that. Better keep it the same. If
+ Object type, then it's already been set to zero, though.
+ */
+ if (ret && (PyArray_DESCR(ret)->type_num != PyArray_OBJECT)) {
+ memset(PyArray_DATA(ret), 0, PyArray_NBYTES(ret));
+ }
+ return ret;
+}
+
+/* end old calls */
+
+
+/*OBJECT_API
+ Copy an array.
+*/
+static PyObject *
+PyArray_NewCopy(PyArrayObject *m1, NPY_ORDER fortran)
+{
+ PyArrayObject *ret;
+ if (fortran == PyArray_ANYORDER)
+ fortran = PyArray_ISFORTRAN(m1);
+
+ Py_INCREF(m1->descr);
+ ret = (PyArrayObject *)PyArray_NewFromDescr(m1->ob_type,
+ m1->descr,
+ m1->nd,
+ m1->dimensions,
+ NULL, NULL,
+ fortran,
+ (PyObject *)m1);
+ if (ret == NULL) return NULL;
+ if (PyArray_CopyInto(ret, m1) == -1) {
+ Py_DECREF(ret);
+ return NULL;
+ }
+
+ return (PyObject *)ret;
+}
+
+static PyObject *array_big_item(PyArrayObject *, intp);
+
+/* Does nothing with descr (cannot be NULL) */
+/*OBJECT_API
+ Get scalar-equivalent to a region of memory described by a descriptor.
+*/
+static PyObject *
+PyArray_Scalar(void *data, PyArray_Descr *descr, PyObject *base)
+{
+ PyTypeObject *type;
+ PyObject *obj;
+ void *destptr;
+ PyArray_CopySwapFunc *copyswap;
+ int type_num;
+ int itemsize;
+ int swap;
+
+ type_num = descr->type_num;
+ if (type_num == PyArray_BOOL)
+ PyArrayScalar_RETURN_BOOL_FROM_LONG(*(Bool*)data);
+ else if (PyDataType_FLAGCHK(descr, NPY_USE_GETITEM)) {
+ return descr->f->getitem(data, base);
+ }
+ itemsize = descr->elsize;
+ copyswap = descr->f->copyswap;
+ type = descr->typeobj;
+ swap = !PyArray_ISNBO(descr->byteorder);
+ if PyTypeNum_ISSTRING(type_num) { /* Eliminate NULL bytes */
+ char *dptr = data;
+ dptr += itemsize-1;
+ while(itemsize && *dptr-- == 0) itemsize--;
+ if (type_num == PyArray_UNICODE && itemsize) {
+ /* make sure itemsize is a multiple of 4 */
+ /* so round up to nearest multiple */
+ itemsize = (((itemsize-1) >> 2) + 1) << 2;
+ }
+ }
+ if (type->tp_itemsize != 0) /* String type */
+ obj = type->tp_alloc(type, itemsize);
+ else
+ obj = type->tp_alloc(type, 0);
+ if (obj == NULL) return NULL;
+ if PyTypeNum_ISFLEXIBLE(type_num) {
+ if (type_num == PyArray_STRING) {
+ destptr = PyString_AS_STRING(obj);
+ ((PyStringObject *)obj)->ob_shash = -1;
+ ((PyStringObject *)obj)->ob_sstate = \
+ SSTATE_NOT_INTERNED;
+ memcpy(destptr, data, itemsize);
+ return obj;
+ }
+ else if (type_num == PyArray_UNICODE) {
+ PyUnicodeObject *uni = (PyUnicodeObject*)obj;
+ int length = itemsize >> 2;
+#ifndef Py_UNICODE_WIDE
+ char *buffer;
+ int alloc=0;
+ length *= 2;
+#endif
+ /* Need an extra slot and need to use
+ Python memory manager */
+ uni->str = NULL;
+ destptr = PyMem_NEW(Py_UNICODE,length+1);
+ if (destptr == NULL) {
+ Py_DECREF(obj);
+ return PyErr_NoMemory();
+ }
+ uni->str = (Py_UNICODE *)destptr;
+ uni->str[0] = 0;
+ uni->str[length] = 0;
+ uni->length = length;
+ uni->hash = -1;
+ uni->defenc = NULL;
+#ifdef Py_UNICODE_WIDE
+ memcpy(destptr, data, itemsize);
+ if (swap)
+ byte_swap_vector(destptr, length, 4);
+#else
+ /* need aligned data buffer */
+ if ((swap) || ((((intp)data) % descr->alignment) != 0)) {
+ buffer = _pya_malloc(itemsize);
+ if (buffer == NULL)
+ return PyErr_NoMemory();
+ alloc = 1;
+ memcpy(buffer, data, itemsize);
+ if (swap) {
+ byte_swap_vector(buffer,
+ itemsize >> 2, 4);
+ }
+ }
+ else buffer = data;
+
+ /* Allocated enough for 2-characters per itemsize.
+ Now convert from the data-buffer
+ */
+ length = PyUCS2Buffer_FromUCS4(uni->str,
+ (PyArray_UCS4 *)buffer,
+ itemsize >> 2);
+ if (alloc) _pya_free(buffer);
+ /* Resize the unicode result */
+ if (MyPyUnicode_Resize(uni, length) < 0) {
+ Py_DECREF(obj);
+ return NULL;
+ }
+#endif
+ return obj;
+ }
+ else {
+ PyVoidScalarObject *vobj = (PyVoidScalarObject *)obj;
+ vobj->base = NULL;
+ vobj->descr = descr;
+ Py_INCREF(descr);
+ vobj->obval = NULL;
+ vobj->ob_size = itemsize;
+ vobj->flags = BEHAVED | OWNDATA;
+ swap = 0;
+ if (descr->names) {
+ if (base) {
+ Py_INCREF(base);
+ vobj->base = base;
+ vobj->flags = PyArray_FLAGS(base);
+ vobj->flags &= ~OWNDATA;
+ vobj->obval = data;
+ return obj;
+ }
+ }
+ destptr = PyDataMem_NEW(itemsize);
+ if (destptr == NULL) {
+ Py_DECREF(obj);
+ return PyErr_NoMemory();
+ }
+ vobj->obval = destptr;
+ }
+ }
+ else {
+ destptr = scalar_value(obj, descr);
+ }
+ /* copyswap for OBJECT increments the reference count */
+ copyswap(destptr, data, swap, base);
+ return obj;
+}
+
+/* returns an Array-Scalar Object of the type of arr
+ from the given pointer to memory -- main Scalar creation function
+ default new method calls this.
+*/
+
+/* Ideally, here the descriptor would contain all the information needed.
+ So, that we simply need the data and the descriptor, and perhaps
+ a flag
+*/
+
+
+/* Return Array Scalar if 0-d array object is encountered */
+
+/*OBJECT_API
+ Return either an array or the appropriate Python object if the array
+ is 0d and matches a Python type.
+*/
+static PyObject *
+PyArray_Return(PyArrayObject *mp)
+{
+
+ if (mp == NULL) return NULL;
+
+ if (PyErr_Occurred()) {
+ Py_XDECREF(mp);
+ return NULL;
+ }
+
+ if (!PyArray_Check(mp)) return (PyObject *)mp;
+
+ if (mp->nd == 0) {
+ PyObject *ret;
+ ret = PyArray_ToScalar(mp->data, mp);
+ Py_DECREF(mp);
+ return ret;
+ }
+ else {
+ return (PyObject *)mp;
+ }
+}
+
+
+/*MULTIARRAY_API
+ Initialize arrfuncs to NULL
+*/
+static void
+PyArray_InitArrFuncs(PyArray_ArrFuncs *f)
+{
+ int i;
+ for (i=0; i<PyArray_NTYPES; i++) {
+ f->cast[i] = NULL;
+ }
+ f->getitem = NULL;
+ f->setitem = NULL;
+ f->copyswapn = NULL;
+ f->copyswap = NULL;
+ f->compare = NULL;
+ f->argmax = NULL;
+ f->dotfunc = NULL;
+ f->scanfunc = NULL;
+ f->fromstr = NULL;
+ f->nonzero = NULL;
+ f->fill = NULL;
+ f->fillwithscalar = NULL;
+ for (i=0; i<PyArray_NSORTS; i++) {
+ f->sort[i] = NULL;
+ f->argsort[i] = NULL;
+ }
+ f->castdict = NULL;
+ f->scalarkind = NULL;
+ f->cancastscalarkindto = NULL;
+ f->cancastto = NULL;
+}
+
+static Bool
+_default_nonzero(void *ip, void *arr)
+{
+ int elsize = PyArray_ITEMSIZE(arr);
+ char *ptr = ip;
+ while (elsize--) {
+ if (*ptr++ != 0) return TRUE;
+ }
+ return FALSE;
+}
+
+/*
+ Given a string return the type-number for
+ the data-type with that string as the type-object name.
+ Returns PyArray_NOTYPE without setting an error if no type can be
+ found. Only works for user-defined data-types.
+*/
+
+/*MULTIARRAY_API
+ */
+static int
+PyArray_TypeNumFromName(char *str)
+{
+ int i;
+ PyArray_Descr *descr;
+
+ for (i=0; i<NPY_NUMUSERTYPES; i++) {
+ descr = userdescrs[i];
+ if (strcmp(descr->typeobj->tp_name, str) == 0)
+ return descr->type_num;
+ }
+
+ return PyArray_NOTYPE;
+}
+
+/*
+ returns typenum to associate with this type >=PyArray_USERDEF.
+ needs the userdecrs table and PyArray_NUMUSER variables
+ defined in arraytypes.inc
+*/
+/*MULTIARRAY_API
+ Register Data type
+ Does not change the reference count of descr
+*/
+static int
+PyArray_RegisterDataType(PyArray_Descr *descr)
+{
+ PyArray_Descr *descr2;
+ int typenum;
+ int i;
+ PyArray_ArrFuncs *f;
+
+ /* See if this type is already registered */
+ for (i=0; i<NPY_NUMUSERTYPES; i++) {
+ descr2 = userdescrs[i];
+ if (descr2 == descr)
+ return descr->type_num;
+ }
+ typenum = PyArray_USERDEF + NPY_NUMUSERTYPES;
+ descr->type_num = typenum;
+ if (descr->elsize == 0) {
+ PyErr_SetString(PyExc_ValueError, "cannot register a" \
+ "flexible data-type");
+ return -1;
+ }
+ f = descr->f;
+ if (f->nonzero == NULL) {
+ f->nonzero = _default_nonzero;
+ }
+ if (f->copyswap == NULL || f->getitem == NULL ||
+ f->copyswapn == NULL || f->setitem == NULL) {
+ PyErr_SetString(PyExc_ValueError, "a required array function" \
+ " is missing.");
+ return -1;
+ }
+ if (descr->typeobj == NULL) {
+ PyErr_SetString(PyExc_ValueError, "missing typeobject");
+ return -1;
+ }
+ userdescrs = realloc(userdescrs,
+ (NPY_NUMUSERTYPES+1)*sizeof(void *));
+ if (userdescrs == NULL) {
+ PyErr_SetString(PyExc_MemoryError, "RegisterDataType");
+ return -1;
+ }
+ userdescrs[NPY_NUMUSERTYPES++] = descr;
+ return typenum;
+}
+
+/*MULTIARRAY_API
+ Register Casting Function
+ Replaces any function currently stored.
+*/
+static int
+PyArray_RegisterCastFunc(PyArray_Descr *descr, int totype,
+ PyArray_VectorUnaryFunc *castfunc)
+{
+ PyObject *cobj, *key;
+ int ret;
+ if (totype < PyArray_NTYPES) {
+ descr->f->cast[totype] = castfunc;
+ return 0;
+ }
+ if (!PyTypeNum_ISUSERDEF(totype)) {
+ PyErr_SetString(PyExc_TypeError, "invalid type number.");
+ return -1;
+ }
+ if (descr->f->castdict == NULL) {
+ descr->f->castdict = PyDict_New();
+ if (descr->f->castdict == NULL) return -1;
+ }
+ key = PyInt_FromLong(totype);
+ if (PyErr_Occurred()) return -1;
+ cobj = PyCObject_FromVoidPtr((void *)castfunc, NULL);
+ if (cobj == NULL) {Py_DECREF(key); return -1;}
+ ret = PyDict_SetItem(descr->f->castdict, key, cobj);
+ Py_DECREF(key);
+ Py_DECREF(cobj);
+ return ret;
+}
+
+static int *
+_append_new(int *types, int insert)
+{
+ int n=0;
+ int *newtypes;
+
+ while (types[n] != PyArray_NOTYPE) n++;
+ newtypes = (int *)realloc(types, (n+2)*sizeof(int));
+ newtypes[n] = insert;
+ newtypes[n+1] = PyArray_NOTYPE;
+ return newtypes;
+}
+
+/*MULTIARRAY_API
+ Register a type number indicating that a descriptor can be cast
+ to it safely
+*/
+static int
+PyArray_RegisterCanCast(PyArray_Descr *descr, int totype,
+ NPY_SCALARKIND scalar)
+{
+ if (scalar == PyArray_NOSCALAR) {
+ /* register with cancastto */
+ /* These lists won't be freed once created
+ -- they become part of the data-type */
+ if (descr->f->cancastto == NULL) {
+ descr->f->cancastto = (int *)malloc(1*sizeof(int));
+ descr->f->cancastto[0] = PyArray_NOTYPE;
+ }
+ descr->f->cancastto = _append_new(descr->f->cancastto,
+ totype);
+ }
+ else {
+ /* register with cancastscalarkindto */
+ if (descr->f->cancastscalarkindto == NULL) {
+ int i;
+ descr->f->cancastscalarkindto = \
+ (int **)malloc(PyArray_NSCALARKINDS* \
+ sizeof(int*));
+ for (i=0; i<PyArray_NSCALARKINDS; i++) {
+ descr->f->cancastscalarkindto[i] = NULL;
+ }
+ }
+ if (descr->f->cancastscalarkindto[scalar] == NULL) {
+ descr->f->cancastscalarkindto[scalar] = \
+ (int *)malloc(1*sizeof(int));
+ descr->f->cancastscalarkindto[scalar][0] = \
+ PyArray_NOTYPE;
+ }
+ descr->f->cancastscalarkindto[scalar] = \
+ _append_new(descr->f->cancastscalarkindto[scalar],
+ totype);
+ }
+ return 0;
+}
+
+/*OBJECT_API
+ To File
+*/
+static int
+PyArray_ToFile(PyArrayObject *self, FILE *fp, char *sep, char *format)
+{
+ intp size;
+ intp n, n2;
+ size_t n3, n4;
+ PyArrayIterObject *it;
+ PyObject *obj, *strobj, *tupobj;
+
+ n3 = (sep ? strlen((const char *)sep) : 0);
+ if (n3 == 0) { /* binary data */
+ if (PyDataType_FLAGCHK(self->descr, NPY_LIST_PICKLE)) {
+ PyErr_SetString(PyExc_ValueError, "cannot write " \
+ "object arrays to a file in " \
+ "binary mode");
+ return -1;
+ }
+
+ if (PyArray_ISCONTIGUOUS(self)) {
+ size = PyArray_SIZE(self);
+ NPY_BEGIN_ALLOW_THREADS
+ n=fwrite((const void *)self->data,
+ (size_t) self->descr->elsize,
+ (size_t) size, fp);
+ NPY_END_ALLOW_THREADS
+ if (n < size) {
+ PyErr_Format(PyExc_ValueError,
+ "%ld requested and %ld written",
+ (long) size, (long) n);
+ return -1;
+ }
+ }
+ else {
+ NPY_BEGIN_THREADS_DEF
+
+ it=(PyArrayIterObject *) \
+ PyArray_IterNew((PyObject *)self);
+ NPY_BEGIN_THREADS
+ while(it->index < it->size) {
+ if (fwrite((const void *)it->dataptr,
+ (size_t) self->descr->elsize,
+ 1, fp) < 1) {
+ NPY_END_THREADS
+ PyErr_Format(PyExc_IOError,
+ "problem writing element"\
+ " %d to file",
+ (int)it->index);
+ Py_DECREF(it);
+ return -1;
+ }
+ PyArray_ITER_NEXT(it);
+ }
+ NPY_END_THREADS
+ Py_DECREF(it);
+ }
+ }
+ else { /* text data */
+
+ it=(PyArrayIterObject *) \
+ PyArray_IterNew((PyObject *)self);
+ n4 = (format ? strlen((const char *)format) : 0);
+ while(it->index < it->size) {
+ obj = self->descr->f->getitem(it->dataptr, self);
+ if (obj == NULL) {Py_DECREF(it); return -1;}
+ if (n4 == 0) { /* standard writing */
+ strobj = PyObject_Str(obj);
+ Py_DECREF(obj);
+ if (strobj == NULL) {Py_DECREF(it); return -1;}
+ }
+ else { /* use format string */
+ tupobj = PyTuple_New(1);
+ if (tupobj == NULL) {Py_DECREF(it); return -1;}
+ PyTuple_SET_ITEM(tupobj,0,obj);
+ obj = PyString_FromString((const char *)format);
+ if (obj == NULL) {Py_DECREF(tupobj);
+ Py_DECREF(it); return -1;}
+ strobj = PyString_Format(obj, tupobj);
+ Py_DECREF(obj);
+ Py_DECREF(tupobj);
+ if (strobj == NULL) {Py_DECREF(it); return -1;}
+ }
+ NPY_BEGIN_ALLOW_THREADS
+ n=fwrite(PyString_AS_STRING(strobj), 1,
+ n2=PyString_GET_SIZE(strobj), fp);
+ NPY_END_ALLOW_THREADS
+ if (n < n2) {
+ PyErr_Format(PyExc_IOError,
+ "problem writing element %d"\
+ " to file",
+ (int) it->index);
+ Py_DECREF(strobj);
+ Py_DECREF(it);
+ return -1;
+ }
+ /* write separator for all but last one */
+ if (it->index != it->size-1)
+ if (fwrite(sep, 1, n3, fp) < n3) {
+ PyErr_Format(PyExc_IOError,
+ "problem writing "\
+ "separator to file");
+ Py_DECREF(strobj);
+ Py_DECREF(it);
+ return -1;
+ }
+ Py_DECREF(strobj);
+ PyArray_ITER_NEXT(it);
+ }
+ Py_DECREF(it);
+ }
+ return 0;
+}
+
+/*OBJECT_API
+ To List
+*/
+static PyObject *
+PyArray_ToList(PyArrayObject *self)
+{
+ PyObject *lp;
+ PyArrayObject *v;
+ intp sz, i;
+
+ if (!PyArray_Check(self)) return (PyObject *)self;
+
+ if (self->nd == 0)
+ return self->descr->f->getitem(self->data,self);
+
+ sz = self->dimensions[0];
+ lp = PyList_New(sz);
+
+ for (i=0; i<sz; i++) {
+ v=(PyArrayObject *)array_big_item(self, i);
+ if (v->nd >= self->nd) {
+ PyErr_SetString(PyExc_RuntimeError,
+ "array_item not returning smaller-" \
+ "dimensional array");
+ Py_DECREF(v);
+ Py_DECREF(lp);
+ return NULL;
+ }
+ PyList_SetItem(lp, i, PyArray_ToList(v));
+ Py_DECREF(v);
+ }
+
+ return lp;
+}
+
+/*OBJECT_API*/
+static PyObject *
+PyArray_ToString(PyArrayObject *self, NPY_ORDER order)
+{
+ intp numbytes;
+ intp index;
+ char *dptr;
+ int elsize;
+ PyObject *ret;
+ PyArrayIterObject *it;
+
+ if (order == NPY_ANYORDER)
+ order = PyArray_ISFORTRAN(self);
+
+ /* if (PyArray_TYPE(self) == PyArray_OBJECT) {
+ PyErr_SetString(PyExc_ValueError, "a string for the data" \
+ "in an object array is not appropriate");
+ return NULL;
+ }
+ */
+
+ numbytes = PyArray_NBYTES(self);
+ if ((PyArray_ISCONTIGUOUS(self) && (order == NPY_CORDER)) || \
+ (PyArray_ISFORTRAN(self) && (order == NPY_FORTRANORDER))) {
+ ret = PyString_FromStringAndSize(self->data, (int) numbytes);
+ }
+ else {
+ PyObject *new;
+ if (order == NPY_FORTRANORDER) {
+ /* iterators are always in C-order */
+ new = PyArray_Transpose(self, NULL);
+ if (new == NULL) return NULL;
+ }
+ else {
+ Py_INCREF(self);
+ new = (PyObject *)self;
+ }
+ it = (PyArrayIterObject *)PyArray_IterNew(new);
+ Py_DECREF(new);
+ if (it==NULL) return NULL;
+ ret = PyString_FromStringAndSize(NULL, (int) numbytes);
+ if (ret == NULL) {Py_DECREF(it); return NULL;}
+ dptr = PyString_AS_STRING(ret);
+ index = it->size;
+ elsize = self->descr->elsize;
+ while(index--) {
+ memcpy(dptr, it->dataptr, elsize);
+ dptr += elsize;
+ PyArray_ITER_NEXT(it);
+ }
+ Py_DECREF(it);
+ }
+ return ret;
+}
+
+
+/*********************** end C-API functions **********************/
+
+
+/* array object functions */
+
+static void
+array_dealloc(PyArrayObject *self) {
+
+ if (self->weakreflist != NULL)
+ PyObject_ClearWeakRefs((PyObject *)self);
+
+ if(self->base) {
+ /* UPDATEIFCOPY means that base points to an
+ array that should be updated with the contents
+ of this array upon destruction.
+ self->base->flags must have been WRITEABLE
+ (checked previously) and it was locked here
+ thus, unlock it.
+ */
+ if (self->flags & UPDATEIFCOPY) {
+ ((PyArrayObject *)self->base)->flags |= WRITEABLE;
+ Py_INCREF(self); /* hold on to self in next call */
+ if (PyArray_CopyAnyInto((PyArrayObject *)self->base,
+ self) < 0) {
+ PyErr_Print();
+ PyErr_Clear();
+ }
+ /* Don't need to DECREF -- because we are deleting
+ self already... */
+ }
+ /* In any case base is pointing to something that we need
+ to DECREF -- either a view or a buffer object */
+ Py_DECREF(self->base);
+ }
+
+ if ((self->flags & OWNDATA) && self->data) {
+ /* Free internal references if an Object array */
+ if (PyDataType_FLAGCHK(self->descr, NPY_ITEM_REFCOUNT)) {
+ Py_INCREF(self); /*hold on to self */
+ PyArray_XDECREF(self);
+ /* Don't need to DECREF -- because we are deleting
+ self already... */
+ }
+ PyDataMem_FREE(self->data);
+ }
+
+ PyDimMem_FREE(self->dimensions);
+
+ Py_DECREF(self->descr);
+
+ self->ob_type->tp_free((PyObject *)self);
+}
+
+/*************************************************************************
+ **************** Implement Mapping Protocol ***************************
+ *************************************************************************/
+
+static Py_ssize_t
+array_length(PyArrayObject *self)
+{
+ if (self->nd != 0) {
+ return self->dimensions[0];
+ } else {
+ PyErr_SetString(PyExc_TypeError, "len() of unsized object");
+ return -1;
+ }
+}
+
+static PyObject *
+array_big_item(PyArrayObject *self, intp i)
+{
+ char *item;
+ PyArrayObject *r;
+
+ if(self->nd == 0) {
+ PyErr_SetString(PyExc_IndexError,
+ "0-d arrays can't be indexed");
+ return NULL;
+ }
+ if ((item = index2ptr(self, i)) == NULL) return NULL;
+
+ Py_INCREF(self->descr);
+ r = (PyArrayObject *)PyArray_NewFromDescr(self->ob_type,
+ self->descr,
+ self->nd-1,
+ self->dimensions+1,
+ self->strides+1, item,
+ self->flags,
+ (PyObject *)self);
+ if (r == NULL) return NULL;
+ Py_INCREF(self);
+ r->base = (PyObject *)self;
+ PyArray_UpdateFlags(r, CONTIGUOUS | FORTRAN);
+ return (PyObject *)r;
+}
+
+/* contains optimization for 1-d arrays */
+static PyObject *
+array_item_nice(PyArrayObject *self, Py_ssize_t i)
+{
+ if (self->nd == 1) {
+ char *item;
+ if ((item = index2ptr(self, i)) == NULL) return NULL;
+ return PyArray_Scalar(item, self->descr, (PyObject *)self);
+ }
+ else {
+ return PyArray_Return((PyArrayObject *)\
+ array_big_item(self, (intp) i));
+ }
+}
+
+static int
+array_ass_big_item(PyArrayObject *self, intp i, PyObject *v)
+{
+ PyArrayObject *tmp;
+ char *item;
+ int ret;
+
+ if (v == NULL) {
+ PyErr_SetString(PyExc_ValueError,
+ "can't delete array elements");
+ return -1;
+ }
+ if (!PyArray_ISWRITEABLE(self)) {
+ PyErr_SetString(PyExc_RuntimeError,
+ "array is not writeable");
+ return -1;
+ }
+ if (self->nd == 0) {
+ PyErr_SetString(PyExc_IndexError,
+ "0-d arrays can't be indexed.");
+ return -1;
+ }
+
+
+ if (self->nd > 1) {
+ if((tmp = (PyArrayObject *)array_big_item(self, i)) == NULL)
+ return -1;
+ ret = PyArray_CopyObject(tmp, v);
+ Py_DECREF(tmp);
+ return ret;
+ }
+
+ if ((item = index2ptr(self, i)) == NULL) return -1;
+ if (self->descr->f->setitem(v, item, self) == -1) return -1;
+ return 0;
+}
+
+#if PY_VERSION_HEX < 0x02050000
+ #if SIZEOF_INT == SIZEOF_INTP
+ #define array_ass_item array_ass_big_item
+ #endif
+#else
+ #if SIZEOF_SIZE_T == SIZEOF_INTP
+ #define array_ass_item array_ass_big_item
+ #endif
+#endif
+#ifndef array_ass_item
+static int
+array_ass_item(PyArrayObject *self, Py_ssize_t i, PyObject *v)
+{
+ return array_ass_big_item(self, (intp) i, v);
+}
+#endif
+
+
+/* -------------------------------------------------------------- */
+static int
+slice_coerce_index(PyObject *o, intp *v)
+{
+ *v = PyArray_PyIntAsIntp(o);
+ if (error_converting(*v)) {
+ PyErr_Clear();
+ return 0;
+ }
+ return 1;
+}
+
+
+/* This is basically PySlice_GetIndicesEx, but with our coercion
+ * of indices to integers (plus, that function is new in Python 2.3) */
+static int
+slice_GetIndices(PySliceObject *r, intp length,
+ intp *start, intp *stop, intp *step,
+ intp *slicelength)
+{
+ intp defstop;
+
+ if (r->step == Py_None) {
+ *step = 1;
+ } else {
+ if (!slice_coerce_index(r->step, step)) return -1;
+ if (*step == 0) {
+ PyErr_SetString(PyExc_ValueError,
+ "slice step cannot be zero");
+ return -1;
+ }
+ }
+ /* defstart = *step < 0 ? length - 1 : 0; */
+
+ defstop = *step < 0 ? -1 : length;
+
+ if (r->start == Py_None) {
+ *start = *step < 0 ? length-1 : 0;
+ } else {
+ if (!slice_coerce_index(r->start, start)) return -1;
+ if (*start < 0) *start += length;
+ if (*start < 0) *start = (*step < 0) ? -1 : 0;
+ if (*start >= length) {
+ *start = (*step < 0) ? length - 1 : length;
+ }
+ }
+
+ if (r->stop == Py_None) {
+ *stop = defstop;
+ } else {
+ if (!slice_coerce_index(r->stop, stop)) return -1;
+ if (*stop < 0) *stop += length;
+ if (*stop < 0) *stop = -1;
+ if (*stop > length) *stop = length;
+ }
+
+ if ((*step < 0 && *stop >= *start) || \
+ (*step > 0 && *start >= *stop)) {
+ *slicelength = 0;
+ } else if (*step < 0) {
+ *slicelength = (*stop - *start + 1) / (*step) + 1;
+ } else {
+ *slicelength = (*stop - *start - 1) / (*step) + 1;
+ }
+
+ return 0;
+}
+
+#define PseudoIndex -1
+#define RubberIndex -2
+#define SingleIndex -3
+
+static intp
+parse_subindex(PyObject *op, intp *step_size, intp *n_steps, intp max)
+{
+ intp index;
+
+ if (op == Py_None) {
+ *n_steps = PseudoIndex;
+ index = 0;
+ } else if (op == Py_Ellipsis) {
+ *n_steps = RubberIndex;
+ index = 0;
+ } else if (PySlice_Check(op)) {
+ intp stop;
+ if (slice_GetIndices((PySliceObject *)op, max,
+ &index, &stop, step_size, n_steps) < 0) {
+ if (!PyErr_Occurred()) {
+ PyErr_SetString(PyExc_IndexError,
+ "invalid slice");
+ }
+ goto fail;
+ }
+ if (*n_steps <= 0) {
+ *n_steps = 0;
+ *step_size = 1;
+ index = 0;
+ }
+ } else {
+ index = PyArray_PyIntAsIntp(op);
+ if (error_converting(index)) {
+ PyErr_SetString(PyExc_IndexError,
+ "each subindex must be either a "\
+ "slice, an integer, Ellipsis, or "\
+ "newaxis");
+ goto fail;
+ }
+ *n_steps = SingleIndex;
+ *step_size = 0;
+ if (index < 0) index += max;
+ if (index >= max || index < 0) {
+ PyErr_SetString(PyExc_IndexError, "invalid index");
+ goto fail;
+ }
+ }
+ return index;
+ fail:
+ return -1;
+}
+
+
+static int
+parse_index(PyArrayObject *self, PyObject *op,
+ intp *dimensions, intp *strides, intp *offset_ptr)
+{
+ int i, j, n;
+ int nd_old, nd_new, n_add, n_pseudo;
+ intp n_steps, start, offset, step_size;
+ PyObject *op1=NULL;
+ int is_slice;
+
+ if (PySlice_Check(op) || op == Py_Ellipsis || op == Py_None) {
+ n = 1;
+ op1 = op;
+ Py_INCREF(op);
+ /* this relies on the fact that n==1 for loop below */
+ is_slice = 1;
+ }
+ else {
+ if (!PySequence_Check(op)) {
+ PyErr_SetString(PyExc_IndexError,
+ "index must be either an int "\
+ "or a sequence");
+ return -1;
+ }
+ n = PySequence_Length(op);
+ is_slice = 0;
+ }
+
+ nd_old = nd_new = 0;
+
+ offset = 0;
+ for(i=0; i<n; i++) {
+ if (!is_slice) {
+ if (!(op1=PySequence_GetItem(op, i))) {
+ PyErr_SetString(PyExc_IndexError,
+ "invalid index");
+ return -1;
+ }
+ }
+
+ start = parse_subindex(op1, &step_size, &n_steps,
+ nd_old < self->nd ? \
+ self->dimensions[nd_old] : 0);
+ Py_DECREF(op1);
+ if (start == -1) break;
+
+ if (n_steps == PseudoIndex) {
+ dimensions[nd_new] = 1; strides[nd_new] = 0;
+ nd_new++;
+ } else {
+ if (n_steps == RubberIndex) {
+ for(j=i+1, n_pseudo=0; j<n; j++) {
+ op1 = PySequence_GetItem(op, j);
+ if (op1 == Py_None) n_pseudo++;
+ Py_DECREF(op1);
+ }
+ n_add = self->nd-(n-i-n_pseudo-1+nd_old);
+ if (n_add < 0) {
+ PyErr_SetString(PyExc_IndexError,
+ "too many indices");
+ return -1;
+ }
+ for(j=0; j<n_add; j++) {
+ dimensions[nd_new] = \
+ self->dimensions[nd_old];
+ strides[nd_new] = \
+ self->strides[nd_old];
+ nd_new++; nd_old++;
+ }
+ } else {
+ if (nd_old >= self->nd) {
+ PyErr_SetString(PyExc_IndexError,
+ "too many indices");
+ return -1;
+ }
+ offset += self->strides[nd_old]*start;
+ nd_old++;
+ if (n_steps != SingleIndex) {
+ dimensions[nd_new] = n_steps;
+ strides[nd_new] = step_size * \
+ self->strides[nd_old-1];
+ nd_new++;
+ }
+ }
+ }
+ }
+ if (i < n) return -1;
+ n_add = self->nd-nd_old;
+ for(j=0; j<n_add; j++) {
+ dimensions[nd_new] = self->dimensions[nd_old];
+ strides[nd_new] = self->strides[nd_old];
+ nd_new++; nd_old++;
+ }
+ *offset_ptr = offset;
+ return nd_new;
+}
+
+static void
+_swap_axes(PyArrayMapIterObject *mit, PyArrayObject **ret, int getmap)
+{
+ PyObject *new;
+ int n1, n2, n3, val, bnd;
+ int i;
+ PyArray_Dims permute;
+ intp d[MAX_DIMS];
+ PyArrayObject *arr;
+
+ permute.ptr = d;
+ permute.len = mit->nd;
+
+ /* arr might not have the right number of dimensions
+ and need to be reshaped first by pre-pending ones */
+ arr = *ret;
+ if (arr->nd != mit->nd) {
+ for (i=1; i<=arr->nd; i++) {
+ permute.ptr[mit->nd-i] = arr->dimensions[arr->nd-i];
+ }
+ for (i=0; i<mit->nd-arr->nd; i++) {
+ permute.ptr[i] = 1;
+ }
+ new = PyArray_Newshape(arr, &permute, PyArray_ANYORDER);
+ Py_DECREF(arr);
+ *ret = (PyArrayObject *)new;
+ if (new == NULL) return;
+ }
+
+ /* Setting and getting need to have different permutations.
+ On the get we are permuting the returned object, but on
+ setting we are permuting the object-to-be-set.
+ The set permutation is the inverse of the get permutation.
+ */
+
+ /* For getting the array the tuple for transpose is
+ (n1,...,n1+n2-1,0,...,n1-1,n1+n2,...,n3-1)
+ n1 is the number of dimensions of
+ the broadcasted index array
+ n2 is the number of dimensions skipped at the
+ start
+ n3 is the number of dimensions of the
+ result
+ */
+
+ /* For setting the array the tuple for transpose is
+ (n2,...,n1+n2-1,0,...,n2-1,n1+n2,...n3-1)
+ */
+ n1 = mit->iters[0]->nd_m1 + 1;
+ n2 = mit->iteraxes[0];
+ n3 = mit->nd;
+
+ bnd = (getmap ? n1 : n2); /* use n1 as the boundary if getting
+ but n2 if setting */
+
+ val = bnd;
+ i = 0;
+ while(val < n1+n2)
+ permute.ptr[i++] = val++;
+ val = 0;
+ while(val < bnd)
+ permute.ptr[i++] = val++;
+ val = n1+n2;
+ while(val < n3)
+ permute.ptr[i++] = val++;
+
+ new = PyArray_Transpose(*ret, &permute);
+ Py_DECREF(*ret);
+ *ret = (PyArrayObject *)new;
+}
+
+/* Prototypes for Mapping calls --- not part of the C-API
+ because only useful as part of a getitem call.
+*/
+
+static void PyArray_MapIterReset(PyArrayMapIterObject *);
+static void PyArray_MapIterNext(PyArrayMapIterObject *);
+static void PyArray_MapIterBind(PyArrayMapIterObject *, PyArrayObject *);
+static PyObject* PyArray_MapIterNew(PyObject *, int, int);
+
+static PyObject *
+PyArray_GetMap(PyArrayMapIterObject *mit)
+{
+
+ PyArrayObject *ret, *temp;
+ PyArrayIterObject *it;
+ int index;
+ int swap;
+ PyArray_CopySwapFunc *copyswap;
+
+ /* Unbound map iterator --- Bind should have been called */
+ if (mit->ait == NULL) return NULL;
+
+ /* This relies on the map iterator object telling us the shape
+ of the new array in nd and dimensions.
+ */
+ temp = mit->ait->ao;
+ Py_INCREF(temp->descr);
+ ret = (PyArrayObject *)\
+ PyArray_NewFromDescr(temp->ob_type,
+ temp->descr,
+ mit->nd, mit->dimensions,
+ NULL, NULL,
+ PyArray_ISFORTRAN(temp),
+ (PyObject *)temp);
+ if (ret == NULL) return NULL;
+
+ /* Now just iterate through the new array filling it in
+ with the next object from the original array as
+ defined by the mapping iterator */
+
+ if ((it = (PyArrayIterObject *)PyArray_IterNew((PyObject *)ret))
+ == NULL) {
+ Py_DECREF(ret);
+ return NULL;
+ }
+ index = it->size;
+ swap = (PyArray_ISNOTSWAPPED(temp) != PyArray_ISNOTSWAPPED(ret));
+ copyswap = ret->descr->f->copyswap;
+ PyArray_MapIterReset(mit);
+ while (index--) {
+ copyswap(it->dataptr, mit->dataptr, swap, ret);
+ PyArray_MapIterNext(mit);
+ PyArray_ITER_NEXT(it);
+ }
+ Py_DECREF(it);
+
+ /* check for consecutive axes */
+ if ((mit->subspace != NULL) && (mit->consec)) {
+ if (mit->iteraxes[0] > 0) { /* then we need to swap */
+ _swap_axes(mit, &ret, 1);
+ }
+ }
+ return (PyObject *)ret;
+}
+
+static int
+PyArray_SetMap(PyArrayMapIterObject *mit, PyObject *op)
+{
+ PyObject *arr=NULL;
+ PyArrayIterObject *it;
+ int index;
+ int swap;
+ PyArray_CopySwapFunc *copyswap;
+ PyArray_Descr *descr;
+
+ /* Unbound Map Iterator */
+ if (mit->ait == NULL) return -1;
+
+ descr = mit->ait->ao->descr;
+ Py_INCREF(descr);
+ arr = PyArray_FromAny(op, descr, 0, 0, FORCECAST, NULL);
+ if (arr == NULL) return -1;
+
+ if ((mit->subspace != NULL) && (mit->consec)) {
+ if (mit->iteraxes[0] > 0) { /* then we need to swap */
+ _swap_axes(mit, (PyArrayObject **)&arr, 0);
+ if (arr == NULL) return -1;
+ }
+ }
+
+ /* Be sure values array is "broadcastable"
+ to shape of mit->dimensions, mit->nd */
+
+ if ((it = (PyArrayIterObject *)\
+ PyArray_BroadcastToShape(arr, mit->dimensions, mit->nd))==NULL) {
+ Py_DECREF(arr);
+ return -1;
+ }
+
+ index = mit->size;
+ swap = (PyArray_ISNOTSWAPPED(mit->ait->ao) != \
+ (PyArray_ISNOTSWAPPED(arr)));
+ copyswap = PyArray_DESCR(arr)->f->copyswap;
+ PyArray_MapIterReset(mit);
+ /* Need to decref hasobject arrays */
+ if (PyDataType_FLAGCHK(descr, NPY_ITEM_REFCOUNT)) {
+ while (index--) {
+ PyArray_Item_XDECREF(mit->dataptr, PyArray_DESCR(arr));
+ PyArray_Item_INCREF(it->dataptr, PyArray_DESCR(arr));
+ memmove(mit->dataptr, it->dataptr, sizeof(PyObject *));
+ /* ignored unless VOID array with object's */
+ if (swap)
+ copyswap(mit->dataptr, NULL, swap, arr);
+ PyArray_MapIterNext(mit);
+ PyArray_ITER_NEXT(it);
+ }
+ Py_DECREF(arr);
+ Py_DECREF(it);
+ return 0;
+ }
+ while(index--) {
+ memmove(mit->dataptr, it->dataptr, PyArray_ITEMSIZE(arr));
+ if (swap)
+ copyswap(mit->dataptr, NULL, swap, arr);
+ PyArray_MapIterNext(mit);
+ PyArray_ITER_NEXT(it);
+ }
+ Py_DECREF(arr);
+ Py_DECREF(it);
+ return 0;
+}
+
+int
+count_new_axes_0d(PyObject *tuple)
+{
+ int i, argument_count;
+ int ellipsis_count = 0;
+ int newaxis_count = 0;
+
+ argument_count = PyTuple_GET_SIZE(tuple);
+
+ for (i = 0; i < argument_count; ++i) {
+ PyObject *arg = PyTuple_GET_ITEM(tuple, i);
+ if (arg == Py_Ellipsis && !ellipsis_count) ellipsis_count++;
+ else if (arg == Py_None) newaxis_count++;
+ else break;
+ }
+ if (i < argument_count) {
+ PyErr_SetString(PyExc_IndexError,
+ "0-d arrays can only use a single ()"
+ " or a list of newaxes (and a single ...)"
+ " as an index");
+ return -1;
+ }
+ if (newaxis_count > MAX_DIMS) {
+ PyErr_SetString(PyExc_IndexError,
+ "too many dimensions");
+ return -1;
+ }
+ return newaxis_count;
+}
+
+static PyObject *
+add_new_axes_0d(PyArrayObject *arr, int newaxis_count)
+{
+ PyArrayObject *other;
+ intp dimensions[MAX_DIMS];
+ int i;
+ for (i = 0; i < newaxis_count; ++i) {
+ dimensions[i] = 1;
+ }
+ Py_INCREF(arr->descr);
+ if ((other = (PyArrayObject *)
+ PyArray_NewFromDescr(arr->ob_type, arr->descr,
+ newaxis_count, dimensions,
+ NULL, arr->data,
+ arr->flags,
+ (PyObject *)arr)) == NULL)
+ return NULL;
+ other->base = (PyObject *)arr;
+ Py_INCREF(arr);
+ return (PyObject *)other;
+}
+
+
+/* This checks the args for any fancy indexing objects */
+
+#define SOBJ_NOTFANCY 0
+#define SOBJ_ISFANCY 1
+#define SOBJ_BADARRAY 2
+#define SOBJ_TOOMANY 3
+#define SOBJ_LISTTUP 4
+
+static int
+fancy_indexing_check(PyObject *args)
+{
+ int i, n;
+ PyObject *obj;
+ int retval = SOBJ_NOTFANCY;
+
+ if (PyTuple_Check(args)) {
+ n = PyTuple_GET_SIZE(args);
+ if (n >= MAX_DIMS) return SOBJ_TOOMANY;
+ for (i=0; i<n; i++) {
+ obj = PyTuple_GET_ITEM(args,i);
+ if (PyArray_Check(obj)) {
+ if (PyArray_ISINTEGER(obj) ||
+ PyArray_ISBOOL(obj))
+ retval = SOBJ_ISFANCY;
+ else {
+ retval = SOBJ_BADARRAY;
+ break;
+ }
+ }
+ else if (PySequence_Check(obj)) {
+ retval = SOBJ_ISFANCY;
+ }
+ }
+ }
+ else if (PyArray_Check(args)) {
+ if ((PyArray_TYPE(args)==PyArray_BOOL) ||
+ (PyArray_ISINTEGER(args)))
+ return SOBJ_ISFANCY;
+ else
+ return SOBJ_BADARRAY;
+ }
+ else if (PySequence_Check(args)) {
+ /* Sequences < MAX_DIMS with any slice objects
+ or newaxis, or Ellipsis is considered standard
+ as long as there are also no Arrays and or additional
+ sequences embedded.
+ */
+ retval = SOBJ_ISFANCY;
+ n = PySequence_Size(args);
+ if (n<0 || n>=MAX_DIMS) return SOBJ_ISFANCY;
+ for (i=0; i<n; i++) {
+ obj = PySequence_GetItem(args, i);
+ if (obj == NULL) return SOBJ_ISFANCY;
+ if (PyArray_Check(obj)) {
+ if (PyArray_ISINTEGER(obj) ||
+ PyArray_ISBOOL(obj))
+ retval = SOBJ_LISTTUP;
+ else
+ retval = SOBJ_BADARRAY;
+ }
+ else if (PySequence_Check(obj)) {
+ retval = SOBJ_LISTTUP;
+ }
+ else if (PySlice_Check(obj) || obj == Py_Ellipsis ||
+ obj == Py_None) {
+ retval = SOBJ_NOTFANCY;
+ }
+ Py_DECREF(obj);
+ if (retval > SOBJ_ISFANCY) return retval;
+ }
+ }
+ return retval;
+}
+
+/* Called when treating array object like a mapping -- called first from
+ Python when using a[object] unless object is a standard slice object
+ (not an extended one).
+
+*/
+
+/* There are two situations:
+
+ 1 - the subscript is a standard view and a reference to the
+ array can be returned
+
+ 2 - the subscript uses Boolean masks or integer indexing and
+ therefore a new array is created and returned.
+
+*/
+
+/* Always returns arrays */
+
+static PyObject *iter_subscript(PyArrayIterObject *, PyObject *);
+
+
+static PyObject *
+array_subscript_simple(PyArrayObject *self, PyObject *op)
+{
+ intp dimensions[MAX_DIMS], strides[MAX_DIMS];
+ intp offset;
+ int nd;
+ PyArrayObject *other;
+ intp value;
+
+ value = PyArray_PyIntAsIntp(op);
+ if (!PyErr_Occurred()) {
+ return array_big_item(self, value);
+ }
+ PyErr_Clear();
+
+ /* Standard (view-based) Indexing */
+ if ((nd = parse_index(self, op, dimensions, strides, &offset))
+ == -1) return NULL;
+
+ /* This will only work if new array will be a view */
+ Py_INCREF(self->descr);
+ if ((other = (PyArrayObject *) \
+ PyArray_NewFromDescr(self->ob_type, self->descr,
+ nd, dimensions,
+ strides, self->data+offset,
+ self->flags,
+ (PyObject *)self)) == NULL)
+ return NULL;
+
+ other->base = (PyObject *)self;
+ Py_INCREF(self);
+
+ PyArray_UpdateFlags(other, UPDATE_ALL);
+
+ return (PyObject *)other;
+}
+
+static PyObject *
+array_subscript(PyArrayObject *self, PyObject *op)
+{
+ int nd, fancy;
+ PyArrayObject *other;
+ PyArrayMapIterObject *mit;
+
+ if (PyString_Check(op) || PyUnicode_Check(op)) {
+ if (self->descr->names) {
+ PyObject *obj;
+ obj = PyDict_GetItem(self->descr->fields, op);
+ if (obj != NULL) {
+ PyArray_Descr *descr;
+ int offset;
+ PyObject *title;
+
+ if (PyArg_ParseTuple(obj, "Oi|O",
+ &descr, &offset, &title)) {
+ Py_INCREF(descr);
+ return PyArray_GetField(self, descr,
+ offset);
+ }
+ }
+ }
+
+ PyErr_Format(PyExc_ValueError,
+ "field named %s not found.",
+ PyString_AsString(op));
+ return NULL;
+ }
+
+ if (self->nd == 0) {
+ if (op == Py_Ellipsis) {
+ /* XXX: This leads to a small inconsistency
+ XXX: with the nd>0 case where (x[...] is x)
+ XXX: is false for nd>0 case. */
+ Py_INCREF(self);
+ return (PyObject *)self;
+ }
+ if (op == Py_None)
+ return add_new_axes_0d(self, 1);
+ if (PyTuple_Check(op)) {
+ if (0 == PyTuple_GET_SIZE(op)) {
+ Py_INCREF(self);
+ return (PyObject *)self;
+ }
+ if ((nd = count_new_axes_0d(op)) == -1)
+ return NULL;
+ return add_new_axes_0d(self, nd);
+ }
+ /* Allow Boolean mask selection also */
+ if (PyBool_Check(op) || PyArray_IsScalar(op, Bool) ||
+ (PyArray_Check(op) && (PyArray_DIMS(op)==0) &&
+ PyArray_ISBOOL(op))) {
+ if (PyObject_IsTrue(op)) {
+ Py_INCREF(self);
+ return (PyObject *)self;
+ }
+ else {
+ intp oned = 0;
+ Py_INCREF(self->descr);
+ return PyArray_NewFromDescr(self->ob_type,
+ self->descr,
+ 1, &oned,
+ NULL, NULL,
+ NPY_DEFAULT,
+ NULL);
+ }
+ }
+ PyErr_SetString(PyExc_IndexError,
+ "0-d arrays can't be indexed.");
+ return NULL;
+ }
+
+ fancy = fancy_indexing_check(op);
+
+ if (fancy != SOBJ_NOTFANCY) {
+ int oned;
+ oned = ((self->nd == 1) &&
+ !(PyTuple_Check(op) && PyTuple_GET_SIZE(op) > 1));
+
+ /* wrap arguments into a mapiter object */
+ mit = (PyArrayMapIterObject *)\
+ PyArray_MapIterNew(op, oned, fancy);
+ if (mit == NULL) return NULL;
+ if (oned) {
+ PyArrayIterObject *it;
+ PyObject *rval;
+ it = (PyArrayIterObject *)\
+ PyArray_IterNew((PyObject *)self);
+ if (it == NULL) {Py_DECREF(mit); return NULL;}
+ rval = iter_subscript(it, mit->indexobj);
+ Py_DECREF(it);
+ Py_DECREF(mit);
+ return rval;
+ }
+ PyArray_MapIterBind(mit, self);
+ other = (PyArrayObject *)PyArray_GetMap(mit);
+ Py_DECREF(mit);
+ return (PyObject *)other;
+ }
+
+ return array_subscript_simple(self, op);
+}
+
+
+/* Another assignment hacked by using CopyObject. */
+
+/* This only works if subscript returns a standard view. */
+
+/* Again there are two cases. In the first case, PyArray_CopyObject
+ can be used. In the second case, a new indexing function has to be
+ used.
+*/
+
+static int iter_ass_subscript(PyArrayIterObject *, PyObject *, PyObject *);
+
+static int
+array_ass_sub_simple(PyArrayObject *self, PyObject *index, PyObject *op)
+{
+ int ret;
+ PyArrayObject *tmp;
+ intp value;
+
+ value = PyArray_PyIntAsIntp(index);
+ if (!error_converting(value)) {
+ return array_ass_big_item(self, value, op);
+ }
+ PyErr_Clear();
+
+ /* Rest of standard (view-based) indexing */
+
+ if (PyArray_CheckExact(self)) {
+ tmp = (PyArrayObject *)array_subscript_simple(self, index);
+ if (tmp == NULL) return -1;
+ }
+ else {
+ PyObject *tmp0;
+ tmp0 = PyObject_GetItem((PyObject *)self, index);
+ if (tmp0 == NULL) return -1;
+ if (!PyArray_Check(tmp0)) {
+ PyErr_SetString(PyExc_RuntimeError,
+ "Getitem not returning array.");
+ Py_DECREF(tmp0);
+ return -1;
+ }
+ tmp = (PyArrayObject *)tmp0;
+ }
+
+ if (PyArray_ISOBJECT(self) && (tmp->nd == 0)) {
+ ret = tmp->descr->f->setitem(op, tmp->data, tmp);
+ }
+ else {
+ ret = PyArray_CopyObject(tmp, op);
+ }
+ Py_DECREF(tmp);
+ return ret;
+}
+
+
+/* return -1 if tuple-object seq is not a tuple of integers.
+ otherwise fill vals with converted integers
+*/
+static int
+_tuple_of_integers(PyObject *seq, intp *vals, int maxvals)
+{
+ int i;
+ PyObject *obj;
+ intp temp;
+
+ for (i=0; i<maxvals; i++) {
+ obj = PyTuple_GET_ITEM(seq, i);
+ if ((PyArray_Check(obj) && PyArray_NDIM(obj) > 0) ||
+ PyList_Check(obj)) return -1;
+ temp = PyArray_PyIntAsIntp(obj);
+ if (error_converting(temp)) return -1;
+ vals[i] = temp;
+ }
+ return 0;
+}
+
+
+static int
+array_ass_sub(PyArrayObject *self, PyObject *index, PyObject *op)
+{
+ int ret, oned, fancy;
+ PyArrayMapIterObject *mit;
+ intp vals[MAX_DIMS];
+
+ if (op == NULL) {
+ PyErr_SetString(PyExc_ValueError,
+ "cannot delete array elements");
+ return -1;
+ }
+ if (!PyArray_ISWRITEABLE(self)) {
+ PyErr_SetString(PyExc_RuntimeError,
+ "array is not writeable");
+ return -1;
+ }
+
+ if (PyInt_Check(index) || PyArray_IsScalar(index, Integer) ||
+ PyLong_Check(index) || (PyIndex_Check(index) &&
+ !PySequence_Check(index))) {
+ intp value;
+ value = PyArray_PyIntAsIntp(index);
+ if (PyErr_Occurred())
+ PyErr_Clear();
+ else
+ return array_ass_big_item(self, value, op);
+ }
+
+ if (PyString_Check(index) || PyUnicode_Check(index)) {
+ if (self->descr->names) {
+ PyObject *obj;
+ obj = PyDict_GetItem(self->descr->fields, index);
+ if (obj != NULL) {
+ PyArray_Descr *descr;
+ int offset;
+ PyObject *title;
+
+ if (PyArg_ParseTuple(obj, "Oi|O",
+ &descr, &offset, &title)) {
+ Py_INCREF(descr);
+ return PyArray_SetField(self, descr,
+ offset, op);
+ }
+ }
+ }
+
+ PyErr_Format(PyExc_ValueError,
+ "field named %s not found.",
+ PyString_AsString(index));
+ return -1;
+ }
+
+ if (self->nd == 0) {
+ /* Several different exceptions to the 0-d no-indexing rule
+
+ 1) ellipses
+ 2) empty tuple
+ 3) Using newaxis (None)
+ 4) Boolean mask indexing
+ */
+ if (index == Py_Ellipsis || index == Py_None || \
+ (PyTuple_Check(index) && (0 == PyTuple_GET_SIZE(index) || \
+ count_new_axes_0d(index) > 0)))
+ return self->descr->f->setitem(op, self->data, self);
+ if (PyBool_Check(index) || PyArray_IsScalar(index, Bool) ||
+ (PyArray_Check(index) && (PyArray_DIMS(index)==0) &&
+ PyArray_ISBOOL(index))) {
+ if (PyObject_IsTrue(index)) {
+ return self->descr->f->setitem(op, self->data, self);
+ }
+ else { /* don't do anything */
+ return 0;
+ }
+ }
+ PyErr_SetString(PyExc_IndexError,
+ "0-d arrays can't be indexed.");
+ return -1;
+ }
+
+ /* optimization for integer-tuple */
+ if (self->nd > 1 &&
+ (PyTuple_Check(index) && (PyTuple_GET_SIZE(index) == self->nd))
+ && (_tuple_of_integers(index, vals, self->nd) >= 0)) {
+ int i;
+ char *item;
+ for (i=0; i<self->nd; i++) {
+ if (vals[i] < 0) vals[i] += self->dimensions[i];
+ if ((vals[i] < 0) || (vals[i] >= self->dimensions[i])) {
+ PyErr_Format(PyExc_IndexError,
+ "index (%"INTP_FMT") out of range "\
+ "(0<=index<%"INTP_FMT") in dimension %d",
+ vals[i], self->dimensions[i], i);
+ return -1;
+ }
+ }
+ item = PyArray_GetPtr(self, vals);
+ /* fprintf(stderr, "Here I am...\n");*/
+ return self->descr->f->setitem(op, item, self);
+ }
+ PyErr_Clear();
+
+ fancy = fancy_indexing_check(index);
+
+ if (fancy != SOBJ_NOTFANCY) {
+ oned = ((self->nd == 1) &&
+ !(PyTuple_Check(index) && PyTuple_GET_SIZE(index) > 1));
+
+ mit = (PyArrayMapIterObject *) \
+ PyArray_MapIterNew(index, oned, fancy);
+ if (mit == NULL) return -1;
+ if (oned) {
+ PyArrayIterObject *it;
+ int rval;
+ it = (PyArrayIterObject *)PyArray_IterNew((PyObject *)self);
+ if (it == NULL) {Py_DECREF(mit); return -1;}
+ rval = iter_ass_subscript(it, mit->indexobj, op);
+ Py_DECREF(it);
+ Py_DECREF(mit);
+ return rval;
+ }
+ PyArray_MapIterBind(mit, self);
+ ret = PyArray_SetMap(mit, op);
+ Py_DECREF(mit);
+ return ret;
+ }
+
+ return array_ass_sub_simple(self, index, op);
+}
+
+
+/* There are places that require that array_subscript return a PyArrayObject
+ and not possibly a scalar. Thus, this is the function exposed to
+ Python so that 0-dim arrays are passed as scalars
+*/
+
+
+static PyObject *
+array_subscript_nice(PyArrayObject *self, PyObject *op)
+{
+
+ PyArrayObject *mp;
+ intp vals[MAX_DIMS];
+
+ if (PyInt_Check(op) || PyArray_IsScalar(op, Integer) || \
+ PyLong_Check(op) || (PyIndex_Check(op) &&
+ !PySequence_Check(op))) {
+ intp value;
+ value = PyArray_PyIntAsIntp(op);
+ if (PyErr_Occurred())
+ PyErr_Clear();
+ else {
+ return array_item_nice(self, (Py_ssize_t) value);
+ }
+ }
+ /* optimization for a tuple of integers */
+ if (self->nd > 1 && PyTuple_Check(op) &&
+ (PyTuple_GET_SIZE(op) == self->nd)
+ && (_tuple_of_integers(op, vals, self->nd) >= 0)) {
+ int i;
+ char *item;
+ for (i=0; i<self->nd; i++) {
+ if (vals[i] < 0) vals[i] += self->dimensions[i];
+ if ((vals[i] < 0) || (vals[i] >= self->dimensions[i])) {
+ PyErr_Format(PyExc_IndexError,
+ "index (%"INTP_FMT") out of range "\
+ "(0<=index<=%"INTP_FMT") in dimension %d",
+ vals[i], self->dimensions[i], i);
+ return NULL;
+ }
+ }
+ item = PyArray_GetPtr(self, vals);
+ return PyArray_Scalar(item, self->descr, (PyObject *)self);
+ }
+ PyErr_Clear();
+
+ mp = (PyArrayObject *)array_subscript(self, op);
+
+ /* The following is just a copy of PyArray_Return with an
+ additional logic in the nd == 0 case.
+ */
+
+ if (mp == NULL) return NULL;
+
+ if (PyErr_Occurred()) {
+ Py_XDECREF(mp);
+ return NULL;
+ }
+
+ if (mp->nd == 0) {
+ Bool noellipses = TRUE;
+ if ((op == Py_Ellipsis) || PyString_Check(op) || PyUnicode_Check(op))
+ noellipses = FALSE;
+ else if (PyBool_Check(op) || PyArray_IsScalar(op, Bool) ||
+ (PyArray_Check(op) && (PyArray_DIMS(op)==0) &&
+ PyArray_ISBOOL(op)))
+ noellipses = FALSE;
+ else if (PySequence_Check(op)) {
+ int n, i;
+ PyObject *temp;
+ n = PySequence_Size(op);
+ i=0;
+ while (i<n && noellipses) {
+ temp = PySequence_GetItem(op, i);
+ if (temp == Py_Ellipsis)
+ noellipses = FALSE;
+ Py_DECREF(temp);
+ i++;
+ }
+ }
+ if (noellipses) {
+ PyObject *ret;
+ ret = PyArray_ToScalar(mp->data, mp);
+ Py_DECREF(mp);
+ return ret;
+ }
+ }
+ return (PyObject *)mp;
+}
+
+
+static PyMappingMethods array_as_mapping = {
+#if PY_VERSION_HEX >= 0x02050000
+ (lenfunc)array_length, /*mp_length*/
+#else
+ (inquiry)array_length, /*mp_length*/
+#endif
+ (binaryfunc)array_subscript_nice, /*mp_subscript*/
+ (objobjargproc)array_ass_sub, /*mp_ass_subscript*/
+};
+
+/****************** End of Mapping Protocol ******************************/
+
+
+/*************************************************************************
+ **************** Implement Buffer Protocol ****************************
+ *************************************************************************/
+
+/* removed multiple segment interface */
+
+static Py_ssize_t
+array_getsegcount(PyArrayObject *self, Py_ssize_t *lenp)
+{
+ if (lenp)
+ *lenp = PyArray_NBYTES(self);
+
+ if (PyArray_ISONESEGMENT(self)) {
+ return 1;
+ }
+
+ if (lenp)
+ *lenp = 0;
+ return 0;
+}
+
+static Py_ssize_t
+array_getreadbuf(PyArrayObject *self, Py_ssize_t segment, void **ptrptr)
+{
+ if (segment != 0) {
+ PyErr_SetString(PyExc_ValueError,
+ "accessing non-existing array segment");
+ return -1;
+ }
+
+ if (PyArray_ISONESEGMENT(self)) {
+ *ptrptr = self->data;
+ return PyArray_NBYTES(self);
+ }
+ PyErr_SetString(PyExc_ValueError, "array is not a single segment");
+ *ptrptr = NULL;
+ return -1;
+}
+
+
+static Py_ssize_t
+array_getwritebuf(PyArrayObject *self, Py_ssize_t segment, void **ptrptr)
+{
+ if (PyArray_CHKFLAGS(self, WRITEABLE))
+ return array_getreadbuf(self, segment, (void **) ptrptr);
+ else {
+ PyErr_SetString(PyExc_ValueError, "array cannot be "\
+ "accessed as a writeable buffer");
+ return -1;
+ }
+}
+
+static Py_ssize_t
+array_getcharbuf(PyArrayObject *self, Py_ssize_t segment, constchar **ptrptr)
+{
+ if (self->descr->type_num == PyArray_STRING || \
+ self->descr->type_num == PyArray_UNICODE || \
+ self->descr->elsize == 1)
+ return array_getreadbuf(self, segment, (void **) ptrptr);
+ else {
+ PyErr_SetString(PyExc_TypeError,
+ "non-character (or 8-bit) array cannot be "\
+ "interpreted as character buffer");
+ return -1;
+ }
+}
+
+static PyBufferProcs array_as_buffer = {
+#if PY_VERSION_HEX >= 0x02050000
+ (readbufferproc)array_getreadbuf, /*bf_getreadbuffer*/
+ (writebufferproc)array_getwritebuf, /*bf_getwritebuffer*/
+ (segcountproc)array_getsegcount, /*bf_getsegcount*/
+ (charbufferproc)array_getcharbuf, /*bf_getcharbuffer*/
+#else
+ (getreadbufferproc)array_getreadbuf, /*bf_getreadbuffer*/
+ (getwritebufferproc)array_getwritebuf, /*bf_getwritebuffer*/
+ (getsegcountproc)array_getsegcount, /*bf_getsegcount*/
+ (getcharbufferproc)array_getcharbuf, /*bf_getcharbuffer*/
+#endif
+};
+
+/****************** End of Buffer Protocol *******************************/
+
+
+/*************************************************************************
+ **************** Implement Number Protocol ****************************
+ *************************************************************************/
+
+
+typedef struct {
+ PyObject *add,
+ *subtract,
+ *multiply,
+ *divide,
+ *remainder,
+ *power,
+ *square,
+ *reciprocal,
+ *ones_like,
+ *sqrt,
+ *negative,
+ *absolute,
+ *invert,
+ *left_shift,
+ *right_shift,
+ *bitwise_and,
+ *bitwise_xor,
+ *bitwise_or,
+ *less,
+ *less_equal,
+ *equal,
+ *not_equal,
+ *greater,
+ *greater_equal,
+ *floor_divide,
+ *true_divide,
+ *logical_or,
+ *logical_and,
+ *floor,
+ *ceil,
+ *maximum,
+ *minimum,
+ *rint,
+ *conjugate;
+} NumericOps;
+
+static NumericOps n_ops; /* NB: static objects inlitialized to zero */
+
+/* Dictionary can contain any of the numeric operations, by name.
+ Those not present will not be changed
+ */
+
+#define SET(op) temp=PyDict_GetItemString(dict, #op); \
+ if (temp != NULL) { \
+ if (!(PyCallable_Check(temp))) return -1; \
+ Py_XDECREF(n_ops.op); \
+ n_ops.op = temp; \
+ }
+
+
+/*OBJECT_API
+ Set internal structure with number functions that all arrays will use
+*/
+int
+PyArray_SetNumericOps(PyObject *dict)
+{
+ PyObject *temp = NULL;
+ SET(add);
+ SET(subtract);
+ SET(multiply);
+ SET(divide);
+ SET(remainder);
+ SET(power);
+ SET(square);
+ SET(reciprocal);
+ SET(ones_like);
+ SET(sqrt);
+ SET(negative);
+ SET(absolute);
+ SET(invert);
+ SET(left_shift);
+ SET(right_shift);
+ SET(bitwise_and);
+ SET(bitwise_or);
+ SET(bitwise_xor);
+ SET(less);
+ SET(less_equal);
+ SET(equal);
+ SET(not_equal);
+ SET(greater);
+ SET(greater_equal);
+ SET(floor_divide);
+ SET(true_divide);
+ SET(logical_or);
+ SET(logical_and);
+ SET(floor);
+ SET(ceil);
+ SET(maximum);
+ SET(minimum);
+ SET(rint);
+ SET(conjugate);
+ return 0;
+}
+
+#define GET(op) if (n_ops.op && \
+ (PyDict_SetItemString(dict, #op, n_ops.op)==-1)) \
+ goto fail;
+
+/*OBJECT_API
+ Get dictionary showing number functions that all arrays will use
+*/
+static PyObject *
+PyArray_GetNumericOps(void)
+{
+ PyObject *dict;
+ if ((dict = PyDict_New())==NULL)
+ return NULL;
+ GET(add);
+ GET(subtract);
+ GET(multiply);
+ GET(divide);
+ GET(remainder);
+ GET(power);
+ GET(square);
+ GET(reciprocal);
+ GET(ones_like);
+ GET(sqrt);
+ GET(negative);
+ GET(absolute);
+ GET(invert);
+ GET(left_shift);
+ GET(right_shift);
+ GET(bitwise_and);
+ GET(bitwise_or);
+ GET(bitwise_xor);
+ GET(less);
+ GET(less_equal);
+ GET(equal);
+ GET(not_equal);
+ GET(greater);
+ GET(greater_equal);
+ GET(floor_divide);
+ GET(true_divide);
+ GET(logical_or);
+ GET(logical_and);
+ GET(floor);
+ GET(ceil);
+ GET(maximum);
+ GET(minimum);
+ GET(rint);
+ GET(conjugate);
+ return dict;
+
+ fail:
+ Py_DECREF(dict);
+ return NULL;
+}
+
+static PyObject *
+_get_keywords(int rtype, PyArrayObject *out)
+{
+ PyObject *kwds=NULL;
+ if (rtype != PyArray_NOTYPE || out != NULL) {
+ kwds = PyDict_New();
+ if (rtype != PyArray_NOTYPE) {
+ PyArray_Descr *descr;
+ descr = PyArray_DescrFromType(rtype);
+ if (descr) {
+ PyDict_SetItemString(kwds, "dtype",
+ (PyObject *)descr);
+ Py_DECREF(descr);
+ }
+ }
+ if (out != NULL) {
+ PyDict_SetItemString(kwds, "out",
+ (PyObject *)out);
+ }
+ }
+ return kwds;
+}
+
+static PyObject *
+PyArray_GenericReduceFunction(PyArrayObject *m1, PyObject *op, int axis,
+ int rtype, PyArrayObject *out)
+{
+ PyObject *args, *ret=NULL, *meth;
+ PyObject *kwds;
+ if (op == NULL) {
+ Py_INCREF(Py_NotImplemented);
+ return Py_NotImplemented;
+ }
+ args = Py_BuildValue("(Oi)", m1, axis);
+ kwds = _get_keywords(rtype, out);
+ meth = PyObject_GetAttrString(op, "reduce");
+ if (meth && PyCallable_Check(meth)) {
+ ret = PyObject_Call(meth, args, kwds);
+ }
+ Py_DECREF(args);
+ Py_DECREF(meth);
+ Py_XDECREF(kwds);
+ return ret;
+}
+
+
+static PyObject *
+PyArray_GenericAccumulateFunction(PyArrayObject *m1, PyObject *op, int axis,
+ int rtype, PyArrayObject *out)
+{
+ PyObject *args, *ret=NULL, *meth;
+ PyObject *kwds;
+ if (op == NULL) {
+ Py_INCREF(Py_NotImplemented);
+ return Py_NotImplemented;
+ }
+ args = Py_BuildValue("(Oi)", m1, axis);
+ kwds = _get_keywords(rtype, out);
+ meth = PyObject_GetAttrString(op, "accumulate");
+ if (meth && PyCallable_Check(meth)) {
+ ret = PyObject_Call(meth, args, kwds);
+ }
+ Py_DECREF(args);
+ Py_DECREF(meth);
+ Py_XDECREF(kwds);
+ return ret;
+}
+
+
+static PyObject *
+PyArray_GenericBinaryFunction(PyArrayObject *m1, PyObject *m2, PyObject *op)
+{
+ if (op == NULL) {
+ Py_INCREF(Py_NotImplemented);
+ return Py_NotImplemented;
+ }
+ return PyObject_CallFunction(op, "OO", m1, m2);
+}
+
+static PyObject *
+PyArray_GenericUnaryFunction(PyArrayObject *m1, PyObject *op)
+{
+ if (op == NULL) {
+ Py_INCREF(Py_NotImplemented);
+ return Py_NotImplemented;
+ }
+ return PyObject_CallFunction(op, "(O)", m1);
+}
+
+static PyObject *
+PyArray_GenericInplaceBinaryFunction(PyArrayObject *m1,
+ PyObject *m2, PyObject *op)
+{
+ if (op == NULL) {
+ Py_INCREF(Py_NotImplemented);
+ return Py_NotImplemented;
+ }
+ return PyObject_CallFunction(op, "OOO", m1, m2, m1);
+}
+
+static PyObject *
+PyArray_GenericInplaceUnaryFunction(PyArrayObject *m1, PyObject *op)
+{
+ if (op == NULL) {
+ Py_INCREF(Py_NotImplemented);
+ return Py_NotImplemented;
+ }
+ return PyObject_CallFunction(op, "OO", m1, m1);
+}
+
+static PyObject *
+array_add(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericBinaryFunction(m1, m2, n_ops.add);
+}
+
+static PyObject *
+array_subtract(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericBinaryFunction(m1, m2, n_ops.subtract);
+}
+
+static PyObject *
+array_multiply(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericBinaryFunction(m1, m2, n_ops.multiply);
+}
+
+static PyObject *
+array_divide(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericBinaryFunction(m1, m2, n_ops.divide);
+}
+
+static PyObject *
+array_remainder(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericBinaryFunction(m1, m2, n_ops.remainder);
+}
+
+static int
+array_power_is_scalar(PyObject *o2, double* exp)
+{
+ PyObject *temp;
+ const int optimize_fpexps = 1;
+
+ if (PyInt_Check(o2)) {
+ *exp = (double)PyInt_AsLong(o2);
+ return 1;
+ }
+ if (optimize_fpexps && PyFloat_Check(o2)) {
+ *exp = PyFloat_AsDouble(o2);
+ return 1;
+ }
+ if ((PyArray_IsZeroDim(o2) &&
+ ((PyArray_ISINTEGER(o2) ||
+ (optimize_fpexps && PyArray_ISFLOAT(o2))))) ||
+ PyArray_IsScalar(o2, Integer) ||
+ (optimize_fpexps && PyArray_IsScalar(o2, Floating))) {
+ temp = o2->ob_type->tp_as_number->nb_float(o2);
+ if (temp != NULL) {
+ *exp = PyFloat_AsDouble(o2);
+ Py_DECREF(temp);
+ return 1;
+ }
+ }
+#if (PY_VERSION_HEX >= 0x02050000)
+ if (PyIndex_Check(o2)) {
+ PyObject* value = PyNumber_Index(o2);
+ Py_ssize_t val;
+ if (value==NULL) {
+ if (PyErr_Occurred())
+ PyErr_Clear();
+ return 0;
+ }
+ val = PyInt_AsSsize_t(value);
+ if (val == -1 && PyErr_Occurred()) {
+ PyErr_Clear();
+ return 0;
+ }
+ *exp = (double) val;
+ return 1;
+ }
+#endif
+ return 0;
+}
+
+/* optimize float array or complex array to a scalar power */
+static PyObject *
+fast_scalar_power(PyArrayObject *a1, PyObject *o2, int inplace) {
+ double exp;
+ if (PyArray_Check(a1) && array_power_is_scalar(o2, &exp)) {
+ PyObject *fastop = NULL;
+ if (PyArray_ISFLOAT(a1) || PyArray_ISCOMPLEX(a1)) {
+ if (exp == 1.0) {
+ /* we have to do this one special, as the
+ "copy" method of array objects isn't set
+ up early enough to be added
+ by PyArray_SetNumericOps.
+ */
+ if (inplace) {
+ Py_INCREF(a1);
+ return (PyObject *)a1;
+ } else {
+ return PyArray_Copy(a1);
+ }
+ } else if (exp == -1.0) {
+ fastop = n_ops.reciprocal;
+ } else if (exp == 0.0) {
+ fastop = n_ops.ones_like;
+ } else if (exp == 0.5) {
+ fastop = n_ops.sqrt;
+ } else if (exp == 2.0) {
+ fastop = n_ops.square;
+ } else {
+ return NULL;
+ }
+ if (inplace) {
+ return PyArray_GenericInplaceUnaryFunction(a1,
+ fastop);
+ } else {
+ return PyArray_GenericUnaryFunction(a1,
+ fastop);
+ }
+ }
+ else if (exp==2.0) {
+ fastop = n_ops.multiply;
+ if (inplace) {
+ return PyArray_GenericInplaceBinaryFunction \
+ (a1, (PyObject *)a1, fastop);
+ }
+ else {
+ return PyArray_GenericBinaryFunction \
+ (a1, (PyObject *)a1, fastop);
+ }
+ }
+ }
+ return NULL;
+}
+
+static PyObject *
+array_power(PyArrayObject *a1, PyObject *o2, PyObject *modulo)
+{
+ /* modulo is ignored! */
+ PyObject *value;
+ value = fast_scalar_power(a1, o2, 0);
+ if (!value) {
+ value = PyArray_GenericBinaryFunction(a1, o2, n_ops.power);
+ }
+ return value;
+}
+
+
+static PyObject *
+array_negative(PyArrayObject *m1)
+{
+ return PyArray_GenericUnaryFunction(m1, n_ops.negative);
+}
+
+static PyObject *
+array_absolute(PyArrayObject *m1)
+{
+ return PyArray_GenericUnaryFunction(m1, n_ops.absolute);
+}
+
+static PyObject *
+array_invert(PyArrayObject *m1)
+{
+ return PyArray_GenericUnaryFunction(m1, n_ops.invert);
+}
+
+static PyObject *
+array_left_shift(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericBinaryFunction(m1, m2, n_ops.left_shift);
+}
+
+static PyObject *
+array_right_shift(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericBinaryFunction(m1, m2, n_ops.right_shift);
+}
+
+static PyObject *
+array_bitwise_and(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericBinaryFunction(m1, m2, n_ops.bitwise_and);
+}
+
+static PyObject *
+array_bitwise_or(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericBinaryFunction(m1, m2, n_ops.bitwise_or);
+}
+
+static PyObject *
+array_bitwise_xor(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericBinaryFunction(m1, m2, n_ops.bitwise_xor);
+}
+
+static PyObject *
+array_inplace_add(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericInplaceBinaryFunction(m1, m2, n_ops.add);
+}
+
+static PyObject *
+array_inplace_subtract(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericInplaceBinaryFunction(m1, m2, n_ops.subtract);
+}
+
+static PyObject *
+array_inplace_multiply(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericInplaceBinaryFunction(m1, m2, n_ops.multiply);
+}
+
+static PyObject *
+array_inplace_divide(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericInplaceBinaryFunction(m1, m2, n_ops.divide);
+}
+
+static PyObject *
+array_inplace_remainder(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericInplaceBinaryFunction(m1, m2, n_ops.remainder);
+}
+
+static PyObject *
+array_inplace_power(PyArrayObject *a1, PyObject *o2, PyObject *modulo)
+{
+ /* modulo is ignored! */
+ PyObject *value;
+ value = fast_scalar_power(a1, o2, 1);
+ if (!value) {
+ value = PyArray_GenericInplaceBinaryFunction(a1, o2, n_ops.power);
+ }
+ return value;
+}
+
+static PyObject *
+array_inplace_left_shift(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericInplaceBinaryFunction(m1, m2, n_ops.left_shift);
+}
+
+static PyObject *
+array_inplace_right_shift(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericInplaceBinaryFunction(m1, m2, n_ops.right_shift);
+}
+
+static PyObject *
+array_inplace_bitwise_and(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericInplaceBinaryFunction(m1, m2, n_ops.bitwise_and);
+}
+
+static PyObject *
+array_inplace_bitwise_or(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericInplaceBinaryFunction(m1, m2, n_ops.bitwise_or);
+}
+
+static PyObject *
+array_inplace_bitwise_xor(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericInplaceBinaryFunction(m1, m2, n_ops.bitwise_xor);
+}
+
+static PyObject *
+array_floor_divide(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericBinaryFunction(m1, m2, n_ops.floor_divide);
+}
+
+static PyObject *
+array_true_divide(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericBinaryFunction(m1, m2, n_ops.true_divide);
+}
+
+static PyObject *
+array_inplace_floor_divide(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericInplaceBinaryFunction(m1, m2,
+ n_ops.floor_divide);
+}
+
+static PyObject *
+array_inplace_true_divide(PyArrayObject *m1, PyObject *m2)
+{
+ return PyArray_GenericInplaceBinaryFunction(m1, m2,
+ n_ops.true_divide);
+}
+
+/* Array evaluates as "TRUE" if any of the elements are non-zero*/
+static int
+array_any_nonzero(PyArrayObject *mp)
+{
+ intp index;
+ PyArrayIterObject *it;
+ Bool anyTRUE = FALSE;
+
+ it = (PyArrayIterObject *)PyArray_IterNew((PyObject *)mp);
+ if (it==NULL) return anyTRUE;
+ index = it->size;
+ while(index--) {
+ if (mp->descr->f->nonzero(it->dataptr, mp)) {
+ anyTRUE = TRUE;
+ break;
+ }
+ PyArray_ITER_NEXT(it);
+ }
+ Py_DECREF(it);
+ return anyTRUE;
+}
+
+static int
+_array_nonzero(PyArrayObject *mp)
+{
+ intp n;
+ n = PyArray_SIZE(mp);
+ if (n == 1) {
+ return mp->descr->f->nonzero(mp->data, mp);
+ }
+ else if (n == 0) {
+ return 0;
+ }
+ else {
+ PyErr_SetString(PyExc_ValueError,
+ "The truth value of an array " \
+ "with more than one element is ambiguous. " \
+ "Use a.any() or a.all()");
+ return -1;
+ }
+}
+
+
+
+static PyObject *
+array_divmod(PyArrayObject *op1, PyObject *op2)
+{
+ PyObject *divp, *modp, *result;
+
+ divp = array_floor_divide(op1, op2);
+ if (divp == NULL) return NULL;
+ modp = array_remainder(op1, op2);
+ if (modp == NULL) {
+ Py_DECREF(divp);
+ return NULL;
+ }
+ result = Py_BuildValue("OO", divp, modp);
+ Py_DECREF(divp);
+ Py_DECREF(modp);
+ return result;
+}
+
+
+static PyObject *
+array_int(PyArrayObject *v)
+{
+ PyObject *pv, *pv2;
+ if (PyArray_SIZE(v) != 1) {
+ PyErr_SetString(PyExc_TypeError, "only length-1 arrays can be"\
+ " converted to Python scalars");
+ return NULL;
+ }
+ pv = v->descr->f->getitem(v->data, v);
+ if (pv == NULL) return NULL;
+ if (pv->ob_type->tp_as_number == 0) {
+ PyErr_SetString(PyExc_TypeError, "cannot convert to an int; "\
+ "scalar object is not a number");
+ Py_DECREF(pv);
+ return NULL;
+ }
+ if (pv->ob_type->tp_as_number->nb_int == 0) {
+ PyErr_SetString(PyExc_TypeError, "don't know how to convert "\
+ "scalar number to int");
+ Py_DECREF(pv);
+ return NULL;
+ }
+
+ pv2 = pv->ob_type->tp_as_number->nb_int(pv);
+ Py_DECREF(pv);
+ return pv2;
+}
+
+static PyObject *
+array_float(PyArrayObject *v)
+{
+ PyObject *pv, *pv2;
+ if (PyArray_SIZE(v) != 1) {
+ PyErr_SetString(PyExc_TypeError, "only length-1 arrays can "\
+ "be converted to Python scalars");
+ return NULL;
+ }
+ pv = v->descr->f->getitem(v->data, v);
+ if (pv == NULL) return NULL;
+ if (pv->ob_type->tp_as_number == 0) {
+ PyErr_SetString(PyExc_TypeError, "cannot convert to a "\
+ "float; scalar object is not a number");
+ Py_DECREF(pv);
+ return NULL;
+ }
+ if (pv->ob_type->tp_as_number->nb_float == 0) {
+ PyErr_SetString(PyExc_TypeError, "don't know how to convert "\
+ "scalar number to float");
+ Py_DECREF(pv);
+ return NULL;
+ }
+ pv2 = pv->ob_type->tp_as_number->nb_float(pv);
+ Py_DECREF(pv);
+ return pv2;
+}
+
+static PyObject *
+array_long(PyArrayObject *v)
+{
+ PyObject *pv, *pv2;
+ if (PyArray_SIZE(v) != 1) {
+ PyErr_SetString(PyExc_TypeError, "only length-1 arrays can "\
+ "be converted to Python scalars");
+ return NULL;
+ }
+ pv = v->descr->f->getitem(v->data, v);
+ if (pv->ob_type->tp_as_number == 0) {
+ PyErr_SetString(PyExc_TypeError, "cannot convert to an int; "\
+ "scalar object is not a number");
+ return NULL;
+ }
+ if (pv->ob_type->tp_as_number->nb_long == 0) {
+ PyErr_SetString(PyExc_TypeError, "don't know how to convert "\
+ "scalar number to long");
+ return NULL;
+ }
+ pv2 = pv->ob_type->tp_as_number->nb_long(pv);
+ Py_DECREF(pv);
+ return pv2;
+}
+
+static PyObject *
+array_oct(PyArrayObject *v)
+{
+ PyObject *pv, *pv2;
+ if (PyArray_SIZE(v) != 1) {
+ PyErr_SetString(PyExc_TypeError, "only length-1 arrays can "\
+ "be converted to Python scalars");
+ return NULL;
+ }
+ pv = v->descr->f->getitem(v->data, v);
+ if (pv->ob_type->tp_as_number == 0) {
+ PyErr_SetString(PyExc_TypeError, "cannot convert to an int; "\
+ "scalar object is not a number");
+ return NULL;
+ }
+ if (pv->ob_type->tp_as_number->nb_oct == 0) {
+ PyErr_SetString(PyExc_TypeError, "don't know how to convert "\
+ "scalar number to oct");
+ return NULL;
+ }
+ pv2 = pv->ob_type->tp_as_number->nb_oct(pv);
+ Py_DECREF(pv);
+ return pv2;
+}
+
+static PyObject *
+array_hex(PyArrayObject *v)
+{
+ PyObject *pv, *pv2;
+ if (PyArray_SIZE(v) != 1) {
+ PyErr_SetString(PyExc_TypeError, "only length-1 arrays can "\
+ "be converted to Python scalars");
+ return NULL;
+ }
+ pv = v->descr->f->getitem(v->data, v);
+ if (pv->ob_type->tp_as_number == 0) {
+ PyErr_SetString(PyExc_TypeError, "cannot convert to an int; "\
+ "scalar object is not a number");
+ return NULL;
+ }
+ if (pv->ob_type->tp_as_number->nb_hex == 0) {
+ PyErr_SetString(PyExc_TypeError, "don't know how to convert "\
+ "scalar number to hex");
+ return NULL;
+ }
+ pv2 = pv->ob_type->tp_as_number->nb_hex(pv);
+ Py_DECREF(pv);
+ return pv2;
+}
+
+static PyObject *
+_array_copy_nice(PyArrayObject *self)
+{
+ return PyArray_Return((PyArrayObject *) \
+ PyArray_Copy(self));
+}
+
+#if PY_VERSION_HEX >= 0x02050000
+static PyObject *
+array_index(PyArrayObject *v)
+{
+ if (!PyArray_ISINTEGER(v) || PyArray_SIZE(v) != 1) {
+ PyErr_SetString(PyExc_TypeError, "only integer arrays with " \
+ "one element can be converted to an index");
+ return NULL;
+ }
+ return v->descr->f->getitem(v->data, v);
+}
+#endif
+
+
+static PyNumberMethods array_as_number = {
+ (binaryfunc)array_add, /*nb_add*/
+ (binaryfunc)array_subtract, /*nb_subtract*/
+ (binaryfunc)array_multiply, /*nb_multiply*/
+ (binaryfunc)array_divide, /*nb_divide*/
+ (binaryfunc)array_remainder, /*nb_remainder*/
+ (binaryfunc)array_divmod, /*nb_divmod*/
+ (ternaryfunc)array_power, /*nb_power*/
+ (unaryfunc)array_negative, /*nb_neg*/
+ (unaryfunc)_array_copy_nice, /*nb_pos*/
+ (unaryfunc)array_absolute, /*(unaryfunc)array_abs,*/
+ (inquiry)_array_nonzero, /*nb_nonzero*/
+ (unaryfunc)array_invert, /*nb_invert*/
+ (binaryfunc)array_left_shift, /*nb_lshift*/
+ (binaryfunc)array_right_shift, /*nb_rshift*/
+ (binaryfunc)array_bitwise_and, /*nb_and*/
+ (binaryfunc)array_bitwise_xor, /*nb_xor*/
+ (binaryfunc)array_bitwise_or, /*nb_or*/
+ 0, /*nb_coerce*/
+ (unaryfunc)array_int, /*nb_int*/
+ (unaryfunc)array_long, /*nb_long*/
+ (unaryfunc)array_float, /*nb_float*/
+ (unaryfunc)array_oct, /*nb_oct*/
+ (unaryfunc)array_hex, /*nb_hex*/
+
+ /*This code adds augmented assignment functionality*/
+ /*that was made available in Python 2.0*/
+ (binaryfunc)array_inplace_add, /*inplace_add*/
+ (binaryfunc)array_inplace_subtract, /*inplace_subtract*/
+ (binaryfunc)array_inplace_multiply, /*inplace_multiply*/
+ (binaryfunc)array_inplace_divide, /*inplace_divide*/
+ (binaryfunc)array_inplace_remainder, /*inplace_remainder*/
+ (ternaryfunc)array_inplace_power, /*inplace_power*/
+ (binaryfunc)array_inplace_left_shift, /*inplace_lshift*/
+ (binaryfunc)array_inplace_right_shift, /*inplace_rshift*/
+ (binaryfunc)array_inplace_bitwise_and, /*inplace_and*/
+ (binaryfunc)array_inplace_bitwise_xor, /*inplace_xor*/
+ (binaryfunc)array_inplace_bitwise_or, /*inplace_or*/
+
+ (binaryfunc)array_floor_divide, /*nb_floor_divide*/
+ (binaryfunc)array_true_divide, /*nb_true_divide*/
+ (binaryfunc)array_inplace_floor_divide, /*nb_inplace_floor_divide*/
+ (binaryfunc)array_inplace_true_divide, /*nb_inplace_true_divide*/
+
+#if PY_VERSION_HEX >= 0x02050000
+ (unaryfunc)array_index, /* nb_index */
+#endif
+
+};
+
+/****************** End of Buffer Protocol *******************************/
+
+
+/*************************************************************************
+ **************** Implement Sequence Protocol **************************
+ *************************************************************************/
+
+/* Some of this is repeated in the array_as_mapping protocol. But
+ we fill it in here so that PySequence_XXXX calls work as expected
+*/
+
+
+static PyObject *
+array_slice(PyArrayObject *self, Py_ssize_t ilow,
+ Py_ssize_t ihigh)
+{
+ PyArrayObject *r;
+ Py_ssize_t l;
+ char *data;
+
+ if (self->nd == 0) {
+ PyErr_SetString(PyExc_ValueError, "cannot slice a 0-d array");
+ return NULL;
+ }
+
+ l=self->dimensions[0];
+ if (ilow < 0) ilow = 0;
+ else if (ilow > l) ilow = l;
+ if (ihigh < ilow) ihigh = ilow;
+ else if (ihigh > l) ihigh = l;
+
+ if (ihigh != ilow) {
+ data = index2ptr(self, ilow);
+ if (data == NULL) return NULL;
+ } else {
+ data = self->data;
+ }
+
+ self->dimensions[0] = ihigh-ilow;
+ Py_INCREF(self->descr);
+ r = (PyArrayObject *) \
+ PyArray_NewFromDescr(self->ob_type, self->descr,
+ self->nd, self->dimensions,
+ self->strides, data,
+ self->flags, (PyObject *)self);
+ self->dimensions[0] = l;
+ if (r == NULL) return NULL;
+ r->base = (PyObject *)self;
+ Py_INCREF(self);
+ PyArray_UpdateFlags(r, UPDATE_ALL);
+ return (PyObject *)r;
+}
+
+
+static int
+array_ass_slice(PyArrayObject *self, Py_ssize_t ilow,
+ Py_ssize_t ihigh, PyObject *v) {
+ int ret;
+ PyArrayObject *tmp;
+
+ if (v == NULL) {
+ PyErr_SetString(PyExc_ValueError,
+ "cannot delete array elements");
+ return -1;
+ }
+ if (!PyArray_ISWRITEABLE(self)) {
+ PyErr_SetString(PyExc_RuntimeError,
+ "array is not writeable");
+ return -1;
+ }
+ if ((tmp = (PyArrayObject *)array_slice(self, ilow, ihigh)) \
+ == NULL)
+ return -1;
+ ret = PyArray_CopyObject(tmp, v);
+ Py_DECREF(tmp);
+
+ return ret;
+}
+
+static int
+array_contains(PyArrayObject *self, PyObject *el)
+{
+ /* equivalent to (self == el).any() */
+
+ PyObject *res;
+ int ret;
+
+ res = PyArray_EnsureAnyArray(PyObject_RichCompare((PyObject *)self,
+ el, Py_EQ));
+ if (res == NULL) return -1;
+ ret = array_any_nonzero((PyArrayObject *)res);
+ Py_DECREF(res);
+ return ret;
+}
+
+static PySequenceMethods array_as_sequence = {
+#if PY_VERSION_HEX >= 0x02050000
+ (lenfunc)array_length, /*sq_length*/
+ (binaryfunc)NULL, /* sq_concat is handled by nb_add*/
+ (ssizeargfunc)NULL,
+ (ssizeargfunc)array_item_nice,
+ (ssizessizeargfunc)array_slice,
+ (ssizeobjargproc)array_ass_item, /*sq_ass_item*/
+ (ssizessizeobjargproc)array_ass_slice, /*sq_ass_slice*/
+ (objobjproc) array_contains, /* sq_contains */
+ (binaryfunc) NULL, /* sg_inplace_concat */
+ (ssizeargfunc)NULL,
+#else
+ (inquiry)array_length, /*sq_length*/
+ (binaryfunc)NULL, /* sq_concat is handled by nb_add*/
+ (intargfunc)NULL, /* sq_repeat is handled nb_multiply*/
+ (intargfunc)array_item_nice, /*sq_item*/
+ (intintargfunc)array_slice, /*sq_slice*/
+ (intobjargproc)array_ass_item, /*sq_ass_item*/
+ (intintobjargproc)array_ass_slice, /*sq_ass_slice*/
+ (objobjproc) array_contains, /* sq_contains */
+ (binaryfunc) NULL, /* sg_inplace_concat */
+ (intargfunc) NULL /* sg_inplace_repeat */
+#endif
+};
+
+
+/****************** End of Sequence Protocol ****************************/
+
+
+static int
+dump_data(char **string, int *n, int *max_n, char *data, int nd,
+ intp *dimensions, intp *strides, PyArrayObject* self)
+{
+ PyArray_Descr *descr=self->descr;
+ PyObject *op, *sp;
+ char *ostring;
+ int i, N;
+
+#define CHECK_MEMORY if (*n >= *max_n-16) { *max_n *= 2; \
+ *string = (char *)_pya_realloc(*string, *max_n); }
+
+ if (nd == 0) {
+
+ if ((op = descr->f->getitem(data, self)) == NULL) return -1;
+ sp = PyObject_Repr(op);
+ if (sp == NULL) {Py_DECREF(op); return -1;}
+ ostring = PyString_AsString(sp);
+ N = PyString_Size(sp)*sizeof(char);
+ *n += N;
+ CHECK_MEMORY
+ memmove(*string+(*n-N), ostring, N);
+ Py_DECREF(sp);
+ Py_DECREF(op);
+ return 0;
+ } else {
+ CHECK_MEMORY
+ (*string)[*n] = '[';
+ *n += 1;
+ for(i=0; i<dimensions[0]; i++) {
+ if (dump_data(string, n, max_n,
+ data+(*strides)*i,
+ nd-1, dimensions+1,
+ strides+1, self) < 0)
+ return -1;
+ CHECK_MEMORY
+ if (i<dimensions[0]-1) {
+ (*string)[*n] = ',';
+ (*string)[*n+1] = ' ';
+ *n += 2;
+ }
+ }
+ CHECK_MEMORY
+ (*string)[*n] = ']'; *n += 1;
+ return 0;
+ }
+
+#undef CHECK_MEMORY
+}
+
+static PyObject *
+array_repr_builtin(PyArrayObject *self, int repr)
+{
+ PyObject *ret;
+ char *string;
+ int n, max_n;
+
+ max_n = PyArray_NBYTES(self)*4*sizeof(char) + 7;
+
+ if ((string = (char *)_pya_malloc(max_n)) == NULL) {
+ PyErr_SetString(PyExc_MemoryError, "out of memory");
+ return NULL;
+ }
+
+ if (repr) {
+ n = 6;
+ sprintf(string, "array(");
+ }
+ else {
+ n = 0;
+ }
+ if (dump_data(&string, &n, &max_n, self->data,
+ self->nd, self->dimensions,
+ self->strides, self) < 0) {
+ _pya_free(string); return NULL;
+ }
+
+ if (repr) {
+ if (PyArray_ISEXTENDED(self)) {
+ char buf[100];
+ snprintf(buf, sizeof(buf), "%d", self->descr->elsize);
+ sprintf(string+n, ", '%c%s')", self->descr->type, buf);
+ ret = PyString_FromStringAndSize(string, n+6+strlen(buf));
+ }
+ else {
+ sprintf(string+n, ", '%c')", self->descr->type);
+ ret = PyString_FromStringAndSize(string, n+6);
+ }
+ }
+ else {
+ ret = PyString_FromStringAndSize(string, n);
+ }
+
+ _pya_free(string);
+ return ret;
+}
+
+static PyObject *PyArray_StrFunction=NULL;
+static PyObject *PyArray_ReprFunction=NULL;
+
+/*OBJECT_API
+ Set the array print function to be a Python function.
+*/
+static void
+PyArray_SetStringFunction(PyObject *op, int repr)
+{
+ if (repr) {
+ /* Dispose of previous callback */
+ Py_XDECREF(PyArray_ReprFunction);
+ /* Add a reference to new callback */
+ Py_XINCREF(op);
+ /* Remember new callback */
+ PyArray_ReprFunction = op;
+ } else {
+ /* Dispose of previous callback */
+ Py_XDECREF(PyArray_StrFunction);
+ /* Add a reference to new callback */
+ Py_XINCREF(op);
+ /* Remember new callback */
+ PyArray_StrFunction = op;
+ }
+}
+
+static PyObject *
+array_repr(PyArrayObject *self)
+{
+ PyObject *s, *arglist;
+
+ if (PyArray_ReprFunction == NULL) {
+ s = array_repr_builtin(self, 1);
+ } else {
+ arglist = Py_BuildValue("(O)", self);
+ s = PyEval_CallObject(PyArray_ReprFunction, arglist);
+ Py_DECREF(arglist);
+ }
+ return s;
+}
+
+static PyObject *
+array_str(PyArrayObject *self)
+{
+ PyObject *s, *arglist;
+
+ if (PyArray_StrFunction == NULL) {
+ s = array_repr_builtin(self, 0);
+ } else {
+ arglist = Py_BuildValue("(O)", self);
+ s = PyEval_CallObject(PyArray_StrFunction, arglist);
+ Py_DECREF(arglist);
+ }
+ return s;
+}
+
+
+
+/*OBJECT_API
+ */
+static int
+PyArray_CompareUCS4(npy_ucs4 *s1, npy_ucs4 *s2, register size_t len)
+{
+ register PyArray_UCS4 c1, c2;
+ while(len-- > 0) {
+ c1 = *s1++;
+ c2 = *s2++;
+ if (c1 != c2) {
+ return (c1 < c2) ? -1 : 1;
+ }
+ }
+ return 0;
+}
+
+/* This also handles possibly mis-aligned data */
+/* Compare s1 and s2 which are not necessarily NULL-terminated.
+ s1 is of length len1
+ s2 is of length len2
+ If they are NULL terminated, then stop comparison.
+*/
+static int
+_myunincmp(PyArray_UCS4 *s1, PyArray_UCS4 *s2, int len1, int len2)
+{
+ PyArray_UCS4 *sptr;
+ PyArray_UCS4 *s1t=s1, *s2t=s2;
+ int val;
+ intp size;
+ int diff;
+
+ if ((intp)s1 % sizeof(PyArray_UCS4) != 0) {
+ size = len1*sizeof(PyArray_UCS4);
+ s1t = malloc(size);
+ memcpy(s1t, s1, size);
+ }
+ if ((intp)s2 % sizeof(PyArray_UCS4) != 0) {
+ size = len2*sizeof(PyArray_UCS4);
+ s2t = malloc(size);
+ memcpy(s2t, s2, size);
+ }
+ val = PyArray_CompareUCS4(s1t, s2t, MIN(len1,len2));
+ if ((val != 0) || (len1 == len2)) goto finish;
+ if (len2 > len1) {sptr = s2t+len1; val = -1; diff=len2-len1;}
+ else {sptr = s1t+len2; val = 1; diff=len1-len2;}
+ while (diff--) {
+ if (*sptr != 0) goto finish;
+ sptr++;
+ }
+ val = 0;
+
+ finish:
+ if (s1t != s1) free(s1t);
+ if (s2t != s2) free(s2t);
+ return val;
+}
+
+
+
+
+/* Compare s1 and s2 which are not necessarily NULL-terminated.
+ s1 is of length len1
+ s2 is of length len2
+ If they are NULL terminated, then stop comparison.
+*/
+static int
+_mystrncmp(char *s1, char *s2, int len1, int len2)
+{
+ char *sptr;
+ int val;
+ int diff;
+
+ val = memcmp(s1, s2, MIN(len1, len2));
+ if ((val != 0) || (len1 == len2)) return val;
+ if (len2 > len1) {sptr = s2+len1; val = -1; diff=len2-len1;}
+ else {sptr = s1+len2; val = 1; diff=len1-len2;}
+ while (diff--) {
+ if (*sptr != 0) return val;
+ sptr++;
+ }
+ return 0; /* Only happens if NULLs are everywhere */
+}
+
+/* Borrowed from Numarray */
+
+#define SMALL_STRING 2048
+
+#if defined(isspace)
+#undef isspace
+#define isspace(c) ((c==' ')||(c=='\t')||(c=='\n')||(c=='\r')||(c=='\v')||(c=='\f'))
+#endif
+
+static void _rstripw(char *s, int n)
+{
+ int i;
+ for(i=n-1; i>=1; i--) /* Never strip to length 0. */
+ {
+ int c = s[i];
+ if (!c || isspace(c))
+ s[i] = 0;
+ else
+ break;
+ }
+}
+
+static void _unistripw(PyArray_UCS4 *s, int n)
+{
+ int i;
+ for(i=n-1; i>=1; i--) /* Never strip to length 0. */
+ {
+ PyArray_UCS4 c = s[i];
+ if (!c || isspace(c))
+ s[i] = 0;
+ else
+ break;
+ }
+}
+
+
+static char *
+_char_copy_n_strip(char *original, char *temp, int nc)
+{
+ if (nc > SMALL_STRING) {
+ temp = malloc(nc);
+ if (!temp) {
+ PyErr_NoMemory();
+ return NULL;
+ }
+ }
+ memcpy(temp, original, nc);
+ _rstripw(temp, nc);
+ return temp;
+}
+
+static void
+_char_release(char *ptr, int nc)
+{
+ if (nc > SMALL_STRING) {
+ free(ptr);
+ }
+}
+
+static char *
+_uni_copy_n_strip(char *original, char *temp, int nc)
+{
+ if (nc*sizeof(PyArray_UCS4) > SMALL_STRING) {
+ temp = malloc(nc*sizeof(PyArray_UCS4));
+ if (!temp) {
+ PyErr_NoMemory();
+ return NULL;
+ }
+ }
+ memcpy(temp, original, nc*sizeof(PyArray_UCS4));
+ _unistripw((PyArray_UCS4 *)temp, nc);
+ return temp;
+}
+
+static void
+_uni_release(char *ptr, int nc)
+{
+ if (nc*sizeof(PyArray_UCS4) > SMALL_STRING) {
+ free(ptr);
+ }
+}
+
+
+/* End borrowed from numarray */
+
+#define _rstrip_loop(CMP) { \
+ void *aptr, *bptr; \
+ char atemp[SMALL_STRING], btemp[SMALL_STRING]; \
+ while(size--) { \
+ aptr = stripfunc(iself->dataptr, atemp, N1); \
+ if (!aptr) return -1; \
+ bptr = stripfunc(iother->dataptr, btemp, N2); \
+ if (!bptr) { \
+ relfunc(aptr, N1); \
+ return -1; \
+ } \
+ val = cmpfunc(aptr, bptr, N1, N2); \
+ *dptr = (val CMP 0); \
+ PyArray_ITER_NEXT(iself); \
+ PyArray_ITER_NEXT(iother); \
+ dptr += 1; \
+ relfunc(aptr, N1); \
+ relfunc(bptr, N2); \
+ } \
+ }
+
+#define _reg_loop(CMP) { \
+ while(size--) { \
+ val = cmpfunc((void *)iself->dataptr, \
+ (void *)iother->dataptr, \
+ N1, N2); \
+ *dptr = (val CMP 0); \
+ PyArray_ITER_NEXT(iself); \
+ PyArray_ITER_NEXT(iother); \
+ dptr += 1; \
+ } \
+ }
+
+#define _loop(CMP) if (rstrip) _rstrip_loop(CMP) \
+ else _reg_loop(CMP)
+
+static int
+_compare_strings(PyObject *result, PyArrayMultiIterObject *multi,
+ int cmp_op, void *func, int rstrip)
+{
+ PyArrayIterObject *iself, *iother;
+ Bool *dptr;
+ intp size;
+ int val;
+ int N1, N2;
+ int (*cmpfunc)(void *, void *, int, int);
+ void (*relfunc)(char *, int);
+ char* (*stripfunc)(char *, char *, int);
+
+ cmpfunc = func;
+ dptr = (Bool *)PyArray_DATA(result);
+ iself = multi->iters[0];
+ iother = multi->iters[1];
+ size = multi->size;
+ N1 = iself->ao->descr->elsize;
+ N2 = iother->ao->descr->elsize;
+ if ((void *)cmpfunc == (void *)_myunincmp) {
+ N1 >>= 2;
+ N2 >>= 2;
+ stripfunc = _uni_copy_n_strip;
+ relfunc = _uni_release;
+ }
+ else {
+ stripfunc = _char_copy_n_strip;
+ relfunc = _char_release;
+ }
+ switch (cmp_op) {
+ case Py_EQ:
+ _loop(==)
+ break;
+ case Py_NE:
+ _loop(!=)
+ break;
+ case Py_LT:
+ _loop(<)
+ break;
+ case Py_LE:
+ _loop(<=)
+ break;
+ case Py_GT:
+ _loop(>)
+ break;
+ case Py_GE:
+ _loop(>=)
+ break;
+ default:
+ PyErr_SetString(PyExc_RuntimeError,
+ "bad comparison operator");
+ return -1;
+ }
+ return 0;
+}
+
+#undef _loop
+#undef _reg_loop
+#undef _rstrip_loop
+#undef SMALL_STRING
+
+static PyObject *
+_strings_richcompare(PyArrayObject *self, PyArrayObject *other, int cmp_op,
+ int rstrip)
+{
+ PyObject *result;
+ PyArrayMultiIterObject *mit;
+ int val;
+
+ /* Cast arrays to a common type */
+ if (self->descr->type_num != other->descr->type_num) {
+ PyObject *new;
+ if (self->descr->type_num == PyArray_STRING && \
+ other->descr->type_num == PyArray_UNICODE) {
+ Py_INCREF(other);
+ Py_INCREF(other->descr);
+ new = PyArray_FromAny((PyObject *)self, other->descr,
+ 0, 0, 0, NULL);
+ if (new == NULL) return NULL;
+ self = (PyArrayObject *)new;
+ }
+ else if (self->descr->type_num == PyArray_UNICODE && \
+ other->descr->type_num == PyArray_STRING) {
+ Py_INCREF(self);
+ Py_INCREF(self->descr);
+ new = PyArray_FromAny((PyObject *)other, self->descr,
+ 0, 0, 0, NULL);
+ if (new == NULL) return NULL;
+ other = (PyArrayObject *)new;
+ }
+ else {
+ PyErr_SetString(PyExc_TypeError,
+ "invalid string data-types "
+ "in comparison");
+ return NULL;
+ }
+ }
+ else {
+ Py_INCREF(self);
+ Py_INCREF(other);
+ }
+
+ /* Broad-cast the arrays to a common shape */
+ mit = (PyArrayMultiIterObject *)PyArray_MultiIterNew(2, self, other);
+ Py_DECREF(self);
+ Py_DECREF(other);
+ if (mit == NULL) return NULL;
+
+ result = PyArray_NewFromDescr(&PyArray_Type,
+ PyArray_DescrFromType(PyArray_BOOL),
+ mit->nd,
+ mit->dimensions,
+ NULL, NULL, 0,
+ NULL);
+ if (result == NULL) goto finish;
+
+ if (self->descr->type_num == PyArray_UNICODE) {
+ val = _compare_strings(result, mit, cmp_op, _myunincmp,
+ rstrip);
+ }
+ else {
+ val = _compare_strings(result, mit, cmp_op, _mystrncmp,
+ rstrip);
+ }
+
+ if (val < 0) {Py_DECREF(result); result = NULL;}
+
+ finish:
+ Py_DECREF(mit);
+ return result;
+}
+
+/* VOID-type arrays can only be compared equal and not-equal
+ in which case the fields are all compared by extracting the fields
+ and testing one at a time...
+ equality testing is performed using logical_ands on all the fields.
+ in-equality testing is performed using logical_ors on all the fields.
+
+ VOID-type arrays without fields are compared for equality by comparing their
+ memory at each location directly (using string-code).
+ */
+
+static PyObject *array_richcompare(PyArrayObject *, PyObject *, int);
+
+
+static PyObject *
+_void_compare(PyArrayObject *self, PyArrayObject *other, int cmp_op)
+{
+ if (!(cmp_op == Py_EQ || cmp_op == Py_NE)) {
+ PyErr_SetString(PyExc_ValueError, "Void-arrays can only" \
+ "be compared for equality.");
+ return NULL;
+ }
+ if (PyArray_HASFIELDS(self)) {
+ PyObject *res=NULL, *temp, *a, *b;
+ PyObject *key, *value, *temp2;
+ PyObject *op;
+ Py_ssize_t pos=0;
+ op = (cmp_op == Py_EQ ? n_ops.logical_and : n_ops.logical_or);
+ while (PyDict_Next(self->descr->fields, &pos, &key, &value)) {
+ a = PyArray_EnsureAnyArray(array_subscript(self, key));
+ if (a==NULL) {Py_XDECREF(res); return NULL;}
+ b = array_subscript(other, key);
+ if (b==NULL) {Py_XDECREF(res); Py_DECREF(a); return NULL;}
+ temp = array_richcompare((PyArrayObject *)a,b,cmp_op);
+ Py_DECREF(a);
+ Py_DECREF(b);
+ if (temp == NULL) {Py_XDECREF(res); return NULL;}
+ if (res == NULL) {
+ res = temp;
+ }
+ else {
+ temp2 = PyObject_CallFunction(op, "OO", res, temp);
+ Py_DECREF(temp);
+ Py_DECREF(res);
+ if (temp2 == NULL) return NULL;
+ res = temp2;
+ }
+ }
+ if (res == NULL && !PyErr_Occurred()) {
+ PyErr_SetString(PyExc_ValueError, "No fields found.");
+ }
+ return res;
+ }
+ else { /* compare as a string */
+ /* assumes self and other have same descr->type */
+ return _strings_richcompare(self, other, cmp_op, 0);
+ }
+}
+
+static PyObject *
+array_richcompare(PyArrayObject *self, PyObject *other, int cmp_op)
+{
+ PyObject *array_other, *result = NULL;
+ int typenum;
+
+ switch (cmp_op)
+ {
+ case Py_LT:
+ result = PyArray_GenericBinaryFunction(self, other,
+ n_ops.less);
+ break;
+ case Py_LE:
+ result = PyArray_GenericBinaryFunction(self, other,
+ n_ops.less_equal);
+ break;
+ case Py_EQ:
+ if (other == Py_None) {
+ Py_INCREF(Py_False);
+ return Py_False;
+ }
+ /* Try to convert other to an array */
+ if (!PyArray_Check(other)) {
+ typenum = self->descr->type_num;
+ if (typenum != PyArray_OBJECT) {
+ typenum = PyArray_NOTYPE;
+ }
+ array_other = PyArray_FromObject(other,
+ typenum, 0, 0);
+ /* If not successful, then return False
+ This fixes code that used to
+ allow equality comparisons between arrays
+ and other objects which would give a result
+ of False
+ */
+ if ((array_other == NULL) || \
+ (array_other == Py_None)) {
+ Py_XDECREF(array_other);
+ PyErr_Clear();
+ Py_INCREF(Py_False);
+ return Py_False;
+ }
+ }
+ else {
+ Py_INCREF(other);
+ array_other = other;
+ }
+ result = PyArray_GenericBinaryFunction(self,
+ array_other,
+ n_ops.equal);
+ if ((result == Py_NotImplemented) &&
+ (self->descr->type_num == PyArray_VOID)) {
+ int _res;
+ _res = PyObject_RichCompareBool \
+ ((PyObject *)self->descr,
+ (PyObject *)\
+ PyArray_DESCR(array_other),
+ Py_EQ);
+ if (_res < 0) {
+ Py_DECREF(result);
+ Py_DECREF(array_other);
+ return NULL;
+ }
+ if (_res) {
+ Py_DECREF(result);
+ result = _void_compare\
+ (self,
+ (PyArrayObject *)array_other,
+ cmp_op);
+ Py_DECREF(array_other);
+ }
+ return result;
+ }
+ /* If the comparison results in NULL, then the
+ two array objects can not be compared together so
+ return zero
+ */
+ Py_DECREF(array_other);
+ if (result == NULL) {
+ PyErr_Clear();
+ Py_INCREF(Py_False);
+ return Py_False;
+ }
+ break;
+ case Py_NE:
+ if (other == Py_None) {
+ Py_INCREF(Py_True);
+ return Py_True;
+ }
+ /* Try to convert other to an array */
+ if (!PyArray_Check(other)) {
+ typenum = self->descr->type_num;
+ if (typenum != PyArray_OBJECT) {
+ typenum = PyArray_NOTYPE;
+ }
+ array_other = PyArray_FromObject(other,
+ typenum, 0, 0);
+ /* If not successful, then objects cannot be
+ compared and cannot be equal, therefore,
+ return True;
+ */
+ if ((array_other == NULL) || \
+ (array_other == Py_None)) {
+ Py_XDECREF(array_other);
+ PyErr_Clear();
+ Py_INCREF(Py_True);
+ return Py_True;
+ }
+ }
+ else {
+ Py_INCREF(other);
+ array_other = other;
+ }
+ result = PyArray_GenericBinaryFunction(self,
+ array_other,
+ n_ops.not_equal);
+ if ((result == Py_NotImplemented) &&
+ (self->descr->type_num == PyArray_VOID)) {
+ int _res;
+ _res = PyObject_RichCompareBool\
+ ((PyObject *)self->descr,
+ (PyObject *)\
+ PyArray_DESCR(array_other),
+ Py_EQ);
+ if (_res < 0) {
+ Py_DECREF(result);
+ Py_DECREF(array_other);
+ return NULL;
+ }
+ if (_res) {
+ Py_DECREF(result);
+ result = _void_compare\
+ (self,
+ (PyArrayObject *)array_other,
+ cmp_op);
+ Py_DECREF(array_other);
+ }
+ return result;
+ }
+
+ Py_DECREF(array_other);
+ if (result == NULL) {
+ PyErr_Clear();
+ Py_INCREF(Py_True);
+ return Py_True;
+ }
+ break;
+ case Py_GT:
+ result = PyArray_GenericBinaryFunction(self, other,
+ n_ops.greater);
+ break;
+ case Py_GE:
+ result = PyArray_GenericBinaryFunction(self, other,
+ n_ops.greater_equal);
+ break;
+ default:
+ result = Py_NotImplemented;
+ Py_INCREF(result);
+ }
+ if (result == Py_NotImplemented) {
+ /* Try to handle string comparisons */
+ if (self->descr->type_num == PyArray_OBJECT) return result;
+ array_other = PyArray_FromObject(other,PyArray_NOTYPE, 0, 0);
+ if (PyArray_ISSTRING(self) && PyArray_ISSTRING(array_other)) {
+ Py_DECREF(result);
+ result = _strings_richcompare(self, (PyArrayObject *)
+ array_other, cmp_op, 0);
+ }
+ Py_DECREF(array_other);
+ }
+ return result;
+}
+
+static PyObject *
+_check_axis(PyArrayObject *arr, int *axis, int flags)
+{
+ PyObject *temp1, *temp2;
+ int n = arr->nd;
+
+ if ((*axis >= MAX_DIMS) || (n==0)) {
+ if (n != 1) {
+ temp1 = PyArray_Ravel(arr,0);
+ if (temp1 == NULL) {*axis=0; return NULL;}
+ *axis = PyArray_NDIM(temp1)-1;
+ }
+ else {
+ temp1 = (PyObject *)arr;
+ Py_INCREF(temp1);
+ *axis = 0;
+ }
+ if (!flags) return temp1;
+ }
+ else {
+ temp1 = (PyObject *)arr;
+ Py_INCREF(temp1);
+ }
+ if (flags) {
+ temp2 = PyArray_CheckFromAny((PyObject *)temp1, NULL,
+ 0, 0, flags, NULL);
+ Py_DECREF(temp1);
+ if (temp2 == NULL) return NULL;
+ }
+ else {
+ temp2 = (PyObject *)temp1;
+ }
+ n = PyArray_NDIM(temp2);
+ if (*axis < 0) *axis += n;
+ if ((*axis < 0) || (*axis >= n)) {
+ PyErr_Format(PyExc_ValueError,
+ "axis(=%d) out of bounds", *axis);
+ Py_DECREF(temp2);
+ return NULL;
+ }
+ return temp2;
+}
+
+#include "arraymethods.c"
+
+/* Lifted from numarray */
+/*MULTIARRAY_API
+ PyArray_IntTupleFromIntp
+*/
+static PyObject *
+PyArray_IntTupleFromIntp(int len, intp *vals)
+{
+ int i;
+ PyObject *intTuple = PyTuple_New(len);
+ if (!intTuple) goto fail;
+ for(i=0; i<len; i++) {
+#if SIZEOF_INTP <= SIZEOF_LONG
+ PyObject *o = PyInt_FromLong((long) vals[i]);
+#else
+ PyObject *o = PyLong_FromLongLong((longlong) vals[i]);
+#endif
+ if (!o) {
+ Py_DECREF(intTuple);
+ intTuple = NULL;
+ goto fail;
+ }
+ PyTuple_SET_ITEM(intTuple, i, o);
+ }
+ fail:
+ return intTuple;
+}
+
+/* Returns the number of dimensions or -1 if an error occurred */
+/* vals must be large enough to hold maxvals */
+/*MULTIARRAY_API
+ PyArray_IntpFromSequence
+*/
+static int
+PyArray_IntpFromSequence(PyObject *seq, intp *vals, int maxvals)
+{
+ int nd, i;
+ PyObject *op;
+
+ /* Check to see if sequence is a single integer first.
+ or, can be made into one */
+ if ((nd=PySequence_Length(seq)) == -1) {
+ if (PyErr_Occurred()) PyErr_Clear();
+#if SIZEOF_LONG >= SIZEOF_INTP
+ if (!(op = PyNumber_Int(seq))) return -1;
+#else
+ if (!(op = PyNumber_Long(seq))) return -1;
+#endif
+ nd = 1;
+#if SIZEOF_LONG >= SIZEOF_INTP
+ vals[0] = (intp ) PyInt_AsLong(op);
+#else
+ vals[0] = (intp ) PyLong_AsLongLong(op);
+#endif
+ Py_DECREF(op);
+ } else {
+ for(i=0; i < MIN(nd,maxvals); i++) {
+ op = PySequence_GetItem(seq, i);
+ if (op == NULL) return -1;
+#if SIZEOF_LONG >= SIZEOF_INTP
+ vals[i]=(intp )PyInt_AsLong(op);
+#else
+ vals[i]=(intp )PyLong_AsLongLong(op);
+#endif
+ Py_DECREF(op);
+ if(PyErr_Occurred()) return -1;
+ }
+ }
+ return nd;
+}
+
+
+
+/* Check whether the given array is stored contiguously (row-wise) in
+ memory. */
+
+/* 0-strided arrays are not contiguous (even if dimension == 1) */
+static int
+_IsContiguous(PyArrayObject *ap)
+{
+ register intp sd;
+ register intp dim;
+ register int i;
+
+ if (ap->nd == 0) return 1;
+ sd = ap->descr->elsize;
+ if (ap->nd == 1) return (ap->dimensions[0] == 1 || \
+ sd == ap->strides[0]);
+ for (i = ap->nd-1; i >= 0; --i) {
+ dim = ap->dimensions[i];
+ /* contiguous by definition */
+ if (dim == 0) return 1;
+ if (ap->strides[i] != sd) return 0;
+ sd *= dim;
+ }
+ return 1;
+}
+
+
+/* 0-strided arrays are not contiguous (even if dimension == 1) */
+static int
+_IsFortranContiguous(PyArrayObject *ap)
+{
+ register intp sd;
+ register intp dim;
+ register int i;
+
+ if (ap->nd == 0) return 1;
+ sd = ap->descr->elsize;
+ if (ap->nd == 1) return (ap->dimensions[0] == 1 || \
+ sd == ap->strides[0]);
+ for (i=0; i< ap->nd; ++i) {
+ dim = ap->dimensions[i];
+ /* fortran contiguous by definition */
+ if (dim == 0) return 1;
+ if (ap->strides[i] != sd) return 0;
+ sd *= dim;
+ }
+ return 1;
+}
+
+static int
+_IsAligned(PyArrayObject *ap)
+{
+ int i, alignment, aligned=1;
+ intp ptr;
+ int type = ap->descr->type_num;
+
+ if ((type == PyArray_STRING) || (type == PyArray_VOID))
+ return 1;
+
+ alignment = ap->descr->alignment;
+ if (alignment == 1) return 1;
+
+ ptr = (intp) ap->data;
+ aligned = (ptr % alignment) == 0;
+ for (i=0; i <ap->nd; i++)
+ aligned &= ((ap->strides[i] % alignment) == 0);
+ return aligned != 0;
+}
+
+static Bool
+_IsWriteable(PyArrayObject *ap)
+{
+ PyObject *base=ap->base;
+ void *dummy;
+ Py_ssize_t n;
+
+ /* If we own our own data, then no-problem */
+ if ((base == NULL) || (ap->flags & OWNDATA)) return TRUE;
+
+ /* Get to the final base object
+ If it is a writeable array, then return TRUE
+ If we can find an array object
+ or a writeable buffer object as the final base object
+ or a string object (for pickling support memory savings).
+ - this last could be removed if a proper pickleable
+ buffer was added to Python.
+ */
+
+ while(PyArray_Check(base)) {
+ if (PyArray_CHKFLAGS(base, OWNDATA))
+ return (Bool) (PyArray_ISWRITEABLE(base));
+ base = PyArray_BASE(base);
+ }
+
+ /* here so pickle support works seamlessly
+ and unpickled array can be set and reset writeable
+ -- could be abused -- */
+ if PyString_Check(base) return TRUE;
+
+ if (PyObject_AsWriteBuffer(base, &dummy, &n) < 0)
+ return FALSE;
+
+ return TRUE;
+}
+
+
+/*OBJECT_API
+ */
+static int
+PyArray_ElementStrides(PyObject *arr)
+{
+ register int itemsize = PyArray_ITEMSIZE(arr);
+ register int i, N=PyArray_NDIM(arr);
+ register intp *strides = PyArray_STRIDES(arr);
+
+ for (i=0; i<N; i++) {
+ if ((strides[i] % itemsize) != 0) return 0;
+ }
+
+ return 1;
+}
+
+/*OBJECT_API
+ Update Several Flags at once.
+*/
+static void
+PyArray_UpdateFlags(PyArrayObject *ret, int flagmask)
+{
+
+ if (flagmask & FORTRAN) {
+ if (_IsFortranContiguous(ret)) {
+ ret->flags |= FORTRAN;
+ if (ret->nd > 1) ret->flags &= ~CONTIGUOUS;
+ }
+ else ret->flags &= ~FORTRAN;
+ }
+ if (flagmask & CONTIGUOUS) {
+ if (_IsContiguous(ret)) {
+ ret->flags |= CONTIGUOUS;
+ if (ret->nd > 1) ret->flags &= ~FORTRAN;
+ }
+ else ret->flags &= ~CONTIGUOUS;
+ }
+ if (flagmask & ALIGNED) {
+ if (_IsAligned(ret)) ret->flags |= ALIGNED;
+ else ret->flags &= ~ALIGNED;
+ }
+ /* This is not checked by default WRITEABLE is not
+ part of UPDATE_ALL */
+ if (flagmask & WRITEABLE) {
+ if (_IsWriteable(ret)) ret->flags |= WRITEABLE;
+ else ret->flags &= ~WRITEABLE;
+ }
+ return;
+}
+
+/* This routine checks to see if newstrides (of length nd) will not
+ ever be able to walk outside of the memory implied numbytes and offset.
+
+ The available memory is assumed to start at -offset and proceed
+ to numbytes-offset. The strides are checked to ensure
+ that accessing memory using striding will not try to reach beyond
+ this memory for any of the axes.
+
+ If numbytes is 0 it will be calculated using the dimensions and
+ element-size.
+
+ This function checks for walking beyond the beginning and right-end
+ of the buffer and therefore works for any integer stride (positive
+ or negative).
+*/
+
+/*OBJECT_API*/
+static Bool
+PyArray_CheckStrides(int elsize, int nd, intp numbytes, intp offset,
+ intp *dims, intp *newstrides)
+{
+ int i;
+ intp byte_begin;
+ intp begin;
+ intp end;
+
+ if (numbytes == 0)
+ numbytes = PyArray_MultiplyList(dims, nd) * elsize;
+
+ begin = -offset;
+ end = numbytes - offset - elsize;
+ for (i=0; i<nd; i++) {
+ byte_begin = newstrides[i]*(dims[i]-1);
+ if ((byte_begin < begin) || (byte_begin > end))
+ return FALSE;
+ }
+ return TRUE;
+
+}
+
+
+/* This is the main array creation routine. */
+
+/* Flags argument has multiple related meanings
+ depending on data and strides:
+
+ If data is given, then flags is flags associated with data.
+ If strides is not given, then a contiguous strides array will be created
+ and the CONTIGUOUS bit will be set. If the flags argument
+ has the FORTRAN bit set, then a FORTRAN-style strides array will be
+ created (and of course the FORTRAN flag bit will be set).
+
+ If data is not given but created here, then flags will be DEFAULT
+ and a non-zero flags argument can be used to indicate a FORTRAN style
+ array is desired.
+*/
+
+static size_t
+_array_fill_strides(intp *strides, intp *dims, int nd, size_t itemsize,
+ int inflag, int *objflags)
+{
+ int i;
+ /* Only make Fortran strides if not contiguous as well */
+ if ((inflag & FORTRAN) && !(inflag & CONTIGUOUS)) {
+ for (i=0; i<nd; i++) {
+ strides[i] = itemsize;
+ itemsize *= dims[i] ? dims[i] : 1;
+ }
+ *objflags |= FORTRAN;
+ if (nd > 1) *objflags &= ~CONTIGUOUS;
+ else *objflags |= CONTIGUOUS;
+ }
+ else {
+ for (i=nd-1;i>=0;i--) {
+ strides[i] = itemsize;
+ itemsize *= dims[i] ? dims[i] : 1;
+ }
+ *objflags |= CONTIGUOUS;
+ if (nd > 1) *objflags &= ~FORTRAN;
+ else *objflags |= FORTRAN;
+ }
+ return itemsize;
+}
+
+/*OBJECT_API
+ Generic new array creation routine.
+*/
+static PyObject *
+PyArray_New(PyTypeObject *subtype, int nd, intp *dims, int type_num,
+ intp *strides, void *data, int itemsize, int flags,
+ PyObject *obj)
+{
+ PyArray_Descr *descr;
+ PyObject *new;
+
+ descr = PyArray_DescrFromType(type_num);
+ if (descr == NULL) return NULL;
+ if (descr->elsize == 0) {
+ if (itemsize < 1) {
+ PyErr_SetString(PyExc_ValueError,
+ "data type must provide an itemsize");
+ Py_DECREF(descr);
+ return NULL;
+ }
+ PyArray_DESCR_REPLACE(descr);
+ descr->elsize = itemsize;
+ }
+ new = PyArray_NewFromDescr(subtype, descr, nd, dims, strides,
+ data, flags, obj);
+ return new;
+}
+
+/* Change a sub-array field to the base descriptor */
+/* and update the dimensions and strides
+ appropriately. Dimensions and strides are added
+ to the end unless we have a FORTRAN array
+ and then they are added to the beginning
+
+ Strides are only added if given (because data is given).
+*/
+static int
+_update_descr_and_dimensions(PyArray_Descr **des, intp *newdims,
+ intp *newstrides, int oldnd, int isfortran)
+{
+ PyArray_Descr *old;
+ int newnd;
+ int numnew;
+ intp *mydim;
+ int i;
+ int tuple;
+
+ old = *des;
+ *des = old->subarray->base;
+
+
+ mydim = newdims + oldnd;
+ tuple = PyTuple_Check(old->subarray->shape);
+ if (tuple) {
+ numnew = PyTuple_GET_SIZE(old->subarray->shape);
+ }
+ else {
+ numnew = 1;
+ }
+
+
+ newnd = oldnd + numnew;
+ if (newnd > MAX_DIMS) goto finish;
+ if (isfortran) {
+ memmove(newdims+numnew, newdims, oldnd*sizeof(intp));
+ mydim = newdims;
+ }
+
+ if (tuple) {
+ for (i=0; i<numnew; i++) {
+ mydim[i] = (intp) PyInt_AsLong \
+ (PyTuple_GET_ITEM(old->subarray->shape, i));
+ }
+ }
+ else {
+ mydim[0] = (intp) PyInt_AsLong(old->subarray->shape);
+ }
+
+ if (newstrides) {
+ intp tempsize;
+ intp *mystrides;
+ mystrides = newstrides + oldnd;
+ if (isfortran) {
+ memmove(newstrides+numnew, newstrides,
+ oldnd*sizeof(intp));
+ mystrides = newstrides;
+ }
+ /* Make new strides -- alwasy C-contiguous */
+ tempsize = (*des)->elsize;
+ for (i=numnew-1; i>=0; i--) {
+ mystrides[i] = tempsize;
+ tempsize *= mydim[i] ? mydim[i] : 1;
+ }
+ }
+
+ finish:
+ Py_INCREF(*des);
+ Py_DECREF(old);
+ return newnd;
+}
+
+
+/* steals a reference to descr (even on failure) */
+/*OBJECT_API
+ Generic new array creation routine.
+*/
+static PyObject *
+PyArray_NewFromDescr(PyTypeObject *subtype, PyArray_Descr *descr, int nd,
+ intp *dims, intp *strides, void *data,
+ int flags, PyObject *obj)
+{
+ PyArrayObject *self;
+ register int i;
+ size_t sd;
+ intp largest;
+ intp size;
+
+ if (descr->subarray) {
+ PyObject *ret;
+ intp newdims[2*MAX_DIMS];
+ intp *newstrides=NULL;
+ int isfortran=0;
+ isfortran = (data && (flags & FORTRAN) && !(flags & CONTIGUOUS)) || \
+ (!data && flags);
+ memcpy(newdims, dims, nd*sizeof(intp));
+ if (strides) {
+ newstrides = newdims + MAX_DIMS;
+ memcpy(newstrides, strides, nd*sizeof(intp));
+ }
+ nd =_update_descr_and_dimensions(&descr, newdims,
+ newstrides, nd, isfortran);
+ ret = PyArray_NewFromDescr(subtype, descr, nd, newdims,
+ newstrides,
+ data, flags, obj);
+ return ret;
+ }
+
+ if (nd < 0) {
+ PyErr_SetString(PyExc_ValueError,
+ "number of dimensions must be >=0");
+ Py_DECREF(descr);
+ return NULL;
+ }
+ if (nd > MAX_DIMS) {
+ PyErr_Format(PyExc_ValueError,
+ "maximum number of dimensions is %d", MAX_DIMS);
+ Py_DECREF(descr);
+ return NULL;
+ }
+
+ /* Check dimensions */
+ size = 1;
+ sd = (size_t) descr->elsize;
+ if (sd == 0) {
+ if (!PyDataType_ISSTRING(descr)) {
+ PyErr_SetString(PyExc_ValueError, "Empty data-type");
+ Py_DECREF(descr);
+ return NULL;
+ }
+ PyArray_DESCR_REPLACE(descr);
+ if (descr->type_num == NPY_STRING) descr->elsize = 1;
+ else descr->elsize = sizeof(PyArray_UCS4);
+ sd = (size_t) descr->elsize;
+ }
+ largest = MAX_INTP / sd;
+ for (i=0;i<nd;i++) {
+ if (dims[i] == 0) continue;
+ if (dims[i] < 0) {
+ PyErr_SetString(PyExc_ValueError,
+ "negative dimensions " \
+ "are not allowed");
+ Py_DECREF(descr);
+ return NULL;
+ }
+ size *= dims[i];
+ if (size > largest) {
+ PyErr_SetString(PyExc_ValueError,
+ "dimensions too large.");
+ Py_DECREF(descr);
+ return NULL;
+ }
+ }
+
+ self = (PyArrayObject *) subtype->tp_alloc(subtype, 0);
+ if (self == NULL) {
+ Py_DECREF(descr);
+ return NULL;
+ }
+ self->nd = nd;
+ self->dimensions = NULL;
+ self->data = NULL;
+ if (data == NULL) {
+ self->flags = DEFAULT;
+ if (flags) {
+ self->flags |= FORTRAN;
+ if (nd > 1) self->flags &= ~CONTIGUOUS;
+ flags = FORTRAN;
+ }
+ }
+ else self->flags = (flags & ~UPDATEIFCOPY);
+
+ self->descr = descr;
+ self->base = (PyObject *)NULL;
+ self->weakreflist = (PyObject *)NULL;
+
+ if (nd > 0) {
+ self->dimensions = PyDimMem_NEW(2*nd);
+ if (self->dimensions == NULL) {
+ PyErr_NoMemory();
+ goto fail;
+ }
+ self->strides = self->dimensions + nd;
+ memcpy(self->dimensions, dims, sizeof(intp)*nd);
+ if (strides == NULL) { /* fill it in */
+ sd = _array_fill_strides(self->strides, dims, nd, sd,
+ flags, &(self->flags));
+ }
+ else { /* we allow strides even when we create
+ the memory, but be careful with this...
+ */
+ memcpy(self->strides, strides, sizeof(intp)*nd);
+ sd *= size;
+ }
+ }
+ else { self->dimensions = self->strides = NULL; }
+
+ if (data == NULL) {
+
+ /* Allocate something even for zero-space arrays
+ e.g. shape=(0,) -- otherwise buffer exposure
+ (a.data) doesn't work as it should. */
+
+ if (sd==0) sd = descr->elsize;
+
+ if ((data = PyDataMem_NEW(sd))==NULL) {
+ PyErr_NoMemory();
+ goto fail;
+ }
+ self->flags |= OWNDATA;
+
+ /* It is bad to have unitialized OBJECT pointers */
+ /* which could also be sub-fields of a VOID array */
+ if (PyDataType_FLAGCHK(descr, NPY_NEEDS_INIT)) {
+ memset(data, 0, sd);
+ }
+ }
+ else {
+ self->flags &= ~OWNDATA; /* If data is passed in,
+ this object won't own it
+ by default.
+ Caller must arrange for
+ this to be reset if truly
+ desired */
+ }
+ self->data = data;
+
+ /* call the __array_finalize__
+ method if a subtype.
+ If obj is NULL, then call method with Py_None
+ */
+ if ((subtype != &PyArray_Type)) {
+ PyObject *res, *func, *args;
+ static PyObject *str=NULL;
+
+ if (str == NULL) {
+ str = PyString_InternFromString("__array_finalize__");
+ }
+ func = PyObject_GetAttr((PyObject *)self, str);
+ if (func && func != Py_None) {
+ if (strides != NULL) { /* did not allocate own data
+ or funny strides */
+ /* update flags before finalize function */
+ PyArray_UpdateFlags(self, UPDATE_ALL);
+ }
+ if PyCObject_Check(func) { /* A C-function is stored here */
+ PyArray_FinalizeFunc *cfunc;
+ cfunc = PyCObject_AsVoidPtr(func);
+ Py_DECREF(func);
+ if (cfunc(self, obj) < 0) goto fail;
+ }
+ else {
+ args = PyTuple_New(1);
+ if (obj == NULL) obj=Py_None;
+ Py_INCREF(obj);
+ PyTuple_SET_ITEM(args, 0, obj);
+ res = PyObject_Call(func, args, NULL);
+ Py_DECREF(args);
+ Py_DECREF(func);
+ if (res == NULL) goto fail;
+ else Py_DECREF(res);
+ }
+ }
+ else Py_XDECREF(func);
+ }
+
+ return (PyObject *)self;
+
+ fail:
+ Py_DECREF(self);
+ return NULL;
+}
+
+static void
+_putzero(char *optr, PyObject *zero, PyArray_Descr *dtype)
+{
+ if (!PyDataType_FLAGCHK(dtype, NPY_ITEM_REFCOUNT)) {
+ memset(optr, 0, dtype->elsize);
+ }
+ else if (PyDescr_HASFIELDS(dtype)) {
+ PyObject *key, *value, *title=NULL;
+ PyArray_Descr *new;
+ int offset;
+ Py_ssize_t pos=0;
+ while (PyDict_Next(dtype->fields, &pos, &key, &value)) {
+ if (!PyArg_ParseTuple(value, "Oi|O", &new, &offset,
+ &title)) return;
+ _putzero(optr + offset, zero, new);
+ }
+ }
+ else {
+ PyObject **temp;
+ Py_INCREF(zero);
+ temp = (PyObject **)optr;
+ *temp = zero;
+ }
+ return;
+}
+
+
+/*OBJECT_API
+ Resize (reallocate data). Only works if nothing else is referencing
+ this array and it is contiguous.
+ If refcheck is 0, then the reference count is not checked
+ and assumed to be 1.
+ You still must own this data and have no weak-references and no base
+ object.
+*/
+static PyObject *
+PyArray_Resize(PyArrayObject *self, PyArray_Dims *newshape, int refcheck,
+ NPY_ORDER fortran)
+{
+ intp oldsize, newsize;
+ int new_nd=newshape->len, k, n, elsize;
+ int refcnt;
+ intp* new_dimensions=newshape->ptr;
+ intp new_strides[MAX_DIMS];
+ size_t sd;
+ intp *dimptr;
+ char *new_data;
+ intp largest;
+
+ if (!PyArray_ISONESEGMENT(self)) {
+ PyErr_SetString(PyExc_ValueError,
+ "resize only works on single-segment arrays");
+ return NULL;
+ }
+
+ if (fortran == PyArray_ANYORDER)
+ fortran = PyArray_CORDER;
+
+ if (self->descr->elsize == 0) {
+ PyErr_SetString(PyExc_ValueError, "Bad data-type size.");
+ return NULL;
+ }
+ newsize = 1;
+ largest = MAX_INTP / self->descr->elsize;
+ for (k=0; k<new_nd; k++) {
+ if (new_dimensions[k]==0) break;
+ if (new_dimensions[k] < 0) {
+ PyErr_SetString(PyExc_ValueError,
+ "negative dimensions not allowed");
+ return NULL;
+ }
+ newsize *= new_dimensions[k];
+ if (newsize <=0 || newsize > largest) {
+ return PyErr_NoMemory();
+ }
+ }
+ oldsize = PyArray_SIZE(self);
+
+ if (oldsize != newsize) {
+ if (!(self->flags & OWNDATA)) {
+ PyErr_SetString(PyExc_ValueError,
+ "cannot resize this array: " \
+ "it does not own its data");
+ return NULL;
+ }
+
+ if (refcheck) refcnt = REFCOUNT(self);
+ else refcnt = 1;
+ if ((refcnt > 2) || (self->base != NULL) || \
+ (self->weakreflist != NULL)) {
+ PyErr_SetString(PyExc_ValueError,
+ "cannot resize an array that has "\
+ "been referenced or is referencing\n"\
+ "another array in this way. Use the "\
+ "resize function");
+ return NULL;
+ }
+
+ if (newsize == 0) sd = self->descr->elsize;
+ else sd = newsize * self->descr->elsize;
+ /* Reallocate space if needed */
+ new_data = PyDataMem_RENEW(self->data, sd);
+ if (new_data == NULL) {
+ PyErr_SetString(PyExc_MemoryError,
+ "cannot allocate memory for array");
+ return NULL;
+ }
+ self->data = new_data;
+ }
+
+ if ((newsize > oldsize) && PyArray_ISWRITEABLE(self)) {
+ /* Fill new memory with zeros */
+ elsize = self->descr->elsize;
+ if (PyDataType_FLAGCHK(self->descr, NPY_ITEM_REFCOUNT)) {
+ PyObject *zero = PyInt_FromLong(0);
+ char *optr;
+ optr = self->data + oldsize*elsize;
+ n = newsize - oldsize;
+ for (k=0; k<n; k++) {
+ _putzero((char *)optr, zero, self->descr);
+ optr += elsize;
+ }
+ Py_DECREF(zero);
+ }
+ else{
+ memset(self->data+oldsize*elsize, 0,
+ (newsize-oldsize)*elsize);
+ }
+ }
+
+ if (self->nd != new_nd) { /* Different number of dimensions. */
+ self->nd = new_nd;
+
+ /* Need new dimensions and strides arrays */
+ dimptr = PyDimMem_RENEW(self->dimensions, 2*new_nd);
+ if (dimptr == NULL) {
+ PyErr_SetString(PyExc_MemoryError,
+ "cannot allocate memory for array " \
+ "(array may be corrupted)");
+ return NULL;
+ }
+ self->dimensions = dimptr;
+ self->strides = dimptr + new_nd;
+ }
+
+ /* make new_strides variable */
+ sd = (size_t) self->descr->elsize;
+ sd = (size_t) _array_fill_strides(new_strides, new_dimensions, new_nd, sd,
+ self->flags, &(self->flags));
+
+ memmove(self->dimensions, new_dimensions, new_nd*sizeof(intp));
+ memmove(self->strides, new_strides, new_nd*sizeof(intp));
+
+ Py_INCREF(Py_None);
+ return Py_None;
+
+}
+
+static void
+_fillobject(char *optr, PyObject *obj, PyArray_Descr *dtype)
+{
+ if (!PyDataType_FLAGCHK(dtype, NPY_ITEM_REFCOUNT)) {
+ if ((obj == Py_None) ||
+ (PyInt_Check(obj) && PyInt_AsLong(obj)==0))
+ return;
+ else {
+ PyObject *arr;
+ Py_INCREF(dtype);
+ arr = PyArray_NewFromDescr(&PyArray_Type, dtype,
+ 0, NULL, NULL, NULL,
+ 0, NULL);
+ if (arr!=NULL)
+ dtype->f->setitem(obj, optr, arr);
+ Py_XDECREF(arr);
+ }
+ }
+ else if (PyDescr_HASFIELDS(dtype)) {
+ PyObject *key, *value, *title=NULL;
+ PyArray_Descr *new;
+ int offset;
+ Py_ssize_t pos=0;
+ while (PyDict_Next(dtype->fields, &pos, &key, &value)) {
+ if (!PyArg_ParseTuple(value, "Oi|O", &new, &offset,
+ &title)) return;
+ _fillobject(optr + offset, obj, new);
+ }
+ }
+ else {
+ PyObject **temp;
+ Py_XINCREF(obj);
+ temp = (PyObject **)optr;
+ *temp = obj;
+ return;
+ }
+}
+
+/* Assumes contiguous */
+/*OBJECT_API*/
+static void
+PyArray_FillObjectArray(PyArrayObject *arr, PyObject *obj)
+{
+ intp i,n;
+ n = PyArray_SIZE(arr);
+ if (arr->descr->type_num == PyArray_OBJECT) {
+ PyObject **optr;
+ optr = (PyObject **)(arr->data);
+ n = PyArray_SIZE(arr);
+ if (obj == NULL) {
+ for (i=0; i<n; i++) {
+ *optr++ = NULL;
+ }
+ }
+ else {
+ for (i=0; i<n; i++) {
+ Py_INCREF(obj);
+ *optr++ = obj;
+ }
+ }
+ }
+ else {
+ char *optr;
+ optr = arr->data;
+ for (i=0; i<n; i++) {
+ _fillobject(optr, obj, arr->descr);
+ optr += arr->descr->elsize;
+ }
+ }
+}
+
+/*OBJECT_API*/
+static int
+PyArray_FillWithScalar(PyArrayObject *arr, PyObject *obj)
+{
+ PyObject *newarr;
+ int itemsize, swap;
+ void *fromptr;
+ PyArray_Descr *descr;
+ intp size;
+ PyArray_CopySwapFunc *copyswap;
+
+ itemsize = arr->descr->elsize;
+ if (PyArray_ISOBJECT(arr)) {
+ fromptr = &obj;
+ swap = 0;
+ newarr = NULL;
+ }
+ else {
+ descr = PyArray_DESCR(arr);
+ Py_INCREF(descr);
+ newarr = PyArray_FromAny(obj, descr, 0,0, ALIGNED, NULL);
+ if (newarr == NULL) return -1;
+ fromptr = PyArray_DATA(newarr);
+ swap=!PyArray_ISNOTSWAPPED(arr);
+ }
+ size=PyArray_SIZE(arr);
+ copyswap = arr->descr->f->copyswap;
+ if (PyArray_ISONESEGMENT(arr)) {
+ char *toptr=PyArray_DATA(arr);
+ PyArray_FillWithScalarFunc* fillwithscalar =
+ arr->descr->f->fillwithscalar;
+ if (fillwithscalar && PyArray_ISALIGNED(arr)) {
+ copyswap(fromptr, NULL, swap, newarr);
+ fillwithscalar(toptr, size, fromptr, arr);
+ }
+ else {
+ while (size--) {
+ copyswap(toptr, fromptr, swap, arr);
+ toptr += itemsize;
+ }
+ }
+ }
+ else {
+ PyArrayIterObject *iter;
+
+ iter = (PyArrayIterObject *)\
+ PyArray_IterNew((PyObject *)arr);
+ if (iter == NULL) {
+ Py_XDECREF(newarr);
+ return -1;
+ }
+ while(size--) {
+ copyswap(iter->dataptr, fromptr, swap, arr);
+ PyArray_ITER_NEXT(iter);
+ }
+ Py_DECREF(iter);
+ }
+ Py_XDECREF(newarr);
+ return 0;
+}
+
+static PyObject *
+array_new(PyTypeObject *subtype, PyObject *args, PyObject *kwds)
+{
+ static char *kwlist[] = {"shape", "dtype", "buffer",
+ "offset", "strides",
+ "order", NULL};
+ PyArray_Descr *descr=NULL;
+ int itemsize;
+ PyArray_Dims dims = {NULL, 0};
+ PyArray_Dims strides = {NULL, 0};
+ PyArray_Chunk buffer;
+ longlong offset=0;
+ NPY_ORDER order=PyArray_CORDER;
+ int fortran = 0;
+ PyArrayObject *ret;
+
+ buffer.ptr = NULL;
+ /* Usually called with shape and type
+ but can also be called with buffer, strides, and swapped info
+ */
+
+ /* For now, let's just use this to create an empty, contiguous
+ array of a specific type and shape.
+ */
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "O&|O&O&LO&O&",
+ kwlist, PyArray_IntpConverter,
+ &dims,
+ PyArray_DescrConverter,
+ &descr,
+ PyArray_BufferConverter,
+ &buffer,
+ &offset,
+ &PyArray_IntpConverter,
+ &strides,
+ &PyArray_OrderConverter,
+ &order))
+ goto fail;
+
+ if (order == PyArray_FORTRANORDER) fortran = 1;
+
+ if (descr == NULL)
+ descr = PyArray_DescrFromType(PyArray_DEFAULT);
+
+ itemsize = descr->elsize;
+
+ if (itemsize == 0) {
+ PyErr_SetString(PyExc_ValueError,
+ "data-type with unspecified variable length");
+ goto fail;
+ }
+
+ if (strides.ptr != NULL) {
+ intp nb, off;
+ if (strides.len != dims.len) {
+ PyErr_SetString(PyExc_ValueError,
+ "strides, if given, must be " \
+ "the same length as shape");
+ goto fail;
+ }
+
+ if (buffer.ptr == NULL) {
+ nb = 0;
+ off = 0;
+ }
+ else {
+ nb = buffer.len;
+ off = (intp) offset;
+ }
+
+
+ if (!PyArray_CheckStrides(itemsize, dims.len,
+ nb, off,
+ dims.ptr, strides.ptr)) {
+ PyErr_SetString(PyExc_ValueError,
+ "strides is incompatible " \
+ "with shape of requested " \
+ "array and size of buffer");
+ goto fail;
+ }
+ }
+
+ if (buffer.ptr == NULL) {
+ ret = (PyArrayObject *) \
+ PyArray_NewFromDescr(subtype, descr,
+ (int)dims.len,
+ dims.ptr,
+ strides.ptr, NULL, fortran, NULL);
+ if (ret == NULL) {descr=NULL;goto fail;}
+ if (PyDataType_FLAGCHK(descr, NPY_ITEM_HASOBJECT)) {
+ /* place Py_None in object positions */
+ PyArray_FillObjectArray(ret, Py_None);
+ if (PyErr_Occurred()) {
+ descr=NULL;
+ goto fail;
+ }
+ }
+ }
+ else { /* buffer given -- use it */
+ if (dims.len == 1 && dims.ptr[0] == -1) {
+ dims.ptr[0] = (buffer.len-(intp)offset) / itemsize;
+ }
+ else if ((strides.ptr == NULL) && \
+ (buffer.len < ((intp)itemsize)* \
+ PyArray_MultiplyList(dims.ptr, dims.len))) {
+ PyErr_SetString(PyExc_TypeError,
+ "buffer is too small for " \
+ "requested array");
+ goto fail;
+ }
+ /* get writeable and aligned */
+ if (fortran) buffer.flags |= FORTRAN;
+ ret = (PyArrayObject *)\
+ PyArray_NewFromDescr(subtype, descr,
+ dims.len, dims.ptr,
+ strides.ptr,
+ offset + (char *)buffer.ptr,
+ buffer.flags, NULL);
+ if (ret == NULL) {descr=NULL; goto fail;}
+ PyArray_UpdateFlags(ret, UPDATE_ALL);
+ ret->base = buffer.base;
+ Py_INCREF(buffer.base);
+ }
+
+ PyDimMem_FREE(dims.ptr);
+ if (strides.ptr) PyDimMem_FREE(strides.ptr);
+ return (PyObject *)ret;
+
+ fail:
+ Py_XDECREF(descr);
+ if (dims.ptr) PyDimMem_FREE(dims.ptr);
+ if (strides.ptr) PyDimMem_FREE(strides.ptr);
+ return NULL;
+}
+
+
+static PyObject *
+array_iter(PyArrayObject *arr)
+{
+ if (arr->nd == 0) {
+ PyErr_SetString(PyExc_TypeError,
+ "iteration over a 0-d array");
+ return NULL;
+ }
+ return PySeqIter_New((PyObject *)arr);
+}
+
+
+/******************* array attribute get and set routines ******************/
+
+static PyObject *
+array_ndim_get(PyArrayObject *self)
+{
+ return PyInt_FromLong(self->nd);
+}
+
+static PyObject *
+array_flags_get(PyArrayObject *self)
+{
+ return PyArray_NewFlagsObject((PyObject *)self);
+}
+
+static PyObject *
+array_shape_get(PyArrayObject *self)
+{
+ return PyArray_IntTupleFromIntp(self->nd, self->dimensions);
+}
+
+
+static int
+array_shape_set(PyArrayObject *self, PyObject *val)
+{
+ int nd;
+ PyObject *ret;
+
+ /* Assumes C-order */
+ ret = PyArray_Reshape(self, val);
+ if (ret == NULL) return -1;
+ if (PyArray_DATA(ret) != PyArray_DATA(self)) {
+ Py_DECREF(ret);
+ PyErr_SetString(PyExc_AttributeError,
+ "incompatible shape for a non-contiguous "\
+ "array");
+ return -1;
+ }
+
+ /* Free old dimensions and strides */
+ PyDimMem_FREE(self->dimensions);
+ nd = PyArray_NDIM(ret);
+ self->nd = nd;
+ if (nd > 0) { /* create new dimensions and strides */
+ self->dimensions = PyDimMem_NEW(2*nd);
+ if (self->dimensions == NULL) {
+ Py_DECREF(ret);
+ PyErr_SetString(PyExc_MemoryError,"");
+ return -1;
+ }
+ self->strides = self->dimensions + nd;
+ memcpy(self->dimensions, PyArray_DIMS(ret),
+ nd*sizeof(intp));
+ memcpy(self->strides, PyArray_STRIDES(ret),
+ nd*sizeof(intp));
+ }
+ else {self->dimensions=NULL; self->strides=NULL;}
+ Py_DECREF(ret);
+ PyArray_UpdateFlags(self, CONTIGUOUS | FORTRAN);
+ return 0;
+}
+
+
+static PyObject *
+array_strides_get(PyArrayObject *self)
+{
+ return PyArray_IntTupleFromIntp(self->nd, self->strides);
+}
+
+static int
+array_strides_set(PyArrayObject *self, PyObject *obj)
+{
+ PyArray_Dims newstrides = {NULL, 0};
+ PyArrayObject *new;
+ intp numbytes=0;
+ intp offset=0;
+ Py_ssize_t buf_len;
+ char *buf;
+
+ if (!PyArray_IntpConverter(obj, &newstrides) || \
+ newstrides.ptr == NULL) {
+ PyErr_SetString(PyExc_TypeError, "invalid strides");
+ return -1;
+ }
+ if (newstrides.len != self->nd) {
+ PyErr_Format(PyExc_ValueError, "strides must be " \
+ " same length as shape (%d)", self->nd);
+ goto fail;
+ }
+ new = self;
+ while(new->base && PyArray_Check(new->base)) {
+ new = (PyArrayObject *)(new->base);
+ }
+ /* Get the available memory through the buffer
+ interface on new->base or if that fails
+ from the current new */
+ if (new->base && PyObject_AsReadBuffer(new->base,
+ (const void **)&buf,
+ &buf_len) >= 0) {
+ offset = self->data - buf;
+ numbytes = buf_len + offset;
+ }
+ else {
+ PyErr_Clear();
+ numbytes = PyArray_MultiplyList(new->dimensions,
+ new->nd)*new->descr->elsize;
+ offset = self->data - new->data;
+ }
+
+ if (!PyArray_CheckStrides(self->descr->elsize, self->nd, numbytes,
+ offset,
+ self->dimensions, newstrides.ptr)) {
+ PyErr_SetString(PyExc_ValueError, "strides is not "\
+ "compatible with available memory");
+ goto fail;
+ }
+ memcpy(self->strides, newstrides.ptr, sizeof(intp)*newstrides.len);
+ PyArray_UpdateFlags(self, CONTIGUOUS | FORTRAN);
+ PyDimMem_FREE(newstrides.ptr);
+ return 0;
+
+ fail:
+ PyDimMem_FREE(newstrides.ptr);
+ return -1;
+}
+
+
+
+static PyObject *
+array_priority_get(PyArrayObject *self)
+{
+ if (PyArray_CheckExact(self))
+ return PyFloat_FromDouble(PyArray_PRIORITY);
+ else
+ return PyFloat_FromDouble(PyArray_SUBTYPE_PRIORITY);
+}
+
+static PyObject *arraydescr_protocol_typestr_get(PyArray_Descr *);
+
+static PyObject *
+array_typestr_get(PyArrayObject *self)
+{
+ return arraydescr_protocol_typestr_get(self->descr);
+}
+
+static PyObject *
+array_descr_get(PyArrayObject *self)
+{
+ Py_INCREF(self->descr);
+ return (PyObject *)self->descr;
+}
+
+static PyObject *arraydescr_protocol_descr_get(PyArray_Descr *self);
+
+static PyObject *
+array_protocol_descr_get(PyArrayObject *self)
+{
+ PyObject *res;
+ PyObject *dobj;
+
+ res = arraydescr_protocol_descr_get(self->descr);
+ if (res) return res;
+ PyErr_Clear();
+
+ /* get default */
+ dobj = PyTuple_New(2);
+ if (dobj == NULL) return NULL;
+ PyTuple_SET_ITEM(dobj, 0, PyString_FromString(""));
+ PyTuple_SET_ITEM(dobj, 1, array_typestr_get(self));
+ res = PyList_New(1);
+ if (res == NULL) {Py_DECREF(dobj); return NULL;}
+ PyList_SET_ITEM(res, 0, dobj);
+ return res;
+}
+
+static PyObject *
+array_protocol_strides_get(PyArrayObject *self)
+{
+ if PyArray_ISCONTIGUOUS(self) {
+ Py_INCREF(Py_None);
+ return Py_None;
+ }
+ return PyArray_IntTupleFromIntp(self->nd, self->strides);
+}
+
+
+
+static PyObject *
+array_dataptr_get(PyArrayObject *self)
+{
+ return Py_BuildValue("NO",
+ PyLong_FromVoidPtr(self->data),
+ (self->flags & WRITEABLE ? Py_False :
+ Py_True));
+}
+
+static PyObject *
+array_ctypes_get(PyArrayObject *self)
+{
+ PyObject *_numpy_internal;
+ PyObject *ret;
+ _numpy_internal = PyImport_ImportModule("numpy.core._internal");
+ if (_numpy_internal == NULL) return NULL;
+ ret = PyObject_CallMethod(_numpy_internal, "_ctypes",
+ "ON", self,
+ PyLong_FromVoidPtr(self->data));
+ Py_DECREF(_numpy_internal);
+ return ret;
+}
+
+static PyObject *
+array_interface_get(PyArrayObject *self)
+{
+ PyObject *dict;
+ PyObject *obj;
+ dict = PyDict_New();
+ if (dict == NULL) return NULL;
+
+ /* dataptr */
+ obj = array_dataptr_get(self);
+ PyDict_SetItemString(dict, "data", obj);
+ Py_DECREF(obj);
+
+ obj = array_protocol_strides_get(self);
+ PyDict_SetItemString(dict, "strides", obj);
+ Py_DECREF(obj);
+
+ obj = array_protocol_descr_get(self);
+ PyDict_SetItemString(dict, "descr", obj);
+ Py_DECREF(obj);
+
+ obj = arraydescr_protocol_typestr_get(self->descr);
+ PyDict_SetItemString(dict, "typestr", obj);
+ Py_DECREF(obj);
+
+ obj = array_shape_get(self);
+ PyDict_SetItemString(dict, "shape", obj);
+ Py_DECREF(obj);
+
+ obj = PyInt_FromLong(3);
+ PyDict_SetItemString(dict, "version", obj);
+ Py_DECREF(obj);
+
+ return dict;
+}
+
+static PyObject *
+array_data_get(PyArrayObject *self)
+{
+ intp nbytes;
+ if (!(PyArray_ISONESEGMENT(self))) {
+ PyErr_SetString(PyExc_AttributeError, "cannot get single-"\
+ "segment buffer for discontiguous array");
+ return NULL;
+ }
+ nbytes = PyArray_NBYTES(self);
+ if PyArray_ISWRITEABLE(self)
+ return PyBuffer_FromReadWriteObject((PyObject *)self, 0,
+ (int) nbytes);
+ else
+ return PyBuffer_FromObject((PyObject *)self, 0, (int) nbytes);
+}
+
+static int
+array_data_set(PyArrayObject *self, PyObject *op)
+{
+ void *buf;
+ Py_ssize_t buf_len;
+ int writeable=1;
+
+ if (PyObject_AsWriteBuffer(op, &buf, &buf_len) < 0) {
+ writeable = 0;
+ if (PyObject_AsReadBuffer(op, (const void **)&buf,
+ &buf_len) < 0) {
+ PyErr_SetString(PyExc_AttributeError,
+ "object does not have single-segment " \
+ "buffer interface");
+ return -1;
+ }
+ }
+ if (!PyArray_ISONESEGMENT(self)) {
+ PyErr_SetString(PyExc_AttributeError, "cannot set single-" \
+ "segment buffer for discontiguous array");
+ return -1;
+ }
+ if (PyArray_NBYTES(self) > buf_len) {
+ PyErr_SetString(PyExc_AttributeError,
+ "not enough data for array");
+ return -1;
+ }
+ if (self->flags & OWNDATA) {
+ PyArray_XDECREF(self);
+ PyDataMem_FREE(self->data);
+ }
+ if (self->base) {
+ if (self->flags & UPDATEIFCOPY) {
+ ((PyArrayObject *)self->base)->flags |= WRITEABLE;
+ self->flags &= ~UPDATEIFCOPY;
+ }
+ Py_DECREF(self->base);
+ }
+ Py_INCREF(op);
+ self->base = op;
+ self->data = buf;
+ self->flags = CARRAY;
+ if (!writeable)
+ self->flags &= ~WRITEABLE;
+ return 0;
+}
+
+
+static PyObject *
+array_itemsize_get(PyArrayObject *self)
+{
+ return PyInt_FromLong((long) self->descr->elsize);
+}
+
+static PyObject *
+array_size_get(PyArrayObject *self)
+{
+ intp size=PyArray_SIZE(self);
+#if SIZEOF_INTP <= SIZEOF_LONG
+ return PyInt_FromLong((long) size);
+#else
+ if (size > MAX_LONG || size < MIN_LONG)
+ return PyLong_FromLongLong(size);
+ else
+ return PyInt_FromLong((long) size);
+#endif
+}
+
+static PyObject *
+array_nbytes_get(PyArrayObject *self)
+{
+ intp nbytes = PyArray_NBYTES(self);
+#if SIZEOF_INTP <= SIZEOF_LONG
+ return PyInt_FromLong((long) nbytes);
+#else
+ if (nbytes > MAX_LONG || nbytes < MIN_LONG)
+ return PyLong_FromLongLong(nbytes);
+ else
+ return PyInt_FromLong((long) nbytes);
+#endif
+}
+
+
+/* If the type is changed.
+ Also needing change: strides, itemsize
+
+ Either itemsize is exactly the same
+ or the array is single-segment (contiguous or fortran) with
+ compatibile dimensions
+
+ The shape and strides will be adjusted in that case as well.
+*/
+
+static int
+array_descr_set(PyArrayObject *self, PyObject *arg)
+{
+ PyArray_Descr *newtype=NULL;
+ intp newdim;
+ int index;
+ char *msg = "new type not compatible with array.";
+
+ if (!(PyArray_DescrConverter(arg, &newtype)) ||
+ newtype == NULL) {
+ PyErr_SetString(PyExc_TypeError, "invalid data-type for array");
+ return -1;
+ }
+ if (PyDataType_FLAGCHK(newtype, NPY_ITEM_HASOBJECT) ||
+ PyDataType_FLAGCHK(newtype, NPY_ITEM_IS_POINTER) ||
+ PyDataType_FLAGCHK(self->descr, NPY_ITEM_HASOBJECT) ||
+ PyDataType_FLAGCHK(self->descr, NPY_ITEM_IS_POINTER)) {
+ PyErr_SetString(PyExc_TypeError, \
+ "Cannot change data-type for object " \
+ "array.");
+ Py_DECREF(newtype);
+ return -1;
+ }
+
+ if (newtype->elsize == 0) {
+ PyErr_SetString(PyExc_TypeError,
+ "data-type must not be 0-sized");
+ Py_DECREF(newtype);
+ return -1;
+ }
+
+
+ if ((newtype->elsize != self->descr->elsize) && \
+ (self->nd == 0 || !PyArray_ISONESEGMENT(self) || \
+ newtype->subarray)) goto fail;
+
+ if (PyArray_ISCONTIGUOUS(self)) index = self->nd - 1;
+ else index = 0;
+
+ if (newtype->elsize < self->descr->elsize) {
+ /* if it is compatible increase the size of the
+ dimension at end (or at the front for FORTRAN)
+ */
+ if (self->descr->elsize % newtype->elsize != 0)
+ goto fail;
+ newdim = self->descr->elsize / newtype->elsize;
+ self->dimensions[index] *= newdim;
+ self->strides[index] = newtype->elsize;
+ }
+
+ else if (newtype->elsize > self->descr->elsize) {
+
+ /* Determine if last (or first if FORTRAN) dimension
+ is compatible */
+
+ newdim = self->dimensions[index] * self->descr->elsize;
+ if ((newdim % newtype->elsize) != 0) goto fail;
+
+ self->dimensions[index] = newdim / newtype->elsize;
+ self->strides[index] = newtype->elsize;
+ }
+
+ /* fall through -- adjust type*/
+
+ Py_DECREF(self->descr);
+ if (newtype->subarray) {
+ /* create new array object from data and update
+ dimensions, strides and descr from it */
+ PyArrayObject *temp;
+
+ /* We would decref newtype here --- temp will
+ steal a reference to it */
+ temp = (PyArrayObject *) \
+ PyArray_NewFromDescr(&PyArray_Type, newtype, self->nd,
+ self->dimensions, self->strides,
+ self->data, self->flags, NULL);
+ if (temp == NULL) return -1;
+ PyDimMem_FREE(self->dimensions);
+ self->dimensions = temp->dimensions;
+ self->nd = temp->nd;
+ self->strides = temp->strides;
+ newtype = temp->descr;
+ Py_INCREF(temp->descr);
+ /* Fool deallocator not to delete these*/
+ temp->nd = 0;
+ temp->dimensions = NULL;
+ Py_DECREF(temp);
+ }
+
+ self->descr = newtype;
+ PyArray_UpdateFlags(self, UPDATE_ALL);
+
+ return 0;
+
+ fail:
+ PyErr_SetString(PyExc_ValueError, msg);
+ Py_DECREF(newtype);
+ return -1;
+}
+
+static PyObject *
+array_struct_get(PyArrayObject *self)
+{
+ PyArrayInterface *inter;
+
+ inter = (PyArrayInterface *)_pya_malloc(sizeof(PyArrayInterface));
+ if (inter==NULL) return PyErr_NoMemory();
+ inter->two = 2;
+ inter->nd = self->nd;
+ inter->typekind = self->descr->kind;
+ inter->itemsize = self->descr->elsize;
+ inter->flags = self->flags;
+ /* reset unused flags */
+ inter->flags &= ~(UPDATEIFCOPY | OWNDATA);
+ if (PyArray_ISNOTSWAPPED(self)) inter->flags |= NOTSWAPPED;
+ /* Copy shape and strides over since these can be reset
+ when the array is "reshaped".
+ */
+ if (self->nd > 0) {
+ inter->shape = (intp *)_pya_malloc(2*sizeof(intp)*self->nd);
+ if (inter->shape == NULL) {
+ _pya_free(inter);
+ return PyErr_NoMemory();
+ }
+ inter->strides = inter->shape + self->nd;
+ memcpy(inter->shape, self->dimensions, sizeof(intp)*self->nd);
+ memcpy(inter->strides, self->strides, sizeof(intp)*self->nd);
+ }
+ else {
+ inter->shape = NULL;
+ inter->strides = NULL;
+ }
+ inter->data = self->data;
+ if (self->descr->names) {
+ inter->descr = arraydescr_protocol_descr_get(self->descr);
+ if (inter->descr == NULL) PyErr_Clear();
+ else inter->flags &= ARR_HAS_DESCR;
+ }
+ else inter->descr = NULL;
+ Py_INCREF(self);
+ return PyCObject_FromVoidPtrAndDesc(inter, self, gentype_struct_free);
+}
+
+static PyObject *
+array_base_get(PyArrayObject *self)
+{
+ if (self->base == NULL) {
+ Py_INCREF(Py_None);
+ return Py_None;
+ }
+ else {
+ Py_INCREF(self->base);
+ return self->base;
+ }
+}
+
+/* Create a view of a complex array with an equivalent data-type
+ except it is real instead of complex.
+*/
+
+static PyArrayObject *
+_get_part(PyArrayObject *self, int imag)
+{
+ PyArray_Descr *type;
+ PyArrayObject *ret;
+ int offset;
+
+ type = PyArray_DescrFromType(self->descr->type_num -
+ PyArray_NUM_FLOATTYPE);
+ offset = (imag ? type->elsize : 0);
+
+ if (!PyArray_ISNBO(self->descr->byteorder)) {
+ PyArray_Descr *new;
+ new = PyArray_DescrNew(type);
+ new->byteorder = self->descr->byteorder;
+ Py_DECREF(type);
+ type = new;
+ }
+ ret = (PyArrayObject *) \
+ PyArray_NewFromDescr(self->ob_type,
+ type,
+ self->nd,
+ self->dimensions,
+ self->strides,
+ self->data + offset,
+ self->flags, (PyObject *)self);
+ if (ret == NULL) return NULL;
+ ret->flags &= ~CONTIGUOUS;
+ ret->flags &= ~FORTRAN;
+ Py_INCREF(self);
+ ret->base = (PyObject *)self;
+ return ret;
+}
+
+static PyObject *
+array_real_get(PyArrayObject *self)
+{
+ PyArrayObject *ret;
+
+ if (PyArray_ISCOMPLEX(self)) {
+ ret = _get_part(self, 0);
+ return (PyObject *)ret;
+ }
+ else {
+ Py_INCREF(self);
+ return (PyObject *)self;
+ }
+}
+
+
+static int
+array_real_set(PyArrayObject *self, PyObject *val)
+{
+ PyArrayObject *ret;
+ PyArrayObject *new;
+ int rint;
+
+ if (PyArray_ISCOMPLEX(self)) {
+ ret = _get_part(self, 0);
+ if (ret == NULL) return -1;
+ }
+ else {
+ Py_INCREF(self);
+ ret = self;
+ }
+ new = (PyArrayObject *)PyArray_FromAny(val, NULL, 0, 0, 0, NULL);
+ if (new == NULL) {Py_DECREF(ret); return -1;}
+ rint = PyArray_MoveInto(ret, new);
+ Py_DECREF(ret);
+ Py_DECREF(new);
+ return rint;
+}
+
+static PyObject *
+array_imag_get(PyArrayObject *self)
+{
+ PyArrayObject *ret;
+ PyArray_Descr *type;
+
+ if (PyArray_ISCOMPLEX(self)) {
+ ret = _get_part(self, 1);
+ return (PyObject *) ret;
+ }
+ else {
+ type = self->descr;
+ Py_INCREF(type);
+ ret = (PyArrayObject *)PyArray_Zeros(self->nd,
+ self->dimensions,
+ type,
+ PyArray_ISFORTRAN(self));
+ ret->flags &= ~WRITEABLE;
+ if (PyArray_CheckExact(self))
+ return (PyObject *)ret;
+ else {
+ PyObject *newret;
+ newret = PyArray_View(ret, NULL, self->ob_type);
+ Py_DECREF(ret);
+ return newret;
+ }
+ }
+}
+
+static int
+array_imag_set(PyArrayObject *self, PyObject *val)
+{
+ if (PyArray_ISCOMPLEX(self)) {
+ PyArrayObject *ret;
+ PyArrayObject *new;
+ int rint;
+
+ ret = _get_part(self, 1);
+ if (ret == NULL) return -1;
+ new = (PyArrayObject *)PyArray_FromAny(val, NULL, 0, 0, 0, NULL);
+ if (new == NULL) {Py_DECREF(ret); return -1;}
+ rint = PyArray_MoveInto(ret, new);
+ Py_DECREF(ret);
+ Py_DECREF(new);
+ return rint;
+ }
+ else {
+ PyErr_SetString(PyExc_TypeError, "array does not have "\
+ "imaginary part to set");
+ return -1;
+ }
+}
+
+static PyObject *
+array_flat_get(PyArrayObject *self)
+{
+ return PyArray_IterNew((PyObject *)self);
+}
+
+static int
+array_flat_set(PyArrayObject *self, PyObject *val)
+{
+ PyObject *arr=NULL;
+ int retval = -1;
+ PyArrayIterObject *selfit=NULL, *arrit=NULL;
+ PyArray_Descr *typecode;
+ int swap;
+ PyArray_CopySwapFunc *copyswap;
+
+ typecode = self->descr;
+ Py_INCREF(typecode);
+ arr = PyArray_FromAny(val, typecode,
+ 0, 0, FORCECAST | FORTRAN_IF(self), NULL);
+ if (arr == NULL) return -1;
+ arrit = (PyArrayIterObject *)PyArray_IterNew(arr);
+ if (arrit == NULL) goto exit;
+ selfit = (PyArrayIterObject *)PyArray_IterNew((PyObject *)self);
+ if (selfit == NULL) goto exit;
+
+ if (arrit->size == 0) {retval = 0; goto exit;}
+
+ swap = PyArray_ISNOTSWAPPED(self) != PyArray_ISNOTSWAPPED(arr);
+ copyswap = self->descr->f->copyswap;
+ if (PyDataType_REFCHK(self->descr)) {
+ while(selfit->index < selfit->size) {
+ PyArray_Item_XDECREF(selfit->dataptr, self->descr);
+ PyArray_Item_INCREF(arrit->dataptr, PyArray_DESCR(arr));
+ memmove(selfit->dataptr, arrit->dataptr,
+ sizeof(PyObject **));
+ if (swap)
+ copyswap(selfit->dataptr, NULL, swap, self);
+ PyArray_ITER_NEXT(selfit);
+ PyArray_ITER_NEXT(arrit);
+ if (arrit->index == arrit->size)
+ PyArray_ITER_RESET(arrit);
+ }
+ retval = 0;
+ goto exit;
+ }
+
+ while(selfit->index < selfit->size) {
+ memmove(selfit->dataptr, arrit->dataptr, self->descr->elsize);
+ if (swap)
+ copyswap(selfit->dataptr, NULL, swap, self);
+ PyArray_ITER_NEXT(selfit);
+ PyArray_ITER_NEXT(arrit);
+ if (arrit->index == arrit->size)
+ PyArray_ITER_RESET(arrit);
+ }
+ retval = 0;
+ exit:
+ Py_XDECREF(selfit);
+ Py_XDECREF(arrit);
+ Py_XDECREF(arr);
+ return retval;
+}
+
+static PyObject *
+array_transpose_get(PyArrayObject *self)
+{
+ return PyArray_Transpose(self, NULL);
+}
+
+/* If this is None, no function call is made
+ --- default sub-class behavior
+*/
+static PyObject *
+array_finalize_get(PyArrayObject *self)
+{
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+static PyGetSetDef array_getsetlist[] = {
+ {"ndim",
+ (getter)array_ndim_get,
+ NULL, NULL},
+ {"flags",
+ (getter)array_flags_get,
+ NULL, NULL},
+ {"shape",
+ (getter)array_shape_get,
+ (setter)array_shape_set,
+ NULL},
+ {"strides",
+ (getter)array_strides_get,
+ (setter)array_strides_set,
+ NULL},
+ {"data",
+ (getter)array_data_get,
+ (setter)array_data_set,
+ NULL},
+ {"itemsize",
+ (getter)array_itemsize_get,
+ NULL, NULL},
+ {"size",
+ (getter)array_size_get,
+ NULL, NULL},
+ {"nbytes",
+ (getter)array_nbytes_get,
+ NULL, NULL},
+ {"base",
+ (getter)array_base_get,
+ NULL, NULL},
+ {"dtype",
+ (getter)array_descr_get,
+ (setter)array_descr_set,
+ NULL},
+ {"real",
+ (getter)array_real_get,
+ (setter)array_real_set,
+ NULL},
+ {"imag",
+ (getter)array_imag_get,
+ (setter)array_imag_set,
+ NULL},
+ {"flat",
+ (getter)array_flat_get,
+ (setter)array_flat_set,
+ NULL},
+ {"ctypes",
+ (getter)array_ctypes_get,
+ NULL, NULL},
+ {"T",
+ (getter)array_transpose_get,
+ NULL, NULL},
+ {"__array_interface__",
+ (getter)array_interface_get,
+ NULL, NULL},
+ {"__array_struct__",
+ (getter)array_struct_get,
+ NULL, NULL},
+ {"__array_priority__",
+ (getter)array_priority_get,
+ NULL, NULL},
+ {"__array_finalize__",
+ (getter)array_finalize_get,
+ NULL, NULL},
+ {NULL, NULL, NULL, NULL}, /* Sentinel */
+};
+
+/****************** end of attribute get and set routines *******************/
+
+
+static PyObject *
+array_alloc(PyTypeObject *type, Py_ssize_t nitems)
+{
+ PyObject *obj;
+ /* nitems will always be 0 */
+ obj = (PyObject *)_pya_malloc(sizeof(PyArrayObject));
+ PyObject_Init(obj, type);
+ return obj;
+}
+
+
+static PyTypeObject PyArray_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0, /*ob_size*/
+ "numpy.ndarray", /*tp_name*/
+ sizeof(PyArrayObject), /*tp_basicsize*/
+ 0, /*tp_itemsize*/
+ /* methods */
+ (destructor)array_dealloc, /*tp_dealloc */
+ (printfunc)NULL, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ (cmpfunc)0, /*tp_compare*/
+ (reprfunc)array_repr, /*tp_repr*/
+ &array_as_number, /*tp_as_number*/
+ &array_as_sequence, /*tp_as_sequence*/
+ &array_as_mapping, /*tp_as_mapping*/
+ (hashfunc)0, /*tp_hash*/
+ (ternaryfunc)0, /*tp_call*/
+ (reprfunc)array_str, /*tp_str*/
+
+ (getattrofunc)0, /*tp_getattro*/
+ (setattrofunc)0, /*tp_setattro*/
+ &array_as_buffer, /*tp_as_buffer*/
+ (Py_TPFLAGS_DEFAULT
+ | Py_TPFLAGS_BASETYPE
+ | Py_TPFLAGS_CHECKTYPES), /*tp_flags*/
+ /*Documentation string */
+ 0, /*tp_doc*/
+
+ (traverseproc)0, /*tp_traverse */
+ (inquiry)0, /*tp_clear */
+ (richcmpfunc)array_richcompare, /*tp_richcompare */
+ offsetof(PyArrayObject, weakreflist), /*tp_weaklistoffset */
+
+ /* Iterator support (use standard) */
+
+ (getiterfunc)array_iter, /* tp_iter */
+ (iternextfunc)0, /* tp_iternext */
+
+ /* Sub-classing (new-style object) support */
+
+ array_methods, /* tp_methods */
+ 0, /* tp_members */
+ array_getsetlist, /* tp_getset */
+ 0, /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
+ 0, /* tp_dictoffset */
+ (initproc)0, /* tp_init */
+ array_alloc, /* tp_alloc */
+ (newfunc)array_new, /* tp_new */
+ 0, /* tp_free */
+ 0, /* tp_is_gc */
+ 0, /* tp_bases */
+ 0, /* tp_mro */
+ 0, /* tp_cache */
+ 0, /* tp_subclasses */
+ 0 /* tp_weaklist */
+};
+
+/* The rest of this code is to build the right kind of array from a python */
+/* object. */
+
+static int
+discover_depth(PyObject *s, int max, int stop_at_string, int stop_at_tuple)
+{
+ int d=0;
+ PyObject *e;
+
+ if(max < 1) return -1;
+
+ if(! PySequence_Check(s) || PyInstance_Check(s) || \
+ PySequence_Length(s) < 0) {
+ PyErr_Clear(); return 0;
+ }
+ if (PyArray_Check(s))
+ return PyArray_NDIM(s);
+ if (PyArray_IsScalar(s, Generic)) return 0;
+ if (PyString_Check(s) || PyBuffer_Check(s) || PyUnicode_Check(s))
+ return stop_at_string ? 0:1;
+ if (stop_at_tuple && PyTuple_Check(s)) return 0;
+ if ((e=PyObject_GetAttrString(s, "__array_struct__")) != NULL) {
+ d = -1;
+ if (PyCObject_Check(e)) {
+ PyArrayInterface *inter;
+ inter = (PyArrayInterface *)PyCObject_AsVoidPtr(e);
+ if (inter->two == 2) {
+ d = inter->nd;
+ }
+ }
+ Py_DECREF(e);
+ if (d > -1) return d;
+ }
+ else PyErr_Clear();
+ if ((e=PyObject_GetAttrString(s, "__array_interface__")) != NULL) {
+ d = -1;
+ if (PyDict_Check(e)) {
+ PyObject *new;
+ new = PyDict_GetItemString(e, "shape");
+ if (new && PyTuple_Check(new))
+ d = PyTuple_GET_SIZE(new);
+ }
+ Py_DECREF(e);
+ if (d>-1) return d;
+ }
+ else PyErr_Clear();
+
+ if (PySequence_Length(s) == 0)
+ return 1;
+ if ((e=PySequence_GetItem(s,0)) == NULL) return -1;
+ if(e!=s) {
+ d=discover_depth(e, max-1, stop_at_string, stop_at_tuple);
+ if(d >= 0) d++;
+ }
+ Py_DECREF(e);
+ return d;
+}
+
+static int
+discover_itemsize(PyObject *s, int nd, int *itemsize)
+{
+ int n, r, i;
+ PyObject *e;
+
+ n = PyObject_Length(s);
+
+ if ((nd == 0) || PyString_Check(s) || \
+ PyUnicode_Check(s) || PyBuffer_Check(s)) {
+ *itemsize = MAX(*itemsize, n);
+ return 0;
+ }
+ for (i=0; i<n; i++) {
+ if ((e=PySequence_GetItem(s,i))==NULL) return -1;
+ r=discover_itemsize(e,nd-1,itemsize);
+ Py_DECREF(e);
+ if (r == -1) return -1;
+ }
+ return 0;
+}
+
+/* Take an arbitrary object known to represent
+ an array of ndim nd, and determine the size in each dimension
+*/
+
+static int
+discover_dimensions(PyObject *s, int nd, intp *d, int check_it)
+{
+ PyObject *e;
+ int r, n, i, n_lower;
+
+ n=PyObject_Length(s);
+ *d = n;
+ if(*d < 0) return -1;
+ if(nd <= 1) return 0;
+ n_lower = 0;
+ for(i=0; i<n; i++) {
+ if ((e=PySequence_GetItem(s,i)) == NULL) return -1;
+ r=discover_dimensions(e,nd-1,d+1,check_it);
+ Py_DECREF(e);
+
+ if (r == -1) return -1;
+ if (check_it && n_lower != 0 && n_lower != d[1]) {
+ PyErr_SetString(PyExc_ValueError,
+ "inconsistent shape in sequence");
+ return -1;
+ }
+ if (d[1] > n_lower) n_lower = d[1];
+ }
+ d[1] = n_lower;
+
+ return 0;
+}
+
+/* new reference */
+/* doesn't alter refcount of chktype or mintype ---
+ unless one of them is returned */
+static PyArray_Descr *
+_array_small_type(PyArray_Descr *chktype, PyArray_Descr* mintype)
+{
+ PyArray_Descr *outtype;
+ int outtype_num, save_num;
+
+ if (PyArray_EquivTypes(chktype, mintype)) {
+ Py_INCREF(mintype);
+ return mintype;
+ }
+
+
+ if (chktype->type_num > mintype->type_num)
+ outtype_num = chktype->type_num;
+ else {
+ if (PyDataType_ISOBJECT(chktype) && \
+ PyDataType_ISSTRING(mintype)) {
+ return PyArray_DescrFromType(NPY_OBJECT);
+ }
+ else {
+ outtype_num = mintype->type_num;
+ }
+ }
+
+ save_num = outtype_num;
+ while(outtype_num < PyArray_NTYPES &&
+ !(PyArray_CanCastSafely(chktype->type_num, outtype_num)
+ && PyArray_CanCastSafely(mintype->type_num, outtype_num)))
+ outtype_num++;
+ if (outtype_num == PyArray_NTYPES) {
+ outtype = PyArray_DescrFromType(save_num);
+ }
+ else {
+ outtype = PyArray_DescrFromType(outtype_num);
+ }
+ if (PyTypeNum_ISEXTENDED(outtype->type_num)) {
+ int testsize = outtype->elsize;
+ register int chksize, minsize;
+ chksize = chktype->elsize;
+ minsize = mintype->elsize;
+ /* Handle string->unicode case separately
+ because string itemsize is 4* as large */
+ if (outtype->type_num == PyArray_UNICODE &&
+ mintype->type_num == PyArray_STRING) {
+ testsize = MAX(chksize, 4*minsize);
+ }
+ else {
+ testsize = MAX(chksize, minsize);
+ }
+ if (testsize != outtype->elsize) {
+ PyArray_DESCR_REPLACE(outtype);
+ outtype->elsize = testsize;
+ Py_XDECREF(outtype->fields);
+ outtype->fields = NULL;
+ Py_XDECREF(outtype->names);
+ outtype->names = NULL;
+ }
+ }
+ return outtype;
+}
+
+static PyArray_Descr *
+_array_find_python_scalar_type(PyObject *op)
+{
+ if (PyFloat_Check(op)) {
+ return PyArray_DescrFromType(PyArray_DOUBLE);
+ }
+ else if (PyComplex_Check(op)) {
+ return PyArray_DescrFromType(PyArray_CDOUBLE);
+ }
+ else if (PyInt_Check(op)) {
+ /* bools are a subclass of int */
+ if (PyBool_Check(op)) {
+ return PyArray_DescrFromType(PyArray_BOOL);
+ } else {
+ return PyArray_DescrFromType(PyArray_LONG);
+ }
+ }
+ else if (PyLong_Check(op)) {
+ /* if integer can fit into a longlong then return that
+ */
+ if ((PyLong_AsLongLong(op) == -1) && PyErr_Occurred()) {
+ PyErr_Clear();
+ return PyArray_DescrFromType(PyArray_OBJECT);
+ }
+ return PyArray_DescrFromType(PyArray_LONGLONG);
+ }
+ return NULL;
+}
+
+static PyArray_Descr *
+_use_default_type(PyObject *op)
+{
+ int typenum, l;
+ PyObject *type;
+
+ typenum = -1;
+ l = 0;
+ type = (PyObject *)op->ob_type;
+ while (l < PyArray_NUMUSERTYPES) {
+ if (type == (PyObject *)(userdescrs[l]->typeobj)) {
+ typenum = l + PyArray_USERDEF;
+ break;
+ }
+ l++;
+ }
+ if (typenum == -1) {
+ typenum = PyArray_OBJECT;
+ }
+ return PyArray_DescrFromType(typenum);
+}
+
+
+/* op is an object to be converted to an ndarray.
+
+ minitype is the minimum type-descriptor needed.
+
+ max is the maximum number of dimensions -- used for recursive call
+ to avoid infinite recursion...
+
+*/
+
+static PyArray_Descr *
+_array_find_type(PyObject *op, PyArray_Descr *minitype, int max)
+{
+ int l;
+ PyObject *ip;
+ PyArray_Descr *chktype=NULL;
+ PyArray_Descr *outtype;
+
+ /* These need to come first because if op already carries
+ a descr structure, then we want it to be the result if minitype
+ is NULL.
+ */
+
+ if (PyArray_Check(op)) {
+ chktype = PyArray_DESCR(op);
+ Py_INCREF(chktype);
+ if (minitype == NULL) return chktype;
+ Py_INCREF(minitype);
+ goto finish;
+ }
+
+ if (PyArray_IsScalar(op, Generic)) {
+ chktype = PyArray_DescrFromScalar(op);
+ if (minitype == NULL) return chktype;
+ Py_INCREF(minitype);
+ goto finish;
+ }
+
+ if (minitype == NULL) {
+ minitype = PyArray_DescrFromType(PyArray_BOOL);
+ }
+ else Py_INCREF(minitype);
+
+ if (max < 0) goto deflt;
+
+ chktype = _array_find_python_scalar_type(op);
+ if (chktype) {
+ goto finish;
+ }
+
+ if ((ip=PyObject_GetAttrString(op, "__array_interface__"))!=NULL) {
+ if (PyDict_Check(ip)) {
+ PyObject *new;
+ new = PyDict_GetItemString(ip, "typestr");
+ if (new && PyString_Check(new)) {
+ chktype =_array_typedescr_fromstr \
+ (PyString_AS_STRING(new));
+ }
+ }
+ Py_DECREF(ip);
+ if (chktype) goto finish;
+ }
+ else PyErr_Clear();
+
+ if ((ip=PyObject_GetAttrString(op, "__array_struct__")) != NULL) {
+ PyArrayInterface *inter;
+ char buf[40];
+ if (PyCObject_Check(ip)) {
+ inter=(PyArrayInterface *)PyCObject_AsVoidPtr(ip);
+ if (inter->two == 2) {
+ snprintf(buf, 40, "|%c%d", inter->typekind,
+ inter->itemsize);
+ chktype = _array_typedescr_fromstr(buf);
+ }
+ }
+ Py_DECREF(ip);
+ if (chktype) goto finish;
+ }
+ else PyErr_Clear();
+
+ if (PyString_Check(op)) {
+ chktype = PyArray_DescrNewFromType(PyArray_STRING);
+ chktype->elsize = PyString_GET_SIZE(op);
+ goto finish;
+ }
+
+ if (PyUnicode_Check(op)) {
+ chktype = PyArray_DescrNewFromType(PyArray_UNICODE);
+ chktype->elsize = PyUnicode_GET_DATA_SIZE(op);
+#ifndef Py_UNICODE_WIDE
+ chktype->elsize <<= 1;
+#endif
+ goto finish;
+ }
+
+ if (PyBuffer_Check(op)) {
+ chktype = PyArray_DescrNewFromType(PyArray_VOID);
+ chktype->elsize = op->ob_type->tp_as_sequence->sq_length(op);
+ PyErr_Clear();
+ goto finish;
+ }
+
+ if (PyObject_HasAttrString(op, "__array__")) {
+ ip = PyObject_CallMethod(op, "__array__", NULL);
+ if(ip && PyArray_Check(ip)) {
+ chktype = PyArray_DESCR(ip);
+ Py_INCREF(chktype);
+ Py_DECREF(ip);
+ goto finish;
+ }
+ Py_XDECREF(ip);
+ if (PyErr_Occurred()) PyErr_Clear();
+ }
+
+ if (PyInstance_Check(op)) goto deflt;
+
+ if (PySequence_Check(op)) {
+
+ l = PyObject_Length(op);
+ if (l < 0 && PyErr_Occurred()) {
+ PyErr_Clear();
+ goto deflt;
+ }
+ if (l == 0 && minitype->type_num == PyArray_BOOL) {
+ Py_DECREF(minitype);
+ minitype = PyArray_DescrFromType(PyArray_DEFAULT);
+ }
+ while (--l >= 0) {
+ PyArray_Descr *newtype;
+ ip = PySequence_GetItem(op, l);
+ if (ip==NULL) {
+ PyErr_Clear();
+ goto deflt;
+ }
+ chktype = _array_find_type(ip, minitype, max-1);
+ newtype = _array_small_type(chktype, minitype);
+ Py_DECREF(minitype);
+ minitype = newtype;
+ Py_DECREF(chktype);
+ Py_DECREF(ip);
+ }
+ chktype = minitype;
+ Py_INCREF(minitype);
+ goto finish;
+ }
+
+
+ deflt:
+ chktype = _use_default_type(op);
+
+ finish:
+
+ outtype = _array_small_type(chktype, minitype);
+ Py_DECREF(chktype);
+ Py_DECREF(minitype);
+ /* VOID Arrays should not occur by "default"
+ unless input was already a VOID */
+ if (outtype->type_num == PyArray_VOID && \
+ minitype->type_num != PyArray_VOID) {
+ Py_DECREF(outtype);
+ return PyArray_DescrFromType(PyArray_OBJECT);
+ }
+ return outtype;
+}
+
+/* adapted from Numarray */
+static int
+setArrayFromSequence(PyArrayObject *a, PyObject *s, int dim, intp offset)
+{
+ Py_ssize_t i, slen = PySequence_Length(s);
+ int res = 0;
+
+ if (dim > a->nd) {
+ PyErr_Format(PyExc_ValueError,
+ "setArrayFromSequence: sequence/array dimensions mismatch.");
+ return -1;
+ }
+
+ if (slen != a->dimensions[dim]) {
+ PyErr_Format(PyExc_ValueError,
+ "setArrayFromSequence: sequence/array shape mismatch.");
+ return -1;
+ }
+
+ for(i=0; i<slen; i++) {
+ PyObject *o = PySequence_GetItem(s, i);
+ if ((a->nd - dim) > 1) {
+ res = setArrayFromSequence(a, o, dim+1, offset);
+ }
+ else {
+ res = a->descr->f->setitem(o, (a->data + offset), a);
+ }
+ Py_DECREF(o);
+ if (res < 0) return res;
+ offset += a->strides[dim];
+ }
+ return 0;
+}
+
+
+static int
+Assign_Array(PyArrayObject *self, PyObject *v)
+{
+ if (!PySequence_Check(v)) {
+ PyErr_SetString(PyExc_ValueError,
+ "assignment from non-sequence");
+ return -1;
+ }
+ if (self->nd == 0) {
+ PyErr_SetString(PyExc_ValueError,
+ "assignment to 0-d array");
+ return -1;
+ }
+
+ return setArrayFromSequence(self, v, 0, 0);
+}
+
+/* "Array Scalars don't call this code" */
+/* steals reference to typecode -- no NULL*/
+static PyObject *
+Array_FromPyScalar(PyObject *op, PyArray_Descr *typecode)
+{
+ PyArrayObject *ret;
+ int itemsize;
+ int type;
+
+ itemsize = typecode->elsize;
+ type = typecode->type_num;
+
+ if (itemsize == 0 && PyTypeNum_ISEXTENDED(type)) {
+ itemsize = PyObject_Length(op);
+ if (type == PyArray_UNICODE) itemsize *= 4;
+
+ if (itemsize != typecode->elsize) {
+ PyArray_DESCR_REPLACE(typecode);
+ typecode->elsize = itemsize;
+ }
+ }
+
+ ret = (PyArrayObject *)PyArray_NewFromDescr(&PyArray_Type, typecode,
+ 0, NULL,
+ NULL, NULL, 0, NULL);
+ if (ret == NULL) return NULL;
+ if (ret->nd > 0) {
+ PyErr_SetString(PyExc_ValueError,
+ "shape-mismatch on array construction");
+ Py_DECREF(ret);
+ return NULL;
+ }
+
+ ret->descr->f->setitem(op, ret->data, ret);
+
+ if (PyErr_Occurred()) {
+ Py_DECREF(ret);
+ return NULL;
+ } else {
+ return (PyObject *)ret;
+ }
+}
+
+
+/* If s is not a list, return 0
+ Otherwise:
+
+ run object_depth_and_dimension on all the elements
+ and make sure the returned shape and size
+ is the same for each element
+
+*/
+static int
+object_depth_and_dimension(PyObject *s, int max, intp *dims)
+{
+ intp *newdims, *test_dims;
+ int nd, test_nd;
+ int i, islist;
+ intp size;
+ PyObject *obj;
+
+ islist = PyList_Check(s);
+ if (!(islist || PyTuple_Check(s)) ||
+ ((size = PySequence_Size(s)) == 0))
+ return 0;
+ if (max < 2) {
+ if (max < 1) return 0;
+ dims[0] = size;
+ return 1;
+ }
+ newdims = PyDimMem_NEW(2*(max-1));
+ test_dims = newdims + (max-1);
+ if (islist) obj = PyList_GET_ITEM(s, 0);
+ else obj = PyTuple_GET_ITEM(s, 0);
+ nd = object_depth_and_dimension(obj, max-1, newdims);
+ for (i=1; i<size; i++) {
+ if (islist) obj = PyList_GET_ITEM(s, i);
+ else obj = PyTuple_GET_ITEM(s, i);
+ test_nd = object_depth_and_dimension(obj, max-1, test_dims);
+ if ((nd != test_nd) ||
+ (!PyArray_CompareLists(newdims, test_dims, nd))) {
+ nd = 0;
+ break;
+ }
+ }
+
+ for (i=1; i<=nd; i++) dims[i] = newdims[i-1];
+ dims[0] = size;
+ PyDimMem_FREE(newdims);
+ return nd+1;
+}
+
+static PyObject *
+ObjectArray_FromNestedList(PyObject *s, PyArray_Descr *typecode, int fortran)
+{
+ int nd;
+ intp d[MAX_DIMS];
+ PyArrayObject *r;
+
+ /* Get the depth and the number of dimensions */
+ nd = object_depth_and_dimension(s, MAX_DIMS, d);
+ if (nd < 0) return NULL;
+
+ if (nd == 0) return Array_FromPyScalar(s, typecode);
+
+ r=(PyArrayObject*)PyArray_NewFromDescr(&PyArray_Type, typecode,
+ nd, d,
+ NULL, NULL,
+ fortran, NULL);
+
+ if(!r) return NULL;
+ if(Assign_Array(r,s) == -1) {
+ Py_DECREF(r);
+ return NULL;
+ }
+ return (PyObject*)r;
+}
+
+/* isobject means that we are constructing an
+ object array on-purpose with a nested list.
+ Only a list is interpreted as a sequence with these rules
+ */
+/* steals reference to typecode */
+static PyObject *
+Array_FromSequence(PyObject *s, PyArray_Descr *typecode, int fortran,
+ int min_depth, int max_depth)
+{
+ PyArrayObject *r;
+ int nd;
+ intp d[MAX_DIMS];
+ int stop_at_string;
+ int stop_at_tuple;
+ int check_it;
+ int type = typecode->type_num;
+ int itemsize = typecode->elsize;
+
+ check_it = (typecode->type != PyArray_CHARLTR);
+
+ stop_at_string = ((type == PyArray_OBJECT) ||
+ (type == PyArray_STRING &&
+ typecode->type == PyArray_STRINGLTR) ||
+ (type == PyArray_UNICODE) ||
+ (type == PyArray_VOID));
+
+ stop_at_tuple = (type == PyArray_VOID && (typecode->names \
+ || typecode->subarray));
+
+ if (!((nd=discover_depth(s, MAX_DIMS+1, stop_at_string,
+ stop_at_tuple)) > 0)) {
+ if (nd==0)
+ return Array_FromPyScalar(s, typecode);
+ PyErr_SetString(PyExc_ValueError,
+ "invalid input sequence");
+ goto fail;
+ }
+
+ if (max_depth && PyTypeNum_ISOBJECT(type) && (nd > max_depth)) {
+ nd = max_depth;
+ }
+
+ if ((max_depth && nd > max_depth) || \
+ (min_depth && nd < min_depth)) {
+ PyErr_SetString(PyExc_ValueError,
+ "invalid number of dimensions");
+ goto fail;
+ }
+
+ if(discover_dimensions(s,nd,d, check_it) == -1) goto fail;
+
+ if (typecode->type == PyArray_CHARLTR && nd > 0 && d[nd-1]==1) {
+ nd = nd-1;
+ }
+
+ if (itemsize == 0 && PyTypeNum_ISEXTENDED(type)) {
+ if (discover_itemsize(s, nd, &itemsize) == -1) goto fail;
+ if (type == PyArray_UNICODE) itemsize*=4;
+ }
+
+ if (itemsize != typecode->elsize) {
+ PyArray_DESCR_REPLACE(typecode);
+ typecode->elsize = itemsize;
+ }
+
+ r=(PyArrayObject*)PyArray_NewFromDescr(&PyArray_Type, typecode,
+ nd, d,
+ NULL, NULL,
+ fortran, NULL);
+
+ if(!r) return NULL;
+ if(Assign_Array(r,s) == -1) {
+ Py_DECREF(r);
+ return NULL;
+ }
+ return (PyObject*)r;
+
+ fail:
+ Py_DECREF(typecode);
+ return NULL;
+}
+
+
+/*OBJECT_API
+ Is the typenum valid?
+*/
+static int
+PyArray_ValidType(int type)
+{
+ PyArray_Descr *descr;
+ int res=TRUE;
+
+ descr = PyArray_DescrFromType(type);
+ if (descr==NULL) res = FALSE;
+ Py_DECREF(descr);
+ return res;
+}
+
+/* For backward compatibility */
+
+/* steals reference to at --- cannot be NULL*/
+/*OBJECT_API
+ Cast an array using typecode structure.
+*/
+static PyObject *
+PyArray_CastToType(PyArrayObject *mp, PyArray_Descr *at, int fortran)
+{
+ PyObject *out;
+ int ret;
+ PyArray_Descr *mpd;
+
+ mpd = mp->descr;
+
+ if (((mpd == at) || ((mpd->type_num == at->type_num) && \
+ PyArray_EquivByteorders(mpd->byteorder,\
+ at->byteorder) && \
+ ((mpd->elsize == at->elsize) || \
+ (at->elsize==0)))) && \
+ PyArray_ISBEHAVED_RO(mp)) {
+ Py_DECREF(at);
+ Py_INCREF(mp);
+ return (PyObject *)mp;
+ }
+
+ if (at->elsize == 0) {
+ PyArray_DESCR_REPLACE(at);
+ if (at == NULL) return NULL;
+ if (mpd->type_num == PyArray_STRING && \
+ at->type_num == PyArray_UNICODE)
+ at->elsize = mpd->elsize << 2;
+ if (mpd->type_num == PyArray_UNICODE &&
+ at->type_num == PyArray_STRING)
+ at->elsize = mpd->elsize >> 2;
+ if (at->type_num == PyArray_VOID)
+ at->elsize = mpd->elsize;
+ }
+
+ out = PyArray_NewFromDescr(mp->ob_type, at,
+ mp->nd,
+ mp->dimensions,
+ NULL, NULL,
+ fortran,
+ (PyObject *)mp);
+
+ if (out == NULL) return NULL;
+ ret = PyArray_CastTo((PyArrayObject *)out, mp);
+ if (ret != -1) return out;
+
+ Py_DECREF(out);
+ return NULL;
+
+}
+
+/*OBJECT_API
+ Get a cast function to cast from the input descriptor to the
+ output type_number (must be a registered data-type).
+ Returns NULL if un-successful.
+*/
+static PyArray_VectorUnaryFunc *
+PyArray_GetCastFunc(PyArray_Descr *descr, int type_num)
+{
+ PyArray_VectorUnaryFunc *castfunc=NULL;
+ if (type_num < PyArray_NTYPES) {
+ castfunc = descr->f->cast[type_num];
+ }
+ if (castfunc == NULL) {
+ PyObject *obj = descr->f->castdict;
+ if (obj && PyDict_Check(obj)) {
+ PyObject *key;
+ PyObject *cobj;
+ key = PyInt_FromLong(type_num);
+ cobj = PyDict_GetItem(obj, key);
+ Py_DECREF(key);
+ if (PyCObject_Check(cobj)) {
+ castfunc = PyCObject_AsVoidPtr(cobj);
+ }
+ }
+ if (castfunc) return castfunc;
+ }
+ else return castfunc;
+
+ PyErr_SetString(PyExc_ValueError,
+ "No cast function available.");
+ return NULL;
+}
+
+/* Reference counts:
+ copyswapn is used which increases and decreases reference counts for OBJECT arrays.
+ All that needs to happen is for any reference counts in the buffers to be
+ decreased when completely finished with the buffers.
+
+ buffers[0] is the destination
+ buffers[1] is the source
+*/
+static void
+_strided_buffered_cast(char *dptr, intp dstride, int delsize, int dswap,
+ PyArray_CopySwapNFunc *dcopyfunc,
+ char *sptr, intp sstride, int selsize, int sswap,
+ PyArray_CopySwapNFunc *scopyfunc,
+ intp N, char **buffers, int bufsize,
+ PyArray_VectorUnaryFunc *castfunc,
+ PyArrayObject *dest, PyArrayObject *src)
+{
+ int i;
+ if (N <= bufsize) {
+ /* 1. copy input to buffer and swap
+ 2. cast input to output
+ 3. swap output if necessary and copy from output buffer
+ */
+ scopyfunc(buffers[1], selsize, sptr, sstride, N, sswap, src);
+ castfunc(buffers[1], buffers[0], N, src, dest);
+ dcopyfunc(dptr, dstride, buffers[0], delsize, N, dswap, dest);
+ return;
+ }
+
+ /* otherwise we need to divide up into bufsize pieces */
+ i = 0;
+ while(N > 0) {
+ int newN;
+ newN = MIN(N, bufsize);
+ _strided_buffered_cast(dptr+i*dstride, dstride, delsize,
+ dswap, dcopyfunc,
+ sptr+i*sstride, sstride, selsize,
+ sswap, scopyfunc,
+ newN, buffers, bufsize, castfunc, dest, src);
+ i += newN;
+ N -= bufsize;
+ }
+ return;
+}
+
+static int
+_broadcast_cast(PyArrayObject *out, PyArrayObject *in,
+ PyArray_VectorUnaryFunc *castfunc, int iswap, int oswap)
+{
+ int delsize, selsize, maxaxis, i, N;
+ PyArrayMultiIterObject *multi;
+ intp maxdim, ostrides, istrides;
+ char *buffers[2];
+ PyArray_CopySwapNFunc *ocopyfunc, *icopyfunc;
+ char *obptr;
+
+ NPY_BEGIN_THREADS_DEF
+
+ delsize = PyArray_ITEMSIZE(out);
+ selsize = PyArray_ITEMSIZE(in);
+ multi = (PyArrayMultiIterObject *)PyArray_MultiIterNew(2, out, in);
+ if (multi == NULL) return -1;
+
+ if (multi->size != PyArray_SIZE(out)) {
+ PyErr_SetString(PyExc_ValueError,
+ "array dimensions are not "\
+ "compatible for copy");
+ Py_DECREF(multi);
+ return -1;
+ }
+
+ icopyfunc = in->descr->f->copyswapn;
+ ocopyfunc = out->descr->f->copyswapn;
+ maxaxis = PyArray_RemoveSmallest(multi);
+ if (maxaxis < 0) { /* cast 1 0-d array to another */
+ N = 1;
+ maxdim = 1;
+ ostrides = delsize;
+ istrides = selsize;
+ }
+ else {
+ maxdim = multi->dimensions[maxaxis];
+ N = (int) (MIN(maxdim, PyArray_BUFSIZE));
+ ostrides = multi->iters[0]->strides[maxaxis];
+ istrides = multi->iters[1]->strides[maxaxis];
+
+ }
+ buffers[0] = _pya_malloc(N*delsize);
+ if (buffers[0] == NULL) {
+ PyErr_NoMemory();
+ return -1;
+ }
+ buffers[1] = _pya_malloc(N*selsize);
+ if (buffers[1] == NULL) {
+ _pya_free(buffers[0]);
+ PyErr_NoMemory();
+ return -1;
+ }
+ if (PyDataType_FLAGCHK(out->descr, NPY_NEEDS_INIT))
+ memset(buffers[0], 0, N*delsize);
+ if (PyDataType_FLAGCHK(in->descr, NPY_NEEDS_INIT))
+ memset(buffers[1], 0, N*selsize);
+
+#if NPY_ALLOW_THREADS
+ if (PyArray_ISNUMBER(in) && PyArray_ISNUMBER(out)) {
+ NPY_BEGIN_THREADS
+ }
+#endif
+
+ while(multi->index < multi->size) {
+ _strided_buffered_cast(multi->iters[0]->dataptr,
+ ostrides,
+ delsize, oswap, ocopyfunc,
+ multi->iters[1]->dataptr,
+ istrides,
+ selsize, iswap, icopyfunc,
+ maxdim, buffers, N,
+ castfunc, out, in);
+ PyArray_MultiIter_NEXT(multi);
+ }
+#if NPY_ALLOW_THREADS
+ if (PyArray_ISNUMBER(in) && PyArray_ISNUMBER(out)) {
+ NPY_END_THREADS
+ }
+#endif
+ Py_DECREF(multi);
+ if (PyDataType_REFCHK(in->descr)) {
+ obptr = buffers[1];
+ for (i=0; i<N; i++, obptr+=selsize)
+ PyArray_Item_XDECREF(obptr, out->descr);
+ }
+ if (PyDataType_REFCHK(out->descr)) {
+ obptr = buffers[0];
+ for (i=0; i<N; i++, obptr+=delsize)
+ PyArray_Item_XDECREF(obptr, out->descr);
+ }
+ _pya_free(buffers[0]);
+ _pya_free(buffers[1]);
+ if (PyErr_Occurred()) return -1;
+ return 0;
+}
+
+
+
+/* Must be broadcastable.
+ This code is very similar to PyArray_CopyInto/PyArray_MoveInto
+ except casting is done --- PyArray_BUFSIZE is used
+ as the size of the casting buffer.
+*/
+
+/*OBJECT_API
+ Cast to an already created array.
+*/
+static int
+PyArray_CastTo(PyArrayObject *out, PyArrayObject *mp)
+{
+
+ int simple;
+ int same;
+ PyArray_VectorUnaryFunc *castfunc=NULL;
+ int mpsize = PyArray_SIZE(mp);
+ int iswap, oswap;
+
+ NPY_BEGIN_THREADS_DEF
+
+ if (mpsize == 0) return 0;
+ if (!PyArray_ISWRITEABLE(out)) {
+ PyErr_SetString(PyExc_ValueError,
+ "output array is not writeable");
+ return -1;
+ }
+
+ castfunc = PyArray_GetCastFunc(mp->descr, out->descr->type_num);
+ if (castfunc == NULL) return -1;
+
+
+ same = PyArray_SAMESHAPE(out, mp);
+ simple = same && ((PyArray_ISCARRAY_RO(mp) && PyArray_ISCARRAY(out)) ||
+ (PyArray_ISFARRAY_RO(mp) && PyArray_ISFARRAY(out)));
+
+ if (simple) {
+
+#if NPY_ALLOW_THREADS
+ if (PyArray_ISNUMBER(mp) && PyArray_ISNUMBER(out)) {
+ NPY_BEGIN_THREADS }
+#endif
+ castfunc(mp->data, out->data, mpsize, mp, out);
+
+#if NPY_ALLOW_THREADS
+ if (PyArray_ISNUMBER(mp) && PyArray_ISNUMBER(out)) {
+ NPY_END_THREADS }
+#endif
+ if (!PyArray_ISNUMBER(mp) && PyErr_Occurred()) return -1;
+ }
+
+ /* If the input or output is OBJECT, STRING, UNICODE, or VOID */
+ /* then getitem and setitem are used for the cast */
+ /* and byteswapping is handled by those methods */
+
+ if (PyArray_ISFLEXIBLE(mp) || PyArray_ISOBJECT(mp) || PyArray_ISOBJECT(out) ||
+ PyArray_ISFLEXIBLE(out)) {
+ iswap = oswap = 0;
+ }
+ else {
+ iswap = PyArray_ISBYTESWAPPED(mp);
+ oswap = PyArray_ISBYTESWAPPED(out);
+ }
+
+ return _broadcast_cast(out, mp, castfunc, iswap, oswap);
+}
+
+
+static int
+_bufferedcast(PyArrayObject *out, PyArrayObject *in,
+ PyArray_VectorUnaryFunc *castfunc)
+{
+ char *inbuffer, *bptr, *optr;
+ char *outbuffer=NULL;
+ PyArrayIterObject *it_in=NULL, *it_out=NULL;
+ register intp i, index;
+ intp ncopies = PyArray_SIZE(out) / PyArray_SIZE(in);
+ int elsize=in->descr->elsize;
+ int nels = PyArray_BUFSIZE;
+ int el;
+ int inswap, outswap=0;
+ int obuf=!PyArray_ISCARRAY(out);
+ int oelsize = out->descr->elsize;
+ PyArray_CopySwapFunc *in_csn;
+ PyArray_CopySwapFunc *out_csn;
+ int retval = -1;
+
+ in_csn = in->descr->f->copyswap;
+ out_csn = out->descr->f->copyswap;
+
+ /* If the input or output is STRING, UNICODE, or VOID */
+ /* then getitem and setitem are used for the cast */
+ /* and byteswapping is handled by those methods */
+
+ inswap = !(PyArray_ISFLEXIBLE(in) || PyArray_ISNOTSWAPPED(in));
+
+ inbuffer = PyDataMem_NEW(PyArray_BUFSIZE*elsize);
+ if (inbuffer == NULL) return -1;
+ if (PyArray_ISOBJECT(in))
+ memset(inbuffer, 0, PyArray_BUFSIZE*elsize);
+ it_in = (PyArrayIterObject *)PyArray_IterNew((PyObject *)in);
+ if (it_in == NULL) goto exit;
+
+ if (obuf) {
+ outswap = !(PyArray_ISFLEXIBLE(out) || \
+ PyArray_ISNOTSWAPPED(out));
+ outbuffer = PyDataMem_NEW(PyArray_BUFSIZE*oelsize);
+ if (outbuffer == NULL) goto exit;
+ if (PyArray_ISOBJECT(out))
+ memset(outbuffer, 0, PyArray_BUFSIZE*oelsize);
+
+ it_out = (PyArrayIterObject *)PyArray_IterNew((PyObject *)out);
+ if (it_out == NULL) goto exit;
+
+ nels = MIN(nels, PyArray_BUFSIZE);
+ }
+
+ optr = (obuf) ? outbuffer: out->data;
+ bptr = inbuffer;
+ el = 0;
+ while(ncopies--) {
+ index = it_in->size;
+ PyArray_ITER_RESET(it_in);
+ while(index--) {
+ in_csn(bptr, it_in->dataptr, inswap, in);
+ bptr += elsize;
+ PyArray_ITER_NEXT(it_in);
+ el += 1;
+ if ((el == nels) || (index == 0)) {
+ /* buffer filled, do cast */
+
+ castfunc(inbuffer, optr, el, in, out);
+
+ if (obuf) {
+ /* Copy from outbuffer to array */
+ for(i=0; i<el; i++) {
+ out_csn(it_out->dataptr,
+ optr, outswap,
+ out);
+ optr += oelsize;
+ PyArray_ITER_NEXT(it_out);
+ }
+ optr = outbuffer;
+ }
+ else {
+ optr += out->descr->elsize * nels;
+ }
+ el = 0;
+ bptr = inbuffer;
+ }
+ }
+ }
+ retval = 0;
+ exit:
+ Py_XDECREF(it_in);
+ PyDataMem_FREE(inbuffer);
+ PyDataMem_FREE(outbuffer);
+ if (obuf) {
+ Py_XDECREF(it_out);
+ }
+ return retval;
+}
+
+/*OBJECT_API
+ Cast to an already created array. Arrays don't have to be "broadcastable"
+ Only requirement is they have the same number of elements.
+*/
+static int
+PyArray_CastAnyTo(PyArrayObject *out, PyArrayObject *mp)
+{
+ int simple;
+ PyArray_VectorUnaryFunc *castfunc=NULL;
+ int mpsize = PyArray_SIZE(mp);
+
+ if (mpsize == 0) return 0;
+ if (!PyArray_ISWRITEABLE(out)) {
+ PyErr_SetString(PyExc_ValueError,
+ "output array is not writeable");
+ return -1;
+ }
+
+ if (!(mpsize == PyArray_SIZE(out))) {
+ PyErr_SetString(PyExc_ValueError,
+ "arrays must have the same number of"
+ " elements for the cast.");
+ return -1;
+ }
+
+ castfunc = PyArray_GetCastFunc(mp->descr, out->descr->type_num);
+ if (castfunc == NULL) return -1;
+
+
+ simple = ((PyArray_ISCARRAY_RO(mp) && PyArray_ISCARRAY(out)) ||
+ (PyArray_ISFARRAY_RO(mp) && PyArray_ISFARRAY(out)));
+
+ if (simple) {
+ castfunc(mp->data, out->data, mpsize, mp, out);
+ return 0;
+ }
+
+ if (PyArray_SAMESHAPE(out, mp)) {
+ int iswap, oswap;
+ iswap = PyArray_ISBYTESWAPPED(mp) && !PyArray_ISFLEXIBLE(mp);
+ oswap = PyArray_ISBYTESWAPPED(out) && !PyArray_ISFLEXIBLE(out);
+ return _broadcast_cast(out, mp, castfunc, iswap, oswap);
+ }
+
+ return _bufferedcast(out, mp, castfunc);
+}
+
+
+
+/* steals reference to newtype --- acc. NULL */
+/*OBJECT_API*/
+static PyObject *
+PyArray_FromArray(PyArrayObject *arr, PyArray_Descr *newtype, int flags)
+{
+
+ PyArrayObject *ret=NULL;
+ int itemsize;
+ int copy = 0;
+ int arrflags;
+ PyArray_Descr *oldtype;
+ char *msg = "cannot copy back to a read-only array";
+ PyTypeObject *subtype;
+
+ oldtype = PyArray_DESCR(arr);
+
+ subtype = arr->ob_type;
+
+ if (newtype == NULL) {newtype = oldtype; Py_INCREF(oldtype);}
+ itemsize = newtype->elsize;
+ if (itemsize == 0) {
+ PyArray_DESCR_REPLACE(newtype);
+ if (newtype == NULL) return NULL;
+ newtype->elsize = oldtype->elsize;
+ itemsize = newtype->elsize;
+ }
+
+ /* Can't cast unless ndim-0 array, FORCECAST is specified
+ or the cast is safe.
+ */
+ if (!(flags & FORCECAST) && !PyArray_NDIM(arr)==0 &&
+ !PyArray_CanCastTo(oldtype, newtype)) {
+ Py_DECREF(newtype);
+ PyErr_SetString(PyExc_TypeError,
+ "array cannot be safely cast " \
+ "to required type");
+ return NULL;
+ }
+
+ /* Don't copy if sizes are compatible */
+ if ((flags & ENSURECOPY) || PyArray_EquivTypes(oldtype, newtype)) {
+ arrflags = arr->flags;
+
+ copy = (flags & ENSURECOPY) || \
+ ((flags & CONTIGUOUS) && (!(arrflags & CONTIGUOUS))) \
+ || ((flags & ALIGNED) && (!(arrflags & ALIGNED))) \
+ || (arr->nd > 1 && \
+ ((flags & FORTRAN) && (!(arrflags & FORTRAN)))) \
+ || ((flags & WRITEABLE) && (!(arrflags & WRITEABLE)));
+
+ if (copy) {
+ if ((flags & UPDATEIFCOPY) && \
+ (!PyArray_ISWRITEABLE(arr))) {
+ Py_DECREF(newtype);
+ PyErr_SetString(PyExc_ValueError, msg);
+ return NULL;
+ }
+ if ((flags & ENSUREARRAY)) {
+ subtype = &PyArray_Type;
+ }
+ ret = (PyArrayObject *) \
+ PyArray_NewFromDescr(subtype, newtype,
+ arr->nd,
+ arr->dimensions,
+ NULL, NULL,
+ flags & FORTRAN,
+ (PyObject *)arr);
+ if (ret == NULL) return NULL;
+ if (PyArray_CopyInto(ret, arr) == -1)
+ {Py_DECREF(ret); return NULL;}
+ if (flags & UPDATEIFCOPY) {
+ ret->flags |= UPDATEIFCOPY;
+ ret->base = (PyObject *)arr;
+ PyArray_FLAGS(ret->base) &= ~WRITEABLE;
+ Py_INCREF(arr);
+ }
+ }
+ /* If no copy then just increase the reference
+ count and return the input */
+ else {
+ Py_DECREF(newtype);
+ if ((flags & ENSUREARRAY) &&
+ !PyArray_CheckExact(arr)) {
+ Py_INCREF(arr->descr);
+ ret = (PyArrayObject *) \
+ PyArray_NewFromDescr(&PyArray_Type,
+ arr->descr,
+ arr->nd,
+ arr->dimensions,
+ arr->strides,
+ arr->data,
+ arr->flags,NULL);
+ if (ret == NULL) return NULL;
+ ret->base = (PyObject *)arr;
+ }
+ else {
+ ret = arr;
+ }
+ Py_INCREF(arr);
+ }
+ }
+
+ /* The desired output type is different than the input
+ array type and copy was not specified */
+ else {
+ if ((flags & UPDATEIFCOPY) && \
+ (!PyArray_ISWRITEABLE(arr))) {
+ Py_DECREF(newtype);
+ PyErr_SetString(PyExc_ValueError, msg);
+ return NULL;
+ }
+ if ((flags & ENSUREARRAY)) {
+ subtype = &PyArray_Type;
+ }
+ ret = (PyArrayObject *) \
+ PyArray_NewFromDescr(subtype, newtype,
+ arr->nd, arr->dimensions,
+ NULL, NULL,
+ flags & FORTRAN,
+ (PyObject *)arr);
+ if (ret == NULL) return NULL;
+ if (PyArray_CastTo(ret, arr) < 0) {
+ Py_DECREF(ret);
+ return NULL;
+ }
+ if (flags & UPDATEIFCOPY) {
+ ret->flags |= UPDATEIFCOPY;
+ ret->base = (PyObject *)arr;
+ PyArray_FLAGS(ret->base) &= ~WRITEABLE;
+ Py_INCREF(arr);
+ }
+ }
+ return (PyObject *)ret;
+}
+
+/* new reference */
+static PyArray_Descr *
+_array_typedescr_fromstr(char *str)
+{
+ PyArray_Descr *descr;
+ int type_num;
+ char typechar;
+ int size;
+ char msg[] = "unsupported typestring";
+ int swap;
+ char swapchar;
+
+ swapchar = str[0];
+ str += 1;
+
+#define _MY_FAIL { \
+ PyErr_SetString(PyExc_ValueError, msg); \
+ return NULL; \
+ }
+
+ typechar = str[0];
+ size = atoi(str + 1);
+ switch (typechar) {
+ case 'b':
+ if (size == sizeof(Bool))
+ type_num = PyArray_BOOL;
+ else _MY_FAIL
+ break;
+ case 'u':
+ if (size == sizeof(uintp))
+ type_num = PyArray_UINTP;
+ else if (size == sizeof(char))
+ type_num = PyArray_UBYTE;
+ else if (size == sizeof(short))
+ type_num = PyArray_USHORT;
+ else if (size == sizeof(ulong))
+ type_num = PyArray_ULONG;
+ else if (size == sizeof(int))
+ type_num = PyArray_UINT;
+ else if (size == sizeof(ulonglong))
+ type_num = PyArray_ULONGLONG;
+ else _MY_FAIL
+ break;
+ case 'i':
+ if (size == sizeof(intp))
+ type_num = PyArray_INTP;
+ else if (size == sizeof(char))
+ type_num = PyArray_BYTE;
+ else if (size == sizeof(short))
+ type_num = PyArray_SHORT;
+ else if (size == sizeof(long))
+ type_num = PyArray_LONG;
+ else if (size == sizeof(int))
+ type_num = PyArray_INT;
+ else if (size == sizeof(longlong))
+ type_num = PyArray_LONGLONG;
+ else _MY_FAIL
+ break;
+ case 'f':
+ if (size == sizeof(float))
+ type_num = PyArray_FLOAT;
+ else if (size == sizeof(double))
+ type_num = PyArray_DOUBLE;
+ else if (size == sizeof(longdouble))
+ type_num = PyArray_LONGDOUBLE;
+ else _MY_FAIL
+ break;
+ case 'c':
+ if (size == sizeof(float)*2)
+ type_num = PyArray_CFLOAT;
+ else if (size == sizeof(double)*2)
+ type_num = PyArray_CDOUBLE;
+ else if (size == sizeof(longdouble)*2)
+ type_num = PyArray_CLONGDOUBLE;
+ else _MY_FAIL
+ break;
+ case 'O':
+ if (size == sizeof(PyObject *))
+ type_num = PyArray_OBJECT;
+ else _MY_FAIL
+ break;
+ case PyArray_STRINGLTR:
+ type_num = PyArray_STRING;
+ break;
+ case PyArray_UNICODELTR:
+ type_num = PyArray_UNICODE;
+ size <<= 2;
+ break;
+ case 'V':
+ type_num = PyArray_VOID;
+ break;
+ default:
+ _MY_FAIL
+ }
+
+#undef _MY_FAIL
+
+ descr = PyArray_DescrFromType(type_num);
+ if (descr == NULL) return NULL;
+ swap = !PyArray_ISNBO(swapchar);
+ if (descr->elsize == 0 || swap) {
+ /* Need to make a new PyArray_Descr */
+ PyArray_DESCR_REPLACE(descr);
+ if (descr==NULL) return NULL;
+ if (descr->elsize == 0)
+ descr->elsize = size;
+ if (swap)
+ descr->byteorder = swapchar;
+ }
+ return descr;
+}
+
+/*OBJECT_API */
+static PyObject *
+PyArray_FromStructInterface(PyObject *input)
+{
+ PyArray_Descr *thetype=NULL;
+ char buf[40];
+ PyArrayInterface *inter;
+ PyObject *attr, *r;
+ char endian = PyArray_NATBYTE;
+
+ attr = PyObject_GetAttrString(input, "__array_struct__");
+ if (attr == NULL) {
+ PyErr_Clear();
+ return Py_NotImplemented;
+ }
+ if (!PyCObject_Check(attr)) goto fail;
+ inter = PyCObject_AsVoidPtr(attr);
+ if (inter->two != 2) goto fail;
+ if ((inter->flags & NOTSWAPPED) != NOTSWAPPED) {
+ endian = PyArray_OPPBYTE;
+ inter->flags &= ~NOTSWAPPED;
+ }
+
+ if (inter->flags & ARR_HAS_DESCR) {
+ if (PyArray_DescrConverter(inter->descr, &thetype) == PY_FAIL) {
+ thetype = NULL;
+ PyErr_Clear();
+ }
+ }
+
+ if (thetype == NULL) {
+ snprintf(buf, 40, "%c%c%d", endian, inter->typekind, inter->itemsize);
+ if (!(thetype=_array_typedescr_fromstr(buf))) {
+ Py_DECREF(attr);
+ return NULL;
+ }
+ }
+
+ r = PyArray_NewFromDescr(&PyArray_Type, thetype,
+ inter->nd, inter->shape,
+ inter->strides, inter->data,
+ inter->flags, NULL);
+ Py_INCREF(input);
+ PyArray_BASE(r) = input;
+ Py_DECREF(attr);
+ PyArray_UpdateFlags((PyArrayObject *)r, UPDATE_ALL);
+ return r;
+
+ fail:
+ PyErr_SetString(PyExc_ValueError, "invalid __array_struct__");
+ Py_DECREF(attr);
+ return NULL;
+}
+
+#define PyIntOrLong_Check(obj) (PyInt_Check(obj) || PyLong_Check(obj))
+
+/*OBJECT_API*/
+static PyObject *
+PyArray_FromInterface(PyObject *input)
+{
+ PyObject *attr=NULL, *item=NULL;
+ PyObject *tstr=NULL, *shape=NULL;
+ PyObject *inter=NULL;
+ PyObject *base=NULL;
+ PyArrayObject *ret;
+ PyArray_Descr *type=NULL;
+ char *data;
+ Py_ssize_t buffer_len;
+ int res, i, n;
+ intp dims[MAX_DIMS], strides[MAX_DIMS];
+ int dataflags = BEHAVED;
+
+ /* Get the memory from __array_data__ and __array_offset__ */
+ /* Get the shape */
+ /* Get the typestring -- ignore array_descr */
+ /* Get the strides */
+
+ inter = PyObject_GetAttrString(input, "__array_interface__");
+ if (inter == NULL) {PyErr_Clear(); return Py_NotImplemented;}
+ if (!PyDict_Check(inter)) {Py_DECREF(inter); return Py_NotImplemented;}
+
+ shape = PyDict_GetItemString(inter, "shape");
+ if (shape == NULL) {Py_DECREF(inter); return Py_NotImplemented;}
+ tstr = PyDict_GetItemString(inter, "typestr");
+ if (tstr == NULL) {Py_DECREF(inter); return Py_NotImplemented;}
+
+ attr = PyDict_GetItemString(inter, "data");
+ base = input;
+ if ((attr == NULL) || (attr==Py_None) || (!PyTuple_Check(attr))) {
+ if (attr && (attr != Py_None)) item=attr;
+ else item=input;
+ res = PyObject_AsWriteBuffer(item, (void **)&data,
+ &buffer_len);
+ if (res < 0) {
+ PyErr_Clear();
+ res = PyObject_AsReadBuffer(item, (const void **)&data,
+ &buffer_len);
+ if (res < 0) goto fail;
+ dataflags &= ~WRITEABLE;
+ }
+ attr = PyDict_GetItemString(inter, "offset");
+ if (attr) {
+ longlong num = PyLong_AsLongLong(attr);
+ if (error_converting(num)) {
+ PyErr_SetString(PyExc_TypeError,
+ "offset "\
+ "must be an integer");
+ goto fail;
+ }
+ data += num;
+ }
+ base = item;
+ }
+ else {
+ PyObject *dataptr;
+ if (PyTuple_GET_SIZE(attr) != 2) {
+ PyErr_SetString(PyExc_TypeError,
+ "data must return " \
+ "a 2-tuple with (data pointer "\
+ "integer, read-only flag)");
+ goto fail;
+ }
+ dataptr = PyTuple_GET_ITEM(attr, 0);
+ if (PyString_Check(dataptr)) {
+ res = sscanf(PyString_AsString(dataptr),
+ "%p", (void **)&data);
+ if (res < 1) {
+ PyErr_SetString(PyExc_TypeError,
+ "data string cannot be " \
+ "converted");
+ goto fail;
+ }
+ }
+ else if (PyIntOrLong_Check(dataptr)) {
+ data = PyLong_AsVoidPtr(dataptr);
+ }
+ else {
+ PyErr_SetString(PyExc_TypeError, "first element " \
+ "of data tuple must be integer" \
+ " or string.");
+ goto fail;
+ }
+ if (PyObject_IsTrue(PyTuple_GET_ITEM(attr,1))) {
+ dataflags &= ~WRITEABLE;
+ }
+ }
+ attr = tstr;
+ if (!PyString_Check(attr)) {
+ PyErr_SetString(PyExc_TypeError, "typestr must be a string");
+ goto fail;
+ }
+ type = _array_typedescr_fromstr(PyString_AS_STRING(attr));
+ if (type==NULL) goto fail;
+ attr = shape;
+ if (!PyTuple_Check(attr)) {
+ PyErr_SetString(PyExc_TypeError, "shape must be a tuple");
+ Py_DECREF(type);
+ goto fail;
+ }
+ n = PyTuple_GET_SIZE(attr);
+ for (i=0; i<n; i++) {
+ item = PyTuple_GET_ITEM(attr, i);
+ dims[i] = PyArray_PyIntAsIntp(item);
+ if (error_converting(dims[i])) break;
+ }
+
+ ret = (PyArrayObject *)PyArray_NewFromDescr(&PyArray_Type, type,
+ n, dims,
+ NULL, data,
+ dataflags, NULL);
+ if (ret == NULL) return NULL;
+ Py_INCREF(base);
+ ret->base = base;
+
+ attr = PyDict_GetItemString(inter, "strides");
+ if (attr != NULL && attr != Py_None) {
+ if (!PyTuple_Check(attr)) {
+ PyErr_SetString(PyExc_TypeError,
+ "strides must be a tuple");
+ Py_DECREF(ret);
+ return NULL;
+ }
+ if (n != PyTuple_GET_SIZE(attr)) {
+ PyErr_SetString(PyExc_ValueError,
+ "mismatch in length of "\
+ "strides and shape");
+ Py_DECREF(ret);
+ return NULL;
+ }
+ for (i=0; i<n; i++) {
+ item = PyTuple_GET_ITEM(attr, i);
+ strides[i] = PyArray_PyIntAsIntp(item);
+ if (error_converting(strides[i])) break;
+ }
+ if (PyErr_Occurred()) PyErr_Clear();
+ memcpy(ret->strides, strides, n*sizeof(intp));
+ }
+ else PyErr_Clear();
+ PyArray_UpdateFlags(ret, UPDATE_ALL);
+ Py_DECREF(inter);
+ return (PyObject *)ret;
+
+ fail:
+ Py_XDECREF(inter);
+ return NULL;
+}
+
+/*OBJECT_API*/
+static PyObject *
+PyArray_FromArrayAttr(PyObject *op, PyArray_Descr *typecode, PyObject *context)
+{
+ PyObject *new;
+ PyObject *array_meth;
+
+ array_meth = PyObject_GetAttrString(op, "__array__");
+ if (array_meth == NULL) {PyErr_Clear(); return Py_NotImplemented;}
+ if (context == NULL) {
+ if (typecode == NULL) new = PyObject_CallFunction(array_meth,
+ NULL);
+ else new = PyObject_CallFunction(array_meth, "O", typecode);
+ }
+ else {
+ if (typecode == NULL) {
+ new = PyObject_CallFunction(array_meth, "OO", Py_None,
+ context);
+ if (new == NULL && \
+ PyErr_ExceptionMatches(PyExc_TypeError)) {
+ PyErr_Clear();
+ new = PyObject_CallFunction(array_meth, "");
+ }
+ }
+ else {
+ new = PyObject_CallFunction(array_meth, "OO",
+ typecode, context);
+ if (new == NULL && \
+ PyErr_ExceptionMatches(PyExc_TypeError)) {
+ PyErr_Clear();
+ new = PyObject_CallFunction(array_meth, "O",
+ typecode);
+ }
+ }
+ }
+ Py_DECREF(array_meth);
+ if (new == NULL) return NULL;
+ if (!PyArray_Check(new)) {
+ PyErr_SetString(PyExc_ValueError,
+ "object __array__ method not " \
+ "producing an array");
+ Py_DECREF(new);
+ return NULL;
+ }
+ return new;
+}
+
+/* Does not check for ENSURECOPY and NOTSWAPPED in flags */
+/* Steals a reference to newtype --- which can be NULL */
+/*OBJECT_API*/
+static PyObject *
+PyArray_FromAny(PyObject *op, PyArray_Descr *newtype, int min_depth,
+ int max_depth, int flags, PyObject *context)
+{
+ /* This is the main code to make a NumPy array from a Python
+ Object. It is called from lot's of different places which
+ is why there are so many checks. The comments try to
+ explain some of the checks. */
+
+ PyObject *r=NULL;
+ int seq = FALSE;
+
+ /* Is input object already an array? */
+ /* This is where the flags are used */
+ if (PyArray_Check(op))
+ r = PyArray_FromArray((PyArrayObject *)op, newtype, flags);
+ else if (PyArray_IsScalar(op, Generic)) {
+ if (flags & UPDATEIFCOPY) goto err;
+ r = PyArray_FromScalar(op, newtype);
+ } else if (newtype == NULL &&
+ (newtype = _array_find_python_scalar_type(op))) {
+ if (flags & UPDATEIFCOPY) goto err;
+ r = Array_FromPyScalar(op, newtype);
+ }
+ else if (PyArray_HasArrayInterfaceType(op, newtype, context, r)) {
+ PyObject *new;
+ if (r == NULL) {Py_XDECREF(newtype); return NULL;}
+ if (newtype != NULL || flags != 0) {
+ new = PyArray_FromArray((PyArrayObject *)r, newtype,
+ flags);
+ Py_DECREF(r);
+ r = new;
+ }
+ }
+ else {
+ int isobject=0;
+ if (flags & UPDATEIFCOPY) goto err;
+ if (newtype == NULL) {
+ newtype = _array_find_type(op, NULL, MAX_DIMS);
+ }
+ else if (newtype->type_num == PyArray_OBJECT) {
+ isobject = 1;
+ }
+ if (PySequence_Check(op)) {
+ PyObject *thiserr=NULL;
+ /* necessary but not sufficient */
+ Py_INCREF(newtype);
+ r = Array_FromSequence(op, newtype, flags & FORTRAN,
+ min_depth, max_depth);
+ if (r == NULL && (thiserr=PyErr_Occurred())) {
+ if (PyErr_GivenExceptionMatches(thiserr,
+ PyExc_MemoryError))
+ return NULL;
+ /* If object was explicitly requested,
+ then try nested list object array creation
+ */
+ PyErr_Clear();
+ if (isobject) {
+ Py_INCREF(newtype);
+ r = ObjectArray_FromNestedList \
+ (op, newtype, flags & FORTRAN);
+ seq = TRUE;
+ Py_DECREF(newtype);
+ }
+ }
+ else {
+ seq = TRUE;
+ Py_DECREF(newtype);
+ }
+ }
+ if (!seq)
+ r = Array_FromPyScalar(op, newtype);
+ }
+
+ /* If we didn't succeed return NULL */
+ if (r == NULL) return NULL;
+
+ /* Be sure we succeed here */
+
+ if(!PyArray_Check(r)) {
+ PyErr_SetString(PyExc_RuntimeError,
+ "internal error: PyArray_FromAny "\
+ "not producing an array");
+ Py_DECREF(r);
+ return NULL;
+ }
+
+ if (min_depth != 0 && ((PyArrayObject *)r)->nd < min_depth) {
+ PyErr_SetString(PyExc_ValueError,
+ "object of too small depth for desired array");
+ Py_DECREF(r);
+ return NULL;
+ }
+ if (max_depth != 0 && ((PyArrayObject *)r)->nd > max_depth) {
+ PyErr_SetString(PyExc_ValueError,
+ "object too deep for desired array");
+ Py_DECREF(r);
+ return NULL;
+ }
+ return r;
+
+ err:
+ Py_XDECREF(newtype);
+ PyErr_SetString(PyExc_TypeError,
+ "UPDATEIFCOPY used for non-array input.");
+ return NULL;
+}
+
+/* new reference -- accepts NULL for mintype*/
+/*OBJECT_API*/
+static PyArray_Descr *
+PyArray_DescrFromObject(PyObject *op, PyArray_Descr *mintype)
+{
+ return _array_find_type(op, mintype, MAX_DIMS);
+}
+
+/*OBJECT_API
+ Return the typecode of the array a Python object would be converted
+ to
+*/
+static int
+PyArray_ObjectType(PyObject *op, int minimum_type)
+{
+ PyArray_Descr *intype;
+ PyArray_Descr *outtype;
+ int ret;
+
+ intype = PyArray_DescrFromType(minimum_type);
+ if (intype == NULL) PyErr_Clear();
+ outtype = _array_find_type(op, intype, MAX_DIMS);
+ ret = outtype->type_num;
+ Py_DECREF(outtype);
+ Py_XDECREF(intype);
+ return ret;
+}
+
+
+/* flags is any of
+ CONTIGUOUS,
+ FORTRAN,
+ ALIGNED,
+ WRITEABLE,
+ NOTSWAPPED,
+ ENSURECOPY,
+ UPDATEIFCOPY,
+ FORCECAST,
+ ENSUREARRAY,
+ ELEMENTSTRIDES
+
+ or'd (|) together
+
+ Any of these flags present means that the returned array should
+ guarantee that aspect of the array. Otherwise the returned array
+ won't guarantee it -- it will depend on the object as to whether or
+ not it has such features.
+
+ Note that ENSURECOPY is enough
+ to guarantee CONTIGUOUS, ALIGNED and WRITEABLE
+ and therefore it is redundant to include those as well.
+
+ BEHAVED == ALIGNED | WRITEABLE
+ CARRAY = CONTIGUOUS | BEHAVED
+ FARRAY = FORTRAN | BEHAVED
+
+ FORTRAN can be set in the FLAGS to request a FORTRAN array.
+ Fortran arrays are always behaved (aligned,
+ notswapped, and writeable) and not (C) CONTIGUOUS (if > 1d).
+
+ UPDATEIFCOPY flag sets this flag in the returned array if a copy is
+ made and the base argument points to the (possibly) misbehaved array.
+ When the new array is deallocated, the original array held in base
+ is updated with the contents of the new array.
+
+ FORCECAST will cause a cast to occur regardless of whether or not
+ it is safe.
+*/
+
+
+/* steals a reference to descr -- accepts NULL */
+/*OBJECT_API*/
+static PyObject *
+PyArray_CheckFromAny(PyObject *op, PyArray_Descr *descr, int min_depth,
+ int max_depth, int requires, PyObject *context)
+{
+ PyObject *obj;
+ if (requires & NOTSWAPPED) {
+ if (!descr && PyArray_Check(op) && \
+ !PyArray_ISNBO(PyArray_DESCR(op)->byteorder)) {
+ descr = PyArray_DescrNew(PyArray_DESCR(op));
+ }
+ else if (descr && !PyArray_ISNBO(descr->byteorder)) {
+ PyArray_DESCR_REPLACE(descr);
+ }
+ if (descr) {
+ descr->byteorder = PyArray_NATIVE;
+ }
+ }
+
+ obj = PyArray_FromAny(op, descr, min_depth, max_depth,
+ requires, context);
+ if (obj == NULL) return NULL;
+ if ((requires & ELEMENTSTRIDES) &&
+ !PyArray_ElementStrides(obj)) {
+ PyObject *new;
+ new = PyArray_NewCopy((PyArrayObject *)obj, PyArray_ANYORDER);
+ Py_DECREF(obj);
+ obj = new;
+ }
+ return obj;
+}
+
+/* This is a quick wrapper around PyArray_FromAny(op, NULL, 0, 0,
+ ENSUREARRAY) */
+/* that special cases Arrays and PyArray_Scalars up front */
+/* It *steals a reference* to the object */
+/* It also guarantees that the result is PyArray_Type */
+
+/* Because it decrefs op if any conversion needs to take place
+ so it can be used like PyArray_EnsureArray(some_function(...)) */
+
+/*OBJECT_API*/
+static PyObject *
+PyArray_EnsureArray(PyObject *op)
+{
+ PyObject *new;
+
+ if (op == NULL) return NULL;
+
+ if (PyArray_CheckExact(op)) return op;
+
+ if (PyArray_Check(op)) {
+ new = PyArray_View((PyArrayObject *)op, NULL, &PyArray_Type);
+ Py_DECREF(op);
+ return new;
+ }
+ if (PyArray_IsScalar(op, Generic)) {
+ new = PyArray_FromScalar(op, NULL);
+ Py_DECREF(op);
+ return new;
+ }
+ new = PyArray_FromAny(op, NULL, 0, 0, ENSUREARRAY, NULL);
+ Py_DECREF(op);
+ return new;
+}
+
+/*OBJECT_API*/
+static PyObject *
+PyArray_EnsureAnyArray(PyObject *op)
+{
+ if (op && PyArray_Check(op)) return op;
+ return PyArray_EnsureArray(op);
+}
+
+/*OBJECT_API
+ Check the type coercion rules.
+*/
+static int
+PyArray_CanCastSafely(int fromtype, int totype)
+{
+ PyArray_Descr *from, *to;
+ register int felsize, telsize;
+
+ if (fromtype == totype) return 1;
+ if (fromtype == PyArray_BOOL) return 1;
+ if (totype == PyArray_BOOL) return 0;
+ if (totype == PyArray_OBJECT || totype == PyArray_VOID) return 1;
+ if (fromtype == PyArray_OBJECT || fromtype == PyArray_VOID) return 0;
+
+ from = PyArray_DescrFromType(fromtype);
+ /* cancastto is a PyArray_NOTYPE terminated C-int-array of types that
+ the data-type can be cast to safely.
+ */
+ if (from->f->cancastto) {
+ int *curtype;
+ curtype = from->f->cancastto;
+ while (*curtype != PyArray_NOTYPE) {
+ if (*curtype++ == totype) return 1;
+ }
+ }
+ if (PyTypeNum_ISUSERDEF(totype)) return 0;
+
+ to = PyArray_DescrFromType(totype);
+ telsize = to->elsize;
+ felsize = from->elsize;
+ Py_DECREF(from);
+ Py_DECREF(to);
+
+ switch(fromtype) {
+ case PyArray_BYTE:
+ case PyArray_SHORT:
+ case PyArray_INT:
+ case PyArray_LONG:
+ case PyArray_LONGLONG:
+ if (PyTypeNum_ISINTEGER(totype)) {
+ if (PyTypeNum_ISUNSIGNED(totype)) {
+ return 0;
+ }
+ else {
+ return (telsize >= felsize);
+ }
+ }
+ else if (PyTypeNum_ISFLOAT(totype)) {
+ if (felsize < 8)
+ return (telsize > felsize);
+ else
+ return (telsize >= felsize);
+ }
+ else if (PyTypeNum_ISCOMPLEX(totype)) {
+ if (felsize < 8)
+ return ((telsize >> 1) > felsize);
+ else
+ return ((telsize >> 1) >= felsize);
+ }
+ else return totype > fromtype;
+ case PyArray_UBYTE:
+ case PyArray_USHORT:
+ case PyArray_UINT:
+ case PyArray_ULONG:
+ case PyArray_ULONGLONG:
+ if (PyTypeNum_ISINTEGER(totype)) {
+ if (PyTypeNum_ISSIGNED(totype)) {
+ return (telsize > felsize);
+ }
+ else {
+ return (telsize >= felsize);
+ }
+ }
+ else if (PyTypeNum_ISFLOAT(totype)) {
+ if (felsize < 8)
+ return (telsize > felsize);
+ else
+ return (telsize >= felsize);
+ }
+ else if (PyTypeNum_ISCOMPLEX(totype)) {
+ if (felsize < 8)
+ return ((telsize >> 1) > felsize);
+ else
+ return ((telsize >> 1) >= felsize);
+ }
+ else return totype > fromtype;
+ case PyArray_FLOAT:
+ case PyArray_DOUBLE:
+ case PyArray_LONGDOUBLE:
+ if (PyTypeNum_ISCOMPLEX(totype))
+ return ((telsize >> 1) >= felsize);
+ else
+ return (totype > fromtype);
+ case PyArray_CFLOAT:
+ case PyArray_CDOUBLE:
+ case PyArray_CLONGDOUBLE:
+ return (totype > fromtype);
+ case PyArray_STRING:
+ case PyArray_UNICODE:
+ return (totype > fromtype);
+ default:
+ return 0;
+ }
+}
+
+/* leaves reference count alone --- cannot be NULL*/
+/*OBJECT_API*/
+static Bool
+PyArray_CanCastTo(PyArray_Descr *from, PyArray_Descr *to)
+{
+ int fromtype=from->type_num;
+ int totype=to->type_num;
+ Bool ret;
+
+ ret = (Bool) PyArray_CanCastSafely(fromtype, totype);
+ if (ret) { /* Check String and Unicode more closely */
+ if (fromtype == PyArray_STRING) {
+ if (totype == PyArray_STRING) {
+ ret = (from->elsize <= to->elsize);
+ }
+ else if (totype == PyArray_UNICODE) {
+ ret = (from->elsize << 2 \
+ <= to->elsize);
+ }
+ }
+ else if (fromtype == PyArray_UNICODE) {
+ if (totype == PyArray_UNICODE) {
+ ret = (from->elsize <= to->elsize);
+ }
+ }
+ /* TODO: If totype is STRING or unicode
+ see if the length is long enough to hold the
+ stringified value of the object.
+ */
+ }
+ return ret;
+}
+
+/*OBJECT_API
+ See if array scalars can be cast.
+ */
+static Bool
+PyArray_CanCastScalar(PyTypeObject *from, PyTypeObject *to)
+{
+ int fromtype;
+ int totype;
+
+ fromtype = _typenum_fromtypeobj((PyObject *)from, 0);
+ totype = _typenum_fromtypeobj((PyObject *)to, 0);
+ if (fromtype == PyArray_NOTYPE || totype == PyArray_NOTYPE)
+ return FALSE;
+ return (Bool) PyArray_CanCastSafely(fromtype, totype);
+}
+
+
+/*********************** Element-wise Array Iterator ***********************/
+/* Aided by Peter J. Verveer's nd_image package and numpy's arraymap ****/
+/* and Python's array iterator ***/
+
+/*OBJECT_API
+ Get Iterator.
+*/
+static PyObject *
+PyArray_IterNew(PyObject *obj)
+{
+ PyArrayIterObject *it;
+ int i, nd;
+ PyArrayObject *ao = (PyArrayObject *)obj;
+
+ if (!PyArray_Check(ao)) {
+ PyErr_BadInternalCall();
+ return NULL;
+ }
+
+ it = (PyArrayIterObject *)_pya_malloc(sizeof(PyArrayIterObject));
+ PyObject_Init((PyObject *)it, &PyArrayIter_Type);
+ /* it = PyObject_New(PyArrayIterObject, &PyArrayIter_Type);*/
+ if (it == NULL)
+ return NULL;
+
+ nd = ao->nd;
+ PyArray_UpdateFlags(ao, CONTIGUOUS);
+ if PyArray_ISCONTIGUOUS(ao) it->contiguous = 1;
+ else it->contiguous = 0;
+ Py_INCREF(ao);
+ it->ao = ao;
+ it->size = PyArray_SIZE(ao);
+ it->nd_m1 = nd - 1;
+ it->factors[nd-1] = 1;
+ for (i=0; i < nd; i++) {
+ it->dims_m1[i] = ao->dimensions[i] - 1;
+ it->strides[i] = ao->strides[i];
+ it->backstrides[i] = it->strides[i] * \
+ it->dims_m1[i];
+ if (i > 0)
+ it->factors[nd-i-1] = it->factors[nd-i] * \
+ ao->dimensions[nd-i];
+ }
+ PyArray_ITER_RESET(it);
+
+ return (PyObject *)it;
+}
+
+/*MULTIARRAY_API
+ Get Iterator broadcast to a particular shape
+ */
+static PyObject *
+PyArray_BroadcastToShape(PyObject *obj, intp *dims, int nd)
+{
+ PyArrayIterObject *it;
+ int i, diff, j, compat, k;
+ PyArrayObject *ao = (PyArrayObject *)obj;
+
+ if (ao->nd > nd) goto err;
+ compat = 1;
+ diff = j = nd - ao->nd;
+ for (i=0; i<ao->nd; i++, j++) {
+ if (ao->dimensions[i] == 1) continue;
+ if (ao->dimensions[i] != dims[j]) {
+ compat = 0;
+ break;
+ }
+ }
+ if (!compat) goto err;
+
+ it = (PyArrayIterObject *)_pya_malloc(sizeof(PyArrayIterObject));
+ PyObject_Init((PyObject *)it, &PyArrayIter_Type);
+
+ if (it == NULL)
+ return NULL;
+
+ PyArray_UpdateFlags(ao, CONTIGUOUS);
+ if PyArray_ISCONTIGUOUS(ao) it->contiguous = 1;
+ else it->contiguous = 0;
+ Py_INCREF(ao);
+ it->ao = ao;
+ it->size = PyArray_MultiplyList(dims, nd);
+ it->nd_m1 = nd - 1;
+ it->factors[nd-1] = 1;
+ for (i=0; i < nd; i++) {
+ it->dims_m1[i] = dims[i] - 1;
+ k = i - diff;
+ if ((k < 0) ||
+ ao->dimensions[k] != dims[i]) {
+ it->contiguous = 0;
+ it->strides[i] = 0;
+ }
+ else {
+ it->strides[i] = ao->strides[k];
+ }
+ it->backstrides[i] = it->strides[i] * \
+ it->dims_m1[i];
+ if (i > 0)
+ it->factors[nd-i-1] = it->factors[nd-i] * \
+ dims[nd-i];
+ }
+ PyArray_ITER_RESET(it);
+
+ return (PyObject *)it;
+
+ err:
+ PyErr_SetString(PyExc_ValueError, "array is not broadcastable to "\
+ "correct shape");
+ return NULL;
+}
+
+
+
+
+
+/*OBJECT_API
+ Get Iterator that iterates over all but one axis (don't use this with
+ PyArray_ITER_GOTO1D). The axis will be over-written if negative
+ with the axis having the smallest stride.
+*/
+static PyObject *
+PyArray_IterAllButAxis(PyObject *obj, int *inaxis)
+{
+ PyArrayIterObject *it;
+ int axis;
+ it = (PyArrayIterObject *)PyArray_IterNew(obj);
+ if (it == NULL) return NULL;
+
+ if (PyArray_NDIM(obj)==0)
+ return (PyObject *)it;
+ if (*inaxis < 0) {
+ int i, minaxis=0;
+ intp minstride=0;
+ i = 0;
+ while (minstride==0 && i<PyArray_NDIM(obj)) {
+ minstride = PyArray_STRIDE(obj,i);
+ i++;
+ }
+ for (i=1; i<PyArray_NDIM(obj); i++) {
+ if (PyArray_STRIDE(obj,i) > 0 &&
+ PyArray_STRIDE(obj, i) < minstride) {
+ minaxis = i;
+ minstride = PyArray_STRIDE(obj,i);
+ }
+ }
+ *inaxis = minaxis;
+ }
+ axis = *inaxis;
+ /* adjust so that will not iterate over axis */
+ it->contiguous = 0;
+ if (it->size != 0) {
+ it->size /= PyArray_DIM(obj,axis);
+ }
+ it->dims_m1[axis] = 0;
+ it->backstrides[axis] = 0;
+
+ /* (won't fix factors so don't use
+ PyArray_ITER_GOTO1D with this iterator) */
+ return (PyObject *)it;
+}
+
+
+/* don't use with PyArray_ITER_GOTO1D because factors are not
+ adjusted */
+
+/*OBJECT_API
+ Adjusts previously broadcasted iterators so that the axis with
+ the smallest sum of iterator strides is not iterated over.
+ Returns dimension which is smallest in the range [0,multi->nd).
+ A -1 is returned if multi->nd == 0.
+ */
+static int
+PyArray_RemoveSmallest(PyArrayMultiIterObject *multi)
+{
+ PyArrayIterObject *it;
+ int i, j;
+ int axis;
+ intp smallest;
+ intp sumstrides[NPY_MAXDIMS];
+
+ if (multi->nd == 0) return -1;
+
+
+ for (i=0; i<multi->nd; i++) {
+ sumstrides[i] = 0;
+ for (j=0; j<multi->numiter; j++) {
+ sumstrides[i] += multi->iters[j]->strides[i];
+ }
+ }
+ axis=0;
+ smallest = sumstrides[0];
+ /* Find longest dimension */
+ for (i=1; i<multi->nd; i++) {
+ if (sumstrides[i] < smallest) {
+ axis = i;
+ smallest = sumstrides[i];
+ }
+ }
+
+ for (i=0; i<multi->numiter; i++) {
+ it = multi->iters[i];
+ it->contiguous = 0;
+ if (it->size != 0)
+ it->size /= (it->dims_m1[axis]+1);
+ it->dims_m1[axis] = 0;
+ it->backstrides[axis] = 0;
+ }
+
+ multi->size = multi->iters[0]->size;
+ return axis;
+}
+
+/* Returns an array scalar holding the element desired */
+
+static PyObject *
+arrayiter_next(PyArrayIterObject *it)
+{
+ PyObject *ret;
+
+ if (it->index < it->size) {
+ ret = PyArray_ToScalar(it->dataptr, it->ao);
+ PyArray_ITER_NEXT(it);
+ return ret;
+ }
+ return NULL;
+}
+
+static void
+arrayiter_dealloc(PyArrayIterObject *it)
+{
+ Py_XDECREF(it->ao);
+ _pya_free(it);
+}
+
+static Py_ssize_t
+iter_length(PyArrayIterObject *self)
+{
+ return self->size;
+}
+
+
+static PyObject *
+iter_subscript_Bool(PyArrayIterObject *self, PyArrayObject *ind)
+{
+ int index, strides, itemsize;
+ intp count=0;
+ char *dptr, *optr;
+ PyObject *r;
+ int swap;
+ PyArray_CopySwapFunc *copyswap;
+
+
+ if (ind->nd != 1) {
+ PyErr_SetString(PyExc_ValueError,
+ "boolean index array should have 1 dimension");
+ return NULL;
+ }
+ index = ind->dimensions[0];
+ if (index > self->size) {
+ PyErr_SetString(PyExc_ValueError,
+ "too many boolean indices");
+ return NULL;
+ }
+
+ strides = ind->strides[0];
+ dptr = ind->data;
+ /* Get size of return array */
+ while(index--) {
+ if (*((Bool *)dptr) != 0)
+ count++;
+ dptr += strides;
+ }
+ itemsize = self->ao->descr->elsize;
+ Py_INCREF(self->ao->descr);
+ r = PyArray_NewFromDescr(self->ao->ob_type,
+ self->ao->descr, 1, &count,
+ NULL, NULL,
+ 0, (PyObject *)self->ao);
+ if (r==NULL) return NULL;
+
+ /* Set up loop */
+ optr = PyArray_DATA(r);
+ index = ind->dimensions[0];
+ dptr = ind->data;
+
+ copyswap = self->ao->descr->f->copyswap;
+ /* Loop over Boolean array */
+ swap = (PyArray_ISNOTSWAPPED(self->ao) != PyArray_ISNOTSWAPPED(r));
+ while(index--) {
+ if (*((Bool *)dptr) != 0) {
+ copyswap(optr, self->dataptr, swap, self->ao);
+ optr += itemsize;
+ }
+ dptr += strides;
+ PyArray_ITER_NEXT(self);
+ }
+ PyArray_ITER_RESET(self);
+ return r;
+}
+
+static PyObject *
+iter_subscript_int(PyArrayIterObject *self, PyArrayObject *ind)
+{
+ intp num;
+ PyObject *r;
+ PyArrayIterObject *ind_it;
+ int itemsize;
+ int swap;
+ char *optr;
+ int index;
+ PyArray_CopySwapFunc *copyswap;
+
+ itemsize = self->ao->descr->elsize;
+ if (ind->nd == 0) {
+ num = *((intp *)ind->data);
+ if (num < 0) num += self->size;
+ if (num < 0 || num >= self->size) {
+ PyErr_Format(PyExc_IndexError,
+ "index %d out of bounds" \
+ " 0<=index<%d", (int) num,
+ (int) self->size);
+ r = NULL;
+ }
+ else {
+ PyArray_ITER_GOTO1D(self, num);
+ r = PyArray_ToScalar(self->dataptr, self->ao);
+ }
+ PyArray_ITER_RESET(self);
+ return r;
+ }
+
+ Py_INCREF(self->ao->descr);
+ r = PyArray_NewFromDescr(self->ao->ob_type, self->ao->descr,
+ ind->nd, ind->dimensions,
+ NULL, NULL,
+ 0, (PyObject *)self->ao);
+ if (r==NULL) return NULL;
+
+ optr = PyArray_DATA(r);
+ ind_it = (PyArrayIterObject *)PyArray_IterNew((PyObject *)ind);
+ if (ind_it == NULL) {Py_DECREF(r); return NULL;}
+ index = ind_it->size;
+ copyswap = PyArray_DESCR(r)->f->copyswap;
+ swap = (PyArray_ISNOTSWAPPED(r) != PyArray_ISNOTSWAPPED(self->ao));
+ while(index--) {
+ num = *((intp *)(ind_it->dataptr));
+ if (num < 0) num += self->size;
+ if (num < 0 || num >= self->size) {
+ PyErr_Format(PyExc_IndexError,
+ "index %d out of bounds" \
+ " 0<=index<%d", (int) num,
+ (int) self->size);
+ Py_DECREF(ind_it);
+ Py_DECREF(r);
+ PyArray_ITER_RESET(self);
+ return NULL;
+ }
+ PyArray_ITER_GOTO1D(self, num);
+ copyswap(optr, self->dataptr, swap, r);
+ optr += itemsize;
+ PyArray_ITER_NEXT(ind_it);
+ }
+ Py_DECREF(ind_it);
+ PyArray_ITER_RESET(self);
+ return r;
+}
+
+
+static PyObject *
+iter_subscript(PyArrayIterObject *self, PyObject *ind)
+{
+ PyArray_Descr *indtype=NULL;
+ intp start, step_size;
+ intp n_steps;
+ PyObject *r;
+ char *dptr;
+ int size;
+ PyObject *obj = NULL;
+ int swap;
+ PyArray_CopySwapFunc *copyswap;
+
+ if (ind == Py_Ellipsis) {
+ ind = PySlice_New(NULL, NULL, NULL);
+ obj = iter_subscript(self, ind);
+ Py_DECREF(ind);
+ return obj;
+ }
+ if (PyTuple_Check(ind)) {
+ int len;
+ len = PyTuple_GET_SIZE(ind);
+ if (len > 1) goto fail;
+ if (len == 0) {
+ Py_INCREF(self->ao);
+ return (PyObject *)self->ao;
+ }
+ ind = PyTuple_GET_ITEM(ind, 0);
+ }
+
+ /* Tuples >1d not accepted --- i.e. no newaxis */
+ /* Could implement this with adjusted strides
+ and dimensions in iterator */
+
+ /* Check for Boolean -- this is first becasue
+ Bool is a subclass of Int */
+ PyArray_ITER_RESET(self);
+
+ if (PyBool_Check(ind)) {
+ if (PyObject_IsTrue(ind)) {
+ return PyArray_ToScalar(self->dataptr, self->ao);
+ }
+ else { /* empty array */
+ intp ii = 0;
+ Py_INCREF(self->ao->descr);
+ r = PyArray_NewFromDescr(self->ao->ob_type,
+ self->ao->descr,
+ 1, &ii,
+ NULL, NULL, 0,
+ (PyObject *)self->ao);
+ return r;
+ }
+ }
+
+ /* Check for Integer or Slice */
+
+ if (PyLong_Check(ind) || PyInt_Check(ind) || PySlice_Check(ind)) {
+ start = parse_subindex(ind, &step_size, &n_steps,
+ self->size);
+ if (start == -1)
+ goto fail;
+ if (n_steps == RubberIndex || n_steps == PseudoIndex) {
+ PyErr_SetString(PyExc_IndexError,
+ "cannot use Ellipsis or newaxes here");
+ goto fail;
+ }
+ PyArray_ITER_GOTO1D(self, start)
+ if (n_steps == SingleIndex) { /* Integer */
+ r = PyArray_ToScalar(self->dataptr, self->ao);
+ PyArray_ITER_RESET(self);
+ return r;
+ }
+ size = self->ao->descr->elsize;
+ Py_INCREF(self->ao->descr);
+ r = PyArray_NewFromDescr(self->ao->ob_type,
+ self->ao->descr,
+ 1, &n_steps,
+ NULL, NULL,
+ 0, (PyObject *)self->ao);
+ if (r==NULL) goto fail;
+ dptr = PyArray_DATA(r);
+ swap = !PyArray_ISNOTSWAPPED(self->ao);
+ copyswap = PyArray_DESCR(r)->f->copyswap;
+ while(n_steps--) {
+ copyswap(dptr, self->dataptr, swap, r);
+ start += step_size;
+ PyArray_ITER_GOTO1D(self, start)
+ dptr += size;
+ }
+ PyArray_ITER_RESET(self);
+ return r;
+ }
+
+ /* convert to INTP array if Integer array scalar or List */
+
+ indtype = PyArray_DescrFromType(PyArray_INTP);
+ if (PyArray_IsScalar(ind, Integer) || PyList_Check(ind)) {
+ Py_INCREF(indtype);
+ obj = PyArray_FromAny(ind, indtype, 0, 0, FORCECAST, NULL);
+ if (obj == NULL) goto fail;
+ }
+ else {
+ Py_INCREF(ind);
+ obj = ind;
+ }
+
+ if (PyArray_Check(obj)) {
+ /* Check for Boolean object */
+ if (PyArray_TYPE(obj)==PyArray_BOOL) {
+ r = iter_subscript_Bool(self, (PyArrayObject *)obj);
+ Py_DECREF(indtype);
+ }
+ /* Check for integer array */
+ else if (PyArray_ISINTEGER(obj)) {
+ PyObject *new;
+ new = PyArray_FromAny(obj, indtype, 0, 0,
+ FORCECAST | ALIGNED, NULL);
+ if (new==NULL) goto fail;
+ Py_DECREF(obj);
+ obj = new;
+ r = iter_subscript_int(self, (PyArrayObject *)obj);
+ }
+ else {
+ goto fail;
+ }
+ Py_DECREF(obj);
+ return r;
+ }
+ else Py_DECREF(indtype);
+
+
+ fail:
+ if (!PyErr_Occurred())
+ PyErr_SetString(PyExc_IndexError, "unsupported iterator index");
+ Py_XDECREF(indtype);
+ Py_XDECREF(obj);
+ return NULL;
+
+}
+
+
+static int
+iter_ass_sub_Bool(PyArrayIterObject *self, PyArrayObject *ind,
+ PyArrayIterObject *val, int swap)
+{
+ int index, strides;
+ char *dptr;
+ PyArray_CopySwapFunc *copyswap;
+
+ if (ind->nd != 1) {
+ PyErr_SetString(PyExc_ValueError,
+ "boolean index array should have 1 dimension");
+ return -1;
+ }
+ index = ind->dimensions[0];
+ strides = ind->strides[0];
+ dptr = ind->data;
+ PyArray_ITER_RESET(self);
+ /* Loop over Boolean array */
+ copyswap = self->ao->descr->f->copyswap;
+ while(index--) {
+ if (*((Bool *)dptr) != 0) {
+ copyswap(self->dataptr, val->dataptr, swap, self->ao);
+ PyArray_ITER_NEXT(val);
+ if (val->index==val->size)
+ PyArray_ITER_RESET(val);
+ }
+ dptr += strides;
+ PyArray_ITER_NEXT(self);
+ }
+ PyArray_ITER_RESET(self);
+ return 0;
+}
+
+static int
+iter_ass_sub_int(PyArrayIterObject *self, PyArrayObject *ind,
+ PyArrayIterObject *val, int swap)
+{
+ PyArray_Descr *typecode;
+ intp num;
+ PyArrayIterObject *ind_it;
+ int index;
+ PyArray_CopySwapFunc *copyswap;
+
+ typecode = self->ao->descr;
+ copyswap = self->ao->descr->f->copyswap;
+ if (ind->nd == 0) {
+ num = *((intp *)ind->data);
+ PyArray_ITER_GOTO1D(self, num);
+ copyswap(self->dataptr, val->dataptr, swap, self->ao);
+ return 0;
+ }
+ ind_it = (PyArrayIterObject *)PyArray_IterNew((PyObject *)ind);
+ if (ind_it == NULL) return -1;
+ index = ind_it->size;
+ while(index--) {
+ num = *((intp *)(ind_it->dataptr));
+ if (num < 0) num += self->size;
+ if ((num < 0) || (num >= self->size)) {
+ PyErr_Format(PyExc_IndexError,
+ "index %d out of bounds" \
+ " 0<=index<%d", (int) num,
+ (int) self->size);
+ Py_DECREF(ind_it);
+ return -1;
+ }
+ PyArray_ITER_GOTO1D(self, num);
+ copyswap(self->dataptr, val->dataptr, swap, self->ao);
+ PyArray_ITER_NEXT(ind_it);
+ PyArray_ITER_NEXT(val);
+ if (val->index == val->size)
+ PyArray_ITER_RESET(val);
+ }
+ Py_DECREF(ind_it);
+ return 0;
+}
+
+static int
+iter_ass_subscript(PyArrayIterObject *self, PyObject *ind, PyObject *val)
+{
+ PyObject *arrval=NULL;
+ PyArrayIterObject *val_it=NULL;
+ PyArray_Descr *type;
+ PyArray_Descr *indtype=NULL;
+ int swap, retval=-1;
+ intp start, step_size;
+ intp n_steps;
+ PyObject *obj=NULL;
+ PyArray_CopySwapFunc *copyswap;
+
+
+ if (ind == Py_Ellipsis) {
+ ind = PySlice_New(NULL, NULL, NULL);
+ retval = iter_ass_subscript(self, ind, val);
+ Py_DECREF(ind);
+ return retval;
+ }
+
+ if (PyTuple_Check(ind)) {
+ int len;
+ len = PyTuple_GET_SIZE(ind);
+ if (len > 1) goto finish;
+ ind = PyTuple_GET_ITEM(ind, 0);
+ }
+
+ type = self->ao->descr;
+
+ /* Check for Boolean -- this is first becasue
+ Bool is a subclass of Int */
+
+ if (PyBool_Check(ind)) {
+ retval = 0;
+ if (PyObject_IsTrue(ind)) {
+ retval = type->f->setitem(val, self->dataptr, self->ao);
+ }
+ goto finish;
+ }
+
+ if (PySequence_Check(ind) || PySlice_Check(ind)) goto skip;
+ start = PyArray_PyIntAsIntp(ind);
+ if (start==-1 && PyErr_Occurred()) PyErr_Clear();
+ else {
+ if (start < -self->size || start >= self->size) {
+ PyErr_Format(PyExc_ValueError,
+ "index (%" NPY_INTP_FMT \
+ ") out of range", start);
+ goto finish;
+ }
+ retval = 0;
+ PyArray_ITER_GOTO1D(self, start);
+ retval = type->f->setitem(val, self->dataptr, self->ao);
+ PyArray_ITER_RESET(self);
+ if (retval < 0) {
+ PyErr_SetString(PyExc_ValueError,
+ "Error setting single item of array.");
+ }
+ goto finish;
+ }
+
+ skip:
+ Py_INCREF(type);
+ arrval = PyArray_FromAny(val, type, 0, 0, 0, NULL);
+ if (arrval==NULL) return -1;
+ val_it = (PyArrayIterObject *)PyArray_IterNew(arrval);
+ if (val_it==NULL) goto finish;
+ if (val_it->size == 0) {retval = 0; goto finish;}
+
+ copyswap = PyArray_DESCR(arrval)->f->copyswap;
+ swap = (PyArray_ISNOTSWAPPED(self->ao)!=PyArray_ISNOTSWAPPED(arrval));
+
+ /* Check Slice */
+
+ if (PySlice_Check(ind)) {
+ start = parse_subindex(ind, &step_size, &n_steps,
+ self->size);
+ if (start == -1) goto finish;
+ if (n_steps == RubberIndex || n_steps == PseudoIndex) {
+ PyErr_SetString(PyExc_IndexError,
+ "cannot use Ellipsis or newaxes here");
+ goto finish;
+ }
+ PyArray_ITER_GOTO1D(self, start);
+ if (n_steps == SingleIndex) { /* Integer */
+ copyswap(self->dataptr, PyArray_DATA(arrval),
+ swap, arrval);
+ PyArray_ITER_RESET(self);
+ retval=0;
+ goto finish;
+ }
+ while(n_steps--) {
+ copyswap(self->dataptr, val_it->dataptr,
+ swap, arrval);
+ start += step_size;
+ PyArray_ITER_GOTO1D(self, start)
+ PyArray_ITER_NEXT(val_it);
+ if (val_it->index == val_it->size)
+ PyArray_ITER_RESET(val_it);
+ }
+ PyArray_ITER_RESET(self);
+ retval = 0;
+ goto finish;
+ }
+
+ /* convert to INTP array if Integer array scalar or List */
+
+ indtype = PyArray_DescrFromType(PyArray_INTP);
+ if (PyList_Check(ind)) {
+ Py_INCREF(indtype);
+ obj = PyArray_FromAny(ind, indtype, 0, 0, FORCECAST, NULL);
+ }
+ else {
+ Py_INCREF(ind);
+ obj = ind;
+ }
+
+ if (obj != NULL && PyArray_Check(obj)) {
+ /* Check for Boolean object */
+ if (PyArray_TYPE(obj)==PyArray_BOOL) {
+ if (iter_ass_sub_Bool(self, (PyArrayObject *)obj,
+ val_it, swap) < 0)
+ goto finish;
+ retval=0;
+ }
+ /* Check for integer array */
+ else if (PyArray_ISINTEGER(obj)) {
+ PyObject *new;
+ Py_INCREF(indtype);
+ new = PyArray_CheckFromAny(obj, indtype, 0, 0,
+ FORCECAST | BEHAVED_NS, NULL);
+ Py_DECREF(obj);
+ obj = new;
+ if (new==NULL) goto finish;
+ if (iter_ass_sub_int(self, (PyArrayObject *)obj,
+ val_it, swap) < 0)
+ goto finish;
+ retval=0;
+ }
+ }
+
+ finish:
+ if (!PyErr_Occurred() && retval < 0)
+ PyErr_SetString(PyExc_IndexError,
+ "unsupported iterator index");
+ Py_XDECREF(indtype);
+ Py_XDECREF(obj);
+ Py_XDECREF(val_it);
+ Py_XDECREF(arrval);
+ return retval;
+
+}
+
+
+static PyMappingMethods iter_as_mapping = {
+#if PY_VERSION_HEX >= 0x02050000
+ (lenfunc)iter_length, /*mp_length*/
+#else
+ (inquiry)iter_length, /*mp_length*/
+#endif
+ (binaryfunc)iter_subscript, /*mp_subscript*/
+ (objobjargproc)iter_ass_subscript, /*mp_ass_subscript*/
+};
+
+
+
+static PyObject *
+iter_array(PyArrayIterObject *it, PyObject *op)
+{
+
+ PyObject *r;
+ intp size;
+
+ /* Any argument ignored */
+
+ /* Two options:
+ 1) underlying array is contiguous
+ -- return 1-d wrapper around it
+ 2) underlying array is not contiguous
+ -- make new 1-d contiguous array with updateifcopy flag set
+ to copy back to the old array
+ */
+
+ size = PyArray_SIZE(it->ao);
+ Py_INCREF(it->ao->descr);
+ if (PyArray_ISCONTIGUOUS(it->ao)) {
+ r = PyArray_NewFromDescr(&PyArray_Type,
+ it->ao->descr,
+ 1, &size,
+ NULL, it->ao->data,
+ it->ao->flags,
+ (PyObject *)it->ao);
+ if (r==NULL) return NULL;
+ }
+ else {
+ r = PyArray_NewFromDescr(&PyArray_Type,
+ it->ao->descr,
+ 1, &size,
+ NULL, NULL,
+ 0, (PyObject *)it->ao);
+ if (r==NULL) return NULL;
+ if (_flat_copyinto(r, (PyObject *)it->ao,
+ PyArray_CORDER) < 0) {
+ Py_DECREF(r);
+ return NULL;
+ }
+ PyArray_FLAGS(r) |= UPDATEIFCOPY;
+ it->ao->flags &= ~WRITEABLE;
+ }
+ Py_INCREF(it->ao);
+ PyArray_BASE(r) = (PyObject *)it->ao;
+ return r;
+
+}
+
+static PyObject *
+iter_copy(PyArrayIterObject *it, PyObject *args)
+{
+ if (!PyArg_ParseTuple(args, "")) return NULL;
+ return PyArray_Flatten(it->ao, 0);
+}
+
+static PyMethodDef iter_methods[] = {
+ /* to get array */
+ {"__array__", (PyCFunction)iter_array, 1, NULL},
+ {"copy", (PyCFunction)iter_copy, 1, NULL},
+ {NULL, NULL} /* sentinel */
+};
+
+static PyObject *
+iter_richcompare(PyArrayIterObject *self, PyObject *other, int cmp_op)
+{
+ PyArrayObject *new;
+ PyObject *ret;
+ new = (PyArrayObject *)iter_array(self, NULL);
+ if (new == NULL) return NULL;
+ ret = array_richcompare(new, other, cmp_op);
+ Py_DECREF(new);
+ return ret;
+}
+
+
+static PyMemberDef iter_members[] = {
+ {"base", T_OBJECT, offsetof(PyArrayIterObject, ao), RO, NULL},
+ {"index", T_INT, offsetof(PyArrayIterObject, index), RO, NULL},
+ {NULL},
+};
+
+static PyObject *
+iter_coords_get(PyArrayIterObject *self)
+{
+ int nd;
+ nd = self->ao->nd;
+ if (self->contiguous) { /* coordinates not kept track of --- need to generate
+ from index */
+ intp val;
+ int i;
+ val = self->index;
+ for (i=0;i<nd; i++) {
+ self->coordinates[i] = val / self->factors[i];
+ val = val % self->factors[i];
+ }
+ }
+ return PyArray_IntTupleFromIntp(nd, self->coordinates);
+}
+
+static PyGetSetDef iter_getsets[] = {
+ {"coords",
+ (getter)iter_coords_get,
+ NULL,
+ NULL},
+ {NULL, NULL, NULL, NULL},
+};
+
+static PyTypeObject PyArrayIter_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0, /* ob_size */
+ "numpy.flatiter", /* tp_name */
+ sizeof(PyArrayIterObject), /* tp_basicsize */
+ 0, /* tp_itemsize */
+ /* methods */
+ (destructor)arrayiter_dealloc, /* tp_dealloc */
+ 0, /* tp_print */
+ 0, /* tp_getattr */
+ 0, /* tp_setattr */
+ 0, /* tp_compare */
+ 0, /* tp_repr */
+ 0, /* tp_as_number */
+ 0, /* tp_as_sequence */
+ &iter_as_mapping, /* tp_as_mapping */
+ 0, /* tp_hash */
+ 0, /* tp_call */
+ 0, /* tp_str */
+ 0, /* tp_getattro */
+ 0, /* tp_setattro */
+ 0, /* tp_as_buffer */
+ Py_TPFLAGS_DEFAULT, /* tp_flags */
+ 0, /* tp_doc */
+ 0, /* tp_traverse */
+ 0, /* tp_clear */
+ (richcmpfunc)iter_richcompare, /* tp_richcompare */
+ 0, /* tp_weaklistoffset */
+ 0, /* tp_iter */
+ (iternextfunc)arrayiter_next, /* tp_iternext */
+ iter_methods, /* tp_methods */
+ iter_members, /* tp_members */
+ iter_getsets, /* tp_getset */
+
+};
+
+/** END of Array Iterator **/
+
+
+
+/*********************** Subscript Array Iterator *************************
+ * *
+ * This object handles subscript behavior for array objects. *
+ * It is an iterator object with a next method *
+ * It abstracts the n-dimensional mapping behavior to make the looping *
+ * code more understandable (maybe) *
+ * and so that indexing can be set up ahead of time *
+ */
+
+
+static int _nonzero_indices(PyObject *myBool, PyArrayIterObject **iters);
+/* convert an indexing object to an INTP indexing array iterator
+ if possible -- otherwise, it is a Slice or Ellipsis object
+ and has to be interpreted on bind to a particular
+ array so leave it NULL for now.
+ */
+static int
+_convert_obj(PyObject *obj, PyArrayIterObject **iter)
+{
+ PyArray_Descr *indtype;
+ PyObject *arr;
+
+ if (PySlice_Check(obj) || (obj == Py_Ellipsis))
+ return 0;
+ else if (PyArray_Check(obj) && PyArray_ISBOOL(obj)) {
+ return _nonzero_indices(obj, iter);
+ }
+ else {
+ indtype = PyArray_DescrFromType(PyArray_INTP);
+ arr = PyArray_FromAny(obj, indtype, 0, 0, FORCECAST, NULL);
+ if (arr == NULL) return -1;
+ *iter = (PyArrayIterObject *)PyArray_IterNew(arr);
+ Py_DECREF(arr);
+ if (*iter == NULL) return -1;
+ }
+ return 1;
+}
+
+/* Adjust dimensionality and strides for index object iterators
+ --- i.e. broadcast
+ */
+/*OBJECT_API*/
+static int
+PyArray_Broadcast(PyArrayMultiIterObject *mit)
+{
+ int i, nd, k, j;
+ intp tmp;
+ PyArrayIterObject *it;
+
+ /* Discover the broadcast number of dimensions */
+ for (i=0, nd=0; i<mit->numiter; i++)
+ nd = MAX(nd, mit->iters[i]->ao->nd);
+ mit->nd = nd;
+
+ /* Discover the broadcast shape in each dimension */
+ for (i=0; i<nd; i++) {
+ mit->dimensions[i] = 1;
+ for (j=0; j<mit->numiter; j++) {
+ it = mit->iters[j];
+ /* This prepends 1 to shapes not already
+ equal to nd */
+ k = i + it->ao->nd - nd;
+ if (k>=0) {
+ tmp = it->ao->dimensions[k];
+ if (tmp == 1) continue;
+ if (mit->dimensions[i] == 1)
+ mit->dimensions[i] = tmp;
+ else if (mit->dimensions[i] != tmp) {
+ PyErr_SetString(PyExc_ValueError,
+ "shape mismatch: objects" \
+ " cannot be broadcast" \
+ " to a single shape");
+ return -1;
+ }
+ }
+ }
+ }
+
+ /* Reset the iterator dimensions and strides of each iterator
+ object -- using 0 valued strides for broadcasting */
+
+ tmp = PyArray_MultiplyList(mit->dimensions, mit->nd);
+ mit->size = tmp;
+ for (i=0; i<mit->numiter; i++) {
+ it = mit->iters[i];
+ it->nd_m1 = mit->nd - 1;
+ it->size = tmp;
+ nd = it->ao->nd;
+ it->factors[mit->nd-1] = 1;
+ for (j=0; j < mit->nd; j++) {
+ it->dims_m1[j] = mit->dimensions[j] - 1;
+ k = j + nd - mit->nd;
+ /* If this dimension was added or shape
+ of underlying array was 1 */
+ if ((k < 0) || \
+ it->ao->dimensions[k] != mit->dimensions[j]) {
+ it->contiguous = 0;
+ it->strides[j] = 0;
+ }
+ else {
+ it->strides[j] = it->ao->strides[k];
+ }
+ it->backstrides[j] = it->strides[j] * \
+ it->dims_m1[j];
+ if (j > 0)
+ it->factors[mit->nd-j-1] = \
+ it->factors[mit->nd-j] * \
+ mit->dimensions[mit->nd-j];
+ }
+ PyArray_ITER_RESET(it);
+ }
+ return 0;
+}
+
+/* Reset the map iterator to the beginning */
+static void
+PyArray_MapIterReset(PyArrayMapIterObject *mit)
+{
+ int i,j; intp coord[MAX_DIMS];
+ PyArrayIterObject *it;
+ PyArray_CopySwapFunc *copyswap;
+
+ mit->index = 0;
+
+ copyswap = mit->iters[0]->ao->descr->f->copyswap;
+
+ if (mit->subspace != NULL) {
+ memcpy(coord, mit->bscoord, sizeof(intp)*mit->ait->ao->nd);
+ PyArray_ITER_RESET(mit->subspace);
+ for (i=0; i<mit->numiter; i++) {
+ it = mit->iters[i];
+ PyArray_ITER_RESET(it);
+ j = mit->iteraxes[i];
+ copyswap(coord+j,it->dataptr,
+ !PyArray_ISNOTSWAPPED(it->ao),
+ it->ao);
+ }
+ PyArray_ITER_GOTO(mit->ait, coord);
+ mit->subspace->dataptr = mit->ait->dataptr;
+ mit->dataptr = mit->subspace->dataptr;
+ }
+ else {
+ for (i=0; i<mit->numiter; i++) {
+ it = mit->iters[i];
+ if (it->size != 0) {
+ PyArray_ITER_RESET(it);
+ copyswap(coord+i,it->dataptr,
+ !PyArray_ISNOTSWAPPED(it->ao),
+ it->ao);
+ }
+ else coord[i] = 0;
+ }
+ PyArray_ITER_GOTO(mit->ait, coord);
+ mit->dataptr = mit->ait->dataptr;
+ }
+ return;
+}
+
+/* This function needs to update the state of the map iterator
+ and point mit->dataptr to the memory-location of the next object
+*/
+static void
+PyArray_MapIterNext(PyArrayMapIterObject *mit)
+{
+ int i, j;
+ intp coord[MAX_DIMS];
+ PyArrayIterObject *it;
+ PyArray_CopySwapFunc *copyswap;
+
+ mit->index += 1;
+ if (mit->index >= mit->size) return;
+ copyswap = mit->iters[0]->ao->descr->f->copyswap;
+ /* Sub-space iteration */
+ if (mit->subspace != NULL) {
+ PyArray_ITER_NEXT(mit->subspace);
+ if (mit->subspace->index >= mit->subspace->size) {
+ /* reset coord to coordinates of
+ beginning of the subspace */
+ memcpy(coord, mit->bscoord,
+ sizeof(intp)*mit->ait->ao->nd);
+ PyArray_ITER_RESET(mit->subspace);
+ for (i=0; i<mit->numiter; i++) {
+ it = mit->iters[i];
+ PyArray_ITER_NEXT(it);
+ j = mit->iteraxes[i];
+ copyswap(coord+j,it->dataptr,
+ !PyArray_ISNOTSWAPPED(it->ao),
+ it->ao);
+ }
+ PyArray_ITER_GOTO(mit->ait, coord);
+ mit->subspace->dataptr = mit->ait->dataptr;
+ }
+ mit->dataptr = mit->subspace->dataptr;
+ }
+ else {
+ for (i=0; i<mit->numiter; i++) {
+ it = mit->iters[i];
+ PyArray_ITER_NEXT(it);
+ copyswap(coord+i,it->dataptr,
+ !PyArray_ISNOTSWAPPED(it->ao),
+ it->ao);
+ }
+ PyArray_ITER_GOTO(mit->ait, coord);
+ mit->dataptr = mit->ait->dataptr;
+ }
+ return;
+}
+
+/* Bind a mapiteration to a particular array */
+
+/* Determine if subspace iteration is necessary. If so,
+ 1) Fill in mit->iteraxes
+ 2) Create subspace iterator
+ 3) Update nd, dimensions, and size.
+
+ Subspace iteration is necessary if: arr->nd > mit->numiter
+*/
+
+/* Need to check for index-errors somewhere.
+
+ Let's do it at bind time and also convert all <0 values to >0 here
+ as well.
+*/
+static void
+PyArray_MapIterBind(PyArrayMapIterObject *mit, PyArrayObject *arr)
+{
+ int subnd;
+ PyObject *sub, *obj=NULL;
+ int i, j, n, curraxis, ellipexp, noellip;
+ PyArrayIterObject *it;
+ intp dimsize;
+ intp *indptr;
+
+ subnd = arr->nd - mit->numiter;
+ if (subnd < 0) {
+ PyErr_SetString(PyExc_ValueError,
+ "too many indices for array");
+ return;
+ }
+
+ mit->ait = (PyArrayIterObject *)PyArray_IterNew((PyObject *)arr);
+ if (mit->ait == NULL) return;
+
+ /* no subspace iteration needed. Finish up and Return */
+ if (subnd == 0) {
+ n = arr->nd;
+ for (i=0; i<n; i++) {
+ mit->iteraxes[i] = i;
+ }
+ goto finish;
+ }
+
+ /* all indexing arrays have been converted to 0
+ therefore we can extract the subspace with a simple
+ getitem call which will use view semantics
+ */
+ /* But, be sure to do it with a true array.
+ */
+ if (PyArray_CheckExact(arr)) {
+ sub = array_subscript_simple(arr, mit->indexobj);
+ }
+ else {
+ Py_INCREF(arr);
+ obj = PyArray_EnsureArray((PyObject *)arr);
+ if (obj == NULL) goto fail;
+ sub = array_subscript_simple((PyArrayObject *)obj, mit->indexobj);
+ Py_DECREF(obj);
+ }
+
+ if (sub == NULL) goto fail;
+ mit->subspace = (PyArrayIterObject *)PyArray_IterNew(sub);
+ Py_DECREF(sub);
+ if (mit->subspace == NULL) goto fail;
+
+ /* Expand dimensions of result */
+ n = mit->subspace->ao->nd;
+ for (i=0; i<n; i++)
+ mit->dimensions[mit->nd+i] = mit->subspace->ao->dimensions[i];
+ mit->nd += n;
+
+ /* Now, we still need to interpret the ellipsis and slice objects
+ to determine which axes the indexing arrays are referring to
+ */
+ n = PyTuple_GET_SIZE(mit->indexobj);
+
+ /* The number of dimensions an ellipsis takes up */
+ ellipexp = arr->nd - n + 1;
+ /* Now fill in iteraxes -- remember indexing arrays have been
+ converted to 0's in mit->indexobj */
+ curraxis = 0;
+ j = 0;
+ noellip = 1; /* Only expand the first ellipsis */
+ memset(mit->bscoord, 0, sizeof(intp)*arr->nd);
+ for (i=0; i<n; i++) {
+ /* We need to fill in the starting coordinates for
+ the subspace */
+ obj = PyTuple_GET_ITEM(mit->indexobj, i);
+ if (PyInt_Check(obj) || PyLong_Check(obj))
+ mit->iteraxes[j++] = curraxis++;
+ else if (noellip && obj == Py_Ellipsis) {
+ curraxis += ellipexp;
+ noellip = 0;
+ }
+ else {
+ intp start=0;
+ intp stop, step;
+ /* Should be slice object or
+ another Ellipsis */
+ if (obj == Py_Ellipsis) {
+ mit->bscoord[curraxis] = 0;
+ }
+ else if (!PySlice_Check(obj) || \
+ (slice_GetIndices((PySliceObject *)obj,
+ arr->dimensions[curraxis],
+ &start, &stop, &step,
+ &dimsize) < 0)) {
+ PyErr_Format(PyExc_ValueError,
+ "unexpected object " \
+ "(%s) in selection position %d",
+ obj->ob_type->tp_name, i);
+ goto fail;
+ }
+ else {
+ mit->bscoord[curraxis] = start;
+ }
+ curraxis += 1;
+ }
+ }
+ finish:
+ /* Here check the indexes (now that we have iteraxes) */
+ mit->size = PyArray_MultiplyList(mit->dimensions, mit->nd);
+ if (mit->ait->size == 0 && mit->size != 0) {
+ PyErr_SetString(PyExc_ValueError,
+ "invalid index into a 0-size array");
+ goto fail;
+ }
+
+ for (i=0; i<mit->numiter; i++) {
+ intp indval;
+ it = mit->iters[i];
+ PyArray_ITER_RESET(it);
+ dimsize = arr->dimensions[mit->iteraxes[i]];
+ while(it->index < it->size) {
+ indptr = ((intp *)it->dataptr);
+ indval = *indptr;
+ if (indval < 0) indval += dimsize;
+ if (indval < 0 || indval >= dimsize) {
+ PyErr_Format(PyExc_IndexError,
+ "index (%d) out of range "\
+ "(0<=index<=%d) in dimension %d",
+ (int) indval, (int) (dimsize-1),
+ mit->iteraxes[i]);
+ goto fail;
+ }
+ PyArray_ITER_NEXT(it);
+ }
+ PyArray_ITER_RESET(it);
+ }
+ return;
+
+ fail:
+ Py_XDECREF(mit->subspace);
+ Py_XDECREF(mit->ait);
+ mit->subspace = NULL;
+ mit->ait = NULL;
+ return;
+}
+
+/* This function takes a Boolean array and constructs index objects and
+ iterators as if nonzero(Bool) had been called
+*/
+static int
+_nonzero_indices(PyObject *myBool, PyArrayIterObject **iters)
+{
+ PyArray_Descr *typecode;
+ PyArrayObject *ba =NULL, *new=NULL;
+ int nd, j;
+ intp size, i, count;
+ Bool *ptr;
+ intp coords[MAX_DIMS], dims_m1[MAX_DIMS];
+ intp *dptr[MAX_DIMS];
+
+ typecode=PyArray_DescrFromType(PyArray_BOOL);
+ ba = (PyArrayObject *)PyArray_FromAny(myBool, typecode, 0, 0,
+ CARRAY, NULL);
+ if (ba == NULL) return -1;
+ nd = ba->nd;
+ for (j=0; j<nd; j++) iters[j] = NULL;
+ size = PyArray_SIZE(ba);
+ ptr = (Bool *)ba->data;
+ count = 0;
+
+ /* pre-determine how many nonzero entries there are */
+ for (i=0; i<size; i++)
+ if (*(ptr++)) count++;
+
+ /* create count-sized index arrays for each dimension */
+ for (j=0; j<nd; j++) {
+ new = (PyArrayObject *)PyArray_New(&PyArray_Type, 1, &count,
+ PyArray_INTP, NULL, NULL,
+ 0, 0, NULL);
+ if (new == NULL) goto fail;
+ iters[j] = (PyArrayIterObject *) \
+ PyArray_IterNew((PyObject *)new);
+ Py_DECREF(new);
+ if (iters[j] == NULL) goto fail;
+ dptr[j] = (intp *)iters[j]->ao->data;
+ coords[j] = 0;
+ dims_m1[j] = ba->dimensions[j]-1;
+ }
+
+ ptr = (Bool *)ba->data;
+
+ if (count == 0) goto finish;
+
+ /* Loop through the Boolean array and copy coordinates
+ for non-zero entries */
+ for (i=0; i<size; i++) {
+ if (*(ptr++)) {
+ for (j=0; j<nd; j++)
+ *(dptr[j]++) = coords[j];
+ }
+ /* Borrowed from ITER_NEXT macro */
+ for (j=nd-1; j>=0; j--) {
+ if (coords[j] < dims_m1[j]) {
+ coords[j]++;
+ break;
+ }
+ else {
+ coords[j] = 0;
+ }
+ }
+ }
+
+ finish:
+ Py_DECREF(ba);
+ return nd;
+
+ fail:
+ for (j=0; j<nd; j++) {
+ Py_XDECREF(iters[j]);
+ }
+ Py_XDECREF(ba);
+ return -1;
+}
+
+static PyObject *
+PyArray_MapIterNew(PyObject *indexobj, int oned, int fancy)
+{
+ PyArrayMapIterObject *mit;
+ PyArray_Descr *indtype;
+ PyObject *arr = NULL;
+ int i, n, started, nonindex;
+
+ if (fancy == SOBJ_BADARRAY) {
+ PyErr_SetString(PyExc_IndexError, \
+ "arrays used as indices must be of " \
+ "integer (or boolean) type");
+ return NULL;
+ }
+ if (fancy == SOBJ_TOOMANY) {
+ PyErr_SetString(PyExc_IndexError, "too many indices");
+ return NULL;
+ }
+
+ mit = (PyArrayMapIterObject *)_pya_malloc(sizeof(PyArrayMapIterObject));
+ PyObject_Init((PyObject *)mit, &PyArrayMapIter_Type);
+ if (mit == NULL)
+ return NULL;
+ for (i=0; i<MAX_DIMS; i++)
+ mit->iters[i] = NULL;
+ mit->index = 0;
+ mit->ait = NULL;
+ mit->subspace = NULL;
+ mit->numiter = 0;
+ mit->consec = 1;
+ Py_INCREF(indexobj);
+ mit->indexobj = indexobj;
+
+ if (fancy == SOBJ_LISTTUP) {
+ PyObject *newobj;
+ newobj = PySequence_Tuple(indexobj);
+ if (newobj == NULL) goto fail;
+ Py_DECREF(indexobj);
+ indexobj = newobj;
+ mit->indexobj = indexobj;
+ }
+
+#undef SOBJ_NOTFANCY
+#undef SOBJ_ISFANCY
+#undef SOBJ_BADARRAY
+#undef SOBJ_TOOMANY
+#undef SOBJ_LISTTUP
+
+ if (oned) return (PyObject *)mit;
+
+ /* Must have some kind of fancy indexing if we are here */
+ /* indexobj is either a list, an arrayobject, or a tuple
+ (with at least 1 list or arrayobject or Bool object), */
+
+ /* convert all inputs to iterators */
+ if (PyArray_Check(indexobj) && \
+ (PyArray_TYPE(indexobj) == PyArray_BOOL)) {
+ mit->numiter = _nonzero_indices(indexobj, mit->iters);
+ if (mit->numiter < 0) goto fail;
+ mit->nd = 1;
+ mit->dimensions[0] = mit->iters[0]->dims_m1[0]+1;
+ Py_DECREF(mit->indexobj);
+ mit->indexobj = PyTuple_New(mit->numiter);
+ if (mit->indexobj == NULL) goto fail;
+ for (i=0; i<mit->numiter; i++) {
+ PyTuple_SET_ITEM(mit->indexobj, i,
+ PyInt_FromLong(0));
+ }
+ }
+
+ else if (PyArray_Check(indexobj) || !PyTuple_Check(indexobj)) {
+ mit->numiter = 1;
+ indtype = PyArray_DescrFromType(PyArray_INTP);
+ arr = PyArray_FromAny(indexobj, indtype, 0, 0, FORCECAST, NULL);
+ if (arr == NULL) goto fail;
+ mit->iters[0] = (PyArrayIterObject *)PyArray_IterNew(arr);
+ if (mit->iters[0] == NULL) {Py_DECREF(arr); goto fail;}
+ mit->nd = PyArray_NDIM(arr);
+ memcpy(mit->dimensions,PyArray_DIMS(arr),mit->nd*sizeof(intp));
+ mit->size = PyArray_SIZE(arr);
+ Py_DECREF(arr);
+ Py_DECREF(mit->indexobj);
+ mit->indexobj = Py_BuildValue("(N)", PyInt_FromLong(0));
+ }
+ else { /* must be a tuple */
+ PyObject *obj;
+ PyArrayIterObject **iterp;
+ PyObject *new;
+ int numiters, j, n2;
+ /* Make a copy of the tuple -- we will be replacing
+ index objects with 0's */
+ n = PyTuple_GET_SIZE(indexobj);
+ n2 = n;
+ new = PyTuple_New(n2);
+ if (new == NULL) goto fail;
+ started = 0;
+ nonindex = 0;
+ j = 0;
+ for (i=0; i<n; i++) {
+ obj = PyTuple_GET_ITEM(indexobj,i);
+ iterp = mit->iters + mit->numiter;
+ if ((numiters=_convert_obj(obj, iterp)) < 0) {
+ Py_DECREF(new);
+ goto fail;
+ }
+ if (numiters > 0) {
+ started = 1;
+ if (nonindex) mit->consec = 0;
+ mit->numiter += numiters;
+ if (numiters == 1) {
+ PyTuple_SET_ITEM(new,j++,
+ PyInt_FromLong(0));
+ }
+ else { /* we need to grow the
+ new indexing object and fill
+ it with 0s for each of the iterators
+ produced */
+ int k;
+ n2 += numiters - 1;
+ if (_PyTuple_Resize(&new, n2) < 0)
+ goto fail;
+ for (k=0;k<numiters;k++) {
+ PyTuple_SET_ITEM \
+ (new,j++,
+ PyInt_FromLong(0));
+ }
+ }
+ }
+ else {
+ if (started) nonindex = 1;
+ Py_INCREF(obj);
+ PyTuple_SET_ITEM(new,j++,obj);
+ }
+ }
+ Py_DECREF(mit->indexobj);
+ mit->indexobj = new;
+ /* Store the number of iterators actually converted */
+ /* These will be mapped to actual axes at bind time */
+ if (PyArray_Broadcast((PyArrayMultiIterObject *)mit) < 0)
+ goto fail;
+ }
+
+ return (PyObject *)mit;
+
+ fail:
+ Py_DECREF(mit);
+ return NULL;
+}
+
+
+static void
+arraymapiter_dealloc(PyArrayMapIterObject *mit)
+{
+ int i;
+ Py_XDECREF(mit->indexobj);
+ Py_XDECREF(mit->ait);
+ Py_XDECREF(mit->subspace);
+ for (i=0; i<mit->numiter; i++)
+ Py_XDECREF(mit->iters[i]);
+ _pya_free(mit);
+}
+
+/* The mapiter object must be created new each time. It does not work
+ to bind to a new array, and continue.
+
+ This was the orginal intention, but currently that does not work.
+ Do not expose the MapIter_Type to Python.
+
+ It's not very useful anyway, since mapiter(indexobj); mapiter.bind(a);
+ mapiter is equivalent to a[indexobj].flat but the latter gets to use
+ slice syntax.
+*/
+
+static PyTypeObject PyArrayMapIter_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0, /* ob_size */
+ "numpy.mapiter", /* tp_name */
+ sizeof(PyArrayIterObject), /* tp_basicsize */
+ 0, /* tp_itemsize */
+ /* methods */
+ (destructor)arraymapiter_dealloc, /* tp_dealloc */
+ 0, /* tp_print */
+ 0, /* tp_getattr */
+ 0, /* tp_setattr */
+ 0, /* tp_compare */
+ 0, /* tp_repr */
+ 0, /* tp_as_number */
+ 0, /* tp_as_sequence */
+ 0, /* tp_as_mapping */
+ 0, /* tp_hash */
+ 0, /* tp_call */
+ 0, /* tp_str */
+ 0, /* tp_getattro */
+ 0, /* tp_setattro */
+ 0, /* tp_as_buffer */
+ Py_TPFLAGS_DEFAULT, /* tp_flags */
+ 0, /* tp_doc */
+ (traverseproc)0, /* tp_traverse */
+ 0, /* tp_clear */
+ 0, /* tp_richcompare */
+ 0, /* tp_weaklistoffset */
+ 0, /* tp_iter */
+ (iternextfunc)0, /* tp_iternext */
+ 0, /* tp_methods */
+ 0, /* tp_members */
+ 0, /* tp_getset */
+ 0, /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
+ 0, /* tp_dictoffset */
+ (initproc)0, /* tp_init */
+ 0, /* tp_alloc */
+ 0, /* tp_new */
+ 0, /* tp_free */
+ 0, /* tp_is_gc */
+ 0, /* tp_bases */
+ 0, /* tp_mro */
+ 0, /* tp_cache */
+ 0, /* tp_subclasses */
+ 0 /* tp_weaklist */
+
+};
+
+/** END of Subscript Iterator **/
+
+
+/*OBJECT_API
+ Get MultiIterator,
+*/
+static PyObject *
+PyArray_MultiIterNew(int n, ...)
+{
+ va_list va;
+ PyArrayMultiIterObject *multi;
+ PyObject *current;
+ PyObject *arr;
+
+ int i, err=0;
+
+ if (n < 2 || n > NPY_MAXARGS) {
+ PyErr_Format(PyExc_ValueError,
+ "Need between 2 and (%d) " \
+ "array objects (inclusive).", NPY_MAXARGS);
+ return NULL;
+ }
+
+ /* fprintf(stderr, "multi new...");*/
+
+ multi = _pya_malloc(sizeof(PyArrayMultiIterObject));
+ if (multi == NULL) return PyErr_NoMemory();
+ PyObject_Init((PyObject *)multi, &PyArrayMultiIter_Type);
+
+ for (i=0; i<n; i++) multi->iters[i] = NULL;
+ multi->numiter = n;
+ multi->index = 0;
+
+ va_start(va, n);
+ for (i=0; i<n; i++) {
+ current = va_arg(va, PyObject *);
+ arr = PyArray_FROM_O(current);
+ if (arr==NULL) {
+ err=1; break;
+ }
+ else {
+ multi->iters[i] = (PyArrayIterObject *)PyArray_IterNew(arr);
+ Py_DECREF(arr);
+ }
+ }
+
+ va_end(va);
+
+ if (!err && PyArray_Broadcast(multi) < 0) err=1;
+
+ if (err) {
+ Py_DECREF(multi);
+ return NULL;
+ }
+
+ PyArray_MultiIter_RESET(multi);
+
+ return (PyObject *)multi;
+}
+
+static PyObject *
+arraymultiter_new(PyTypeObject *subtype, PyObject *args, PyObject *kwds)
+{
+
+ int n, i;
+ PyArrayMultiIterObject *multi;
+ PyObject *arr;
+
+ if (kwds != NULL) {
+ PyErr_SetString(PyExc_ValueError,
+ "keyword arguments not accepted.");
+ return NULL;
+ }
+
+ n = PyTuple_Size(args);
+ if (n < 2 || n > NPY_MAXARGS) {
+ if (PyErr_Occurred()) return NULL;
+ PyErr_Format(PyExc_ValueError,
+ "Need at least two and fewer than (%d) " \
+ "array objects.", NPY_MAXARGS);
+ return NULL;
+ }
+
+ multi = _pya_malloc(sizeof(PyArrayMultiIterObject));
+ if (multi == NULL) return PyErr_NoMemory();
+ PyObject_Init((PyObject *)multi, &PyArrayMultiIter_Type);
+
+ multi->numiter = n;
+ multi->index = 0;
+ for (i=0; i<n; i++) multi->iters[i] = NULL;
+ for (i=0; i<n; i++) {
+ arr = PyArray_FromAny(PyTuple_GET_ITEM(args, i), NULL, 0, 0, 0, NULL);
+ if (arr == NULL) goto fail;
+ if ((multi->iters[i] = \
+ (PyArrayIterObject *)PyArray_IterNew(arr))==NULL)
+ goto fail;
+ Py_DECREF(arr);
+ }
+ if (PyArray_Broadcast(multi) < 0) goto fail;
+ PyArray_MultiIter_RESET(multi);
+
+ return (PyObject *)multi;
+
+ fail:
+ Py_DECREF(multi);
+ return NULL;
+}
+
+static PyObject *
+arraymultiter_next(PyArrayMultiIterObject *multi)
+{
+ PyObject *ret;
+ int i, n;
+
+ n = multi->numiter;
+ ret = PyTuple_New(n);
+ if (ret == NULL) return NULL;
+ if (multi->index < multi->size) {
+ for (i=0; i < n; i++) {
+ PyArrayIterObject *it=multi->iters[i];
+ PyTuple_SET_ITEM(ret, i,
+ PyArray_ToScalar(it->dataptr, it->ao));
+ PyArray_ITER_NEXT(it);
+ }
+ multi->index++;
+ return ret;
+ }
+ return NULL;
+}
+
+static void
+arraymultiter_dealloc(PyArrayMultiIterObject *multi)
+{
+ int i;
+
+ for (i=0; i<multi->numiter; i++)
+ Py_XDECREF(multi->iters[i]);
+ multi->ob_type->tp_free((PyObject *)multi);
+}
+
+static PyObject *
+arraymultiter_size_get(PyArrayMultiIterObject *self)
+{
+#if SIZEOF_INTP <= SIZEOF_LONG
+ return PyInt_FromLong((long) self->size);
+#else
+ if (self->size < MAX_LONG)
+ return PyInt_FromLong((long) self->size);
+ else
+ return PyLong_FromLongLong((longlong) self->size);
+#endif
+}
+
+static PyObject *
+arraymultiter_index_get(PyArrayMultiIterObject *self)
+{
+#if SIZEOF_INTP <= SIZEOF_LONG
+ return PyInt_FromLong((long) self->index);
+#else
+ if (self->size < MAX_LONG)
+ return PyInt_FromLong((long) self->index);
+ else
+ return PyLong_FromLongLong((longlong) self->index);
+#endif
+}
+
+static PyObject *
+arraymultiter_shape_get(PyArrayMultiIterObject *self)
+{
+ return PyArray_IntTupleFromIntp(self->nd, self->dimensions);
+}
+
+static PyObject *
+arraymultiter_iters_get(PyArrayMultiIterObject *self)
+{
+ PyObject *res;
+ int i, n;
+ n = self->numiter;
+ res = PyTuple_New(n);
+ if (res == NULL) return res;
+ for (i=0; i<n; i++) {
+ Py_INCREF(self->iters[i]);
+ PyTuple_SET_ITEM(res, i, (PyObject *)self->iters[i]);
+ }
+ return res;
+}
+
+static PyGetSetDef arraymultiter_getsetlist[] = {
+ {"size",
+ (getter)arraymultiter_size_get,
+ NULL, NULL},
+ {"index",
+ (getter)arraymultiter_index_get,
+ NULL, NULL},
+ {"shape",
+ (getter)arraymultiter_shape_get,
+ NULL, NULL},
+ {"iters",
+ (getter)arraymultiter_iters_get,
+ NULL, NULL},
+ {NULL, NULL, NULL, NULL},
+};
+
+static PyMemberDef arraymultiter_members[] = {
+ {"numiter", T_INT, offsetof(PyArrayMultiIterObject, numiter),
+ RO, NULL},
+ {"nd", T_INT, offsetof(PyArrayMultiIterObject, nd), RO, NULL},
+ {NULL},
+};
+
+static PyObject *
+arraymultiter_reset(PyArrayMultiIterObject *self, PyObject *args)
+{
+ if (!PyArg_ParseTuple(args, "")) return NULL;
+
+ PyArray_MultiIter_RESET(self);
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+static PyMethodDef arraymultiter_methods[] = {
+ {"reset", (PyCFunction) arraymultiter_reset, METH_VARARGS, NULL},
+ {NULL, NULL},
+};
+
+static PyTypeObject PyArrayMultiIter_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0, /* ob_size */
+ "numpy.broadcast", /* tp_name */
+ sizeof(PyArrayMultiIterObject), /* tp_basicsize */
+ 0, /* tp_itemsize */
+ /* methods */
+ (destructor)arraymultiter_dealloc, /* tp_dealloc */
+ 0, /* tp_print */
+ 0, /* tp_getattr */
+ 0, /* tp_setattr */
+ 0, /* tp_compare */
+ 0, /* tp_repr */
+ 0, /* tp_as_number */
+ 0, /* tp_as_sequence */
+ 0, /* tp_as_mapping */
+ 0, /* tp_hash */
+ 0, /* tp_call */
+ 0, /* tp_str */
+ 0, /* tp_getattro */
+ 0, /* tp_setattro */
+ 0, /* tp_as_buffer */
+ Py_TPFLAGS_DEFAULT, /* tp_flags */
+ 0, /* tp_doc */
+ 0, /* tp_traverse */
+ 0, /* tp_clear */
+ 0, /* tp_richcompare */
+ 0, /* tp_weaklistoffset */
+ 0, /* tp_iter */
+ (iternextfunc)arraymultiter_next, /* tp_iternext */
+ arraymultiter_methods, /* tp_methods */
+ arraymultiter_members, /* tp_members */
+ arraymultiter_getsetlist, /* tp_getset */
+ 0, /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
+ 0, /* tp_dictoffset */
+ (initproc)0, /* tp_init */
+ 0, /* tp_alloc */
+ arraymultiter_new, /* tp_new */
+ 0, /* tp_free */
+ 0, /* tp_is_gc */
+ 0, /* tp_bases */
+ 0, /* tp_mro */
+ 0, /* tp_cache */
+ 0, /* tp_subclasses */
+ 0 /* tp_weaklist */
+};
+
+/*OBJECT_API*/
+static PyArray_Descr *
+PyArray_DescrNewFromType(int type_num)
+{
+ PyArray_Descr *old;
+ PyArray_Descr *new;
+
+ old = PyArray_DescrFromType(type_num);
+ new = PyArray_DescrNew(old);
+ Py_DECREF(old);
+ return new;
+}
+
+/*** Array Descr Objects for dynamic types **/
+
+/** There are some statically-defined PyArray_Descr objects corresponding
+ to the basic built-in types.
+ These can and should be DECREF'd and INCREF'd as appropriate, anyway.
+ If a mistake is made in reference counting, deallocation on these
+ builtins will be attempted leading to problems.
+
+ This let's us deal with all PyArray_Descr objects using reference
+ counting (regardless of whether they are statically or dynamically
+ allocated).
+**/
+
+/* base cannot be NULL */
+/*OBJECT_API*/
+static PyArray_Descr *
+PyArray_DescrNew(PyArray_Descr *base)
+{
+ PyArray_Descr *new;
+
+ new = PyObject_New(PyArray_Descr, &PyArrayDescr_Type);
+ if (new == NULL) return NULL;
+ /* Don't copy PyObject_HEAD part */
+ memcpy((char *)new+sizeof(PyObject),
+ (char *)base+sizeof(PyObject),
+ sizeof(PyArray_Descr)-sizeof(PyObject));
+
+ if (new->fields == Py_None) new->fields = NULL;
+ Py_XINCREF(new->fields);
+ Py_XINCREF(new->names);
+ if (new->subarray) {
+ new->subarray = _pya_malloc(sizeof(PyArray_ArrayDescr));
+ memcpy(new->subarray, base->subarray,
+ sizeof(PyArray_ArrayDescr));
+ Py_INCREF(new->subarray->shape);
+ Py_INCREF(new->subarray->base);
+ }
+ Py_XINCREF(new->typeobj);
+ return new;
+}
+
+/* should never be called for builtin-types unless
+ there is a reference-count problem
+*/
+static void
+arraydescr_dealloc(PyArray_Descr *self)
+{
+ if (self->fields == Py_None) {
+ fprintf(stderr, "*** Reference count error detected: \n" \
+ "an attempt was made to deallocate %d (%c) ***\n",
+ self->type_num, self->type);
+ Py_INCREF(self);
+ Py_INCREF(self);
+ return;
+ }
+ Py_XDECREF(self->typeobj);
+ Py_XDECREF(self->names);
+ Py_XDECREF(self->fields);
+ if (self->subarray) {
+ Py_DECREF(self->subarray->shape);
+ Py_DECREF(self->subarray->base);
+ _pya_free(self->subarray);
+ }
+ self->ob_type->tp_free((PyObject *)self);
+}
+
+/* we need to be careful about setting attributes because these
+ objects are pointed to by arrays that depend on them for interpreting
+ data. Currently no attributes of dtype objects can be set.
+*/
+static PyMemberDef arraydescr_members[] = {
+ {"type", T_OBJECT, offsetof(PyArray_Descr, typeobj), RO, NULL},
+ {"kind", T_CHAR, offsetof(PyArray_Descr, kind), RO, NULL},
+ {"char", T_CHAR, offsetof(PyArray_Descr, type), RO, NULL},
+ {"num", T_INT, offsetof(PyArray_Descr, type_num), RO, NULL},
+ {"byteorder", T_CHAR, offsetof(PyArray_Descr, byteorder), RO, NULL},
+ {"itemsize", T_INT, offsetof(PyArray_Descr, elsize), RO, NULL},
+ {"alignment", T_INT, offsetof(PyArray_Descr, alignment), RO, NULL},
+ {"flags", T_UBYTE, offsetof(PyArray_Descr, hasobject), RO, NULL},
+ {"names", T_OBJECT, offsetof(PyArray_Descr, names), RO, NULL},
+ {NULL},
+};
+
+static PyObject *
+arraydescr_subdescr_get(PyArray_Descr *self)
+{
+ if (self->subarray == NULL) {
+ Py_INCREF(Py_None);
+ return Py_None;
+ }
+ return Py_BuildValue("OO", (PyObject *)self->subarray->base,
+ self->subarray->shape);
+}
+
+static PyObject *
+arraydescr_protocol_typestr_get(PyArray_Descr *self)
+{
+ char basic_=self->kind;
+ char endian = self->byteorder;
+ int size=self->elsize;
+
+ if (endian == '=') {
+ endian = '<';
+ if (!PyArray_IsNativeByteOrder(endian)) endian = '>';
+ }
+
+ if (self->type_num == PyArray_UNICODE) {
+ size >>= 2;
+ }
+ return PyString_FromFormat("%c%c%d", endian, basic_, size);
+}
+
+static PyObject *
+arraydescr_typename_get(PyArray_Descr *self)
+{
+ int len;
+ PyTypeObject *typeobj = self->typeobj;
+ PyObject *res;
+ char *s;
+ static int prefix_len=0;
+
+ if (PyTypeNum_ISUSERDEF(self->type_num)) {
+ s = strrchr(typeobj->tp_name, '.');
+ if (s == NULL) {
+ res = PyString_FromString(typeobj->tp_name);
+ }
+ else {
+ res = PyString_FromStringAndSize(s+1, strlen(s)-1);
+ }
+ return res;
+ }
+ else {
+ if (prefix_len == 0)
+ prefix_len = strlen("numpy.");
+
+ len = strlen(typeobj->tp_name);
+ if (*(typeobj->tp_name + (len-1)) == '_')
+ len-=1;
+ len -= prefix_len;
+ res = PyString_FromStringAndSize(typeobj->tp_name+prefix_len, len);
+ }
+ if (PyTypeNum_ISFLEXIBLE(self->type_num) && self->elsize != 0) {
+ PyObject *p;
+ p = PyString_FromFormat("%d", self->elsize * 8);
+ PyString_ConcatAndDel(&res, p);
+ }
+ return res;
+}
+
+static PyObject *
+arraydescr_base_get(PyArray_Descr *self)
+{
+ if (self->subarray == NULL) {
+ Py_INCREF(self);
+ return (PyObject *)self;
+ }
+ Py_INCREF(self->subarray->base);
+ return (PyObject *)(self->subarray->base);
+}
+
+static PyObject *
+arraydescr_shape_get(PyArray_Descr *self)
+{
+ if (self->subarray == NULL) {
+ return PyTuple_New(0);
+ }
+ if (PyTuple_Check(self->subarray->shape)) {
+ Py_INCREF(self->subarray->shape);
+ return (PyObject *)(self->subarray->shape);
+ }
+ return Py_BuildValue("(O)", self->subarray->shape);
+}
+
+static PyObject *
+arraydescr_protocol_descr_get(PyArray_Descr *self)
+{
+ PyObject *dobj, *res;
+ PyObject *_numpy_internal;
+
+ if (self->names == NULL) {
+ /* get default */
+ dobj = PyTuple_New(2);
+ if (dobj == NULL) return NULL;
+ PyTuple_SET_ITEM(dobj, 0, PyString_FromString(""));
+ PyTuple_SET_ITEM(dobj, 1, \
+ arraydescr_protocol_typestr_get(self));
+ res = PyList_New(1);
+ if (res == NULL) {Py_DECREF(dobj); return NULL;}
+ PyList_SET_ITEM(res, 0, dobj);
+ return res;
+ }
+
+ _numpy_internal = PyImport_ImportModule("numpy.core._internal");
+ if (_numpy_internal == NULL) return NULL;
+ res = PyObject_CallMethod(_numpy_internal, "_array_descr",
+ "O", self);
+ Py_DECREF(_numpy_internal);
+ return res;
+}
+
+/* returns 1 for a builtin type
+ and 2 for a user-defined data-type descriptor
+ return 0 if neither (i.e. it's a copy of one)
+*/
+static PyObject *
+arraydescr_isbuiltin_get(PyArray_Descr *self)
+{
+ long val;
+ val = 0;
+ if (self->fields == Py_None) val = 1;
+ if (PyTypeNum_ISUSERDEF(self->type_num)) val = 2;
+ return PyInt_FromLong(val);
+}
+
+static int
+_arraydescr_isnative(PyArray_Descr *self)
+{
+ if (self->names == NULL) {
+ return PyArray_ISNBO(self->byteorder);
+ }
+ else {
+ PyObject *key, *value, *title=NULL;
+ PyArray_Descr *new;
+ int offset;
+ Py_ssize_t pos=0;
+ while(PyDict_Next(self->fields, &pos, &key, &value)) {
+ if (!PyArg_ParseTuple(value, "Oi|O", &new, &offset,
+ &title)) return -1;
+ if (!_arraydescr_isnative(new)) return 0;
+ }
+ }
+ return 1;
+}
+
+/* return Py_True if this data-type descriptor
+ has native byteorder if no fields are defined
+
+ or if all sub-fields have native-byteorder if
+ fields are defined
+*/
+static PyObject *
+arraydescr_isnative_get(PyArray_Descr *self)
+{
+ PyObject *ret;
+ int retval;
+ retval = _arraydescr_isnative(self);
+ if (retval == -1) return NULL;
+ ret = (retval ? Py_True : Py_False);
+ Py_INCREF(ret);
+ return ret;
+}
+
+static PyObject *
+arraydescr_fields_get(PyArray_Descr *self)
+{
+ if (self->names == NULL) {
+ Py_INCREF(Py_None);
+ return Py_None;
+ }
+ return PyDictProxy_New(self->fields);
+}
+
+static PyObject *
+arraydescr_hasobject_get(PyArray_Descr *self)
+{
+ PyObject *res;
+ if (PyDataType_FLAGCHK(self, NPY_ITEM_HASOBJECT))
+ res = Py_True;
+ else
+ res = Py_False;
+ Py_INCREF(res);
+ return res;
+}
+
+static PyGetSetDef arraydescr_getsets[] = {
+ {"subdtype",
+ (getter)arraydescr_subdescr_get,
+ NULL, NULL},
+ {"descr",
+ (getter)arraydescr_protocol_descr_get,
+ NULL, NULL},
+ {"str",
+ (getter)arraydescr_protocol_typestr_get,
+ NULL, NULL},
+ {"name",
+ (getter)arraydescr_typename_get,
+ NULL, NULL},
+ {"base",
+ (getter)arraydescr_base_get,
+ NULL, NULL},
+ {"shape",
+ (getter)arraydescr_shape_get,
+ NULL, NULL},
+ {"isbuiltin",
+ (getter)arraydescr_isbuiltin_get,
+ NULL, NULL},
+ {"isnative",
+ (getter)arraydescr_isnative_get,
+ NULL, NULL},
+ {"fields",
+ (getter)arraydescr_fields_get,
+ NULL, NULL},
+ {"hasobject",
+ (getter)arraydescr_hasobject_get,
+ NULL, NULL},
+ {NULL, NULL, NULL, NULL},
+};
+
+static PyObject *
+arraydescr_new(PyTypeObject *subtype, PyObject *args, PyObject *kwds)
+{
+ PyObject *odescr;
+ PyArray_Descr *descr, *conv;
+ Bool align=FALSE;
+ Bool copy=FALSE;
+ static char *kwlist[] = {"dtype", "align", "copy", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "O|O&O&",
+ kwlist, &odescr,
+ PyArray_BoolConverter, &align,
+ PyArray_BoolConverter, &copy))
+ return NULL;
+
+ if (align) {
+ if (!PyArray_DescrAlignConverter(odescr, &conv))
+ return NULL;
+ }
+ else if (!PyArray_DescrConverter(odescr, &conv))
+ return NULL;
+ /* Get a new copy of it unless it's already a copy */
+ if (copy && conv->fields == Py_None) {
+ descr = PyArray_DescrNew(conv);
+ Py_DECREF(conv);
+ conv = descr;
+ }
+ return (PyObject *)conv;
+}
+
+
+/* return a tuple of (callable object, args, state). */
+static PyObject *
+arraydescr_reduce(PyArray_Descr *self, PyObject *args)
+{
+ /* version number of this pickle type. Increment if we need to
+ change the format. Be sure to handle the old versions in
+ arraydescr_setstate. */
+ const int version = 3;
+ PyObject *ret, *mod, *obj;
+ PyObject *state;
+ char endian;
+ int elsize, alignment;
+
+ ret = PyTuple_New(3);
+ if (ret == NULL) return NULL;
+ mod = PyImport_ImportModule("numpy.core.multiarray");
+ if (mod == NULL) {Py_DECREF(ret); return NULL;}
+ obj = PyObject_GetAttrString(mod, "dtype");
+ Py_DECREF(mod);
+ if (obj == NULL) {Py_DECREF(ret); return NULL;}
+ PyTuple_SET_ITEM(ret, 0, obj);
+ if (PyTypeNum_ISUSERDEF(self->type_num) || \
+ ((self->type_num == PyArray_VOID && \
+ self->typeobj != &PyVoidArrType_Type))) {
+ obj = (PyObject *)self->typeobj;
+ Py_INCREF(obj);
+ }
+ else {
+ elsize = self->elsize;
+ if (self->type_num == PyArray_UNICODE) {
+ elsize >>= 2;
+ }
+ obj = PyString_FromFormat("%c%d",self->kind, elsize);
+ }
+ PyTuple_SET_ITEM(ret, 1, Py_BuildValue("(Nii)", obj, 0, 1));
+
+ /* Now return the state which is at least
+ byteorder, subarray, and fields */
+ endian = self->byteorder;
+ if (endian == '=') {
+ endian = '<';
+ if (!PyArray_IsNativeByteOrder(endian)) endian = '>';
+ }
+ state = PyTuple_New(8);
+ PyTuple_SET_ITEM(state, 0, PyInt_FromLong(version));
+ PyTuple_SET_ITEM(state, 1, PyString_FromFormat("%c", endian));
+ PyTuple_SET_ITEM(state, 2, arraydescr_subdescr_get(self));
+ if (self->names) {
+ Py_INCREF(self->names);
+ Py_INCREF(self->fields);
+ PyTuple_SET_ITEM(state, 3, self->names);
+ PyTuple_SET_ITEM(state, 4, self->fields);
+ }
+ else {
+ PyTuple_SET_ITEM(state, 3, Py_None);
+ PyTuple_SET_ITEM(state, 4, Py_None);
+ Py_INCREF(Py_None);
+ Py_INCREF(Py_None);
+ }
+
+ /* for extended types it also includes elsize and alignment */
+ if (PyTypeNum_ISEXTENDED(self->type_num)) {
+ elsize = self->elsize;
+ alignment = self->alignment;
+ }
+ else {elsize = -1; alignment = -1;}
+
+ PyTuple_SET_ITEM(state, 5, PyInt_FromLong(elsize));
+ PyTuple_SET_ITEM(state, 6, PyInt_FromLong(alignment));
+ PyTuple_SET_ITEM(state, 7, PyInt_FromLong(self->hasobject));
+
+ PyTuple_SET_ITEM(ret, 2, state);
+ return ret;
+}
+
+/* returns 1 if this data-type has an object portion
+ used when setting the state because hasobject is not stored.
+ */
+static int
+_descr_find_object(PyArray_Descr *self)
+{
+ if (self->hasobject || self->type_num == PyArray_OBJECT ||
+ self->kind == 'O')
+ return NPY_OBJECT_DTYPE_FLAGS;
+ if (PyDescr_HASFIELDS(self)) {
+ PyObject *key, *value, *title=NULL;
+ PyArray_Descr *new;
+ int offset;
+ Py_ssize_t pos=0;
+ while (PyDict_Next(self->fields, &pos, &key, &value)) {
+ if (!PyArg_ParseTuple(value, "Oi|O", &new, &offset,
+ &title)) {
+ PyErr_Clear();
+ return 0;
+ }
+ if (_descr_find_object(new)) {
+ new->hasobject = NPY_OBJECT_DTYPE_FLAGS;
+ return NPY_OBJECT_DTYPE_FLAGS;
+ }
+ }
+ }
+ return 0;
+}
+
+/* state is at least byteorder, subarray, and fields but could include elsize
+ and alignment for EXTENDED arrays
+*/
+
+static PyObject *
+arraydescr_setstate(PyArray_Descr *self, PyObject *args)
+{
+ int elsize = -1, alignment = -1;
+ int version = 3;
+ char endian;
+ PyObject *subarray, *fields, *names=NULL;
+ int incref_names = 1;
+ int dtypeflags=0;
+
+ if (self->fields == Py_None) {Py_INCREF(Py_None); return Py_None;}
+
+ if (PyTuple_GET_SIZE(args) != 1 ||
+ !(PyTuple_Check(PyTuple_GET_ITEM(args, 0)))) {
+ PyErr_BadInternalCall();
+ return NULL;
+ }
+ switch (PyTuple_GET_SIZE(PyTuple_GET_ITEM(args,0))) {
+ case 8:
+ if (!PyArg_ParseTuple(args, "(icOOOiii)", &version, &endian,
+ &subarray, &names, &fields, &elsize,
+ &alignment, &dtypeflags)) {
+ return NULL;
+ }
+ break;
+ case 7:
+ if (!PyArg_ParseTuple(args, "(icOOOii)", &version, &endian,
+ &subarray, &names, &fields, &elsize,
+ &alignment)) {
+ return NULL;
+ }
+ break;
+ case 6:
+ if (!PyArg_ParseTuple(args, "(icOOii)", &version,
+ &endian, &subarray, &fields,
+ &elsize, &alignment)) {
+ PyErr_Clear();
+ }
+ break;
+ case 5:
+ version = 0;
+ if (!PyArg_ParseTuple(args, "(cOOii)",
+ &endian, &subarray, &fields, &elsize,
+ &alignment)) {
+ return NULL;
+ }
+ break;
+ default:
+ version = -1; /* raise an error */
+ }
+
+ /* If we ever need another pickle format, increment the version
+ number. But we should still be able to handle the old versions.
+ */
+ if (version < 0 || version > 3) {
+ PyErr_Format(PyExc_ValueError,
+ "can't handle version %d of numpy.dtype pickle",
+ version);
+ return NULL;
+ }
+
+ if (version == 1 || version == 0) {
+ if (fields != Py_None) {
+ PyObject *key, *list;
+ key = PyInt_FromLong(-1);
+ list = PyDict_GetItem(fields, key);
+ if (!list) return NULL;
+ Py_INCREF(list);
+ names = list;
+ PyDict_DelItem(fields, key);
+ incref_names = 0;
+ }
+ else {
+ names = Py_None;
+ }
+ }
+
+
+ if ((fields == Py_None && names != Py_None) || \
+ (names == Py_None && fields != Py_None)) {
+ PyErr_Format(PyExc_ValueError,
+ "inconsistent fields and names");
+ return NULL;
+ }
+
+ if (endian != '|' &&
+ PyArray_IsNativeByteOrder(endian)) endian = '=';
+
+ self->byteorder = endian;
+ if (self->subarray) {
+ Py_XDECREF(self->subarray->base);
+ Py_XDECREF(self->subarray->shape);
+ _pya_free(self->subarray);
+ }
+ self->subarray = NULL;
+
+ if (subarray != Py_None) {
+ self->subarray = _pya_malloc(sizeof(PyArray_ArrayDescr));
+ self->subarray->base = (PyArray_Descr *)PyTuple_GET_ITEM(subarray, 0);
+ Py_INCREF(self->subarray->base);
+ self->subarray->shape = PyTuple_GET_ITEM(subarray, 1);
+ Py_INCREF(self->subarray->shape);
+ }
+
+ if (fields != Py_None) {
+ Py_XDECREF(self->fields);
+ self->fields = fields;
+ Py_INCREF(fields);
+ Py_XDECREF(self->names);
+ self->names = names;
+ if (incref_names)
+ Py_INCREF(names);
+ }
+
+ if (PyTypeNum_ISEXTENDED(self->type_num)) {
+ self->elsize = elsize;
+ self->alignment = alignment;
+ }
+
+ self->hasobject = dtypeflags;
+ if (version < 3) {
+ self->hasobject = _descr_find_object(self);
+ }
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+/* returns a copy of the PyArray_Descr structure with the byteorder
+ altered:
+ no arguments: The byteorder is swapped (in all subfields as well)
+ single argument: The byteorder is forced to the given state
+ (in all subfields as well)
+
+ Valid states: ('big', '>') or ('little' or '<')
+ ('native', or '=')
+
+ If a descr structure with | is encountered it's own
+ byte-order is not changed but any fields are:
+*/
+
+/*OBJECT_API
+ Deep bytorder change of a data-type descriptor
+ *** Leaves reference count of self unchanged --- does not DECREF self ***
+*/
+static PyArray_Descr *
+PyArray_DescrNewByteorder(PyArray_Descr *self, char newendian)
+{
+ PyArray_Descr *new;
+ char endian;
+
+ new = PyArray_DescrNew(self);
+ endian = new->byteorder;
+ if (endian != PyArray_IGNORE) {
+ if (newendian == PyArray_SWAP) { /* swap byteorder */
+ if PyArray_ISNBO(endian) endian = PyArray_OPPBYTE;
+ else endian = PyArray_NATBYTE;
+ new->byteorder = endian;
+ }
+ else if (newendian != PyArray_IGNORE) {
+ new->byteorder = newendian;
+ }
+ }
+ if (new->names) {
+ PyObject *newfields;
+ PyObject *key, *value;
+ PyObject *newvalue;
+ PyObject *old;
+ PyArray_Descr *newdescr;
+ Py_ssize_t pos = 0;
+ int len, i;
+ newfields = PyDict_New();
+ /* make new dictionary with replaced */
+ /* PyArray_Descr Objects */
+ while(PyDict_Next(self->fields, &pos, &key, &value)) {
+ if (!PyString_Check(key) || \
+ !PyTuple_Check(value) || \
+ ((len=PyTuple_GET_SIZE(value)) < 2))
+ continue;
+
+ old = PyTuple_GET_ITEM(value, 0);
+ if (!PyArray_DescrCheck(old)) continue;
+ newdescr = PyArray_DescrNewByteorder \
+ ((PyArray_Descr *)old, newendian);
+ if (newdescr == NULL) {
+ Py_DECREF(newfields); Py_DECREF(new);
+ return NULL;
+ }
+ newvalue = PyTuple_New(len);
+ PyTuple_SET_ITEM(newvalue, 0, \
+ (PyObject *)newdescr);
+ for(i=1; i<len; i++) {
+ old = PyTuple_GET_ITEM(value, i);
+ Py_INCREF(old);
+ PyTuple_SET_ITEM(newvalue, i, old);
+ }
+ PyDict_SetItem(newfields, key, newvalue);
+ Py_DECREF(newvalue);
+ }
+ Py_DECREF(new->fields);
+ new->fields = newfields;
+ }
+ if (new->subarray) {
+ Py_DECREF(new->subarray->base);
+ new->subarray->base = PyArray_DescrNewByteorder \
+ (self->subarray->base, newendian);
+ }
+ return new;
+}
+
+
+static PyObject *
+arraydescr_newbyteorder(PyArray_Descr *self, PyObject *args)
+{
+ char endian=PyArray_SWAP;
+
+ if (!PyArg_ParseTuple(args, "|O&", PyArray_ByteorderConverter,
+ &endian)) return NULL;
+
+ return (PyObject *)PyArray_DescrNewByteorder(self, endian);
+}
+
+static PyMethodDef arraydescr_methods[] = {
+ /* for pickling */
+ {"__reduce__", (PyCFunction)arraydescr_reduce, METH_VARARGS,
+ NULL},
+ {"__setstate__", (PyCFunction)arraydescr_setstate, METH_VARARGS,
+ NULL},
+ {"newbyteorder", (PyCFunction)arraydescr_newbyteorder, METH_VARARGS,
+ NULL},
+ {NULL, NULL} /* sentinel */
+};
+
+static PyObject *
+arraydescr_str(PyArray_Descr *self)
+{
+ PyObject *sub;
+
+ if (self->names) {
+ PyObject *lst;
+ lst = arraydescr_protocol_descr_get(self);
+ if (!lst) {
+ sub = PyString_FromString("<err>");
+ PyErr_Clear();
+ }
+ else sub = PyObject_Str(lst);
+ Py_XDECREF(lst);
+ if (self->type_num != PyArray_VOID) {
+ PyObject *p;
+ PyObject *t=PyString_FromString("'");
+ p = arraydescr_protocol_typestr_get(self);
+ PyString_Concat(&p, t);
+ PyString_ConcatAndDel(&t, p);
+ p = PyString_FromString("(");
+ PyString_ConcatAndDel(&p, t);
+ PyString_ConcatAndDel(&p, PyString_FromString(", "));
+ PyString_ConcatAndDel(&p, sub);
+ PyString_ConcatAndDel(&p, PyString_FromString(")"));
+ sub = p;
+ }
+ }
+ else if (self->subarray) {
+ PyObject *p;
+ PyObject *t = PyString_FromString("(");
+ PyObject *sh;
+ p = arraydescr_str(self->subarray->base);
+ if (!self->subarray->base->names && !self->subarray->base->subarray) {
+ PyObject *t=PyString_FromString("'");
+ PyString_Concat(&p, t);
+ PyString_ConcatAndDel(&t, p);
+ p = t;
+ }
+ PyString_ConcatAndDel(&t, p);
+ PyString_ConcatAndDel(&t, PyString_FromString(","));
+ if (!PyTuple_Check(self->subarray->shape)) {
+ sh = Py_BuildValue("(O)", self->subarray->shape);
+ }
+ else {
+ sh = self->subarray->shape;
+ Py_INCREF(sh);
+ }
+ PyString_ConcatAndDel(&t, PyObject_Str(sh));
+ Py_DECREF(sh);
+ PyString_ConcatAndDel(&t, PyString_FromString(")"));
+ sub = t;
+ }
+ else if (PyDataType_ISFLEXIBLE(self) || !PyArray_ISNBO(self->byteorder)) {
+ sub = arraydescr_protocol_typestr_get(self);
+ }
+ else {
+ sub = arraydescr_typename_get(self);
+ }
+ return sub;
+}
+
+static PyObject *
+arraydescr_repr(PyArray_Descr *self)
+{
+ PyObject *sub, *s;
+ s = PyString_FromString("dtype(");
+ sub = arraydescr_str(self);
+ if (!self->names && !self->subarray) {
+ PyObject *t=PyString_FromString("'");
+ PyString_Concat(&sub, t);
+ PyString_ConcatAndDel(&t, sub);
+ sub = t;
+ }
+ PyString_ConcatAndDel(&s, sub);
+ sub = PyString_FromString(")");
+ PyString_ConcatAndDel(&s, sub);
+ return s;
+}
+
+static PyObject *
+arraydescr_richcompare(PyArray_Descr *self, PyObject *other, int cmp_op)
+{
+ PyArray_Descr *new=NULL;
+ PyObject *result = Py_NotImplemented;
+ if (!PyArray_DescrCheck(other)) {
+ if (PyArray_DescrConverter(other, &new) == PY_FAIL)
+ return NULL;
+ }
+ else {
+ new = (PyArray_Descr *)other;
+ Py_INCREF(new);
+ }
+ switch (cmp_op) {
+ case Py_LT:
+ if (!PyArray_EquivTypes(self, new) && PyArray_CanCastTo(self, new))
+ result = Py_True;
+ else
+ result = Py_False;
+ break;
+ case Py_LE:
+ if (PyArray_CanCastTo(self, new))
+ result = Py_True;
+ else
+ result = Py_False;
+ break;
+ case Py_EQ:
+ if (PyArray_EquivTypes(self, new))
+ result = Py_True;
+ else
+ result = Py_False;
+ break;
+ case Py_NE:
+ if (PyArray_EquivTypes(self, new))
+ result = Py_False;
+ else
+ result = Py_True;
+ break;
+ case Py_GT:
+ if (!PyArray_EquivTypes(self, new) && PyArray_CanCastTo(new, self))
+ result = Py_True;
+ else
+ result = Py_False;
+ break;
+ case Py_GE:
+ if (PyArray_CanCastTo(new, self))
+ result = Py_True;
+ else
+ result = Py_False;
+ break;
+ default:
+ result = Py_NotImplemented;
+ }
+
+ Py_XDECREF(new);
+ Py_INCREF(result);
+ return result;
+}
+
+/*************************************************************************
+ **************** Implement Mapping Protocol ***************************
+ *************************************************************************/
+
+static Py_ssize_t
+descr_length(PyObject *self0)
+{
+
+ PyArray_Descr *self = (PyArray_Descr *)self0;
+
+ if (self->names)
+ return PyTuple_GET_SIZE(self->names);
+ else return 0;
+}
+
+static PyObject *
+descr_repeat(PyObject *self, Py_ssize_t length)
+{
+ PyObject *tup;
+ PyArray_Descr *new;
+ if (length < 0)
+ return PyErr_Format(PyExc_ValueError,
+#if (PY_VERSION_HEX < 0x02050000)
+ "Array length must be >= 0, not %d",
+#else
+ "Array length must be >= 0, not %zd",
+#endif
+ length);
+ tup = Py_BuildValue("O" NPY_SSIZE_T_PYFMT, self, length);
+ if (tup == NULL) return NULL;
+ PyArray_DescrConverter(tup, &new);
+ Py_DECREF(tup);
+ return (PyObject *)new;
+}
+
+static PyObject *
+descr_subscript(PyArray_Descr *self, PyObject *op)
+{
+
+ if (self->names) {
+ if (PyString_Check(op) || PyUnicode_Check(op)) {
+ PyObject *obj;
+ obj = PyDict_GetItem(self->fields, op);
+ if (obj != NULL) {
+ PyObject *descr;
+ descr = PyTuple_GET_ITEM(obj, 0);
+ Py_INCREF(descr);
+ return descr;
+ }
+ else {
+ PyErr_Format(PyExc_KeyError,
+ "field named \'%s\' not found.",
+ PyString_AsString(op));
+ }
+ }
+ else {
+ PyObject *name;
+ int value;
+ value = PyArray_PyIntAsInt(op);
+ if (!PyErr_Occurred()) {
+ int size;
+ size = PyTuple_GET_SIZE(self->names);
+ if (value < 0) value += size;
+ if (value < 0 || value >= size) {
+ PyErr_Format(PyExc_IndexError,
+ "0<=index<%d not %d",
+ size, value);
+ return NULL;
+ }
+ name = PyTuple_GET_ITEM(self->names, value);
+ return descr_subscript(self, name);
+ }
+ }
+ PyErr_SetString(PyExc_ValueError,
+ "only integers, strings or unicode values "
+ "allowed for getting fields.");
+ }
+ else {
+ PyObject *astr;
+ astr = arraydescr_str(self);
+ PyErr_Format(PyExc_KeyError,
+ "there are no fields in dtype %s.",
+ PyString_AsString(astr));
+ Py_DECREF(astr);
+ }
+ return NULL;
+}
+
+static PySequenceMethods descr_as_sequence = {
+ descr_length,
+ (binaryfunc)NULL,
+ descr_repeat,
+};
+
+static PyMappingMethods descr_as_mapping = {
+ descr_length, /*mp_length*/
+ (binaryfunc)descr_subscript, /*mp_subscript*/
+ (objobjargproc)NULL, /*mp_ass_subscript*/
+};
+
+/****************** End of Mapping Protocol ******************************/
+
+
+static PyTypeObject PyArrayDescr_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0, /* ob_size */
+ "numpy.dtype", /* tp_name */
+ sizeof(PyArray_Descr), /* tp_basicsize */
+ 0, /* tp_itemsize */
+ /* methods */
+ (destructor)arraydescr_dealloc, /* tp_dealloc */
+ 0, /* tp_print */
+ 0, /* tp_getattr */
+ 0, /* tp_setattr */
+ 0, /* tp_compare */
+ (reprfunc)arraydescr_repr, /* tp_repr */
+ 0, /* tp_as_number */
+ &descr_as_sequence, /* tp_as_sequence */
+ &descr_as_mapping, /* tp_as_mapping */
+ 0, /* tp_hash */
+ 0, /* tp_call */
+ (reprfunc)arraydescr_str, /* tp_str */
+ 0, /* tp_getattro */
+ 0, /* tp_setattro */
+ 0, /* tp_as_buffer */
+ Py_TPFLAGS_DEFAULT, /* tp_flags */
+ 0, /* tp_doc */
+ 0, /* tp_traverse */
+ 0, /* tp_clear */
+ (richcmpfunc)arraydescr_richcompare, /* tp_richcompare */
+ 0, /* tp_weaklistoffset */
+ 0, /* tp_iter */
+ 0, /* tp_iternext */
+ arraydescr_methods, /* tp_methods */
+ arraydescr_members, /* tp_members */
+ arraydescr_getsets, /* tp_getset */
+ 0, /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
+ 0, /* tp_dictoffset */
+ 0, /* tp_init */
+ 0, /* tp_alloc */
+ arraydescr_new, /* tp_new */
+ 0, /* tp_free */
+ 0, /* tp_is_gc */
+ 0, /* tp_bases */
+ 0, /* tp_mro */
+ 0, /* tp_cache */
+ 0, /* tp_subclasses */
+ 0 /* tp_weaklist */
+};
+
+
+/** Array Flags Object **/
+
+/*OBJECT_API
+ Get New ArrayFlagsObject
+*/
+static PyObject *
+PyArray_NewFlagsObject(PyObject *obj)
+{
+ PyObject *flagobj;
+ int flags;
+ if (obj == NULL) {
+ flags = CONTIGUOUS | OWNDATA | FORTRAN | ALIGNED;
+ }
+ else {
+ flags = PyArray_FLAGS(obj);
+ }
+ flagobj = PyArrayFlags_Type.tp_alloc(&PyArrayFlags_Type, 0);
+ if (flagobj == NULL) return NULL;
+ Py_XINCREF(obj);
+ ((PyArrayFlagsObject *)flagobj)->arr = obj;
+ ((PyArrayFlagsObject *)flagobj)->flags = flags;
+
+ return flagobj;
+}
+
+static void
+arrayflags_dealloc(PyArrayFlagsObject *self)
+{
+ Py_XDECREF(self->arr);
+ self->ob_type->tp_free((PyObject *)self);
+}
+
+
+#define _define_get(UPPER, lower) \
+static PyObject * \
+arrayflags_ ## lower ## _get(PyArrayFlagsObject *self) \
+{ \
+ PyObject *item; \
+ item = ((self->flags & (UPPER)) == (UPPER)) ? Py_True : Py_False; \
+ Py_INCREF(item); \
+ return item; \
+}
+
+_define_get(CONTIGUOUS, contiguous)
+_define_get(FORTRAN, fortran)
+_define_get(UPDATEIFCOPY, updateifcopy)
+_define_get(OWNDATA, owndata)
+_define_get(ALIGNED, aligned)
+_define_get(WRITEABLE, writeable)
+
+_define_get(ALIGNED|WRITEABLE, behaved)
+_define_get(ALIGNED|WRITEABLE|CONTIGUOUS, carray)
+
+static PyObject *
+arrayflags_forc_get(PyArrayFlagsObject *self)
+{
+ PyObject *item;
+
+ if (((self->flags & FORTRAN) == FORTRAN) ||
+ ((self->flags & CONTIGUOUS) == CONTIGUOUS))
+ item = Py_True;
+ else
+ item = Py_False;
+
+ Py_INCREF(item);
+ return item;
+}
+
+static PyObject *
+arrayflags_fnc_get(PyArrayFlagsObject *self)
+{
+ PyObject *item;
+
+ if (((self->flags & FORTRAN) == FORTRAN) &&
+ !((self->flags & CONTIGUOUS) == CONTIGUOUS))
+ item = Py_True;
+ else
+ item = Py_False;
+
+ Py_INCREF(item);
+ return item;
+}
+
+static PyObject *
+arrayflags_farray_get(PyArrayFlagsObject *self)
+{
+ PyObject *item;
+
+ if (((self->flags & (ALIGNED|WRITEABLE|FORTRAN)) == \
+ (ALIGNED|WRITEABLE|FORTRAN)) &&
+ !((self->flags & CONTIGUOUS) == CONTIGUOUS))
+ item = Py_True;
+ else
+ item = Py_False;
+
+ Py_INCREF(item);
+ return item;
+}
+
+static PyObject *
+arrayflags_num_get(PyArrayFlagsObject *self)
+{
+ return PyInt_FromLong(self->flags);
+}
+
+/* relies on setflags order being write, align, uic */
+static int
+arrayflags_updateifcopy_set(PyArrayFlagsObject *self, PyObject *obj)
+{
+ PyObject *res;
+ if (self->arr == NULL) {
+ PyErr_SetString(PyExc_ValueError, "Cannot set flags on array scalars.");
+ return -1;
+ }
+ res = PyObject_CallMethod(self->arr, "setflags", "OOO", Py_None, Py_None,
+ (PyObject_IsTrue(obj) ? Py_True : Py_False));
+ if (res == NULL) return -1;
+ Py_DECREF(res);
+ return 0;
+}
+
+static int
+arrayflags_aligned_set(PyArrayFlagsObject *self, PyObject *obj)
+{
+ PyObject *res;
+ if (self->arr == NULL) {
+ PyErr_SetString(PyExc_ValueError, "Cannot set flags on array scalars.");
+ return -1;
+ }
+ res = PyObject_CallMethod(self->arr, "setflags", "OOO", Py_None,
+ (PyObject_IsTrue(obj) ? Py_True : Py_False),
+ Py_None);
+ if (res == NULL) return -1;
+ Py_DECREF(res);
+ return 0;
+}
+
+static int
+arrayflags_writeable_set(PyArrayFlagsObject *self, PyObject *obj)
+{
+ PyObject *res;
+ if (self->arr == NULL) {
+ PyErr_SetString(PyExc_ValueError, "Cannot set flags on array scalars.");
+ return -1;
+ }
+ res = PyObject_CallMethod(self->arr, "setflags", "OOO",
+ (PyObject_IsTrue(obj) ? Py_True : Py_False),
+ Py_None, Py_None);
+ if (res == NULL) return -1;
+ Py_DECREF(res);
+ return 0;
+}
+
+
+static PyGetSetDef arrayflags_getsets[] = {
+ {"contiguous",
+ (getter)arrayflags_contiguous_get,
+ NULL,
+ ""},
+ {"c_contiguous",
+ (getter)arrayflags_contiguous_get,
+ NULL,
+ ""},
+ {"f_contiguous",
+ (getter)arrayflags_fortran_get,
+ NULL,
+ ""},
+ {"fortran",
+ (getter)arrayflags_fortran_get,
+ NULL,
+ ""},
+ {"updateifcopy",
+ (getter)arrayflags_updateifcopy_get,
+ (setter)arrayflags_updateifcopy_set,
+ ""},
+ {"owndata",
+ (getter)arrayflags_owndata_get,
+ NULL,
+ ""},
+ {"aligned",
+ (getter)arrayflags_aligned_get,
+ (setter)arrayflags_aligned_set,
+ ""},
+ {"writeable",
+ (getter)arrayflags_writeable_get,
+ (setter)arrayflags_writeable_set,
+ ""},
+ {"fnc",
+ (getter)arrayflags_fnc_get,
+ NULL,
+ ""},
+ {"forc",
+ (getter)arrayflags_forc_get,
+ NULL,
+ ""},
+ {"behaved",
+ (getter)arrayflags_behaved_get,
+ NULL,
+ ""},
+ {"carray",
+ (getter)arrayflags_carray_get,
+ NULL,
+ ""},
+ {"farray",
+ (getter)arrayflags_farray_get,
+ NULL,
+ ""},
+ {"num",
+ (getter)arrayflags_num_get,
+ NULL,
+ ""},
+ {NULL, NULL, NULL, NULL},
+};
+
+static PyObject *
+arrayflags_getitem(PyArrayFlagsObject *self, PyObject *ind)
+{
+ char *key;
+ int n;
+ if (!PyString_Check(ind)) goto fail;
+ key = PyString_AS_STRING(ind);
+ n = PyString_GET_SIZE(ind);
+ switch(n) {
+ case 1:
+ switch(key[0]) {
+ case 'C':
+ return arrayflags_contiguous_get(self);
+ case 'F':
+ return arrayflags_fortran_get(self);
+ case 'W':
+ return arrayflags_writeable_get(self);
+ case 'B':
+ return arrayflags_behaved_get(self);
+ case 'O':
+ return arrayflags_owndata_get(self);
+ case 'A':
+ return arrayflags_aligned_get(self);
+ case 'U':
+ return arrayflags_updateifcopy_get(self);
+ default:
+ goto fail;
+ }
+ break;
+ case 2:
+ if (strncmp(key, "CA", n)==0)
+ return arrayflags_carray_get(self);
+ if (strncmp(key, "FA", n)==0)
+ return arrayflags_farray_get(self);
+ break;
+ case 3:
+ if (strncmp(key, "FNC", n)==0)
+ return arrayflags_fnc_get(self);
+ break;
+ case 4:
+ if (strncmp(key, "FORC", n)==0)
+ return arrayflags_forc_get(self);
+ break;
+ case 6:
+ if (strncmp(key, "CARRAY", n)==0)
+ return arrayflags_carray_get(self);
+ if (strncmp(key, "FARRAY", n)==0)
+ return arrayflags_farray_get(self);
+ break;
+ case 7:
+ if (strncmp(key,"FORTRAN",n)==0)
+ return arrayflags_fortran_get(self);
+ if (strncmp(key,"BEHAVED",n)==0)
+ return arrayflags_behaved_get(self);
+ if (strncmp(key,"OWNDATA",n)==0)
+ return arrayflags_owndata_get(self);
+ if (strncmp(key,"ALIGNED",n)==0)
+ return arrayflags_aligned_get(self);
+ break;
+ case 9:
+ if (strncmp(key,"WRITEABLE",n)==0)
+ return arrayflags_writeable_get(self);
+ break;
+ case 10:
+ if (strncmp(key,"CONTIGUOUS",n)==0)
+ return arrayflags_contiguous_get(self);
+ break;
+ case 12:
+ if (strncmp(key, "UPDATEIFCOPY", n)==0)
+ return arrayflags_updateifcopy_get(self);
+ if (strncmp(key, "C_CONTIGUOUS", n)==0)
+ return arrayflags_contiguous_get(self);
+ if (strncmp(key, "F_CONTIGUOUS", n)==0)
+ return arrayflags_fortran_get(self);
+ break;
+ }
+
+ fail:
+ PyErr_SetString(PyExc_KeyError, "Unknown flag");
+ return NULL;
+}
+
+static int
+arrayflags_setitem(PyArrayFlagsObject *self, PyObject *ind, PyObject *item)
+{
+ char *key;
+ int n;
+ if (!PyString_Check(ind)) goto fail;
+ key = PyString_AS_STRING(ind);
+ n = PyString_GET_SIZE(ind);
+ if (((n==9) && (strncmp(key, "WRITEABLE", n)==0)) ||
+ ((n==1) && (strncmp(key, "W", n)==0)))
+ return arrayflags_writeable_set(self, item);
+ else if (((n==7) && (strncmp(key, "ALIGNED", n)==0)) ||
+ ((n==1) && (strncmp(key, "A", n)==0)))
+ return arrayflags_aligned_set(self, item);
+ else if (((n==12) && (strncmp(key, "UPDATEIFCOPY", n)==0)) ||
+ ((n==1) && (strncmp(key, "U", n)==0)))
+ return arrayflags_updateifcopy_set(self, item);
+
+fail:
+ PyErr_SetString(PyExc_KeyError, "Unknown flag");
+ return -1;
+}
+
+static char *
+_torf_(int flags, int val)
+{
+ if ((flags & val) == val) return "True";
+ else return "False";
+}
+
+static PyObject *
+arrayflags_print(PyArrayFlagsObject *self)
+{
+ int fl = self->flags;
+
+ return PyString_FromFormat(" %s : %s\n %s : %s\n %s : %s\n"\
+ " %s : %s\n %s : %s\n %s : %s",
+ "C_CONTIGUOUS", _torf_(fl, CONTIGUOUS),
+ "F_CONTIGUOUS", _torf_(fl, FORTRAN),
+ "OWNDATA", _torf_(fl, OWNDATA),
+ "WRITEABLE", _torf_(fl, WRITEABLE),
+ "ALIGNED", _torf_(fl, ALIGNED),
+ "UPDATEIFCOPY", _torf_(fl, UPDATEIFCOPY));
+}
+
+
+static int
+arrayflags_compare(PyArrayFlagsObject *self, PyArrayFlagsObject *other)
+{
+ if (self->flags == other->flags)
+ return 0;
+ else if (self->flags < other->flags)
+ return -1;
+ else
+ return 1;
+}
+
+static PyMappingMethods arrayflags_as_mapping = {
+#if PY_VERSION_HEX >= 0x02050000
+ (lenfunc)NULL, /*mp_length*/
+#else
+ (inquiry)NULL, /*mp_length*/
+#endif
+ (binaryfunc)arrayflags_getitem, /*mp_subscript*/
+ (objobjargproc)arrayflags_setitem, /*mp_ass_subscript*/
+};
+
+
+static PyObject *
+arrayflags_new(PyTypeObject *self, PyObject *args, PyObject *kwds)
+{
+ PyObject *arg=NULL;
+ if (!PyArg_UnpackTuple(args, "flagsobj", 0, 1, &arg))
+ return NULL;
+
+ if ((arg != NULL) && PyArray_Check(arg)) {
+ return PyArray_NewFlagsObject(arg);
+ }
+ else {
+ return PyArray_NewFlagsObject(NULL);
+ }
+}
+
+static PyTypeObject PyArrayFlags_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0,
+ "numpy.flagsobj",
+ sizeof(PyArrayFlagsObject),
+ 0, /* tp_itemsize */
+ /* methods */
+ (destructor)arrayflags_dealloc, /* tp_dealloc */
+ 0, /* tp_print */
+ 0, /* tp_getattr */
+ 0, /* tp_setattr */
+ (cmpfunc)arrayflags_compare, /* tp_compare */
+ (reprfunc)arrayflags_print, /* tp_repr */
+ 0, /* tp_as_number */
+ 0, /* tp_as_sequence */
+ &arrayflags_as_mapping, /* tp_as_mapping */
+ 0, /* tp_hash */
+ 0, /* tp_call */
+ (reprfunc)arrayflags_print, /* tp_str */
+ 0, /* tp_getattro */
+ 0, /* tp_setattro */
+ 0, /* tp_as_buffer */
+ Py_TPFLAGS_DEFAULT, /* tp_flags */
+ 0, /* tp_doc */
+ 0, /* tp_traverse */
+ 0, /* tp_clear */
+ 0, /* tp_richcompare */
+ 0, /* tp_weaklistoffset */
+ 0, /* tp_iter */
+ 0, /* tp_iternext */
+ 0, /* tp_methods */
+ 0, /* tp_members */
+ arrayflags_getsets, /* tp_getset */
+ 0, /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
+ 0, /* tp_dictoffset */
+ 0, /* tp_init */
+ 0, /* tp_alloc */
+ arrayflags_new, /* tp_new */
+ 0, /* tp_free */
+ 0, /* tp_is_gc */
+ 0, /* tp_bases */
+ 0, /* tp_mro */
+ 0, /* tp_cache */
+ 0, /* tp_subclasses */
+ 0 /* tp_weaklist */
+};
diff --git a/numpy/core/src/arraytypes.inc.src b/numpy/core/src/arraytypes.inc.src
new file mode 100644
index 000000000..3ebc52f05
--- /dev/null
+++ b/numpy/core/src/arraytypes.inc.src
@@ -0,0 +1,2461 @@
+/* -*- c -*- */
+
+static longlong
+MyPyLong_AsLongLong(PyObject *vv)
+{
+ longlong ret;
+
+ if (!PyLong_Check(vv)) {
+ PyObject *mylong;
+ mylong = PyNumber_Long(vv);
+ if (mylong == NULL) return (longlong) -1;
+ vv = mylong;
+ }
+ else Py_INCREF(vv);
+
+ ret = PyLong_AsLongLong(vv);
+ Py_DECREF(vv);
+ return ret;
+}
+
+static ulong
+MyPyLong_AsUnsignedLong(PyObject *vv)
+{
+ longlong val;
+
+ if (!PyLong_Check(vv)) {
+ PyObject *mylong;
+ mylong = PyNumber_Long(vv);
+ if (mylong == NULL) return (ulong) -1;
+ vv = mylong;
+ }
+ else Py_INCREF(vv);
+
+ val = PyLong_AsLongLong(vv);
+ Py_DECREF(vv);
+ return (ulong) val;
+}
+
+static ulonglong
+MyPyLong_AsUnsignedLongLong(PyObject *vv)
+{
+ ulonglong ret;
+
+ if (!PyLong_Check(vv)) {
+ PyObject *mylong;
+ mylong = PyNumber_Long(vv);
+ if (mylong == NULL) return (ulonglong) -1;
+ vv = mylong;
+ }
+ else Py_INCREF(vv);
+
+ ret = PyLong_AsUnsignedLongLong(vv);
+ if (PyErr_Occurred()) {
+ longlong new;
+ PyErr_Clear();
+ new = PyLong_AsLongLong(vv);
+ if (!PyErr_Occurred() && new < 0)
+ ret = (ulonglong) new;
+ ret = NPY_MAX_ULONGLONG;
+ }
+ Py_DECREF(vv);
+ return ret;
+}
+
+
+static double
+_getNAN(void) {
+#ifdef NAN
+ return NAN;
+#else
+ static double nan=0;
+
+ if (nan == 0) {
+ double mul = 1e100;
+ double tmp = 0.0;
+ double pinf=0;
+ pinf = mul;
+ for (;;) {
+ pinf *= mul;
+ if (pinf == tmp) break;
+ tmp = pinf;
+ }
+ nan = pinf / pinf;
+ }
+ return nan;
+#endif
+}
+
+static double
+MyPyFloat_AsDouble(PyObject *obj)
+{
+ if (obj == Py_None) return _getNAN();
+ return PyFloat_AsDouble(obj);
+}
+
+
+/****************** getitem and setitem **********************/
+
+/**begin repeat
+
+#TYP=BOOL,BYTE,UBYTE,SHORT,USHORT,INT,LONG,UINT,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE#
+#func1=PyBool_FromLong, PyInt_FromLong*6, PyLong_FromUnsignedLong*2, PyLong_FromLongLong, PyLong_FromUnsignedLongLong, PyFloat_FromDouble*2#
+#func2=PyObject_IsTrue, PyInt_AsLong*6, MyPyLong_AsUnsignedLong*2, MyPyLong_AsLongLong, MyPyLong_AsUnsignedLongLong, MyPyFloat_AsDouble*2#
+#typ=Bool, byte, ubyte, short, ushort, int, long, uint, ulong, longlong, ulonglong, float, double#
+#typ1=long*7, ulong*2, longlong, ulonglong, float, double#
+#kind=Bool, Byte, UByte, Short, UShort, Int, Long, UInt, ULong, LongLong, ULongLong, Float, Double#
+*/
+
+static PyObject *
+@TYP@_getitem(char *ip, PyArrayObject *ap) {
+ @typ@ t1;
+
+ if ((ap==NULL) || PyArray_ISBEHAVED_RO(ap)) {
+ t1 = *((@typ@ *)ip);
+ return @func1@((@typ1@)t1);
+ }
+ else {
+ ap->descr->f->copyswap(&t1, ip, !PyArray_ISNOTSWAPPED(ap),
+ ap);
+ return @func1@((@typ1@)t1);
+ }
+}
+
+static int
+@TYP@_setitem(PyObject *op, char *ov, PyArrayObject *ap) {
+ @typ@ temp; /* ensures alignment */
+
+
+ if (PyArray_IsScalar(op, @kind@)) {
+ temp = ((Py@kind@ScalarObject *)op)->obval;
+ }
+ else {
+ temp = (@typ@)@func2@(op);
+ }
+ if (PyErr_Occurred()) {
+ if (PySequence_Check(op)) {
+ PyErr_Clear();
+ PyErr_SetString(PyExc_ValueError, "setting an array" \
+ " element with a sequence.");
+ }
+ return -1;
+ }
+ if (ap == NULL || PyArray_ISBEHAVED(ap))
+ *((@typ@ *)ov)=temp;
+ else {
+ ap->descr->f->copyswap(ov, &temp, !PyArray_ISNOTSWAPPED(ap),
+ ap);
+ }
+
+ return 0;
+}
+
+/**end repeat**/
+
+
+/**begin repeat
+
+#TYP=CFLOAT,CDOUBLE#
+#typ=float, double#
+*/
+
+static PyObject *
+@TYP@_getitem(char *ip, PyArrayObject *ap) {
+ @typ@ t1, t2;
+
+ if ((ap==NULL) || PyArray_ISBEHAVED_RO(ap)) {
+ return PyComplex_FromDoubles((double)((@typ@ *)ip)[0],
+ (double)((@typ@ *)ip)[1]);
+ }
+ else {
+ int size = sizeof(@typ@);
+ Bool swap = !PyArray_ISNOTSWAPPED(ap);
+ copy_and_swap(&t1, ip, size, 1, 0, swap);
+ copy_and_swap(&t2, ip+size, size, 1, 0, swap);
+ return PyComplex_FromDoubles((double)t1, (double)t2);
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+
+#TYP=CFLOAT, CDOUBLE, CLONGDOUBLE#
+#typ=float, double, longdouble#
+#kind=CFloat, CDouble, CLongDouble#
+*/
+static int
+@TYP@_setitem(PyObject *op, char *ov, PyArrayObject *ap)
+{
+ Py_complex oop;
+ PyObject *op2;
+ c@typ@ temp;
+ int rsize;
+
+ if (!(PyArray_IsScalar(op, @kind@))) {
+ if (PyArray_Check(op) && (PyArray_NDIM(op)==0)) {
+ op2 = ((PyArrayObject *)op)->descr->f->getitem \
+ (((PyArrayObject *)op)->data,
+ (PyArrayObject *)op);
+ }
+ else {
+ op2 = op; Py_INCREF(op);
+ }
+ if (op2 == Py_None) {
+ oop.real = oop.imag = _getNAN();
+ }
+ else {
+ oop = PyComplex_AsCComplex (op2);
+ }
+ Py_DECREF(op2);
+ if (PyErr_Occurred()) return -1;
+ temp.real = (@typ@) oop.real;
+ temp.imag = (@typ@) oop.imag;
+ }
+ else {
+ temp = ((Py@kind@ScalarObject *)op)->obval;
+ }
+
+ memcpy(ov, &temp, ap->descr->elsize);
+ if (!PyArray_ISNOTSWAPPED(ap))
+ byte_swap_vector(ov, 2, sizeof(@typ@));
+
+ rsize = sizeof(@typ@);
+ copy_and_swap(ov, &temp, rsize, 2, rsize, !PyArray_ISNOTSWAPPED(ap));
+ return 0;
+}
+/**end repeat**/
+
+static PyObject *
+LONGDOUBLE_getitem(char *ip, PyArrayObject *ap)
+{
+ return PyArray_Scalar(ip, ap->descr, NULL);
+}
+
+static int
+LONGDOUBLE_setitem(PyObject *op, char *ov, PyArrayObject *ap) {
+ longdouble temp; /* ensures alignment */
+
+ if (PyArray_IsScalar(op, LongDouble)) {
+ temp = ((PyLongDoubleScalarObject *)op)->obval;
+ }
+ else {
+ temp = (longdouble) MyPyFloat_AsDouble(op);
+ }
+ if (PyErr_Occurred()) return -1;
+ if (ap == NULL || PyArray_ISBEHAVED(ap))
+ *((longdouble *)ov)=temp;
+ else {
+ copy_and_swap(ov, &temp, ap->descr->elsize, 1, 0,
+ !PyArray_ISNOTSWAPPED(ap));
+ }
+ return 0;
+}
+
+static PyObject *
+CLONGDOUBLE_getitem(char *ip, PyArrayObject *ap)
+{
+ return PyArray_Scalar(ip, ap->descr, NULL);
+}
+
+
+/* UNICODE */
+static PyObject *
+UNICODE_getitem(char *ip, PyArrayObject *ap)
+{
+ PyObject *obj;
+ int mysize;
+ PyArray_UCS4 *dptr;
+ char *buffer;
+ int alloc=0;
+
+ mysize = ap->descr->elsize >> 2;
+ dptr = (PyArray_UCS4 *)ip + mysize-1;
+ while(mysize > 0 && *dptr-- == 0) mysize--;
+ if (!PyArray_ISBEHAVED(ap)) {
+ buffer = _pya_malloc(mysize << 2);
+ if (buffer == NULL)
+ return PyErr_NoMemory();
+ alloc = 1;
+ memcpy(buffer, ip, mysize << 2);
+ if (!PyArray_ISNOTSWAPPED(ap)) {
+ byte_swap_vector(buffer, mysize, 4);
+ }
+ }
+ else buffer = ip;
+#ifdef Py_UNICODE_WIDE
+ obj = PyUnicode_FromUnicode((const Py_UNICODE *)buffer, mysize);
+#else
+ /* create new empty unicode object of length mysize*2 */
+ obj = MyPyUnicode_New(mysize*2);
+ if (obj == NULL) {if (alloc) _pya_free(buffer); return obj;}
+ mysize = PyUCS2Buffer_FromUCS4(((PyUnicodeObject *)obj)->str,
+ (PyArray_UCS4 *)buffer, mysize);
+ /* reset length of unicode object to ucs2size */
+ if (MyPyUnicode_Resize((PyUnicodeObject *)obj, mysize) < 0) {
+ if (alloc) _pya_free(buffer);
+ Py_DECREF(obj);
+ return NULL;
+ }
+#endif
+ if (alloc) _pya_free(buffer);
+
+ return obj;
+}
+
+static int
+UNICODE_setitem(PyObject *op, char *ov, PyArrayObject *ap)
+{
+ PyObject *temp;
+ Py_UNICODE *ptr;
+ int datalen;
+#ifndef Py_UNICODE_WIDE
+ char *buffer;
+#endif
+
+ if (!PyString_Check(op) && !PyUnicode_Check(op) &&
+ PySequence_Check(op) && PySequence_Size(op) > 0) {
+ PyErr_SetString(PyExc_ValueError,
+ "setting an array element with a sequence");
+ return -1;
+ }
+ /* Sequence_Size might have returned an error */
+ if (PyErr_Occurred()) PyErr_Clear();
+ if ((temp=PyObject_Unicode(op)) == NULL) return -1;
+ ptr = PyUnicode_AS_UNICODE(temp);
+ if ((ptr == NULL) || (PyErr_Occurred())) {
+ Py_DECREF(temp);
+ return -1;
+ }
+ datalen = PyUnicode_GET_DATA_SIZE(temp);
+
+#ifdef Py_UNICODE_WIDE
+ memcpy(ov, ptr, MIN(ap->descr->elsize, datalen));
+#else
+ if (!PyArray_ISALIGNED(ap)) {
+ buffer = _pya_malloc(ap->descr->elsize);
+ if (buffer == NULL) {
+ Py_DECREF(temp);
+ PyErr_NoMemory();
+ return -1;
+ }
+ }
+ else buffer = ov;
+ datalen = PyUCS2Buffer_AsUCS4(ptr, (PyArray_UCS4 *)buffer,
+ datalen >> 1,
+ ap->descr->elsize >> 2);
+ datalen <<= 2;
+ if (!PyArray_ISALIGNED(ap)) {
+ memcpy(ov, buffer, datalen);
+ _pya_free(buffer);
+ }
+#endif
+ /* Fill in the rest of the space with 0 */
+ if (ap->descr->elsize > datalen) {
+ memset(ov + datalen, 0, (ap->descr->elsize - datalen));
+ }
+
+ if (!PyArray_ISNOTSWAPPED(ap))
+ byte_swap_vector(ov, ap->descr->elsize >> 2, 4);
+ Py_DECREF(temp);
+ return 0;
+}
+
+/* STRING -- can handle both NULL-terminated and not NULL-terminated cases
+ will truncate all ending NULLs in returned string.
+*/
+static PyObject *
+STRING_getitem(char *ip, PyArrayObject *ap)
+{
+ /* Will eliminate NULLs at the end */
+ char *ptr;
+ int size = ap->descr->elsize;
+
+ ptr = ip + size-1;
+ while (*ptr-- == '\0' && size > 0) size--;
+ return PyString_FromStringAndSize(ip,size);
+}
+
+static int
+STRING_setitem(PyObject *op, char *ov, PyArrayObject *ap)
+{
+ char *ptr;
+ Py_ssize_t len;
+ PyObject *temp=NULL;
+
+ if (!PyString_Check(op) && !PyUnicode_Check(op) &&
+ PySequence_Check(op) && PySequence_Size(op) > 0) {
+ PyErr_SetString(PyExc_ValueError,
+ "setting an array element with a sequence");
+ return -1;
+ }
+ /* Sequence_Size might have returned an error */
+ if (PyErr_Occurred()) PyErr_Clear();
+ if ((temp = PyObject_Str(op)) == NULL) return -1;
+
+ if (PyString_AsStringAndSize(temp, &ptr, &len) == -1) {
+ Py_DECREF(temp);
+ return -1;
+ }
+ memcpy(ov, ptr, MIN(ap->descr->elsize,len));
+ if (ap->descr->elsize > len) {
+ memset(ov + len, 0, (ap->descr->elsize - len));
+ }
+ Py_DECREF(temp);
+ return 0;
+}
+
+/* OBJECT */
+
+static PyObject *
+OBJECT_getitem(char *ip, PyArrayObject *ap)
+{
+ if (*(PyObject **)ip == NULL) {
+ Py_INCREF(Py_None);
+ return Py_None;
+ }
+ if (!ap || PyArray_ISALIGNED(ap)) {
+ Py_INCREF(*(PyObject **)ip);
+ return *(PyObject **)ip;
+ }
+ else {
+ PyObject **obj;
+ obj = (PyObject **)ip;
+ Py_INCREF(*obj);
+ return *obj;
+ }
+}
+
+
+static int
+OBJECT_setitem(PyObject *op, char *ov, PyArrayObject *ap)
+{
+ Py_INCREF(op);
+ if (!ap || PyArray_ISALIGNED(ap)) {
+ Py_XDECREF(*(PyObject **)ov);
+ *(PyObject **)ov = op;
+ }
+ else {
+ PyObject **obj;
+ obj = (PyObject **)ov;
+ Py_XDECREF(*obj);
+ memcpy(ov, &op, sizeof(PyObject *));
+ }
+ return PyErr_Occurred() ? -1:0;
+}
+
+/* VOID */
+
+static PyObject *
+VOID_getitem(char *ip, PyArrayObject *ap)
+{
+ PyObject *u=NULL;
+ PyArray_Descr* descr;
+ int itemsize;
+
+ descr = ap->descr;
+ if (descr->names) {
+ PyObject *key;
+ PyObject *names;
+ int i, n;
+ PyObject *ret;
+ PyObject *tup, *title;
+ PyArray_Descr *new;
+ int offset;
+ int savedflags;
+
+ /* get the names from the fields dictionary*/
+ names = descr->names;
+ if (!names) goto finish;
+ n = PyTuple_GET_SIZE(names);
+ ret = PyTuple_New(n);
+ savedflags = ap->flags;
+ for (i=0; i<n; i++) {
+ key = PyTuple_GET_ITEM(names, i);
+ tup = PyDict_GetItem(descr->fields, key);
+ if (!PyArg_ParseTuple(tup, "Oi|O", &new, &offset,
+ &title)) {
+ Py_DECREF(ret);
+ ap->descr = descr;
+ return NULL;
+ }
+ ap->descr = new;
+ /* update alignment based on offset */
+ if ((new->alignment > 1) && \
+ ((((intp)(ip+offset)) % new->alignment) != 0))
+ ap->flags &= ~ALIGNED;
+ else
+ ap->flags |= ALIGNED;
+
+ PyTuple_SET_ITEM(ret, i, \
+ new->f->getitem(ip+offset, ap));
+ ap->flags = savedflags;
+ }
+ ap->descr = descr;
+ return ret;
+ }
+
+ if (descr->subarray) {
+ /* return an array of the basic type */
+ PyArray_Dims shape={NULL,-1};
+ PyObject *ret;
+ if (!(PyArray_IntpConverter(descr->subarray->shape,
+ &shape))) {
+ PyDimMem_FREE(shape.ptr);
+ PyErr_SetString(PyExc_ValueError,
+ "invalid shape in fixed-type tuple.");
+ return NULL;
+ }
+ Py_INCREF(descr->subarray->base);
+ ret = PyArray_NewFromDescr(&PyArray_Type,
+ descr->subarray->base,
+ shape.len, shape.ptr,
+ NULL, ip, ap->flags, NULL);
+ PyDimMem_FREE(shape.ptr);
+ if (!ret) return NULL;
+ PyArray_BASE(ret) = (PyObject *)ap;
+ Py_INCREF(ap);
+ PyArray_UpdateFlags((PyArrayObject *)ret, UPDATE_ALL);
+ return ret;
+ }
+
+ finish:
+ if (PyDataType_FLAGCHK(descr, NPY_ITEM_HASOBJECT) ||
+ PyDataType_FLAGCHK(descr, NPY_ITEM_IS_POINTER)) {
+ PyErr_SetString(PyExc_ValueError,
+ "tried to get void-array with object"
+ " members as buffer.");
+ return NULL;
+ }
+
+ itemsize=ap->descr->elsize;
+ if (PyArray_ISWRITEABLE(ap))
+ u = PyBuffer_FromReadWriteMemory(ip, itemsize);
+ else
+ u = PyBuffer_FromMemory(ip, itemsize);
+ if (u==NULL) goto fail;
+
+ /* default is to return buffer object pointing to current item */
+ /* a view of it */
+ return u;
+
+ fail:
+ return NULL;
+}
+
+
+
+static int PyArray_CopyObject(PyArrayObject *, PyObject *);
+
+static int
+VOID_setitem(PyObject *op, char *ip, PyArrayObject *ap)
+{
+ PyArray_Descr* descr;
+ int itemsize=ap->descr->elsize;
+ int res;
+
+ descr = ap->descr;
+ if (descr->names && PyTuple_Check(op)) {
+ PyObject *key;
+ PyObject *names;
+ int i, n;
+ PyObject *tup, *title;
+ PyArray_Descr *new;
+ int offset;
+ int savedflags;
+ res = -1;
+ /* get the names from the fields dictionary*/
+ names = descr->names;
+ n = PyTuple_GET_SIZE(names);
+ if (PyTuple_GET_SIZE(op) != n) {
+ PyErr_SetString(PyExc_ValueError,
+ "size of tuple must match "\
+ "number of fields.");
+ return -1;
+ }
+ savedflags = ap->flags;
+ for (i=0; i<n; i++) {
+ key = PyTuple_GET_ITEM(names, i);
+ tup = PyDict_GetItem(descr->fields, key);
+ if (!PyArg_ParseTuple(tup, "Oi|O", &new, &offset,
+ &title)) {
+ ap->descr = descr;
+ return -1;
+ }
+ ap->descr = new;
+ /* remember to update alignment flags */
+ if ((new->alignment > 1) && \
+ ((((intp)(ip+offset)) % new->alignment) != 0))
+ ap->flags &= ~ALIGNED;
+ else
+ ap->flags |= ALIGNED;
+
+ res = new->f->setitem(PyTuple_GET_ITEM(op, i),
+ ip+offset, ap);
+ ap->flags = savedflags;
+ if (res < 0) break;
+ }
+ ap->descr = descr;
+ return res;
+ }
+
+ if (descr->subarray) {
+ /* copy into an array of the same basic type */
+ PyArray_Dims shape={NULL,-1};
+ PyObject *ret;
+ if (!(PyArray_IntpConverter(descr->subarray->shape,
+ &shape))) {
+ PyDimMem_FREE(shape.ptr);
+ PyErr_SetString(PyExc_ValueError,
+ "invalid shape in fixed-type tuple.");
+ return -1;
+ }
+ Py_INCREF(descr->subarray->base);
+ ret = PyArray_NewFromDescr(&PyArray_Type,
+ descr->subarray->base,
+ shape.len, shape.ptr,
+ NULL, ip, ap->flags, NULL);
+ PyDimMem_FREE(shape.ptr);
+ if (!ret) return -1;
+ PyArray_BASE(ret) = (PyObject *)ap;
+ Py_INCREF(ap);
+ PyArray_UpdateFlags((PyArrayObject *)ret, UPDATE_ALL);
+ res = PyArray_CopyObject((PyArrayObject *)ret, op);
+ Py_DECREF(ret);
+ return res;
+ }
+
+ /* Default is to use buffer interface to set item */
+ {
+ const void *buffer;
+ Py_ssize_t buflen;
+ if (PyDataType_FLAGCHK(descr, NPY_ITEM_HASOBJECT) ||
+ PyDataType_FLAGCHK(descr, NPY_ITEM_IS_POINTER)) {
+ PyErr_SetString(PyExc_ValueError,
+ "tried to set void-array with object"
+ " members using buffer.");
+ return -1;
+ }
+ res = PyObject_AsReadBuffer(op, &buffer, &buflen);
+ if (res == -1) goto fail;
+ memcpy(ip, buffer, NPY_MIN(buflen, itemsize));
+ if (itemsize > buflen) {
+ memset(ip+buflen, 0, (itemsize-buflen));
+ }
+ }
+ return 0;
+
+ fail:
+ return -1;
+}
+
+
+/****************** XXX_to_YYY *******************************/
+
+/* Assumes contiguous, and aligned, from and to */
+
+
+/**begin repeat
+#to=(BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE)*16#
+#from=BYTE*13,UBYTE*13,SHORT*13,USHORT*13,INT*13,UINT*13,LONG*13,ULONG*13,LONGLONG*13,ULONGLONG*13,FLOAT*13,DOUBLE*13,LONGDOUBLE*13,CFLOAT*13,CDOUBLE*13,CLONGDOUBLE*13#
+#totyp=(byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble)*16#
+#fromtyp=byte*13, ubyte*13, short*13, ushort*13, int*13, uint*13, long*13, ulong*13, longlong*13, ulonglong*13, float*13, double*13, longdouble*13, float*13, double*13, longdouble*13#
+#incr= ip++*169,ip+=2*39#
+*/
+static void
+@from@_to_@to@(register @fromtyp@ *ip, register @totyp@ *op, register intp n,
+ PyArrayObject *aip, PyArrayObject *aop)
+{
+ while (n--) {
+ *op++ = (@totyp@)*ip;
+ @incr@;
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+#from=BOOL,BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE#
+#fromtyp=Bool, byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble#
+*/
+static void
+@from@_to_BOOL(register @fromtyp@ *ip, register Bool *op, register intp n,
+ PyArrayObject *aip, PyArrayObject *aop)
+{
+ while (n--) {
+ *op++ = (Bool)(*ip++ != FALSE);
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+#from=CFLOAT, CDOUBLE, CLONGDOUBLE#
+#fromtyp=cfloat, cdouble, clongdouble#
+*/
+static void
+@from@_to_BOOL(register @fromtyp@ *ip, register Bool *op, register intp n,
+ PyArrayObject *aip, PyArrayObject *aop)
+{
+ while (n--) {
+ *op = (Bool)(((*ip).real != FALSE) || ((*ip).imag != FALSE));
+ op++; ip++;
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+#to=BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE#
+#totyp=byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble#
+*/
+static void
+BOOL_to_@to@(register Bool *ip, register @totyp@ *op, register intp n,
+ PyArrayObject *aip, PyArrayObject *aop)
+{
+ while (n--) {
+ *op++ = (@totyp@)(*ip++ != FALSE);
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+
+#to=(CFLOAT,CDOUBLE,CLONGDOUBLE)*14#
+#from=BOOL*3,BYTE*3,UBYTE*3,SHORT*3,USHORT*3,INT*3,UINT*3,LONG*3,ULONG*3,LONGLONG*3,ULONGLONG*3,FLOAT*3,DOUBLE*3,LONGDOUBLE*3#
+#fromtyp=Bool*3,byte*3, ubyte*3, short*3, ushort*3, int*3, uint*3, long*3, ulong*3, longlong*3, ulonglong*3, float*3, double*3, longdouble*3#
+#totyp= (float, double, longdouble)*14#
+*/
+static void
+@from@_to_@to@(register @fromtyp@ *ip, register @totyp@ *op, register intp n,
+ PyArrayObject *aip, PyArrayObject *aop)
+{
+ while (n--) {
+ *op++ = (@totyp@)*ip++;
+ *op++ = 0.0;
+ }
+
+}
+/**end repeat**/
+
+/**begin repeat
+
+#to=(CFLOAT,CDOUBLE,CLONGDOUBLE)*3#
+#from=CFLOAT*3,CDOUBLE*3,CLONGDOUBLE*3#
+#totyp=(float, double, longdouble)*3#
+#fromtyp=float*3, double*3, longdouble*3#
+*/
+static void
+@from@_to_@to@(register @fromtyp@ *ip, register @totyp@ *op, register intp n,
+ PyArrayObject *aip, PyArrayObject *aop)
+{
+ n <<= 1;
+ while (n--) {
+ *op++ = (@totyp@)*ip++;
+ }
+
+}
+/**end repeat**/
+
+/**begin repeat
+
+#from=BOOL,BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE,CFLOAT,CDOUBLE,CLONGDOUBLE, STRING, UNICODE, VOID, OBJECT#
+#fromtyp=Bool, byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble, cfloat, cdouble, clongdouble, char, char, char, PyObject *#
+#skip= 1*17, aip->descr->elsize*3, 1#
+*/
+static void
+@from@_to_OBJECT(@fromtyp@ *ip, PyObject **op, intp n, PyArrayObject *aip,
+ PyArrayObject *aop)
+{
+ register intp i;
+ int skip=@skip@;
+ for(i=0;i<n;i++,ip+=skip,op++) {
+ Py_XDECREF(*op);
+ *op = @from@_getitem((char *)ip, aip);
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+
+#to=BOOL,BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE,CFLOAT,CDOUBLE,CLONGDOUBLE, STRING, UNICODE, VOID#
+#totyp=Bool, byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble, cfloat, cdouble, clongdouble, char, char, char#
+#skip= 1*17, aip->descr->elsize*3#
+*/
+static void
+OBJECT_to_@to@(PyObject **ip, @totyp@ *op, intp n, PyArrayObject *aip,
+ PyArrayObject *aop)
+{
+ register intp i;
+ int skip=@skip@;
+ for(i=0;i<n;i++,ip++,op+=skip) {
+ if (*ip == NULL) {
+ @to@_setitem(Py_False, (char *)op, aop);
+ }
+ else {
+ @to@_setitem(*ip, (char *)op, aop);
+ }
+ }
+}
+/**end repeat**/
+
+
+/**begin repeat
+
+#from=STRING*20, UNICODE*20, VOID*20#
+#fromtyp=char*60#
+#to=(BOOL,BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE,CFLOAT,CDOUBLE,CLONGDOUBLE,STRING,UNICODE,VOID)*3#
+#totyp=(Bool, byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble, cfloat, cdouble, clongdouble, char, char, char)*3#
+#oskip=(1*17,aop->descr->elsize*3)*3#
+#convert=1*17,0*3,1*17,0*3,0*20#
+#convstr=(Int*9,Long*2,Float*3,Complex*3,Tuple*3)*3#
+*/
+static void
+@from@_to_@to@(@fromtyp@ *ip, @totyp@ *op, intp n, PyArrayObject *aip,
+ PyArrayObject *aop)
+{
+ register intp i;
+ PyObject *temp=NULL;
+ int skip=aip->descr->elsize;
+ int oskip=@oskip@;
+ for(i=0; i<n; i++, ip+=skip, op+=oskip) {
+ temp = @from@_getitem((char *)ip, aip);
+ if (temp==NULL) return;
+ /* convert from Python object to needed one */
+ if (@convert@) {
+ PyObject *new, *args;
+ /* call out to the Python builtin given by convstr */
+ args = Py_BuildValue("(N)", temp);
+ new = Py@convstr@_Type.tp_new(&Py@convstr@_Type, args, NULL);
+ Py_DECREF(args);
+ temp = new;
+ if (temp==NULL) return;
+ }
+
+ @to@_setitem(temp,(char *)op, aop);
+ Py_DECREF(temp);
+ }
+}
+
+/**end repeat**/
+
+/**begin repeat
+
+#to=STRING*17, UNICODE*17, VOID*17#
+#totyp=char*17, char*17, char*17#
+#from=(BOOL,BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE,CFLOAT,CDOUBLE,CLONGDOUBLE)*3#
+#fromtyp=(Bool, byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble, cfloat, cdouble, clongdouble)*3#
+*/
+
+static void
+@from@_to_@to@(@fromtyp@ *ip, @totyp@ *op, intp n, PyArrayObject *aip,
+ PyArrayObject *aop)
+{
+ register intp i;
+ PyObject *temp=NULL;
+ int skip=1;
+ int oskip=aop->descr->elsize;
+ for(i=0; i<n; i++, ip+=skip, op+=oskip) {
+ temp = @from@_getitem((char *)ip, aip);
+ if (temp==NULL) {
+ Py_INCREF(Py_False);
+ temp = Py_False;
+ }
+ @to@_setitem(temp,(char *)op, aop);
+ Py_DECREF(temp);
+ }
+}
+
+/**end repeat**/
+
+
+/****************** scan *************************************/
+
+/* The first ignore argument is for backwards compatibility.
+ Should be removed when the API version is bumped up.
+ */
+
+/**begin repeat
+
+#fname=SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE#
+#type=short,ushort,int,uint,long,ulong,longlong,ulonglong,float,double,longdouble#
+#format="hd","hu","d","u","ld","lu",LONGLONG_FMT,ULONGLONG_FMT,"f","lf","Lf"#
+*/
+static int
+@fname@_scan (FILE *fp, @type@ *ip, void *ignore, PyArray_Descr *ignore2)
+{
+ return fscanf(fp, "%"@format@, ip);
+}
+
+/**end repeat**/
+
+/**begin repeat
+#fname=BYTE,UBYTE#
+#type=byte,ubyte#
+#btype=int,uint#
+#format="d","u"#
+*/
+static int
+@fname@_scan (FILE *fp, @type@ *ip, void *ignore, PyArray_Descr *ignore2)
+{
+ @btype@ temp;
+ int num;
+ num = fscanf(fp, "%"@format@, &temp);
+ *ip = (@type@) temp;
+ return num;
+}
+/**end repeat**/
+
+static int
+BOOL_scan (FILE *fp, Bool *ip, void *ignore, PyArray_Descr *ignore2)
+{
+ int temp;
+ int num;
+ num = fscanf(fp, "%d", &temp);
+ *ip = (Bool) (temp != 0);
+ return num;
+}
+
+/**begin repeat
+#fname=CFLOAT,CDOUBLE,CLONGDOUBLE,OBJECT,STRING,UNICODE,VOID#
+*/
+#define @fname@_scan NULL
+/**end repeat**/
+
+/****************** fromstr *************************************/
+
+/**begin repeat
+#fname=BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG#
+#type=byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong#
+#func=(l,ul)*5#
+#btype=(long,ulong)*5#
+*/
+static int
+@fname@_fromstr(char *str, @type@ *ip, char **endptr, PyArray_Descr *ignore)
+{
+ @btype@ result;
+
+ result = PyOS_strto@func@(str, endptr, 0);
+ *ip = (@type@) result;
+ return 0;
+}
+/**end repeat**/
+
+/**begin repeat
+#fname=FLOAT,DOUBLE,LONGDOUBLE#
+#type=float,double,longdouble#
+*/
+#if (PY_VERSION_HEX >= 0x02040000) || defined(PyOS_ascii_strtod)
+static int
+@fname@_fromstr(char *str, @type@ *ip, char **endptr, PyArray_Descr *ignore)
+{
+ double result;
+
+ result = PyOS_ascii_strtod(str, endptr);
+ *ip = (@type@) result;
+ return 0;
+}
+#else
+#define @fname@_fromstr NULL
+#endif
+/**end repeat**/
+
+
+
+/**begin repeat
+#fname=BOOL,CFLOAT,CDOUBLE,CLONGDOUBLE,OBJECT,STRING,UNICODE,VOID#
+*/
+#define @fname@_fromstr NULL
+/**end repeat**/
+
+
+/****************** copyswapn *************************************/
+
+/**begin repeat
+
+#fname=SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE#
+#fsize=SHORT,SHORT,INT,INT,LONG,LONG,LONGLONG,LONGLONG,FLOAT,DOUBLE,LONGDOUBLE#
+#type=short,ushort,int,uint,long,ulong,longlong,ulonglong,float,double,longdouble#
+*/
+static void
+@fname@_copyswapn (void *dst, intp dstride, void *src, intp sstride,
+ intp n, int swap, void *arr)
+{
+ if (src != NULL) {
+ if (sstride == sizeof(@type@) && dstride == sizeof(@type@)) {
+ memcpy(dst, src, n*sizeof(@type@));
+ }
+ else {
+ _unaligned_strided_byte_copy(dst, dstride, src, sstride,
+ n, sizeof(@type@));
+ }
+ }
+ if (swap) {
+ _strided_byte_swap(dst, dstride, n, sizeof(@type@));
+ }
+}
+
+static void
+@fname@_copyswap (void *dst, void *src, int swap, void *arr)
+{
+
+ if (src != NULL) /* copy first if needed */
+ memcpy(dst, src, sizeof(@type@));
+
+ if (swap) {
+ register char *a, *b, c;
+ a = (char *)dst;
+#if SIZEOF_@fsize@ == 2
+ b = a + 1;
+ c = *a; *a++ = *b; *b = c;
+#elif SIZEOF_@fsize@ == 4
+ b = a + 3;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b = c;
+#elif SIZEOF_@fsize@ == 8
+ b = a + 7;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b = c;
+#elif SIZEOF_@fsize@ == 10
+ b = a + 9;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b = c;
+#elif SIZEOF_@fsize@ == 12
+ b = a + 11;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b = c;
+#elif SIZEOF_@fsize@ == 16
+ b = a + 15;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b = c;
+#else
+ {
+ register int i, nn;
+ b = a + (SIZEOF_@fsize@-1);
+ nn = SIZEOF_@fsize@ / 2;
+ for (i=0; i<nn; i++) {
+ c=*a; *a++ = *b; *b-- = c;
+ }
+ }
+#endif
+ }
+}
+
+
+/**end repeat**/
+
+/**begin repeat
+
+#fname=BOOL, BYTE, UBYTE#
+#type=Bool, byte, ubyte#
+*/
+static void
+@fname@_copyswapn (void *dst, intp dstride, void *src, intp sstride, intp n,
+ int swap, void *arr)
+{
+ if (src != NULL) {
+ if (sstride == sizeof(@type@) && dstride == sizeof(@type@)) {
+ memcpy(dst, src, n*sizeof(@type@));
+ }
+ else {
+ _unaligned_strided_byte_copy(dst, dstride, src, sstride,
+ n, sizeof(@type@));
+ }
+ }
+ /* ignore swap */
+}
+
+static void
+@fname@_copyswap (void *dst, void *src, int swap, void *arr)
+{
+ if (src != NULL) /* copy first if needed */
+ memcpy(dst, src, sizeof(@type@));
+ /* ignore swap */
+}
+
+/**end repeat**/
+
+
+
+/**begin repeat
+
+#fname=CFLOAT,CDOUBLE,CLONGDOUBLE#
+#type=cfloat, cdouble, clongdouble#
+#fsize=FLOAT,DOUBLE,LONGDOUBLE#
+*/
+static void
+@fname@_copyswapn (void *dst, intp dstride, void *src, intp sstride, intp n,
+ int swap, void *arr)
+{
+
+ if (src != NULL) { /* copy first if needed */
+ if (sstride == sizeof(@type@) && dstride == sizeof(@type@)) {
+ memcpy(dst, src, n*sizeof(@type@));
+ }
+ else {
+ _unaligned_strided_byte_copy(dst, dstride, src,
+ sstride, n,
+ sizeof(@type@));
+ }
+ }
+
+ if (swap) {
+ _strided_byte_swap(dst, dstride, n, SIZEOF_@fsize@);
+ _strided_byte_swap(((char *)dst + SIZEOF_@fsize@), dstride,
+ n, SIZEOF_@fsize@);
+ }
+}
+
+static void
+@fname@_copyswap (void *dst, void *src, int swap, void *arr)
+{
+ if (src != NULL) /* copy first if needed */
+ memcpy(dst, src, sizeof(@type@));
+
+ if (swap) {
+ register char *a, *b, c;
+ a = (char *)dst;
+#if SIZEOF_@fsize@ == 4
+ b = a + 3;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b = c;
+ a += 2;
+ b = a + 3;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b = c;
+#elif SIZEOF_@fsize@ == 8
+ b = a + 7;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b = c;
+ a += 4;
+ b = a + 7;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b = c;
+#elif SIZEOF_@fsize@ == 10
+ b = a + 9;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b = c;
+ a += 5;
+ b = a + 9;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b = c;
+#elif SIZEOF_@fsize@ == 12
+ b = a + 11;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b = c;
+ a += 6;
+ b = a + 11;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b = c;
+#elif SIZEOF_@fsize@ == 16
+ b = a + 15;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b = c;
+ a += 8;
+ b = a + 15;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b-- = c;
+ c = *a; *a++ = *b; *b = c;
+#else
+ {
+ register int i, nn;
+ b = a + (SIZEOF_@fsize@-1);
+ nn = SIZEOF_@fsize@ / 2;
+ for (i=0; i<nn; i++) {
+ c=*a; *a++ = *b; *b-- = c;
+ }
+ a += nn / 2;
+ b = a + (SIZEOF_@fsize@-1);
+ nn = SIZEOF_@fsize@ / 2;
+ for (i=0; i<nn; i++) {
+ c=*a; *a++ = *b; *b-- = c;
+ }
+ }
+#endif
+ }
+}
+
+/**end repeat**/
+
+#define __ALIGNED(obj, sz) ((((size_t) obj) % (sz))==0)
+static void
+OBJECT_copyswapn (PyObject **dst, intp dstride, PyObject **src, intp sstride,
+ register intp n, int swap, void *arr)
+{
+ register intp i;
+ if (src != NULL) {
+ dstride /= sizeof(PyObject **);
+ sstride /= sizeof(PyObject **);
+ if (__ALIGNED(dst,sizeof(PyObject **)) && __ALIGNED(src, sizeof(PyObject **))) {
+ for (i=0; i<n; i++) {
+ Py_XINCREF(*src);
+ Py_XDECREF(*dst);
+ *dst = *src;
+ dst += dstride;
+ src += sstride;
+ }
+ }
+ else {
+ PyObject **dp, **sp;
+ for (i=0; i<n; i++) {
+ dp = dst;
+ sp = src;
+ Py_XINCREF(*sp);
+ Py_XDECREF(*dp);
+ memcpy(dst, src, sizeof(PyObject *));
+ dst += dstride;
+ src += sstride;
+ }
+ }
+ }
+ /* ignore swap */
+ return;
+}
+
+static void
+OBJECT_copyswap(PyObject **dst, PyObject **src, int swap, void *arr)
+{
+
+ if (src != NULL) {
+ if (__ALIGNED(dst,sizeof(PyObject **)) && __ALIGNED(src,sizeof(PyObject **))) {
+ Py_XINCREF(*src);
+ Py_XDECREF(*dst);
+ *dst = *src;
+ }
+ else {
+ PyObject **dp=dst, **sp=src;
+ Py_XINCREF(*sp);
+ Py_XDECREF(*dp);
+ memcpy(dst, src, sizeof(PyObject *));
+ }
+ }
+}
+
+/* ignore swap */
+static void
+STRING_copyswapn (char *dst, intp dstride, char *src, intp sstride,
+ intp n, int swap, PyArrayObject *arr)
+{
+ if (src != NULL && arr != NULL) {
+ int itemsize = arr->descr->elsize;
+ if (dstride == itemsize && sstride == itemsize) {
+ memcpy(dst, src, itemsize * n);
+ }
+ else {
+ _unaligned_strided_byte_copy(dst, dstride, src, sstride, n, itemsize);
+ }
+ }
+ return;
+}
+
+/* */
+static void
+VOID_copyswapn (char *dst, intp dstride, char *src, intp sstride,
+ intp n, int swap, PyArrayObject *arr)
+{
+ if (arr == NULL) return;
+ if (PyArray_HASFIELDS(arr)) {
+ PyObject *key, *value, *title=NULL;
+ PyArray_Descr *new, *descr;
+ int offset;
+ Py_ssize_t pos=0;
+ descr = arr->descr;
+ while (PyDict_Next(descr->fields, &pos, &key, &value)) {
+ if (!PyArg_ParseTuple(value, "Oi|O", &new, &offset,
+ &title)) {
+ arr->descr=descr;return;
+ }
+ arr->descr = new;
+ new->f->copyswapn(dst+offset, dstride,
+ (src != NULL ? src+offset : NULL),
+ sstride, n, swap, arr);
+ }
+ arr->descr = descr;
+ return;
+ }
+ if (swap && arr->descr->subarray != NULL) {
+ PyArray_Descr *descr, *new;
+ npy_intp num;
+ npy_intp i;
+ int subitemsize;
+ char *dstptr, *srcptr;
+ descr = arr->descr;
+ new = descr->subarray->base;
+ arr->descr = new;
+ dstptr = dst;
+ srcptr = src;
+ subitemsize = new->elsize;
+ num = descr->elsize / subitemsize;
+ for (i=0; i<n; i++) {
+ new->f->copyswapn(dstptr, subitemsize, srcptr,
+ subitemsize, num, swap, arr);
+ dstptr += dstride;
+ if (srcptr) srcptr += sstride;
+ }
+ arr->descr = descr;
+ return;
+ }
+ if (src != NULL) {
+ memcpy(dst, src, arr->descr->elsize * n);
+ }
+ return;
+}
+
+static void
+VOID_copyswap (char *dst, char *src, int swap, PyArrayObject *arr)
+{
+ if (arr==NULL) return;
+ if (PyArray_HASFIELDS(arr)) {
+ PyObject *key, *value, *title=NULL;
+ PyArray_Descr *new, *descr;
+ int offset;
+ Py_ssize_t pos=0;
+ descr = arr->descr; /* Save it */
+ while (PyDict_Next(descr->fields, &pos, &key, &value)) {
+ if (!PyArg_ParseTuple(value, "Oi|O", &new, &offset,
+ &title)) {
+ arr->descr=descr;return;
+ }
+ arr->descr = new;
+ new->f->copyswap(dst+offset,
+ (src != NULL ? src+offset : NULL),
+ swap, arr);
+ }
+ arr->descr = descr;
+ return;
+ }
+ if (swap && arr->descr->subarray != NULL) {
+ PyArray_Descr *descr, *new;
+ npy_intp num;
+ int itemsize;
+ descr = arr->descr;
+ new = descr->subarray->base;
+ arr->descr = new;
+ itemsize = new->elsize;
+ num = descr->elsize / itemsize;
+ new->f->copyswapn(dst, itemsize, src,
+ itemsize, num, swap, arr);
+ arr->descr = descr;
+ return;
+ }
+ if (src != NULL) {
+ memcpy(dst, src, arr->descr->elsize);
+ }
+ return;
+}
+
+
+static void
+UNICODE_copyswapn (char *dst, intp dstride, char *src, intp sstride,
+ intp n, int swap, PyArrayObject *arr)
+{
+ int itemsize;
+ if (arr==NULL) return;
+ itemsize = arr->descr->elsize;
+ if (src != NULL) {
+ if (dstride == itemsize && sstride == itemsize)
+ memcpy(dst, src, n * itemsize);
+ else
+ _unaligned_strided_byte_copy(dst, dstride, src,
+ sstride, n, itemsize);
+ }
+
+ n *= itemsize;
+ if (swap) {
+ register char *a, *b, c;
+ n >>= 2; /* n is the number of unicode characters to swap */
+ for (a = (char *)dst; n>0; n--) {
+ b = a + 3;
+ c=*a; *a++ = *b; *b-- = c;
+ c=*a; *a++ = *b; *b-- = c;
+ a += 2;
+ }
+ }
+}
+
+
+static void
+STRING_copyswap (char *dst, char *src, int swap, PyArrayObject *arr)
+{
+ if (src != NULL && arr != NULL) {
+ memcpy(dst, src, arr->descr->elsize);
+ }
+}
+
+static void
+UNICODE_copyswap (char *dst, char *src, int swap, PyArrayObject *arr)
+{
+ int itemsize;
+ if (arr == NULL) return;
+ itemsize = arr->descr->elsize;
+ if (src != NULL) {
+ memcpy(dst, src, itemsize);
+ }
+
+ if (swap) {
+ register char *a, *b, c;
+ itemsize >>= 2;
+ for (a = (char *)dst; itemsize>0; itemsize--) {
+ b = a + 3;
+ c=*a; *a++ = *b; *b-- = c;
+ c=*a; *a++ = *b; *b-- = c;
+ a += 2;
+ }
+ }
+}
+
+
+/****************** nonzero **********************************/
+
+/**begin repeat
+#fname=BOOL,BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE#
+#type=Bool, byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble#
+*/
+static Bool
+@fname@_nonzero (@type@ *ip, PyArrayObject *ap)
+{
+ @type@ t1;
+ if (ap==NULL || PyArray_ISBEHAVED_RO(ap))
+ return (Bool) (*ip != 0);
+ else {
+ /* don't worry about swap, since we are just testing
+ whether or not equal to 0 */
+ memcpy(&t1, ip, sizeof(@type@));
+ return (Bool) (t1 != 0);
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+#fname=CFLOAT,CDOUBLE,CLONGDOUBLE#
+#type=cfloat, cdouble, clongdouble#
+*/
+static Bool
+@fname@_nonzero (@type@ *ip, PyArrayObject *ap)
+{
+ @type@ t1;
+ if (ap==NULL || PyArray_ISBEHAVED_RO(ap))
+ return (Bool) ((ip->real != 0) || (ip->imag != 0));
+ else {
+ /* don't worry about swap, since we are just testing
+ whether or not equal to 0 */
+ memcpy(&t1, ip, sizeof(@type@));
+ return (Bool) ((t1.real != 0) || (t1.imag != 0));
+ }
+}
+/**end repeat**/
+
+
+#define WHITESPACE " \t\n\r\v\f"
+#define WHITELEN 6
+
+static Bool
+Py_STRING_ISSPACE(char ch)
+{
+ char white[] = WHITESPACE;
+ int j;
+ Bool space=FALSE;
+ for (j=0; j<WHITELEN; j++) {
+ if (ch == white[j]) {
+ space=TRUE;
+ break;
+ }
+ }
+ return space;
+}
+
+static Bool
+STRING_nonzero (char *ip, PyArrayObject *ap)
+{
+ int len = ap->descr->elsize;
+ int i;
+ Bool nonz = FALSE;
+
+ for (i=0; i<len; i++) {
+ if (!Py_STRING_ISSPACE(*ip)) {
+ nonz = TRUE;
+ break;
+ }
+ ip++;
+ }
+ return nonz;
+}
+
+#ifdef Py_UNICODE_WIDE
+#define PyArray_UCS4_ISSPACE Py_UNICODE_ISSPACE
+#else
+#define PyArray_UCS4_ISSPACE(ch) Py_STRING_ISSPACE((char)ch)
+#endif
+
+static Bool
+UNICODE_nonzero (PyArray_UCS4 *ip, PyArrayObject *ap)
+{
+ int len = ap->descr->elsize >> 2;
+ int i;
+ Bool nonz = FALSE;
+ char *buffer=NULL;
+
+ if ((!PyArray_ISNOTSWAPPED(ap)) || \
+ (!PyArray_ISALIGNED(ap))) {
+ buffer = _pya_malloc(ap->descr->elsize);
+ if (buffer == NULL) {
+ return nonz;
+ }
+ memcpy(buffer, ip, ap->descr->elsize);
+ if (!PyArray_ISNOTSWAPPED(ap)) {
+ byte_swap_vector(buffer, len, 4);
+ }
+ ip = (PyArray_UCS4 *)buffer;
+ }
+
+ for (i=0; i<len; i++) {
+ if (!PyArray_UCS4_ISSPACE(*ip)) {
+ nonz = TRUE;
+ break;
+ }
+ ip++;
+ }
+ _pya_free(buffer);
+ return nonz;
+}
+
+static Bool
+OBJECT_nonzero (PyObject **ip, PyArrayObject *ap)
+{
+
+ if (*ip == NULL) return FALSE;
+ if (PyArray_ISALIGNED(ap)) {
+ return (Bool) PyObject_IsTrue(*ip);
+ }
+ else {
+ PyObject **obj;
+ obj = ip;
+ return (Bool) PyObject_IsTrue(*obj);
+ }
+}
+
+/* if we have fields, then nonzero only if all sub-fields are nonzero.
+*/
+static Bool
+VOID_nonzero (char *ip, PyArrayObject *ap)
+{
+ int i;
+ int len;
+ Bool nonz = FALSE;
+
+ if (PyArray_HASFIELDS(ap)) {
+ PyArray_Descr *descr, *new;
+ PyObject *key, *value, *title;
+ int savedflags, offset;
+ Py_ssize_t pos=0;
+ descr = ap->descr;
+ savedflags = ap->flags;
+ while (PyDict_Next(descr->fields, &pos, &key, &value)) {
+ if (!PyArg_ParseTuple(value, "Oi|O", &new, &offset,
+ &title)) {PyErr_Clear(); continue;}
+ ap->descr = new;
+ ap->flags = savedflags;
+ if ((new->alignment > 1) && !__ALIGNED(ip+offset, new->alignment))
+ ap->flags &= ~ALIGNED;
+ else
+ ap->flags |= ALIGNED;
+ if (new->f->nonzero(ip+offset, ap)) {
+ nonz=TRUE;
+ break;
+ }
+ }
+ ap->descr = descr;
+ ap->flags = savedflags;
+ return nonz;
+ }
+ len = ap->descr->elsize;
+ for (i=0; i<len; i++) {
+ if (*ip != '\0') {
+ nonz = TRUE;
+ break;
+ }
+ ip++;
+ }
+ return nonz;
+}
+
+#undef __ALIGNED
+
+
+/****************** compare **********************************/
+
+static int
+BOOL_compare(Bool *ip1, Bool *ip2, PyArrayObject *ap)
+{
+ return (*ip1 ? (*ip2 ? 0 : 1) : (*ip2 ? -1 : 0));
+}
+
+/**begin repeat
+#fname=BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE#
+#type=byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble#
+*/
+
+static int
+@fname@_compare (@type@ *ip1, @type@ *ip2, PyArrayObject *ap)
+{
+ return *ip1 < *ip2 ? -1 : *ip1 == *ip2 ? 0 : 1;
+}
+
+/**end repeat**/
+
+/* compare imaginary part first, then complex if equal imaginary */
+/**begin repeat
+#fname=CFLOAT, CDOUBLE, CLONGDOUBLE#
+#type= float, double, longdouble#
+*/
+
+static int
+@fname@_compare (@type@ *ip1, @type@ *ip2, PyArrayObject *ap)
+{
+ if (*ip1 == *ip2) {
+ return ip1[1]<ip2[1] ? -1 : (ip1[1] == ip2[1] ? 0 : 1);
+ }
+ else {
+ return *ip1 < *ip2 ? -1 : 1;
+ }
+}
+ /**end repeat**/
+
+static int
+OBJECT_compare(PyObject **ip1, PyObject **ip2, PyArrayObject *ap)
+{
+ if ((*ip1 == NULL) || (*ip2 == NULL)) {
+ if (ip1 == ip2) return 1;
+ if (ip1 == NULL) return -1;
+ return 1;
+ }
+ return PyObject_Compare(*ip1, *ip2);
+}
+
+static int
+STRING_compare(char *ip1, char *ip2, PyArrayObject *ap)
+{
+ return strncmp(ip1, ip2, ap->descr->elsize);
+}
+
+/* taken from Python */
+static int
+UNICODE_compare(register PyArray_UCS4 *ip1, register PyArray_UCS4 *ip2,
+ PyArrayObject *ap)
+{
+ register int itemsize=ap->descr->elsize;
+ register PyArray_UCS4 c1, c2;
+
+ if (itemsize < 0) return 0;
+
+ while(itemsize-- > 0) {
+ c1 = *ip1++;
+ c2 = *ip2++;
+
+ if (c1 != c2)
+ return (c1 < c2) ? -1 : 1;
+ }
+ return 0;
+}
+
+/* If fields are defined, then compare on first field and if equal
+ compare on second field. Continue until done or comparison results
+ in not_equal.
+
+ Must align data passed on to sub-comparisons.
+*/
+
+static int
+VOID_compare(char *ip1, char *ip2, PyArrayObject *ap)
+{
+ PyArray_Descr *descr, *new;
+ PyObject *names, *key;
+ PyObject *tup, *title;
+ char *nip1, *nip2;
+ int i, offset, res=0;
+
+ if (!PyArray_HASFIELDS(ap))
+ return STRING_compare(ip1, ip2, ap);
+
+ descr = ap->descr;
+ /* Compare on the first-field. If equal, then
+ compare on the second-field, etc.
+ */
+ names = descr->names;
+ for (i=0; i<PyTuple_GET_SIZE(names); i++) {
+ key = PyTuple_GET_ITEM(names, i);
+ tup = PyDict_GetItem(descr->fields, key);
+ if (!PyArg_ParseTuple(tup, "Oi|O", &new, &offset,
+ &title)) {
+ goto finish;
+ }
+ ap->descr = new;
+ nip1 = ip1+offset;
+ nip2 = ip2+offset;
+ if (new->alignment > 1) {
+ if (((intp)(nip1) % new->alignment) != 0) {
+ /* create buffer and copy */
+ nip1 = _pya_malloc(new->elsize);
+ if (nip1 == NULL) goto finish;
+ memcpy(nip1, ip1+offset, new->elsize);
+ }
+ if (((intp)(nip2) % new->alignment) != 0) {
+ /* copy data to a buffer */
+ nip2 = _pya_malloc(new->elsize);
+ if (nip2 == NULL) {
+ if (nip1 != ip1+offset)
+ _pya_free(nip1);
+ goto finish;
+ }
+ memcpy(nip2, ip2+offset, new->elsize);
+ }
+ }
+ res = new->f->compare(nip1, nip2, ap);
+ if (new->alignment > 1) {
+ if (nip1 != ip1+offset) {
+ _pya_free(nip1);
+ }
+ if (nip2 != ip2+offset) {
+ _pya_free(nip2);
+ }
+ }
+ if (res != 0) break;
+ }
+
+ finish:
+ ap->descr = descr;
+ return res;
+}
+
+/****************** argfunc **********************************/
+
+/**begin repeat
+
+#fname= BOOL,BYTE, UBYTE, SHORT, USHORT, INT, UINT, LONG, ULONG, LONGLONG, ULONGLONG, FLOAT, DOUBLE, LONGDOUBLE, CFLOAT, CDOUBLE, CLONGDOUBLE#
+#type= Bool, byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble, float, double, longdouble#
+#incr= ip++*14, ip+=2*3#
+*/
+
+static int
+@fname@_argmax(@type@ *ip, intp n, intp *max_ind, PyArrayObject *aip)
+{
+ register intp i;
+ @type@ mp=*ip;
+ *max_ind=0;
+ for (i=1; i<n; i++) {
+ @incr@;
+ if (*ip > mp) {
+ mp = *ip;
+ *max_ind = i;
+ }
+ }
+ return 0;
+}
+
+/**end repeat**/
+
+static int
+OBJECT_argmax(PyObject **ip, intp n, intp *max_ind, PyArrayObject *aip)
+{
+ register intp i;
+ PyObject *mp=ip[0]; *max_ind=0;
+ i = 1;
+ while(i<n && mp==NULL) {
+ mp=ip[i];
+ i++;
+ }
+ for(; i<n; i++) {
+ ip++;
+ if (*ip != NULL && PyObject_Compare(*ip,mp) > 0) {
+ mp = *ip;
+ *max_ind=i;
+ }
+ }
+ return 0;
+}
+
+/**begin repeat
+
+#fname= STRING, UNICODE#
+#type= char, PyArray_UCS4#
+
+*/
+static int
+@fname@_argmax(@type@ *ip, intp n, intp *max_ind, PyArrayObject *aip)
+{
+ register intp i;
+ int elsize = aip->descr->elsize;
+ @type@ *mp = (@type@ *)_pya_malloc(elsize);
+
+ if (mp==NULL) return 0;
+ memcpy(mp, ip, elsize);
+ *max_ind = 0;
+ for(i=1; i<n; i++) {
+ ip += elsize;
+ if (@fname@_compare(ip,mp,aip) > 0) {
+ memcpy(mp, ip, elsize);
+ *max_ind=i;
+ }
+ }
+ _pya_free(mp);
+ return 0;
+}
+
+/**end repeat**/
+
+#define VOID_argmax NULL
+
+static void
+BOOL_dot(char *ip1, intp is1, char *ip2, intp is2, char *op, intp n,
+ void *ignore)
+{
+ register Bool tmp=FALSE;
+ register intp i;
+ for(i=0;i<n;i++,ip1+=is1,ip2+=is2) {
+ if ((*((Bool *)ip1) != 0) && (*((Bool *)ip2) != 0)) {
+ tmp = TRUE;
+ break;
+ }
+ }
+ *((Bool *)op) = tmp;
+}
+
+/**begin repeat
+#name=BYTE, UBYTE, SHORT, USHORT, INT, UINT, LONG, ULONG, LONGLONG, ULONGLONG, FLOAT, DOUBLE, LONGDOUBLE#
+#type= byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble#
+#out= long, ulong, long, ulong, long, ulong, long, ulong, longlong, ulonglong, float, double, longdouble#
+*/
+static void
+@name@_dot(char *ip1, intp is1, char *ip2, intp is2, char *op, intp n,
+ void *ignore)
+{
+ register @out@ tmp=(@out@)0;
+ register intp i;
+ for(i=0;i<n;i++,ip1+=is1,ip2+=is2) {
+ tmp += (@out@)(*((@type@ *)ip1)) * \
+ (@out@)(*((@type@ *)ip2));
+ }
+ *((@type@ *)op) = (@type@) tmp;
+}
+/**end repeat**/
+
+
+/**begin repeat
+#name=CFLOAT, CDOUBLE, CLONGDOUBLE#
+#type= float, double, longdouble#
+*/
+static void @name@_dot(char *ip1, intp is1, char *ip2, intp is2,
+ char *op, intp n, void *ignore)
+{
+ @type@ tmpr=(@type@)0.0, tmpi=(@type@)0.0;
+ intp i;
+ for(i=0;i<n;i++,ip1+=is1,ip2+=is2) {
+ tmpr += ((@type@ *)ip1)[0] * ((@type@ *)ip2)[0]
+ - ((@type@ *)ip1)[1] * ((@type@ *)ip2)[1];
+ tmpi += ((@type@ *)ip1)[1] * ((@type@ *)ip2)[0]
+ + ((@type@ *)ip1)[0] * ((@type@ *)ip2)[1];
+ }
+ ((@type@ *)op)[0] = tmpr; ((@type@ *)op)[1] = tmpi;
+}
+
+/**end repeat**/
+
+static void
+OBJECT_dot(char *ip1, intp is1, char *ip2, intp is2, char *op, intp n,
+ void *ignore)
+{
+ intp i;
+ PyObject *tmp1, *tmp2, *tmp=NULL;
+ PyObject **tmp3;
+ for(i=0;i<n;i++,ip1+=is1,ip2+=is2) {
+ if ((*((PyObject **)ip1) == NULL) || (*((PyObject **)ip2) == NULL)) {
+ tmp1 = Py_False;
+ Py_INCREF(Py_False);
+ }
+ else {
+ tmp1 = PyNumber_Multiply(*((PyObject **)ip1),
+ *((PyObject **)ip2));
+ if (!tmp1) { Py_XDECREF(tmp); return;}
+ }
+ if (i == 0) {
+ tmp = tmp1;
+ } else {
+ tmp2 = PyNumber_Add(tmp, tmp1);
+ Py_XDECREF(tmp);
+ Py_XDECREF(tmp1);
+ if (!tmp2) return;
+ tmp = tmp2;
+ }
+ }
+ tmp3 = (PyObject**) op;
+ tmp2 = *tmp3;
+ *((PyObject **)op) = tmp;
+ Py_XDECREF(tmp2);
+}
+
+#define BOOL_fill NULL
+
+/* this requires buffer to be filled with objects or NULL */
+static void
+OBJECT_fill(PyObject **buffer, intp length, void *ignored)
+{
+ intp i;
+ PyObject *start = buffer[0];
+ PyObject *delta = buffer[1];
+ delta = PyNumber_Subtract(delta, start);
+ if (!delta) return;
+ start = PyNumber_Add(start, delta);
+ if (!start) goto finish;
+ buffer += 2;
+
+ for (i=2; i<length; i++, buffer++) {
+ start = PyNumber_Add(start, delta);
+ if (!start) goto finish;
+ Py_XDECREF(*buffer);
+ *buffer = start;
+ }
+
+ finish:
+ Py_DECREF(delta);
+ return;
+}
+
+/**begin repeat
+#NAME=BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE#
+#typ=byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong,float,double,longdouble#
+*/
+static void
+@NAME@_fill(@typ@ *buffer, intp length, void *ignored)
+{
+ register intp i;
+ @typ@ start = buffer[0];
+ @typ@ delta = buffer[1];
+ delta -= start;
+ for (i=2; i<length; ++i) {
+ buffer[i] = start + i*delta;
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+#NAME=CFLOAT,CDOUBLE,CLONGDOUBLE#
+#typ=cfloat,cdouble,clongdouble#
+*/
+static void
+@NAME@_fill(@typ@ *buffer, intp length, void *ignored)
+{
+ register intp i;
+ @typ@ start;
+ @typ@ delta;
+
+ start.real = buffer->real;
+ start.imag = buffer->imag;
+ delta.real = buffer[1].real;
+ delta.imag = buffer[1].imag;
+ delta.real -= start.real;
+ delta.imag -= start.imag;
+ buffer += 2;
+ for (i=2; i<length; i++, buffer++) {
+ buffer->real = start.real + i*delta.real;
+ buffer->imag = start.imag + i*delta.imag;
+ }
+}
+/**end repeat**/
+
+
+/* this requires buffer to be filled with objects or NULL */
+static void
+OBJECT_fillwithscalar(PyObject **buffer, intp length, PyObject **value, void *ignored)
+{
+ intp i;
+ PyObject *val = *value;
+ for (i=0; i<length; i++) {
+ Py_XDECREF(buffer[i]);
+ Py_XINCREF(val);
+ buffer[i] = val;
+ }
+}
+/**begin repeat
+#NAME=BOOL,BYTE,UBYTE#
+#typ=Bool,byte,ubyte#
+*/
+static void
+@NAME@_fillwithscalar(@typ@ *buffer, intp length, @typ@ *value, void *ignored)
+{
+ memset(buffer, *value, length);
+}
+/**end repeat**/
+
+/**begin repeat
+#NAME=SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE,CFLOAT,CDOUBLE,CLONGDOUBLE#
+#typ=short,ushort,int,uint,long,ulong,longlong,ulonglong,float,double,longdouble,cfloat,cdouble,clongdouble#
+*/
+static void
+@NAME@_fillwithscalar(@typ@ *buffer, intp length, @typ@ *value, void *ignored)
+{
+ register intp i;
+ @typ@ val = *value;
+ for (i=0; i<length; ++i) {
+ buffer[i] = val;
+ }
+}
+
+/**end repeat**/
+
+
+
+/************************
+ * Fast clip functions
+ *************************/
+
+/**begin repeat
+#name=BOOL,BYTE, UBYTE, SHORT, USHORT, INT, UINT, LONG, ULONG, LONGLONG, ULONGLONG, FLOAT, DOUBLE, LONGDOUBLE#
+#type= Bool, byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble#
+*/
+static void
+@name@_fastclip(@type@ *in, intp ni, @type@ *min, @type@ *max, @type@ *out)
+{
+ register npy_intp i;
+ @type@ max_val, min_val;
+
+ max_val = *max;
+ min_val = *min;
+
+ for (i = 0; i < ni; i++) {
+ if (in[i] < min_val) {
+ out[i] = min_val;
+ } else if (in[i] > max_val) {
+ out[i] = max_val;
+ }
+ }
+
+ return;
+}
+/**end repeat**/
+
+/**begin repeat
+#name=CFLOAT, CDOUBLE, CLONGDOUBLE#
+#type= cfloat, cdouble, clongdouble#
+*/
+static void
+@name@_fastclip(@type@ *in, intp ni, @type@ *min, @type@ *max, @type@ *out)
+{
+ register npy_intp i;
+ @type@ max_val, min_val;
+
+ min_val = *min;
+ max_val = *max;
+
+ for (i = 0; i < ni; i++) {
+ if (PyArray_CLT(in[i], min_val)) {
+ out[i] = min_val;
+ } else if (PyArray_CGT(in[i], max_val)) {
+ out[i] = max_val;
+ }
+ }
+ return;
+}
+
+/**end repeat**/
+
+#define OBJECT_fastclip NULL
+
+#define _ALIGN(type) offsetof(struct {char c; type v;},v)
+
+/* Disable harmless compiler warning "4116: unnamed type definition in
+ parentheses" which is caused by the _ALIGN macro. */
+
+#if defined(_MSC_VER)
+#pragma warning(disable:4116)
+#endif
+
+
+/**begin repeat
+
+#from= VOID, STRING, UNICODE#
+#align= char, char, PyArray_UCS4#
+#NAME= Void, String, Unicode#
+#endian= |, |, =#
+*/
+
+static PyArray_ArrFuncs _Py@NAME@_ArrFuncs = {
+ {
+ (PyArray_VectorUnaryFunc*)@from@_to_BOOL,
+ (PyArray_VectorUnaryFunc*)@from@_to_BYTE,
+ (PyArray_VectorUnaryFunc*)@from@_to_UBYTE,
+ (PyArray_VectorUnaryFunc*)@from@_to_SHORT,
+ (PyArray_VectorUnaryFunc*)@from@_to_USHORT,
+ (PyArray_VectorUnaryFunc*)@from@_to_INT,
+ (PyArray_VectorUnaryFunc*)@from@_to_UINT,
+ (PyArray_VectorUnaryFunc*)@from@_to_LONG,
+ (PyArray_VectorUnaryFunc*)@from@_to_ULONG,
+ (PyArray_VectorUnaryFunc*)@from@_to_LONGLONG,
+ (PyArray_VectorUnaryFunc*)@from@_to_ULONGLONG,
+ (PyArray_VectorUnaryFunc*)@from@_to_FLOAT,
+ (PyArray_VectorUnaryFunc*)@from@_to_DOUBLE,
+ (PyArray_VectorUnaryFunc*)@from@_to_LONGDOUBLE,
+ (PyArray_VectorUnaryFunc*)@from@_to_CFLOAT,
+ (PyArray_VectorUnaryFunc*)@from@_to_CDOUBLE,
+ (PyArray_VectorUnaryFunc*)@from@_to_CLONGDOUBLE,
+ (PyArray_VectorUnaryFunc*)@from@_to_OBJECT,
+ (PyArray_VectorUnaryFunc*)@from@_to_STRING,
+ (PyArray_VectorUnaryFunc*)@from@_to_UNICODE,
+ (PyArray_VectorUnaryFunc*)@from@_to_VOID
+ },
+ (PyArray_GetItemFunc*)@from@_getitem,
+ (PyArray_SetItemFunc*)@from@_setitem,
+ (PyArray_CopySwapNFunc*)@from@_copyswapn,
+ (PyArray_CopySwapFunc*)@from@_copyswap,
+ (PyArray_CompareFunc*)@from@_compare,
+ (PyArray_ArgFunc*)@from@_argmax,
+ (PyArray_DotFunc*)NULL,
+ (PyArray_ScanFunc*)@from@_scan,
+ (PyArray_FromStrFunc*)@from@_fromstr,
+ (PyArray_NonzeroFunc*)@from@_nonzero,
+ (PyArray_FillFunc*)NULL,
+ (PyArray_FillWithScalarFunc*)NULL,
+ {
+ NULL, NULL, NULL
+ },
+ {
+ NULL, NULL, NULL
+ },
+ NULL,
+ (PyArray_ScalarKindFunc*)NULL,
+ NULL,
+ NULL,
+ (PyArray_FastClipFunc *)NULL
+};
+
+static PyArray_Descr @from@_Descr = {
+ PyObject_HEAD_INIT(&PyArrayDescr_Type)
+ &Py@NAME@ArrType_Type,
+ PyArray_@from@LTR,
+ PyArray_@from@LTR,
+ '@endian@', 0,
+ PyArray_@from@, 0,
+ _ALIGN(@align@),
+ NULL,
+ NULL,
+ NULL,
+ &_Py@NAME@_ArrFuncs,
+};
+
+/**end repeat**/
+
+
+/**begin repeat
+
+#from= BOOL,BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE,CFLOAT,CDOUBLE,CLONGDOUBLE,OBJECT#
+#num= 1*14,2*3,1#
+#fromtyp= Bool, byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble, float, double, longdouble, PyObject *#
+#NAME= Bool, Byte, UByte, Short, UShort, Int, UInt, Long, ULong, LongLong, ULongLong, Float, Double, LongDouble, CFloat, CDouble, CLongDouble, Object#
+#kind= GENBOOL, SIGNED, UNSIGNED, SIGNED, UNSIGNED, SIGNED, UNSIGNED, SIGNED, UNSIGNED, SIGNED, UNSIGNED, FLOATING, FLOATING, FLOATING, COMPLEX, COMPLEX, COMPLEX, OBJECT#
+#endian= |*3, =*14, |#
+#isobject= 0*17,NPY_OBJECT_DTYPE_FLAGS#
+*/
+
+static PyArray_ArrFuncs _Py@NAME@_ArrFuncs = {
+ {
+ (PyArray_VectorUnaryFunc*)@from@_to_BOOL,
+ (PyArray_VectorUnaryFunc*)@from@_to_BYTE,
+ (PyArray_VectorUnaryFunc*)@from@_to_UBYTE,
+ (PyArray_VectorUnaryFunc*)@from@_to_SHORT,
+ (PyArray_VectorUnaryFunc*)@from@_to_USHORT,
+ (PyArray_VectorUnaryFunc*)@from@_to_INT,
+ (PyArray_VectorUnaryFunc*)@from@_to_UINT,
+ (PyArray_VectorUnaryFunc*)@from@_to_LONG,
+ (PyArray_VectorUnaryFunc*)@from@_to_ULONG,
+ (PyArray_VectorUnaryFunc*)@from@_to_LONGLONG,
+ (PyArray_VectorUnaryFunc*)@from@_to_ULONGLONG,
+ (PyArray_VectorUnaryFunc*)@from@_to_FLOAT,
+ (PyArray_VectorUnaryFunc*)@from@_to_DOUBLE,
+ (PyArray_VectorUnaryFunc*)@from@_to_LONGDOUBLE,
+ (PyArray_VectorUnaryFunc*)@from@_to_CFLOAT,
+ (PyArray_VectorUnaryFunc*)@from@_to_CDOUBLE,
+ (PyArray_VectorUnaryFunc*)@from@_to_CLONGDOUBLE,
+ (PyArray_VectorUnaryFunc*)@from@_to_OBJECT,
+ (PyArray_VectorUnaryFunc*)@from@_to_STRING,
+ (PyArray_VectorUnaryFunc*)@from@_to_UNICODE,
+ (PyArray_VectorUnaryFunc*)@from@_to_VOID
+ },
+ (PyArray_GetItemFunc*)@from@_getitem,
+ (PyArray_SetItemFunc*)@from@_setitem,
+ (PyArray_CopySwapNFunc*)@from@_copyswapn,
+ (PyArray_CopySwapFunc*)@from@_copyswap,
+ (PyArray_CompareFunc*)@from@_compare,
+ (PyArray_ArgFunc*)@from@_argmax,
+ (PyArray_DotFunc*)@from@_dot,
+ (PyArray_ScanFunc*)@from@_scan,
+ (PyArray_FromStrFunc*)@from@_fromstr,
+ (PyArray_NonzeroFunc*)@from@_nonzero,
+ (PyArray_FillFunc*)@from@_fill,
+ (PyArray_FillWithScalarFunc*)@from@_fillwithscalar,
+ {
+ NULL, NULL, NULL
+ },
+ {
+ NULL, NULL, NULL
+ },
+ NULL,
+ (PyArray_ScalarKindFunc*)NULL,
+ NULL,
+ NULL,
+ (PyArray_FastClipFunc*)@from@_fastclip
+};
+
+static PyArray_Descr @from@_Descr = {
+ PyObject_HEAD_INIT(&PyArrayDescr_Type)
+ &Py@NAME@ArrType_Type,
+ PyArray_@kind@LTR,
+ PyArray_@from@LTR,
+ '@endian@', @isobject@,
+ PyArray_@from@,
+ @num@*sizeof(@fromtyp@),
+ _ALIGN(@fromtyp@),
+ NULL,
+ NULL,
+ NULL,
+ &_Py@NAME@_ArrFuncs,
+};
+
+/**end repeat**/
+
+#define _MAX_LETTER 128
+static char _letter_to_num[_MAX_LETTER];
+
+static PyArray_Descr *_builtin_descrs[] = {
+ &BOOL_Descr,
+ &BYTE_Descr,
+ &UBYTE_Descr,
+ &SHORT_Descr,
+ &USHORT_Descr,
+ &INT_Descr,
+ &UINT_Descr,
+ &LONG_Descr,
+ &ULONG_Descr,
+ &LONGLONG_Descr,
+ &ULONGLONG_Descr,
+ &FLOAT_Descr,
+ &DOUBLE_Descr,
+ &LONGDOUBLE_Descr,
+ &CFLOAT_Descr,
+ &CDOUBLE_Descr,
+ &CLONGDOUBLE_Descr,
+ &OBJECT_Descr,
+ &STRING_Descr,
+ &UNICODE_Descr,
+ &VOID_Descr,
+};
+
+/*OBJECT_API
+ Get the PyArray_Descr structure for a type.
+*/
+static PyArray_Descr *
+PyArray_DescrFromType(int type)
+{
+ PyArray_Descr *ret=NULL;
+
+ if (type < PyArray_NTYPES) {
+ ret = _builtin_descrs[type];
+ }
+ else if (type == PyArray_NOTYPE) {
+ /* This needs to not raise an error so
+ that PyArray_DescrFromType(PyArray_NOTYPE)
+ works for backwards-compatible C-API
+ */
+ return NULL;
+ }
+ else if ((type == PyArray_CHAR) || \
+ (type == PyArray_CHARLTR)) {
+ ret = PyArray_DescrNew(_builtin_descrs[PyArray_STRING]);
+ ret->elsize = 1;
+ ret->type = PyArray_CHARLTR;
+ return ret;
+ }
+ else if PyTypeNum_ISUSERDEF(type) {
+ ret = userdescrs[type-PyArray_USERDEF];
+ }
+ else {
+ int num=PyArray_NTYPES;
+ if (type < _MAX_LETTER)
+ num = (int) _letter_to_num[type];
+ if (num >= PyArray_NTYPES)
+ ret = NULL;
+ else
+ ret = _builtin_descrs[num];
+ }
+ if (ret==NULL) {
+ PyErr_SetString(PyExc_ValueError,
+ "Invalid data-type for array");
+ }
+ else Py_INCREF(ret);
+ return ret;
+}
+
+
+static int
+set_typeinfo(PyObject *dict)
+{
+ PyObject *infodict, *s;
+ int i;
+
+ for (i=0; i<_MAX_LETTER; i++) {
+ _letter_to_num[i] = PyArray_NTYPES;
+ }
+
+/**begin repeat
+#name=BOOL,BYTE,UBYTE,SHORT,USHORT,INT,UINT,INTP,UINTP,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE,CFLOAT,CDOUBLE,CLONGDOUBLE,OBJECT,STRING,UNICODE,VOID#
+*/
+ _letter_to_num[PyArray_@name@LTR] = PyArray_@name@;
+/**end repeat**/
+ _letter_to_num[PyArray_STRINGLTR2] = PyArray_STRING;
+
+/**begin repeat
+#name=BOOL,BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE,CFLOAT,CDOUBLE,CLONGDOUBLE,OBJECT,STRING,UNICODE,VOID#
+*/
+ @name@_Descr.fields = Py_None;
+/**end repeat**/
+
+ /* Set a dictionary with type information */
+ infodict = PyDict_New();
+ if (infodict == NULL) return -1;
+
+#define BITSOF_INTP CHAR_BIT*SIZEOF_PY_INTPTR_T
+#define BITSOF_BYTE CHAR_BIT
+
+/**begin repeat
+
+#name=BOOL,BYTE,UBYTE,SHORT,USHORT,INT,UINT,INTP,UINTP,LONG,ULONG,LONGLONG,ULONGLONG#
+#uname=BOOL,BYTE*2,SHORT*2,INT*2,INTP*2,LONG*2,LONGLONG*2#
+#Name=Bool,Byte,UByte,Short,UShort,Int,UInt,Intp,UIntp,Long,ULong,LongLong,ULongLong#
+#type=Bool,byte,ubyte,short,ushort,int,uint,intp,uintp,long,ulong,longlong,ulonglong#
+#max=1,MAX_BYTE,MAX_UBYTE,MAX_SHORT,MAX_USHORT,MAX_INT,PyLong_FromUnsignedLong(MAX_UINT),PyLong_FromLongLong((longlong) MAX_INTP),PyLong_FromUnsignedLongLong((ulonglong) MAX_UINTP),MAX_LONG,PyLong_FromUnsignedLong((unsigned long) MAX_ULONG),PyLong_FromLongLong((longlong) MAX_LONGLONG), PyLong_FromUnsignedLongLong((ulonglong) MAX_ULONGLONG)#
+#min=0,MIN_BYTE,0,MIN_SHORT,0,MIN_INT,0,PyLong_FromLongLong((longlong) MIN_INTP),0,MIN_LONG,0,PyLong_FromLongLong((longlong) MIN_LONGLONG),0#
+#cx=i*6,N,N,N,l,N,N,N#
+#cn=i*7,N,i,l,i,N,i#
+*/
+ PyDict_SetItemString(infodict, "@name@",
+ s=Py_BuildValue("ciii@cx@@cn@O",
+ PyArray_@name@LTR,
+ PyArray_@name@,
+ BITSOF_@uname@,
+ _ALIGN(@type@),
+ @max@, @min@,
+ (PyObject *)&Py@Name@ArrType_Type));
+ Py_DECREF(s);
+/**end repeat**/
+
+#define BITSOF_CFLOAT 2*BITSOF_FLOAT
+#define BITSOF_CDOUBLE 2*BITSOF_DOUBLE
+#define BITSOF_CLONGDOUBLE 2*BITSOF_LONGDOUBLE
+
+/**begin repeat
+
+#type=float,double,longdouble,cfloat,cdouble,clongdouble#
+#name=FLOAT, DOUBLE, LONGDOUBLE, CFLOAT, CDOUBLE, CLONGDOUBLE#
+#Name=Float,Double,LongDouble,CFloat,CDouble,CLongDouble#
+*/
+ PyDict_SetItemString(infodict, "@name@",
+ s=Py_BuildValue("ciiiO", PyArray_@name@LTR,
+ PyArray_@name@, BITSOF_@name@,
+ _ALIGN(@type@),
+ (PyObject *)\
+ &Py@Name@ArrType_Type));
+ Py_DECREF(s);
+/**end repeat**/
+
+ PyDict_SetItemString(infodict, "OBJECT",
+ s=Py_BuildValue("ciiiO", PyArray_OBJECTLTR,
+ PyArray_OBJECT,
+ sizeof(PyObject *)*CHAR_BIT,
+ _ALIGN(PyObject *),
+ (PyObject *)\
+ &PyObjectArrType_Type));
+ Py_DECREF(s);
+ PyDict_SetItemString(infodict, "STRING",
+ s=Py_BuildValue("ciiiO", PyArray_STRINGLTR,
+ PyArray_STRING, 0,
+ _ALIGN(char),
+ (PyObject *)\
+ &PyStringArrType_Type));
+ Py_DECREF(s);
+ PyDict_SetItemString(infodict, "UNICODE",
+ s=Py_BuildValue("ciiiO", PyArray_UNICODELTR,
+ PyArray_UNICODE, 0,
+ _ALIGN(PyArray_UCS4),
+ (PyObject *)\
+ &PyUnicodeArrType_Type));
+ Py_DECREF(s);
+ PyDict_SetItemString(infodict, "VOID",
+ s=Py_BuildValue("ciiiO", PyArray_VOIDLTR,
+ PyArray_VOID, 0,
+ _ALIGN(char),
+ (PyObject *)\
+ &PyVoidArrType_Type));
+ Py_DECREF(s);
+
+#define SETTYPE(name) \
+ Py_INCREF(&Py##name##ArrType_Type); \
+ PyDict_SetItemString(infodict, #name, \
+ (PyObject *)&Py##name##ArrType_Type);
+
+ SETTYPE(Generic)
+ SETTYPE(Number)
+ SETTYPE(Integer)
+ SETTYPE(Inexact)
+ SETTYPE(SignedInteger)
+ SETTYPE(UnsignedInteger)
+ SETTYPE(Floating)
+ SETTYPE(ComplexFloating)
+ SETTYPE(Flexible)
+ SETTYPE(Character)
+
+#undef SETTYPE
+
+ PyDict_SetItemString(dict, "typeinfo", infodict);
+ Py_DECREF(infodict);
+ return 0;
+}
+
+#undef _MAX_LETTER
diff --git a/numpy/core/src/multiarraymodule.c b/numpy/core/src/multiarraymodule.c
new file mode 100644
index 000000000..c63ebff6c
--- /dev/null
+++ b/numpy/core/src/multiarraymodule.c
@@ -0,0 +1,7604 @@
+/*
+ Python Multiarray Module -- A useful collection of functions for creating and
+ using ndarrays
+
+ Original file
+ Copyright (c) 1995, 1996, 1997 Jim Hugunin, hugunin@mit.edu
+
+ Modified for numpy in 2005
+
+ Travis E. Oliphant
+ oliphant@ee.byu.edu
+ Brigham Young University
+*/
+
+/* $Id: multiarraymodule.c,v 1.36 2005/09/14 00:14:00 teoliphant Exp $ */
+
+#define PY_SSIZE_T_CLEAN
+#include "Python.h"
+#include "structmember.h"
+
+#define _MULTIARRAYMODULE
+#define NPY_NO_PREFIX
+#include "numpy/arrayobject.h"
+
+#define PyAO PyArrayObject
+
+
+static PyObject *typeDict=NULL; /* Must be explicitly loaded */
+
+static PyArray_Descr *
+_arraydescr_fromobj(PyObject *obj)
+{
+ PyObject *dtypedescr;
+ PyArray_Descr *new;
+ int ret;
+
+ dtypedescr = PyObject_GetAttrString(obj, "dtype");
+ PyErr_Clear();
+ if (dtypedescr) {
+ ret = PyArray_DescrConverter(dtypedescr, &new);
+ Py_DECREF(dtypedescr);
+ if (ret == PY_SUCCEED) return new;
+ PyErr_Clear();
+ }
+ /* Understand basic ctypes */
+ dtypedescr = PyObject_GetAttrString(obj, "_type_");
+ PyErr_Clear();
+ if (dtypedescr) {
+ ret = PyArray_DescrConverter(dtypedescr, &new);
+ Py_DECREF(dtypedescr);
+ if (ret == PY_SUCCEED) {
+ PyObject *length;
+ length = PyObject_GetAttrString(obj, "_length_");
+ PyErr_Clear();
+ if (length) { /* derived type */
+ PyObject *newtup;
+ PyArray_Descr *derived;
+ newtup = Py_BuildValue("NO", new, length);
+ ret = PyArray_DescrConverter(newtup, &derived);
+ Py_DECREF(newtup);
+ if (ret == PY_SUCCEED) return derived;
+ PyErr_Clear();
+ return NULL;
+ }
+ return new;
+ }
+ PyErr_Clear();
+ return NULL;
+ }
+ /* Understand ctypes structures --
+ bit-fields are not supported
+ automatically aligns */
+ dtypedescr = PyObject_GetAttrString(obj, "_fields_");
+ PyErr_Clear();
+ if (dtypedescr) {
+ ret = PyArray_DescrAlignConverter(dtypedescr, &new);
+ Py_DECREF(dtypedescr);
+ if (ret == PY_SUCCEED) return new;
+ PyErr_Clear();
+ }
+ return NULL;
+}
+
+
+/* Including this file is the only way I know how to declare functions
+ static in each file, and store the pointers from functions in both
+ arrayobject.c and multiarraymodule.c for the C-API
+
+ Declarying an external pointer-containing variable in arrayobject.c
+ and trying to copy it to PyArray_API, did not work.
+
+ Think about two modules with a common api that import each other...
+
+ This file would just be the module calls.
+*/
+
+#include "arrayobject.c"
+
+
+/* An Error object -- rarely used? */
+static PyObject *MultiArrayError;
+
+/*MULTIARRAY_API
+ Multiply a List of ints
+*/
+static int
+PyArray_MultiplyIntList(register int *l1, register int n)
+{
+ register int s=1;
+ while (n--) s *= (*l1++);
+ return s;
+}
+
+/*MULTIARRAY_API
+ Multiply a List
+*/
+static intp
+PyArray_MultiplyList(register intp *l1, register int n)
+{
+ register intp s=1;
+ while (n--) s *= (*l1++);
+ return s;
+}
+
+/*MULTIARRAY_API
+ Produce a pointer into array
+*/
+static void *
+PyArray_GetPtr(PyArrayObject *obj, register intp* ind)
+{
+ register int n = obj->nd;
+ register intp *strides = obj->strides;
+ register char *dptr = obj->data;
+
+ while (n--) dptr += (*strides++) * (*ind++);
+ return (void *)dptr;
+}
+
+/*MULTIARRAY_API
+ Get axis from an object (possibly None) -- a converter function,
+*/
+static int
+PyArray_AxisConverter(PyObject *obj, int *axis)
+{
+ if (obj == Py_None) {
+ *axis = MAX_DIMS;
+ }
+ else {
+ *axis = (int) PyInt_AsLong(obj);
+ if (PyErr_Occurred()) {
+ return PY_FAIL;
+ }
+ }
+ return PY_SUCCEED;
+}
+
+/*MULTIARRAY_API
+ Compare Lists
+*/
+static int
+PyArray_CompareLists(intp *l1, intp *l2, int n)
+{
+ int i;
+ for(i=0;i<n;i++) {
+ if (l1[i] != l2[i]) return 0;
+ }
+ return 1;
+}
+
+/* steals a reference to type -- accepts NULL */
+/*MULTIARRAY_API
+ View
+*/
+static PyObject *
+PyArray_View(PyArrayObject *self, PyArray_Descr *type, PyTypeObject *pytype)
+{
+ PyObject *new=NULL;
+ PyTypeObject *subtype;
+
+ if (pytype) subtype = pytype;
+ else subtype = self->ob_type;
+
+ Py_INCREF(self->descr);
+ new = PyArray_NewFromDescr(subtype,
+ self->descr,
+ self->nd, self->dimensions,
+ self->strides,
+ self->data,
+ self->flags, (PyObject *)self);
+
+ if (new==NULL) return NULL;
+ Py_INCREF(self);
+ PyArray_BASE(new) = (PyObject *)self;
+
+ if (type != NULL) {
+ if (PyObject_SetAttrString(new, "dtype",
+ (PyObject *)type) < 0) {
+ Py_DECREF(new);
+ Py_DECREF(type);
+ return NULL;
+ }
+ Py_DECREF(type);
+ }
+ return new;
+}
+
+/* Returns a contiguous array */
+
+/*MULTIARRAY_API
+ Ravel
+*/
+static PyObject *
+PyArray_Ravel(PyArrayObject *a, NPY_ORDER fortran)
+{
+ PyArray_Dims newdim = {NULL,1};
+ intp val[1] = {-1};
+
+ if (fortran == PyArray_ANYORDER)
+ fortran = PyArray_ISFORTRAN(a);
+
+ newdim.ptr = val;
+ if (!fortran && PyArray_ISCONTIGUOUS(a)) {
+ return PyArray_Newshape(a, &newdim, PyArray_CORDER);
+ }
+ else if (fortran && PyArray_ISFORTRAN(a)) {
+ return PyArray_Newshape(a, &newdim, PyArray_FORTRANORDER);
+ }
+ else
+ return PyArray_Flatten(a, fortran);
+}
+
+static double
+power_of_ten(int n)
+{
+ static const double p10[] = {1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8};
+ double ret;
+ if (n < 9)
+ ret = p10[n];
+ else {
+ ret = 1e9;
+ while (n-- > 9)
+ ret *= 10.;
+ }
+ return ret;
+}
+
+/*MULTIARRAY_API
+ Round
+*/
+static PyObject *
+PyArray_Round(PyArrayObject *a, int decimals, PyArrayObject *out)
+{
+ PyObject *f, *ret=NULL, *tmp, *op1, *op2;
+ int ret_int=0;
+ PyArray_Descr *my_descr;
+ if (out && (PyArray_SIZE(out) != PyArray_SIZE(a))) {
+ PyErr_SetString(PyExc_ValueError,
+ "invalid output shape");
+ return NULL;
+ }
+ if (PyArray_ISCOMPLEX(a)) {
+ PyObject *part;
+ PyObject *round_part;
+ PyObject *new;
+ int res;
+ if (out) {
+ new = (PyObject *)out;
+ Py_INCREF(new);
+ }
+ else {
+ new = PyArray_Copy(a);
+ if (new == NULL) return NULL;
+ }
+
+ /* new.real = a.real.round(decimals) */
+ part = PyObject_GetAttrString(new, "real");
+ if (part == NULL) {Py_DECREF(new); return NULL;}
+ part = PyArray_EnsureAnyArray(part);
+ round_part = PyArray_Round((PyArrayObject *)part,
+ decimals, NULL);
+ Py_DECREF(part);
+ if (round_part == NULL) {Py_DECREF(new); return NULL;}
+ res = PyObject_SetAttrString(new, "real", round_part);
+ Py_DECREF(round_part);
+ if (res < 0) {Py_DECREF(new); return NULL;}
+
+ /* new.imag = a.imag.round(decimals) */
+ part = PyObject_GetAttrString(new, "imag");
+ if (part == NULL) {Py_DECREF(new); return NULL;}
+ part = PyArray_EnsureAnyArray(part);
+ round_part = PyArray_Round((PyArrayObject *)part,
+ decimals, NULL);
+ Py_DECREF(part);
+ if (round_part == NULL) {Py_DECREF(new); return NULL;}
+ res = PyObject_SetAttrString(new, "imag", round_part);
+ Py_DECREF(round_part);
+ if (res < 0) {Py_DECREF(new); return NULL;}
+ return new;
+ }
+ /* do the most common case first */
+ if (decimals >= 0) {
+ if (PyArray_ISINTEGER(a)) {
+ if (out) {
+ if (PyArray_CopyAnyInto(out, a) < 0) return NULL;
+ Py_INCREF(out);
+ return (PyObject *)out;
+ }
+ else {
+ Py_INCREF(a);
+ return (PyObject *)a;
+ }
+ }
+ if (decimals == 0) {
+ if (out) {
+ return PyObject_CallFunction(n_ops.rint, "OO",
+ a, out);
+ }
+ return PyObject_CallFunction(n_ops.rint, "O", a);
+ }
+ op1 = n_ops.multiply;
+ op2 = n_ops.true_divide;
+ }
+ else {
+ op1 = n_ops.true_divide;
+ op2 = n_ops.multiply;
+ decimals = -decimals;
+ }
+ if (!out) {
+ if (PyArray_ISINTEGER(a)) {
+ ret_int = 1;
+ my_descr = PyArray_DescrFromType(NPY_DOUBLE);
+ }
+ else {
+ Py_INCREF(a->descr);
+ my_descr = a->descr;
+ }
+ out = (PyArrayObject *)PyArray_Empty(a->nd, a->dimensions,
+ my_descr,
+ PyArray_ISFORTRAN(a));
+ if (out == NULL) return NULL;
+ }
+ else Py_INCREF(out);
+ f = PyFloat_FromDouble(power_of_ten(decimals));
+ if (f==NULL) return NULL;
+ ret = PyObject_CallFunction(op1, "OOO", a, f, out);
+ if (ret==NULL) goto finish;
+ tmp = PyObject_CallFunction(n_ops.rint, "OO", ret, ret);
+ if (tmp == NULL) {Py_DECREF(ret); ret=NULL; goto finish;}
+ Py_DECREF(tmp);
+ tmp = PyObject_CallFunction(op2, "OOO", ret, f, ret);
+ if (tmp == NULL) {Py_DECREF(ret); ret=NULL; goto finish;}
+ Py_DECREF(tmp);
+
+ finish:
+ Py_DECREF(f);
+ Py_DECREF(out);
+ if (ret_int) {
+ Py_INCREF(a->descr);
+ tmp = PyArray_CastToType((PyArrayObject *)ret,
+ a->descr, PyArray_ISFORTRAN(a));
+ Py_DECREF(ret);
+ return tmp;
+ }
+ return ret;
+
+}
+
+
+/*MULTIARRAY_API
+ Flatten
+*/
+static PyObject *
+PyArray_Flatten(PyArrayObject *a, NPY_ORDER order)
+{
+ PyObject *ret;
+ intp size;
+
+ if (order == PyArray_ANYORDER)
+ order = PyArray_ISFORTRAN(a);
+
+ size = PyArray_SIZE(a);
+ Py_INCREF(a->descr);
+ ret = PyArray_NewFromDescr(a->ob_type,
+ a->descr,
+ 1, &size,
+ NULL,
+ NULL,
+ 0, (PyObject *)a);
+
+ if (ret== NULL) return NULL;
+ if (_flat_copyinto(ret, (PyObject *)a, order) < 0) {
+ Py_DECREF(ret);
+ return NULL;
+ }
+ return ret;
+}
+
+
+/* For back-ward compatability *
+
+/ * Not recommended */
+
+/*MULTIARRAY_API
+ Reshape an array
+*/
+static PyObject *
+PyArray_Reshape(PyArrayObject *self, PyObject *shape)
+{
+ PyObject *ret;
+ PyArray_Dims newdims;
+
+ if (!PyArray_IntpConverter(shape, &newdims)) return NULL;
+ ret = PyArray_Newshape(self, &newdims, PyArray_CORDER);
+ PyDimMem_FREE(newdims.ptr);
+ return ret;
+}
+
+/* inserts 0 for strides where dimension will be 1 */
+static int
+_check_ones(PyArrayObject *self, int newnd, intp* newdims, intp *strides)
+{
+ int nd;
+ intp *dims;
+ Bool done=FALSE;
+ int j, k;
+
+ nd = self->nd;
+ dims = self->dimensions;
+
+ for (k=0, j=0; !done && (j<nd || k<newnd);) {
+ if ((j<nd) && (k<newnd) && (newdims[k]==dims[j])) {
+ strides[k] = self->strides[j];
+ j++; k++;
+ }
+ else if ((k<newnd) && (newdims[k]==1)) {
+ strides[k] = 0;
+ k++;
+ }
+ else if ((j<nd) && (dims[j]==1)) {
+ j++;
+ }
+ else done=TRUE;
+ }
+ if (done) return -1;
+ return 0;
+}
+
+/* attempt to reshape an array without copying data
+ *
+ * This function should correctly handle all reshapes, including
+ * axes of length 1. Zero strides should work but are untested.
+ *
+ * If a copy is needed, returns 0
+ * If no copy is needed, returns 1 and fills newstrides
+ * with appropriate strides
+ *
+ * The "fortran" argument describes how the array should be viewed
+ * during the reshape, not how it is stored in memory (that
+ * information is in self->strides).
+ *
+ * If some output dimensions have length 1, the strides assigned to
+ * them are arbitrary. In the current implementation, they are the
+ * stride of the next-fastest index.
+ */
+static int
+_attempt_nocopy_reshape(PyArrayObject *self, int newnd, intp* newdims,
+ intp *newstrides, int fortran)
+{
+ int oldnd;
+ intp olddims[MAX_DIMS];
+ intp oldstrides[MAX_DIMS];
+ int oi, oj, ok, ni, nj, nk;
+ int np, op;
+
+ oldnd = 0;
+ for (oi=0; oi<self->nd; oi++) {
+ if (self->dimensions[oi]!=1) {
+ olddims[oldnd] = self->dimensions[oi];
+ oldstrides[oldnd] = self->strides[oi];
+ oldnd++;
+ }
+ }
+
+ /*
+ fprintf(stderr, "_attempt_nocopy_reshape( (");
+ for (oi=0; oi<oldnd; oi++)
+ fprintf(stderr, "(%d,%d), ", olddims[oi], oldstrides[oi]);
+ fprintf(stderr, ") -> (");
+ for (ni=0; ni<newnd; ni++)
+ fprintf(stderr, "(%d,*), ", newdims[ni]);
+ fprintf(stderr, "), fortran=%d)\n", fortran);
+ */
+
+
+ np = 1;
+ for (ni=0; ni<newnd; ni++) np*=newdims[ni];
+
+ op = 1;
+ for (oi=0; oi<oldnd; oi++) op*=olddims[oi];
+
+ if (np != op) return 0; /* different total sizes; no hope */
+
+
+ oi = 0;
+ oj = 1;
+ ni = 0;
+ nj = 1;
+
+ while(ni<newnd && oi<oldnd) {
+
+ np = newdims[ni];
+ op = olddims[oi];
+
+ while (np!=op) {
+ if (np<op) {
+ np *= newdims[nj++];
+ } else {
+ op *= olddims[oj++];
+ }
+ }
+
+ for(ok=oi; ok<oj-1; ok++) {
+ if (fortran) {
+ if (oldstrides[ok+1] != \
+ olddims[ok]*oldstrides[ok])
+ return 0; /* not contiguous enough */
+ } else { /* C order */
+ if (oldstrides[ok] != \
+ olddims[ok+1]*oldstrides[ok+1])
+ return 0; /* not contiguous enough */
+ }
+ }
+
+ if (fortran) {
+ newstrides[ni]=oldstrides[oi];
+ for (nk=ni+1;nk<nj;nk++)
+ newstrides[nk]=newstrides[nk-1]*newdims[nk-1];
+ } else { /* C order */
+ newstrides[nj-1]=oldstrides[oj-1];
+ for (nk=nj-1;nk>ni;nk--)
+ newstrides[nk-1]=newstrides[nk]*newdims[nk];
+ }
+
+ ni = nj++;
+ oi = oj++;
+
+ }
+
+ /*
+ fprintf(stderr, "success: _attempt_nocopy_reshape (");
+ for (oi=0; oi<oldnd; oi++)
+ fprintf(stderr, "(%d,%d), ", olddims[oi], oldstrides[oi]);
+ fprintf(stderr, ") -> (");
+ for (ni=0; ni<newnd; ni++)
+ fprintf(stderr, "(%d,%d), ", newdims[ni], newstrides[ni]);
+ fprintf(stderr, ")\n");
+ */
+
+ return 1;
+}
+
+static int
+_fix_unknown_dimension(PyArray_Dims *newshape, intp s_original)
+{
+ intp *dimensions;
+ intp i_unknown, s_known;
+ int i, n;
+ static char msg[] = "total size of new array must be unchanged";
+
+ dimensions = newshape->ptr;
+ n = newshape->len;
+ s_known = 1;
+ i_unknown = -1;
+
+ for(i=0; i<n; i++) {
+ if (dimensions[i] < 0) {
+ if (i_unknown == -1) {
+ i_unknown = i;
+ } else {
+ PyErr_SetString(PyExc_ValueError,
+ "can only specify one" \
+ " unknown dimension");
+ return -1;
+ }
+ } else {
+ s_known *= dimensions[i];
+ }
+ }
+
+ if (i_unknown >= 0) {
+ if ((s_known == 0) || (s_original % s_known != 0)) {
+ PyErr_SetString(PyExc_ValueError, msg);
+ return -1;
+ }
+ dimensions[i_unknown] = s_original/s_known;
+ } else {
+ if (s_original != s_known) {
+ PyErr_SetString(PyExc_ValueError, msg);
+ return -1;
+ }
+ }
+ return 0;
+}
+
+/* Returns a new array
+ with the new shape from the data
+ in the old array --- order-perspective depends on fortran argument.
+ copy-only-if-necessary
+*/
+
+/*MULTIARRAY_API
+ New shape for an array
+*/
+static PyObject *
+PyArray_Newshape(PyArrayObject *self, PyArray_Dims *newdims,
+ NPY_ORDER fortran)
+{
+ intp i;
+ intp *dimensions = newdims->ptr;
+ PyArrayObject *ret;
+ int n = newdims->len;
+ Bool same, incref=TRUE;
+ intp *strides = NULL;
+ intp newstrides[MAX_DIMS];
+ int flags;
+
+ if (fortran == PyArray_ANYORDER)
+ fortran = PyArray_ISFORTRAN(self);
+
+ /* Quick check to make sure anything actually needs to be done */
+ if (n == self->nd) {
+ same = TRUE;
+ i=0;
+ while(same && i<n) {
+ if (PyArray_DIM(self,i) != dimensions[i])
+ same=FALSE;
+ i++;
+ }
+ if (same) return PyArray_View(self, NULL, NULL);
+ }
+
+ /* Returns a pointer to an appropriate strides array
+ if all we are doing is inserting ones into the shape,
+ or removing ones from the shape
+ or doing a combination of the two
+ In this case we don't need to do anything but update strides and
+ dimensions. So, we can handle non single-segment cases.
+ */
+ i=_check_ones(self, n, dimensions, newstrides);
+ if (i==0) strides=newstrides;
+
+ flags = self->flags;
+
+ if (strides==NULL) { /* we are really re-shaping not just adding ones
+ to the shape somewhere */
+
+ /* fix any -1 dimensions and check new-dimensions against
+ old size */
+ if (_fix_unknown_dimension(newdims, PyArray_SIZE(self)) < 0)
+ return NULL;
+
+ /* sometimes we have to create a new copy of the array
+ in order to get the right orientation and
+ because we can't just re-use the buffer with the
+ data in the order it is in.
+ */
+ if (!(PyArray_ISONESEGMENT(self)) ||
+ (((PyArray_CHKFLAGS(self, NPY_CONTIGUOUS) &&
+ fortran == NPY_FORTRANORDER)
+ || (PyArray_CHKFLAGS(self, NPY_FORTRAN) &&
+ fortran == NPY_CORDER)) && (self->nd > 1))) {
+
+ int success=0;
+ success = _attempt_nocopy_reshape(self,n,dimensions,
+ newstrides,fortran);
+ if (success) {
+ /* no need to copy the array after all */
+ strides = newstrides;
+ flags = self->flags;
+ } else {
+ PyObject *new;
+ new = PyArray_NewCopy(self, fortran);
+ if (new == NULL) return NULL;
+ incref = FALSE;
+ self = (PyArrayObject *)new;
+ flags = self->flags;
+ }
+ }
+
+ /* We always have to interpret the contiguous buffer correctly
+ */
+
+ /* Make sure the flags argument is set.
+ */
+ if (n > 1) {
+ if (fortran == NPY_FORTRANORDER) {
+ flags &= ~NPY_CONTIGUOUS;
+ flags |= NPY_FORTRAN;
+ }
+ else {
+ flags &= ~NPY_FORTRAN;
+ flags |= NPY_CONTIGUOUS;
+ }
+ }
+ }
+ else if (n > 0) {
+ /* replace any 0-valued strides with
+ appropriate value to preserve contiguousness
+ */
+ if (fortran == PyArray_FORTRANORDER) {
+ if (strides[0] == 0)
+ strides[0] = self->descr->elsize;
+ for (i=1; i<n; i++) {
+ if (strides[i] == 0)
+ strides[i] = strides[i-1] * \
+ dimensions[i-1];
+ }
+ }
+ else {
+ if (strides[n-1] == 0)
+ strides[n-1] = self->descr->elsize;
+ for (i=n-2; i>-1; i--) {
+ if (strides[i] == 0)
+ strides[i] = strides[i+1] * \
+ dimensions[i+1];
+ }
+ }
+ }
+
+ Py_INCREF(self->descr);
+ ret = (PyAO *)PyArray_NewFromDescr(self->ob_type,
+ self->descr,
+ n, dimensions,
+ strides,
+ self->data,
+ flags, (PyObject *)self);
+
+ if (ret== NULL) goto fail;
+
+ if (incref) Py_INCREF(self);
+ ret->base = (PyObject *)self;
+ PyArray_UpdateFlags(ret, CONTIGUOUS | FORTRAN);
+
+ return (PyObject *)ret;
+
+ fail:
+ if (!incref) {Py_DECREF(self);}
+ return NULL;
+}
+
+
+
+/* return a new view of the array object with all of its unit-length
+ dimensions squeezed out if needed, otherwise
+ return the same array.
+ */
+
+/*MULTIARRAY_API*/
+static PyObject *
+PyArray_Squeeze(PyArrayObject *self)
+{
+ int nd = self->nd;
+ int newnd = nd;
+ intp dimensions[MAX_DIMS];
+ intp strides[MAX_DIMS];
+ int i,j;
+ PyObject *ret;
+
+ if (nd == 0) {
+ Py_INCREF(self);
+ return (PyObject *)self;
+ }
+ for (j=0, i=0; i<nd; i++) {
+ if (self->dimensions[i] == 1) {
+ newnd -= 1;
+ }
+ else {
+ dimensions[j] = self->dimensions[i];
+ strides[j++] = self->strides[i];
+ }
+ }
+
+ Py_INCREF(self->descr);
+ ret = PyArray_NewFromDescr(self->ob_type,
+ self->descr,
+ newnd, dimensions,
+ strides, self->data,
+ self->flags,
+ (PyObject *)self);
+ if (ret == NULL) return NULL;
+ PyArray_FLAGS(ret) &= ~OWNDATA;
+ PyArray_BASE(ret) = (PyObject *)self;
+ Py_INCREF(self);
+ return (PyObject *)ret;
+}
+
+
+/*MULTIARRAY_API
+ Mean
+*/
+static PyObject *
+PyArray_Mean(PyArrayObject *self, int axis, int rtype, PyArrayObject *out)
+{
+ PyObject *obj1=NULL, *obj2=NULL;
+ PyObject *new, *ret;
+
+ if ((new = _check_axis(self, &axis, 0))==NULL) return NULL;
+
+ obj1 = PyArray_GenericReduceFunction((PyAO *)new, n_ops.add, axis,
+ rtype, out);
+ obj2 = PyFloat_FromDouble((double) PyArray_DIM(new,axis));
+ Py_DECREF(new);
+ if (obj1 == NULL || obj2 == NULL) {
+ Py_XDECREF(obj1);
+ Py_XDECREF(obj2);
+ return NULL;
+ }
+ if (!out) {
+ ret = PyNumber_Divide(obj1, obj2);
+ }
+ else {
+ ret = PyObject_CallFunction(n_ops.divide, "OOO", out, obj2, out);
+ }
+ Py_DECREF(obj1);
+ Py_DECREF(obj2);
+ return ret;
+}
+
+/* Set variance to 1 to by-pass square-root calculation and return variance */
+/*MULTIARRAY_API
+ Std
+*/
+static PyObject *
+PyArray_Std(PyArrayObject *self, int axis, int rtype, PyArrayObject *out,
+ int variance)
+{
+ PyObject *obj1=NULL, *obj2=NULL, *new=NULL;
+ PyObject *ret=NULL, *newshape=NULL;
+ int i, n;
+ intp val;
+
+ if ((new = _check_axis(self, &axis, 0))==NULL) return NULL;
+
+ /* Compute and reshape mean */
+ obj1 = PyArray_EnsureArray(PyArray_Mean((PyAO *)new, axis, rtype, NULL));
+ if (obj1 == NULL) {Py_DECREF(new); return NULL;}
+ n = PyArray_NDIM(new);
+ newshape = PyTuple_New(n);
+ if (newshape == NULL) {Py_DECREF(obj1); Py_DECREF(new); return NULL;}
+ for (i=0; i<n; i++) {
+ if (i==axis) val = 1;
+ else val = PyArray_DIM(new,i);
+ PyTuple_SET_ITEM(newshape, i, PyInt_FromLong((long)val));
+ }
+ obj2 = PyArray_Reshape((PyAO *)obj1, newshape);
+ Py_DECREF(obj1);
+ Py_DECREF(newshape);
+ if (obj2 == NULL) {Py_DECREF(new); return NULL;}
+
+ /* Compute x = x - mx */
+ obj1 = PyArray_EnsureArray(PyNumber_Subtract((PyObject *)new, obj2));
+ Py_DECREF(obj2);
+ if (obj1 == NULL) {Py_DECREF(new); return NULL;}
+
+ /* Compute x * x */
+ obj2 = PyArray_EnsureArray \
+ (PyArray_GenericBinaryFunction((PyAO *)obj1, obj1, n_ops.multiply));
+ Py_DECREF(obj1);
+ if (obj2 == NULL) {Py_DECREF(new); return NULL;}
+
+ /* Compute add.reduce(x*x,axis) */
+ obj1 = PyArray_GenericReduceFunction((PyAO *)obj2, n_ops.add,
+ axis, rtype, NULL);
+ Py_DECREF(obj2);
+ if (obj1 == NULL) {Py_DECREF(new); return NULL;}
+
+ n = PyArray_DIM(new,axis);
+ Py_DECREF(new);
+ if (n==0) n=1;
+ obj2 = PyFloat_FromDouble(1.0/((double )n));
+ if (obj2 == NULL) {Py_DECREF(obj1); return NULL;}
+ ret = PyNumber_Multiply(obj1, obj2);
+ Py_DECREF(obj1);
+ Py_DECREF(obj2);
+
+ if (!variance) {
+ obj1 = PyArray_EnsureArray(ret);
+
+ /* sqrt() */
+ ret = PyArray_GenericUnaryFunction((PyAO *)obj1, n_ops.sqrt);
+ Py_DECREF(obj1);
+ }
+ if (ret == NULL || PyArray_CheckExact(self)) return ret;
+ if (PyArray_Check(self) && self->ob_type == ret->ob_type) return ret;
+ obj1 = PyArray_EnsureArray(ret);
+ if (obj1 == NULL) return NULL;
+ ret = PyArray_View((PyAO *)obj1, NULL, self->ob_type);
+ Py_DECREF(obj1);
+ if (out) {
+ if (PyArray_CopyAnyInto(out, (PyArrayObject *)ret) < 0) {
+ Py_DECREF(ret);
+ return NULL;
+ }
+ Py_DECREF(ret);
+ Py_INCREF(out);
+ return (PyObject *)out;
+ }
+ return ret;
+}
+
+
+/*MULTIARRAY_API
+ Sum
+*/
+static PyObject *
+PyArray_Sum(PyArrayObject *self, int axis, int rtype, PyArrayObject *out)
+{
+ PyObject *new, *ret;
+
+ if ((new = _check_axis(self, &axis, 0))==NULL) return NULL;
+
+ ret = PyArray_GenericReduceFunction((PyAO *)new, n_ops.add, axis,
+ rtype, out);
+ Py_DECREF(new);
+ return ret;
+}
+
+/*MULTIARRAY_API
+ Prod
+*/
+static PyObject *
+PyArray_Prod(PyArrayObject *self, int axis, int rtype, PyArrayObject *out)
+{
+ PyObject *new, *ret;
+
+ if ((new = _check_axis(self, &axis, 0))==NULL) return NULL;
+
+ ret = PyArray_GenericReduceFunction((PyAO *)new, n_ops.multiply, axis,
+ rtype, out);
+ Py_DECREF(new);
+ return ret;
+}
+
+/*MULTIARRAY_API
+ CumSum
+*/
+static PyObject *
+PyArray_CumSum(PyArrayObject *self, int axis, int rtype, PyArrayObject *out)
+{
+ PyObject *new, *ret;
+
+ if ((new = _check_axis(self, &axis, 0))==NULL) return NULL;
+
+ ret = PyArray_GenericAccumulateFunction((PyAO *)new, n_ops.add, axis,
+ rtype, out);
+ Py_DECREF(new);
+ return ret;
+}
+
+/*MULTIARRAY_API
+ CumProd
+*/
+static PyObject *
+PyArray_CumProd(PyArrayObject *self, int axis, int rtype, PyArrayObject *out)
+{
+ PyObject *new, *ret;
+
+ if ((new = _check_axis(self, &axis, 0))==NULL) return NULL;
+
+ ret = PyArray_GenericAccumulateFunction((PyAO *)new,
+ n_ops.multiply, axis,
+ rtype, out);
+ Py_DECREF(new);
+ return ret;
+}
+
+/*MULTIARRAY_API
+ Any
+*/
+static PyObject *
+PyArray_Any(PyArrayObject *self, int axis, PyArrayObject *out)
+{
+ PyObject *new, *ret;
+
+ if ((new = _check_axis(self, &axis, 0))==NULL) return NULL;
+
+ ret = PyArray_GenericReduceFunction((PyAO *)new,
+ n_ops.logical_or, axis,
+ PyArray_BOOL, out);
+ Py_DECREF(new);
+ return ret;
+}
+
+/*MULTIARRAY_API
+ All
+*/
+static PyObject *
+PyArray_All(PyArrayObject *self, int axis, PyArrayObject *out)
+{
+ PyObject *new, *ret;
+
+ if ((new = _check_axis(self, &axis, 0))==NULL) return NULL;
+
+ ret = PyArray_GenericReduceFunction((PyAO *)new,
+ n_ops.logical_and, axis,
+ PyArray_BOOL, out);
+ Py_DECREF(new);
+ return ret;
+}
+
+
+/*MULTIARRAY_API
+ Compress
+*/
+static PyObject *
+PyArray_Compress(PyArrayObject *self, PyObject *condition, int axis,
+ PyArrayObject *out)
+{
+ PyArrayObject *cond;
+ PyObject *res, *ret;
+
+ cond = (PyAO *)PyArray_FROM_O(condition);
+ if (cond == NULL) return NULL;
+
+ if (cond->nd != 1) {
+ Py_DECREF(cond);
+ PyErr_SetString(PyExc_ValueError,
+ "condition must be 1-d array");
+ return NULL;
+ }
+
+ res = PyArray_Nonzero(cond);
+ Py_DECREF(cond);
+ if (res == NULL) return res;
+ ret = PyArray_TakeFrom(self, PyTuple_GET_ITEM(res, 0), axis,
+ out, NPY_RAISE);
+ Py_DECREF(res);
+ return ret;
+}
+
+/*MULTIARRAY_API
+ Nonzero
+*/
+static PyObject *
+PyArray_Nonzero(PyArrayObject *self)
+{
+ int n=self->nd, j;
+ intp count=0, i, size;
+ PyArrayIterObject *it=NULL;
+ PyObject *ret=NULL, *item;
+ intp *dptr[MAX_DIMS];
+
+ it = (PyArrayIterObject *)PyArray_IterNew((PyObject *)self);
+ if (it==NULL) return NULL;
+
+ size = it->size;
+ for (i=0; i<size; i++) {
+ if (self->descr->f->nonzero(it->dataptr, self)) count++;
+ PyArray_ITER_NEXT(it);
+ }
+
+ PyArray_ITER_RESET(it);
+ ret = PyTuple_New(n);
+ if (ret == NULL) goto fail;
+ for (j=0; j<n; j++) {
+ item = PyArray_New(self->ob_type, 1, &count,
+ PyArray_INTP, NULL, NULL, 0, 0,
+ (PyObject *)self);
+ if (item == NULL) goto fail;
+ PyTuple_SET_ITEM(ret, j, item);
+ dptr[j] = (intp *)PyArray_DATA(item);
+ }
+ if (n==1) {
+ for (i=0; i<size; i++) {
+ if (self->descr->f->nonzero(it->dataptr, self))
+ *(dptr[0])++ = i;
+ PyArray_ITER_NEXT(it);
+ }
+ }
+ else {
+ /* reset contiguous so that coordinates gets updated */
+ it->contiguous = 0;
+ for (i=0; i<size; i++) {
+ if (self->descr->f->nonzero(it->dataptr, self))
+ for (j=0; j<n; j++)
+ *(dptr[j])++ = it->coordinates[j];
+ PyArray_ITER_NEXT(it);
+ }
+ }
+
+ Py_DECREF(it);
+ return ret;
+
+ fail:
+ Py_XDECREF(ret);
+ Py_XDECREF(it);
+ return NULL;
+
+}
+
+static PyObject *
+_slow_array_clip(PyArrayObject *self, PyObject *min, PyObject *max, PyArrayObject *out)
+{
+ PyObject *selector=NULL, *newtup=NULL, *ret=NULL;
+ PyObject *res1=NULL, *res2=NULL, *res3=NULL;
+ PyObject *two;
+
+ two = PyInt_FromLong((long)2);
+ res1 = PyArray_GenericBinaryFunction(self, max, n_ops.greater);
+ res2 = PyArray_GenericBinaryFunction(self, min, n_ops.less);
+ if ((res1 == NULL) || (res2 == NULL)) {
+ Py_DECREF(two);
+ Py_XDECREF(res1);
+ Py_XDECREF(res2);
+ return NULL;
+ }
+ res3 = PyNumber_Multiply(two, res1);
+ Py_DECREF(two);
+ Py_DECREF(res1);
+ if (res3 == NULL) return NULL;
+
+ selector = PyArray_EnsureAnyArray(PyNumber_Add(res2, res3));
+ Py_DECREF(res2);
+ Py_DECREF(res3);
+ if (selector == NULL) return NULL;
+
+ newtup = Py_BuildValue("(OOO)", (PyObject *)self, min, max);
+ if (newtup == NULL) {Py_DECREF(selector); return NULL;}
+ ret = PyArray_Choose((PyAO *)selector, newtup, out, NPY_RAISE);
+ Py_DECREF(selector);
+ Py_DECREF(newtup);
+ return ret;
+}
+
+/*MULTIARRAY_API
+ Clip
+*/
+static PyObject *
+PyArray_Clip(PyArrayObject *self, PyObject *min, PyObject *max, PyArrayObject *out)
+{
+ PyArray_FastClipFunc *func;
+ int outgood=0, ingood=0;
+ PyArrayObject *maxa=NULL;
+ PyArrayObject *mina=NULL;
+ PyArrayObject *newout=NULL, *newin=NULL;
+ PyArray_Descr *indescr, *newdescr;
+ PyObject *zero;
+
+ func = self->descr->f->fastclip;
+ if (func == NULL || !PyArray_CheckAnyScalar(min) ||
+ !PyArray_CheckAnyScalar(max))
+ return _slow_array_clip(self, min, max, out);
+
+ /* Use the fast scalar clip function */
+
+ /* First we need to figure out the correct type */
+ indescr = PyArray_DescrFromObject(min, NULL);
+ if (indescr == NULL) return NULL;
+ newdescr = PyArray_DescrFromObject(max, indescr);
+ Py_DECREF(indescr);
+
+ if (newdescr == NULL) return NULL;
+ /* Use the scalar descriptor only if it is of a bigger
+ KIND than the input array (and then find the
+ type that matches both).
+ */
+ if (PyArray_ScalarKind(newdescr->type_num, NULL) >
+ PyArray_ScalarKind(self->descr->type_num, NULL)) {
+ indescr = _array_small_type(newdescr, self->descr);
+ func = indescr->f->fastclip;
+ }
+ else {
+ indescr = self->descr;
+ Py_INCREF(indescr);
+ }
+ Py_DECREF(newdescr);
+
+ if (!PyDataType_ISNOTSWAPPED(indescr)) {
+ PyArray_Descr *descr2;
+ descr2 = PyArray_DescrNewByteorder(indescr, '=');
+ Py_DECREF(indescr);
+ if (descr2 == NULL) goto fail;
+ indescr = descr2;
+ }
+
+ /* Convert max to an array */
+ maxa = (NPY_AO *)PyArray_FromAny(max, indescr, 0, 0,
+ NPY_DEFAULT, NULL);
+ if (maxa == NULL) return NULL;
+
+
+ /* If we are unsigned, then make sure min is not <0 */
+ /* This is to match the behavior of
+ _slow_array_clip
+
+ We allow min and max to go beyond the limits
+ for other data-types in which case they
+ are interpreted as their modular counterparts.
+ */
+ if (PyArray_ISUNSIGNED(self)) {
+ int cmp;
+ zero = PyInt_FromLong(0);
+ cmp = PyObject_RichCompareBool(min, zero, Py_LT);
+ if (cmp == -1) { Py_DECREF(zero); goto fail;}
+ if (cmp == 1) {
+ min = zero;
+ }
+ else {
+ Py_DECREF(zero);
+ Py_INCREF(min);
+ }
+ }
+ else {
+ Py_INCREF(min);
+ }
+
+ /* Convert min to an array */
+ Py_INCREF(indescr);
+ mina = (NPY_AO *)PyArray_FromAny(min, indescr, 0, 0,
+ NPY_DEFAULT, NULL);
+ Py_DECREF(min);
+ if (mina == NULL) goto fail;
+
+
+ /* Check to see if input is single-segment, aligned,
+ and in native byteorder */
+ if (PyArray_ISONESEGMENT(self) && PyArray_CHKFLAGS(self, ALIGNED) &&
+ PyArray_ISNOTSWAPPED(self) && (self->descr == indescr))
+ ingood = 1;
+
+ if (!ingood) {
+ int flags;
+ if (PyArray_ISFORTRAN(self)) flags = NPY_FARRAY;
+ else flags = NPY_CARRAY;
+ Py_INCREF(indescr);
+ newin = (NPY_AO *)PyArray_FromArray(self, indescr, flags);
+ if (newin == NULL) goto fail;
+ }
+ else {
+ newin = self;
+ Py_INCREF(newin);
+ }
+
+ /* At this point, newin is a single-segment, aligned, and correct
+ byte-order array of the correct type
+
+ if ingood == 0, then it is a copy, otherwise,
+ it is the original input.
+ */
+
+ /* If we have already made a copy of the data, then use
+ that as the output array
+ */
+ if (out == NULL && !ingood) {
+ out = newin;
+ }
+
+ /* Now, we know newin is a usable array for fastclip,
+ we need to make sure the output array is available
+ and usable */
+ if (out == NULL) {
+ Py_INCREF(indescr);
+ out = (NPY_AO*)PyArray_NewFromDescr(self->ob_type,
+ indescr, self->nd,
+ self->dimensions,
+ NULL, NULL,
+ PyArray_ISFORTRAN(self),
+ NULL);
+ if (out == NULL) goto fail;
+ outgood = 1;
+ }
+ else Py_INCREF(out);
+ /* Input is good at this point */
+ if (out == newin) {
+ outgood = 1;
+ }
+ if (!outgood && PyArray_ISONESEGMENT(out) &&
+ PyArray_CHKFLAGS(out, ALIGNED) && PyArray_ISNOTSWAPPED(out) &&
+ PyArray_EquivTypes(out->descr, indescr)) {
+ outgood = 1;
+ }
+
+ /* Do we still not have a suitable output array? */
+ /* Create one, now */
+ if (!outgood) {
+ int oflags;
+ if (PyArray_ISFORTRAN(out))
+ oflags = NPY_FARRAY;
+ else
+ oflags = NPY_CARRAY;
+ oflags |= NPY_UPDATEIFCOPY | NPY_FORCECAST;
+ Py_INCREF(indescr);
+ newout = (NPY_AO*)PyArray_FromArray(out, indescr, oflags);
+ if (newout == NULL) goto fail;
+ }
+ else {
+ newout = out;
+ Py_INCREF(newout);
+ }
+
+ /* make sure the shape of the output array is the same */
+ if (!PyArray_SAMESHAPE(newin, newout)) {
+ PyErr_SetString(PyExc_ValueError, "clip: Output array must have the"
+ "same shape as the input.");
+ goto fail;
+ }
+
+ if (newout->data != newin->data) {
+ memcpy(newout->data, newin->data, PyArray_NBYTES(newin));
+ }
+
+ /* Now we can call the fast-clip function */
+
+ func(newin->data, PyArray_SIZE(newin), mina->data, maxa->data,
+ newout->data);
+
+ /* Clean up temporary variables */
+ Py_DECREF(mina);
+ Py_DECREF(maxa);
+ Py_DECREF(newin);
+ /* Copy back into out if out was not already a nice array. */
+ Py_DECREF(newout);
+ return (PyObject *)out;
+
+ fail:
+ Py_XDECREF(maxa);
+ Py_XDECREF(mina);
+ Py_XDECREF(newin);
+ PyArray_XDECREF_ERR(newout);
+ return NULL;
+}
+
+
+/*MULTIARRAY_API
+ Conjugate
+*/
+static PyObject *
+PyArray_Conjugate(PyArrayObject *self, PyArrayObject *out)
+{
+ if (PyArray_ISCOMPLEX(self)) {
+ if (out == NULL) {
+ return PyArray_GenericUnaryFunction(self,
+ n_ops.conjugate);
+ }
+ else {
+ return PyArray_GenericBinaryFunction(self,
+ (PyObject *)out,
+ n_ops.conjugate);
+ }
+ }
+ else {
+ PyArrayObject *ret;
+ if (out) {
+ if (PyArray_CopyAnyInto(out, self)< 0)
+ return NULL;
+ ret = out;
+ }
+ else ret = self;
+ Py_INCREF(ret);
+ return (PyObject *)ret;
+ }
+}
+
+/*MULTIARRAY_API
+ Trace
+*/
+static PyObject *
+PyArray_Trace(PyArrayObject *self, int offset, int axis1, int axis2,
+ int rtype, PyArrayObject *out)
+{
+ PyObject *diag=NULL, *ret=NULL;
+
+ diag = PyArray_Diagonal(self, offset, axis1, axis2);
+ if (diag == NULL) return NULL;
+ ret = PyArray_GenericReduceFunction((PyAO *)diag, n_ops.add, -1, rtype, out);
+ Py_DECREF(diag);
+ return ret;
+}
+
+/*MULTIARRAY_API
+ Diagonal
+*/
+static PyObject *
+PyArray_Diagonal(PyArrayObject *self, int offset, int axis1, int axis2)
+{
+ int n = self->nd;
+ PyObject *new;
+ PyArray_Dims newaxes;
+ intp dims[MAX_DIMS];
+ int i, pos;
+
+ newaxes.ptr = dims;
+ if (n < 2) {
+ PyErr_SetString(PyExc_ValueError,
+ "array.ndim must be >= 2");
+ return NULL;
+ }
+ if (axis1 < 0) axis1 += n;
+ if (axis2 < 0) axis2 += n;
+ if ((axis1 == axis2) || (axis1 < 0) || (axis1 >= n) || \
+ (axis2 < 0) || (axis2 >= n)) {
+ PyErr_Format(PyExc_ValueError, "axis1(=%d) and axis2(=%d) "\
+ "must be different and within range (nd=%d)",
+ axis1, axis2, n);
+ return NULL;
+ }
+
+ newaxes.len = n;
+ /* insert at the end */
+ newaxes.ptr[n-2] = axis1;
+ newaxes.ptr[n-1] = axis2;
+ pos = 0;
+ for (i=0; i<n; i++) {
+ if ((i==axis1) || (i==axis2)) continue;
+ newaxes.ptr[pos++] = i;
+ }
+ new = PyArray_Transpose(self, &newaxes);
+ if (new == NULL) return NULL;
+ self = (PyAO *)new;
+
+ if (n == 2) {
+ PyObject *a=NULL, *indices=NULL, *ret=NULL;
+ intp n1, n2, start, stop, step, count;
+ intp *dptr;
+ n1 = self->dimensions[0];
+ n2 = self->dimensions[1];
+ step = n2+1;
+ if (offset < 0) {
+ start = -n2 * offset;
+ stop = MIN(n2, n1+offset)*(n2+1) - n2*offset;
+ }
+ else {
+ start = offset;
+ stop = MIN(n1, n2-offset)*(n2+1) + offset;
+ }
+
+ /* count = ceil((stop-start)/step) */
+ count = ((stop-start) / step) + (((stop-start) % step) != 0);
+
+ indices = PyArray_New(&PyArray_Type, 1, &count,
+ PyArray_INTP, NULL, NULL, 0, 0, NULL);
+ if (indices == NULL) {
+ Py_DECREF(self); return NULL;
+ }
+ dptr = (intp *)PyArray_DATA(indices);
+ for (n1=start; n1<stop; n1+=step) *dptr++ = n1;
+ a = PyArray_IterNew((PyObject *)self);
+ Py_DECREF(self);
+ if (a == NULL) {Py_DECREF(indices); return NULL;}
+ ret = PyObject_GetItem(a, indices);
+ Py_DECREF(a);
+ Py_DECREF(indices);
+ return ret;
+ }
+
+ else {
+ /*
+ my_diagonal = []
+ for i in range (s [0]) :
+ my_diagonal.append (diagonal (a [i], offset))
+ return array (my_diagonal)
+ */
+ PyObject *mydiagonal=NULL, *new=NULL, *ret=NULL, *sel=NULL;
+ intp i, n1;
+ int res;
+ PyArray_Descr *typecode;
+
+ typecode = self->descr;
+
+ mydiagonal = PyList_New(0);
+ if (mydiagonal == NULL) {Py_DECREF(self); return NULL;}
+ n1 = self->dimensions[0];
+ for (i=0; i<n1; i++) {
+ new = PyInt_FromLong((long) i);
+ sel = PyArray_EnsureAnyArray(PyObject_GetItem((PyObject *)self, new));
+ Py_DECREF(new);
+ if (sel == NULL) {
+ Py_DECREF(self);
+ Py_DECREF(mydiagonal);
+ return NULL;
+ }
+ new = PyArray_Diagonal((PyAO *)sel, offset, n-3, n-2);
+ Py_DECREF(sel);
+ if (new == NULL) {
+ Py_DECREF(self);
+ Py_DECREF(mydiagonal);
+ return NULL;
+ }
+ res = PyList_Append(mydiagonal, new);
+ Py_DECREF(new);
+ if (res < 0) {
+ Py_DECREF(self);
+ Py_DECREF(mydiagonal);
+ return NULL;
+ }
+ }
+ Py_DECREF(self);
+ Py_INCREF(typecode);
+ ret = PyArray_FromAny(mydiagonal, typecode, 0, 0, 0, NULL);
+ Py_DECREF(mydiagonal);
+ return ret;
+ }
+}
+
+/* simulates a C-style 1-3 dimensional array which can be accesed using
+ ptr[i] or ptr[i][j] or ptr[i][j][k] -- requires pointer allocation
+ for 2-d and 3-d.
+
+ For 2-d and up, ptr is NOT equivalent to a statically defined
+ 2-d or 3-d array. In particular, it cannot be passed into a
+ function that requires a true pointer to a fixed-size array.
+*/
+
+/* steals a reference to typedescr -- can be NULL*/
+/*MULTIARRAY_API
+ Simulat a C-array
+*/
+static int
+PyArray_AsCArray(PyObject **op, void *ptr, intp *dims, int nd,
+ PyArray_Descr* typedescr)
+{
+ PyArrayObject *ap;
+ intp n, m, i, j;
+ char **ptr2;
+ char ***ptr3;
+
+ if ((nd < 1) || (nd > 3)) {
+ PyErr_SetString(PyExc_ValueError,
+ "C arrays of only 1-3 dimensions available");
+ Py_XDECREF(typedescr);
+ return -1;
+ }
+ if ((ap = (PyArrayObject*)PyArray_FromAny(*op, typedescr, nd, nd,
+ CARRAY, NULL)) == NULL)
+ return -1;
+ switch(nd) {
+ case 1:
+ *((char **)ptr) = ap->data;
+ break;
+ case 2:
+ n = ap->dimensions[0];
+ ptr2 = (char **)_pya_malloc(n * sizeof(char *));
+ if (!ptr2) goto fail;
+ for (i=0; i<n; i++) {
+ ptr2[i] = ap->data + i*ap->strides[0];
+ }
+ *((char ***)ptr) = ptr2;
+ break;
+ case 3:
+ n = ap->dimensions[0];
+ m = ap->dimensions[1];
+ ptr3 = (char ***)_pya_malloc(n*(m+1) * sizeof(char *));
+ if (!ptr3) goto fail;
+ for (i=0; i<n; i++) {
+ ptr3[i] = ptr3[n + (m-1)*i];
+ for (j=0; j<m; j++) {
+ ptr3[i][j] = ap->data + i*ap->strides[0] + \
+ j*ap->strides[1];
+ }
+ }
+ *((char ****)ptr) = ptr3;
+ }
+ memcpy(dims, ap->dimensions, nd*sizeof(intp));
+ *op = (PyObject *)ap;
+ return 0;
+
+ fail:
+ PyErr_SetString(PyExc_MemoryError, "no memory");
+ return -1;
+}
+
+/* Deprecated --- Use PyArray_AsCArray instead */
+
+/*MULTIARRAY_API
+ Convert to a 1D C-array
+*/
+static int
+PyArray_As1D(PyObject **op, char **ptr, int *d1, int typecode)
+{
+ intp newd1;
+ PyArray_Descr *descr;
+
+ descr = PyArray_DescrFromType(typecode);
+ if (PyArray_AsCArray(op, (void *)ptr, &newd1, 1, descr) == -1)
+ return -1;
+ *d1 = (int) newd1;
+ return 0;
+}
+
+/*MULTIARRAY_API
+ Convert to a 2D C-array
+*/
+static int
+PyArray_As2D(PyObject **op, char ***ptr, int *d1, int *d2, int typecode)
+{
+ intp newdims[2];
+ PyArray_Descr *descr;
+
+ descr = PyArray_DescrFromType(typecode);
+ if (PyArray_AsCArray(op, (void *)ptr, newdims, 2, descr) == -1)
+ return -1;
+
+ *d1 = (int ) newdims[0];
+ *d2 = (int ) newdims[1];
+ return 0;
+}
+
+/* End Deprecated */
+
+/*MULTIARRAY_API
+ Free pointers created if As2D is called
+*/
+static int
+PyArray_Free(PyObject *op, void *ptr)
+{
+ PyArrayObject *ap = (PyArrayObject *)op;
+
+ if ((ap->nd < 1) || (ap->nd > 3))
+ return -1;
+ if (ap->nd >= 2) {
+ _pya_free(ptr);
+ }
+ Py_DECREF(ap);
+ return 0;
+}
+
+
+static PyObject *
+_swap_and_concat(PyObject *op, int axis, int n)
+{
+ PyObject *newtup=NULL;
+ PyObject *otmp, *arr;
+ int i;
+
+ newtup = PyTuple_New(n);
+ if (newtup==NULL) return NULL;
+ for (i=0; i<n; i++) {
+ otmp = PySequence_GetItem(op, i);
+ arr = PyArray_FROM_O(otmp);
+ Py_DECREF(otmp);
+ if (arr==NULL) goto fail;
+ otmp = PyArray_SwapAxes((PyArrayObject *)arr, axis, 0);
+ Py_DECREF(arr);
+ if (otmp == NULL) goto fail;
+ PyTuple_SET_ITEM(newtup, i, otmp);
+ }
+ otmp = PyArray_Concatenate(newtup, 0);
+ Py_DECREF(newtup);
+ if (otmp == NULL) return NULL;
+ arr = PyArray_SwapAxes((PyArrayObject *)otmp, axis, 0);
+ Py_DECREF(otmp);
+ return arr;
+
+ fail:
+ Py_DECREF(newtup);
+ return NULL;
+}
+
+/*op is a python object supporting the sequence interface.
+ Its elements will be concatenated together to form a single
+ multidimensional array.*/
+/* If axis is MAX_DIMS or bigger, then each sequence object will
+ be flattened before concatenation
+*/
+/*MULTIARRAY_API
+ Concatenate an arbitrary Python sequence into an array.
+*/
+static PyObject *
+PyArray_Concatenate(PyObject *op, int axis)
+{
+ PyArrayObject *ret, **mps;
+ PyObject *otmp;
+ int i, n, tmp, nd=0, new_dim;
+ char *data;
+ PyTypeObject *subtype;
+ double prior1, prior2;
+ intp numbytes;
+
+ n = PySequence_Length(op);
+ if (n == -1) {
+ return NULL;
+ }
+ if (n == 0) {
+ PyErr_SetString(PyExc_ValueError,
+ "concatenation of zero-length sequences is "\
+ "impossible");
+ return NULL;
+ }
+
+ if ((axis < 0) || ((0 < axis) && (axis < MAX_DIMS)))
+ return _swap_and_concat(op, axis, n);
+
+ mps = PyArray_ConvertToCommonType(op, &n);
+ if (mps == NULL) return NULL;
+
+ /* Make sure these arrays are legal to concatenate. */
+ /* Must have same dimensions except d0 */
+
+ prior1 = PyArray_PRIORITY;
+ subtype = &PyArray_Type;
+ ret = NULL;
+ for(i=0; i<n; i++) {
+ if (axis >= MAX_DIMS) {
+ otmp = PyArray_Ravel(mps[i],0);
+ Py_DECREF(mps[i]);
+ mps[i] = (PyArrayObject *)otmp;
+ }
+ if (mps[i]->ob_type != subtype) {
+ prior2 = PyArray_GetPriority((PyObject *)(mps[i]), 0.0);
+ if (prior2 > prior1) {
+ prior1 = prior2;
+ subtype = mps[i]->ob_type;
+ }
+ }
+ }
+
+ new_dim = 0;
+ for(i=0; i<n; i++) {
+ if (mps[i] == NULL) goto fail;
+ if (i == 0) nd = mps[i]->nd;
+ else {
+ if (nd != mps[i]->nd) {
+ PyErr_SetString(PyExc_ValueError,
+ "arrays must have same "\
+ "number of dimensions");
+ goto fail;
+ }
+ if (!PyArray_CompareLists(mps[0]->dimensions+1,
+ mps[i]->dimensions+1,
+ nd-1)) {
+ PyErr_SetString(PyExc_ValueError,
+ "array dimensions must "\
+ "agree except for d_0");
+ goto fail;
+ }
+ }
+ if (nd == 0) {
+ PyErr_SetString(PyExc_ValueError,
+ "0-d arrays can't be concatenated");
+ goto fail;
+ }
+ new_dim += mps[i]->dimensions[0];
+ }
+
+ tmp = mps[0]->dimensions[0];
+ mps[0]->dimensions[0] = new_dim;
+ Py_INCREF(mps[0]->descr);
+ ret = (PyArrayObject *)PyArray_NewFromDescr(subtype,
+ mps[0]->descr, nd,
+ mps[0]->dimensions,
+ NULL, NULL, 0,
+ (PyObject *)ret);
+ mps[0]->dimensions[0] = tmp;
+
+ if (ret == NULL) goto fail;
+
+ data = ret->data;
+ for(i=0; i<n; i++) {
+ numbytes = PyArray_NBYTES(mps[i]);
+ memcpy(data, mps[i]->data, numbytes);
+ data += numbytes;
+ }
+
+ PyArray_INCREF(ret);
+ for(i=0; i<n; i++) Py_XDECREF(mps[i]);
+ PyDataMem_FREE(mps);
+ return (PyObject *)ret;
+
+ fail:
+ Py_XDECREF(ret);
+ for(i=0; i<n; i++) Py_XDECREF(mps[i]);
+ PyDataMem_FREE(mps);
+ return NULL;
+}
+
+/*MULTIARRAY_API
+ SwapAxes
+*/
+static PyObject *
+PyArray_SwapAxes(PyArrayObject *ap, int a1, int a2)
+{
+ PyArray_Dims new_axes;
+ intp dims[MAX_DIMS];
+ int n, i, val;
+ PyObject *ret;
+
+ if (a1 == a2) {
+ Py_INCREF(ap);
+ return (PyObject *)ap;
+ }
+
+ n = ap->nd;
+ if (n <= 1) {
+ Py_INCREF(ap);
+ return (PyObject *)ap;
+ }
+
+ if (a1 < 0) a1 += n;
+ if (a2 < 0) a2 += n;
+ if ((a1 < 0) || (a1 >= n)) {
+ PyErr_SetString(PyExc_ValueError,
+ "bad axis1 argument to swapaxes");
+ return NULL;
+ }
+ if ((a2 < 0) || (a2 >= n)) {
+ PyErr_SetString(PyExc_ValueError,
+ "bad axis2 argument to swapaxes");
+ return NULL;
+ }
+ new_axes.ptr = dims;
+ new_axes.len = n;
+
+ for (i=0; i<n; i++) {
+ if (i == a1) val = a2;
+ else if (i == a2) val = a1;
+ else val = i;
+ new_axes.ptr[i] = val;
+ }
+ ret = PyArray_Transpose(ap, &new_axes);
+ return ret;
+}
+
+/*MULTIARRAY_API
+ Return Transpose.
+*/
+static PyObject *
+PyArray_Transpose(PyArrayObject *ap, PyArray_Dims *permute)
+{
+ intp *axes, axis;
+ intp i, n;
+ intp permutation[MAX_DIMS], reverse_permutation[MAX_DIMS];
+ PyArrayObject *ret = NULL;
+
+ if (permute == NULL) {
+ n = ap->nd;
+ for (i=0; i<n; i++) {
+ permutation[i] = n-1-i;
+ }
+ } else {
+ n = permute->len;
+ axes = permute->ptr;
+ if (n != ap->nd) {
+ PyErr_SetString(PyExc_ValueError,
+ "axes don't match array");
+ return NULL;
+ }
+ for (i=0; i<n; i++) {
+ reverse_permutation[i] = -1;
+ }
+ for (i=0; i<n; i++) {
+ axis = axes[i];
+ if (axis < 0) axis = ap->nd+axis;
+ if (axis < 0 || axis >= ap->nd) {
+ PyErr_SetString(PyExc_ValueError,
+ "invalid axis for this array");
+ return NULL;
+ }
+ if (reverse_permutation[axis] != -1) {
+ PyErr_SetString(PyExc_ValueError,
+ "repeated axis in transpose");
+ return NULL;
+ }
+ reverse_permutation[axis] = i;
+ permutation[i] = axis;
+ }
+ for (i=0; i<n; i++) {
+ }
+ }
+
+ /* this allocates memory for dimensions and strides (but fills them
+ incorrectly), sets up descr, and points data at ap->data. */
+ Py_INCREF(ap->descr);
+ ret = (PyArrayObject *)\
+ PyArray_NewFromDescr(ap->ob_type,
+ ap->descr,
+ n, ap->dimensions,
+ NULL, ap->data, ap->flags,
+ (PyObject *)ap);
+ if (ret == NULL) return NULL;
+
+ /* point at true owner of memory: */
+ ret->base = (PyObject *)ap;
+ Py_INCREF(ap);
+
+ /* fix the dimensions and strides of the return-array */
+ for(i=0; i<n; i++) {
+ ret->dimensions[i] = ap->dimensions[permutation[i]];
+ ret->strides[i] = ap->strides[permutation[i]];
+ }
+ PyArray_UpdateFlags(ret, CONTIGUOUS | FORTRAN);
+
+ return (PyObject *)ret;
+}
+
+/*MULTIARRAY_API
+ Repeat the array.
+*/
+static PyObject *
+PyArray_Repeat(PyArrayObject *aop, PyObject *op, int axis)
+{
+ intp *counts;
+ intp n, n_outer, i, j, k, chunk, total;
+ intp tmp;
+ int nd;
+ PyArrayObject *repeats=NULL;
+ PyObject *ap=NULL;
+ PyArrayObject *ret=NULL;
+ char *new_data, *old_data;
+
+ repeats = (PyAO *)PyArray_ContiguousFromAny(op, PyArray_INTP, 0, 1);
+ if (repeats == NULL) return NULL;
+ nd = repeats->nd;
+ counts = (intp *)repeats->data;
+
+ if ((ap=_check_axis(aop, &axis, CARRAY))==NULL) {
+ Py_DECREF(repeats);
+ return NULL;
+ }
+
+ aop = (PyAO *)ap;
+
+ if (nd == 1)
+ n = repeats->dimensions[0];
+ else /* nd == 0 */
+ n = aop->dimensions[axis];
+
+ if (aop->dimensions[axis] != n) {
+ PyErr_SetString(PyExc_ValueError,
+ "a.shape[axis] != len(repeats)");
+ goto fail;
+ }
+
+
+ if (nd == 0)
+ total = counts[0]*n;
+ else {
+
+ total = 0;
+ for(j=0; j<n; j++) {
+ if (counts[j] < 0) {
+ PyErr_SetString(PyExc_ValueError, "count < 0");
+ goto fail;
+ }
+ total += counts[j];
+ }
+ }
+
+
+ /* Construct new array */
+ aop->dimensions[axis] = total;
+ Py_INCREF(aop->descr);
+ ret = (PyArrayObject *)PyArray_NewFromDescr(aop->ob_type,
+ aop->descr,
+ aop->nd,
+ aop->dimensions,
+ NULL, NULL, 0,
+ (PyObject *)aop);
+ aop->dimensions[axis] = n;
+
+ if (ret == NULL) goto fail;
+
+ new_data = ret->data;
+ old_data = aop->data;
+
+ chunk = aop->descr->elsize;
+ for(i=axis+1; i<aop->nd; i++) {
+ chunk *= aop->dimensions[i];
+ }
+
+ n_outer = 1;
+ for(i=0; i<axis; i++) n_outer *= aop->dimensions[i];
+
+ for(i=0; i<n_outer; i++) {
+ for(j=0; j<n; j++) {
+ tmp = (nd ? counts[j] : counts[0]);
+ for(k=0; k<tmp; k++) {
+ memcpy(new_data, old_data, chunk);
+ new_data += chunk;
+ }
+ old_data += chunk;
+ }
+ }
+
+ Py_DECREF(repeats);
+ PyArray_INCREF(ret);
+ Py_XDECREF(aop);
+ return (PyObject *)ret;
+
+ fail:
+ Py_DECREF(repeats);
+ Py_XDECREF(aop);
+ Py_XDECREF(ret);
+ return NULL;
+}
+
+
+static int
+_signbit_set(PyArrayObject *arr)
+{
+ static char bitmask = (char) 0x80;
+ char *ptr; /* points to the byte to test */
+ char byteorder;
+ int elsize;
+
+ elsize = arr->descr->elsize;
+ byteorder = arr->descr->byteorder;
+ ptr = arr->data;
+ if (elsize > 1 && \
+ (byteorder == PyArray_LITTLE || \
+ (byteorder == PyArray_NATIVE &&
+ PyArray_ISNBO(PyArray_LITTLE))))
+ ptr += elsize-1;
+
+ return ((*ptr & bitmask) != 0);
+}
+
+
+/*OBJECT_API*/
+static NPY_SCALARKIND
+PyArray_ScalarKind(int typenum, PyArrayObject **arr)
+{
+ if (PyTypeNum_ISSIGNED(typenum)) {
+ if (arr && _signbit_set(*arr)) return PyArray_INTNEG_SCALAR;
+ else return PyArray_INTPOS_SCALAR;
+ }
+ if (PyTypeNum_ISFLOAT(typenum)) return PyArray_FLOAT_SCALAR;
+ if (PyTypeNum_ISUNSIGNED(typenum)) return PyArray_INTPOS_SCALAR;
+ if (PyTypeNum_ISCOMPLEX(typenum)) return PyArray_COMPLEX_SCALAR;
+ if (PyTypeNum_ISBOOL(typenum)) return PyArray_BOOL_SCALAR;
+
+ if (PyTypeNum_ISUSERDEF(typenum)) {
+ NPY_SCALARKIND retval;
+ PyArray_Descr* descr;
+ descr = PyArray_DescrFromType(typenum);
+ if (descr->f->scalarkind)
+ retval = descr->f->scalarkind((arr ? *arr : NULL));
+ else
+ retval = PyArray_NOSCALAR;
+ Py_DECREF(descr);
+ return retval;
+ }
+ return PyArray_OBJECT_SCALAR;
+}
+
+/*OBJECT_API*/
+static int
+PyArray_CanCoerceScalar(int thistype, int neededtype,
+ NPY_SCALARKIND scalar)
+{
+ PyArray_Descr* from;
+ int *castlist;
+
+ if (scalar == PyArray_NOSCALAR) {
+ return PyArray_CanCastSafely(thistype, neededtype);
+ }
+ from = PyArray_DescrFromType(thistype);
+ if (from->f->cancastscalarkindto &&
+ (castlist = from->f->cancastscalarkindto[scalar])) {
+ while (*castlist != PyArray_NOTYPE)
+ if (*castlist++ == neededtype) return 1;
+ }
+ switch(scalar) {
+ case PyArray_BOOL_SCALAR:
+ case PyArray_OBJECT_SCALAR:
+ return PyArray_CanCastSafely(thistype, neededtype);
+ default:
+ if (PyTypeNum_ISUSERDEF(neededtype)) return FALSE;
+ switch(scalar) {
+ case PyArray_INTPOS_SCALAR:
+ return (neededtype >= PyArray_BYTE);
+ case PyArray_INTNEG_SCALAR:
+ return (neededtype >= PyArray_BYTE) && \
+ !(PyTypeNum_ISUNSIGNED(neededtype));
+ case PyArray_FLOAT_SCALAR:
+ return (neededtype >= PyArray_FLOAT);
+ case PyArray_COMPLEX_SCALAR:
+ return (neededtype >= PyArray_CFLOAT);
+ default:
+ return 1; /* should never get here... */
+ }
+ }
+}
+
+
+/*OBJECT_API*/
+static PyArrayObject **
+PyArray_ConvertToCommonType(PyObject *op, int *retn)
+{
+ int i, n, allscalars=0;
+ PyArrayObject **mps=NULL;
+ PyObject *otmp;
+ PyArray_Descr *intype=NULL, *stype=NULL;
+ PyArray_Descr *newtype=NULL;
+ NPY_SCALARKIND scalarkind=NPY_NOSCALAR, intypekind=NPY_NOSCALAR;
+
+ *retn = n = PySequence_Length(op);
+ if (PyErr_Occurred()) {*retn = 0; return NULL;}
+
+ mps = (PyArrayObject **)PyDataMem_NEW(n*sizeof(PyArrayObject *));
+ if (mps == NULL) {
+ *retn = 0;
+ return (void*)PyErr_NoMemory();
+ }
+
+ if (PyArray_Check(op)) {
+ for (i=0; i<n; i++) {
+ mps[i] = (PyArrayObject *)\
+ array_big_item((PyArrayObject *)op, i);
+ }
+ if (!PyArray_ISCARRAY(op)) {
+ for (i=0; i<n; i++) {
+ PyObject *obj;
+ obj = PyArray_NewCopy(mps[i], NPY_CORDER);
+ Py_DECREF(mps[i]);
+ mps[i] = (PyArrayObject *)obj;
+ }
+ }
+ return mps;
+ }
+
+ for(i=0; i<n; i++) {
+ otmp = PySequence_GetItem(op, i);
+ if (!PyArray_CheckAnyScalar(otmp)) {
+ newtype = PyArray_DescrFromObject(otmp, intype);
+ Py_XDECREF(intype);
+ intype = newtype;
+ mps[i] = NULL;
+ intypekind = PyArray_ScalarKind(intype->type_num,
+ NULL);
+ }
+ else {
+ newtype = PyArray_DescrFromObject(otmp, stype);
+ Py_XDECREF(stype);
+ stype = newtype;
+ scalarkind = PyArray_ScalarKind(newtype->type_num,
+ NULL);
+ mps[i] = (PyArrayObject *)Py_None;
+ Py_INCREF(Py_None);
+ }
+ Py_XDECREF(otmp);
+ }
+ if (intype==NULL) { /* all scalars */
+ allscalars = 1;
+ intype = stype;
+ Py_INCREF(intype);
+ for (i=0; i<n; i++) {
+ Py_XDECREF(mps[i]);
+ mps[i] = NULL;
+ }
+ }
+ else if ((stype != NULL) && (intypekind != scalarkind)) { \
+ /* we need to upconvert to type that
+ handles both intype and stype
+
+ also don't forcecast the scalars.
+ */
+
+ if (!PyArray_CanCoerceScalar(stype->type_num,
+ intype->type_num,
+ scalarkind)) {
+ newtype = _array_small_type(intype, stype);
+ Py_XDECREF(intype);
+ intype = newtype;
+ }
+ for (i=0; i<n; i++) {
+ Py_XDECREF(mps[i]);
+ mps[i] = NULL;
+ }
+ }
+
+
+ /* Make sure all arrays are actual array objects. */
+ for(i=0; i<n; i++) {
+ int flags = CARRAY;
+ if ((otmp = PySequence_GetItem(op, i)) == NULL)
+ goto fail;
+ if (!allscalars && ((PyObject *)(mps[i]) == Py_None)) {
+ /* forcecast scalars */
+ flags |= FORCECAST;
+ Py_DECREF(Py_None);
+ }
+ Py_INCREF(intype);
+ mps[i] = (PyArrayObject*)
+ PyArray_FromAny(otmp, intype, 0, 0, flags, NULL);
+ Py_DECREF(otmp);
+ if (mps[i] == NULL) goto fail;
+ }
+ Py_DECREF(intype);
+ Py_XDECREF(stype);
+ return mps;
+
+ fail:
+ Py_XDECREF(intype);
+ Py_XDECREF(stype);
+ *retn = 0;
+ for (i=0; i<n; i++) Py_XDECREF(mps[i]);
+ PyDataMem_FREE(mps);
+ return NULL;
+}
+
+
+/*MULTIARRAY_API
+*/
+static PyObject *
+PyArray_Choose(PyArrayObject *ip, PyObject *op, PyArrayObject *ret,
+ NPY_CLIPMODE clipmode)
+{
+ intp *sizes, offset;
+ int n, elsize;
+ intp i, m;
+ char *ret_data;
+ PyArrayObject **mps, *ap;
+ intp *self_data, mi;
+ int copyret=0;
+ ap = NULL;
+
+ /* Convert all inputs to arrays of a common type */
+ mps = PyArray_ConvertToCommonType(op, &n);
+ if (mps == NULL) return NULL;
+
+ sizes = (intp *)_pya_malloc(n*sizeof(intp));
+ if (sizes == NULL) goto fail;
+
+ ap = (PyArrayObject *)PyArray_ContiguousFromAny((PyObject *)ip,
+ PyArray_INTP,
+ 0, 0);
+ if (ap == NULL) goto fail;
+
+ /* Check the dimensions of the arrays */
+ for(i=0; i<n; i++) {
+ if (mps[i] == NULL) goto fail;
+ if (ap->nd < mps[i]->nd) {
+ PyErr_SetString(PyExc_ValueError,
+ "too many dimensions");
+ goto fail;
+ }
+ if (!PyArray_CompareLists(ap->dimensions+(ap->nd-mps[i]->nd),
+ mps[i]->dimensions, mps[i]->nd)) {
+ PyErr_SetString(PyExc_ValueError,
+ "array dimensions must agree");
+ goto fail;
+ }
+ sizes[i] = PyArray_NBYTES(mps[i]);
+ }
+
+ if (!ret) {
+ Py_INCREF(mps[0]->descr);
+ ret = (PyArrayObject *)PyArray_NewFromDescr(ap->ob_type,
+ mps[0]->descr,
+ ap->nd,
+ ap->dimensions,
+ NULL, NULL, 0,
+ (PyObject *)ap);
+ }
+ else {
+ PyArrayObject *obj;
+ int flags = NPY_CARRAY | NPY_UPDATEIFCOPY | NPY_FORCECAST;
+
+ if (PyArray_SIZE(ret) != PyArray_SIZE(ap)) {
+ PyErr_SetString(PyExc_TypeError,
+ "invalid shape for output array.");
+ ret = NULL;
+ goto fail;
+ }
+ if (clipmode == NPY_RAISE) {
+ /* we need to make sure and get a copy
+ so the input array is not changed
+ before the error is called
+ */
+ flags |= NPY_ENSURECOPY;
+ }
+ Py_INCREF(mps[0]->descr);
+ obj = (PyArrayObject *)PyArray_FromArray(ret, mps[0]->descr,
+ flags);
+ if (obj != ret) copyret = 1;
+ ret = obj;
+ }
+
+ if (ret == NULL) goto fail;
+ elsize = ret->descr->elsize;
+ m = PyArray_SIZE(ret);
+ self_data = (intp *)ap->data;
+ ret_data = ret->data;
+
+ for (i=0; i<m; i++) {
+ mi = *self_data;
+ if (mi < 0 || mi >= n) {
+ switch(clipmode) {
+ case NPY_RAISE:
+ PyErr_SetString(PyExc_ValueError,
+ "invalid entry in choice "\
+ "array");
+ goto fail;
+ case NPY_WRAP:
+ if (mi < 0) {
+ while(mi<0) mi += n;
+ }
+ else {
+ while(mi>=n) mi -= n;
+ }
+ break;
+ case NPY_CLIP:
+ if (mi < 0) mi=0;
+ else if (mi>=n) mi=n-1;
+ break;
+ }
+ }
+ offset = i*elsize;
+ if (offset >= sizes[mi]) {offset = offset % sizes[mi]; }
+ memmove(ret_data, mps[mi]->data+offset, elsize);
+ ret_data += elsize; self_data++;
+ }
+
+ PyArray_INCREF(ret);
+ for(i=0; i<n; i++) Py_XDECREF(mps[i]);
+ Py_DECREF(ap);
+ PyDataMem_FREE(mps);
+ _pya_free(sizes);
+ if (copyret) {
+ PyObject *obj;
+ obj = ret->base;
+ Py_INCREF(obj);
+ Py_DECREF(ret);
+ ret = (PyArrayObject *)obj;
+ }
+ return (PyObject *)ret;
+
+ fail:
+ for(i=0; i<n; i++) Py_XDECREF(mps[i]);
+ Py_XDECREF(ap);
+ PyDataMem_FREE(mps);
+ _pya_free(sizes);
+ PyArray_XDECREF_ERR(ret);
+ return NULL;
+}
+
+/* These algorithms use special sorting. They are not called unless the
+ underlying sort function for the type is available.
+ Note that axis is already
+ valid. The sort functions require 1-d contiguous and well-behaved data.
+ Therefore, a copy will be made of the data if needed before handing
+ it to the
+ sorting routine.
+ An iterator is constructed and adjusted to walk over all but
+ the desired sorting
+ axis.
+*/
+static int
+_new_sort(PyArrayObject *op, int axis, NPY_SORTKIND which)
+{
+ PyArrayIterObject *it;
+ int needcopy=0, swap;
+ intp N, size;
+ int elsize;
+ intp astride;
+ PyArray_SortFunc *sort;
+ BEGIN_THREADS_DEF
+
+ it = (PyArrayIterObject *)PyArray_IterAllButAxis((PyObject *)op, &axis);
+ swap = !PyArray_ISNOTSWAPPED(op);
+ if (it == NULL) return -1;
+
+ NPY_BEGIN_THREADS_DESCR(op->descr)
+
+ sort = op->descr->f->sort[which];
+ size = it->size;
+ N = op->dimensions[axis];
+ elsize = op->descr->elsize;
+ astride = op->strides[axis];
+
+ needcopy = !(op->flags & ALIGNED) || (astride != (intp) elsize) \
+ || swap;
+
+ if (needcopy) {
+ char *buffer;
+ buffer = PyDataMem_NEW(N*elsize);
+ while (size--) {
+ _unaligned_strided_byte_copy(buffer, (intp) elsize, it->dataptr,
+ astride, N, elsize);
+ if (swap) _strided_byte_swap(buffer, (intp) elsize, N, elsize);
+ if (sort(buffer, N, op) < 0) {
+ PyDataMem_FREE(buffer); goto fail;
+ }
+ if (swap) _strided_byte_swap(buffer, (intp) elsize, N, elsize);
+
+ _unaligned_strided_byte_copy(it->dataptr, astride, buffer,
+ (intp) elsize, N, elsize);
+ PyArray_ITER_NEXT(it);
+ }
+ PyDataMem_FREE(buffer);
+ }
+ else {
+ while (size--) {
+ if (sort(it->dataptr, N, op) < 0) goto fail;
+ PyArray_ITER_NEXT(it);
+ }
+ }
+
+ NPY_END_THREADS_DESCR(op->descr)
+
+ Py_DECREF(it);
+ return 0;
+
+ fail:
+ END_THREADS
+
+ Py_DECREF(it);
+ return 0;
+}
+
+static PyObject*
+_new_argsort(PyArrayObject *op, int axis, NPY_SORTKIND which)
+{
+
+ PyArrayIterObject *it=NULL;
+ PyArrayIterObject *rit=NULL;
+ PyObject *ret;
+ int needcopy=0, i;
+ intp N, size;
+ int elsize, swap;
+ intp astride, rstride, *iptr;
+ PyArray_ArgSortFunc *argsort;
+ BEGIN_THREADS_DEF
+
+ ret = PyArray_New(op->ob_type, op->nd,
+ op->dimensions, PyArray_INTP,
+ NULL, NULL, 0, 0, (PyObject *)op);
+ if (ret == NULL) return NULL;
+
+ it = (PyArrayIterObject *)PyArray_IterAllButAxis((PyObject *)op, &axis);
+ rit = (PyArrayIterObject *)PyArray_IterAllButAxis(ret, &axis);
+ if (rit == NULL || it == NULL) goto fail;
+
+ swap = !PyArray_ISNOTSWAPPED(op);
+
+ NPY_BEGIN_THREADS_DESCR(op->descr)
+
+ argsort = op->descr->f->argsort[which];
+ size = it->size;
+ N = op->dimensions[axis];
+ elsize = op->descr->elsize;
+ astride = op->strides[axis];
+ rstride = PyArray_STRIDE(ret,axis);
+
+ needcopy = swap || !(op->flags & ALIGNED) || (astride != (intp) elsize) || \
+ (rstride != sizeof(intp));
+
+ if (needcopy) {
+ char *valbuffer, *indbuffer;
+ valbuffer = PyDataMem_NEW(N*elsize);
+ indbuffer = PyDataMem_NEW(N*sizeof(intp));
+ while (size--) {
+ _unaligned_strided_byte_copy(valbuffer, (intp) elsize, it->dataptr,
+ astride, N, elsize);
+ if (swap) _strided_byte_swap(valbuffer, (intp) elsize, N, elsize);
+ iptr = (intp *)indbuffer;
+ for (i=0; i<N; i++) *iptr++ = i;
+ if (argsort(valbuffer, (intp *)indbuffer, N, op) < 0) {
+ PyDataMem_FREE(valbuffer);
+ PyDataMem_FREE(indbuffer);
+ goto fail;
+ }
+ _unaligned_strided_byte_copy(rit->dataptr, rstride, indbuffer,
+ sizeof(intp), N, sizeof(intp));
+ PyArray_ITER_NEXT(it);
+ PyArray_ITER_NEXT(rit);
+ }
+ PyDataMem_FREE(valbuffer);
+ PyDataMem_FREE(indbuffer);
+ }
+ else {
+ while (size--) {
+ iptr = (intp *)rit->dataptr;
+ for (i=0; i<N; i++) *iptr++ = i;
+ if (argsort(it->dataptr, (intp *)rit->dataptr,
+ N, op) < 0) goto fail;
+ PyArray_ITER_NEXT(it);
+ PyArray_ITER_NEXT(rit);
+ }
+ }
+
+ NPY_END_THREADS_DESCR(op->descr)
+
+ Py_DECREF(it);
+ Py_DECREF(rit);
+ return ret;
+
+ fail:
+
+ END_THREADS
+
+ Py_DECREF(ret);
+ Py_XDECREF(it);
+ Py_XDECREF(rit);
+ return NULL;
+}
+
+
+/* Be sure to save this global_compare when necessary */
+
+static PyArrayObject *global_obj;
+
+static int
+qsortCompare (const void *a, const void *b)
+{
+ return global_obj->descr->f->compare(a,b,global_obj);
+}
+
+/* Consumes reference to ap (op gets it)
+ op contains a version of the array with axes swapped if
+ local variable axis is not the last dimension.
+ orign must be defined locally.
+*/
+
+#define SWAPAXES(op, ap) { \
+ orign = (ap)->nd-1; \
+ if (axis != orign) { \
+ (op) = (PyAO *)PyArray_SwapAxes((ap), axis, orign); \
+ Py_DECREF((ap)); \
+ if ((op) == NULL) return NULL; \
+ } \
+ else (op) = (ap); \
+ }
+
+/* Consumes reference to ap (op gets it)
+ origin must be previously defined locally.
+ SWAPAXES must have been called previously.
+ op contains the swapped version of the array.
+*/
+#define SWAPBACK(op, ap) { \
+ if (axis != orign) { \
+ (op) = (PyAO *)PyArray_SwapAxes((ap), axis, orign); \
+ Py_DECREF((ap)); \
+ if ((op) == NULL) return NULL; \
+ } \
+ else (op) = (ap); \
+ }
+
+/* These swap axes in-place if necessary */
+#define SWAPINTP(a,b) {intp c; c=(a); (a) = (b); (b) = c;}
+#define SWAPAXES2(ap) { \
+ orign = (ap)->nd-1; \
+ if (axis != orign) { \
+ SWAPINTP(ap->dimensions[axis], ap->dimensions[orign]); \
+ SWAPINTP(ap->strides[axis], ap->strides[orign]); \
+ PyArray_UpdateFlags(ap, CONTIGUOUS | FORTRAN); \
+ } \
+ }
+
+#define SWAPBACK2(ap) { \
+ if (axis != orign) { \
+ SWAPINTP(ap->dimensions[axis], ap->dimensions[orign]); \
+ SWAPINTP(ap->strides[axis], ap->strides[orign]); \
+ PyArray_UpdateFlags(ap, CONTIGUOUS | FORTRAN); \
+ } \
+ }
+
+/*MULTIARRAY_API
+ Sort an array in-place
+*/
+static int
+PyArray_Sort(PyArrayObject *op, int axis, NPY_SORTKIND which)
+{
+ PyArrayObject *ap=NULL, *store_arr=NULL;
+ char *ip;
+ int i, n, m, elsize, orign;
+
+ n = op->nd;
+ if ((n==0) || (PyArray_SIZE(op)==1)) return 0;
+
+ if (axis < 0) axis += n;
+ if ((axis < 0) || (axis >= n)) {
+ PyErr_Format(PyExc_ValueError,
+ "axis(=%d) out of bounds", axis);
+ return -1;
+ }
+ if (!PyArray_ISWRITEABLE(op)) {
+ PyErr_SetString(PyExc_RuntimeError,
+ "attempted sort on unwriteable array.");
+ return -1;
+ }
+
+ /* Determine if we should use type-specific algorithm or not */
+ if (op->descr->f->sort[which] != NULL) {
+ return _new_sort(op, axis, which);
+ }
+
+ if ((which != PyArray_QUICKSORT) || \
+ op->descr->f->compare == NULL) {
+ PyErr_SetString(PyExc_TypeError,
+ "desired sort not supported for this type");
+ return -1;
+ }
+
+ SWAPAXES2(op);
+
+ ap = (PyArrayObject *)PyArray_FromAny((PyObject *)op,
+ NULL, 1, 0,
+ DEFAULT | UPDATEIFCOPY, NULL);
+ if (ap == NULL) goto fail;
+
+ elsize = ap->descr->elsize;
+ m = ap->dimensions[ap->nd-1];
+ if (m == 0) goto finish;
+
+ n = PyArray_SIZE(ap)/m;
+
+ /* Store global -- allows re-entry -- restore before leaving*/
+ store_arr = global_obj;
+ global_obj = ap;
+
+ for (ip=ap->data, i=0; i<n; i++, ip+=elsize*m) {
+ qsort(ip, m, elsize, qsortCompare);
+ }
+
+ global_obj = store_arr;
+
+ if (PyErr_Occurred()) goto fail;
+
+ finish:
+ Py_DECREF(ap); /* Should update op if needed */
+ SWAPBACK2(op);
+ return 0;
+ fail:
+ Py_XDECREF(ap);
+ SWAPBACK2(op);
+ return -1;
+}
+
+
+static char *global_data;
+
+static int
+argsort_static_compare(const void *ip1, const void *ip2)
+{
+ int isize = global_obj->descr->elsize;
+ const intp *ipa = ip1;
+ const intp *ipb = ip2;
+ return global_obj->descr->f->compare(global_data + (isize * *ipa),
+ global_data + (isize * *ipb),
+ global_obj);
+}
+
+/*MULTIARRAY_API
+ ArgSort an array
+*/
+static PyObject *
+PyArray_ArgSort(PyArrayObject *op, int axis, NPY_SORTKIND which)
+{
+ PyArrayObject *ap=NULL, *ret=NULL, *store, *op2;
+ intp *ip;
+ intp i, j, n, m, orign;
+ int argsort_elsize;
+ char *store_ptr;
+
+ n = op->nd;
+ if ((n==0) || (PyArray_SIZE(op)==1)) {
+ ret = (PyArrayObject *)PyArray_New(op->ob_type, op->nd,
+ op->dimensions,
+ PyArray_INTP,
+ NULL, NULL, 0, 0,
+ (PyObject *)op);
+ if (ret == NULL) return NULL;
+ *((intp *)ret->data) = 0;
+ return (PyObject *)ret;
+ }
+
+ /* Creates new reference op2 */
+ if ((op2=(PyAO *)_check_axis(op, &axis, 0))==NULL) return NULL;
+
+ /* Determine if we should use new algorithm or not */
+ if (op2->descr->f->argsort[which] != NULL) {
+ ret = (PyArrayObject *)_new_argsort(op2, axis, which);
+ Py_DECREF(op2);
+ return (PyObject *)ret;
+ }
+
+ if ((which != PyArray_QUICKSORT) || op2->descr->f->compare == NULL) {
+ PyErr_SetString(PyExc_TypeError,
+ "requested sort not available for type");
+ Py_DECREF(op2);
+ op = NULL;
+ goto fail;
+ }
+
+ /* ap will contain the reference to op2 */
+ SWAPAXES(ap, op2);
+
+ op = (PyArrayObject *)PyArray_ContiguousFromAny((PyObject *)ap,
+ PyArray_NOTYPE,
+ 1, 0);
+
+ Py_DECREF(ap);
+ if (op == NULL) return NULL;
+
+ ret = (PyArrayObject *)PyArray_New(op->ob_type, op->nd,
+ op->dimensions, PyArray_INTP,
+ NULL, NULL, 0, 0, (PyObject *)op);
+ if (ret == NULL) goto fail;
+
+
+ ip = (intp *)ret->data;
+ argsort_elsize = op->descr->elsize;
+ m = op->dimensions[op->nd-1];
+ if (m == 0) goto finish;
+
+ n = PyArray_SIZE(op)/m;
+ store_ptr = global_data;
+ global_data = op->data;
+ store = global_obj;
+ global_obj = op;
+ for (i=0; i<n; i++, ip+=m, global_data += m*argsort_elsize) {
+ for(j=0; j<m; j++) ip[j] = j;
+ qsort((char *)ip, m, sizeof(intp),
+ argsort_static_compare);
+ }
+ global_data = store_ptr;
+ global_obj = store;
+
+
+ finish:
+ Py_DECREF(op);
+ SWAPBACK(op, ret);
+ return (PyObject *)op;
+
+ fail:
+ Py_XDECREF(op);
+ Py_XDECREF(ret);
+ return NULL;
+
+}
+
+
+/*MULTIARRAY_API
+ LexSort an array providing indices that will sort a collection of arrays
+ lexicographically. The first key is sorted on first, followed by the second key
+ -- requires that arg"merge"sort is available for each sort_key
+
+ Returns an index array that shows the indexes for the lexicographic sort along
+ the given axis.
+*/
+static PyObject *
+PyArray_LexSort(PyObject *sort_keys, int axis)
+{
+ PyArrayObject **mps;
+ PyArrayIterObject **its;
+ PyArrayObject *ret=NULL;
+ PyArrayIterObject *rit=NULL;
+ int n;
+ int nd;
+ int needcopy=0, i,j;
+ intp N, size;
+ int elsize;
+ int maxelsize;
+ intp astride, rstride, *iptr;
+ int object=0;
+ PyArray_ArgSortFunc *argsort;
+
+ NPY_BEGIN_THREADS_DEF
+
+ if (!PySequence_Check(sort_keys) || \
+ ((n=PySequence_Size(sort_keys)) <= 0)) {
+ PyErr_SetString(PyExc_TypeError,
+ "need sequence of keys with len > 0 in lexsort");
+ return NULL;
+ }
+ mps = (PyArrayObject **) _pya_malloc(n*sizeof(PyArrayObject));
+ if (mps==NULL) return PyErr_NoMemory();
+ its = (PyArrayIterObject **) _pya_malloc(n*sizeof(PyArrayIterObject));
+ if (its == NULL) {_pya_free(mps); return PyErr_NoMemory();}
+ for (i=0; i<n; i++) {mps[i] = NULL; its[i] = NULL;}
+ for (i=0; i<n; i++) {
+ PyObject *obj;
+ obj = PySequence_GetItem(sort_keys, i);
+ mps[i] = (PyArrayObject *)PyArray_FROM_O(obj);
+ Py_DECREF(obj);
+ if (mps[i] == NULL) goto fail;
+ if (i>0) {
+ if ((mps[i]->nd != mps[0]->nd) || \
+ (!PyArray_CompareLists(mps[i]->dimensions,
+ mps[0]->dimensions,
+ mps[0]->nd))) {
+ PyErr_SetString(PyExc_ValueError,
+ "all keys need to be the same shape");
+ goto fail;
+ }
+ }
+ if (!mps[i]->descr->f->argsort[PyArray_MERGESORT]) {
+ PyErr_Format(PyExc_TypeError,
+ "merge sort not available for item %d", i);
+ goto fail;
+ }
+ if (!object &&
+ PyDataType_FLAGCHK(mps[i]->descr, NPY_NEEDS_PYAPI))
+ object = 1;
+ its[i] = (PyArrayIterObject *)PyArray_IterAllButAxis \
+ ((PyObject *)mps[i], &axis);
+ if (its[i]==NULL) goto fail;
+ }
+
+ /* Now we can check the axis */
+ nd = mps[0]->nd;
+ if ((nd==0) || (PyArray_SIZE(mps[0])==1)) {
+ ret = (PyArrayObject *)PyArray_New(&PyArray_Type, mps[0]->nd,
+ mps[0]->dimensions,
+ PyArray_INTP,
+ NULL, NULL, 0, 0, NULL);
+
+ if (ret == NULL) goto fail;
+ *((intp *)(ret->data)) = 0;
+ goto finish;
+ }
+ if (axis < 0) axis += nd;
+ if ((axis < 0) || (axis >= nd)) {
+ PyErr_Format(PyExc_ValueError,
+ "axis(=%d) out of bounds", axis);
+ goto fail;
+ }
+
+ /* Now do the sorting */
+
+ ret = (PyArrayObject *)PyArray_New(&PyArray_Type, mps[0]->nd,
+ mps[0]->dimensions, PyArray_INTP,
+ NULL, NULL, 0, 0, NULL);
+ if (ret == NULL) goto fail;
+
+ rit = (PyArrayIterObject *)\
+ PyArray_IterAllButAxis((PyObject *)ret, &axis);
+ if (rit == NULL) goto fail;
+
+ if (!object) {NPY_BEGIN_THREADS}
+
+ size = rit->size;
+ N = mps[0]->dimensions[axis];
+ rstride = PyArray_STRIDE(ret,axis);
+
+ maxelsize = mps[0]->descr->elsize;
+ needcopy = (rstride != sizeof(intp));
+ for (j=0; j<n && !needcopy; j++) {
+ needcopy = PyArray_ISBYTESWAPPED(mps[j]) || \
+ !(mps[j]->flags & ALIGNED) || \
+ (mps[j]->strides[axis] != (intp)mps[j]->descr->elsize);
+ if (mps[j]->descr->elsize > maxelsize)
+ maxelsize = mps[j]->descr->elsize;
+ }
+
+ if (needcopy) {
+ char *valbuffer, *indbuffer;
+ int *swaps;
+ valbuffer = PyDataMem_NEW(N*maxelsize);
+ indbuffer = PyDataMem_NEW(N*sizeof(intp));
+ swaps = malloc(n*sizeof(int));
+ for (j=0; j<n; j++) swaps[j] = PyArray_ISBYTESWAPPED(mps[j]);
+ while (size--) {
+ iptr = (intp *)indbuffer;
+ for (i=0; i<N; i++) *iptr++ = i;
+ for (j=0; j<n; j++) {
+ elsize = mps[j]->descr->elsize;
+ astride = mps[j]->strides[axis];
+ argsort = mps[j]->descr->f->argsort[PyArray_MERGESORT];
+ _unaligned_strided_byte_copy(valbuffer, (intp) elsize,
+ its[j]->dataptr, astride, N, elsize);
+ if (swaps[j])
+ _strided_byte_swap(valbuffer, (intp) elsize, N, elsize);
+ if (argsort(valbuffer, (intp *)indbuffer, N, mps[j]) < 0) {
+ PyDataMem_FREE(valbuffer);
+ PyDataMem_FREE(indbuffer);
+ free(swaps);
+ goto fail;
+ }
+ PyArray_ITER_NEXT(its[j]);
+ }
+ _unaligned_strided_byte_copy(rit->dataptr, rstride, indbuffer,
+ sizeof(intp), N, sizeof(intp));
+ PyArray_ITER_NEXT(rit);
+ }
+ PyDataMem_FREE(valbuffer);
+ PyDataMem_FREE(indbuffer);
+ free(swaps);
+ }
+ else {
+ while (size--) {
+ iptr = (intp *)rit->dataptr;
+ for (i=0; i<N; i++) *iptr++ = i;
+ for (j=0; j<n; j++) {
+ argsort = mps[j]->descr->f->argsort[PyArray_MERGESORT];
+ if (argsort(its[j]->dataptr, (intp *)rit->dataptr,
+ N, mps[j]) < 0) goto fail;
+ PyArray_ITER_NEXT(its[j]);
+ }
+ PyArray_ITER_NEXT(rit);
+ }
+ }
+
+ if (!object) {NPY_END_THREADS}
+
+ finish:
+ for (i=0; i<n; i++) {Py_XDECREF(mps[i]); Py_XDECREF(its[i]);}
+ Py_XDECREF(rit);
+ _pya_free(mps);
+ _pya_free(its);
+ return (PyObject *)ret;
+
+ fail:
+ NPY_END_THREADS
+
+ Py_XDECREF(rit);
+ Py_XDECREF(ret);
+ for (i=0; i<n; i++) {Py_XDECREF(mps[i]); Py_XDECREF(its[i]);}
+ _pya_free(mps);
+ _pya_free(its);
+ return NULL;
+
+}
+
+
+/** @brief Use bisection of sorted array to find first entries >= keys.
+ *
+ * For each key use bisection to find the first index i s.t. key <= arr[i].
+ * When there is no such index i, set i = len(arr). Return the results in ret.
+ * All arrays are assumed contiguous on entry and both arr and key must be of
+ * the same comparable type.
+ *
+ * @param arr contiguous sorted array to be searched.
+ * @param key contiguous array of keys.
+ * @param ret contiguous array of intp for returned indices.
+ * @return void
+ */
+static void
+local_search_left(PyArrayObject *arr, PyArrayObject *key, PyArrayObject *ret)
+{
+ PyArray_CompareFunc *compare = key->descr->f->compare;
+ intp nelts = arr->dimensions[arr->nd - 1];
+ intp nkeys = PyArray_SIZE(key);
+ char *parr = arr->data;
+ char *pkey = key->data;
+ intp *pret = (intp *)ret->data;
+ int elsize = arr->descr->elsize;
+ intp i;
+
+ for(i = 0; i < nkeys; ++i) {
+ intp imin = 0;
+ intp imax = nelts;
+ while (imin < imax) {
+ intp imid = imin + ((imax - imin) >> 2);
+ if (compare(parr + elsize*imid, pkey, key) < 0)
+ imin = imid + 1;
+ else
+ imax = imid;
+ }
+ *pret = imin;
+ pret += 1;
+ pkey += elsize;
+ }
+}
+
+
+/** @brief Use bisection of sorted array to find first entries > keys.
+ *
+ * For each key use bisection to find the first index i s.t. key < arr[i].
+ * When there is no such index i, set i = len(arr). Return the results in ret.
+ * All arrays are assumed contiguous on entry and both arr and key must be of
+ * the same comparable type.
+ *
+ * @param arr contiguous sorted array to be searched.
+ * @param key contiguous array of keys.
+ * @param ret contiguous array of intp for returned indices.
+ * @return void
+ */
+static void
+local_search_right(PyArrayObject *arr, PyArrayObject *key, PyArrayObject *ret)
+{
+ PyArray_CompareFunc *compare = key->descr->f->compare;
+ intp nelts = arr->dimensions[arr->nd - 1];
+ intp nkeys = PyArray_SIZE(key);
+ char *parr = arr->data;
+ char *pkey = key->data;
+ intp *pret = (intp *)ret->data;
+ int elsize = arr->descr->elsize;
+ intp i;
+
+ for(i = 0; i < nkeys; ++i) {
+ intp imin = 0;
+ intp imax = nelts;
+ while (imin < imax) {
+ intp imid = imin + ((imax - imin) >> 2);
+ if (compare(parr + elsize*imid, pkey, key) <= 0)
+ imin = imid + 1;
+ else
+ imax = imid;
+ }
+ *pret = imin;
+ pret += 1;
+ pkey += elsize;
+ }
+}
+
+
+/*MULTIARRAY_API
+ Convert object to searchsorted side
+*/
+static int
+PyArray_SearchsideConverter(PyObject *obj, void *addr)
+{
+ NPY_SEARCHSIDE *side = (NPY_SEARCHSIDE *)addr;
+ char *str = PyString_AsString(obj);
+
+ if (!str || strlen(str) < 1) {
+ PyErr_SetString(PyExc_ValueError,
+ "expected nonempty string for keyword 'side'");
+ return PY_FAIL;
+ }
+
+ if (str[0] == 'l' || str[0] == 'L')
+ *side = NPY_SEARCHLEFT;
+ else if (str[0] == 'r' || str[0] == 'R')
+ *side = NPY_SEARCHRIGHT;
+ else {
+ PyErr_Format(PyExc_ValueError,
+ "'%s' is an invalid value for keyword 'side'", str);
+ return PY_FAIL;
+ }
+ return PY_SUCCEED;
+}
+
+
+/*MULTIARRAY_API
+ Numeric.searchsorted(a,v)
+*/
+static PyObject *
+PyArray_SearchSorted(PyArrayObject *op1, PyObject *op2, NPY_SEARCHSIDE side)
+{
+ PyArrayObject *ap1=NULL;
+ PyArrayObject *ap2=NULL;
+ PyArrayObject *ret=NULL;
+ int typenum = 0;
+
+ NPY_BEGIN_THREADS_DEF
+
+ typenum = PyArray_ObjectType((PyObject *)op1, 0);
+ typenum = PyArray_ObjectType(op2, typenum);
+
+ /* need ap1 as contiguous array and of right type */
+ ap1 = (PyArrayObject *)PyArray_ContiguousFromAny((PyObject *)op1,
+ typenum,
+ 1, 1);
+ if (ap1 == NULL)
+ return NULL;
+
+ /* need ap2 as contiguous array and of right type */
+ ap2 = (PyArrayObject *)PyArray_ContiguousFromAny(op2, typenum,
+ 0, 0);
+ if (ap2 == NULL)
+ goto fail;
+
+ /* ret is a contiguous array of intp type to hold returned indices */
+ ret = (PyArrayObject *)PyArray_New(ap2->ob_type, ap2->nd,
+ ap2->dimensions, PyArray_INTP,
+ NULL, NULL, 0, 0, (PyObject *)ap2);
+ if (ret == NULL)
+ goto fail;
+
+ /* check that comparison function exists */
+ if (ap2->descr->f->compare == NULL) {
+ PyErr_SetString(PyExc_TypeError,
+ "compare not supported for type");
+ goto fail;
+ }
+
+ if (side == NPY_SEARCHLEFT) {
+ NPY_BEGIN_THREADS_DESCR(ap2->descr)
+ local_search_left(ap1, ap2, ret);
+ NPY_END_THREADS_DESCR(ap2->descr)
+ }
+ else if (side == NPY_SEARCHRIGHT) {
+ NPY_BEGIN_THREADS_DESCR(ap2->descr)
+ local_search_right(ap1, ap2, ret);
+ NPY_END_THREADS_DESCR(ap2->descr)
+ }
+ Py_DECREF(ap1);
+ Py_DECREF(ap2);
+ return (PyObject *)ret;
+
+ fail:
+ Py_XDECREF(ap1);
+ Py_XDECREF(ap2);
+ Py_XDECREF(ret);
+ return NULL;
+}
+
+/*
+ Make a new empty array, of the passed size, of a type that takes the
+ priority of ap1 and ap2 into account.
+ */
+static PyArrayObject *
+new_array_for_sum(PyArrayObject *ap1, PyArrayObject *ap2,
+ int nd, intp dimensions[], int typenum)
+{
+ PyArrayObject *ret;
+ PyTypeObject *subtype;
+ double prior1, prior2;
+ /* Need to choose an output array that can hold a sum
+ -- use priority to determine which subtype.
+ */
+ if (ap2->ob_type != ap1->ob_type) {
+ prior2 = PyArray_GetPriority((PyObject *)ap2, 0.0);
+ prior1 = PyArray_GetPriority((PyObject *)ap1, 0.0);
+
+ subtype = (prior2 > prior1 ? ap2->ob_type : ap1->ob_type);
+ } else {
+ prior1 = prior2 = 0.0;
+ subtype = ap1->ob_type;
+ }
+
+ ret = (PyArrayObject *)PyArray_New(subtype, nd, dimensions,
+ typenum, NULL, NULL, 0, 0,
+ (PyObject *)
+ (prior2 > prior1 ? ap2 : ap1));
+ return ret;
+}
+
+/* Could perhaps be redone to not make contiguous arrays
+ */
+
+/*MULTIARRAY_API
+ Numeric.innerproduct(a,v)
+*/
+static PyObject *
+PyArray_InnerProduct(PyObject *op1, PyObject *op2)
+{
+ PyArrayObject *ap1, *ap2, *ret=NULL;
+ PyArrayIterObject *it1, *it2;
+ intp i, j, l;
+ int typenum, nd, axis;
+ intp is1, is2, os;
+ char *op;
+ intp dimensions[MAX_DIMS];
+ PyArray_DotFunc *dot;
+ PyArray_Descr *typec;
+
+ NPY_BEGIN_THREADS_DEF
+
+ typenum = PyArray_ObjectType(op1, 0);
+ typenum = PyArray_ObjectType(op2, typenum);
+
+ typec = PyArray_DescrFromType(typenum);
+ Py_INCREF(typec);
+ ap1 = (PyArrayObject *)PyArray_FromAny(op1, typec, 0, 0,
+ BEHAVED, NULL);
+ if (ap1 == NULL) {Py_DECREF(typec); return NULL;}
+ ap2 = (PyArrayObject *)PyArray_FromAny(op2, typec, 0, 0,
+ BEHAVED, NULL);
+ if (ap2 == NULL) goto fail;
+
+ if (ap1->nd == 0 || ap2->nd == 0) {
+ ret = (ap1->nd == 0 ? ap1 : ap2);
+ ret = (PyArrayObject *)ret->ob_type->tp_as_number->\
+ nb_multiply((PyObject *)ap1, (PyObject *)ap2);
+ Py_DECREF(ap1);
+ Py_DECREF(ap2);
+ return (PyObject *)ret;
+ }
+
+ l = ap1->dimensions[ap1->nd-1];
+
+ if (ap2->dimensions[ap2->nd-1] != l) {
+ PyErr_SetString(PyExc_ValueError, "matrices are not aligned");
+ goto fail;
+ }
+
+ nd = ap1->nd+ap2->nd-2;
+ j = 0;
+ for(i=0; i<ap1->nd-1; i++) {
+ dimensions[j++] = ap1->dimensions[i];
+ }
+ for(i=0; i<ap2->nd-1; i++) {
+ dimensions[j++] = ap2->dimensions[i];
+ }
+
+
+ /* Need to choose an output array that can hold a sum
+ -- use priority to determine which subtype.
+ */
+ ret = new_array_for_sum(ap1, ap2, nd, dimensions, typenum);
+ if (ret == NULL) goto fail;
+
+ dot = (ret->descr->f->dotfunc);
+
+ if (dot == NULL) {
+ PyErr_SetString(PyExc_ValueError,
+ "dot not available for this type");
+ goto fail;
+ }
+
+ is1 = ap1->strides[ap1->nd-1];
+ is2 = ap2->strides[ap2->nd-1];
+ op = ret->data; os = ret->descr->elsize;
+
+ axis = ap1->nd-1;
+ it1 = (PyArrayIterObject *)\
+ PyArray_IterAllButAxis((PyObject *)ap1, &axis);
+ axis = ap2->nd-1;
+ it2 = (PyArrayIterObject *)\
+ PyArray_IterAllButAxis((PyObject *)ap2, &axis);
+
+ NPY_BEGIN_THREADS_DESCR(ap2->descr)
+ while(1) {
+ while(it2->index < it2->size) {
+ dot(it1->dataptr, is1, it2->dataptr, is2, op, l, ret);
+ op += os;
+ PyArray_ITER_NEXT(it2);
+ }
+ PyArray_ITER_NEXT(it1);
+ if (it1->index >= it1->size) break;
+ PyArray_ITER_RESET(it2);
+ }
+ NPY_END_THREADS_DESCR(ap2->descr)
+ Py_DECREF(it1);
+ Py_DECREF(it2);
+
+ if (PyErr_Occurred()) goto fail;
+
+
+ Py_DECREF(ap1);
+ Py_DECREF(ap2);
+ return (PyObject *)ret;
+
+ fail:
+ Py_XDECREF(ap1);
+ Py_XDECREF(ap2);
+ Py_XDECREF(ret);
+ return NULL;
+}
+
+
+/* just like inner product but does the swapaxes stuff on the fly */
+/*MULTIARRAY_API
+ Numeric.matrixproduct(a,v)
+*/
+static PyObject *
+PyArray_MatrixProduct(PyObject *op1, PyObject *op2)
+{
+ PyArrayObject *ap1, *ap2, *ret=NULL;
+ PyArrayIterObject *it1, *it2;
+ intp i, j, l;
+ int typenum, nd, axis, matchDim;
+ intp is1, is2, os;
+ char *op;
+ intp dimensions[MAX_DIMS];
+ PyArray_DotFunc *dot;
+ PyArray_Descr *typec;
+
+ NPY_BEGIN_THREADS_DEF
+
+ typenum = PyArray_ObjectType(op1, 0);
+ typenum = PyArray_ObjectType(op2, typenum);
+
+ typec = PyArray_DescrFromType(typenum);
+ Py_INCREF(typec);
+ ap1 = (PyArrayObject *)PyArray_FromAny(op1, typec, 0, 0,
+ BEHAVED, NULL);
+ if (ap1 == NULL) {Py_DECREF(typec); return NULL;}
+ ap2 = (PyArrayObject *)PyArray_FromAny(op2, typec, 0, 0,
+ BEHAVED, NULL);
+ if (ap2 == NULL) goto fail;
+
+ if (ap1->nd == 0 || ap2->nd == 0) {
+ ret = (ap1->nd == 0 ? ap1 : ap2);
+ ret = (PyArrayObject *)ret->ob_type->tp_as_number->\
+ nb_multiply((PyObject *)ap1, (PyObject *)ap2);
+ Py_DECREF(ap1);
+ Py_DECREF(ap2);
+ return (PyObject *)ret;
+ }
+
+ l = ap1->dimensions[ap1->nd-1];
+ if (ap2->nd > 1) {
+ matchDim = ap2->nd - 2;
+ }
+ else {
+ matchDim = 0;
+ }
+
+ if (ap2->dimensions[matchDim] != l) {
+ PyErr_SetString(PyExc_ValueError, "objects are not aligned");
+ goto fail;
+ }
+
+ nd = ap1->nd+ap2->nd-2;
+ if (nd > NPY_MAXDIMS) {
+ PyErr_SetString(PyExc_ValueError,
+ "dot: too many dimensions in result");
+ goto fail;
+ }
+ j = 0;
+ for(i=0; i<ap1->nd-1; i++) {
+ dimensions[j++] = ap1->dimensions[i];
+ }
+ for(i=0; i<ap2->nd-2; i++) {
+ dimensions[j++] = ap2->dimensions[i];
+ }
+ if(ap2->nd > 1) {
+ dimensions[j++] = ap2->dimensions[ap2->nd-1];
+ }
+ /*
+ fprintf(stderr, "nd=%d dimensions=", nd);
+ for(i=0; i<j; i++)
+ fprintf(stderr, "%d ", dimensions[i]);
+ fprintf(stderr, "\n");
+ */
+
+ is1 = ap1->strides[ap1->nd-1]; is2 = ap2->strides[matchDim];
+
+ /* Choose which subtype to return */
+ ret = new_array_for_sum(ap1, ap2, nd, dimensions, typenum);
+ if (ret == NULL) goto fail;
+
+ /* Ensure that multiarray.dot(<Nx0>,<0xM>) -> zeros((N,M)) */
+ if (PyArray_SIZE(ap1) == 0 && PyArray_SIZE(ap2) == 0) {
+ memset(PyArray_DATA(ret), 0, PyArray_NBYTES(ret));
+ }
+ else { /* Ensure that multiarray.dot([],[]) -> 0 */
+ memset(PyArray_DATA(ret), 0, PyArray_ITEMSIZE(ret));
+ }
+
+
+ dot = ret->descr->f->dotfunc;
+ if (dot == NULL) {
+ PyErr_SetString(PyExc_ValueError,
+ "dot not available for this type");
+ goto fail;
+ }
+
+ op = ret->data; os = ret->descr->elsize;
+
+ axis = ap1->nd-1;
+ it1 = (PyArrayIterObject *)\
+ PyArray_IterAllButAxis((PyObject *)ap1, &axis);
+ it2 = (PyArrayIterObject *)\
+ PyArray_IterAllButAxis((PyObject *)ap2, &matchDim);
+
+ NPY_BEGIN_THREADS_DESCR(ap2->descr)
+ while(1) {
+ while(it2->index < it2->size) {
+ dot(it1->dataptr, is1, it2->dataptr, is2, op, l, ret);
+ op += os;
+ PyArray_ITER_NEXT(it2);
+ }
+ PyArray_ITER_NEXT(it1);
+ if (it1->index >= it1->size) break;
+ PyArray_ITER_RESET(it2);
+ }
+ NPY_END_THREADS_DESCR(ap2->descr)
+ Py_DECREF(it1);
+ Py_DECREF(it2);
+ if (PyErr_Occurred()) goto fail; /* only for OBJECT arrays */
+
+ Py_DECREF(ap1);
+ Py_DECREF(ap2);
+ return (PyObject *)ret;
+
+ fail:
+ Py_XDECREF(ap1);
+ Py_XDECREF(ap2);
+ Py_XDECREF(ret);
+ return NULL;
+}
+
+/*MULTIARRAY_API
+ Fast Copy and Transpose
+*/
+static PyObject *
+PyArray_CopyAndTranspose(PyObject *op)
+{
+ PyObject *ret, *arr;
+ int nd;
+ intp dims[2];
+ intp i,j;
+ int elsize, str2;
+ char *iptr;
+ char *optr;
+
+ /* make sure it is well-behaved */
+ arr = PyArray_FromAny(op, NULL, 0, 0, CARRAY, NULL);
+ nd = PyArray_NDIM(arr);
+ if (nd == 1) { /* we will give in to old behavior */
+ ret = PyArray_Copy((PyArrayObject *)arr);
+ Py_DECREF(arr);
+ return ret;
+ }
+ else if (nd != 2) {
+ Py_DECREF(arr);
+ PyErr_SetString(PyExc_ValueError,
+ "only 2-d arrays are allowed");
+ return NULL;
+ }
+
+ /* Now construct output array */
+ dims[0] = PyArray_DIM(arr,1);
+ dims[1] = PyArray_DIM(arr,0);
+ elsize = PyArray_ITEMSIZE(arr);
+
+ Py_INCREF(PyArray_DESCR(arr));
+ ret = PyArray_NewFromDescr(arr->ob_type,
+ PyArray_DESCR(arr),
+ 2, dims,
+ NULL, NULL, 0, arr);
+
+ if (ret == NULL) {
+ Py_DECREF(arr);
+ return NULL;
+ }
+ /* do 2-d loop */
+ NPY_BEGIN_ALLOW_THREADS
+ optr = PyArray_DATA(ret);
+ str2 = elsize*dims[0];
+ for (i=0; i<dims[0]; i++) {
+ iptr = PyArray_BYTES(arr) + i*elsize;
+ for (j=0; j<dims[1]; j++) {
+ /* optr[i,j] = iptr[j,i] */
+ memcpy(optr, iptr, elsize);
+ optr += elsize;
+ iptr += str2;
+ }
+ }
+ NPY_END_ALLOW_THREADS
+ Py_DECREF(arr);
+ return ret;
+}
+
+/*MULTIARRAY_API
+ Numeric.correlate(a1,a2,mode)
+*/
+static PyObject *
+PyArray_Correlate(PyObject *op1, PyObject *op2, int mode)
+{
+ PyArrayObject *ap1, *ap2, *ret=NULL;
+ intp length;
+ intp i, n1, n2, n, n_left, n_right;
+ int typenum;
+ intp is1, is2, os;
+ char *ip1, *ip2, *op;
+ PyArray_DotFunc *dot;
+ PyArray_Descr *typec;
+
+ NPY_BEGIN_THREADS_DEF
+
+ typenum = PyArray_ObjectType(op1, 0);
+ typenum = PyArray_ObjectType(op2, typenum);
+
+ typec = PyArray_DescrFromType(typenum);
+ Py_INCREF(typec);
+ ap1 = (PyArrayObject *)PyArray_FromAny(op1, typec, 1, 1,
+ DEFAULT, NULL);
+ if (ap1 == NULL) {Py_DECREF(typec); return NULL;}
+ ap2 = (PyArrayObject *)PyArray_FromAny(op2, typec, 1, 1,
+ DEFAULT, NULL);
+ if (ap2 == NULL) goto fail;
+
+ n1 = ap1->dimensions[0];
+ n2 = ap2->dimensions[0];
+
+ if (n1 < n2) {
+ ret = ap1; ap1 = ap2; ap2 = ret;
+ ret = NULL; i = n1;n1=n2;n2=i;
+ }
+ length = n1;
+ n = n2;
+ switch(mode) {
+ case 0:
+ length = length-n+1;
+ n_left = n_right = 0;
+ break;
+ case 1:
+ n_left = (intp)(n/2);
+ n_right = n-n_left-1;
+ break;
+ case 2:
+ n_right = n-1;
+ n_left = n-1;
+ length = length+n-1;
+ break;
+ default:
+ PyErr_SetString(PyExc_ValueError,
+ "mode must be 0, 1, or 2");
+ goto fail;
+ }
+
+ /* Need to choose an output array that can hold a sum
+ -- use priority to determine which subtype.
+ */
+ ret = new_array_for_sum(ap1, ap2, 1, &length, typenum);
+ if (ret == NULL) goto fail;
+
+ dot = ret->descr->f->dotfunc;
+ if (dot == NULL) {
+ PyErr_SetString(PyExc_ValueError,
+ "function not available for this data type");
+ goto fail;
+ }
+
+ NPY_BEGIN_THREADS_DESCR(ret->descr)
+
+ is1 = ap1->strides[0]; is2 = ap2->strides[0];
+ op = ret->data; os = ret->descr->elsize;
+
+ ip1 = ap1->data; ip2 = ap2->data+n_left*is2;
+ n = n-n_left;
+ for(i=0; i<n_left; i++) {
+ dot(ip1, is1, ip2, is2, op, n, ret);
+ n++;
+ ip2 -= is2;
+ op += os;
+ }
+ for(i=0; i<(n1-n2+1); i++) {
+ dot(ip1, is1, ip2, is2, op, n, ret);
+ ip1 += is1;
+ op += os;
+ }
+ for(i=0; i<n_right; i++) {
+ n--;
+ dot(ip1, is1, ip2, is2, op, n, ret);
+ ip1 += is1;
+ op += os;
+ }
+ NPY_END_THREADS_DESCR(ret->descr)
+
+ if (PyErr_Occurred()) goto fail;
+ Py_DECREF(ap1);
+ Py_DECREF(ap2);
+ return (PyObject *)ret;
+
+ fail:
+ Py_XDECREF(ap1);
+ Py_XDECREF(ap2);
+ Py_XDECREF(ret);
+ return NULL;
+}
+
+
+/*MULTIARRAY_API
+ ArgMin
+*/
+static PyObject *
+PyArray_ArgMin(PyArrayObject *ap, int axis, PyArrayObject *out)
+{
+ PyObject *obj, *new, *ret;
+
+ if (PyArray_ISFLEXIBLE(ap)) {
+ PyErr_SetString(PyExc_TypeError,
+ "argmax is unsupported for this type");
+ return NULL;
+ }
+ else if (PyArray_ISUNSIGNED(ap))
+ obj = PyInt_FromLong((long) -1);
+
+ else if (PyArray_TYPE(ap)==PyArray_BOOL)
+ obj = PyInt_FromLong((long) 1);
+
+ else
+ obj = PyInt_FromLong((long) 0);
+
+ new = PyArray_EnsureAnyArray(PyNumber_Subtract(obj, (PyObject *)ap));
+ Py_DECREF(obj);
+ if (new == NULL) return NULL;
+ ret = PyArray_ArgMax((PyArrayObject *)new, axis, out);
+ Py_DECREF(new);
+ return ret;
+}
+
+/*MULTIARRAY_API
+ Max
+*/
+static PyObject *
+PyArray_Max(PyArrayObject *ap, int axis, PyArrayObject *out)
+{
+ PyArrayObject *arr;
+ PyObject *ret;
+
+ if ((arr=(PyArrayObject *)_check_axis(ap, &axis, 0))==NULL)
+ return NULL;
+ ret = PyArray_GenericReduceFunction(arr, n_ops.maximum, axis,
+ arr->descr->type_num, out);
+ Py_DECREF(arr);
+ return ret;
+}
+
+/*MULTIARRAY_API
+ Min
+*/
+static PyObject *
+PyArray_Min(PyArrayObject *ap, int axis, PyArrayObject *out)
+{
+ PyArrayObject *arr;
+ PyObject *ret;
+
+ if ((arr=(PyArrayObject *)_check_axis(ap, &axis, 0))==NULL)
+ return NULL;
+ ret = PyArray_GenericReduceFunction(arr, n_ops.minimum, axis,
+ arr->descr->type_num, out);
+ Py_DECREF(arr);
+ return ret;
+}
+
+/*MULTIARRAY_API
+ Ptp
+*/
+static PyObject *
+PyArray_Ptp(PyArrayObject *ap, int axis, PyArrayObject *out)
+{
+ PyArrayObject *arr;
+ PyObject *ret;
+ PyObject *obj1=NULL, *obj2=NULL;
+
+ if ((arr=(PyArrayObject *)_check_axis(ap, &axis, 0))==NULL)
+ return NULL;
+ obj1 = PyArray_Max(arr, axis, out);
+ if (obj1 == NULL) goto fail;
+ obj2 = PyArray_Min(arr, axis, NULL);
+ if (obj2 == NULL) goto fail;
+ Py_DECREF(arr);
+ if (out) {
+ ret = PyObject_CallFunction(n_ops.subtract, "OOO", out, obj2, out);
+ }
+ else {
+ ret = PyNumber_Subtract(obj1, obj2);
+ }
+ Py_DECREF(obj1);
+ Py_DECREF(obj2);
+ return ret;
+
+ fail:
+ Py_XDECREF(arr);
+ Py_XDECREF(obj1);
+ Py_XDECREF(obj2);
+ return NULL;
+}
+
+
+/*MULTIARRAY_API
+ ArgMax
+*/
+static PyObject *
+PyArray_ArgMax(PyArrayObject *op, int axis, PyArrayObject *out)
+{
+ PyArrayObject *ap=NULL, *rp=NULL;
+ PyArray_ArgFunc* arg_func;
+ char *ip;
+ intp *rptr;
+ intp i, n, m;
+ int elsize;
+ int copyret=0;
+
+ NPY_BEGIN_THREADS_DEF
+
+ if ((ap=(PyAO *)_check_axis(op, &axis, 0))==NULL) return NULL;
+
+ /* We need to permute the array so that axis is placed at the end.
+ And all other dimensions are shifted left.
+ */
+ if (axis != ap->nd-1) {
+ PyArray_Dims newaxes;
+ intp dims[MAX_DIMS];
+ int i;
+ newaxes.ptr = dims;
+ newaxes.len = ap->nd;
+ for (i=0; i<axis; i++) dims[i] = i;
+ for (i=axis; i<ap->nd-1; i++) dims[i] = i+1;
+ dims[ap->nd-1] = axis;
+ op = (PyAO *)PyArray_Transpose(ap, &newaxes);
+ Py_DECREF(ap);
+ if (op == NULL) return NULL;
+ }
+ else {
+ op = ap;
+ }
+
+ ap = (PyArrayObject *)\
+ PyArray_ContiguousFromAny((PyObject *)op,
+ PyArray_NOTYPE, 1, 0);
+
+ Py_DECREF(op);
+ if (ap == NULL) return NULL;
+
+ arg_func = ap->descr->f->argmax;
+ if (arg_func == NULL) {
+ PyErr_SetString(PyExc_TypeError, "data type not ordered");
+ goto fail;
+ }
+
+ elsize = ap->descr->elsize;
+ m = ap->dimensions[ap->nd-1];
+ if (m == 0) {
+ PyErr_SetString(MultiArrayError,
+ "attempt to get argmax/argmin "\
+ "of an empty sequence??");
+ goto fail;
+ }
+
+ if (!out) {
+ rp = (PyArrayObject *)PyArray_New(ap->ob_type, ap->nd-1,
+ ap->dimensions, PyArray_INTP,
+ NULL, NULL, 0, 0,
+ (PyObject *)ap);
+ if (rp == NULL) goto fail;
+ }
+ else {
+ if (PyArray_SIZE(out) != \
+ PyArray_MultiplyList(ap->dimensions, ap->nd-1)) {
+ PyErr_SetString(PyExc_TypeError,
+ "invalid shape for output array.");
+ }
+ rp = (PyArrayObject *)\
+ PyArray_FromArray(out,
+ PyArray_DescrFromType(PyArray_INTP),
+ NPY_CARRAY | NPY_UPDATEIFCOPY);
+ if (rp == NULL) goto fail;
+ if (rp != out) copyret = 1;
+ }
+
+ NPY_BEGIN_THREADS_DESCR(ap->descr)
+ n = PyArray_SIZE(ap)/m;
+ rptr = (intp *)rp->data;
+ for (ip = ap->data, i=0; i<n; i++, ip+=elsize*m) {
+ arg_func(ip, m, rptr, ap);
+ rptr += 1;
+ }
+ NPY_END_THREADS_DESCR(ap->descr)
+
+ Py_DECREF(ap);
+ if (copyret) {
+ PyArrayObject *obj;
+ obj = (PyArrayObject *)rp->base;
+ Py_INCREF(obj);
+ Py_DECREF(rp);
+ rp = obj;
+ }
+ return (PyObject *)rp;
+
+ fail:
+ Py_DECREF(ap);
+ Py_XDECREF(rp);
+ return NULL;
+}
+
+
+/*MULTIARRAY_API
+ Take
+*/
+static PyObject *
+PyArray_TakeFrom(PyArrayObject *self0, PyObject *indices0, int axis,
+ PyArrayObject *ret, NPY_CLIPMODE clipmode)
+{
+ PyArrayObject *self, *indices;
+ intp nd, i, j, n, m, max_item, tmp, chunk;
+ intp shape[MAX_DIMS];
+ char *src, *dest;
+ int copyret=0;
+
+ indices = NULL;
+ self = (PyAO *)_check_axis(self0, &axis, CARRAY);
+ if (self == NULL) return NULL;
+
+ indices = (PyArrayObject *)PyArray_ContiguousFromAny(indices0,
+ PyArray_INTP,
+ 1, 0);
+ if (indices == NULL) goto fail;
+
+ n = m = chunk = 1;
+ nd = self->nd + indices->nd - 1;
+ for (i=0; i< nd; i++) {
+ if (i < axis) {
+ shape[i] = self->dimensions[i];
+ n *= shape[i];
+ } else {
+ if (i < axis+indices->nd) {
+ shape[i] = indices->dimensions[i-axis];
+ m *= shape[i];
+ } else {
+ shape[i] = self->dimensions[i-indices->nd+1];
+ chunk *= shape[i];
+ }
+ }
+ }
+ Py_INCREF(self->descr);
+ if (!ret) {
+ ret = (PyArrayObject *)PyArray_NewFromDescr(self->ob_type,
+ self->descr,
+ nd, shape,
+ NULL, NULL, 0,
+ (PyObject *)self);
+
+ if (ret == NULL) goto fail;
+ }
+ else {
+ PyArrayObject *obj;
+ int flags = NPY_CARRAY | NPY_UPDATEIFCOPY;
+
+ if ((ret->nd != nd) ||
+ !PyArray_CompareLists(ret->dimensions, shape, nd)) {
+ PyErr_SetString(PyExc_ValueError,
+ "bad shape in output array");
+ ret = NULL;
+ Py_DECREF(self->descr);
+ goto fail;
+ }
+
+ if (clipmode == NPY_RAISE) {
+ /* we need to make sure and get a copy
+ so the input array is not changed
+ before the error is called
+ */
+ flags |= NPY_ENSURECOPY;
+ }
+ obj = (PyArrayObject *)PyArray_FromArray(ret, self->descr,
+ flags);
+ if (obj != ret) copyret = 1;
+ ret = obj;
+ }
+
+ max_item = self->dimensions[axis];
+ chunk = chunk * ret->descr->elsize;
+ src = self->data;
+ dest = ret->data;
+
+ switch(clipmode) {
+ case NPY_RAISE:
+ for(i=0; i<n; i++) {
+ for(j=0; j<m; j++) {
+ tmp = ((intp *)(indices->data))[j];
+ if (tmp < 0) tmp = tmp+max_item;
+ if ((tmp < 0) || (tmp >= max_item)) {
+ PyErr_SetString(PyExc_IndexError,
+ "index out of range "\
+ "for array");
+ goto fail;
+ }
+ memmove(dest, src+tmp*chunk, chunk);
+ dest += chunk;
+ }
+ src += chunk*max_item;
+ }
+ break;
+ case NPY_WRAP:
+ for(i=0; i<n; i++) {
+ for(j=0; j<m; j++) {
+ tmp = ((intp *)(indices->data))[j];
+ if (tmp < 0) while (tmp < 0) tmp += max_item;
+ else if (tmp >= max_item)
+ while (tmp >= max_item)
+ tmp -= max_item;
+ memmove(dest, src+tmp*chunk, chunk);
+ dest += chunk;
+ }
+ src += chunk*max_item;
+ }
+ break;
+ case NPY_CLIP:
+ for(i=0; i<n; i++) {
+ for(j=0; j<m; j++) {
+ tmp = ((intp *)(indices->data))[j];
+ if (tmp < 0)
+ tmp = 0;
+ else if (tmp >= max_item)
+ tmp = max_item-1;
+ memmove(dest, src+tmp*chunk, chunk);
+ dest += chunk;
+ }
+ src += chunk*max_item;
+ }
+ break;
+ }
+
+ PyArray_INCREF(ret);
+
+ Py_XDECREF(indices);
+ Py_XDECREF(self);
+ if (copyret) {
+ PyObject *obj;
+ obj = ret->base;
+ Py_INCREF(obj);
+ Py_DECREF(ret);
+ ret = (PyArrayObject *)obj;
+ }
+
+ return (PyObject *)ret;
+
+
+ fail:
+ PyArray_XDECREF_ERR(ret);
+ Py_XDECREF(indices);
+ Py_XDECREF(self);
+ return NULL;
+}
+
+/*MULTIARRAY_API
+ Put values into an array
+*/
+static PyObject *
+PyArray_PutTo(PyArrayObject *self, PyObject* values0, PyObject *indices0,
+ NPY_CLIPMODE clipmode)
+{
+ PyArrayObject *indices, *values;
+ int i, chunk, ni, max_item, nv, tmp;
+ char *src, *dest;
+ int copied = 0;
+
+ indices = NULL;
+ values = NULL;
+
+ if (!PyArray_Check(self)) {
+ PyErr_SetString(PyExc_TypeError,
+ "put: first argument must be an array");
+ return NULL;
+ }
+ if (!PyArray_ISCONTIGUOUS(self)) {
+ PyArrayObject *obj;
+ int flags = NPY_CARRAY | NPY_UPDATEIFCOPY;
+ if (clipmode == NPY_RAISE) {
+ flags |= NPY_ENSURECOPY;
+ }
+ Py_INCREF(self->descr);
+ obj = (PyArrayObject *)PyArray_FromArray(self,
+ self->descr, flags);
+ if (obj != self) copied = 1;
+ self = obj;
+ }
+ max_item = PyArray_SIZE(self);
+ dest = self->data;
+ chunk = self->descr->elsize;
+
+ indices = (PyArrayObject *)PyArray_ContiguousFromAny(indices0,
+ PyArray_INTP, 0, 0);
+ if (indices == NULL) goto fail;
+ ni = PyArray_SIZE(indices);
+
+ Py_INCREF(self->descr);
+ values = (PyArrayObject *)PyArray_FromAny(values0, self->descr, 0, 0,
+ DEFAULT | FORCECAST, NULL);
+ if (values == NULL) goto fail;
+ nv = PyArray_SIZE(values);
+ if (nv <= 0) goto finish;
+ if (PyDataType_REFCHK(self->descr)) {
+ switch(clipmode) {
+ case NPY_RAISE:
+ for(i=0; i<ni; i++) {
+ src = values->data + chunk * (i % nv);
+ tmp = ((intp *)(indices->data))[i];
+ if (tmp < 0) tmp = tmp+max_item;
+ if ((tmp < 0) || (tmp >= max_item)) {
+ PyErr_SetString(PyExc_IndexError,
+ "index out of " \
+ "range for array");
+ goto fail;
+ }
+ PyArray_Item_INCREF(src, self->descr);
+ PyArray_Item_XDECREF(dest+tmp*chunk, self->descr);
+ memmove(dest + tmp * chunk, src, chunk);
+ }
+ break;
+ case NPY_WRAP:
+ for(i=0; i<ni; i++) {
+ src = values->data + chunk * (i % nv);
+ tmp = ((intp *)(indices->data))[i];
+ if (tmp < 0) while(tmp < 0) tmp+=max_item;
+ else if (tmp >= max_item)
+ while(tmp >= max_item)
+ tmp -= max_item;
+ PyArray_Item_INCREF(src, self->descr);
+ PyArray_Item_XDECREF(dest+tmp*chunk, self->descr);
+ memmove(dest + tmp * chunk, src, chunk);
+ }
+ break;
+ case NPY_CLIP:
+ for(i=0; i<ni; i++) {
+ src = values->data + chunk * (i % nv);
+ tmp = ((intp *)(indices->data))[i];
+ if (tmp < 0) tmp = 0;
+ else if (tmp >= max_item)
+ tmp = max_item - 1;
+ PyArray_Item_INCREF(src, self->descr);
+ PyArray_Item_XDECREF(dest+tmp*chunk, self->descr);
+ memmove(dest + tmp * chunk, src, chunk);
+ }
+ break;
+ }
+ }
+ else {
+ switch(clipmode) {
+ case NPY_RAISE:
+ for(i=0; i<ni; i++) {
+ src = values->data + chunk * (i % nv);
+ tmp = ((intp *)(indices->data))[i];
+ if (tmp < 0) tmp = tmp+max_item;
+ if ((tmp < 0) || (tmp >= max_item)) {
+ PyErr_SetString(PyExc_IndexError,
+ "index out of " \
+ "range for array");
+ goto fail;
+ }
+ memmove(dest + tmp * chunk, src, chunk);
+ }
+ break;
+ case NPY_WRAP:
+ for(i=0; i<ni; i++) {
+ src = values->data + chunk * (i % nv);
+ tmp = ((intp *)(indices->data))[i];
+ if (tmp < 0) while(tmp < 0) tmp+=max_item;
+ else if (tmp >= max_item)
+ while(tmp >= max_item)
+ tmp -= max_item;
+ memmove(dest + tmp * chunk, src, chunk);
+ }
+ break;
+ case NPY_CLIP:
+ for(i=0; i<ni; i++) {
+ src = values->data + chunk * (i % nv);
+ tmp = ((intp *)(indices->data))[i];
+ if (tmp < 0) tmp = 0;
+ else if (tmp >= max_item)
+ tmp = max_item - 1;
+ memmove(dest + tmp * chunk, src, chunk);
+ }
+ break;
+ }
+ }
+
+ finish:
+ Py_XDECREF(values);
+ Py_XDECREF(indices);
+ if (copied) {
+ Py_DECREF(self);
+ }
+ Py_INCREF(Py_None);
+ return Py_None;
+
+ fail:
+ Py_XDECREF(indices);
+ Py_XDECREF(values);
+ if (copied) {
+ PyArray_XDECREF_ERR(self);
+ }
+ return NULL;
+}
+
+static PyObject *
+array_putmask(PyObject *module, PyObject *args, PyObject *kwds)
+{
+ PyObject *mask, *values;
+ PyObject *array;
+
+ static char *kwlist[] = {"arr", "mask", "values", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "O!OO:putmask", kwlist,
+ &PyArray_Type,
+ &array, &mask, &values))
+ return NULL;
+
+ return PyArray_PutMask((PyArrayObject *)array, values, mask);
+}
+
+/*MULTIARRAY_API
+ Put values into an array according to a mask.
+*/
+static PyObject *
+PyArray_PutMask(PyArrayObject *self, PyObject* values0, PyObject* mask0)
+{
+ PyArrayObject *mask, *values;
+ int i, chunk, ni, max_item, nv, tmp;
+ char *src, *dest;
+ int copied=0;
+
+ mask = NULL;
+ values = NULL;
+
+ if (!PyArray_Check(self)) {
+ PyErr_SetString(PyExc_TypeError,
+ "putmask: first argument must "\
+ "be an array");
+ return NULL;
+ }
+ if (!PyArray_ISCONTIGUOUS(self)) {
+ PyArrayObject *obj;
+ int flags = NPY_CARRAY | NPY_UPDATEIFCOPY;
+ Py_INCREF(self->descr);
+ obj = (PyArrayObject *)PyArray_FromArray(self,
+ self->descr, flags);
+ if (obj != self) copied = 1;
+ self = obj;
+ }
+
+ max_item = PyArray_SIZE(self);
+ dest = self->data;
+ chunk = self->descr->elsize;
+
+ mask = (PyArrayObject *)\
+ PyArray_FROM_OTF(mask0, PyArray_BOOL, CARRAY | FORCECAST);
+ if (mask == NULL) goto fail;
+ ni = PyArray_SIZE(mask);
+ if (ni != max_item) {
+ PyErr_SetString(PyExc_ValueError,
+ "putmask: mask and data must be "\
+ "the same size");
+ goto fail;
+ }
+
+ values = (PyArrayObject *)\
+ PyArray_ContiguousFromAny(values0, self->descr->type_num, 0, 0);
+ if (values == NULL) goto fail;
+ nv = PyArray_SIZE(values); /* zero if null array */
+ if (nv <= 0) {
+ Py_XDECREF(values);
+ Py_XDECREF(mask);
+ Py_INCREF(Py_None);
+ return Py_None;
+ }
+ if (nv > 0) {
+ if (PyDataType_REFCHK(self->descr)) {
+ for(i=0; i<ni; i++) {
+ src = values->data + chunk * (i % nv);
+ tmp = ((Bool *)(mask->data))[i];
+ if (tmp) {
+ PyArray_Item_INCREF(src, self->descr);
+ PyArray_Item_XDECREF(dest+i*chunk, self->descr);
+ memmove(dest + i * chunk, src, chunk);
+ }
+ }
+ }
+ else {
+ for(i=0; i<ni; i++) {
+ src = values->data + chunk * (i % nv);
+ tmp = ((Bool *)(mask->data))[i];
+ if (tmp) memmove(dest + i * chunk, src, chunk);
+ }
+ }
+ }
+
+ Py_XDECREF(values);
+ Py_XDECREF(mask);
+ if (copied) {
+ Py_DECREF(self);
+ }
+ Py_INCREF(Py_None);
+ return Py_None;
+
+ fail:
+ Py_XDECREF(mask);
+ Py_XDECREF(values);
+ if (copied) {
+ PyArray_XDECREF_ERR(self);
+ }
+ return NULL;
+}
+
+
+/* This conversion function can be used with the "O&" argument for
+ PyArg_ParseTuple. It will immediately return an object of array type
+ or will convert to a CARRAY any other object.
+
+ If you use PyArray_Converter, you must DECREF the array when finished
+ as you get a new reference to it.
+*/
+
+/*MULTIARRAY_API
+ Useful to pass as converter function for O& processing in
+ PyArgs_ParseTuple.
+*/
+static int
+PyArray_Converter(PyObject *object, PyObject **address)
+{
+ if (PyArray_Check(object)) {
+ *address = object;
+ Py_INCREF(object);
+ return PY_SUCCEED;
+ }
+ else {
+ *address = PyArray_FromAny(object, NULL, 0, 0, CARRAY, NULL);
+ if (*address == NULL) return PY_FAIL;
+ return PY_SUCCEED;
+ }
+}
+
+/*MULTIARRAY_API
+ Useful to pass as converter function for O& processing in
+ PyArgs_ParseTuple for output arrays
+*/
+static int
+PyArray_OutputConverter(PyObject *object, PyArrayObject **address)
+{
+ if (object == NULL || object == Py_None) {
+ *address = NULL;
+ return PY_SUCCEED;
+ }
+ if (PyArray_Check(object)) {
+ *address = (PyArrayObject *)object;
+ return PY_SUCCEED;
+ }
+ else {
+ PyErr_SetString(PyExc_TypeError,
+ "output must be an array");
+ *address = NULL;
+ return PY_FAIL;
+ }
+}
+
+
+/*MULTIARRAY_API
+ Convert an object to true / false
+*/
+static int
+PyArray_BoolConverter(PyObject *object, Bool *val)
+{
+ if (PyObject_IsTrue(object))
+ *val=TRUE;
+ else *val=FALSE;
+ if (PyErr_Occurred())
+ return PY_FAIL;
+ return PY_SUCCEED;
+}
+
+/*MULTIARRAY_API
+ Convert an object to FORTRAN / C / ANY
+*/
+static int
+PyArray_OrderConverter(PyObject *object, NPY_ORDER *val)
+{
+ char *str;
+ if (object == NULL || object == Py_None) {
+ *val = PyArray_ANYORDER;
+ }
+ else if (!PyString_Check(object) || PyString_GET_SIZE(object) < 1) {
+ if (PyObject_IsTrue(object))
+ *val = PyArray_FORTRANORDER;
+ else
+ *val = PyArray_CORDER;
+ if (PyErr_Occurred())
+ return PY_FAIL;
+ return PY_SUCCEED;
+ }
+ else {
+ str = PyString_AS_STRING(object);
+ if (str[0] == 'C' || str[0] == 'c') {
+ *val = PyArray_CORDER;
+ }
+ else if (str[0] == 'F' || str[0] == 'f') {
+ *val = PyArray_FORTRANORDER;
+ }
+ else if (str[0] == 'A' || str[0] == 'a') {
+ *val = PyArray_ANYORDER;
+ }
+ else {
+ PyErr_SetString(PyExc_TypeError,
+ "order not understood");
+ return PY_FAIL;
+ }
+ }
+ return PY_SUCCEED;
+}
+
+/*MULTIARRAY_API
+ Convert an object to NPY_RAISE / NPY_CLIP / NPY_WRAP
+*/
+static int
+PyArray_ClipmodeConverter(PyObject *object, NPY_CLIPMODE *val)
+{
+ if (object == NULL || object == Py_None) {
+ *val = NPY_RAISE;
+ }
+ else if (PyString_Check(object)) {
+ char *str;
+ str = PyString_AS_STRING(object);
+ if (str[0] == 'C' || str[0] == 'c') {
+ *val = NPY_CLIP;
+ }
+ else if (str[0] == 'W' || str[0] == 'w') {
+ *val = NPY_WRAP;
+ }
+ else if (str[0] == 'R' || str[0] == 'r') {
+ *val = NPY_RAISE;
+ }
+ else {
+ PyErr_SetString(PyExc_TypeError,
+ "clipmode not understood");
+ return PY_FAIL;
+ }
+ }
+ else {
+ int number;
+ number = PyInt_AsLong(object);
+ if (number == -1 && PyErr_Occurred()) goto fail;
+ if (number <= (int) NPY_RAISE &&
+ number >= (int) NPY_CLIP)
+ *val = (NPY_CLIPMODE) number;
+ else goto fail;
+ }
+ return PY_SUCCEED;
+
+ fail:
+ PyErr_SetString(PyExc_TypeError,
+ "clipmode not understood");
+ return PY_FAIL;
+}
+
+
+
+/*MULTIARRAY_API
+ Typestr converter
+*/
+static int
+PyArray_TypestrConvert(int itemsize, int gentype)
+{
+ register int newtype = gentype;
+
+ if (gentype == PyArray_GENBOOLLTR) {
+ if (itemsize == 1)
+ newtype = PyArray_BOOL;
+ else
+ newtype = PyArray_NOTYPE;
+ }
+ else if (gentype == PyArray_SIGNEDLTR) {
+ switch(itemsize) {
+ case 1:
+ newtype = PyArray_INT8;
+ break;
+ case 2:
+ newtype = PyArray_INT16;
+ break;
+ case 4:
+ newtype = PyArray_INT32;
+ break;
+ case 8:
+ newtype = PyArray_INT64;
+ break;
+#ifdef PyArray_INT128
+ case 16:
+ newtype = PyArray_INT128;
+ break;
+#endif
+ default:
+ newtype = PyArray_NOTYPE;
+ }
+ }
+
+ else if (gentype == PyArray_UNSIGNEDLTR) {
+ switch(itemsize) {
+ case 1:
+ newtype = PyArray_UINT8;
+ break;
+ case 2:
+ newtype = PyArray_UINT16;
+ break;
+ case 4:
+ newtype = PyArray_UINT32;
+ break;
+ case 8:
+ newtype = PyArray_UINT64;
+ break;
+#ifdef PyArray_INT128
+ case 16:
+ newtype = PyArray_UINT128;
+ break;
+#endif
+ default:
+ newtype = PyArray_NOTYPE;
+ break;
+ }
+ }
+ else if (gentype == PyArray_FLOATINGLTR) {
+ switch(itemsize) {
+ case 4:
+ newtype = PyArray_FLOAT32;
+ break;
+ case 8:
+ newtype = PyArray_FLOAT64;
+ break;
+#ifdef PyArray_FLOAT80
+ case 10:
+ newtype = PyArray_FLOAT80;
+ break;
+#endif
+#ifdef PyArray_FLOAT96
+ case 12:
+ newtype = PyArray_FLOAT96;
+ break;
+#endif
+#ifdef PyArray_FLOAT128
+ case 16:
+ newtype = PyArray_FLOAT128;
+ break;
+#endif
+ default:
+ newtype = PyArray_NOTYPE;
+ }
+ }
+
+ else if (gentype == PyArray_COMPLEXLTR) {
+ switch(itemsize) {
+ case 8:
+ newtype = PyArray_COMPLEX64;
+ break;
+ case 16:
+ newtype = PyArray_COMPLEX128;
+ break;
+#ifdef PyArray_FLOAT80
+ case 20:
+ newtype = PyArray_COMPLEX160;
+ break;
+#endif
+#ifdef PyArray_FLOAT96
+ case 24:
+ newtype = PyArray_COMPLEX192;
+ break;
+#endif
+#ifdef PyArray_FLOAT128
+ case 32:
+ newtype = PyArray_COMPLEX256;
+ break;
+#endif
+ default:
+ newtype = PyArray_NOTYPE;
+ }
+ }
+
+ return newtype;
+}
+
+
+/* this function takes a Python object which exposes the (single-segment)
+ buffer interface and returns a pointer to the data segment
+
+ You should increment the reference count by one of buf->base
+ if you will hang on to a reference
+
+ You only get a borrowed reference to the object. Do not free the
+ memory...
+*/
+
+
+/*MULTIARRAY_API
+ Get buffer chunk from object
+*/
+static int
+PyArray_BufferConverter(PyObject *obj, PyArray_Chunk *buf)
+{
+ Py_ssize_t buflen;
+
+ buf->ptr = NULL;
+ buf->flags = BEHAVED;
+ buf->base = NULL;
+
+ if (obj == Py_None)
+ return PY_SUCCEED;
+
+ if (PyObject_AsWriteBuffer(obj, &(buf->ptr), &buflen) < 0) {
+ PyErr_Clear();
+ buf->flags &= ~WRITEABLE;
+ if (PyObject_AsReadBuffer(obj, (const void **)&(buf->ptr),
+ &buflen) < 0)
+ return PY_FAIL;
+ }
+ buf->len = (intp) buflen;
+
+ /* Point to the base of the buffer object if present */
+ if (PyBuffer_Check(obj)) buf->base = ((PyArray_Chunk *)obj)->base;
+ if (buf->base == NULL) buf->base = obj;
+
+ return PY_SUCCEED;
+}
+
+
+
+/* This function takes a Python sequence object and allocates and
+ fills in an intp array with the converted values.
+
+ **Remember to free the pointer seq.ptr when done using
+ PyDimMem_FREE(seq.ptr)**
+*/
+
+/*MULTIARRAY_API
+ Get intp chunk from sequence
+*/
+static int
+PyArray_IntpConverter(PyObject *obj, PyArray_Dims *seq)
+{
+ int len;
+ int nd;
+
+ seq->ptr = NULL;
+ seq->len = 0;
+ if (obj == Py_None) return PY_SUCCEED;
+ len = PySequence_Size(obj);
+ if (len == -1) { /* Check to see if it is a number */
+ if (PyNumber_Check(obj)) len = 1;
+ }
+ if (len < 0) {
+ PyErr_SetString(PyExc_TypeError,
+ "expected sequence object with len >= 0");
+ return PY_FAIL;
+ }
+ if (len > MAX_DIMS) {
+ PyErr_Format(PyExc_ValueError, "sequence too large; " \
+ "must be smaller than %d", MAX_DIMS);
+ return PY_FAIL;
+ }
+ if (len > 0) {
+ seq->ptr = PyDimMem_NEW(len);
+ if (seq->ptr == NULL) {
+ PyErr_NoMemory();
+ return PY_FAIL;
+ }
+ }
+ seq->len = len;
+ nd = PyArray_IntpFromSequence(obj, (intp *)seq->ptr, len);
+ if (nd == -1 || nd != len) {
+ PyDimMem_FREE(seq->ptr);
+ seq->ptr=NULL;
+ return PY_FAIL;
+ }
+ return PY_SUCCEED;
+}
+
+
+/* A tuple type would be either (generic typeobject, typesize)
+ or (fixed-length data-type, shape)
+
+ or (inheriting data-type, new-data-type)
+ The new data-type must have the same itemsize as the inheriting data-type
+ unless the latter is 0
+
+ Thus (int32, {'real':(int16,0),'imag',(int16,2)})
+
+ is one way to specify a descriptor that will give
+ a['real'] and a['imag'] to an int32 array.
+*/
+
+/* leave type reference alone */
+static PyArray_Descr *
+_use_inherit(PyArray_Descr *type, PyObject *newobj, int *errflag)
+{
+ PyArray_Descr *new;
+ PyArray_Descr *conv;
+
+ *errflag = 0;
+ if (!PyArray_DescrConverter(newobj, &conv)) {
+ return NULL;
+ }
+ *errflag = 1;
+ new = PyArray_DescrNew(type);
+ if (new == NULL) goto fail;
+
+ if (new->elsize && new->elsize != conv->elsize) {
+ PyErr_SetString(PyExc_ValueError,
+ "mismatch in size of old "\
+ "and new data-descriptor");
+ goto fail;
+ }
+ new->elsize = conv->elsize;
+ if (conv->names) {
+ new->fields = conv->fields;
+ Py_XINCREF(new->fields);
+ new->names = conv->names;
+ Py_XINCREF(new->names);
+ }
+ new->hasobject = conv->hasobject;
+ Py_DECREF(conv);
+ *errflag = 0;
+ return new;
+
+ fail:
+ Py_DECREF(conv);
+ return NULL;
+
+}
+
+static PyArray_Descr *
+_convert_from_tuple(PyObject *obj)
+{
+ PyArray_Descr *type, *res;
+ PyObject *val;
+ int errflag;
+
+ if (PyTuple_GET_SIZE(obj) != 2) return NULL;
+
+ if (!PyArray_DescrConverter(PyTuple_GET_ITEM(obj,0), &type))
+ return NULL;
+ val = PyTuple_GET_ITEM(obj,1);
+ /* try to interpret next item as a type */
+ res = _use_inherit(type, val, &errflag);
+ if (res || errflag) {
+ Py_DECREF(type);
+ if (res) return res;
+ else return NULL;
+ }
+ PyErr_Clear();
+ /* We get here if res was NULL but errflag wasn't set
+ --- i.e. the conversion to a data-descr failed in _use_inherit
+ */
+
+ if (type->elsize == 0) { /* interpret next item as a typesize */
+ int itemsize;
+ itemsize = PyArray_PyIntAsInt(PyTuple_GET_ITEM(obj,1));
+ if (error_converting(itemsize)) {
+ PyErr_SetString(PyExc_ValueError,
+ "invalid itemsize in generic type "\
+ "tuple");
+ goto fail;
+ }
+ PyArray_DESCR_REPLACE(type);
+ if (type->type_num == PyArray_UNICODE)
+ type->elsize = itemsize << 2;
+ else
+ type->elsize = itemsize;
+ }
+ else {
+ /* interpret next item as shape (if it's a tuple)
+ and reset the type to PyArray_VOID with
+ a new fields attribute.
+ */
+ PyArray_Dims shape={NULL,-1};
+ PyArray_Descr *newdescr;
+ if (!(PyArray_IntpConverter(val, &shape)) ||
+ (shape.len > MAX_DIMS)) {
+ PyDimMem_FREE(shape.ptr);
+ PyErr_SetString(PyExc_ValueError,
+ "invalid shape in fixed-type tuple.");
+ goto fail;
+ }
+ /* If (type, 1) was given, it is equivalent to type...
+ or (type, ()) was given it is equivalent to type... */
+ if ((shape.len == 1 && shape.ptr[0] == 1 && PyNumber_Check(val)) || \
+ (shape.len == 0 && PyTuple_Check(val))) {
+ PyDimMem_FREE(shape.ptr);
+ return type;
+ }
+ newdescr = PyArray_DescrNewFromType(PyArray_VOID);
+ if (newdescr == NULL) {PyDimMem_FREE(shape.ptr); goto fail;}
+ newdescr->elsize = type->elsize;
+ newdescr->elsize *= PyArray_MultiplyList(shape.ptr,
+ shape.len);
+ PyDimMem_FREE(shape.ptr);
+ newdescr->subarray = _pya_malloc(sizeof(PyArray_ArrayDescr));
+ newdescr->subarray->base = type;
+ newdescr->hasobject = type->hasobject;
+ Py_INCREF(val);
+ newdescr->subarray->shape = val;
+ Py_XDECREF(newdescr->fields);
+ Py_XDECREF(newdescr->names);
+ newdescr->fields = NULL;
+ newdescr->names = NULL;
+ type = newdescr;
+ }
+ return type;
+
+ fail:
+ Py_XDECREF(type);
+ return NULL;
+}
+
+/* obj is a list. Each item is a tuple with
+
+(field-name, data-type (either a list or a string), and an optional
+ shape parameter).
+*/
+static PyArray_Descr *
+_convert_from_array_descr(PyObject *obj, int align)
+{
+ int n, i, totalsize;
+ int ret;
+ PyObject *fields, *item, *newobj;
+ PyObject *name, *tup, *title;
+ PyObject *nameslist;
+ PyArray_Descr *new;
+ PyArray_Descr *conv;
+ int dtypeflags=0;
+ int maxalign = 0;
+
+
+ n = PyList_GET_SIZE(obj);
+ nameslist = PyTuple_New(n);
+ if (!nameslist) return NULL;
+ totalsize = 0;
+ fields = PyDict_New();
+ for (i=0; i<n; i++) {
+ item = PyList_GET_ITEM(obj, i);
+ if (!PyTuple_Check(item) || (PyTuple_GET_SIZE(item) < 2))
+ goto fail;
+ name = PyTuple_GET_ITEM(item, 0);
+ if (PyString_Check(name)) {
+ title=NULL;
+ }
+ else if (PyTuple_Check(name)) {
+ if (PyTuple_GET_SIZE(name) != 2) goto fail;
+ title = PyTuple_GET_ITEM(name, 0);
+ name = PyTuple_GET_ITEM(name, 1);
+ if (!PyString_Check(name))
+ goto fail;
+ }
+ else goto fail;
+ if (PyString_GET_SIZE(name)==0) {
+ if (title==NULL)
+ name = PyString_FromFormat("f%d", i);
+ else {
+ name = title;
+ Py_INCREF(name);
+ }
+ }
+ else {
+ Py_INCREF(name);
+ }
+ PyTuple_SET_ITEM(nameslist, i, name);
+ if (PyTuple_GET_SIZE(item) == 2) {
+ ret = PyArray_DescrConverter(PyTuple_GET_ITEM(item, 1),
+ &conv);
+ if (ret == PY_FAIL)
+ PyObject_Print(PyTuple_GET_ITEM(item,1),
+ stderr, 0);
+ }
+ else if (PyTuple_GET_SIZE(item) == 3) {
+ newobj = PyTuple_GetSlice(item, 1, 3);
+ ret = PyArray_DescrConverter(newobj, &conv);
+ Py_DECREF(newobj);
+ }
+ else goto fail;
+ if (ret == PY_FAIL) goto fail;
+ if ((PyDict_GetItem(fields, name) != NULL) ||
+ (title &&
+ (PyString_Check(title) || PyUnicode_Check(title)) &&
+ (PyDict_GetItem(fields, title) != NULL))) {
+ PyErr_SetString(PyExc_ValueError,
+ "two fields with the same name");
+ goto fail;
+ }
+ dtypeflags |= (conv->hasobject & NPY_FROM_FIELDS);
+ tup = PyTuple_New((title == NULL ? 2 : 3));
+ PyTuple_SET_ITEM(tup, 0, (PyObject *)conv);
+ if (align) {
+ int _align;
+ _align = conv->alignment;
+ if (_align > 1) totalsize = \
+ ((totalsize + _align - 1)/_align)*_align;
+ maxalign = MAX(maxalign, _align);
+ }
+ PyTuple_SET_ITEM(tup, 1, PyInt_FromLong((long) totalsize));
+
+ /* Title can be "meta-data". Only insert it
+ into the fields dictionary if it is a string
+ */
+ if (title != NULL) {
+ Py_INCREF(title);
+ PyTuple_SET_ITEM(tup, 2, title);
+ if (PyString_Check(title) || PyUnicode_Check(title))
+ PyDict_SetItem(fields, title, tup);
+ }
+ PyDict_SetItem(fields, name, tup);
+ totalsize += conv->elsize;
+ Py_DECREF(tup);
+ }
+ new = PyArray_DescrNewFromType(PyArray_VOID);
+ new->fields = fields;
+ new->names = nameslist;
+ new->elsize = totalsize;
+ new->hasobject=dtypeflags;
+ if (maxalign > 1) {
+ totalsize = ((totalsize+maxalign-1)/maxalign)*maxalign;
+ }
+ if (align) new->alignment = maxalign;
+ return new;
+
+ fail:
+ Py_DECREF(fields);
+ Py_DECREF(nameslist);
+ return NULL;
+
+}
+
+/* a list specifying a data-type can just be
+ a list of formats. The names for the fields
+ will default to f0, f1, f2, and so forth.
+*/
+
+static PyArray_Descr *
+_convert_from_list(PyObject *obj, int align)
+{
+ int n, i;
+ int totalsize;
+ PyObject *fields;
+ PyArray_Descr *conv=NULL;
+ PyArray_Descr *new;
+ PyObject *key, *tup;
+ PyObject *nameslist=NULL;
+ int ret;
+ int maxalign=0;
+ int dtypeflags=0;
+
+ n = PyList_GET_SIZE(obj);
+ /* Ignore any empty string at end which _internal._commastring
+ can produce */
+ key = PyList_GET_ITEM(obj, n-1);
+ if (PyString_Check(key) && PyString_GET_SIZE(key) == 0) n = n-1;
+ /* End ignore code.*/
+ totalsize = 0;
+ if (n==0) return NULL;
+ nameslist = PyTuple_New(n);
+ if (!nameslist) return NULL;
+ fields = PyDict_New();
+ for (i=0; i<n; i++) {
+ tup = PyTuple_New(2);
+ key = PyString_FromFormat("f%d", i);
+ ret = PyArray_DescrConverter(PyList_GET_ITEM(obj, i), &conv);
+ if (ret == PY_FAIL) {
+ Py_DECREF(tup);
+ Py_DECREF(key);
+ goto fail;
+ }
+ dtypeflags |= (conv->hasobject & NPY_FROM_FIELDS);
+ PyTuple_SET_ITEM(tup, 0, (PyObject *)conv);
+ if (align) {
+ int _align;
+ _align = conv->alignment;
+ if (_align > 1) totalsize = \
+ ((totalsize + _align - 1)/_align)*_align;
+ maxalign = MAX(maxalign, _align);
+ }
+ PyTuple_SET_ITEM(tup, 1, PyInt_FromLong((long) totalsize));
+ PyDict_SetItem(fields, key, tup);
+ Py_DECREF(tup);
+ PyTuple_SET_ITEM(nameslist, i, key);
+ totalsize += conv->elsize;
+ }
+ new = PyArray_DescrNewFromType(PyArray_VOID);
+ new->fields = fields;
+ new->names = nameslist;
+ new->hasobject=dtypeflags;
+ if (maxalign > 1) {
+ totalsize = ((totalsize+maxalign-1)/maxalign)*maxalign;
+ }
+ if (align) new->alignment = maxalign;
+ new->elsize = totalsize;
+ return new;
+
+ fail:
+ Py_DECREF(nameslist);
+ Py_DECREF(fields);
+ return NULL;
+}
+
+
+/* comma-separated string */
+/* this is the format developed by the numarray records module */
+/* and implemented by the format parser in that module */
+/* this is an alternative implementation found in the _internal.py
+ file patterned after that one -- the approach is to try to convert
+ to a list (with tuples if any repeat information is present)
+ and then call the _convert_from_list)
+*/
+
+static PyArray_Descr *
+_convert_from_commastring(PyObject *obj, int align)
+{
+ PyObject *listobj;
+ PyArray_Descr *res;
+ PyObject *_numpy_internal;
+
+ if (!PyString_Check(obj)) return NULL;
+ _numpy_internal = PyImport_ImportModule("numpy.core._internal");
+ if (_numpy_internal == NULL) return NULL;
+ listobj = PyObject_CallMethod(_numpy_internal, "_commastring",
+ "O", obj);
+ Py_DECREF(_numpy_internal);
+ if (!listobj) return NULL;
+ if (!PyList_Check(listobj) || PyList_GET_SIZE(listobj)<1) {
+ PyErr_SetString(PyExc_RuntimeError, "_commastring is " \
+ "not returning a list with len >= 1");
+ return NULL;
+ }
+ if (PyList_GET_SIZE(listobj) == 1) {
+ if (PyArray_DescrConverter(PyList_GET_ITEM(listobj, 0),
+ &res) == NPY_FAIL) {
+ res = NULL;
+ }
+ }
+ else {
+ res = _convert_from_list(listobj, align);
+ }
+ Py_DECREF(listobj);
+ if (!res && !PyErr_Occurred()) {
+ PyErr_SetString(PyExc_ValueError, "invalid data-type");
+ return NULL;
+ }
+ return res;
+}
+
+
+
+/* a dictionary specifying a data-type
+ must have at least two and up to four
+ keys These must all be sequences of the same length.
+
+ "names" --- field names
+ "formats" --- the data-type descriptors for the field.
+
+ Optional:
+
+ "offsets" --- integers indicating the offset into the
+ record of the start of the field.
+ if not given, then "consecutive offsets"
+ will be assumed and placed in the dictionary.
+
+ "titles" --- Allows the use of an additional key
+ for the fields dictionary.(if these are strings
+ or unicode objects) or
+ this can also be meta-data to
+ be passed around with the field description.
+
+Attribute-lookup-based field names merely has to query the fields
+dictionary of the data-descriptor. Any result present can be used
+to return the correct field.
+
+So, the notion of what is a name and what is a title is really quite
+arbitrary.
+
+What does distinguish a title, however, is that if it is not None,
+it will be placed at the end of the tuple inserted into the
+fields dictionary.and can therefore be used to carry meta-data around.
+
+If the dictionary does not have "names" and "formats" entries,
+then it will be checked for conformity and used directly.
+*/
+
+static PyArray_Descr *
+_use_fields_dict(PyObject *obj, int align)
+{
+ PyObject *_numpy_internal;
+ PyArray_Descr *res;
+ _numpy_internal = PyImport_ImportModule("numpy.core._internal");
+ if (_numpy_internal == NULL) return NULL;
+ res = (PyArray_Descr *)PyObject_CallMethod(_numpy_internal,
+ "_usefields",
+ "Oi", obj, align);
+ Py_DECREF(_numpy_internal);
+ return res;
+}
+
+static PyArray_Descr *
+_convert_from_dict(PyObject *obj, int align)
+{
+ PyArray_Descr *new;
+ PyObject *fields=NULL;
+ PyObject *names, *offsets, *descrs, *titles;
+ int n, i;
+ int totalsize;
+ int maxalign=0;
+ int dtypeflags=0;
+
+ fields = PyDict_New();
+ if (fields == NULL) return (PyArray_Descr *)PyErr_NoMemory();
+
+ names = PyDict_GetItemString(obj, "names");
+ descrs = PyDict_GetItemString(obj, "formats");
+
+ if (!names || !descrs) {
+ Py_DECREF(fields);
+ return _use_fields_dict(obj, align);
+ }
+ n = PyObject_Length(names);
+ offsets = PyDict_GetItemString(obj, "offsets");
+ titles = PyDict_GetItemString(obj, "titles");
+ if ((n > PyObject_Length(descrs)) || \
+ (offsets && (n > PyObject_Length(offsets))) || \
+ (titles && (n > PyObject_Length(titles)))) {
+ PyErr_SetString(PyExc_ValueError,
+ "all items in the dictionary must have" \
+ " the same length.");
+ goto fail;
+ }
+
+ totalsize = 0;
+ for(i=0; i<n; i++) {
+ PyObject *tup, *descr, *index, *item, *name, *off;
+ int len, ret, _align=1;
+ PyArray_Descr *newdescr;
+
+ /* Build item to insert (descr, offset, [title])*/
+ len = 2;
+ item = NULL;
+ index = PyInt_FromLong(i);
+ if (titles) {
+ item=PyObject_GetItem(titles, index);
+ if (item && item != Py_None) len = 3;
+ else Py_XDECREF(item);
+ PyErr_Clear();
+ }
+ tup = PyTuple_New(len);
+ descr = PyObject_GetItem(descrs, index);
+ ret = PyArray_DescrConverter(descr, &newdescr);
+ Py_DECREF(descr);
+ if (ret == PY_FAIL) {
+ Py_DECREF(tup);
+ Py_DECREF(index);
+ goto fail;
+ }
+ PyTuple_SET_ITEM(tup, 0, (PyObject *)newdescr);
+ if (align) {
+ _align = newdescr->alignment;
+ maxalign = MAX(maxalign,_align);
+ }
+ if (offsets) {
+ long offset;
+ off = PyObject_GetItem(offsets, index);
+ offset = PyInt_AsLong(off);
+ PyTuple_SET_ITEM(tup, 1, off);
+ if (offset < totalsize) {
+ PyErr_SetString(PyExc_ValueError,
+ "invalid offset (must be "\
+ "ordered)");
+ ret = PY_FAIL;
+ }
+ if (offset > totalsize) totalsize = offset;
+ }
+ else {
+ if (align && _align > 1) {
+ totalsize = ((totalsize + _align - 1) \
+ /_align)*_align;
+ }
+ PyTuple_SET_ITEM(tup, 1, PyInt_FromLong(totalsize));
+ }
+ if (len == 3) PyTuple_SET_ITEM(tup, 2, item);
+ name = PyObject_GetItem(names, index);
+ Py_DECREF(index);
+ if (!(PyString_Check(name) || PyUnicode_Check(name))) {
+ PyErr_SetString(PyExc_ValueError,
+ "field names must be strings");
+ ret = PY_FAIL;
+ }
+
+ /* Insert into dictionary */
+ if (PyDict_GetItem(fields, name) != NULL) {
+ PyErr_SetString(PyExc_ValueError,
+ "name already used as a name or "\
+ "title");
+ ret = PY_FAIL;
+ }
+ PyDict_SetItem(fields, name, tup);
+ Py_DECREF(name);
+ if (len == 3) {
+ if ((PyString_Check(item) || PyUnicode_Check(item)) &&
+ PyDict_GetItem(fields, item) != NULL) {
+ PyErr_SetString(PyExc_ValueError,
+ "title already used as a "\
+ "name or title.");
+ ret=PY_FAIL;
+ }
+ else {
+ PyDict_SetItem(fields, item, tup);
+ }
+ }
+ Py_DECREF(tup);
+ if ((ret == PY_FAIL) || (newdescr->elsize == 0)) goto fail;
+ dtypeflags |= (newdescr->hasobject & NPY_FROM_FIELDS);
+ totalsize += newdescr->elsize;
+ }
+
+ new = PyArray_DescrNewFromType(PyArray_VOID);
+ if (new == NULL) goto fail;
+ if (maxalign > 1)
+ totalsize = ((totalsize + maxalign - 1)/maxalign)*maxalign;
+ if (align) new->alignment = maxalign;
+ new->elsize = totalsize;
+ if (!PyTuple_Check(names)) {
+ names = PySequence_Tuple(names);
+ }
+ else {
+ Py_INCREF(names);
+ }
+ new->names = names;
+ new->fields = fields;
+ new->hasobject = dtypeflags;
+ return new;
+
+ fail:
+ Py_XDECREF(fields);
+ return NULL;
+}
+
+#define _chk_byteorder(arg) (arg == '>' || arg == '<' || \
+ arg == '|' || arg == '=')
+
+static int
+_check_for_commastring(char *type, int len)
+{
+ int i;
+
+ /* Check for ints at start of string */
+ if ((type[0] >= '0' && type[0] <= '9') ||
+ ((len > 1) && _chk_byteorder(type[0]) &&
+ (type[1] >= '0' && type[1] <= '9')))
+ return 1;
+
+ /* Check for empty tuple */
+ if (((len > 1) && (type[0] == '(' && type[1] == ')')) ||
+ ((len > 3) && _chk_byteorder(type[0]) &&
+ (type[1] == '(' && type[2] == ')')))
+ return 1;
+
+ /* Check for presence of commas */
+ for (i=1;i<len;i++)
+ if (type[i] == ',') return 1;
+
+ return 0;
+}
+
+#undef _chk_byteorder
+
+/*
+ any object with
+ the .fields attribute and/or .itemsize attribute
+ (if the .fields attribute does not give
+ the total size -- i.e. a partial record naming).
+ If itemsize is given it must be >= size computed from fields
+
+ The .fields attribute must return a convertible dictionary if
+ present. Result inherits from PyArray_VOID.
+*/
+
+
+/*MULTIARRAY_API
+ Get type-descriptor from an object forcing alignment if possible
+ None goes to DEFAULT type.
+*/
+static int
+PyArray_DescrAlignConverter(PyObject *obj, PyArray_Descr **at)
+{
+ if PyDict_Check(obj) {
+ *at = _convert_from_dict(obj, 1);
+ }
+ else if PyString_Check(obj) {
+ *at = _convert_from_commastring(obj, 1);
+ }
+ else if PyList_Check(obj) {
+ *at = _convert_from_array_descr(obj, 1);
+ }
+ else {
+ return PyArray_DescrConverter(obj, at);
+ }
+ if (*at == NULL) {
+ if (!PyErr_Occurred()) {
+ PyErr_SetString(PyExc_ValueError,
+ "data-type-descriptor not understood");
+ }
+ return PY_FAIL;
+ }
+ return PY_SUCCEED;
+}
+
+/*MULTIARRAY_API
+ Get type-descriptor from an object forcing alignment if possible
+ None goes to NULL.
+*/
+static int
+PyArray_DescrAlignConverter2(PyObject *obj, PyArray_Descr **at)
+{
+ if PyDict_Check(obj) {
+ *at = _convert_from_dict(obj, 1);
+ }
+ else if PyString_Check(obj) {
+ *at = _convert_from_commastring(obj, 1);
+ }
+ else if PyList_Check(obj) {
+ *at = _convert_from_array_descr(obj, 1);
+ }
+ else {
+ return PyArray_DescrConverter2(obj, at);
+ }
+ if (*at == NULL) {
+ if (!PyErr_Occurred()) {
+ PyErr_SetString(PyExc_ValueError,
+ "data-type-descriptor not understood");
+ }
+ return PY_FAIL;
+ }
+ return PY_SUCCEED;
+}
+
+
+/*MULTIARRAY_API
+ Get typenum from an object -- None goes to NULL
+*/
+static int
+PyArray_DescrConverter2(PyObject *obj, PyArray_Descr **at)
+{
+ if (obj == Py_None) {
+ *at = NULL;
+ return PY_SUCCEED;
+ }
+ else return PyArray_DescrConverter(obj, at);
+}
+
+/* This function takes a Python object representing a type and converts it
+ to a the correct PyArray_Descr * structure to describe the type.
+
+ Many objects can be used to represent a data-type which in NumPy is
+ quite a flexible concept.
+
+ This is the central code that converts Python objects to
+ Type-descriptor objects that are used throughout numpy.
+ */
+
+/* new reference in *at */
+/*MULTIARRAY_API
+ Get typenum from an object -- None goes to PyArray_DEFAULT
+*/
+static int
+PyArray_DescrConverter(PyObject *obj, PyArray_Descr **at)
+{
+ char *type;
+ int check_num=PyArray_NOTYPE+10;
+ int len;
+ PyObject *item;
+ int elsize = 0;
+ char endian = '=';
+
+ *at=NULL;
+
+ /* default */
+ if (obj == Py_None) {
+ *at = PyArray_DescrFromType(PyArray_DEFAULT);
+ return PY_SUCCEED;
+ }
+
+ if (PyArray_DescrCheck(obj)) {
+ *at = (PyArray_Descr *)obj;
+ Py_INCREF(*at);
+ return PY_SUCCEED;
+ }
+
+ if (PyType_Check(obj)) {
+ if (PyType_IsSubtype((PyTypeObject *)obj,
+ &PyGenericArrType_Type)) {
+ *at = PyArray_DescrFromTypeObject(obj);
+ if (*at) return PY_SUCCEED;
+ else return PY_FAIL;
+ }
+ check_num = PyArray_OBJECT;
+ if (obj == (PyObject *)(&PyInt_Type))
+ check_num = PyArray_LONG;
+ else if (obj == (PyObject *)(&PyLong_Type))
+ check_num = PyArray_LONGLONG;
+ else if (obj == (PyObject *)(&PyFloat_Type))
+ check_num = PyArray_DOUBLE;
+ else if (obj == (PyObject *)(&PyComplex_Type))
+ check_num = PyArray_CDOUBLE;
+ else if (obj == (PyObject *)(&PyBool_Type))
+ check_num = PyArray_BOOL;
+ else if (obj == (PyObject *)(&PyString_Type))
+ check_num = PyArray_STRING;
+ else if (obj == (PyObject *)(&PyUnicode_Type))
+ check_num = PyArray_UNICODE;
+ else if (obj == (PyObject *)(&PyBuffer_Type))
+ check_num = PyArray_VOID;
+ else {
+ *at = _arraydescr_fromobj(obj);
+ if (*at) return PY_SUCCEED;
+ }
+ goto finish;
+ }
+
+ /* or a typecode string */
+
+ if (PyString_Check(obj)) {
+ /* Check for a string typecode. */
+ type = PyString_AS_STRING(obj);
+ len = PyString_GET_SIZE(obj);
+ if (len <= 0) goto fail;
+
+ /* check for commas present
+ or first (or second) element a digit */
+ if (_check_for_commastring(type, len)) {
+ *at = _convert_from_commastring(obj, 0);
+ if (*at) return PY_SUCCEED;
+ return PY_FAIL;
+ }
+ check_num = (int) type[0];
+ if ((char) check_num == '>' || (char) check_num == '<' || \
+ (char) check_num == '|' || (char) check_num == '=') {
+ if (len <= 1) goto fail;
+ endian = (char) check_num;
+ type++; len--;
+ check_num = (int) type[0];
+ if (endian == '|') endian = '=';
+ }
+ if (len > 1) {
+ elsize = atoi(type+1);
+ if (elsize == 0) {
+ check_num = PyArray_NOTYPE+10;
+ }
+ /* When specifying length of UNICODE
+ the number of characters is given to match
+ the STRING interface. Each character can be
+ more than one byte and itemsize must be
+ the number of bytes.
+ */
+ else if (check_num == PyArray_UNICODELTR) {
+ elsize <<= 2;
+ }
+ /* Support for generic processing
+ c4, i4, f8, etc...
+ */
+ else if ((check_num != PyArray_STRINGLTR) && \
+ (check_num != PyArray_VOIDLTR) && \
+ (check_num != PyArray_STRINGLTR2)) {
+ check_num = \
+ PyArray_TypestrConvert(elsize,
+ check_num);
+ if (check_num == PyArray_NOTYPE)
+ check_num += 10;
+ elsize = 0;
+ }
+ }
+ }
+ /* or a tuple */
+ else if (PyTuple_Check(obj)) {
+ *at = _convert_from_tuple(obj);
+ if (*at == NULL){
+ if (PyErr_Occurred()) return PY_FAIL;
+ goto fail;
+ }
+ return PY_SUCCEED;
+ }
+ /* or a list */
+ else if (PyList_Check(obj)) {
+ *at = _convert_from_array_descr(obj,0);
+ if (*at == NULL) {
+ if (PyErr_Occurred()) return PY_FAIL;
+ goto fail;
+ }
+ return PY_SUCCEED;
+ }
+ /* or a dictionary */
+ else if (PyDict_Check(obj)) {
+ *at = _convert_from_dict(obj,0);
+ if (*at == NULL) {
+ if (PyErr_Occurred()) return PY_FAIL;
+ goto fail;
+ }
+ return PY_SUCCEED;
+ }
+ else if (PyArray_Check(obj)) goto fail;
+ else /* goto fail;*/ {
+ *at = _arraydescr_fromobj(obj);
+ if (*at) return PY_SUCCEED;
+ if (PyErr_Occurred()) return PY_FAIL;
+ goto fail;
+ }
+ if (PyErr_Occurred()) goto fail;
+
+ /*
+ if (check_num == PyArray_NOTYPE) return PY_FAIL;
+ */
+
+ finish:
+ if ((check_num == PyArray_NOTYPE+10) || \
+ (*at = PyArray_DescrFromType(check_num))==NULL) {
+ /* Now check to see if the object is registered
+ in typeDict */
+ if (typeDict != NULL) {
+ item = PyDict_GetItem(typeDict, obj);
+ if (item) return PyArray_DescrConverter(item, at);
+ }
+ goto fail;
+ }
+
+ if (((*at)->elsize == 0) && (elsize != 0)) {
+ PyArray_DESCR_REPLACE(*at);
+ (*at)->elsize = elsize;
+ }
+ if (endian != '=' && PyArray_ISNBO(endian)) endian = '=';
+
+ if (endian != '=' && (*at)->byteorder != '|' && \
+ (*at)->byteorder != endian) {
+ PyArray_DESCR_REPLACE(*at);
+ (*at)->byteorder = endian;
+ }
+
+ return PY_SUCCEED;
+
+ fail:
+ PyErr_SetString(PyExc_TypeError,
+ "data type not understood");
+ *at=NULL;
+ return PY_FAIL;
+}
+
+/*MULTIARRAY_API
+ Convert object to endian
+*/
+static int
+PyArray_ByteorderConverter(PyObject *obj, char *endian)
+{
+ char *str;
+ *endian = PyArray_SWAP;
+ str = PyString_AsString(obj);
+ if (!str) return PY_FAIL;
+ if (strlen(str) < 1) {
+ PyErr_SetString(PyExc_ValueError,
+ "Byteorder string must be at least length 1");
+ return PY_FAIL;
+ }
+ *endian = str[0];
+ if (str[0] != PyArray_BIG && str[0] != PyArray_LITTLE && \
+ str[0] != PyArray_NATIVE) {
+ if (str[0] == 'b' || str[0] == 'B')
+ *endian = PyArray_BIG;
+ else if (str[0] == 'l' || str[0] == 'L')
+ *endian = PyArray_LITTLE;
+ else if (str[0] == 'n' || str[0] == 'N')
+ *endian = PyArray_NATIVE;
+ else if (str[0] == 'i' || str[0] == 'I')
+ *endian = PyArray_IGNORE;
+ else if (str[0] == 's' || str[0] == 'S')
+ *endian = PyArray_SWAP;
+ else {
+ PyErr_Format(PyExc_ValueError,
+ "%s is an unrecognized byteorder",
+ str);
+ return PY_FAIL;
+ }
+ }
+ return PY_SUCCEED;
+}
+
+/*MULTIARRAY_API
+ Convert object to sort kind
+*/
+static int
+PyArray_SortkindConverter(PyObject *obj, NPY_SORTKIND *sortkind)
+{
+ char *str;
+ *sortkind = PyArray_QUICKSORT;
+ str = PyString_AsString(obj);
+ if (!str) return PY_FAIL;
+ if (strlen(str) < 1) {
+ PyErr_SetString(PyExc_ValueError,
+ "Sort kind string must be at least length 1");
+ return PY_FAIL;
+ }
+ if (str[0] == 'q' || str[0] == 'Q')
+ *sortkind = PyArray_QUICKSORT;
+ else if (str[0] == 'h' || str[0] == 'H')
+ *sortkind = PyArray_HEAPSORT;
+ else if (str[0] == 'm' || str[0] == 'M')
+ *sortkind = PyArray_MERGESORT;
+ else {
+ PyErr_Format(PyExc_ValueError,
+ "%s is an unrecognized kind of sort",
+ str);
+ return PY_FAIL;
+ }
+ return PY_SUCCEED;
+}
+
+
+/* compare the field dictionary for two types
+ return 1 if the same or 0 if not
+ */
+
+static int
+_equivalent_fields(PyObject *field1, PyObject *field2) {
+
+ int same, val;
+
+ if (field1 == field2) return 1;
+ if (field1 == NULL || field2 == NULL) return 0;
+ val = PyObject_Compare(field1, field2);
+ if (val != 0 || PyErr_Occurred()) same = 0;
+ else same = 1;
+ PyErr_Clear();
+ return same;
+}
+
+/* This function returns true if the two typecodes are
+ equivalent (same basic kind and same itemsize).
+*/
+
+/*MULTIARRAY_API*/
+static unsigned char
+PyArray_EquivTypes(PyArray_Descr *typ1, PyArray_Descr *typ2)
+{
+ register int typenum1=typ1->type_num;
+ register int typenum2=typ2->type_num;
+ register int size1=typ1->elsize;
+ register int size2=typ2->elsize;
+
+ if (size1 != size2) return FALSE;
+
+ if (PyArray_ISNBO(typ1->byteorder) != PyArray_ISNBO(typ2->byteorder))
+ return FALSE;
+
+ if (typenum1 == PyArray_VOID || \
+ typenum2 == PyArray_VOID) {
+ return ((typenum1 == typenum2) &&
+ _equivalent_fields(typ1->fields, typ2->fields));
+ }
+ return (typ1->kind == typ2->kind);
+}
+
+/*MULTIARRAY_API*/
+static unsigned char
+PyArray_EquivTypenums(int typenum1, int typenum2)
+{
+ PyArray_Descr *d1, *d2;
+ Bool ret;
+ d1 = PyArray_DescrFromType(typenum1);
+ d2 = PyArray_DescrFromType(typenum2);
+ ret = PyArray_EquivTypes(d1, d2);
+ Py_DECREF(d1);
+ Py_DECREF(d2);
+ return ret;
+}
+
+/*** END C-API FUNCTIONS **/
+
+static PyObject *
+_prepend_ones(PyArrayObject *arr, int nd, int ndmin)
+{
+ intp newdims[MAX_DIMS];
+ intp newstrides[MAX_DIMS];
+ int i,k,num;
+ PyObject *ret;
+
+ num = ndmin-nd;
+ for (i=0; i<num; i++) {
+ newdims[i] = 1;
+ newstrides[i] = arr->descr->elsize;
+ }
+ for (i=num;i<ndmin;i++) {
+ k = i-num;
+ newdims[i] = arr->dimensions[k];
+ newstrides[i] = arr->strides[k];
+ }
+ Py_INCREF(arr->descr);
+ ret = PyArray_NewFromDescr(arr->ob_type, arr->descr, ndmin,
+ newdims, newstrides, arr->data, arr->flags,
+ (PyObject *)arr);
+ /* steals a reference to arr --- so don't increment
+ here */
+ PyArray_BASE(ret) = (PyObject *)arr;
+ return ret;
+}
+
+
+#define _ARET(x) PyArray_Return((PyArrayObject *)(x))
+
+#define STRIDING_OK(op, order) ((order) == PyArray_ANYORDER || \
+ ((order) == PyArray_CORDER && \
+ PyArray_ISCONTIGUOUS(op)) || \
+ ((order) == PyArray_FORTRANORDER && \
+ PyArray_ISFORTRAN(op)))
+
+static PyObject *
+_array_fromobject(PyObject *ignored, PyObject *args, PyObject *kws)
+{
+ PyObject *op, *ret=NULL;
+ static char *kwd[]= {"object", "dtype", "copy", "order", "subok",
+ "ndmin", NULL};
+ Bool subok=FALSE;
+ Bool copy=TRUE;
+ int ndmin=0, nd;
+ PyArray_Descr *type=NULL;
+ PyArray_Descr *oldtype=NULL;
+ NPY_ORDER order=PyArray_ANYORDER;
+ int flags=0;
+
+ if (PyTuple_GET_SIZE(args) > 2) {
+ PyErr_SetString(PyExc_ValueError,
+ "only 2 non-keyword arguments accepted");
+ return NULL;
+ }
+
+ if(!PyArg_ParseTupleAndKeywords(args, kws, "O|O&O&O&O&i", kwd, &op,
+ PyArray_DescrConverter2,
+ &type,
+ PyArray_BoolConverter, &copy,
+ PyArray_OrderConverter, &order,
+ PyArray_BoolConverter, &subok,
+ &ndmin))
+ return NULL;
+
+ /* fast exit if simple call */
+ if ((subok && PyArray_Check(op)) ||
+ (!subok && PyArray_CheckExact(op))) {
+ if (type==NULL) {
+ if (!copy && STRIDING_OK(op, order)) {
+ Py_INCREF(op);
+ ret = op;
+ goto finish;
+ }
+ else {
+ ret = PyArray_NewCopy((PyArrayObject*)op,
+ order);
+ goto finish;
+ }
+ }
+ /* One more chance */
+ oldtype = PyArray_DESCR(op);
+ if (PyArray_EquivTypes(oldtype, type)) {
+ if (!copy && STRIDING_OK(op, order)) {
+ Py_INCREF(op);
+ ret = op;
+ goto finish;
+ }
+ else {
+ ret = PyArray_NewCopy((PyArrayObject*)op,
+ order);
+ if (oldtype == type) goto finish;
+ Py_INCREF(oldtype);
+ Py_DECREF(PyArray_DESCR(ret));
+ PyArray_DESCR(ret) = oldtype;
+ goto finish;
+ }
+ }
+ }
+
+ if (copy) {
+ flags = ENSURECOPY;
+ }
+ if (order == PyArray_CORDER) {
+ flags |= CONTIGUOUS;
+ }
+ else if ((order == PyArray_FORTRANORDER) ||
+ /* order == PyArray_ANYORDER && */
+ (PyArray_Check(op) && PyArray_ISFORTRAN(op))) {
+ flags |= FORTRAN;
+ }
+ if (!subok) {
+ flags |= ENSUREARRAY;
+ }
+
+ flags |= NPY_FORCECAST;
+
+ ret = PyArray_CheckFromAny(op, type, 0, 0, flags, NULL);
+
+ finish:
+ if (!ret || (nd=PyArray_NDIM(ret)) >= ndmin) return ret;
+ /* create a new array from the same data with ones in the shape */
+ /* steals a reference to ret */
+ return _prepend_ones((PyArrayObject *)ret, nd, ndmin);
+}
+
+/* accepts NULL type */
+/* steals referenct to type */
+/*MULTIARRAY_API
+ Empty
+*/
+static PyObject *
+PyArray_Empty(int nd, intp *dims, PyArray_Descr *type, int fortran)
+{
+ PyArrayObject *ret;
+
+ if (!type) type = PyArray_DescrFromType(PyArray_DEFAULT);
+ ret = (PyArrayObject *)PyArray_NewFromDescr(&PyArray_Type,
+ type, nd, dims,
+ NULL, NULL,
+ fortran, NULL);
+ if (ret == NULL) return NULL;
+
+ if (PyDataType_REFCHK(type)) {
+ PyArray_FillObjectArray(ret, Py_None);
+ if (PyErr_Occurred()) {Py_DECREF(ret); return NULL;}
+ }
+ return (PyObject *)ret;
+}
+
+static PyObject *
+array_empty(PyObject *ignored, PyObject *args, PyObject *kwds)
+{
+
+ static char *kwlist[] = {"shape","dtype","order",NULL};
+ PyArray_Descr *typecode=NULL;
+ PyArray_Dims shape = {NULL, 0};
+ NPY_ORDER order = PyArray_CORDER;
+ Bool fortran;
+ PyObject *ret=NULL;
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "O&|O&O&",
+ kwlist, PyArray_IntpConverter,
+ &shape,
+ PyArray_DescrConverter,
+ &typecode,
+ PyArray_OrderConverter, &order))
+ goto fail;
+
+ if (order == PyArray_FORTRANORDER) fortran = TRUE;
+ else fortran = FALSE;
+
+ ret = PyArray_Empty(shape.len, shape.ptr, typecode, fortran);
+ PyDimMem_FREE(shape.ptr);
+ return ret;
+
+ fail:
+ PyDimMem_FREE(shape.ptr);
+ return ret;
+}
+
+static PyObject *
+array_scalar(PyObject *ignored, PyObject *args, PyObject *kwds)
+{
+
+ static char *kwlist[] = {"dtype","obj", NULL};
+ PyArray_Descr *typecode;
+ PyObject *obj=NULL;
+ int alloc=0;
+ void *dptr;
+ PyObject *ret;
+
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "O!|O",
+ kwlist, &PyArrayDescr_Type,
+ &typecode,
+ &obj))
+ return NULL;
+
+ if (typecode->elsize == 0) {
+ PyErr_SetString(PyExc_ValueError, \
+ "itemsize cannot be zero");
+ return NULL;
+ }
+
+ if (PyDataType_FLAGCHK(typecode, NPY_ITEM_IS_POINTER)) {
+ if (obj == NULL) obj = Py_None;
+ dptr = &obj;
+ }
+ else {
+ if (obj == NULL) {
+ dptr = _pya_malloc(typecode->elsize);
+ if (dptr == NULL) {
+ return PyErr_NoMemory();
+ }
+ memset(dptr, '\0', typecode->elsize);
+ alloc = 1;
+ }
+ else {
+ if (!PyString_Check(obj)) {
+ PyErr_SetString(PyExc_TypeError,
+ "initializing object must "\
+ "be a string");
+ return NULL;
+ }
+ if (PyString_GET_SIZE(obj) < typecode->elsize) {
+ PyErr_SetString(PyExc_ValueError,
+ "initialization string is too"\
+ " small");
+ return NULL;
+ }
+ dptr = PyString_AS_STRING(obj);
+ }
+ }
+
+ ret = PyArray_Scalar(dptr, typecode, NULL);
+
+ /* free dptr which contains zeros */
+ if (alloc) _pya_free(dptr);
+ return ret;
+}
+
+
+/* steal a reference */
+/* accepts NULL type */
+/*MULTIARRAY_API
+ Zeros
+*/
+static PyObject *
+PyArray_Zeros(int nd, intp *dims, PyArray_Descr *type, int fortran)
+{
+ PyArrayObject *ret;
+ intp n;
+
+ if (!type) type = PyArray_DescrFromType(PyArray_DEFAULT);
+ ret = (PyArrayObject *)PyArray_NewFromDescr(&PyArray_Type,
+ type,
+ nd, dims,
+ NULL, NULL,
+ fortran, NULL);
+ if (ret == NULL) return NULL;
+
+ if (PyDataType_REFCHK(type)) {
+ PyObject *zero = PyInt_FromLong(0);
+ PyArray_FillObjectArray(ret, zero);
+ Py_DECREF(zero);
+ if (PyErr_Occurred()) {Py_DECREF(ret); return NULL;}
+ }
+ else {
+ n = PyArray_NBYTES(ret);
+ memset(ret->data, 0, n);
+ }
+ return (PyObject *)ret;
+
+}
+
+static PyObject *
+array_zeros(PyObject *ignored, PyObject *args, PyObject *kwds)
+{
+ static char *kwlist[] = {"shape","dtype","order",NULL}; /* XXX ? */
+ PyArray_Descr *typecode=NULL;
+ PyArray_Dims shape = {NULL, 0};
+ NPY_ORDER order = PyArray_CORDER;
+ Bool fortran = FALSE;
+ PyObject *ret=NULL;
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "O&|O&O&",
+ kwlist, PyArray_IntpConverter,
+ &shape,
+ PyArray_DescrConverter,
+ &typecode,
+ PyArray_OrderConverter,
+ &order))
+ goto fail;
+
+ if (order == PyArray_FORTRANORDER) fortran = TRUE;
+ else fortran = FALSE;
+ ret = PyArray_Zeros(shape.len, shape.ptr, typecode, (int) fortran);
+ PyDimMem_FREE(shape.ptr);
+ return ret;
+
+ fail:
+ PyDimMem_FREE(shape.ptr);
+ return ret;
+}
+
+static PyObject *
+array_set_typeDict(PyObject *ignored, PyObject *args)
+{
+ PyObject *dict;
+ if (!PyArg_ParseTuple(args, "O", &dict)) return NULL;
+ Py_XDECREF(typeDict); /* Decrement old reference (if any)*/
+ typeDict = dict;
+ Py_INCREF(dict); /* Create an internal reference to it */
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+/* Reading from a file or a string.
+
+ As much as possible, we try to use the same code for both files and strings,
+ so the semantics for fromstring and fromfile are the same, especially with
+ regards to the handling of text representations.
+ */
+
+
+typedef int (*next_element)(void **, void *, PyArray_Descr *, void *);
+typedef int (*skip_separator)(void **, const char *, void *);
+
+static int
+fromstr_next_element(char **s, void *dptr, PyArray_Descr *dtype,
+ const char *end)
+{
+ int r = dtype->f->fromstr(*s, dptr, s, dtype);
+ if (end != NULL && *s > end) {
+ return -1;
+ }
+ return r;
+}
+
+static int
+fromfile_next_element(FILE **fp, void *dptr, PyArray_Descr *dtype,
+ void *stream_data)
+{
+ /* the NULL argument is for backwards-compatibility */
+ return dtype->f->scanfunc(*fp, dptr, NULL, dtype);
+}
+
+/* Remove multiple whitespace from the separator, and add a space to the
+ beginning and end. This simplifies the separator-skipping code below.
+*/
+static char *
+swab_separator(char *sep)
+{
+ int skip_space = 0;
+ char *s, *start;
+ s = start = malloc(strlen(sep)+3);
+ /* add space to front if there isn't one */
+ if (*sep != '\0' && !isspace(*sep)) {
+ *s = ' '; s++;
+ }
+ while (*sep != '\0') {
+ if (isspace(*sep)) {
+ if (skip_space) {
+ sep++;
+ } else {
+ *s = ' ';
+ s++; sep++;
+ skip_space = 1;
+ }
+ } else {
+ *s = *sep;
+ s++; sep++;
+ skip_space = 0;
+ }
+ }
+ /* add space to end if there isn't one */
+ if (s != start && s[-1] == ' ') {
+ *s = ' ';
+ s++;
+ }
+ *s = '\0';
+ return start;
+}
+
+/* Assuming that the separator is the next bit in the string (file), skip it.
+
+ Single spaces in the separator are matched to arbitrary-long sequences
+ of whitespace in the input.
+
+ If we can't match the separator, return -2.
+ If we hit the end of the string (file), return -1.
+ Otherwise, return 0.
+ */
+
+static int
+fromstr_skip_separator(char **s, const char *sep, const char *end)
+{
+ char *string = *s;
+ int result = 0;
+ while (1) {
+ char c = *string;
+ if (c == '\0' || (end != NULL && string >= end)) {
+ result = -1;
+ break;
+ } else if (*sep == '\0') {
+ /* matched separator */
+ result = 0;
+ break;
+ } else if (*sep == ' ') {
+ if (!isspace(c)) {
+ sep++;
+ continue;
+ }
+ } else if (*sep != c) {
+ result = -2;
+ break;
+ } else {
+ sep++;
+ }
+ string++;
+ }
+ *s = string;
+ return result;
+}
+
+static int
+fromfile_skip_separator(FILE **fp, const char *sep, void *stream_data)
+{
+ int result = 0;
+ while (1) {
+ int c = fgetc(*fp);
+ if (c == EOF) {
+ result = -1;
+ break;
+ } else if (*sep == '\0') {
+ /* matched separator */
+ ungetc(c, *fp);
+ result = 0;
+ break;
+ } else if (*sep == ' ') {
+ if (!isspace(c)) {
+ sep++;
+ ungetc(c, *fp);
+ }
+ } else if (*sep != c) {
+ ungetc(c, *fp);
+ result = -2;
+ break;
+ } else {
+ sep++;
+ }
+ }
+ return result;
+}
+
+/* Create an array by reading from the given stream, using the passed
+ next_element and skip_separator functions.
+ */
+
+#define FROM_BUFFER_SIZE 4096
+static PyArrayObject *
+array_from_text(PyArray_Descr *dtype, intp num, char *sep, size_t *nread,
+ void *stream, next_element next, skip_separator skip_sep,
+ void *stream_data)
+{
+ PyArrayObject *r;
+ intp i;
+ char *dptr, *clean_sep;
+
+ intp thisbuf = 0;
+ intp size;
+ intp bytes, totalbytes;
+
+ size = (num >= 0) ? num : FROM_BUFFER_SIZE;
+
+ r = (PyArrayObject *)
+ PyArray_NewFromDescr(&PyArray_Type,
+ dtype,
+ 1, &size,
+ NULL, NULL,
+ 0, NULL);
+ if (r == NULL) return NULL;
+ clean_sep = swab_separator(sep);
+ NPY_BEGIN_ALLOW_THREADS;
+ totalbytes = bytes = size * dtype->elsize;
+ dptr = r->data;
+ for (i=0; num < 0 || i < num; i++) {
+ if (next(&stream, dptr, dtype, stream_data) < 0)
+ break;
+ *nread += 1;
+ thisbuf += 1;
+ dptr += dtype->elsize;
+ if (num < 0 && thisbuf == size) {
+ totalbytes += bytes;
+ r->data = PyDataMem_RENEW(r->data, totalbytes);
+ dptr = r->data + (totalbytes - bytes);
+ thisbuf = 0;
+ }
+ if (skip_sep(&stream, clean_sep, stream_data) < 0)
+ break;
+ }
+ if (num < 0) {
+ r->data = PyDataMem_RENEW(r->data, (*nread)*dtype->elsize);
+ PyArray_DIM(r,0) = *nread;
+ }
+ NPY_END_ALLOW_THREADS;
+ free(clean_sep);
+ if (PyErr_Occurred()) {
+ Py_DECREF(r);
+ return NULL;
+ }
+ return r;
+}
+#undef FROM_BUFFER_SIZE
+
+/*OBJECT_API
+
+ Given a pointer to a string ``data``, a string length ``slen``, and
+ a ``PyArray_Descr``, return an array corresponding to the data
+ encoded in that string.
+
+ If the dtype is NULL, the default array type is used (double).
+ If non-null, the reference is stolen.
+
+ If ``slen`` is < 0, then the end of string is used for text data.
+ It is an error for ``slen`` to be < 0 for binary data (since embedded NULLs
+ would be the norm).
+
+ The number of elements to read is given as ``num``; if it is < 0, then
+ then as many as possible are read.
+
+ If ``sep`` is NULL or empty, then binary data is assumed, else
+ text data, with ``sep`` as the separator between elements. Whitespace in
+ the separator matches any length of whitespace in the text, and a match
+ for whitespace around the separator is added.
+ */
+static PyObject *
+PyArray_FromString(char *data, intp slen, PyArray_Descr *dtype,
+ intp num, char *sep)
+{
+ int itemsize;
+ PyArrayObject *ret;
+ Bool binary;
+
+ if (dtype == NULL)
+ dtype=PyArray_DescrFromType(PyArray_DEFAULT);
+
+ if (PyDataType_FLAGCHK(dtype, NPY_ITEM_IS_POINTER)) {
+ PyErr_SetString(PyExc_ValueError,
+ "Cannot create an object array from" \
+ " a string");
+ Py_DECREF(dtype);
+ return NULL;
+ }
+
+ itemsize = dtype->elsize;
+ if (itemsize == 0) {
+ PyErr_SetString(PyExc_ValueError, "zero-valued itemsize");
+ Py_DECREF(dtype);
+ return NULL;
+ }
+
+ binary = ((sep == NULL) || (strlen(sep) == 0));
+
+ if (binary) {
+ if (num < 0 ) {
+ if (slen % itemsize != 0) {
+ PyErr_SetString(PyExc_ValueError,
+ "string size must be a "\
+ "multiple of element size");
+ Py_DECREF(dtype);
+ return NULL;
+ }
+ num = slen/itemsize;
+ } else {
+ if (slen < num*itemsize) {
+ PyErr_SetString(PyExc_ValueError,
+ "string is smaller than " \
+ "requested size");
+ Py_DECREF(dtype);
+ return NULL;
+ }
+ }
+
+ ret = (PyArrayObject *)
+ PyArray_NewFromDescr(&PyArray_Type, dtype,
+ 1, &num, NULL, NULL,
+ 0, NULL);
+ if (ret == NULL) return NULL;
+ memcpy(ret->data, data, num*dtype->elsize);
+ } else {
+ /* read from character-based string */
+ size_t nread = 0;
+ char *end;
+ if (dtype->f->scanfunc == NULL) {
+ PyErr_SetString(PyExc_ValueError,
+ "don't know how to read " \
+ "character strings with that " \
+ "array type");
+ Py_DECREF(dtype);
+ return NULL;
+ }
+ if (slen < 0) {
+ end = NULL;
+ } else {
+ end = data + slen;
+ }
+ ret = array_from_text(dtype, num, sep, &nread,
+ data,
+ (next_element) fromstr_next_element,
+ (skip_separator) fromstr_skip_separator,
+ end);
+ }
+ return (PyObject *)ret;
+}
+
+static PyObject *
+array_fromstring(PyObject *ignored, PyObject *args, PyObject *keywds)
+{
+ char *data;
+ Py_ssize_t nin=-1;
+ char *sep=NULL;
+ Py_ssize_t s;
+ static char *kwlist[] = {"string", "dtype", "count", "sep", NULL};
+ PyArray_Descr *descr=NULL;
+
+ if (!PyArg_ParseTupleAndKeywords(args, keywds, "s#|O&"
+ NPY_SSIZE_T_PYFMT "s", kwlist,
+ &data, &s,
+ PyArray_DescrConverter, &descr,
+ &nin, &sep)) {
+ return NULL;
+ }
+
+ return PyArray_FromString(data, (intp)s, descr, (intp)nin, sep);
+}
+
+
+
+static PyArrayObject *
+array_fromfile_binary(FILE *fp, PyArray_Descr *dtype, intp num, size_t *nread)
+{
+ PyArrayObject *r;
+ intp start, numbytes;
+
+ if (num < 0) {
+ int fail=0;
+ start = (intp )ftell(fp);
+ if (start < 0) fail=1;
+ if (fseek(fp, 0, SEEK_END) < 0) fail=1;
+ numbytes = (intp) ftell(fp);
+ if (numbytes < 0) fail=1;
+ numbytes -= start;
+ if (fseek(fp, start, SEEK_SET) < 0) fail=1;
+ if (fail) {
+ PyErr_SetString(PyExc_IOError,
+ "could not seek in file");
+ Py_DECREF(dtype);
+ return NULL;
+ }
+ num = numbytes / dtype->elsize;
+ }
+ r = (PyArrayObject *)PyArray_NewFromDescr(&PyArray_Type,
+ dtype,
+ 1, &num,
+ NULL, NULL,
+ 0, NULL);
+ if (r==NULL) return NULL;
+ NPY_BEGIN_ALLOW_THREADS;
+ *nread = fread(r->data, dtype->elsize, num, fp);
+ NPY_END_ALLOW_THREADS;
+ return r;
+}
+
+/*OBJECT_API
+
+ Given a ``FILE *`` pointer ``fp``, and a ``PyArray_Descr``, return an
+ array corresponding to the data encoded in that file.
+
+ If the dtype is NULL, the default array type is used (double).
+ If non-null, the reference is stolen.
+
+ The number of elements to read is given as ``num``; if it is < 0, then
+ then as many as possible are read.
+
+ If ``sep`` is NULL or empty, then binary data is assumed, else
+ text data, with ``sep`` as the separator between elements. Whitespace in
+ the separator matches any length of whitespace in the text, and a match
+ for whitespace around the separator is added.
+
+ For memory-mapped files, use the buffer interface. No more data than
+ necessary is read by this routine.
+*/
+static PyObject *
+PyArray_FromFile(FILE *fp, PyArray_Descr *dtype, intp num, char *sep)
+{
+ PyArrayObject *ret;
+ size_t nread = 0;
+
+ if (PyDataType_REFCHK(dtype)) {
+ PyErr_SetString(PyExc_ValueError,
+ "cannot read into object array");
+ Py_DECREF(dtype);
+ return NULL;
+ }
+ if (dtype->elsize == 0) {
+ PyErr_SetString(PyExc_ValueError, "0-sized elements.");
+ Py_DECREF(dtype);
+ return NULL;
+ }
+
+ if ((sep == NULL) || (strlen(sep) == 0)) {
+ ret = array_fromfile_binary(fp, dtype, num, &nread);
+ } else {
+ if (dtype->f->scanfunc == NULL) {
+ PyErr_SetString(PyExc_ValueError,
+ "don't know how to read " \
+ "character files with that " \
+ "array type");
+ Py_DECREF(dtype);
+ return NULL;
+ }
+ ret = array_from_text(dtype, num, sep, &nread,
+ fp,
+ (next_element) fromfile_next_element,
+ (skip_separator) fromfile_skip_separator,
+ NULL);
+ }
+ if (((intp) nread) < num) {
+ fprintf(stderr, "%ld items requested but only %ld read\n",
+ (long) num, (long) nread);
+ ret->data = PyDataMem_RENEW(ret->data,
+ nread * ret->descr->elsize);
+ PyArray_DIM(ret,0) = nread;
+ }
+ return (PyObject *)ret;
+}
+
+static PyObject *
+array_fromfile(PyObject *ignored, PyObject *args, PyObject *keywds)
+{
+ PyObject *file=NULL, *ret;
+ FILE *fp;
+ char *sep="";
+ Py_ssize_t nin=-1;
+ static char *kwlist[] = {"file", "dtype", "count", "sep", NULL};
+ PyArray_Descr *type=NULL;
+
+ if (!PyArg_ParseTupleAndKeywords(args, keywds,
+ "O|O&" NPY_SSIZE_T_PYFMT "s",
+ kwlist,
+ &file,
+ PyArray_DescrConverter, &type,
+ &nin, &sep)) {
+ return NULL;
+ }
+
+ if (type == NULL) type = PyArray_DescrFromType(PyArray_DEFAULT);
+
+ if (PyString_Check(file) || PyUnicode_Check(file)) {
+ file = PyObject_CallFunction((PyObject *)&PyFile_Type,
+ "Os", file, "rb");
+ if (file==NULL) return NULL;
+ }
+ else {
+ Py_INCREF(file);
+ }
+ fp = PyFile_AsFile(file);
+ if (fp == NULL) {
+ PyErr_SetString(PyExc_IOError,
+ "first argument must be an open file");
+ Py_DECREF(file);
+ return NULL;
+ }
+ ret = PyArray_FromFile(fp, type, (intp) nin, sep);
+ Py_DECREF(file);
+ return ret;
+}
+
+
+/* steals a reference to dtype (which cannot be NULL) */
+/*OBJECT_API */
+static PyObject *
+PyArray_FromIter(PyObject *obj, PyArray_Descr *dtype, intp count)
+{
+ PyObject *value;
+ PyObject *iter = PyObject_GetIter(obj);
+ PyArrayObject *ret = NULL;
+ intp i, elsize, elcount;
+ char *item, *new_data;
+
+ if (iter == NULL) goto done;
+
+ elcount = (count < 0) ? 0 : count;
+ elsize = dtype->elsize;
+
+ /* We would need to alter the memory RENEW code to decrement any
+ reference counts before throwing away any memory.
+ */
+ if (PyDataType_REFCHK(dtype)) {
+ PyErr_SetString(PyExc_ValueError, "cannot create "\
+ "object arrays from iterator");
+ goto done;
+ }
+
+ ret = (PyArrayObject *)PyArray_NewFromDescr(&PyArray_Type, dtype, 1,
+ &elcount, NULL,NULL, 0, NULL);
+ dtype = NULL;
+ if (ret == NULL) goto done;
+
+ for (i = 0; (i < count || count == -1) &&
+ (value = PyIter_Next(iter)); i++) {
+
+ if (i >= elcount) {
+ /*
+ Grow ret->data:
+ this is similar for the strategy for PyListObject, but we use
+ 50% overallocation => 0, 4, 8, 14, 23, 36, 56, 86 ...
+ */
+ elcount = (i >> 1) + (i < 4 ? 4 : 2) + i;
+ if (elcount <= (intp)((~(size_t)0) / elsize))
+ new_data = PyDataMem_RENEW(ret->data, elcount * elsize);
+ else
+ new_data = NULL;
+ if (new_data == NULL) {
+ PyErr_SetString(PyExc_MemoryError,
+ "cannot allocate array memory");
+ Py_DECREF(value);
+ goto done;
+ }
+ ret->data = new_data;
+ }
+ ret->dimensions[0] = i+1;
+
+ if (((item = index2ptr(ret, i)) == NULL) ||
+ (ret->descr->f->setitem(value, item, ret) == -1)) {
+ Py_DECREF(value);
+ goto done;
+ }
+ Py_DECREF(value);
+
+ }
+
+ if (i < count) {
+ PyErr_SetString(PyExc_ValueError, "iterator too short");
+ goto done;
+ }
+
+ /*
+ Realloc the data so that don't keep extra memory tied up
+ (assuming realloc is reasonably good about reusing space...)
+ */
+ if (i==0) i = 1;
+ ret->data = PyDataMem_RENEW(ret->data, i * elsize);
+ if (ret->data == NULL) {
+ PyErr_SetString(PyExc_MemoryError, "cannot allocate array memory");
+ goto done;
+ }
+
+done:
+ Py_XDECREF(iter);
+ Py_XDECREF(dtype);
+ if (PyErr_Occurred()) {
+ Py_XDECREF(ret);
+ return NULL;
+ }
+ return (PyObject *)ret;
+}
+
+static PyObject *
+array_fromiter(PyObject *ignored, PyObject *args, PyObject *keywds)
+{
+ PyObject *iter;
+ Py_ssize_t nin=-1;
+ static char *kwlist[] = {"iter", "dtype", "count", NULL};
+ PyArray_Descr *descr=NULL;
+
+ if (!PyArg_ParseTupleAndKeywords(args, keywds,
+ "OO&|" NPY_SSIZE_T_PYFMT,
+ kwlist,
+ &iter,
+ PyArray_DescrConverter, &descr,
+ &nin)) {
+ return NULL;
+ }
+
+ return PyArray_FromIter(iter, descr, (intp)nin);
+}
+
+
+/*OBJECT_API*/
+static PyObject *
+PyArray_FromBuffer(PyObject *buf, PyArray_Descr *type,
+ intp count, intp offset)
+{
+ PyArrayObject *ret;
+ char *data;
+ Py_ssize_t ts;
+ intp s, n;
+ int itemsize;
+ int write=1;
+
+
+ if (PyDataType_REFCHK(type)) {
+ PyErr_SetString(PyExc_ValueError,
+ "cannot create an OBJECT array from memory"\
+ " buffer");
+ Py_DECREF(type);
+ return NULL;
+ }
+ if (type->elsize == 0) {
+ PyErr_SetString(PyExc_ValueError,
+ "itemsize cannot be zero in type");
+ Py_DECREF(type);
+ return NULL;
+ }
+
+ if (buf->ob_type->tp_as_buffer == NULL || \
+ (buf->ob_type->tp_as_buffer->bf_getwritebuffer == NULL && \
+ buf->ob_type->tp_as_buffer->bf_getreadbuffer == NULL)) {
+ PyObject *newbuf;
+ newbuf = PyObject_GetAttrString(buf, "__buffer__");
+ if (newbuf == NULL) {Py_DECREF(type); return NULL;}
+ buf = newbuf;
+ }
+ else {Py_INCREF(buf);}
+
+ if (PyObject_AsWriteBuffer(buf, (void *)&data, &ts)==-1) {
+ write = 0;
+ PyErr_Clear();
+ if (PyObject_AsReadBuffer(buf, (void *)&data, &ts)==-1) {
+ Py_DECREF(buf);
+ Py_DECREF(type);
+ return NULL;
+ }
+ }
+
+ if ((offset < 0) || (offset >= ts)) {
+ PyErr_Format(PyExc_ValueError,
+ "offset must be positive and smaller than %"
+ INTP_FMT, (intp)ts);
+ }
+
+ data += offset;
+ s = (intp)ts - offset;
+ n = (intp)count;
+ itemsize = type->elsize;
+
+ if (n < 0 ) {
+ if (s % itemsize != 0) {
+ PyErr_SetString(PyExc_ValueError,
+ "buffer size must be a multiple"\
+ " of element size");
+ Py_DECREF(buf);
+ Py_DECREF(type);
+ return NULL;
+ }
+ n = s/itemsize;
+ } else {
+ if (s < n*itemsize) {
+ PyErr_SetString(PyExc_ValueError,
+ "buffer is smaller than requested"\
+ " size");
+ Py_DECREF(buf);
+ Py_DECREF(type);
+ return NULL;
+ }
+ }
+
+ if ((ret = (PyArrayObject *)PyArray_NewFromDescr(&PyArray_Type,
+ type,
+ 1, &n,
+ NULL, data,
+ DEFAULT,
+ NULL)) == NULL) {
+ Py_DECREF(buf);
+ return NULL;
+ }
+
+ if (!write) ret->flags &= ~WRITEABLE;
+
+ /* Store a reference for decref on deallocation */
+ ret->base = buf;
+ PyArray_UpdateFlags(ret, ALIGNED);
+ return (PyObject *)ret;
+}
+
+static PyObject *
+array_frombuffer(PyObject *ignored, PyObject *args, PyObject *keywds)
+{
+ PyObject *obj=NULL;
+ Py_ssize_t nin=-1, offset=0;
+ static char *kwlist[] = {"buffer", "dtype", "count", "offset", NULL};
+ PyArray_Descr *type=NULL;
+
+ if (!PyArg_ParseTupleAndKeywords(args, keywds, "O|O&"
+ NPY_SSIZE_T_PYFMT
+ NPY_SSIZE_T_PYFMT, kwlist,
+ &obj,
+ PyArray_DescrConverter, &type,
+ &nin, &offset)) {
+ return NULL;
+ }
+ if (type==NULL)
+ type = PyArray_DescrFromType(PyArray_DEFAULT);
+
+ return PyArray_FromBuffer(obj, type, (intp)nin, (intp)offset);
+}
+
+static PyObject *
+array_concatenate(PyObject *dummy, PyObject *args, PyObject *kwds)
+{
+ PyObject *a0;
+ int axis=0;
+ static char *kwlist[] = {"seq", "axis", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "O|O&", kwlist,
+ &a0,
+ PyArray_AxisConverter, &axis))
+ return NULL;
+ return PyArray_Concatenate(a0, axis);
+}
+
+static PyObject *array_innerproduct(PyObject *dummy, PyObject *args) {
+ PyObject *b0, *a0;
+
+ if (!PyArg_ParseTuple(args, "OO", &a0, &b0)) return NULL;
+
+ return _ARET(PyArray_InnerProduct(a0, b0));
+}
+
+static PyObject *array_matrixproduct(PyObject *dummy, PyObject *args) {
+ PyObject *v, *a;
+
+ if (!PyArg_ParseTuple(args, "OO", &a, &v)) return NULL;
+
+ return _ARET(PyArray_MatrixProduct(a, v));
+}
+
+static PyObject *array_fastCopyAndTranspose(PyObject *dummy, PyObject *args) {
+ PyObject *a0;
+
+ if (!PyArg_ParseTuple(args, "O", &a0)) return NULL;
+
+ return _ARET(PyArray_CopyAndTranspose(a0));
+}
+
+static PyObject *array_correlate(PyObject *dummy, PyObject *args, PyObject *kwds) {
+ PyObject *shape, *a0;
+ int mode=0;
+ static char *kwlist[] = {"a", "v", "mode", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "OO|i", kwlist,
+ &a0, &shape, &mode)) return NULL;
+
+ return PyArray_Correlate(a0, shape, mode);
+}
+
+
+/*MULTIARRAY_API
+ Arange,
+*/
+static PyObject *
+PyArray_Arange(double start, double stop, double step, int type_num)
+{
+ intp length;
+ PyObject *range;
+ PyArray_ArrFuncs *funcs;
+ PyObject *obj;
+ int ret;
+
+ length = (intp ) ceil((stop - start)/step);
+
+ if (length <= 0) {
+ length = 0;
+ return PyArray_New(&PyArray_Type, 1, &length, type_num,
+ NULL, NULL, 0, 0, NULL);
+ }
+
+ range = PyArray_New(&PyArray_Type, 1, &length, type_num,
+ NULL, NULL, 0, 0, NULL);
+ if (range == NULL) return NULL;
+
+ funcs = PyArray_DESCR(range)->f;
+
+ /* place start in the buffer and the next value in the second position */
+ /* if length > 2, then call the inner loop, otherwise stop */
+
+ obj = PyFloat_FromDouble(start);
+ ret = funcs->setitem(obj, PyArray_DATA(range), (PyArrayObject *)range);
+ Py_DECREF(obj);
+ if (ret < 0) goto fail;
+ if (length == 1) return range;
+
+ obj = PyFloat_FromDouble(start + step);
+ ret = funcs->setitem(obj, PyArray_BYTES(range)+PyArray_ITEMSIZE(range),
+ (PyArrayObject *)range);
+ Py_DECREF(obj);
+ if (ret < 0) goto fail;
+ if (length == 2) return range;
+
+ if (!funcs->fill) {
+ PyErr_SetString(PyExc_ValueError, "no fill-function for data-type.");
+ Py_DECREF(range);
+ return NULL;
+ }
+ funcs->fill(PyArray_DATA(range), length, (PyArrayObject *)range);
+ if (PyErr_Occurred()) goto fail;
+
+ return range;
+
+ fail:
+ Py_DECREF(range);
+ return NULL;
+}
+
+/* the formula is
+ len = (intp) ceil((start - stop) / step);
+*/
+static intp
+_calc_length(PyObject *start, PyObject *stop, PyObject *step, PyObject **next, int cmplx)
+{
+ intp len;
+ PyObject *val;
+ double value;
+
+ *next = PyNumber_Subtract(stop, start);
+ if (!(*next)) {
+ if (PyTuple_Check(stop)) {
+ PyErr_Clear();
+ PyErr_SetString(PyExc_TypeError,
+ "arange: scalar arguments expected "\
+ "instead of a tuple.");
+ }
+ return -1;
+ }
+ val = PyNumber_TrueDivide(*next, step);
+ Py_DECREF(*next); *next=NULL;
+ if (!val) return -1;
+ if (cmplx && PyComplex_Check(val)) {
+ value = PyComplex_RealAsDouble(val);
+ if (error_converting(value)) {Py_DECREF(val); return -1;}
+ len = (intp) ceil(value);
+ value = PyComplex_ImagAsDouble(val);
+ Py_DECREF(val);
+ if (error_converting(value)) return -1;
+ len = MIN(len, (intp) ceil(value));
+ }
+ else {
+ value = PyFloat_AsDouble(val);
+ Py_DECREF(val);
+ if (error_converting(value)) return -1;
+ len = (intp) ceil(value);
+ }
+
+ if (len > 0) {
+ *next = PyNumber_Add(start, step);
+ if (!next) return -1;
+ }
+ return len;
+}
+
+/* this doesn't change the references */
+/*MULTIARRAY_API
+ ArangeObj,
+*/
+static PyObject *
+PyArray_ArangeObj(PyObject *start, PyObject *stop, PyObject *step, PyArray_Descr *dtype)
+{
+ PyObject *range;
+ PyArray_ArrFuncs *funcs;
+ PyObject *next;
+ intp length;
+ PyArray_Descr *native=NULL;
+ int swap;
+
+ if (!dtype) {
+ PyArray_Descr *deftype;
+ PyArray_Descr *newtype;
+ /* intentionally made to be PyArray_LONG default */
+ deftype = PyArray_DescrFromType(PyArray_LONG);
+ newtype = PyArray_DescrFromObject(start, deftype);
+ Py_DECREF(deftype);
+ deftype = newtype;
+ if (stop && stop != Py_None) {
+ newtype = PyArray_DescrFromObject(stop, deftype);
+ Py_DECREF(deftype);
+ deftype = newtype;
+ }
+ if (step && step != Py_None) {
+ newtype = PyArray_DescrFromObject(step, deftype);
+ Py_DECREF(deftype);
+ deftype = newtype;
+ }
+ dtype = deftype;
+ }
+ else Py_INCREF(dtype);
+
+ if (!step || step == Py_None) {
+ step = PyInt_FromLong(1);
+ }
+ else Py_XINCREF(step);
+
+ if (!stop || stop == Py_None) {
+ stop = start;
+ start = PyInt_FromLong(0);
+ }
+ else Py_INCREF(start);
+
+ /* calculate the length and next = start + step*/
+ length = _calc_length(start, stop, step, &next,
+ PyTypeNum_ISCOMPLEX(dtype->type_num));
+
+ if (PyErr_Occurred()) {Py_DECREF(dtype); goto fail;}
+ if (length <= 0) {
+ length = 0;
+ range = PyArray_SimpleNewFromDescr(1, &length, dtype);
+ Py_DECREF(step); Py_DECREF(start); return range;
+ }
+
+ /* If dtype is not in native byte-order then get native-byte
+ order version. And then swap on the way out.
+ */
+ if (!PyArray_ISNBO(dtype->byteorder)) {
+ native = PyArray_DescrNewByteorder(dtype, PyArray_NATBYTE);
+ swap = 1;
+ }
+ else {
+ native = dtype;
+ swap = 0;
+ }
+
+ range = PyArray_SimpleNewFromDescr(1, &length, native);
+ if (range == NULL) goto fail;
+
+ funcs = PyArray_DESCR(range)->f;
+
+ /* place start in the buffer and the next value in the second position */
+ /* if length > 2, then call the inner loop, otherwise stop */
+
+ if (funcs->setitem(start, PyArray_DATA(range), (PyArrayObject *)range) < 0)
+ goto fail;
+ if (length == 1) goto finish;
+ if (funcs->setitem(next, PyArray_BYTES(range)+PyArray_ITEMSIZE(range),
+ (PyArrayObject *)range) < 0) goto fail;
+ if (length == 2) goto finish;
+
+ if (!funcs->fill) {
+ PyErr_SetString(PyExc_ValueError, "no fill-function for data-type.");
+ Py_DECREF(range);
+ goto fail;
+ }
+ funcs->fill(PyArray_DATA(range), length, (PyArrayObject *)range);
+ if (PyErr_Occurred()) goto fail;
+
+ if (swap) {
+ PyObject *new;
+ new = PyArray_Byteswap((PyArrayObject *)range, 1);
+ Py_DECREF(new);
+ Py_DECREF(PyArray_DESCR(range));
+ PyArray_DESCR(range) = dtype; /* steals the reference */
+ }
+
+ finish:
+ Py_DECREF(start);
+ Py_DECREF(step);
+ Py_DECREF(next);
+ return range;
+
+ fail:
+ Py_DECREF(start);
+ Py_DECREF(step);
+ Py_XDECREF(next);
+ return NULL;
+}
+
+static PyObject *
+array_arange(PyObject *ignored, PyObject *args, PyObject *kws) {
+ PyObject *o_start=NULL, *o_stop=NULL, *o_step=NULL;
+ static char *kwd[]= {"start", "stop", "step", "dtype", NULL};
+ PyArray_Descr *typecode=NULL;
+
+ if(!PyArg_ParseTupleAndKeywords(args, kws, "O|OOO&", kwd, &o_start,
+ &o_stop, &o_step,
+ PyArray_DescrConverter2,
+ &typecode))
+ return NULL;
+
+ return PyArray_ArangeObj(o_start, o_stop, o_step, typecode);
+}
+
+/*
+Included at the very first so not auto-grabbed and thus not
+labeled.
+*/
+static unsigned int
+PyArray_GetNDArrayCVersion(void)
+{
+ return (unsigned int)NPY_VERSION;
+}
+
+static PyObject *
+array__get_ndarray_c_version(PyObject *dummy, PyObject *args, PyObject *kwds)
+{
+ static char *kwlist[] = {NULL};
+ if(!PyArg_ParseTupleAndKeywords(args, kwds, "", kwlist )) return NULL;
+
+ return PyInt_FromLong( (long) PyArray_GetNDArrayCVersion() );
+}
+
+static PyObject *
+array__reconstruct(PyObject *dummy, PyObject *args)
+{
+
+ PyObject *ret;
+ PyTypeObject *subtype;
+ PyArray_Dims shape = {NULL, 0};
+ PyArray_Descr *dtype=NULL;
+ if (!PyArg_ParseTuple(args, "O!O&O&", &PyType_Type, &subtype,
+ PyArray_IntpConverter, &shape,
+ PyArray_DescrConverter, &dtype))
+ goto fail;
+
+ if (!PyType_IsSubtype(subtype, &PyArray_Type)) {
+ PyErr_SetString(PyExc_TypeError,
+ "_reconstruct: First argument must be " \
+ "a sub-type of ndarray");
+ goto fail;
+ }
+
+ ret = PyArray_NewFromDescr(subtype, dtype,
+ (int)shape.len, shape.ptr,
+ NULL, NULL, 0, NULL);
+ if (shape.ptr) PyDimMem_FREE(shape.ptr);
+ return ret;
+
+ fail:
+ Py_XDECREF(dtype);
+ if (shape.ptr) PyDimMem_FREE(shape.ptr);
+ return NULL;
+}
+
+static PyObject *
+array_set_string_function(PyObject *dummy, PyObject *args, PyObject *kwds)
+{
+ PyObject *op=NULL;
+ int repr=1;
+ static char *kwlist[] = {"f", "repr", NULL};
+
+ if(!PyArg_ParseTupleAndKeywords(args, kwds, "|Oi", kwlist,
+ &op, &repr)) return NULL;
+
+ /* reset the array_repr function to built-in */
+ if (op == Py_None) op = NULL;
+ if (op != NULL && !PyCallable_Check(op)) {
+ PyErr_SetString(PyExc_TypeError,
+ "Argument must be callable.");
+ return NULL;
+ }
+ PyArray_SetStringFunction(op, repr);
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+static PyObject *
+array_set_ops_function(PyObject *self, PyObject *args, PyObject *kwds)
+{
+ PyObject *oldops=NULL;
+
+ if ((oldops = PyArray_GetNumericOps())==NULL) return NULL;
+
+ /* Should probably ensure that objects are at least callable */
+ /* Leave this to the caller for now --- error will be raised
+ later when use is attempted
+ */
+ if (kwds && PyArray_SetNumericOps(kwds) == -1) {
+ Py_DECREF(oldops);
+ PyErr_SetString(PyExc_ValueError,
+ "one or more objects not callable");
+ return NULL;
+ }
+ return oldops;
+}
+
+
+/*MULTIARRAY_API
+ Where
+*/
+static PyObject *
+PyArray_Where(PyObject *condition, PyObject *x, PyObject *y)
+{
+ PyArrayObject *arr;
+ PyObject *tup=NULL, *obj=NULL;
+ PyObject *ret=NULL, *zero=NULL;
+
+
+ arr = (PyArrayObject *)PyArray_FromAny(condition, NULL, 0, 0, 0, NULL);
+ if (arr == NULL) return NULL;
+
+ if ((x==NULL) && (y==NULL)) {
+ ret = PyArray_Nonzero(arr);
+ Py_DECREF(arr);
+ return ret;
+ }
+
+ if ((x==NULL) || (y==NULL)) {
+ Py_DECREF(arr);
+ PyErr_SetString(PyExc_ValueError, "either both or neither "
+ "of x and y should be given");
+ return NULL;
+ }
+
+
+ zero = PyInt_FromLong((long) 0);
+
+ obj = PyArray_EnsureAnyArray(PyArray_GenericBinaryFunction(arr, zero,
+ n_ops.not_equal));
+ Py_DECREF(zero);
+ Py_DECREF(arr);
+ if (obj == NULL) return NULL;
+
+ tup = Py_BuildValue("(OO)", y, x);
+ if (tup == NULL) {Py_DECREF(obj); return NULL;}
+
+ ret = PyArray_Choose((PyAO *)obj, tup, NULL, NPY_RAISE);
+
+ Py_DECREF(obj);
+ Py_DECREF(tup);
+ return ret;
+}
+
+static PyObject *
+array_where(PyObject *ignored, PyObject *args)
+{
+ PyObject *obj=NULL, *x=NULL, *y=NULL;
+
+ if (!PyArg_ParseTuple(args, "O|OO", &obj, &x, &y)) return NULL;
+
+ return PyArray_Where(obj, x, y);
+}
+
+static PyObject *
+array_lexsort(PyObject *ignored, PyObject *args, PyObject *kwds)
+{
+ int axis=-1;
+ PyObject *obj;
+ static char *kwlist[] = {"keys", "axis", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "O|i", kwlist,
+ &obj, &axis)) return NULL;
+
+ return _ARET(PyArray_LexSort(obj, axis));
+}
+
+#undef _ARET
+
+static PyObject *
+array_can_cast_safely(PyObject *dummy, PyObject *args, PyObject *kwds)
+{
+ PyArray_Descr *d1=NULL;
+ PyArray_Descr *d2=NULL;
+ Bool ret;
+ PyObject *retobj;
+ static char *kwlist[] = {"from", "to", NULL};
+
+ if(!PyArg_ParseTupleAndKeywords(args, kwds, "O&O&", kwlist,
+ PyArray_DescrConverter, &d1,
+ PyArray_DescrConverter, &d2))
+ return NULL;
+ if (d1 == NULL || d2 == NULL) {
+ PyErr_SetString(PyExc_TypeError,
+ "did not understand one of the types; " \
+ "'None' not accepted");
+ return NULL;
+ }
+
+ ret = PyArray_CanCastTo(d1, d2);
+ retobj = (ret ? Py_True : Py_False);
+ Py_INCREF(retobj);
+ return retobj;
+}
+
+static PyObject *
+new_buffer(PyObject *dummy, PyObject *args)
+{
+ int size;
+
+ if(!PyArg_ParseTuple(args, "i", &size))
+ return NULL;
+
+ return PyBuffer_New(size);
+}
+
+static PyObject *
+buffer_buffer(PyObject *dummy, PyObject *args, PyObject *kwds)
+{
+ PyObject *obj;
+ Py_ssize_t offset=0, size=Py_END_OF_BUFFER, n;
+ void *unused;
+ static char *kwlist[] = {"object", "offset", "size", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "O|" NPY_SSIZE_T_PYFMT \
+ NPY_SSIZE_T_PYFMT, kwlist,
+ &obj, &offset, &size))
+ return NULL;
+
+
+ if (PyObject_AsWriteBuffer(obj, &unused, &n) < 0) {
+ PyErr_Clear();
+ return PyBuffer_FromObject(obj, offset, size);
+ }
+ else
+ return PyBuffer_FromReadWriteObject(obj, offset, size);
+}
+
+#ifndef _MSC_VER
+#include <setjmp.h>
+#include <signal.h>
+jmp_buf _NPY_SIGSEGV_BUF;
+static void
+_SigSegv_Handler(int signum)
+{
+ longjmp(_NPY_SIGSEGV_BUF, signum);
+}
+#endif
+
+#define _test_code() { \
+ test = *((char*)memptr); \
+ if (!ro) { \
+ *((char *)memptr) = '\0'; \
+ *((char *)memptr) = test; \
+ } \
+ test = *((char*)memptr+size-1); \
+ if (!ro) { \
+ *((char *)memptr+size-1) = '\0'; \
+ *((char *)memptr+size-1) = test; \
+ } \
+ }
+
+static PyObject *
+as_buffer(PyObject *dummy, PyObject *args, PyObject *kwds)
+{
+ PyObject *mem;
+ Py_ssize_t size;
+ Bool ro=FALSE, check=TRUE;
+ void *memptr;
+ static char *kwlist[] = {"mem", "size", "readonly", "check", NULL};
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "O" \
+ NPY_SSIZE_T_PYFMT "|O&O&", kwlist,
+ &mem, &size, PyArray_BoolConverter,
+ &ro, PyArray_BoolConverter,
+ &check)) return NULL;
+ memptr = PyLong_AsVoidPtr(mem);
+ if (memptr == NULL) return NULL;
+
+ if (check) {
+ /* Try to dereference the start and end of the memory region */
+ /* Catch segfault and report error if it occurs */
+ char test;
+ int err=0;
+#ifdef _MSC_VER
+ __try {
+ _test_code();
+ }
+ __except(1) {
+ err = 1;
+ }
+#else
+ PyOS_sighandler_t _npy_sig_save;
+ _npy_sig_save = PyOS_setsig(SIGSEGV, _SigSegv_Handler);
+
+ if (setjmp(_NPY_SIGSEGV_BUF) == 0) {
+ _test_code();
+ }
+ else {
+ err = 1;
+ }
+ PyOS_setsig(SIGSEGV, _npy_sig_save);
+#endif
+ if (err) {
+ PyErr_SetString(PyExc_ValueError,
+ "cannot use memory location as " \
+ "a buffer.");
+ return NULL;
+ }
+ }
+
+
+ if (ro) {
+ return PyBuffer_FromMemory(memptr, size);
+ }
+ return PyBuffer_FromReadWriteMemory(memptr, size);
+}
+
+#undef _test_code
+
+static PyObject *
+format_longfloat(PyObject *dummy, PyObject *args, PyObject *kwds)
+{
+ PyObject *obj;
+ unsigned int precision;
+ longdouble x;
+ static char *kwlist[] = {"x", "precision", NULL};
+ static char repr[100];
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "OI", kwlist,
+ &obj, &precision)) {
+ return NULL;
+ }
+ if (!PyArray_IsScalar(obj, LongDouble)) {
+ PyErr_SetString(PyExc_TypeError, "not a longfloat");
+ return NULL;
+ }
+ x = ((PyLongDoubleScalarObject *)obj)->obval;
+ if (precision > 70) {
+ precision = 70;
+ }
+ format_longdouble(repr, 100, x, precision);
+ return PyString_FromString(repr);
+}
+
+static PyObject *
+compare_chararrays(PyObject *dummy, PyObject *args, PyObject *kwds)
+{
+ PyObject *array;
+ PyObject *other;
+ PyArrayObject *newarr, *newoth;
+ int cmp_op;
+ Bool rstrip;
+ char *cmp_str;
+ Py_ssize_t strlen;
+ PyObject *res=NULL;
+ static char msg[] = \
+ "comparision must be '==', '!=', '<', '>', '<=', '>='";
+
+ static char *kwlist[] = {"a1", "a2", "cmp", "rstrip", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "OOs#O&", kwlist,
+ &array, &other,
+ &cmp_str, &strlen,
+ PyArray_BoolConverter, &rstrip))
+ return NULL;
+
+ if (strlen < 1 || strlen > 2) goto err;
+ if (strlen > 1) {
+ if (cmp_str[1] != '=') goto err;
+ if (cmp_str[0] == '=') cmp_op = Py_EQ;
+ else if (cmp_str[0] == '!') cmp_op = Py_NE;
+ else if (cmp_str[0] == '<') cmp_op = Py_LE;
+ else if (cmp_str[0] == '>') cmp_op = Py_GE;
+ else goto err;
+ }
+ else {
+ if (cmp_str[0] == '<') cmp_op = Py_LT;
+ else if (cmp_str[0] == '>') cmp_op = Py_GT;
+ else goto err;
+ }
+
+ newarr = (PyArrayObject *)PyArray_FROM_O(array);
+ if (newarr == NULL) return NULL;
+ newoth = (PyArrayObject *)PyArray_FROM_O(other);
+ if (newoth == NULL) {
+ Py_DECREF(newarr);
+ return NULL;
+ }
+
+ if (PyArray_ISSTRING(newarr) && PyArray_ISSTRING(newoth)) {
+ res = _strings_richcompare(newarr, newoth, cmp_op, rstrip != 0);
+ }
+ else {
+ PyErr_SetString(PyExc_TypeError,
+ "comparison of non-string arrays");
+ }
+
+ Py_DECREF(newarr);
+ Py_DECREF(newoth);
+ return res;
+
+ err:
+ PyErr_SetString(PyExc_ValueError, msg);
+ return NULL;
+}
+
+
+#ifndef NPY_NO_SIGNAL
+
+SIGJMP_BUF _NPY_SIGINT_BUF;
+
+/*MULTIARRAY_API
+*/
+static void
+_PyArray_SigintHandler(int signum)
+{
+ PyOS_setsig(signum, SIG_IGN);
+ SIGLONGJMP(_NPY_SIGINT_BUF, signum);
+}
+
+/*MULTIARRAY_API
+*/
+static void*
+_PyArray_GetSigintBuf(void)
+{
+ return (void *)&_NPY_SIGINT_BUF;
+}
+
+#else
+
+static void
+_PyArray_SigintHandler(int signum)
+{
+ return;
+}
+
+static void*
+_PyArray_GetSigintBuf(void)
+{
+ return NULL;
+}
+
+#endif
+
+
+static PyObject *
+test_interrupt(PyObject *self, PyObject *args)
+{
+ int kind=0;
+ int a = 0;
+
+ if (!PyArg_ParseTuple(args, "|i", &kind)) return NULL;
+
+ if (kind) {
+ Py_BEGIN_ALLOW_THREADS
+ while (a>=0) {
+ if ((a % 1000 == 0) &&
+ PyOS_InterruptOccurred()) break;
+ a+=1;
+ }
+ Py_END_ALLOW_THREADS
+ }
+ else {
+
+ NPY_SIGINT_ON
+
+ while(a>=0) {
+ a += 1;
+ }
+
+ NPY_SIGINT_OFF
+ }
+
+ return PyInt_FromLong(a);
+}
+
+static struct PyMethodDef array_module_methods[] = {
+ {"_get_ndarray_c_version", (PyCFunction)array__get_ndarray_c_version,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"_reconstruct", (PyCFunction)array__reconstruct,
+ METH_VARARGS, NULL},
+ {"set_string_function", (PyCFunction)array_set_string_function,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"set_numeric_ops", (PyCFunction)array_set_ops_function,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"set_typeDict", (PyCFunction)array_set_typeDict,
+ METH_VARARGS, NULL},
+
+ {"array", (PyCFunction)_array_fromobject,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"arange", (PyCFunction)array_arange,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"zeros", (PyCFunction)array_zeros,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"empty", (PyCFunction)array_empty,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"scalar", (PyCFunction)array_scalar,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"where", (PyCFunction)array_where,
+ METH_VARARGS, NULL},
+ {"lexsort", (PyCFunction)array_lexsort,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"putmask", (PyCFunction)array_putmask,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"fromstring",(PyCFunction)array_fromstring,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"fromiter",(PyCFunction)array_fromiter,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"concatenate", (PyCFunction)array_concatenate,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"inner", (PyCFunction)array_innerproduct,
+ METH_VARARGS, NULL},
+ {"dot", (PyCFunction)array_matrixproduct,
+ METH_VARARGS, NULL},
+ {"_fastCopyAndTranspose", (PyCFunction)array_fastCopyAndTranspose,
+ METH_VARARGS, NULL},
+ {"correlate", (PyCFunction)array_correlate,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"frombuffer", (PyCFunction)array_frombuffer,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"fromfile", (PyCFunction)array_fromfile,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"can_cast", (PyCFunction)array_can_cast_safely,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"newbuffer", (PyCFunction)new_buffer,
+ METH_VARARGS, NULL},
+ {"getbuffer", (PyCFunction)buffer_buffer,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"int_asbuffer", (PyCFunction)as_buffer,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"format_longfloat", (PyCFunction)format_longfloat,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"compare_chararrays", (PyCFunction)compare_chararrays,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"test_interrupt", (PyCFunction)test_interrupt,
+ METH_VARARGS, NULL},
+ {NULL, NULL, 0} /* sentinel */
+};
+
+#include "__multiarray_api.c"
+
+/* Establish scalar-type hierarchy */
+
+/* For dual inheritance we need to make sure that the objects being
+ inherited from have the tp->mro object initialized. This is
+ not necessarily true for the basic type objects of Python (it is
+ checked for single inheritance but not dual in PyType_Ready).
+
+ Thus, we call PyType_Ready on the standard Python Types, here.
+*/
+static int
+setup_scalartypes(PyObject *dict)
+{
+
+ initialize_numeric_types();
+
+ if (PyType_Ready(&PyBool_Type) < 0) return -1;
+ if (PyType_Ready(&PyInt_Type) < 0) return -1;
+ if (PyType_Ready(&PyFloat_Type) < 0) return -1;
+ if (PyType_Ready(&PyComplex_Type) < 0) return -1;
+ if (PyType_Ready(&PyString_Type) < 0) return -1;
+ if (PyType_Ready(&PyUnicode_Type) < 0) return -1;
+
+#define SINGLE_INHERIT(child, parent) \
+ Py##child##ArrType_Type.tp_base = &Py##parent##ArrType_Type; \
+ if (PyType_Ready(&Py##child##ArrType_Type) < 0) { \
+ PyErr_Print(); \
+ PyErr_Format(PyExc_SystemError, \
+ "could not initialize Py%sArrType_Type", \
+ #child); \
+ return -1; \
+ }
+
+ if (PyType_Ready(&PyGenericArrType_Type) < 0)
+ return -1;
+
+ SINGLE_INHERIT(Number, Generic);
+ SINGLE_INHERIT(Integer, Number);
+ SINGLE_INHERIT(Inexact, Number);
+ SINGLE_INHERIT(SignedInteger, Integer);
+ SINGLE_INHERIT(UnsignedInteger, Integer);
+ SINGLE_INHERIT(Floating, Inexact);
+ SINGLE_INHERIT(ComplexFloating, Inexact);
+ SINGLE_INHERIT(Flexible, Generic);
+ SINGLE_INHERIT(Character, Flexible);
+
+#define DUAL_INHERIT(child, parent1, parent2) \
+ Py##child##ArrType_Type.tp_base = &Py##parent2##ArrType_Type; \
+ Py##child##ArrType_Type.tp_bases = \
+ Py_BuildValue("(OO)", &Py##parent2##ArrType_Type, \
+ &Py##parent1##_Type); \
+ if (PyType_Ready(&Py##child##ArrType_Type) < 0) { \
+ PyErr_Print(); \
+ PyErr_Format(PyExc_SystemError, \
+ "could not initialize Py%sArrType_Type", \
+ #child); \
+ return -1; \
+ }\
+ Py##child##ArrType_Type.tp_hash = Py##parent1##_Type.tp_hash;
+
+#define DUAL_INHERIT2(child, parent1, parent2) \
+ Py##child##ArrType_Type.tp_base = &Py##parent1##_Type; \
+ Py##child##ArrType_Type.tp_bases = \
+ Py_BuildValue("(OO)", &Py##parent1##_Type, \
+ &Py##parent2##ArrType_Type); \
+ Py##child##ArrType_Type.tp_richcompare = \
+ Py##parent1##_Type.tp_richcompare; \
+ Py##child##ArrType_Type.tp_compare = \
+ Py##parent1##_Type.tp_compare; \
+ Py##child##ArrType_Type.tp_hash = Py##parent1##_Type.tp_hash; \
+ if (PyType_Ready(&Py##child##ArrType_Type) < 0) { \
+ PyErr_Print(); \
+ PyErr_Format(PyExc_SystemError, \
+ "could not initialize Py%sArrType_Type", \
+ #child); \
+ return -1; \
+ }
+
+ SINGLE_INHERIT(Bool, Generic);
+ SINGLE_INHERIT(Byte, SignedInteger);
+ SINGLE_INHERIT(Short, SignedInteger);
+#if SIZEOF_INT == SIZEOF_LONG
+ DUAL_INHERIT(Int, Int, SignedInteger);
+#else
+ SINGLE_INHERIT(Int, SignedInteger);
+#endif
+ DUAL_INHERIT(Long, Int, SignedInteger);
+#if SIZEOF_LONGLONG == SIZEOF_LONG
+ DUAL_INHERIT(LongLong, Int, SignedInteger);
+#else
+ SINGLE_INHERIT(LongLong, SignedInteger);
+#endif
+
+ /* fprintf(stderr, "tp_free = %p, PyObject_Del = %p, int_tp_free = %p, base.tp_free = %p\n", PyIntArrType_Type.tp_free, PyObject_Del, PyInt_Type.tp_free, PySignedIntegerArrType_Type.tp_free);
+ */
+ SINGLE_INHERIT(UByte, UnsignedInteger);
+ SINGLE_INHERIT(UShort, UnsignedInteger);
+ SINGLE_INHERIT(UInt, UnsignedInteger);
+ SINGLE_INHERIT(ULong, UnsignedInteger);
+ SINGLE_INHERIT(ULongLong, UnsignedInteger);
+
+ SINGLE_INHERIT(Float, Floating);
+ DUAL_INHERIT(Double, Float, Floating);
+ SINGLE_INHERIT(LongDouble, Floating);
+
+ SINGLE_INHERIT(CFloat, ComplexFloating);
+ DUAL_INHERIT(CDouble, Complex, ComplexFloating);
+ SINGLE_INHERIT(CLongDouble, ComplexFloating);
+
+ DUAL_INHERIT2(String, String, Character);
+ DUAL_INHERIT2(Unicode, Unicode, Character);
+
+ SINGLE_INHERIT(Void, Flexible);
+
+ SINGLE_INHERIT(Object, Generic);
+
+ return 0;
+
+#undef SINGLE_INHERIT
+#undef DUAL_INHERIT
+
+ /* Clean up string and unicode array types so they act more like
+ strings -- get their tables from the standard types.
+ */
+}
+
+/* place a flag dictionary in d */
+
+static void
+set_flaginfo(PyObject *d)
+{
+ PyObject *s;
+ PyObject *newd;
+
+ newd = PyDict_New();
+
+#define _addnew(val, one) \
+ PyDict_SetItemString(newd, #val, s=PyInt_FromLong(val)); \
+ Py_DECREF(s); \
+ PyDict_SetItemString(newd, #one, s=PyInt_FromLong(val)); \
+ Py_DECREF(s)
+
+#define _addone(val) \
+ PyDict_SetItemString(newd, #val, s=PyInt_FromLong(val)); \
+ Py_DECREF(s)
+
+ _addnew(OWNDATA, O);
+ _addnew(FORTRAN, F);
+ _addnew(CONTIGUOUS, C);
+ _addnew(ALIGNED, A);
+ _addnew(UPDATEIFCOPY, U);
+ _addnew(WRITEABLE, W);
+ _addone(C_CONTIGUOUS);
+ _addone(F_CONTIGUOUS);
+
+#undef _addone
+#undef _addnew
+
+ PyDict_SetItemString(d, "_flagdict", newd);
+ Py_DECREF(newd);
+ return;
+}
+
+
+/* Initialization function for the module */
+
+PyMODINIT_FUNC initmultiarray(void) {
+ PyObject *m, *d, *s;
+ PyObject *c_api;
+
+ /* Create the module and add the functions */
+ m = Py_InitModule("multiarray", array_module_methods);
+ if (!m) goto err;
+
+ /* Add some symbolic constants to the module */
+ d = PyModule_GetDict(m);
+ if (!d) goto err;
+
+ PyArray_Type.tp_free = _pya_free;
+ if (PyType_Ready(&PyArray_Type) < 0)
+ return;
+
+ if (setup_scalartypes(d) < 0) goto err;
+
+ PyArrayIter_Type.tp_iter = PyObject_SelfIter;
+ PyArrayMultiIter_Type.tp_iter = PyObject_SelfIter;
+ PyArrayMultiIter_Type.tp_free = _pya_free;
+ if (PyType_Ready(&PyArrayIter_Type) < 0)
+ return;
+
+ if (PyType_Ready(&PyArrayMapIter_Type) < 0)
+ return;
+
+ if (PyType_Ready(&PyArrayMultiIter_Type) < 0)
+ return;
+
+ PyArrayDescr_Type.tp_hash = (hashfunc)_Py_HashPointer;
+ if (PyType_Ready(&PyArrayDescr_Type) < 0)
+ return;
+
+ if (PyType_Ready(&PyArrayFlags_Type) < 0)
+ return;
+
+ c_api = PyCObject_FromVoidPtr((void *)PyArray_API, NULL);
+ PyDict_SetItemString(d, "_ARRAY_API", c_api);
+ Py_DECREF(c_api);
+ if (PyErr_Occurred()) goto err;
+
+ MultiArrayError = PyString_FromString ("multiarray.error");
+ PyDict_SetItemString (d, "error", MultiArrayError);
+
+ s = PyString_FromString("3.0");
+ PyDict_SetItemString(d, "__version__", s);
+ Py_DECREF(s);
+
+#define ADDCONST(NAME) \
+ s = PyInt_FromLong(NPY_##NAME); \
+ PyDict_SetItemString(d, #NAME, s); \
+ Py_DECREF(s)
+
+
+ ADDCONST(ALLOW_THREADS);
+ ADDCONST(BUFSIZE);
+ ADDCONST(CLIP);
+
+ ADDCONST(ITEM_HASOBJECT);
+ ADDCONST(LIST_PICKLE);
+ ADDCONST(ITEM_IS_POINTER);
+ ADDCONST(NEEDS_INIT);
+ ADDCONST(NEEDS_PYAPI);
+ ADDCONST(USE_GETITEM);
+ ADDCONST(USE_SETITEM);
+
+ ADDCONST(RAISE);
+ ADDCONST(WRAP);
+ ADDCONST(MAXDIMS);
+#undef ADDCONST
+
+ Py_INCREF(&PyArray_Type);
+ PyDict_SetItemString(d, "ndarray", (PyObject *)&PyArray_Type);
+ Py_INCREF(&PyArrayIter_Type);
+ PyDict_SetItemString(d, "flatiter", (PyObject *)&PyArrayIter_Type);
+ Py_INCREF(&PyArrayMultiIter_Type);
+ PyDict_SetItemString(d, "broadcast",
+ (PyObject *)&PyArrayMultiIter_Type);
+ Py_INCREF(&PyArrayDescr_Type);
+ PyDict_SetItemString(d, "dtype", (PyObject *)&PyArrayDescr_Type);
+
+ Py_INCREF(&PyArrayFlags_Type);
+ PyDict_SetItemString(d, "flagsobj", (PyObject *)&PyArrayFlags_Type);
+
+ set_flaginfo(d);
+
+ if (set_typeinfo(d) != 0) goto err;
+ return;
+
+ err:
+ if (!PyErr_Occurred()) {
+ PyErr_SetString(PyExc_RuntimeError,
+ "cannot load multiarray module.");
+ }
+ return;
+}
diff --git a/numpy/core/src/scalarmathmodule.c.src b/numpy/core/src/scalarmathmodule.c.src
new file mode 100644
index 000000000..00f7c6ed6
--- /dev/null
+++ b/numpy/core/src/scalarmathmodule.c.src
@@ -0,0 +1,1225 @@
+/* -*- c -*- */
+
+/* The purpose of this module is to add faster math for array scalars
+ that does not go through the ufunc machinery
+
+ but still supports error-modes.
+*/
+
+#include "Python.h"
+#include "numpy/noprefix.h"
+#include "numpy/ufuncobject.h"
+#include "numpy/arrayscalars.h"
+
+
+/** numarray adapted routines.... **/
+
+static int ulonglong_overflow(ulonglong a, ulonglong b)
+{
+ ulonglong ah, al, bh, bl, w, x, y, z;
+
+#if SIZEOF_LONGLONG == 64
+ ah = (a >> 32);
+ al = (a & 0xFFFFFFFFL);
+ bh = (b >> 32);
+ bl = (b & 0xFFFFFFFFL);
+#elif SIZEOF_LONGLONG == 128
+ ah = (a >> 64);
+ al = (a & 0xFFFFFFFFFFFFFFFFL);
+ bh = (b >> 64);
+ bl = (b & 0xFFFFFFFFFFFFFFFFL);
+#else
+ ah = al = bh = bl = 0;
+#endif
+
+ /* 128-bit product: z*2**64 + (x+y)*2**32 + w */
+ w = al*bl;
+ x = bh*al;
+ y = ah*bl;
+ z = ah*bh;
+
+ /* *c = ((x + y)<<32) + w; */
+#if SIZEOF_LONGLONG == 64
+ return z || (x>>32) || (y>>32) ||
+ (((x & 0xFFFFFFFFL) + (y & 0xFFFFFFFFL) + (w >> 32)) >> 32);
+#elif SIZEOF_LONGLONG == 128
+ return z || (x>>64) || (y>>64) ||
+ (((x & 0xFFFFFFFFFFFFFFFFL) + (y & 0xFFFFFFFFFFFFFFFFL) + (w >> 64)) >> 64);
+#else
+ return 0;
+#endif
+
+}
+
+static int slonglong_overflow(longlong a0, longlong b0)
+{
+ ulonglong a, b;
+ ulonglong ah, al, bh, bl, w, x, y, z;
+
+ /* Convert to non-negative quantities */
+ if (a0 < 0) { a = -a0; } else { a = a0; }
+ if (b0 < 0) { b = -b0; } else { b = b0; }
+
+
+#if SIZEOF_LONGLONG == 64
+ ah = (a >> 32);
+ al = (a & 0xFFFFFFFFL);
+ bh = (b >> 32);
+ bl = (b & 0xFFFFFFFFL);
+#elif SIZEOF_LONGLONG == 128
+ ah = (a >> 64);
+ al = (a & 0xFFFFFFFFFFFFFFFFL);
+ bh = (b >> 64);
+ bl = (b & 0xFFFFFFFFFFFFFFFFL);
+#else
+ ah = al = bh = bl = 0;
+#endif
+
+ w = al*bl;
+ x = bh*al;
+ y = ah*bl;
+ z = ah*bh;
+
+ /*
+ ulonglong c = ((x + y)<<32) + w;
+ if ((a0 < 0) ^ (b0 < 0))
+ *c = -c;
+ else
+ *c = c
+ */
+
+#if SIZEOF_LONGLONG == 64
+ return z || (x>>31) || (y>>31) ||
+ (((x & 0xFFFFFFFFL) + (y & 0xFFFFFFFFL) + (w >> 32)) >> 31);
+#elif SIZEOF_LONGLONG == 128
+ return z || (x>>63) || (y>>63) ||
+ (((x & 0xFFFFFFFFFFFFFFFFL) + (y & 0xFFFFFFFFFFFFFFFFL) + (w >> 64)) >> 63);
+#else
+ return 0;
+#endif
+}
+/** end direct numarray code **/
+
+
+/* Basic operations:
+
+BINARY:
+
+add, subtract, multiply, divide, remainder, divmod, power,
+floor_divide, true_divide
+
+lshift, rshift, and, or, xor (integers only)
+
+UNARY:
+
+negative, positive, absolute, nonzero, invert, int, long, float, oct, hex
+
+*/
+
+/**begin repeat
+ #name=byte,short,int,long,longlong#
+**/
+static void
+@name@_ctype_add(@name@ a, @name@ b, @name@ *out) {
+ *out = a + b;
+ if ((*out^a) >= 0 || (*out^b) >= 0)
+ return;
+ generate_overflow_error();
+ return;
+}
+static void
+@name@_ctype_subtract(@name@ a, @name@ b, @name@ *out) {
+ *out = a - b;
+ if ((*out^a) >= 0 || (*out^~b) >= 0)
+ return;
+ generate_overflow_error();
+ return;
+}
+/**end repeat**/
+/**begin repeat
+ #name=ubyte,ushort,uint,ulong,ulonglong#
+**/
+static void
+@name@_ctype_add(@name@ a, @name@ b, @name@ *out) {
+ *out = a + b;
+ if (*out >= a && *out >= b)
+ return;
+ generate_overflow_error();
+ return;
+}
+static void
+@name@_ctype_subtract(@name@ a, @name@ b, @name@ *out) {
+ *out = a - b;
+ if (a >= b) return;
+ generate_overflow_error();
+ return;
+}
+/**end repeat**/
+
+#ifndef SIZEOF_BYTE
+#define SIZEOF_BYTE 1
+#endif
+
+/**begin repeat
+ #name=byte,ubyte,short,ushort,int,uint,long,ulong#
+ #big=(int,uint)*2,(longlong,ulonglong)*2#
+ #NAME=BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG#
+ #SIZENAME=BYTE*2,SHORT*2,INT*2,LONG*2#
+ #SIZE=INT*4,LONGLONG*4#
+ #neg=(1,0)*4#
+**/
+#if SIZEOF_@SIZE@ > SIZEOF_@SIZENAME@
+static void
+@name@_ctype_multiply(@name@ a, @name@ b, @name@ *out) {
+ @big@ temp;
+ temp = ((@big@) a) * ((@big@) b);
+ *out = (@name@) temp;
+#if @neg@
+ if (temp > MAX_@NAME@ || temp < MIN_@NAME@)
+#else
+ if (temp > MAX_@NAME@)
+#endif
+ generate_overflow_error();
+ return;
+}
+#endif
+/**end repeat**/
+
+/**begin repeat
+ #name=int,uint,long,ulong,longlong,ulonglong#
+ #SIZE=INT*2,LONG*2,LONGLONG*2#
+ #char=(s,u)*3#
+**/
+#if SIZEOF_LONGLONG == SIZEOF_@SIZE@
+static void
+@name@_ctype_multiply(@name@ a, @name@ b, @name@ *out) {
+ *out = a * b;
+ if (@char@longlong_overflow(a, b))
+ generate_overflow_error();
+ return;
+}
+#endif
+/**end repeat**/
+
+/**begin repeat
+ #name=byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong#
+ #neg=(1,0)*5#
+**/
+static void
+@name@_ctype_divide(@name@ a, @name@ b, @name@ *out) {
+ if (b == 0) {
+ generate_divbyzero_error();
+ *out = 0;
+ }
+#if @neg@
+ else if (b == -1 && a < 0 && a == -a) {
+ generate_overflow_error();
+ *out = a / b;
+ }
+#endif
+ else {
+#if @neg@
+ @name@ tmp;
+ tmp = a / b;
+ if (((a > 0) != (b > 0)) && (a % b != 0)) tmp--;
+ *out = tmp;
+#else
+ *out = a / b;
+#endif
+ }
+}
+#define @name@_ctype_floor_divide @name@_ctype_divide
+static void
+@name@_ctype_remainder(@name@ a, @name@ b, @name@ *out) {
+ if (a == 0 || b == 0) {
+ if (b == 0) generate_divbyzero_error();
+ *out = 0;
+ return;
+ }
+#if @neg@
+ else if ((a > 0) == (b > 0)) {
+ *out = a % b;
+ }
+ else { /* handled like Python does */
+ *out = a % b;
+ if (*out) *out += b;
+ }
+#else
+ *out = a % b;
+#endif
+}
+/**end repeat**/
+
+/**begin repeat
+ #name=byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong#
+ #otyp=float*4, double*6#
+**/
+#define @name@_ctype_true_divide(a, b, out) \
+ *(out) = ((@otyp@) (a)) / ((@otyp@) (b));
+/**end repeat**/
+
+/* b will always be positive in this call */
+/**begin repeat
+ #name=byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong#
+ #upc=BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG#
+**/
+static void
+@name@_ctype_power(@name@ a, @name@ b, @name@ *out) {
+ @name@ temp, ix, mult;
+ /* code from Python's intobject.c, with overflow checking removed. */
+ temp = a;
+ ix = 1;
+ while (b > 0) {
+ if (b & 1) {
+ @name@_ctype_multiply(ix, temp, &mult);
+ ix = mult;
+ if (temp == 0)
+ break; /* Avoid ix / 0 */
+ }
+ b >>= 1; /* Shift exponent down by 1 bit */
+ if (b==0) break;
+ /* Square the value of temp */
+ @name@_ctype_multiply(temp, temp, &mult);
+ temp = mult;
+ }
+ *out = ix;
+}
+/**end repeat**/
+
+
+
+/* QUESTION: Should we check for overflow / underflow in (l,r)shift? */
+
+/**begin repeat
+ #name=(byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong)*5#
+ #oper=and*10, xor*10, or*10, lshift*10, rshift*10#
+ #op=&*10, ^*10, |*10, <<*10, >>*10#
+**/
+#define @name@_ctype_@oper@(arg1, arg2, out) *(out) = (arg1) @op@ (arg2)
+/**end repeat**/
+
+/**begin repeat
+ #name=float, double, longdouble#
+**/
+static @name@ (*_basic_@name@_floor)(@name@);
+static @name@ (*_basic_@name@_sqrt)(@name@);
+static @name@ (*_basic_@name@_fmod)(@name@, @name@);
+#define @name@_ctype_add(a, b, outp) *(outp) = a + b
+#define @name@_ctype_subtract(a, b, outp) *(outp) = a - b
+#define @name@_ctype_multiply(a, b, outp) *(outp) = a * b
+#define @name@_ctype_divide(a, b, outp) *(outp) = a / b
+#define @name@_ctype_true_divide @name@_ctype_divide
+#define @name@_ctype_floor_divide(a, b, outp) \
+ *(outp) = _basic_@name@_floor((a) / (b))
+/**end repeat**/
+
+/**begin repeat
+ #name=cfloat, cdouble, clongdouble#
+ #rtype=float, double, longdouble#
+ #c=f,,l#
+**/
+#define @name@_ctype_add(a, b, outp) do{ \
+ (outp)->real = (a).real + (b).real; \
+ (outp)->imag = (a).imag + (b).imag; \
+ }while(0)
+#define @name@_ctype_subtract(a, b, outp) do{ \
+ (outp)->real = (a).real - (b).real; \
+ (outp)->imag = (a).imag - (b).imag; \
+ }while(0)
+#define @name@_ctype_multiply(a, b, outp) do{ \
+ (outp)->real = (a).real * (b).real - (a).imag * (b).imag; \
+ (outp)->imag = (a).real * (b).imag + (a).imag * (b).real; \
+ }while(0)
+#define @name@_ctype_divide(a, b, outp) do{ \
+ @rtype@ d = (b).real*(b).real + (b).imag*(b).imag; \
+ (outp)->real = ((a).real*(b).real + (a).imag*(b).imag)/d; \
+ (outp)->imag = ((a).imag*(b).real - (a).real*(b).imag)/d; \
+ }while(0)
+#define @name@_ctype_true_divide @name@_ctype_divide
+#define @name@_ctype_floor_divide(a, b, outp) do { \
+ (outp)->real = _basic_@rtype@_floor \
+ (((a).real*(b).real + (a).imag*(b).imag) / \
+ ((b).real*(b).real + (b).imag*(b).imag)); \
+ (outp)->imag = 0; \
+ }while(0)
+/**end repeat**/
+
+/**begin repeat
+ #name=float,double,longdouble#
+**/
+static void
+@name@_ctype_remainder(@name@ a, @name@ b, @name@ *out) {
+ @name@ mod;
+ mod = _basic_@name@_fmod(a, b);
+ if (mod && (((b < 0) != (mod < 0)))) mod += b;
+ *out = mod;
+}
+/**end repeat**/
+
+
+
+/**begin repeat
+ #name=byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong,float,double,longdouble,cfloat,cdouble,clongdouble#
+**/
+#define @name@_ctype_divmod(a, b, out, out2) { \
+ @name@_ctype_floor_divide(a, b, out); \
+ @name@_ctype_remainder(a, b, out2); \
+ }
+/**end repeat**/
+
+/**begin repeat
+ #name= float, double, longdouble#
+**/
+static @name@ (*_basic_@name@_pow)(@name@ a, @name@ b);
+static void
+@name@_ctype_power(@name@ a, @name@ b, @name@ *out) {
+ *out = _basic_@name@_pow(a, b);
+}
+/**end repeat**/
+
+/**begin repeat
+ #name=byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble#
+ #uns=(1,0)*5,0*3#
+**/
+static void
+@name@_ctype_negative(@name@ a, @name@ *out)
+{
+#if @uns@
+ generate_overflow_error();
+#endif
+ *out = -a;
+}
+/**end repeat**/
+
+
+/**begin repeat
+ #name= cfloat, cdouble, clongdouble#
+**/
+static void
+@name@_ctype_negative(@name@ a, @name@ *out)
+{
+ out->real = -a.real;
+ out->imag = -a.imag;
+}
+/**end repeat**/
+
+/**begin repeat
+ #name=byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble#
+**/
+static void
+@name@_ctype_positive(@name@ a, @name@ *out)
+{
+ *out = a;
+}
+/**end repeat**/
+
+/* Get the nc_powf, nc_pow, and nc_powl functions from
+ the data area of the power ufunc in umathmodule.
+*/
+
+/**begin repeat
+ #name=cfloat, cdouble, clongdouble#
+**/
+static void
+@name@_ctype_positive(@name@ a, @name@ *out)
+{
+ out->real = a.real;
+ out->imag = a.imag;
+}
+static void (*_basic_@name@_pow)(@name@ *, @name@ *, @name@ *);
+static void
+@name@_ctype_power(@name@ a, @name@ b, @name@ *out)
+{
+ _basic_@name@_pow(&a, &b, out);
+}
+/**end repeat**/
+
+
+/**begin repeat
+ #name=ubyte, ushort, uint, ulong, ulonglong#
+**/
+#define @name@_ctype_absolute @name@_ctype_positive
+/**end repeat**/
+
+
+/**begin repeat
+ #name=byte, short, int, long, longlong, float, double, longdouble#
+**/
+static void
+@name@_ctype_absolute(@name@ a, @name@ *out)
+{
+ *out = (a < 0 ? -a : a);
+}
+/**end repeat**/
+
+/**begin repeat
+ #name= cfloat, cdouble, clongdouble#
+ #rname= float, double, longdouble#
+**/
+static void
+@name@_ctype_absolute(@name@ a, @rname@ *out)
+{
+ *out = _basic_@rname@_sqrt(a.real*a.real + a.imag*a.imag);
+}
+/**end repeat**/
+
+/**begin repeat
+ #name=byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong#
+**/
+#define @name@_ctype_invert(a, out) *(out) = ~a;
+/**end repeat**/
+
+/*** END OF BASIC CODE **/
+
+
+/* The general strategy for commutative binary operators is to
+
+1) Convert the types to the common type if both are scalars (0 return)
+2) If both are not scalars use ufunc machinery (-2 return)
+3) If both are scalars but cannot be cast to the right type
+return NotImplmented (-1 return)
+
+4) Perform the function on the C-type.
+5) If an error condition occurred, check to see
+what the current error-handling is and handle the error.
+
+6) Construct and return the output scalar.
+*/
+
+
+/**begin repeat
+ #name=byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong,float,double,longdouble,cfloat,cdouble,clongdouble#
+ #Name=Byte, UByte, Short, UShort, Int, UInt, Long, ULong, LongLong, ULongLong, Float, Double, LongDouble, CFloat, CDouble, CLongDouble#
+ #NAME=BYTE, UBYTE, SHORT, USHORT, INT, UINT, LONG, ULONG, LONGLONG, ULONGLONG, FLOAT, DOUBLE, LONGDOUBLE, CFLOAT, CDOUBLE, CLONGDOUBLE#
+**/
+
+static int
+_@name@_convert_to_ctype(PyObject *a, @name@ *arg1)
+{
+ PyObject *temp;
+
+ if (PyArray_IsScalar(a, @Name@)) {
+ *arg1 = PyArrayScalar_VAL(a, @Name@);
+ return 0;
+ }
+ else if (PyArray_IsScalar(a, Generic)) {
+ PyArray_Descr *descr1;
+ int ret;
+ if (!PyArray_IsScalar(a, Number)) return -1;
+ descr1 = PyArray_DescrFromTypeObject((PyObject *)(a->ob_type));
+ if (PyArray_CanCastSafely(descr1->type_num, PyArray_@NAME@)) {
+ PyArray_CastScalarDirect(a, descr1, arg1, PyArray_@NAME@);
+ ret = 0;
+ }
+ else ret = -1;
+ Py_DECREF(descr1);
+ return ret;
+ }
+ else if ((temp = PyArray_ScalarFromObject(a)) != NULL) {
+ int retval;
+ retval = _@name@_convert_to_ctype(temp, arg1);
+ Py_DECREF(temp);
+ return retval;
+ }
+ return -2;
+}
+
+static int
+_@name@_convert2_to_ctypes(PyObject *a, @name@ *arg1,
+ PyObject *b, @name@ *arg2)
+{
+ int ret;
+ ret = _@name@_convert_to_ctype(a, arg1);
+ if (ret < 0) return ret;
+ ret = _@name@_convert_to_ctype(b, arg2);
+ if (ret < 0) return ret;
+ return 0;
+}
+
+/**end repeat**/
+
+/**begin repeat
+ #name=(byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong)*13, (float, double, longdouble, cfloat, cdouble, clongdouble)*6, (float, double, longdouble)*2#
+ #Name=(Byte, UByte, Short, UShort, Int, UInt, Long, ULong, LongLong, ULongLong)*13, (Float, Double, LongDouble, CFloat, CDouble, CLongDouble)*6, (Float, Double, LongDouble)*2#
+ #oper=add*10, subtract*10, multiply*10, divide*10, remainder*10, divmod*10, floor_divide*10, lshift*10, rshift*10, and*10, or*10, xor*10, true_divide*10, add*6, subtract*6, multiply*6, divide*6, floor_divide*6, true_divide*6, divmod*3, remainder*3#
+ #fperr=1*70,0*50,1*52#
+ #twoout=0*50,1*10,0*106,1*3,0*3#
+ #otyp=(byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong)*12, float*4, double*6, (float, double, longdouble, cfloat, cdouble, clongdouble)*6, (float, double, longdouble)*2#
+ #OName=(Byte, UByte, Short, UShort, Int, UInt, Long, ULong, LongLong, ULongLong)*12, Float*4, Double*6, (Float, Double, LongDouble, CFloat, CDouble, CLongDouble)*6, (Float, Double, LongDouble)*2#
+**/
+
+static PyObject *
+@name@_@oper@(PyObject *a, PyObject *b)
+{
+ PyObject *ret;
+ @name@ arg1, arg2;
+ @otyp@ out;
+#if @twoout@
+ @otyp@ out2;
+ PyObject *obj;
+#endif
+
+#if @fperr@
+ int retstatus;
+ int first;
+#endif
+
+ switch(_@name@_convert2_to_ctypes(a, &arg1, b, &arg2)) {
+ case 0:
+ break;
+ case -1: /* one of them can't be cast safely
+ must be mixed-types*/
+ return PyArray_Type.tp_as_number->nb_@oper@(a,b);
+ case -2: /* use default handling */
+ if (PyErr_Occurred()) return NULL;
+ return PyGenericArrType_Type.tp_as_number->nb_@oper@(a,b);
+ }
+
+#if @fperr@
+ PyUFunc_clearfperr();
+#endif
+
+ /* here we do the actual calculation with arg1 and arg2 */
+ /* as a function call. */
+#if @twoout@
+ @name@_ctype_@oper@(arg1, arg2, &out, &out2);
+#else
+ @name@_ctype_@oper@(arg1, arg2, &out);
+#endif
+
+#if @fperr@
+ /* Check status flag. If it is set, then look up what to do */
+ retstatus = PyUFunc_getfperr();
+ if (retstatus) {
+ int bufsize, errmask;
+ PyObject *errobj;
+ if (PyUFunc_GetPyValues("@name@_scalars", &bufsize, &errmask,
+ &errobj) < 0)
+ return NULL;
+ first = 1;
+ if (PyUFunc_handlefperr(errmask, errobj, retstatus, &first))
+ return NULL;
+ }
+#endif
+
+
+#if @twoout@
+ ret = PyTuple_New(2);
+ if (ret==NULL) return NULL;
+ obj = PyArrayScalar_New(@OName@);
+ if (obj == NULL) {Py_DECREF(ret); return NULL;}
+ PyArrayScalar_ASSIGN(obj, @OName@, out);
+ PyTuple_SET_ITEM(ret, 0, obj);
+ obj = PyArrayScalar_New(@OName@);
+ if (obj == NULL) {Py_DECREF(ret); return NULL;}
+ PyArrayScalar_ASSIGN(obj, @OName@, out2);
+ PyTuple_SET_ITEM(ret, 1, obj);
+#else
+ ret = PyArrayScalar_New(@OName@);
+ if (ret==NULL) return NULL;
+ PyArrayScalar_ASSIGN(ret, @OName@, out);
+#endif
+ return ret;
+}
+/**end repeat**/
+
+/**begin repeat
+ #name=byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong,float, double, longdouble, cfloat, cdouble, clongdouble#
+ #Name=Byte, UByte, Short, UShort, Int, UInt, Long, ULong, LongLong, ULongLong, Float, Double, LongDouble, CFloat, CDouble, CLongDouble#
+ #otyp=float*4, double*6, float, double, longdouble, cfloat, cdouble, clongdouble#
+ #OName=Float*4, Double*6, Float, Double, LongDouble, CFloat, CDouble, CLongDouble#
+ #isint=(1,0)*5,0*6#
+ #cmplx=0*13,1*3#
+**/
+
+static PyObject *
+@name@_power(PyObject *a, PyObject *b, PyObject *c)
+{
+ PyObject *ret;
+ @name@ arg1, arg2;
+ int retstatus;
+ int first;
+
+#if @cmplx@
+ @name@ out = {0,0};
+ @otyp@ out1;
+ out1.real = out.imag = 0;
+#else
+ @name@ out = 0;
+ @otyp@ out1=0;
+#endif
+
+ switch(_@name@_convert2_to_ctypes(a, &arg1, b, &arg2)) {
+ case 0:
+ break;
+ case -1: /* can't cast both safely
+ mixed-types? */
+ return PyArray_Type.tp_as_number->nb_power(a,b,NULL);
+ case -2: /* use default handling */
+ if (PyErr_Occurred()) return NULL;
+ return PyGenericArrType_Type.tp_as_number->nb_power(a,b,NULL);
+ }
+
+ PyUFunc_clearfperr();
+
+ /* here we do the actual calculation with arg1 and arg2 */
+ /* as a function call. */
+#if @cmplx@
+ if (arg2.real == 0 && arg1.real == 0) {
+ out1.real = out.real = 1;
+ out1.imag = out.imag = 0;
+ }
+#else
+ if (arg2 == 0) {
+ out1 = out = 1;
+ }
+#endif
+#if @isint@
+ else if (arg2 < 0) {
+ @name@_ctype_power(arg1, -arg2, &out);
+ out1 = (@otyp@) (1.0 / out);
+ }
+#endif
+ else {
+ @name@_ctype_power(arg1, arg2, &out);
+ }
+
+ /* Check status flag. If it is set, then look up what to do */
+ retstatus = PyUFunc_getfperr();
+ if (retstatus) {
+ int bufsize, errmask;
+ PyObject *errobj;
+ if (PyUFunc_GetPyValues("@name@_scalars", &bufsize, &errmask,
+ &errobj) < 0)
+ return NULL;
+ first = 1;
+ if (PyUFunc_handlefperr(errmask, errobj, retstatus, &first))
+ return NULL;
+ }
+
+#if @isint@
+ if (arg2 < 0) {
+ ret = PyArrayScalar_New(@OName@);
+ if (ret==NULL) return NULL;
+ PyArrayScalar_ASSIGN(ret, @OName@, out1);
+ }
+ else {
+ ret = PyArrayScalar_New(@Name@);
+ if (ret==NULL) return NULL;
+ PyArrayScalar_ASSIGN(ret, @Name@, out);
+ }
+#else
+ ret = PyArrayScalar_New(@Name@);
+ if (ret==NULL) return NULL;
+ PyArrayScalar_ASSIGN(ret, @Name@, out);
+#endif
+
+ return ret;
+}
+/**end repeat**/
+
+
+/**begin repeat
+#name=(cfloat,cdouble,clongdouble)*2#
+#oper=divmod*3,remainder*3#
+**/
+#define @name@_@oper@ NULL
+/**end repeat**/
+
+/**begin repeat
+ #name=(float,double,longdouble,cfloat,cdouble,clongdouble)*5#
+ #oper=lshift*6, rshift*6, and*6, or*6, xor*6#
+**/
+#define @name@_@oper@ NULL
+/**end repeat**/
+
+
+/**begin repeat
+ #name=(byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong,float,double,longdouble,cfloat,cdouble,clongdouble)*3, byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong#
+ #otyp=(byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong,float,double,longdouble,cfloat,cdouble,clongdouble)*2,byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong,float,double,longdouble,float,double,longdouble,byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong#
+ #OName=(Byte, UByte, Short, UShort, Int, UInt, Long, ULong, LongLong, ULongLong, Float, Double, LongDouble, CFloat, CDouble, CLongDouble)*2, Byte, UByte, Short, UShort, Int, UInt, Long, ULong, LongLong, ULongLong, Float, Double, LongDouble, Float, Double, LongDouble, Byte, UByte, Short, UShort, Int, UInt, Long, ULong, LongLong, ULongLong#
+ #oper=negative*16, positive*16, absolute*16, invert*10#
+**/
+static PyObject *
+@name@_@oper@(PyObject *a)
+{
+ @name@ arg1;
+ @otyp@ out;
+ PyObject *ret;
+
+ switch(_@name@_convert_to_ctype(a, &arg1)) {
+ case 0:
+ break;
+ case -1: /* can't cast both safely use different add function */
+ Py_INCREF(Py_NotImplemented);
+ return Py_NotImplemented;
+ case -2: /* use default handling */
+ if (PyErr_Occurred()) return NULL;
+ return PyGenericArrType_Type.tp_as_number->nb_@oper@(a);
+ }
+
+ /* here we do the actual calculation with arg1 and arg2 */
+ /* make it a function call. */
+
+ @name@_ctype_@oper@(arg1, &out);
+
+ ret = PyArrayScalar_New(@OName@);
+ PyArrayScalar_ASSIGN(ret, @OName@, out);
+
+ return ret;
+}
+/**end repeat**/
+
+/**begin repeat
+#name=float,double,longdouble,cfloat,cdouble,clongdouble#
+**/
+#define @name@_invert NULL
+/**end repeat**/
+
+/**begin repeat
+ #name=byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong,float,double,longdouble,cfloat,cdouble,clongdouble#
+ #simp=1*13,0*3#
+**/
+static int
+@name@_nonzero(PyObject *a)
+{
+ int ret;
+ @name@ arg1;
+
+ if (_@name@_convert_to_ctype(a, &arg1) < 0) {
+ if (PyErr_Occurred()) return -1;
+ return PyGenericArrType_Type.tp_as_number->nb_nonzero(a);
+ }
+
+ /* here we do the actual calculation with arg1 and arg2 */
+ /* make it a function call. */
+
+#if @simp@
+ ret = (arg1 != 0);
+#else
+ ret = ((arg1.real != 0) || (arg1.imag != 0));
+#endif
+
+ return ret;
+}
+/**end repeat**/
+
+/**begin repeat
+ #name=(byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong,float,double,longdouble,cfloat,cdouble,clongdouble)*3#
+ #Name=(Byte,UByte,Short,UShort,Int,UInt,Long,ULong,LongLong,ULongLong,Float,Double,LongDouble,CFloat,CDouble,CLongDouble)*3#
+ #cmplx=(,,,,,,,,,,,,,.real,.real,.real)*3#
+ #which=int*16,long*16,float*16#
+ #func=PyInt_FromLong*16,(PyLong_FromLongLong, PyLong_FromUnsignedLongLong)*5,PyLong_FromDouble*6,PyFloat_FromDouble*16#
+**/
+static PyObject *
+@name@_@which@(PyObject *obj)
+{
+ return @func@((PyArrayScalar_VAL(obj, @Name@))@cmplx@);
+}
+/**end repeat**/
+
+
+/**begin repeat
+ #name=(byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong,float,double,longdouble,cfloat,cdouble,clongdouble)*2#
+ #oper=oct*16, hex*16#
+ #kind=(int*5, long*5, int, long*2, int, long*2)*2#
+ #cap=(Int*5, Long*5, Int, Long*2, Int, Long*2)*2#
+**/
+static PyObject *
+@name@_@oper@(PyObject *obj)
+{
+ PyObject *pyint;
+ pyint = @name@_@kind@(obj);
+ if (pyint == NULL) return NULL;
+ return Py@cap@_Type.tp_as_number->nb_@oper@(pyint);
+}
+/**end repeat**/
+
+
+/**begin repeat
+ #oper=le,ge,lt,gt,eq,ne#
+ #op=<=,>=,<,>,==,!=#
+**/
+#define def_cmp_@oper@(arg1, arg2) (arg1 @op@ arg2)
+#define cmplx_cmp_@oper@(arg1, arg2) ((arg1.real == arg2.real) ? \
+ arg1.imag @op@ arg2.imag : \
+ arg1.real @op@ arg2.real)
+/**end repeat**/
+
+/**begin repeat
+ #name=byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong,float,double,longdouble,cfloat,cdouble,clongdouble#
+ #simp=def*13,cmplx*3#
+**/
+static PyObject*
+@name@_richcompare(PyObject *self, PyObject *other, int cmp_op)
+{
+ @name@ arg1, arg2;
+ int out=0;
+
+ switch(_@name@_convert2_to_ctypes(self, &arg1, other, &arg2)) {
+ case 0:
+ break;
+ case -1: /* can't cast both safely use different add function */
+ case -2: /* use ufunc */
+ if (PyErr_Occurred()) return NULL;
+ return PyGenericArrType_Type.tp_richcompare(self, other, cmp_op);
+ }
+
+ /* here we do the actual calculation with arg1 and arg2 */
+ switch (cmp_op) {
+ case Py_EQ:
+ out = @simp@_cmp_eq(arg1, arg2);
+ break;
+ case Py_NE:
+ out = @simp@_cmp_ne(arg1, arg2);
+ break;
+ case Py_LE:
+ out = @simp@_cmp_le(arg1, arg2);
+ break;
+ case Py_GE:
+ out = @simp@_cmp_ge(arg1, arg2);
+ break;
+ case Py_LT:
+ out = @simp@_cmp_lt(arg1, arg2);
+ break;
+ case Py_GT:
+ out = @simp@_cmp_gt(arg1, arg2);
+ break;
+ }
+
+ if (out) {
+ PyArrayScalar_RETURN_TRUE;
+ }
+ else {
+ PyArrayScalar_RETURN_FALSE;
+ }
+}
+/**end repeat**/
+
+
+/**begin repeat
+ #name=byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong,float,double,longdouble,cfloat,cdouble,clongdouble#
+**/
+static PyNumberMethods @name@_as_number = {
+ (binaryfunc)@name@_add, /*nb_add*/
+ (binaryfunc)@name@_subtract, /*nb_subtract*/
+ (binaryfunc)@name@_multiply, /*nb_multiply*/
+ (binaryfunc)@name@_divide, /*nb_divide*/
+ (binaryfunc)@name@_remainder, /*nb_remainder*/
+ (binaryfunc)@name@_divmod, /*nb_divmod*/
+ (ternaryfunc)@name@_power, /*nb_power*/
+ (unaryfunc)@name@_negative,
+ (unaryfunc)@name@_positive, /*nb_pos*/
+ (unaryfunc)@name@_absolute, /*nb_abs*/
+ (inquiry)@name@_nonzero, /*nb_nonzero*/
+ (unaryfunc)@name@_invert, /*nb_invert*/
+ (binaryfunc)@name@_lshift, /*nb_lshift*/
+ (binaryfunc)@name@_rshift, /*nb_rshift*/
+ (binaryfunc)@name@_and, /*nb_and*/
+ (binaryfunc)@name@_xor, /*nb_xor*/
+ (binaryfunc)@name@_or, /*nb_or*/
+ 0, /*nb_coerce*/
+ (unaryfunc)@name@_int, /*nb_int*/
+ (unaryfunc)@name@_long, /*nb_long*/
+ (unaryfunc)@name@_float, /*nb_float*/
+ (unaryfunc)@name@_oct, /*nb_oct*/
+ (unaryfunc)@name@_hex, /*nb_hex*/
+ 0, /*inplace_add*/
+ 0, /*inplace_subtract*/
+ 0, /*inplace_multiply*/
+ 0, /*inplace_divide*/
+ 0, /*inplace_remainder*/
+ 0, /*inplace_power*/
+ 0, /*inplace_lshift*/
+ 0, /*inplace_rshift*/
+ 0, /*inplace_and*/
+ 0, /*inplace_xor*/
+ 0, /*inplace_or*/
+ (binaryfunc)@name@_floor_divide, /*nb_floor_divide*/
+ (binaryfunc)@name@_true_divide, /*nb_true_divide*/
+ 0, /*nb_inplace_floor_divide*/
+ 0, /*nb_inplace_true_divide*/
+#if PY_VERSION_HEX >= 0x02050000
+ (unaryfunc)NULL, /*nb_index*/
+#endif
+};
+/**end repeat**/
+
+static void *saved_tables_arrtype[9];
+
+static void
+add_scalarmath(void)
+{
+ /**begin repeat
+ #name=byte,ubyte,short,ushort,int,uint,long,ulong,longlong,ulonglong,float,double,longdouble,cfloat,cdouble,clongdouble#
+ #NAME=Byte, UByte, Short, UShort, Int, UInt, Long, ULong, LongLong, ULongLong, Float, Double, LongDouble, CFloat, CDouble, CLongDouble#
+ **/
+#if PY_VERSION_HEX >= 0x02050000
+ @name@_as_number.nb_index = Py@NAME@ArrType_Type.tp_as_number->nb_index;
+#endif
+ Py@NAME@ArrType_Type.tp_as_number = &(@name@_as_number);
+ Py@NAME@ArrType_Type.tp_richcompare = @name@_richcompare;
+ /**end repeat**/
+
+ saved_tables_arrtype[0] = PyLongArrType_Type.tp_as_number;
+ saved_tables_arrtype[1] = PyLongArrType_Type.tp_compare;
+ saved_tables_arrtype[2] = PyLongArrType_Type.tp_richcompare;
+ saved_tables_arrtype[3] = PyDoubleArrType_Type.tp_as_number;
+ saved_tables_arrtype[4] = PyDoubleArrType_Type.tp_compare;
+ saved_tables_arrtype[5] = PyDoubleArrType_Type.tp_richcompare;
+ saved_tables_arrtype[6] = PyCDoubleArrType_Type.tp_as_number;
+ saved_tables_arrtype[7] = PyCDoubleArrType_Type.tp_compare;
+ saved_tables_arrtype[8] = PyCDoubleArrType_Type.tp_richcompare;
+}
+
+static int
+get_functions(void)
+{
+ PyObject *mm, *obj;
+ void **funcdata;
+ char *signatures;
+ int i, j;
+ int ret = -1;
+
+ /* Get the nc_pow functions */
+ /* Get the pow functions */
+ mm = PyImport_ImportModule("numpy.core.umath");
+ if (mm == NULL) return -1;
+
+ obj = PyObject_GetAttrString(mm, "power");
+ if (obj == NULL) goto fail;
+ funcdata = ((PyUFuncObject *)obj)->data;
+ signatures = ((PyUFuncObject *)obj)->types;
+
+ i = 0;
+ j = 0;
+ while(signatures[i] != PyArray_FLOAT) {i+=3; j++;}
+ _basic_float_pow = funcdata[j];
+ _basic_double_pow = funcdata[j+1];
+ _basic_longdouble_pow = funcdata[j+2];
+ _basic_cfloat_pow = funcdata[j+3];
+ _basic_cdouble_pow = funcdata[j+4];
+ _basic_clongdouble_pow = funcdata[j+5];
+ Py_DECREF(obj);
+
+ /* Get the floor functions */
+ obj = PyObject_GetAttrString(mm, "floor");
+ if (obj == NULL) goto fail;
+ funcdata = ((PyUFuncObject *)obj)->data;
+ signatures = ((PyUFuncObject *)obj)->types;
+ i = 0;
+ j = 0;
+ while(signatures[i] != PyArray_FLOAT) {i+=2; j++;}
+ _basic_float_floor = funcdata[j];
+ _basic_double_floor = funcdata[j+1];
+ _basic_longdouble_floor = funcdata[j+2];
+ Py_DECREF(obj);
+
+ /* Get the sqrt functions */
+ obj = PyObject_GetAttrString(mm, "sqrt");
+ if (obj == NULL) goto fail;
+ funcdata = ((PyUFuncObject *)obj)->data;
+ signatures = ((PyUFuncObject *)obj)->types;
+ i = 0;
+ j = 0;
+ while(signatures[i] != PyArray_FLOAT) {i+=2; j++;}
+ _basic_float_sqrt = funcdata[j];
+ _basic_double_sqrt = funcdata[j+1];
+ _basic_longdouble_sqrt = funcdata[j+2];
+ Py_DECREF(obj);
+
+ /* Get the fmod functions */
+ obj = PyObject_GetAttrString(mm, "fmod");
+ if (obj == NULL) goto fail;
+ funcdata = ((PyUFuncObject *)obj)->data;
+ signatures = ((PyUFuncObject *)obj)->types;
+ i = 0;
+ j = 0;
+ while(signatures[i] != PyArray_FLOAT) {i+=3; j++;}
+ _basic_float_fmod = funcdata[j];
+ _basic_double_fmod = funcdata[j+1];
+ _basic_longdouble_fmod = funcdata[j+2];
+ Py_DECREF(obj);
+ return
+
+ ret = 0;
+ fail:
+ Py_DECREF(mm);
+ return ret;
+}
+
+static void *saved_tables[9];
+
+char doc_alterpyscalars[] = "";
+
+static PyObject *
+alter_pyscalars(PyObject *dummy, PyObject *args)
+{
+ int n;
+ PyObject *obj;
+ n = PyTuple_GET_SIZE(args);
+ while(n--) {
+ obj = PyTuple_GET_ITEM(args, n);
+ if (obj == (PyObject *)(&PyInt_Type)) {
+ PyInt_Type.tp_as_number = PyLongArrType_Type.tp_as_number;
+ PyInt_Type.tp_compare = PyLongArrType_Type.tp_compare;
+ PyInt_Type.tp_richcompare = PyLongArrType_Type.tp_richcompare;
+ }
+ else if (obj == (PyObject *)(&PyFloat_Type)) {
+ PyFloat_Type.tp_as_number = PyDoubleArrType_Type.tp_as_number;
+ PyFloat_Type.tp_compare = PyDoubleArrType_Type.tp_compare;
+ PyFloat_Type.tp_richcompare = PyDoubleArrType_Type.tp_richcompare;
+ }
+ else if (obj == (PyObject *)(&PyComplex_Type)) {
+ PyComplex_Type.tp_as_number = PyCDoubleArrType_Type.tp_as_number;
+ PyComplex_Type.tp_compare = PyCDoubleArrType_Type.tp_compare;
+ PyComplex_Type.tp_richcompare = \
+ PyCDoubleArrType_Type.tp_richcompare;
+ }
+ else {
+ PyErr_SetString(PyExc_ValueError,
+ "arguments must be int, float, or complex");
+ return NULL;
+ }
+ }
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+char doc_restorepyscalars[] = "";
+static PyObject *
+restore_pyscalars(PyObject *dummy, PyObject *args)
+{
+ int n;
+ PyObject *obj;
+ n = PyTuple_GET_SIZE(args);
+ while(n--) {
+ obj = PyTuple_GET_ITEM(args, n);
+ if (obj == (PyObject *)(&PyInt_Type)) {
+ PyInt_Type.tp_as_number = saved_tables[0];
+ PyInt_Type.tp_compare = saved_tables[1];
+ PyInt_Type.tp_richcompare = saved_tables[2];
+ }
+ else if (obj == (PyObject *)(&PyFloat_Type)) {
+ PyFloat_Type.tp_as_number = saved_tables[3];
+ PyFloat_Type.tp_compare = saved_tables[4];
+ PyFloat_Type.tp_richcompare = saved_tables[5];
+ }
+ else if (obj == (PyObject *)(&PyComplex_Type)) {
+ PyComplex_Type.tp_as_number = saved_tables[6];
+ PyComplex_Type.tp_compare = saved_tables[7];
+ PyComplex_Type.tp_richcompare = saved_tables[8];
+ }
+ else {
+ PyErr_SetString(PyExc_ValueError,
+ "arguments must be int, float, or complex");
+ return NULL;
+ }
+ }
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+char doc_usepythonmath[] = "";
+static PyObject *
+use_pythonmath(PyObject *dummy, PyObject *args)
+{
+ int n;
+ PyObject *obj;
+ n = PyTuple_GET_SIZE(args);
+ while(n--) {
+ obj = PyTuple_GET_ITEM(args, n);
+ if (obj == (PyObject *)(&PyInt_Type)) {
+ PyLongArrType_Type.tp_as_number = saved_tables[0];
+ PyLongArrType_Type.tp_compare = saved_tables[1];
+ PyLongArrType_Type.tp_richcompare = saved_tables[2];
+ }
+ else if (obj == (PyObject *)(&PyFloat_Type)) {
+ PyDoubleArrType_Type.tp_as_number = saved_tables[3];
+ PyDoubleArrType_Type.tp_compare = saved_tables[4];
+ PyDoubleArrType_Type.tp_richcompare = saved_tables[5];
+ }
+ else if (obj == (PyObject *)(&PyComplex_Type)) {
+ PyCDoubleArrType_Type.tp_as_number = saved_tables[6];
+ PyCDoubleArrType_Type.tp_compare = saved_tables[7];
+ PyCDoubleArrType_Type.tp_richcompare = saved_tables[8];
+ }
+ else {
+ PyErr_SetString(PyExc_ValueError,
+ "arguments must be int, float, or complex");
+ return NULL;
+ }
+ }
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+char doc_usescalarmath[] = "";
+static PyObject *
+use_scalarmath(PyObject *dummy, PyObject *args)
+{
+ int n;
+ PyObject *obj;
+ n = PyTuple_GET_SIZE(args);
+ while(n--) {
+ obj = PyTuple_GET_ITEM(args, n);
+ if (obj == (PyObject *)(&PyInt_Type)) {
+ PyLongArrType_Type.tp_as_number = saved_tables_arrtype[0];
+ PyLongArrType_Type.tp_compare = saved_tables_arrtype[1];
+ PyLongArrType_Type.tp_richcompare = saved_tables_arrtype[2];
+ }
+ else if (obj == (PyObject *)(&PyFloat_Type)) {
+ PyDoubleArrType_Type.tp_as_number = saved_tables_arrtype[3];
+ PyDoubleArrType_Type.tp_compare = saved_tables_arrtype[4];
+ PyDoubleArrType_Type.tp_richcompare = saved_tables_arrtype[5];
+ }
+ else if (obj == (PyObject *)(&PyComplex_Type)) {
+ PyCDoubleArrType_Type.tp_as_number = saved_tables_arrtype[6];
+ PyCDoubleArrType_Type.tp_compare = saved_tables_arrtype[7];
+ PyCDoubleArrType_Type.tp_richcompare = saved_tables_arrtype[8];
+ }
+ else {
+ PyErr_SetString(PyExc_ValueError,
+ "arguments must be int, float, or complex");
+ return NULL;
+ }
+ }
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+static struct PyMethodDef methods[] = {
+ {"alter_pythonmath", (PyCFunction) alter_pyscalars,
+ METH_VARARGS, doc_alterpyscalars},
+ {"restore_pythonmath", (PyCFunction) restore_pyscalars,
+ METH_VARARGS, doc_restorepyscalars},
+ {"use_pythonmath", (PyCFunction) use_pythonmath,
+ METH_VARARGS, doc_usepythonmath},
+ {"use_scalarmath", (PyCFunction) use_scalarmath,
+ METH_VARARGS, doc_usescalarmath},
+ {NULL, NULL, 0}
+};
+
+PyMODINIT_FUNC initscalarmath(void) {
+
+ Py_InitModule("scalarmath", methods);
+
+ import_array();
+ import_umath();
+
+ if (get_functions() < 0) return;
+
+ add_scalarmath();
+
+ saved_tables[0] = PyInt_Type.tp_as_number;
+ saved_tables[1] = PyInt_Type.tp_compare;
+ saved_tables[2] = PyInt_Type.tp_richcompare;
+ saved_tables[3] = PyFloat_Type.tp_as_number;
+ saved_tables[4] = PyFloat_Type.tp_compare;
+ saved_tables[5] = PyFloat_Type.tp_richcompare;
+ saved_tables[6] = PyComplex_Type.tp_as_number;
+ saved_tables[7] = PyComplex_Type.tp_compare;
+ saved_tables[8] = PyComplex_Type.tp_richcompare;
+
+ return;
+}
diff --git a/numpy/core/src/scalartypes.inc.src b/numpy/core/src/scalartypes.inc.src
new file mode 100644
index 000000000..acf2097d1
--- /dev/null
+++ b/numpy/core/src/scalartypes.inc.src
@@ -0,0 +1,2742 @@
+/* -*- c -*- */
+
+#ifndef _MULTIARRAYMODULE
+#define _MULTIARRAYMODULE
+#endif
+#include "numpy/arrayscalars.h"
+
+static PyBoolScalarObject _PyArrayScalar_BoolValues[2] = {
+ {PyObject_HEAD_INIT(&PyBoolArrType_Type) 0},
+ {PyObject_HEAD_INIT(&PyBoolArrType_Type) 1},
+};
+
+/* Inheritance established later when tp_bases is set (or tp_base for
+ single inheritance) */
+
+/**begin repeat
+
+#name=number, integer, signedinteger, unsignedinteger, inexact, floating, complexfloating, flexible,
+character#
+#NAME=Number, Integer, SignedInteger, UnsignedInteger, Inexact, Floating, ComplexFloating, Flexible, Character#
+*/
+
+static PyTypeObject Py@NAME@ArrType_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0, /*ob_size*/
+ "numpy.@name@", /*tp_name*/
+ sizeof(PyObject), /*tp_basicsize*/
+};
+/**end repeat**/
+
+static void *
+scalar_value(PyObject *scalar, PyArray_Descr *descr)
+{
+ int type_num;
+ int align;
+ intp memloc;
+ if (descr == NULL) {
+ descr = PyArray_DescrFromScalar(scalar);
+ type_num = descr->type_num;
+ Py_DECREF(descr);
+ } else {
+ type_num = descr->type_num;
+ }
+ switch (type_num) {
+#define CASE(ut,lt) case NPY_##ut: return &(((Py##lt##ScalarObject *)scalar)->obval)
+ CASE(BOOL, Bool);
+ CASE(BYTE, Byte);
+ CASE(UBYTE, UByte);
+ CASE(SHORT, Short);
+ CASE(USHORT, UShort);
+ CASE(INT, Int);
+ CASE(UINT, UInt);
+ CASE(LONG, Long);
+ CASE(ULONG, ULong);
+ CASE(LONGLONG, LongLong);
+ CASE(ULONGLONG, ULongLong);
+ CASE(FLOAT, Float);
+ CASE(DOUBLE, Double);
+ CASE(LONGDOUBLE, LongDouble);
+ CASE(CFLOAT, CFloat);
+ CASE(CDOUBLE, CDouble);
+ CASE(CLONGDOUBLE, CLongDouble);
+ CASE(OBJECT, Object);
+#undef CASE
+ case NPY_STRING: return (void *)PyString_AS_STRING(scalar);
+ case NPY_UNICODE: return (void *)PyUnicode_AS_DATA(scalar);
+ case NPY_VOID: return ((PyVoidScalarObject *)scalar)->obval;
+ }
+
+ /* Must be a user-defined type --- check to see which
+ scalar it inherits from. */
+
+#define _CHK(cls) (PyObject_IsInstance(scalar, \
+ (PyObject *)&Py##cls##ArrType_Type))
+#define _OBJ(lt) &(((Py##lt##ScalarObject *)scalar)->obval)
+#define _IFCASE(cls) if _CHK(cls) return _OBJ(cls)
+
+ if _CHK(Number) {
+ if _CHK(Integer) {
+ if _CHK(SignedInteger) {
+ _IFCASE(Byte);
+ _IFCASE(Short);
+ _IFCASE(Int);
+ _IFCASE(Long);
+ _IFCASE(LongLong);
+ }
+ else { /* Unsigned Integer */
+ _IFCASE(UByte);
+ _IFCASE(UShort);
+ _IFCASE(UInt);
+ _IFCASE(ULong);
+ _IFCASE(ULongLong);
+ }
+ }
+ else { /* Inexact */
+ if _CHK(Floating) {
+ _IFCASE(Float);
+ _IFCASE(Double);
+ _IFCASE(LongDouble);
+ }
+ else { /*ComplexFloating */
+ _IFCASE(CFloat);
+ _IFCASE(CDouble);
+ _IFCASE(CLongDouble);
+ }
+ }
+ }
+ else if _CHK(Bool) return _OBJ(Bool);
+ else if _CHK(Flexible) {
+ if _CHK(String) return (void *)PyString_AS_STRING(scalar);
+ if _CHK(Unicode) return (void *)PyUnicode_AS_DATA(scalar);
+ if _CHK(Void) return ((PyVoidScalarObject *)scalar)->obval;
+ }
+ else _IFCASE(Object);
+
+
+ /* Use the alignment flag to figure out where the data begins
+ after a PyObject_HEAD
+ */
+ memloc = (intp)scalar;
+ memloc += sizeof(PyObject);
+ /* now round-up to the nearest alignment value
+ */
+ align = descr->alignment;
+ if (align > 1) memloc = ((memloc + align - 1)/align)*align;
+ return (void *)memloc;
+#undef _IFCASE
+#undef _OBJ
+#undef _CHK
+}
+
+/* no error checking is performed -- ctypeptr must be same type as scalar */
+/* in case of flexible type, the data is not copied
+ into ctypeptr which is expected to be a pointer to pointer */
+/*OBJECT_API
+ Convert to c-type
+*/
+static void
+PyArray_ScalarAsCtype(PyObject *scalar, void *ctypeptr)
+{
+ PyArray_Descr *typecode;
+ void *newptr;
+ typecode = PyArray_DescrFromScalar(scalar);
+ newptr = scalar_value(scalar, typecode);
+
+ if (PyTypeNum_ISEXTENDED(typecode->type_num)) {
+ void **ct = (void **)ctypeptr;
+ *ct = newptr;
+ } else {
+ memcpy(ctypeptr, newptr, typecode->elsize);
+ }
+ Py_DECREF(typecode);
+ return;
+}
+
+/* The output buffer must be large-enough to receive the value */
+/* Even for flexible types which is different from ScalarAsCtype
+ where only a reference for flexible types is returned
+*/
+
+/* This may not work right on narrow builds for NumPy unicode scalars.
+ */
+
+/*OBJECT_API
+ Cast Scalar to c-type
+*/
+static int
+PyArray_CastScalarToCtype(PyObject *scalar, void *ctypeptr,
+ PyArray_Descr *outcode)
+{
+ PyArray_Descr* descr;
+ PyArray_VectorUnaryFunc* castfunc;
+
+ descr = PyArray_DescrFromScalar(scalar);
+ castfunc = PyArray_GetCastFunc(descr, outcode->type_num);
+ if (castfunc == NULL) return -1;
+ if (PyTypeNum_ISEXTENDED(descr->type_num) ||
+ PyTypeNum_ISEXTENDED(outcode->type_num)) {
+ PyArrayObject *ain, *aout;
+
+ ain = (PyArrayObject *)PyArray_FromScalar(scalar, NULL);
+ if (ain == NULL) {Py_DECREF(descr); return -1;}
+ aout = (PyArrayObject *)
+ PyArray_NewFromDescr(&PyArray_Type,
+ outcode,
+ 0, NULL,
+ NULL, ctypeptr,
+ CARRAY, NULL);
+ if (aout == NULL) {Py_DECREF(ain); return -1;}
+ castfunc(ain->data, aout->data, 1, ain, aout);
+ Py_DECREF(ain);
+ Py_DECREF(aout);
+ }
+ else {
+ castfunc(scalar_value(scalar, descr), ctypeptr, 1, NULL, NULL);
+ }
+ Py_DECREF(descr);
+ return 0;
+}
+
+/*OBJECT_API
+ Cast Scalar to c-type
+*/
+static int
+PyArray_CastScalarDirect(PyObject *scalar, PyArray_Descr *indescr,
+ void *ctypeptr, int outtype)
+{
+ PyArray_VectorUnaryFunc* castfunc;
+ void *ptr;
+ castfunc = PyArray_GetCastFunc(indescr, outtype);
+ if (castfunc == NULL) return -1;
+ ptr = scalar_value(scalar, indescr);
+ castfunc(ptr, ctypeptr, 1, NULL, NULL);
+ return 0;
+}
+
+/* 0-dim array from array-scalar object */
+/* always contains a copy of the data
+ unless outcode is NULL, it is of void type and the referrer does
+ not own it either.
+*/
+
+/* steals reference to outcode */
+/*OBJECT_API
+ Get 0-dim array from scalar
+*/
+static PyObject *
+PyArray_FromScalar(PyObject *scalar, PyArray_Descr *outcode)
+{
+ PyArray_Descr *typecode;
+ PyObject *r;
+ char *memptr;
+ PyObject *ret;
+
+ /* convert to 0-dim array of scalar typecode */
+ typecode = PyArray_DescrFromScalar(scalar);
+ if ((typecode->type_num == PyArray_VOID) &&
+ !(((PyVoidScalarObject *)scalar)->flags & OWNDATA) &&
+ outcode == NULL) {
+ r = PyArray_NewFromDescr(&PyArray_Type,
+ typecode,
+ 0, NULL, NULL,
+ ((PyVoidScalarObject *)scalar)->obval,
+ ((PyVoidScalarObject *)scalar)->flags,
+ NULL);
+ PyArray_BASE(r) = (PyObject *)scalar;
+ Py_INCREF(scalar);
+ return r;
+ }
+ r = PyArray_NewFromDescr(&PyArray_Type,
+ typecode,
+ 0, NULL,
+ NULL, NULL, 0, NULL);
+ if (r==NULL) {Py_XDECREF(outcode); return NULL;}
+
+ if (PyDataType_FLAGCHK(typecode, NPY_USE_SETITEM)) {
+ if (typecode->f->setitem(scalar, PyArray_DATA(r), r) < 0) {
+ Py_XDECREF(outcode); Py_DECREF(r);
+ return NULL;
+ }
+ goto finish;
+ }
+
+ memptr = scalar_value(scalar, typecode);
+
+#ifndef Py_UNICODE_WIDE
+ if (typecode->type_num == PyArray_UNICODE) {
+ PyUCS2Buffer_AsUCS4((Py_UNICODE *)memptr,
+ (PyArray_UCS4 *)PyArray_DATA(r),
+ PyUnicode_GET_SIZE(scalar),
+ PyArray_ITEMSIZE(r) >> 2);
+ } else
+#endif
+ {
+ memcpy(PyArray_DATA(r), memptr, PyArray_ITEMSIZE(r));
+ if (PyDataType_FLAGCHK(typecode, NPY_ITEM_HASOBJECT)) {
+ Py_INCREF(*((PyObject **)memptr));
+ }
+ }
+
+ finish:
+ if (outcode == NULL) return r;
+
+ if (outcode->type_num == typecode->type_num) {
+ if (!PyTypeNum_ISEXTENDED(typecode->type_num))
+ return r;
+ if (outcode->elsize == typecode->elsize);
+ return r;
+ }
+
+ /* cast if necessary to desired output typecode */
+ ret = PyArray_CastToType((PyArrayObject *)r, outcode, 0);
+ Py_DECREF(r);
+ return ret;
+}
+
+/*OBJECT_API
+ Get an Array Scalar From a Python Object
+ Returns NULL if unsuccessful but error is only
+ set if another error occurred. Currently only Numeric-like
+ object supported.
+ */
+static PyObject *
+PyArray_ScalarFromObject(PyObject *object)
+{
+ PyObject *ret=NULL;
+ if (PyArray_IsZeroDim(object)) {
+ return PyArray_ToScalar(PyArray_DATA(object), object);
+ }
+ if (PyInt_Check(object)) {
+ ret = PyArrayScalar_New(Long);
+ if (ret == NULL) return NULL;
+ PyArrayScalar_VAL(ret, Long) = PyInt_AS_LONG(object);
+ }
+ else if (PyFloat_Check(object)) {
+ ret = PyArrayScalar_New(Double);
+ if (ret == NULL) return NULL;
+ PyArrayScalar_VAL(ret, Double) = PyFloat_AS_DOUBLE(object);
+ }
+ else if (PyComplex_Check(object)) {
+ ret = PyArrayScalar_New(CDouble);
+ if (ret == NULL) return NULL;
+ PyArrayScalar_VAL(ret, CDouble).real = \
+ ((PyComplexObject *)object)->cval.real;
+ PyArrayScalar_VAL(ret, CDouble).imag = \
+ ((PyComplexObject *)object)->cval.imag;
+ }
+ else if (PyLong_Check(object)) {
+ longlong val;
+ val = PyLong_AsLongLong(object);
+ if (val==-1 && PyErr_Occurred()) {
+ PyErr_Clear();
+ return NULL;
+ }
+ ret = PyArrayScalar_New(LongLong);
+ if (ret == NULL) return NULL;
+ PyArrayScalar_VAL(ret, LongLong) = val;
+ }
+ else if (PyBool_Check(object)) {
+ if (object == Py_True) {
+ PyArrayScalar_RETURN_TRUE;
+ }
+ else {
+ PyArrayScalar_RETURN_FALSE;
+ }
+ }
+ return ret;
+}
+
+
+static PyObject *
+gentype_alloc(PyTypeObject *type, Py_ssize_t nitems)
+{
+ PyObject *obj;
+ const size_t size = _PyObject_VAR_SIZE(type, nitems+1);
+
+ obj = (PyObject *)_pya_malloc(size);
+ memset(obj, 0, size);
+ if (type->tp_itemsize == 0)
+ PyObject_INIT(obj, type);
+ else
+ (void) PyObject_INIT_VAR((PyVarObject *)obj, type, nitems);
+ return obj;
+}
+
+static void
+gentype_dealloc(PyObject *v)
+{
+ v->ob_type->tp_free(v);
+}
+
+
+static PyObject *
+gentype_power(PyObject *m1, PyObject *m2, PyObject *m3)
+{
+ PyObject *arr, *ret, *arg2;
+ char *msg="unsupported operand type(s) for ** or pow()";
+
+ if (!PyArray_IsScalar(m1,Generic)) {
+ if (PyArray_Check(m1)) {
+ ret = m1->ob_type->tp_as_number->nb_power(m1,m2,
+ Py_None);
+ }
+ else {
+ if (!PyArray_IsScalar(m2,Generic)) {
+ PyErr_SetString(PyExc_TypeError, msg);
+ return NULL;
+ }
+ arr = PyArray_FromScalar(m2, NULL);
+ if (arr == NULL) return NULL;
+ ret = arr->ob_type->tp_as_number->nb_power(m1, arr,
+ Py_None);
+ Py_DECREF(arr);
+ }
+ return ret;
+ }
+ if (!PyArray_IsScalar(m2, Generic)) {
+ if (PyArray_Check(m2)) {
+ ret = m2->ob_type->tp_as_number->nb_power(m1,m2,
+ Py_None);
+ }
+ else {
+ if (!PyArray_IsScalar(m1, Generic)) {
+ PyErr_SetString(PyExc_TypeError, msg);
+ return NULL;
+ }
+ arr = PyArray_FromScalar(m1, NULL);
+ if (arr == NULL) return NULL;
+ ret = arr->ob_type->tp_as_number->nb_power(arr, m2,
+ Py_None);
+ Py_DECREF(arr);
+ }
+ return ret;
+ }
+ arr=arg2=NULL;
+ arr = PyArray_FromScalar(m1, NULL);
+ arg2 = PyArray_FromScalar(m2, NULL);
+ if (arr == NULL || arg2 == NULL) {
+ Py_XDECREF(arr); Py_XDECREF(arg2); return NULL;
+ }
+ ret = arr->ob_type->tp_as_number->nb_power(arr, arg2, Py_None);
+ Py_DECREF(arr);
+ Py_DECREF(arg2);
+ return ret;
+}
+
+static PyObject *
+gentype_generic_method(PyObject *self, PyObject *args, PyObject *kwds,
+ char *str)
+{
+ PyObject *arr, *meth, *ret;
+
+ arr = PyArray_FromScalar(self, NULL);
+ if (arr == NULL) return NULL;
+ meth = PyObject_GetAttrString(arr, str);
+ if (meth == NULL) {Py_DECREF(arr); return NULL;}
+ if (kwds == NULL)
+ ret = PyObject_CallObject(meth, args);
+ else
+ ret = PyObject_Call(meth, args, kwds);
+ Py_DECREF(meth);
+ Py_DECREF(arr);
+ if (ret && PyArray_Check(ret))
+ return PyArray_Return((PyArrayObject *)ret);
+ else
+ return ret;
+}
+
+/**begin repeat
+
+#name=add, subtract, divide, remainder, divmod, lshift, rshift, and, xor, or, floor_divide, true_divide#
+#PYNAME=Add, Subtract, Divide, Remainder, Divmod, Lshift, Rshift, And, Xor, Or, FloorDivide, TrueDivide#
+*/
+
+static PyObject *
+gentype_@name@(PyObject *m1, PyObject *m2)
+{
+ return PyArray_Type.tp_as_number->nb_@name@(m1, m2);
+}
+/**end repeat**/
+
+
+static PyObject *
+gentype_multiply(PyObject *m1, PyObject *m2)
+{
+ PyObject *ret=NULL;
+ long repeat;
+
+ if (!PyArray_IsScalar(m1, Generic) &&
+ ((m1->ob_type->tp_as_number == NULL) ||
+ (m1->ob_type->tp_as_number->nb_multiply == NULL))) {
+ /* Try to convert m2 to an int and try sequence
+ repeat */
+ repeat = PyInt_AsLong(m2);
+ if (repeat == -1 && PyErr_Occurred()) return NULL;
+ ret = PySequence_Repeat(m1, (int) repeat);
+ }
+ else if (!PyArray_IsScalar(m2, Generic) &&
+ ((m2->ob_type->tp_as_number == NULL) ||
+ (m2->ob_type->tp_as_number->nb_multiply == NULL))) {
+ /* Try to convert m1 to an int and try sequence
+ repeat */
+ repeat = PyInt_AsLong(m1);
+ if (repeat == -1 && PyErr_Occurred()) return NULL;
+ ret = PySequence_Repeat(m2, (int) repeat);
+ }
+ if (ret==NULL) {
+ PyErr_Clear(); /* no effect if not set */
+ ret = PyArray_Type.tp_as_number->nb_multiply(m1, m2);
+ }
+ return ret;
+}
+
+/**begin repeat
+
+#name=positive, negative, absolute, invert, int, long, float, oct, hex#
+*/
+
+static PyObject *
+gentype_@name@(PyObject *m1)
+{
+ PyObject *arr, *ret;
+
+ arr = PyArray_FromScalar(m1, NULL);
+ if (arr == NULL) return NULL;
+ ret = arr->ob_type->tp_as_number->nb_@name@(arr);
+ Py_DECREF(arr);
+ return ret;
+}
+/**end repeat**/
+
+static int
+gentype_nonzero_number(PyObject *m1)
+{
+ PyObject *arr;
+ int ret;
+
+ arr = PyArray_FromScalar(m1, NULL);
+ if (arr == NULL) return -1;
+ ret = arr->ob_type->tp_as_number->nb_nonzero(arr);
+ Py_DECREF(arr);
+ return ret;
+}
+
+static PyObject *
+gentype_str(PyObject *self)
+{
+ PyArrayObject *arr;
+ PyObject *ret;
+
+ arr = (PyArrayObject *)PyArray_FromScalar(self, NULL);
+ if (arr==NULL) return NULL;
+ ret = PyObject_Str((PyObject *)arr);
+ Py_DECREF(arr);
+ return ret;
+}
+
+
+static PyObject *
+gentype_repr(PyObject *self)
+{
+ PyArrayObject *arr;
+ PyObject *ret;
+
+ arr = (PyArrayObject *)PyArray_FromScalar(self, NULL);
+ if (arr==NULL) return NULL;
+ ret = PyObject_Str((PyObject *)arr);
+ Py_DECREF(arr);
+ return ret;
+}
+
+static void
+format_longdouble(char *buf, size_t buflen, longdouble val,
+ unsigned int precision)
+{
+ char *cp;
+
+ PyOS_snprintf(buf, buflen, "%.*" LONGDOUBLE_FMT, precision, val);
+ cp = buf;
+ if (*cp == '-')
+ cp++;
+ for (; *cp != '\0'; cp++) {
+ if (!isdigit(Py_CHARMASK(*cp)))
+ break;
+ }
+ if (*cp == '\0') {
+ *cp++ = '.';
+ *cp++ = '0';
+ *cp++ = '\0';
+ }
+}
+
+/* over-ride repr and str of array-scalar strings and unicode to
+ remove NULL bytes and then call the corresponding functions
+ of string and unicode.
+ */
+
+/**begin repeat
+#name=string*2,unicode*2#
+#form=(repr,str)*2#
+#Name=String*2,Unicode*2#
+#NAME=STRING*2,UNICODE*2#
+#extra=AndSize*2,,#
+#type=char*2, Py_UNICODE*2#
+*/
+static PyObject *
+@name@type_@form@(PyObject *self)
+{
+ const @type@ *dptr, *ip;
+ int len;
+ PyObject *new;
+ PyObject *ret;
+
+ ip = dptr = Py@Name@_AS_@NAME@(self);
+ len = Py@Name@_GET_SIZE(self);
+ dptr += len-1;
+ while(len > 0 && *dptr-- == 0) len--;
+ new = Py@Name@_From@Name@@extra@(ip, len);
+ if (new == NULL) return PyString_FromString("");
+ ret = Py@Name@_Type.tp_@form@(new);
+ Py_DECREF(new);
+ return ret;
+}
+/**end repeat**/
+
+
+
+#if SIZEOF_LONGDOUBLE == SIZEOF_DOUBLE
+#define PREC_REPR 17
+#define PREC_STR 17
+#else
+#define PREC_REPR 21
+#define PREC_STR 21
+#endif
+
+static PyObject *
+longdoubletype_repr(PyObject *self)
+{
+ static char buf[100];
+ format_longdouble(buf, sizeof(buf),
+ ((PyLongDoubleScalarObject *)self)->obval, PREC_REPR);
+ return PyString_FromString(buf);
+}
+
+static PyObject *
+clongdoubletype_repr(PyObject *self)
+{
+ static char buf1[100];
+ static char buf2[100];
+ static char buf3[202];
+ clongdouble x;
+ x = ((PyCLongDoubleScalarObject *)self)->obval;
+ format_longdouble(buf1, sizeof(buf1), x.real, PREC_REPR);
+ format_longdouble(buf2, sizeof(buf2), x.imag, PREC_REPR);
+
+ snprintf(buf3, sizeof(buf3), "(%s+%sj)", buf1, buf2);
+ return PyString_FromString(buf3);
+}
+
+#define longdoubletype_str longdoubletype_repr
+#define clongdoubletype_str clongdoubletype_repr
+
+/** Could improve this with a PyLong_FromLongDouble(longdouble ldval)
+ but this would need some more work...
+**/
+
+/**begin repeat
+
+#name=(int, long, hex, oct, float)*2#
+#KIND=(Long*4, Float)*2#
+#char=,,,,,c*5#
+#CHAR=,,,,,C*5#
+#POST=,,,,,.real*5#
+*/
+static PyObject *
+@char@longdoubletype_@name@(PyObject *self)
+{
+ double dval;
+ PyObject *obj, *ret;
+
+ dval = (double)(((Py@CHAR@LongDoubleScalarObject *)self)->obval)@POST@;
+ obj = Py@KIND@_FromDouble(dval);
+ ret = obj->ob_type->tp_as_number->nb_@name@(obj);
+ Py_DECREF(obj);
+ return ret;
+}
+/**end repeat**/
+
+
+static PyNumberMethods gentype_as_number = {
+ (binaryfunc)gentype_add, /*nb_add*/
+ (binaryfunc)gentype_subtract, /*nb_subtract*/
+ (binaryfunc)gentype_multiply, /*nb_multiply*/
+ (binaryfunc)gentype_divide, /*nb_divide*/
+ (binaryfunc)gentype_remainder, /*nb_remainder*/
+ (binaryfunc)gentype_divmod, /*nb_divmod*/
+ (ternaryfunc)gentype_power, /*nb_power*/
+ (unaryfunc)gentype_negative,
+ (unaryfunc)gentype_positive, /*nb_pos*/
+ (unaryfunc)gentype_absolute, /*(unaryfunc)gentype_abs,*/
+ (inquiry)gentype_nonzero_number, /*nb_nonzero*/
+ (unaryfunc)gentype_invert, /*nb_invert*/
+ (binaryfunc)gentype_lshift, /*nb_lshift*/
+ (binaryfunc)gentype_rshift, /*nb_rshift*/
+ (binaryfunc)gentype_and, /*nb_and*/
+ (binaryfunc)gentype_xor, /*nb_xor*/
+ (binaryfunc)gentype_or, /*nb_or*/
+ 0, /*nb_coerce*/
+ (unaryfunc)gentype_int, /*nb_int*/
+ (unaryfunc)gentype_long, /*nb_long*/
+ (unaryfunc)gentype_float, /*nb_float*/
+ (unaryfunc)gentype_oct, /*nb_oct*/
+ (unaryfunc)gentype_hex, /*nb_hex*/
+ 0, /*inplace_add*/
+ 0, /*inplace_subtract*/
+ 0, /*inplace_multiply*/
+ 0, /*inplace_divide*/
+ 0, /*inplace_remainder*/
+ 0, /*inplace_power*/
+ 0, /*inplace_lshift*/
+ 0, /*inplace_rshift*/
+ 0, /*inplace_and*/
+ 0, /*inplace_xor*/
+ 0, /*inplace_or*/
+ (binaryfunc)gentype_floor_divide, /*nb_floor_divide*/
+ (binaryfunc)gentype_true_divide, /*nb_true_divide*/
+ 0, /*nb_inplace_floor_divide*/
+ 0, /*nb_inplace_true_divide*/
+#if PY_VERSION_HEX >= 0x02050000
+ (unaryfunc)NULL, /* nb_index */
+#endif
+};
+
+
+static PyObject *
+gentype_richcompare(PyObject *self, PyObject *other, int cmp_op)
+{
+
+ PyObject *arr, *ret;
+
+ arr = PyArray_FromScalar(self, NULL);
+ if (arr == NULL) return NULL;
+ ret = arr->ob_type->tp_richcompare(arr, other, cmp_op);
+ Py_DECREF(arr);
+ return ret;
+}
+
+static PyObject *
+gentype_ndim_get(PyObject *self)
+{
+ return PyInt_FromLong(0);
+}
+
+static PyObject *
+gentype_flags_get(PyObject *self)
+{
+ return PyArray_NewFlagsObject(NULL);
+}
+
+static PyObject *
+voidtype_flags_get(PyVoidScalarObject *self)
+{
+ PyObject *flagobj;
+ flagobj = PyArrayFlags_Type.tp_alloc(&PyArrayFlags_Type, 0);
+ if (flagobj == NULL) return NULL;
+ ((PyArrayFlagsObject *)flagobj)->arr = NULL;
+ ((PyArrayFlagsObject *)flagobj)->flags = self->flags;
+ return flagobj;
+}
+
+static PyObject *
+voidtype_dtypedescr_get(PyVoidScalarObject *self)
+{
+ Py_INCREF(self->descr);
+ return (PyObject *)self->descr;
+}
+
+
+static PyObject *
+gentype_data_get(PyObject *self)
+{
+ return PyBuffer_FromObject(self, 0, Py_END_OF_BUFFER);
+}
+
+
+static PyObject *
+gentype_itemsize_get(PyObject *self)
+{
+ PyArray_Descr *typecode;
+ PyObject *ret;
+ int elsize;
+
+ typecode = PyArray_DescrFromScalar(self);
+ elsize = typecode->elsize;
+#ifndef Py_UNICODE_WIDE
+ if (typecode->type_num == NPY_UNICODE) {
+ elsize >>= 1;
+ }
+#endif
+ ret = PyInt_FromLong((long) elsize);
+ Py_DECREF(typecode);
+ return ret;
+}
+
+static PyObject *
+gentype_size_get(PyObject *self)
+{
+ return PyInt_FromLong(1);
+}
+
+static void
+gentype_struct_free(void *ptr, void *arg)
+{
+ PyArrayInterface *arrif = (PyArrayInterface *)ptr;
+ Py_DECREF((PyObject *)arg);
+ Py_XDECREF(arrif->descr);
+ _pya_free(arrif->shape);
+ _pya_free(arrif);
+}
+
+static PyObject *
+gentype_struct_get(PyObject *self)
+{
+ PyArrayObject *arr;
+ PyArrayInterface *inter;
+
+ arr = (PyArrayObject *)PyArray_FromScalar(self, NULL);
+ inter = (PyArrayInterface *)_pya_malloc(sizeof(PyArrayInterface));
+ inter->two = 2;
+ inter->nd = 0;
+ inter->flags = arr->flags;
+ inter->flags &= ~(UPDATEIFCOPY | OWNDATA);
+ inter->flags |= NPY_NOTSWAPPED;
+ inter->typekind = arr->descr->kind;
+ inter->itemsize = arr->descr->elsize;
+ inter->strides = NULL;
+ inter->shape = NULL;
+ inter->data = arr->data;
+ inter->descr = NULL;
+
+ return PyCObject_FromVoidPtrAndDesc(inter, arr, gentype_struct_free);
+}
+
+static PyObject *
+gentype_priority_get(PyObject *self)
+{
+ return PyFloat_FromDouble(NPY_SCALAR_PRIORITY);
+}
+
+static PyObject *
+gentype_shape_get(PyObject *self)
+{
+ return PyTuple_New(0);
+}
+
+
+static PyObject *
+gentype_interface_get(PyObject *self)
+{
+ PyArrayObject *arr;
+ PyObject *inter;
+
+ arr = (PyArrayObject *)PyArray_FromScalar(self, NULL);
+ if (arr == NULL) return NULL;
+ inter = PyObject_GetAttrString((PyObject *)arr, "__array_interface__");
+ Py_DECREF(arr);
+ return inter;
+}
+
+
+
+static PyObject *
+gentype_typedescr_get(PyObject *self)
+{
+ return (PyObject *)PyArray_DescrFromScalar(self);
+}
+
+
+static PyObject *
+gentype_base_get(PyObject *self)
+{
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+static PyArray_Descr *
+_realdescr_fromcomplexscalar(PyObject *self, int *typenum)
+{
+ if (PyArray_IsScalar(self, CDouble)) {
+ *typenum = PyArray_CDOUBLE;
+ return PyArray_DescrFromType(PyArray_DOUBLE);
+ }
+ if (PyArray_IsScalar(self, CFloat)) {
+ *typenum = PyArray_CFLOAT;
+ return PyArray_DescrFromType(PyArray_FLOAT);
+ }
+ if (PyArray_IsScalar(self, CLongDouble)) {
+ *typenum = PyArray_CLONGDOUBLE;
+ return PyArray_DescrFromType(PyArray_LONGDOUBLE);
+ }
+ return NULL;
+}
+
+static PyObject *
+gentype_real_get(PyObject *self)
+{
+ PyArray_Descr *typecode;
+ PyObject *ret;
+ int typenum;
+
+ if (PyArray_IsScalar(self, ComplexFloating)) {
+ void *ptr;
+ typecode = _realdescr_fromcomplexscalar(self, &typenum);
+ ptr = scalar_value(self, NULL);
+ ret = PyArray_Scalar(ptr, typecode, NULL);
+ Py_DECREF(typecode);
+ return ret;
+ }
+ else if (PyArray_IsScalar(self, Object)) {
+ PyObject *obj = ((PyObjectScalarObject *)self)->obval;
+ ret = PyObject_GetAttrString(obj, "real");
+ if (ret != NULL) return ret;
+ PyErr_Clear();
+ }
+ Py_INCREF(self);
+ return (PyObject *)self;
+}
+
+static PyObject *
+gentype_imag_get(PyObject *self)
+{
+ PyArray_Descr *typecode=NULL;
+ PyObject *ret;
+ int typenum;
+
+ if (PyArray_IsScalar(self, ComplexFloating)) {
+ char *ptr;
+ typecode = _realdescr_fromcomplexscalar(self, &typenum);
+ ptr = (char *)scalar_value(self, NULL);
+ ret = PyArray_Scalar(ptr + typecode->elsize,
+ typecode, NULL);
+ }
+ else if (PyArray_IsScalar(self, Object)) {
+ PyObject *obj = ((PyObjectScalarObject *)self)->obval;
+ PyArray_Descr *newtype;
+ ret = PyObject_GetAttrString(obj, "imag");
+ if (ret == NULL) {
+ PyErr_Clear();
+ obj = PyInt_FromLong(0);
+ newtype = PyArray_DescrFromType(PyArray_OBJECT);
+ ret = PyArray_Scalar((char *)&obj, newtype, NULL);
+ Py_DECREF(newtype);
+ Py_DECREF(obj);
+ }
+ }
+ else {
+ char *temp;
+ int elsize;
+ typecode = PyArray_DescrFromScalar(self);
+ elsize = typecode->elsize;
+ temp = PyDataMem_NEW(elsize);
+ memset(temp, '\0', elsize);
+ ret = PyArray_Scalar(temp, typecode, NULL);
+ PyDataMem_FREE(temp);
+ }
+
+ Py_XDECREF(typecode);
+ return ret;
+}
+
+static PyObject *
+gentype_flat_get(PyObject *self)
+{
+ PyObject *ret, *arr;
+
+ arr = PyArray_FromScalar(self, NULL);
+ if (arr == NULL) return NULL;
+ ret = PyArray_IterNew(arr);
+ Py_DECREF(arr);
+ return ret;
+}
+
+
+static PyObject *
+gentype_transpose_get(PyObject *self)
+{
+ Py_INCREF(self);
+ return self;
+}
+
+
+static PyGetSetDef gentype_getsets[] = {
+ {"ndim",
+ (getter)gentype_ndim_get,
+ (setter) 0,
+ "number of array dimensions"},
+ {"flags",
+ (getter)gentype_flags_get,
+ (setter)0,
+ "integer value of flags"},
+ {"shape",
+ (getter)gentype_shape_get,
+ (setter)0,
+ "tuple of array dimensions"},
+ {"strides",
+ (getter)gentype_shape_get,
+ (setter) 0,
+ "tuple of bytes steps in each dimension"},
+ {"data",
+ (getter)gentype_data_get,
+ (setter) 0,
+ "pointer to start of data"},
+ {"itemsize",
+ (getter)gentype_itemsize_get,
+ (setter)0,
+ "length of one element in bytes"},
+ {"size",
+ (getter)gentype_size_get,
+ (setter)0,
+ "number of elements in the gentype"},
+ {"nbytes",
+ (getter)gentype_itemsize_get,
+ (setter)0,
+ "length of item in bytes"},
+ {"base",
+ (getter)gentype_base_get,
+ (setter)0,
+ "base object"},
+ {"dtype",
+ (getter)gentype_typedescr_get,
+ NULL,
+ "get array data-descriptor"},
+ {"real",
+ (getter)gentype_real_get,
+ (setter)0,
+ "real part of scalar"},
+ {"imag",
+ (getter)gentype_imag_get,
+ (setter)0,
+ "imaginary part of scalar"},
+ {"flat",
+ (getter)gentype_flat_get,
+ (setter)0,
+ "a 1-d view of scalar"},
+ {"T",
+ (getter)gentype_transpose_get,
+ (setter)0,
+ "transpose"},
+ {"__array_interface__",
+ (getter)gentype_interface_get,
+ NULL,
+ "Array protocol: Python side"},
+ {"__array_struct__",
+ (getter)gentype_struct_get,
+ NULL,
+ "Array protocol: struct"},
+ {"__array_priority__",
+ (getter)gentype_priority_get,
+ NULL,
+ "Array priority."},
+ {NULL, NULL, NULL, NULL} /* Sentinel */
+};
+
+
+/* 0-dim array from scalar object */
+
+static char doc_getarray[] = "sc.__array__(|type) return 0-dim array";
+
+static PyObject *
+gentype_getarray(PyObject *scalar, PyObject *args)
+{
+ PyArray_Descr *outcode=NULL;
+ PyObject *ret;
+
+ if (!PyArg_ParseTuple(args, "|O&", &PyArray_DescrConverter,
+ &outcode)) return NULL;
+ ret = PyArray_FromScalar(scalar, outcode);
+ return ret;
+}
+
+static char doc_sc_wraparray[] = "sc.__array_wrap__(obj) return scalar from array";
+
+static PyObject *
+gentype_wraparray(PyObject *scalar, PyObject *args)
+{
+ PyObject *arr;
+
+ if (PyTuple_Size(args) < 1) {
+ PyErr_SetString(PyExc_TypeError,
+ "only accepts 1 argument.");
+ return NULL;
+ }
+ arr = PyTuple_GET_ITEM(args, 0);
+ if (!PyArray_Check(arr)) {
+ PyErr_SetString(PyExc_TypeError,
+ "can only be called with ndarray object");
+ return NULL;
+ }
+
+ return PyArray_Scalar(PyArray_DATA(arr), PyArray_DESCR(arr), arr);
+}
+
+
+/**begin repeat
+
+#name=tolist, item, tostring, astype, copy, __deepcopy__, searchsorted, view, swapaxes, conj, conjugate, nonzero, flatten, ravel, fill, transpose, newbyteorder#
+*/
+
+static PyObject *
+gentype_@name@(PyObject *self, PyObject *args)
+{
+ return gentype_generic_method(self, args, NULL, "@name@");
+}
+/**end repeat**/
+
+static PyObject *
+gentype_itemset(PyObject *self, PyObject *args)
+{
+ PyErr_SetString(PyExc_ValueError, "array-scalars are immutable");
+ return NULL;
+}
+
+static PyObject *
+gentype_squeeze(PyObject *self, PyObject *args)
+{
+ if (!PyArg_ParseTuple(args, "")) return NULL;
+ Py_INCREF(self);
+ return self;
+}
+
+static Py_ssize_t
+gentype_getreadbuf(PyObject *, Py_ssize_t, void **);
+
+static PyObject *
+gentype_byteswap(PyObject *self, PyObject *args)
+{
+ Bool inplace=FALSE;
+
+ if (!PyArg_ParseTuple(args, "|O&", PyArray_BoolConverter, &inplace))
+ return NULL;
+
+ if (inplace) {
+ PyErr_SetString(PyExc_ValueError,
+ "cannot byteswap a scalar in-place");
+ return NULL;
+ }
+ else {
+ /* get the data, copyswap it and pass it to a new Array scalar
+ */
+ char *data;
+ int numbytes;
+ PyArray_Descr *descr;
+ PyObject *new;
+ char *newmem;
+
+ numbytes = gentype_getreadbuf(self, 0, (void **)&data);
+ descr = PyArray_DescrFromScalar(self);
+ newmem = _pya_malloc(descr->elsize);
+ if (newmem == NULL) {Py_DECREF(descr); return PyErr_NoMemory();}
+ else memcpy(newmem, data, descr->elsize);
+ byte_swap_vector(newmem, 1, descr->elsize);
+ new = PyArray_Scalar(newmem, descr, NULL);
+ _pya_free(newmem);
+ Py_DECREF(descr);
+ return new;
+ }
+}
+
+
+/**begin repeat
+
+#name=take, getfield, put, repeat, tofile, mean, trace, diagonal, clip, std, var, sum, cumsum, prod, cumprod, compress, sort, argsort, round, argmax, argmin, max, min, ptp, any, all, resize, reshape, choose#
+*/
+
+static PyObject *
+gentype_@name@(PyObject *self, PyObject *args, PyObject *kwds)
+{
+ return gentype_generic_method(self, args, kwds, "@name@");
+}
+/**end repeat**/
+
+static PyObject *
+voidtype_getfield(PyVoidScalarObject *self, PyObject *args, PyObject *kwds)
+{
+ PyObject *ret;
+
+ ret = gentype_generic_method((PyObject *)self, args, kwds, "getfield");
+ if (!ret) return ret;
+ if (PyArray_IsScalar(ret, Generic) && \
+ (!PyArray_IsScalar(ret, Void))) {
+ PyArray_Descr *new;
+ void *ptr;
+ if (!PyArray_ISNBO(self->descr->byteorder)) {
+ new = PyArray_DescrFromScalar(ret);
+ ptr = scalar_value(ret, new);
+ byte_swap_vector(ptr, 1, new->elsize);
+ Py_DECREF(new);
+ }
+ }
+ return ret;
+}
+
+static PyObject *
+gentype_setfield(PyObject *self, PyObject *args, PyObject *kwds)
+{
+
+ PyErr_SetString(PyExc_TypeError,
+ "Can't set fields in a non-void array scalar.");
+ return NULL;
+}
+
+static PyObject *
+voidtype_setfield(PyVoidScalarObject *self, PyObject *args, PyObject *kwds)
+{
+ PyArray_Descr *typecode;
+ int offset = 0;
+ PyObject *value, *src;
+ int mysize;
+ char *dptr;
+ static char *kwlist[] = {"value", "dtype", "offset", 0};
+
+ if ((self->flags & WRITEABLE) != WRITEABLE) {
+ PyErr_SetString(PyExc_RuntimeError,
+ "Can't write to memory");
+ return NULL;
+ }
+ if (!PyArg_ParseTupleAndKeywords(args, kwds, "OO&|i", kwlist,
+ &value,
+ PyArray_DescrConverter,
+ &typecode, &offset)) return NULL;
+
+ mysize = self->ob_size;
+
+ if (offset < 0 || (offset + typecode->elsize) > mysize) {
+ PyErr_Format(PyExc_ValueError,
+ "Need 0 <= offset <= %d for requested type " \
+ "but received offset = %d",
+ mysize-typecode->elsize, offset);
+ Py_DECREF(typecode);
+ return NULL;
+ }
+
+ dptr = self->obval + offset;
+
+ if (typecode->type_num == PyArray_OBJECT) {
+ PyObject **temp;
+ Py_INCREF(value);
+ temp = (PyObject **)dptr;
+ Py_XDECREF(*temp);
+ memcpy(temp, &value, sizeof(PyObject *));
+ }
+ else {
+ /* Copy data from value to correct place in dptr */
+ src = PyArray_FromAny(value, typecode, 0, 0, CARRAY, NULL);
+ if (src == NULL) return NULL;
+ typecode->f->copyswap(dptr, PyArray_DATA(src),
+ !PyArray_ISNBO(self->descr->byteorder),
+ src);
+ Py_DECREF(src);
+ }
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+static PyObject *
+gentype_reduce(PyObject *self, PyObject *args)
+{
+ PyObject *ret=NULL, *obj=NULL, *mod=NULL;
+ const char *buffer;
+ Py_ssize_t buflen;
+
+ /* Return a tuple of (callable object, arguments) */
+
+ ret = PyTuple_New(2);
+ if (ret == NULL) return NULL;
+ if (PyObject_AsReadBuffer(self, (const void **)&buffer, &buflen)<0) {
+ Py_DECREF(ret); return NULL;
+ }
+ mod = PyImport_ImportModule("numpy.core.multiarray");
+ if (mod == NULL) return NULL;
+ obj = PyObject_GetAttrString(mod, "scalar");
+ Py_DECREF(mod);
+ if (obj == NULL) return NULL;
+ PyTuple_SET_ITEM(ret, 0, obj);
+ obj = PyObject_GetAttrString((PyObject *)self, "dtype");
+ if (PyArray_IsScalar(self, Object)) {
+ mod = ((PyObjectScalarObject *)self)->obval;
+ PyTuple_SET_ITEM(ret, 1,
+ Py_BuildValue("NO", obj, mod));
+ }
+ else {
+ mod = PyString_FromStringAndSize(buffer, buflen);
+ PyTuple_SET_ITEM(ret, 1,
+ Py_BuildValue("NN", obj, mod));
+ }
+ return ret;
+}
+
+/* ignores everything */
+static PyObject *
+gentype_setstate(PyObject *self, PyObject *args)
+{
+ Py_INCREF(Py_None);
+ return (Py_None);
+}
+
+static PyObject *
+gentype_dump(PyObject *self, PyObject *args)
+{
+ PyObject *file=NULL;
+ int ret;
+
+ if (!PyArg_ParseTuple(args, "O", &file))
+ return NULL;
+ ret = PyArray_Dump(self, file, 2);
+ if (ret < 0) return NULL;
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+static PyObject *
+gentype_dumps(PyObject *self, PyObject *args)
+{
+ if (!PyArg_ParseTuple(args, ""))
+ return NULL;
+ return PyArray_Dumps(self, 2);
+}
+
+
+/* setting flags cannot be done for scalars */
+static PyObject *
+gentype_setflags(PyObject *self, PyObject *args, PyObject *kwds)
+{
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+/* need to fill in doc-strings for these methods on import -- copy from
+ array docstrings
+*/
+static PyMethodDef gentype_methods[] = {
+ {"tolist", (PyCFunction)gentype_tolist, 1, NULL},
+ {"item", (PyCFunction)gentype_item, METH_VARARGS, NULL},
+ {"itemset", (PyCFunction)gentype_itemset, METH_VARARGS, NULL},
+ {"tofile", (PyCFunction)gentype_tofile,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"tostring", (PyCFunction)gentype_tostring, METH_VARARGS, NULL},
+ {"byteswap", (PyCFunction)gentype_byteswap,1, NULL},
+ {"astype", (PyCFunction)gentype_astype, 1, NULL},
+ {"getfield", (PyCFunction)gentype_getfield,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"setfield", (PyCFunction)gentype_setfield,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"copy", (PyCFunction)gentype_copy, 1, NULL},
+ {"resize", (PyCFunction)gentype_resize,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+
+ {"__array__", (PyCFunction)gentype_getarray, 1, doc_getarray},
+ {"__array_wrap__", (PyCFunction)gentype_wraparray, 1, doc_sc_wraparray},
+
+ /* for the copy module */
+ {"__copy__", (PyCFunction)gentype_copy, 1, NULL},
+ {"__deepcopy__", (PyCFunction)gentype___deepcopy__, 1, NULL},
+
+
+ {"__reduce__", (PyCFunction) gentype_reduce, 1, NULL},
+ /* For consistency does nothing */
+ {"__setstate__", (PyCFunction) gentype_setstate, 1, NULL},
+
+ {"dumps", (PyCFunction) gentype_dumps, 1, NULL},
+ {"dump", (PyCFunction) gentype_dump, 1, NULL},
+
+ /* Methods for array */
+ {"fill", (PyCFunction)gentype_fill,
+ METH_VARARGS, NULL},
+ {"transpose", (PyCFunction)gentype_transpose,
+ METH_VARARGS, NULL},
+ {"take", (PyCFunction)gentype_take,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"put", (PyCFunction)gentype_put,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"repeat", (PyCFunction)gentype_repeat,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"choose", (PyCFunction)gentype_choose,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"sort", (PyCFunction)gentype_sort,
+ METH_VARARGS, NULL},
+ {"argsort", (PyCFunction)gentype_argsort,
+ METH_VARARGS, NULL},
+ {"searchsorted", (PyCFunction)gentype_searchsorted,
+ METH_VARARGS, NULL},
+ {"argmax", (PyCFunction)gentype_argmax,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"argmin", (PyCFunction)gentype_argmin,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"reshape", (PyCFunction)gentype_reshape,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"squeeze", (PyCFunction)gentype_squeeze,
+ METH_VARARGS, NULL},
+ {"view", (PyCFunction)gentype_view,
+ METH_VARARGS, NULL},
+ {"swapaxes", (PyCFunction)gentype_swapaxes,
+ METH_VARARGS, NULL},
+ {"max", (PyCFunction)gentype_max,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"min", (PyCFunction)gentype_min,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"ptp", (PyCFunction)gentype_ptp,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"mean", (PyCFunction)gentype_mean,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"trace", (PyCFunction)gentype_trace,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"diagonal", (PyCFunction)gentype_diagonal,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"clip", (PyCFunction)gentype_clip,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"conj", (PyCFunction)gentype_conj,
+ METH_VARARGS, NULL},
+ {"conjugate", (PyCFunction)gentype_conjugate,
+ METH_VARARGS, NULL},
+ {"nonzero", (PyCFunction)gentype_nonzero,
+ METH_VARARGS, NULL},
+ {"std", (PyCFunction)gentype_std,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"var", (PyCFunction)gentype_var,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"sum", (PyCFunction)gentype_sum,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"cumsum", (PyCFunction)gentype_cumsum,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"prod", (PyCFunction)gentype_prod,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"cumprod", (PyCFunction)gentype_cumprod,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"all", (PyCFunction)gentype_all,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"any", (PyCFunction)gentype_any,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"compress", (PyCFunction)gentype_compress,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"flatten", (PyCFunction)gentype_flatten,
+ METH_VARARGS, NULL},
+ {"ravel", (PyCFunction)gentype_ravel,
+ METH_VARARGS, NULL},
+ {"round", (PyCFunction)gentype_round,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"setflags", (PyCFunction)gentype_setflags,
+ METH_VARARGS|METH_KEYWORDS, NULL},
+ {"newbyteorder", (PyCFunction)gentype_newbyteorder,
+ METH_VARARGS, NULL},
+ {NULL, NULL} /* sentinel */
+};
+
+
+static PyGetSetDef voidtype_getsets[] = {
+ {"flags",
+ (getter)voidtype_flags_get,
+ (setter)0,
+ "integer value of flags"},
+ {"dtype",
+ (getter)voidtype_dtypedescr_get,
+ (setter)0,
+ "dtype object"},
+ {NULL, NULL}
+};
+
+static PyMethodDef voidtype_methods[] = {
+ {"getfield", (PyCFunction)voidtype_getfield,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"setfield", (PyCFunction)voidtype_setfield,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {NULL, NULL}
+};
+
+/************* As_mapping functions for void array scalar ************/
+
+static Py_ssize_t
+voidtype_length(PyVoidScalarObject *self)
+{
+ if (!self->descr->names) {
+ return 0;
+ }
+ else { /* return the number of fields */
+ return (Py_ssize_t) PyTuple_GET_SIZE(self->descr->names);
+ }
+}
+
+static PyObject *
+voidtype_item(PyVoidScalarObject *self, Py_ssize_t n)
+{
+ intp m;
+ PyObject *flist=NULL, *fieldinfo;
+
+ if (!(PyDescr_HASFIELDS(self->descr))) {
+ PyErr_SetString(PyExc_IndexError,
+ "can't index void scalar without fields");
+ return NULL;
+ }
+ flist = self->descr->names;
+ m = PyTuple_GET_SIZE(flist);
+ if (n < 0) n += m;
+ if (n < 0 || n >= m) {
+ PyErr_Format(PyExc_IndexError, "invalid index (%d)", (int) n);
+ return NULL;
+ }
+ fieldinfo = PyDict_GetItem(self->descr->fields,
+ PyTuple_GET_ITEM(flist, n));
+ return voidtype_getfield(self, fieldinfo, NULL);
+}
+
+
+/* get field by name or number */
+static PyObject *
+voidtype_subscript(PyVoidScalarObject *self, PyObject *ind)
+{
+ intp n;
+ PyObject *fieldinfo;
+
+ if (!(PyDescr_HASFIELDS(self->descr))) {
+ PyErr_SetString(PyExc_IndexError,
+ "can't index void scalar without fields");
+ return NULL;
+ }
+
+ if (PyString_Check(ind) || PyUnicode_Check(ind)) {
+ /* look up in fields */
+ fieldinfo = PyDict_GetItem(self->descr->fields, ind);
+ if (!fieldinfo) goto fail;
+ return voidtype_getfield(self, fieldinfo, NULL);
+ }
+
+ /* try to convert it to a number */
+ n = PyArray_PyIntAsIntp(ind);
+ if (error_converting(n)) goto fail;
+
+ return voidtype_item(self, (Py_ssize_t)n);
+
+ fail:
+ PyErr_SetString(PyExc_IndexError, "invalid index");
+ return NULL;
+
+}
+
+static int
+voidtype_ass_item(PyVoidScalarObject *self, Py_ssize_t n, PyObject *val)
+{
+ intp m;
+ PyObject *flist=NULL, *fieldinfo, *newtup;
+ PyObject *res;
+
+ if (!(PyDescr_HASFIELDS(self->descr))) {
+ PyErr_SetString(PyExc_IndexError,
+ "can't index void scalar without fields");
+ return -1;
+ }
+
+ flist = self->descr->names;
+ m = PyTuple_GET_SIZE(flist);
+ if (n < 0) n += m;
+ if (n < 0 || n >= m) goto fail;
+ fieldinfo = PyDict_GetItem(self->descr->fields,
+ PyTuple_GET_ITEM(flist, n));
+ newtup = Py_BuildValue("(OOO)", val,
+ PyTuple_GET_ITEM(fieldinfo, 0),
+ PyTuple_GET_ITEM(fieldinfo, 1));
+ res = voidtype_setfield(self, newtup, NULL);
+ Py_DECREF(newtup);
+ if (!res) return -1;
+ Py_DECREF(res);
+ return 0;
+
+ fail:
+ PyErr_Format(PyExc_IndexError, "invalid index (%d)", (int) n);
+ return -1;
+
+}
+
+static int
+voidtype_ass_subscript(PyVoidScalarObject *self, PyObject *ind, PyObject *val)
+{
+ intp n;
+ char *msg = "invalid index";
+ PyObject *fieldinfo, *newtup;
+ PyObject *res;
+
+ if (!PyDescr_HASFIELDS(self->descr)) {
+ PyErr_SetString(PyExc_IndexError,
+ "can't index void scalar without fields");
+ return -1;
+ }
+
+ if (PyString_Check(ind) || PyUnicode_Check(ind)) {
+ /* look up in fields */
+ fieldinfo = PyDict_GetItem(self->descr->fields, ind);
+ if (!fieldinfo) goto fail;
+ newtup = Py_BuildValue("(OOO)", val,
+ PyTuple_GET_ITEM(fieldinfo, 0),
+ PyTuple_GET_ITEM(fieldinfo, 1));
+ res = voidtype_setfield(self, newtup, NULL);
+ Py_DECREF(newtup);
+ if (!res) return -1;
+ Py_DECREF(res);
+ return 0;
+ }
+
+ /* try to convert it to a number */
+ n = PyArray_PyIntAsIntp(ind);
+ if (error_converting(n)) goto fail;
+ return voidtype_ass_item(self, (Py_ssize_t)n, val);
+
+ fail:
+ PyErr_SetString(PyExc_IndexError, msg);
+ return -1;
+}
+
+static PyMappingMethods voidtype_as_mapping = {
+#if PY_VERSION_HEX >= 0x02050000
+ (lenfunc)voidtype_length, /*mp_length*/
+#else
+ (inquiry)voidtype_length, /*mp_length*/
+#endif
+ (binaryfunc)voidtype_subscript, /*mp_subscript*/
+ (objobjargproc)voidtype_ass_subscript, /*mp_ass_subscript*/
+};
+
+
+static PySequenceMethods voidtype_as_sequence = {
+#if PY_VERSION_HEX >= 0x02050000
+ (lenfunc)voidtype_length, /*sq_length*/
+ 0, /*sq_concat*/
+ 0, /*sq_repeat*/
+ (ssizeargfunc)voidtype_item, /*sq_item*/
+ 0, /*sq_slice*/
+ (ssizeobjargproc)voidtype_ass_item /*sq_ass_item*/
+#else
+ (inquiry)voidtype_length, /*sq_length*/
+ 0, /*sq_concat*/
+ 0, /*sq_repeat*/
+ (intargfunc)voidtype_item, /*sq_item*/
+ 0, /*sq_slice*/
+ (intobjargproc)voidtype_ass_item /*sq_ass_item*/
+#endif
+};
+
+
+
+static Py_ssize_t
+gentype_getreadbuf(PyObject *self, Py_ssize_t segment, void **ptrptr)
+{
+ int numbytes;
+ PyArray_Descr *outcode;
+
+ if (segment != 0) {
+ PyErr_SetString(PyExc_SystemError,
+ "Accessing non-existent array segment");
+ return -1;
+ }
+
+ outcode = PyArray_DescrFromScalar(self);
+ numbytes = outcode->elsize;
+ *ptrptr = (void *)scalar_value(self, outcode);
+
+#ifndef Py_UNICODE_WIDE
+ if (outcode->type_num == NPY_UNICODE) {
+ numbytes >>= 1;
+ }
+#endif
+ Py_DECREF(outcode);
+ return numbytes;
+}
+
+static Py_ssize_t
+gentype_getsegcount(PyObject *self, Py_ssize_t *lenp)
+{
+ PyArray_Descr *outcode;
+
+ outcode = PyArray_DescrFromScalar(self);
+ if (lenp) {
+ *lenp = outcode->elsize;
+#ifndef Py_UNICODE_WIDE
+ if (outcode->type_num == NPY_UNICODE) {
+ *lenp >>= 1;
+ }
+#endif
+ }
+ Py_DECREF(outcode);
+ return 1;
+}
+
+static Py_ssize_t
+gentype_getcharbuf(PyObject *self, Py_ssize_t segment, constchar **ptrptr)
+{
+ if (PyArray_IsScalar(self, String) || \
+ PyArray_IsScalar(self, Unicode))
+ return gentype_getreadbuf(self, segment, (void **)ptrptr);
+ else {
+ PyErr_SetString(PyExc_TypeError,
+ "Non-character array cannot be interpreted "\
+ "as character buffer.");
+ return -1;
+ }
+}
+
+
+static PyBufferProcs gentype_as_buffer = {
+ gentype_getreadbuf, /*bf_getreadbuffer*/
+ NULL, /*bf_getwritebuffer*/
+ gentype_getsegcount, /*bf_getsegcount*/
+ gentype_getcharbuf, /*bf_getcharbuffer*/
+};
+
+
+#define BASEFLAGS Py_TPFLAGS_DEFAULT | Py_TPFLAGS_BASETYPE | Py_TPFLAGS_CHECKTYPES
+#define LEAFFLAGS Py_TPFLAGS_DEFAULT | Py_TPFLAGS_CHECKTYPES
+
+static PyTypeObject PyGenericArrType_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0, /*ob_size*/
+ "numpy.generic", /*tp_name*/
+ sizeof(PyObject), /*tp_basicsize*/
+};
+
+static void
+void_dealloc(PyVoidScalarObject *v)
+{
+ if (v->flags & OWNDATA)
+ PyDataMem_FREE(v->obval);
+ Py_XDECREF(v->descr);
+ Py_XDECREF(v->base);
+ v->ob_type->tp_free(v);
+}
+
+static void
+object_arrtype_dealloc(PyObject *v)
+{
+ Py_XDECREF(((PyObjectScalarObject *)v)->obval);
+ v->ob_type->tp_free(v);
+}
+
+/* string and unicode inherit from Python Type first and so GET_ITEM is different to get to the Python Type.
+ */
+/* ok is a work-around for a bug in complex_new that doesn't allocate
+ memory from the sub-types memory allocator.
+*/
+
+#define _WORK(num) \
+ if (type->tp_bases && (PyTuple_GET_SIZE(type->tp_bases)==2)) { \
+ PyTypeObject *sup; \
+ /* We are inheriting from a Python type as well so \
+ give it first dibs on conversion */ \
+ sup = (PyTypeObject *)PyTuple_GET_ITEM(type->tp_bases, num); \
+ robj = sup->tp_new(type, args, kwds); \
+ if (robj != NULL) goto finish; \
+ if (PyTuple_GET_SIZE(args)!=1) return NULL; \
+ PyErr_Clear(); \
+ /* now do default conversion */ \
+ }
+
+#define _WORK1 _WORK(1)
+#define _WORKz _WORK(0)
+#define _WORK0
+
+/**begin repeat1
+#name=byte, short, int, long, longlong, ubyte, ushort, uint, ulong, ulonglong, float, double, longdouble, cfloat, cdouble, clongdouble, string, unicode, object#
+#TYPE=BYTE, SHORT, INT, LONG, LONGLONG, UBYTE, USHORT, UINT, ULONG, ULONGLONG, FLOAT, DOUBLE, LONGDOUBLE, CFLOAT, CDOUBLE, CLONGDOUBLE, STRING, UNICODE, OBJECT#
+#work=0,0,1,1,1,0,0,0,0,0,0,1,0,0,0,0,z,z,1#
+#default=0*16,1*2,2#
+*/
+static PyObject *
+@name@_arrtype_new(PyTypeObject *type, PyObject *args, PyObject *kwds)
+{
+ PyObject *obj=NULL;
+ PyObject *robj;
+ PyObject *arr;
+ PyArray_Descr *typecode=NULL;
+ int itemsize;
+ void *dest, *src;
+
+ _WORK@work@
+
+ if (!PyArg_ParseTuple(args, "|O", &obj)) return NULL;
+
+ typecode = PyArray_DescrFromType(PyArray_@TYPE@);
+ Py_INCREF(typecode);
+ if (obj == NULL) {
+#if @default@ == 0
+ char *mem;
+ mem = malloc(sizeof(@name@));
+ memset(mem, 0, sizeof(@name@));
+ robj = PyArray_Scalar(mem, typecode, NULL);
+ free(mem);
+#elif @default@ == 1
+ robj = PyArray_Scalar(NULL, typecode, NULL);
+#elif @default@ == 2
+ obj = Py_None;
+ robj = PyArray_Scalar(&obj, typecode, NULL);
+#endif
+ goto finish;
+ }
+
+ arr = PyArray_FromAny(obj, typecode, 0, 0, FORCECAST, NULL);
+ if ((arr==NULL) || (PyArray_NDIM(arr) > 0)) return arr;
+ robj = PyArray_Return((PyArrayObject *)arr);
+
+ finish:
+ if ((robj==NULL) || (robj->ob_type == type)) return robj;
+ /* Need to allocate new type and copy data-area over */
+ if (type->tp_itemsize) {
+ itemsize = PyString_GET_SIZE(robj);
+ }
+ else itemsize = 0;
+ obj = type->tp_alloc(type, itemsize);
+ if (obj == NULL) {Py_DECREF(robj); return NULL;}
+ if (typecode==NULL)
+ typecode = PyArray_DescrFromType(PyArray_@TYPE@);
+ dest = scalar_value(obj, typecode);
+ src = scalar_value(robj, typecode);
+ Py_DECREF(typecode);
+#if @default@ == 0
+ *((npy_@name@ *)dest) = *((npy_@name@ *)src);
+#elif @default@ == 1
+ if (itemsize == 0) {
+ itemsize = ((PyUnicodeObject *)robj)->length << 2;
+ }
+ memcpy(dest, src, itemsize);
+#elif @default@ == 2
+ memcpy(dest, src, sizeof(void *));
+ Py_INCREF(*((PyObject **)dest));
+#endif
+ Py_DECREF(robj);
+ return obj;
+}
+/**end repeat**/
+
+#undef _WORK1
+#undef _WORKz
+#undef _WORK0
+#undef _WORK
+
+/* bool->tp_new only returns Py_True or Py_False */
+static PyObject *
+bool_arrtype_new(PyTypeObject *type, PyObject *args, PyObject *kwds)
+{
+ PyObject *obj=NULL;
+ PyObject *arr;
+
+ if (!PyArg_ParseTuple(args, "|O", &obj)) return NULL;
+ if (obj == NULL)
+ PyArrayScalar_RETURN_FALSE;
+ if (obj == Py_False)
+ PyArrayScalar_RETURN_FALSE;
+ if (obj == Py_True)
+ PyArrayScalar_RETURN_TRUE;
+ arr = PyArray_FROM_OTF(obj, PyArray_BOOL, FORCECAST);
+ if (arr && 0 == PyArray_NDIM(arr)) {
+ Bool val = *((Bool *)PyArray_DATA(arr));
+ Py_DECREF(arr);
+ PyArrayScalar_RETURN_BOOL_FROM_LONG(val);
+ }
+ return PyArray_Return((PyArrayObject *)arr);
+}
+
+static PyObject *
+bool_arrtype_and(PyObject *a, PyObject *b)
+{
+ if (PyArray_IsScalar(a, Bool) && PyArray_IsScalar(b, Bool))
+ PyArrayScalar_RETURN_BOOL_FROM_LONG
+ ((a == PyArrayScalar_True)&(b == PyArrayScalar_True));
+ return PyGenericArrType_Type.tp_as_number->nb_and(a, b);
+}
+
+static PyObject *
+bool_arrtype_or(PyObject *a, PyObject *b)
+{
+ if (PyArray_IsScalar(a, Bool) && PyArray_IsScalar(b, Bool))
+ PyArrayScalar_RETURN_BOOL_FROM_LONG
+ ((a == PyArrayScalar_True)|(b == PyArrayScalar_True));
+ return PyGenericArrType_Type.tp_as_number->nb_or(a, b);
+}
+
+static PyObject *
+bool_arrtype_xor(PyObject *a, PyObject *b)
+{
+ if (PyArray_IsScalar(a, Bool) && PyArray_IsScalar(b, Bool))
+ PyArrayScalar_RETURN_BOOL_FROM_LONG
+ ((a == PyArrayScalar_True)^(b == PyArrayScalar_True));
+ return PyGenericArrType_Type.tp_as_number->nb_xor(a, b);
+}
+
+static int
+bool_arrtype_nonzero(PyObject *a)
+{
+ return a == PyArrayScalar_True;
+}
+
+#if PY_VERSION_HEX >= 0x02050000
+/**begin repeat
+#name=byte, short, int, long, ubyte, ushort, longlong, uint, ulong, ulonglong#
+#Name=Byte, Short, Int, Long, UByte, UShort, LongLong, UInt, ULong, ULongLong#
+#type=PyInt_FromLong*6, PyLong_FromLongLong*1, PyLong_FromUnsignedLong*2, PyLong_FromUnsignedLongLong#
+*/
+static PyNumberMethods @name@_arrtype_as_number;
+static PyObject *
+@name@_index(PyObject *self)
+{
+ return @type@(PyArrayScalar_VAL(self, @Name@));
+}
+/**end repeat**/
+static PyObject *
+bool_index(PyObject *a)
+{
+ return PyInt_FromLong(PyArrayScalar_VAL(a, Bool));
+}
+#endif
+
+/* Arithmetic methods -- only so we can override &, |, ^. */
+static PyNumberMethods bool_arrtype_as_number = {
+ 0, /* nb_add */
+ 0, /* nb_subtract */
+ 0, /* nb_multiply */
+ 0, /* nb_divide */
+ 0, /* nb_remainder */
+ 0, /* nb_divmod */
+ 0, /* nb_power */
+ 0, /* nb_negative */
+ 0, /* nb_positive */
+ 0, /* nb_absolute */
+ (inquiry)bool_arrtype_nonzero, /* nb_nonzero */
+ 0, /* nb_invert */
+ 0, /* nb_lshift */
+ 0, /* nb_rshift */
+ (binaryfunc)bool_arrtype_and, /* nb_and */
+ (binaryfunc)bool_arrtype_xor, /* nb_xor */
+ (binaryfunc)bool_arrtype_or, /* nb_or */
+};
+
+static PyObject *
+void_arrtype_new(PyTypeObject *type, PyObject *args, PyObject *kwds)
+{
+ PyObject *obj, *arr;
+ ulonglong memu=1;
+ PyObject *new=NULL;
+ char *destptr;
+
+ if (!PyArg_ParseTuple(args, "O", &obj)) return NULL;
+ /* For a VOID scalar first see if obj is an integer or long
+ and create new memory of that size (filled with 0) for the scalar
+ */
+
+ if (PyLong_Check(obj) || PyInt_Check(obj) || \
+ PyArray_IsScalar(obj, Integer) ||
+ (PyArray_Check(obj) && PyArray_NDIM(obj)==0 && \
+ PyArray_ISINTEGER(obj))) {
+ new = obj->ob_type->tp_as_number->nb_long(obj);
+ }
+ if (new && PyLong_Check(new)) {
+ PyObject *ret;
+ memu = PyLong_AsUnsignedLongLong(new);
+ Py_DECREF(new);
+ if (PyErr_Occurred() || (memu > MAX_INT)) {
+ PyErr_Clear();
+ PyErr_Format(PyExc_OverflowError,
+ "size must be smaller than %d",
+ (int) MAX_INT);
+ return NULL;
+ }
+ destptr = PyDataMem_NEW((int) memu);
+ if (destptr == NULL) return PyErr_NoMemory();
+ ret = type->tp_alloc(type, 0);
+ if (ret == NULL) {
+ PyDataMem_FREE(destptr);
+ return PyErr_NoMemory();
+ }
+ ((PyVoidScalarObject *)ret)->obval = destptr;
+ ((PyVoidScalarObject *)ret)->ob_size = (int) memu;
+ ((PyVoidScalarObject *)ret)->descr = \
+ PyArray_DescrNewFromType(PyArray_VOID);
+ ((PyVoidScalarObject *)ret)->descr->elsize = (int) memu;
+ ((PyVoidScalarObject *)ret)->flags = BEHAVED | OWNDATA;
+ ((PyVoidScalarObject *)ret)->base = NULL;
+ memset(destptr, '\0', (size_t) memu);
+ return ret;
+ }
+
+ arr = PyArray_FROM_OTF(obj, PyArray_VOID, FORCECAST);
+ return PyArray_Return((PyArrayObject *)arr);
+}
+
+
+/**************** Define Hash functions ********************/
+
+/**begin repeat
+#lname=bool,ubyte,ushort#
+#name=Bool,UByte, UShort#
+ */
+static long
+@lname@_arrtype_hash(PyObject *obj)
+{
+ return (long)(((Py@name@ScalarObject *)obj)->obval);
+}
+/**end repeat**/
+
+/**begin repeat
+#lname=byte,short,uint,ulong#
+#name=Byte,Short,UInt,ULong#
+ */
+static long
+@lname@_arrtype_hash(PyObject *obj)
+{
+ long x = (long)(((Py@name@ScalarObject *)obj)->obval);
+ if (x == -1) x=-2;
+ return x;
+}
+/**end repeat**/
+
+#if SIZEOF_INT != SIZEOF_LONG
+static long
+int_arrtype_hash(PyObject *obj)
+{
+ long x = (long)(((PyIntScalarObject *)obj)->obval);
+ if (x == -1) x=-2;
+ return x;
+}
+#endif
+
+/**begin repeat
+#char=,u#
+#Char=,U#
+#ext=&& (x >= LONG_MIN),#
+*/
+#if SIZEOF_LONG != SIZEOF_LONGLONG
+/* we assume SIZEOF_LONGLONG=2*SIZEOF_LONG */
+static long
+@char@longlong_arrtype_hash(PyObject *obj)
+{
+ long y;
+ @char@longlong x = (((Py@Char@LongLongScalarObject *)obj)->obval);
+
+ if ((x <= LONG_MAX)@ext@) {
+ y = (long) x;
+ }
+ else {
+ union Mask {
+ long hashvals[2];
+ @char@longlong v;
+ } both;
+
+ both.v = x;
+ y = both.hashvals[0] + (1000003)*both.hashvals[1];
+ }
+ if (y == -1) y = -2;
+ return y;
+}
+#endif
+/**end repeat**/
+
+#if SIZEOF_LONG==SIZEOF_LONGLONG
+static long
+ulonglong_arrtype_hash(PyObject *obj)
+{
+ long x = (long)(((PyULongLongScalarObject *)obj)->obval);
+ if (x == -1) x=-2;
+ return x;
+}
+#endif
+
+
+
+/* Wrong thing to do for longdouble, but....*/
+/**begin repeat
+#lname=float, longdouble#
+#name=Float, LongDouble#
+ */
+static long
+@lname@_arrtype_hash(PyObject *obj)
+{
+ return _Py_HashDouble((double) ((Py@name@ScalarObject *)obj)->obval);
+}
+
+/* borrowed from complex_hash */
+static long
+c@lname@_arrtype_hash(PyObject *obj)
+{
+ long hashreal, hashimag, combined;
+ hashreal = _Py_HashDouble((double) \
+ (((PyC@name@ScalarObject *)obj)->obval).real);
+
+ if (hashreal == -1) return -1;
+ hashimag = _Py_HashDouble((double) \
+ (((PyC@name@ScalarObject *)obj)->obval).imag);
+ if (hashimag == -1) return -1;
+
+ combined = hashreal + 1000003 * hashimag;
+ if (combined == -1) combined = -2;
+ return combined;
+}
+/**end repeat**/
+
+static long
+object_arrtype_hash(PyObject *obj)
+{
+ return PyObject_Hash(((PyObjectScalarObject *)obj)->obval);
+}
+
+/* just hash the pointer */
+static long
+void_arrtype_hash(PyObject *obj)
+{
+ return _Py_HashPointer((void *)(((PyVoidScalarObject *)obj)->obval));
+}
+
+/*object arrtype getattro and setattro */
+static PyObject *
+object_arrtype_getattro(PyObjectScalarObject *obj, PyObject *attr) {
+ PyObject *res;
+
+ /* first look in object and then hand off to generic type */
+
+ res = PyObject_GenericGetAttr(obj->obval, attr);
+ if (res) return res;
+ PyErr_Clear();
+ return PyObject_GenericGetAttr((PyObject *)obj, attr);
+}
+
+static int
+object_arrtype_setattro(PyObjectScalarObject *obj, PyObject *attr, PyObject *val) {
+ int res;
+ /* first look in object and then hand off to generic type */
+
+ res = PyObject_GenericSetAttr(obj->obval, attr, val);
+ if (res >= 0) return res;
+ PyErr_Clear();
+ return PyObject_GenericSetAttr((PyObject *)obj, attr, val);
+}
+
+static PyObject *
+object_arrtype_concat(PyObjectScalarObject *self, PyObject *other)
+{
+ return PySequence_Concat(self->obval, other);
+}
+
+static Py_ssize_t
+object_arrtype_length(PyObjectScalarObject *self)
+{
+ return PyObject_Length(self->obval);
+}
+
+static PyObject *
+object_arrtype_repeat(PyObjectScalarObject *self, Py_ssize_t count)
+{
+ return PySequence_Repeat(self->obval, count);
+}
+
+static PyObject *
+object_arrtype_subscript(PyObjectScalarObject *self, PyObject *key)
+{
+ return PyObject_GetItem(self->obval, key);
+}
+
+static int
+object_arrtype_ass_subscript(PyObjectScalarObject *self, PyObject *key,
+ PyObject *value)
+{
+ return PyObject_SetItem(self->obval, key, value);
+}
+
+static int
+object_arrtype_contains(PyObjectScalarObject *self, PyObject *ob)
+{
+ return PySequence_Contains(self->obval, ob);
+}
+
+static PyObject *
+object_arrtype_inplace_concat(PyObjectScalarObject *self, PyObject *o)
+{
+ return PySequence_InPlaceConcat(self->obval, o);
+}
+
+static PyObject *
+object_arrtype_inplace_repeat(PyObjectScalarObject *self, Py_ssize_t count)
+{
+ return PySequence_InPlaceRepeat(self->obval, count);
+}
+
+static PySequenceMethods object_arrtype_as_sequence = {
+#if PY_VERSION_HEX >= 0x02050000
+ (lenfunc)object_arrtype_length, /*sq_length*/
+ (binaryfunc)object_arrtype_concat, /*sq_concat*/
+ (ssizeargfunc)object_arrtype_repeat, /*sq_repeat*/
+ 0, /*sq_item*/
+ 0, /*sq_slice*/
+ 0, /* sq_ass_item */
+ 0, /* sq_ass_slice */
+ (objobjproc)object_arrtype_contains, /* sq_contains */
+ (binaryfunc)object_arrtype_inplace_concat, /* sq_inplace_concat */
+ (ssizeargfunc)object_arrtype_inplace_repeat, /* sq_inplace_repeat */
+#else
+ (inquiry)object_arrtype_length, /*sq_length*/
+ (binaryfunc)object_arrtype_concat, /*sq_concat*/
+ (intargfunc)object_arrtype_repeat, /*sq_repeat*/
+ 0, /*sq_item*/
+ 0, /*sq_slice*/
+ 0, /* sq_ass_item */
+ 0, /* sq_ass_slice */
+ (objobjproc)object_arrtype_contains, /* sq_contains */
+ (binaryfunc)object_arrtype_inplace_concat, /* sq_inplace_concat */
+ (intargfunc)object_arrtype_inplace_repeat, /* sq_inplace_repeat */
+#endif
+};
+
+static PyMappingMethods object_arrtype_as_mapping = {
+#if PY_VERSION_HEX >= 0x02050000
+ (lenfunc)object_arrtype_length,
+ (binaryfunc)object_arrtype_subscript,
+ (objobjargproc)object_arrtype_ass_subscript,
+#else
+ (inquiry)object_arrtype_length,
+ (binaryfunc)object_arrtype_subscript,
+ (objobjargproc)object_arrtype_ass_subscript,
+#endif
+};
+
+static Py_ssize_t
+object_arrtype_getsegcount(PyObjectScalarObject *self, Py_ssize_t *lenp)
+{
+ Py_ssize_t newlen;
+ int cnt;
+ PyBufferProcs *pb = self->obval->ob_type->tp_as_buffer;
+
+ if (pb == NULL || \
+ pb->bf_getsegcount == NULL || \
+ (cnt = (*pb->bf_getsegcount)(self->obval, &newlen)) != 1)
+ return 0;
+
+ if (lenp)
+ *lenp = newlen;
+
+ return cnt;
+}
+
+static Py_ssize_t
+object_arrtype_getreadbuf(PyObjectScalarObject *self, Py_ssize_t segment, void **ptrptr)
+{
+ PyBufferProcs *pb = self->obval->ob_type->tp_as_buffer;
+
+ if (pb == NULL || \
+ pb->bf_getreadbuffer == NULL ||
+ pb->bf_getsegcount == NULL) {
+ PyErr_SetString(PyExc_TypeError,
+ "expected a readable buffer object");
+ return -1;
+ }
+
+ return (*pb->bf_getreadbuffer)(self->obval, segment, ptrptr);
+}
+
+static Py_ssize_t
+object_arrtype_getwritebuf(PyObjectScalarObject *self, Py_ssize_t segment, void **ptrptr)
+{
+ PyBufferProcs *pb = self->obval->ob_type->tp_as_buffer;
+
+ if (pb == NULL || \
+ pb->bf_getwritebuffer == NULL ||
+ pb->bf_getsegcount == NULL) {
+ PyErr_SetString(PyExc_TypeError,
+ "expected a writeable buffer object");
+ return -1;
+ }
+
+ return (*pb->bf_getwritebuffer)(self->obval, segment, ptrptr);
+}
+
+static Py_ssize_t
+object_arrtype_getcharbuf(PyObjectScalarObject *self, Py_ssize_t segment,
+ constchar **ptrptr)
+{
+ PyBufferProcs *pb = self->obval->ob_type->tp_as_buffer;
+
+ if (pb == NULL || \
+ pb->bf_getcharbuffer == NULL ||
+ pb->bf_getsegcount == NULL) {
+ PyErr_SetString(PyExc_TypeError,
+ "expected a character buffer object");
+ return -1;
+ }
+
+ return (*pb->bf_getcharbuffer)(self->obval, segment, ptrptr);
+}
+
+static PyBufferProcs object_arrtype_as_buffer = {
+#if PY_VERSION_HEX >= 0x02050000
+ (readbufferproc)object_arrtype_getreadbuf,
+ (writebufferproc)object_arrtype_getwritebuf,
+ (segcountproc)object_arrtype_getsegcount,
+ (charbufferproc)object_arrtype_getcharbuf,
+#else
+ (getreadbufferproc)object_arrtype_getreadbuf,
+ (getwritebufferproc)object_arrtype_getwritebuf,
+ (getsegcountproc)object_arrtype_getsegcount,
+ (getcharbufferproc)object_arrtype_getcharbuf,
+#endif
+};
+
+static PyObject *
+object_arrtype_call(PyObjectScalarObject *obj, PyObject *args, PyObject *kwds)
+{
+ return PyObject_Call(obj->obval, args, kwds);
+}
+
+static PyTypeObject PyObjectArrType_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0, /*ob_size*/
+ "numpy.object_", /*tp_name*/
+ sizeof(PyObjectScalarObject), /*tp_basicsize*/
+ 0, /* tp_itemsize */
+ (destructor)object_arrtype_dealloc, /* tp_dealloc */
+ 0, /* tp_print */
+ 0, /* tp_getattr */
+ 0, /* tp_setattr */
+ 0, /* tp_compare */
+ 0, /* tp_repr */
+ 0, /* tp_as_number */
+ &object_arrtype_as_sequence, /* tp_as_sequence */
+ &object_arrtype_as_mapping, /* tp_as_mapping */
+ 0, /* tp_hash */
+ (ternaryfunc)object_arrtype_call, /* tp_call */
+ 0, /* tp_str */
+ (getattrofunc)object_arrtype_getattro, /* tp_getattro */
+ (setattrofunc)object_arrtype_setattro, /* tp_setattro */
+ &object_arrtype_as_buffer, /* tp_as_buffer */
+ 0, /* tp_flags */
+};
+
+/**begin repeat
+#name=bool, string, unicode, void#
+#NAME=Bool, String, Unicode, Void#
+#ex=_,_,_,#
+*/
+static PyTypeObject Py@NAME@ArrType_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0, /*ob_size*/
+ "numpy.@name@@ex@", /*tp_name*/
+ sizeof(Py@NAME@ScalarObject), /*tp_basicsize*/
+};
+/**end repeat**/
+
+/**begin repeat
+#NAME=Byte, Short, Int, Long, LongLong, UByte, UShort, UInt, ULong, ULongLong, Float, Double, LongDouble#
+#name=int*5, uint*5, float*3#
+#CNAME=(CHAR, SHORT, INT, LONG, LONGLONG)*2, FLOAT, DOUBLE, LONGDOUBLE#
+*/
+#if BITSOF_@CNAME@ == 8
+#define _THIS_SIZE "8"
+#elif BITSOF_@CNAME@ == 16
+#define _THIS_SIZE "16"
+#elif BITSOF_@CNAME@ == 32
+#define _THIS_SIZE "32"
+#elif BITSOF_@CNAME@ == 64
+#define _THIS_SIZE "64"
+#elif BITSOF_@CNAME@ == 80
+#define _THIS_SIZE "80"
+#elif BITSOF_@CNAME@ == 96
+#define _THIS_SIZE "96"
+#elif BITSOF_@CNAME@ == 128
+#define _THIS_SIZE "128"
+#elif BITSOF_@CNAME@ == 256
+#define _THIS_SIZE "256"
+#endif
+static PyTypeObject Py@NAME@ArrType_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0, /*ob_size*/
+ "numpy.@name@" _THIS_SIZE, /*tp_name*/
+ sizeof(Py@NAME@ScalarObject), /*tp_basicsize*/
+};
+
+#undef _THIS_SIZE
+/**end repeat**/
+
+/**begin repeat
+#NAME=CFloat, CDouble, CLongDouble#
+#name=complex*3#
+#CNAME=FLOAT, DOUBLE, LONGDOUBLE#
+*/
+#if BITSOF_@CNAME@ == 16
+#define _THIS_SIZE2 "16"
+#define _THIS_SIZE1 "32"
+#elif BITSOF_@CNAME@ == 32
+#define _THIS_SIZE2 "32"
+#define _THIS_SIZE1 "64"
+#elif BITSOF_@CNAME@ == 64
+#define _THIS_SIZE2 "64"
+#define _THIS_SIZE1 "128"
+#elif BITSOF_@CNAME@ == 80
+#define _THIS_SIZE2 "80"
+#define _THIS_SIZE1 "160"
+#elif BITSOF_@CNAME@ == 96
+#define _THIS_SIZE2 "96"
+#define _THIS_SIZE1 "192"
+#elif BITSOF_@CNAME@ == 128
+#define _THIS_SIZE2 "128"
+#define _THIS_SIZE1 "256"
+#elif BITSOF_@CNAME@ == 256
+#define _THIS_SIZE2 "256"
+#define _THIS_SIZE1 "512"
+#endif
+static PyTypeObject Py@NAME@ArrType_Type = {
+ PyObject_HEAD_INIT(NULL)
+ 0, /*ob_size*/
+ "numpy.@name@" _THIS_SIZE1, /*tp_name*/
+ sizeof(Py@NAME@ScalarObject), /*tp_basicsize*/
+ 0, /*tp_itemsize*/
+ 0, /*tp_dealloc*/
+ 0, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+ 0, /*tp_hash */
+ 0, /*tp_call*/
+ 0, /*tp_str*/
+ 0, /*tp_getattro*/
+ 0, /*tp_setattro*/
+ 0, /*tp_as_buffer*/
+ Py_TPFLAGS_DEFAULT, /*tp_flags*/
+ "Composed of two " _THIS_SIZE2 " bit floats", /* tp_doc */
+};
+#undef _THIS_SIZE1
+#undef _THIS_SIZE2
+
+/**end repeat**/
+
+
+
+static PyNumberMethods longdoubletype_as_number;
+static PyNumberMethods clongdoubletype_as_number;
+
+
+static void
+initialize_numeric_types(void)
+{
+ PyGenericArrType_Type.tp_dealloc = (destructor)gentype_dealloc;
+ PyGenericArrType_Type.tp_as_number = &gentype_as_number;
+ PyGenericArrType_Type.tp_as_buffer = &gentype_as_buffer;
+ PyGenericArrType_Type.tp_flags = BASEFLAGS;
+ PyGenericArrType_Type.tp_methods = gentype_methods;
+ PyGenericArrType_Type.tp_getset = gentype_getsets;
+ PyGenericArrType_Type.tp_new = NULL;
+ PyGenericArrType_Type.tp_alloc = gentype_alloc;
+ PyGenericArrType_Type.tp_free = _pya_free;
+ PyGenericArrType_Type.tp_repr = gentype_repr;
+ PyGenericArrType_Type.tp_str = gentype_str;
+ PyGenericArrType_Type.tp_richcompare = gentype_richcompare;
+
+ PyBoolArrType_Type.tp_as_number = &bool_arrtype_as_number;
+#if PY_VERSION_HEX >= 0x02050000
+ /* need to add dummy versions with filled-in nb_index
+ in-order for PyType_Ready to fill in .__index__() method
+ */
+ /**begin repeat
+#name=byte, short, int, long, longlong, ubyte, ushort, uint, ulong, ulonglong#
+#NAME=Byte, Short, Int, Long, LongLong, UByte, UShort, UInt, ULong, ULongLong#
+ */
+ Py@NAME@ArrType_Type.tp_as_number = &@name@_arrtype_as_number;
+ Py@NAME@ArrType_Type.tp_as_number->nb_index = (unaryfunc)@name@_index;
+
+ /**end repeat**/
+ PyBoolArrType_Type.tp_as_number->nb_index = (unaryfunc)bool_index;
+#endif
+
+ PyStringArrType_Type.tp_alloc = NULL;
+ PyStringArrType_Type.tp_free = NULL;
+
+ PyStringArrType_Type.tp_repr = stringtype_repr;
+ PyStringArrType_Type.tp_str = stringtype_str;
+
+ PyUnicodeArrType_Type.tp_repr = unicodetype_repr;
+ PyUnicodeArrType_Type.tp_str = unicodetype_str;
+
+ PyVoidArrType_Type.tp_methods = voidtype_methods;
+ PyVoidArrType_Type.tp_getset = voidtype_getsets;
+ PyVoidArrType_Type.tp_as_mapping = &voidtype_as_mapping;
+ PyVoidArrType_Type.tp_as_sequence = &voidtype_as_sequence;
+
+ /**begin repeat
+#NAME=Number, Integer, SignedInteger, UnsignedInteger, Inexact, Floating,
+ComplexFloating, Flexible, Character#
+ */
+ Py@NAME@ArrType_Type.tp_flags = BASEFLAGS;
+ /**end repeat**/
+
+ /**begin repeat
+#name=bool, byte, short, int, long, longlong, ubyte, ushort, uint, ulong, ulonglong, float, double, longdouble, cfloat, cdouble, clongdouble, string, unicode, void, object#
+#NAME=Bool, Byte, Short, Int, Long, LongLong, UByte, UShort, UInt, ULong, ULongLong, Float, Double, LongDouble, CFloat, CDouble, CLongDouble, String, Unicode, Void, Object#
+ */
+ Py@NAME@ArrType_Type.tp_flags = BASEFLAGS;
+ Py@NAME@ArrType_Type.tp_new = @name@_arrtype_new;
+ Py@NAME@ArrType_Type.tp_richcompare = gentype_richcompare;
+ /**end repeat**/
+
+ /**begin repeat
+#name=bool, byte, short, ubyte, ushort, uint, ulong, ulonglong, float, longdouble, cfloat, clongdouble, void, object#
+#NAME=Bool, Byte, Short, UByte, UShort, UInt, ULong, ULongLong, Float, LongDouble, CFloat, CLongDouble, Void, Object#
+ */
+ Py@NAME@ArrType_Type.tp_hash = @name@_arrtype_hash;
+ /**end repeat**/
+
+#if SIZEOF_INT != SIZEOF_LONG
+ /* We won't be inheriting from Python Int type. */
+ PyIntArrType_Type.tp_hash = int_arrtype_hash;
+#endif
+
+#if SIZEOF_LONG != SIZEOF_LONGLONG
+ /* We won't be inheriting from Python Int type. */
+ PyLongLongArrType_Type.tp_hash = longlong_arrtype_hash;
+#endif
+
+ /* These need to be coded specially because getitem does not
+ return a normal Python type
+ */
+ PyLongDoubleArrType_Type.tp_as_number = &longdoubletype_as_number;
+ PyCLongDoubleArrType_Type.tp_as_number = &clongdoubletype_as_number;
+
+ /**begin repeat
+#name=int, long, hex, oct, float, repr, str#
+#kind=tp_as_number->nb*5, tp*2#
+ */
+ PyLongDoubleArrType_Type.@kind@_@name@ = longdoubletype_@name@;
+ PyCLongDoubleArrType_Type.@kind@_@name@ = clongdoubletype_@name@;
+ /**end repeat**/
+
+ PyStringArrType_Type.tp_itemsize = sizeof(char);
+ PyVoidArrType_Type.tp_dealloc = (destructor) void_dealloc;
+
+ PyArrayIter_Type.tp_iter = PyObject_SelfIter;
+ PyArrayMapIter_Type.tp_iter = PyObject_SelfIter;
+}
+
+
+/* the order of this table is important */
+static PyTypeObject *typeobjects[] = {
+ &PyBoolArrType_Type,
+ &PyByteArrType_Type,
+ &PyUByteArrType_Type,
+ &PyShortArrType_Type,
+ &PyUShortArrType_Type,
+ &PyIntArrType_Type,
+ &PyUIntArrType_Type,
+ &PyLongArrType_Type,
+ &PyULongArrType_Type,
+ &PyLongLongArrType_Type,
+ &PyULongLongArrType_Type,
+ &PyFloatArrType_Type,
+ &PyDoubleArrType_Type,
+ &PyLongDoubleArrType_Type,
+ &PyCFloatArrType_Type,
+ &PyCDoubleArrType_Type,
+ &PyCLongDoubleArrType_Type,
+ &PyObjectArrType_Type,
+ &PyStringArrType_Type,
+ &PyUnicodeArrType_Type,
+ &PyVoidArrType_Type
+};
+
+static int
+_typenum_fromtypeobj(PyObject *type, int user)
+{
+ int typenum, i;
+
+ typenum = PyArray_NOTYPE;
+ i = 0;
+ while(i < PyArray_NTYPES) {
+ if (type == (PyObject *)typeobjects[i]) {
+ typenum = i;
+ break;
+ }
+ i++;
+ }
+
+ if (!user) return typenum;
+
+ /* Search any registered types */
+ i = 0;
+ while (i < PyArray_NUMUSERTYPES) {
+ if (type == (PyObject *)(userdescrs[i]->typeobj)) {
+ typenum = i + PyArray_USERDEF;
+ break;
+ }
+ i++;
+ }
+ return typenum;
+}
+
+static PyArray_Descr *
+_descr_from_subtype(PyObject *type)
+{
+ PyObject *mro;
+ mro = ((PyTypeObject *)type)->tp_mro;
+ if (PyTuple_GET_SIZE(mro) < 2) {
+ return PyArray_DescrFromType(PyArray_OBJECT);
+ }
+ return PyArray_DescrFromTypeObject(PyTuple_GET_ITEM(mro, 1));
+}
+
+/*New reference */
+/*OBJECT_API
+ */
+static PyArray_Descr *
+PyArray_DescrFromTypeObject(PyObject *type)
+{
+ int typenum;
+ PyArray_Descr *new, *conv=NULL;
+
+ /* if it's a builtin type, then use the typenumber */
+ typenum = _typenum_fromtypeobj(type,1);
+ if (typenum != PyArray_NOTYPE) {
+ new = PyArray_DescrFromType(typenum);
+ return new;
+ }
+
+ /* Check the generic types */
+ if ((type == (PyObject *) &PyNumberArrType_Type) || \
+ (type == (PyObject *) &PyInexactArrType_Type) || \
+ (type == (PyObject *) &PyFloatingArrType_Type))
+ typenum = PyArray_DOUBLE;
+ else if (type == (PyObject *)&PyComplexFloatingArrType_Type)
+ typenum = PyArray_CDOUBLE;
+ else if ((type == (PyObject *)&PyIntegerArrType_Type) || \
+ (type == (PyObject *)&PySignedIntegerArrType_Type))
+ typenum = PyArray_LONG;
+ else if (type == (PyObject *) &PyUnsignedIntegerArrType_Type)
+ typenum = PyArray_ULONG;
+ else if (type == (PyObject *) &PyCharacterArrType_Type)
+ typenum = PyArray_STRING;
+ else if ((type == (PyObject *) &PyGenericArrType_Type) || \
+ (type == (PyObject *) &PyFlexibleArrType_Type))
+ typenum = PyArray_VOID;
+
+ if (typenum != PyArray_NOTYPE) {
+ return PyArray_DescrFromType(typenum);
+ }
+
+ /* Otherwise --- type is a sub-type of an array scalar
+ not corresponding to a registered data-type object.
+ */
+
+ /* Do special thing for VOID sub-types
+ */
+ if (PyType_IsSubtype((PyTypeObject *)type, &PyVoidArrType_Type)) {
+ new = PyArray_DescrNewFromType(PyArray_VOID);
+
+ conv = _arraydescr_fromobj(type);
+ if (conv) {
+ new->fields = conv->fields;
+ Py_INCREF(new->fields);
+ new->names = conv->names;
+ Py_INCREF(new->names);
+ new->elsize = conv->elsize;
+ new->subarray = conv->subarray;
+ conv->subarray = NULL;
+ Py_DECREF(conv);
+ }
+ Py_XDECREF(new->typeobj);
+ new->typeobj = (PyTypeObject *)type;
+ Py_INCREF(type);
+ return new;
+ }
+ return _descr_from_subtype(type);
+}
+
+/*OBJECT_API
+ Return the tuple of ordered field names from a dictionary.
+*/
+static PyObject *
+PyArray_FieldNames(PyObject *fields)
+{
+ PyObject *tup;
+ PyObject *ret;
+ PyObject *_numpy_internal;
+
+ if (!PyDict_Check(fields)) {
+ PyErr_SetString(PyExc_TypeError,
+ "Fields must be a dictionary");
+ return NULL;
+ }
+ _numpy_internal = PyImport_ImportModule("numpy.core._internal");
+ if (_numpy_internal == NULL) return NULL;
+ tup = PyObject_CallMethod(_numpy_internal, "_makenames_list", "O", fields);
+ Py_DECREF(_numpy_internal);
+ if (tup == NULL) return NULL;
+ ret = PyTuple_GET_ITEM(tup, 0);
+ ret = PySequence_Tuple(ret);
+ Py_DECREF(tup);
+ return ret;
+}
+
+/* New reference */
+/*OBJECT_API
+ Return descr object from array scalar.
+*/
+static PyArray_Descr *
+PyArray_DescrFromScalar(PyObject *sc)
+{
+ int type_num;
+ PyArray_Descr *descr;
+
+ if (PyArray_IsScalar(sc, Void)) {
+ descr = ((PyVoidScalarObject *)sc)->descr;
+ Py_INCREF(descr);
+ return descr;
+ }
+ descr = PyArray_DescrFromTypeObject((PyObject *)sc->ob_type);
+ if (descr->elsize == 0) {
+ PyArray_DESCR_REPLACE(descr);
+ type_num = descr->type_num;
+ if (type_num == PyArray_STRING)
+ descr->elsize = PyString_GET_SIZE(sc);
+ else if (type_num == PyArray_UNICODE) {
+ descr->elsize = PyUnicode_GET_DATA_SIZE(sc);
+#ifndef Py_UNICODE_WIDE
+ descr->elsize <<= 1;
+#endif
+ }
+ else {
+ descr->elsize =
+ ((PyVoidScalarObject *)sc)->ob_size;
+ descr->fields = PyObject_GetAttrString(sc, "fields");
+ if (!descr->fields || !PyDict_Check(descr->fields) ||
+ (descr->fields == Py_None)) {
+ Py_XDECREF(descr->fields);
+ descr->fields = NULL;
+ }
+ if (descr->fields)
+ descr->names = PyArray_FieldNames(descr->fields);
+ PyErr_Clear();
+ }
+ }
+ return descr;
+}
+
+/* New reference */
+/*OBJECT_API
+ Get a typeobject from a type-number -- can return NULL.
+*/
+static PyObject *
+PyArray_TypeObjectFromType(int type)
+{
+ PyArray_Descr *descr;
+ PyObject *obj;
+
+ descr = PyArray_DescrFromType(type);
+ if (descr == NULL) return NULL;
+ obj = (PyObject *)descr->typeobj;
+ Py_XINCREF(obj);
+ Py_DECREF(descr);
+ return obj;
+}
diff --git a/numpy/core/src/ucsnarrow.c b/numpy/core/src/ucsnarrow.c
new file mode 100644
index 000000000..6eceadd0e
--- /dev/null
+++ b/numpy/core/src/ucsnarrow.c
@@ -0,0 +1,108 @@
+/* Functions only needed on narrow builds of Python
+ for converting back and forth between the NumPy Unicode data-type
+ (always 4-byte)
+ and the Python Unicode scalar (2-bytes on a narrow build).
+*/
+
+/* the ucs2 buffer must be large enough to hold 2*ucs4length characters
+ due to the use of surrogate pairs.
+
+ The return value is the number of ucs2 bytes used-up which
+ is ucs4length + number of surrogate pairs found.
+
+ values above 0xffff are converted to surrogate pairs.
+ */
+static int
+PyUCS2Buffer_FromUCS4(Py_UNICODE *ucs2, PyArray_UCS4 *ucs4, int ucs4length)
+{
+ register int i;
+ int numucs2 = 0;
+ PyArray_UCS4 chr;
+ for (i=0; i<ucs4length; i++) {
+ chr = *ucs4++;
+ if (chr > 0xffff) {
+ numucs2++;
+ chr -= 0x10000L;
+ *ucs2++ = 0xD800 + (Py_UNICODE) (chr >> 10);
+ *ucs2++ = 0xDC00 + (Py_UNICODE) (chr & 0x03FF);
+ }
+ else {
+ *ucs2++ = (Py_UNICODE) chr;
+ }
+ numucs2++;
+ }
+ return numucs2;
+}
+
+
+/* This converts a UCS2 buffer of the given length to UCS4 buffer.
+ It converts up to ucs4len characters of UCS2
+
+ It returns the number of characters converted which can
+ be less than ucslen if there are surrogate pairs in ucs2.
+
+ The return value is the actual size of the used part of the ucs4 buffer.
+*/
+
+static int
+PyUCS2Buffer_AsUCS4(Py_UNICODE *ucs2, PyArray_UCS4 *ucs4, int ucs2len, int ucs4len)
+{
+ register int i;
+ register PyArray_UCS4 chr;
+ register Py_UNICODE ch;
+ register int numchars=0;
+
+ for (i=0; (i < ucs2len) && (numchars < ucs4len); i++) {
+ ch = *ucs2++;
+ if (ch >= 0xd800 && ch <= 0xdfff) {
+ /* surrogate pair */
+ chr = ((PyArray_UCS4)(ch-0xd800)) << 10;
+ chr += *ucs2++ + 0x2400; /* -0xdc00 + 0x10000 */
+ i++;
+ }
+ else {
+ chr = (PyArray_UCS4) ch;
+ }
+ *ucs4++ = chr;
+ numchars++;
+ }
+ return numchars;
+}
+
+
+static PyObject *
+MyPyUnicode_New(int length)
+{
+ PyUnicodeObject *unicode;
+ unicode = PyObject_New(PyUnicodeObject, &PyUnicode_Type);
+ if (unicode == NULL) return NULL;
+ unicode->str = PyMem_NEW(Py_UNICODE, length+1);
+ if (!unicode->str) {
+ _Py_ForgetReference((PyObject *)unicode);
+ PyObject_Del(unicode);
+ return PyErr_NoMemory();
+ }
+ unicode->str[0] = 0;
+ unicode->str[length] = 0;
+ unicode->length = length;
+ unicode->hash = -1;
+ unicode->defenc = NULL;
+ return (PyObject *)unicode;
+}
+
+static int
+MyPyUnicode_Resize(PyUnicodeObject *uni, int length)
+{
+ void *oldstr;
+
+ oldstr = uni->str;
+ PyMem_RESIZE(uni->str, Py_UNICODE, length+1);
+ if (!uni->str) {
+ uni->str = oldstr;
+ PyErr_NoMemory();
+ return -1;
+ }
+ uni->str[length] = 0;
+ uni->length = length;
+ return 0;
+}
diff --git a/numpy/core/src/ufuncobject.c b/numpy/core/src/ufuncobject.c
new file mode 100644
index 000000000..f4c0ed805
--- /dev/null
+++ b/numpy/core/src/ufuncobject.c
@@ -0,0 +1,3891 @@
+/*
+ Python Universal Functions Object -- Math for all types, plus fast
+ arrays math
+
+ Full description
+
+ This supports mathematical (and Boolean) functions on arrays and other python
+ objects. Math on large arrays of basic C types is rather efficient.
+
+ Travis E. Oliphant 2005, 2006 oliphant@ee.byu.edu (oliphant.travis@ieee.org)
+ Brigham Young University
+
+ based on the
+
+ Original Implementation:
+ Copyright (c) 1995, 1996, 1997 Jim Hugunin, hugunin@mit.edu
+
+ with inspiration and code from
+ Numarray
+ Space Science Telescope Institute
+ J. Todd Miller
+ Perry Greenfield
+ Rick White
+
+*/
+
+
+typedef double (DoubleBinaryFunc)(double x, double y);
+typedef float (FloatBinaryFunc)(float x, float y);
+typedef longdouble (LongdoubleBinaryFunc)(longdouble x, longdouble y);
+
+typedef void (CdoubleBinaryFunc)(cdouble *x, cdouble *y, cdouble *res);
+typedef void (CfloatBinaryFunc)(cfloat *x, cfloat *y, cfloat *res);
+typedef void (ClongdoubleBinaryFunc)(clongdouble *x, clongdouble *y, \
+ clongdouble *res);
+
+#define USE_USE_DEFAULTS 1
+
+
+/*UFUNC_API*/
+static void
+PyUFunc_ff_f_As_dd_d(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i, n=dimensions[0];
+ register intp is1=steps[0],is2=steps[1],os=steps[2];
+ char *ip1=args[0], *ip2=args[1], *op=args[2];
+
+ for(i=0; i<n; i++, ip1+=is1, ip2+=is2, op+=os) {
+ *(float *)op = (float)((DoubleBinaryFunc *)func) \
+ ((double)*(float *)ip1, (double)*(float *)ip2);
+ }
+}
+
+/*UFUNC_API*/
+static void
+PyUFunc_ff_f(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i, n=dimensions[0];
+ register intp is1=steps[0],is2=steps[1],os=steps[2];
+ char *ip1=args[0], *ip2=args[1], *op=args[2];
+
+
+ for(i=0; i<n; i++, ip1+=is1, ip2+=is2, op+=os) {
+ *(float *)op = ((FloatBinaryFunc *)func)(*(float *)ip1,
+ *(float *)ip2);
+ }
+}
+
+/*UFUNC_API*/
+static void
+PyUFunc_dd_d(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i, n=dimensions[0];
+ register intp is1=steps[0],is2=steps[1],os=steps[2];
+ char *ip1=args[0], *ip2=args[1], *op=args[2];
+
+
+ for(i=0; i<n; i++, ip1+=is1, ip2+=is2, op+=os) {
+ *(double *)op = ((DoubleBinaryFunc *)func)\
+ (*(double *)ip1, *(double *)ip2);
+ }
+}
+
+/*UFUNC_API*/
+static void
+PyUFunc_gg_g(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i, n=dimensions[0];
+ register intp is1=steps[0],is2=steps[1],os=steps[2];
+ char *ip1=args[0], *ip2=args[1], *op=args[2];
+
+ for(i=0; i<n; i++, ip1+=is1, ip2+=is2, op+=os) {
+ *(longdouble *)op = \
+ ((LongdoubleBinaryFunc *)func)(*(longdouble *)ip1,
+ *(longdouble *)ip2);
+ }
+}
+
+
+/*UFUNC_API*/
+static void
+PyUFunc_FF_F_As_DD_D(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i,n=dimensions[0],is1=steps[0],is2=steps[1],os=steps[2];
+ char *ip1=args[0], *ip2=args[1], *op=args[2];
+ cdouble x, y, r;
+
+ for(i=0; i<n; i++, ip1+=is1, ip2+=is2, op+=os) {
+ x.real = ((float *)ip1)[0]; x.imag = ((float *)ip1)[1];
+ y.real = ((float *)ip2)[0]; y.imag = ((float *)ip2)[1];
+ ((CdoubleBinaryFunc *)func)(&x, &y, &r);
+ ((float *)op)[0] = (float)r.real;
+ ((float *)op)[1] = (float)r.imag;
+ }
+}
+
+/*UFUNC_API*/
+static void
+PyUFunc_DD_D(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i, is1=steps[0],is2=steps[1],os=steps[2],n=dimensions[0];
+ char *ip1=args[0], *ip2=args[1], *op=args[2];
+ cdouble x,y,r;
+
+ for(i=0; i<n; i++, ip1+=is1, ip2+=is2, op+=os) {
+ x.real = ((double *)ip1)[0]; x.imag = ((double *)ip1)[1];
+ y.real = ((double *)ip2)[0]; y.imag = ((double *)ip2)[1];
+ ((CdoubleBinaryFunc *)func)(&x, &y, &r);
+ ((double *)op)[0] = r.real;
+ ((double *)op)[1] = r.imag;
+ }
+}
+
+/*UFUNC_API*/
+static void
+PyUFunc_FF_F(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i, is1=steps[0],is2=steps[1],os=steps[2],n=dimensions[0];
+ char *ip1=args[0], *ip2=args[1], *op=args[2];
+ cfloat x,y,r;
+
+ for(i=0; i<n; i++, ip1+=is1, ip2+=is2, op+=os) {
+ x.real = ((float *)ip1)[0]; x.imag = ((float *)ip1)[1];
+ y.real = ((float *)ip2)[0]; y.imag = ((float *)ip2)[1];
+ ((CfloatBinaryFunc *)func)(&x, &y, &r);
+ ((float *)op)[0] = r.real;
+ ((float *)op)[1] = r.imag;
+ }
+}
+
+/*UFUNC_API*/
+static void
+PyUFunc_GG_G(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i, is1=steps[0],is2=steps[1],os=steps[2],n=dimensions[0];
+ char *ip1=args[0], *ip2=args[1], *op=args[2];
+ clongdouble x,y,r;
+
+ for(i=0; i<n; i++, ip1+=is1, ip2+=is2, op+=os) {
+ x.real = ((longdouble *)ip1)[0];
+ x.imag = ((longdouble *)ip1)[1];
+ y.real = ((longdouble *)ip2)[0];
+ y.imag = ((longdouble *)ip2)[1];
+ ((ClongdoubleBinaryFunc *)func)(&x, &y, &r);
+ ((longdouble *)op)[0] = r.real;
+ ((longdouble *)op)[1] = r.imag;
+ }
+}
+
+/*UFUNC_API*/
+static void
+PyUFunc_OO_O(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i, is1=steps[0],is2=steps[1],os=steps[2], \
+ n=dimensions[0];
+ char *ip1=args[0], *ip2=args[1], *op=args[2];
+ PyObject *tmp;
+ PyObject *x1, *x2;
+
+ for(i=0; i<n; i++, ip1+=is1, ip2+=is2, op+=os) {
+ x1 = *((PyObject **)ip1);
+ x2 = *((PyObject **)ip2);
+ if ((x1 == NULL) || (x2 == NULL)) goto done;
+ if ( (void *) func == (void *) PyNumber_Power)
+ tmp = ((ternaryfunc)func)(x1, x2, Py_None);
+ else
+ tmp = ((binaryfunc)func)(x1, x2);
+ if (PyErr_Occurred()) goto done;
+ Py_XDECREF(*((PyObject **)op));
+ *((PyObject **)op) = tmp;
+ }
+ done:
+ return;
+}
+
+/*UFUNC_API*/
+static void
+PyUFunc_OO_O_method(char **args, intp *dimensions, intp *steps, void *func)
+{
+ intp i, is1=steps[0], is2=steps[1], os=steps[2], n=dimensions[0];
+ PyObject *tmp, *meth, *arglist, *x1, *x2;
+ char *ip1=args[0], *ip2=args[1], *op=args[2];
+
+ for(i=0; i<n; i++, ip1 += is1, ip2 += is2, op += os) {
+ x1 = *(PyObject **)ip1;
+ x2 = *(PyObject **)ip2;
+ if ((x1 == NULL) || (x2 == NULL)) goto done;
+ meth = PyObject_GetAttrString(x1, (char *)func);
+ if (meth != NULL) {
+ arglist = PyTuple_New(1);
+ if (arglist == NULL) {
+ Py_DECREF(meth);
+ goto done;
+ }
+ Py_INCREF(x2);
+ PyTuple_SET_ITEM(arglist, 0, x2);
+ tmp = PyEval_CallObject(meth, arglist);
+ Py_DECREF(arglist);
+ Py_DECREF(meth);
+ if ((tmp==NULL) || PyErr_Occurred()) goto done;
+ Py_XDECREF(*((PyObject **)op));
+ *((PyObject **)op) = tmp;
+ }
+ }
+ done:
+ return;
+
+}
+
+typedef double DoubleUnaryFunc(double x);
+typedef float FloatUnaryFunc(float x);
+typedef longdouble LongdoubleUnaryFunc(longdouble x);
+typedef void CdoubleUnaryFunc(cdouble *x, cdouble *res);
+typedef void CfloatUnaryFunc(cfloat *x, cfloat *res);
+typedef void ClongdoubleUnaryFunc(clongdouble *x, clongdouble *res);
+
+/*UFUNC_API*/
+static void
+PyUFunc_f_f_As_d_d(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i, n=dimensions[0];
+ char *ip1=args[0], *op=args[1];
+ for(i=0; i<n; i++, ip1+=steps[0], op+=steps[1]) {
+ *(float *)op = (float)((DoubleUnaryFunc *)func)((double)*(float *)ip1);
+ }
+}
+
+/*UFUNC_API*/
+static void
+PyUFunc_d_d(char **args, intp *dimensions, intp *steps, void *func)
+{
+ intp i;
+ char *ip1=args[0], *op=args[1];
+ for(i=0; i<*dimensions; i++, ip1+=steps[0], op+=steps[1]) {
+ *(double *)op = ((DoubleUnaryFunc *)func)(*(double *)ip1);
+ }
+}
+
+/*UFUNC_API*/
+static void
+PyUFunc_f_f(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp n=dimensions[0];
+ char *ip1=args[0], *op=args[1];
+ for(i=0; i<n; i++, ip1+=steps[0], op+=steps[1]) {
+ *(float *)op = ((FloatUnaryFunc *)func)(*(float *)ip1);
+ }
+}
+
+/*UFUNC_API*/
+static void
+PyUFunc_g_g(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp n=dimensions[0];
+ char *ip1=args[0], *op=args[1];
+ for(i=0; i<n; i++, ip1+=steps[0], op+=steps[1]) {
+ *(longdouble *)op = ((LongdoubleUnaryFunc *)func)\
+ (*(longdouble *)ip1);
+ }
+}
+
+
+/*UFUNC_API*/
+static void
+PyUFunc_F_F_As_D_D(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i; cdouble x, res;
+ intp n=dimensions[0];
+ char *ip1=args[0], *op=args[1];
+ for(i=0; i<n; i++, ip1+=steps[0], op+=steps[1]) {
+ x.real = ((float *)ip1)[0]; x.imag = ((float *)ip1)[1];
+ ((CdoubleUnaryFunc *)func)(&x, &res);
+ ((float *)op)[0] = (float)res.real;
+ ((float *)op)[1] = (float)res.imag;
+ }
+}
+
+/*UFUNC_API*/
+static void
+PyUFunc_F_F(char **args, intp *dimensions, intp *steps, void *func)
+{
+ intp i; cfloat x, res;
+ char *ip1=args[0], *op=args[1];
+ for(i=0; i<*dimensions; i++, ip1+=steps[0], op+=steps[1]) {
+ x.real = ((float *)ip1)[0];
+ x.imag = ((float *)ip1)[1];
+ ((CfloatUnaryFunc *)func)(&x, &res);
+ ((float *)op)[0] = res.real;
+ ((float *)op)[1] = res.imag;
+ }
+}
+
+
+/*UFUNC_API*/
+static void
+PyUFunc_D_D(char **args, intp *dimensions, intp *steps, void *func)
+{
+ intp i; cdouble x, res;
+ char *ip1=args[0], *op=args[1];
+ for(i=0; i<*dimensions; i++, ip1+=steps[0], op+=steps[1]) {
+ x.real = ((double *)ip1)[0];
+ x.imag = ((double *)ip1)[1];
+ ((CdoubleUnaryFunc *)func)(&x, &res);
+ ((double *)op)[0] = res.real;
+ ((double *)op)[1] = res.imag;
+ }
+}
+
+
+/*UFUNC_API*/
+static void
+PyUFunc_G_G(char **args, intp *dimensions, intp *steps, void *func)
+{
+ intp i; clongdouble x, res;
+ char *ip1=args[0], *op=args[1];
+ for(i=0; i<*dimensions; i++, ip1+=steps[0], op+=steps[1]) {
+ x.real = ((longdouble *)ip1)[0];
+ x.imag = ((longdouble *)ip1)[1];
+ ((ClongdoubleUnaryFunc *)func)(&x, &res);
+ ((double *)op)[0] = res.real;
+ ((double *)op)[1] = res.imag;
+ }
+}
+
+/*UFUNC_API*/
+static void
+PyUFunc_O_O(char **args, intp *dimensions, intp *steps, void *func)
+{
+ intp i; PyObject *tmp, *x1;
+ char *ip1=args[0], *op=args[1];
+
+ for(i=0; i<*dimensions; i++, ip1+=steps[0], op+=steps[1]) {
+ x1 = *(PyObject **)ip1;
+ if (x1 == NULL) goto done;
+ tmp = ((unaryfunc)func)(x1);
+ if ((tmp==NULL) || PyErr_Occurred()) goto done;
+ Py_XDECREF(*((PyObject **)op));
+ *((PyObject **)op) = tmp;
+ }
+ done:
+ return;
+}
+
+/*UFUNC_API*/
+static void
+PyUFunc_O_O_method(char **args, intp *dimensions, intp *steps, void *func)
+{
+ intp i; PyObject *tmp, *meth, *arglist, *x1;
+ char *ip1=args[0], *op=args[1];
+
+ for(i=0; i<*dimensions; i++, ip1+=steps[0], op+=steps[1]) {
+ x1 = *(PyObject **)ip1;
+ if (x1 == NULL) goto done;
+ meth = PyObject_GetAttrString(x1, (char *)func);
+ if (meth != NULL) {
+ arglist = PyTuple_New(0);
+ if (arglist == NULL) {
+ Py_DECREF(meth);
+ goto done;
+ }
+ tmp = PyEval_CallObject(meth, arglist);
+ Py_DECREF(arglist);
+ Py_DECREF(meth);
+ if ((tmp==NULL) || PyErr_Occurred()) goto done;
+ Py_XDECREF(*((PyObject **)op));
+ *((PyObject **)op) = tmp;
+ }
+ }
+ done:
+ return;
+
+}
+
+
+
+/* a general-purpose ufunc that deals with general-purpose Python callable.
+ func is a structure with nin, nout, and a Python callable function
+*/
+
+/*UFUNC_API*/
+static void
+PyUFunc_On_Om(char **args, intp *dimensions, intp *steps, void *func)
+{
+ intp i, j;
+ intp n=dimensions[0];
+ PyUFunc_PyFuncData *data = (PyUFunc_PyFuncData *)func;
+ int nin = data->nin, nout=data->nout;
+ int ntot;
+ PyObject *tocall = data->callable;
+ char *ptrs[NPY_MAXARGS];
+ PyObject *arglist, *result;
+ PyObject *in, **op;
+
+ ntot = nin+nout;
+
+ for (j=0; j < ntot; j++) ptrs[j] = args[j];
+ for(i=0; i<n; i++) {
+ arglist = PyTuple_New(nin);
+ if (arglist == NULL) return;
+ for (j=0; j < nin; j++) {
+ in = *((PyObject **)ptrs[j]);
+ if (in == NULL) {Py_DECREF(arglist); return;}
+ PyTuple_SET_ITEM(arglist, j, in);
+ Py_INCREF(in);
+ }
+ result = PyEval_CallObject(tocall, arglist);
+ Py_DECREF(arglist);
+ if (result == NULL) return;
+ if PyTuple_Check(result) {
+ if (nout != PyTuple_Size(result)) {
+ Py_DECREF(result);
+ return;
+ }
+ for (j=0; j < nout; j++) {
+ op = (PyObject **)ptrs[j+nin];
+ Py_XDECREF(*op);
+ *op = PyTuple_GET_ITEM(result, j);
+ Py_INCREF(*op);
+ }
+ Py_DECREF(result);
+ }
+ else {
+ op = (PyObject **)ptrs[nin];
+ Py_XDECREF(*op);
+ *op = result;
+ }
+ for (j=0; j < ntot; j++) ptrs[j] += steps[j];
+ }
+ return;
+}
+
+
+
+
+/* ---------------------------------------------------------------- */
+
+
+/* fpstatus is the ufunc_formatted hardware status
+ errmask is the handling mask specified by the user.
+ errobj is a Python object with (string, callable object or None)
+ or NULL
+*/
+
+/*
+ 2. for each of the flags
+ determine whether to ignore, warn, raise error, or call Python function.
+ If ignore, do nothing
+ If warn, print a warning and continue
+ If raise return an error
+ If call, call a user-defined function with string
+*/
+
+static int
+_error_handler(int method, PyObject *errobj, char *errtype, int retstatus, int *first)
+{
+ PyObject *pyfunc, *ret, *args;
+ char *name=PyString_AS_STRING(PyTuple_GET_ITEM(errobj,0));
+ char msg[100];
+
+ ALLOW_C_API_DEF
+
+ ALLOW_C_API
+
+ switch(method) {
+ case UFUNC_ERR_WARN:
+ snprintf(msg, 100, "%s encountered in %s", errtype, name);
+ if (PyErr_Warn(PyExc_RuntimeWarning, msg) < 0) goto fail;
+ break;
+ case UFUNC_ERR_RAISE:
+ PyErr_Format(PyExc_FloatingPointError,
+ "%s encountered in %s",
+ errtype, name);
+ goto fail;
+ case UFUNC_ERR_CALL:
+ pyfunc = PyTuple_GET_ITEM(errobj, 1);
+
+ if (pyfunc == Py_None) {
+ PyErr_Format(PyExc_NameError,
+ "python callback specified for %s (in " \
+ " %s) but no function found.",
+ errtype, name);
+ goto fail;
+ }
+ args = Py_BuildValue("NN", PyString_FromString(errtype),
+ PyInt_FromLong((long) retstatus));
+ if (args == NULL) goto fail;
+ ret = PyObject_CallObject(pyfunc, args);
+ Py_DECREF(args);
+ if (ret == NULL) goto fail;
+ Py_DECREF(ret);
+
+ break;
+ case UFUNC_ERR_PRINT:
+ if (*first) {
+ fprintf(stderr, "Warning: %s encountered in %s\n", errtype, name);
+ *first = 0;
+ }
+ break;
+ case UFUNC_ERR_LOG:
+ if (first) {
+ *first = 0;
+ pyfunc = PyTuple_GET_ITEM(errobj, 1);
+ if (pyfunc == Py_None) {
+ PyErr_Format(PyExc_NameError,
+ "log specified for %s (in %s) but no " \
+ "object with write method found.",
+ errtype, name);
+ goto fail;
+ }
+ snprintf(msg, 100, "Warning: %s encountered in %s\n", errtype, name);
+ ret = PyObject_CallMethod(pyfunc, "write", "s", msg);
+ if (ret == NULL) goto fail;
+ Py_DECREF(ret);
+ }
+ break;
+ }
+ DISABLE_C_API
+ return 0;
+
+ fail:
+ DISABLE_C_API
+ return -1;
+}
+
+
+/*UFUNC_API*/
+static int
+PyUFunc_getfperr(void)
+{
+ int retstatus;
+ UFUNC_CHECK_STATUS(retstatus);
+ return retstatus;
+}
+
+#define HANDLEIT(NAME, str) {if (retstatus & UFUNC_FPE_##NAME) { \
+ handle = errmask & UFUNC_MASK_##NAME;\
+ if (handle && \
+ _error_handler(handle >> UFUNC_SHIFT_##NAME, \
+ errobj, str, retstatus, first) < 0) \
+ return -1; \
+ }}
+
+/*UFUNC_API*/
+static int
+PyUFunc_handlefperr(int errmask, PyObject *errobj, int retstatus, int *first)
+{
+ int handle;
+ if (errmask && retstatus) {
+ HANDLEIT(DIVIDEBYZERO, "divide by zero");
+ HANDLEIT(OVERFLOW, "overflow");
+ HANDLEIT(UNDERFLOW, "underflow");
+ HANDLEIT(INVALID, "invalid value");
+ }
+ return 0;
+}
+
+#undef HANDLEIT
+
+
+/*UFUNC_API*/
+static int
+PyUFunc_checkfperr(int errmask, PyObject *errobj, int *first)
+{
+ int retstatus;
+
+ /* 1. check hardware flag --- this is platform dependent code */
+ retstatus = PyUFunc_getfperr();
+ return PyUFunc_handlefperr(errmask, errobj, retstatus, first);
+}
+
+
+/* Checking the status flag clears it */
+/*UFUNC_API*/
+static void
+PyUFunc_clearfperr()
+{
+ PyUFunc_getfperr();
+}
+
+
+#define NO_UFUNCLOOP 0
+#define ZERO_EL_REDUCELOOP 0
+#define ONE_UFUNCLOOP 1
+#define ONE_EL_REDUCELOOP 1
+#define NOBUFFER_UFUNCLOOP 2
+#define NOBUFFER_REDUCELOOP 2
+#define BUFFER_UFUNCLOOP 3
+#define BUFFER_REDUCELOOP 3
+
+
+static char
+_lowest_type(char intype)
+{
+ switch(intype) {
+ /* case PyArray_BYTE */
+ case PyArray_SHORT:
+ case PyArray_INT:
+ case PyArray_LONG:
+ case PyArray_LONGLONG:
+ return PyArray_BYTE;
+ /* case PyArray_UBYTE */
+ case PyArray_USHORT:
+ case PyArray_UINT:
+ case PyArray_ULONG:
+ case PyArray_ULONGLONG:
+ return PyArray_UBYTE;
+ /* case PyArray_FLOAT:*/
+ case PyArray_DOUBLE:
+ case PyArray_LONGDOUBLE:
+ return PyArray_FLOAT;
+ /* case PyArray_CFLOAT:*/
+ case PyArray_CDOUBLE:
+ case PyArray_CLONGDOUBLE:
+ return PyArray_CFLOAT;
+ default:
+ return intype;
+ }
+}
+
+static char *_types_msg = "function not supported for these types, " \
+ "and can't coerce safely to supported types";
+
+/* Called for non-NULL user-defined functions.
+ The object should be a CObject pointing to a linked-list of functions
+ storing the function, data, and signature of all user-defined functions.
+ There must be a match with the input argument types or an error
+ will occur.
+ */
+static int
+_find_matching_userloop(PyObject *obj, int *arg_types,
+ PyArray_SCALARKIND *scalars,
+ PyUFuncGenericFunction *function, void **data,
+ int nargs, int nin)
+{
+ PyUFunc_Loop1d *funcdata;
+ int i;
+ funcdata = (PyUFunc_Loop1d *)PyCObject_AsVoidPtr(obj);
+ while (funcdata != NULL) {
+ for (i=0; i<nin; i++) {
+ if (!PyArray_CanCoerceScalar(arg_types[i],
+ funcdata->arg_types[i],
+ scalars[i]))
+ break;
+ }
+ if (i==nin) { /* match found */
+ *function = funcdata->func;
+ *data = funcdata->data;
+ /* Make sure actual arg_types supported
+ by the loop are used */
+ for (i=0; i<nargs; i++) {
+ arg_types[i] = funcdata->arg_types[i];
+ }
+ return 0;
+ }
+ funcdata = funcdata->next;
+ }
+ PyErr_SetString(PyExc_TypeError, _types_msg);
+ return -1;
+}
+
+/* if only one type is specified then it is the "first" output data-type
+ and the first signature matching this output data-type is returned.
+
+ if a tuple of types is specified then an exact match to the signature
+ is searched and it much match exactly or an error occurs
+*/
+static int
+extract_specified_loop(PyUFuncObject *self, int *arg_types,
+ PyUFuncGenericFunction *function, void **data,
+ PyObject *type_tup, int userdef)
+{
+ Py_ssize_t n=1;
+ int *rtypenums;
+ static char msg[] = "loop written to specified type(s) not found";
+ PyArray_Descr *dtype;
+ int nargs;
+ int i, j;
+ int strtype=0;
+
+ nargs = self->nargs;
+
+ if (PyTuple_Check(type_tup)) {
+ n = PyTuple_GET_SIZE(type_tup);
+ if (n != 1 && n != nargs) {
+ PyErr_Format(PyExc_ValueError,
+ "a type-tuple must be specified " \
+ "of length 1 or %d for %s", nargs,
+ self->name ? self->name : "(unknown)");
+ return -1;
+ }
+ }
+ else if PyString_Check(type_tup) {
+ int slen;
+ char *thestr;
+ slen = PyString_GET_SIZE(type_tup);
+ thestr = PyString_AS_STRING(type_tup);
+ for (i=0; i < slen-2; i++) {
+ if (thestr[i] == '-' && thestr[i+1] == '>')
+ break;
+ }
+ if (i < slen-2) {
+ strtype = 1;
+ n = slen-2;
+ if (i != self->nin ||
+ slen-2-i != self->nout) {
+ PyErr_Format(PyExc_ValueError,
+ "a type-string for %s, " \
+ "requires %d typecode(s) before " \
+ "and %d after the -> sign",
+ self->name ? self->name : "(unknown)",
+ self->nin, self->nout);
+ return -1;
+ }
+ }
+ }
+ rtypenums = (int *)_pya_malloc(n*sizeof(int));
+ if (rtypenums==NULL) {
+ PyErr_NoMemory();
+ return -1;
+ }
+
+ if (strtype) {
+ char *ptr;
+ ptr = PyString_AS_STRING(type_tup);
+ i = 0;
+ while (i < n) {
+ if (*ptr == '-' || *ptr == '>') {
+ ptr++;
+ continue;
+ }
+ dtype = PyArray_DescrFromType((int) *ptr);
+ if (dtype == NULL) goto fail;
+ rtypenums[i] = dtype->type_num;
+ Py_DECREF(dtype);
+ ptr++; i++;
+ }
+ }
+ else if (PyTuple_Check(type_tup)) {
+ for (i=0; i<n; i++) {
+ if (PyArray_DescrConverter(PyTuple_GET_ITEM \
+ (type_tup, i),
+ &dtype) == NPY_FAIL)
+ goto fail;
+ rtypenums[i] = dtype->type_num;
+ Py_DECREF(dtype);
+ }
+ }
+ else {
+ if (PyArray_DescrConverter(type_tup, &dtype) == NPY_FAIL) {
+ goto fail;
+ }
+ rtypenums[0] = dtype->type_num;
+ Py_DECREF(dtype);
+ }
+
+ if (userdef > 0) { /* search in the user-defined functions */
+ PyObject *key, *obj;
+ PyUFunc_Loop1d *funcdata;
+ obj = NULL;
+ key = PyInt_FromLong((long) userdef);
+ if (key == NULL) goto fail;
+ obj = PyDict_GetItem(self->userloops, key);
+ Py_DECREF(key);
+ if (obj == NULL) {
+ PyErr_SetString(PyExc_TypeError,
+ "user-defined type used in ufunc" \
+ " with no registered loops");
+ goto fail;
+ }
+ /* extract the correct function
+ data and argtypes
+ */
+ funcdata = (PyUFunc_Loop1d *)PyCObject_AsVoidPtr(obj);
+ while (funcdata != NULL) {
+ if (n != 1) {
+ for (i=0; i<nargs; i++) {
+ if (rtypenums[i] != funcdata->arg_types[i])
+ break;
+ }
+ }
+ else if (rtypenums[0] == funcdata->arg_types[self->nin]) {
+ i = nargs;
+ }
+ else i = -1;
+ if (i == nargs) {
+ *function = funcdata->func;
+ *data = funcdata->data;
+ for (i=0; i<nargs; i++) {
+ arg_types[i] = funcdata->arg_types[i];
+ }
+ Py_DECREF(obj);
+ goto finish;
+ }
+ funcdata = funcdata->next;
+ }
+ PyErr_SetString(PyExc_TypeError, msg);
+ goto fail;
+ }
+
+ /* look for match in self->functions */
+
+ for (j=0; j<self->ntypes; j++) {
+ if (n != 1) {
+ for (i=0; i<nargs; i++) {
+ if (rtypenums[i] != self->types[j*nargs + i])
+ break;
+ }
+ }
+ else if (rtypenums[0] == self->types[j*nargs+self->nin]) {
+ i = nargs;
+ }
+ else i = -1;
+ if (i == nargs) {
+ *function = self->functions[j];
+ *data = self->data[j];
+ for (i=0; i<nargs; i++) {
+ arg_types[i] = self->types[j*nargs+i];
+ }
+ goto finish;
+ }
+ }
+ PyErr_SetString(PyExc_TypeError, msg);
+
+
+ fail:
+ _pya_free(rtypenums);
+ return -1;
+
+ finish:
+ _pya_free(rtypenums);
+ return 0;
+
+}
+
+
+/* Called to determine coercion
+ Can change arg_types.
+ */
+
+static int
+select_types(PyUFuncObject *self, int *arg_types,
+ PyUFuncGenericFunction *function, void **data,
+ PyArray_SCALARKIND *scalars,
+ PyObject *typetup)
+{
+ int i, j;
+ char start_type;
+ int userdef=-1;
+
+ if (self->userloops) {
+ for (i=0; i<self->nin; i++) {
+ if (PyTypeNum_ISUSERDEF(arg_types[i])) {
+ userdef = arg_types[i];
+ break;
+ }
+ }
+ }
+
+ if (typetup != NULL)
+ return extract_specified_loop(self, arg_types, function, data,
+ typetup, userdef);
+
+ if (userdef > 0) {
+ PyObject *key, *obj;
+ int ret;
+ obj = NULL;
+ key = PyInt_FromLong((long) userdef);
+ if (key == NULL) return -1;
+ obj = PyDict_GetItem(self->userloops, key);
+ Py_DECREF(key);
+ if (obj == NULL) {
+ PyErr_SetString(PyExc_TypeError,
+ "user-defined type used in ufunc" \
+ " with no registered loops");
+ return -1;
+ }
+ /* extract the correct function
+ data and argtypes
+ */
+ ret = _find_matching_userloop(obj, arg_types, scalars,
+ function, data, self->nargs,
+ self->nin);
+ Py_DECREF(obj);
+ return ret;
+ }
+
+ start_type = arg_types[0];
+ /* If the first argument is a scalar we need to place
+ the start type as the lowest type in the class
+ */
+ if (scalars[0] != PyArray_NOSCALAR) {
+ start_type = _lowest_type(start_type);
+ }
+
+ i = 0;
+ while (i<self->ntypes && start_type > self->types[i*self->nargs])
+ i++;
+
+ for(;i<self->ntypes; i++) {
+ for(j=0; j<self->nin; j++) {
+ if (!PyArray_CanCoerceScalar(arg_types[j],
+ self->types[i*self->nargs+j],
+ scalars[j]))
+ break;
+ }
+ if (j == self->nin) break;
+ }
+ if(i>=self->ntypes) {
+ PyErr_SetString(PyExc_TypeError, _types_msg);
+ return -1;
+ }
+ for(j=0; j<self->nargs; j++)
+ arg_types[j] = self->types[i*self->nargs+j];
+
+ if (self->data)
+ *data = self->data[i];
+ else
+ *data = NULL;
+ *function = self->functions[i];
+
+ return 0;
+}
+
+#if USE_USE_DEFAULTS==1
+static int PyUFunc_NUM_NODEFAULTS=0;
+#endif
+static PyObject *PyUFunc_PYVALS_NAME=NULL;
+
+
+static int
+_extract_pyvals(PyObject *ref, char *name, int *bufsize,
+ int *errmask, PyObject **errobj)
+{
+ PyObject *retval;
+
+ *errobj = NULL;
+ if (!PyList_Check(ref) || (PyList_GET_SIZE(ref)!=3)) {
+ PyErr_Format(PyExc_TypeError, "%s must be a length 3 list.",
+ UFUNC_PYVALS_NAME);
+ return -1;
+ }
+
+ *bufsize = PyInt_AsLong(PyList_GET_ITEM(ref, 0));
+ if ((*bufsize == -1) && PyErr_Occurred()) return -1;
+ if ((*bufsize < PyArray_MIN_BUFSIZE) || \
+ (*bufsize > PyArray_MAX_BUFSIZE) || \
+ (*bufsize % 16 != 0)) {
+ PyErr_Format(PyExc_ValueError,
+ "buffer size (%d) is not in range "
+ "(%"INTP_FMT" - %"INTP_FMT") or not a multiple of 16",
+ *bufsize, (intp) PyArray_MIN_BUFSIZE,
+ (intp) PyArray_MAX_BUFSIZE);
+ return -1;
+ }
+
+ *errmask = PyInt_AsLong(PyList_GET_ITEM(ref, 1));
+ if (*errmask < 0) {
+ if (PyErr_Occurred()) return -1;
+ PyErr_Format(PyExc_ValueError, \
+ "invalid error mask (%d)",
+ *errmask);
+ return -1;
+ }
+
+ retval = PyList_GET_ITEM(ref, 2);
+ if (retval != Py_None && !PyCallable_Check(retval)) {
+ PyObject *temp;
+ temp = PyObject_GetAttrString(retval, "write");
+ if (temp == NULL || !PyCallable_Check(temp)) {
+ PyErr_SetString(PyExc_TypeError,
+ "python object must be callable or have " \
+ "a callable write method");
+ Py_XDECREF(temp);
+ return -1;
+ }
+ Py_DECREF(temp);
+ }
+
+ *errobj = Py_BuildValue("NO",
+ PyString_FromString(name),
+ retval);
+ if (*errobj == NULL) return -1;
+
+ return 0;
+}
+
+
+
+/*UFUNC_API*/
+static int
+PyUFunc_GetPyValues(char *name, int *bufsize, int *errmask, PyObject **errobj)
+{
+ PyObject *thedict;
+ PyObject *ref=NULL;
+
+ #if USE_USE_DEFAULTS==1
+ if (PyUFunc_NUM_NODEFAULTS != 0) {
+ #endif
+ if (PyUFunc_PYVALS_NAME == NULL) {
+ PyUFunc_PYVALS_NAME = \
+ PyString_InternFromString(UFUNC_PYVALS_NAME);
+ }
+ thedict = PyThreadState_GetDict();
+ if (thedict == NULL) {
+ thedict = PyEval_GetBuiltins();
+ }
+ ref = PyDict_GetItem(thedict, PyUFunc_PYVALS_NAME);
+ #if USE_USE_DEFAULTS==1
+ }
+ #endif
+ if (ref == NULL) {
+ *errmask = UFUNC_ERR_DEFAULT;
+ *errobj = Py_BuildValue("NO",
+ PyString_FromString(name),
+ Py_None);
+ *bufsize = PyArray_BUFSIZE;
+ return 0;
+ }
+ return _extract_pyvals(ref, name, bufsize, errmask, errobj);
+}
+
+/* Create copies for any arrays that are less than loop->bufsize
+ in total size and are mis-behaved or in need
+ of casting.
+*/
+
+static int
+_create_copies(PyUFuncLoopObject *loop, int *arg_types, PyArrayObject **mps)
+{
+ int nin = loop->ufunc->nin;
+ int i;
+ intp size;
+ PyObject *new;
+ PyArray_Descr *ntype;
+ PyArray_Descr *atype;
+
+ for (i=0; i<nin; i++) {
+ size = PyArray_SIZE(mps[i]);
+ /* if the type of mps[i] is equivalent to arg_types[i] */
+ /* then set arg_types[i] equal to type of
+ mps[i] for later checking....
+ */
+ if (PyArray_TYPE(mps[i]) != arg_types[i]) {
+ ntype = mps[i]->descr;
+ atype = PyArray_DescrFromType(arg_types[i]);
+ if (PyArray_EquivTypes(atype, ntype)) {
+ arg_types[i] = ntype->type_num;
+ }
+ Py_DECREF(atype);
+ }
+ if (size < loop->bufsize) {
+ if (!(PyArray_ISBEHAVED_RO(mps[i])) || \
+ PyArray_TYPE(mps[i]) != arg_types[i]) {
+ ntype = PyArray_DescrFromType(arg_types[i]);
+ new = PyArray_FromAny((PyObject *)mps[i],
+ ntype, 0, 0,
+ FORCECAST | ALIGNED, NULL);
+ if (new == NULL) return -1;
+ Py_DECREF(mps[i]);
+ mps[i] = (PyArrayObject *)new;
+ }
+ }
+ }
+
+ return 0;
+}
+
+#define _GETATTR_(str, rstr) if (strcmp(name, #str) == 0) { \
+ return PyObject_HasAttrString(op, "__" #rstr "__");}
+
+static int
+_has_reflected_op(PyObject *op, char *name)
+{
+ _GETATTR_(add, radd)
+ _GETATTR_(subtract, rsub)
+ _GETATTR_(multiply, rmul)
+ _GETATTR_(divide, rdiv)
+ _GETATTR_(true_divide, rtruediv)
+ _GETATTR_(floor_divide, rfloordiv)
+ _GETATTR_(remainder, rmod)
+ _GETATTR_(power, rpow)
+ _GETATTR_(left_shift, rrlshift)
+ _GETATTR_(right_shift, rrshift)
+ _GETATTR_(bitwise_and, rand)
+ _GETATTR_(bitwise_xor, rxor)
+ _GETATTR_(bitwise_or, ror)
+ return 0;
+}
+
+#undef _GETATTR_
+
+static int
+construct_arrays(PyUFuncLoopObject *loop, PyObject *args, PyArrayObject **mps,
+ PyObject *typetup)
+{
+ int nargs, i;
+ int arg_types[NPY_MAXARGS];
+ PyArray_SCALARKIND scalars[NPY_MAXARGS];
+ PyArray_SCALARKIND maxarrkind, maxsckind, new;
+ PyUFuncObject *self=loop->ufunc;
+ Bool allscalars=TRUE;
+ PyTypeObject *subtype=&PyArray_Type;
+ PyObject *context=NULL;
+ PyObject *obj;
+ int flexible=0;
+ int object=0;
+
+ /* Check number of arguments */
+ nargs = PyTuple_Size(args);
+ if ((nargs < self->nin) || (nargs > self->nargs)) {
+ PyErr_SetString(PyExc_ValueError,
+ "invalid number of arguments");
+ return -1;
+ }
+
+ /* Get each input argument */
+ maxarrkind = PyArray_NOSCALAR;
+ maxsckind = PyArray_NOSCALAR;
+ for (i=0; i<self->nin; i++) {
+ obj = PyTuple_GET_ITEM(args,i);
+ if (!PyArray_Check(obj) && !PyArray_IsScalar(obj, Generic)) {
+ context = Py_BuildValue("OOi", self, args, i);
+ }
+ else context = NULL;
+ mps[i] = (PyArrayObject *)PyArray_FromAny(obj, NULL, 0, 0, 0, context);
+ Py_XDECREF(context);
+ if (mps[i] == NULL) return -1;
+ arg_types[i] = PyArray_TYPE(mps[i]);
+ if (!flexible && PyTypeNum_ISFLEXIBLE(arg_types[i])) {
+ flexible = 1;
+ }
+ if (!object && PyTypeNum_ISOBJECT(arg_types[i])) {
+ object = 1;
+ }
+ /*
+ fprintf(stderr, "array %d has reference %d\n", i,
+ (mps[i])->ob_refcnt);
+ */
+
+ /* Scalars are 0-dimensional arrays
+ at this point
+ */
+
+ /* We need to keep track of whether or not scalars
+ are mixed with arrays of different kinds.
+ */
+
+ if (mps[i]->nd > 0) {
+ scalars[i] = PyArray_NOSCALAR;
+ allscalars=FALSE;
+ new = PyArray_ScalarKind(arg_types[i], NULL);
+ maxarrkind = NPY_MAX(new, maxarrkind);
+ }
+ else {
+ scalars[i] = PyArray_ScalarKind(arg_types[i], &(mps[i]));
+ maxsckind = NPY_MAX(scalars[i], maxsckind);
+ }
+ }
+
+ if (flexible && !object) {
+ loop->notimplemented = 1;
+ return nargs;
+ }
+
+ /* If everything is a scalar, or scalars mixed with arrays of
+ different kinds of lesser types then use normal coercion rules */
+ if (allscalars || (maxsckind > maxarrkind)) {
+ for (i=0; i<self->nin; i++) {
+ scalars[i] = PyArray_NOSCALAR;
+ }
+ }
+
+ /* Select an appropriate function for these argument types. */
+ if (select_types(loop->ufunc, arg_types, &(loop->function),
+ &(loop->funcdata), scalars, typetup) == -1)
+ return -1;
+
+ /* FAIL with NotImplemented if the other object has
+ the __r<op>__ method and has __array_priority__ as
+ an attribute (signalling it can handle ndarray's)
+ and is not already an ndarray
+ */
+ if ((arg_types[1] == PyArray_OBJECT) && \
+ (loop->ufunc->nin==2) && (loop->ufunc->nout == 1)) {
+ PyObject *_obj = PyTuple_GET_ITEM(args, 1);
+ if (!PyArray_CheckExact(_obj) && \
+ PyObject_HasAttrString(_obj, "__array_priority__") && \
+ _has_reflected_op(_obj, loop->ufunc->name)) {
+ loop->notimplemented = 1;
+ return nargs;
+ }
+ }
+
+ /* Create copies for some of the arrays if they are small
+ enough and not already contiguous */
+ if (_create_copies(loop, arg_types, mps) < 0) return -1;
+
+ /* Create Iterators for the Inputs */
+ for (i=0; i<self->nin; i++) {
+ loop->iters[i] = (PyArrayIterObject *) \
+ PyArray_IterNew((PyObject *)mps[i]);
+ if (loop->iters[i] == NULL) return -1;
+ }
+
+ /* Broadcast the result */
+ loop->numiter = self->nin;
+ if (PyArray_Broadcast((PyArrayMultiIterObject *)loop) < 0)
+ return -1;
+
+ /* Get any return arguments */
+ for (i=self->nin; i<nargs; i++) {
+ mps[i] = (PyArrayObject *)PyTuple_GET_ITEM(args, i);
+ if (((PyObject *)mps[i])==Py_None) {
+ mps[i] = NULL;
+ continue;
+ }
+ Py_INCREF(mps[i]);
+ if (!PyArray_Check((PyObject *)mps[i])) {
+ PyObject *new;
+ if (PyArrayIter_Check(mps[i])) {
+ new = PyObject_CallMethod((PyObject *)mps[i],
+ "__array__", NULL);
+ Py_DECREF(mps[i]);
+ mps[i] = (PyArrayObject *)new;
+ }
+ else {
+ PyErr_SetString(PyExc_TypeError,
+ "return arrays must be "\
+ "of ArrayType");
+ Py_DECREF(mps[i]);
+ mps[i] = NULL;
+ return -1;
+ }
+ }
+ if (mps[i]->nd != loop->nd ||
+ !PyArray_CompareLists(mps[i]->dimensions,
+ loop->dimensions, loop->nd)) {
+ PyErr_SetString(PyExc_ValueError,
+ "invalid return array shape");
+ Py_DECREF(mps[i]);
+ mps[i] = NULL;
+ return -1;
+ }
+ if (!PyArray_ISWRITEABLE(mps[i])) {
+ PyErr_SetString(PyExc_ValueError,
+ "return array is not writeable");
+ Py_DECREF(mps[i]);
+ mps[i] = NULL;
+ return -1;
+ }
+ }
+
+ /* construct any missing return arrays and make output iterators */
+
+ for (i=self->nin; i<self->nargs; i++) {
+ PyArray_Descr *ntype;
+
+ if (mps[i] == NULL) {
+ mps[i] = (PyArrayObject *)PyArray_New(subtype,
+ loop->nd,
+ loop->dimensions,
+ arg_types[i],
+ NULL, NULL,
+ 0, 0, NULL);
+ if (mps[i] == NULL) return -1;
+ }
+
+ /* reset types for outputs that are equivalent
+ -- no sense casting uselessly
+ */
+ else {
+ if (mps[i]->descr->type_num != arg_types[i]) {
+ PyArray_Descr *atype;
+ ntype = mps[i]->descr;
+ atype = PyArray_DescrFromType(arg_types[i]);
+ if (PyArray_EquivTypes(atype, ntype)) {
+ arg_types[i] = ntype->type_num;
+ }
+ Py_DECREF(atype);
+ }
+
+ /* still not the same -- or will we have to use buffers?*/
+ if (mps[i]->descr->type_num != arg_types[i] ||
+ !PyArray_ISBEHAVED_RO(mps[i])) {
+ if (loop->size < loop->bufsize) {
+ PyObject *new;
+ /* Copy the array to a temporary copy
+ and set the UPDATEIFCOPY flag
+ */
+ ntype = PyArray_DescrFromType(arg_types[i]);
+ new = PyArray_FromAny((PyObject *)mps[i],
+ ntype, 0, 0,
+ FORCECAST | ALIGNED |
+ UPDATEIFCOPY, NULL);
+ if (new == NULL) return -1;
+ Py_DECREF(mps[i]);
+ mps[i] = (PyArrayObject *)new;
+ }
+ }
+ }
+
+ loop->iters[i] = (PyArrayIterObject *) \
+ PyArray_IterNew((PyObject *)mps[i]);
+ if (loop->iters[i] == NULL) return -1;
+ }
+
+
+ /* If any of different type, or misaligned or swapped
+ then must use buffers */
+
+ loop->bufcnt = 0;
+ loop->obj = 0;
+
+ /* Determine looping method needed */
+ loop->meth = NO_UFUNCLOOP;
+
+ if (loop->size == 0) return nargs;
+
+
+ for (i=0; i<self->nargs; i++) {
+ loop->needbuffer[i] = 0;
+ if (arg_types[i] != mps[i]->descr->type_num ||
+ !PyArray_ISBEHAVED_RO(mps[i])) {
+ loop->meth = BUFFER_UFUNCLOOP;
+ loop->needbuffer[i] = 1;
+ }
+ if (!loop->obj && mps[i]->descr->type_num == PyArray_OBJECT) {
+ loop->obj = 1;
+ }
+ }
+
+ if (loop->meth == NO_UFUNCLOOP) {
+
+ loop->meth = ONE_UFUNCLOOP;
+
+ /* All correct type and BEHAVED */
+ /* Check for non-uniform stridedness */
+
+ for (i=0; i<self->nargs; i++) {
+ if (!(loop->iters[i]->contiguous)) {
+ /* may still have uniform stride
+ if (broadcated result) <= 1-d */
+ if (mps[i]->nd != 0 && \
+ (loop->iters[i]->nd_m1 > 0)) {
+ loop->meth = NOBUFFER_UFUNCLOOP;
+ break;
+ }
+ }
+ }
+ if (loop->meth == ONE_UFUNCLOOP) {
+ for (i=0; i<self->nargs; i++) {
+ loop->bufptr[i] = mps[i]->data;
+ }
+ }
+ }
+
+ loop->numiter = self->nargs;
+
+ /* Fill in steps */
+ if (loop->meth != ONE_UFUNCLOOP) {
+ int ldim;
+ intp minsum;
+ intp maxdim;
+ PyArrayIterObject *it;
+ intp stride_sum[NPY_MAXDIMS];
+ int j;
+
+ /* Fix iterators */
+
+ /* Optimize axis the iteration takes place over
+
+ The first thought was to have the loop go
+ over the largest dimension to minimize the number of loops
+
+ However, on processors with slow memory bus and cache,
+ the slowest loops occur when the memory access occurs for
+ large strides.
+
+ Thus, choose the axis for which strides of the last iterator is
+ smallest but non-zero.
+ */
+
+ for (i=0; i<loop->nd; i++) {
+ stride_sum[i] = 0;
+ for (j=0; j<loop->numiter; j++) {
+ stride_sum[i] += loop->iters[j]->strides[i];
+ }
+ }
+
+ ldim = loop->nd - 1;
+ minsum = stride_sum[loop->nd-1];
+ for (i=loop->nd - 2; i>=0; i--) {
+ if (stride_sum[i] < minsum ) {
+ ldim = i;
+ minsum = stride_sum[i];
+ }
+ }
+
+ maxdim = loop->dimensions[ldim];
+ loop->size /= maxdim;
+ loop->bufcnt = maxdim;
+ loop->lastdim = ldim;
+
+ /* Fix the iterators so the inner loop occurs over the
+ largest dimensions -- This can be done by
+ setting the size to 1 in that dimension
+ (just in the iterators)
+ */
+
+ for (i=0; i<loop->numiter; i++) {
+ it = loop->iters[i];
+ it->contiguous = 0;
+ it->size /= (it->dims_m1[ldim]+1);
+ it->dims_m1[ldim] = 0;
+ it->backstrides[ldim] = 0;
+
+ /* (won't fix factors because we
+ don't use PyArray_ITER_GOTO1D
+ so don't change them) */
+
+ /* Set the steps to the strides in that dimension */
+ loop->steps[i] = it->strides[ldim];
+ }
+
+ /* fix up steps where we will be copying data to
+ buffers and calculate the ninnerloops and leftover
+ values -- if step size is already zero that is not changed...
+ */
+ if (loop->meth == BUFFER_UFUNCLOOP) {
+ loop->leftover = maxdim % loop->bufsize;
+ loop->ninnerloops = (maxdim / loop->bufsize) + 1;
+ for (i=0; i<self->nargs; i++) {
+ if (loop->needbuffer[i] && loop->steps[i]) {
+ loop->steps[i] = mps[i]->descr->elsize;
+ }
+ /* These are changed later if casting is needed */
+ }
+ }
+ }
+ else { /* uniformly-strided case ONE_UFUNCLOOP */
+ for (i=0; i<self->nargs; i++) {
+ if (PyArray_SIZE(mps[i]) == 1)
+ loop->steps[i] = 0;
+ else
+ loop->steps[i] = mps[i]->strides[mps[i]->nd-1];
+ }
+ }
+
+
+ /* Finally, create memory for buffers if we need them */
+
+ /* buffers for scalars are specially made small -- scalars are
+ not copied multiple times */
+ if (loop->meth == BUFFER_UFUNCLOOP) {
+ int cnt = 0, cntcast = 0; /* keeps track of bytes to allocate */
+ int scnt = 0, scntcast = 0;
+ char *castptr;
+ char *bufptr;
+ int last_was_scalar=0;
+ int last_cast_was_scalar=0;
+ int oldbufsize=0;
+ int oldsize=0;
+ int scbufsize = 4*sizeof(double);
+ int memsize;
+ PyArray_Descr *descr;
+
+ /* compute the element size */
+ for (i=0; i<self->nargs;i++) {
+ if (!loop->needbuffer) continue;
+ if (arg_types[i] != mps[i]->descr->type_num) {
+ descr = PyArray_DescrFromType(arg_types[i]);
+ if (loop->steps[i])
+ cntcast += descr->elsize;
+ else
+ scntcast += descr->elsize;
+ if (i < self->nin) {
+ loop->cast[i] = \
+ PyArray_GetCastFunc(mps[i]->descr,
+ arg_types[i]);
+ }
+ else {
+ loop->cast[i] = PyArray_GetCastFunc \
+ (descr, mps[i]->descr->type_num);
+ }
+ Py_DECREF(descr);
+ if (!loop->cast[i]) return -1;
+ }
+ loop->swap[i] = !(PyArray_ISNOTSWAPPED(mps[i]));
+ if (loop->steps[i])
+ cnt += mps[i]->descr->elsize;
+ else
+ scnt += mps[i]->descr->elsize;
+ }
+ memsize = loop->bufsize*(cnt+cntcast) + scbufsize*(scnt+scntcast);
+ loop->buffer[0] = PyDataMem_NEW(memsize);
+
+ /* fprintf(stderr, "Allocated buffer at %p of size %d, cnt=%d, cntcast=%d\n", loop->buffer[0], loop->bufsize * (cnt + cntcast), cnt, cntcast); */
+
+ if (loop->buffer[0] == NULL) {PyErr_NoMemory(); return -1;}
+ if (loop->obj) memset(loop->buffer[0], 0, memsize);
+ castptr = loop->buffer[0] + loop->bufsize*cnt + scbufsize*scnt;
+ bufptr = loop->buffer[0];
+ loop->objfunc = 0;
+ for (i=0; i<self->nargs; i++) {
+ if (!loop->needbuffer[i]) continue;
+ loop->buffer[i] = bufptr + (last_was_scalar ? scbufsize : \
+ loop->bufsize)*oldbufsize;
+ last_was_scalar = (loop->steps[i] == 0);
+ bufptr = loop->buffer[i];
+ oldbufsize = mps[i]->descr->elsize;
+ /* fprintf(stderr, "buffer[%d] = %p\n", i, loop->buffer[i]); */
+ if (loop->cast[i]) {
+ PyArray_Descr *descr;
+ loop->castbuf[i] = castptr + (last_cast_was_scalar ? scbufsize : \
+ loop->bufsize)*oldsize;
+ last_cast_was_scalar = last_was_scalar;
+ /* fprintf(stderr, "castbuf[%d] = %p\n", i, loop->castbuf[i]); */
+ descr = PyArray_DescrFromType(arg_types[i]);
+ oldsize = descr->elsize;
+ Py_DECREF(descr);
+ loop->bufptr[i] = loop->castbuf[i];
+ castptr = loop->castbuf[i];
+ if (loop->steps[i])
+ loop->steps[i] = oldsize;
+ }
+ else {
+ loop->bufptr[i] = loop->buffer[i];
+ }
+ if (!loop->objfunc && loop->obj) {
+ if (arg_types[i] == PyArray_OBJECT) {
+ loop->objfunc = 1;
+ }
+ }
+ }
+ }
+ return nargs;
+}
+
+static void
+ufuncreduce_dealloc(PyUFuncReduceObject *self)
+{
+ if (self->ufunc) {
+ Py_XDECREF(self->it);
+ Py_XDECREF(self->rit);
+ Py_XDECREF(self->ret);
+ Py_XDECREF(self->errobj);
+ Py_XDECREF(self->decref);
+ if (self->buffer) PyDataMem_FREE(self->buffer);
+ Py_DECREF(self->ufunc);
+ }
+ _pya_free(self);
+}
+
+static void
+ufuncloop_dealloc(PyUFuncLoopObject *self)
+{
+ int i;
+
+ if (self->ufunc != NULL) {
+ for (i=0; i<self->ufunc->nargs; i++)
+ Py_XDECREF(self->iters[i]);
+ if (self->buffer[0]) PyDataMem_FREE(self->buffer[0]);
+ Py_XDECREF(self->errobj);
+ Py_DECREF(self->ufunc);
+ }
+ _pya_free(self);
+}
+
+static PyUFuncLoopObject *
+construct_loop(PyUFuncObject *self, PyObject *args, PyObject *kwds, PyArrayObject **mps)
+{
+ PyUFuncLoopObject *loop;
+ int i;
+ PyObject *typetup=NULL;
+ PyObject *extobj=NULL;
+ char *name;
+
+ if (self == NULL) {
+ PyErr_SetString(PyExc_ValueError, "function not supported");
+ return NULL;
+ }
+ if ((loop = _pya_malloc(sizeof(PyUFuncLoopObject)))==NULL) {
+ PyErr_NoMemory(); return loop;
+ }
+
+ loop->index = 0;
+ loop->ufunc = self;
+ Py_INCREF(self);
+ loop->buffer[0] = NULL;
+ for (i=0; i<self->nargs; i++) {
+ loop->iters[i] = NULL;
+ loop->cast[i] = NULL;
+ }
+ loop->errobj = NULL;
+ loop->notimplemented = 0;
+ loop->first = 1;
+
+ name = self->name ? self->name : "";
+
+ /* Extract sig= keyword and
+ extobj= keyword if present
+ Raise an error if anything else present in the keyword dictionary
+ */
+ if (kwds != NULL) {
+ PyObject *key, *value;
+ Py_ssize_t pos=0;
+ while (PyDict_Next(kwds, &pos, &key, &value)) {
+ if (!PyString_Check(key)) {
+ PyErr_SetString(PyExc_TypeError,
+ "invalid keyword");
+ goto fail;
+ }
+ if (strncmp(PyString_AS_STRING(key),"extobj",6) == 0) {
+ extobj = value;
+ }
+ else if (strncmp(PyString_AS_STRING(key),"sig",5)==0) {
+ typetup = value;
+ }
+ else {
+ PyErr_Format(PyExc_TypeError,
+ "'%s' is an invalid keyword " \
+ "to %s",
+ PyString_AS_STRING(key), name);
+ goto fail;
+ }
+ }
+ }
+
+ if (extobj == NULL) {
+ if (PyUFunc_GetPyValues(name,
+ &(loop->bufsize), &(loop->errormask),
+ &(loop->errobj)) < 0) goto fail;
+ }
+ else {
+ if (_extract_pyvals(extobj, name,
+ &(loop->bufsize), &(loop->errormask),
+ &(loop->errobj)) < 0) goto fail;
+ }
+
+ /* Setup the arrays */
+ if (construct_arrays(loop, args, mps, typetup) < 0) goto fail;
+
+ PyUFunc_clearfperr();
+
+ return loop;
+
+ fail:
+ ufuncloop_dealloc(loop);
+ return NULL;
+}
+
+
+/*
+static void
+_printbytebuf(PyUFuncLoopObject *loop, int bufnum)
+{
+ int i;
+
+ fprintf(stderr, "Printing byte buffer %d\n", bufnum);
+ for (i=0; i<loop->bufcnt; i++) {
+ fprintf(stderr, " %d\n", *(((byte *)(loop->buffer[bufnum]))+i));
+ }
+}
+
+static void
+_printlongbuf(PyUFuncLoopObject *loop, int bufnum)
+{
+ int i;
+
+ fprintf(stderr, "Printing long buffer %d\n", bufnum);
+ for (i=0; i<loop->bufcnt; i++) {
+ fprintf(stderr, " %ld\n", *(((long *)(loop->buffer[bufnum]))+i));
+ }
+}
+
+static void
+_printlongbufptr(PyUFuncLoopObject *loop, int bufnum)
+{
+ int i;
+
+ fprintf(stderr, "Printing long buffer %d\n", bufnum);
+ for (i=0; i<loop->bufcnt; i++) {
+ fprintf(stderr, " %ld\n", *(((long *)(loop->bufptr[bufnum]))+i));
+ }
+}
+
+
+
+static void
+_printcastbuf(PyUFuncLoopObject *loop, int bufnum)
+{
+ int i;
+
+ fprintf(stderr, "Printing long buffer %d\n", bufnum);
+ for (i=0; i<loop->bufcnt; i++) {
+ fprintf(stderr, " %ld\n", *(((long *)(loop->castbuf[bufnum]))+i));
+ }
+}
+
+*/
+
+
+
+
+/* currently generic ufuncs cannot be built for use on flexible arrays.
+
+ The cast functions in the generic loop would need to be fixed to pass
+ in something besides NULL, NULL.
+
+ Also the underlying ufunc loops would not know the element-size unless
+ that was passed in as data (which could be arranged).
+
+*/
+
+/* This generic function is called with the ufunc object, the arguments to it,
+ and an array of (pointers to) PyArrayObjects which are NULL. The
+ arguments are parsed and placed in mps in construct_loop (construct_arrays)
+*/
+
+/*UFUNC_API*/
+static int
+PyUFunc_GenericFunction(PyUFuncObject *self, PyObject *args, PyObject *kwds,
+ PyArrayObject **mps)
+{
+ PyUFuncLoopObject *loop;
+ int i;
+ NPY_BEGIN_THREADS_DEF
+
+ if (!(loop = construct_loop(self, args, kwds, mps))) return -1;
+ if (loop->notimplemented) {ufuncloop_dealloc(loop); return -2;}
+
+ NPY_LOOP_BEGIN_THREADS
+
+ switch(loop->meth) {
+ case ONE_UFUNCLOOP:
+ /* Everything is contiguous, notswapped, aligned,
+ and of the right type. -- Fastest.
+ Or if not contiguous, then a single-stride
+ increment moves through the entire array.
+ */
+ /*fprintf(stderr, "ONE...%d\n", loop->size);*/
+ loop->function((char **)loop->bufptr, &(loop->size),
+ loop->steps, loop->funcdata);
+ UFUNC_CHECK_ERROR(loop);
+ break;
+ case NOBUFFER_UFUNCLOOP:
+ /* Everything is notswapped, aligned and of the
+ right type but not contiguous. -- Almost as fast.
+ */
+ /*fprintf(stderr, "NOBUFFER...%d\n", loop->size);*/
+ while (loop->index < loop->size) {
+ for (i=0; i<self->nargs; i++)
+ loop->bufptr[i] = loop->iters[i]->dataptr;
+
+ loop->function((char **)loop->bufptr, &(loop->bufcnt),
+ loop->steps, loop->funcdata);
+ UFUNC_CHECK_ERROR(loop);
+
+ /* Adjust loop pointers */
+
+ for (i=0; i<self->nargs; i++) {
+ PyArray_ITER_NEXT(loop->iters[i]);
+ }
+ loop->index++;
+ }
+ break;
+ case BUFFER_UFUNCLOOP: {
+ PyArray_CopySwapNFunc *copyswapn[NPY_MAXARGS];
+ PyArrayIterObject **iters=loop->iters;
+ int *swap=loop->swap;
+ char **dptr=loop->dptr;
+ int mpselsize[NPY_MAXARGS];
+ intp laststrides[NPY_MAXARGS];
+ int fastmemcpy[NPY_MAXARGS];
+ int *needbuffer=loop->needbuffer;
+ intp index=loop->index, size=loop->size;
+ int bufsize;
+ intp bufcnt;
+ int copysizes[NPY_MAXARGS];
+ char **bufptr = loop->bufptr;
+ char **buffer = loop->buffer;
+ char **castbuf = loop->castbuf;
+ intp *steps = loop->steps;
+ char *tptr[NPY_MAXARGS];
+ int ninnerloops = loop->ninnerloops;
+ Bool pyobject[NPY_MAXARGS];
+ int datasize[NPY_MAXARGS];
+ int j, k, stopcondition;
+ char *myptr1, *myptr2;
+
+
+ for (i=0; i<self->nargs; i++) {
+ copyswapn[i] = mps[i]->descr->f->copyswapn;
+ mpselsize[i] = mps[i]->descr->elsize;
+ pyobject[i] = (loop->obj && \
+ (mps[i]->descr->type_num == PyArray_OBJECT));
+ laststrides[i] = iters[i]->strides[loop->lastdim];
+ if (steps[i] && laststrides[i] != mpselsize[i]) fastmemcpy[i] = 0;
+ else fastmemcpy[i] = 1;
+ }
+ /* Do generic buffered looping here (works for any kind of
+ arrays -- some need buffers, some don't.
+ */
+
+ /* New algorithm: N is the largest dimension. B is the buffer-size.
+ quotient is loop->ninnerloops-1
+ remainder is loop->leftover
+
+ Compute N = quotient * B + remainder.
+ quotient = N / B # integer math
+ (store quotient + 1) as the number of innerloops
+ remainder = N % B # integer remainder
+
+ On the inner-dimension we will have (quotient + 1) loops where
+ the size of the inner function is B for all but the last when the niter size is
+ remainder.
+
+ So, the code looks very similar to NOBUFFER_LOOP except the inner-most loop is
+ replaced with...
+
+ for(i=0; i<quotient+1; i++) {
+ if (i==quotient+1) make itersize remainder size
+ copy only needed items to buffer.
+ swap input buffers if needed
+ cast input buffers if needed
+ call loop_function()
+ cast outputs in buffers if needed
+ swap outputs in buffers if needed
+ copy only needed items back to output arrays.
+ update all data-pointers by strides*niter
+ }
+ */
+
+
+ /* fprintf(stderr, "BUFFER...%d,%d,%d\n", loop->size,
+ loop->ninnerloops, loop->leftover);
+ */
+ /*
+ for (i=0; i<self->nargs; i++) {
+ fprintf(stderr, "iters[%d]->dataptr = %p, %p of size %d\n", i,
+ iters[i], iters[i]->ao->data, PyArray_NBYTES(iters[i]->ao));
+ }
+ */
+
+ stopcondition = ninnerloops;
+ if (loop->leftover == 0) stopcondition--;
+ while (index < size) {
+ bufsize=loop->bufsize;
+ for (i=0; i<self->nargs; i++) {
+ tptr[i] = loop->iters[i]->dataptr;
+ if (needbuffer[i]) {
+ dptr[i] = bufptr[i];
+ datasize[i] = (steps[i] ? bufsize : 1);
+ copysizes[i] = datasize[i] * mpselsize[i];
+ }
+ else {
+ dptr[i] = tptr[i];
+ }
+ }
+
+ /* This is the inner function over the last dimension */
+ for (k=1; k<=stopcondition; k++) {
+ if (k==ninnerloops) {
+ bufsize = loop->leftover;
+ for (i=0; i<self->nargs;i++) {
+ if (!needbuffer[i]) continue;
+ datasize[i] = (steps[i] ? bufsize : 1);
+ copysizes[i] = datasize[i] * mpselsize[i];
+ }
+ }
+
+ for (i=0; i<self->nin; i++) {
+ if (!needbuffer[i]) continue;
+ if (fastmemcpy[i])
+ memcpy(buffer[i], tptr[i],
+ copysizes[i]);
+ else {
+ myptr1 = buffer[i];
+ myptr2 = tptr[i];
+ for (j=0; j<bufsize; j++) {
+ memcpy(myptr1, myptr2, mpselsize[i]);
+ myptr1 += mpselsize[i];
+ myptr2 += laststrides[i];
+ }
+ }
+
+ /* swap the buffer if necessary */
+ if (swap[i]) {
+ /* fprintf(stderr, "swapping...\n");*/
+ copyswapn[i](buffer[i], mpselsize[i], NULL, -1,
+ (intp) datasize[i], 1,
+ mps[i]);
+ }
+ /* cast to the other buffer if necessary */
+ if (loop->cast[i]) {
+ loop->cast[i](buffer[i],
+ castbuf[i],
+ (intp) datasize[i],
+ NULL, NULL);
+ }
+ }
+
+ bufcnt = (intp) bufsize;
+ loop->function((char **)dptr, &bufcnt, steps, loop->funcdata);
+
+ for (i=self->nin; i<self->nargs; i++) {
+ if (!needbuffer[i]) continue;
+ if (loop->cast[i]) {
+ loop->cast[i](castbuf[i],
+ buffer[i],
+ (intp) datasize[i],
+ NULL, NULL);
+ }
+ if (swap[i]) {
+ copyswapn[i](buffer[i], mpselsize[i], NULL, -1,
+ (intp) datasize[i], 1,
+ mps[i]);
+ }
+ /* copy back to output arrays */
+ /* decref what's already there for object arrays */
+ if (pyobject[i]) {
+ myptr1 = tptr[i];
+ for (j=0; j<datasize[i]; j++) {
+ Py_XDECREF(*((PyObject **)myptr1));
+ myptr1 += laststrides[i];
+ }
+ }
+ if (fastmemcpy[i])
+ memcpy(tptr[i], buffer[i], copysizes[i]);
+ else {
+ myptr2 = buffer[i];
+ myptr1 = tptr[i];
+ for (j=0; j<bufsize; j++) {
+ memcpy(myptr1, myptr2,
+ mpselsize[i]);
+ myptr1 += laststrides[i];
+ myptr2 += mpselsize[i];
+ }
+ }
+ }
+ if (k == stopcondition) continue;
+ for (i=0; i<self->nargs; i++) {
+ tptr[i] += bufsize * laststrides[i];
+ if (!needbuffer[i]) dptr[i] = tptr[i];
+ }
+ }
+ /* end inner function over last dimension */
+
+ if (loop->objfunc) { /* DECREF castbuf when underlying function used object arrays
+ and casting was needed to get to object arrays */
+ for (i=0; i<self->nargs; i++) {
+ if (loop->cast[i]) {
+ if (steps[i] == 0) {
+ Py_XDECREF(*((PyObject **)castbuf[i]));
+ }
+ else {
+ int size = loop->bufsize;
+ PyObject **objptr = (PyObject **)castbuf[i];
+ /* size is loop->bufsize unless there
+ was only one loop */
+ if (ninnerloops == 1) \
+ size = loop->leftover;
+
+ for (j=0; j<size; j++) {
+ Py_XDECREF(*objptr);
+ *objptr = NULL;
+ objptr += 1;
+ }
+ }
+ }
+ }
+
+ }
+
+ UFUNC_CHECK_ERROR(loop);
+
+ for (i=0; i<self->nargs; i++) {
+ PyArray_ITER_NEXT(loop->iters[i]);
+ }
+ index++;
+ }
+ }
+ }
+
+ NPY_LOOP_END_THREADS
+
+ ufuncloop_dealloc(loop);
+ return 0;
+
+ fail:
+ NPY_LOOP_END_THREADS
+
+ if (loop) ufuncloop_dealloc(loop);
+ return -1;
+}
+
+static PyArrayObject *
+_getidentity(PyUFuncObject *self, int otype, char *str)
+{
+ PyObject *obj, *arr;
+ PyArray_Descr *typecode;
+
+ if (self->identity == PyUFunc_None) {
+ PyErr_Format(PyExc_ValueError,
+ "zero-size array to ufunc.%s " \
+ "without identity", str);
+ return NULL;
+ }
+ if (self->identity == PyUFunc_One) {
+ obj = PyInt_FromLong((long) 1);
+ } else {
+ obj = PyInt_FromLong((long) 0);
+ }
+
+ typecode = PyArray_DescrFromType(otype);
+ arr = PyArray_FromAny(obj, typecode, 0, 0, CARRAY, NULL);
+ Py_DECREF(obj);
+ return (PyArrayObject *)arr;
+}
+
+static int
+_create_reduce_copy(PyUFuncReduceObject *loop, PyArrayObject **arr, int rtype)
+{
+ intp maxsize;
+ PyObject *new;
+ PyArray_Descr *ntype;
+
+ maxsize = PyArray_SIZE(*arr);
+
+ if (maxsize < loop->bufsize) {
+ if (!(PyArray_ISBEHAVED_RO(*arr)) || \
+ PyArray_TYPE(*arr) != rtype) {
+ ntype = PyArray_DescrFromType(rtype);
+ new = PyArray_FromAny((PyObject *)(*arr),
+ ntype, 0, 0,
+ FORCECAST | ALIGNED, NULL);
+ if (new == NULL) return -1;
+ *arr = (PyArrayObject *)new;
+ loop->decref = new;
+ }
+ }
+
+ /* Don't decref *arr before re-assigning
+ because it was not going to be DECREF'd anyway.
+
+ If a copy is made, then the copy will be removed
+ on deallocation of the loop structure by setting
+ loop->decref.
+ */
+
+ return 0;
+}
+
+static PyUFuncReduceObject *
+construct_reduce(PyUFuncObject *self, PyArrayObject **arr, PyArrayObject *out,
+ int axis, int otype, int operation, intp ind_size, char *str)
+{
+ PyUFuncReduceObject *loop;
+ PyArrayObject *idarr;
+ PyArrayObject *aar;
+ intp loop_i[MAX_DIMS], outsize=0;
+ int arg_types[3];
+ PyArray_SCALARKIND scalars[3] = {PyArray_NOSCALAR, PyArray_NOSCALAR,
+ PyArray_NOSCALAR};
+ int i, j, nd;
+ int flags;
+ /* Reduce type is the type requested of the input
+ during reduction */
+
+ nd = (*arr)->nd;
+ arg_types[0] = otype;
+ arg_types[1] = otype;
+ arg_types[2] = otype;
+ if ((loop = _pya_malloc(sizeof(PyUFuncReduceObject)))==NULL) {
+ PyErr_NoMemory(); return loop;
+ }
+
+ loop->retbase=0;
+ loop->swap = 0;
+ loop->index = 0;
+ loop->ufunc = self;
+ Py_INCREF(self);
+ loop->cast = NULL;
+ loop->buffer = NULL;
+ loop->ret = NULL;
+ loop->it = NULL;
+ loop->rit = NULL;
+ loop->errobj = NULL;
+ loop->first = 1;
+ loop->decref=NULL;
+ loop->N = (*arr)->dimensions[axis];
+ loop->instrides = (*arr)->strides[axis];
+
+ if (select_types(loop->ufunc, arg_types, &(loop->function),
+ &(loop->funcdata), scalars, NULL) == -1) goto fail;
+
+ /* output type may change -- if it does
+ reduction is forced into that type
+ and we need to select the reduction function again
+ */
+ if (otype != arg_types[2]) {
+ otype = arg_types[2];
+ arg_types[0] = otype;
+ arg_types[1] = otype;
+ if (select_types(loop->ufunc, arg_types, &(loop->function),
+ &(loop->funcdata), scalars, NULL) == -1)
+ goto fail;
+ }
+
+ /* get looping parameters from Python */
+ if (PyUFunc_GetPyValues(str, &(loop->bufsize), &(loop->errormask),
+ &(loop->errobj)) < 0) goto fail;
+
+ /* Make copy if misbehaved or not otype for small arrays */
+ if (_create_reduce_copy(loop, arr, otype) < 0) goto fail;
+ aar = *arr;
+
+ if (loop->N == 0) {
+ loop->meth = ZERO_EL_REDUCELOOP;
+ }
+ else if (PyArray_ISBEHAVED_RO(aar) && \
+ otype == (aar)->descr->type_num) {
+ if (loop->N == 1) {
+ loop->meth = ONE_EL_REDUCELOOP;
+ }
+ else {
+ loop->meth = NOBUFFER_UFUNCLOOP;
+ loop->steps[1] = (aar)->strides[axis];
+ loop->N -= 1;
+ }
+ }
+ else {
+ loop->meth = BUFFER_UFUNCLOOP;
+ loop->swap = !(PyArray_ISNOTSWAPPED(aar));
+ }
+
+ /* Determine if object arrays are involved */
+ if (otype == PyArray_OBJECT || aar->descr->type_num == PyArray_OBJECT)
+ loop->obj = 1;
+ else
+ loop->obj = 0;
+
+ if (loop->meth == ZERO_EL_REDUCELOOP) {
+ idarr = _getidentity(self, otype, str);
+ if (idarr == NULL) goto fail;
+ if (idarr->descr->elsize > UFUNC_MAXIDENTITY) {
+ PyErr_Format(PyExc_RuntimeError,
+ "UFUNC_MAXIDENTITY (%d)" \
+ " is too small (needs to be at least %d)",
+ UFUNC_MAXIDENTITY, idarr->descr->elsize);
+ Py_DECREF(idarr);
+ goto fail;
+ }
+ memcpy(loop->idptr, idarr->data, idarr->descr->elsize);
+ Py_DECREF(idarr);
+ }
+
+ /* Construct return array */
+ flags = NPY_CARRAY | NPY_UPDATEIFCOPY | NPY_FORCECAST;
+ switch(operation) {
+ case UFUNC_REDUCE:
+ for (j=0, i=0; i<nd; i++) {
+ if (i != axis)
+ loop_i[j++] = (aar)->dimensions[i];
+
+ }
+ if (out == NULL) {
+ loop->ret = (PyArrayObject *) \
+ PyArray_New(aar->ob_type, aar->nd-1, loop_i,
+ otype, NULL, NULL, 0, 0,
+ (PyObject *)aar);
+ }
+ else {
+ outsize = PyArray_MultiplyList(loop_i, aar->nd-1);
+ }
+ break;
+ case UFUNC_ACCUMULATE:
+ if (out == NULL) {
+ loop->ret = (PyArrayObject *) \
+ PyArray_New(aar->ob_type, aar->nd, aar->dimensions,
+ otype, NULL, NULL, 0, 0, (PyObject *)aar);
+ }
+ else {
+ outsize = PyArray_MultiplyList(aar->dimensions, aar->nd);
+ }
+ break;
+ case UFUNC_REDUCEAT:
+ memcpy(loop_i, aar->dimensions, nd*sizeof(intp));
+ /* Index is 1-d array */
+ loop_i[axis] = ind_size;
+ if (out == NULL) {
+ loop->ret = (PyArrayObject *) \
+ PyArray_New(aar->ob_type, aar->nd, loop_i, otype,
+ NULL, NULL, 0, 0, (PyObject *)aar);
+ }
+ else {
+ outsize = PyArray_MultiplyList(loop_i, aar->nd);
+ }
+ if (ind_size == 0) {
+ loop->meth = ZERO_EL_REDUCELOOP;
+ return loop;
+ }
+ if (loop->meth == ONE_EL_REDUCELOOP)
+ loop->meth = NOBUFFER_REDUCELOOP;
+ break;
+ }
+ if (out) {
+ if (PyArray_SIZE(out) != outsize) {
+ PyErr_SetString(PyExc_ValueError,
+ "wrong shape for output");
+ goto fail;
+ }
+ loop->ret = (PyArrayObject *) \
+ PyArray_FromArray(out, PyArray_DescrFromType(otype),
+ flags);
+ if (loop->ret && loop->ret != out) {
+ loop->retbase = 1;
+ }
+ }
+ if (loop->ret == NULL) goto fail;
+ loop->insize = aar->descr->elsize;
+ loop->outsize = loop->ret->descr->elsize;
+ loop->bufptr[0] = loop->ret->data;
+
+ if (loop->meth == ZERO_EL_REDUCELOOP) {
+ loop->size = PyArray_SIZE(loop->ret);
+ return loop;
+ }
+
+ loop->it = (PyArrayIterObject *)PyArray_IterNew((PyObject *)aar);
+ if (loop->it == NULL) return NULL;
+
+ if (loop->meth == ONE_EL_REDUCELOOP) {
+ loop->size = loop->it->size;
+ return loop;
+ }
+
+ /* Fix iterator to loop over correct dimension */
+ /* Set size in axis dimension to 1 */
+
+ loop->it->contiguous = 0;
+ loop->it->size /= (loop->it->dims_m1[axis]+1);
+ loop->it->dims_m1[axis] = 0;
+ loop->it->backstrides[axis] = 0;
+
+
+ loop->size = loop->it->size;
+
+ if (operation == UFUNC_REDUCE) {
+ loop->steps[0] = 0;
+ }
+ else {
+ loop->rit = (PyArrayIterObject *) \
+ PyArray_IterNew((PyObject *)(loop->ret));
+ if (loop->rit == NULL) return NULL;
+
+ /* Fix iterator to loop over correct dimension */
+ /* Set size in axis dimension to 1 */
+
+ loop->rit->contiguous = 0;
+ loop->rit->size /= (loop->rit->dims_m1[axis]+1);
+ loop->rit->dims_m1[axis] = 0;
+ loop->rit->backstrides[axis] = 0;
+
+ if (operation == UFUNC_ACCUMULATE)
+ loop->steps[0] = loop->ret->strides[axis];
+ else
+ loop->steps[0] = 0;
+ }
+ loop->steps[2] = loop->steps[0];
+ loop->bufptr[2] = loop->bufptr[0] + loop->steps[2];
+
+
+ if (loop->meth == BUFFER_UFUNCLOOP) {
+ int _size;
+ loop->steps[1] = loop->outsize;
+ if (otype != aar->descr->type_num) {
+ _size=loop->bufsize*(loop->outsize + \
+ aar->descr->elsize);
+ loop->buffer = PyDataMem_NEW(_size);
+ if (loop->buffer == NULL) goto fail;
+ if (loop->obj) memset(loop->buffer, 0, _size);
+ loop->castbuf = loop->buffer + \
+ loop->bufsize*aar->descr->elsize;
+ loop->bufptr[1] = loop->castbuf;
+ loop->cast = PyArray_GetCastFunc(aar->descr, otype);
+ if (loop->cast == NULL) goto fail;
+ }
+ else {
+ _size = loop->bufsize * loop->outsize;
+ loop->buffer = PyDataMem_NEW(_size);
+ if (loop->buffer == NULL) goto fail;
+ if (loop->obj) memset(loop->buffer, 0, _size);
+ loop->bufptr[1] = loop->buffer;
+ }
+ }
+
+
+ PyUFunc_clearfperr();
+ return loop;
+
+ fail:
+ ufuncreduce_dealloc(loop);
+ return NULL;
+}
+
+
+/* We have two basic kinds of loops */
+/* One is used when arr is not-swapped and aligned and output type
+ is the same as input type.
+ and another using buffers when one of these is not satisfied.
+
+ Zero-length and one-length axes-to-be-reduced are handled separately.
+*/
+
+static PyObject *
+PyUFunc_Reduce(PyUFuncObject *self, PyArrayObject *arr, PyArrayObject *out,
+ int axis, int otype)
+{
+ PyArrayObject *ret=NULL;
+ PyUFuncReduceObject *loop;
+ intp i, n;
+ char *dptr;
+ NPY_BEGIN_THREADS_DEF
+
+ /* Construct loop object */
+ loop = construct_reduce(self, &arr, out, axis, otype, UFUNC_REDUCE, 0,
+ "reduce");
+ if (!loop) return NULL;
+
+ NPY_LOOP_BEGIN_THREADS
+ switch(loop->meth) {
+ case ZERO_EL_REDUCELOOP:
+ /* fprintf(stderr, "ZERO..%d\n", loop->size); */
+ for(i=0; i<loop->size; i++) {
+ if (loop->obj) Py_INCREF(*((PyObject **)loop->idptr));
+ memmove(loop->bufptr[0], loop->idptr, loop->outsize);
+ loop->bufptr[0] += loop->outsize;
+ }
+ break;
+ case ONE_EL_REDUCELOOP:
+ /*fprintf(stderr, "ONEDIM..%d\n", loop->size); */
+ while(loop->index < loop->size) {
+ if (loop->obj)
+ Py_INCREF(*((PyObject **)loop->it->dataptr));
+ memmove(loop->bufptr[0], loop->it->dataptr,
+ loop->outsize);
+ PyArray_ITER_NEXT(loop->it);
+ loop->bufptr[0] += loop->outsize;
+ loop->index++;
+ }
+ break;
+ case NOBUFFER_UFUNCLOOP:
+ /*fprintf(stderr, "NOBUFFER..%d\n", loop->size); */
+ while(loop->index < loop->size) {
+ /* Copy first element to output */
+ if (loop->obj)
+ Py_INCREF(*((PyObject **)loop->it->dataptr));
+ memmove(loop->bufptr[0], loop->it->dataptr,
+ loop->outsize);
+ /* Adjust input pointer */
+ loop->bufptr[1] = loop->it->dataptr+loop->steps[1];
+ loop->function((char **)loop->bufptr,
+ &(loop->N),
+ loop->steps, loop->funcdata);
+ UFUNC_CHECK_ERROR(loop);
+
+ PyArray_ITER_NEXT(loop->it)
+ loop->bufptr[0] += loop->outsize;
+ loop->bufptr[2] = loop->bufptr[0];
+ loop->index++;
+ }
+ break;
+ case BUFFER_UFUNCLOOP:
+ /* use buffer for arr */
+ /*
+ For each row to reduce
+ 1. copy first item over to output (casting if necessary)
+ 2. Fill inner buffer
+ 3. When buffer is filled or end of row
+ a. Cast input buffers if needed
+ b. Call inner function.
+ 4. Repeat 2 until row is done.
+ */
+ /* fprintf(stderr, "BUFFERED..%d %d\n", loop->size,
+ loop->swap); */
+ while(loop->index < loop->size) {
+ loop->inptr = loop->it->dataptr;
+ /* Copy (cast) First term over to output */
+ if (loop->cast) {
+ /* A little tricky because we need to
+ cast it first */
+ arr->descr->f->copyswap(loop->buffer,
+ loop->inptr,
+ loop->swap,
+ NULL);
+ loop->cast(loop->buffer, loop->castbuf,
+ 1, NULL, NULL);
+ if (loop->obj)
+ Py_INCREF(*((PyObject **)loop->castbuf));
+ memcpy(loop->bufptr[0], loop->castbuf,
+ loop->outsize);
+ }
+ else { /* Simple copy */
+ arr->descr->f->copyswap(loop->bufptr[0],
+ loop->inptr,
+ loop->swap, NULL);
+ }
+ loop->inptr += loop->instrides;
+ n = 1;
+ while(n < loop->N) {
+ /* Copy up to loop->bufsize elements to
+ buffer */
+ dptr = loop->buffer;
+ for (i=0; i<loop->bufsize; i++, n++) {
+ if (n == loop->N) break;
+ arr->descr->f->copyswap(dptr,
+ loop->inptr,
+ loop->swap,
+ NULL);
+ loop->inptr += loop->instrides;
+ dptr += loop->insize;
+ }
+ if (loop->cast)
+ loop->cast(loop->buffer,
+ loop->castbuf,
+ i, NULL, NULL);
+ loop->function((char **)loop->bufptr,
+ &i,
+ loop->steps, loop->funcdata);
+ loop->bufptr[0] += loop->steps[0]*i;
+ loop->bufptr[2] += loop->steps[2]*i;
+ UFUNC_CHECK_ERROR(loop);
+ }
+ PyArray_ITER_NEXT(loop->it);
+ loop->bufptr[0] += loop->outsize;
+ loop->bufptr[2] = loop->bufptr[0];
+ loop->index++;
+ }
+ }
+
+ NPY_LOOP_END_THREADS
+
+ /* Hang on to this reference -- will be decref'd with loop */
+ if (loop->retbase) ret = (PyArrayObject *)loop->ret->base;
+ else ret = loop->ret;
+ Py_INCREF(ret);
+ ufuncreduce_dealloc(loop);
+ return (PyObject *)ret;
+
+ fail:
+ NPY_LOOP_END_THREADS
+
+ if (loop) ufuncreduce_dealloc(loop);
+ return NULL;
+}
+
+
+static PyObject *
+PyUFunc_Accumulate(PyUFuncObject *self, PyArrayObject *arr, PyArrayObject *out,
+ int axis, int otype)
+{
+ PyArrayObject *ret=NULL;
+ PyUFuncReduceObject *loop;
+ intp i, n;
+ char *dptr;
+ NPY_BEGIN_THREADS_DEF
+
+ /* Construct loop object */
+ loop = construct_reduce(self, &arr, out, axis, otype, UFUNC_ACCUMULATE, 0,
+ "accumulate");
+ if (!loop) return NULL;
+
+ NPY_LOOP_BEGIN_THREADS
+ switch(loop->meth) {
+ case ZERO_EL_REDUCELOOP: /* Accumulate */
+ /* fprintf(stderr, "ZERO..%d\n", loop->size); */
+ for(i=0; i<loop->size; i++) {
+ if (loop->obj)
+ Py_INCREF(*((PyObject **)loop->idptr));
+ memcpy(loop->bufptr[0], loop->idptr, loop->outsize);
+ loop->bufptr[0] += loop->outsize;
+ }
+ break;
+ case ONE_EL_REDUCELOOP: /* Accumulate */
+ /* fprintf(stderr, "ONEDIM..%d\n", loop->size); */
+ while(loop->index < loop->size) {
+ if (loop->obj)
+ Py_INCREF(*((PyObject **)loop->it->dataptr));
+ memcpy(loop->bufptr[0], loop->it->dataptr,
+ loop->outsize);
+ PyArray_ITER_NEXT(loop->it);
+ loop->bufptr[0] += loop->outsize;
+ loop->index++;
+ }
+ break;
+ case NOBUFFER_UFUNCLOOP: /* Accumulate */
+ /* fprintf(stderr, "NOBUFFER..%d\n", loop->size); */
+ while(loop->index < loop->size) {
+ /* Copy first element to output */
+ if (loop->obj)
+ Py_INCREF(*((PyObject **)loop->it->dataptr));
+ memcpy(loop->bufptr[0], loop->it->dataptr,
+ loop->outsize);
+ /* Adjust input pointer */
+ loop->bufptr[1] = loop->it->dataptr+loop->steps[1];
+ loop->function((char **)loop->bufptr,
+ &(loop->N),
+ loop->steps, loop->funcdata);
+ UFUNC_CHECK_ERROR(loop);
+
+ PyArray_ITER_NEXT(loop->it);
+ PyArray_ITER_NEXT(loop->rit);
+ loop->bufptr[0] = loop->rit->dataptr;
+ loop->bufptr[2] = loop->bufptr[0] + loop->steps[0];
+ loop->index++;
+ }
+ break;
+ case BUFFER_UFUNCLOOP: /* Accumulate */
+ /* use buffer for arr */
+ /*
+ For each row to reduce
+ 1. copy identity over to output (casting if necessary)
+ 2. Fill inner buffer
+ 3. When buffer is filled or end of row
+ a. Cast input buffers if needed
+ b. Call inner function.
+ 4. Repeat 2 until row is done.
+ */
+ /* fprintf(stderr, "BUFFERED..%d %p\n", loop->size,
+ loop->cast); */
+ while(loop->index < loop->size) {
+ loop->inptr = loop->it->dataptr;
+ /* Copy (cast) First term over to output */
+ if (loop->cast) {
+ /* A little tricky because we need to
+ cast it first */
+ arr->descr->f->copyswap(loop->buffer,
+ loop->inptr,
+ loop->swap,
+ NULL);
+ loop->cast(loop->buffer, loop->castbuf,
+ 1, NULL, NULL);
+ if (loop->obj)
+ Py_INCREF(*((PyObject **)loop->castbuf));
+ memcpy(loop->bufptr[0], loop->castbuf,
+ loop->outsize);
+ }
+ else { /* Simple copy */
+ arr->descr->f->copyswap(loop->bufptr[0],
+ loop->inptr,
+ loop->swap,
+ NULL);
+ }
+ loop->inptr += loop->instrides;
+ n = 1;
+ while(n < loop->N) {
+ /* Copy up to loop->bufsize elements to
+ buffer */
+ dptr = loop->buffer;
+ for (i=0; i<loop->bufsize; i++, n++) {
+ if (n == loop->N) break;
+ arr->descr->f->copyswap(dptr,
+ loop->inptr,
+ loop->swap,
+ NULL);
+ loop->inptr += loop->instrides;
+ dptr += loop->insize;
+ }
+ if (loop->cast)
+ loop->cast(loop->buffer,
+ loop->castbuf,
+ i, NULL, NULL);
+ loop->function((char **)loop->bufptr,
+ &i,
+ loop->steps, loop->funcdata);
+ loop->bufptr[0] += loop->steps[0]*i;
+ loop->bufptr[2] += loop->steps[2]*i;
+ UFUNC_CHECK_ERROR(loop);
+ }
+ PyArray_ITER_NEXT(loop->it);
+ PyArray_ITER_NEXT(loop->rit);
+ loop->bufptr[0] = loop->rit->dataptr;
+ loop->bufptr[2] = loop->bufptr[0] + loop->steps[0];
+ loop->index++;
+ }
+ }
+
+ NPY_LOOP_END_THREADS
+
+ /* Hang on to this reference -- will be decref'd with loop */
+ if (loop->retbase) ret = (PyArrayObject *)loop->ret->base;
+ else ret = loop->ret;
+ Py_INCREF(ret);
+ ufuncreduce_dealloc(loop);
+ return (PyObject *)ret;
+
+ fail:
+ NPY_LOOP_END_THREADS
+
+ if (loop) ufuncreduce_dealloc(loop);
+ return NULL;
+}
+
+/* Reduceat performs a reduce over an axis using the indices as a guide
+
+op.reduceat(array,indices) computes
+op.reduce(array[indices[i]:indices[i+1]]
+ for i=0..end with an implicit indices[i+1]=len(array)
+ assumed when i=end-1
+
+if indices[i+1] <= indices[i]+1
+ then the result is array[indices[i]] for that value
+
+op.accumulate(array) is the same as
+op.reduceat(array,indices)[::2]
+where indices is range(len(array)-1) with a zero placed in every other sample
+ indices = zeros(len(array)*2-1)
+ indices[1::2] = range(1,len(array))
+
+output shape is based on the size of indices
+ */
+
+static PyObject *
+PyUFunc_Reduceat(PyUFuncObject *self, PyArrayObject *arr, PyArrayObject *ind,
+ PyArrayObject *out, int axis, int otype)
+{
+ PyArrayObject *ret;
+ PyUFuncReduceObject *loop;
+ intp *ptr=(intp *)ind->data;
+ intp nn=ind->dimensions[0];
+ intp mm=arr->dimensions[axis]-1;
+ intp n, i, j;
+ char *dptr;
+ NPY_BEGIN_THREADS_DEF
+
+ /* Check for out-of-bounds values in indices array */
+ for (i=0; i<nn; i++) {
+ if ((*ptr < 0) || (*ptr > mm)) {
+ PyErr_Format(PyExc_IndexError,
+ "index out-of-bounds (0, %d)", (int) mm);
+ return NULL;
+ }
+ ptr++;
+ }
+
+ ptr = (intp *)ind->data;
+ /* Construct loop object */
+ loop = construct_reduce(self, &arr, out, axis, otype, UFUNC_REDUCEAT, nn,
+ "reduceat");
+ if (!loop) return NULL;
+
+ NPY_LOOP_BEGIN_THREADS
+ switch(loop->meth) {
+ /* zero-length index -- return array immediately */
+ case ZERO_EL_REDUCELOOP:
+ /* fprintf(stderr, "ZERO..\n"); */
+ break;
+ /* NOBUFFER -- behaved array and same type */
+ case NOBUFFER_UFUNCLOOP: /* Reduceat */
+ /* fprintf(stderr, "NOBUFFER..%d\n", loop->size); */
+ while(loop->index < loop->size) {
+ ptr = (intp *)ind->data;
+ for (i=0; i<nn; i++) {
+ loop->bufptr[1] = loop->it->dataptr + \
+ (*ptr)*loop->instrides;
+ if (loop->obj)
+ Py_INCREF(*((PyObject **)loop->bufptr[1]));
+ memcpy(loop->bufptr[0], loop->bufptr[1],
+ loop->outsize);
+ mm = (i==nn-1 ? arr->dimensions[axis]-*ptr : \
+ *(ptr+1) - *ptr) - 1;
+ if (mm > 0) {
+ loop->bufptr[1] += loop->instrides;
+ loop->bufptr[2] = loop->bufptr[0];
+ loop->function((char **)loop->bufptr,
+ &mm, loop->steps,
+ loop->funcdata);
+ UFUNC_CHECK_ERROR(loop);
+ }
+ loop->bufptr[0] += loop->ret->strides[axis];
+ ptr++;
+ }
+ PyArray_ITER_NEXT(loop->it);
+ PyArray_ITER_NEXT(loop->rit);
+ loop->bufptr[0] = loop->rit->dataptr;
+ loop->index++;
+ }
+ break;
+
+ /* BUFFER -- misbehaved array or different types */
+ case BUFFER_UFUNCLOOP: /* Reduceat */
+ /* fprintf(stderr, "BUFFERED..%d\n", loop->size); */
+ while(loop->index < loop->size) {
+ ptr = (intp *)ind->data;
+ for (i=0; i<nn; i++) {
+ if (loop->obj)
+ Py_INCREF(*((PyObject **)loop->idptr));
+ memcpy(loop->bufptr[0], loop->idptr,
+ loop->outsize);
+ n = 0;
+ mm = (i==nn-1 ? arr->dimensions[axis] - *ptr :\
+ *(ptr+1) - *ptr);
+ if (mm < 1) mm = 1;
+ loop->inptr = loop->it->dataptr + \
+ (*ptr)*loop->instrides;
+ while (n < mm) {
+ /* Copy up to loop->bufsize elements
+ to buffer */
+ dptr = loop->buffer;
+ for (j=0; j<loop->bufsize; j++, n++) {
+ if (n == mm) break;
+ arr->descr->f->copyswap\
+ (dptr,
+ loop->inptr,
+ loop->swap, NULL);
+ loop->inptr += loop->instrides;
+ dptr += loop->insize;
+ }
+ if (loop->cast)
+ loop->cast(loop->buffer,
+ loop->castbuf,
+ j, NULL, NULL);
+ loop->bufptr[2] = loop->bufptr[0];
+ loop->function((char **)loop->bufptr,
+ &j, loop->steps,
+ loop->funcdata);
+ UFUNC_CHECK_ERROR(loop);
+ loop->bufptr[0] += j*loop->steps[0];
+ }
+ loop->bufptr[0] += loop->ret->strides[axis];
+ ptr++;
+ }
+ PyArray_ITER_NEXT(loop->it);
+ PyArray_ITER_NEXT(loop->rit);
+ loop->bufptr[0] = loop->rit->dataptr;
+ loop->index++;
+ }
+ break;
+ }
+
+ NPY_LOOP_END_THREADS
+
+ /* Hang on to this reference -- will be decref'd with loop */
+ if (loop->retbase) ret = (PyArrayObject *)loop->ret->base;
+ else ret = loop->ret;
+ Py_INCREF(ret);
+ ufuncreduce_dealloc(loop);
+ return (PyObject *)ret;
+
+ fail:
+ NPY_LOOP_END_THREADS
+
+ if (loop) ufuncreduce_dealloc(loop);
+ return NULL;
+}
+
+
+/* This code handles reduce, reduceat, and accumulate
+ (accumulate and reduce are special cases of the more general reduceat
+ but they are handled separately for speed)
+*/
+
+static PyObject *
+PyUFunc_GenericReduction(PyUFuncObject *self, PyObject *args,
+ PyObject *kwds, int operation)
+{
+ int axis=0;
+ PyArrayObject *mp, *ret = NULL;
+ PyObject *op, *res=NULL;
+ PyObject *obj_ind, *context;
+ PyArrayObject *indices = NULL;
+ PyArray_Descr *otype=NULL;
+ PyArrayObject *out=NULL;
+ static char *kwlist1[] = {"array", "axis", "dtype", "out", NULL};
+ static char *kwlist2[] = {"array", "indices", "axis", "dtype", "out", NULL};
+ static char *_reduce_type[] = {"reduce", "accumulate", \
+ "reduceat", NULL};
+ if (self == NULL) {
+ PyErr_SetString(PyExc_ValueError, "function not supported");
+ return NULL;
+ }
+
+ if (self->nin != 2) {
+ PyErr_Format(PyExc_ValueError,
+ "%s only supported for binary functions",
+ _reduce_type[operation]);
+ return NULL;
+ }
+ if (self->nout != 1) {
+ PyErr_Format(PyExc_ValueError,
+ "%s only supported for functions " \
+ "returning a single value",
+ _reduce_type[operation]);
+ return NULL;
+ }
+
+ if (operation == UFUNC_REDUCEAT) {
+ PyArray_Descr *indtype;
+ indtype = PyArray_DescrFromType(PyArray_INTP);
+ if(!PyArg_ParseTupleAndKeywords(args, kwds, "OO|iO&O&", kwlist2,
+ &op, &obj_ind, &axis,
+ PyArray_DescrConverter2,
+ &otype,
+ PyArray_OutputConverter,
+ &out)) return NULL;
+ indices = (PyArrayObject *)PyArray_FromAny(obj_ind, indtype,
+ 1, 1, CARRAY, NULL);
+ if (indices == NULL) return NULL;
+ }
+ else {
+ if(!PyArg_ParseTupleAndKeywords(args, kwds, "O|iO&O&", kwlist1,
+ &op, &axis,
+ PyArray_DescrConverter2,
+ &otype,
+ PyArray_OutputConverter,
+ &out)) return NULL;
+ }
+
+ /* Ensure input is an array */
+ if (!PyArray_Check(op) && !PyArray_IsScalar(op, Generic)) {
+ context = Py_BuildValue("O(O)i", self, op, 0);
+ }
+ else {
+ context = NULL;
+ }
+ mp = (PyArrayObject *)PyArray_FromAny(op, NULL, 0, 0, 0, context);
+ Py_XDECREF(context);
+ if (mp == NULL) return NULL;
+
+ /* Check to see if input is zero-dimensional */
+ if (mp->nd == 0) {
+ PyErr_Format(PyExc_TypeError, "cannot %s on a scalar",
+ _reduce_type[operation]);
+ Py_DECREF(mp);
+ return NULL;
+ }
+
+ /* Check to see that type (and otype) is not FLEXIBLE */
+ if (PyArray_ISFLEXIBLE(mp) ||
+ (otype && PyTypeNum_ISFLEXIBLE(otype->type_num))) {
+ PyErr_Format(PyExc_TypeError,
+ "cannot perform %s with flexible type",
+ _reduce_type[operation]);
+ Py_DECREF(mp);
+ return NULL;
+ }
+
+ if (axis < 0) axis += mp->nd;
+ if (axis < 0 || axis >= mp->nd) {
+ PyErr_SetString(PyExc_ValueError, "axis not in array");
+ Py_DECREF(mp);
+ return NULL;
+ }
+
+ /* If out is specified it determines otype unless otype
+ already specified.
+ */
+ if (otype == NULL && out != NULL) {
+ otype = out->descr;
+ Py_INCREF(otype);
+ }
+
+ if (otype == NULL) {
+ /* For integer types --- make sure at
+ least a long is used for add and multiply
+ reduction --- to avoid overflow */
+ int typenum = PyArray_TYPE(mp);
+ if ((typenum < NPY_FLOAT) && \
+ ((strcmp(self->name,"add")==0) || \
+ (strcmp(self->name,"multiply")==0))) {
+ if (PyTypeNum_ISBOOL(typenum))
+ typenum = PyArray_LONG;
+ else if (mp->descr->elsize < sizeof(long)) {
+ if (PyTypeNum_ISUNSIGNED(typenum))
+ typenum = PyArray_ULONG;
+ else
+ typenum = PyArray_LONG;
+ }
+ }
+ otype = PyArray_DescrFromType(typenum);
+ }
+
+
+ switch(operation) {
+ case UFUNC_REDUCE:
+ ret = (PyArrayObject *)PyUFunc_Reduce(self, mp, out, axis,
+ otype->type_num);
+ break;
+ case UFUNC_ACCUMULATE:
+ ret = (PyArrayObject *)PyUFunc_Accumulate(self, mp, out, axis,
+ otype->type_num);
+ break;
+ case UFUNC_REDUCEAT:
+ ret = (PyArrayObject *)PyUFunc_Reduceat(self, mp, indices, out,
+ axis, otype->type_num);
+ Py_DECREF(indices);
+ break;
+ }
+ Py_DECREF(mp);
+ Py_DECREF(otype);
+ if (ret==NULL) return NULL;
+ if (op->ob_type != ret->ob_type) {
+ res = PyObject_CallMethod(op, "__array_wrap__", "O", ret);
+ if (res == NULL) PyErr_Clear();
+ else if (res == Py_None) Py_DECREF(res);
+ else {
+ Py_DECREF(ret);
+ return res;
+ }
+ }
+ return PyArray_Return(ret);
+
+}
+
+/* This function analyzes the input arguments
+ and determines an appropriate __array_wrap__ function to call
+ for the outputs.
+
+ If an output argument is provided, then it is wrapped
+ with its own __array_wrap__ not with the one determined by
+ the input arguments.
+
+ if the provided output argument is already an array,
+ the wrapping function is None (which means no wrapping will
+ be done --- not even PyArray_Return).
+
+ A NULL is placed in output_wrap for outputs that
+ should just have PyArray_Return called.
+ */
+
+static void
+_find_array_wrap(PyObject *args, PyObject **output_wrap, int nin, int nout)
+{
+ int nargs, i;
+ int np = 0;
+ double priority, maxpriority;
+ PyObject *with_wrap[NPY_MAXARGS], *wraps[NPY_MAXARGS];
+ PyObject *obj, *wrap = NULL;
+
+ nargs = PyTuple_GET_SIZE(args);
+ for (i=0; i<nin; i++) {
+ obj = PyTuple_GET_ITEM(args, i);
+ if (PyArray_CheckExact(obj) || \
+ PyArray_IsAnyScalar(obj))
+ continue;
+ wrap = PyObject_GetAttrString(obj, "__array_wrap__");
+ if (wrap) {
+ if (PyCallable_Check(wrap)) {
+ with_wrap[np] = obj;
+ wraps[np] = wrap;
+ ++np;
+ }
+ else {
+ Py_DECREF(wrap);
+ wrap = NULL;
+ }
+ }
+ else {
+ PyErr_Clear();
+ }
+ }
+ if (np >= 2) {
+ wrap = wraps[0];
+ maxpriority = PyArray_GetPriority(with_wrap[0],
+ PyArray_SUBTYPE_PRIORITY);
+ for (i = 1; i < np; ++i) {
+ priority = \
+ PyArray_GetPriority(with_wrap[i],
+ PyArray_SUBTYPE_PRIORITY);
+ if (priority > maxpriority) {
+ maxpriority = priority;
+ Py_DECREF(wrap);
+ wrap = wraps[i];
+ } else {
+ Py_DECREF(wraps[i]);
+ }
+ }
+ }
+
+ /* Here wrap is the wrapping function determined from the
+ input arrays (could be NULL).
+
+ For all the output arrays decide what to do.
+
+ 1) Use the wrap function determined from the input arrays
+ This is the default if the output array is not
+ passed in.
+
+ 2) Use the __array_wrap__ method of the output object
+ passed in. -- this is special cased for
+ exact ndarray so that no PyArray_Return is
+ done in that case.
+ */
+
+ for (i=0; i<nout; i++) {
+ int j = nin + i;
+ int incref=1;
+ output_wrap[i] = wrap;
+ if (j < nargs) {
+ obj = PyTuple_GET_ITEM(args, j);
+ if (obj == Py_None)
+ continue;
+ if (PyArray_CheckExact(obj)) {
+ output_wrap[i] = Py_None;
+ }
+ else {
+ PyObject *owrap;
+ owrap = PyObject_GetAttrString \
+ (obj,"__array_wrap__");
+ incref=0;
+ if (!(owrap) || !(PyCallable_Check(owrap))) {
+ Py_XDECREF(owrap);
+ owrap = wrap;
+ incref=1;
+ PyErr_Clear();
+ }
+ output_wrap[i] = owrap;
+ }
+ }
+ if (incref) {
+ Py_XINCREF(output_wrap[i]);
+ }
+ }
+
+ Py_XDECREF(wrap);
+ return;
+}
+
+static PyObject *
+ufunc_generic_call(PyUFuncObject *self, PyObject *args, PyObject *kwds)
+{
+ int i;
+ PyTupleObject *ret;
+ PyArrayObject *mps[NPY_MAXARGS];
+ PyObject *retobj[NPY_MAXARGS];
+ PyObject *wraparr[NPY_MAXARGS];
+ PyObject *res;
+ int errval;
+
+ /* Initialize all array objects to NULL to make cleanup easier
+ if something goes wrong. */
+ for(i=0; i<self->nargs; i++) mps[i] = NULL;
+
+ errval = PyUFunc_GenericFunction(self, args, kwds, mps);
+ if (errval < 0) {
+ for(i=0; i<self->nargs; i++) {
+ PyArray_XDECREF_ERR(mps[i]);
+ }
+ if (errval == -1)
+ return NULL;
+ else {
+ Py_INCREF(Py_NotImplemented);
+ return Py_NotImplemented;
+ }
+ }
+
+ for(i=0; i<self->nin; i++) Py_DECREF(mps[i]);
+
+
+ /* Use __array_wrap__ on all outputs
+ if present on one of the input arguments.
+ If present for multiple inputs:
+ use __array_wrap__ of input object with largest
+ __array_priority__ (default = 0.0)
+ */
+
+ /* Exception: we should not wrap outputs for items already
+ passed in as output-arguments. These items should either
+ be left unwrapped or wrapped by calling their own __array_wrap__
+ routine.
+
+ For each output argument, wrap will be either
+ NULL --- call PyArray_Return() -- default if no output arguments given
+ None --- array-object passed in don't call PyArray_Return
+ method --- the __array_wrap__ method to call.
+ */
+ _find_array_wrap(args, wraparr, self->nin, self->nout);
+
+ /* wrap outputs */
+ for (i=0; i<self->nout; i++) {
+ int j=self->nin+i;
+ PyObject *wrap;
+ /* check to see if any UPDATEIFCOPY flags are set
+ which meant that a temporary output was generated
+ */
+ if (mps[j]->flags & UPDATEIFCOPY) {
+ PyObject *old = mps[j]->base;
+ Py_INCREF(old); /* we want to hang on to this */
+ Py_DECREF(mps[j]); /* should trigger the copy
+ back into old */
+ mps[j] = (PyArrayObject *)old;
+ }
+ wrap = wraparr[i];
+ if (wrap != NULL) {
+ if (wrap == Py_None) {
+ Py_DECREF(wrap);
+ retobj[i] = (PyObject *)mps[j];
+ continue;
+ }
+ res = PyObject_CallFunction(wrap, "O(OOi)",
+ mps[j], self, args, i);
+ if (res == NULL && \
+ PyErr_ExceptionMatches(PyExc_TypeError)) {
+ PyErr_Clear();
+ res = PyObject_CallFunctionObjArgs(wrap,
+ mps[j],
+ NULL);
+ }
+ Py_DECREF(wrap);
+ if (res == NULL) goto fail;
+ else if (res == Py_None) Py_DECREF(res);
+ else {
+ Py_DECREF(mps[j]);
+ retobj[i] = res;
+ continue;
+ }
+ }
+ /* default behavior */
+ retobj[i] = PyArray_Return(mps[j]);
+ }
+
+ if (self->nout == 1) {
+ return retobj[0];
+ } else {
+ ret = (PyTupleObject *)PyTuple_New(self->nout);
+ for(i=0; i<self->nout; i++) {
+ PyTuple_SET_ITEM(ret, i, retobj[i]);
+ }
+ return (PyObject *)ret;
+ }
+ fail:
+ for(i=self->nin; i<self->nargs; i++) Py_XDECREF(mps[i]);
+ return NULL;
+}
+
+static PyObject *
+ufunc_geterr(PyObject *dummy, PyObject *args)
+{
+ PyObject *thedict;
+ PyObject *res;
+
+ if (!PyArg_ParseTuple(args, "")) return NULL;
+
+ if (PyUFunc_PYVALS_NAME == NULL) {
+ PyUFunc_PYVALS_NAME = PyString_InternFromString(UFUNC_PYVALS_NAME);
+ }
+ thedict = PyThreadState_GetDict();
+ if (thedict == NULL) {
+ thedict = PyEval_GetBuiltins();
+ }
+ res = PyDict_GetItem(thedict, PyUFunc_PYVALS_NAME);
+ if (res != NULL) {
+ Py_INCREF(res);
+ return res;
+ }
+ /* Construct list of defaults */
+ res = PyList_New(3);
+ if (res == NULL) return NULL;
+ PyList_SET_ITEM(res, 0, PyInt_FromLong(PyArray_BUFSIZE));
+ PyList_SET_ITEM(res, 1, PyInt_FromLong(UFUNC_ERR_DEFAULT));
+ PyList_SET_ITEM(res, 2, Py_None); Py_INCREF(Py_None);
+ return res;
+}
+
+#if USE_USE_DEFAULTS==1
+/*
+This is a strategy to buy a little speed up and avoid the dictionary
+look-up in the default case. It should work in the presence of
+threads. If it is deemed too complicated or it doesn't actually work
+it could be taken out.
+*/
+static int
+ufunc_update_use_defaults(void)
+{
+ PyObject *errobj;
+ int errmask, bufsize;
+ int res;
+
+ PyUFunc_NUM_NODEFAULTS += 1;
+ res = PyUFunc_GetPyValues("test", &bufsize, &errmask,
+ &errobj);
+ PyUFunc_NUM_NODEFAULTS -= 1;
+
+ if (res < 0) return -1;
+
+ if ((errmask != UFUNC_ERR_DEFAULT) || \
+ (bufsize != PyArray_BUFSIZE) || \
+ (PyTuple_GET_ITEM(errobj, 1) != Py_None)) {
+ PyUFunc_NUM_NODEFAULTS += 1;
+ }
+ else if (PyUFunc_NUM_NODEFAULTS > 0) {
+ PyUFunc_NUM_NODEFAULTS -= 1;
+ }
+ return 0;
+}
+#endif
+
+static PyObject *
+ufunc_seterr(PyObject *dummy, PyObject *args)
+{
+ PyObject *thedict;
+ int res;
+ PyObject *val;
+ static char *msg = "Error object must be a list of length 3";
+
+ if (!PyArg_ParseTuple(args, "O", &val)) return NULL;
+
+ if (!PyList_CheckExact(val) || PyList_GET_SIZE(val) != 3) {
+ PyErr_SetString(PyExc_ValueError, msg);
+ return NULL;
+ }
+ if (PyUFunc_PYVALS_NAME == NULL) {
+ PyUFunc_PYVALS_NAME = PyString_InternFromString(UFUNC_PYVALS_NAME);
+ }
+ thedict = PyThreadState_GetDict();
+ if (thedict == NULL) {
+ thedict = PyEval_GetBuiltins();
+ }
+ res = PyDict_SetItem(thedict, PyUFunc_PYVALS_NAME, val);
+ if (res < 0) return NULL;
+#if USE_USE_DEFAULTS==1
+ if (ufunc_update_use_defaults() < 0) return NULL;
+#endif
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+
+
+static PyUFuncGenericFunction pyfunc_functions[] = {PyUFunc_On_Om};
+
+static char
+doc_frompyfunc[] = "frompyfunc(func, nin, nout) take an arbitrary python function that takes nin objects as input and returns nout objects and return a universal function (ufunc). This ufunc always returns PyObject arrays";
+
+static PyObject *
+ufunc_frompyfunc(PyObject *dummy, PyObject *args, PyObject *kwds) {
+ /* Keywords are ignored for now */
+
+ PyObject *function, *pyname=NULL;
+ int nin, nout, i;
+ PyUFunc_PyFuncData *fdata;
+ PyUFuncObject *self;
+ char *fname, *str;
+ Py_ssize_t fname_len=-1;
+ int offset[2];
+
+ if (!PyArg_ParseTuple(args, "Oii", &function, &nin, &nout)) return NULL;
+
+ if (!PyCallable_Check(function)) {
+ PyErr_SetString(PyExc_TypeError, "function must be callable");
+ return NULL;
+ }
+
+ self = _pya_malloc(sizeof(PyUFuncObject));
+ if (self == NULL) return NULL;
+ PyObject_Init((PyObject *)self, &PyUFunc_Type);
+
+ self->userloops = NULL;
+ self->nin = nin;
+ self->nout = nout;
+ self->nargs = nin+nout;
+ self->identity = PyUFunc_None;
+ self->functions = pyfunc_functions;
+
+ self->ntypes = 1;
+ self->check_return = 0;
+
+ pyname = PyObject_GetAttrString(function, "__name__");
+ if (pyname)
+ (void) PyString_AsStringAndSize(pyname, &fname, &fname_len);
+
+ if (PyErr_Occurred()) {
+ fname = "?";
+ fname_len = 1;
+ PyErr_Clear();
+ }
+ Py_XDECREF(pyname);
+
+
+
+ /* self->ptr holds a pointer for enough memory for
+ self->data[0] (fdata)
+ self->data
+ self->name
+ self->types
+
+ To be safest, all of these need their memory aligned on void * pointers
+ Therefore, we may need to allocate extra space.
+ */
+ offset[0] = sizeof(PyUFunc_PyFuncData);
+ i = (sizeof(PyUFunc_PyFuncData) % sizeof(void *));
+ if (i) offset[0] += (sizeof(void *) - i);
+ offset[1] = self->nargs;
+ i = (self->nargs % sizeof(void *));
+ if (i) offset[1] += (sizeof(void *)-i);
+
+ self->ptr = _pya_malloc(offset[0] + offset[1] + sizeof(void *) + \
+ (fname_len+14));
+
+ if (self->ptr == NULL) return PyErr_NoMemory();
+ Py_INCREF(function);
+ self->obj = function;
+ fdata = (PyUFunc_PyFuncData *)(self->ptr);
+ fdata->nin = nin;
+ fdata->nout = nout;
+ fdata->callable = function;
+
+ self->data = (void **)(((char *)self->ptr) + offset[0]);
+ self->data[0] = (void *)fdata;
+
+ self->types = (char *)self->data + sizeof(void *);
+ for (i=0; i<self->nargs; i++) self->types[i] = PyArray_OBJECT;
+
+ str = self->types + offset[1];
+ memcpy(str, fname, fname_len);
+ memcpy(str+fname_len, " (vectorized)", 14);
+
+ self->name = str;
+
+ /* Do a better job someday */
+ self->doc = "dynamic ufunc based on a python function";
+
+
+ return (PyObject *)self;
+}
+
+/*UFUNC_API*/
+static int
+PyUFunc_ReplaceLoopBySignature(PyUFuncObject *func,
+ PyUFuncGenericFunction newfunc,
+ int *signature,
+ PyUFuncGenericFunction *oldfunc)
+{
+ int i,j;
+ int res = -1;
+ /* Find the location of the matching signature */
+ for (i=0; i<func->ntypes; i++) {
+ for (j=0; j<func->nargs; j++) {
+ if (signature[j] != func->types[i*func->nargs+j])
+ break;
+ }
+ if (j < func->nargs) continue;
+
+ if (oldfunc != NULL) {
+ *oldfunc = func->functions[i];
+ }
+ func->functions[i] = newfunc;
+ res = 0;
+ break;
+ }
+ return res;
+}
+
+/*UFUNC_API*/
+static PyObject *
+PyUFunc_FromFuncAndData(PyUFuncGenericFunction *func, void **data,
+ char *types, int ntypes,
+ int nin, int nout, int identity,
+ char *name, char *doc, int check_return)
+{
+ PyUFuncObject *self;
+
+ self = _pya_malloc(sizeof(PyUFuncObject));
+ if (self == NULL) return NULL;
+ PyObject_Init((PyObject *)self, &PyUFunc_Type);
+
+ self->nin = nin;
+ self->nout = nout;
+ self->nargs = nin+nout;
+ self->identity = identity;
+
+ self->functions = func;
+ self->data = data;
+ self->types = types;
+ self->ntypes = ntypes;
+ self->check_return = check_return;
+ self->ptr = NULL;
+ self->obj = NULL;
+ self->userloops=NULL;
+
+ if (name == NULL) self->name = "?";
+ else self->name = name;
+
+ if (doc == NULL) self->doc = "NULL";
+ else self->doc = doc;
+
+ return (PyObject *)self;
+}
+
+/* This is the first-part of the CObject structure.
+
+ I don't think this will change, but if it should, then
+ this needs to be fixed. The exposed C-API was insufficient
+ because I needed to replace the pointer and it wouldn't
+ let me with a destructor set (even though it works fine
+ with the destructor).
+ */
+
+typedef struct {
+ PyObject_HEAD
+ void *c_obj;
+} _simple_cobj;
+
+#define _SETCPTR(cobj, val) ((_simple_cobj *)(cobj))->c_obj = (val)
+
+/* return 1 if arg1 > arg2, 0 if arg1 == arg2, and -1 if arg1 < arg2
+ */
+static int
+cmp_arg_types(int *arg1, int *arg2, int n)
+{
+ while (n--) {
+ if (PyArray_EquivTypenums(*arg1, *arg2)) continue;
+ if (PyArray_CanCastSafely(*arg1, *arg2))
+ return -1;
+ return 1;
+ }
+ return 0;
+}
+
+/* This frees the linked-list structure
+ when the CObject is destroyed (removed
+ from the internal dictionary)
+*/
+static void
+_loop1d_list_free(void *ptr)
+{
+ PyUFunc_Loop1d *funcdata;
+ if (ptr == NULL) return;
+ funcdata = (PyUFunc_Loop1d *)ptr;
+ if (funcdata == NULL) return;
+ _pya_free(funcdata->arg_types);
+ _loop1d_list_free(funcdata->next);
+ _pya_free(funcdata);
+}
+
+
+/*UFUNC_API*/
+static int
+PyUFunc_RegisterLoopForType(PyUFuncObject *ufunc,
+ int usertype,
+ PyUFuncGenericFunction function,
+ int *arg_types,
+ void *data)
+{
+ PyArray_Descr *descr;
+ PyUFunc_Loop1d *funcdata;
+ PyObject *key, *cobj;
+ int i;
+ int *newtypes=NULL;
+
+ descr=PyArray_DescrFromType(usertype);
+ if ((usertype < PyArray_USERDEF) || (descr==NULL)) {
+ PyErr_SetString(PyExc_TypeError,
+ "unknown user-defined type");
+ return -1;
+ }
+ Py_DECREF(descr);
+
+ if (ufunc->userloops == NULL) {
+ ufunc->userloops = PyDict_New();
+ }
+ key = PyInt_FromLong((long) usertype);
+ if (key == NULL) return -1;
+ funcdata = _pya_malloc(sizeof(PyUFunc_Loop1d));
+ if (funcdata == NULL) goto fail;
+ newtypes = _pya_malloc(sizeof(int)*ufunc->nargs);
+ if (newtypes == NULL) goto fail;
+ if (arg_types != NULL) {
+ for (i=0; i<ufunc->nargs; i++) {
+ newtypes[i] = arg_types[i];
+ }
+ }
+ else {
+ for (i=0; i<ufunc->nargs; i++) {
+ newtypes[i] = usertype;
+ }
+ }
+
+ funcdata->func = function;
+ funcdata->arg_types = newtypes;
+ funcdata->data = data;
+ funcdata->next = NULL;
+
+ /* Get entry for this user-defined type*/
+ cobj = PyDict_GetItem(ufunc->userloops, key);
+
+ /* If it's not there, then make one and return. */
+ if (cobj == NULL) {
+ cobj = PyCObject_FromVoidPtr((void *)funcdata,
+ _loop1d_list_free);
+ if (cobj == NULL) goto fail;
+ PyDict_SetItem(ufunc->userloops, key, cobj);
+ Py_DECREF(cobj);
+ Py_DECREF(key);
+ return 0;
+ }
+ else {
+ PyUFunc_Loop1d *current, *prev=NULL;
+ int cmp=1;
+ /* There is already at least 1 loop. Place this one in
+ lexicographic order. If the next one signature
+ is exactly like this one, then just replace.
+ Otherwise insert.
+ */
+ current = (PyUFunc_Loop1d *)PyCObject_AsVoidPtr(cobj);
+ while (current != NULL) {
+ cmp = cmp_arg_types(current->arg_types, newtypes,
+ ufunc->nargs);
+ if (cmp >= 0) break;
+ prev = current;
+ current = current->next;
+ }
+ if (cmp == 0) { /* just replace it with new function */
+ current->func = function;
+ current->data = data;
+ _pya_free(newtypes);
+ _pya_free(funcdata);
+ }
+ else { /* insert it before the current one
+ by hacking the internals of cobject to
+ replace the function pointer ---
+ can't use CObject API because destructor is set.
+ */
+ funcdata->next = current;
+ if (prev == NULL) { /* place this at front */
+ _SETCPTR(cobj, funcdata);
+ }
+ else {
+ prev->next = funcdata;
+ }
+ }
+ }
+ Py_DECREF(key);
+ return 0;
+
+
+ fail:
+ Py_DECREF(key);
+ _pya_free(funcdata);
+ _pya_free(newtypes);
+ if (!PyErr_Occurred()) PyErr_NoMemory();
+ return -1;
+}
+
+#undef _SETCPTR
+
+
+static void
+ufunc_dealloc(PyUFuncObject *self)
+{
+ if (self->ptr) _pya_free(self->ptr);
+ Py_XDECREF(self->userloops);
+ Py_XDECREF(self->obj);
+ _pya_free(self);
+}
+
+static PyObject *
+ufunc_repr(PyUFuncObject *self)
+{
+ char buf[100];
+
+ sprintf(buf, "<ufunc '%.50s'>", self->name);
+
+ return PyString_FromString(buf);
+}
+
+
+/* -------------------------------------------------------- */
+
+/* op.outer(a,b) is equivalent to op(a[:,NewAxis,NewAxis,etc.],b)
+ where a has b.ndim NewAxis terms appended.
+
+ The result has dimensions a.ndim + b.ndim
+ */
+
+static PyObject *
+ufunc_outer(PyUFuncObject *self, PyObject *args, PyObject *kwds)
+{
+ int i;
+ PyObject *ret;
+ PyArrayObject *ap1=NULL, *ap2=NULL, *ap_new=NULL;
+ PyObject *new_args, *tmp;
+ PyObject *shape1, *shape2, *newshape;
+
+ if(self->nin != 2) {
+ PyErr_SetString(PyExc_ValueError,
+ "outer product only supported "\
+ "for binary functions");
+ return NULL;
+ }
+
+ if (PySequence_Length(args) != 2) {
+ PyErr_SetString(PyExc_TypeError,
+ "exactly two arguments expected");
+ return NULL;
+ }
+
+ tmp = PySequence_GetItem(args, 0);
+ if (tmp == NULL) return NULL;
+ ap1 = (PyArrayObject *) \
+ PyArray_FromObject(tmp, PyArray_NOTYPE, 0, 0);
+ Py_DECREF(tmp);
+ if (ap1 == NULL) return NULL;
+
+ tmp = PySequence_GetItem(args, 1);
+ if (tmp == NULL) return NULL;
+ ap2 = (PyArrayObject *)PyArray_FromObject(tmp, PyArray_NOTYPE, 0, 0);
+ Py_DECREF(tmp);
+ if (ap2 == NULL) {Py_DECREF(ap1); return NULL;}
+
+ /* Construct new shape tuple */
+ shape1 = PyTuple_New(ap1->nd);
+ if (shape1 == NULL) goto fail;
+ for (i=0; i<ap1->nd; i++)
+ PyTuple_SET_ITEM(shape1, i,
+ PyLong_FromLongLong((longlong)ap1-> \
+ dimensions[i]));
+
+ shape2 = PyTuple_New(ap2->nd);
+ for (i=0; i<ap2->nd; i++)
+ PyTuple_SET_ITEM(shape2, i, PyInt_FromLong((long) 1));
+ if (shape2 == NULL) {Py_DECREF(shape1); goto fail;}
+ newshape = PyNumber_Add(shape1, shape2);
+ Py_DECREF(shape1);
+ Py_DECREF(shape2);
+ if (newshape == NULL) goto fail;
+
+ ap_new = (PyArrayObject *)PyArray_Reshape(ap1, newshape);
+ Py_DECREF(newshape);
+ if (ap_new == NULL) goto fail;
+
+ new_args = Py_BuildValue("(OO)", ap_new, ap2);
+ Py_DECREF(ap1);
+ Py_DECREF(ap2);
+ Py_DECREF(ap_new);
+ ret = ufunc_generic_call(self, new_args, kwds);
+ Py_DECREF(new_args);
+ return ret;
+
+ fail:
+ Py_XDECREF(ap1);
+ Py_XDECREF(ap2);
+ Py_XDECREF(ap_new);
+ return NULL;
+}
+
+
+static PyObject *
+ufunc_reduce(PyUFuncObject *self, PyObject *args, PyObject *kwds)
+{
+
+ return PyUFunc_GenericReduction(self, args, kwds, UFUNC_REDUCE);
+}
+
+static PyObject *
+ufunc_accumulate(PyUFuncObject *self, PyObject *args, PyObject *kwds)
+{
+
+ return PyUFunc_GenericReduction(self, args, kwds, UFUNC_ACCUMULATE);
+}
+
+static PyObject *
+ufunc_reduceat(PyUFuncObject *self, PyObject *args, PyObject *kwds)
+{
+ return PyUFunc_GenericReduction(self, args, kwds, UFUNC_REDUCEAT);
+}
+
+
+static struct PyMethodDef ufunc_methods[] = {
+ {"reduce", (PyCFunction)ufunc_reduce, METH_VARARGS | METH_KEYWORDS},
+ {"accumulate", (PyCFunction)ufunc_accumulate,
+ METH_VARARGS | METH_KEYWORDS},
+ {"reduceat", (PyCFunction)ufunc_reduceat,
+ METH_VARARGS | METH_KEYWORDS},
+ {"outer", (PyCFunction)ufunc_outer, METH_VARARGS | METH_KEYWORDS},
+ {NULL, NULL} /* sentinel */
+};
+
+
+
+/* construct the string
+ y1,y2,...,yn
+*/
+static PyObject *
+_makeargs(int num, char *ltr)
+{
+ PyObject *str;
+ int i;
+ switch (num) {
+ case 0:
+ return PyString_FromString("");
+ case 1:
+ return PyString_FromString(ltr);
+ }
+ str = PyString_FromFormat("%s1,%s2", ltr, ltr);
+ for(i = 3; i <= num; ++i) {
+ PyString_ConcatAndDel(&str, PyString_FromFormat(",%s%d", ltr, i));
+ }
+ return str;
+}
+
+static char
+_typecharfromnum(int num) {
+ PyArray_Descr *descr;
+ char ret;
+
+ descr = PyArray_DescrFromType(num);
+ ret = descr->type;
+ Py_DECREF(descr);
+ return ret;
+}
+
+static PyObject *
+ufunc_get_doc(PyUFuncObject *self)
+{
+ /* Put docstring first or FindMethod finds it...*/
+ /* could so some introspection on name and nin + nout */
+ /* to automate the first part of it */
+ /* the doc string shouldn't need the calling convention */
+ /* construct
+ y1,y2,,... = name(x1,x2,...) __doc__
+ */
+ PyObject *outargs, *inargs, *doc;
+ outargs = _makeargs(self->nout, "y");
+ inargs = _makeargs(self->nin, "x");
+ doc = PyString_FromFormat("%s = %s(%s) %s",
+ PyString_AS_STRING(outargs),
+ self->name,
+ PyString_AS_STRING(inargs),
+ self->doc);
+ Py_DECREF(outargs);
+ Py_DECREF(inargs);
+ return doc;
+}
+
+static PyObject *
+ufunc_get_nin(PyUFuncObject *self)
+{
+ return PyInt_FromLong(self->nin);
+}
+
+static PyObject *
+ufunc_get_nout(PyUFuncObject *self)
+{
+ return PyInt_FromLong(self->nout);
+}
+
+static PyObject *
+ufunc_get_nargs(PyUFuncObject *self)
+{
+ return PyInt_FromLong(self->nargs);
+}
+
+static PyObject *
+ufunc_get_ntypes(PyUFuncObject *self)
+{
+ return PyInt_FromLong(self->ntypes);
+}
+
+static PyObject *
+ufunc_get_types(PyUFuncObject *self)
+{
+ /* return a list with types grouped
+ input->output */
+ PyObject *list;
+ PyObject *str;
+ int k, j, n, nt=self->ntypes;
+ int ni = self->nin;
+ int no = self->nout;
+ char *t;
+ list = PyList_New(nt);
+ if (list == NULL) return NULL;
+ t = _pya_malloc(no+ni+2);
+ n = 0;
+ for (k=0; k<nt; k++) {
+ for (j=0; j<ni; j++) {
+ t[j] = _typecharfromnum(self->types[n]);
+ n++;
+ }
+ t[ni] = '-';
+ t[ni+1] = '>';
+ for (j=0; j<no; j++) {
+ t[ni+2+j] = \
+ _typecharfromnum(self->types[n]);
+ n++;
+ }
+ str = PyString_FromStringAndSize(t, no+ni+2);
+ PyList_SET_ITEM(list, k, str);
+ }
+ _pya_free(t);
+ return list;
+
+}
+
+static PyObject *
+ufunc_get_name(PyUFuncObject *self)
+{
+ return PyString_FromString(self->name);
+}
+
+static PyObject *
+ufunc_get_identity(PyUFuncObject *self)
+{
+ switch(self->identity) {
+ case PyUFunc_One:
+ return PyInt_FromLong(1);
+ case PyUFunc_Zero:
+ return PyInt_FromLong(0);
+ }
+ return Py_None;
+}
+
+
+#undef _typecharfromnum
+
+static char Ufunctype__doc__[] =
+ "Optimized functions make it possible to implement arithmetic "\
+ "with arrays efficiently";
+
+static PyGetSetDef ufunc_getset[] = {
+ {"__doc__", (getter)ufunc_get_doc, NULL, "documentation string"},
+ {"nin", (getter)ufunc_get_nin, NULL, "number of inputs"},
+ {"nout", (getter)ufunc_get_nout, NULL, "number of outputs"},
+ {"nargs", (getter)ufunc_get_nargs, NULL, "number of arguments"},
+ {"ntypes", (getter)ufunc_get_ntypes, NULL, "number of types"},
+ {"types", (getter)ufunc_get_types, NULL, "return a list with types grouped input->output"},
+ {"__name__", (getter)ufunc_get_name, NULL, "function name"},
+ {"identity", (getter)ufunc_get_identity, NULL, "identity value"},
+ {NULL, NULL, NULL, NULL}, /* Sentinel */
+};
+
+static PyTypeObject PyUFunc_Type = {
+ PyObject_HEAD_INIT(0)
+ 0, /*ob_size*/
+ "numpy.ufunc", /*tp_name*/
+ sizeof(PyUFuncObject), /*tp_basicsize*/
+ 0, /*tp_itemsize*/
+ /* methods */
+ (destructor)ufunc_dealloc, /*tp_dealloc*/
+ (printfunc)0, /*tp_print*/
+ (getattrfunc)0, /*tp_getattr*/
+ (setattrfunc)0, /*tp_setattr*/
+ (cmpfunc)0, /*tp_compare*/
+ (reprfunc)ufunc_repr, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+ (hashfunc)0, /*tp_hash*/
+ (ternaryfunc)ufunc_generic_call, /*tp_call*/
+ (reprfunc)ufunc_repr, /*tp_str*/
+ 0, /* tp_getattro */
+ 0, /* tp_setattro */
+ 0, /* tp_as_buffer */
+ Py_TPFLAGS_DEFAULT, /* tp_flags */
+ Ufunctype__doc__, /* tp_doc */
+ 0, /* tp_traverse */
+ 0, /* tp_clear */
+ 0, /* tp_richcompare */
+ 0, /* tp_weaklistoffset */
+ 0, /* tp_iter */
+ 0, /* tp_iternext */
+ ufunc_methods, /* tp_methods */
+ 0, /* tp_members */
+ ufunc_getset, /* tp_getset */
+};
+
+/* End of code for ufunc objects */
+/* -------------------------------------------------------- */
diff --git a/numpy/core/src/umathmodule.c.src b/numpy/core/src/umathmodule.c.src
new file mode 100644
index 000000000..93bd760f9
--- /dev/null
+++ b/numpy/core/src/umathmodule.c.src
@@ -0,0 +1,2265 @@
+/* -*- c -*- */
+
+#include "Python.h"
+#include "numpy/noprefix.h"
+#define _UMATHMODULE
+#include "numpy/ufuncobject.h"
+#include "abstract.h"
+#include <math.h>
+
+/* A whole slew of basic math functions are provided originally
+ by Konrad Hinsen. */
+
+#if !defined(__STDC__) && !defined(_MSC_VER)
+extern double fmod (double, double);
+extern double frexp (double, int *);
+extern double ldexp (double, int);
+extern double modf (double, double *);
+#endif
+#ifndef M_PI
+#define M_PI 3.14159265358979323846264338328
+#endif
+
+
+#ifndef HAVE_INVERSE_HYPERBOLIC
+static double acosh(double x)
+{
+ return 2*log(sqrt((x+1.0)/2)+sqrt((x-1.0)/2));
+}
+
+double log1p(double);
+static double asinh(double xx)
+{
+ double x, d;
+ int sign;
+ if (xx < 0.0) {
+ sign = -1;
+ x = -xx;
+ }
+ else {
+ sign = 1;
+ x = xx;
+ }
+ if (x > 1e8) {
+ d = x;
+ } else {
+ d = sqrt(x*x + 1);
+ }
+ return sign*log1p(x*(1.0 + x/(d+1)));
+}
+
+static double atanh(double x)
+{
+ return 0.5*log1p(2.0*x/(1.0-x));
+}
+#endif
+
+#if !defined(HAVE_INVERSE_HYPERBOLIC_FLOAT)
+#ifdef HAVE_FLOAT_FUNCS
+#ifdef log1pf
+#undef log1pf
+#endif
+#ifdef logf
+#undef logf
+#endif
+#ifdef sqrtf
+#undef sqrtf
+#endif
+float log1pf(float);
+float logf(float);
+float sqrtf(float);
+#ifdef acoshf
+#undef acoshf
+#endif
+static float acoshf(float x)
+{
+ return 2*logf(sqrtf((x+1)/2)+sqrtf((x-1)/2));
+}
+
+#ifdef asinhf
+#undef asinhf
+#endif
+static float asinhf(float xx)
+{
+ float x, d;
+ int sign;
+ if (xx < 0) {
+ sign = -1;
+ x = -xx;
+ }
+ else {
+ sign = 1;
+ x = xx;
+ }
+ if (x > 1e5) {
+ d = x;
+ } else {
+ d = sqrtf(x*x + 1);
+ }
+ return sign*log1pf(x*(1 + x/(d+1)));
+}
+
+#ifdef atanhf
+#undef atanhf
+#endif
+static float atanhf(float x)
+{
+ return log1pf(2*x/(1-x))/2;
+}
+#else
+#ifdef acoshf
+#undef acoshf
+#endif
+static float acoshf(float x)
+{
+ return (float)acosh((double)(x));
+}
+
+#ifdef asinhf
+#undef asinhf
+#endif
+static float asinhf(float x)
+{
+ return (float)asinh((double)(x));
+}
+
+#ifdef atanhf
+#undef atanhf
+#endif
+static float atanhf(float x)
+{
+ return (float)atanh((double)(x));
+}
+#endif
+#endif
+
+
+#if !defined(HAVE_INVERSE_HYPERBOLIC_LONGDOUBLE)
+#ifdef HAVE_LONGDOUBLE_FUNCS
+#ifdef logl
+#undef logl
+#endif
+#ifdef sqrtl
+#undef sqrtl
+#endif
+#ifdef log1pl
+#undef log1pl
+#endif
+longdouble logl(longdouble);
+longdouble sqrtl(longdouble);
+longdouble log1pl(longdouble);
+#ifdef acoshl
+#undef acoshl
+#endif
+static longdouble acoshl(longdouble x)
+{
+ return 2*logl(sqrtl((x+1.0)/2)+sqrtl((x-1.0)/2));
+}
+
+#ifdef asinhl
+#undef asinhl
+#endif
+static longdouble asinhl(longdouble xx)
+{
+ longdouble x, d;
+ int sign;
+ if (xx < 0.0) {
+ sign = -1;
+ x = -xx;
+ }
+ else {
+ sign = 1;
+ x = xx;
+ }
+ if (x > 1e17) {
+ d = x;
+ } else {
+ d = sqrtl(x*x + 1);
+ }
+ return sign*log1pl(x*(1.0 + x/(d+1)));
+}
+
+#ifdef atanhl
+#undef atanhl
+#endif
+static longdouble atanhl(longdouble x)
+{
+ return 0.5*log1pl(2.0*x/(1.0-x));
+}
+
+#else
+
+#ifdef acoshl
+#undef acoshl
+#endif
+static longdouble acoshl(longdouble x)
+{
+ return (longdouble)acosh((double)(x));
+}
+
+#ifdef asinhl
+#undef asinhl
+#endif
+static longdouble asinhl(longdouble x)
+{
+ return (longdouble)asinh((double)(x));
+}
+
+#ifdef atanhl
+#undef atanhl
+#endif
+static longdouble atanhl(longdouble x)
+{
+ return (longdouble)atanh((double)(x));
+}
+
+#endif
+#endif
+
+
+#ifdef HAVE_HYPOT
+#if !defined(NeXT) && !defined(_MSC_VER)
+extern double hypot(double, double);
+#endif
+#else
+static double hypot(double x, double y)
+{
+ double yx;
+
+ x = fabs(x);
+ y = fabs(y);
+ if (x < y) {
+ double temp = x;
+ x = y;
+ y = temp;
+ }
+ if (x == 0.)
+ return 0.;
+ else {
+ yx = y/x;
+ return x*sqrt(1.+yx*yx);
+ }
+}
+#endif
+
+
+#ifndef HAVE_RINT
+static double
+rint (double x)
+{
+ double y, r;
+
+ y = floor(x);
+ r = x - y;
+
+ if (r > 0.5) goto rndup;
+
+ /* Round to nearest even */
+ if (r==0.5) {
+ r = y - 2.0*floor(0.5*y);
+ if (r==1.0) {
+ rndup:
+ y+=1.0;
+ }
+ }
+ return y;
+}
+#endif
+
+
+
+
+
+/* Define isnan, isinf, isfinite, signbit if needed */
+/* Use fpclassify if possible */
+/* isnan, isinf --
+ these will use macros and then fpclassify if available before
+ defaulting to a dumb convert-to-double version...
+
+ isfinite -- define a macro if not already available
+ signbit -- if macro available use it, otherwise define a function
+ and a dumb convert-to-double version for other types.
+*/
+
+#if defined(fpclassify)
+
+#if !defined(isnan)
+#define isnan(x) (fpclassify(x) == FP_NAN)
+#endif
+#if !defined(isinf)
+#define isinf(x) (fpclassify(x) == FP_INFINITE)
+#endif
+
+#else /* check to see if already have a function like this */
+
+#if !defined(HAVE_ISNAN)
+
+#if !defined(isnan)
+#include "_isnan.c"
+#endif
+#endif /* HAVE_ISNAN */
+
+#if !defined(HAVE_ISINF)
+#if !defined(isinf)
+#define isinf(x) (!isnan((x)) && isnan((x)-(x)))
+#endif
+#endif /* HAVE_ISINF */
+
+#endif /* defined(fpclassify) */
+
+
+/* Define signbit if needed */
+#if !defined(signbit)
+#include "_signbit.c"
+#endif
+
+/* Now defined the extended type macros */
+
+#if !defined(isnan)
+
+#if !defined(HAVE_LONGDOUBLE_FUNCS) || !defined(HAVE_ISNAN)
+#define isnanl(x) isnan((double)(x))
+#endif
+
+#if !defined(HAVE_FLOAT_FUNCS) || !defined(HAVE_ISNAN)
+#define isnanf(x) isnan((double)(x))
+#endif
+
+#else /* !defined(isnan) */
+
+#define isnanl(x) isnan((x))
+#define isnanf(x) isnan((x))
+
+#endif /* !defined(isnan) */
+
+
+#if !defined(isinf)
+
+#if !defined(HAVE_LONGDOUBLE_FUNCS) || !defined(HAVE_ISINF)
+#define isinfl(x) (!isnanl((x)) && isnanl((x)-(x)))
+#endif
+
+#if !defined(HAVE_FLOAT_FUNCS) || !defined(HAVE_ISINF)
+#define isinff(x) (!isnanf((x)) && isnanf((x)-(x)))
+#endif
+
+#else /* !defined(isinf) */
+
+#define isinfl(x) isinf((x))
+#define isinff(x) isinf((x))
+
+#endif /* !defined(isinf) */
+
+
+#if !defined(signbit)
+#define signbitl(x) ((longdouble) signbit((double)(x)))
+#define signbitf(x) ((float) signbit((double) (x)))
+#else
+#define signbitl(x) signbit((x))
+#define signbitf(x) signbit((x))
+#endif
+
+#if !defined(isfinite)
+#define isfinite(x) (!(isinf((x)) || isnan((x))))
+#endif
+#define isfinitef(x) (!(isinff((x)) || isnanf((x))))
+#define isfinitel(x) (!(isinfl((x)) || isnanl((x))))
+
+
+/* First, the C functions that do the real work */
+
+/* if C99 extensions not available then define dummy functions that use the
+ double versions for
+
+ sin, cos, tan
+ sinh, cosh, tanh,
+ fabs, floor, ceil, fmod, sqrt, log10, log, exp, fabs
+ asin, acos, atan,
+ asinh, acosh, atanh
+
+ hypot, atan2, pow
+*/
+
+/**begin repeat
+
+#kind=(sin,cos,tan,sinh,cosh,tanh,fabs,floor,ceil,sqrt,log10,log,exp,asin,acos,atan,rint)*2#
+#typ=longdouble*17, float*17#
+#c=l*17,f*17#
+#TYPE=LONGDOUBLE*17, FLOAT*17#
+*/
+#ifndef HAVE_@TYPE@_FUNCS
+#ifdef @kind@@c@
+#undef @kind@@c@
+#endif
+@typ@ @kind@@c@(@typ@ x) {
+ return (@typ@) @kind@((double)x);
+}
+#endif
+/**end repeat**/
+
+/**begin repeat
+
+#kind=(atan2,hypot,pow,fmod)*2#
+#typ=longdouble*4, float*4#
+#c=l*4,f*4#
+#TYPE=LONGDOUBLE*4,FLOAT*4#
+*/
+#ifndef HAVE_@TYPE@_FUNCS
+#ifdef @kind@@c@
+#undef @kind@@c@
+#endif
+@typ@ @kind@@c@(@typ@ x, @typ@ y) {
+ return (@typ@) @kind@((double)x, (double) y);
+}
+#endif
+/**end repeat**/
+
+/**begin repeat
+#kind=modf*2#
+#typ=longdouble, float#
+#c=l,f#
+#TYPE=LONGDOUBLE, FLOAT#
+*/
+#ifndef HAVE_@TYPE@_FUNCS
+#ifdef modf@c@
+#undef modf@c@
+#endif
+@typ@ modf@c@(@typ@ x, @typ@ *iptr) {
+ double nx, niptr, y;
+ nx = (double) x;
+ y = modf(nx, &niptr);
+ *iptr = (@typ@) niptr;
+ return (@typ@) y;
+}
+#endif
+/**end repeat**/
+
+
+
+#ifndef HAVE_LOG1P
+double log1p(double x)
+{
+ double u = 1. + x;
+ if (u == 1.0) {
+ return x;
+ } else {
+ return log(u) * x / (u-1.);
+ }
+}
+#endif
+
+#if !defined(HAVE_LOG1P) || !defined(HAVE_LONGDOUBLE_FUNCS)
+#ifdef log1pl
+#undef log1pl
+#endif
+longdouble log1pl(longdouble x)
+{
+ longdouble u = 1. + x;
+ if (u == 1.0) {
+ return x;
+ } else {
+ return logl(u) * x / (u-1.);
+ }
+}
+#endif
+
+#if !defined(HAVE_LOG1P) || !defined(HAVE_FLOAT_FUNCS)
+#ifdef log1pf
+#undef log1pf
+#endif
+float log1pf(float x)
+{
+ float u = 1 + x;
+ if (u == 1) {
+ return x;
+ } else {
+ return logf(u) * x / (u-1);
+ }
+}
+#endif
+
+#ifndef HAVE_EXPM1
+static double expm1(double x)
+{
+ double u = exp(x);
+ if (u == 1.0) {
+ return x;
+ } else if (u-1.0 == -1.0) {
+ return -1;
+ } else {
+ return (u-1.0) * x/log(u);
+ }
+}
+#endif
+
+#if !defined(HAVE_EXPM1) || !defined(HAVE_LONGDOUBLE_FUNCS)
+#ifdef expml1
+#undef expml1
+#endif
+static longdouble expm1l(longdouble x)
+{
+ longdouble u = expl(x);
+ if (u == 1.0) {
+ return x;
+ } else if (u-1.0 == -1.0) {
+ return -1;
+ } else {
+ return (u-1.0) * x/logl(u);
+ }
+}
+#endif
+
+#if !defined(HAVE_EXPM1) || !defined(HAVE_FLOAT_FUNCS)
+#ifdef expm1f
+#undef expm1f
+#endif
+static float expm1f(float x)
+{
+ float u = expf(x);
+ if (u == 1) {
+ return x;
+ } else if (u-1 == -1) {
+ return -1;
+ } else {
+ return (u-1) * x/logf(u);
+ }
+}
+#endif
+
+
+
+/* Don't pass structures between functions (only pointers) because how
+ structures are passed is compiler dependent and could cause
+ segfaults if ufuncobject.c is compiled with a different compiler
+ than an extension that makes use of the UFUNC API
+*/
+
+/**begin repeat
+
+#typ=float, double, longdouble#
+#c=f,,l#
+*/
+
+/* constants */
+static c@typ@ nc_1@c@ = {1., 0.};
+static c@typ@ nc_half@c@ = {0.5, 0.};
+static c@typ@ nc_i@c@ = {0., 1.};
+static c@typ@ nc_i2@c@ = {0., 0.5};
+/*
+static c@typ@ nc_mi@c@ = {0., -1.};
+static c@typ@ nc_pi2@c@ = {M_PI/2., 0.};
+*/
+
+static void
+nc_sum@c@(c@typ@ *a, c@typ@ *b, c@typ@ *r)
+{
+ r->real = a->real + b->real;
+ r->imag = a->imag + b->imag;
+ return;
+}
+
+static void
+nc_diff@c@(c@typ@ *a, c@typ@ *b, c@typ@ *r)
+{
+ r->real = a->real - b->real;
+ r->imag = a->imag - b->imag;
+ return;
+}
+
+static void
+nc_neg@c@(c@typ@ *a, c@typ@ *r)
+{
+ r->real = -a->real;
+ r->imag = -a->imag;
+ return;
+}
+
+static void
+nc_prod@c@(c@typ@ *a, c@typ@ *b, c@typ@ *r)
+{
+ register @typ@ ar=a->real, br=b->real, ai=a->imag, bi=b->imag;
+ r->real = ar*br - ai*bi;
+ r->imag = ar*bi + ai*br;
+ return;
+}
+
+static void
+nc_quot@c@(c@typ@ *a, c@typ@ *b, c@typ@ *r)
+{
+
+ register @typ@ ar=a->real, br=b->real, ai=a->imag, bi=b->imag;
+ register @typ@ d = br*br + bi*bi;
+ r->real = (ar*br + ai*bi)/d;
+ r->imag = (ai*br - ar*bi)/d;
+ return;
+}
+
+static void
+nc_sqrt@c@(c@typ@ *x, c@typ@ *r)
+{
+ @typ@ s,d;
+ if (x->real == 0. && x->imag == 0.)
+ *r = *x;
+ else {
+ s = sqrt@c@((fabs@c@(x->real) + hypot@c@(x->real,x->imag))/2);
+ d = x->imag/(2*s);
+ if (x->real > 0) {
+ r->real = s;
+ r->imag = d;
+ }
+ else if (x->imag >= 0) {
+ r->real = d;
+ r->imag = s;
+ }
+ else {
+ r->real = -d;
+ r->imag = -s;
+ }
+ }
+ return;
+}
+
+static void
+nc_rint@c@(c@typ@ *x, c@typ@ *r)
+{
+ r->real = rint@c@(x->real);
+ r->imag = rint@c@(x->imag);
+}
+
+static void
+nc_log@c@(c@typ@ *x, c@typ@ *r)
+{
+ @typ@ l = hypot@c@(x->real,x->imag);
+ r->imag = atan2@c@(x->imag, x->real);
+ r->real = log@c@(l);
+ return;
+}
+
+static void
+nc_log1p@c@(c@typ@ *x, c@typ@ *r)
+{
+ @typ@ l = hypot@c@(x->real + 1,x->imag);
+ r->imag = atan2@c@(x->imag, x->real + 1);
+ r->real = log@c@(l);
+ return;
+}
+
+static void
+nc_exp@c@(c@typ@ *x, c@typ@ *r)
+{
+ @typ@ a = exp@c@(x->real);
+ r->real = a*cos@c@(x->imag);
+ r->imag = a*sin@c@(x->imag);
+ return;
+}
+
+static void
+nc_expm1@c@(c@typ@ *x, c@typ@ *r)
+{
+ @typ@ a = exp@c@(x->real);
+ r->real = a*cos@c@(x->imag) - 1;
+ r->imag = a*sin@c@(x->imag);
+ return;
+}
+
+static void
+nc_pow@c@(c@typ@ *a, c@typ@ *b, c@typ@ *r)
+{
+ intp n;
+ @typ@ ar=a->real, br=b->real, ai=a->imag, bi=b->imag;
+
+ if (br == 0. && bi == 0.) {
+ r->real = 1.;
+ r->imag = 0.;
+ return;
+ }
+ if (ar == 0. && ai == 0.) {
+ r->real = 0.;
+ r->imag = 0.;
+ return;
+ }
+ if (bi == 0 && (n=(intp)br) == br) {
+ if (n > -100 && n < 100) {
+ c@typ@ p, aa;
+ intp mask = 1;
+ if (n < 0) n = -n;
+ aa = nc_1@c@;
+ p.real = ar; p.imag = ai;
+ while (1) {
+ if (n & mask)
+ nc_prod@c@(&aa,&p,&aa);
+ mask <<= 1;
+ if (n < mask || mask <= 0) break;
+ nc_prod@c@(&p,&p,&p);
+ }
+ r->real = aa.real; r->imag = aa.imag;
+ if (br < 0) nc_quot@c@(&nc_1@c@, r, r);
+ return;
+ }
+ }
+ /* complexobect.c uses an inline version of this formula
+ investigate whether this had better performance or accuracy */
+ nc_log@c@(a, r);
+ nc_prod@c@(r, b, r);
+ nc_exp@c@(r, r);
+ return;
+}
+
+
+static void
+nc_prodi@c@(c@typ@ *x, c@typ@ *r)
+{
+ @typ@ xr = x->real;
+ r->real = -x->imag;
+ r->imag = xr;
+ return;
+}
+
+
+static void
+nc_acos@c@(c@typ@ *x, c@typ@ *r)
+{
+ nc_prod@c@(x,x,r);
+ nc_diff@c@(&nc_1@c@, r, r);
+ nc_sqrt@c@(r, r);
+ nc_prodi@c@(r, r);
+ nc_sum@c@(x, r, r);
+ nc_log@c@(r, r);
+ nc_prodi@c@(r, r);
+ nc_neg@c@(r, r);
+ return;
+ /* return nc_neg(nc_prodi(nc_log(nc_sum(x,nc_prod(nc_i,
+ nc_sqrt(nc_diff(nc_1,nc_prod(x,x))))))));
+ */
+}
+
+static void
+nc_acosh@c@(c@typ@ *x, c@typ@ *r)
+{
+ nc_prod@c@(x, x, r);
+ nc_diff@c@(&nc_1@c@, r, r);
+ nc_sqrt@c@(r, r);
+ nc_prodi@c@(r, r);
+ nc_sum@c@(x, r, r);
+ nc_log@c@(r, r);
+ return;
+ /*
+ return nc_log(nc_sum(x,nc_prod(nc_i,
+ nc_sqrt(nc_diff(nc_1,nc_prod(x,x))))));
+ */
+}
+
+static void
+nc_asin@c@(c@typ@ *x, c@typ@ *r)
+{
+ c@typ@ a, *pa=&a;
+ nc_prod@c@(x, x, r);
+ nc_diff@c@(&nc_1@c@, r, r);
+ nc_sqrt@c@(r, r);
+ nc_prodi@c@(x, pa);
+ nc_sum@c@(pa, r, r);
+ nc_log@c@(r, r);
+ nc_prodi@c@(r, r);
+ nc_neg@c@(r, r);
+ return;
+ /*
+ return nc_neg(nc_prodi(nc_log(nc_sum(nc_prod(nc_i,x),
+ nc_sqrt(nc_diff(nc_1,nc_prod(x,x)))))));
+ */
+}
+
+
+static void
+nc_asinh@c@(c@typ@ *x, c@typ@ *r)
+{
+ nc_prod@c@(x, x, r);
+ nc_sum@c@(&nc_1@c@, r, r);
+ nc_sqrt@c@(r, r);
+ nc_diff@c@(r, x, r);
+ nc_log@c@(r, r);
+ nc_neg@c@(r, r);
+ return;
+ /*
+ return nc_neg(nc_log(nc_diff(nc_sqrt(nc_sum(nc_1,nc_prod(x,x))),x)));
+ */
+}
+
+static void
+nc_atan@c@(c@typ@ *x, c@typ@ *r)
+{
+ c@typ@ a, *pa=&a;
+ nc_diff@c@(&nc_i@c@, x, pa);
+ nc_sum@c@(&nc_i@c@, x, r);
+ nc_quot@c@(r, pa, r);
+ nc_log@c@(r,r);
+ nc_prod@c@(&nc_i2@c@, r, r);
+ return;
+ /*
+ return nc_prod(nc_i2,nc_log(nc_quot(nc_sum(nc_i,x),nc_diff(nc_i,x))));
+ */
+}
+
+static void
+nc_atanh@c@(c@typ@ *x, c@typ@ *r)
+{
+ c@typ@ a, *pa=&a;
+ nc_diff@c@(&nc_1@c@, x, r);
+ nc_sum@c@(&nc_1@c@, x, pa);
+ nc_quot@c@(pa, r, r);
+ nc_log@c@(r, r);
+ nc_prod@c@(&nc_half@c@, r, r);
+ return;
+ /*
+ return nc_prod(nc_half,nc_log(nc_quot(nc_sum(nc_1,x),nc_diff(nc_1,x))));
+ */
+}
+
+static void
+nc_cos@c@(c@typ@ *x, c@typ@ *r)
+{
+ @typ@ xr=x->real, xi=x->imag;
+ r->real = cos@c@(xr)*cosh@c@(xi);
+ r->imag = -sin@c@(xr)*sinh@c@(xi);
+ return;
+}
+
+static void
+nc_cosh@c@(c@typ@ *x, c@typ@ *r)
+{
+ @typ@ xr=x->real, xi=x->imag;
+ r->real = cos@c@(xi)*cosh@c@(xr);
+ r->imag = sin@c@(xi)*sinh@c@(xr);
+ return;
+}
+
+
+#define M_LOG10_E 0.434294481903251827651128918916605082294397
+
+static void
+nc_log10@c@(c@typ@ *x, c@typ@ *r)
+{
+ nc_log@c@(x, r);
+ r->real *= (@typ@) M_LOG10_E;
+ r->imag *= (@typ@) M_LOG10_E;
+ return;
+}
+
+static void
+nc_sin@c@(c@typ@ *x, c@typ@ *r)
+{
+ @typ@ xr=x->real, xi=x->imag;
+ r->real = sin@c@(xr)*cosh@c@(xi);
+ r->imag = cos@c@(xr)*sinh@c@(xi);
+ return;
+}
+
+static void
+nc_sinh@c@(c@typ@ *x, c@typ@ *r)
+{
+ @typ@ xr=x->real, xi=x->imag;
+ r->real = cos@c@(xi)*sinh@c@(xr);
+ r->imag = sin@c@(xi)*cosh@c@(xr);
+ return;
+}
+
+static void
+nc_tan@c@(c@typ@ *x, c@typ@ *r)
+{
+ @typ@ sr,cr,shi,chi;
+ @typ@ rs,is,rc,ic;
+ @typ@ d;
+ @typ@ xr=x->real, xi=x->imag;
+ sr = sin@c@(xr);
+ cr = cos@c@(xr);
+ shi = sinh@c@(xi);
+ chi = cosh@c@(xi);
+ rs = sr*chi;
+ is = cr*shi;
+ rc = cr*chi;
+ ic = -sr*shi;
+ d = rc*rc + ic*ic;
+ r->real = (rs*rc+is*ic)/d;
+ r->imag = (is*rc-rs*ic)/d;
+ return;
+}
+
+static void
+nc_tanh@c@(c@typ@ *x, c@typ@ *r)
+{
+ @typ@ si,ci,shr,chr;
+ @typ@ rs,is,rc,ic;
+ @typ@ d;
+ @typ@ xr=x->real, xi=x->imag;
+ si = sin@c@(xi);
+ ci = cos@c@(xi);
+ shr = sinh@c@(xr);
+ chr = cosh@c@(xr);
+ rs = ci*shr;
+ is = si*chr;
+ rc = ci*chr;
+ ic = si*shr;
+ d = rc*rc + ic*ic;
+ r->real = (rs*rc+is*ic)/d;
+ r->imag = (is*rc-rs*ic)/d;
+ return;
+}
+
+/**end repeat**/
+
+
+/**begin repeat
+
+#TYPE=(BOOL, BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE)*2#
+#OP=||, +*13, ^, -*13#
+#kind=add*14, subtract*14#
+#typ=(Bool, byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble)*2#
+*/
+
+static void
+@TYPE@_@kind@(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],is2=steps[1],os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ *((@typ@ *)op)=*((@typ@ *)i1) @OP@ *((@typ@ *)i2);
+ }
+}
+
+/**end repeat**/
+
+/**begin repeat
+
+#TYPE=(CFLOAT, CDOUBLE, CLONGDOUBLE)*2#
+#OP=+*3,-*3#
+#kind=add*3,subtract*3#
+#typ=(float, double, longdouble)*2#
+*/
+
+static void
+@TYPE@_@kind@(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],is2=steps[1],os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ ((@typ@ *)op)[0]=((@typ@ *)i1)[0] @OP@ ((@typ@ *)i2)[0];
+ ((@typ@ *)op)[1]=((@typ@ *)i1)[1] @OP@ ((@typ@ *)i2)[1];
+ }
+}
+
+/**end repeat**/
+
+
+static void
+BOOL_multiply(char **args, intp *dimensions, intp *steps, void *func) {
+ register intp i;
+ intp is1=steps[0], is2=steps[1], os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ for (i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ *((Bool *)op) = *((Bool *)i1) && *((Bool *)i2);
+ }
+}
+
+/**begin repeat
+
+#TYP= BYTE, SHORT, INT, LONG, LONGLONG, UBYTE, USHORT, UINT, ULONG, ULONGLONG, FLOAT, DOUBLE, LONGDOUBLE#
+#typ= byte, short, int, long, longlong, ubyte, ushort, uint, ulong, ulonglong, float, double, longdouble#
+*/
+static void
+@TYP@_multiply(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0], is2=steps[1], os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ for (i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ *((@typ@ *)op) = (*((@typ@ *)i1)) * (*((@typ@ *)i2));
+ }
+}
+/**end repeat**/
+
+
+/**begin repeat
+#TYP= CFLOAT, CDOUBLE, CLONGDOUBLE#
+#typ= float, double, longdouble#
+#c=f,,l#
+*/
+static void
+@TYP@_multiply(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0], is2=steps[1], os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ for (i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ register @typ@ ar=((c@typ@ *)i1)->real, \
+ ai=((c@typ@ *)i1)->imag, \
+ br=((c@typ@ *)i2)->real, \
+ bi=((c@typ@ *)i2)->imag;
+ ((c@typ@ *)op)->real = ar*br - ai*bi;
+ ((c@typ@ *)op)->imag = ar*bi + ai*br;
+ }
+}
+
+static void
+@TYP@_divide(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0], is2=steps[1], os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ for (i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ register @typ@ ar=((c@typ@ *)i1)->real, \
+ ai=((c@typ@ *)i1)->imag, \
+ br=((c@typ@ *)i2)->real, \
+ bi=((c@typ@ *)i2)->imag;
+ register @typ@ d = br*br + bi*bi;
+ ((c@typ@ *)op)->real = (ar*br + ai*bi)/d;
+ ((c@typ@ *)op)->imag = (ai*br - ar*bi)/d;
+ }
+}
+
+static void
+@TYP@_floor_divide(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],is2=steps[1],os=steps[2],n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ register @typ@ ar=((c@typ@ *)i1)->real, \
+ ai=((c@typ@ *)i1)->imag, \
+ br=((c@typ@ *)i2)->real, \
+ bi=((c@typ@ *)i2)->imag;
+ register @typ@ d = br*br + bi*bi;
+ ((c@typ@ *)op)->real = floor@c@((ar*br + ai*bi)/d);
+ ((c@typ@ *)op)->imag = 0;
+ }
+}
+
+#define @TYP@_true_divide @TYP@_divide
+/**end repeat**/
+
+
+/**begin repeat
+#TYP=UBYTE,USHORT,UINT,ULONG,ULONGLONG#
+#typ=ubyte, ushort, uint, ulong, ulonglong#
+*/
+static void
+@TYP@_divide(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i, is1=steps[0],is2=steps[1],os=steps[2],n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ if (*((@typ@ *)i2)==0) {
+ generate_divbyzero_error();
+ *((@typ@ *)op)=0;
+ }
+ else {
+ *((@typ@ *)op)= *((@typ@ *)i1) / *((@typ@ *)i2);
+ }
+ }
+}
+/**end repeat**/
+
+
+/**begin repeat
+#TYP=BYTE,SHORT,INT,LONG,LONGLONG#
+#typ=char, short, int, long, longlong#
+*/
+static void
+@TYP@_divide(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i, is1=steps[0],is2=steps[1],os=steps[2],n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ @typ@ x, y, tmp;
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ y = *((@typ@ *)i2);
+ if (y == 0) {
+ generate_divbyzero_error();
+ *((@typ@ *)op)=0;
+ }
+ else {
+ x = *((@typ@ *)i1);
+ tmp = x / y;
+ if (((x > 0) != (y > 0)) && (x % y != 0)) tmp--;
+ *((@typ@ *)op)= tmp;
+ }
+ }
+}
+/**end repeat**/
+
+
+/**begin repeat
+#TYP=BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG#
+#typ=char, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong#
+#otyp=float*4, double*6#
+*/
+static void
+@TYP@_true_divide(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i, is1=steps[0],is2=steps[1],os=steps[2],n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ if (*((@typ@ *)i2)==0) {
+ generate_divbyzero_error();
+ *((@otyp@ *)op)=0;
+ }
+ else {
+ *((@otyp@ *)op)= \
+ *((@typ@ *)i1) / (double)*((@typ@ *)i2);
+ }
+ }
+}
+#define @TYP@_floor_divide @TYP@_divide
+/**end repeat**/
+
+
+
+/**begin repeat
+#TYP=FLOAT,DOUBLE,LONGDOUBLE#
+#typ=float,double,longdouble#
+*/
+static void
+@TYP@_divide(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i, is1=steps[0],is2=steps[1],os=steps[2],n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ *((@typ@ *)op)=*((@typ@ *)i1) / *((@typ@ *)i2);
+ }
+}
+#define @TYP@_true_divide @TYP@_divide
+/**end repeat**/
+
+/**begin repeat
+
+#TYP=FLOAT,DOUBLE,LONGDOUBLE#
+#typ=float,double,longdouble#
+#c=f,,l#
+*/
+static void
+@TYP@_floor_divide(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i, is1=steps[0],is2=steps[1],os=steps[2],n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ *((@typ@ *)op)=floor@c@(*((@typ@ *)i1) / *((@typ@ *)i2));
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+#TYP=BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE#
+#typ=char, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble#
+*/
+static void
+@TYP@_square(char **args, intp *dimensions, intp *steps, void *data)
+{
+ intp i, is1 = steps[0], os = steps[1], n = dimensions[0];
+ char *i1 = args[0], *op = args[1];
+
+ for (i = 0; i < n; i++, i1 += is1, op += os) {
+ @typ@ x = *((@typ@ *)i1);
+ *((@typ@ *)op) = x*x;
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+#TYP=CFLOAT,CDOUBLE,CLONGDOUBLE#
+#typ=float, double, longdouble#
+*/
+static void
+@TYP@_square(char **args, intp *dimensions, intp *steps, void *data)
+{
+ intp i, is1 = steps[0], os = steps[1], n = dimensions[0];
+ char *i1 = args[0], *op = args[1];
+ c@typ@ *x, *y;
+ @typ@ xr, xi;
+
+ for (i = 0; i < n; i++, i1 += is1, op += os) {
+ x = (c@typ@ *)i1;
+ y = (c@typ@ *)op;
+ xr = x->real;
+ xi = x->imag;
+ y->real = xr*xr - xi*xi;
+ y->imag = 2*xr*xi;
+ }
+}
+/**end repeat**/
+
+static PyObject *
+Py_square(PyObject *o)
+{
+ return PyNumber_Multiply(o, o);
+}
+
+
+/**begin repeat
+#TYP=BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE#
+#typ=char, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble#
+*/
+static void
+@TYP@_reciprocal(char **args, intp *dimensions, intp *steps, void *data)
+{
+ intp i, is1 = steps[0], os = steps[1], n = dimensions[0];
+ char *i1 = args[0], *op = args[1];
+
+ for (i = 0; i < n; i++, i1 += is1, op += os) {
+ @typ@ x = *((@typ@ *)i1);
+ *((@typ@ *)op) = (@typ@) (1.0 / x);
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+#TYP=CFLOAT,CDOUBLE,CLONGDOUBLE#
+#typ=float, double, longdouble#
+*/
+static void
+@TYP@_reciprocal(char **args, intp *dimensions, intp *steps, void *data)
+{
+ intp i, is1 = steps[0], os = steps[1], n = dimensions[0];
+ char *i1 = args[0], *op = args[1];
+ c@typ@ *x, *y;
+ @typ@ xr, xi, r, denom;
+
+ for (i = 0; i < n; i++, i1 += is1, op += os) {
+ x = (c@typ@ *)i1;
+ y = (c@typ@ *)op;
+ xr = x->real;
+ xi = x->imag;
+ if (fabs(xi) <= fabs(xr)) {
+ r = xi / xr;
+ denom = xr + xi * r;
+ y->real = 1 / denom;
+ y->imag = -r / denom;
+ } else {
+ r = xr / xi;
+ denom = xr * r + xi;
+ y->real = r / denom;
+ y->imag = -1 / denom;
+ }
+ }
+}
+/**end repeat**/
+
+
+static PyObject *
+Py_reciprocal(PyObject *o)
+{
+ PyObject *one, *result;
+ one = PyInt_FromLong(1);
+ if (!one) return NULL;
+ result = PyNumber_Divide(one, o);
+ Py_DECREF(one);
+ return result;
+}
+
+static PyObject *
+_npy_ObjectMax(PyObject *i1, PyObject *i2)
+{
+ int cmp;
+ PyObject *res;
+ if (PyObject_Cmp(i1, i2, &cmp) < 0) return NULL;
+
+ if (cmp >= 0) {
+ res = i1;
+ }
+ else {
+ res = i2;
+ }
+ Py_INCREF(res);
+ return res;
+}
+
+static PyObject *
+_npy_ObjectMin(PyObject *i1, PyObject *i2)
+{
+ int cmp;
+ PyObject *res;
+ if (PyObject_Cmp(i1, i2, &cmp) < 0) return NULL;
+
+ if (cmp <= 0) {
+ res = i1;
+ }
+ else {
+ res = i2;
+ }
+ Py_INCREF(res);
+ return res;
+}
+
+/* ones_like is defined here because it's used for x**0 */
+
+/**begin repeat
+#TYP=BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE#
+#typ=char, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble#
+*/
+static void
+@TYP@_ones_like(char **args, intp *dimensions, intp *steps, void *data)
+{
+ intp i, os = steps[1], n = dimensions[0];
+ char *op = args[1];
+
+ for (i = 0; i < n; i++, op += os) {
+ *((@typ@ *)op) = 1;
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+#TYP=CFLOAT,CDOUBLE,CLONGDOUBLE#
+#typ=float, double, longdouble#
+*/
+static void
+@TYP@_ones_like(char **args, intp *dimensions, intp *steps, void *data)
+{
+ intp i, is1 = steps[0], os = steps[1], n = dimensions[0];
+ char *i1 = args[0], *op = args[1];
+ c@typ@ *y;
+
+ for (i = 0; i < n; i++, i1 += is1, op += os) {
+ y = (c@typ@ *)op;
+ y->real = 1.0;
+ y->imag = 0.0;
+ }
+}
+/**end repeat**/
+
+static PyObject *
+Py_get_one(PyObject *o)
+{
+ return PyInt_FromLong(1);
+}
+
+
+/**begin repeat
+#TYP=BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG#
+#typ=char, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong#
+#btyp=float*4, double*6#
+*/
+static void
+@TYP@_power(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i, is1=steps[0],is2=steps[1];
+ register intp os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ @btyp@ x, y;
+
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ x = *((@typ@ *)i1);
+ y = *((@typ@ *)i2);
+ *((@typ@ *)op) = (@typ@) pow(x,y);
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+#TYP=UBYTE, BYTE, SHORT, USHORT, INT, UINT, LONG, ULONG, LONGLONG, ULONGLONG, FLOAT, DOUBLE, LONGDOUBLE#
+#typ=ubyte, char, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble#
+*/
+static void
+@TYP@_conjugate(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i, is1=steps[0], os=steps[1], n=dimensions[0];
+ char *i1=args[0], *op=args[1];
+ for(i=0; i<n; i++, i1+=is1, op+=os) {
+ *((@typ@ *)op)=*((@typ@ *)i1);
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+
+#TYP=CFLOAT, CDOUBLE, CLONGDOUBLE#
+#typ=float, double, longdouble#
+*/
+static void
+@TYP@_conjugate(char **args, intp *dimensions, intp *steps, void *func) {
+ register intp i, is1=steps[0], os=steps[1], n=dimensions[0];
+ char *i1=args[0], *op=args[1];
+
+ for(i=0; i<n; i++, i1+=is1, op+=os) {
+ ((@typ@ *)op)[0]=((@typ@ *)i1)[0];
+ ((@typ@ *)op)[1]=-(((@typ@ *)i1)[1]);
+ }
+}
+/**end repeat**/
+
+
+/**begin repeat
+
+#TYPE=BOOL,UBYTE,USHORT,UINT,ULONG,ULONGLONG#
+#typ=Bool, ubyte, ushort, uint, ulong, ulonglong#
+*/
+static void
+@TYPE@_absolute(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i, n;
+ intp is1=steps[0], os=steps[1];
+ char *i1=args[0], *op=args[1];
+
+ n=dimensions[0];
+
+ for(i=0; i<n; i++, i1+=is1, op+=os) {
+ *((@typ@ *)op) = *((@typ@*)i1);
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+
+#TYPE=BYTE,SHORT,INT,LONG,LONGLONG,FLOAT,DOUBLE,LONGDOUBLE#
+#typ=byte, short, int, long, longlong, float, double, longdouble#
+*/
+static void
+@TYPE@_absolute(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i, n;
+ intp is1=steps[0], os=steps[1];
+ char *i1=args[0], *op=args[1];
+
+ n=dimensions[0];
+ for(i=0; i<n; i++, i1+=is1, op+=os) {
+ *((@typ@ *)op) = *((@typ@ *)i1) < 0 ? -*((@typ@ *)i1) : *((@typ@ *)i1);
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+ #TYPE=CFLOAT,CDOUBLE,CLONGDOUBLE#
+ #typ= float, double, longdouble#
+ #c= f,,l#
+*/
+static void
+@TYPE@_absolute(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i, n;
+ register intp is1=steps[0], os=steps[1];
+ char *i1=args[0], *op=args[1];
+ n=dimensions[0];
+ for(i=0; i<n; i++, i1+=is1, op+=os) {
+ *((@typ@ *)op) = (@typ@)sqrt@c@(((@typ@ *)i1)[0]*((@typ@ *)i1)[0] + ((@typ@ *)i1)[1]*((@typ@ *)i1)[1]);
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+
+#kind=greater, greater_equal, less, less_equal, equal, not_equal, logical_and, logical_or, bitwise_and, bitwise_or, bitwise_xor#
+#OP=>, >=, <, <=, ==, !=, &&, ||, &, |, ^#
+**/
+static void
+BOOL_@kind@(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],is2=steps[1],os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ Bool in1, in2;
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ in1 = (*((Bool *)i1) != 0);
+ in2 = (*((Bool *)i2) != 0);
+ *((Bool *)op)= in1 @OP@ in2;
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+
+#TYPE=(BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE)*4#
+#OP= >*13, >=*13, <*13, <=*13#
+#typ=(byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble)*4#
+#kind= greater*13, greater_equal*13, less*13, less_equal*13#
+*/
+
+static void
+@TYPE@_@kind@(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],is2=steps[1],os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ *((Bool *)op)=*((@typ@ *)i1) @OP@ *((@typ@ *)i2);
+ }
+}
+/**end repeat**/
+
+
+/**begin repeat
+#TYPE=(CFLOAT,CDOUBLE,CLONGDOUBLE)*4#
+#OP= >*3, >=*3, <*3, <=*3#
+#typ=(cfloat, cdouble, clongdouble)*4#
+#kind= greater*3, greater_equal*3, less*3, less_equal*3#
+*/
+
+static void
+@TYPE@_@kind@(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],is2=steps[1],os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ if (((@typ@ *)i1)->real == ((@typ@ *)i2)->real)
+ *((Bool *)op)=((@typ@ *)i1)->imag @OP@ \
+ ((@typ@ *)i2)->imag;
+ else
+ *((Bool *)op)=((@typ@ *)i1)->real @OP@ \
+ ((@typ@ *)i2)->real;
+ }
+}
+/**end repeat**/
+
+
+/**begin repeat
+#TYPE=(BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE)*4#
+#typ=(byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble)*4#
+#OP= ==*13, !=*13, &&*13, ||*13#
+#kind=equal*13, not_equal*13, logical_and*13, logical_or*13#
+*/
+static void
+@TYPE@_@kind@(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],is2=steps[1],os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ *((Bool *)op) = *((@typ@ *)i1) @OP@ *((@typ@ *)i2);
+ }
+}
+/**end repeat**/
+
+
+/**begin repeat
+
+#TYPE=(CFLOAT, CDOUBLE, CLONGDOUBLE)*4#
+#typ=(float, double, longdouble)*4#
+#OP= ==*3, !=*3, &&*3, ||*3#
+#OP2= &&*3, ||*3, &&*3, ||*3#
+#kind=equal*3, not_equal*3, logical_and*3, logical_or*3#
+*/
+static void
+@TYPE@_@kind@(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],is2=steps[1],os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ *((Bool *)op) = (*((@typ@ *)i1) @OP@ *((@typ@ *)i2)) @OP2@ (*((@typ@ *)i1+1) @OP@ *((@typ@ *)i2+1));
+ }
+}
+/**end repeat**/
+
+
+/** OBJECT comparison for OBJECT arrays **/
+
+/**begin repeat
+
+#kind=greater, greater_equal, less, less_equal, equal, not_equal#
+#op=GT, GE, LT, LE, EQ, NE#
+*/
+static void
+OBJECT_@kind@(char **args, intp *dimensions, intp *steps, void *func) {
+ register intp i, is1=steps[0],is2=steps[1],os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ *((Bool *)op)=PyObject_RichCompareBool(*((PyObject **)i1),
+ *((PyObject **)i2),
+ Py_@op@);
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+
+#TYPE=BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE#
+#typ=byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble#
+*/
+ static void
+@TYPE@_negative(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],os=steps[1], n=dimensions[0];
+ char *i1=args[0], *op=args[1];
+ for(i=0; i<n; i++, i1+=is1, op+=os) {
+ *((@typ@ *)op) = - *((@typ@ *)i1);
+ }
+}
+/**end repeat**/
+
+#define BOOL_negative BOOL_logical_not
+
+#define _SIGN1(x) ((x) > 0 ? 1 : ((x) < 0 ? -1 : 0))
+#define _SIGN2(x) ((x) == 0 ? 0 : 1)
+#define _SIGNC(x) (((x).real > 0) ? 1 : ((x).real < 0 ? -1 : ((x).imag > 0 ? 1 : ((x).imag < 0) ? -1 : 0)))
+/**begin repeat
+#TYPE=BYTE,SHORT,INT,LONG,LONGLONG,FLOAT,DOUBLE,LONGDOUBLE,UBYTE,USHORT,UINT,ULONG,ULONGLONG#
+#typ=byte,short,int,long,longlong,float,double,longdouble,ubyte,ushort,uint,ulong,ulonglong#
+#func=_SIGN1*8,_SIGN2*5#
+ */
+static void
+@TYPE@_sign(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],os=steps[1], n=dimensions[0];
+ char *i1=args[0], *op=args[1];
+ @typ@ t1;
+ for(i=0; i<n; i++, i1+=is1, op+=os) {
+ t1 = *((@typ@ *)i1);
+ *((@typ@ *)op) = (@typ@) @func@(t1);
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+#TYPE=CFLOAT,CDOUBLE,CLONGDOUBLE#
+#typ=cfloat,cdouble,clongdouble#
+ */
+static void
+@TYPE@_sign(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],os=steps[1], n=dimensions[0];
+ char *i1=args[0], *op=args[1];
+ @typ@ t1;
+ for(i=0; i<n; i++, i1+=is1, op+=os) {
+ t1 = *((@typ@ *)i1);
+ (*((@typ@ *)op)).real = _SIGNC(t1);
+ (*((@typ@ *)op)).imag = 0;
+ }
+}
+/**end repeat**/
+
+#undef _SIGN1
+#undef _SIGN2
+#undef _SIGNC
+
+
+static void
+OBJECT_sign(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],os=steps[1], n=dimensions[0];
+ char *i1=args[0], *op=args[1];
+ PyObject *t1, *zero, *res;
+ zero = PyInt_FromLong(0);
+ for(i=0; i<n; i++, i1+=is1, op+=os) {
+ t1 = *((PyObject **)i1);
+ res = PyInt_FromLong((long) PyObject_Compare(t1, zero));
+ *((PyObject **)op) = res;
+ }
+ Py_DECREF(zero);
+}
+
+
+/**begin repeat
+#TYPE=BOOL,BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE#
+#typ=Bool, byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble#
+*/
+static void
+@TYPE@_logical_not(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],os=steps[1], n=dimensions[0];
+ char *i1=args[0], *op=args[1];
+ for(i=0; i<n; i++, i1+=is1, op+=os) {
+ *((Bool *)op) = ! *((@typ@ *)i1);
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+#TYPE=CFLOAT,CDOUBLE,CLONGDOUBLE#
+#typ=cfloat, cdouble, clongdouble#
+*/
+static void
+@TYPE@_logical_not(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],os=steps[1], n=dimensions[0];
+ char *i1=args[0], *op=args[1];
+ for(i=0; i<n; i++, i1+=is1, op+=os) {
+ *((Bool *)op) = ! (((@typ@ *)i1)->real || \
+ ((@typ@ *)i1)->imag);
+ }
+}
+/**end repeat**/
+
+
+
+
+/**begin repeat
+#TYPE=BYTE,SHORT,INT,LONG,LONGLONG#
+#typ=byte, short, int, long, longlong#
+#c=f*2,,,l*1#
+*/
+static void
+@TYPE@_remainder(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],is2=steps[1],os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ register @typ@ ix,iy, tmp;
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ ix = *((@typ@ *)i1);
+ iy = *((@typ@ *)i2);
+ if (iy == 0 || ix == 0) {
+ if (iy == 0) generate_divbyzero_error();
+ *((@typ@ *)op) = 0;
+ }
+ else if ((ix > 0) == (iy > 0)) {
+ *((@typ@ *)op) = ix % iy;
+ }
+ else { /* handle mixed case the way Python does */
+ tmp = ix % iy;
+ if (tmp) tmp += iy;
+ *((@typ@ *)op)= tmp;
+ }
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+#TYPE=UBYTE,USHORT,UINT,ULONG,ULONGLONG#
+#typ=ubyte, ushort, uint, ulong, ulonglong#
+*/
+static void
+@TYPE@_remainder(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],is2=steps[1],os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ register @typ@ ix,iy;
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ ix = *((@typ@ *)i1);
+ iy = *((@typ@ *)i2);
+ if (iy == 0) {
+ generate_divbyzero_error();
+ *((@typ@ *)op) = 0;
+ }
+ *((@typ@ *)op) = ix % iy;
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+#TYPE=FLOAT,DOUBLE,LONGDOUBLE#
+#typ=float,double,longdouble#
+#c=f,,l#
+*/
+static void
+@TYPE@_remainder(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],is2=steps[1],os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ @typ@ x, y, res;
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ x = *((@typ@ *)i1);
+ y = *((@typ@ *)i2);
+ res = fmod@c@(x, y);
+ if (res && ((y < 0) != (res < 0))) {
+ res += y;
+ }
+ *((@typ@ *)op)= res;
+ }
+}
+/**end repeat**/
+
+
+/**begin repeat
+
+#TYPE=BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG#
+#typ=byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong#
+*/
+static void
+@TYPE@_fmod(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],is2=steps[1],os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ @typ@ x, y;
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ x = *((@typ@ *)i1);
+ y = *((@typ@ *)i2);
+ if (y == 0) {
+ generate_divbyzero_error();
+ *((@typ@ *)op) = 0;
+ }
+ else {
+ *((@typ@ *)op)= x % y;
+ }
+
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+
+#TYPE=(BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG)*5#
+#typ=(byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong)*5#
+#OP= &*10, |*10, ^*10, <<*10, >>*10#
+#kind=bitwise_and*10, bitwise_or*10, bitwise_xor*10, left_shift*10, right_shift*10#
+
+*/
+static void
+@TYPE@_@kind@(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],is2=steps[1],os=steps[2], n=dimensions[0];
+ register char *i1=args[0], *i2=args[1], *op=args[2];
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ *((@typ@ *)op)=*((@typ@ *)i1) @OP@ *((@typ@ *)i2);
+ }
+}
+/**end repeat**/
+
+
+/**begin repeat
+ #TYPE=BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG#
+ #typ=byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong#
+*/
+static void
+@TYPE@_invert(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0], os=steps[1], n=dimensions[0];
+ char *i1=args[0], *op=args[1];
+ for(i=0; i<n; i++, i1+=is1, op+=os) {
+ *((@typ@ *)op) = ~ *((@typ@*)i1);
+ }
+}
+/**end repeat**/
+
+static void
+BOOL_invert(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0], os=steps[1], n=dimensions[0];
+ char *i1=args[0], *op=args[1];
+ for(i=0; i<n; i++, i1+=is1, op+=os) {
+ *((Bool *)op) = (*((Bool *)i1) ? FALSE : TRUE);
+ }
+}
+
+
+/**begin repeat
+#TYPE=BOOL,BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE#
+#typ=Bool, byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble#
+
+*/
+static void
+@TYPE@_logical_xor(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],is2=steps[1],os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ *((Bool *)op)=(*((@typ@ *)i1) || *((@typ@ *)i2)) && !(*((@typ@ *)i1) && *((@typ@ *)i2));
+ }
+}
+/**end repeat**/
+
+
+/**begin repeat
+#TYPE=CFLOAT,CDOUBLE,CLONGDOUBLE#
+#typ=cfloat, cdouble, clongdouble#
+*/
+static void
+@TYPE@_logical_xor(char **args, intp *dimensions, intp *steps, void *func)
+{
+ Bool p1, p2;
+ register intp i;
+ intp is1=steps[0],is2=steps[1],os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ p1 = ((@typ@ *)i1)->real || ((@typ@ *)i1)->imag;
+ p2 = ((@typ@ *)i2)->real || ((@typ@ *)i2)->imag;
+ *((Bool *)op)= (p1 || p2) && !(p1 && p2);
+ }
+}
+/**end repeat**/
+
+
+
+/**begin repeat
+
+#TYPE=(BOOL,BYTE,UBYTE,SHORT,USHORT,INT,UINT,LONG,ULONG,LONGLONG,ULONGLONG,FLOAT,DOUBLE,LONGDOUBLE)*2#
+#OP= >*14, <*14#
+#typ=(Bool, byte, ubyte, short, ushort, int, uint, long, ulong, longlong, ulonglong, float, double, longdouble)*2#
+#kind= maximum*14, minimum*14#
+*/
+static void
+@TYPE@_@kind@(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],is2=steps[1],os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ *((@typ@ *)op)=*((@typ@ *)i1) @OP@ *((@typ@ *)i2) ? *((@typ@ *)i1) : *((@typ@ *)i2);
+ }
+}
+/**end repeat**/
+
+/**begin repeat
+
+#TYPE=(CFLOAT,CDOUBLE,CLONGDOUBLE)*2#
+#OP= >*3, <*3#
+#typ=(cfloat, cdouble, clongdouble)*2#
+#kind= maximum*3, minimum*3#
+*/
+static void
+@TYPE@_@kind@(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],is2=steps[1],os=steps[2], n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ @typ@ *i1c, *i2c;
+ for(i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ i1c = (@typ@ *)i1;
+ i2c = (@typ@ *)i2;
+ if ((i1c->real @OP@ i2c->real) || \
+ ((i1c->real==i2c->real) && (i1c->imag @OP@ i2c->imag)))
+ memmove(op, i1, sizeof(@typ@));
+ else
+ memmove(op, i2, sizeof(@typ@));
+ }
+}
+/**end repeat**/
+
+
+
+/*** isinf, isinf, isfinite, signbit ***/
+/**begin repeat
+#kind=isnan*3, isinf*3, isfinite*3, signbit*3#
+#TYPE=(FLOAT, DOUBLE, LONGDOUBLE)*4#
+#typ=(float, double, longdouble)*4#
+#c=(f,,l)*4#
+*/
+static void
+@TYPE@_@kind@(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is=steps[0], os=steps[1], n=dimensions[0];
+ char *ip=args[0], *op=args[1];
+ for(i=0; i<n; i++, ip+=is, op+=os) {
+ *((Bool *)op) = (Bool) (@kind@@c@(*((@typ@ *)ip)) != 0);
+ }
+}
+/**end repeat**/
+
+
+/**begin repeat
+#kind=isnan*3, isinf*3, isfinite*3#
+#TYPE=(CFLOAT, CDOUBLE, CLONGDOUBLE)*3#
+#typ=(float, double, longdouble)*3#
+#c=(f,,l)*3#
+#OP=||*6,&&*3#
+*/
+static void
+@TYPE@_@kind@(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is=steps[0], os=steps[1], n=dimensions[0];
+ char *ip=args[0], *op=args[1];
+ for(i=0; i<n; i++, ip+=is, op+=os) {
+ *((Bool *)op) = @kind@@c@(((@typ@ *)ip)[0]) @OP@ \
+ @kind@@c@(((@typ@ *)ip)[1]);
+ }
+}
+/**end repeat**/
+
+
+
+
+/****** modf ****/
+
+/**begin repeat
+#TYPE=FLOAT, DOUBLE, LONGDOUBLE#
+#typ=float, double, longdouble#
+#c=f,,l#
+*/
+static void
+@TYPE@_modf(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],os1=steps[1],os2=steps[2],n=dimensions[0];
+ char *i1=args[0], *op1=args[1], *op2=args[2];
+ @typ@ x1, y1, y2;
+ for (i=0; i<n; i++, i1+=is1, op1+=os1, op2+=os2) {
+ x1 = *((@typ@ *)i1);
+ y1 = modf@c@(x1, &y2);
+ *((@typ@ *)op1) = y1;
+ *((@typ@ *)op2) = y2;
+ }
+}
+/**end repeat**/
+
+#define HAVE_DOUBLE_FUNCS
+/**begin repeat
+#TYPE=FLOAT, DOUBLE, LONGDOUBLE#
+#typ=float, double, longdouble#
+#c=f,,l#
+*/
+#ifdef HAVE_@TYPE@_FUNCS
+static void
+@TYPE@_frexp(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],os1=steps[1],os2=steps[2],n=dimensions[0];
+ char *i1=args[0], *op1=args[1], *op2=args[2];
+ @typ@ x1, y1;
+ int y2;
+ for (i=0; i<n; i++, i1+=is1, op1+=os1, op2+=os2) {
+ x1 = *((@typ@ *)i1);
+ y1 = frexp@c@(x1, &y2);
+ *((@typ@ *)op1) = y1;
+ *((int *) op2) = y2;
+ }
+}
+
+static void
+@TYPE@_ldexp(char **args, intp *dimensions, intp *steps, void *func)
+{
+ register intp i;
+ intp is1=steps[0],is2=steps[1],os=steps[2],n=dimensions[0];
+ char *i1=args[0], *i2=args[1], *op=args[2];
+ @typ@ x1, y1;
+ int x2;
+ for (i=0; i<n; i++, i1+=is1, i2+=is2, op+=os) {
+ x1 = *((@typ@ *)i1);
+ x2 = *((int *)i2);
+ y1 = ldexp@c@(x1, x2);
+ *((@typ@ *)op) = y1;
+ }
+}
+#endif
+/**end repeat**/
+#undef HAVE_DOUBLE_FUNCS
+
+
+static PyUFuncGenericFunction frexp_functions[] = {
+#ifdef HAVE_FLOAT_FUNCS
+ FLOAT_frexp,
+#endif
+ DOUBLE_frexp
+#ifdef HAVE_LONGDOUBLE_FUNCS
+ ,LONGDOUBLE_frexp
+#endif
+};
+
+static void * blank3_data[] = { (void *)NULL, (void *)NULL, (void *)NULL};
+static char frexp_signatures[] = {
+#ifdef HAVE_FLOAT_FUNCS
+ PyArray_FLOAT, PyArray_FLOAT, PyArray_INT,
+#endif
+ PyArray_DOUBLE, PyArray_DOUBLE, PyArray_INT
+#ifdef HAVE_LONGDOUBLE_FUNCS
+ ,PyArray_LONGDOUBLE, PyArray_LONGDOUBLE, PyArray_INT
+#endif
+};
+
+
+static PyUFuncGenericFunction ldexp_functions[] = {
+#ifdef HAVE_FLOAT_FUNCS
+ FLOAT_ldexp,
+#endif
+ DOUBLE_ldexp
+#ifdef HAVE_LONGDOUBLE_FUNCS
+ ,LONGDOUBLE_ldexp
+#endif
+};
+
+static char ldexp_signatures[] = {
+#ifdef HAVE_FLOAT_FUNCS
+ PyArray_FLOAT, PyArray_INT, PyArray_FLOAT,
+#endif
+ PyArray_DOUBLE, PyArray_INT, PyArray_DOUBLE
+#ifdef HAVE_LONGDOUBLE_FUNCS
+ ,PyArray_LONGDOUBLE, PyArray_INT, PyArray_LONGDOUBLE
+#endif
+};
+
+
+
+#include "__umath_generated.c"
+
+
+#include "ufuncobject.c"
+
+#include "__ufunc_api.c"
+
+static double
+pinf_init(void)
+{
+ double mul = 1e10;
+ double tmp = 0.0;
+ double pinf;
+
+ pinf = mul;
+ for (;;) {
+ pinf *= mul;
+ if (pinf == tmp) break;
+ tmp = pinf;
+ }
+ return pinf;
+}
+
+static double
+pzero_init(void)
+{
+ double div = 1e10;
+ double tmp = 0.0;
+ double pinf;
+
+ pinf = div;
+ for (;;) {
+ pinf /= div;
+ if (pinf == tmp) break;
+ tmp = pinf;
+ }
+ return pinf;
+}
+
+/* Less automated additions to the ufuncs */
+
+static void
+InitOtherOperators(PyObject *dictionary) {
+ PyObject *f;
+ int num=1;
+
+#ifdef HAVE_LONGDOUBLE_FUNCS
+ num += 1;
+#endif
+#ifdef HAVE_FLOAT_FUNCS
+ num += 1;
+#endif
+ f = PyUFunc_FromFuncAndData(frexp_functions, blank3_data,
+ frexp_signatures, num,
+ 1, 2, PyUFunc_None, "frexp",
+ "Split the number, x, into a normalized"\
+ " fraction (y1) and exponent (y2)",0);
+ PyDict_SetItemString(dictionary, "frexp", f);
+ Py_DECREF(f);
+
+ f = PyUFunc_FromFuncAndData(ldexp_functions, blank3_data, ldexp_signatures, num,
+ 2, 1, PyUFunc_None, "ldexp",
+ "Compute y = x1 * 2**x2.",0);
+ PyDict_SetItemString(dictionary, "ldexp", f);
+ Py_DECREF(f);
+ return;
+}
+
+static struct PyMethodDef methods[] = {
+ {"frompyfunc", (PyCFunction) ufunc_frompyfunc,
+ METH_VARARGS | METH_KEYWORDS, doc_frompyfunc},
+ {"seterrobj", (PyCFunction) ufunc_seterr,
+ METH_VARARGS, NULL},
+ {"geterrobj", (PyCFunction) ufunc_geterr,
+ METH_VARARGS, NULL},
+ {NULL, NULL, 0} /* sentinel */
+};
+
+PyMODINIT_FUNC initumath(void) {
+ PyObject *m, *d, *s, *s2, *c_api;
+ double pinf, pzero, mynan;
+ int UFUNC_FLOATING_POINT_SUPPORT = 1;
+
+#ifdef NO_UFUNC_FLOATING_POINT_SUPPORT
+ UFUNC_FLOATING_POINT_SUPPORT = 0;
+#endif
+ /* Create the module and add the functions */
+ m = Py_InitModule("umath", methods);
+
+ /* Import the array */
+ if (_import_array() < 0) {
+ if (!PyErr_Occurred()) {
+ PyErr_SetString(PyExc_ImportError,
+ "umath failed: Could not import array core.");
+ }
+ return;
+ }
+
+ /* Initialize the types */
+ if (PyType_Ready(&PyUFunc_Type) < 0)
+ return;
+
+ /* Add some symbolic constants to the module */
+ d = PyModule_GetDict(m);
+
+ c_api = PyCObject_FromVoidPtr((void *)PyUFunc_API, NULL);
+ if (PyErr_Occurred()) goto err;
+ PyDict_SetItemString(d, "_UFUNC_API", c_api);
+ Py_DECREF(c_api);
+ if (PyErr_Occurred()) goto err;
+
+ s = PyString_FromString("0.4.0");
+ PyDict_SetItemString(d, "__version__", s);
+ Py_DECREF(s);
+
+ /* Load the ufunc operators into the array module's namespace */
+ InitOperators(d);
+
+ InitOtherOperators(d);
+
+ PyDict_SetItemString(d, "pi", s = PyFloat_FromDouble(M_PI));
+ Py_DECREF(s);
+ PyDict_SetItemString(d, "e", s = PyFloat_FromDouble(exp(1.0)));
+ Py_DECREF(s);
+
+#define ADDCONST(str) PyModule_AddIntConstant(m, #str, UFUNC_##str)
+#define ADDSCONST(str) PyModule_AddStringConstant(m, "UFUNC_" #str, UFUNC_##str)
+
+ ADDCONST(ERR_IGNORE);
+ ADDCONST(ERR_WARN);
+ ADDCONST(ERR_CALL);
+ ADDCONST(ERR_RAISE);
+ ADDCONST(ERR_PRINT);
+ ADDCONST(ERR_LOG);
+ ADDCONST(ERR_DEFAULT);
+ ADDCONST(ERR_DEFAULT2);
+
+ ADDCONST(SHIFT_DIVIDEBYZERO);
+ ADDCONST(SHIFT_OVERFLOW);
+ ADDCONST(SHIFT_UNDERFLOW);
+ ADDCONST(SHIFT_INVALID);
+
+ ADDCONST(FPE_DIVIDEBYZERO);
+ ADDCONST(FPE_OVERFLOW);
+ ADDCONST(FPE_UNDERFLOW);
+ ADDCONST(FPE_INVALID);
+
+ ADDCONST(FLOATING_POINT_SUPPORT);
+
+ ADDSCONST(PYVALS_NAME);
+
+#undef ADDCONST
+#undef ADDSCONST
+ PyModule_AddIntConstant(m, "UFUNC_BUFSIZE_DEFAULT", (long)PyArray_BUFSIZE);
+
+ pinf = pinf_init();
+ pzero = pzero_init();
+ mynan = pinf / pinf;
+
+ PyModule_AddObject(m, "PINF", PyFloat_FromDouble(pinf));
+ PyModule_AddObject(m, "NINF", PyFloat_FromDouble(-pinf));
+ PyModule_AddObject(m, "PZERO", PyFloat_FromDouble(pzero));
+ PyModule_AddObject(m, "NZERO", PyFloat_FromDouble(-pzero));
+ PyModule_AddObject(m, "NAN", PyFloat_FromDouble(mynan));
+
+ s = PyDict_GetItemString(d, "conjugate");
+ s2 = PyDict_GetItemString(d, "remainder");
+ /* Setup the array object's numerical structures with appropriate
+ ufuncs in d*/
+ PyArray_SetNumericOps(d);
+
+ PyDict_SetItemString(d, "conj", s);
+ PyDict_SetItemString(d, "mod", s2);
+
+ return;
+ err:
+ /* Check for errors */
+ if (!PyErr_Occurred()) {
+ PyErr_SetString(PyExc_RuntimeError,
+ "cannot load umath module.");
+ }
+ return;
+}
diff --git a/numpy/core/tests/test_defmatrix.py b/numpy/core/tests/test_defmatrix.py
new file mode 100644
index 000000000..1330bfff2
--- /dev/null
+++ b/numpy/core/tests/test_defmatrix.py
@@ -0,0 +1,184 @@
+from numpy.testing import *
+set_package_path()
+import numpy.core;reload(numpy.core)
+from numpy.core import *
+restore_path()
+
+class test_ctor(NumpyTestCase):
+ def check_basic(self):
+ A = array([[1,2],[3,4]])
+ mA = matrix(A)
+ assert all(mA.A == A)
+
+ B = bmat("A,A;A,A")
+ C = bmat([[A,A], [A,A]])
+ D = array([[1,2,1,2],
+ [3,4,3,4],
+ [1,2,1,2],
+ [3,4,3,4]])
+ assert all(B.A == D)
+ assert all(C.A == D)
+
+ vec = arange(5)
+ mvec = matrix(vec)
+ assert mvec.shape == (1,5)
+
+class test_properties(NumpyTestCase):
+ def check_sum(self):
+ """Test whether matrix.sum(axis=1) preserves orientation.
+ Fails in NumPy <= 0.9.6.2127.
+ """
+ M = matrix([[1,2,0,0],
+ [3,4,0,0],
+ [1,2,1,2],
+ [3,4,3,4]])
+ sum0 = matrix([8,12,4,6])
+ sum1 = matrix([3,7,6,14]).T
+ sumall = 30
+ assert_array_equal(sum0, M.sum(axis=0))
+ assert_array_equal(sum1, M.sum(axis=1))
+ assert sumall == M.sum()
+
+ def check_basic(self):
+ import numpy.linalg as linalg
+
+ A = array([[1., 2.],
+ [3., 4.]])
+ mA = matrix(A)
+ assert allclose(linalg.inv(A), mA.I)
+ assert all(array(transpose(A) == mA.T))
+ assert all(array(transpose(A) == mA.H))
+ assert all(A == mA.A)
+
+ B = A + 2j*A
+ mB = matrix(B)
+ assert allclose(linalg.inv(B), mB.I)
+ assert all(array(transpose(B) == mB.T))
+ assert all(array(conjugate(transpose(B)) == mB.H))
+
+ def check_comparisons(self):
+ A = arange(100).reshape(10,10)
+ mA = matrix(A)
+ mB = matrix(A) + 0.1
+ assert all(mB == A+0.1)
+ assert all(mB == matrix(A+0.1))
+ assert not any(mB == matrix(A-0.1))
+ assert all(mA < mB)
+ assert all(mA <= mB)
+ assert all(mA <= mA)
+ assert not any(mA < mA)
+
+ assert not any(mB < mA)
+ assert all(mB >= mA)
+ assert all(mB >= mB)
+ assert not any(mB > mB)
+
+ assert all(mA == mA)
+ assert not any(mA == mB)
+ assert all(mB != mA)
+
+ assert not all(abs(mA) > 0)
+ assert all(abs(mB > 0))
+
+ def check_asmatrix(self):
+ A = arange(100).reshape(10,10)
+ mA = asmatrix(A)
+ A[0,0] = -10
+ assert A[0,0] == mA[0,0]
+
+ def check_noaxis(self):
+ A = matrix([[1,0],[0,1]])
+ assert A.sum() == matrix(2)
+ assert A.mean() == matrix(0.5)
+
+class test_casting(NumpyTestCase):
+ def check_basic(self):
+ A = arange(100).reshape(10,10)
+ mA = matrix(A)
+
+ mB = mA.copy()
+ O = ones((10,10), float64) * 0.1
+ mB = mB + O
+ assert mB.dtype.type == float64
+ assert all(mA != mB)
+ assert all(mB == mA+0.1)
+
+ mC = mA.copy()
+ O = ones((10,10), complex128)
+ mC = mC * O
+ assert mC.dtype.type == complex128
+ assert all(mA != mB)
+
+class test_algebra(NumpyTestCase):
+ def check_basic(self):
+ import numpy.linalg as linalg
+
+ A = array([[1., 2.],
+ [3., 4.]])
+ mA = matrix(A)
+
+ B = identity(2)
+ for i in xrange(6):
+ assert allclose((mA ** i).A, B)
+ B = dot(B, A)
+
+ Ainv = linalg.inv(A)
+ B = identity(2)
+ for i in xrange(6):
+ assert allclose((mA ** -i).A, B)
+ B = dot(B, Ainv)
+
+ assert allclose((mA * mA).A, dot(A, A))
+ assert allclose((mA + mA).A, (A + A))
+ assert allclose((3*mA).A, (3*A))
+
+class test_matrix_return(NumpyTestCase):
+ def check_instance_methods(self):
+ a = matrix([1.0], dtype='f8')
+ methodargs = {
+ 'astype' : ('intc',),
+ 'clip' : (0.0, 1.0),
+ 'compress' : ([1],),
+ 'repeat' : (1,),
+ 'reshape' : (1,),
+ 'swapaxes' : (0,0)
+ }
+ excluded_methods = [
+ 'argmin', 'choose', 'dump', 'dumps', 'fill', 'getfield',
+ 'getA', 'getA1', 'item', 'nonzero', 'put', 'putmask', 'resize',
+ 'searchsorted', 'setflags', 'setfield', 'sort', 'take',
+ 'tofile', 'tolist', 'tostring', 'all', 'any', 'sum',
+ 'argmax', 'argmin', 'min', 'max', 'mean', 'var', 'ptp',
+ 'prod', 'std', 'ctypes', 'itemset'
+ ]
+ for attrib in dir(a):
+ if attrib.startswith('_') or attrib in excluded_methods:
+ continue
+ f = eval('a.%s' % attrib)
+ if callable(f):
+ # reset contents of a
+ a.astype('f8')
+ a.fill(1.0)
+ if methodargs.has_key(attrib):
+ args = methodargs[attrib]
+ else:
+ args = ()
+ b = f(*args)
+ assert type(b) is matrix, "%s" % attrib
+ assert type(a.real) is matrix
+ assert type(a.imag) is matrix
+ c,d = matrix([0.0]).nonzero()
+ assert type(c) is matrix
+ assert type(d) is matrix
+
+class test_indexing(NumpyTestCase):
+ def check_basic(self):
+ x = asmatrix(zeros((3,2),float))
+ y = zeros((3,1),float)
+ y[:,0] = [0.8,0.2,0.3]
+ x[:,1] = y>0.5
+ assert_equal(x, [[0,1],[0,0],[0,0]])
+
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/core/tests/test_errstate.py b/numpy/core/tests/test_errstate.py
new file mode 100644
index 000000000..a7ce798b0
--- /dev/null
+++ b/numpy/core/tests/test_errstate.py
@@ -0,0 +1,62 @@
+# The following exec statement (or something like it) is needed to
+# prevent SyntaxError on Python < 2.5. Even though this is a test,
+# SyntaxErrors are not acceptable; on Debian systems, they block
+# byte-compilation during install and thus cause the package to fail
+# to install.
+
+import sys
+if sys.version_info[:2] >= (2, 5):
+ exec """
+from __future__ import with_statement
+from numpy.core import *
+from numpy.random import rand, randint
+from numpy.testing import *
+
+
+
+class test_errstate(NumpyTestCase):
+
+
+ def test_invalid(self):
+ with errstate(all='raise', under='ignore'):
+ a = -arange(3)
+ # This should work
+ with errstate(invalid='ignore'):
+ sqrt(a)
+ # While this should fail!
+ try:
+ sqrt(a)
+ except FloatingPointError:
+ pass
+ else:
+ self.fail()
+
+ def test_divide(self):
+ with errstate(all='raise', under='ignore'):
+ a = -arange(3)
+ # This should work
+ with errstate(divide='ignore'):
+ a / 0
+ # While this should fail!
+ try:
+ a / 0
+ except FloatingPointError:
+ pass
+ else:
+ self.fail()
+
+ def test_errcall(self):
+ def foo(*args):
+ print args
+ olderrcall = geterrcall()
+ with errstate(call=foo):
+ assert(geterrcall() is foo), 'call is not foo'
+ with errstate(call=None):
+ assert(geterrcall() is None), 'call is not None'
+ assert(geterrcall() is olderrcall), 'call is not olderrcall'
+
+"""
+
+if __name__ == '__main__':
+ from numpy.testing import *
+ NumpyTest().run()
diff --git a/numpy/core/tests/test_ma.py b/numpy/core/tests/test_ma.py
new file mode 100644
index 000000000..a74638a23
--- /dev/null
+++ b/numpy/core/tests/test_ma.py
@@ -0,0 +1,873 @@
+import numpy
+import types, time
+from numpy.core.ma import *
+from numpy.core.numerictypes import float32
+from numpy.testing import NumpyTestCase, NumpyTest
+pi = numpy.pi
+def eq(v,w, msg=''):
+ result = allclose(v,w)
+ if not result:
+ print """Not eq:%s
+%s
+----
+%s"""% (msg, str(v), str(w))
+ return result
+
+class test_ma(NumpyTestCase):
+ def __init__(self, *args, **kwds):
+ NumpyTestCase.__init__(self, *args, **kwds)
+ self.setUp()
+
+ def setUp (self):
+ x=numpy.array([1.,1.,1.,-2., pi/2.0, 4., 5., -10., 10., 1., 2., 3.])
+ y=numpy.array([5.,0.,3., 2., -1., -4., 0., -10., 10., 1., 0., 3.])
+ a10 = 10.
+ m1 = [1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0]
+ m2 = [0, 0, 1, 0, 0, 1, 1, 0, 0, 0 ,0, 1]
+ xm = array(x, mask=m1)
+ ym = array(y, mask=m2)
+ z = numpy.array([-.5, 0., .5, .8])
+ zm = array(z, mask=[0,1,0,0])
+ xf = numpy.where(m1, 1.e+20, x)
+ s = x.shape
+ xm.set_fill_value(1.e+20)
+ self.d = (x, y, a10, m1, m2, xm, ym, z, zm, xf, s)
+
+ def check_testBasic1d(self):
+ "Test of basic array creation and properties in 1 dimension."
+ (x, y, a10, m1, m2, xm, ym, z, zm, xf, s) = self.d
+ self.failIf(isMaskedArray(x))
+ self.failUnless(isMaskedArray(xm))
+ self.assertEqual(shape(xm), s)
+ self.assertEqual(xm.shape, s)
+ self.assertEqual(xm.dtype, x.dtype)
+ self.assertEqual( xm.size , reduce(lambda x,y:x*y, s))
+ self.assertEqual(count(xm) , len(m1) - reduce(lambda x,y:x+y, m1))
+ self.failUnless(eq(xm, xf))
+ self.failUnless(eq(filled(xm, 1.e20), xf))
+ self.failUnless(eq(x, xm))
+
+ def check_testBasic2d(self):
+ "Test of basic array creation and properties in 2 dimensions."
+ for s in [(4,3), (6,2)]:
+ (x, y, a10, m1, m2, xm, ym, z, zm, xf, s) = self.d
+ x.shape = s
+ y.shape = s
+ xm.shape = s
+ ym.shape = s
+ xf.shape = s
+
+ self.failIf(isMaskedArray(x))
+ self.failUnless(isMaskedArray(xm))
+ self.assertEqual(shape(xm), s)
+ self.assertEqual(xm.shape, s)
+ self.assertEqual( xm.size , reduce(lambda x,y:x*y, s))
+ self.assertEqual( count(xm) , len(m1) - reduce(lambda x,y:x+y, m1))
+ self.failUnless(eq(xm, xf))
+ self.failUnless(eq(filled(xm, 1.e20), xf))
+ self.failUnless(eq(x, xm))
+ self.setUp()
+
+ def check_testArithmetic (self):
+ "Test of basic arithmetic."
+ (x, y, a10, m1, m2, xm, ym, z, zm, xf, s) = self.d
+ a2d = array([[1,2],[0,4]])
+ a2dm = masked_array(a2d, [[0,0],[1,0]])
+ self.failUnless(eq (a2d * a2d, a2d * a2dm))
+ self.failUnless(eq (a2d + a2d, a2d + a2dm))
+ self.failUnless(eq (a2d - a2d, a2d - a2dm))
+ for s in [(12,), (4,3), (2,6)]:
+ x = x.reshape(s)
+ y = y.reshape(s)
+ xm = xm.reshape(s)
+ ym = ym.reshape(s)
+ xf = xf.reshape(s)
+ self.failUnless(eq(-x, -xm))
+ self.failUnless(eq(x + y, xm + ym))
+ self.failUnless(eq(x - y, xm - ym))
+ self.failUnless(eq(x * y, xm * ym))
+ olderr = numpy.seterr(divide='ignore', invalid='ignore')
+ self.failUnless(eq(x / y, xm / ym))
+ numpy.seterr(**olderr)
+ self.failUnless(eq(a10 + y, a10 + ym))
+ self.failUnless(eq(a10 - y, a10 - ym))
+ self.failUnless(eq(a10 * y, a10 * ym))
+ olderr = numpy.seterr(divide='ignore', invalid='ignore')
+ self.failUnless(eq(a10 / y, a10 / ym))
+ numpy.seterr(**olderr)
+ self.failUnless(eq(x + a10, xm + a10))
+ self.failUnless(eq(x - a10, xm - a10))
+ self.failUnless(eq(x * a10, xm * a10))
+ self.failUnless(eq(x / a10, xm / a10))
+ self.failUnless(eq(x**2, xm**2))
+ self.failUnless(eq(abs(x)**2.5, abs(xm) **2.5))
+ self.failUnless(eq(x**y, xm**ym))
+ self.failUnless(eq(numpy.add(x,y), add(xm, ym)))
+ self.failUnless(eq(numpy.subtract(x,y), subtract(xm, ym)))
+ self.failUnless(eq(numpy.multiply(x,y), multiply(xm, ym)))
+ olderr = numpy.seterr(divide='ignore', invalid='ignore')
+ self.failUnless(eq(numpy.divide(x,y), divide(xm, ym)))
+ numpy.seterr(**olderr)
+
+
+ def check_testMixedArithmetic(self):
+ na = numpy.array([1])
+ ma = array([1])
+ self.failUnless(isinstance(na + ma, MaskedArray))
+ self.failUnless(isinstance(ma + na, MaskedArray))
+
+ def check_testUfuncs1 (self):
+ "Test various functions such as sin, cos."
+ (x, y, a10, m1, m2, xm, ym, z, zm, xf, s) = self.d
+ self.failUnless (eq(numpy.cos(x), cos(xm)))
+ self.failUnless (eq(numpy.cosh(x), cosh(xm)))
+ self.failUnless (eq(numpy.sin(x), sin(xm)))
+ self.failUnless (eq(numpy.sinh(x), sinh(xm)))
+ self.failUnless (eq(numpy.tan(x), tan(xm)))
+ self.failUnless (eq(numpy.tanh(x), tanh(xm)))
+ olderr = numpy.seterr(divide='ignore', invalid='ignore')
+ self.failUnless (eq(numpy.sqrt(abs(x)), sqrt(xm)))
+ self.failUnless (eq(numpy.log(abs(x)), log(xm)))
+ self.failUnless (eq(numpy.log10(abs(x)), log10(xm)))
+ numpy.seterr(**olderr)
+ self.failUnless (eq(numpy.exp(x), exp(xm)))
+ self.failUnless (eq(numpy.arcsin(z), arcsin(zm)))
+ self.failUnless (eq(numpy.arccos(z), arccos(zm)))
+ self.failUnless (eq(numpy.arctan(z), arctan(zm)))
+ self.failUnless (eq(numpy.arctan2(x, y), arctan2(xm, ym)))
+ self.failUnless (eq(numpy.absolute(x), absolute(xm)))
+ self.failUnless (eq(numpy.equal(x,y), equal(xm, ym)))
+ self.failUnless (eq(numpy.not_equal(x,y), not_equal(xm, ym)))
+ self.failUnless (eq(numpy.less(x,y), less(xm, ym)))
+ self.failUnless (eq(numpy.greater(x,y), greater(xm, ym)))
+ self.failUnless (eq(numpy.less_equal(x,y), less_equal(xm, ym)))
+ self.failUnless (eq(numpy.greater_equal(x,y), greater_equal(xm, ym)))
+ self.failUnless (eq(numpy.conjugate(x), conjugate(xm)))
+ self.failUnless (eq(numpy.concatenate((x,y)), concatenate((xm,ym))))
+ self.failUnless (eq(numpy.concatenate((x,y)), concatenate((x,y))))
+ self.failUnless (eq(numpy.concatenate((x,y)), concatenate((xm,y))))
+ self.failUnless (eq(numpy.concatenate((x,y,x)), concatenate((x,ym,x))))
+
+ def check_xtestCount (self):
+ "Test count"
+ ott = array([0.,1.,2.,3.], mask=[1,0,0,0])
+ self.failUnless( isinstance(count(ott), types.IntType))
+ self.assertEqual(3, count(ott))
+ self.assertEqual(1, count(1))
+ self.failUnless (eq(0, array(1,mask=[1])))
+ ott=ott.reshape((2,2))
+ assert isMaskedArray(count(ott,0))
+ assert isinstance(count(ott), types.IntType)
+ self.failUnless (eq(3, count(ott)))
+ assert getmask(count(ott,0)) is nomask
+ self.failUnless (eq([1,2],count(ott,0)))
+
+ def check_testMinMax (self):
+ "Test minimum and maximum."
+ (x, y, a10, m1, m2, xm, ym, z, zm, xf, s) = self.d
+ xr = numpy.ravel(x) #max doesn't work if shaped
+ xmr = ravel(xm)
+ self.failUnless (eq(max(xr), maximum(xmr))) #true because of careful selection of data
+ self.failUnless (eq(min(xr), minimum(xmr))) #true because of careful selection of data
+
+ def check_testAddSumProd (self):
+ "Test add, sum, product."
+ (x, y, a10, m1, m2, xm, ym, z, zm, xf, s) = self.d
+ self.failUnless (eq(numpy.add.reduce(x), add.reduce(x)))
+ self.failUnless (eq(numpy.add.accumulate(x), add.accumulate(x)))
+ self.failUnless (eq(4, sum(array(4),axis=0)))
+ self.failUnless (eq(4, sum(array(4), axis=0)))
+ self.failUnless (eq(numpy.sum(x,axis=0), sum(x,axis=0)))
+ self.failUnless (eq(numpy.sum(filled(xm,0),axis=0), sum(xm,axis=0)))
+ self.failUnless (eq(numpy.sum(x,0), sum(x,0)))
+ self.failUnless (eq(numpy.product(x,axis=0), product(x,axis=0)))
+ self.failUnless (eq(numpy.product(x,0), product(x,0)))
+ self.failUnless (eq(numpy.product(filled(xm,1),axis=0), product(xm,axis=0)))
+ if len(s) > 1:
+ self.failUnless (eq(numpy.concatenate((x,y),1), concatenate((xm,ym),1)))
+ self.failUnless (eq(numpy.add.reduce(x,1), add.reduce(x,1)))
+ self.failUnless (eq(numpy.sum(x,1), sum(x,1)))
+ self.failUnless (eq(numpy.product(x,1), product(x,1)))
+
+
+ def check_testCI(self):
+ "Test of conversions and indexing"
+ x1 = numpy.array([1,2,4,3])
+ x2 = array(x1, mask = [1,0,0,0])
+ x3 = array(x1, mask = [0,1,0,1])
+ x4 = array(x1)
+ # test conversion to strings
+ junk, garbage = str(x2), repr(x2)
+ assert eq(numpy.sort(x1),sort(x2, fill_value=0))
+ # tests of indexing
+ assert type(x2[1]) is type(x1[1])
+ assert x1[1] == x2[1]
+ assert x2[0] is masked
+ assert eq(x1[2],x2[2])
+ assert eq(x1[2:5],x2[2:5])
+ assert eq(x1[:],x2[:])
+ assert eq(x1[1:], x3[1:])
+ x1[2]=9
+ x2[2]=9
+ assert eq(x1,x2)
+ x1[1:3] = 99
+ x2[1:3] = 99
+ assert eq(x1,x2)
+ x2[1] = masked
+ assert eq(x1,x2)
+ x2[1:3]=masked
+ assert eq(x1,x2)
+ x2[:] = x1
+ x2[1] = masked
+ assert allequal(getmask(x2),array([0,1,0,0]))
+ x3[:] = masked_array([1,2,3,4],[0,1,1,0])
+ assert allequal(getmask(x3), array([0,1,1,0]))
+ x4[:] = masked_array([1,2,3,4],[0,1,1,0])
+ assert allequal(getmask(x4), array([0,1,1,0]))
+ assert allequal(x4, array([1,2,3,4]))
+ x1 = numpy.arange(5)*1.0
+ x2 = masked_values(x1, 3.0)
+ assert eq(x1,x2)
+ assert allequal(array([0,0,0,1,0],MaskType), x2.mask)
+ assert eq(3.0, x2.fill_value())
+ x1 = array([1,'hello',2,3],object)
+ x2 = numpy.array([1,'hello',2,3],object)
+ s1 = x1[1]
+ s2 = x2[1]
+ self.assertEqual(type(s2), str)
+ self.assertEqual(type(s1), str)
+ self.assertEqual(s1, s2)
+ assert x1[1:1].shape == (0,)
+
+ def check_testCopySize(self):
+ "Tests of some subtle points of copying and sizing."
+ n = [0,0,1,0,0]
+ m = make_mask(n)
+ m2 = make_mask(m)
+ self.failUnless(m is m2)
+ m3 = make_mask(m, copy=1)
+ self.failUnless(m is not m3)
+
+ x1 = numpy.arange(5)
+ y1 = array(x1, mask=m)
+ self.failUnless( y1.raw_data() is not x1)
+ self.failUnless( allequal(x1,y1.raw_data()))
+ self.failUnless( y1.mask is m)
+
+ y1a = array(y1, copy=0)
+ self.failUnless( y1a.raw_data() is y1.raw_data())
+ self.failUnless( y1a.mask is y1.mask)
+
+ y2 = array(x1, mask=m, copy=0)
+ self.failUnless( y2.raw_data() is x1)
+ self.failUnless( y2.mask is m)
+ self.failUnless( y2[2] is masked)
+ y2[2]=9
+ self.failUnless( y2[2] is not masked)
+ self.failUnless( y2.mask is not m)
+ self.failUnless( allequal(y2.mask, 0))
+
+ y3 = array(x1*1.0, mask=m)
+ self.failUnless(filled(y3).dtype is (x1*1.0).dtype)
+
+ x4 = arange(4)
+ x4[2] = masked
+ y4 = resize(x4, (8,))
+ self.failUnless( eq(concatenate([x4,x4]), y4))
+ self.failUnless( eq(getmask(y4),[0,0,1,0,0,0,1,0]))
+ y5 = repeat(x4, (2,2,2,2), axis=0)
+ self.failUnless( eq(y5, [0,0,1,1,2,2,3,3]))
+ y6 = repeat(x4, 2, axis=0)
+ self.failUnless( eq(y5, y6))
+
+ def check_testPut(self):
+ "Test of put"
+ d = arange(5)
+ n = [0,0,0,1,1]
+ m = make_mask(n)
+ x = array(d, mask = m)
+ self.failUnless( x[3] is masked)
+ self.failUnless( x[4] is masked)
+ x[[1,4]] = [10,40]
+ self.failUnless( x.mask is not m)
+ self.failUnless( x[3] is masked)
+ self.failUnless( x[4] is not masked)
+ self.failUnless( eq(x, [0,10,2,-1,40]))
+
+ x = array(d, mask = m)
+ x.put([-1,100,200])
+ self.failUnless( eq(x, [-1,100,200,0,0]))
+ self.failUnless( x[3] is masked)
+ self.failUnless( x[4] is masked)
+
+ x = array(d, mask = m)
+ x.putmask([30,40])
+ self.failUnless( eq(x, [0,1,2,30,40]))
+ self.failUnless( x.mask is nomask)
+
+ x = array(d, mask = m)
+ y = x.compressed()
+ z = array(x, mask = m)
+ z.put(y)
+ assert eq (x, z)
+
+ def check_testMaPut(self):
+ (x, y, a10, m1, m2, xm, ym, z, zm, xf, s) = self.d
+ m = [1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1]
+ i = numpy.nonzero(m)[0]
+ putmask(xm, m, z)
+ assert take(xm, i,axis=0) == z
+ put(ym, i, zm)
+ assert take(ym, i,axis=0) == zm
+
+ def check_testOddFeatures(self):
+ "Test of other odd features"
+ x = arange(20); x=x.reshape(4,5)
+ x.flat[5] = 12
+ assert x[1,0] == 12
+ z = x + 10j * x
+ assert eq(z.real, x)
+ assert eq(z.imag, 10*x)
+ assert eq((z*conjugate(z)).real, 101*x*x)
+ z.imag[...] = 0.0
+
+ x = arange(10)
+ x[3] = masked
+ assert str(x[3]) == str(masked)
+ c = x >= 8
+ assert count(where(c,masked,masked)) == 0
+ assert shape(where(c,masked,masked)) == c.shape
+ z = where(c , x, masked)
+ assert z.dtype is x.dtype
+ assert z[3] is masked
+ assert z[4] is masked
+ assert z[7] is masked
+ assert z[8] is not masked
+ assert z[9] is not masked
+ assert eq(x,z)
+ z = where(c , masked, x)
+ assert z.dtype is x.dtype
+ assert z[3] is masked
+ assert z[4] is not masked
+ assert z[7] is not masked
+ assert z[8] is masked
+ assert z[9] is masked
+ z = masked_where(c, x)
+ assert z.dtype is x.dtype
+ assert z[3] is masked
+ assert z[4] is not masked
+ assert z[7] is not masked
+ assert z[8] is masked
+ assert z[9] is masked
+ assert eq(x,z)
+ x = array([1.,2.,3.,4.,5.])
+ c = array([1,1,1,0,0])
+ x[2] = masked
+ z = where(c, x, -x)
+ assert eq(z, [1.,2.,0., -4., -5])
+ c[0] = masked
+ z = where(c, x, -x)
+ assert eq(z, [1.,2.,0., -4., -5])
+ assert z[0] is masked
+ assert z[1] is not masked
+ assert z[2] is masked
+ assert eq(masked_where(greater(x, 2), x), masked_greater(x,2))
+ assert eq(masked_where(greater_equal(x, 2), x), masked_greater_equal(x,2))
+ assert eq(masked_where(less(x, 2), x), masked_less(x,2))
+ assert eq(masked_where(less_equal(x, 2), x), masked_less_equal(x,2))
+ assert eq(masked_where(not_equal(x, 2), x), masked_not_equal(x,2))
+ assert eq(masked_where(equal(x, 2), x), masked_equal(x,2))
+ assert eq(masked_where(not_equal(x,2), x), masked_not_equal(x,2))
+ assert eq(masked_inside(range(5), 1, 3), [0, 199, 199, 199, 4])
+ assert eq(masked_outside(range(5), 1, 3),[199,1,2,3,199])
+ assert eq(masked_inside(array(range(5), mask=[1,0,0,0,0]), 1, 3).mask, [1,1,1,1,0])
+ assert eq(masked_outside(array(range(5), mask=[0,1,0,0,0]), 1, 3).mask, [1,1,0,0,1])
+ assert eq(masked_equal(array(range(5), mask=[1,0,0,0,0]), 2).mask, [1,0,1,0,0])
+ assert eq(masked_not_equal(array([2,2,1,2,1], mask=[1,0,0,0,0]), 2).mask, [1,0,1,0,1])
+ assert eq(masked_where([1,1,0,0,0], [1,2,3,4,5]), [99,99,3,4,5])
+ atest = ones((10,10,10), dtype=float32)
+ btest = zeros(atest.shape, MaskType)
+ ctest = masked_where(btest,atest)
+ assert eq(atest,ctest)
+ z = choose(c, (-x, x))
+ assert eq(z, [1.,2.,0., -4., -5])
+ assert z[0] is masked
+ assert z[1] is not masked
+ assert z[2] is masked
+ x = arange(6)
+ x[5] = masked
+ y = arange(6)*10
+ y[2]= masked
+ c = array([1,1,1,0,0,0], mask=[1,0,0,0,0,0])
+ cm = c.filled(1)
+ z = where(c,x,y)
+ zm = where(cm,x,y)
+ assert eq(z, zm)
+ assert getmask(zm) is nomask
+ assert eq(zm, [0,1,2,30,40,50])
+ z = where(c, masked, 1)
+ assert eq(z, [99,99,99,1,1,1])
+ z = where(c, 1, masked)
+ assert eq(z, [99, 1, 1, 99, 99, 99])
+
+ def check_testMinMax(self):
+ "Test of minumum, maximum."
+ assert eq(minimum([1,2,3],[4,0,9]), [1,0,3])
+ assert eq(maximum([1,2,3],[4,0,9]), [4,2,9])
+ x = arange(5)
+ y = arange(5) - 2
+ x[3] = masked
+ y[0] = masked
+ assert eq(minimum(x,y), where(less(x,y), x, y))
+ assert eq(maximum(x,y), where(greater(x,y), x, y))
+ assert minimum(x) == 0
+ assert maximum(x) == 4
+
+ def check_testTakeTransposeInnerOuter(self):
+ "Test of take, transpose, inner, outer products"
+ x = arange(24)
+ y = numpy.arange(24)
+ x[5:6] = masked
+ x=x.reshape(2,3,4)
+ y=y.reshape(2,3,4)
+ assert eq(numpy.transpose(y,(2,0,1)), transpose(x,(2,0,1)))
+ assert eq(numpy.take(y, (2,0,1), 1), take(x, (2,0,1), 1))
+ assert eq(numpy.inner(filled(x,0),filled(y,0)),
+ inner(x, y))
+ assert eq(numpy.outer(filled(x,0),filled(y,0)),
+ outer(x, y))
+ y = array(['abc', 1, 'def', 2, 3], object)
+ y[2] = masked
+ t = take(y,[0,3,4])
+ assert t[0] == 'abc'
+ assert t[1] == 2
+ assert t[2] == 3
+
+ def check_testInplace(self):
+ """Test of inplace operations and rich comparisons"""
+ y = arange(10)
+
+ x = arange(10)
+ xm = arange(10)
+ xm[2] = masked
+ x += 1
+ assert eq(x, y+1)
+ xm += 1
+ assert eq(x, y+1)
+
+ x = arange(10)
+ xm = arange(10)
+ xm[2] = masked
+ x -= 1
+ assert eq(x, y-1)
+ xm -= 1
+ assert eq(xm, y-1)
+
+ x = arange(10)*1.0
+ xm = arange(10)*1.0
+ xm[2] = masked
+ x *= 2.0
+ assert eq(x, y*2)
+ xm *= 2.0
+ assert eq(xm, y*2)
+
+ x = arange(10)*2
+ xm = arange(10)
+ xm[2] = masked
+ x /= 2
+ assert eq(x, y)
+ xm /= 2
+ assert eq(x, y)
+
+ x = arange(10)*1.0
+ xm = arange(10)*1.0
+ xm[2] = masked
+ x /= 2.0
+ assert eq(x, y/2.0)
+ xm /= arange(10)
+ assert eq(xm, ones((10,)))
+
+ x = arange(10).astype(float32)
+ xm = arange(10)
+ xm[2] = masked
+ id1 = id(x.raw_data())
+ x += 1.
+ assert id1 == id(x.raw_data())
+ assert eq(x, y+1.)
+
+ def check_testPickle(self):
+ "Test of pickling"
+ import pickle
+ x = arange(12)
+ x[4:10:2] = masked
+ x = x.reshape(4,3)
+ s = pickle.dumps(x)
+ y = pickle.loads(s)
+ assert eq(x,y)
+
+ def check_testMasked(self):
+ "Test of masked element"
+ xx=arange(6)
+ xx[1] = masked
+ self.failUnless(str(masked) == '--')
+ self.failUnless(xx[1] is masked)
+ self.failUnlessEqual(filled(xx[1], 0), 0)
+ # don't know why these should raise an exception...
+ #self.failUnlessRaises(Exception, lambda x,y: x+y, masked, masked)
+ #self.failUnlessRaises(Exception, lambda x,y: x+y, masked, 2)
+ #self.failUnlessRaises(Exception, lambda x,y: x+y, masked, xx)
+ #self.failUnlessRaises(Exception, lambda x,y: x+y, xx, masked)
+
+ def check_testAverage1(self):
+ "Test of average."
+ ott = array([0.,1.,2.,3.], mask=[1,0,0,0])
+ self.failUnless(eq(2.0, average(ott,axis=0)))
+ self.failUnless(eq(2.0, average(ott, weights=[1., 1., 2., 1.])))
+ result, wts = average(ott, weights=[1.,1.,2.,1.], returned=1)
+ self.failUnless(eq(2.0, result))
+ self.failUnless(wts == 4.0)
+ ott[:] = masked
+ self.failUnless(average(ott,axis=0) is masked)
+ ott = array([0.,1.,2.,3.], mask=[1,0,0,0])
+ ott=ott.reshape(2,2)
+ ott[:,1] = masked
+ self.failUnless(eq(average(ott,axis=0), [2.0, 0.0]))
+ self.failUnless(average(ott,axis=1)[0] is masked)
+ self.failUnless(eq([2.,0.], average(ott, axis=0)))
+ result, wts = average(ott, axis=0, returned=1)
+ self.failUnless(eq(wts, [1., 0.]))
+
+ def check_testAverage2(self):
+ "More tests of average."
+ w1 = [0,1,1,1,1,0]
+ w2 = [[0,1,1,1,1,0],[1,0,0,0,0,1]]
+ x=arange(6)
+ self.failUnless(allclose(average(x, axis=0), 2.5))
+ self.failUnless(allclose(average(x, axis=0, weights=w1), 2.5))
+ y=array([arange(6), 2.0*arange(6)])
+ self.failUnless(allclose(average(y, None), numpy.add.reduce(numpy.arange(6))*3./12.))
+ self.failUnless(allclose(average(y, axis=0), numpy.arange(6) * 3./2.))
+ self.failUnless(allclose(average(y, axis=1), [average(x,axis=0), average(x,axis=0) * 2.0]))
+ self.failUnless(allclose(average(y, None, weights=w2), 20./6.))
+ self.failUnless(allclose(average(y, axis=0, weights=w2), [0.,1.,2.,3.,4.,10.]))
+ self.failUnless(allclose(average(y, axis=1), [average(x,axis=0), average(x,axis=0) * 2.0]))
+ m1 = zeros(6)
+ m2 = [0,0,1,1,0,0]
+ m3 = [[0,0,1,1,0,0],[0,1,1,1,1,0]]
+ m4 = ones(6)
+ m5 = [0, 1, 1, 1, 1, 1]
+ self.failUnless(allclose(average(masked_array(x, m1),axis=0), 2.5))
+ self.failUnless(allclose(average(masked_array(x, m2),axis=0), 2.5))
+ self.failUnless(average(masked_array(x, m4),axis=0) is masked)
+ self.assertEqual(average(masked_array(x, m5),axis=0), 0.0)
+ self.assertEqual(count(average(masked_array(x, m4),axis=0)), 0)
+ z = masked_array(y, m3)
+ self.failUnless(allclose(average(z, None), 20./6.))
+ self.failUnless(allclose(average(z, axis=0), [0.,1.,99.,99.,4.0, 7.5]))
+ self.failUnless(allclose(average(z, axis=1), [2.5, 5.0]))
+ self.failUnless(allclose( average(z,axis=0, weights=w2), [0.,1., 99., 99., 4.0, 10.0]))
+
+ a = arange(6)
+ b = arange(6) * 3
+ r1, w1 = average([[a,b],[b,a]], axis=1, returned=1)
+ self.assertEqual(shape(r1) , shape(w1))
+ self.assertEqual(r1.shape , w1.shape)
+ r2, w2 = average(ones((2,2,3)), axis=0, weights=[3,1], returned=1)
+ self.assertEqual(shape(w2) , shape(r2))
+ r2, w2 = average(ones((2,2,3)), returned=1)
+ self.assertEqual(shape(w2) , shape(r2))
+ r2, w2 = average(ones((2,2,3)), weights=ones((2,2,3)), returned=1)
+ self.failUnless(shape(w2) == shape(r2))
+ a2d = array([[1,2],[0,4]], float)
+ a2dm = masked_array(a2d, [[0,0],[1,0]])
+ a2da = average(a2d, axis=0)
+ self.failUnless(eq (a2da, [0.5, 3.0]))
+ a2dma = average(a2dm, axis=0)
+ self.failUnless(eq( a2dma, [1.0, 3.0]))
+ a2dma = average(a2dm, axis=None)
+ self.failUnless(eq(a2dma, 7./3.))
+ a2dma = average(a2dm, axis=1)
+ self.failUnless(eq(a2dma, [1.5, 4.0]))
+
+ def check_testToPython(self):
+ self.assertEqual(1, int(array(1)))
+ self.assertEqual(1.0, float(array(1)))
+ self.assertEqual(1, int(array([[[1]]])))
+ self.assertEqual(1.0, float(array([[1]])))
+ self.failUnlessRaises(ValueError, float, array([1,1]))
+ self.failUnlessRaises(MAError, float, array([1],mask=[1]))
+ self.failUnless(bool(array([0,1])))
+ self.failUnless(bool(array([0,0],mask=[0,1])))
+ self.failIf(bool(array([0,0])))
+ self.failIf(bool(array([0,0],mask=[0,0])))
+
+ def check_testScalarArithmetic(self):
+ xm = array(0, mask=1)
+ self.failUnless((1/array(0)).mask)
+ self.failUnless((1 + xm).mask)
+ self.failUnless((-xm).mask)
+ self.failUnless((-xm).mask)
+ self.failUnless(maximum(xm, xm).mask)
+ self.failUnless(minimum(xm, xm).mask)
+ self.failUnless(xm.filled().dtype is xm.data.dtype)
+ x = array(0, mask=0)
+ self.failUnless(x.filled() == x.data)
+ self.failUnlessEqual(str(xm), str(masked_print_option))
+
+ def check_testArrayMethods(self):
+ a = array([1,3,2])
+ b = array([1,3,2], mask=[1,0,1])
+ self.failUnless(eq(a.any(), a.data.any()))
+ self.failUnless(eq(a.all(), a.data.all()))
+ self.failUnless(eq(a.argmax(), a.data.argmax()))
+ self.failUnless(eq(a.argmin(), a.data.argmin()))
+ self.failUnless(eq(a.choose(0,1,2,3,4), a.data.choose(0,1,2,3,4)))
+ self.failUnless(eq(a.compress([1,0,1]), a.data.compress([1,0,1])))
+ self.failUnless(eq(a.conj(), a.data.conj()))
+ self.failUnless(eq(a.conjugate(), a.data.conjugate()))
+ m = array([[1,2],[3,4]])
+ self.failUnless(eq(m.diagonal(), m.data.diagonal()))
+ self.failUnless(eq(a.sum(), a.data.sum()))
+ self.failUnless(eq(a.take([1,2]), a.data.take([1,2])))
+ self.failUnless(eq(m.transpose(), m.data.transpose()))
+
+ def check_testArrayAttributes(self):
+ a = array([1,3,2])
+ b = array([1,3,2], mask=[1,0,1])
+ self.failUnlessEqual(a.ndim, 1)
+
+ def check_testAPI(self):
+ self.failIf([m for m in dir(numpy.ndarray)
+ if m not in dir(array) and not m.startswith('_')])
+
+ def check_testSingleElementSubscript(self):
+ a = array([1,3,2])
+ b = array([1,3,2], mask=[1,0,1])
+ self.failUnlessEqual(a[0].shape, ())
+ self.failUnlessEqual(b[0].shape, ())
+ self.failUnlessEqual(b[1].shape, ())
+
+class test_ufuncs(NumpyTestCase):
+ def setUp(self):
+ self.d = (array([1.0, 0, -1, pi/2]*2, mask=[0,1]+[0]*6),
+ array([1.0, 0, -1, pi/2]*2, mask=[1,0]+[0]*6),)
+
+
+ def check_testUfuncRegression(self):
+ for f in ['sqrt', 'log', 'log10', 'exp', 'conjugate',
+ 'sin', 'cos', 'tan',
+ 'arcsin', 'arccos', 'arctan',
+ 'sinh', 'cosh', 'tanh',
+ 'arcsinh',
+ 'arccosh',
+ 'arctanh',
+ 'absolute', 'fabs', 'negative',
+ # 'nonzero', 'around',
+ 'floor', 'ceil',
+ # 'sometrue', 'alltrue',
+ 'logical_not',
+ 'add', 'subtract', 'multiply',
+ 'divide', 'true_divide', 'floor_divide',
+ 'remainder', 'fmod', 'hypot', 'arctan2',
+ 'equal', 'not_equal', 'less_equal', 'greater_equal',
+ 'less', 'greater',
+ 'logical_and', 'logical_or', 'logical_xor',
+ ]:
+ try:
+ uf = getattr(umath, f)
+ except AttributeError:
+ uf = getattr(fromnumeric, f)
+ mf = getattr(numpy.ma, f)
+ args = self.d[:uf.nin]
+ olderr = numpy.geterr()
+ if f in ['sqrt', 'arctanh', 'arcsin', 'arccos', 'arccosh', 'arctanh', 'log',
+ 'log10','divide','true_divide', 'floor_divide', 'remainder', 'fmod']:
+ numpy.seterr(invalid='ignore')
+ if f in ['arctanh', 'log', 'log10']:
+ numpy.seterr(divide='ignore')
+ ur = uf(*args)
+ mr = mf(*args)
+ numpy.seterr(**olderr)
+ self.failUnless(eq(ur.filled(0), mr.filled(0), f))
+ self.failUnless(eqmask(ur.mask, mr.mask))
+
+ def test_reduce(self):
+ a = self.d[0]
+ self.failIf(alltrue(a,axis=0))
+ self.failUnless(sometrue(a,axis=0))
+ self.failUnlessEqual(sum(a[:3],axis=0), 0)
+ self.failUnlessEqual(product(a,axis=0), 0)
+
+ def test_minmax(self):
+ a = arange(1,13).reshape(3,4)
+ amask = masked_where(a < 5,a)
+ self.failUnlessEqual(amask.max(), a.max())
+ self.failUnlessEqual(amask.min(), 5)
+ self.failUnless((amask.max(0) == a.max(0)).all())
+ self.failUnless((amask.min(0) == [5,6,7,8]).all())
+ self.failUnless(amask.max(1)[0].mask)
+ self.failUnless(amask.min(1)[0].mask)
+
+ def test_nonzero(self):
+ for t in "?bhilqpBHILQPfdgFDGO":
+ x = array([1,0,2,0], mask=[0,0,1,1])
+ self.failUnless(eq(nonzero(x), [0]))
+
+
+class test_array_methods(NumpyTestCase):
+
+ def setUp(self):
+ x = numpy.array([ 8.375, 7.545, 8.828, 8.5 , 1.757, 5.928,
+ 8.43 , 7.78 , 9.865, 5.878, 8.979, 4.732,
+ 3.012, 6.022, 5.095, 3.116, 5.238, 3.957,
+ 6.04 , 9.63 , 7.712, 3.382, 4.489, 6.479,
+ 7.189, 9.645, 5.395, 4.961, 9.894, 2.893,
+ 7.357, 9.828, 6.272, 3.758, 6.693, 0.993])
+ X = x.reshape(6,6)
+ XX = x.reshape(3,2,2,3)
+
+ m = numpy.array([0, 1, 0, 1, 0, 0,
+ 1, 0, 1, 1, 0, 1,
+ 0, 0, 0, 1, 0, 1,
+ 0, 0, 0, 1, 1, 1,
+ 1, 0, 0, 1, 0, 0,
+ 0, 0, 1, 0, 1, 0])
+ mx = array(data=x,mask=m)
+ mX = array(data=X,mask=m.reshape(X.shape))
+ mXX = array(data=XX,mask=m.reshape(XX.shape))
+
+ m2 = numpy.array([1, 1, 0, 1, 0, 0,
+ 1, 1, 1, 1, 0, 1,
+ 0, 0, 1, 1, 0, 1,
+ 0, 0, 0, 1, 1, 1,
+ 1, 0, 0, 1, 1, 0,
+ 0, 0, 1, 0, 1, 1])
+ m2x = array(data=x,mask=m2)
+ m2X = array(data=X,mask=m2.reshape(X.shape))
+ m2XX = array(data=XX,mask=m2.reshape(XX.shape))
+ self.d = (x,X,XX,m,mx,mX,mXX)
+
+ #------------------------------------------------------
+ def test_trace(self):
+ (x,X,XX,m,mx,mX,mXX,) = self.d
+ mXdiag = mX.diagonal()
+ self.assertEqual(mX.trace(), mX.diagonal().compressed().sum())
+ self.failUnless(eq(mX.trace(),
+ X.trace() - sum(mXdiag.mask*X.diagonal(),axis=0)))
+
+ def test_clip(self):
+ (x,X,XX,m,mx,mX,mXX,) = self.d
+ clipped = mx.clip(2,8)
+ self.failUnless(eq(clipped.mask,mx.mask))
+ self.failUnless(eq(clipped.data,x.clip(2,8)))
+ self.failUnless(eq(clipped.data,mx.data.clip(2,8)))
+
+ def test_ptp(self):
+ (x,X,XX,m,mx,mX,mXX,) = self.d
+ (n,m) = X.shape
+ self.assertEqual(mx.ptp(),mx.compressed().ptp())
+ rows = numpy.zeros(n,numpy.float_)
+ cols = numpy.zeros(m,numpy.float_)
+ for k in range(m):
+ cols[k] = mX[:,k].compressed().ptp()
+ for k in range(n):
+ rows[k] = mX[k].compressed().ptp()
+ self.failUnless(eq(mX.ptp(0),cols))
+ self.failUnless(eq(mX.ptp(1),rows))
+
+ def test_swapaxes(self):
+ (x,X,XX,m,mx,mX,mXX,) = self.d
+ mXswapped = mX.swapaxes(0,1)
+ self.failUnless(eq(mXswapped[-1],mX[:,-1]))
+ mXXswapped = mXX.swapaxes(0,2)
+ self.assertEqual(mXXswapped.shape,(2,2,3,3))
+
+
+ def test_cumprod(self):
+ (x,X,XX,m,mx,mX,mXX,) = self.d
+ mXcp = mX.cumprod(0)
+ self.failUnless(eq(mXcp.data,mX.filled(1).cumprod(0)))
+ mXcp = mX.cumprod(1)
+ self.failUnless(eq(mXcp.data,mX.filled(1).cumprod(1)))
+
+ def test_cumsum(self):
+ (x,X,XX,m,mx,mX,mXX,) = self.d
+ mXcp = mX.cumsum(0)
+ self.failUnless(eq(mXcp.data,mX.filled(0).cumsum(0)))
+ mXcp = mX.cumsum(1)
+ self.failUnless(eq(mXcp.data,mX.filled(0).cumsum(1)))
+
+ def test_varstd(self):
+ (x,X,XX,m,mx,mX,mXX,) = self.d
+ self.failUnless(eq(mX.var(axis=None),mX.compressed().var()))
+ self.failUnless(eq(mX.std(axis=None),mX.compressed().std()))
+ self.failUnless(eq(mXX.var(axis=3).shape,XX.var(axis=3).shape))
+ self.failUnless(eq(mX.var().shape,X.var().shape))
+ (mXvar0,mXvar1) = (mX.var(axis=0), mX.var(axis=1))
+ for k in range(6):
+ self.failUnless(eq(mXvar1[k],mX[k].compressed().var()))
+ self.failUnless(eq(mXvar0[k],mX[:,k].compressed().var()))
+ self.failUnless(eq(numpy.sqrt(mXvar0[k]),
+ mX[:,k].compressed().std()))
+
+
+def eqmask(m1, m2):
+ if m1 is nomask:
+ return m2 is nomask
+ if m2 is nomask:
+ return m1 is nomask
+ return (m1 == m2).all()
+
+def timingTest():
+ for f in [testf, testinplace]:
+ for n in [1000,10000,50000]:
+ t = testta(n, f)
+ t1 = testtb(n, f)
+ t2 = testtc(n, f)
+ print f.test_name
+ print """\
+n = %7d
+numpy time (ms) %6.1f
+MA maskless ratio %6.1f
+MA masked ratio %6.1f
+""" % (n, t*1000.0, t1/t, t2/t)
+
+def testta(n, f):
+ x=numpy.arange(n) + 1.0
+ tn0 = time.time()
+ z = f(x)
+ return time.time() - tn0
+
+def testtb(n, f):
+ x=arange(n) + 1.0
+ tn0 = time.time()
+ z = f(x)
+ return time.time() - tn0
+
+def testtc(n, f):
+ x=arange(n) + 1.0
+ x[0] = masked
+ tn0 = time.time()
+ z = f(x)
+ return time.time() - tn0
+
+def testf(x):
+ for i in range(25):
+ y = x **2 + 2.0 * x - 1.0
+ w = x **2 + 1.0
+ z = (y / w) ** 2
+ return z
+testf.test_name = 'Simple arithmetic'
+
+def testinplace(x):
+ for i in range(25):
+ y = x**2
+ y += 2.0*x
+ y -= 1.0
+ y /= x
+ return y
+testinplace.test_name = 'Inplace operations'
+
+if __name__ == "__main__":
+ NumpyTest('numpy.core.ma').run()
+ #timingTest()
diff --git a/numpy/core/tests/test_multiarray.py b/numpy/core/tests/test_multiarray.py
new file mode 100644
index 000000000..d7ab0be93
--- /dev/null
+++ b/numpy/core/tests/test_multiarray.py
@@ -0,0 +1,430 @@
+from numpy.testing import *
+from numpy.core import *
+from numpy import random
+import numpy as N
+
+class test_flags(NumpyTestCase):
+ def setUp(self):
+ self.a = arange(10)
+
+ def check_writeable(self):
+ mydict = locals()
+ self.a.flags.writeable = False
+ self.assertRaises(RuntimeError, runstring, 'self.a[0] = 3', mydict)
+ self.a.flags.writeable = True
+ self.a[0] = 5
+ self.a[0] = 0
+
+ def check_otherflags(self):
+ assert_equal(self.a.flags.carray, True)
+ assert_equal(self.a.flags.farray, False)
+ assert_equal(self.a.flags.behaved, True)
+ assert_equal(self.a.flags.fnc, False)
+ assert_equal(self.a.flags.forc, True)
+ assert_equal(self.a.flags.owndata, True)
+ assert_equal(self.a.flags.writeable, True)
+ assert_equal(self.a.flags.aligned, True)
+ assert_equal(self.a.flags.updateifcopy, False)
+
+
+class test_attributes(NumpyTestCase):
+ def setUp(self):
+ self.one = arange(10)
+ self.two = arange(20).reshape(4,5)
+ self.three = arange(60,dtype=float64).reshape(2,5,6)
+
+ def check_attributes(self):
+ assert_equal(self.one.shape, (10,))
+ assert_equal(self.two.shape, (4,5))
+ assert_equal(self.three.shape, (2,5,6))
+ self.three.shape = (10,3,2)
+ assert_equal(self.three.shape, (10,3,2))
+ self.three.shape = (2,5,6)
+ assert_equal(self.one.strides, (self.one.itemsize,))
+ num = self.two.itemsize
+ assert_equal(self.two.strides, (5*num, num))
+ num = self.three.itemsize
+ assert_equal(self.three.strides, (30*num, 6*num, num))
+ assert_equal(self.one.ndim, 1)
+ assert_equal(self.two.ndim, 2)
+ assert_equal(self.three.ndim, 3)
+ num = self.two.itemsize
+ assert_equal(self.two.size, 20)
+ assert_equal(self.two.nbytes, 20*num)
+ assert_equal(self.two.itemsize, self.two.dtype.itemsize)
+ assert_equal(self.two.base, arange(20))
+
+ def check_dtypeattr(self):
+ assert_equal(self.one.dtype, dtype(int_))
+ assert_equal(self.three.dtype, dtype(float_))
+ assert_equal(self.one.dtype.char, 'l')
+ assert_equal(self.three.dtype.char, 'd')
+ self.failUnless(self.three.dtype.str[0] in '<>')
+ assert_equal(self.one.dtype.str[1], 'i')
+ assert_equal(self.three.dtype.str[1], 'f')
+
+ def check_stridesattr(self):
+ x = self.one
+ def make_array(size, offset, strides):
+ return ndarray([size], buffer=x, dtype=int,
+ offset=offset*x.itemsize,
+ strides=strides*x.itemsize)
+ assert_equal(make_array(4, 4, -1), array([4, 3, 2, 1]))
+ self.failUnlessRaises(ValueError, make_array, 4, 4, -2)
+ self.failUnlessRaises(ValueError, make_array, 4, 2, -1)
+ self.failUnlessRaises(ValueError, make_array, 8, 3, 1)
+ #self.failUnlessRaises(ValueError, make_array, 8, 3, 0)
+ #self.failUnlessRaises(ValueError, lambda: ndarray([1], strides=4))
+
+
+ def check_set_stridesattr(self):
+ x = self.one
+ def make_array(size, offset, strides):
+ try:
+ r = ndarray([size], dtype=int, buffer=x, offset=offset*x.itemsize)
+ except:
+ pass
+ r.strides = strides=strides*x.itemsize
+ return r
+ assert_equal(make_array(4, 4, -1), array([4, 3, 2, 1]))
+ self.failUnlessRaises(ValueError, make_array, 4, 4, -2)
+ self.failUnlessRaises(ValueError, make_array, 4, 2, -1)
+ self.failUnlessRaises(ValueError, make_array, 8, 3, 1)
+ #self.failUnlessRaises(ValueError, make_array, 8, 3, 0)
+
+ def check_fill(self):
+ for t in "?bhilqpBHILQPfdgFDGO":
+ x = empty((3,2,1), t)
+ y = empty((3,2,1), t)
+ x.fill(1)
+ y[...] = 1
+ assert_equal(x,y)
+
+ x = array([(0,0.0), (1,1.0)], dtype='i4,f8')
+ x.fill(x[0])
+ assert_equal(x['f1'][1], x['f1'][0])
+
+class test_dtypedescr(NumpyTestCase):
+ def check_construction(self):
+ d1 = dtype('i4')
+ assert_equal(d1, dtype(int32))
+ d2 = dtype('f8')
+ assert_equal(d2, dtype(float64))
+
+class test_fromstring(NumpyTestCase):
+ def check_binary(self):
+ a = fromstring('\x00\x00\x80?\x00\x00\x00@\x00\x00@@\x00\x00\x80@',dtype='<f4')
+ assert_array_equal(a, array([1,2,3,4]))
+
+ def check_string(self):
+ a = fromstring('1,2,3,4', sep=',')
+ assert_array_equal(a, [1., 2., 3., 4.])
+
+ def check_counted_string(self):
+ a = fromstring('1,2,3,4', count=4, sep=',')
+ assert_array_equal(a, [1., 2., 3., 4.])
+ a = fromstring('1,2,3,4', count=3, sep=',')
+ assert_array_equal(a, [1., 2., 3.])
+
+ def check_string_with_ws(self):
+ a = fromstring('1 2 3 4 ', dtype=int, sep=' ')
+ assert_array_equal(a, [1, 2, 3, 4])
+
+ def check_counted_string_with_ws(self):
+ a = fromstring('1 2 3 4 ', count=3, dtype=int, sep=' ')
+ assert_array_equal(a, [1, 2, 3])
+
+ def check_ascii(self):
+ a = fromstring('1 , 2 , 3 , 4', sep=',')
+ b = fromstring('1,2,3,4', dtype=float, sep=',')
+ assert_array_equal(a, [1.,2.,3.,4.])
+ assert_array_equal(a,b)
+
+class test_zero_rank(NumpyTestCase):
+ def setUp(self):
+ self.d = array(0), array('x', object)
+
+ def check_ellipsis_subscript(self):
+ a,b = self.d
+ self.failUnlessEqual(a[...], 0)
+ self.failUnlessEqual(b[...], 'x')
+ self.failUnless(a[...] is a)
+ self.failUnless(b[...] is b)
+
+ def check_empty_subscript(self):
+ a,b = self.d
+ self.failUnlessEqual(a[()], 0)
+ self.failUnlessEqual(b[()], 'x')
+ self.failUnless(type(a[()]) is a.dtype.type)
+ self.failUnless(type(b[()]) is str)
+
+ def check_invalid_subscript(self):
+ a,b = self.d
+ self.failUnlessRaises(IndexError, lambda x: x[0], a)
+ self.failUnlessRaises(IndexError, lambda x: x[0], b)
+ self.failUnlessRaises(IndexError, lambda x: x[array([], int)], a)
+ self.failUnlessRaises(IndexError, lambda x: x[array([], int)], b)
+
+ def check_ellipsis_subscript_assignment(self):
+ a,b = self.d
+ a[...] = 42
+ self.failUnlessEqual(a, 42)
+ b[...] = ''
+ self.failUnlessEqual(b.item(), '')
+
+ def check_empty_subscript_assignment(self):
+ a,b = self.d
+ a[()] = 42
+ self.failUnlessEqual(a, 42)
+ b[()] = ''
+ self.failUnlessEqual(b.item(), '')
+
+ def check_invalid_subscript_assignment(self):
+ a,b = self.d
+ def assign(x, i, v):
+ x[i] = v
+ self.failUnlessRaises(IndexError, assign, a, 0, 42)
+ self.failUnlessRaises(IndexError, assign, b, 0, '')
+ self.failUnlessRaises(ValueError, assign, a, (), '')
+
+ def check_newaxis(self):
+ a,b = self.d
+ self.failUnlessEqual(a[newaxis].shape, (1,))
+ self.failUnlessEqual(a[..., newaxis].shape, (1,))
+ self.failUnlessEqual(a[newaxis, ...].shape, (1,))
+ self.failUnlessEqual(a[..., newaxis].shape, (1,))
+ self.failUnlessEqual(a[newaxis, ..., newaxis].shape, (1,1))
+ self.failUnlessEqual(a[..., newaxis, newaxis].shape, (1,1))
+ self.failUnlessEqual(a[newaxis, newaxis, ...].shape, (1,1))
+ self.failUnlessEqual(a[(newaxis,)*10].shape, (1,)*10)
+
+ def check_invalid_newaxis(self):
+ a,b = self.d
+ def subscript(x, i): x[i]
+ self.failUnlessRaises(IndexError, subscript, a, (newaxis, 0))
+ self.failUnlessRaises(IndexError, subscript, a, (newaxis,)*50)
+
+ def check_constructor(self):
+ x = ndarray(())
+ x[()] = 5
+ self.failUnlessEqual(x[()], 5)
+ y = ndarray((),buffer=x)
+ y[()] = 6
+ self.failUnlessEqual(x[()], 6)
+
+ def check_output(self):
+ x = array(2)
+ self.failUnlessRaises(ValueError, add, x, [1], x)
+
+class test_creation(NumpyTestCase):
+ def check_from_attribute(self):
+ class x(object):
+ def __array__(self, dtype=None):
+ pass
+ self.failUnlessRaises(ValueError, array, x())
+
+class test_bool(NumpyTestCase):
+ def check_test_interning(self):
+ a0 = bool_(0)
+ b0 = bool_(False)
+ self.failUnless(a0 is b0)
+ a1 = bool_(1)
+ b1 = bool_(True)
+ self.failUnless(a1 is b1)
+ self.failUnless(array([True])[0] is a1)
+ self.failUnless(array(True)[()] is a1)
+
+
+class test_methods(NumpyTestCase):
+ def check_test_round(self):
+ assert_equal(array([1.2,1.5]).round(), [1,2])
+ assert_equal(array(1.5).round(), 2)
+ assert_equal(array([12.2,15.5]).round(-1), [10,20])
+ assert_equal(array([12.15,15.51]).round(1), [12.2,15.5])
+
+ def check_transpose(self):
+ a = array([[1,2],[3,4]])
+ assert_equal(a.transpose(), [[1,3],[2,4]])
+ self.failUnlessRaises(ValueError, lambda: a.transpose(0))
+ self.failUnlessRaises(ValueError, lambda: a.transpose(0,0))
+ self.failUnlessRaises(ValueError, lambda: a.transpose(0,1,2))
+
+class test_subscripting(NumpyTestCase):
+ def check_test_zero_rank(self):
+ x = array([1,2,3])
+ self.failUnless(isinstance(x[0], int))
+ self.failUnless(type(x[0, ...]) is ndarray)
+
+class test_pickling(NumpyTestCase):
+ def check_both(self):
+ import pickle
+ carray = array([[2,9],[7,0],[3,8]])
+ tarray = transpose(carray)
+ assert_equal(carray, pickle.loads(carray.dumps()))
+ assert_equal(tarray, pickle.loads(tarray.dumps()))
+
+ # version 0 pickles, using protocol=2 to pickle
+ # version 0 doesn't have a version field
+ def check_version0_int8(self):
+ s = '\x80\x02cnumpy.core._internal\n_reconstruct\nq\x01cnumpy\nndarray\nq\x02K\x00\x85U\x01b\x87Rq\x03(K\x04\x85cnumpy\ndtype\nq\x04U\x02i1K\x00K\x01\x87Rq\x05(U\x01|NNJ\xff\xff\xff\xffJ\xff\xff\xff\xfftb\x89U\x04\x01\x02\x03\x04tb.'
+ a = array([1,2,3,4], dtype=int8)
+ p = loads(s)
+ assert_equal(a, p)
+
+ def check_version0_float32(self):
+ s = '\x80\x02cnumpy.core._internal\n_reconstruct\nq\x01cnumpy\nndarray\nq\x02K\x00\x85U\x01b\x87Rq\x03(K\x04\x85cnumpy\ndtype\nq\x04U\x02f4K\x00K\x01\x87Rq\x05(U\x01<NNJ\xff\xff\xff\xffJ\xff\xff\xff\xfftb\x89U\x10\x00\x00\x80?\x00\x00\x00@\x00\x00@@\x00\x00\x80@tb.'
+ a = array([1.0, 2.0, 3.0, 4.0], dtype=float32)
+ p = loads(s)
+ assert_equal(a, p)
+
+ def check_version0_object(self):
+ s = '\x80\x02cnumpy.core._internal\n_reconstruct\nq\x01cnumpy\nndarray\nq\x02K\x00\x85U\x01b\x87Rq\x03(K\x02\x85cnumpy\ndtype\nq\x04U\x02O8K\x00K\x01\x87Rq\x05(U\x01|NNJ\xff\xff\xff\xffJ\xff\xff\xff\xfftb\x89]q\x06(}q\x07U\x01aK\x01s}q\x08U\x01bK\x02setb.'
+ a = array([{'a':1}, {'b':2}])
+ p = loads(s)
+ assert_equal(a, p)
+
+ # version 1 pickles, using protocol=2 to pickle
+ def check_version1_int8(self):
+ s = '\x80\x02cnumpy.core._internal\n_reconstruct\nq\x01cnumpy\nndarray\nq\x02K\x00\x85U\x01b\x87Rq\x03(K\x01K\x04\x85cnumpy\ndtype\nq\x04U\x02i1K\x00K\x01\x87Rq\x05(K\x01U\x01|NNJ\xff\xff\xff\xffJ\xff\xff\xff\xfftb\x89U\x04\x01\x02\x03\x04tb.'
+ a = array([1,2,3,4], dtype=int8)
+ p = loads(s)
+ assert_equal(a, p)
+
+ def check_version1_float32(self):
+ s = '\x80\x02cnumpy.core._internal\n_reconstruct\nq\x01cnumpy\nndarray\nq\x02K\x00\x85U\x01b\x87Rq\x03(K\x01K\x04\x85cnumpy\ndtype\nq\x04U\x02f4K\x00K\x01\x87Rq\x05(K\x01U\x01<NNJ\xff\xff\xff\xffJ\xff\xff\xff\xfftb\x89U\x10\x00\x00\x80?\x00\x00\x00@\x00\x00@@\x00\x00\x80@tb.'
+ a = array([1.0, 2.0, 3.0, 4.0], dtype=float32)
+ p = loads(s)
+ assert_equal(a, p)
+
+ def check_version1_object(self):
+ s = '\x80\x02cnumpy.core._internal\n_reconstruct\nq\x01cnumpy\nndarray\nq\x02K\x00\x85U\x01b\x87Rq\x03(K\x01K\x02\x85cnumpy\ndtype\nq\x04U\x02O8K\x00K\x01\x87Rq\x05(K\x01U\x01|NNJ\xff\xff\xff\xffJ\xff\xff\xff\xfftb\x89]q\x06(}q\x07U\x01aK\x01s}q\x08U\x01bK\x02setb.'
+ a = array([{'a':1}, {'b':2}])
+ p = loads(s)
+ assert_equal(a, p)
+
+class test_fancy_indexing(NumpyTestCase):
+ def check_list(self):
+ x = ones((1,1))
+ x[:,[0]] = 2.0
+ assert_array_equal(x, array([[2.0]]))
+
+ x = ones((1,1,1))
+ x[:,:,[0]] = 2.0
+ assert_array_equal(x, array([[[2.0]]]))
+
+ def check_tuple(self):
+ x = ones((1,1))
+ x[:,(0,)] = 2.0
+ assert_array_equal(x, array([[2.0]]))
+ x = ones((1,1,1))
+ x[:,:,(0,)] = 2.0
+ assert_array_equal(x, array([[[2.0]]]))
+
+class test_string_compare(NumpyTestCase):
+ def check_string(self):
+ g1 = array(["This","is","example"])
+ g2 = array(["This","was","example"])
+ assert_array_equal(g1 == g2, [g1[i] == g2[i] for i in [0,1,2]])
+ assert_array_equal(g1 != g2, [g1[i] != g2[i] for i in [0,1,2]])
+ assert_array_equal(g1 <= g2, [g1[i] <= g2[i] for i in [0,1,2]])
+ assert_array_equal(g1 >= g2, [g1[i] >= g2[i] for i in [0,1,2]])
+ assert_array_equal(g1 < g2, [g1[i] < g2[i] for i in [0,1,2]])
+ assert_array_equal(g1 > g2, [g1[i] > g2[i] for i in [0,1,2]])
+
+ def check_mixed(self):
+ g1 = array(["spam","spa","spammer","and eggs"])
+ g2 = "spam"
+ assert_array_equal(g1 == g2, [x == g2 for x in g1])
+ assert_array_equal(g1 != g2, [x != g2 for x in g1])
+ assert_array_equal(g1 < g2, [x < g2 for x in g1])
+ assert_array_equal(g1 > g2, [x > g2 for x in g1])
+ assert_array_equal(g1 <= g2, [x <= g2 for x in g1])
+ assert_array_equal(g1 >= g2, [x >= g2 for x in g1])
+
+
+ def check_unicode(self):
+ g1 = array([u"This",u"is",u"example"])
+ g2 = array([u"This",u"was",u"example"])
+ assert_array_equal(g1 == g2, [g1[i] == g2[i] for i in [0,1,2]])
+ assert_array_equal(g1 != g2, [g1[i] != g2[i] for i in [0,1,2]])
+ assert_array_equal(g1 <= g2, [g1[i] <= g2[i] for i in [0,1,2]])
+ assert_array_equal(g1 >= g2, [g1[i] >= g2[i] for i in [0,1,2]])
+ assert_array_equal(g1 < g2, [g1[i] < g2[i] for i in [0,1,2]])
+ assert_array_equal(g1 > g2, [g1[i] > g2[i] for i in [0,1,2]])
+
+
+class test_argmax(NumpyTestCase):
+ def check_all(self):
+ a = random.normal(0,1,(4,5,6,7,8))
+ for i in xrange(a.ndim):
+ amax = a.max(i)
+ aargmax = a.argmax(i)
+ axes = range(a.ndim)
+ axes.remove(i)
+ assert all(amax == aargmax.choose(*a.transpose(i,*axes)))
+
+class test_newaxis(NumpyTestCase):
+ def check_basic(self):
+ sk = array([0,-0.1,0.1])
+ res = 250*sk[:,newaxis]
+ assert_almost_equal(res.ravel(),250*sk)
+
+class test_clip(NumpyTestCase):
+ def _check_range(self,x,cmin,cmax):
+ assert N.all(x >= cmin)
+ assert N.all(x <= cmax)
+
+ def _clip_type(self,type_group,array_max,
+ clip_min,clip_max,inplace=False,
+ expected_min=None,expected_max=None):
+ if expected_min is None:
+ expected_min = clip_min
+ if expected_max is None:
+ expected_max = clip_max
+
+ for T in N.sctypes[type_group]:
+ if sys.byteorder == 'little':
+ byte_orders = ['=','>']
+ else:
+ byte_orders = ['<','=']
+
+ for byteorder in byte_orders:
+ dtype = N.dtype(T).newbyteorder(byteorder)
+
+ x = (N.random.random(1000) * array_max).astype(dtype)
+ if inplace:
+ x.clip(clip_min,clip_max,x)
+ else:
+ x = x.clip(clip_min,clip_max)
+ byteorder = '='
+
+ if x.dtype.byteorder == '|': byteorder = '|'
+ assert_equal(x.dtype.byteorder,byteorder)
+ self._check_range(x,expected_min,expected_max)
+ return x
+
+ def check_basic(self):
+ for inplace in [False, True]:
+ self._clip_type('float',1024,-12.8,100.2, inplace=inplace)
+ self._clip_type('float',1024,0,0, inplace=inplace)
+
+ self._clip_type('int',1024,-120,100.5, inplace=inplace)
+ self._clip_type('int',1024,0,0, inplace=inplace)
+
+ x = self._clip_type('uint',1024,-120,100,expected_min=0, inplace=inplace)
+ x = self._clip_type('uint',1024,0,0, inplace=inplace)
+
+ def check_record_array(self):
+ rec = N.array([(-5, 2.0, 3.0), (5.0, 4.0, 3.0)],
+ dtype=[('x', '<f8'), ('y', '<f8'), ('z', '<f8')])
+ y = rec['x'].clip(-0.3,0.5)
+ self._check_range(y,-0.3,0.5)
+
+# Import tests from unicode
+set_local_path()
+from test_unicode import *
+from test_regression import *
+restore_path()
+
+if __name__ == "__main__":
+ NumpyTest('numpy.core.multiarray').run()
diff --git a/numpy/core/tests/test_numeric.py b/numpy/core/tests/test_numeric.py
new file mode 100644
index 000000000..f4c4431b6
--- /dev/null
+++ b/numpy/core/tests/test_numeric.py
@@ -0,0 +1,679 @@
+from numpy.core import *
+from numpy.random import rand, randint, randn
+from numpy.testing import *
+from numpy.core.multiarray import dot as dot_
+import sys
+
+class Vec:
+ def __init__(self,sequence=None):
+ if sequence is None:
+ sequence=[]
+ self.array=array(sequence)
+ def __add__(self,other):
+ out=Vec()
+ out.array=self.array+other.array
+ return out
+ def __sub__(self,other):
+ out=Vec()
+ out.array=self.array-other.array
+ return out
+ def __mul__(self,other): # with scalar
+ out=Vec(self.array.copy())
+ out.array*=other
+ return out
+ def __rmul__(self,other):
+ return self*other
+ def __abs__(self):
+ out=Vec()
+ out.array=abs(self.array)
+ return out
+ def __repr__(self):
+ return "Vec("+repr(self.array.tolist())+")"
+ __str__=__repr__
+
+class test_dot(NumpyTestCase):
+ def setUp(self):
+ self.A = rand(10,8)
+ self.b1 = rand(8,1)
+ self.b2 = rand(8)
+ self.b3 = rand(1,8)
+ self.b4 = rand(10)
+ self.N = 14
+
+ def check_matmat(self):
+ A = self.A
+ c1 = dot(A.transpose(), A)
+ c2 = dot_(A.transpose(), A)
+ assert_almost_equal(c1, c2, decimal=self.N)
+
+ def check_matvec(self):
+ A, b1 = self.A, self.b1
+ c1 = dot(A, b1)
+ c2 = dot_(A, b1)
+ assert_almost_equal(c1, c2, decimal=self.N)
+
+ def check_matvec2(self):
+ A, b2 = self.A, self.b2
+ c1 = dot(A, b2)
+ c2 = dot_(A, b2)
+ assert_almost_equal(c1, c2, decimal=self.N)
+
+ def check_vecmat(self):
+ A, b4 = self.A, self.b4
+ c1 = dot(b4, A)
+ c2 = dot_(b4, A)
+ assert_almost_equal(c1, c2, decimal=self.N)
+
+ def check_vecmat2(self):
+ b3, A = self.b3, self.A
+ c1 = dot(b3, A.transpose())
+ c2 = dot_(b3, A.transpose())
+ assert_almost_equal(c1, c2, decimal=self.N)
+
+ def check_vecmat3(self):
+ A, b4 = self.A, self.b4
+ c1 = dot(A.transpose(),b4)
+ c2 = dot_(A.transpose(),b4)
+ assert_almost_equal(c1, c2, decimal=self.N)
+
+ def check_vecvecouter(self):
+ b1, b3 = self.b1, self.b3
+ c1 = dot(b1, b3)
+ c2 = dot_(b1, b3)
+ assert_almost_equal(c1, c2, decimal=self.N)
+
+ def check_vecvecinner(self):
+ b1, b3 = self.b1, self.b3
+ c1 = dot(b3, b1)
+ c2 = dot_(b3, b1)
+ assert_almost_equal(c1, c2, decimal=self.N)
+
+ def check_matscalar(self):
+ b1 = matrix(ones((3,3),dtype=complex))
+ assert_equal(b1*1.0, b1)
+
+ def check_columnvect(self):
+ b1 = ones((3,1))
+ b2 = [5.3]
+ c1 = dot(b1,b2)
+ c2 = dot_(b1,b2)
+ assert_almost_equal(c1, c2, decimal=self.N)
+
+ def check_columnvect(self):
+ b1 = ones((3,1)).transpose()
+ b2 = [6.2]
+ c1 = dot(b2,b1)
+ c2 = dot_(b2,b1)
+ assert_almost_equal(c1, c2, decimal=self.N)
+
+ def check_vecscalar(self):
+ b1 = rand(1,1)
+ b2 = rand(1,8)
+ c1 = dot(b1,b2)
+ c2 = dot_(b1,b2)
+ assert_almost_equal(c1, c2, decimal=self.N)
+
+ def check_vecscalar2(self):
+ b1 = rand(8,1)
+ b2 = rand(1,1)
+ c1 = dot(b1,b2)
+ c2 = dot_(b1,b2)
+ assert_almost_equal(c1, c2, decimal=self.N)
+
+ def check_all(self):
+ dims = [(),(1,),(1,1)]
+ for dim1 in dims:
+ for dim2 in dims:
+ arg1 = rand(*dim1)
+ arg2 = rand(*dim2)
+ c1 = dot(arg1, arg2)
+ c2 = dot_(arg1, arg2)
+ assert (c1.shape == c2.shape)
+ assert_almost_equal(c1, c2, decimal=self.N)
+
+ def check_vecobject(self):
+ U_non_cont = transpose([[1.,1.],[1.,2.]])
+ U_cont = ascontiguousarray(U_non_cont)
+ x = array([Vec([1.,0.]),Vec([0.,1.])])
+ zeros = array([Vec([0.,0.]),Vec([0.,0.])])
+ zeros_test = dot(U_cont,x) - dot(U_non_cont,x)
+ assert_equal(zeros[0].array, zeros_test[0].array)
+ assert_equal(zeros[1].array, zeros_test[1].array)
+
+
+class test_bool_scalar(NumpyTestCase):
+ def test_logical(self):
+ f = False_
+ t = True_
+ s = "xyz"
+ self.failUnless((t and s) is s)
+ self.failUnless((f and s) is f)
+
+ def test_bitwise_or(self):
+ f = False_
+ t = True_
+ self.failUnless((t | t) is t)
+ self.failUnless((f | t) is t)
+ self.failUnless((t | f) is t)
+ self.failUnless((f | f) is f)
+
+ def test_bitwise_and(self):
+ f = False_
+ t = True_
+ self.failUnless((t & t) is t)
+ self.failUnless((f & t) is f)
+ self.failUnless((t & f) is f)
+ self.failUnless((f & f) is f)
+
+ def test_bitwise_xor(self):
+ f = False_
+ t = True_
+ self.failUnless((t ^ t) is f)
+ self.failUnless((f ^ t) is t)
+ self.failUnless((t ^ f) is t)
+ self.failUnless((f ^ f) is f)
+
+
+class test_seterr(NumpyTestCase):
+ def test_set(self):
+ err = seterr()
+ old = seterr(divide='warn')
+ self.failUnless(err == old)
+ new = seterr()
+ self.failUnless(new['divide'] == 'warn')
+ seterr(over='raise')
+ self.failUnless(geterr()['over'] == 'raise')
+ self.failUnless(new['divide'] == 'warn')
+ seterr(**old)
+ self.failUnless(geterr() == old)
+ def test_divideerr(self):
+ seterr(divide='raise')
+ try:
+ array([1.]) / array([0.])
+ except FloatingPointError:
+ pass
+ else:
+ self.fail()
+ seterr(divide='ignore')
+ array([1.]) / array([0.])
+
+
+class test_fromiter(NumpyTestCase):
+
+ def makegen(self):
+ for x in xrange(24):
+ yield x**2
+
+ def test_types(self):
+ ai32 = fromiter(self.makegen(), int32)
+ ai64 = fromiter(self.makegen(), int64)
+ af = fromiter(self.makegen(), float)
+ self.failUnless(ai32.dtype == dtype(int32))
+ self.failUnless(ai64.dtype == dtype(int64))
+ self.failUnless(af.dtype == dtype(float))
+
+ def test_lengths(self):
+ expected = array(list(self.makegen()))
+ a = fromiter(self.makegen(), int)
+ a20 = fromiter(self.makegen(), int, 20)
+ self.failUnless(len(a) == len(expected))
+ self.failUnless(len(a20) == 20)
+ try:
+ fromiter(self.makegen(), int, len(expected) + 10)
+ except ValueError:
+ pass
+ else:
+ self.fail()
+
+ def test_values(self):
+ expected = array(list(self.makegen()))
+ a = fromiter(self.makegen(), int)
+ a20 = fromiter(self.makegen(), int, 20)
+ self.failUnless(alltrue(a == expected,axis=0))
+ self.failUnless(alltrue(a20 == expected[:20],axis=0))
+
+class test_index(NumpyTestCase):
+ def test_boolean(self):
+ a = rand(3,5,8)
+ V = rand(5,8)
+ g1 = randint(0,5,size=15)
+ g2 = randint(0,8,size=15)
+ V[g1,g2] = -V[g1,g2]
+ assert (array([a[0][V>0],a[1][V>0],a[2][V>0]]) == a[:,V>0]).all()
+
+class test_binary_repr(NumpyTestCase):
+ def test_zero(self):
+ assert_equal(binary_repr(0),'0')
+
+ def test_large(self):
+ assert_equal(binary_repr(10736848),'101000111101010011010000')
+
+ def test_negative(self):
+ assert_equal(binary_repr(-1), '-1')
+ assert_equal(binary_repr(-1, width=8), '11111111')
+
+def assert_array_strict_equal(x, y):
+ assert_array_equal(x, y)
+ # Check flags
+ assert x.flags == y.flags
+ # check endianness
+ assert x.dtype.isnative == y.dtype.isnative
+
+
+class test_clip(NumpyTestCase):
+ def setUp(self):
+ self.nr = 5
+ self.nc = 3
+
+ def fastclip(self, a, m, M, out=None):
+ if out is None:
+ return a.clip(m,M)
+ else:
+ return a.clip(m,M,out)
+
+ def clip(self, a, m, M, out=None):
+ # use slow-clip
+ selector = less(a, m)+2*greater(a, M)
+ return selector.choose((a, m, M), out=out)
+
+ # Handy functions
+ def _generate_data(self, n, m):
+ return randn(n, m)
+
+ def _generate_data_complex(self, n, m):
+ return randn(n, m) + 1.j *rand(n, m)
+
+ def _generate_flt_data(self, n, m):
+ return (randn(n, m)).astype(float32)
+
+ def _neg_byteorder(self, a):
+ import sys
+ a = asarray(a)
+ if sys.byteorder == 'little':
+ a = a.astype(a.dtype.newbyteorder('>'))
+ else:
+ a = a.astype(a.dtype.newbyteorder('<'))
+ return a
+
+ def _generate_non_native_data(self, n, m):
+ data = randn(n, m)
+ data = self._neg_byteorder(data)
+ assert not data.dtype.isnative
+ return data
+
+ def _generate_int_data(self, n, m):
+ return (10 * rand(n, m)).astype(int64)
+
+ def _generate_int32_data(self, n, m):
+ return (10 * rand(n, m)).astype(int32)
+
+ # Now the real test cases
+ def test_simple_double(self):
+ """Test native double input with scalar min/max."""
+ a = self._generate_data(self.nr, self.nc)
+ m = 0.1
+ M = 0.6
+ ac = self.fastclip(a, m, M)
+ act = self.clip(a, m, M)
+ assert_array_strict_equal(ac, act)
+
+ def test_simple_int(self):
+ """Test native int input with scalar min/max."""
+ a = self._generate_int_data(self.nr, self.nc)
+ a = a.astype(int)
+ m = -2
+ M = 4
+ ac = self.fastclip(a, m, M)
+ act = self.clip(a, m, M)
+ assert_array_strict_equal(ac, act)
+
+ def test_array_double(self):
+ """Test native double input with array min/max."""
+ a = self._generate_data(self.nr, self.nc)
+ m = zeros(a.shape)
+ M = m + 0.5
+ ac = self.fastclip(a, m, M)
+ act = self.clip(a, m, M)
+ assert_array_strict_equal(ac, act)
+
+ def test_simple_nonnative(self):
+ """Test non native double input with scalar min/max.
+ Test native double input with non native double scalar min/max."""
+ a = self._generate_non_native_data(self.nr, self.nc)
+ m = -0.5
+ M = 0.6
+ ac = self.fastclip(a, m, M)
+ act = self.clip(a, m, M)
+ assert_array_equal(ac, act)
+
+ "Test native double input with non native double scalar min/max."
+ a = self._generate_data(self.nr, self.nc)
+ m = -0.5
+ M = self._neg_byteorder(0.6)
+ assert not M.dtype.isnative
+ ac = self.fastclip(a, m, M)
+ act = self.clip(a, m, M)
+ assert_array_equal(ac, act)
+
+ def test_simple_complex(self):
+ """Test native complex input with native double scalar min/max.
+ Test native input with complex double scalar min/max.
+ """
+ a = 3 * self._generate_data_complex(self.nr, self.nc)
+ m = -0.5
+ M = 1.
+ ac = self.fastclip(a, m, M)
+ act = self.clip(a, m, M)
+ assert_array_strict_equal(ac, act)
+
+ "Test native input with complex double scalar min/max."
+ a = 3 * self._generate_data(self.nr, self.nc)
+ m = -0.5 + 1.j
+ M = 1. + 2.j
+ ac = self.fastclip(a, m, M)
+ act = self.clip(a, m, M)
+ assert_array_strict_equal(ac, act)
+
+ def test_clip_non_contig(self):
+ """Test clip for non contiguous native input and native scalar min/max."""
+ a = self._generate_data(self.nr * 2, self.nc * 3)
+ a = a[::2, ::3]
+ assert not a.flags['F_CONTIGUOUS']
+ assert not a.flags['C_CONTIGUOUS']
+ ac = self.fastclip(a, -1.6, 1.7)
+ act = self.clip(a, -1.6, 1.7)
+ assert_array_strict_equal(ac, act)
+
+ def test_simple_out(self):
+ """Test native double input with scalar min/max."""
+ a = self._generate_data(self.nr, self.nc)
+ m = -0.5
+ M = 0.6
+ ac = zeros(a.shape)
+ act = zeros(a.shape)
+ self.fastclip(a, m, M, ac)
+ self.clip(a, m, M, act)
+ assert_array_strict_equal(ac, act)
+
+ def test_simple_int32_inout(self):
+ """Test native int32 input with double min/max and int32 out."""
+ a = self._generate_int32_data(self.nr, self.nc)
+ m = float64(0)
+ M = float64(2)
+ ac = zeros(a.shape, dtype = int32)
+ act = ac.copy()
+ self.fastclip(a, m, M, ac)
+ self.clip(a, m, M, act)
+ assert_array_strict_equal(ac, act)
+
+ def test_simple_int64_out(self):
+ """Test native int32 input with int32 scalar min/max and int64 out."""
+ a = self._generate_int32_data(self.nr, self.nc)
+ m = int32(-1)
+ M = int32(1)
+ ac = zeros(a.shape, dtype = int64)
+ act = ac.copy()
+ self.fastclip(a, m, M, ac)
+ self.clip(a, m, M, act)
+ assert_array_strict_equal(ac, act)
+
+ def test_simple_int64_inout(self):
+ """Test native in32 input with double array min/max and int32 out."""
+ a = self._generate_int32_data(self.nr, self.nc)
+ m = zeros(a.shape, float64)
+ M = float64(1)
+ ac = zeros(a.shape, dtype = int32)
+ act = ac.copy()
+ self.fastclip(a, m, M, ac)
+ self.clip(a, m, M, act)
+ assert_array_strict_equal(ac, act)
+
+ def test_simple_int32_out(self):
+ """Test native double input with scalar min/max and int out."""
+ a = self._generate_data(self.nr, self.nc)
+ m = -1.0
+ M = 2.0
+ ac = zeros(a.shape, dtype = int32)
+ act = ac.copy()
+ self.fastclip(a, m, M, ac)
+ self.clip(a, m, M, act)
+ assert_array_strict_equal(ac, act)
+
+ def test_simple_inplace_01(self):
+ """Test native double input with array min/max in-place."""
+ a = self._generate_data(self.nr, self.nc)
+ ac = a.copy()
+ m = zeros(a.shape)
+ M = 1.0
+ self.fastclip(a, m, M, a)
+ self.clip(a, m, M, ac)
+ assert_array_strict_equal(a, ac)
+
+ def test_simple_inplace_02(self):
+ """Test native double input with scalar min/max in-place."""
+ a = self._generate_data(self.nr, self.nc)
+ ac = a.copy()
+ m = -0.5
+ M = 0.6
+ self.fastclip(a, m, M, a)
+ self.clip(a, m, M, ac)
+ assert_array_strict_equal(a, ac)
+
+ def test_noncontig_inplace(self):
+ """Test non contiguous double input with double scalar min/max in-place."""
+ a = self._generate_data(self.nr * 2, self.nc * 3)
+ a = a[::2, ::3]
+ assert not a.flags['F_CONTIGUOUS']
+ assert not a.flags['C_CONTIGUOUS']
+ ac = a.copy()
+ m = -0.5
+ M = 0.6
+ self.fastclip(a, m, M, a)
+ self.clip(a, m, M, ac)
+ assert_array_equal(a, ac)
+
+ def test_type_cast_01(self):
+ "Test native double input with scalar min/max."
+ a = self._generate_data(self.nr, self.nc)
+ m = -0.5
+ M = 0.6
+ ac = self.fastclip(a, m, M)
+ act = self.clip(a, m, M)
+ assert_array_strict_equal(ac, act)
+
+ def test_type_cast_02(self):
+ "Test native int32 input with int32 scalar min/max."
+ a = self._generate_int_data(self.nr, self.nc)
+ a = a.astype(int32)
+ m = -2
+ M = 4
+ ac = self.fastclip(a, m, M)
+ act = self.clip(a, m, M)
+ assert_array_strict_equal(ac, act)
+
+ def test_type_cast_03(self):
+ "Test native int32 input with float64 scalar min/max."
+ a = self._generate_int32_data(self.nr, self.nc)
+ m = -2
+ M = 4
+ ac = self.fastclip(a, float64(m), float64(M))
+ act = self.clip(a, float64(m), float64(M))
+ assert_array_strict_equal(ac, act)
+
+ def test_type_cast_04(self):
+ "Test native int32 input with float32 scalar min/max."
+ a = self._generate_int32_data(self.nr, self.nc)
+ m = float32(-2)
+ M = float32(4)
+ act = self.fastclip(a,m,M)
+ ac = self.clip(a,m,M)
+ assert_array_strict_equal(ac, act)
+
+ def test_type_cast_04(self):
+ "Test native int32 with double arrays min/max."
+ a = self._generate_int_data(self.nr, self.nc)
+ m = -0.5
+ M = 1.
+ ac = self.fastclip(a, m * zeros(a.shape), M)
+ act = self.clip(a, m * zeros(a.shape), M)
+ assert_array_strict_equal(ac, act)
+
+ def test_type_cast_05(self):
+ "Test native with NON native scalar min/max."
+ a = self._generate_data(self.nr, self.nc)
+ m = 0.5
+ m_s = self._neg_byteorder(m)
+ M = 1.
+ act = self.clip(a, m_s, M)
+ ac = self.fastclip(a, m_s, M)
+ assert_array_strict_equal(ac, act)
+
+ def test_type_cast_06(self):
+ "Test NON native with native array min/max."
+ a = self._generate_data(self.nr, self.nc)
+ m = -0.5 * ones(a.shape)
+ M = 1.
+ a_s = self._neg_byteorder(a)
+ assert not a_s.dtype.isnative
+ act = a_s.clip(m, M)
+ ac = self.fastclip(a_s, m, M)
+ assert_array_strict_equal(ac, act)
+
+ def test_type_cast_07(self):
+ "Test NON native with native scalar min/max."
+ a = self._generate_data(self.nr, self.nc)
+ m = -0.5
+ M = 1.
+ a_s = self._neg_byteorder(a)
+ assert not a_s.dtype.isnative
+ ac = self.fastclip(a_s, m , M)
+ act = a_s.clip(m, M)
+ assert_array_strict_equal(ac, act)
+
+ def test_type_cast_08(self):
+ "Test native with NON native array min/max."
+ a = self._generate_data(self.nr, self.nc)
+ m = -0.5 * ones(a.shape)
+ M = 1.
+ m_s = self._neg_byteorder(m)
+ assert not m_s.dtype.isnative
+ ac = self.fastclip(a, m_s , M)
+ act = self.clip(a, m_s, M)
+ assert_array_strict_equal(ac, act)
+
+ def test_type_cast_09(self):
+ """Test native int32 with float min/max and float out for output argument."""
+ a = self._generate_int_data(self.nr, self.nc)
+ b = zeros(a.shape, dtype = float32)
+ m = float32(-0.5)
+ M = float32(1)
+ act = self.clip(a, m, M, out = b)
+ ac = self.fastclip(a, m , M, out = b)
+ assert_array_strict_equal(ac, act)
+
+ def test_type_cast_10(self):
+ "Test non native with native scalar, min/max, out non native"
+ a = self._generate_non_native_data(self.nr, self.nc)
+ b = a.copy()
+ b = b.astype(b.dtype.newbyteorder('>'))
+ bt = b.copy()
+ m = -0.5
+ M = 1.
+ self.fastclip(a, m , M, out = b)
+ self.clip(a, m, M, out = bt)
+ assert_array_strict_equal(b, bt)
+
+ def test_type_cast_11(self):
+ "Test native int32 input and min/max and float out"
+ a = self._generate_int_data(self.nr, self.nc)
+ b = zeros(a.shape, dtype = float32)
+ m = int32(0)
+ M = int32(1)
+ act = self.clip(a, m, M, out = b)
+ ac = self.fastclip(a, m , M, out = b)
+ assert_array_strict_equal(ac, act)
+
+ def test_clip_with_out_simple(self):
+ "Test native double input with scalar min/max"
+ a = self._generate_data(self.nr, self.nc)
+ m = -0.5
+ M = 0.6
+ ac = zeros(a.shape)
+ act = zeros(a.shape)
+ self.fastclip(a, m, M, ac)
+ self.clip(a, m, M, act)
+ assert_array_strict_equal(ac, act)
+
+ def test_clip_with_out_simple2(self):
+ "Test native int32 input with double min/max and int32 out"
+ a = self._generate_int32_data(self.nr, self.nc)
+ m = float64(0)
+ M = float64(2)
+ ac = zeros(a.shape, dtype = int32)
+ act = ac.copy()
+ self.fastclip(a, m, M, ac)
+ self.clip(a, m, M, act)
+ assert_array_strict_equal(ac, act)
+
+ def test_clip_with_out_simple_int32(self):
+ "Test native int32 input with int32 scalar min/max and int64 out"
+ a = self._generate_int32_data(self.nr, self.nc)
+ m = int32(-1)
+ M = int32(1)
+ ac = zeros(a.shape, dtype = int64)
+ act = ac.copy()
+ self.fastclip(a, m, M, ac)
+ self.clip(a, m, M, act)
+ assert_array_strict_equal(ac, act)
+
+ def test_clip_with_out_array_int32(self):
+ "Test native int32 input with double array min/max and int32 out"
+ a = self._generate_int32_data(self.nr, self.nc)
+ m = zeros(a.shape, float64)
+ M = float64(1)
+ ac = zeros(a.shape, dtype = int32)
+ act = ac.copy()
+ self.fastclip(a, m, M, ac)
+ self.clip(a, m, M, act)
+ assert_array_strict_equal(ac, act)
+
+ def test_clip_with_out_array_outint32(self):
+ "Test native double input with scalar min/max and int out"
+ a = self._generate_data(self.nr, self.nc)
+ m = -1.0
+ M = 2.0
+ ac = zeros(a.shape, dtype = int32)
+ act = ac.copy()
+ self.fastclip(a, m, M, ac)
+ self.clip(a, m, M, act)
+ assert_array_strict_equal(ac, act)
+
+ def test_clip_inplace_array(self):
+ "Test native double input with array min/max"
+ a = self._generate_data(self.nr, self.nc)
+ ac = a.copy()
+ m = zeros(a.shape)
+ M = 1.0
+ self.fastclip(a, m, M, a)
+ self.clip(a, m, M, ac)
+ assert_array_strict_equal(a, ac)
+
+ def test_clip_inplace_simple(self):
+ "Test native double input with scalar min/max"
+ a = self._generate_data(self.nr, self.nc)
+ ac = a.copy()
+ m = -0.5
+ M = 0.6
+ self.fastclip(a, m, M, a)
+ self.clip(a, m, M, ac)
+ assert_array_strict_equal(a, ac)
+
+
+import sys
+if sys.version_info[:2] >= (2, 5):
+ set_local_path()
+ from test_errstate import *
+ restore_path()
+
+if __name__ == '__main__':
+ NumpyTest().run()
diff --git a/numpy/core/tests/test_numerictypes.py b/numpy/core/tests/test_numerictypes.py
new file mode 100644
index 000000000..b6a7f6202
--- /dev/null
+++ b/numpy/core/tests/test_numerictypes.py
@@ -0,0 +1,342 @@
+import sys
+from numpy.testing import *
+import numpy
+from numpy import zeros, ones, array
+
+
+# This is the structure of the table used for plain objects:
+#
+# +-+-+-+
+# |x|y|z|
+# +-+-+-+
+
+# Structure of a plain array description:
+Pdescr = [
+ ('x', 'i4', (2,)),
+ ('y', 'f8', (2, 2)),
+ ('z', 'u1')]
+
+# A plain list of tuples with values for testing:
+PbufferT = [
+ # x y z
+ ([3,2], [[6.,4.],[6.,4.]], 8),
+ ([4,3], [[7.,5.],[7.,5.]], 9),
+ ]
+
+
+# This is the structure of the table used for nested objects (DON'T PANIC!):
+#
+# +-+---------------------------------+-----+----------+-+-+
+# |x|Info |color|info |y|z|
+# | +-----+--+----------------+----+--+ +----+-----+ | |
+# | |value|y2|Info2 |name|z2| |Name|Value| | |
+# | | | +----+-----+--+--+ | | | | | | |
+# | | | |name|value|y3|z3| | | | | | | |
+# +-+-----+--+----+-----+--+--+----+--+-----+----+-----+-+-+
+#
+
+# The corresponding nested array description:
+Ndescr = [
+ ('x', 'i4', (2,)),
+ ('Info', [
+ ('value', 'c16'),
+ ('y2', 'f8'),
+ ('Info2', [
+ ('name', 'S2'),
+ ('value', 'c16', (2,)),
+ ('y3', 'f8', (2,)),
+ ('z3', 'u4', (2,))]),
+ ('name', 'S2'),
+ ('z2', 'b1')]),
+ ('color', 'S2'),
+ ('info', [
+ ('Name', 'U8'),
+ ('Value', 'c16')]),
+ ('y', 'f8', (2, 2)),
+ ('z', 'u1')]
+
+NbufferT = [
+ # x Info color info y z
+ # value y2 Info2 name z2 Name Value
+ # name value y3 z3
+ ([3,2], (6j, 6., ('nn', [6j,4j], [6.,4.], [1,2]), 'NN', True), 'cc', ('NN', 6j), [[6.,4.],[6.,4.]], 8),
+ ([4,3], (7j, 7., ('oo', [7j,5j], [7.,5.], [2,1]), 'OO', False), 'dd', ('OO', 7j), [[7.,5.],[7.,5.]], 9),
+ ]
+
+
+byteorder = {'little':'<', 'big':'>'}[sys.byteorder]
+
+def normalize_descr(descr):
+ "Normalize a description adding the platform byteorder."
+
+ out = []
+ for item in descr:
+ dtype = item[1]
+ if isinstance(dtype, str):
+ if dtype[0] not in ['|','<','>']:
+ onebyte = dtype[1:] == "1"
+ if onebyte or dtype[0] in ['S', 'V', 'b']:
+ dtype = "|" + dtype
+ else:
+ dtype = byteorder + dtype
+ if len(item) > 2 and item[2] > 1:
+ nitem = (item[0], dtype, item[2])
+ else:
+ nitem = (item[0], dtype)
+ out.append(nitem)
+ elif isinstance(item[1], list):
+ l = []
+ for j in normalize_descr(item[1]):
+ l.append(j)
+ out.append((item[0], l))
+ else:
+ raise ValueError("Expected a str or list and got %s" % \
+ (type(item)))
+ return out
+
+
+############################################################
+# Creation tests
+############################################################
+
+class create_zeros:
+ """Check the creation of heterogeneous arrays zero-valued"""
+
+ def check_zeros0D(self):
+ """Check creation of 0-dimensional objects"""
+ h = zeros((), dtype=self._descr)
+ self.assert_(normalize_descr(self._descr) == h.dtype.descr)
+ self.assert_(h.dtype.fields['x'][0].name[:4] == 'void')
+ self.assert_(h.dtype.fields['x'][0].char == 'V')
+ self.assert_(h.dtype.fields['x'][0].type == numpy.void)
+ # A small check that data is ok
+ assert_equal(h['z'], zeros((), dtype='u1'))
+
+ def check_zerosSD(self):
+ """Check creation of single-dimensional objects"""
+ h = zeros((2,), dtype=self._descr)
+ self.assert_(normalize_descr(self._descr) == h.dtype.descr)
+ self.assert_(h.dtype['y'].name[:4] == 'void')
+ self.assert_(h.dtype['y'].char == 'V')
+ self.assert_(h.dtype['y'].type == numpy.void)
+ # A small check that data is ok
+ assert_equal(h['z'], zeros((2,), dtype='u1'))
+
+ def check_zerosMD(self):
+ """Check creation of multi-dimensional objects"""
+ h = zeros((2,3), dtype=self._descr)
+ self.assert_(normalize_descr(self._descr) == h.dtype.descr)
+ self.assert_(h.dtype['z'].name == 'uint8')
+ self.assert_(h.dtype['z'].char == 'B')
+ self.assert_(h.dtype['z'].type == numpy.uint8)
+ # A small check that data is ok
+ assert_equal(h['z'], zeros((2,3), dtype='u1'))
+
+
+class test_create_zeros_plain(create_zeros, NumpyTestCase):
+ """Check the creation of heterogeneous arrays zero-valued (plain)"""
+ _descr = Pdescr
+
+class test_create_zeros_nested(create_zeros, NumpyTestCase):
+ """Check the creation of heterogeneous arrays zero-valued (nested)"""
+ _descr = Ndescr
+
+
+class create_values:
+ """Check the creation of heterogeneous arrays with values"""
+
+ def check_tuple(self):
+ """Check creation from tuples"""
+ h = array(self._buffer, dtype=self._descr)
+ self.assert_(normalize_descr(self._descr) == h.dtype.descr)
+ if self.multiple_rows:
+ self.assert_(h.shape == (2,))
+ else:
+ self.assert_(h.shape == ())
+
+ def check_list_of_tuple(self):
+ """Check creation from list of tuples"""
+ h = array([self._buffer], dtype=self._descr)
+ self.assert_(normalize_descr(self._descr) == h.dtype.descr)
+ if self.multiple_rows:
+ self.assert_(h.shape == (1,2))
+ else:
+ self.assert_(h.shape == (1,))
+
+ def check_list_of_list_of_tuple(self):
+ """Check creation from list of list of tuples"""
+ h = array([[self._buffer]], dtype=self._descr)
+ self.assert_(normalize_descr(self._descr) == h.dtype.descr)
+ if self.multiple_rows:
+ self.assert_(h.shape == (1,1,2))
+ else:
+ self.assert_(h.shape == (1,1))
+
+
+class test_create_values_plain_single(create_values, NumpyTestCase):
+ """Check the creation of heterogeneous arrays (plain, single row)"""
+ _descr = Pdescr
+ multiple_rows = 0
+ _buffer = PbufferT[0]
+
+class test_create_values_plain_multiple(create_values, NumpyTestCase):
+ """Check the creation of heterogeneous arrays (plain, multiple rows)"""
+ _descr = Pdescr
+ multiple_rows = 1
+ _buffer = PbufferT
+
+class test_create_values_nested_single(create_values, NumpyTestCase):
+ """Check the creation of heterogeneous arrays (nested, single row)"""
+ _descr = Ndescr
+ multiple_rows = 0
+ _buffer = NbufferT[0]
+
+class test_create_values_nested_multiple(create_values, NumpyTestCase):
+ """Check the creation of heterogeneous arrays (nested, multiple rows)"""
+ _descr = Ndescr
+ multiple_rows = 1
+ _buffer = NbufferT
+
+
+############################################################
+# Reading tests
+############################################################
+
+class read_values_plain:
+ """Check the reading of values in heterogeneous arrays (plain)"""
+
+ def check_access_fields(self):
+ h = array(self._buffer, dtype=self._descr)
+ if not self.multiple_rows:
+ self.assert_(h.shape == ())
+ assert_equal(h['x'], array(self._buffer[0], dtype='i4'))
+ assert_equal(h['y'], array(self._buffer[1], dtype='f8'))
+ assert_equal(h['z'], array(self._buffer[2], dtype='u1'))
+ else:
+ self.assert_(len(h) == 2)
+ assert_equal(h['x'], array([self._buffer[0][0],
+ self._buffer[1][0]], dtype='i4'))
+ assert_equal(h['y'], array([self._buffer[0][1],
+ self._buffer[1][1]], dtype='f8'))
+ assert_equal(h['z'], array([self._buffer[0][2],
+ self._buffer[1][2]], dtype='u1'))
+
+
+class test_read_values_plain_single(read_values_plain, NumpyTestCase):
+ """Check the creation of heterogeneous arrays (plain, single row)"""
+ _descr = Pdescr
+ multiple_rows = 0
+ _buffer = PbufferT[0]
+
+class test_read_values_plain_multiple(read_values_plain, NumpyTestCase):
+ """Check the values of heterogeneous arrays (plain, multiple rows)"""
+ _descr = Pdescr
+ multiple_rows = 1
+ _buffer = PbufferT
+
+class read_values_nested:
+ """Check the reading of values in heterogeneous arrays (nested)"""
+
+
+ def check_access_top_fields(self):
+ """Check reading the top fields of a nested array"""
+ h = array(self._buffer, dtype=self._descr)
+ if not self.multiple_rows:
+ self.assert_(h.shape == ())
+ assert_equal(h['x'], array(self._buffer[0], dtype='i4'))
+ assert_equal(h['y'], array(self._buffer[4], dtype='f8'))
+ assert_equal(h['z'], array(self._buffer[5], dtype='u1'))
+ else:
+ self.assert_(len(h) == 2)
+ assert_equal(h['x'], array([self._buffer[0][0],
+ self._buffer[1][0]], dtype='i4'))
+ assert_equal(h['y'], array([self._buffer[0][4],
+ self._buffer[1][4]], dtype='f8'))
+ assert_equal(h['z'], array([self._buffer[0][5],
+ self._buffer[1][5]], dtype='u1'))
+
+
+ def check_nested1_acessors(self):
+ """Check reading the nested fields of a nested array (1st level)"""
+ h = array(self._buffer, dtype=self._descr)
+ if not self.multiple_rows:
+ assert_equal(h['Info']['value'],
+ array(self._buffer[1][0], dtype='c16'))
+ assert_equal(h['Info']['y2'],
+ array(self._buffer[1][1], dtype='f8'))
+ assert_equal(h['info']['Name'],
+ array(self._buffer[3][0], dtype='U2'))
+ assert_equal(h['info']['Value'],
+ array(self._buffer[3][1], dtype='c16'))
+ else:
+ assert_equal(h['Info']['value'],
+ array([self._buffer[0][1][0],
+ self._buffer[1][1][0]],
+ dtype='c16'))
+ assert_equal(h['Info']['y2'],
+ array([self._buffer[0][1][1],
+ self._buffer[1][1][1]],
+ dtype='f8'))
+ assert_equal(h['info']['Name'],
+ array([self._buffer[0][3][0],
+ self._buffer[1][3][0]],
+ dtype='U2'))
+ assert_equal(h['info']['Value'],
+ array([self._buffer[0][3][1],
+ self._buffer[1][3][1]],
+ dtype='c16'))
+
+ def check_nested2_acessors(self):
+ """Check reading the nested fields of a nested array (2nd level)"""
+ h = array(self._buffer, dtype=self._descr)
+ if not self.multiple_rows:
+ assert_equal(h['Info']['Info2']['value'],
+ array(self._buffer[1][2][1], dtype='c16'))
+ assert_equal(h['Info']['Info2']['z3'],
+ array(self._buffer[1][2][3], dtype='u4'))
+ else:
+ assert_equal(h['Info']['Info2']['value'],
+ array([self._buffer[0][1][2][1],
+ self._buffer[1][1][2][1]],
+ dtype='c16'))
+ assert_equal(h['Info']['Info2']['z3'],
+ array([self._buffer[0][1][2][3],
+ self._buffer[1][1][2][3]],
+ dtype='u4'))
+
+ def check_nested1_descriptor(self):
+ """Check access nested descriptors of a nested array (1st level)"""
+ h = array(self._buffer, dtype=self._descr)
+ self.assert_(h.dtype['Info']['value'].name == 'complex128')
+ self.assert_(h.dtype['Info']['y2'].name == 'float64')
+ self.assert_(h.dtype['info']['Name'].name == 'unicode256')
+ self.assert_(h.dtype['info']['Value'].name == 'complex128')
+
+ def check_nested2_descriptor(self):
+ """Check access nested descriptors of a nested array (2nd level)"""
+ h = array(self._buffer, dtype=self._descr)
+ self.assert_(h.dtype['Info']['Info2']['value'].name == 'void256')
+ self.assert_(h.dtype['Info']['Info2']['z3'].name == 'void64')
+
+
+class test_read_values_nested_single(read_values_nested, NumpyTestCase):
+ """Check the values of heterogeneous arrays (nested, single row)"""
+ _descr = Ndescr
+ multiple_rows = False
+ _buffer = NbufferT[0]
+
+class test_read_values_nested_multiple(read_values_nested, NumpyTestCase):
+ """Check the values of heterogeneous arrays (nested, multiple rows)"""
+ _descr = Ndescr
+ multiple_rows = True
+ _buffer = NbufferT
+
+class test_empty_field(NumpyTestCase):
+ def check_assign(self):
+ a = numpy.arange(10, dtype=numpy.float32)
+ a.dtype = [("int", "<0i4"),("float", "<2f4")]
+ assert(a['int'].shape == (5,0))
+ assert(a['float'].shape == (5,2))
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/core/tests/test_records.py b/numpy/core/tests/test_records.py
new file mode 100644
index 000000000..c1eca7b58
--- /dev/null
+++ b/numpy/core/tests/test_records.py
@@ -0,0 +1,89 @@
+
+from numpy.testing import *
+set_package_path()
+import os as _os
+import numpy.core;reload(numpy.core)
+from numpy.core import *
+restore_path()
+
+class test_fromrecords(NumpyTestCase):
+ def check_fromrecords(self):
+ r = rec.fromrecords([[456,'dbe',1.2],[2,'de',1.3]],names='col1,col2,col3')
+ assert_equal(r[0].item(),(456, 'dbe', 1.2))
+
+ def check_method_array(self):
+ r = rec.array('abcdefg'*100,formats='i2,a3,i4',shape=3,byteorder='big')
+ assert_equal(r[1].item(),(25444, 'efg', 1633837924))
+
+ def check_method_array2(self):
+ r=rec.array([(1,11,'a'),(2,22,'b'),(3,33,'c'),(4,44,'d'),(5,55,'ex'),(6,66,'f'),(7,77,'g')],formats='u1,f4,a1')
+ assert_equal(r[1].item(),(2, 22.0, 'b'))
+
+ def check_recarray_slices(self):
+ r=rec.array([(1,11,'a'),(2,22,'b'),(3,33,'c'),(4,44,'d'),(5,55,'ex'),(6,66,'f'),(7,77,'g')],formats='u1,f4,a1')
+ assert_equal(r[1::2][1].item(),(4, 44.0, 'd'))
+
+ def check_recarray_fromarrays(self):
+ x1 = array([1,2,3,4])
+ x2 = array(['a','dd','xyz','12'])
+ x3 = array([1.1,2,3,4])
+ r = rec.fromarrays([x1,x2,x3],names='a,b,c')
+ assert_equal(r[1].item(),(2,'dd',2.0))
+ x1[1] = 34
+ assert_equal(r.a,array([1,2,3,4]))
+
+ def check_recarray_fromfile(self):
+ __path__ = _os.path.split(__file__)
+ filename = _os.path.join(__path__[0], "testdata.fits")
+ fd = open(filename)
+ fd.seek(2880*2)
+ r = rec.fromfile(fd, formats='f8,i4,a5', shape=3, byteorder='big')
+
+ def check_recarray_from_obj(self):
+ count = 10
+ a = zeros(count, dtype='O')
+ b = zeros(count, dtype='f8')
+ c = zeros(count, dtype='f8')
+ for i in range(len(a)):
+ a[i] = range(1,10)
+
+ mine = numpy.rec.fromarrays([a,b,c],
+ names='date,data1,data2')
+ for i in range(len(a)):
+ assert(mine.date[i]==range(1,10))
+ assert(mine.data1[i]==0.0)
+ assert(mine.data2[i]==0.0)
+
+ def check_recarray_from_names(self):
+ ra = rec.array([
+ (1, 'abc', 3.7000002861022949, 0),
+ (2, 'xy', 6.6999998092651367, 1),
+ (0, ' ', 0.40000000596046448, 0)],
+ names='c1, c2, c3, c4')
+ pa = rec.fromrecords([
+ (1, 'abc', 3.7000002861022949, 0),
+ (2, 'xy', 6.6999998092651367, 1),
+ (0, ' ', 0.40000000596046448, 0)],
+ names='c1, c2, c3, c4')
+ assert ra.dtype == pa.dtype
+ assert ra.shape == pa.shape
+ for k in xrange(len(ra)):
+ assert ra[k].item() == pa[k].item()
+
+ def check_recarray_conflict_fields(self):
+ ra = rec.array([(1,'abc',2.3),(2,'xyz',4.2),
+ (3,'wrs',1.3)],
+ names='field, shape, mean')
+ ra.mean = [1.1,2.2,3.3]
+ assert_array_almost_equal(ra['mean'], [1.1,2.2,3.3])
+ assert type(ra.mean) is type(ra.var)
+ ra.shape = (1,3)
+ assert ra.shape == (1,3)
+ ra.shape = ['A','B','C']
+ assert_array_equal(ra['shape'], [['A','B','C']])
+ ra.field = 5
+ assert_array_equal(ra['field'], [[5,5,5]])
+ assert callable(ra.field)
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/core/tests/test_regression.py b/numpy/core/tests/test_regression.py
new file mode 100644
index 000000000..526b34ee1
--- /dev/null
+++ b/numpy/core/tests/test_regression.py
@@ -0,0 +1,691 @@
+from numpy.testing import *
+from StringIO import StringIO
+import pickle
+import sys
+
+set_local_path()
+import numpy as N
+restore_path()
+
+rlevel = 1
+
+def assert_valid_refcount(op):
+ a = N.arange(100 * 100)
+ b = N.arange(100*100).reshape(100, 100)
+ c = b
+
+ i = 1
+
+ rc = sys.getrefcount(i)
+ for j in range(15):
+ d = op(b,c)
+
+ assert(sys.getrefcount(i) >= rc)
+
+class test_regression(NumpyTestCase):
+ def check_invalid_round(self,level=rlevel):
+ """Ticket #3"""
+ v = 4.7599999999999998
+ assert_array_equal(N.array([v]),N.array(v))
+
+ def check_mem_empty(self,level=rlevel):
+ """Ticket #7"""
+ N.empty((1,),dtype=[('x',N.int64)])
+
+ def check_pickle_transposed(self,level=rlevel):
+ """Ticket #16"""
+ a = N.transpose(N.array([[2,9],[7,0],[3,8]]))
+ f = StringIO()
+ pickle.dump(a,f)
+ f.seek(0)
+ b = pickle.load(f)
+ f.close()
+ assert_array_equal(a,b)
+
+ def check_masked_array_create(self,level=rlevel):
+ """Ticket #17"""
+ x = N.ma.masked_array([0,1,2,3,0,4,5,6],mask=[0,0,0,1,1,1,0,0])
+ assert_array_equal(N.ma.nonzero(x),[[1,2,6,7]])
+
+ def check_poly1d(self,level=rlevel):
+ """Ticket #28"""
+ assert_equal(N.poly1d([1]) - N.poly1d([1,0]),
+ N.poly1d([-1,1]))
+
+ def check_typeNA(self,level=rlevel):
+ """Ticket #31"""
+ assert_equal(N.typeNA[N.int64],'Int64')
+ assert_equal(N.typeNA[N.uint64],'UInt64')
+
+ def check_dtype_names(self,level=rlevel):
+ """Ticket #35"""
+ dt = N.dtype([(('name','label'),N.int32,3)])
+
+ def check_reduce(self,level=rlevel):
+ """Ticket #40"""
+ assert_almost_equal(N.add.reduce([1.,.5],dtype=None), 1.5)
+
+ def check_zeros_order(self,level=rlevel):
+ """Ticket #43"""
+ N.zeros([3], int, 'C')
+ N.zeros([3], order='C')
+ N.zeros([3], int, order='C')
+
+ def check_sort_bigendian(self,level=rlevel):
+ """Ticket #47"""
+ a = N.linspace(0, 10, 11)
+ c = a.astype(N.dtype('<f8'))
+ c.sort()
+ assert_array_almost_equal(c, a)
+
+ def check_negative_nd_indexing(self,level=rlevel):
+ """Ticket #49"""
+ c = N.arange(125).reshape((5,5,5))
+ origidx = N.array([-1, 0, 1])
+ idx = N.array(origidx)
+ c[idx]
+ assert_array_equal(idx, origidx)
+
+ def check_char_dump(self,level=rlevel):
+ """Ticket #50"""
+ import tempfile
+ f = StringIO()
+ ca = N.char.array(N.arange(1000,1010),itemsize=4)
+ ca.dump(f)
+ f.seek(0)
+ ca = N.load(f)
+ f.close()
+
+ def check_noncontiguous_fill(self,level=rlevel):
+ """Ticket #58."""
+ a = N.zeros((5,3))
+ b = a[:,:2,]
+ def rs():
+ b.shape = (10,)
+ self.failUnlessRaises(AttributeError,rs)
+
+ def check_bool(self,level=rlevel):
+ """Ticket #60"""
+ x = N.bool_(1)
+
+ def check_masked_array(self,level=rlevel):
+ """Ticket #61"""
+ x = N.core.ma.array(1,mask=[1])
+
+ def check_mem_masked_where(self,level=rlevel):
+ """Ticket #62"""
+ from numpy.core.ma import masked_where, MaskType
+ a = N.zeros((1,1))
+ b = N.zeros(a.shape, MaskType)
+ c = masked_where(b,a)
+ a-c
+
+ def check_indexing1(self,level=rlevel):
+ """Ticket #64"""
+ descr = [('x', [('y', [('z', 'c16', (2,)),]),]),]
+ buffer = ((([6j,4j],),),)
+ h = N.array(buffer, dtype=descr)
+ h['x']['y']['z']
+
+ def check_indexing2(self,level=rlevel):
+ """Ticket #65"""
+ descr = [('x', 'i4', (2,))]
+ buffer = ([3,2],)
+ h = N.array(buffer, dtype=descr)
+ h['x']
+
+ def check_round(self,level=rlevel):
+ """Ticket #67"""
+ x = N.array([1+2j])
+ assert_almost_equal(x**(-1), [1/(1+2j)])
+
+ def check_kron_matrix(self,level=rlevel):
+ """Ticket #71"""
+ x = N.matrix('[1 0; 1 0]')
+ assert_equal(type(N.kron(x,x)),type(x))
+
+ def check_scalar_compare(self,level=rlevel):
+ """Ticket #72"""
+ a = N.array(['test', 'auto'])
+ assert_array_equal(a == 'auto', N.array([False,True]))
+ self.assert_(a[1] == 'auto')
+ self.assert_(a[0] != 'auto')
+ b = N.linspace(0, 10, 11)
+ self.assert_(b != 'auto')
+ self.assert_(b[0] != 'auto')
+
+ def check_unicode_swapping(self,level=rlevel):
+ """Ticket #79"""
+ ulen = 1
+ ucs_value = u'\U0010FFFF'
+ ua = N.array([[[ucs_value*ulen]*2]*3]*4, dtype='U%s' % ulen)
+ ua2 = ua.newbyteorder()
+
+ def check_matrix_std_argmax(self,level=rlevel):
+ """Ticket #83"""
+ x = N.asmatrix(N.random.uniform(0,1,(3,3)))
+ self.assertEqual(x.std().shape, ())
+ self.assertEqual(x.argmax().shape, ())
+
+ def check_object_array_fill(self,level=rlevel):
+ """Ticket #86"""
+ x = N.zeros(1, 'O')
+ x.fill([])
+
+ def check_cov_parameters(self,level=rlevel):
+ """Ticket #91"""
+ x = N.random.random((3,3))
+ y = x.copy()
+ N.cov(x,rowvar=1)
+ N.cov(y,rowvar=0)
+ assert_array_equal(x,y)
+
+ def check_mem_dtype_align(self,level=rlevel):
+ """Ticket #93"""
+ self.failUnlessRaises(TypeError,N.dtype,
+ {'names':['a'],'formats':['foo']},align=1)
+
+ def check_mem_digitize(self,level=rlevel):
+ """Ticket #95"""
+ for i in range(100):
+ N.digitize([1,2,3,4],[1,3])
+ N.digitize([0,1,2,3,4],[1,3])
+
+ def check_intp(self,level=rlevel):
+ """Ticket #99"""
+ i_width = N.int_(0).nbytes*2 - 1
+ N.intp('0x' + 'f'*i_width,16)
+ self.failUnlessRaises(OverflowError,N.intp,'0x' + 'f'*(i_width+1),16)
+ self.failUnlessRaises(ValueError,N.intp,'0x1',32)
+ assert_equal(255,N.intp('0xFF',16))
+ assert_equal(1024,N.intp(1024))
+
+ def check_endian_bool_indexing(self,level=rlevel):
+ """Ticket #105"""
+ a = N.arange(10.,dtype='>f8')
+ b = N.arange(10.,dtype='<f8')
+ xa = N.where((a>2) & (a<6))
+ xb = N.where((b>2) & (b<6))
+ ya = ((a>2) & (a<6))
+ yb = ((b>2) & (b<6))
+ assert_array_almost_equal(xa,ya.nonzero())
+ assert_array_almost_equal(xb,yb.nonzero())
+ assert(N.all(a[ya] > 0.5))
+ assert(N.all(b[yb] > 0.5))
+
+ def check_mem_dot(self,level=rlevel):
+ """Ticket #106"""
+ x = N.random.randn(0,1)
+ y = N.random.randn(10,1)
+ z = N.dot(x, N.transpose(y))
+
+ def check_arange_endian(self,level=rlevel):
+ """Ticket #111"""
+ ref = N.arange(10)
+ x = N.arange(10,dtype='<f8')
+ assert_array_equal(ref,x)
+ x = N.arange(10,dtype='>f8')
+ assert_array_equal(ref,x)
+
+# Longfloat support is not consistent enough across
+# platforms for this test to be meaningful.
+# def check_longfloat_repr(self,level=rlevel):
+# """Ticket #112"""
+# if N.longfloat(0).itemsize > 8:
+# a = N.exp(N.array([1000],dtype=N.longfloat))
+# assert(str(a)[1:9] == str(a[0])[:8])
+
+ def check_argmax(self,level=rlevel):
+ """Ticket #119"""
+ a = N.random.normal(0,1,(4,5,6,7,8))
+ for i in xrange(a.ndim):
+ aargmax = a.argmax(i)
+
+ def check_matrix_properties(self,level=rlevel):
+ """Ticket #125"""
+ a = N.matrix([1.0],dtype=float)
+ assert(type(a.real) is N.matrix)
+ assert(type(a.imag) is N.matrix)
+ c,d = N.matrix([0.0]).nonzero()
+ assert(type(c) is N.matrix)
+ assert(type(d) is N.matrix)
+
+ def check_mem_divmod(self,level=rlevel):
+ """Ticket #126"""
+ for i in range(10):
+ divmod(N.array([i])[0],10)
+
+
+ def check_hstack_invalid_dims(self,level=rlevel):
+ """Ticket #128"""
+ x = N.arange(9).reshape((3,3))
+ y = N.array([0,0,0])
+ self.failUnlessRaises(ValueError,N.hstack,(x,y))
+
+ def check_squeeze_type(self,level=rlevel):
+ """Ticket #133"""
+ a = N.array([3])
+ b = N.array(3)
+ assert(type(a.squeeze()) is N.ndarray)
+ assert(type(b.squeeze()) is N.ndarray)
+
+ def check_add_identity(self,level=rlevel):
+ """Ticket #143"""
+ assert_equal(0,N.add.identity)
+
+ def check_binary_repr_0(self,level=rlevel):
+ """Ticket #151"""
+ assert_equal('0',N.binary_repr(0))
+
+ def check_rec_iterate(self,level=rlevel):
+ """Ticket #160"""
+ descr = N.dtype([('i',int),('f',float),('s','|S3')])
+ x = N.rec.array([(1,1.1,'1.0'),
+ (2,2.2,'2.0')],dtype=descr)
+ x[0].tolist()
+ [i for i in x[0]]
+
+ def check_unicode_string_comparison(self,level=rlevel):
+ """Ticket #190"""
+ a = N.array('hello',N.unicode_)
+ b = N.array('world')
+ a == b
+
+ def check_tostring_FORTRANORDER_discontiguous(self,level=rlevel):
+ """Fix in r2836"""
+ # Create discontiguous Fortran-ordered array
+ x = N.array(N.random.rand(3,3),order='F')[:,:2]
+ assert_array_almost_equal(x.ravel(),N.fromstring(x.tostring()))
+
+ def check_flat_assignment(self,level=rlevel):
+ """Correct behaviour of ticket #194"""
+ x = N.empty((3,1))
+ x.flat = N.arange(3)
+ assert_array_almost_equal(x,[[0],[1],[2]])
+ x.flat = N.arange(3,dtype=float)
+ assert_array_almost_equal(x,[[0],[1],[2]])
+
+ def check_broadcast_flat_assignment(self,level=rlevel):
+ """Ticket #194"""
+ x = N.empty((3,1))
+ def bfa(): x[:] = N.arange(3)
+ def bfb(): x[:] = N.arange(3,dtype=float)
+ self.failUnlessRaises(ValueError, bfa)
+ self.failUnlessRaises(ValueError, bfb)
+
+ def check_unpickle_dtype_with_object(self,level=rlevel):
+ """Implemented in r2840"""
+ dt = N.dtype([('x',int),('y',N.object_),('z','O')])
+ f = StringIO()
+ pickle.dump(dt,f)
+ f.seek(0)
+ dt_ = pickle.load(f)
+ f.close()
+ assert_equal(dt,dt_)
+
+ def check_mem_array_creation_invalid_specification(self,level=rlevel):
+ """Ticket #196"""
+ dt = N.dtype([('x',int),('y',N.object_)])
+ # Wrong way
+ self.failUnlessRaises(ValueError, N.array, [1,'object'], dt)
+ # Correct way
+ N.array([(1,'object')],dt)
+
+ def check_recarray_single_element(self,level=rlevel):
+ """Ticket #202"""
+ a = N.array([1,2,3],dtype=N.int32)
+ b = a.copy()
+ r = N.rec.array(a,shape=1,formats=['3i4'],names=['d'])
+ assert_array_equal(a,b)
+ assert_equal(a,r[0][0])
+
+ def check_zero_sized_array_indexing(self,level=rlevel):
+ """Ticket #205"""
+ tmp = N.array([])
+ def index_tmp(): tmp[N.array(10)]
+ self.failUnlessRaises(IndexError, index_tmp)
+
+ def check_unique_zero_sized(self,level=rlevel):
+ """Ticket #205"""
+ assert_array_equal([], N.unique(N.array([])))
+
+ def check_chararray_rstrip(self,level=rlevel):
+ """Ticket #222"""
+ x = N.chararray((1,),5)
+ x[0] = 'a '
+ x = x.rstrip()
+ assert_equal(x[0], 'a')
+
+ def check_object_array_shape(self,level=rlevel):
+ """Ticket #239"""
+ assert_equal(N.array([[1,2],3,4],dtype=object).shape, (3,))
+ assert_equal(N.array([[1,2],[3,4]],dtype=object).shape, (2,2))
+ assert_equal(N.array([(1,2),(3,4)],dtype=object).shape, (2,2))
+ assert_equal(N.array([],dtype=object).shape, (0,))
+ assert_equal(N.array([[],[],[]],dtype=object).shape, (3,0))
+ assert_equal(N.array([[3,4],[5,6],None],dtype=object).shape, (3,))
+
+ def check_mem_around(self,level=rlevel):
+ """Ticket #243"""
+ x = N.zeros((1,))
+ y = [0]
+ decimal = 6
+ N.around(abs(x-y),decimal) <= 10.0**(-decimal)
+
+ def check_character_array_strip(self,level=rlevel):
+ """Ticket #246"""
+ x = N.char.array(("x","x ","x "))
+ for c in x: assert_equal(c,"x")
+
+ def check_lexsort(self,level=rlevel):
+ """Lexsort memory error"""
+ v = N.array([1,2,3,4,5,6,7,8,9,10])
+ assert_equal(N.lexsort(v),0)
+
+ def check_pickle_dtype(self,level=rlevel):
+ """Ticket #251"""
+ import pickle
+ pickle.dumps(N.float)
+
+ def check_masked_array_multiply(self,level=rlevel):
+ """Ticket #254"""
+ a = N.ma.zeros((4,1))
+ a[2,0] = N.ma.masked
+ b = N.zeros((4,2))
+ a*b
+ b*a
+
+ def check_swap_real(self, level=rlevel):
+ """Ticket #265"""
+ assert_equal(N.arange(4,dtype='>c8').imag.max(),0.0)
+ assert_equal(N.arange(4,dtype='<c8').imag.max(),0.0)
+ assert_equal(N.arange(4,dtype='>c8').real.max(),3.0)
+ assert_equal(N.arange(4,dtype='<c8').real.max(),3.0)
+
+ def check_object_array_from_list(self, level=rlevel):
+ """Ticket #270"""
+ a = N.array([1,'A',None])
+
+ def check_masked_array_repeat(self, level=rlevel):
+ """Ticket #271"""
+ N.ma.array([1],mask=False).repeat(10)
+
+ def check_multiple_assign(self, level=rlevel):
+ """Ticket #273"""
+ a = N.zeros((3,1),int)
+ a[[1,2]] = 1
+
+ def check_empty_array_type(self, level=rlevel):
+ assert_equal(N.array([]).dtype, N.zeros(0).dtype)
+
+ def check_void_coercion(self, level=rlevel):
+ dt = N.dtype([('a','f4'),('b','i4')])
+ x = N.zeros((1,),dt)
+ assert(N.r_[x,x].dtype == dt)
+
+ def check_void_copyswap(self, level=rlevel):
+ dt = N.dtype([('one', '<i4'),('two', '<i4')])
+ x = N.array((1,2), dtype=dt)
+ x = x.byteswap()
+ assert(x['one'] > 1 and x['two'] > 2)
+
+ def check_method_args(self, level=rlevel):
+ # Make sure methods and functions have same default axis
+ # keyword and arguments
+ funcs1= ['argmax', 'argmin', 'sum', ('product', 'prod'),
+ ('sometrue', 'any'),
+ ('alltrue', 'all'), 'cumsum', ('cumproduct', 'cumprod'),
+ 'ptp', 'cumprod', 'prod', 'std', 'var', 'mean',
+ 'round', 'min', 'max', 'argsort', 'sort']
+ funcs2 = ['compress', 'take', 'repeat']
+
+ for func in funcs1:
+ arr = N.random.rand(8,7)
+ arr2 = arr.copy()
+ if isinstance(func, tuple):
+ func_meth = func[1]
+ func = func[0]
+ else:
+ func_meth = func
+ res1 = getattr(arr, func_meth)()
+ res2 = getattr(N, func)(arr2)
+ if res1 is None:
+ assert abs(arr-res2).max() < 1e-8, func
+ else:
+ assert abs(res1-res2).max() < 1e-8, func
+
+ for func in funcs2:
+ arr1 = N.random.rand(8,7)
+ arr2 = N.random.rand(8,7)
+ res1 = None
+ if func == 'compress':
+ arr1 = arr1.ravel()
+ res1 = getattr(arr2, func)(arr1)
+ else:
+ arr2 = (15*arr2).astype(int).ravel()
+ if res1 is None:
+ res1 = getattr(arr1, func)(arr2)
+ res2 = getattr(N, func)(arr1, arr2)
+ assert abs(res1-res2).max() < 1e-8, func
+
+ def check_mem_lexsort_strings(self, level=rlevel):
+ """Ticket #298"""
+ lst = ['abc','cde','fgh']
+ N.lexsort((lst,))
+
+ def check_fancy_index(self, level=rlevel):
+ """Ticket #302"""
+ x = N.array([1,2])[N.array([0])]
+ assert_equal(x.shape,(1,))
+
+ def check_recarray_copy(self, level=rlevel):
+ """Ticket #312"""
+ dt = [('x',N.int16),('y',N.float64)]
+ ra = N.array([(1,2.3)], dtype=dt)
+ rb = N.rec.array(ra, dtype=dt)
+ rb['x'] = 2.
+ assert ra['x'] != rb['x']
+
+ def check_rec_fromarray(self, level=rlevel):
+ """Ticket #322"""
+ x1 = N.array([[1,2],[3,4],[5,6]])
+ x2 = N.array(['a','dd','xyz'])
+ x3 = N.array([1.1,2,3])
+ N.rec.fromarrays([x1,x2,x3], formats="(2,)i4,a3,f8")
+
+ def check_object_array_assign(self, level=rlevel):
+ x = N.empty((2,2),object)
+ x.flat[2] = (1,2,3)
+ assert_equal(x.flat[2],(1,2,3))
+
+ def check_ndmin_float64(self, level=rlevel):
+ """Ticket #324"""
+ x = N.array([1,2,3],dtype=N.float64)
+ assert_equal(N.array(x,dtype=N.float32,ndmin=2).ndim,2)
+ assert_equal(N.array(x,dtype=N.float64,ndmin=2).ndim,2)
+
+ def check_mem_vectorise(self, level=rlevel):
+ """Ticket #325"""
+ vt = N.vectorize(lambda *args: args)
+ vt(N.zeros((1,2,1)), N.zeros((2,1,1)), N.zeros((1,1,2)))
+ vt(N.zeros((1,2,1)), N.zeros((2,1,1)), N.zeros((1,1,2)), N.zeros((2,2)))
+
+ def check_mem_axis_minimization(self, level=rlevel):
+ """Ticket #327"""
+ data = N.arange(5)
+ data = N.add.outer(data,data)
+
+ def check_mem_float_imag(self, level=rlevel):
+ """Ticket #330"""
+ N.float64(1.0).imag
+
+ def check_dtype_tuple(self, level=rlevel):
+ """Ticket #334"""
+ assert N.dtype('i4') == N.dtype(('i4',()))
+
+ def check_dtype_posttuple(self, level=rlevel):
+ """Ticket #335"""
+ N.dtype([('col1', '()i4')])
+
+ def check_mgrid_single_element(self, level=rlevel):
+ """Ticket #339"""
+ assert_array_equal(N.mgrid[0:0:1j],[0])
+ assert_array_equal(N.mgrid[0:0],[])
+
+ def check_numeric_carray_compare(self, level=rlevel):
+ """Ticket #341"""
+ assert_equal(N.array([ 'X' ], 'c'),'X')
+
+ def check_string_array_size(self, level=rlevel):
+ """Ticket #342"""
+ self.failUnlessRaises(ValueError,
+ N.array,[['X'],['X','X','X']],'|S1')
+
+ def check_dtype_repr(self, level=rlevel):
+ """Ticket #344"""
+ dt1=N.dtype(('uint32', 2))
+ dt2=N.dtype(('uint32', (2,)))
+ assert_equal(dt1.__repr__(), dt2.__repr__())
+
+ def check_reshape_order(self, level=rlevel):
+ """Make sure reshape order works."""
+ a = N.arange(6).reshape(2,3,order='F')
+ assert_equal(a,[[0,2,4],[1,3,5]])
+ a = N.array([[1,2],[3,4],[5,6],[7,8]])
+ b = a[:,1]
+ assert_equal(b.reshape(2,2,order='F'), [[2,6],[4,8]])
+
+ def check_repeat_discont(self, level=rlevel):
+ """Ticket #352"""
+ a = N.arange(12).reshape(4,3)[:,2]
+ assert_equal(a.repeat(3), [2,2,2,5,5,5,8,8,8,11,11,11])
+
+ def check_array_index(self, level=rlevel):
+ """Make sure optimization is not called in this case."""
+ a = N.array([1,2,3])
+ a2 = N.array([[1,2,3]])
+ assert_equal(a[N.where(a==3)], a2[N.where(a2==3)])
+
+ def check_object_argmax(self, level=rlevel):
+ a = N.array([1,2,3],dtype=object)
+ assert a.argmax() == 2
+
+ def check_recarray_fields(self, level=rlevel):
+ """Ticket #372"""
+ dt0 = N.dtype([('f0','i4'),('f1','i4')])
+ dt1 = N.dtype([('f0','i8'),('f1','i8')])
+ for a in [N.array([(1,2),(3,4)],"i4,i4"),
+ N.rec.array([(1,2),(3,4)],"i4,i4"),
+ N.rec.array([(1,2),(3,4)]),
+ N.rec.fromarrays([(1,2),(3,4)],"i4,i4"),
+ N.rec.fromarrays([(1,2),(3,4)])]:
+ assert(a.dtype in [dt0,dt1])
+
+ def check_random_shuffle(self, level=rlevel):
+ """Ticket #374"""
+ a = N.arange(5).reshape((5,1))
+ b = a.copy()
+ N.random.shuffle(b)
+ assert_equal(N.sort(b, axis=0),a)
+
+ def check_refcount_vectorize(self, level=rlevel):
+ """Ticket #378"""
+ def p(x,y): return 123
+ v = N.vectorize(p)
+ assert_valid_refcount(v)
+
+ def check_refcount_vdot(self, level=rlevel):
+ """Changeset #3443"""
+ assert_valid_refcount(N.vdot)
+
+ def check_startswith(self, level=rlevel):
+ ca = N.char.array(['Hi','There'])
+ assert_equal(ca.startswith('H'),[True,False])
+
+ def check_noncommutative_reduce_accumulate(self, level=rlevel):
+ """Ticket #413"""
+ tosubtract = N.arange(5)
+ todivide = N.array([2.0, 0.5, 0.25])
+ assert_equal(N.subtract.reduce(tosubtract), -10)
+ assert_equal(N.divide.reduce(todivide), 16.0)
+ assert_array_equal(N.subtract.accumulate(tosubtract),
+ N.array([0, -1, -3, -6, -10]))
+ assert_array_equal(N.divide.accumulate(todivide),
+ N.array([2., 4., 16.]))
+
+ def check_mem_polymul(self, level=rlevel):
+ """Ticket #448"""
+ N.polymul([],[1.])
+
+ def check_convolve_empty(self, level=rlevel):
+ """Convolve should raise an error for empty input array."""
+ self.failUnlessRaises(AssertionError,N.convolve,[],[1])
+ self.failUnlessRaises(AssertionError,N.convolve,[1],[])
+
+ def check_multidim_byteswap(self, level=rlevel):
+ """Ticket #449"""
+ r=N.array([(1,(0,1,2))], dtype="i2,3i2")
+ assert_array_equal(r.byteswap(),
+ N.array([(256,(0,256,512))],r.dtype))
+
+ def check_string_NULL(self, level=rlevel):
+ """Changeset 3557"""
+ assert_equal(N.array("a\x00\x0b\x0c\x00").item(),
+ 'a\x00\x0b\x0c')
+
+ def check_mem_string_concat(self, level=rlevel):
+ """Ticket #469"""
+ x = N.array([])
+ N.append(x,'asdasd\tasdasd')
+
+ def check_matrix_multiply_by_1d_vector(self, level=rlevel) :
+ """Ticket #473"""
+ def mul() :
+ N.mat(N.eye(2))*N.ones(2)
+
+ self.failUnlessRaises(ValueError,mul)
+
+ def check_junk_in_string_fields_of_recarray(self, level=rlevel):
+ """Ticket #483"""
+ r = N.array([['abc']], dtype=[('var1', '|S20')])
+ assert str(r['var1'][0][0]) == 'abc'
+
+ def check_take_output(self, level=rlevel):
+ """Ensure that 'take' honours output parameter."""
+ x = N.arange(12).reshape((3,4))
+ a = N.take(x,[0,2],axis=1)
+ b = N.zeros_like(a)
+ N.take(x,[0,2],axis=1,out=b)
+ assert_array_equal(a,b)
+
+ def check_array_str_64bit(self, level=rlevel):
+ """Ticket #501"""
+ s = N.array([1, N.nan],dtype=N.float64)
+ errstate = N.seterr(all='raise')
+ try:
+ sstr = N.array_str(s)
+ finally:
+ N.seterr(**errstate)
+
+ def check_frompyfunc_endian(self, level=rlevel):
+ """Ticket #503"""
+ from math import radians
+ uradians = N.frompyfunc(radians, 1, 1)
+ big_endian = N.array([83.4, 83.5], dtype='>f8')
+ little_endian = N.array([83.4, 83.5], dtype='<f8')
+ assert_almost_equal(uradians(big_endian).astype(float),
+ uradians(little_endian).astype(float))
+
+ def check_mem_string_arr(self, level=rlevel):
+ """Ticket #514"""
+ s = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+ t = []
+ N.hstack((t, s ))
+
+ def check_arr_transpose(self, level=rlevel):
+ """Ticket #516"""
+ x = N.random.rand(*(2,)*16)
+ y = x.transpose(range(16))
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/core/tests/test_scalarmath.py b/numpy/core/tests/test_scalarmath.py
new file mode 100644
index 000000000..ecb695c5c
--- /dev/null
+++ b/numpy/core/tests/test_scalarmath.py
@@ -0,0 +1,55 @@
+from numpy.testing import *
+set_package_path()
+import numpy.core.umath as ncu
+from numpy import array
+import numpy as N
+restore_path()
+
+types = [N.bool_, N.byte, N.ubyte, N.short, N.ushort, N.intc, N.uintc,
+ N.int_, N.uint, N.longlong, N.ulonglong,
+ N.single, N.double, N.longdouble, N.csingle,
+ N.cdouble, N.clongdouble]
+
+# This compares scalarmath against ufuncs.
+
+class test_types(NumpyTestCase):
+ def check_types(self, level=1):
+ for atype in types:
+ a = atype(1)
+ assert a == 1, "error with %r: got %r" % (atype,a)
+
+ def check_type_add(self, level=1):
+ # list of types
+ for k, atype in enumerate(types):
+ vala = atype(3)
+ val1 = array([3],dtype=atype)
+ for l, btype in enumerate(types):
+ valb = btype(1)
+ val2 = array([1],dtype=btype)
+ val = vala+valb
+ valo = val1 + val2
+ assert val.dtype.num == valo.dtype.num and \
+ val.dtype.char == valo.dtype.char, \
+ "error with (%d,%d)" % (k,l)
+
+ def check_type_create(self, level=1):
+ for k, atype in enumerate(types):
+ a = array([1,2,3],atype)
+ b = atype([1,2,3])
+ assert_equal(a,b)
+
+class test_power(NumpyTestCase):
+ def check_small_types(self):
+ for t in [N.int8, N.int16]:
+ a = t(3)
+ b = a ** 4
+ assert b == 81, "error with %r: got %r" % (t,b)
+
+ def check_large_types(self):
+ for t in [N.int32, N.int64, N.float32, N.float64, N.longdouble]:
+ a = t(51)
+ b = a ** 4
+ assert b == 6765201, "error with %r: got %r" % (t,b)
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/core/tests/test_umath.py b/numpy/core/tests/test_umath.py
new file mode 100644
index 000000000..09e5c1d93
--- /dev/null
+++ b/numpy/core/tests/test_umath.py
@@ -0,0 +1,198 @@
+from numpy.testing import *
+set_package_path()
+from numpy.core.umath import minimum, maximum, exp
+import numpy.core.umath as ncu
+from numpy import zeros, ndarray, array, choose
+restore_path()
+
+class test_division(NumpyTestCase):
+ def check_division_int(self):
+ # int division should return the floor of the result, a la Python
+ x = array([5, 10, 90, 100, -5, -10, -90, -100, -120])
+ assert_equal(x / 100, [0, 0, 0, 1, -1, -1, -1, -1, -2])
+ assert_equal(x // 100, [0, 0, 0, 1, -1, -1, -1, -1, -2])
+ assert_equal(x % 100, [5, 10, 90, 0, 95, 90, 10, 0, 80])
+
+class test_power(NumpyTestCase):
+ def check_power_float(self):
+ x = array([1., 2., 3.])
+ assert_equal(x**0, [1., 1., 1.])
+ assert_equal(x**1, x)
+ assert_equal(x**2, [1., 4., 9.])
+ y = x.copy()
+ y **= 2
+ assert_equal(y, [1., 4., 9.])
+ assert_almost_equal(x**(-1), [1., 0.5, 1./3])
+ assert_almost_equal(x**(0.5), [1., ncu.sqrt(2), ncu.sqrt(3)])
+
+ def check_power_complex(self):
+ x = array([1+2j, 2+3j, 3+4j])
+ assert_equal(x**0, [1., 1., 1.])
+ assert_equal(x**1, x)
+ assert_equal(x**2, [-3+4j, -5+12j, -7+24j])
+ assert_almost_equal(x**(-1), [1/(1+2j), 1/(2+3j), 1/(3+4j)])
+ assert_almost_equal(x**(-3), [(-11+2j)/125, (-46-9j)/2197,
+ (-117-44j)/15625])
+ assert_almost_equal(x**(0.5), [ncu.sqrt(1+2j), ncu.sqrt(2+3j),
+ ncu.sqrt(3+4j)])
+ assert_almost_equal(x**14, [-76443+16124j, 23161315+58317492j,
+ 5583548873 + 2465133864j])
+
+class test_log1p(NumpyTestCase):
+ def check_log1p(self):
+ assert_almost_equal(ncu.log1p(0.2), ncu.log(1.2))
+ assert_almost_equal(ncu.log1p(1e-6), ncu.log(1+1e-6))
+
+class test_expm1(NumpyTestCase):
+ def check_expm1(self):
+ assert_almost_equal(ncu.expm1(0.2), ncu.exp(0.2)-1)
+ assert_almost_equal(ncu.expm1(1e-6), ncu.exp(1e-6)-1)
+
+class test_maximum(NumpyTestCase):
+ def check_reduce_complex(self):
+ assert_equal(maximum.reduce([1,2j]),1)
+ assert_equal(maximum.reduce([1+3j,2j]),1+3j)
+
+class test_minimum(NumpyTestCase):
+ def check_reduce_complex(self):
+ assert_equal(minimum.reduce([1,2j]),2j)
+
+class test_floating_point(NumpyTestCase):
+ def check_floating_point(self):
+ assert_equal(ncu.FLOATING_POINT_SUPPORT, 1)
+
+class test_special_methods(NumpyTestCase):
+ def test_wrap(self):
+ class with_wrap(object):
+ def __array__(self):
+ return zeros(1)
+ def __array_wrap__(self, arr, context):
+ r = with_wrap()
+ r.arr = arr
+ r.context = context
+ return r
+ a = with_wrap()
+ x = minimum(a, a)
+ assert_equal(x.arr, zeros(1))
+ func, args, i = x.context
+ self.failUnless(func is minimum)
+ self.failUnlessEqual(len(args), 2)
+ assert_equal(args[0], a)
+ assert_equal(args[1], a)
+ self.failUnlessEqual(i, 0)
+
+ def test_old_wrap(self):
+ class with_wrap(object):
+ def __array__(self):
+ return zeros(1)
+ def __array_wrap__(self, arr):
+ r = with_wrap()
+ r.arr = arr
+ return r
+ a = with_wrap()
+ x = minimum(a, a)
+ assert_equal(x.arr, zeros(1))
+
+ def test_priority(self):
+ class A(object):
+ def __array__(self):
+ return zeros(1)
+ def __array_wrap__(self, arr, context):
+ r = type(self)()
+ r.arr = arr
+ r.context = context
+ return r
+ class B(A):
+ __array_priority__ = 20.
+ class C(A):
+ __array_priority__ = 40.
+ x = zeros(1)
+ a = A()
+ b = B()
+ c = C()
+ f = minimum
+ self.failUnless(type(f(x,x)) is ndarray)
+ self.failUnless(type(f(x,a)) is A)
+ self.failUnless(type(f(x,b)) is B)
+ self.failUnless(type(f(x,c)) is C)
+ self.failUnless(type(f(a,x)) is A)
+ self.failUnless(type(f(b,x)) is B)
+ self.failUnless(type(f(c,x)) is C)
+
+ self.failUnless(type(f(a,a)) is A)
+ self.failUnless(type(f(a,b)) is B)
+ self.failUnless(type(f(b,a)) is B)
+ self.failUnless(type(f(b,b)) is B)
+ self.failUnless(type(f(b,c)) is C)
+ self.failUnless(type(f(c,b)) is C)
+ self.failUnless(type(f(c,c)) is C)
+
+ self.failUnless(type(exp(a) is A))
+ self.failUnless(type(exp(b) is B))
+ self.failUnless(type(exp(c) is C))
+
+ def test_failing_wrap(self):
+ class A(object):
+ def __array__(self):
+ return zeros(1)
+ def __array_wrap__(self, arr, context):
+ raise RuntimeError
+ a = A()
+ self.failUnlessRaises(RuntimeError, maximum, a, a)
+
+ def test_array_with_context(self):
+ class A(object):
+ def __array__(self, dtype=None, context=None):
+ func, args, i = context
+ self.func = func
+ self.args = args
+ self.i = i
+ return zeros(1)
+ class B(object):
+ def __array__(self, dtype=None):
+ return zeros(1, dtype)
+ class C(object):
+ def __array__(self):
+ return zeros(1)
+ a = A()
+ maximum(zeros(1), a)
+ self.failUnless(a.func is maximum)
+ assert_equal(a.args[0], 0)
+ self.failUnless(a.args[1] is a)
+ self.failUnless(a.i == 1)
+ assert_equal(maximum(a, B()), 0)
+ assert_equal(maximum(a, C()), 0)
+
+class test_choose(NumpyTestCase):
+ def test_mixed(self):
+ c = array([True,True])
+ a = array([True,True])
+ assert_equal(choose(c, (a, 1)), array([1,1]))
+
+
+class _test_complex_real(NumpyTestCase):
+ def setUp(self):
+ self.x = 0.52
+ self.z = self.x+0j
+ self.funcs = ['arcsin', 'arccos', 'arctan', 'arcsinh', 'arccosh',
+ 'arctanh', 'sin', 'cos', 'tan', 'exp', 'log', 'sqrt',
+ 'log10']
+ def test_it(self):
+ for fun in self.funcs:
+ cr = fun(self.z)
+ assert_almost_equal(fun(self.x),cr.real)
+ assert_almost_equal(0, cr.imag)
+
+class test_choose(NumpyTestCase):
+ def test_attributes(self):
+ add = ncu.add
+ assert_equal(add.__name__, 'add')
+ assert_equal(add.__doc__, 'y = add(x1,x2) adds the arguments elementwise.')
+ self.failUnless(add.ntypes >= 18) # don't fail if types added
+ self.failUnless('ii->i' in add.types)
+ assert_equal(add.nin, 2)
+ assert_equal(add.nout, 1)
+ assert_equal(add.identity, 0)
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/core/tests/test_unicode.py b/numpy/core/tests/test_unicode.py
new file mode 100644
index 000000000..7d7c06f30
--- /dev/null
+++ b/numpy/core/tests/test_unicode.py
@@ -0,0 +1,304 @@
+import sys
+from numpy.testing import *
+from numpy.core import *
+
+# Guess the UCS length for this python interpreter
+if len(buffer(u'u')) == 4:
+ ucs4 = True
+else:
+ ucs4 = False
+
+# Value that can be represented in UCS2 interpreters
+ucs2_value = u'\uFFFF'
+# Value that cannot be represented in UCS2 interpreters (but can in UCS4)
+ucs4_value = u'\U0010FFFF'
+
+
+############################################################
+# Creation tests
+############################################################
+
+class create_zeros(NumpyTestCase):
+ """Check the creation of zero-valued arrays"""
+
+ def content_test(self, ua, ua_scalar, nbytes):
+
+ # Check the length of the unicode base type
+ self.assert_(int(ua.dtype.str[2:]) == self.ulen)
+ # Check the length of the data buffer
+ self.assert_(len(ua.data) == nbytes)
+ # Small check that data in array element is ok
+ self.assert_(ua_scalar == u'')
+ # Encode to ascii and double check
+ self.assert_(ua_scalar.encode('ascii') == '')
+ # Check buffer lengths for scalars
+ if ucs4:
+ self.assert_(len(buffer(ua_scalar)) == 0)
+ else:
+ self.assert_(len(buffer(ua_scalar)) == 0)
+
+ def check_zeros0D(self):
+ """Check creation of 0-dimensional objects"""
+ ua = zeros((), dtype='U%s' % self.ulen)
+ self.content_test(ua, ua[()], 4*self.ulen)
+
+ def check_zerosSD(self):
+ """Check creation of single-dimensional objects"""
+ ua = zeros((2,), dtype='U%s' % self.ulen)
+ self.content_test(ua, ua[0], 4*self.ulen*2)
+ self.content_test(ua, ua[1], 4*self.ulen*2)
+
+ def check_zerosMD(self):
+ """Check creation of multi-dimensional objects"""
+ ua = zeros((2,3,4), dtype='U%s' % self.ulen)
+ self.content_test(ua, ua[0,0,0], 4*self.ulen*2*3*4)
+ self.content_test(ua, ua[-1,-1,-1], 4*self.ulen*2*3*4)
+
+
+class test_create_zeros_1(create_zeros):
+ """Check the creation of zero-valued arrays (size 1)"""
+ ulen = 1
+
+class test_create_zeros_2(create_zeros):
+ """Check the creation of zero-valued arrays (size 2)"""
+ ulen = 2
+
+class test_create_zeros_1009(create_zeros):
+ """Check the creation of zero-valued arrays (size 1009)"""
+ ulen = 1009
+
+
+class create_values(NumpyTestCase):
+ """Check the creation of unicode arrays with values"""
+
+ def content_test(self, ua, ua_scalar, nbytes):
+
+ # Check the length of the unicode base type
+ self.assert_(int(ua.dtype.str[2:]) == self.ulen)
+ # Check the length of the data buffer
+ self.assert_(len(ua.data) == nbytes)
+ # Small check that data in array element is ok
+ self.assert_(ua_scalar == self.ucs_value*self.ulen)
+ # Encode to UTF-8 and double check
+ self.assert_(ua_scalar.encode('utf-8') == \
+ (self.ucs_value*self.ulen).encode('utf-8'))
+ # Check buffer lengths for scalars
+ if ucs4:
+ self.assert_(len(buffer(ua_scalar)) == 4*self.ulen)
+ else:
+ if self.ucs_value == ucs4_value:
+ # In UCS2, the \U0010FFFF will be represented using a
+ # surrogate *pair*
+ self.assert_(len(buffer(ua_scalar)) == 2*2*self.ulen)
+ else:
+ # In UCS2, the \uFFFF will be represented using a
+ # regular 2-byte word
+ self.assert_(len(buffer(ua_scalar)) == 2*self.ulen)
+
+ def check_values0D(self):
+ """Check creation of 0-dimensional objects with values"""
+ ua = array(self.ucs_value*self.ulen, dtype='U%s' % self.ulen)
+ self.content_test(ua, ua[()], 4*self.ulen)
+
+ def check_valuesSD(self):
+ """Check creation of single-dimensional objects with values"""
+ ua = array([self.ucs_value*self.ulen]*2, dtype='U%s' % self.ulen)
+ self.content_test(ua, ua[0], 4*self.ulen*2)
+ self.content_test(ua, ua[1], 4*self.ulen*2)
+
+ def check_valuesMD(self):
+ """Check creation of multi-dimensional objects with values"""
+ ua = array([[[self.ucs_value*self.ulen]*2]*3]*4, dtype='U%s' % self.ulen)
+ self.content_test(ua, ua[0,0,0], 4*self.ulen*2*3*4)
+ self.content_test(ua, ua[-1,-1,-1], 4*self.ulen*2*3*4)
+
+
+class test_create_values_1_ucs2(create_values):
+ """Check the creation of valued arrays (size 1, UCS2 values)"""
+ ulen = 1
+ ucs_value = ucs2_value
+
+class test_create_values_1_ucs4(create_values):
+ """Check the creation of valued arrays (size 1, UCS4 values)"""
+ ulen = 1
+ ucs_value = ucs4_value
+
+class test_create_values_2_ucs2(create_values):
+ """Check the creation of valued arrays (size 2, UCS2 values)"""
+ ulen = 2
+ ucs_value = ucs2_value
+
+class test_create_values_2_ucs4(create_values):
+ """Check the creation of valued arrays (size 2, UCS4 values)"""
+ ulen = 2
+ ucs_value = ucs4_value
+
+class test_create_values_1009_ucs2(create_values):
+ """Check the creation of valued arrays (size 1009, UCS2 values)"""
+ ulen = 1009
+ ucs_value = ucs2_value
+
+class test_create_values_1009_ucs4(create_values):
+ """Check the creation of valued arrays (size 1009, UCS4 values)"""
+ ulen = 1009
+ ucs_value = ucs4_value
+
+
+############################################################
+# Assignment tests
+############################################################
+
+class assign_values(NumpyTestCase):
+ """Check the assignment of unicode arrays with values"""
+
+ def content_test(self, ua, ua_scalar, nbytes):
+
+ # Check the length of the unicode base type
+ self.assert_(int(ua.dtype.str[2:]) == self.ulen)
+ # Check the length of the data buffer
+ self.assert_(len(ua.data) == nbytes)
+ # Small check that data in array element is ok
+ self.assert_(ua_scalar == self.ucs_value*self.ulen)
+ # Encode to UTF-8 and double check
+ self.assert_(ua_scalar.encode('utf-8') == \
+ (self.ucs_value*self.ulen).encode('utf-8'))
+ # Check buffer lengths for scalars
+ if ucs4:
+ self.assert_(len(buffer(ua_scalar)) == 4*self.ulen)
+ else:
+ if self.ucs_value == ucs4_value:
+ # In UCS2, the \U0010FFFF will be represented using a
+ # surrogate *pair*
+ self.assert_(len(buffer(ua_scalar)) == 2*2*self.ulen)
+ else:
+ # In UCS2, the \uFFFF will be represented using a
+ # regular 2-byte word
+ self.assert_(len(buffer(ua_scalar)) == 2*self.ulen)
+
+ def check_values0D(self):
+ """Check assignment of 0-dimensional objects with values"""
+ ua = zeros((), dtype='U%s' % self.ulen)
+ ua[()] = self.ucs_value*self.ulen
+ self.content_test(ua, ua[()], 4*self.ulen)
+
+ def check_valuesSD(self):
+ """Check assignment of single-dimensional objects with values"""
+ ua = zeros((2,), dtype='U%s' % self.ulen)
+ ua[0] = self.ucs_value*self.ulen
+ self.content_test(ua, ua[0], 4*self.ulen*2)
+ ua[1] = self.ucs_value*self.ulen
+ self.content_test(ua, ua[1], 4*self.ulen*2)
+
+ def check_valuesMD(self):
+ """Check assignment of multi-dimensional objects with values"""
+ ua = zeros((2,3,4), dtype='U%s' % self.ulen)
+ ua[0,0,0] = self.ucs_value*self.ulen
+ self.content_test(ua, ua[0,0,0], 4*self.ulen*2*3*4)
+ ua[-1,-1,-1] = self.ucs_value*self.ulen
+ self.content_test(ua, ua[-1,-1,-1], 4*self.ulen*2*3*4)
+
+
+class test_assign_values_1_ucs2(assign_values):
+ """Check the assignment of valued arrays (size 1, UCS2 values)"""
+ ulen = 1
+ ucs_value = ucs2_value
+
+class test_assign_values_1_ucs4(assign_values):
+ """Check the assignment of valued arrays (size 1, UCS4 values)"""
+ ulen = 1
+ ucs_value = ucs4_value
+
+class test_assign_values_2_ucs2(assign_values):
+ """Check the assignment of valued arrays (size 2, UCS2 values)"""
+ ulen = 2
+ ucs_value = ucs2_value
+
+class test_assign_values_2_ucs4(assign_values):
+ """Check the assignment of valued arrays (size 2, UCS4 values)"""
+ ulen = 2
+ ucs_value = ucs4_value
+
+class test_assign_values_1009_ucs2(assign_values):
+ """Check the assignment of valued arrays (size 1009, UCS2 values)"""
+ ulen = 1009
+ ucs_value = ucs2_value
+
+class test_assign_values_1009_ucs4(assign_values):
+ """Check the assignment of valued arrays (size 1009, UCS4 values)"""
+ ulen = 1009
+ ucs_value = ucs4_value
+
+
+############################################################
+# Byteorder tests
+############################################################
+
+class byteorder_values(NumpyTestCase):
+ """Check the byteorder of unicode arrays in round-trip conversions"""
+
+ def check_values0D(self):
+ """Check byteorder of 0-dimensional objects"""
+ ua = array(self.ucs_value*self.ulen, dtype='U%s' % self.ulen)
+ ua2 = ua.newbyteorder()
+ # This changes the interpretation of the data region (but not the
+ # actual data), therefore the returned scalars are not
+ # the same (they are byte-swapped versions of each other).
+ self.assert_(ua[()] != ua2[()])
+ ua3 = ua2.newbyteorder()
+ # Arrays must be equal after the round-trip
+ assert_equal(ua, ua3)
+
+ def check_valuesSD(self):
+ """Check byteorder of single-dimensional objects"""
+ ua = array([self.ucs_value*self.ulen]*2, dtype='U%s' % self.ulen)
+ ua2 = ua.newbyteorder()
+ self.assert_(ua[0] != ua2[0])
+ self.assert_(ua[-1] != ua2[-1])
+ ua3 = ua2.newbyteorder()
+ # Arrays must be equal after the round-trip
+ assert_equal(ua, ua3)
+
+ def check_valuesMD(self):
+ """Check byteorder of multi-dimensional objects"""
+ ua = array([[[self.ucs_value*self.ulen]*2]*3]*4,
+ dtype='U%s' % self.ulen)
+ ua2 = ua.newbyteorder()
+ self.assert_(ua[0,0,0] != ua2[0,0,0])
+ self.assert_(ua[-1,-1,-1] != ua2[-1,-1,-1])
+ ua3 = ua2.newbyteorder()
+ # Arrays must be equal after the round-trip
+ assert_equal(ua, ua3)
+
+class test_byteorder_1_ucs2(byteorder_values):
+ """Check the byteorder in unicode (size 1, UCS2 values)"""
+ ulen = 1
+ ucs_value = ucs2_value
+
+class test_byteorder_1_ucs4(byteorder_values):
+ """Check the byteorder in unicode (size 1, UCS4 values)"""
+ ulen = 1
+ ucs_value = ucs4_value
+
+class test_byteorder_2_ucs2(byteorder_values):
+ """Check the byteorder in unicode (size 2, UCS2 values)"""
+ ulen = 2
+ ucs_value = ucs2_value
+
+class test_byteorder_2_ucs4(byteorder_values):
+ """Check the byteorder in unicode (size 2, UCS4 values)"""
+ ulen = 2
+ ucs_value = ucs4_value
+
+class test_byteorder_1009_ucs2(byteorder_values):
+ """Check the byteorder in unicode (size 1009, UCS2 values)"""
+ ulen = 1009
+ ucs_value = ucs2_value
+
+class test_byteorder_1009_ucs4(byteorder_values):
+ """Check the byteorder in unicode (size 1009, UCS4 values)"""
+ ulen = 1009
+ ucs_value = ucs4_value
+
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/core/tests/testdata.fits b/numpy/core/tests/testdata.fits
new file mode 100644
index 000000000..ca48ee851
--- /dev/null
+++ b/numpy/core/tests/testdata.fits
Binary files differ
diff --git a/numpy/ctypeslib.py b/numpy/ctypeslib.py
new file mode 100644
index 000000000..82f6a91df
--- /dev/null
+++ b/numpy/ctypeslib.py
@@ -0,0 +1,165 @@
+__all__ = ['load_library', 'ndpointer', 'test', 'ctypes_load_library',
+ 'c_intp']
+
+import sys, os
+from numpy import integer, ndarray, dtype as _dtype, deprecate
+from numpy.core.multiarray import _flagdict, flagsobj
+
+try:
+ import ctypes
+except ImportError:
+ ctypes = None
+
+if ctypes is None:
+ def _dummy(*args, **kwds):
+ raise ImportError, "ctypes is not available."
+ ctypes_load_library = _dummy
+ load_library = _dummy
+ from numpy import intp as c_intp
+else:
+ import numpy.core._internal as nic
+ c_intp = nic._getintp_ctype()
+ del nic
+
+ # Adapted from Albert Strasheim
+ def load_library(libname, loader_path):
+ if ctypes.__version__ < '1.0.1':
+ import warnings
+ warnings.warn("All features of ctypes interface may not work " \
+ "with ctypes < 1.0.1")
+ if '.' not in libname:
+ if sys.platform == 'win32':
+ libname = '%s.dll' % libname
+ elif sys.platform == 'darwin':
+ libname = '%s.dylib' % libname
+ else:
+ libname = '%s.so' % libname
+ loader_path = os.path.abspath(loader_path)
+ if not os.path.isdir(loader_path):
+ libdir = os.path.dirname(loader_path)
+ else:
+ libdir = loader_path
+ libpath = os.path.join(libdir, libname)
+ return ctypes.cdll[libpath]
+
+ ctypes_load_library = deprecate(load_library, 'ctypes_load_library',
+ 'load_library')
+
+def _num_fromflags(flaglist):
+ num = 0
+ for val in flaglist:
+ num += _flagdict[val]
+ return num
+
+_flagnames = ['C_CONTIGUOUS', 'F_CONTIGUOUS', 'ALIGNED', 'WRITEABLE',
+ 'OWNDATA', 'UPDATEIFCOPY']
+def _flags_fromnum(num):
+ res = []
+ for key in _flagnames:
+ value = _flagdict[key]
+ if (num & value):
+ res.append(key)
+ return res
+
+
+class _ndptr(object):
+ def from_param(cls, obj):
+ if not isinstance(obj, ndarray):
+ raise TypeError, "argument must be an ndarray"
+ if cls._dtype_ is not None \
+ and obj.dtype != cls._dtype_:
+ raise TypeError, "array must have data type %s" % cls._dtype_
+ if cls._ndim_ is not None \
+ and obj.ndim != cls._ndim_:
+ raise TypeError, "array must have %d dimension(s)" % cls._ndim_
+ if cls._shape_ is not None \
+ and obj.shape != cls._shape_:
+ raise TypeError, "array must have shape %s" % str(cls._shape_)
+ if cls._flags_ is not None \
+ and ((obj.flags.num & cls._flags_) != cls._flags_):
+ raise TypeError, "array must have flags %s" % \
+ _flags_fromnum(cls._flags_)
+ return obj.ctypes
+ from_param = classmethod(from_param)
+
+
+# Factory for an array-checking class with from_param defined for
+# use with ctypes argtypes mechanism
+_pointer_type_cache = {}
+def ndpointer(dtype=None, ndim=None, shape=None, flags=None):
+ """Array-checking restype/argtypes.
+
+ An ndpointer instance is used to describe an ndarray in restypes
+ and argtypes specifications. This approach is more flexible than
+ using, for example,
+
+ POINTER(c_double)
+
+ since several restrictions can be specified, which are verified
+ upon calling the ctypes function. These include data type
+ (dtype), number of dimensions (ndim), shape and flags (e.g.
+ 'C_CONTIGUOUS' or 'F_CONTIGUOUS'). If a given array does not satisfy the
+ specified restrictions, a TypeError is raised.
+
+ Example:
+
+ clib.somefunc.argtypes = [ndpointer(dtype=float64,
+ ndim=1,
+ flags='C_CONTIGUOUS')]
+ clib.somefunc(array([1,2,3],dtype=float64))
+
+ """
+
+ if dtype is not None:
+ dtype = _dtype(dtype)
+ num = None
+ if flags is not None:
+ if isinstance(flags, str):
+ flags = flags.split(',')
+ elif isinstance(flags, (int, integer)):
+ num = flags
+ flags = _flags_fromnum(num)
+ elif isinstance(flags, flagsobj):
+ num = flags.num
+ flags = _flags_fromnum(num)
+ if num is None:
+ try:
+ flags = [x.strip().upper() for x in flags]
+ except:
+ raise TypeError, "invalid flags specification"
+ num = _num_fromflags(flags)
+ try:
+ return _pointer_type_cache[(dtype, ndim, shape, num)]
+ except KeyError:
+ pass
+ if dtype is None:
+ name = 'any'
+ elif dtype.names:
+ name = str(id(dtype))
+ else:
+ name = dtype.str
+ if ndim is not None:
+ name += "_%dd" % ndim
+ if shape is not None:
+ try:
+ strshape = [str(x) for x in shape]
+ except TypeError:
+ strshape = [str(shape)]
+ shape = (shape,)
+ shape = tuple(shape)
+ name += "_"+"x".join(strshape)
+ if flags is not None:
+ name += "_"+"_".join(flags)
+ else:
+ flags = []
+ klass = type("ndpointer_%s"%name, (_ndptr,),
+ {"_dtype_": dtype,
+ "_shape_" : shape,
+ "_ndim_" : ndim,
+ "_flags_" : num})
+ _pointer_type_cache[dtype] = klass
+ return klass
+
+def test(level=1, verbosity=1):
+ from numpy.testing import NumpyTest
+ return NumpyTest().test(level, verbosity)
diff --git a/numpy/distutils/__init__.py b/numpy/distutils/__init__.py
new file mode 100644
index 000000000..3af26ac41
--- /dev/null
+++ b/numpy/distutils/__init__.py
@@ -0,0 +1,19 @@
+
+from __version__ import version as __version__
+# Must import local ccompiler ASAP in order to get
+# customized CCompiler.spawn effective.
+import ccompiler
+import unixccompiler
+
+from info import __doc__
+
+try:
+ import __config__
+ _INSTALLED = True
+except ImportError:
+ _INSTALLED = False
+
+if _INSTALLED:
+ def test(level=1, verbosity=1):
+ from numpy.testing import NumpyTest
+ return NumpyTest().test(level, verbosity)
diff --git a/numpy/distutils/__version__.py b/numpy/distutils/__version__.py
new file mode 100644
index 000000000..06077f79c
--- /dev/null
+++ b/numpy/distutils/__version__.py
@@ -0,0 +1,4 @@
+major = 0
+minor = 4
+micro = 0
+version = '%(major)d.%(minor)d.%(micro)d' % (locals())
diff --git a/numpy/distutils/ccompiler.py b/numpy/distutils/ccompiler.py
new file mode 100644
index 000000000..bf077bacc
--- /dev/null
+++ b/numpy/distutils/ccompiler.py
@@ -0,0 +1,436 @@
+import re
+import os
+import sys
+import new
+
+from distutils.ccompiler import *
+from distutils import ccompiler
+from distutils.sysconfig import customize_compiler
+from distutils.version import LooseVersion
+
+from numpy.distutils import log
+from numpy.distutils.exec_command import exec_command
+from numpy.distutils.misc_util import cyg2win32, is_sequence, mingw32
+from distutils.spawn import _nt_quote_args
+
+# hack to set compiler optimizing options. Needs to integrated with something.
+import distutils.sysconfig
+_old_init_posix = distutils.sysconfig._init_posix
+def _new_init_posix():
+ _old_init_posix()
+ distutils.sysconfig._config_vars['OPT'] = '-Wall -g -O0'
+#distutils.sysconfig._init_posix = _new_init_posix
+
+def replace_method(klass, method_name, func):
+ m = new.instancemethod(func, None, klass)
+ setattr(klass, method_name, m)
+
+# Using customized CCompiler.spawn.
+def CCompiler_spawn(self, cmd, display=None):
+ if display is None:
+ display = cmd
+ if is_sequence(display):
+ display = ' '.join(list(display))
+ log.info(display)
+ if is_sequence(cmd) and os.name == 'nt':
+ cmd = _nt_quote_args(list(cmd))
+ s,o = exec_command(cmd)
+ if s:
+ if is_sequence(cmd):
+ cmd = ' '.join(list(cmd))
+ print o
+ raise DistutilsExecError,\
+ 'Command "%s" failed with exit status %d' % (cmd, s)
+
+replace_method(CCompiler, 'spawn', CCompiler_spawn)
+
+def CCompiler_object_filenames(self, source_filenames, strip_dir=0, output_dir=''):
+ if output_dir is None:
+ output_dir = ''
+ obj_names = []
+ for src_name in source_filenames:
+ base, ext = os.path.splitext(os.path.normpath(src_name))
+ base = os.path.splitdrive(base)[1] # Chop off the drive
+ base = base[os.path.isabs(base):] # If abs, chop off leading /
+ if base.startswith('..'):
+ # Resolve starting relative path components, middle ones
+ # (if any) have been handled by os.path.normpath above.
+ i = base.rfind('..')+2
+ d = base[:i]
+ d = os.path.basename(os.path.abspath(d))
+ base = d + base[i:]
+ if ext not in self.src_extensions:
+ raise UnknownFileError, \
+ "unknown file type '%s' (from '%s')" % (ext, src_name)
+ if strip_dir:
+ base = os.path.basename(base)
+ obj_name = os.path.join(output_dir,base + self.obj_extension)
+ obj_names.append(obj_name)
+ return obj_names
+
+replace_method(CCompiler, 'object_filenames', CCompiler_object_filenames)
+
+def CCompiler_compile(self, sources, output_dir=None, macros=None,
+ include_dirs=None, debug=0, extra_preargs=None,
+ extra_postargs=None, depends=None):
+ # This method is effective only with Python >=2.3 distutils.
+ # Any changes here should be applied also to fcompiler.compile
+ # method to support pre Python 2.3 distutils.
+ if not sources:
+ return []
+ from fcompiler import FCompiler
+ if isinstance(self, FCompiler):
+ display = []
+ for fc in ['f77','f90','fix']:
+ fcomp = getattr(self,'compiler_'+fc)
+ if fcomp is None:
+ continue
+ display.append("Fortran %s compiler: %s" % (fc, ' '.join(fcomp)))
+ display = '\n'.join(display)
+ else:
+ ccomp = self.compiler_so
+ display = "C compiler: %s\n" % (' '.join(ccomp),)
+ log.info(display)
+ macros, objects, extra_postargs, pp_opts, build = \
+ self._setup_compile(output_dir, macros, include_dirs, sources,
+ depends, extra_postargs)
+ cc_args = self._get_cc_args(pp_opts, debug, extra_preargs)
+ display = "compile options: '%s'" % (' '.join(cc_args))
+ if extra_postargs:
+ display += "\nextra options: '%s'" % (' '.join(extra_postargs))
+ log.info(display)
+
+ # build any sources in same order as they were originally specified
+ # especially important for fortran .f90 files using modules
+ if isinstance(self, FCompiler):
+ objects_to_build = build.keys()
+ for obj in objects:
+ if obj in objects_to_build:
+ src, ext = build[obj]
+ if self.compiler_type=='absoft':
+ obj = cyg2win32(obj)
+ src = cyg2win32(src)
+ self._compile(obj, src, ext, cc_args, extra_postargs, pp_opts)
+ else:
+ for obj, (src, ext) in build.items():
+ self._compile(obj, src, ext, cc_args, extra_postargs, pp_opts)
+
+ # Return *all* object filenames, not just the ones we just built.
+ return objects
+
+replace_method(CCompiler, 'compile', CCompiler_compile)
+
+def CCompiler_customize_cmd(self, cmd):
+ """ Customize compiler using distutils command.
+ """
+ log.info('customize %s using %s' % (self.__class__.__name__,
+ cmd.__class__.__name__))
+ if getattr(cmd,'include_dirs',None) is not None:
+ self.set_include_dirs(cmd.include_dirs)
+ if getattr(cmd,'define',None) is not None:
+ for (name,value) in cmd.define:
+ self.define_macro(name, value)
+ if getattr(cmd,'undef',None) is not None:
+ for macro in cmd.undef:
+ self.undefine_macro(macro)
+ if getattr(cmd,'libraries',None) is not None:
+ self.set_libraries(self.libraries + cmd.libraries)
+ if getattr(cmd,'library_dirs',None) is not None:
+ self.set_library_dirs(self.library_dirs + cmd.library_dirs)
+ if getattr(cmd,'rpath',None) is not None:
+ self.set_runtime_library_dirs(cmd.rpath)
+ if getattr(cmd,'link_objects',None) is not None:
+ self.set_link_objects(cmd.link_objects)
+ return
+
+replace_method(CCompiler, 'customize_cmd', CCompiler_customize_cmd)
+
+def _compiler_to_string(compiler):
+ props = []
+ mx = 0
+ keys = compiler.executables.keys()
+ for key in ['version','libraries','library_dirs',
+ 'object_switch','compile_switch',
+ 'include_dirs','define','undef','rpath','link_objects']:
+ if key not in keys:
+ keys.append(key)
+ for key in keys:
+ if hasattr(compiler,key):
+ v = getattr(compiler, key)
+ mx = max(mx,len(key))
+ props.append((key,repr(v)))
+ lines = []
+ format = '%-' + repr(mx+1) + 's = %s'
+ for prop in props:
+ lines.append(format % prop)
+ return '\n'.join(lines)
+
+def CCompiler_show_customization(self):
+ if 0:
+ for attrname in ['include_dirs','define','undef',
+ 'libraries','library_dirs',
+ 'rpath','link_objects']:
+ attr = getattr(self,attrname,None)
+ if not attr:
+ continue
+ log.info("compiler '%s' is set to %s" % (attrname,attr))
+ try: self.get_version()
+ except: pass
+ if log._global_log.threshold<2:
+ print '*'*80
+ print self.__class__
+ print _compiler_to_string(self)
+ print '*'*80
+
+replace_method(CCompiler, 'show_customization', CCompiler_show_customization)
+
+def CCompiler_customize(self, dist, need_cxx=0):
+ # See FCompiler.customize for suggested usage.
+ log.info('customize %s' % (self.__class__.__name__))
+ customize_compiler(self)
+ if need_cxx:
+ # In general, distutils uses -Wstrict-prototypes, but this option is
+ # not valid for C++ code, only for C. Remove it if it's there to
+ # avoid a spurious warning on every compilation. All the default
+ # options used by distutils can be extracted with:
+
+ # from distutils import sysconfig
+ # sysconfig.get_config_vars('CC', 'CXX', 'OPT', 'BASECFLAGS',
+ # 'CCSHARED', 'LDSHARED', 'SO')
+ try:
+ self.compiler_so.remove('-Wstrict-prototypes')
+ except (AttributeError, ValueError):
+ pass
+
+ if hasattr(self,'compiler') and self.compiler[0].find('cc')>=0:
+ if not self.compiler_cxx:
+ if self.compiler[0].startswith('gcc'):
+ a, b = 'gcc', 'g++'
+ else:
+ a, b = 'cc', 'c++'
+ self.compiler_cxx = [self.compiler[0].replace(a,b)]\
+ + self.compiler[1:]
+ else:
+ if hasattr(self,'compiler'):
+ log.warn("#### %s #######" % (self.compiler,))
+ log.warn('Missing compiler_cxx fix for '+self.__class__.__name__)
+ return
+
+replace_method(CCompiler, 'customize', CCompiler_customize)
+
+def simple_version_match(pat=r'[-.\d]+', ignore='', start=''):
+ """
+ Simple matching of version numbers, for use in CCompiler and FCompiler
+ classes.
+
+ :Parameters:
+ pat : regex matching version numbers.
+ ignore : false or regex matching expressions to skip over.
+ start : false or regex matching the start of where to start looking
+ for version numbers.
+
+ :Returns:
+ A function that is appropiate to use as the .version_match
+ attribute of a CCompiler class.
+ """
+ def matcher(self, version_string):
+ pos = 0
+ if start:
+ m = re.match(start, version_string)
+ if not m:
+ return None
+ pos = m.end()
+ while 1:
+ m = re.search(pat, version_string[pos:])
+ if not m:
+ return None
+ if ignore and re.match(ignore, m.group(0)):
+ pos = m.end()
+ continue
+ break
+ return m.group(0)
+ return matcher
+
+def CCompiler_get_version(self, force=0, ok_status=[0]):
+ """ Compiler version. Returns None if compiler is not available. """
+ if not force and hasattr(self,'version'):
+ return self.version
+ try:
+ version_cmd = self.version_cmd
+ except AttributeError:
+ return None
+ if not version_cmd or not version_cmd[0]:
+ return None
+ cmd = ' '.join(version_cmd)
+ try:
+ matcher = self.version_match
+ except AttributeError:
+ try:
+ pat = self.version_pattern
+ except AttributeError:
+ return None
+ def matcher(version_string):
+ m = re.match(pat, version_string)
+ if not m:
+ return None
+ version = m.group('version')
+ return version
+
+ status, output = exec_command(cmd,use_tee=0)
+ version = None
+ if status in ok_status:
+ version = matcher(output)
+ if version:
+ version = LooseVersion(version)
+ self.version = version
+ return version
+
+replace_method(CCompiler, 'get_version', CCompiler_get_version)
+
+def CCompiler_cxx_compiler(self):
+ if self.compiler_type=='msvc': return self
+ cxx = copy(self)
+ cxx.compiler_so = [cxx.compiler_cxx[0]] + cxx.compiler_so[1:]
+ if sys.platform.startswith('aix') and 'ld_so_aix' in cxx.linker_so[0]:
+ # AIX needs the ld_so_aix script included with Python
+ cxx.linker_so = [cxx.linker_so[0]] + cxx.compiler_cxx[0] \
+ + cxx.linker_so[2:]
+ else:
+ cxx.linker_so = [cxx.compiler_cxx[0]] + cxx.linker_so[1:]
+ return cxx
+
+replace_method(CCompiler, 'cxx_compiler', CCompiler_cxx_compiler)
+
+compiler_class['intel'] = ('intelccompiler','IntelCCompiler',
+ "Intel C Compiler for 32-bit applications")
+compiler_class['intele'] = ('intelccompiler','IntelItaniumCCompiler',
+ "Intel C Itanium Compiler for Itanium-based applications")
+ccompiler._default_compilers += (('linux.*','intel'),('linux.*','intele'))
+
+if sys.platform == 'win32':
+ compiler_class['mingw32'] = ('mingw32ccompiler', 'Mingw32CCompiler',
+ "Mingw32 port of GNU C Compiler for Win32"\
+ "(for MSC built Python)")
+ if mingw32():
+ # On windows platforms, we want to default to mingw32 (gcc)
+ # because msvc can't build blitz stuff.
+ log.info('Setting mingw32 as default compiler for nt.')
+ ccompiler._default_compilers = (('nt', 'mingw32'),) \
+ + ccompiler._default_compilers
+
+
+_distutils_new_compiler = new_compiler
+def new_compiler (plat=None,
+ compiler=None,
+ verbose=0,
+ dry_run=0,
+ force=0):
+ # Try first C compilers from numpy.distutils.
+ if plat is None:
+ plat = os.name
+ try:
+ if compiler is None:
+ compiler = get_default_compiler(plat)
+ (module_name, class_name, long_description) = compiler_class[compiler]
+ except KeyError:
+ msg = "don't know how to compile C/C++ code on platform '%s'" % plat
+ if compiler is not None:
+ msg = msg + " with '%s' compiler" % compiler
+ raise DistutilsPlatformError, msg
+ module_name = "numpy.distutils." + module_name
+ try:
+ __import__ (module_name)
+ except ImportError, msg:
+ log.info('%s in numpy.distutils; trying from distutils',
+ str(msg))
+ module_name = module_name[6:]
+ try:
+ __import__(module_name)
+ except ImportError, msg:
+ raise DistutilsModuleError, \
+ "can't compile C/C++ code: unable to load module '%s'" % \
+ module_name
+ try:
+ module = sys.modules[module_name]
+ klass = vars(module)[class_name]
+ except KeyError:
+ raise DistutilsModuleError, \
+ ("can't compile C/C++ code: unable to find class '%s' " +
+ "in module '%s'") % (class_name, module_name)
+ compiler = klass(None, dry_run, force)
+ log.debug('new_compiler returns %s' % (klass))
+ return compiler
+
+ccompiler.new_compiler = new_compiler
+
+
+_distutils_gen_lib_options = gen_lib_options
+def gen_lib_options(compiler, library_dirs, runtime_library_dirs, libraries):
+ r = _distutils_gen_lib_options(compiler, library_dirs,
+ runtime_library_dirs, libraries)
+ lib_opts = []
+ for i in r:
+ if is_sequence(i):
+ lib_opts.extend(list(i))
+ else:
+ lib_opts.append(i)
+ return lib_opts
+ccompiler.gen_lib_options = gen_lib_options
+
+
+##Fix distutils.util.split_quoted:
+import re,string
+_wordchars_re = re.compile(r'[^\\\'\"%s ]*' % string.whitespace)
+_squote_re = re.compile(r"'(?:[^'\\]|\\.)*'")
+_dquote_re = re.compile(r'"(?:[^"\\]|\\.)*"')
+_has_white_re = re.compile(r'\s')
+def split_quoted(s):
+ s = string.strip(s)
+ words = []
+ pos = 0
+
+ while s:
+ m = _wordchars_re.match(s, pos)
+ end = m.end()
+ if end == len(s):
+ words.append(s[:end])
+ break
+
+ if s[end] in string.whitespace: # unescaped, unquoted whitespace: now
+ words.append(s[:end]) # we definitely have a word delimiter
+ s = string.lstrip(s[end:])
+ pos = 0
+
+ elif s[end] == '\\': # preserve whatever is being escaped;
+ # will become part of the current word
+ s = s[:end] + s[end+1:]
+ pos = end+1
+
+ else:
+ if s[end] == "'": # slurp singly-quoted string
+ m = _squote_re.match(s, end)
+ elif s[end] == '"': # slurp doubly-quoted string
+ m = _dquote_re.match(s, end)
+ else:
+ raise RuntimeError, \
+ "this can't happen (bad char '%c')" % s[end]
+
+ if m is None:
+ raise ValueError, \
+ "bad string (mismatched %s quotes?)" % s[end]
+
+ (beg, end) = m.span()
+ if _has_white_re.search(s[beg+1:end-1]):
+ s = s[:beg] + s[beg+1:end-1] + s[end:]
+ pos = m.end() - 2
+ else:
+ # Keeping quotes when a quoted word does not contain
+ # white-space. XXX: send a patch to distutils
+ pos = m.end()
+
+ if pos >= len(s):
+ words.append(s)
+ break
+
+ return words
+ccompiler.split_quoted = split_quoted
diff --git a/numpy/distutils/command/__init__.py b/numpy/distutils/command/__init__.py
new file mode 100644
index 000000000..dfe81d542
--- /dev/null
+++ b/numpy/distutils/command/__init__.py
@@ -0,0 +1,31 @@
+"""distutils.command
+
+Package containing implementation of all the standard Distutils
+commands."""
+
+__revision__ = "$Id: __init__.py,v 1.3 2005/05/16 11:08:49 pearu Exp $"
+
+distutils_all = [ 'build_py',
+ 'clean',
+ 'install_lib',
+ 'install_scripts',
+ 'bdist',
+ 'bdist_dumb',
+ 'bdist_wininst',
+ ]
+
+__import__('distutils.command',globals(),locals(),distutils_all)
+
+__all__ = ['build',
+ 'config_compiler',
+ 'config',
+ 'build_src',
+ 'build_ext',
+ 'build_clib',
+ 'build_scripts',
+ 'install',
+ 'install_data',
+ 'install_headers',
+ 'bdist_rpm',
+ 'sdist',
+ ] + distutils_all
diff --git a/numpy/distutils/command/bdist_rpm.py b/numpy/distutils/command/bdist_rpm.py
new file mode 100644
index 000000000..593dfe878
--- /dev/null
+++ b/numpy/distutils/command/bdist_rpm.py
@@ -0,0 +1,19 @@
+import os
+import sys
+from distutils.command.bdist_rpm import bdist_rpm as old_bdist_rpm
+
+class bdist_rpm(old_bdist_rpm):
+
+ def _make_spec_file(self):
+ spec_file = old_bdist_rpm._make_spec_file(self)
+
+ # Replace hardcoded setup.py script name
+ # with the real setup script name.
+ setup_py = os.path.basename(sys.argv[0])
+ if setup_py == 'setup.py':
+ return spec_file
+ new_spec_file = []
+ for line in spec_file:
+ line = line.replace('setup.py',setup_py)
+ new_spec_file.append(line)
+ return new_spec_file
diff --git a/numpy/distutils/command/build.py b/numpy/distutils/command/build.py
new file mode 100644
index 000000000..1f5c08205
--- /dev/null
+++ b/numpy/distutils/command/build.py
@@ -0,0 +1,34 @@
+import os
+import sys
+from distutils.command.build import build as old_build
+from distutils.util import get_platform
+from numpy.distutils.command.config_compiler import show_fortran_compilers
+
+class build(old_build):
+
+ sub_commands = [('config_cc', lambda *args: True),
+ ('config_fc', lambda *args: True),
+ ('build_src', old_build.has_ext_modules),
+ ] + old_build.sub_commands
+
+ user_options = old_build.user_options + [
+ ('fcompiler=', None,
+ "specify the Fortran compiler type"),
+ ]
+
+ help_options = old_build.help_options + [
+ ('help-fcompiler',None, "list available Fortran compilers",
+ show_fortran_compilers),
+ ]
+
+ def initialize_options(self):
+ old_build.initialize_options(self)
+ self.fcompiler = None
+
+ def finalize_options(self):
+ build_scripts = self.build_scripts
+ old_build.finalize_options(self)
+ plat_specifier = ".%s-%s" % (get_platform(), sys.version[0:3])
+ if build_scripts is None:
+ self.build_scripts = os.path.join(self.build_base,
+ 'scripts' + plat_specifier)
diff --git a/numpy/distutils/command/build_clib.py b/numpy/distutils/command/build_clib.py
new file mode 100644
index 000000000..02e88a204
--- /dev/null
+++ b/numpy/distutils/command/build_clib.py
@@ -0,0 +1,250 @@
+""" Modified version of build_clib that handles fortran source files.
+"""
+
+import os
+from distutils.command.build_clib import build_clib as old_build_clib
+from distutils.errors import DistutilsSetupError, DistutilsError
+
+from numpy.distutils import log
+from distutils.dep_util import newer_group
+from numpy.distutils.misc_util import filter_sources, has_f_sources,\
+ has_cxx_sources, all_strings, get_lib_source_files, is_sequence
+
+# Fix Python distutils bug sf #1718574:
+_l = old_build_clib.user_options
+for _i in range(len(_l)):
+ if _l[_i][0] in ['build-clib', 'build-temp']:
+ _l[_i] = (_l[_i][0]+'=',)+_l[_i][1:]
+#
+
+class build_clib(old_build_clib):
+
+ description = "build C/C++/F libraries used by Python extensions"
+
+ user_options = old_build_clib.user_options + [
+ ('fcompiler=', None,
+ "specify the Fortran compiler type"),
+ ]
+
+ def initialize_options(self):
+ old_build_clib.initialize_options(self)
+ self.fcompiler = None
+ return
+
+ def have_f_sources(self):
+ for (lib_name, build_info) in self.libraries:
+ if has_f_sources(build_info.get('sources',[])):
+ return True
+ return False
+
+ def have_cxx_sources(self):
+ for (lib_name, build_info) in self.libraries:
+ if has_cxx_sources(build_info.get('sources',[])):
+ return True
+ return False
+
+ def run(self):
+ if not self.libraries:
+ return
+
+ # Make sure that library sources are complete.
+ languages = []
+ for (lib_name, build_info) in self.libraries:
+ if not all_strings(build_info.get('sources',[])):
+ self.run_command('build_src')
+ l = build_info.get('language',None)
+ if l and l not in languages: languages.append(l)
+
+ from distutils.ccompiler import new_compiler
+ self.compiler = new_compiler(compiler=self.compiler,
+ dry_run=self.dry_run,
+ force=self.force)
+ self.compiler.customize(self.distribution,
+ need_cxx=self.have_cxx_sources())
+
+ libraries = self.libraries
+ self.libraries = None
+ self.compiler.customize_cmd(self)
+ self.libraries = libraries
+
+ self.compiler.show_customization()
+
+ if self.have_f_sources():
+ from numpy.distutils.fcompiler import new_fcompiler
+ self.fcompiler = new_fcompiler(compiler=self.fcompiler,
+ verbose=self.verbose,
+ dry_run=self.dry_run,
+ force=self.force,
+ requiref90='f90' in languages)
+ self.fcompiler.customize(self.distribution)
+
+ libraries = self.libraries
+ self.libraries = None
+ self.fcompiler.customize_cmd(self)
+ self.libraries = libraries
+
+ self.fcompiler.show_customization()
+
+ self.build_libraries(self.libraries)
+
+ def get_source_files(self):
+ self.check_library_list(self.libraries)
+ filenames = []
+ for lib in self.libraries:
+ filenames.extend(get_lib_source_files(lib))
+ return filenames
+
+ def build_libraries(self, libraries):
+ for (lib_name, build_info) in libraries:
+ # default compilers
+ compiler = self.compiler
+ fcompiler = self.fcompiler
+
+ sources = build_info.get('sources')
+ if sources is None or not is_sequence(sources):
+ raise DistutilsSetupError, \
+ ("in 'libraries' option (library '%s'), " +
+ "'sources' must be present and must be " +
+ "a list of source filenames") % lib_name
+ sources = list(sources)
+
+ c_sources, cxx_sources, f_sources, fmodule_sources \
+ = filter_sources(sources)
+ requiref90 = not not fmodule_sources or \
+ build_info.get('language','c')=='f90'
+
+ # save source type information so that build_ext can use it.
+ source_languages = []
+ if c_sources: source_languages.append('c')
+ if cxx_sources: source_languages.append('c++')
+ if requiref90: source_languages.append('f90')
+ elif f_sources: source_languages.append('f77')
+ build_info['source_languages'] = source_languages
+
+ lib_file = compiler.library_filename(lib_name,
+ output_dir=self.build_clib)
+ depends = sources + build_info.get('depends',[])
+ if not (self.force or newer_group(depends, lib_file, 'newer')):
+ log.debug("skipping '%s' library (up-to-date)", lib_name)
+ continue
+ else:
+ log.info("building '%s' library", lib_name)
+
+ config_fc = build_info.get('config_fc',{})
+ if fcompiler is not None and config_fc:
+ log.info('using additional config_fc from setup script '\
+ 'for fortran compiler: %s' \
+ % (config_fc,))
+ from numpy.distutils.fcompiler import new_fcompiler
+ fcompiler = new_fcompiler(compiler=fcompiler.compiler_type,
+ verbose=self.verbose,
+ dry_run=self.dry_run,
+ force=self.force,
+ requiref90=requiref90)
+ dist = self.distribution
+ base_config_fc = dist.get_option_dict('config_fc').copy()
+ base_config_fc.update(config_fc)
+ fcompiler.customize(base_config_fc)
+
+ # check availability of Fortran compilers
+ if (f_sources or fmodule_sources) and fcompiler is None:
+ raise DistutilsError, "library %s has Fortran sources"\
+ " but no Fortran compiler found" % (lib_name)
+
+ macros = build_info.get('macros')
+ include_dirs = build_info.get('include_dirs')
+ extra_postargs = build_info.get('extra_compiler_args') or []
+
+ # where compiled F90 module files are:
+ module_dirs = build_info.get('module_dirs') or []
+ module_build_dir = os.path.dirname(lib_file)
+ if requiref90: self.mkpath(module_build_dir)
+
+ if compiler.compiler_type=='msvc':
+ # this hack works around the msvc compiler attributes
+ # problem, msvc uses its own convention :(
+ c_sources += cxx_sources
+ cxx_sources = []
+
+ objects = []
+ if c_sources:
+ log.info("compiling C sources")
+ objects = compiler.compile(c_sources,
+ output_dir=self.build_temp,
+ macros=macros,
+ include_dirs=include_dirs,
+ debug=self.debug,
+ extra_postargs=extra_postargs)
+
+ if cxx_sources:
+ log.info("compiling C++ sources")
+ cxx_compiler = compiler.cxx_compiler()
+ cxx_objects = cxx_compiler.compile(cxx_sources,
+ output_dir=self.build_temp,
+ macros=macros,
+ include_dirs=include_dirs,
+ debug=self.debug,
+ extra_postargs=extra_postargs)
+ objects.extend(cxx_objects)
+
+ if f_sources or fmodule_sources:
+ extra_postargs = []
+ f_objects = []
+
+ if requiref90:
+ if fcompiler.module_dir_switch is None:
+ existing_modules = glob('*.mod')
+ extra_postargs += fcompiler.module_options(\
+ module_dirs,module_build_dir)
+
+ if fmodule_sources:
+ log.info("compiling Fortran 90 module sources")
+ f_objects += fcompiler.compile(fmodule_sources,
+ output_dir=self.build_temp,
+ macros=macros,
+ include_dirs=include_dirs,
+ debug=self.debug,
+ extra_postargs=extra_postargs)
+
+ if requiref90 and self.fcompiler.module_dir_switch is None:
+ # move new compiled F90 module files to module_build_dir
+ for f in glob('*.mod'):
+ if f in existing_modules:
+ continue
+ t = os.path.join(module_build_dir, f)
+ if os.path.abspath(f)==os.path.abspath(t):
+ continue
+ if os.path.isfile(t):
+ os.remove(t)
+ try:
+ self.move_file(f, module_build_dir)
+ except DistutilsFileError:
+ log.warn('failed to move %r to %r' \
+ % (f, module_build_dir))
+
+ if f_sources:
+ log.info("compiling Fortran sources")
+ f_objects += fcompiler.compile(f_sources,
+ output_dir=self.build_temp,
+ macros=macros,
+ include_dirs=include_dirs,
+ debug=self.debug,
+ extra_postargs=extra_postargs)
+ else:
+ f_objects = []
+
+ objects.extend(f_objects)
+
+ # assume that default linker is suitable for
+ # linking Fortran object files
+ compiler.create_static_lib(objects, lib_name,
+ output_dir=self.build_clib,
+ debug=self.debug)
+
+ # fix library dependencies
+ clib_libraries = build_info.get('libraries',[])
+ for lname, binfo in libraries:
+ if lname in clib_libraries:
+ clib_libraries.extend(binfo[1].get('libraries',[]))
+ if clib_libraries:
+ build_info['libraries'] = clib_libraries
diff --git a/numpy/distutils/command/build_ext.py b/numpy/distutils/command/build_ext.py
new file mode 100644
index 000000000..6febe9124
--- /dev/null
+++ b/numpy/distutils/command/build_ext.py
@@ -0,0 +1,465 @@
+""" Modified version of build_ext that handles fortran source files.
+"""
+
+import os
+import sys
+from glob import glob
+
+from distutils.dep_util import newer_group
+from distutils.command.build_ext import build_ext as old_build_ext
+from distutils.errors import DistutilsFileError, DistutilsSetupError,\
+ DistutilsError
+from distutils.file_util import copy_file
+
+from numpy.distutils import log
+from numpy.distutils.exec_command import exec_command
+from numpy.distutils.system_info import combine_paths
+from numpy.distutils.misc_util import filter_sources, has_f_sources, \
+ has_cxx_sources, get_ext_source_files, \
+ get_numpy_include_dirs, is_sequence
+from numpy.distutils.command.config_compiler import show_fortran_compilers
+
+try:
+ set
+except NameError:
+ from sets import Set as set
+
+class build_ext (old_build_ext):
+
+ description = "build C/C++/F extensions (compile/link to build directory)"
+
+ user_options = old_build_ext.user_options + [
+ ('fcompiler=', None,
+ "specify the Fortran compiler type"),
+ ]
+
+ help_options = old_build_ext.help_options + [
+ ('help-fcompiler',None, "list available Fortran compilers",
+ show_fortran_compilers),
+ ]
+
+ def initialize_options(self):
+ old_build_ext.initialize_options(self)
+ self.fcompiler = None
+
+ def finalize_options(self):
+ incl_dirs = self.include_dirs
+ old_build_ext.finalize_options(self)
+ if incl_dirs is not None:
+ self.include_dirs.extend(self.distribution.include_dirs or [])
+
+ def run(self):
+ if not self.extensions:
+ return
+
+ # Make sure that extension sources are complete.
+ self.run_command('build_src')
+
+ if self.distribution.has_c_libraries():
+ self.run_command('build_clib')
+ build_clib = self.get_finalized_command('build_clib')
+ self.library_dirs.append(build_clib.build_clib)
+ else:
+ build_clib = None
+
+ # Not including C libraries to the list of
+ # extension libraries automatically to prevent
+ # bogus linking commands. Extensions must
+ # explicitly specify the C libraries that they use.
+
+ from distutils.ccompiler import new_compiler
+ from numpy.distutils.fcompiler import new_fcompiler
+
+ compiler_type = self.compiler
+ # Initialize C compiler:
+ self.compiler = new_compiler(compiler=compiler_type,
+ verbose=self.verbose,
+ dry_run=self.dry_run,
+ force=self.force)
+ self.compiler.customize(self.distribution)
+ self.compiler.customize_cmd(self)
+ self.compiler.show_customization()
+
+ # Create mapping of libraries built by build_clib:
+ clibs = {}
+ if build_clib is not None:
+ for libname,build_info in build_clib.libraries or []:
+ if clibs.has_key(libname):
+ log.warn('library %r defined more than once,'\
+ ' overwriting build_info %r with %r.' \
+ % (libname, clibs[libname], build_info))
+ clibs[libname] = build_info
+ # .. and distribution libraries:
+ for libname,build_info in self.distribution.libraries or []:
+ if clibs.has_key(libname):
+ # build_clib libraries have a precedence before distribution ones
+ continue
+ clibs[libname] = build_info
+
+ # Determine if C++/Fortran 77/Fortran 90 compilers are needed.
+ # Update extension libraries, library_dirs, and macros.
+ all_languages = set()
+ for ext in self.extensions:
+ ext_languages = set()
+ c_libs = []
+ c_lib_dirs = []
+ macros = []
+ for libname in ext.libraries:
+ if clibs.has_key(libname):
+ binfo = clibs[libname]
+ c_libs += binfo.get('libraries',[])
+ c_lib_dirs += binfo.get('library_dirs',[])
+ for m in binfo.get('macros',[]):
+ if m not in macros:
+ macros.append(m)
+ for l in clibs.get(libname,{}).get('source_languages',[]):
+ ext_languages.add(l)
+ if c_libs:
+ new_c_libs = ext.libraries + c_libs
+ log.info('updating extension %r libraries from %r to %r'
+ % (ext.name, ext.libraries, new_c_libs))
+ ext.libraries = new_c_libs
+ ext.library_dirs = ext.library_dirs + c_lib_dirs
+ if macros:
+ log.info('extending extension %r defined_macros with %r'
+ % (ext.name, macros))
+ ext.define_macros = ext.define_macros + macros
+
+ # determine extension languages
+ if has_f_sources(ext.sources):
+ ext_languages.add('f77')
+ if has_cxx_sources(ext.sources):
+ ext_languages.add('c++')
+ l = ext.language or self.compiler.detect_language(ext.sources)
+ if l:
+ ext_languages.add(l)
+ # reset language attribute for choosing proper linker
+ if 'c++' in ext_languages:
+ ext_language = 'c++'
+ elif 'f90' in ext_languages:
+ ext_language = 'f90'
+ elif 'f77' in ext_languages:
+ ext_language = 'f77'
+ else:
+ ext_language = 'c' # default
+ if l and l != ext_language and ext.language:
+ log.warn('resetting extension %r language from %r to %r.' %
+ (ext.name,l,ext_language))
+ ext.language = ext_language
+ # global language
+ all_languages.update(ext_languages)
+
+ need_f90_compiler = 'f90' in all_languages
+ need_f77_compiler = 'f77' in all_languages
+ need_cxx_compiler = 'c++' in all_languages
+
+ # Initialize C++ compiler:
+ if need_cxx_compiler:
+ self._cxx_compiler = new_compiler(compiler=compiler_type,
+ verbose=self.verbose,
+ dry_run=self.dry_run,
+ force=self.force)
+ compiler = self._cxx_compiler
+ compiler.customize(self.distribution,need_cxx=need_cxx_compiler)
+ compiler.customize_cmd(self)
+ compiler.show_customization()
+ self._cxx_compiler = compiler.cxx_compiler()
+ else:
+ self._cxx_compiler = None
+
+ # Initialize Fortran 77 compiler:
+ if need_f77_compiler:
+ self._f77_compiler = new_fcompiler(compiler=self.fcompiler,
+ verbose=self.verbose,
+ dry_run=self.dry_run,
+ force=self.force,
+ requiref90=False)
+ fcompiler = self._f77_compiler
+ if fcompiler.get_version():
+ fcompiler.customize(self.distribution)
+ fcompiler.customize_cmd(self)
+ fcompiler.show_customization()
+ else:
+ self.warn('f77_compiler=%s is not available.' %
+ (fcompiler.compiler_type))
+ self._f77_compiler = None
+ else:
+ self._f77_compiler = None
+
+ # Initialize Fortran 90 compiler:
+ if need_f90_compiler:
+ self._f90_compiler = new_fcompiler(compiler=self.fcompiler,
+ verbose=self.verbose,
+ dry_run=self.dry_run,
+ force=self.force,
+ requiref90=True)
+ fcompiler = self._f90_compiler
+ if fcompiler.get_version():
+ fcompiler.customize(self.distribution)
+ fcompiler.customize_cmd(self)
+ fcompiler.show_customization()
+ else:
+ self.warn('f90_compiler=%s is not available.' %
+ (fcompiler.compiler_type))
+ self._f90_compiler = None
+ else:
+ self._f90_compiler = None
+
+ # Build extensions
+ self.build_extensions()
+
+ def swig_sources(self, sources):
+ # Do nothing. Swig sources have beed handled in build_src command.
+ return sources
+
+ def build_extension(self, ext):
+ sources = ext.sources
+ if sources is None or not is_sequence(sources):
+ raise DistutilsSetupError(
+ ("in 'ext_modules' option (extension '%s'), " +
+ "'sources' must be present and must be " +
+ "a list of source filenames") % ext.name)
+ sources = list(sources)
+
+ if not sources:
+ return
+
+ fullname = self.get_ext_fullname(ext.name)
+ if self.inplace:
+ modpath = fullname.split('.')
+ package = '.'.join(modpath[0:-1])
+ base = modpath[-1]
+ build_py = self.get_finalized_command('build_py')
+ package_dir = build_py.get_package_dir(package)
+ ext_filename = os.path.join(package_dir,
+ self.get_ext_filename(base))
+ else:
+ ext_filename = os.path.join(self.build_lib,
+ self.get_ext_filename(fullname))
+ depends = sources + ext.depends
+
+ if not (self.force or newer_group(depends, ext_filename, 'newer')):
+ log.debug("skipping '%s' extension (up-to-date)", ext.name)
+ return
+ else:
+ log.info("building '%s' extension", ext.name)
+
+ extra_args = ext.extra_compile_args or []
+ macros = ext.define_macros[:]
+ for undef in ext.undef_macros:
+ macros.append((undef,))
+
+ c_sources, cxx_sources, f_sources, fmodule_sources = \
+ filter_sources(ext.sources)
+
+
+
+ if self.compiler.compiler_type=='msvc':
+ if cxx_sources:
+ # Needed to compile kiva.agg._agg extension.
+ extra_args.append('/Zm1000')
+ # this hack works around the msvc compiler attributes
+ # problem, msvc uses its own convention :(
+ c_sources += cxx_sources
+ cxx_sources = []
+
+ # Set Fortran/C++ compilers for compilation and linking.
+ if ext.language=='f90':
+ fcompiler = self._f90_compiler
+ elif ext.language=='f77':
+ fcompiler = self._f77_compiler
+ else: # in case ext.language is c++, for instance
+ fcompiler = self._f90_compiler or self._f77_compiler
+ cxx_compiler = self._cxx_compiler
+
+ # check for the availability of required compilers
+ if cxx_sources and cxx_compiler is None:
+ raise DistutilsError, "extension %r has C++ sources" \
+ "but no C++ compiler found" % (ext.name)
+ if (f_sources or fmodule_sources) and fcompiler is None:
+ raise DistutilsError, "extension %r has Fortran sources " \
+ "but no Fortran compiler found" % (ext.name)
+ if ext.language in ['f77','f90'] and fcompiler is None:
+ self.warn("extension %r has Fortran libraries " \
+ "but no Fortran linker found, using default linker" % (ext.name))
+ if ext.language=='c++' and cxx_compiler is None:
+ self.warn("extension %r has C++ libraries " \
+ "but no C++ linker found, using default linker" % (ext.name))
+
+ kws = {'depends':ext.depends}
+ output_dir = self.build_temp
+
+ include_dirs = ext.include_dirs + get_numpy_include_dirs()
+
+ c_objects = []
+ if c_sources:
+ log.info("compiling C sources")
+ c_objects = self.compiler.compile(c_sources,
+ output_dir=output_dir,
+ macros=macros,
+ include_dirs=include_dirs,
+ debug=self.debug,
+ extra_postargs=extra_args,
+ **kws)
+
+ if cxx_sources:
+ log.info("compiling C++ sources")
+ c_objects += cxx_compiler.compile(cxx_sources,
+ output_dir=output_dir,
+ macros=macros,
+ include_dirs=include_dirs,
+ debug=self.debug,
+ extra_postargs=extra_args,
+ **kws)
+
+ extra_postargs = []
+ f_objects = []
+ if fmodule_sources:
+ log.info("compiling Fortran 90 module sources")
+ module_dirs = ext.module_dirs[:]
+ module_build_dir = os.path.join(
+ self.build_temp,os.path.dirname(
+ self.get_ext_filename(fullname)))
+
+ self.mkpath(module_build_dir)
+ if fcompiler.module_dir_switch is None:
+ existing_modules = glob('*.mod')
+ extra_postargs += fcompiler.module_options(
+ module_dirs,module_build_dir)
+ f_objects += fcompiler.compile(fmodule_sources,
+ output_dir=self.build_temp,
+ macros=macros,
+ include_dirs=include_dirs,
+ debug=self.debug,
+ extra_postargs=extra_postargs,
+ depends=ext.depends)
+
+ if fcompiler.module_dir_switch is None:
+ for f in glob('*.mod'):
+ if f in existing_modules:
+ continue
+ t = os.path.join(module_build_dir, f)
+ if os.path.abspath(f)==os.path.abspath(t):
+ continue
+ if os.path.isfile(t):
+ os.remove(t)
+ try:
+ self.move_file(f, module_build_dir)
+ except DistutilsFileError:
+ log.warn('failed to move %r to %r' %
+ (f, module_build_dir))
+ if f_sources:
+ log.info("compiling Fortran sources")
+ f_objects += fcompiler.compile(f_sources,
+ output_dir=self.build_temp,
+ macros=macros,
+ include_dirs=include_dirs,
+ debug=self.debug,
+ extra_postargs=extra_postargs,
+ depends=ext.depends)
+
+ objects = c_objects + f_objects
+
+ if ext.extra_objects:
+ objects.extend(ext.extra_objects)
+ extra_args = ext.extra_link_args or []
+ libraries = self.get_libraries(ext)[:]
+ library_dirs = ext.library_dirs[:]
+
+ linker = self.compiler.link_shared_object
+ # Always use system linker when using MSVC compiler.
+ if self.compiler.compiler_type=='msvc':
+ # expand libraries with fcompiler libraries as we are
+ # not using fcompiler linker
+ self._libs_with_msvc_and_fortran(fcompiler, libraries, library_dirs)
+ elif ext.language in ['f77','f90'] and fcompiler is not None:
+ linker = fcompiler.link_shared_object
+ if ext.language=='c++' and cxx_compiler is not None:
+ linker = cxx_compiler.link_shared_object
+
+ if sys.version[:3]>='2.3':
+ kws = {'target_lang':ext.language}
+ else:
+ kws = {}
+
+ linker(objects, ext_filename,
+ libraries=libraries,
+ library_dirs=library_dirs,
+ runtime_library_dirs=ext.runtime_library_dirs,
+ extra_postargs=extra_args,
+ export_symbols=self.get_export_symbols(ext),
+ debug=self.debug,
+ build_temp=self.build_temp,**kws)
+
+ def _libs_with_msvc_and_fortran(self, fcompiler, c_libraries,
+ c_library_dirs):
+ if fcompiler is None: return
+
+ for libname in c_libraries:
+ if libname.startswith('msvc'): continue
+ fileexists = False
+ for libdir in c_library_dirs or []:
+ libfile = os.path.join(libdir,'%s.lib' % (libname))
+ if os.path.isfile(libfile):
+ fileexists = True
+ break
+ if fileexists: continue
+ # make g77-compiled static libs available to MSVC
+ fileexists = False
+ for libdir in c_library_dirs:
+ libfile = os.path.join(libdir,'lib%s.a' % (libname))
+ if os.path.isfile(libfile):
+ # copy libname.a file to name.lib so that MSVC linker
+ # can find it
+ libfile2 = os.path.join(self.build_temp, libname + '.lib')
+ copy_file(libfile, libfile2)
+ if self.build_temp not in c_library_dirs:
+ c_library_dirs.append(self.build_temp)
+ fileexists = True
+ break
+ if fileexists: continue
+ log.warn('could not find library %r in directories %s'
+ % (libname, c_library_dirs))
+
+ # Always use system linker when using MSVC compiler.
+ f_lib_dirs = []
+ for dir in fcompiler.library_dirs:
+ # correct path when compiling in Cygwin but with normal Win
+ # Python
+ if dir.startswith('/usr/lib'):
+ s,o = exec_command(['cygpath', '-w', dir], use_tee=False)
+ if not s:
+ dir = o
+ f_lib_dirs.append(dir)
+ c_library_dirs.extend(f_lib_dirs)
+
+ # make g77-compiled static libs available to MSVC
+ for lib in fcompiler.libraries:
+ if not lib.startswith('msvc'):
+ c_libraries.append(lib)
+ p = combine_paths(f_lib_dirs, 'lib' + lib + '.a')
+ if p:
+ dst_name = os.path.join(self.build_temp, lib + '.lib')
+ if not os.path.isfile(dst_name):
+ copy_file(p[0], dst_name)
+ if self.build_temp not in c_library_dirs:
+ c_library_dirs.append(self.build_temp)
+
+ def get_source_files (self):
+ self.check_extensions_list(self.extensions)
+ filenames = []
+ for ext in self.extensions:
+ filenames.extend(get_ext_source_files(ext))
+ return filenames
+
+ def get_outputs (self):
+ self.check_extensions_list(self.extensions)
+
+ outputs = []
+ for ext in self.extensions:
+ if not ext.sources:
+ continue
+ fullname = self.get_ext_fullname(ext.name)
+ outputs.append(os.path.join(self.build_lib,
+ self.get_ext_filename(fullname)))
+ return outputs
diff --git a/numpy/distutils/command/build_py.py b/numpy/distutils/command/build_py.py
new file mode 100644
index 000000000..0da23a513
--- /dev/null
+++ b/numpy/distutils/command/build_py.py
@@ -0,0 +1,25 @@
+
+from distutils.command.build_py import build_py as old_build_py
+from numpy.distutils.misc_util import is_string
+
+class build_py(old_build_py):
+
+ def find_package_modules(self, package, package_dir):
+ modules = old_build_py.find_package_modules(self, package, package_dir)
+
+ # Find build_src generated *.py files.
+ build_src = self.get_finalized_command('build_src')
+ modules += build_src.py_modules_dict.get(package,[])
+
+ return modules
+
+ def find_modules(self):
+ old_py_modules = self.py_modules[:]
+ new_py_modules = filter(is_string, self.py_modules)
+ self.py_modules[:] = new_py_modules
+ modules = old_build_py.find_modules(self)
+ self.py_modules[:] = old_py_modules
+ return modules
+
+ # XXX: Fix find_source_files for item in py_modules such that item is 3-tuple
+ # and item[2] is source file.
diff --git a/numpy/distutils/command/build_scripts.py b/numpy/distutils/command/build_scripts.py
new file mode 100644
index 000000000..1217a2c1f
--- /dev/null
+++ b/numpy/distutils/command/build_scripts.py
@@ -0,0 +1,45 @@
+""" Modified version of build_scripts that handles building scripts from functions.
+"""
+
+from distutils.command.build_scripts import build_scripts as old_build_scripts
+from numpy.distutils import log
+from numpy.distutils.misc_util import is_string
+
+class build_scripts(old_build_scripts):
+
+ def generate_scripts(self, scripts):
+ new_scripts = []
+ func_scripts = []
+ for script in scripts:
+ if is_string(script):
+ new_scripts.append(script)
+ else:
+ func_scripts.append(script)
+ if not func_scripts:
+ return new_scripts
+
+ build_dir = self.build_dir
+ self.mkpath(build_dir)
+ for func in func_scripts:
+ script = func(build_dir)
+ if not script:
+ continue
+ if is_string(script):
+ log.info(" adding '%s' to scripts" % (script,))
+ new_scripts.append(script)
+ else:
+ [log.info(" adding '%s' to scripts" % (s,)) for s in script]
+ new_scripts.extend(list(script))
+ return new_scripts
+
+ def run (self):
+ if not self.scripts:
+ return
+
+ self.scripts = self.generate_scripts(self.scripts)
+
+ return old_build_scripts.run(self)
+
+ def get_source_files(self):
+ from numpy.distutils.misc_util import get_script_files
+ return get_script_files(self.scripts)
diff --git a/numpy/distutils/command/build_src.py b/numpy/distutils/command/build_src.py
new file mode 100644
index 000000000..b487dc11c
--- /dev/null
+++ b/numpy/distutils/command/build_src.py
@@ -0,0 +1,712 @@
+""" Build swig, f2py, weave, sources.
+"""
+
+import os
+import re
+import sys
+
+from distutils.command import build_ext
+from distutils.dep_util import newer_group, newer
+from distutils.util import get_platform
+from distutils.errors import DistutilsError, DistutilsSetupError
+
+from numpy.distutils import log
+from numpy.distutils.misc_util import fortran_ext_match, \
+ appendpath, is_string, is_sequence
+from numpy.distutils.from_template import process_file as process_f_file
+from numpy.distutils.conv_template import process_file as process_c_file
+from numpy.distutils.exec_command import splitcmdline
+
+class build_src(build_ext.build_ext):
+
+ description = "build sources from SWIG, F2PY files or a function"
+
+ user_options = [
+ ('build-src=', 'd', "directory to \"build\" sources to"),
+ ('f2py-opts=', None, "list of f2py command line options"),
+ ('swig=', None, "path to the SWIG executable"),
+ ('swig-opts=', None, "list of SWIG command line options"),
+ ('swig-cpp', None, "make SWIG create C++ files (default is autodetected from sources)"),
+ ('f2pyflags=', None, "additional flags to f2py (use --f2py-opts= instead)"), # obsolete
+ ('swigflags=', None, "additional flags to swig (use --swig-opts= instead)"), # obsolete
+ ('force', 'f', "forcibly build everything (ignore file timestamps)"),
+ ('inplace', 'i',
+ "ignore build-lib and put compiled extensions into the source " +
+ "directory alongside your pure Python modules"),
+ ]
+
+ boolean_options = ['force','inplace']
+
+ help_options = []
+
+ def initialize_options(self):
+ self.extensions = None
+ self.package = None
+ self.py_modules = None
+ self.py_modules_dict = None
+ self.build_src = None
+ self.build_lib = None
+ self.build_base = None
+ self.force = None
+ self.inplace = None
+ self.package_dir = None
+ self.f2pyflags = None # obsolete
+ self.f2py_opts = None
+ self.swigflags = None # obsolete
+ self.swig_opts = None
+ self.swig_cpp = None
+ self.swig = None
+ return
+
+ def finalize_options(self):
+ self.set_undefined_options('build',
+ ('build_base', 'build_base'),
+ ('build_lib', 'build_lib'),
+ ('force', 'force'))
+ if self.package is None:
+ self.package = self.distribution.ext_package
+ self.extensions = self.distribution.ext_modules
+ self.libraries = self.distribution.libraries or []
+ self.py_modules = self.distribution.py_modules or []
+ self.data_files = self.distribution.data_files or []
+
+ if self.build_src is None:
+ plat_specifier = ".%s-%s" % (get_platform(), sys.version[0:3])
+ self.build_src = os.path.join(self.build_base, 'src'+plat_specifier)
+
+ # py_modules_dict is used in build_py.find_package_modules
+ self.py_modules_dict = {}
+
+ if self.f2pyflags:
+ if self.f2py_opts:
+ log.warn('ignoring --f2pyflags as --f2py-opts already used')
+ else:
+ self.f2py_opts = self.f2pyflags
+ self.f2pyflags = None
+ if self.f2py_opts is None:
+ self.f2py_opts = []
+ else:
+ self.f2py_opts = splitcmdline(self.f2py_opts)
+
+ if self.swigflags:
+ if self.swig_opts:
+ log.warn('ignoring --swigflags as --swig-opts already used')
+ else:
+ self.swig_opts = self.swigflags
+ self.swigflags = None
+
+ if self.swig_opts is None:
+ self.swig_opts = []
+ else:
+ self.swig_opts = splitcmdline(self.swig_opts)
+
+ # use options from build_ext command
+ build_ext = self.get_finalized_command('build_ext')
+ if self.inplace is None:
+ self.inplace = build_ext.inplace
+ if self.swig_cpp is None:
+ self.swig_cpp = build_ext.swig_cpp
+ for c in ['swig','swig_opt']:
+ o = '--'+c.replace('_','-')
+ v = getattr(build_ext,c,None)
+ if v:
+ if getattr(self,c):
+ log.warn('both build_src and build_ext define %s option' % (o))
+ else:
+ log.info('using "%s=%s" option from build_ext command' % (o,v))
+ setattr(self, c, v)
+ return
+
+ def run(self):
+ if not (self.extensions or self.libraries):
+ return
+ self.build_sources()
+
+ return
+
+ def build_sources(self):
+
+ if self.inplace:
+ self.get_package_dir = self.get_finalized_command('build_py')\
+ .get_package_dir
+
+ self.build_py_modules_sources()
+
+ for libname_info in self.libraries:
+ self.build_library_sources(*libname_info)
+
+ if self.extensions:
+ self.check_extensions_list(self.extensions)
+
+ for ext in self.extensions:
+ self.build_extension_sources(ext)
+
+ self.build_data_files_sources()
+
+ return
+
+ def build_data_files_sources(self):
+ if not self.data_files:
+ return
+ log.info('building data_files sources')
+ from numpy.distutils.misc_util import get_data_files
+ new_data_files = []
+ for data in self.data_files:
+ if isinstance(data,str):
+ new_data_files.append(data)
+ elif isinstance(data,tuple):
+ d,files = data
+ if self.inplace:
+ build_dir = self.get_package_dir('.'.join(d.split(os.sep)))
+ else:
+ build_dir = os.path.join(self.build_src,d)
+ funcs = filter(callable,files)
+ files = filter(lambda f:not callable(f), files)
+ for f in funcs:
+ if f.func_code.co_argcount==1:
+ s = f(build_dir)
+ else:
+ s = f()
+ if s is not None:
+ if isinstance(s,list):
+ files.extend(s)
+ elif isinstance(s,str):
+ files.append(s)
+ else:
+ raise TypeError(repr(s))
+ filenames = get_data_files((d,files))
+ new_data_files.append((d, filenames))
+ else:
+ raise TypeError(repr(data))
+ self.data_files[:] = new_data_files
+ return
+
+ def build_py_modules_sources(self):
+ if not self.py_modules:
+ return
+ log.info('building py_modules sources')
+ new_py_modules = []
+ for source in self.py_modules:
+ if is_sequence(source) and len(source)==3:
+ package, module_base, source = source
+ if self.inplace:
+ build_dir = self.get_package_dir(package)
+ else:
+ build_dir = os.path.join(self.build_src,
+ os.path.join(*package.split('.')))
+ if callable(source):
+ target = os.path.join(build_dir, module_base + '.py')
+ source = source(target)
+ if source is None:
+ continue
+ modules = [(package, module_base, source)]
+ if not self.py_modules_dict.has_key(package):
+ self.py_modules_dict[package] = []
+ self.py_modules_dict[package] += modules
+ else:
+ new_py_modules.append(source)
+ self.py_modules[:] = new_py_modules
+ return
+
+ def build_library_sources(self, lib_name, build_info):
+ sources = list(build_info.get('sources',[]))
+
+ if not sources:
+ return
+
+ log.info('building library "%s" sources' % (lib_name))
+
+ sources = self.generate_sources(sources, (lib_name, build_info))
+
+ sources = self.template_sources(sources, (lib_name, build_info))
+
+ sources, h_files = self.filter_h_files(sources)
+
+ if h_files:
+ print self.package,'- nothing done with h_files=',h_files
+
+ #for f in h_files:
+ # self.distribution.headers.append((lib_name,f))
+
+ build_info['sources'] = sources
+ return
+
+ def build_extension_sources(self, ext):
+
+ sources = list(ext.sources)
+
+ log.info('building extension "%s" sources' % (ext.name))
+
+ fullname = self.get_ext_fullname(ext.name)
+
+ modpath = fullname.split('.')
+ package = '.'.join(modpath[0:-1])
+
+ if self.inplace:
+ self.ext_target_dir = self.get_package_dir(package)
+
+ sources = self.generate_sources(sources, ext)
+
+ sources = self.template_sources(sources, ext)
+
+ sources = self.swig_sources(sources, ext)
+
+ sources = self.f2py_sources(sources, ext)
+
+ sources = self.pyrex_sources(sources, ext)
+
+ sources, py_files = self.filter_py_files(sources)
+
+ if not self.py_modules_dict.has_key(package):
+ self.py_modules_dict[package] = []
+ modules = []
+ for f in py_files:
+ module = os.path.splitext(os.path.basename(f))[0]
+ modules.append((package, module, f))
+ self.py_modules_dict[package] += modules
+
+ sources, h_files = self.filter_h_files(sources)
+
+ if h_files:
+ print package,'- nothing done with h_files=',h_files
+ #for f in h_files:
+ # self.distribution.headers.append((package,f))
+
+ ext.sources = sources
+
+ return
+
+ def generate_sources(self, sources, extension):
+ new_sources = []
+ func_sources = []
+ for source in sources:
+ if is_string(source):
+ new_sources.append(source)
+ else:
+ func_sources.append(source)
+ if not func_sources:
+ return new_sources
+ if self.inplace and not is_sequence(extension):
+ build_dir = self.ext_target_dir
+ else:
+ if is_sequence(extension):
+ name = extension[0]
+ # if not extension[1].has_key('include_dirs'):
+ # extension[1]['include_dirs'] = []
+ # incl_dirs = extension[1]['include_dirs']
+ else:
+ name = extension.name
+ # incl_dirs = extension.include_dirs
+ #if self.build_src not in incl_dirs:
+ # incl_dirs.append(self.build_src)
+ build_dir = os.path.join(*([self.build_src]\
+ +name.split('.')[:-1]))
+ self.mkpath(build_dir)
+ for func in func_sources:
+ source = func(extension, build_dir)
+ if not source:
+ continue
+ if is_sequence(source):
+ [log.info(" adding '%s' to sources." % (s,)) for s in source]
+ new_sources.extend(source)
+ else:
+ log.info(" adding '%s' to sources." % (source,))
+ new_sources.append(source)
+
+ return new_sources
+
+ def filter_py_files(self, sources):
+ return self.filter_files(sources,['.py'])
+
+ def filter_h_files(self, sources):
+ return self.filter_files(sources,['.h','.hpp','.inc'])
+
+ def filter_files(self, sources, exts = []):
+ new_sources = []
+ files = []
+ for source in sources:
+ (base, ext) = os.path.splitext(source)
+ if ext in exts:
+ files.append(source)
+ else:
+ new_sources.append(source)
+ return new_sources, files
+
+ def template_sources(self, sources, extension):
+ new_sources = []
+ if is_sequence(extension):
+ depends = extension[1].get('depends')
+ include_dirs = extension[1].get('include_dirs')
+ else:
+ depends = extension.depends
+ include_dirs = extension.include_dirs
+ for source in sources:
+ (base, ext) = os.path.splitext(source)
+ if ext == '.src': # Template file
+ if self.inplace:
+ target_dir = os.path.dirname(base)
+ else:
+ target_dir = appendpath(self.build_src, os.path.dirname(base))
+ self.mkpath(target_dir)
+ target_file = os.path.join(target_dir,os.path.basename(base))
+ if (self.force or newer_group([source] + depends, target_file)):
+ if _f_pyf_ext_match(base):
+ log.info("from_template:> %s" % (target_file))
+ outstr = process_f_file(source)
+ else:
+ log.info("conv_template:> %s" % (target_file))
+ outstr = process_c_file(source)
+ fid = open(target_file,'w')
+ fid.write(outstr)
+ fid.close()
+ if _header_ext_match(target_file):
+ d = os.path.dirname(target_file)
+ if d not in include_dirs:
+ log.info(" adding '%s' to include_dirs." % (d))
+ include_dirs.append(d)
+ new_sources.append(target_file)
+ else:
+ new_sources.append(source)
+ return new_sources
+
+ def pyrex_sources(self, sources, extension):
+ have_pyrex = False
+ try:
+ import Pyrex
+ have_pyrex = True
+ except ImportError:
+ pass
+ new_sources = []
+ ext_name = extension.name.split('.')[-1]
+ for source in sources:
+ (base, ext) = os.path.splitext(source)
+ if ext == '.pyx':
+ if self.inplace or not have_pyrex:
+ target_dir = os.path.dirname(base)
+ else:
+ target_dir = appendpath(self.build_src, os.path.dirname(base))
+ target_file = os.path.join(target_dir, ext_name + '.c')
+ depends = [source] + extension.depends
+ if (self.force or newer_group(depends, target_file, 'newer')):
+ if have_pyrex:
+ log.info("pyrexc:> %s" % (target_file))
+ self.mkpath(target_dir)
+ from Pyrex.Compiler import Main
+ options = Main.CompilationOptions(
+ defaults=Main.default_options,
+ output_file=target_file)
+ pyrex_result = Main.compile(source, options=options)
+ if pyrex_result.num_errors != 0:
+ raise DistutilsError,"%d errors while compiling %r with Pyrex" \
+ % (pyrex_result.num_errors, source)
+ elif os.path.isfile(target_file):
+ log.warn("Pyrex required for compiling %r but not available,"\
+ " using old target %r"\
+ % (source, target_file))
+ else:
+ raise DistutilsError,"Pyrex required for compiling %r but not available" % (source)
+ new_sources.append(target_file)
+ else:
+ new_sources.append(source)
+ return new_sources
+
+ def f2py_sources(self, sources, extension):
+ new_sources = []
+ f2py_sources = []
+ f_sources = []
+ f2py_targets = {}
+ target_dirs = []
+ ext_name = extension.name.split('.')[-1]
+ skip_f2py = 0
+
+ for source in sources:
+ (base, ext) = os.path.splitext(source)
+ if ext == '.pyf': # F2PY interface file
+ if self.inplace:
+ target_dir = os.path.dirname(base)
+ else:
+ target_dir = appendpath(self.build_src, os.path.dirname(base))
+ if os.path.isfile(source):
+ name = get_f2py_modulename(source)
+ if name != ext_name:
+ raise DistutilsSetupError('mismatch of extension names: %s '
+ 'provides %r but expected %r' % (
+ source, name, ext_name))
+ target_file = os.path.join(target_dir,name+'module.c')
+ else:
+ log.debug(' source %s does not exist: skipping f2py\'ing.' \
+ % (source))
+ name = ext_name
+ skip_f2py = 1
+ target_file = os.path.join(target_dir,name+'module.c')
+ if not os.path.isfile(target_file):
+ log.warn(' target %s does not exist:\n '\
+ 'Assuming %smodule.c was generated with '\
+ '"build_src --inplace" command.' \
+ % (target_file, name))
+ target_dir = os.path.dirname(base)
+ target_file = os.path.join(target_dir,name+'module.c')
+ if not os.path.isfile(target_file):
+ raise DistutilsSetupError("%r missing" % (target_file,))
+ log.info(' Yes! Using %r as up-to-date target.' \
+ % (target_file))
+ target_dirs.append(target_dir)
+ f2py_sources.append(source)
+ f2py_targets[source] = target_file
+ new_sources.append(target_file)
+ elif fortran_ext_match(ext):
+ f_sources.append(source)
+ else:
+ new_sources.append(source)
+
+ if not (f2py_sources or f_sources):
+ return new_sources
+
+ map(self.mkpath, target_dirs)
+
+ f2py_options = extension.f2py_options + self.f2py_opts
+
+ if self.distribution.libraries:
+ for name,build_info in self.distribution.libraries:
+ if name in extension.libraries:
+ f2py_options.extend(build_info.get('f2py_options',[]))
+
+ log.info("f2py options: %s" % (f2py_options))
+
+ if f2py_sources:
+ if len(f2py_sources) != 1:
+ raise DistutilsSetupError(
+ 'only one .pyf file is allowed per extension module but got'\
+ ' more: %r' % (f2py_sources,))
+ source = f2py_sources[0]
+ target_file = f2py_targets[source]
+ target_dir = os.path.dirname(target_file) or '.'
+ depends = [source] + extension.depends
+ if (self.force or newer_group(depends, target_file,'newer')) \
+ and not skip_f2py:
+ log.info("f2py: %s" % (source))
+ import numpy.f2py as f2py2e
+ f2py2e.run_main(f2py_options + ['--build-dir',target_dir,source])
+ else:
+ log.debug(" skipping '%s' f2py interface (up-to-date)" % (source))
+ else:
+ #XXX TODO: --inplace support for sdist command
+ if is_sequence(extension):
+ name = extension[0]
+ else: name = extension.name
+ target_dir = os.path.join(*([self.build_src]\
+ +name.split('.')[:-1]))
+ target_file = os.path.join(target_dir,ext_name + 'module.c')
+ new_sources.append(target_file)
+ depends = f_sources + extension.depends
+ if (self.force or newer_group(depends, target_file, 'newer')) \
+ and not skip_f2py:
+ import numpy.f2py as f2py2e
+ log.info("f2py:> %s" % (target_file))
+ self.mkpath(target_dir)
+ f2py2e.run_main(f2py_options + ['--lower',
+ '--build-dir',target_dir]+\
+ ['-m',ext_name]+f_sources)
+ else:
+ log.debug(" skipping f2py fortran files for '%s' (up-to-date)"\
+ % (target_file))
+
+ if not os.path.isfile(target_file):
+ raise DistutilsError("f2py target file %r not generated" % (target_file,))
+
+ target_c = os.path.join(self.build_src,'fortranobject.c')
+ target_h = os.path.join(self.build_src,'fortranobject.h')
+ log.info(" adding '%s' to sources." % (target_c))
+ new_sources.append(target_c)
+ if self.build_src not in extension.include_dirs:
+ log.info(" adding '%s' to include_dirs." \
+ % (self.build_src))
+ extension.include_dirs.append(self.build_src)
+
+ if not skip_f2py:
+ import numpy.f2py as f2py2e
+ d = os.path.dirname(f2py2e.__file__)
+ source_c = os.path.join(d,'src','fortranobject.c')
+ source_h = os.path.join(d,'src','fortranobject.h')
+ if newer(source_c,target_c) or newer(source_h,target_h):
+ self.mkpath(os.path.dirname(target_c))
+ self.copy_file(source_c,target_c)
+ self.copy_file(source_h,target_h)
+ else:
+ if not os.path.isfile(target_c):
+ raise DistutilsSetupError("f2py target_c file %r not found" % (target_c,))
+ if not os.path.isfile(target_h):
+ raise DistutilsSetupError("f2py target_h file %r not found" % (target_h,))
+
+ for name_ext in ['-f2pywrappers.f','-f2pywrappers2.f90']:
+ filename = os.path.join(target_dir,ext_name + name_ext)
+ if os.path.isfile(filename):
+ log.info(" adding '%s' to sources." % (filename))
+ f_sources.append(filename)
+
+ return new_sources + f_sources
+
+ def swig_sources(self, sources, extension):
+ # Assuming SWIG 1.3.14 or later. See compatibility note in
+ # http://www.swig.org/Doc1.3/Python.html#Python_nn6
+
+ new_sources = []
+ swig_sources = []
+ swig_targets = {}
+ target_dirs = []
+ py_files = [] # swig generated .py files
+ target_ext = '.c'
+ if self.swig_cpp:
+ typ = 'c++'
+ is_cpp = True
+ else:
+ typ = None
+ is_cpp = False
+ skip_swig = 0
+ ext_name = extension.name.split('.')[-1]
+
+ for source in sources:
+ (base, ext) = os.path.splitext(source)
+ if ext == '.i': # SWIG interface file
+ if self.inplace:
+ target_dir = os.path.dirname(base)
+ py_target_dir = self.ext_target_dir
+ else:
+ target_dir = appendpath(self.build_src, os.path.dirname(base))
+ py_target_dir = target_dir
+ if os.path.isfile(source):
+ name = get_swig_modulename(source)
+ if name != ext_name[1:]:
+ raise DistutilsSetupError(
+ 'mismatch of extension names: %s provides %r'
+ ' but expected %r' % (source, name, ext_name[1:]))
+ if typ is None:
+ typ = get_swig_target(source)
+ is_cpp = typ=='c++'
+ if is_cpp: target_ext = '.cpp'
+ else:
+ typ2 = get_swig_target(source)
+ if typ!=typ2:
+ log.warn('expected %r but source %r defines %r swig target' \
+ % (typ, source, typ2))
+ if typ2=='c++':
+ log.warn('resetting swig target to c++ (some targets may have .c extension)')
+ is_cpp = True
+ target_ext = '.cpp'
+ else:
+ log.warn('assuming that %r has c++ swig target' % (source))
+ target_file = os.path.join(target_dir,'%s_wrap%s' \
+ % (name, target_ext))
+ else:
+ log.warn(' source %s does not exist: skipping swig\'ing.' \
+ % (source))
+ name = ext_name[1:]
+ skip_swig = 1
+ target_file = _find_swig_target(target_dir, name)
+ if not os.path.isfile(target_file):
+ log.warn(' target %s does not exist:\n '\
+ 'Assuming %s_wrap.{c,cpp} was generated with '\
+ '"build_src --inplace" command.' \
+ % (target_file, name))
+ target_dir = os.path.dirname(base)
+ target_file = _find_swig_target(target_dir, name)
+ if not os.path.isfile(target_file):
+ raise DistutilsSetupError("%r missing" % (target_file,))
+ log.warn(' Yes! Using %r as up-to-date target.' \
+ % (target_file))
+ target_dirs.append(target_dir)
+ new_sources.append(target_file)
+ py_files.append(os.path.join(py_target_dir, name+'.py'))
+ swig_sources.append(source)
+ swig_targets[source] = new_sources[-1]
+ else:
+ new_sources.append(source)
+
+ if not swig_sources:
+ return new_sources
+
+ if skip_swig:
+ return new_sources + py_files
+
+ map(self.mkpath, target_dirs)
+ swig = self.swig or self.find_swig()
+ swig_cmd = [swig, "-python"]
+ if is_cpp:
+ swig_cmd.append('-c++')
+ for d in extension.include_dirs:
+ swig_cmd.append('-I'+d)
+ for source in swig_sources:
+ target = swig_targets[source]
+ depends = [source] + extension.depends
+ if self.force or newer_group(depends, target, 'newer'):
+ log.info("%s: %s" % (os.path.basename(swig) \
+ + (is_cpp and '++' or ''), source))
+ self.spawn(swig_cmd + self.swig_opts \
+ + ["-o", target, '-outdir', py_target_dir, source])
+ else:
+ log.debug(" skipping '%s' swig interface (up-to-date)" \
+ % (source))
+
+ return new_sources + py_files
+
+_f_pyf_ext_match = re.compile(r'.*[.](f90|f95|f77|for|ftn|f|pyf)\Z',re.I).match
+_header_ext_match = re.compile(r'.*[.](inc|h|hpp)\Z',re.I).match
+
+#### SWIG related auxiliary functions ####
+_swig_module_name_match = re.compile(r'\s*%module\s*(.*\(\s*package\s*=\s*"(?P<package>[\w_]+)".*\)|)\s*(?P<name>[\w_]+)',
+ re.I).match
+_has_c_header = re.compile(r'-[*]-\s*c\s*-[*]-',re.I).search
+_has_cpp_header = re.compile(r'-[*]-\s*c[+][+]\s*-[*]-',re.I).search
+
+def get_swig_target(source):
+ f = open(source,'r')
+ result = 'c'
+ line = f.readline()
+ if _has_cpp_header(line):
+ result = 'c++'
+ if _has_c_header(line):
+ result = 'c'
+ f.close()
+ return result
+
+def get_swig_modulename(source):
+ f = open(source,'r')
+ f_readlines = getattr(f,'xreadlines',f.readlines)
+ name = None
+ for line in f_readlines():
+ m = _swig_module_name_match(line)
+ if m:
+ name = m.group('name')
+ break
+ f.close()
+ return name
+
+def _find_swig_target(target_dir,name):
+ for ext in ['.cpp','.c']:
+ target = os.path.join(target_dir,'%s_wrap%s' % (name, ext))
+ if os.path.isfile(target):
+ break
+ return target
+
+#### F2PY related auxiliary functions ####
+
+_f2py_module_name_match = re.compile(r'\s*python\s*module\s*(?P<name>[\w_]+)',
+ re.I).match
+_f2py_user_module_name_match = re.compile(r'\s*python\s*module\s*(?P<name>[\w_]*?'\
+ '__user__[\w_]*)',re.I).match
+
+def get_f2py_modulename(source):
+ name = None
+ f = open(source)
+ f_readlines = getattr(f,'xreadlines',f.readlines)
+ for line in f_readlines():
+ m = _f2py_module_name_match(line)
+ if m:
+ if _f2py_user_module_name_match(line): # skip *__user__* names
+ continue
+ name = m.group('name')
+ break
+ f.close()
+ return name
+
+##########################################
diff --git a/numpy/distutils/command/config.py b/numpy/distutils/command/config.py
new file mode 100644
index 000000000..f4e96664c
--- /dev/null
+++ b/numpy/distutils/command/config.py
@@ -0,0 +1,156 @@
+# Added Fortran compiler support to config. Currently useful only for
+# try_compile call. try_run works but is untested for most of Fortran
+# compilers (they must define linker_exe first).
+# Pearu Peterson
+
+import os, signal
+from distutils.command.config import config as old_config
+from distutils.command.config import LANG_EXT
+from distutils import log
+from distutils.file_util import copy_file
+from numpy.distutils.exec_command import exec_command
+
+LANG_EXT['f77'] = '.f'
+LANG_EXT['f90'] = '.f90'
+
+class config(old_config):
+ old_config.user_options += [
+ ('fcompiler=', None, "specify the Fortran compiler type"),
+ ]
+
+ def initialize_options(self):
+ self.fcompiler = None
+ old_config.initialize_options(self)
+
+ def _check_compiler (self):
+ old_config._check_compiler(self)
+ from numpy.distutils.fcompiler import FCompiler, new_fcompiler
+ if not isinstance(self.fcompiler, FCompiler):
+ self.fcompiler = new_fcompiler(compiler=self.fcompiler,
+ dry_run=self.dry_run, force=1)
+ self.fcompiler.customize(self.distribution)
+ self.fcompiler.customize_cmd(self)
+ self.fcompiler.show_customization()
+
+ def _wrap_method(self,mth,lang,args):
+ from distutils.ccompiler import CompileError
+ from distutils.errors import DistutilsExecError
+ save_compiler = self.compiler
+ if lang in ['f77','f90']:
+ self.compiler = self.fcompiler
+ try:
+ ret = mth(*((self,)+args))
+ except (DistutilsExecError,CompileError),msg:
+ self.compiler = save_compiler
+ raise CompileError
+ self.compiler = save_compiler
+ return ret
+
+ def _compile (self, body, headers, include_dirs, lang):
+ return self._wrap_method(old_config._compile,lang,
+ (body, headers, include_dirs, lang))
+
+ def _link (self, body,
+ headers, include_dirs,
+ libraries, library_dirs, lang):
+ if self.compiler.compiler_type=='msvc':
+ libraries = (libraries or [])[:]
+ library_dirs = (library_dirs or [])[:]
+ if lang in ['f77','f90']:
+ lang = 'c' # always use system linker when using MSVC compiler
+ if self.fcompiler:
+ for d in self.fcompiler.library_dirs or []:
+ # correct path when compiling in Cygwin but with
+ # normal Win Python
+ if d.startswith('/usr/lib'):
+ s,o = exec_command(['cygpath', '-w', d],
+ use_tee=False)
+ if not s: d = o
+ library_dirs.append(d)
+ for libname in self.fcompiler.libraries or []:
+ if libname not in libraries:
+ libraries.append(libname)
+ for libname in libraries:
+ if libname.startswith('msvc'): continue
+ fileexists = False
+ for libdir in library_dirs or []:
+ libfile = os.path.join(libdir,'%s.lib' % (libname))
+ if os.path.isfile(libfile):
+ fileexists = True
+ break
+ if fileexists: continue
+ # make g77-compiled static libs available to MSVC
+ fileexists = False
+ for libdir in library_dirs:
+ libfile = os.path.join(libdir,'lib%s.a' % (libname))
+ if os.path.isfile(libfile):
+ # copy libname.a file to name.lib so that MSVC linker
+ # can find it
+ libfile2 = os.path.join(libdir,'%s.lib' % (libname))
+ copy_file(libfile, libfile2)
+ self.temp_files.append(libfile2)
+ fileexists = True
+ break
+ if fileexists: continue
+ log.warn('could not find library %r in directories %s' \
+ % (libname, library_dirs))
+ return self._wrap_method(old_config._link,lang,
+ (body, headers, include_dirs,
+ libraries, library_dirs, lang))
+
+ def check_func(self, func,
+ headers=None, include_dirs=None,
+ libraries=None, library_dirs=None,
+ decl=False, call=False, call_args=None):
+ # clean up distutils's config a bit: add void to main(), and
+ # return a value.
+ self._check_compiler()
+ body = []
+ if decl:
+ body.append("int %s ();" % func)
+ body.append("int main (void) {")
+ if call:
+ if call_args is None:
+ call_args = ''
+ body.append(" %s(%s);" % (func, call_args))
+ else:
+ body.append(" %s;" % func)
+ body.append(" return 0;")
+ body.append("}")
+ body = '\n'.join(body) + "\n"
+
+ return self.try_link(body, headers, include_dirs,
+ libraries, library_dirs)
+
+ def get_output(self, body, headers=None, include_dirs=None,
+ libraries=None, library_dirs=None,
+ lang="c"):
+ """Try to compile, link to an executable, and run a program
+ built from 'body' and 'headers'. Returns the exit status code
+ of the program and its output.
+ """
+ from distutils.ccompiler import CompileError, LinkError
+ self._check_compiler()
+ exitcode, output = 255, ''
+ try:
+ src, obj, exe = self._link(body, headers, include_dirs,
+ libraries, library_dirs, lang)
+ exe = os.path.join('.', exe)
+ exitstatus, output = exec_command(exe, execute_in='.')
+ if hasattr(os, 'WEXITSTATUS'):
+ exitcode = os.WEXITSTATUS(exitstatus)
+ if os.WIFSIGNALED(exitstatus):
+ sig = os.WTERMSIG(exitstatus)
+ log.error('subprocess exited with signal %d' % (sig,))
+ if sig == signal.SIGINT:
+ # control-C
+ raise KeyboardInterrupt
+ else:
+ exitcode = exitstatus
+ log.info("success!")
+ except (CompileError, LinkError):
+ log.info("failure.")
+
+ self._clean()
+ return exitcode, output
+
diff --git a/numpy/distutils/command/config_compiler.py b/numpy/distutils/command/config_compiler.py
new file mode 100644
index 000000000..af99dbd32
--- /dev/null
+++ b/numpy/distutils/command/config_compiler.py
@@ -0,0 +1,124 @@
+import sys
+from distutils.core import Command
+from numpy.distutils import log
+
+#XXX: Linker flags
+
+def show_fortran_compilers(_cache=[]):
+ # Using cache to prevent infinite recursion
+ if _cache: return
+ _cache.append(1)
+ from numpy.distutils.fcompiler import show_fcompilers
+ import distutils.core
+ dist = distutils.core._setup_distribution
+ show_fcompilers(dist)
+
+class config_fc(Command):
+ """ Distutils command to hold user specified options
+ to Fortran compilers.
+
+ config_fc command is used by the FCompiler.customize() method.
+ """
+
+ description = "specify Fortran 77/Fortran 90 compiler information"
+
+ user_options = [
+ ('fcompiler=',None,"specify Fortran compiler type"),
+ ('f77exec=', None, "specify F77 compiler command"),
+ ('f90exec=', None, "specify F90 compiler command"),
+ ('f77flags=',None,"specify F77 compiler flags"),
+ ('f90flags=',None,"specify F90 compiler flags"),
+ ('opt=',None,"specify optimization flags"),
+ ('arch=',None,"specify architecture specific optimization flags"),
+ ('debug','g',"compile with debugging information"),
+ ('noopt',None,"compile without optimization"),
+ ('noarch',None,"compile without arch-dependent optimization"),
+ ]
+
+ help_options = [
+ ('help-fcompiler',None, "list available Fortran compilers",
+ show_fortran_compilers),
+ ]
+
+ boolean_options = ['debug','noopt','noarch']
+
+ def initialize_options(self):
+ self.fcompiler = None
+ self.f77exec = None
+ self.f90exec = None
+ self.f77flags = None
+ self.f90flags = None
+ self.opt = None
+ self.arch = None
+ self.debug = None
+ self.noopt = None
+ self.noarch = None
+
+ def finalize_options(self):
+ log.info('unifing config_fc, config, build_clib, build_ext, build commands --fcompiler options')
+ build_clib = self.get_finalized_command('build_clib')
+ build_ext = self.get_finalized_command('build_ext')
+ config = self.get_finalized_command('config')
+ build = self.get_finalized_command('build')
+ cmd_list = [self, config, build_clib, build_ext, build]
+ for a in ['fcompiler']:
+ l = []
+ for c in cmd_list:
+ v = getattr(c,a)
+ if v is not None:
+ if not isinstance(v, str): v = v.compiler_type
+ if v not in l: l.append(v)
+ if not l: v1 = None
+ else: v1 = l[0]
+ if len(l)>1:
+ log.warn(' commands have different --%s options: %s'\
+ ', using first in list as default' % (a, l))
+ if v1:
+ for c in cmd_list:
+ if getattr(c,a) is None: setattr(c, a, v1)
+
+ def run(self):
+ # Do nothing.
+ return
+
+class config_cc(Command):
+ """ Distutils command to hold user specified options
+ to C/C++ compilers.
+ """
+
+ description = "specify C/C++ compiler information"
+
+ user_options = [
+ ('compiler=',None,"specify C/C++ compiler type"),
+ ]
+
+ def initialize_options(self):
+ self.compiler = None
+
+ def finalize_options(self):
+ log.info('unifing config_cc, config, build_clib, build_ext, build commands --compiler options')
+ build_clib = self.get_finalized_command('build_clib')
+ build_ext = self.get_finalized_command('build_ext')
+ config = self.get_finalized_command('config')
+ build = self.get_finalized_command('build')
+ cmd_list = [self, config, build_clib, build_ext, build]
+ for a in ['compiler']:
+ l = []
+ for c in cmd_list:
+ v = getattr(c,a)
+ if v is not None:
+ if not isinstance(v, str): v = v.compiler_type
+ if v not in l: l.append(v)
+ if not l: v1 = None
+ else: v1 = l[0]
+ if len(l)>1:
+ log.warn(' commands have different --%s options: %s'\
+ ', using first in list as default' % (a, l))
+ if v1:
+ for c in cmd_list:
+ if getattr(c,a) is None: setattr(c, a, v1)
+ return
+
+ def run(self):
+ # Do nothing.
+ return
diff --git a/numpy/distutils/command/egg_info.py b/numpy/distutils/command/egg_info.py
new file mode 100644
index 000000000..d2f07e28f
--- /dev/null
+++ b/numpy/distutils/command/egg_info.py
@@ -0,0 +1,6 @@
+from setuptools.command.egg_info import egg_info as _egg_info
+
+class egg_info(_egg_info):
+ def run(self):
+ self.run_command("build_src")
+ _egg_info.run(self)
diff --git a/numpy/distutils/command/install.py b/numpy/distutils/command/install.py
new file mode 100644
index 000000000..36e6b5a66
--- /dev/null
+++ b/numpy/distutils/command/install.py
@@ -0,0 +1,36 @@
+import sys
+if 'setuptools' in sys.modules:
+ import setuptools.command.install as old_install_mod
+else:
+ import distutils.command.install as old_install_mod
+old_install = old_install_mod.install
+from distutils.file_util import write_file
+
+class install(old_install):
+
+ def finalize_options (self):
+ old_install.finalize_options(self)
+ self.install_lib = self.install_libbase
+
+ def run(self):
+ r = old_install.run(self)
+ if self.record:
+ # bdist_rpm fails when INSTALLED_FILES contains
+ # paths with spaces. Such paths must be enclosed
+ # with double-quotes.
+ f = open(self.record,'r')
+ lines = []
+ need_rewrite = False
+ for l in f.readlines():
+ l = l.rstrip()
+ if ' ' in l:
+ need_rewrite = True
+ l = '"%s"' % (l)
+ lines.append(l)
+ f.close()
+ if need_rewrite:
+ self.execute(write_file,
+ (self.record, lines),
+ "re-writing list of installed files to '%s'" %
+ self.record)
+ return r
diff --git a/numpy/distutils/command/install_data.py b/numpy/distutils/command/install_data.py
new file mode 100644
index 000000000..b72737f85
--- /dev/null
+++ b/numpy/distutils/command/install_data.py
@@ -0,0 +1,13 @@
+from distutils.command.install_data import install_data as old_install_data
+
+#data installer with improved intelligence over distutils
+#data files are copied into the project directory instead
+#of willy-nilly
+class install_data (old_install_data):
+
+ def finalize_options (self):
+ self.set_undefined_options('install',
+ ('install_lib', 'install_dir'),
+ ('root', 'root'),
+ ('force', 'force'),
+ )
diff --git a/numpy/distutils/command/install_headers.py b/numpy/distutils/command/install_headers.py
new file mode 100644
index 000000000..58ace1064
--- /dev/null
+++ b/numpy/distutils/command/install_headers.py
@@ -0,0 +1,25 @@
+import os
+from distutils.command.install_headers import install_headers as old_install_headers
+
+class install_headers (old_install_headers):
+
+ def run (self):
+ headers = self.distribution.headers
+ if not headers:
+ return
+
+ prefix = os.path.dirname(self.install_dir)
+ for header in headers:
+ if isinstance(header,tuple):
+ # Kind of a hack, but I don't know where else to change this...
+ if header[0] == 'numpy.core':
+ header = ('numpy', header[1])
+ if os.path.splitext(header[1])[1] == '.inc':
+ continue
+ d = os.path.join(*([prefix]+header[0].split('.')))
+ header = header[1]
+ else:
+ d = self.install_dir
+ self.mkpath(d)
+ (out, _) = self.copy_file(header, d)
+ self.outfiles.append(out)
diff --git a/numpy/distutils/command/sdist.py b/numpy/distutils/command/sdist.py
new file mode 100644
index 000000000..9134fed53
--- /dev/null
+++ b/numpy/distutils/command/sdist.py
@@ -0,0 +1,22 @@
+from distutils.command.sdist import sdist as old_sdist
+from numpy.distutils.misc_util import get_data_files
+
+class sdist(old_sdist):
+
+ def add_defaults (self):
+ old_sdist.add_defaults(self)
+
+ dist = self.distribution
+
+ if dist.has_data_files():
+ for data in dist.data_files:
+ self.filelist.extend(get_data_files(data))
+
+ if dist.has_headers():
+ headers = []
+ for h in dist.headers:
+ if isinstance(h,str): headers.append(h)
+ else: headers.append(h[1])
+ self.filelist.extend(headers)
+
+ return
diff --git a/numpy/distutils/conv_template.py b/numpy/distutils/conv_template.py
new file mode 100644
index 000000000..591ae54ad
--- /dev/null
+++ b/numpy/distutils/conv_template.py
@@ -0,0 +1,202 @@
+#!/usr/bin/python
+
+# takes templated file .xxx.src and produces .xxx file where .xxx is .i or .c or .h
+# using the following template rules
+
+# /**begin repeat on a line by itself marks the beginning of a segment of code to be repeated
+# /**end repeat**/ on a line by itself marks it's end
+
+# after the /**begin repeat and before the */
+# all the named templates are placed
+# these should all have the same number of replacements
+
+# in the main body, the names are used.
+# Each replace will use one entry from the list of named replacements
+
+# Note that all #..# forms in a block must have the same number of
+# comma-separated entries.
+
+__all__ = ['process_str', 'process_file']
+
+import os
+import sys
+import re
+
+def parse_structure(astr):
+ spanlist = []
+ # subroutines
+ ind = 0
+ line = 1
+ while 1:
+ start = astr.find("/**begin repeat", ind)
+ if start == -1:
+ break
+ start2 = astr.find("*/",start)
+ start2 = astr.find("\n",start2)
+ fini1 = astr.find("/**end repeat**/",start2)
+ fini2 = astr.find("\n",fini1)
+ line += astr.count("\n", ind, start2+1)
+ spanlist.append((start, start2+1, fini1, fini2+1, line))
+ line += astr.count("\n", start2+1, fini2)
+ ind = fini2
+ spanlist.sort()
+ return spanlist
+
+# return n copies of substr with template replacement
+_special_names = {}
+
+template_re = re.compile(r"@([\w]+)@")
+named_re = re.compile(r"#([\w]*)=([^#]*?)#")
+
+parenrep = re.compile(r"[(]([^)]*?)[)]\*(\d+)")
+def paren_repl(obj):
+ torep = obj.group(1)
+ numrep = obj.group(2)
+ return ','.join([torep]*int(numrep))
+
+plainrep = re.compile(r"([^*]+)\*(\d+)")
+
+def conv(astr):
+ # replaces all occurrences of '(a,b,c)*4' in astr
+ # with 'a,b,c,a,b,c,a,b,c,a,b,c'
+ astr = parenrep.sub(paren_repl,astr)
+ # replaces occurences of xxx*3 with xxx, xxx, xxx
+ astr = ','.join([plainrep.sub(paren_repl,x.strip())
+ for x in astr.split(',')])
+ return astr
+
+def unique_key(adict):
+ # this obtains a unique key given a dictionary
+ # currently it works by appending together n of the letters of the
+ # current keys and increasing n until a unique key is found
+ # -- not particularly quick
+ allkeys = adict.keys()
+ done = False
+ n = 1
+ while not done:
+ newkey = "".join([x[:n] for x in allkeys])
+ if newkey in allkeys:
+ n += 1
+ else:
+ done = True
+ return newkey
+
+def expand_sub(substr, namestr, line):
+ # find all named replacements
+ reps = named_re.findall(namestr)
+ names = {}
+ names.update(_special_names)
+ numsubs = None
+ for rep in reps:
+ name = rep[0].strip()
+ thelist = conv(rep[1])
+ names[name] = thelist
+
+ # make lists out of string entries in name dictionary
+ for name in names.keys():
+ entry = names[name]
+ entrylist = entry.split(',')
+ names[name] = entrylist
+ num = len(entrylist)
+ if numsubs is None:
+ numsubs = num
+ elif numsubs != num:
+ print namestr
+ print substr
+ raise ValueError, "Mismatch in number to replace"
+
+ # now replace all keys for each of the lists
+ mystr = ''
+ thissub = [None]
+ def namerepl(match):
+ name = match.group(1)
+ return names[name][thissub[0]]
+ for k in range(numsubs):
+ thissub[0] = k
+ mystr += ("#line %d\n%s\n\n"
+ % (line, template_re.sub(namerepl, substr)))
+ return mystr
+
+
+_head = \
+"""/* This file was autogenerated from a template DO NOT EDIT!!!!
+ Changes should be made to the original source (.src) file
+*/
+
+"""
+
+def get_line_header(str,beg):
+ extra = []
+ ind = beg-1
+ char = str[ind]
+ while (ind > 0) and (char != '\n'):
+ extra.insert(0,char)
+ ind = ind - 1
+ char = str[ind]
+ return ''.join(extra)
+
+def process_str(allstr):
+ newstr = allstr
+ writestr = _head
+
+ struct = parse_structure(newstr)
+ # return a (sorted) list of tuples for each begin repeat section
+ # each tuple is the start and end of a region to be template repeated
+
+ oldend = 0
+ for sub in struct:
+ writestr += newstr[oldend:sub[0]]
+ expanded = expand_sub(newstr[sub[1]:sub[2]],
+ newstr[sub[0]:sub[1]], sub[4])
+ writestr += expanded
+ oldend = sub[3]
+
+
+ writestr += newstr[oldend:]
+ return writestr
+
+include_src_re = re.compile(r"(\n|\A)#include\s*['\"]"
+ r"(?P<name>[\w\d./\\]+[.]src)['\"]", re.I)
+
+def resolve_includes(source):
+ d = os.path.dirname(source)
+ fid = open(source)
+ lines = []
+ for line in fid.readlines():
+ m = include_src_re.match(line)
+ if m:
+ fn = m.group('name')
+ if not os.path.isabs(fn):
+ fn = os.path.join(d,fn)
+ if os.path.isfile(fn):
+ print 'Including file',fn
+ lines.extend(resolve_includes(fn))
+ else:
+ lines.append(line)
+ else:
+ lines.append(line)
+ fid.close()
+ return lines
+
+def process_file(source):
+ lines = resolve_includes(source)
+ sourcefile = os.path.normcase(source).replace("\\","\\\\")
+ return ('#line 1 "%s"\n%s'
+ % (sourcefile, process_str(''.join(lines))))
+
+if __name__ == "__main__":
+
+ try:
+ file = sys.argv[1]
+ except IndexError:
+ fid = sys.stdin
+ outfile = sys.stdout
+ else:
+ fid = open(file,'r')
+ (base, ext) = os.path.splitext(file)
+ newname = base
+ outfile = open(newname,'w')
+
+ allstr = fid.read()
+ writestr = process_str(allstr)
+ outfile.write(writestr)
diff --git a/numpy/distutils/core.py b/numpy/distutils/core.py
new file mode 100644
index 000000000..589e97bc0
--- /dev/null
+++ b/numpy/distutils/core.py
@@ -0,0 +1,217 @@
+
+import sys
+from distutils.core import *
+
+if 'setuptools' in sys.modules:
+ have_setuptools = True
+ from setuptools import setup as old_setup
+ # easy_install imports math, it may be picked up from cwd
+ from setuptools.command import develop, easy_install
+ try:
+ # very old versions of setuptools don't have this
+ from setuptools.command import bdist_egg
+ except ImportError:
+ have_setuptools = False
+else:
+ from distutils.core import setup as old_setup
+ have_setuptools = False
+
+import warnings
+import distutils.core
+import distutils.dist
+
+from numpy.distutils.extension import Extension
+from numpy.distutils.command import config, config_compiler, \
+ build, build_py, build_ext, build_clib, build_src, build_scripts, \
+ sdist, install_data, install_headers, install, bdist_rpm
+from numpy.distutils.misc_util import get_data_files, is_sequence, is_string
+
+numpy_cmdclass = {'build': build.build,
+ 'build_src': build_src.build_src,
+ 'build_scripts': build_scripts.build_scripts,
+ 'config_cc': config_compiler.config_cc,
+ 'config_fc': config_compiler.config_fc,
+ 'config': config.config,
+ 'build_ext': build_ext.build_ext,
+ 'build_py': build_py.build_py,
+ 'build_clib': build_clib.build_clib,
+ 'sdist': sdist.sdist,
+ 'install_data': install_data.install_data,
+ 'install_headers': install_headers.install_headers,
+ 'install': install.install,
+ 'bdist_rpm': bdist_rpm.bdist_rpm,
+ }
+if have_setuptools:
+ from numpy.distutils.command import egg_info
+ numpy_cmdclass['bdist_egg'] = bdist_egg.bdist_egg
+ numpy_cmdclass['develop'] = develop.develop
+ numpy_cmdclass['easy_install'] = easy_install.easy_install
+ numpy_cmdclass['egg_info'] = egg_info.egg_info
+
+def _dict_append(d, **kws):
+ for k,v in kws.items():
+ if not d.has_key(k):
+ d[k] = v
+ continue
+ dv = d[k]
+ if isinstance(dv, tuple):
+ d[k] = dv + tuple(v)
+ elif isinstance(dv, list):
+ d[k] = dv + list(v)
+ elif isinstance(dv, dict):
+ _dict_append(dv, **v)
+ elif is_string(dv):
+ d[k] = dv + v
+ else:
+ raise TypeError, repr(type(dv))
+
+def _command_line_ok(_cache=[]):
+ """ Return True if command line does not contain any
+ help or display requests.
+ """
+ if _cache:
+ return _cache[0]
+ ok = True
+ display_opts = ['--'+n for n in Distribution.display_option_names]
+ for o in Distribution.display_options:
+ if o[1]:
+ display_opts.append('-'+o[1])
+ for arg in sys.argv:
+ if arg.startswith('--help') or arg=='-h' or arg in display_opts:
+ ok = False
+ break
+ _cache.append(ok)
+ return ok
+
+def _exit_interactive_session(_cache=[]):
+ if _cache:
+ return # been here
+ _cache.append(1)
+ print '-'*72
+ raw_input('Press ENTER to close the interactive session..')
+ print '='*72
+
+def get_distribution(always=False):
+ dist = distutils.core._setup_distribution
+ # XXX Hack to get numpy installable with easy_install.
+ # The problem is easy_install runs it's own setup(), which
+ # sets up distutils.core._setup_distribution. However,
+ # when our setup() runs, that gets overwritten and lost.
+ # We can't use isinstance, as the DistributionWithoutHelpCommands
+ # class is local to a function in setuptools.command.easy_install
+ if dist is not None and \
+ repr(dist).find('DistributionWithoutHelpCommands') != -1:
+ dist = None
+ if always and dist is None:
+ dist = distutils.dist.Distribution()
+ return dist
+
+def setup(**attr):
+
+ if len(sys.argv)<=1 and not attr.get('script_args',[]):
+ from interactive import interactive_sys_argv
+ import atexit
+ atexit.register(_exit_interactive_session)
+ sys.argv[:] = interactive_sys_argv(sys.argv)
+ if len(sys.argv)>1:
+ return setup(**attr)
+
+ cmdclass = numpy_cmdclass.copy()
+
+ new_attr = attr.copy()
+ if new_attr.has_key('cmdclass'):
+ cmdclass.update(new_attr['cmdclass'])
+ new_attr['cmdclass'] = cmdclass
+
+ if new_attr.has_key('configuration'):
+ # To avoid calling configuration if there are any errors
+ # or help request in command in the line.
+ configuration = new_attr.pop('configuration')
+
+ old_dist = distutils.core._setup_distribution
+ old_stop = distutils.core._setup_stop_after
+ distutils.core._setup_distribution = None
+ distutils.core._setup_stop_after = "commandline"
+ try:
+ dist = setup(**new_attr)
+ finally:
+ distutils.core._setup_distribution = old_dist
+ distutils.core._setup_stop_after = old_stop
+ if dist.help or not _command_line_ok():
+ # probably displayed help, skip running any commands
+ return dist
+
+ # create setup dictionary and append to new_attr
+ config = configuration()
+ if hasattr(config,'todict'):
+ config = config.todict()
+ _dict_append(new_attr, **config)
+
+ # Move extension source libraries to libraries
+ libraries = []
+ for ext in new_attr.get('ext_modules',[]):
+ new_libraries = []
+ for item in ext.libraries:
+ if is_sequence(item):
+ lib_name, build_info = item
+ _check_append_ext_library(libraries, item)
+ new_libraries.append(lib_name)
+ elif is_string(item):
+ new_libraries.append(item)
+ else:
+ raise TypeError("invalid description of extension module "
+ "library %r" % (item,))
+ ext.libraries = new_libraries
+ if libraries:
+ if not new_attr.has_key('libraries'):
+ new_attr['libraries'] = []
+ for item in libraries:
+ _check_append_library(new_attr['libraries'], item)
+
+ # sources in ext_modules or libraries may contain header files
+ if (new_attr.has_key('ext_modules') or new_attr.has_key('libraries')) \
+ and not new_attr.has_key('headers'):
+ new_attr['headers'] = []
+
+ return old_setup(**new_attr)
+
+def _check_append_library(libraries, item):
+ for libitem in libraries:
+ if is_sequence(libitem):
+ if is_sequence(item):
+ if item[0]==libitem[0]:
+ if item[1] is libitem[1]:
+ return
+ warnings.warn("[0] libraries list contains %r with"
+ " different build_info" % (item[0],))
+ break
+ else:
+ if item==libitem[0]:
+ warnings.warn("[1] libraries list contains %r with"
+ " no build_info" % (item[0],))
+ break
+ else:
+ if is_sequence(item):
+ if item[0]==libitem:
+ warnings.warn("[2] libraries list contains %r with"
+ " no build_info" % (item[0],))
+ break
+ else:
+ if item==libitem:
+ return
+ libraries.append(item)
+
+def _check_append_ext_library(libraries, (lib_name,build_info)):
+ for item in libraries:
+ if is_sequence(item):
+ if item[0]==lib_name:
+ if item[1] is build_info:
+ return
+ warnings.warn("[3] libraries list contains %r with"
+ " different build_info" % (lib_name,))
+ break
+ elif item==lib_name:
+ warnings.warn("[4] libraries list contains %r with"
+ " no build_info" % (lib_name,))
+ break
+ libraries.append((lib_name,build_info))
diff --git a/numpy/distutils/cpuinfo.py b/numpy/distutils/cpuinfo.py
new file mode 100644
index 000000000..1a182eace
--- /dev/null
+++ b/numpy/distutils/cpuinfo.py
@@ -0,0 +1,696 @@
+#!/usr/bin/env python
+"""
+cpuinfo
+
+Copyright 2002 Pearu Peterson all rights reserved,
+Pearu Peterson <pearu@cens.ioc.ee>
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy (BSD style) license. See LICENSE.txt that came with
+this distribution for specifics.
+
+Note: This should be merged into proc at some point. Perhaps proc should
+be returning classes like this instead of using dictionaries.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+$Revision: 1.1 $
+$Date: 2005/04/09 19:29:34 $
+Pearu Peterson
+"""
+
+__version__ = "$Id: cpuinfo.py,v 1.1 2005/04/09 19:29:34 pearu Exp $"
+
+__all__ = ['cpu']
+
+import sys,string,re,types
+
+class cpuinfo_base:
+ """Holds CPU information and provides methods for requiring
+ the availability of various CPU features.
+ """
+
+ def _try_call(self,func):
+ try:
+ return func()
+ except:
+ pass
+
+ def __getattr__(self,name):
+ if name[0]!='_':
+ if hasattr(self,'_'+name):
+ attr = getattr(self,'_'+name)
+ if type(attr) is types.MethodType:
+ return lambda func=self._try_call,attr=attr : func(attr)
+ else:
+ return lambda : None
+ raise AttributeError,name
+
+ def _getNCPUs(self):
+ return 1
+
+ def _is_32bit(self):
+ return not self.is_64bit()
+
+class linux_cpuinfo(cpuinfo_base):
+
+ info = None
+
+ def __init__(self):
+ if self.info is not None:
+ return
+ info = []
+ try:
+ for line in open('/proc/cpuinfo').readlines():
+ name_value = map(string.strip,string.split(line,':',1))
+ if len(name_value)!=2:
+ continue
+ name,value = name_value
+ if not info or info[-1].has_key(name): # next processor
+ info.append({})
+ info[-1][name] = value
+ import commands
+ status,output = commands.getstatusoutput('uname -m')
+ if not status:
+ if not info: info.append({})
+ info[-1]['uname_m'] = string.strip(output)
+ except:
+ print sys.exc_value,'(ignoring)'
+ self.__class__.info = info
+
+ def _not_impl(self): pass
+
+ # Athlon
+
+ def _is_AMD(self):
+ return self.info[0]['vendor_id']=='AuthenticAMD'
+
+ def _is_AthlonK6_2(self):
+ return self._is_AMD() and self.info[0]['model'] == '2'
+
+ def _is_AthlonK6_3(self):
+ return self._is_AMD() and self.info[0]['model'] == '3'
+
+ def _is_AthlonK6(self):
+ return re.match(r'.*?AMD-K6',self.info[0]['model name']) is not None
+
+ def _is_AthlonK7(self):
+ return re.match(r'.*?AMD-K7',self.info[0]['model name']) is not None
+
+ def _is_AthlonMP(self):
+ return re.match(r'.*?Athlon\(tm\) MP\b',
+ self.info[0]['model name']) is not None
+
+ def _is_Athlon64(self):
+ return re.match(r'.*?Athlon\(tm\) 64\b',
+ self.info[0]['model name']) is not None
+
+ def _is_AthlonHX(self):
+ return re.match(r'.*?Athlon HX\b',
+ self.info[0]['model name']) is not None
+
+ def _is_Opteron(self):
+ return re.match(r'.*?Opteron\b',
+ self.info[0]['model name']) is not None
+
+ def _is_Hammer(self):
+ return re.match(r'.*?Hammer\b',
+ self.info[0]['model name']) is not None
+
+ # Alpha
+
+ def _is_Alpha(self):
+ return self.info[0]['cpu']=='Alpha'
+
+ def _is_EV4(self):
+ return self.is_Alpha() and self.info[0]['cpu model'] == 'EV4'
+
+ def _is_EV5(self):
+ return self.is_Alpha() and self.info[0]['cpu model'] == 'EV5'
+
+ def _is_EV56(self):
+ return self.is_Alpha() and self.info[0]['cpu model'] == 'EV56'
+
+ def _is_PCA56(self):
+ return self.is_Alpha() and self.info[0]['cpu model'] == 'PCA56'
+
+ # Intel
+
+ #XXX
+ _is_i386 = _not_impl
+
+ def _is_Intel(self):
+ return self.info[0]['vendor_id']=='GenuineIntel'
+
+ def _is_i486(self):
+ return self.info[0]['cpu']=='i486'
+
+ def _is_i586(self):
+ return self.is_Intel() and self.info[0]['cpu family'] == '5'
+
+ def _is_i686(self):
+ return self.is_Intel() and self.info[0]['cpu family'] == '6'
+
+ def _is_Celeron(self):
+ return re.match(r'.*?Celeron',
+ self.info[0]['model name']) is not None
+
+ def _is_Pentium(self):
+ return re.match(r'.*?Pentium',
+ self.info[0]['model name']) is not None
+
+ def _is_PentiumII(self):
+ return re.match(r'.*?Pentium.*?II\b',
+ self.info[0]['model name']) is not None
+
+ def _is_PentiumPro(self):
+ return re.match(r'.*?PentiumPro\b',
+ self.info[0]['model name']) is not None
+
+ def _is_PentiumMMX(self):
+ return re.match(r'.*?Pentium.*?MMX\b',
+ self.info[0]['model name']) is not None
+
+ def _is_PentiumIII(self):
+ return re.match(r'.*?Pentium.*?III\b',
+ self.info[0]['model name']) is not None
+
+ def _is_PentiumIV(self):
+ return re.match(r'.*?Pentium.*?(IV|4)\b',
+ self.info[0]['model name']) is not None
+
+ def _is_PentiumM(self):
+ return re.match(r'.*?Pentium.*?M\b',
+ self.info[0]['model name']) is not None
+
+ def _is_Prescott(self):
+ return self.is_PentiumIV() and self.has_sse3()
+
+ def _is_Nocona(self):
+ return self.is_64bit() and self.is_PentiumIV()
+
+ def _is_Core2(self):
+ return self.is_64bit() and self.is_Intel() and \
+ re.match(r'.*?Core\(TM\)2\b', \
+ self.info[0]['model name']) is not None
+
+ def _is_Itanium(self):
+ return re.match(r'.*?Itanium\b',
+ self.info[0]['family']) is not None
+
+ def _is_XEON(self):
+ return re.match(r'.*?XEON\b',
+ self.info[0]['model name'],re.IGNORECASE) is not None
+
+ _is_Xeon = _is_XEON
+
+ # Varia
+
+ def _is_singleCPU(self):
+ return len(self.info) == 1
+
+ def _getNCPUs(self):
+ return len(self.info)
+
+ def _has_fdiv_bug(self):
+ return self.info[0]['fdiv_bug']=='yes'
+
+ def _has_f00f_bug(self):
+ return self.info[0]['f00f_bug']=='yes'
+
+ def _has_mmx(self):
+ return re.match(r'.*?\bmmx\b',self.info[0]['flags']) is not None
+
+ def _has_sse(self):
+ return re.match(r'.*?\bsse\b',self.info[0]['flags']) is not None
+
+ def _has_sse2(self):
+ return re.match(r'.*?\bsse2\b',self.info[0]['flags']) is not None
+
+ def _has_sse3(self):
+ return re.match(r'.*?\bsse3\b',self.info[0]['flags']) is not None
+
+ def _has_3dnow(self):
+ return re.match(r'.*?\b3dnow\b',self.info[0]['flags']) is not None
+
+ def _has_3dnowext(self):
+ return re.match(r'.*?\b3dnowext\b',self.info[0]['flags']) is not None
+
+ def _is_64bit(self):
+ if self.is_Alpha():
+ return True
+ if self.info[0].get('clflush size','')=='64':
+ return True
+ if self.info[0].get('uname_m','')=='x86_64':
+ return True
+ if self.info[0].get('arch','')=='IA-64':
+ return True
+ return False
+
+ def _is_32bit(self):
+ return not self.is_64bit()
+
+class irix_cpuinfo(cpuinfo_base):
+
+ info = None
+
+ def __init__(self):
+ if self.info is not None:
+ return
+ info = []
+ try:
+ import commands
+ status,output = commands.getstatusoutput('sysconf')
+ if status not in [0,256]:
+ return
+ for line in output.split('\n'):
+ name_value = map(string.strip,string.split(line,' ',1))
+ if len(name_value)!=2:
+ continue
+ name,value = name_value
+ if not info:
+ info.append({})
+ info[-1][name] = value
+ except:
+ print sys.exc_value,'(ignoring)'
+ self.__class__.info = info
+
+ #print info
+ def _not_impl(self): pass
+
+ def _is_singleCPU(self):
+ return self.info[0].get('NUM_PROCESSORS') == '1'
+
+ def _getNCPUs(self):
+ return int(self.info[0].get('NUM_PROCESSORS'))
+
+ def __cputype(self,n):
+ return self.info[0].get('PROCESSORS').split()[0].lower() == 'r%s' % (n)
+ def _is_r2000(self): return self.__cputype(2000)
+ def _is_r3000(self): return self.__cputype(3000)
+ def _is_r3900(self): return self.__cputype(3900)
+ def _is_r4000(self): return self.__cputype(4000)
+ def _is_r4100(self): return self.__cputype(4100)
+ def _is_r4300(self): return self.__cputype(4300)
+ def _is_r4400(self): return self.__cputype(4400)
+ def _is_r4600(self): return self.__cputype(4600)
+ def _is_r4650(self): return self.__cputype(4650)
+ def _is_r5000(self): return self.__cputype(5000)
+ def _is_r6000(self): return self.__cputype(6000)
+ def _is_r8000(self): return self.__cputype(8000)
+ def _is_r10000(self): return self.__cputype(10000)
+ def _is_r12000(self): return self.__cputype(12000)
+ def _is_rorion(self): return self.__cputype('orion')
+
+ def get_ip(self):
+ try: return self.info[0].get('MACHINE')
+ except: pass
+ def __machine(self,n):
+ return self.info[0].get('MACHINE').lower() == 'ip%s' % (n)
+ def _is_IP19(self): return self.__machine(19)
+ def _is_IP20(self): return self.__machine(20)
+ def _is_IP21(self): return self.__machine(21)
+ def _is_IP22(self): return self.__machine(22)
+ def _is_IP22_4k(self): return self.__machine(22) and self._is_r4000()
+ def _is_IP22_5k(self): return self.__machine(22) and self._is_r5000()
+ def _is_IP24(self): return self.__machine(24)
+ def _is_IP25(self): return self.__machine(25)
+ def _is_IP26(self): return self.__machine(26)
+ def _is_IP27(self): return self.__machine(27)
+ def _is_IP28(self): return self.__machine(28)
+ def _is_IP30(self): return self.__machine(30)
+ def _is_IP32(self): return self.__machine(32)
+ def _is_IP32_5k(self): return self.__machine(32) and self._is_r5000()
+ def _is_IP32_10k(self): return self.__machine(32) and self._is_r10000()
+
+class darwin_cpuinfo(cpuinfo_base):
+
+ info = None
+
+ def __init__(self):
+ if self.info is not None:
+ return
+ info = []
+ try:
+ import commands
+ status,output = commands.getstatusoutput('arch')
+ if not status:
+ if not info: info.append({})
+ info[-1]['arch'] = string.strip(output)
+ status,output = commands.getstatusoutput('machine')
+ if not status:
+ if not info: info.append({})
+ info[-1]['machine'] = string.strip(output)
+ status,output = commands.getstatusoutput('sysctl hw')
+ if not status:
+ if not info: info.append({})
+ d = {}
+ for l in string.split(output,'\n'):
+ l = map(string.strip,string.split(l, '='))
+ if len(l)==2:
+ d[l[0]]=l[1]
+ info[-1]['sysctl_hw'] = d
+ except:
+ print sys.exc_value,'(ignoring)'
+ self.__class__.info = info
+
+ def _not_impl(self): pass
+
+ def _getNCPUs(self):
+ try: return int(self.info[0]['sysctl_hw']['hw.ncpu'])
+ except: return 1
+
+ def _is_Power_Macintosh(self):
+ return self.info[0]['sysctl_hw']['hw.machine']=='Power Macintosh'
+
+ def _is_i386(self):
+ return self.info[0]['arch']=='i386'
+ def _is_ppc(self):
+ return self.info[0]['arch']=='ppc'
+
+ def __machine(self,n):
+ return self.info[0]['machine'] == 'ppc%s'%n
+ def _is_ppc601(self): return self.__machine(601)
+ def _is_ppc602(self): return self.__machine(602)
+ def _is_ppc603(self): return self.__machine(603)
+ def _is_ppc603e(self): return self.__machine('603e')
+ def _is_ppc604(self): return self.__machine(604)
+ def _is_ppc604e(self): return self.__machine('604e')
+ def _is_ppc620(self): return self.__machine(620)
+ def _is_ppc630(self): return self.__machine(630)
+ def _is_ppc740(self): return self.__machine(740)
+ def _is_ppc7400(self): return self.__machine(7400)
+ def _is_ppc7450(self): return self.__machine(7450)
+ def _is_ppc750(self): return self.__machine(750)
+ def _is_ppc403(self): return self.__machine(403)
+ def _is_ppc505(self): return self.__machine(505)
+ def _is_ppc801(self): return self.__machine(801)
+ def _is_ppc821(self): return self.__machine(821)
+ def _is_ppc823(self): return self.__machine(823)
+ def _is_ppc860(self): return self.__machine(860)
+
+class sunos_cpuinfo(cpuinfo_base):
+
+ info = None
+
+ def __init__(self):
+ if self.info is not None:
+ return
+ info = []
+ try:
+ import commands
+ status,output = commands.getstatusoutput('arch')
+ if not status:
+ if not info: info.append({})
+ info[-1]['arch'] = string.strip(output)
+ status,output = commands.getstatusoutput('mach')
+ if not status:
+ if not info: info.append({})
+ info[-1]['mach'] = string.strip(output)
+ status,output = commands.getstatusoutput('uname -i')
+ if not status:
+ if not info: info.append({})
+ info[-1]['uname_i'] = string.strip(output)
+ status,output = commands.getstatusoutput('uname -X')
+ if not status:
+ if not info: info.append({})
+ d = {}
+ for l in string.split(output,'\n'):
+ l = map(string.strip,string.split(l, '='))
+ if len(l)==2:
+ d[l[0]]=l[1]
+ info[-1]['uname_X'] = d
+ status,output = commands.getstatusoutput('isainfo -b')
+ if not status:
+ if not info: info.append({})
+ info[-1]['isainfo_b'] = string.strip(output)
+ status,output = commands.getstatusoutput('isainfo -n')
+ if not status:
+ if not info: info.append({})
+ info[-1]['isainfo_n'] = string.strip(output)
+ status,output = commands.getstatusoutput('psrinfo -v 0')
+ if not status:
+ if not info: info.append({})
+ for l in string.split(output,'\n'):
+ m = re.match(r'\s*The (?P<p>[\w\d]+) processor operates at',l)
+ if m:
+ info[-1]['processor'] = m.group('p')
+ break
+ except:
+ print sys.exc_value,'(ignoring)'
+ self.__class__.info = info
+
+ def _not_impl(self): pass
+
+ def _is_32bit(self):
+ return self.info[0]['isainfo_b']=='32'
+ def _is_64bit(self):
+ return self.info[0]['isainfo_b']=='64'
+
+ def _is_i386(self):
+ return self.info[0]['isainfo_n']=='i386'
+ def _is_sparc(self):
+ return self.info[0]['isainfo_n']=='sparc'
+ def _is_sparcv9(self):
+ return self.info[0]['isainfo_n']=='sparcv9'
+
+ def _getNCPUs(self):
+ try: return int(self.info[0]['uname_X']['NumCPU'])
+ except: return 1
+
+ def _is_sun4(self):
+ return self.info[0]['arch']=='sun4'
+
+ def _is_SUNW(self):
+ return re.match(r'SUNW',self.info[0]['uname_i']) is not None
+ def _is_sparcstation5(self):
+ return re.match(r'.*SPARCstation-5',self.info[0]['uname_i']) is not None
+ def _is_ultra1(self):
+ return re.match(r'.*Ultra-1',self.info[0]['uname_i']) is not None
+ def _is_ultra250(self):
+ return re.match(r'.*Ultra-250',self.info[0]['uname_i']) is not None
+ def _is_ultra2(self):
+ return re.match(r'.*Ultra-2',self.info[0]['uname_i']) is not None
+ def _is_ultra30(self):
+ return re.match(r'.*Ultra-30',self.info[0]['uname_i']) is not None
+ def _is_ultra4(self):
+ return re.match(r'.*Ultra-4',self.info[0]['uname_i']) is not None
+ def _is_ultra5_10(self):
+ return re.match(r'.*Ultra-5_10',self.info[0]['uname_i']) is not None
+ def _is_ultra5(self):
+ return re.match(r'.*Ultra-5',self.info[0]['uname_i']) is not None
+ def _is_ultra60(self):
+ return re.match(r'.*Ultra-60',self.info[0]['uname_i']) is not None
+ def _is_ultra80(self):
+ return re.match(r'.*Ultra-80',self.info[0]['uname_i']) is not None
+ def _is_ultraenterprice(self):
+ return re.match(r'.*Ultra-Enterprise',self.info[0]['uname_i']) is not None
+ def _is_ultraenterprice10k(self):
+ return re.match(r'.*Ultra-Enterprise-10000',self.info[0]['uname_i']) is not None
+ def _is_sunfire(self):
+ return re.match(r'.*Sun-Fire',self.info[0]['uname_i']) is not None
+ def _is_ultra(self):
+ return re.match(r'.*Ultra',self.info[0]['uname_i']) is not None
+
+ def _is_cpusparcv7(self):
+ return self.info[0]['processor']=='sparcv7'
+ def _is_cpusparcv8(self):
+ return self.info[0]['processor']=='sparcv8'
+ def _is_cpusparcv9(self):
+ return self.info[0]['processor']=='sparcv9'
+
+class win32_cpuinfo(cpuinfo_base):
+
+ info = None
+ pkey = "HARDWARE\\DESCRIPTION\\System\\CentralProcessor"
+ # XXX: what does the value of
+ # HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0
+ # mean?
+
+ def __init__(self):
+ if self.info is not None:
+ return
+ info = []
+ try:
+ #XXX: Bad style to use so long `try:...except:...`. Fix it!
+ import _winreg
+ pkey = "HARDWARE\\DESCRIPTION\\System\\CentralProcessor"
+ prgx = re.compile(r"family\s+(?P<FML>\d+)\s+model\s+(?P<MDL>\d+)"\
+ "\s+stepping\s+(?P<STP>\d+)",re.IGNORECASE)
+ chnd=_winreg.OpenKey(_winreg.HKEY_LOCAL_MACHINE,pkey)
+ pnum=0
+ while 1:
+ try:
+ proc=_winreg.EnumKey(chnd,pnum)
+ except _winreg.error:
+ break
+ else:
+ pnum+=1
+ print proc
+ info.append({"Processor":proc})
+ phnd=_winreg.OpenKey(chnd,proc)
+ pidx=0
+ while True:
+ try:
+ name,value,vtpe=_winreg.EnumValue(phnd,pidx)
+ except _winreg.error:
+ break
+ else:
+ pidx=pidx+1
+ info[-1][name]=value
+ if name=="Identifier":
+ srch=prgx.search(value)
+ if srch:
+ info[-1]["Family"]=int(srch.group("FML"))
+ info[-1]["Model"]=int(srch.group("MDL"))
+ info[-1]["Stepping"]=int(srch.group("STP"))
+ except:
+ print sys.exc_value,'(ignoring)'
+ self.__class__.info = info
+
+ def _not_impl(self): pass
+
+ # Athlon
+
+ def _is_AMD(self):
+ return self.info[0]['VendorIdentifier']=='AuthenticAMD'
+
+ def _is_Am486(self):
+ return self.is_AMD() and self.info[0]['Family']==4
+
+ def _is_Am5x86(self):
+ return self.is_AMD() and self.info[0]['Family']==4
+
+ def _is_AMDK5(self):
+ return self.is_AMD() and self.info[0]['Family']==5 \
+ and self.info[0]['Model'] in [0,1,2,3]
+
+ def _is_AMDK6(self):
+ return self.is_AMD() and self.info[0]['Family']==5 \
+ and self.info[0]['Model'] in [6,7]
+
+ def _is_AMDK6_2(self):
+ return self.is_AMD() and self.info[0]['Family']==5 \
+ and self.info[0]['Model']==8
+
+ def _is_AMDK6_3(self):
+ return self.is_AMD() and self.info[0]['Family']==5 \
+ and self.info[0]['Model']==9
+
+ def _is_Athlon(self):
+ return self.is_AMD() and self.info[0]['Family']==6
+
+ def _is_Athlon64(self):
+ return self.is_AMD() and self.info[0]['Family']==15 \
+ and self.info[0]['Model']==4
+
+ def _is_Opteron(self):
+ return self.is_AMD() and self.info[0]['Family']==15 \
+ and self.info[0]['Model']==5
+
+ # Intel
+
+ def _is_Intel(self):
+ return self.info[0]['VendorIdentifier']=='GenuineIntel'
+
+ def _is_i386(self):
+ return self.info[0]['Family']==3
+
+ def _is_i486(self):
+ return self.info[0]['Family']==4
+
+ def _is_i586(self):
+ return self.is_Intel() and self.info[0]['Family']==5
+
+ def _is_i686(self):
+ return self.is_Intel() and self.info[0]['Family']==6
+
+ def _is_Pentium(self):
+ return self.is_Intel() and self.info[0]['Family']==5
+
+ def _is_PentiumMMX(self):
+ return self.is_Intel() and self.info[0]['Family']==5 \
+ and self.info[0]['Model']==4
+
+ def _is_PentiumPro(self):
+ return self.is_Intel() and self.info[0]['Family']==6 \
+ and self.info[0]['Model']==1
+
+ def _is_PentiumII(self):
+ return self.is_Intel() and self.info[0]['Family']==6 \
+ and self.info[0]['Model'] in [3,5,6]
+
+ def _is_PentiumIII(self):
+ return self.is_Intel() and self.info[0]['Family']==6 \
+ and self.info[0]['Model'] in [7,8,9,10,11]
+
+ def _is_PentiumIV(self):
+ return self.is_Intel() and self.info[0]['Family']==15
+
+ # Varia
+
+ def _is_singleCPU(self):
+ return len(self.info) == 1
+
+ def _getNCPUs(self):
+ return len(self.info)
+
+ def _has_mmx(self):
+ if self.is_Intel():
+ return (self.info[0]['Family']==5 and self.info[0]['Model']==4) \
+ or (self.info[0]['Family'] in [6,15])
+ elif self.is_AMD():
+ return self.info[0]['Family'] in [5,6,15]
+
+ def _has_sse(self):
+ if self.is_Intel():
+ return (self.info[0]['Family']==6 and \
+ self.info[0]['Model'] in [7,8,9,10,11]) \
+ or self.info[0]['Family']==15
+ elif self.is_AMD():
+ return (self.info[0]['Family']==6 and \
+ self.info[0]['Model'] in [6,7,8,10]) \
+ or self.info[0]['Family']==15
+
+ def _has_sse2(self):
+ return self.info[0]['Family']==15
+
+ def _has_3dnow(self):
+ # XXX: does only AMD have 3dnow??
+ return self.is_AMD() and self.info[0]['Family'] in [5,6,15]
+
+ def _has_3dnowext(self):
+ return self.is_AMD() and self.info[0]['Family'] in [6,15]
+
+if sys.platform[:5] == 'linux': # variations: linux2,linux-i386 (any others?)
+ cpuinfo = linux_cpuinfo
+elif sys.platform[:4] == 'irix':
+ cpuinfo = irix_cpuinfo
+elif sys.platform == 'darwin':
+ cpuinfo = darwin_cpuinfo
+elif sys.platform[:5] == 'sunos':
+ cpuinfo = sunos_cpuinfo
+elif sys.platform[:5] == 'win32':
+ cpuinfo = win32_cpuinfo
+elif sys.platform[:6] == 'cygwin':
+ cpuinfo = linux_cpuinfo
+#XXX: other OS's. Eg. use _winreg on Win32. Or os.uname on unices.
+else:
+ cpuinfo = cpuinfo_base
+
+cpu = cpuinfo()
+
+if __name__ == "__main__":
+
+ cpu.is_blaa()
+ cpu.is_Intel()
+ cpu.is_Alpha()
+
+ print 'CPU information:',
+ for name in dir(cpuinfo):
+ if name[0]=='_' and name[1]!='_':
+ r = getattr(cpu,name[1:])()
+ if r:
+ if r!=1:
+ print '%s=%s' %(name[1:],r),
+ else:
+ print name[1:],
+ print
diff --git a/numpy/distutils/exec_command.py b/numpy/distutils/exec_command.py
new file mode 100644
index 000000000..e00753b9a
--- /dev/null
+++ b/numpy/distutils/exec_command.py
@@ -0,0 +1,636 @@
+#!/usr/bin/env python
+"""
+exec_command
+
+Implements exec_command function that is (almost) equivalent to
+commands.getstatusoutput function but on NT, DOS systems the
+returned status is actually correct (though, the returned status
+values may be different by a factor). In addition, exec_command
+takes keyword arguments for (re-)defining environment variables.
+
+Provides functions:
+ exec_command --- execute command in a specified directory and
+ in the modified environment.
+ splitcmdline --- inverse of ' '.join(argv)
+ find_executable --- locate a command using info from environment
+ variable PATH. Equivalent to posix `which`
+ command.
+
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: 11 January 2003
+
+Requires: Python 2.x
+
+Succesfully tested on:
+ os.name | sys.platform | comments
+ --------+--------------+----------
+ posix | linux2 | Debian (sid) Linux, Python 2.1.3+, 2.2.3+, 2.3.3
+ PyCrust 0.9.3, Idle 1.0.2
+ posix | linux2 | Red Hat 9 Linux, Python 2.1.3, 2.2.2, 2.3.2
+ posix | sunos5 | SunOS 5.9, Python 2.2, 2.3.2
+ posix | darwin | Darwin 7.2.0, Python 2.3
+ nt | win32 | Windows Me
+ Python 2.3(EE), Idle 1.0, PyCrust 0.7.2
+ Python 2.1.1 Idle 0.8
+ nt | win32 | Windows 98, Python 2.1.1. Idle 0.8
+ nt | win32 | Cygwin 98-4.10, Python 2.1.1(MSC) - echo tests
+ fail i.e. redefining environment variables may
+ not work. FIXED: don't use cygwin echo!
+ Comment: also `cmd /c echo` will not work
+ but redefining environment variables do work.
+ posix | cygwin | Cygwin 98-4.10, Python 2.3.3(cygming special)
+ nt | win32 | Windows XP, Python 2.3.3
+
+Known bugs:
+- Tests, that send messages to stderr, fail when executed from MSYS prompt
+ because the messages are lost at some point.
+"""
+
+__all__ = ['exec_command','find_executable']
+
+import os
+import re
+import sys
+import tempfile
+
+from numpy.distutils.misc_util import is_sequence
+
+############################################################
+
+from log import _global_log as log
+
+############################################################
+
+def get_pythonexe():
+ pythonexe = sys.executable
+ if os.name in ['nt','dos']:
+ fdir,fn = os.path.split(pythonexe)
+ fn = fn.upper().replace('PYTHONW','PYTHON')
+ pythonexe = os.path.join(fdir,fn)
+ assert os.path.isfile(pythonexe), '%r is not a file' % (pythonexe,)
+ return pythonexe
+
+############################################################
+
+def splitcmdline(line):
+ """ Inverse of ' '.join(sys.argv).
+ """
+ log.debug('splitcmdline(%r)' % (line))
+ lst = []
+ flag = 0
+ s,pc,cc = '','',''
+ for nc in line+' ':
+ if flag==0:
+ flag = (pc != '\\' and \
+ ((cc=='"' and 1) or (cc=="'" and 2) or \
+ (cc==' ' and pc!=' ' and -2))) or flag
+ elif flag==1:
+ flag = (cc=='"' and pc!='\\' and nc==' ' and -1) or flag
+ elif flag==2:
+ flag = (cc=="'" and pc!='\\' and nc==' ' and -1) or flag
+ if flag!=-2:
+ s += cc
+ if flag<0:
+ flag = 0
+ s = s.strip()
+ if s:
+ lst.append(s)
+ s = ''
+ pc,cc = cc,nc
+ else:
+ s = s.strip()
+ if s:
+ lst.append(s)
+ log.debug('splitcmdline -> %r' % (lst))
+ return lst
+
+def test_splitcmdline():
+ l = splitcmdline('a b cc')
+ assert l==['a','b','cc'], repr(l)
+ l = splitcmdline('a')
+ assert l==['a'], repr(l)
+ l = splitcmdline('a " b cc"')
+ assert l==['a','" b cc"'], repr(l)
+ l = splitcmdline('"a bcc" -h')
+ assert l==['"a bcc"','-h'], repr(l)
+ l = splitcmdline(r'"\"a \" bcc" -h')
+ assert l==[r'"\"a \" bcc"','-h'], repr(l)
+ l = splitcmdline(" 'a bcc' -h")
+ assert l==["'a bcc'",'-h'], repr(l)
+ l = splitcmdline(r"'\'a \' bcc' -h")
+ assert l==[r"'\'a \' bcc'",'-h'], repr(l)
+
+############################################################
+
+def find_executable(exe, path=None):
+ """Return full path of a executable.
+
+ Symbolic links are not followed.
+ """
+ log.debug('find_executable(%r)' % exe)
+ orig_exe = exe
+
+ if path is None:
+ path = os.environ.get('PATH',os.defpath)
+ if os.name=='posix' and sys.version[:3]>'2.1':
+ realpath = os.path.realpath
+ else:
+ realpath = lambda a:a
+
+ if exe.startswith('"'):
+ exe = exe[1:-1]
+
+ suffixes = ['']
+ if os.name in ['nt','dos','os2']:
+ fn,ext = os.path.splitext(exe)
+ extra_suffixes = ['.exe','.com','.bat']
+ if ext.lower() not in extra_suffixes:
+ suffixes = extra_suffixes
+
+ if os.path.isabs(exe):
+ paths = ['']
+ else:
+ paths = [ os.path.abspath(p) for p in path.split(os.pathsep) ]
+
+ for path in paths:
+ fn = os.path.join(path, exe)
+ for s in suffixes:
+ f_ext = fn+s
+ if not os.path.islink(f_ext):
+ f_ext = realpath(f_ext)
+ if os.path.isfile(f_ext) and os.access(f_ext, os.X_OK):
+ log.debug('Found executable %s' % f_ext)
+ return f_ext
+
+ log.warn('Could not locate executable %s' % orig_exe)
+ return None
+
+############################################################
+
+def _preserve_environment( names ):
+ log.debug('_preserve_environment(%r)' % (names))
+ env = {}
+ for name in names:
+ env[name] = os.environ.get(name)
+ return env
+
+def _update_environment( **env ):
+ log.debug('_update_environment(...)')
+ for name,value in env.items():
+ os.environ[name] = value or ''
+
+def exec_command( command,
+ execute_in='', use_shell=None, use_tee = None,
+ _with_python = 1,
+ **env ):
+ """ Return (status,output) of executed command.
+
+ command is a concatenated string of executable and arguments.
+ The output contains both stdout and stderr messages.
+ The following special keyword arguments can be used:
+ use_shell - execute `sh -c command`
+ use_tee - pipe the output of command through tee
+ execute_in - before command `cd execute_in` and after `cd -`.
+
+ On NT, DOS systems the returned status is correct for external commands.
+ Wild cards will not work for non-posix systems or when use_shell=0.
+ """
+ log.debug('exec_command(%r,%s)' % (command,\
+ ','.join(['%s=%r'%kv for kv in env.items()])))
+
+ if use_tee is None:
+ use_tee = os.name=='posix'
+ if use_shell is None:
+ use_shell = os.name=='posix'
+ execute_in = os.path.abspath(execute_in)
+ oldcwd = os.path.abspath(os.getcwd())
+
+ if __name__[-12:] == 'exec_command':
+ exec_dir = os.path.dirname(os.path.abspath(__file__))
+ elif os.path.isfile('exec_command.py'):
+ exec_dir = os.path.abspath('.')
+ else:
+ exec_dir = os.path.abspath(sys.argv[0])
+ if os.path.isfile(exec_dir):
+ exec_dir = os.path.dirname(exec_dir)
+
+ if oldcwd!=execute_in:
+ os.chdir(execute_in)
+ log.debug('New cwd: %s' % execute_in)
+ else:
+ log.debug('Retaining cwd: %s' % oldcwd)
+
+ oldenv = _preserve_environment( env.keys() )
+ _update_environment( **env )
+
+ try:
+ # _exec_command is robust but slow, it relies on
+ # usable sys.std*.fileno() descriptors. If they
+ # are bad (like in win32 Idle, PyCrust environments)
+ # then _exec_command_python (even slower)
+ # will be used as a last resort.
+ #
+ # _exec_command_posix uses os.system and is faster
+ # but not on all platforms os.system will return
+ # a correct status.
+ if _with_python and (0 or sys.__stdout__.fileno()==-1):
+ st = _exec_command_python(command,
+ exec_command_dir = exec_dir,
+ **env)
+ elif os.name=='posix':
+ st = _exec_command_posix(command,
+ use_shell=use_shell,
+ use_tee=use_tee,
+ **env)
+ else:
+ st = _exec_command(command, use_shell=use_shell,
+ use_tee=use_tee,**env)
+ finally:
+ if oldcwd!=execute_in:
+ os.chdir(oldcwd)
+ log.debug('Restored cwd to %s' % oldcwd)
+ _update_environment(**oldenv)
+
+ return st
+
+def _exec_command_posix( command,
+ use_shell = None,
+ use_tee = None,
+ **env ):
+ log.debug('_exec_command_posix(...)')
+
+ if is_sequence(command):
+ command_str = ' '.join(list(command))
+ else:
+ command_str = command
+
+ tmpfile = tempfile.mktemp()
+ stsfile = None
+ if use_tee:
+ stsfile = tempfile.mktemp()
+ filter = ''
+ if use_tee == 2:
+ filter = r'| tr -cd "\n" | tr "\n" "."; echo'
+ command_posix = '( %s ; echo $? > %s ) 2>&1 | tee %s %s'\
+ % (command_str,stsfile,tmpfile,filter)
+ else:
+ stsfile = tempfile.mktemp()
+ command_posix = '( %s ; echo $? > %s ) > %s 2>&1'\
+ % (command_str,stsfile,tmpfile)
+ #command_posix = '( %s ) > %s 2>&1' % (command_str,tmpfile)
+
+ log.debug('Running os.system(%r)' % (command_posix))
+ status = os.system(command_posix)
+
+ if use_tee:
+ if status:
+ # if command_tee fails then fall back to robust exec_command
+ log.warn('_exec_command_posix failed (status=%s)' % status)
+ return _exec_command(command, use_shell=use_shell, **env)
+
+ if stsfile is not None:
+ f = open(stsfile,'r')
+ status_text = f.read()
+ status = int(status_text)
+ f.close()
+ os.remove(stsfile)
+
+ f = open(tmpfile,'r')
+ text = f.read()
+ f.close()
+ os.remove(tmpfile)
+
+ if text[-1:]=='\n':
+ text = text[:-1]
+
+ return status, text
+
+
+def _exec_command_python(command,
+ exec_command_dir='', **env):
+ log.debug('_exec_command_python(...)')
+
+ python_exe = get_pythonexe()
+ cmdfile = tempfile.mktemp()
+ stsfile = tempfile.mktemp()
+ outfile = tempfile.mktemp()
+
+ f = open(cmdfile,'w')
+ f.write('import os\n')
+ f.write('import sys\n')
+ f.write('sys.path.insert(0,%r)\n' % (exec_command_dir))
+ f.write('from exec_command import exec_command\n')
+ f.write('del sys.path[0]\n')
+ f.write('cmd = %r\n' % command)
+ f.write('os.environ = %r\n' % (os.environ))
+ f.write('s,o = exec_command(cmd, _with_python=0, **%r)\n' % (env))
+ f.write('f=open(%r,"w")\nf.write(str(s))\nf.close()\n' % (stsfile))
+ f.write('f=open(%r,"w")\nf.write(o)\nf.close()\n' % (outfile))
+ f.close()
+
+ cmd = '%s %s' % (python_exe, cmdfile)
+ status = os.system(cmd)
+ if status:
+ raise RuntimeError("%r failed" % (cmd,))
+ os.remove(cmdfile)
+
+ f = open(stsfile,'r')
+ status = int(f.read())
+ f.close()
+ os.remove(stsfile)
+
+ f = open(outfile,'r')
+ text = f.read()
+ f.close()
+ os.remove(outfile)
+
+ return status, text
+
+def quote_arg(arg):
+ if arg[0]!='"' and ' ' in arg:
+ return '"%s"' % arg
+ return arg
+
+def _exec_command( command, use_shell=None, use_tee = None, **env ):
+ log.debug('_exec_command(...)')
+
+ if use_shell is None:
+ use_shell = os.name=='posix'
+ if use_tee is None:
+ use_tee = os.name=='posix'
+
+ using_command = 0
+ if use_shell:
+ # We use shell (unless use_shell==0) so that wildcards can be
+ # used.
+ sh = os.environ.get('SHELL','/bin/sh')
+ if is_sequence(command):
+ argv = [sh,'-c',' '.join(list(command))]
+ else:
+ argv = [sh,'-c',command]
+ else:
+ # On NT, DOS we avoid using command.com as it's exit status is
+ # not related to the exit status of a command.
+ if is_sequence(command):
+ argv = command[:]
+ else:
+ argv = splitcmdline(command)
+
+ if hasattr(os,'spawnvpe'):
+ spawn_command = os.spawnvpe
+ else:
+ spawn_command = os.spawnve
+ argv[0] = find_executable(argv[0])
+ if not os.path.isfile(argv[0]):
+ log.warn('Executable %s does not exist' % (argv[0]))
+ if os.name in ['nt','dos']:
+ # argv[0] might be internal command
+ argv = [os.environ['COMSPEC'],'/C'] + argv
+ using_command = 1
+
+ # sys.__std*__ is used instead of sys.std* because environments
+ # like IDLE, PyCrust, etc overwrite sys.std* commands.
+ so_fileno = sys.__stdout__.fileno()
+ se_fileno = sys.__stderr__.fileno()
+ so_flush = sys.__stdout__.flush
+ se_flush = sys.__stderr__.flush
+ so_dup = os.dup(so_fileno)
+ se_dup = os.dup(se_fileno)
+
+ outfile = tempfile.mktemp()
+ fout = open(outfile,'w')
+ if using_command:
+ errfile = tempfile.mktemp()
+ ferr = open(errfile,'w')
+
+ log.debug('Running %s(%s,%r,%r,os.environ)' \
+ % (spawn_command.__name__,os.P_WAIT,argv[0],argv))
+
+ argv0 = argv[0]
+ if not using_command:
+ argv[0] = quote_arg(argv0)
+
+ so_flush()
+ se_flush()
+ os.dup2(fout.fileno(),so_fileno)
+ if using_command:
+ #XXX: disabled for now as it does not work from cmd under win32.
+ # Tests fail on msys
+ os.dup2(ferr.fileno(),se_fileno)
+ else:
+ os.dup2(fout.fileno(),se_fileno)
+ try:
+ status = spawn_command(os.P_WAIT,argv0,argv,os.environ)
+ except OSError,errmess:
+ status = 999
+ sys.stderr.write('%s: %s'%(errmess,argv[0]))
+
+ so_flush()
+ se_flush()
+ os.dup2(so_dup,so_fileno)
+ os.dup2(se_dup,se_fileno)
+
+ fout.close()
+ fout = open(outfile,'r')
+ text = fout.read()
+ fout.close()
+ os.remove(outfile)
+
+ if using_command:
+ ferr.close()
+ ferr = open(errfile,'r')
+ errmess = ferr.read()
+ ferr.close()
+ os.remove(errfile)
+ if errmess and not status:
+ # Not sure how to handle the case where errmess
+ # contains only warning messages and that should
+ # not be treated as errors.
+ #status = 998
+ if text:
+ text = text + '\n'
+ #text = '%sCOMMAND %r FAILED: %s' %(text,command,errmess)
+ text = text + errmess
+ print errmess
+ if text[-1:]=='\n':
+ text = text[:-1]
+ if status is None:
+ status = 0
+
+ if use_tee:
+ print text
+
+ return status, text
+
+
+def test_nt(**kws):
+ pythonexe = get_pythonexe()
+ echo = find_executable('echo')
+ using_cygwin_echo = echo != 'echo'
+ if using_cygwin_echo:
+ log.warn('Using cygwin echo in win32 environment is not supported')
+
+ s,o=exec_command(pythonexe\
+ +' -c "import os;print os.environ.get(\'AAA\',\'\')"')
+ assert s==0 and o=='',(s,o)
+
+ s,o=exec_command(pythonexe\
+ +' -c "import os;print os.environ.get(\'AAA\')"',
+ AAA='Tere')
+ assert s==0 and o=='Tere',(s,o)
+
+ os.environ['BBB'] = 'Hi'
+ s,o=exec_command(pythonexe\
+ +' -c "import os;print os.environ.get(\'BBB\',\'\')"')
+ assert s==0 and o=='Hi',(s,o)
+
+ s,o=exec_command(pythonexe\
+ +' -c "import os;print os.environ.get(\'BBB\',\'\')"',
+ BBB='Hey')
+ assert s==0 and o=='Hey',(s,o)
+
+ s,o=exec_command(pythonexe\
+ +' -c "import os;print os.environ.get(\'BBB\',\'\')"')
+ assert s==0 and o=='Hi',(s,o)
+ elif 0:
+ s,o=exec_command('echo Hello')
+ assert s==0 and o=='Hello',(s,o)
+
+ s,o=exec_command('echo a%AAA%')
+ assert s==0 and o=='a',(s,o)
+
+ s,o=exec_command('echo a%AAA%',AAA='Tere')
+ assert s==0 and o=='aTere',(s,o)
+
+ os.environ['BBB'] = 'Hi'
+ s,o=exec_command('echo a%BBB%')
+ assert s==0 and o=='aHi',(s,o)
+
+ s,o=exec_command('echo a%BBB%',BBB='Hey')
+ assert s==0 and o=='aHey', (s,o)
+ s,o=exec_command('echo a%BBB%')
+ assert s==0 and o=='aHi',(s,o)
+
+ s,o=exec_command('this_is_not_a_command')
+ assert s and o!='',(s,o)
+
+ s,o=exec_command('type not_existing_file')
+ assert s and o!='',(s,o)
+
+ s,o=exec_command('echo path=%path%')
+ assert s==0 and o!='',(s,o)
+
+ s,o=exec_command('%s -c "import sys;sys.stderr.write(sys.platform)"' \
+ % pythonexe)
+ assert s==0 and o=='win32',(s,o)
+
+ s,o=exec_command('%s -c "raise \'Ignore me.\'"' % pythonexe)
+ assert s==1 and o,(s,o)
+
+ s,o=exec_command('%s -c "import sys;sys.stderr.write(\'0\');sys.stderr.write(\'1\');sys.stderr.write(\'2\')"'\
+ % pythonexe)
+ assert s==0 and o=='012',(s,o)
+
+ s,o=exec_command('%s -c "import sys;sys.exit(15)"' % pythonexe)
+ assert s==15 and o=='',(s,o)
+
+ s,o=exec_command('%s -c "print \'Heipa\'"' % pythonexe)
+ assert s==0 and o=='Heipa',(s,o)
+
+ print 'ok'
+
+def test_posix(**kws):
+ s,o=exec_command("echo Hello",**kws)
+ assert s==0 and o=='Hello',(s,o)
+
+ s,o=exec_command('echo $AAA',**kws)
+ assert s==0 and o=='',(s,o)
+
+ s,o=exec_command('echo "$AAA"',AAA='Tere',**kws)
+ assert s==0 and o=='Tere',(s,o)
+
+
+ s,o=exec_command('echo "$AAA"',**kws)
+ assert s==0 and o=='',(s,o)
+
+ os.environ['BBB'] = 'Hi'
+ s,o=exec_command('echo "$BBB"',**kws)
+ assert s==0 and o=='Hi',(s,o)
+
+ s,o=exec_command('echo "$BBB"',BBB='Hey',**kws)
+ assert s==0 and o=='Hey',(s,o)
+
+ s,o=exec_command('echo "$BBB"',**kws)
+ assert s==0 and o=='Hi',(s,o)
+
+
+ s,o=exec_command('this_is_not_a_command',**kws)
+ assert s!=0 and o!='',(s,o)
+
+ s,o=exec_command('echo path=$PATH',**kws)
+ assert s==0 and o!='',(s,o)
+
+ s,o=exec_command('python -c "import sys,os;sys.stderr.write(os.name)"',**kws)
+ assert s==0 and o=='posix',(s,o)
+
+ s,o=exec_command('python -c "raise \'Ignore me.\'"',**kws)
+ assert s==1 and o,(s,o)
+
+ s,o=exec_command('python -c "import sys;sys.stderr.write(\'0\');sys.stderr.write(\'1\');sys.stderr.write(\'2\')"',**kws)
+ assert s==0 and o=='012',(s,o)
+
+ s,o=exec_command('python -c "import sys;sys.exit(15)"',**kws)
+ assert s==15 and o=='',(s,o)
+
+ s,o=exec_command('python -c "print \'Heipa\'"',**kws)
+ assert s==0 and o=='Heipa',(s,o)
+
+ print 'ok'
+
+def test_execute_in(**kws):
+ pythonexe = get_pythonexe()
+ tmpfile = tempfile.mktemp()
+ fn = os.path.basename(tmpfile)
+ tmpdir = os.path.dirname(tmpfile)
+ f = open(tmpfile,'w')
+ f.write('Hello')
+ f.close()
+
+ s,o = exec_command('%s -c "print \'Ignore the following IOError:\','\
+ 'open(%r,\'r\')"' % (pythonexe,fn),**kws)
+ assert s and o!='',(s,o)
+ s,o = exec_command('%s -c "print open(%r,\'r\').read()"' % (pythonexe,fn),
+ execute_in = tmpdir,**kws)
+ assert s==0 and o=='Hello',(s,o)
+ os.remove(tmpfile)
+ print 'ok'
+
+def test_svn(**kws):
+ s,o = exec_command(['svn','status'],**kws)
+ assert s,(s,o)
+ print 'svn ok'
+
+def test_cl(**kws):
+ if os.name=='nt':
+ s,o = exec_command(['cl','/V'],**kws)
+ assert s,(s,o)
+ print 'cl ok'
+
+if os.name=='posix':
+ test = test_posix
+elif os.name in ['nt','dos']:
+ test = test_nt
+else:
+ raise NotImplementedError,'exec_command tests for '+os.name
+
+############################################################
+
+if __name__ == "__main__":
+
+ test_splitcmdline()
+ test(use_tee=0)
+ test(use_tee=1)
+ test_execute_in(use_tee=0)
+ test_execute_in(use_tee=1)
+ test_svn(use_tee=1)
+ test_cl(use_tee=1)
diff --git a/numpy/distutils/extension.py b/numpy/distutils/extension.py
new file mode 100644
index 000000000..2db62969e
--- /dev/null
+++ b/numpy/distutils/extension.py
@@ -0,0 +1,74 @@
+"""distutils.extension
+
+Provides the Extension class, used to describe C/C++ extension
+modules in setup scripts.
+
+Overridden to support f2py.
+"""
+
+__revision__ = "$Id: extension.py,v 1.1 2005/04/09 19:29:34 pearu Exp $"
+
+from distutils.extension import Extension as old_Extension
+
+import re
+cxx_ext_re = re.compile(r'.*[.](cpp|cxx|cc)\Z',re.I).match
+fortran_pyf_ext_re = re.compile(r'.*[.](f90|f95|f77|for|ftn|f|pyf)\Z',re.I).match
+
+class Extension(old_Extension):
+ def __init__ (self, name, sources,
+ include_dirs=None,
+ define_macros=None,
+ undef_macros=None,
+ library_dirs=None,
+ libraries=None,
+ runtime_library_dirs=None,
+ extra_objects=None,
+ extra_compile_args=None,
+ extra_link_args=None,
+ export_symbols=None,
+ swig_opts=None,
+ depends=None,
+ language=None,
+ f2py_options=None,
+ module_dirs=None,
+ ):
+ old_Extension.__init__(self,name, [],
+ include_dirs,
+ define_macros,
+ undef_macros,
+ library_dirs,
+ libraries,
+ runtime_library_dirs,
+ extra_objects,
+ extra_compile_args,
+ extra_link_args,
+ export_symbols)
+ # Avoid assert statements checking that sources contains strings:
+ self.sources = sources
+
+ # Python 2.4 distutils new features
+ self.swig_opts = swig_opts or []
+
+ # Python 2.3 distutils new features
+ self.depends = depends or []
+ self.language = language
+
+ # numpy_distutils features
+ self.f2py_options = f2py_options or []
+ self.module_dirs = module_dirs or []
+
+ return
+
+ def has_cxx_sources(self):
+ for source in self.sources:
+ if cxx_ext_re(str(source)):
+ return True
+ return False
+
+ def has_f2py_sources(self):
+ for source in self.sources:
+ if fortran_pyf_ext_re(source):
+ return True
+ return False
+
+# class Extension
diff --git a/numpy/distutils/fcompiler/__init__.py b/numpy/distutils/fcompiler/__init__.py
new file mode 100644
index 000000000..799a36cb6
--- /dev/null
+++ b/numpy/distutils/fcompiler/__init__.py
@@ -0,0 +1,825 @@
+"""numpy.distutils.fcompiler
+
+Contains FCompiler, an abstract base class that defines the interface
+for the numpy.distutils Fortran compiler abstraction model.
+"""
+
+__all__ = ['FCompiler','new_fcompiler','show_fcompilers',
+ 'dummy_fortran_file']
+
+import os
+import sys
+import re
+from distutils.sysconfig import get_config_var, get_python_lib
+from distutils.fancy_getopt import FancyGetopt
+from distutils.errors import DistutilsModuleError,DistutilsArgError,\
+ DistutilsExecError,CompileError,LinkError,DistutilsPlatformError
+from distutils.util import split_quoted
+
+from numpy.distutils.ccompiler import CCompiler, gen_lib_options
+from numpy.distutils import log
+from numpy.distutils.command.config_compiler import config_fc
+from numpy.distutils.misc_util import is_string, is_sequence
+from distutils.spawn import _nt_quote_args
+
+class FCompiler(CCompiler):
+ """ Abstract base class to define the interface that must be implemented
+ by real Fortran compiler classes.
+
+ Methods that subclasses may redefine:
+
+ find_executables(), get_version_cmd(), get_linker_so(), get_version()
+ get_flags(), get_flags_opt(), get_flags_arch(), get_flags_debug()
+ get_flags_f77(), get_flags_opt_f77(), get_flags_arch_f77(),
+ get_flags_debug_f77(), get_flags_f90(), get_flags_opt_f90(),
+ get_flags_arch_f90(), get_flags_debug_f90(),
+ get_flags_fix(), get_flags_linker_so(), get_flags_version()
+
+ DON'T call these methods (except get_version) after
+ constructing a compiler instance or inside any other method.
+ All methods, except get_version_cmd() and get_flags_version(), may
+ call get_version() method.
+
+ After constructing a compiler instance, always call customize(dist=None)
+ method that finalizes compiler construction and makes the following
+ attributes available:
+ compiler_f77
+ compiler_f90
+ compiler_fix
+ linker_so
+ archiver
+ ranlib
+ libraries
+ library_dirs
+ """
+
+
+ language_map = {'.f':'f77',
+ '.for':'f77',
+ '.F':'f77', # XXX: needs preprocessor
+ '.ftn':'f77',
+ '.f77':'f77',
+ '.f90':'f90',
+ '.F90':'f90', # XXX: needs preprocessor
+ '.f95':'f90',
+ }
+ language_order = ['f90','f77']
+
+ version_pattern = None
+
+ executables = {
+ 'version_cmd' : ["f77","-v"],
+ 'compiler_f77' : ["f77"],
+ 'compiler_f90' : ["f90"],
+ 'compiler_fix' : ["f90","-fixed"],
+ 'linker_so' : ["f90","-shared"],
+ 'linker_exe' : ["f90"],
+ 'archiver' : ["ar","-cr"],
+ 'ranlib' : None,
+ }
+
+ compile_switch = "-c"
+ object_switch = "-o " # Ending space matters! It will be stripped
+ # but if it is missing then object_switch
+ # will be prefixed to object file name by
+ # string concatenation.
+ library_switch = "-o " # Ditto!
+
+ # Switch to specify where module files are created and searched
+ # for USE statement. Normally it is a string and also here ending
+ # space matters. See above.
+ module_dir_switch = None
+
+ # Switch to specify where module files are searched for USE statement.
+ module_include_switch = '-I'
+
+ pic_flags = [] # Flags to create position-independent code
+
+ src_extensions = ['.for','.ftn','.f77','.f','.f90','.f95','.F','.F90']
+ obj_extension = ".o"
+ shared_lib_extension = get_config_var('SO') # or .dll
+ static_lib_extension = ".a" # or .lib
+ static_lib_format = "lib%s%s" # or %s%s
+ shared_lib_format = "%s%s"
+ exe_extension = ""
+
+ # If compiler does not support compiling Fortran 90 then it can
+ # suggest using another compiler. For example, gnu would suggest
+ # gnu95 compiler type when there are F90 sources.
+ suggested_f90_compiler = None
+
+ ######################################################################
+ ## Methods that subclasses may redefine. But don't call these methods!
+ ## They are private to FCompiler class and may return unexpected
+ ## results if used elsewhere. So, you have been warned..
+
+ def find_executables(self):
+ """Modify self.executables to hold found executables, instead of
+ searching for them at class creation time."""
+ pass
+
+ def get_version_cmd(self):
+ """ Compiler command to print out version information. """
+ f77 = self.executables.get('compiler_f77')
+ if f77 is not None:
+ f77 = f77[0]
+ cmd = self.executables.get('version_cmd')
+ if cmd is not None:
+ cmd = cmd[0]
+ if cmd==f77:
+ cmd = self.compiler_f77[0]
+ else:
+ f90 = self.executables.get('compiler_f90')
+ if f90 is not None:
+ f90 = f90[0]
+ if cmd==f90:
+ cmd = self.compiler_f90[0]
+ return cmd
+
+ def get_linker_so(self):
+ """ Linker command to build shared libraries. """
+ f77 = self.executables['compiler_f77']
+ if f77 is not None:
+ f77 = f77[0]
+ ln = self.executables.get('linker_so')
+ if ln is not None:
+ ln = ln[0]
+ if ln==f77:
+ ln = self.compiler_f77[0]
+ else:
+ f90 = self.executables.get('compiler_f90')
+ if f90 is not None:
+ f90 = f90[0]
+ if ln==f90:
+ ln = self.compiler_f90[0]
+ return ln
+
+ def get_linker_exe(self):
+ """ Linker command to build shared libraries. """
+ f77 = self.executables['compiler_f77']
+ if f77 is not None:
+ f77 = f77[0]
+ ln = self.executables.get('linker_exe')
+ if ln is not None:
+ ln = ln[0]
+ if ln==f77:
+ ln = self.compiler_f77[0]
+ else:
+ f90 = self.executables.get('compiler_f90')
+ if f90 is not None:
+ f90 = f90[0]
+ if ln==f90:
+ ln = self.compiler_f90[0]
+ return ln
+
+ def get_flags(self):
+ """ List of flags common to all compiler types. """
+ return [] + self.pic_flags
+ def get_flags_version(self):
+ """ List of compiler flags to print out version information. """
+ if self.executables.get('version_cmd'):
+ return self.executables['version_cmd'][1:]
+ return []
+ def get_flags_f77(self):
+ """ List of Fortran 77 specific flags. """
+ if self.executables.get('compiler_f77'):
+ return self.executables['compiler_f77'][1:]
+ return []
+ def get_flags_f90(self):
+ """ List of Fortran 90 specific flags. """
+ if self.executables.get('compiler_f90'):
+ return self.executables['compiler_f90'][1:]
+ return []
+ def get_flags_free(self):
+ """ List of Fortran 90 free format specific flags. """
+ return []
+ def get_flags_fix(self):
+ """ List of Fortran 90 fixed format specific flags. """
+ if self.executables.get('compiler_fix'):
+ return self.executables['compiler_fix'][1:]
+ return []
+ def get_flags_linker_so(self):
+ """ List of linker flags to build a shared library. """
+ if self.executables.get('linker_so'):
+ return self.executables['linker_so'][1:]
+ return []
+ def get_flags_linker_exe(self):
+ """ List of linker flags to build an executable. """
+ if self.executables.get('linker_exe'):
+ return self.executables['linker_exe'][1:]
+ return []
+ def get_flags_ar(self):
+ """ List of archiver flags. """
+ if self.executables.get('archiver'):
+ return self.executables['archiver'][1:]
+ return []
+ def get_flags_opt(self):
+ """ List of architecture independent compiler flags. """
+ return []
+ def get_flags_arch(self):
+ """ List of architecture dependent compiler flags. """
+ return []
+ def get_flags_debug(self):
+ """ List of compiler flags to compile with debugging information. """
+ return []
+
+ get_flags_opt_f77 = get_flags_opt_f90 = get_flags_opt
+ get_flags_arch_f77 = get_flags_arch_f90 = get_flags_arch
+ get_flags_debug_f77 = get_flags_debug_f90 = get_flags_debug
+
+ def get_libraries(self):
+ """ List of compiler libraries. """
+ return self.libraries[:]
+ def get_library_dirs(self):
+ """ List of compiler library directories. """
+ return self.library_dirs[:]
+
+ ############################################################
+
+ ## Public methods:
+
+ def customize(self, dist=None):
+ """ Customize Fortran compiler.
+
+ This method gets Fortran compiler specific information from
+ (i) class definition, (ii) environment, (iii) distutils config
+ files, and (iv) command line.
+
+ This method should be always called after constructing a
+ compiler instance. But not in __init__ because Distribution
+ instance is needed for (iii) and (iv).
+ """
+ log.info('customize %s' % (self.__class__.__name__))
+ from distutils.dist import Distribution
+ if dist is None:
+ # These hooks are for testing only!
+ dist = Distribution()
+ dist.script_name = os.path.basename(sys.argv[0])
+ dist.script_args = ['config_fc'] + sys.argv[1:]
+ dist.cmdclass['config_fc'] = config_fc
+ dist.parse_config_files()
+ dist.parse_command_line()
+ if isinstance(dist,Distribution):
+ conf = dist.get_option_dict('config_fc')
+ else:
+ assert isinstance(dist,dict)
+ conf = dist
+ noopt = conf.get('noopt',[None,0])[1]
+ if 0: # change to `if 1:` when making release.
+ # Don't use architecture dependent compiler flags:
+ noarch = 1
+ else:
+ noarch = conf.get('noarch',[None,noopt])[1]
+ debug = conf.get('debug',[None,0])[1]
+
+ self.find_executables()
+
+ f77 = self.__get_cmd('compiler_f77','F77',(conf,'f77exec'))
+ f90 = self.__get_cmd('compiler_f90','F90',(conf,'f90exec'))
+ # Temporarily setting f77,f90 compilers so that
+ # version_cmd can use their executables.
+ if f77:
+ self.set_executables(compiler_f77=[f77])
+ if f90:
+ self.set_executables(compiler_f90=[f90])
+
+ # Must set version_cmd before others as self.get_flags*
+ # methods may call self.get_version.
+ vers_cmd = self.__get_cmd(self.get_version_cmd)
+ if vers_cmd:
+ vflags = self.__get_flags(self.get_flags_version)
+ self.set_executables(version_cmd=[vers_cmd]+vflags)
+
+ if f77:
+ f77flags = self.__get_flags(self.get_flags_f77,'F77FLAGS',
+ (conf,'f77flags'))
+ if f90:
+ f90flags = self.__get_flags(self.get_flags_f90,'F90FLAGS',
+ (conf,'f90flags'))
+ freeflags = self.__get_flags(self.get_flags_free,'FREEFLAGS',
+ (conf,'freeflags'))
+ # XXX Assuming that free format is default for f90 compiler.
+ fix = self.__get_cmd('compiler_fix','F90',(conf,'f90exec'))
+ if fix:
+ fixflags = self.__get_flags(self.get_flags_fix) + f90flags
+
+ oflags,aflags,dflags = [],[],[]
+ if not noopt:
+ oflags = self.__get_flags(self.get_flags_opt,'FOPT',(conf,'opt'))
+ if f77 and self.get_flags_opt is not self.get_flags_opt_f77:
+ f77flags += self.__get_flags(self.get_flags_opt_f77)
+ if f90 and self.get_flags_opt is not self.get_flags_opt_f90:
+ f90flags += self.__get_flags(self.get_flags_opt_f90)
+ if fix and self.get_flags_opt is not self.get_flags_opt_f90:
+ fixflags += self.__get_flags(self.get_flags_opt_f90)
+ if not noarch:
+ aflags = self.__get_flags(self.get_flags_arch,'FARCH',
+ (conf,'arch'))
+ if f77 and self.get_flags_arch is not self.get_flags_arch_f77:
+ f77flags += self.__get_flags(self.get_flags_arch_f77)
+ if f90 and self.get_flags_arch is not self.get_flags_arch_f90:
+ f90flags += self.__get_flags(self.get_flags_arch_f90)
+ if fix and self.get_flags_arch is not self.get_flags_arch_f90:
+ fixflags += self.__get_flags(self.get_flags_arch_f90)
+ if debug:
+ dflags = self.__get_flags(self.get_flags_debug,'FDEBUG')
+ if f77 and self.get_flags_debug is not self.get_flags_debug_f77:
+ f77flags += self.__get_flags(self.get_flags_debug_f77)
+ if f90 and self.get_flags_debug is not self.get_flags_debug_f90:
+ f90flags += self.__get_flags(self.get_flags_debug_f90)
+ if fix and self.get_flags_debug is not self.get_flags_debug_f90:
+ fixflags += self.__get_flags(self.get_flags_debug_f90)
+
+ fflags = self.__get_flags(self.get_flags,'FFLAGS') \
+ + dflags + oflags + aflags
+
+ if f77:
+ self.set_executables(compiler_f77=[f77]+f77flags+fflags)
+ if f90:
+ self.set_executables(compiler_f90=[f90]+freeflags+f90flags+fflags)
+ if fix:
+ self.set_executables(compiler_fix=[fix]+fixflags+fflags)
+ #XXX: Do we need LDSHARED->SOSHARED, LDFLAGS->SOFLAGS
+ linker_so = self.__get_cmd(self.get_linker_so,'LDSHARED')
+ if linker_so:
+ linker_so_flags = self.__get_flags(self.get_flags_linker_so,'LDFLAGS')
+ if sys.platform.startswith('aix'):
+ python_lib = get_python_lib(standard_lib=1)
+ ld_so_aix = os.path.join(python_lib, 'config', 'ld_so_aix')
+ python_exp = os.path.join(python_lib, 'config', 'python.exp')
+ linker_so = [ld_so_aix, linker_so, '-bI:'+python_exp]
+ else:
+ linker_so = [linker_so]
+ self.set_executables(linker_so=linker_so+linker_so_flags)
+
+ linker_exe = self.__get_cmd(self.get_linker_exe,'LD')
+ if linker_exe:
+ linker_exe_flags = self.__get_flags(self.get_flags_linker_exe,'LDFLAGS')
+ self.set_executables(linker_exe=[linker_exe]+linker_exe_flags)
+ ar = self.__get_cmd('archiver','AR')
+ if ar:
+ arflags = self.__get_flags(self.get_flags_ar,'ARFLAGS')
+ self.set_executables(archiver=[ar]+arflags)
+
+ ranlib = self.__get_cmd('ranlib','RANLIB')
+ if ranlib:
+ self.set_executables(ranlib=[ranlib])
+
+ self.set_library_dirs(self.get_library_dirs())
+ self.set_libraries(self.get_libraries())
+
+
+ verbose = conf.get('verbose',[None,0])[1]
+ if verbose:
+ self.dump_properties()
+ return
+
+ def dump_properties(self):
+ """ Print out the attributes of a compiler instance. """
+ props = []
+ for key in self.executables.keys() + \
+ ['version','libraries','library_dirs',
+ 'object_switch','compile_switch']:
+ if hasattr(self,key):
+ v = getattr(self,key)
+ props.append((key, None, '= '+`v`))
+ props.sort()
+
+ pretty_printer = FancyGetopt(props)
+ for l in pretty_printer.generate_help("%s instance properties:" \
+ % (self.__class__.__name__)):
+ if l[:4]==' --':
+ l = ' ' + l[4:]
+ print l
+ return
+
+ ###################
+
+ def _compile(self, obj, src, ext, cc_args, extra_postargs, pp_opts):
+ """Compile 'src' to product 'obj'."""
+ src_flags = {}
+ if is_f_file(src) and not has_f90_header(src):
+ flavor = ':f77'
+ compiler = self.compiler_f77
+ src_flags = get_f77flags(src)
+ elif is_free_format(src):
+ flavor = ':f90'
+ compiler = self.compiler_f90
+ if compiler is None:
+ raise DistutilsExecError, 'f90 not supported by %s needed for %s'\
+ % (self.__class__.__name__,src)
+ else:
+ flavor = ':fix'
+ compiler = self.compiler_fix
+ if compiler is None:
+ raise DistutilsExecError, 'f90 (fixed) not supported by %s needed for %s'\
+ % (self.__class__.__name__,src)
+ if self.object_switch[-1]==' ':
+ o_args = [self.object_switch.strip(),obj]
+ else:
+ o_args = [self.object_switch.strip()+obj]
+
+ assert self.compile_switch.strip()
+ s_args = [self.compile_switch, src]
+
+ extra_flags = src_flags.get(self.compiler_type,[])
+ if extra_flags:
+ log.info('using compile options from source: %r' \
+ % ' '.join(extra_flags))
+
+ if os.name == 'nt':
+ compiler = _nt_quote_args(compiler)
+ command = compiler + cc_args + extra_flags + s_args + o_args + extra_postargs
+
+ display = '%s: %s' % (os.path.basename(compiler[0]) + flavor,
+ src)
+ try:
+ self.spawn(command,display=display)
+ except DistutilsExecError, msg:
+ raise CompileError, msg
+
+ return
+
+ def module_options(self, module_dirs, module_build_dir):
+ options = []
+ if self.module_dir_switch is not None:
+ if self.module_dir_switch[-1]==' ':
+ options.extend([self.module_dir_switch.strip(),module_build_dir])
+ else:
+ options.append(self.module_dir_switch.strip()+module_build_dir)
+ else:
+ print 'XXX: module_build_dir=%r option ignored' % (module_build_dir)
+ print 'XXX: Fix module_dir_switch for ',self.__class__.__name__
+ if self.module_include_switch is not None:
+ for d in [module_build_dir]+module_dirs:
+ options.append('%s%s' % (self.module_include_switch, d))
+ else:
+ print 'XXX: module_dirs=%r option ignored' % (module_dirs)
+ print 'XXX: Fix module_include_switch for ',self.__class__.__name__
+ return options
+
+ def library_option(self, lib):
+ return "-l" + lib
+ def library_dir_option(self, dir):
+ return "-L" + dir
+
+ def link(self, target_desc, objects,
+ output_filename, output_dir=None, libraries=None,
+ library_dirs=None, runtime_library_dirs=None,
+ export_symbols=None, debug=0, extra_preargs=None,
+ extra_postargs=None, build_temp=None, target_lang=None):
+ objects, output_dir = self._fix_object_args(objects, output_dir)
+ libraries, library_dirs, runtime_library_dirs = \
+ self._fix_lib_args(libraries, library_dirs, runtime_library_dirs)
+
+ lib_opts = gen_lib_options(self, library_dirs, runtime_library_dirs,
+ libraries)
+ if is_string(output_dir):
+ output_filename = os.path.join(output_dir, output_filename)
+ elif output_dir is not None:
+ raise TypeError, "'output_dir' must be a string or None"
+
+ if self._need_link(objects, output_filename):
+ if self.library_switch[-1]==' ':
+ o_args = [self.library_switch.strip(),output_filename]
+ else:
+ o_args = [self.library_switch.strip()+output_filename]
+
+ if is_string(self.objects):
+ ld_args = objects + [self.objects]
+ else:
+ ld_args = objects + self.objects
+ ld_args = ld_args + lib_opts + o_args
+ if debug:
+ ld_args[:0] = ['-g']
+ if extra_preargs:
+ ld_args[:0] = extra_preargs
+ if extra_postargs:
+ ld_args.extend(extra_postargs)
+ self.mkpath(os.path.dirname(output_filename))
+ if target_desc == CCompiler.EXECUTABLE:
+ linker = self.linker_exe[:]
+ else:
+ linker = self.linker_so[:]
+ if os.name == 'nt':
+ linker = _nt_quote_args(linker)
+ command = linker + ld_args
+ try:
+ self.spawn(command)
+ except DistutilsExecError, msg:
+ raise LinkError, msg
+ else:
+ log.debug("skipping %s (up-to-date)", output_filename)
+ return
+
+
+ ## Private methods:
+
+ def __get_cmd(self, command, envvar=None, confvar=None):
+ if command is None:
+ var = None
+ elif is_string(command):
+ var = self.executables[command]
+ if var is not None:
+ var = var[0]
+ else:
+ var = command()
+ if envvar is not None:
+ var = os.environ.get(envvar, var)
+ if confvar is not None:
+ var = confvar[0].get(confvar[1], [None,var])[1]
+ return var
+
+ def __get_flags(self, command, envvar=None, confvar=None):
+ if command is None:
+ var = []
+ elif is_string(command):
+ var = self.executables[command][1:]
+ else:
+ var = command()
+ if envvar is not None:
+ var = os.environ.get(envvar, var)
+ if confvar is not None:
+ var = confvar[0].get(confvar[1], [None,var])[1]
+ if is_string(var):
+ var = split_quoted(var)
+ return var
+
+ ## class FCompiler
+
+fcompiler_class = {'gnu':('gnu','GnuFCompiler',
+ "GNU Fortran Compiler"),
+ 'gnu95':('gnu','Gnu95FCompiler',
+ "GNU 95 Fortran Compiler"),
+ 'g95':('g95','G95FCompiler',
+ "G95 Fortran Compiler"),
+ 'pg':('pg','PGroupFCompiler',
+ "Portland Group Fortran Compiler"),
+ 'absoft':('absoft','AbsoftFCompiler',
+ "Absoft Corp Fortran Compiler"),
+ 'mips':('mips','MipsFCompiler',
+ "MIPSpro Fortran Compiler"),
+ 'sun':('sun','SunFCompiler',
+ "Sun|Forte Fortran 95 Compiler"),
+ 'intel':('intel','IntelFCompiler',
+ "Intel Fortran Compiler for 32-bit apps"),
+ 'intelv':('intel','IntelVisualFCompiler',
+ "Intel Visual Fortran Compiler for 32-bit apps"),
+ 'intele':('intel','IntelItaniumFCompiler',
+ "Intel Fortran Compiler for Itanium apps"),
+ 'intelev':('intel','IntelItaniumVisualFCompiler',
+ "Intel Visual Fortran Compiler for Itanium apps"),
+ 'intelem':('intel','IntelEM64TFCompiler',
+ "Intel Fortran Compiler for EM64T-based apps"),
+ 'nag':('nag','NAGFCompiler',
+ "NAGWare Fortran 95 Compiler"),
+ 'compaq':('compaq','CompaqFCompiler',
+ "Compaq Fortran Compiler"),
+ 'compaqv':('compaq','CompaqVisualFCompiler',
+ "DIGITAL|Compaq Visual Fortran Compiler"),
+ 'vast':('vast','VastFCompiler',
+ "Pacific-Sierra Research Fortran 90 Compiler"),
+ 'hpux':('hpux','HPUXFCompiler',
+ "HP Fortran 90 Compiler"),
+ 'lahey':('lahey','LaheyFCompiler',
+ "Lahey/Fujitsu Fortran 95 Compiler"),
+ 'ibm':('ibm','IbmFCompiler',
+ "IBM XL Fortran Compiler"),
+ 'f':('f','FFCompiler',
+ "Fortran Company/NAG F Compiler"),
+ 'none':('none','NoneFCompiler',"Fake Fortran compiler")
+ }
+
+_default_compilers = (
+ # Platform mappings
+ ('win32',('gnu','intelv','absoft','compaqv','intelev','gnu95','g95')),
+ ('cygwin.*',('gnu','intelv','absoft','compaqv','intelev','gnu95','g95')),
+ ('linux.*',('gnu','intel','lahey','pg','absoft','nag','vast','compaq',
+ 'intele','intelem','gnu95','g95')),
+ ('darwin.*',('nag','absoft','ibm','gnu','gnu95','g95')),
+ ('sunos.*',('sun','gnu','gnu95','g95')),
+ ('irix.*',('mips','gnu','gnu95',)),
+ ('aix.*',('ibm','gnu','gnu95',)),
+ # OS mappings
+ ('posix',('gnu','gnu95',)),
+ ('nt',('gnu','gnu95',)),
+ ('mac',('gnu','gnu95',)),
+ )
+
+def _find_existing_fcompiler(compilers, osname=None, platform=None, requiref90=None):
+ for compiler in compilers:
+ v = None
+ try:
+ c = new_fcompiler(plat=platform, compiler=compiler)
+ c.customize()
+ v = c.get_version()
+ if requiref90 and c.compiler_f90 is None:
+ v = None
+ new_compiler = c.suggested_f90_compiler
+ if new_compiler:
+ log.warn('Trying %r compiler as suggested by %r compiler for f90 support.' % (compiler, new_compiler))
+ c = new_fcompiler(plat=platform, compiler=new_compiler)
+ c.customize()
+ v = c.get_version()
+ if v is not None:
+ compiler = new_compiler
+ if requiref90 and c.compiler_f90 is None:
+ raise ValueError,'%s does not support compiling f90 codes, skipping.' \
+ % (c.__class__.__name__)
+ except DistutilsModuleError:
+ pass
+ except Exception, msg:
+ log.warn(msg)
+ if v is not None:
+ return compiler
+ return
+
+def get_default_fcompiler(osname=None, platform=None, requiref90=None):
+ """ Determine the default Fortran compiler to use for the given platform. """
+ if osname is None:
+ osname = os.name
+ if platform is None:
+ platform = sys.platform
+ matching_compilers = []
+ for pattern, compiler in _default_compilers:
+ if re.match(pattern, platform) is not None or \
+ re.match(pattern, osname) is not None:
+ if is_sequence(compiler):
+ matching_compilers.extend(list(compiler))
+ else:
+ matching_compilers.append(compiler)
+ if not matching_compilers:
+ matching_compilers.append('gnu')
+ compiler = _find_existing_fcompiler(matching_compilers,
+ osname=osname,
+ platform=platform,
+ requiref90=requiref90)
+ if compiler is not None:
+ return compiler
+ return matching_compilers[0]
+
+def new_fcompiler(plat=None,
+ compiler=None,
+ verbose=0,
+ dry_run=0,
+ force=0,
+ requiref90=0):
+ """ Generate an instance of some FCompiler subclass for the supplied
+ platform/compiler combination.
+ """
+ if plat is None:
+ plat = os.name
+ try:
+ if compiler is None:
+ compiler = get_default_fcompiler(plat,requiref90=requiref90)
+ (module_name, class_name, long_description) = fcompiler_class[compiler]
+ except KeyError:
+ msg = "don't know how to compile Fortran code on platform '%s'" % plat
+ if compiler is not None:
+ msg = msg + " with '%s' compiler." % compiler
+ msg = msg + " Supported compilers are: %s)" \
+ % (','.join(fcompiler_class.keys()))
+ raise DistutilsPlatformError, msg
+
+ try:
+ module_name = 'numpy.distutils.fcompiler.'+module_name
+ __import__ (module_name)
+ module = sys.modules[module_name]
+ klass = vars(module)[class_name]
+ except ImportError:
+ raise DistutilsModuleError, \
+ "can't compile Fortran code: unable to load module '%s'" % \
+ module_name
+ except KeyError:
+ raise DistutilsModuleError, \
+ ("can't compile Fortran code: unable to find class '%s' " +
+ "in module '%s'") % (class_name, module_name)
+ compiler = klass(None, dry_run, force)
+ log.debug('new_fcompiler returns %s' % (klass))
+ return compiler
+
+def show_fcompilers(dist = None):
+ """ Print list of available compilers (used by the "--help-fcompiler"
+ option to "config_fc").
+ """
+ if dist is None:
+ from distutils.dist import Distribution
+ dist = Distribution()
+ dist.script_name = os.path.basename(sys.argv[0])
+ dist.script_args = ['config_fc'] + sys.argv[1:]
+ dist.cmdclass['config_fc'] = config_fc
+ dist.parse_config_files()
+ dist.parse_command_line()
+ compilers = []
+ compilers_na = []
+ compilers_ni = []
+ for compiler in fcompiler_class.keys():
+ v = 'N/A'
+ log.set_verbosity(-2)
+ try:
+ c = new_fcompiler(compiler=compiler)
+ c.customize(dist)
+ v = c.get_version()
+ except DistutilsModuleError:
+ pass
+ except Exception, msg:
+ log.warn(msg)
+
+ if v is None:
+ compilers_na.append(("fcompiler="+compiler, None,
+ fcompiler_class[compiler][2]))
+ elif v=='N/A':
+ compilers_ni.append(("fcompiler="+compiler, None,
+ fcompiler_class[compiler][2]))
+ else:
+ compilers.append(("fcompiler="+compiler, None,
+ fcompiler_class[compiler][2] + ' (%s)' % v))
+
+ compilers.sort()
+ compilers_na.sort()
+ pretty_printer = FancyGetopt(compilers)
+ pretty_printer.print_help("List of available Fortran compilers:")
+ pretty_printer = FancyGetopt(compilers_na)
+ pretty_printer.print_help("List of unavailable Fortran compilers:")
+ if compilers_ni:
+ pretty_printer = FancyGetopt(compilers_ni)
+ pretty_printer.print_help("List of unimplemented Fortran compilers:")
+ print "For compiler details, run 'config_fc --verbose' setup command."
+
+def dummy_fortran_file():
+ import atexit
+ import tempfile
+ dummy_name = tempfile.mktemp()+'__dummy'
+ dummy = open(dummy_name+'.f','w')
+ dummy.write(" subroutine dummy()\n end\n")
+ dummy.close()
+ def rm_file(name=dummy_name,log_threshold=log._global_log.threshold):
+ save_th = log._global_log.threshold
+ log.set_threshold(log_threshold)
+ try: os.remove(name+'.f'); log.debug('removed '+name+'.f')
+ except OSError: pass
+ try: os.remove(name+'.o'); log.debug('removed '+name+'.o')
+ except OSError: pass
+ log.set_threshold(save_th)
+ atexit.register(rm_file)
+ return dummy_name
+
+is_f_file = re.compile(r'.*[.](for|ftn|f77|f)\Z',re.I).match
+_has_f_header = re.compile(r'-[*]-\s*fortran\s*-[*]-',re.I).search
+_has_f90_header = re.compile(r'-[*]-\s*f90\s*-[*]-',re.I).search
+_has_fix_header = re.compile(r'-[*]-\s*fix\s*-[*]-',re.I).search
+_free_f90_start = re.compile(r'[^c*!]\s*[^\s\d\t]',re.I).match
+
+def is_free_format(file):
+ """Check if file is in free format Fortran."""
+ # f90 allows both fixed and free format, assuming fixed unless
+ # signs of free format are detected.
+ result = 0
+ f = open(file,'r')
+ line = f.readline()
+ n = 10000 # the number of non-comment lines to scan for hints
+ if _has_f_header(line):
+ n = 0
+ elif _has_f90_header(line):
+ n = 0
+ result = 1
+ while n>0 and line:
+ line = line.rstrip()
+ if line and line[0]!='!':
+ n -= 1
+ if (line[0]!='\t' and _free_f90_start(line[:5])) or line[-1:]=='&':
+ result = 1
+ break
+ line = f.readline()
+ f.close()
+ return result
+
+def has_f90_header(src):
+ f = open(src,'r')
+ line = f.readline()
+ f.close()
+ return _has_f90_header(line) or _has_fix_header(line)
+
+_f77flags_re = re.compile(r'(c|)f77flags\s*\(\s*(?P<fcname>\w+)\s*\)\s*=\s*(?P<fflags>.*)',re.I)
+def get_f77flags(src):
+ """
+ Search the first 20 lines of fortran 77 code for line pattern
+ `CF77FLAGS(<fcompiler type>)=<f77 flags>`
+ Return a dictionary {<fcompiler type>:<f77 flags>}.
+ """
+ flags = {}
+ f = open(src,'r')
+ i = 0
+ for line in f.readlines():
+ i += 1
+ if i>20: break
+ m = _f77flags_re.match(line)
+ if not m: continue
+ fcname = m.group('fcname').strip()
+ fflags = m.group('fflags').strip()
+ flags[fcname] = split_quoted(fflags)
+ f.close()
+ return flags
+
+if __name__ == '__main__':
+ show_fcompilers()
diff --git a/numpy/distutils/fcompiler/absoft.py b/numpy/distutils/fcompiler/absoft.py
new file mode 100644
index 000000000..a00ca78b8
--- /dev/null
+++ b/numpy/distutils/fcompiler/absoft.py
@@ -0,0 +1,151 @@
+
+# http://www.absoft.com/literature/osxuserguide.pdf
+# http://www.absoft.com/documentation.html
+
+# Notes:
+# - when using -g77 then use -DUNDERSCORE_G77 to compile f2py
+# generated extension modules (works for f2py v2.45.241_1936 and up)
+
+import os
+import sys
+
+from numpy.distutils.cpuinfo import cpu
+from numpy.distutils.fcompiler import FCompiler, dummy_fortran_file
+from numpy.distutils.misc_util import cyg2win32
+
+class AbsoftFCompiler(FCompiler):
+
+ compiler_type = 'absoft'
+ #version_pattern = r'FORTRAN 77 Compiler (?P<version>[^\s*,]*).*?Absoft Corp'
+ version_pattern = r'(f90:.*?(Absoft Pro FORTRAN Version|FORTRAN 77 Compiler|Absoft Fortran Compiler Version|Copyright Absoft Corporation.*?Version))'+\
+ r' (?P<version>[^\s*,]*)(.*?Absoft Corp|)'
+
+ # on windows: f90 -V -c dummy.f
+ # f90: Copyright Absoft Corporation 1994-1998 mV2; Cray Research, Inc. 1994-1996 CF90 (2.x.x.x f36t87) Version 2.3 Wed Apr 19, 2006 13:05:16
+
+ # samt5735(8)$ f90 -V -c dummy.f
+ # f90: Copyright Absoft Corporation 1994-2002; Absoft Pro FORTRAN Version 8.0
+ # Note that fink installs g77 as f77, so need to use f90 for detection.
+
+ executables = {
+ 'version_cmd' : ["f90", "-V -c %(fname)s.f -o %(fname)s.o" \
+ % {'fname':cyg2win32(dummy_fortran_file())}],
+ 'compiler_f77' : ["f77"],
+ 'compiler_fix' : ["f90"],
+ 'compiler_f90' : ["f90"],
+ 'linker_so' : ["f90"],
+ 'archiver' : ["ar", "-cr"],
+ 'ranlib' : ["ranlib"]
+ }
+
+ if os.name=='nt':
+ library_switch = '/out:' #No space after /out:!
+
+ module_dir_switch = None
+ module_include_switch = '-p'
+
+ def get_flags_linker_so(self):
+ if os.name=='nt':
+ opt = ['/dll']
+ # The "-K shared" switches are being left in for pre-9.0 versions
+ # of Absoft though I don't think versions earlier than 9 can
+ # actually be used to build shared libraries. In fact, version
+ # 8 of Absoft doesn't recognize "-K shared" and will fail.
+ elif self.get_version() >= '9.0':
+ opt = ['-shared']
+ else:
+ opt = ["-K","shared"]
+ return opt
+
+ def library_dir_option(self, dir):
+ if os.name=='nt':
+ return ['-link','/PATH:"%s"' % (dir)]
+ return "-L" + dir
+
+ def library_option(self, lib):
+ if os.name=='nt':
+ return '%s.lib' % (lib)
+ return "-l" + lib
+
+ def get_library_dirs(self):
+ opt = FCompiler.get_library_dirs(self)
+ d = os.environ.get('ABSOFT')
+ if d:
+ if self.get_version() >= '10.0':
+ # use shared libraries, the static libraries were not compiled -fPIC
+ prefix = 'sh'
+ else:
+ prefix = ''
+ if cpu.is_64bit():
+ suffix = '64'
+ else:
+ suffix = ''
+ opt.append(os.path.join(d, '%slib%s' % (prefix, suffix)))
+ return opt
+
+ def get_libraries(self):
+ opt = FCompiler.get_libraries(self)
+ if self.get_version() >= '10.0':
+ opt.extend(['af90math', 'afio', 'af77math', 'U77'])
+ elif self.get_version() >= '8.0':
+ opt.extend(['f90math','fio','f77math','U77'])
+ else:
+ opt.extend(['fio','f90math','fmath','U77'])
+ if os.name =='nt':
+ opt.append('COMDLG32')
+ return opt
+
+ def get_flags(self):
+ opt = FCompiler.get_flags(self)
+ if os.name != 'nt':
+ opt.extend(['-s'])
+ if self.get_version():
+ if self.get_version()>='8.2':
+ opt.append('-fpic')
+ return opt
+
+ def get_flags_f77(self):
+ opt = FCompiler.get_flags_f77(self)
+ opt.extend(['-N22','-N90','-N110'])
+ v = self.get_version()
+ if os.name == 'nt':
+ if v and v>='8.0':
+ opt.extend(['-f','-N15'])
+ else:
+ opt.append('-f')
+ if v:
+ if v<='4.6':
+ opt.append('-B108')
+ else:
+ # Though -N15 is undocumented, it works with
+ # Absoft 8.0 on Linux
+ opt.append('-N15')
+ return opt
+
+ def get_flags_f90(self):
+ opt = FCompiler.get_flags_f90(self)
+ opt.extend(["-YCFRL=1","-YCOM_NAMES=LCS","-YCOM_PFX","-YEXT_PFX",
+ "-YCOM_SFX=_","-YEXT_SFX=_","-YEXT_NAMES=LCS"])
+ if self.get_version():
+ if self.get_version()>'4.6':
+ opt.extend(["-YDEALLOC=ALL"])
+ return opt
+
+ def get_flags_fix(self):
+ opt = FCompiler.get_flags_fix(self)
+ opt.extend(["-YCFRL=1","-YCOM_NAMES=LCS","-YCOM_PFX","-YEXT_PFX",
+ "-YCOM_SFX=_","-YEXT_SFX=_","-YEXT_NAMES=LCS"])
+ opt.extend(["-f","fixed"])
+ return opt
+
+ def get_flags_opt(self):
+ opt = ['-O']
+ return opt
+
+if __name__ == '__main__':
+ from distutils import log
+ log.set_verbosity(2)
+ from numpy.distutils.fcompiler import new_fcompiler
+ compiler = new_fcompiler(compiler='absoft')
+ compiler.customize()
+ print compiler.get_version()
diff --git a/numpy/distutils/fcompiler/compaq.py b/numpy/distutils/fcompiler/compaq.py
new file mode 100644
index 000000000..c2897f5ca
--- /dev/null
+++ b/numpy/distutils/fcompiler/compaq.py
@@ -0,0 +1,96 @@
+
+#http://www.compaq.com/fortran/docs/
+
+import os
+import sys
+
+from numpy.distutils.cpuinfo import cpu
+from numpy.distutils.fcompiler import FCompiler
+
+class CompaqFCompiler(FCompiler):
+
+ compiler_type = 'compaq'
+ version_pattern = r'Compaq Fortran (?P<version>[^\s]*).*'
+
+ if sys.platform[:5]=='linux':
+ fc_exe = 'fort'
+ else:
+ fc_exe = 'f90'
+
+ executables = {
+ 'version_cmd' : [fc_exe, "-version"],
+ 'compiler_f77' : [fc_exe, "-f77rtl","-fixed"],
+ 'compiler_fix' : [fc_exe, "-fixed"],
+ 'compiler_f90' : [fc_exe],
+ 'linker_so' : [fc_exe],
+ 'archiver' : ["ar", "-cr"],
+ 'ranlib' : ["ranlib"]
+ }
+
+ module_dir_switch = '-module ' # not tested
+ module_include_switch = '-I'
+
+ def get_flags(self):
+ return ['-assume no2underscore','-nomixed_str_len_arg']
+ def get_flags_debug(self):
+ return ['-g','-check bounds']
+ def get_flags_opt(self):
+ return ['-O4','-align dcommons','-assume bigarrays',
+ '-assume nozsize','-math_library fast']
+ def get_flags_arch(self):
+ return ['-arch host', '-tune host']
+ def get_flags_linker_so(self):
+ if sys.platform[:5]=='linux':
+ return ['-shared']
+ return ['-shared','-Wl,-expect_unresolved,*']
+
+class CompaqVisualFCompiler(FCompiler):
+
+ compiler_type = 'compaqv'
+ version_pattern = r'(DIGITAL|Compaq) Visual Fortran Optimizing Compiler'\
+ ' Version (?P<version>[^\s]*).*'
+
+ compile_switch = '/compile_only'
+ object_switch = '/object:'
+ library_switch = '/OUT:' #No space after /OUT:!
+
+ static_lib_extension = ".lib"
+ static_lib_format = "%s%s"
+ module_dir_switch = '/module:'
+ module_include_switch = '/I'
+
+ ar_exe = 'lib.exe'
+ fc_exe = 'DF'
+ if sys.platform=='win32':
+ from distutils.msvccompiler import MSVCCompiler
+ m = MSVCCompiler()
+ m.initialize()
+ ar_exe = m.lib
+
+ executables = {
+ 'version_cmd' : ['DF', "/what"],
+ 'compiler_f77' : ['DF', "/f77rtl","/fixed"],
+ 'compiler_fix' : ['DF', "/fixed"],
+ 'compiler_f90' : ['DF'],
+ 'linker_so' : ['DF'],
+ 'archiver' : [ar_exe, "/OUT:"],
+ 'ranlib' : None
+ }
+
+ def get_flags(self):
+ return ['/nologo','/MD','/WX','/iface=(cref,nomixed_str_len_arg)',
+ '/names:lowercase','/assume:underscore']
+ def get_flags_opt(self):
+ return ['/Ox','/fast','/optimize:5','/unroll:0','/math_library:fast']
+ def get_flags_arch(self):
+ return ['/threads']
+ def get_flags_debug(self):
+ return ['/debug']
+
+if __name__ == '__main__':
+ from distutils import log
+ log.set_verbosity(2)
+ from numpy.distutils.fcompiler import new_fcompiler
+ compiler = new_fcompiler(compiler='compaq')
+ compiler.customize()
+ print compiler.get_version()
diff --git a/numpy/distutils/fcompiler/g95.py b/numpy/distutils/fcompiler/g95.py
new file mode 100644
index 000000000..8fe79bfbb
--- /dev/null
+++ b/numpy/distutils/fcompiler/g95.py
@@ -0,0 +1,48 @@
+# http://g95.sourceforge.net/
+
+import os
+import sys
+
+from numpy.distutils.cpuinfo import cpu
+from numpy.distutils.fcompiler import FCompiler
+
+class G95FCompiler(FCompiler):
+
+ compiler_type = 'g95'
+# version_pattern = r'G95 \((GCC (?P<gccversion>[\d.]+)|.*?) \(g95!\) (?P<version>.*)\).*'
+ # $ g95 --version
+ # G95 (GCC 4.0.3 (g95!) May 22 2006)
+
+ version_pattern = r'G95 \((GCC (?P<gccversion>[\d.]+)|.*?) \(g95 (?P<version>.*)!\) (?P<date>.*)\).*'
+ # $ g95 --version
+ # G95 (GCC 4.0.3 (g95 0.90!) Aug 22 2006)
+
+
+ executables = {
+ 'version_cmd' : ["g95", "--version"],
+ 'compiler_f77' : ["g95", "-ffixed-form"],
+ 'compiler_fix' : ["g95", "-ffixed-form"],
+ 'compiler_f90' : ["g95"],
+ 'linker_so' : ["g95","-shared"],
+ 'archiver' : ["ar", "-cr"],
+ 'ranlib' : ["ranlib"]
+ }
+ pic_flags = ['-fpic']
+ module_dir_switch = '-fmod='
+ module_include_switch = '-I'
+
+ def get_flags(self):
+ return ['-fno-second-underscore']
+ def get_flags_opt(self):
+ return ['-O']
+ def get_flags_debug(self):
+ return ['-g']
+
+if __name__ == '__main__':
+ from distutils import log
+ log.set_verbosity(2)
+ from numpy.distutils.fcompiler import new_fcompiler
+ #compiler = new_fcompiler(compiler='g95')
+ compiler = G95FCompiler()
+ compiler.customize()
+ print compiler.get_version()
diff --git a/numpy/distutils/fcompiler/gnu.py b/numpy/distutils/fcompiler/gnu.py
new file mode 100644
index 000000000..64be7fbfe
--- /dev/null
+++ b/numpy/distutils/fcompiler/gnu.py
@@ -0,0 +1,341 @@
+import re
+import os
+import sys
+import warnings
+
+from numpy.distutils.cpuinfo import cpu
+from numpy.distutils.fcompiler import FCompiler
+from numpy.distutils.exec_command import exec_command, find_executable
+from numpy.distutils.misc_util import mingw32, msvc_runtime_library
+
+class GnuFCompiler(FCompiler):
+
+ compiler_type = 'gnu'
+
+ def gnu_version_match(self, version_string):
+ """Handle the different versions of GNU fortran compilers"""
+ m = re.match(r'GNU Fortran', version_string)
+ if not m:
+ return None
+ m = re.match(r'GNU Fortran\s+95.*?([0-9-.]+)', version_string)
+ if m:
+ return ('gfortran', m.group(1))
+ m = re.match(r'GNU Fortran.*?([0-9-.]+)', version_string)
+ if m:
+ v = m.group(1)
+ if v.startswith('0') or v.startswith('2') or v.startswith('3'):
+ # the '0' is for early g77's
+ return ('g77', v)
+ else:
+ # at some point in the 4.x series, the ' 95' was dropped
+ # from the version string
+ return ('gfortran', v)
+
+ def version_match(self, version_string):
+ v = self.gnu_version_match(version_string)
+ if not v or v[0] != 'g77':
+ return None
+ return v[1]
+
+ # 'g77 --version' results
+ # SunOS: GNU Fortran (GCC 3.2) 3.2 20020814 (release)
+ # Debian: GNU Fortran (GCC) 3.3.3 20040110 (prerelease) (Debian)
+ # GNU Fortran (GCC) 3.3.3 (Debian 20040401)
+ # GNU Fortran 0.5.25 20010319 (prerelease)
+ # Redhat: GNU Fortran (GCC 3.2.2 20030222 (Red Hat Linux 3.2.2-5)) 3.2.2 20030222 (Red Hat Linux 3.2.2-5)
+
+ executables = {
+ 'version_cmd' : ["g77", "--version"],
+ 'compiler_f77' : ["g77", "-g", "-Wall","-fno-second-underscore"],
+ 'compiler_f90' : None, # Use --fcompiler=gnu95 for f90 codes
+ 'compiler_fix' : None,
+ 'linker_so' : ["g77", "-g", "-Wall"],
+ 'archiver' : ["ar", "-cr"],
+ 'ranlib' : ["ranlib"],
+ 'linker_exe' : ["g77", "-g", "-Wall"]
+ }
+ module_dir_switch = None
+ module_include_switch = None
+
+ # Cygwin: f771: warning: -fPIC ignored for target (all code is
+ # position independent)
+ if os.name != 'nt' and sys.platform!='cygwin':
+ pic_flags = ['-fPIC']
+
+ # use -mno-cygwin for g77 when Python is not Cygwin-Python
+ if sys.platform == 'win32':
+ for key in ['version_cmd', 'compiler_f77', 'linker_so', 'linker_exe']:
+ executables[key].append('-mno-cygwin')
+
+ g2c = 'g2c'
+
+ suggested_f90_compiler = 'gnu95'
+
+ def find_executables(self):
+ for fc_exe in [find_executable(c) for c in ['g77','f77']]:
+ if os.path.isfile(fc_exe):
+ break
+ for key in ['version_cmd', 'compiler_f77', 'linker_so', 'linker_exe']:
+ self.executables[key][0] = fc_exe
+
+ #def get_linker_so(self):
+ # # win32 linking should be handled by standard linker
+ # # Darwin g77 cannot be used as a linker.
+ # #if re.match(r'(darwin)', sys.platform):
+ # # return
+ # return FCompiler.get_linker_so(self)
+
+ def get_flags_linker_so(self):
+ opt = self.linker_so[1:]
+ if sys.platform=='darwin':
+ # MACOSX_DEPLOYMENT_TARGET must be at least 10.3. This is
+ # a reasonable default value even when building on 10.4 when using
+ # the official Python distribution and those derived from it (when
+ # not broken).
+ target = os.environ.get('MACOSX_DEPLOYMENT_TARGET', None)
+ if target is None or target == '':
+ target = '10.3'
+ major, minor = target.split('.')
+ if int(minor) < 3:
+ minor = '3'
+ warnings.warn('Environment variable '
+ 'MACOSX_DEPLOYMENT_TARGET reset to %s.%s' % (major, minor))
+ os.environ['MACOSX_DEPLOYMENT_TARGET'] = '%s.%s' % (major,
+ minor)
+
+ opt.extend(['-undefined', 'dynamic_lookup', '-bundle'])
+ else:
+ opt.append("-shared")
+ if sys.platform[:5]=='sunos':
+ # SunOS often has dynamically loaded symbols defined in the
+ # static library libg2c.a The linker doesn't like this. To
+ # ignore the problem, use the -mimpure-text flag. It isn't
+ # the safest thing, but seems to work. 'man gcc' says:
+ # ".. Instead of using -mimpure-text, you should compile all
+ # source code with -fpic or -fPIC."
+ opt.append('-mimpure-text')
+ return opt
+
+ def get_libgcc_dir(self):
+ status, output = exec_command(self.compiler_f77 +
+ ['-print-libgcc-file-name'],
+ use_tee=0)
+ if not status:
+ return os.path.dirname(output)
+ return None
+
+ def get_library_dirs(self):
+ opt = []
+ if sys.platform[:5] != 'linux':
+ d = self.get_libgcc_dir()
+ if d:
+ # if windows and not cygwin, libg2c lies in a different folder
+ if sys.platform == 'win32' and not d.startswith('/usr/lib'):
+ d = os.path.normpath(d)
+ if not os.path.exists(os.path.join(d, 'libg2c.a')):
+ d2 = os.path.abspath(os.path.join(d,
+ '../../../../lib'))
+ if os.path.exists(os.path.join(d2, 'libg2c.a')):
+ opt.append(d2)
+ opt.append(d)
+ return opt
+
+ def get_libraries(self):
+ opt = []
+ d = self.get_libgcc_dir()
+ if d is not None:
+ g2c = self.g2c + '-pic'
+ f = self.static_lib_format % (g2c, self.static_lib_extension)
+ if not os.path.isfile(os.path.join(d,f)):
+ g2c = self.g2c
+ else:
+ g2c = self.g2c
+
+ if g2c is not None:
+ opt.append(g2c)
+ if sys.platform == 'win32':
+ # in case want to link F77 compiled code with MSVC
+ opt.append('gcc')
+ runtime_lib = msvc_runtime_library()
+ if runtime_lib:
+ opt.append(runtime_lib)
+ if sys.platform == 'darwin':
+ opt.append('cc_dynamic')
+ return opt
+
+ def get_flags_debug(self):
+ return ['-g']
+
+ def get_flags_opt(self):
+ if self.get_version()<='3.3.3':
+ # With this compiler version building Fortran BLAS/LAPACK
+ # with -O3 caused failures in lib.lapack heevr,syevr tests.
+ opt = ['-O2']
+ else:
+ opt = ['-O3']
+ opt.append('-funroll-loops')
+ return opt
+
+ def get_flags_arch(self):
+ opt = []
+ if sys.platform=='darwin':
+ if os.name != 'posix':
+ # this should presumably correspond to Apple
+ if cpu.is_ppc():
+ opt.append('-arch ppc')
+ elif cpu.is_i386():
+ opt.append('-arch i386')
+ for a in '601 602 603 603e 604 604e 620 630 740 7400 7450 750'\
+ '403 505 801 821 823 860'.split():
+ if getattr(cpu,'is_ppc%s'%a)():
+ opt.append('-mcpu='+a)
+ opt.append('-mtune='+a)
+ break
+ return opt
+
+ # default march options in case we find nothing better
+ if cpu.is_i686():
+ march_opt = '-march=i686'
+ elif cpu.is_i586():
+ march_opt = '-march=i586'
+ elif cpu.is_i486():
+ march_opt = '-march=i486'
+ elif cpu.is_i386():
+ march_opt = '-march=i386'
+ else:
+ march_opt = ''
+
+ gnu_ver = self.get_version()
+
+ if gnu_ver >= '0.5.26': # gcc 3.0
+ if cpu.is_AthlonK6():
+ march_opt = '-march=k6'
+ elif cpu.is_AthlonK7():
+ march_opt = '-march=athlon'
+
+ if gnu_ver >= '3.1.1':
+ if cpu.is_AthlonK6_2():
+ march_opt = '-march=k6-2'
+ elif cpu.is_AthlonK6_3():
+ march_opt = '-march=k6-3'
+ elif cpu.is_AthlonMP():
+ march_opt = '-march=athlon-mp'
+ # there's also: athlon-tbird, athlon-4, athlon-xp
+ elif cpu.is_Nocona():
+ march_opt = '-march=nocona'
+ elif cpu.is_Core2():
+ march_opt = '-march=nocona'
+ elif cpu.is_Xeon() and cpu.is_64bit():
+ march_opt = '-march=nocona'
+ elif cpu.is_Prescott():
+ march_opt = '-march=prescott'
+ elif cpu.is_PentiumIV():
+ march_opt = '-march=pentium4'
+ elif cpu.is_PentiumIII():
+ march_opt = '-march=pentium3'
+ elif cpu.is_PentiumM():
+ march_opt = '-march=pentium3'
+ elif cpu.is_PentiumII():
+ march_opt = '-march=pentium2'
+
+ if gnu_ver >= '3.4':
+ if cpu.is_Opteron():
+ march_opt = '-march=opteron'
+ elif cpu.is_Athlon64():
+ march_opt = '-march=athlon64'
+
+ if gnu_ver >= '3.4.4':
+ if cpu.is_PentiumM():
+ march_opt = '-march=pentium-m'
+ # Future:
+ # if gnu_ver >= '4.3':
+ # if cpu.is_Core2():
+ # march_opt = '-march=core2'
+
+ # Note: gcc 3.2 on win32 has breakage with -march specified
+ if '3.1.1' <= gnu_ver <= '3.4' and sys.platform=='win32':
+ march_opt = ''
+
+ if march_opt:
+ opt.append(march_opt)
+
+ # other CPU flags
+ if gnu_ver >= '3.1.1':
+ if cpu.has_mmx(): opt.append('-mmmx')
+ if cpu.has_3dnow(): opt.append('-m3dnow')
+
+ if gnu_ver > '3.2.2':
+ if cpu.has_sse2(): opt.append('-msse2')
+ if cpu.has_sse(): opt.append('-msse')
+ if gnu_ver >= '3.4':
+ if cpu.has_sse3(): opt.append('-msse3')
+ if cpu.is_Intel():
+ opt.append('-fomit-frame-pointer')
+ if cpu.is_32bit():
+ opt.append('-malign-double')
+ return opt
+
+class Gnu95FCompiler(GnuFCompiler):
+
+ compiler_type = 'gnu95'
+
+ def version_match(self, version_string):
+ v = self.gnu_version_match(version_string)
+ if not v or v[0] != 'gfortran':
+ return None
+ return v[1]
+
+ # 'gfortran --version' results:
+ # XXX is the below right?
+ # Debian: GNU Fortran 95 (GCC 4.0.3 20051023 (prerelease) (Debian 4.0.2-3))
+ # GNU Fortran 95 (GCC) 4.1.2 20061115 (prerelease) (Debian 4.1.1-21)
+ # OS X: GNU Fortran 95 (GCC) 4.1.0
+ # GNU Fortran 95 (GCC) 4.2.0 20060218 (experimental)
+ # GNU Fortran (GCC) 4.3.0 20070316 (experimental)
+
+ executables = {
+ 'version_cmd' : ["gfortran", "--version"],
+ 'compiler_f77' : ["gfortran", "-Wall", "-ffixed-form",
+ "-fno-second-underscore"],
+ 'compiler_f90' : ["gfortran", "-Wall", "-fno-second-underscore"],
+ 'compiler_fix' : ["gfortran", "-Wall", "-ffixed-form",
+ "-fno-second-underscore"],
+ 'linker_so' : ["gfortran", "-Wall"],
+ 'archiver' : ["ar", "-cr"],
+ 'ranlib' : ["ranlib"],
+ 'linker_exe' : ["gfortran", "-Wall"]
+ }
+
+ # use -mno-cygwin flag for g77 when Python is not Cygwin-Python
+ if sys.platform == 'win32':
+ for key in ['version_cmd', 'compiler_f77', 'compiler_f90',
+ 'compiler_fix', 'linker_so', 'linker_exe']:
+ executables[key].append('-mno-cygwin')
+
+ module_dir_switch = '-J'
+ module_include_switch = '-I'
+
+ g2c = 'gfortran'
+
+ def find_executables(self):
+ for fc_exe in [find_executable(c) for c in ['gfortran','f95']]:
+ if os.path.isfile(fc_exe):
+ break
+ for key in ['version_cmd', 'compiler_f77', 'compiler_f90',
+ 'compiler_fix', 'linker_so', 'linker_exe']:
+ self.executables[key][0] = fc_exe
+
+ def get_libraries(self):
+ opt = GnuFCompiler.get_libraries(self)
+ if sys.platform == 'darwin':
+ opt.remove('cc_dynamic')
+ return opt
+
+if __name__ == '__main__':
+ from distutils import log
+ log.set_verbosity(2)
+ from numpy.distutils.fcompiler import new_fcompiler
+ #compiler = new_fcompiler(compiler='gnu')
+ compiler = GnuFCompiler()
+ compiler.customize()
+ print compiler.get_version()
diff --git a/numpy/distutils/fcompiler/hpux.py b/numpy/distutils/fcompiler/hpux.py
new file mode 100644
index 000000000..8cab2c611
--- /dev/null
+++ b/numpy/distutils/fcompiler/hpux.py
@@ -0,0 +1,41 @@
+import os
+import sys
+
+from numpy.distutils.cpuinfo import cpu
+from numpy.distutils.fcompiler import FCompiler
+
+class HPUXFCompiler(FCompiler):
+
+ compiler_type = 'hpux'
+ version_pattern = r'HP F90 (?P<version>[^\s*,]*)'
+
+ executables = {
+ 'version_cmd' : ["f90", "+version"],
+ 'compiler_f77' : ["f90"],
+ 'compiler_fix' : ["f90"],
+ 'compiler_f90' : ["f90"],
+ 'linker_so' : None,
+ 'archiver' : ["ar", "-cr"],
+ 'ranlib' : ["ranlib"]
+ }
+ module_dir_switch = None #XXX: fix me
+ module_include_switch = None #XXX: fix me
+ pic_flags = ['+pic=long']
+ def get_flags(self):
+ return self.pic_flags + ['+ppu']
+ def get_flags_opt(self):
+ return ['-O3']
+ def get_libraries(self):
+ return ['m']
+ def get_version(self, force=0, ok_status=[256,0]):
+ # XXX status==256 may indicate 'unrecognized option' or
+ # 'no input file'. So, version_cmd needs more work.
+ return FCompiler.get_version(self,force,ok_status)
+
+if __name__ == '__main__':
+ from distutils import log
+ log.set_verbosity(10)
+ from numpy.distutils.fcompiler import new_fcompiler
+ compiler = new_fcompiler(compiler='hpux')
+ compiler.customize()
+ print compiler.get_version()
diff --git a/numpy/distutils/fcompiler/ibm.py b/numpy/distutils/fcompiler/ibm.py
new file mode 100644
index 000000000..e4e2cec32
--- /dev/null
+++ b/numpy/distutils/fcompiler/ibm.py
@@ -0,0 +1,97 @@
+import os
+import re
+import sys
+
+from numpy.distutils.fcompiler import FCompiler
+from numpy.distutils.exec_command import exec_command, find_executable
+from distutils import log
+from distutils.sysconfig import get_python_lib
+
+class IbmFCompiler(FCompiler):
+
+ compiler_type = 'ibm'
+ version_pattern = r'(xlf\(1\)\s*|)IBM XL Fortran ((Advanced Edition |)Version |Enterprise Edition V)(?P<version>[^\s*]*)'
+ #IBM XL Fortran Enterprise Edition V10.1 for AIX \nVersion: 10.01.0000.0004
+ executables = {
+ 'version_cmd' : ["xlf","-qversion"],
+ 'compiler_f77' : ["xlf"],
+ 'compiler_fix' : ["xlf90", "-qfixed"],
+ 'compiler_f90' : ["xlf90"],
+ 'linker_so' : ["xlf95"],
+ 'archiver' : ["ar", "-cr"],
+ 'ranlib' : ["ranlib"]
+ }
+
+ def get_version(self,*args,**kwds):
+ version = FCompiler.get_version(self,*args,**kwds)
+
+ if version is None and sys.platform.startswith('aix'):
+ # use lslpp to find out xlf version
+ lslpp = find_executable('lslpp')
+ xlf = find_executable('xlf')
+ if os.path.exists(xlf) and os.path.exists(lslpp):
+ s,o = exec_command(lslpp + ' -Lc xlfcmp')
+ m = re.search('xlfcmp:(?P<version>\d+([.]\d+)+)', o)
+ if m: version = m.group('version')
+
+ xlf_dir = '/etc/opt/ibmcmp/xlf'
+ if version is None and os.path.isdir(xlf_dir):
+ # linux:
+ # If the output of xlf does not contain version info
+ # (that's the case with xlf 8.1, for instance) then
+ # let's try another method:
+ l = os.listdir(xlf_dir)
+ l.sort()
+ l.reverse()
+ l = [d for d in l if os.path.isfile(os.path.join(xlf_dir,d,'xlf.cfg'))]
+ if l:
+ from distutils.version import LooseVersion
+ self.version = version = LooseVersion(l[0])
+ return version
+
+ def get_flags(self):
+ return ['-qextname']
+
+ def get_flags_debug(self):
+ return ['-g']
+
+ def get_flags_linker_so(self):
+ opt = []
+ if sys.platform=='darwin':
+ opt.append('-Wl,-bundle,-flat_namespace,-undefined,suppress')
+ else:
+ opt.append('-bshared')
+ version = self.get_version(ok_status=[0,40])
+ if version is not None:
+ import tempfile
+ if sys.platform.startswith('aix'):
+ xlf_cfg = '/etc/xlf.cfg'
+ else:
+ xlf_cfg = '/etc/opt/ibmcmp/xlf/%s/xlf.cfg' % version
+ new_cfg = tempfile.mktemp()+'_xlf.cfg'
+ log.info('Creating '+new_cfg)
+ fi = open(xlf_cfg,'r')
+ fo = open(new_cfg,'w')
+ crt1_match = re.compile(r'\s*crt\s*[=]\s*(?P<path>.*)/crt1.o').match
+ for line in fi.readlines():
+ m = crt1_match(line)
+ if m:
+ fo.write('crt = %s/bundle1.o\n' % (m.group('path')))
+ else:
+ fo.write(line)
+ fi.close()
+ fo.close()
+ opt.append('-F'+new_cfg)
+ return opt
+
+ def get_flags_opt(self):
+ return ['-O5']
+
+if __name__ == '__main__':
+ from distutils import log
+ log.set_verbosity(2)
+ from numpy.distutils.fcompiler import new_fcompiler
+ #compiler = new_fcompiler(compiler='ibm')
+ compiler = IbmFCompiler()
+ compiler.customize()
+ print compiler.get_version()
diff --git a/numpy/distutils/fcompiler/intel.py b/numpy/distutils/fcompiler/intel.py
new file mode 100644
index 000000000..f5e57dda2
--- /dev/null
+++ b/numpy/distutils/fcompiler/intel.py
@@ -0,0 +1,212 @@
+# -*- encoding: iso-8859-1 -*-
+# above encoding b/c there's a non-ASCII character in the sample output
+# of intele
+# http://developer.intel.com/software/products/compilers/flin/
+
+import os
+import sys
+
+from numpy.distutils.cpuinfo import cpu
+from numpy.distutils.ccompiler import simple_version_match
+from numpy.distutils.fcompiler import FCompiler, dummy_fortran_file
+from numpy.distutils.exec_command import find_executable
+
+def intel_version_match(type):
+ # Match against the important stuff in the version string
+ return simple_version_match(start=r'Intel.*?Fortran.*?%s.*?Version' % (type,))
+
+class IntelFCompiler(FCompiler):
+
+ compiler_type = 'intel'
+ version_match = intel_version_match('32-bit')
+
+ for fc_exe in map(find_executable,['ifort','ifc']):
+ if os.path.isfile(fc_exe):
+ break
+
+ executables = {
+ 'version_cmd' : [fc_exe, "-FI -V -c %(fname)s.f -o %(fname)s.o" \
+ % {'fname':dummy_fortran_file()}],
+ 'compiler_f77' : [fc_exe,"-72","-w90","-w95"],
+ 'compiler_fix' : [fc_exe,"-FI"],
+ 'compiler_f90' : [fc_exe],
+ 'linker_so' : [fc_exe,"-shared"],
+ 'archiver' : ["ar", "-cr"],
+ 'ranlib' : ["ranlib"]
+ }
+
+ pic_flags = ['-KPIC']
+ module_dir_switch = '-module ' # Don't remove ending space!
+ module_include_switch = '-I'
+
+ def get_flags(self):
+ opt = self.pic_flags + ["-cm"]
+ return opt
+
+ def get_flags_free(self):
+ return ["-FR"]
+
+ def get_flags_opt(self):
+ return ['-O3','-unroll']
+
+ def get_flags_arch(self):
+ opt = []
+ if cpu.has_fdiv_bug():
+ opt.append('-fdiv_check')
+ if cpu.has_f00f_bug():
+ opt.append('-0f_check')
+ if cpu.is_PentiumPro() or cpu.is_PentiumII() or cpu.is_PentiumIII():
+ opt.extend(['-tpp6'])
+ elif cpu.is_PentiumM():
+ opt.extend(['-tpp7','-xB'])
+ elif cpu.is_Pentium():
+ opt.append('-tpp5')
+ elif cpu.is_PentiumIV() or cpu.is_Xeon():
+ opt.extend(['-tpp7','-xW'])
+ if cpu.has_mmx() and not cpu.is_Xeon():
+ opt.append('-xM')
+ if cpu.has_sse2():
+ opt.append('-arch SSE2')
+ elif cpu.has_sse():
+ opt.append('-arch SSE')
+ return opt
+
+ def get_flags_linker_so(self):
+ opt = FCompiler.get_flags_linker_so(self)
+ v = self.get_version()
+ if v and v >= '8.0':
+ opt.append('-nofor_main')
+ return opt
+
+class IntelItaniumFCompiler(IntelFCompiler):
+ compiler_type = 'intele'
+
+ version_match = intel_version_match('Itanium')
+
+#Intel(R) Fortran Itanium(R) Compiler for Itanium(R)-based applications
+#Version 9.1    Build 20060928 Package ID: l_fc_c_9.1.039
+#Copyright (C) 1985-2006 Intel Corporation.  All rights reserved.
+#30 DAY EVALUATION LICENSE
+
+ for fc_exe in map(find_executable,['ifort','efort','efc']):
+ if os.path.isfile(fc_exe):
+ break
+
+ executables = {
+ 'version_cmd' : [fc_exe, "-FI -V -c %(fname)s.f -o %(fname)s.o" \
+ % {'fname':dummy_fortran_file()}],
+ 'compiler_f77' : [fc_exe,"-FI","-w90","-w95"],
+ 'compiler_fix' : [fc_exe,"-FI"],
+ 'compiler_f90' : [fc_exe],
+ 'linker_so' : [fc_exe,"-shared"],
+ 'archiver' : ["ar", "-cr"],
+ 'ranlib' : ["ranlib"]
+ }
+
+class IntelEM64TFCompiler(IntelFCompiler):
+ compiler_type = 'intelem'
+
+ version_match = intel_version_match('EM64T-based')
+
+ for fc_exe in map(find_executable,['ifort','efort','efc']):
+ if os.path.isfile(fc_exe):
+ break
+
+ executables = {
+ 'version_cmd' : [fc_exe, "-FI -V -c %(fname)s.f -o %(fname)s.o" \
+ % {'fname':dummy_fortran_file()}],
+ 'compiler_f77' : [fc_exe,"-FI","-w90","-w95"],
+ 'compiler_fix' : [fc_exe,"-FI"],
+ 'compiler_f90' : [fc_exe],
+ 'linker_so' : [fc_exe,"-shared"],
+ 'archiver' : ["ar", "-cr"],
+ 'ranlib' : ["ranlib"]
+ }
+
+ def get_flags_arch(self):
+ opt = []
+ if cpu.is_PentiumIV() or cpu.is_Xeon():
+ opt.extend(['-tpp7', '-xW'])
+ return opt
+
+# Is there no difference in the version string between the above compilers
+# and the Visual compilers?
+
+class IntelVisualFCompiler(FCompiler):
+
+ compiler_type = 'intelv'
+ version_match = intel_version_match('32-bit')
+
+ ar_exe = 'lib.exe'
+ fc_exe = 'ifl'
+
+ executables = {
+ 'version_cmd' : [fc_exe, "-FI -V -c %(fname)s.f -o %(fname)s.o" \
+ % {'fname':dummy_fortran_file()}],
+ 'compiler_f77' : [fc_exe,"-FI","-w90","-w95"],
+ 'compiler_fix' : [fc_exe,"-FI","-4L72","-w"],
+ 'compiler_f90' : [fc_exe],
+ 'linker_so' : [fc_exe,"-shared"],
+ 'archiver' : [ar_exe, "/verbose", "/OUT:"],
+ 'ranlib' : None
+ }
+
+ compile_switch = '/c '
+ object_switch = '/Fo' #No space after /Fo!
+ library_switch = '/OUT:' #No space after /OUT:!
+ module_dir_switch = '/module:' #No space after /module:
+ module_include_switch = '/I'
+
+ def get_flags(self):
+ opt = ['/nologo','/MD','/nbs','/Qlowercase','/us']
+ return opt
+
+ def get_flags_free(self):
+ return ["-FR"]
+
+ def get_flags_debug(self):
+ return ['/4Yb','/d2']
+
+ def get_flags_opt(self):
+ return ['/O3','/Qip','/Qipo','/Qipo_obj']
+
+ def get_flags_arch(self):
+ opt = []
+ if cpu.is_PentiumPro() or cpu.is_PentiumII():
+ opt.extend(['/G6','/Qaxi'])
+ elif cpu.is_PentiumIII():
+ opt.extend(['/G6','/QaxK'])
+ elif cpu.is_Pentium():
+ opt.append('/G5')
+ elif cpu.is_PentiumIV():
+ opt.extend(['/G7','/QaxW'])
+ if cpu.has_mmx():
+ opt.append('/QaxM')
+ return opt
+
+class IntelItaniumVisualFCompiler(IntelVisualFCompiler):
+
+ compiler_type = 'intelev'
+ version_match = intel_version_match('Itanium')
+
+ fc_exe = 'efl' # XXX this is a wild guess
+ ar_exe = IntelVisualFCompiler.ar_exe
+
+ executables = {
+ 'version_cmd' : [fc_exe, "-FI -V -c %(fname)s.f -o %(fname)s.o" \
+ % {'fname':dummy_fortran_file()}],
+ 'compiler_f77' : [fc_exe,"-FI","-w90","-w95"],
+ 'compiler_fix' : [fc_exe,"-FI","-4L72","-w"],
+ 'compiler_f90' : [fc_exe],
+ 'linker_so' : [fc_exe,"-shared"],
+ 'archiver' : [ar_exe, "/verbose", "/OUT:"],
+ 'ranlib' : None
+ }
+
+if __name__ == '__main__':
+ from distutils import log
+ log.set_verbosity(2)
+ from numpy.distutils.fcompiler import new_fcompiler
+ compiler = new_fcompiler(compiler='intel')
+ compiler.customize()
+ print compiler.get_version()
diff --git a/numpy/distutils/fcompiler/lahey.py b/numpy/distutils/fcompiler/lahey.py
new file mode 100644
index 000000000..eaa577b62
--- /dev/null
+++ b/numpy/distutils/fcompiler/lahey.py
@@ -0,0 +1,46 @@
+import os
+import sys
+
+from numpy.distutils.cpuinfo import cpu
+from numpy.distutils.fcompiler import FCompiler
+
+class LaheyFCompiler(FCompiler):
+
+ compiler_type = 'lahey'
+ version_pattern = r'Lahey/Fujitsu Fortran 95 Compiler Release (?P<version>[^\s*]*)'
+
+ executables = {
+ 'version_cmd' : ["lf95", "--version"],
+ 'compiler_f77' : ["lf95", "--fix"],
+ 'compiler_fix' : ["lf95", "--fix"],
+ 'compiler_f90' : ["lf95"],
+ 'linker_so' : ["lf95","-shared"],
+ 'archiver' : ["ar", "-cr"],
+ 'ranlib' : ["ranlib"]
+ }
+
+ module_dir_switch = None #XXX Fix me
+ module_include_switch = None #XXX Fix me
+
+ def get_flags_opt(self):
+ return ['-O']
+ def get_flags_debug(self):
+ return ['-g','--chk','--chkglobal']
+ def get_library_dirs(self):
+ opt = []
+ d = os.environ.get('LAHEY')
+ if d:
+ opt.append(os.path.join(d,'lib'))
+ return opt
+ def get_libraries(self):
+ opt = []
+ opt.extend(['fj9f6', 'fj9i6', 'fj9ipp', 'fj9e6'])
+ return opt
+
+if __name__ == '__main__':
+ from distutils import log
+ log.set_verbosity(2)
+ from numpy.distutils.fcompiler import new_fcompiler
+ compiler = new_fcompiler(compiler='lahey')
+ compiler.customize()
+ print compiler.get_version()
diff --git a/numpy/distutils/fcompiler/mips.py b/numpy/distutils/fcompiler/mips.py
new file mode 100644
index 000000000..915cbead9
--- /dev/null
+++ b/numpy/distutils/fcompiler/mips.py
@@ -0,0 +1,56 @@
+import os
+import sys
+
+from numpy.distutils.cpuinfo import cpu
+from numpy.distutils.fcompiler import FCompiler
+
+class MipsFCompiler(FCompiler):
+
+ compiler_type = 'mips'
+ version_pattern = r'MIPSpro Compilers: Version (?P<version>[^\s*,]*)'
+
+ executables = {
+ 'version_cmd' : ["f90", "-version"],
+ 'compiler_f77' : ["f77", "-f77"],
+ 'compiler_fix' : ["f90", "-fixedform"],
+ 'compiler_f90' : ["f90"],
+ 'linker_so' : ["f90","-shared"],
+ 'archiver' : ["ar", "-cr"],
+ 'ranlib' : None
+ }
+ module_dir_switch = None #XXX: fix me
+ module_include_switch = None #XXX: fix me
+ pic_flags = ['-KPIC']
+
+ def get_flags(self):
+ return self.pic_flags + ['-n32']
+ def get_flags_opt(self):
+ return ['-O3']
+ def get_flags_arch(self):
+ opt = []
+ for a in '19 20 21 22_4k 22_5k 24 25 26 27 28 30 32_5k 32_10k'.split():
+ if getattr(cpu,'is_IP%s'%a)():
+ opt.append('-TARG:platform=IP%s' % a)
+ break
+ return opt
+ def get_flags_arch_f77(self):
+ r = None
+ if cpu.is_r10000(): r = 10000
+ elif cpu.is_r12000(): r = 12000
+ elif cpu.is_r8000(): r = 8000
+ elif cpu.is_r5000(): r = 5000
+ elif cpu.is_r4000(): r = 4000
+ if r is not None:
+ return ['r%s' % (r)]
+ return []
+ def get_flags_arch_f90(self):
+ r = self.get_flags_arch_f77()
+ if r:
+ r[0] = '-' + r[0]
+ return r
+
+if __name__ == '__main__':
+ from numpy.distutils.fcompiler import new_fcompiler
+ compiler = new_fcompiler(compiler='mips')
+ compiler.customize()
+ print compiler.get_version()
diff --git a/numpy/distutils/fcompiler/nag.py b/numpy/distutils/fcompiler/nag.py
new file mode 100644
index 000000000..79413dfc1
--- /dev/null
+++ b/numpy/distutils/fcompiler/nag.py
@@ -0,0 +1,43 @@
+import os
+import sys
+
+from numpy.distutils.cpuinfo import cpu
+from numpy.distutils.fcompiler import FCompiler
+
+class NAGFCompiler(FCompiler):
+
+ compiler_type = 'nag'
+ version_pattern = r'NAGWare Fortran 95 compiler Release (?P<version>[^\s]*)'
+
+ executables = {
+ 'version_cmd' : ["f95", "-V"],
+ 'compiler_f77' : ["f95", "-fixed"],
+ 'compiler_fix' : ["f95", "-fixed"],
+ 'compiler_f90' : ["f95"],
+ 'linker_so' : ["f95"],
+ 'archiver' : ["ar", "-cr"],
+ 'ranlib' : ["ranlib"]
+ }
+
+ def get_flags_linker_so(self):
+ if sys.platform=='darwin':
+ return ['-unsharedf95','-Wl,-bundle,-flat_namespace,-undefined,suppress']
+ return ["-Wl,-shared"]
+ def get_flags_opt(self):
+ return ['-O4']
+ def get_flags_arch(self):
+ version = self.get_version()
+ if version < '5.1':
+ return ['-target=native']
+ else:
+ return ['']
+ def get_flags_debug(self):
+ return ['-g','-gline','-g90','-nan','-C']
+
+if __name__ == '__main__':
+ from distutils import log
+ log.set_verbosity(2)
+ from numpy.distutils.fcompiler import new_fcompiler
+ compiler = new_fcompiler(compiler='nag')
+ compiler.customize()
+ print compiler.get_version()
diff --git a/numpy/distutils/fcompiler/none.py b/numpy/distutils/fcompiler/none.py
new file mode 100644
index 000000000..c38b9f1ac
--- /dev/null
+++ b/numpy/distutils/fcompiler/none.py
@@ -0,0 +1,24 @@
+
+from numpy.distutils.fcompiler import FCompiler
+
+class NoneFCompiler(FCompiler):
+
+ compiler_type = 'none'
+
+ executables = {'compiler_f77':['/path/to/nowhere/none'],
+ 'compiler_f90':['/path/to/nowhere/none'],
+ 'compiler_fix':['/path/to/nowhere/none'],
+ 'linker_so':['/path/to/nowhere/none'],
+ 'archiver':['/path/to/nowhere/none'],
+ 'ranlib':['/path/to/nowhere/none'],
+ 'version_cmd':['/path/to/nowhere/none'],
+ }
+
+
+if __name__ == '__main__':
+ from distutils import log
+ log.set_verbosity(2)
+ from numpy.distutils.fcompiler import new_fcompiler
+ compiler = NoneFCompiler()
+ compiler.customize()
+ print compiler.get_version()
diff --git a/numpy/distutils/fcompiler/pg.py b/numpy/distutils/fcompiler/pg.py
new file mode 100644
index 000000000..94aefa244
--- /dev/null
+++ b/numpy/distutils/fcompiler/pg.py
@@ -0,0 +1,42 @@
+
+# http://www.pgroup.com
+
+import os
+import sys
+
+from numpy.distutils.cpuinfo import cpu
+from numpy.distutils.fcompiler import FCompiler
+
+class PGroupFCompiler(FCompiler):
+
+ compiler_type = 'pg'
+ version_pattern = r'\s*pg(f77|f90|hpf) (?P<version>[\d.-]+).*'
+
+ executables = {
+ 'version_cmd' : ["pgf77", "-V 2>/dev/null"],
+ 'compiler_f77' : ["pgf77"],
+ 'compiler_fix' : ["pgf90", "-Mfixed"],
+ 'compiler_f90' : ["pgf90"],
+ 'linker_so' : ["pgf90","-shared","-fpic"],
+ 'archiver' : ["ar", "-cr"],
+ 'ranlib' : ["ranlib"]
+ }
+ pic_flags = ['-fpic']
+ module_dir_switch = '-module '
+ module_include_switch = '-I'
+
+ def get_flags(self):
+ opt = ['-Minform=inform','-Mnosecond_underscore']
+ return self.pic_flags + opt
+ def get_flags_opt(self):
+ return ['-fast']
+ def get_flags_debug(self):
+ return ['-g']
+
+if __name__ == '__main__':
+ from distutils import log
+ log.set_verbosity(2)
+ from numpy.distutils.fcompiler import new_fcompiler
+ compiler = new_fcompiler(compiler='pg')
+ compiler.customize()
+ print compiler.get_version()
diff --git a/numpy/distutils/fcompiler/sun.py b/numpy/distutils/fcompiler/sun.py
new file mode 100644
index 000000000..a0eaa3da0
--- /dev/null
+++ b/numpy/distutils/fcompiler/sun.py
@@ -0,0 +1,51 @@
+import os
+import sys
+
+from numpy.distutils.cpuinfo import cpu
+from numpy.distutils.ccompiler import simple_version_match
+from numpy.distutils.fcompiler import FCompiler
+
+class SunFCompiler(FCompiler):
+
+ compiler_type = 'sun'
+ # ex:
+ # f90: Sun WorkShop 6 update 2 Fortran 95 6.2 Patch 111690-10 2003/08/28
+ version_match = simple_version_match(
+ start=r'f9[05]: (Sun|Forte|WorkShop).*Fortran 95')
+
+ executables = {
+ 'version_cmd' : ["f90", "-V"],
+ 'compiler_f77' : ["f90"],
+ 'compiler_fix' : ["f90", "-fixed"],
+ 'compiler_f90' : ["f90"],
+ 'linker_so' : ["f90","-Bdynamic","-G"],
+ 'archiver' : ["ar", "-cr"],
+ 'ranlib' : ["ranlib"]
+ }
+ module_dir_switch = '-moddir='
+ module_include_switch = '-M'
+ pic_flags = ['-xcode=pic32']
+
+ def get_flags_f77(self):
+ ret = ["-ftrap=%none"]
+ if (self.get_version() or '') >= '7':
+ ret.append("-f77")
+ else:
+ ret.append("-fixed")
+ return ret
+ def get_opt(self):
+ return ['-fast','-dalign']
+ def get_arch(self):
+ return ['-xtarget=generic']
+ def get_libraries(self):
+ opt = []
+ opt.extend(['fsu','sunmath','mvec','f77compat'])
+ return opt
+
+if __name__ == '__main__':
+ from distutils import log
+ log.set_verbosity(2)
+ from numpy.distutils.fcompiler import new_fcompiler
+ compiler = new_fcompiler(compiler='sun')
+ compiler.customize()
+ print compiler.get_version()
diff --git a/numpy/distutils/fcompiler/vast.py b/numpy/distutils/fcompiler/vast.py
new file mode 100644
index 000000000..30472d893
--- /dev/null
+++ b/numpy/distutils/fcompiler/vast.py
@@ -0,0 +1,53 @@
+import os
+import sys
+
+from numpy.distutils.cpuinfo import cpu
+from numpy.distutils.fcompiler.gnu import GnuFCompiler
+
+class VastFCompiler(GnuFCompiler):
+
+ compiler_type = 'vast'
+ version_pattern = r'\s*Pacific-Sierra Research vf90 '\
+ '(Personal|Professional)\s+(?P<version>[^\s]*)'
+
+ # VAST f90 does not support -o with -c. So, object files are created
+ # to the current directory and then moved to build directory
+ object_switch = ' && function _mvfile { mv -v `basename $1` $1 ; } && _mvfile '
+
+ executables = {
+ 'version_cmd' : ["vf90", "-v"],
+ 'compiler_f77' : ["g77"],
+ 'compiler_fix' : ["f90", "-Wv,-ya"],
+ 'compiler_f90' : ["f90"],
+ 'linker_so' : ["f90"],
+ 'archiver' : ["ar", "-cr"],
+ 'ranlib' : ["ranlib"]
+ }
+ module_dir_switch = None #XXX Fix me
+ module_include_switch = None #XXX Fix me
+
+ def find_executables(self):
+ pass
+
+ def get_version_cmd(self):
+ f90 = self.compiler_f90[0]
+ d,b = os.path.split(f90)
+ vf90 = os.path.join(d,'v'+b)
+ return vf90
+
+ def get_flags_arch(self):
+ vast_version = self.get_version()
+ gnu = GnuFCompiler()
+ gnu.customize(None)
+ self.version = gnu.get_version()
+ opt = GnuFCompiler.get_flags_arch(self)
+ self.version = vast_version
+ return opt
+
+if __name__ == '__main__':
+ from distutils import log
+ log.set_verbosity(2)
+ from numpy.distutils.fcompiler import new_fcompiler
+ compiler = new_fcompiler(compiler='vast')
+ compiler.customize()
+ print compiler.get_version()
diff --git a/numpy/distutils/from_template.py b/numpy/distutils/from_template.py
new file mode 100644
index 000000000..6cfc88ddb
--- /dev/null
+++ b/numpy/distutils/from_template.py
@@ -0,0 +1,256 @@
+#!/usr/bin/python
+"""
+
+process_file(filename)
+
+ takes templated file .xxx.src and produces .xxx file where .xxx
+ is .pyf .f90 or .f using the following template rules:
+
+ '<..>' denotes a template.
+
+ All function and subroutine blocks in a source file with names that
+ contain '<..>' will be replicated according to the rules in '<..>'.
+
+ The number of comma-separeted words in '<..>' will determine the number of
+ replicates.
+
+ '<..>' may have two different forms, named and short. For example,
+
+ named:
+ <p=d,s,z,c> where anywhere inside a block '<p>' will be replaced with
+ 'd', 's', 'z', and 'c' for each replicate of the block.
+
+ <_c> is already defined: <_c=s,d,c,z>
+ <_t> is already defined: <_t=real,double precision,complex,double complex>
+
+ short:
+ <s,d,c,z>, a short form of the named, useful when no <p> appears inside
+ a block.
+
+ In general, '<..>' contains a comma separated list of arbitrary
+ expressions. If these expression must contain a comma|leftarrow|rightarrow,
+ then prepend the comma|leftarrow|rightarrow with a backslash.
+
+ If an expression matches '\\<index>' then it will be replaced
+ by <index>-th expression.
+
+ Note that all '<..>' forms in a block must have the same number of
+ comma-separated entries.
+
+ Predefined named template rules:
+ <prefix=s,d,c,z>
+ <ftype=real,double precision,complex,double complex>
+ <ftypereal=real,double precision,\\0,\\1>
+ <ctype=float,double,complex_float,complex_double>
+ <ctypereal=float,double,\\0,\\1>
+
+"""
+
+__all__ = ['process_str','process_file']
+
+import os
+import sys
+import re
+
+routine_start_re = re.compile(r'(\n|\A)(( (\$|\*))|)\s*(subroutine|function)\b',re.I)
+routine_end_re = re.compile(r'\n\s*end\s*(subroutine|function)\b.*(\n|\Z)',re.I)
+function_start_re = re.compile(r'\n (\$|\*)\s*function\b',re.I)
+
+def parse_structure(astr):
+ """ Return a list of tuples for each function or subroutine each
+ tuple is the start and end of a subroutine or function to be
+ expanded.
+ """
+
+ spanlist = []
+ ind = 0
+ while 1:
+ m = routine_start_re.search(astr,ind)
+ if m is None:
+ break
+ start = m.start()
+ if function_start_re.match(astr,start,m.end()):
+ while 1:
+ i = astr.rfind('\n',ind,start)
+ if i==-1:
+ break
+ start = i
+ if astr[i:i+7]!='\n $':
+ break
+ start += 1
+ m = routine_end_re.search(astr,m.end())
+ ind = end = m and m.end()-1 or len(astr)
+ spanlist.append((start,end))
+ return spanlist
+
+template_re = re.compile(r"<\s*(\w[\w\d]*)\s*>")
+named_re = re.compile(r"<\s*(\w[\w\d]*)\s*=\s*(.*?)\s*>")
+list_re = re.compile(r"<\s*((.*?))\s*>")
+
+def find_repl_patterns(astr):
+ reps = named_re.findall(astr)
+ names = {}
+ for rep in reps:
+ name = rep[0].strip() or unique_key(names)
+ repl = rep[1].replace('\,','@comma@')
+ thelist = conv(repl)
+ names[name] = thelist
+ return names
+
+item_re = re.compile(r"\A\\(?P<index>\d+)\Z")
+def conv(astr):
+ b = astr.split(',')
+ l = [x.strip() for x in b]
+ for i in range(len(l)):
+ m = item_re.match(l[i])
+ if m:
+ j = int(m.group('index'))
+ l[i] = l[j]
+ return ','.join(l)
+
+def unique_key(adict):
+ """ Obtain a unique key given a dictionary."""
+ allkeys = adict.keys()
+ done = False
+ n = 1
+ while not done:
+ newkey = '__l%s' % (n)
+ if newkey in allkeys:
+ n += 1
+ else:
+ done = True
+ return newkey
+
+
+template_name_re = re.compile(r'\A\s*(\w[\w\d]*)\s*\Z')
+def expand_sub(substr,names):
+ substr = substr.replace('\>','@rightarrow@')
+ substr = substr.replace('\<','@leftarrow@')
+ lnames = find_repl_patterns(substr)
+ substr = named_re.sub(r"<\1>",substr) # get rid of definition templates
+
+ def listrepl(mobj):
+ thelist = conv(mobj.group(1).replace('\,','@comma@'))
+ if template_name_re.match(thelist):
+ return "<%s>" % (thelist)
+ name = None
+ for key in lnames.keys(): # see if list is already in dictionary
+ if lnames[key] == thelist:
+ name = key
+ if name is None: # this list is not in the dictionary yet
+ name = unique_key(lnames)
+ lnames[name] = thelist
+ return "<%s>" % name
+
+ substr = list_re.sub(listrepl, substr) # convert all lists to named templates
+ # newnames are constructed as needed
+
+ numsubs = None
+ base_rule = None
+ rules = {}
+ for r in template_re.findall(substr):
+ if not rules.has_key(r):
+ thelist = lnames.get(r,names.get(r,None))
+ if thelist is None:
+ raise ValueError,'No replicates found for <%s>' % (r)
+ if not names.has_key(r) and not thelist.startswith('_'):
+ names[r] = thelist
+ rule = [i.replace('@comma@',',') for i in thelist.split(',')]
+ num = len(rule)
+
+ if numsubs is None:
+ numsubs = num
+ rules[r] = rule
+ base_rule = r
+ elif num == numsubs:
+ rules[r] = rule
+ else:
+ print "Mismatch in number of replacements (base <%s=%s>)"\
+ " for <%s=%s>. Ignoring." % (base_rule,
+ ','.join(rules[base_rule]),
+ r,thelist)
+ if not rules:
+ return substr
+
+ def namerepl(mobj):
+ name = mobj.group(1)
+ return rules.get(name,(k+1)*[name])[k]
+
+ newstr = ''
+ for k in range(numsubs):
+ newstr += template_re.sub(namerepl, substr) + '\n\n'
+
+ newstr = newstr.replace('@rightarrow@','>')
+ newstr = newstr.replace('@leftarrow@','<')
+ return newstr
+
+def process_str(allstr):
+ newstr = allstr
+ writestr = '' #_head # using _head will break free-format files
+
+ struct = parse_structure(newstr)
+
+ oldend = 0
+ names = {}
+ names.update(_special_names)
+ for sub in struct:
+ writestr += newstr[oldend:sub[0]]
+ names.update(find_repl_patterns(newstr[oldend:sub[0]]))
+ writestr += expand_sub(newstr[sub[0]:sub[1]],names)
+ oldend = sub[1]
+ writestr += newstr[oldend:]
+
+ return writestr
+
+include_src_re = re.compile(r"(\n|\A)\s*include\s*['\"](?P<name>[\w\d./\\]+[.]src)['\"]",re.I)
+
+def resolve_includes(source):
+ d = os.path.dirname(source)
+ fid = open(source)
+ lines = []
+ for line in fid.readlines():
+ m = include_src_re.match(line)
+ if m:
+ fn = m.group('name')
+ if not os.path.isabs(fn):
+ fn = os.path.join(d,fn)
+ if os.path.isfile(fn):
+ print 'Including file',fn
+ lines.extend(resolve_includes(fn))
+ else:
+ lines.append(line)
+ else:
+ lines.append(line)
+ fid.close()
+ return lines
+
+def process_file(source):
+ lines = resolve_includes(source)
+ return process_str(''.join(lines))
+
+_special_names = find_repl_patterns('''
+<_c=s,d,c,z>
+<_t=real,double precision,complex,double complex>
+<prefix=s,d,c,z>
+<ftype=real,double precision,complex,double complex>
+<ctype=float,double,complex_float,complex_double>
+<ftypereal=real,double precision,\\0,\\1>
+<ctypereal=float,double,\\0,\\1>
+''')
+
+if __name__ == "__main__":
+
+ try:
+ file = sys.argv[1]
+ except IndexError:
+ fid = sys.stdin
+ outfile = sys.stdout
+ else:
+ fid = open(file,'r')
+ (base, ext) = os.path.splitext(file)
+ newname = base
+ outfile = open(newname,'w')
+
+ allstr = fid.read()
+ writestr = process_str(allstr)
+ outfile.write(writestr)
diff --git a/numpy/distutils/info.py b/numpy/distutils/info.py
new file mode 100644
index 000000000..3d27a8092
--- /dev/null
+++ b/numpy/distutils/info.py
@@ -0,0 +1,5 @@
+"""
+Enhanced distutils with Fortran compilers support and more.
+"""
+
+postpone_import = True
diff --git a/numpy/distutils/intelccompiler.py b/numpy/distutils/intelccompiler.py
new file mode 100644
index 000000000..ff95ca9e5
--- /dev/null
+++ b/numpy/distutils/intelccompiler.py
@@ -0,0 +1,30 @@
+
+import os
+from distutils.unixccompiler import UnixCCompiler
+from numpy.distutils.exec_command import find_executable
+
+class IntelCCompiler(UnixCCompiler):
+
+ """ A modified Intel compiler compatible with an gcc built Python.
+ """
+
+ compiler_type = 'intel'
+ cc_exe = 'icc'
+
+ def __init__ (self, verbose=0, dry_run=0, force=0):
+ UnixCCompiler.__init__ (self, verbose,dry_run, force)
+ compiler = self.cc_exe
+ self.set_executables(compiler=compiler,
+ compiler_so=compiler,
+ compiler_cxx=compiler,
+ linker_exe=compiler,
+ linker_so=compiler + ' -shared')
+
+class IntelItaniumCCompiler(IntelCCompiler):
+ compiler_type = 'intele'
+
+ # On Itanium, the Intel Compiler used to be called ecc, let's search for
+ # it (now it's also icc, so ecc is last in the search).
+ for cc_exe in map(find_executable,['icc','ecc']):
+ if cc_exe:
+ break
diff --git a/numpy/distutils/interactive.py b/numpy/distutils/interactive.py
new file mode 100644
index 000000000..46bc6eeca
--- /dev/null
+++ b/numpy/distutils/interactive.py
@@ -0,0 +1,187 @@
+import os
+import sys
+from pprint import pformat
+
+__all__ = ['interactive_sys_argv']
+
+def show_information(*args):
+ print 'Python',sys.version
+ for a in ['platform','prefix','byteorder','path']:
+ print 'sys.%s = %s' % (a,pformat(getattr(sys,a)))
+ for a in ['name']:
+ print 'os.%s = %s' % (a,pformat(getattr(os,a)))
+ if hasattr(os,'uname'):
+ print 'system,node,release,version,machine = ',os.uname()
+
+def show_environ(*args):
+ for k,i in os.environ.items():
+ print ' %s = %s' % (k, i)
+
+def show_fortran_compilers(*args):
+ from fcompiler import show_fcompilers
+ show_fcompilers({})
+
+def show_compilers(*args):
+ from distutils.ccompiler import show_compilers
+ show_compilers()
+
+def show_tasks(argv,ccompiler,fcompiler):
+ print """\
+
+Tasks:
+ i - Show python/platform/machine information
+ ie - Show environment information
+ c - Show C compilers information
+ c<name> - Set C compiler (current:%s)
+ f - Show Fortran compilers information
+ f<name> - Set Fortran compiler (current:%s)
+ e - Edit proposed sys.argv[1:].
+
+Task aliases:
+ 0 - Configure
+ 1 - Build
+ 2 - Install
+ 2<prefix> - Install with prefix.
+ 3 - Inplace build
+ 4 - Source distribution
+ 5 - Binary distribution
+
+Proposed sys.argv = %s
+ """ % (ccompiler, fcompiler, argv)
+
+
+from exec_command import splitcmdline
+
+def edit_argv(*args):
+ argv = args[0]
+ readline = args[1]
+ if readline is not None:
+ readline.add_history(' '.join(argv[1:]))
+ try:
+ s = raw_input('Edit argv [UpArrow to retrive %r]: ' % (' '.join(argv[1:])))
+ except EOFError:
+ return
+ if s:
+ argv[1:] = splitcmdline(s)
+ return
+
+def interactive_sys_argv(argv):
+ print '='*72
+ print 'Starting interactive session'
+ print '-'*72
+
+ readline = None
+ try:
+ try:
+ import readline
+ except ImportError:
+ pass
+ else:
+ import tempfile
+ tdir = tempfile.gettempdir()
+ username = os.environ.get('USER',os.environ.get('USERNAME','UNKNOWN'))
+ histfile = os.path.join(tdir,".pyhist_interactive_setup-" + username)
+ try:
+ try: readline.read_history_file(histfile)
+ except IOError: pass
+ import atexit
+ atexit.register(readline.write_history_file, histfile)
+ except AttributeError: pass
+ except Exception, msg:
+ print msg
+
+ task_dict = {'i':show_information,
+ 'ie':show_environ,
+ 'f':show_fortran_compilers,
+ 'c':show_compilers,
+ 'e':edit_argv,
+ }
+ c_compiler_name = None
+ f_compiler_name = None
+
+ while 1:
+ show_tasks(argv,c_compiler_name, f_compiler_name)
+ try:
+ task = raw_input('Choose a task (^D to quit, Enter to continue with setup): ').lower()
+ except EOFError:
+ print
+ task = 'quit'
+ if task=='': break
+ if task=='quit': sys.exit()
+ task_func = task_dict.get(task,None)
+ if task_func is None:
+ if task[0]=='c':
+ c_compiler_name = task[1:]
+ if c_compiler_name=='none':
+ c_compiler_name = None
+ continue
+ if task[0]=='f':
+ f_compiler_name = task[1:]
+ if f_compiler_name=='none':
+ f_compiler_name = None
+ continue
+ if task[0]=='2' and len(task)>1:
+ prefix = task[1:]
+ task = task[0]
+ else:
+ prefix = None
+ if task == '4':
+ argv[1:] = ['sdist','-f']
+ continue
+ elif task in '01235':
+ cmd_opts = {'config':[],'config_fc':[],
+ 'build_ext':[],'build_src':[],
+ 'build_clib':[]}
+ if c_compiler_name is not None:
+ c = '--compiler=%s' % (c_compiler_name)
+ cmd_opts['config'].append(c)
+ if task != '0':
+ cmd_opts['build_ext'].append(c)
+ cmd_opts['build_clib'].append(c)
+ if f_compiler_name is not None:
+ c = '--fcompiler=%s' % (f_compiler_name)
+ cmd_opts['config_fc'].append(c)
+ if task != '0':
+ cmd_opts['build_ext'].append(c)
+ cmd_opts['build_clib'].append(c)
+ if task=='3':
+ cmd_opts['build_ext'].append('--inplace')
+ cmd_opts['build_src'].append('--inplace')
+ conf = []
+ sorted_keys = ['config','config_fc','build_src',
+ 'build_clib','build_ext']
+ for k in sorted_keys:
+ opts = cmd_opts[k]
+ if opts: conf.extend([k]+opts)
+ if task=='0':
+ if 'config' not in conf:
+ conf.append('config')
+ argv[1:] = conf
+ elif task=='1':
+ argv[1:] = conf+['build']
+ elif task=='2':
+ if prefix is not None:
+ argv[1:] = conf+['install','--prefix=%s' % (prefix)]
+ else:
+ argv[1:] = conf+['install']
+ elif task=='3':
+ argv[1:] = conf+['build']
+ elif task=='5':
+ if sys.platform=='win32':
+ argv[1:] = conf+['bdist_wininst']
+ else:
+ argv[1:] = conf+['bdist']
+ else:
+ print 'Skipping unknown task:',`task`
+ else:
+ print '-'*68
+ try:
+ task_func(argv,readline)
+ except Exception,msg:
+ print 'Failed running task %s: %s' % (task,msg)
+ break
+ print '-'*68
+ print
+
+ print '-'*72
+ return argv
diff --git a/numpy/distutils/lib2def.py b/numpy/distutils/lib2def.py
new file mode 100644
index 000000000..c42530931
--- /dev/null
+++ b/numpy/distutils/lib2def.py
@@ -0,0 +1,116 @@
+import re
+import sys
+import os
+import string
+
+__doc__ = """This module generates a DEF file from the symbols in
+an MSVC-compiled DLL import library. It correctly discriminates between
+data and functions. The data is collected from the output of the program
+nm(1).
+
+Usage:
+ python lib2def.py [libname.lib] [output.def]
+or
+ python lib2def.py [libname.lib] > output.def
+
+libname.lib defaults to python<py_ver>.lib and output.def defaults to stdout
+
+Author: Robert Kern <kernr@mail.ncifcrf.gov>
+Last Update: April 30, 1999
+"""
+
+__version__ = '0.1a'
+
+import sys
+
+py_ver = "%d%d" % tuple(sys.version_info[:2])
+
+DEFAULT_NM = 'nm -Cs'
+
+DEF_HEADER = """LIBRARY python%s.dll
+;CODE PRELOAD MOVEABLE DISCARDABLE
+;DATA PRELOAD SINGLE
+
+EXPORTS
+""" % py_ver
+# the header of the DEF file
+
+FUNC_RE = re.compile(r"^(.*) in python%s\.dll" % py_ver, re.MULTILINE)
+DATA_RE = re.compile(r"^_imp__(.*) in python%s\.dll" % py_ver, re.MULTILINE)
+
+def parse_cmd():
+ """Parses the command-line arguments.
+
+libfile, deffile = parse_cmd()"""
+ if len(sys.argv) == 3:
+ if sys.argv[1][-4:] == '.lib' and sys.argv[2][-4:] == '.def':
+ libfile, deffile = sys.argv[1:]
+ elif sys.argv[1][-4:] == '.def' and sys.argv[2][-4:] == '.lib':
+ deffile, libfile = sys.argv[1:]
+ else:
+ print "I'm assuming that your first argument is the library"
+ print "and the second is the DEF file."
+ elif len(sys.argv) == 2:
+ if sys.argv[1][-4:] == '.def':
+ deffile = sys.argv[1]
+ libfile = 'python%s.lib' % py_ver
+ elif sys.argv[1][-4:] == '.lib':
+ deffile = None
+ libfile = sys.argv[1]
+ else:
+ libfile = 'python%s.lib' % py_ver
+ deffile = None
+ return libfile, deffile
+
+def getnm(nm_cmd = 'nm -Cs python%s.lib' % py_ver):
+ """Returns the output of nm_cmd via a pipe.
+
+nm_output = getnam(nm_cmd = 'nm -Cs py_lib')"""
+ f = os.popen(nm_cmd)
+ nm_output = f.read()
+ f.close()
+ return nm_output
+
+def parse_nm(nm_output):
+ """Returns a tuple of lists: dlist for the list of data
+symbols and flist for the list of function symbols.
+
+dlist, flist = parse_nm(nm_output)"""
+ data = DATA_RE.findall(nm_output)
+ func = FUNC_RE.findall(nm_output)
+
+ flist = []
+ for sym in data:
+ if sym in func and (sym[:2] == 'Py' or sym[:3] == '_Py' or sym[:4] == 'init'):
+ flist.append(sym)
+
+ dlist = []
+ for sym in data:
+ if sym not in flist and (sym[:2] == 'Py' or sym[:3] == '_Py'):
+ dlist.append(sym)
+
+ dlist.sort()
+ flist.sort()
+ return dlist, flist
+
+def output_def(dlist, flist, header, file = sys.stdout):
+ """Outputs the final DEF file to a file defaulting to stdout.
+
+output_def(dlist, flist, header, file = sys.stdout)"""
+ for data_sym in dlist:
+ header = header + '\t%s DATA\n' % data_sym
+ header = header + '\n' # blank line
+ for func_sym in flist:
+ header = header + '\t%s\n' % func_sym
+ file.write(header)
+
+if __name__ == '__main__':
+ libfile, deffile = parse_cmd()
+ if deffile is None:
+ deffile = sys.stdout
+ else:
+ deffile = open(deffile, 'w')
+ nm_cmd = '%s %s' % (DEFAULT_NM, libfile)
+ nm_output = getnm(nm_cmd)
+ dlist, flist = parse_nm(nm_output)
+ output_def(dlist, flist, DEF_HEADER, deffile)
diff --git a/numpy/distutils/line_endings.py b/numpy/distutils/line_endings.py
new file mode 100644
index 000000000..65fe2d129
--- /dev/null
+++ b/numpy/distutils/line_endings.py
@@ -0,0 +1,75 @@
+""" Functions for converting from DOS to UNIX line endings
+"""
+
+import sys, re, os
+
+def dos2unix(file):
+ "Replace CRLF with LF in argument files. Print names of changed files."
+ if os.path.isdir(file):
+ print file, "Directory!"
+ return
+
+ data = open(file, "rb").read()
+ if '\0' in data:
+ print file, "Binary!"
+ return
+
+ newdata = re.sub("\r\n", "\n", data)
+ if newdata != data:
+ print 'dos2unix:', file
+ f = open(file, "wb")
+ f.write(newdata)
+ f.close()
+ return file
+ else:
+ print file, 'ok'
+
+def dos2unix_one_dir(modified_files,dir_name,file_names):
+ for file in file_names:
+ full_path = os.path.join(dir_name,file)
+ file = dos2unix(full_path)
+ if file is not None:
+ modified_files.append(file)
+
+def dos2unix_dir(dir_name):
+ modified_files = []
+ os.path.walk(dir_name,dos2unix_one_dir,modified_files)
+ return modified_files
+#----------------------------------
+
+def unix2dos(file):
+ "Replace LF with CRLF in argument files. Print names of changed files."
+ if os.path.isdir(file):
+ print file, "Directory!"
+ return
+
+ data = open(file, "rb").read()
+ if '\0' in data:
+ print file, "Binary!"
+ return
+ newdata = re.sub("\r\n", "\n", data)
+ newdata = re.sub("\n", "\r\n", newdata)
+ if newdata != data:
+ print 'unix2dos:', file
+ f = open(file, "wb")
+ f.write(newdata)
+ f.close()
+ return file
+ else:
+ print file, 'ok'
+
+def unix2dos_one_dir(modified_files,dir_name,file_names):
+ for file in file_names:
+ full_path = os.path.join(dir_name,file)
+ unix2dos(full_path)
+ if file is not None:
+ modified_files.append(file)
+
+def unix2dos_dir(dir_name):
+ modified_files = []
+ os.path.walk(dir_name,unix2dos_one_dir,modified_files)
+ return modified_files
+
+if __name__ == "__main__":
+ import sys
+ dos2unix_dir(sys.argv[1])
diff --git a/numpy/distutils/log.py b/numpy/distutils/log.py
new file mode 100644
index 000000000..7484f1f5e
--- /dev/null
+++ b/numpy/distutils/log.py
@@ -0,0 +1,47 @@
+# Colored log, requires Python 2.3 or up.
+
+import sys
+from distutils.log import *
+from distutils.log import Log as old_Log
+from distutils.log import _global_log
+from misc_util import red_text, yellow_text, cyan_text, is_sequence, is_string
+
+
+def _fix_args(args,flag=1):
+ if is_string(args):
+ return args.replace('%','%%')
+ if flag and is_sequence(args):
+ return tuple([_fix_args(a,flag=0) for a in args])
+ return args
+
+class Log(old_Log):
+ def _log(self, level, msg, args):
+ if level >= self.threshold:
+ if args:
+ print _global_color_map[level](msg % _fix_args(args))
+ else:
+ print _global_color_map[level](msg)
+ sys.stdout.flush()
+_global_log.__class__ = Log
+
+def set_verbosity(v):
+ prev_level = _global_log.threshold
+ if v < 0:
+ set_threshold(ERROR)
+ elif v == 0:
+ set_threshold(WARN)
+ elif v == 1:
+ set_threshold(INFO)
+ elif v >= 2:
+ set_threshold(DEBUG)
+ return {FATAL:-2,ERROR:-1,WARN:0,INFO:1,DEBUG:2}.get(prev_level,1)
+
+_global_color_map = {
+ DEBUG:cyan_text,
+ INFO:yellow_text,
+ WARN:red_text,
+ ERROR:red_text,
+ FATAL:red_text
+}
+
+set_verbosity(1)
diff --git a/numpy/distutils/mingw32ccompiler.py b/numpy/distutils/mingw32ccompiler.py
new file mode 100644
index 000000000..91a80a626
--- /dev/null
+++ b/numpy/distutils/mingw32ccompiler.py
@@ -0,0 +1,227 @@
+"""
+Support code for building Python extensions on Windows.
+
+ # NT stuff
+ # 1. Make sure libpython<version>.a exists for gcc. If not, build it.
+ # 2. Force windows to use gcc (we're struggling with MSVC and g77 support)
+ # 3. Force windows to use g77
+
+"""
+
+import os
+import sys
+import log
+
+# Overwrite certain distutils.ccompiler functions:
+import numpy.distutils.ccompiler
+
+# NT stuff
+# 1. Make sure libpython<version>.a exists for gcc. If not, build it.
+# 2. Force windows to use gcc (we're struggling with MSVC and g77 support)
+# --> this is done in numpy/distutils/ccompiler.py
+# 3. Force windows to use g77
+
+import distutils.cygwinccompiler
+from distutils.version import StrictVersion
+from numpy.distutils.ccompiler import gen_preprocess_options, gen_lib_options
+from distutils.errors import DistutilsExecError, CompileError, UnknownFileError
+
+from distutils.unixccompiler import UnixCCompiler
+from numpy.distutils.misc_util import msvc_runtime_library
+
+# the same as cygwin plus some additional parameters
+class Mingw32CCompiler(distutils.cygwinccompiler.CygwinCCompiler):
+ """ A modified MingW32 compiler compatible with an MSVC built Python.
+
+ """
+
+ compiler_type = 'mingw32'
+
+ def __init__ (self,
+ verbose=0,
+ dry_run=0,
+ force=0):
+
+ distutils.cygwinccompiler.CygwinCCompiler.__init__ (self,
+ verbose,dry_run, force)
+
+ # we need to support 3.2 which doesn't match the standard
+ # get_versions methods regex
+ if self.gcc_version is None:
+ import re
+ out = os.popen('gcc -dumpversion','r')
+ out_string = out.read()
+ out.close()
+ result = re.search('(\d+\.\d+)',out_string)
+ if result:
+ self.gcc_version = StrictVersion(result.group(1))
+
+ # A real mingw32 doesn't need to specify a different entry point,
+ # but cygwin 2.91.57 in no-cygwin-mode needs it.
+ if self.gcc_version <= "2.91.57":
+ entry_point = '--entry _DllMain@12'
+ else:
+ entry_point = ''
+
+ if self.linker_dll == 'dllwrap':
+ # Commented out '--driver-name g++' part that fixes weird
+ # g++.exe: g++: No such file or directory
+ # error (mingw 1.0 in Enthon24 tree, gcc-3.4.5).
+ # If the --driver-name part is required for some environment
+ # then make the inclusion of this part specific to that environment.
+ self.linker = 'dllwrap' # --driver-name g++'
+ elif self.linker_dll == 'gcc':
+ self.linker = 'g++'
+
+ # **changes: eric jones 4/11/01
+ # 1. Check for import library on Windows. Build if it doesn't exist.
+
+ build_import_library()
+
+ # **changes: eric jones 4/11/01
+ # 2. increased optimization and turned off all warnings
+ # 3. also added --driver-name g++
+ #self.set_executables(compiler='gcc -mno-cygwin -O2 -w',
+ # compiler_so='gcc -mno-cygwin -mdll -O2 -w',
+ # linker_exe='gcc -mno-cygwin',
+ # linker_so='%s --driver-name g++ -mno-cygwin -mdll -static %s'
+ # % (self.linker, entry_point))
+ if self.gcc_version <= "3.0.0":
+ self.set_executables(compiler='gcc -mno-cygwin -O2 -w',
+ compiler_so='gcc -mno-cygwin -mdll -O2 -w -Wstrict-prototypes',
+ linker_exe='g++ -mno-cygwin',
+ linker_so='%s -mno-cygwin -mdll -static %s'
+ % (self.linker, entry_point))
+ else:
+ self.set_executables(compiler='gcc -mno-cygwin -O2 -Wall',
+ compiler_so='gcc -mno-cygwin -O2 -Wall -Wstrict-prototypes',
+ linker_exe='g++ -mno-cygwin',
+ linker_so='g++ -mno-cygwin -shared')
+ # added for python2.3 support
+ # we can't pass it through set_executables because pre 2.2 would fail
+ self.compiler_cxx = ['g++']
+
+ # Maybe we should also append -mthreads, but then the finished
+ # dlls need another dll (mingwm10.dll see Mingw32 docs)
+ # (-mthreads: Support thread-safe exception handling on `Mingw32')
+
+ # no additional libraries needed
+ #self.dll_libraries=[]
+ return
+
+ # __init__ ()
+
+ def link(self,
+ target_desc,
+ objects,
+ output_filename,
+ output_dir,
+ libraries,
+ library_dirs,
+ runtime_library_dirs,
+ export_symbols = None,
+ debug=0,
+ extra_preargs=None,
+ extra_postargs=None,
+ build_temp=None,
+ target_lang=None):
+ # Include the appropiate MSVC runtime library if Python was built
+ # with MSVC >= 7.0 (MinGW standard is msvcrt)
+ runtime_library = msvc_runtime_library()
+ if runtime_library:
+ if not libraries:
+ libraries = []
+ libraries.append(runtime_library)
+ args = (self,
+ target_desc,
+ objects,
+ output_filename,
+ output_dir,
+ libraries,
+ library_dirs,
+ runtime_library_dirs,
+ None, #export_symbols, we do this in our def-file
+ debug,
+ extra_preargs,
+ extra_postargs,
+ build_temp,
+ target_lang)
+ if self.gcc_version < "3.0.0":
+ func = distutils.cygwinccompiler.CygwinCCompiler.link
+ else:
+ func = UnixCCompiler.link
+ func(*args[:func.im_func.func_code.co_argcount])
+ return
+
+ def object_filenames (self,
+ source_filenames,
+ strip_dir=0,
+ output_dir=''):
+ if output_dir is None: output_dir = ''
+ obj_names = []
+ for src_name in source_filenames:
+ # use normcase to make sure '.rc' is really '.rc' and not '.RC'
+ (base, ext) = os.path.splitext (os.path.normcase(src_name))
+
+ # added these lines to strip off windows drive letters
+ # without it, .o files are placed next to .c files
+ # instead of the build directory
+ drv,base = os.path.splitdrive(base)
+ if drv:
+ base = base[1:]
+
+ if ext not in (self.src_extensions + ['.rc','.res']):
+ raise UnknownFileError, \
+ "unknown file type '%s' (from '%s')" % \
+ (ext, src_name)
+ if strip_dir:
+ base = os.path.basename (base)
+ if ext == '.res' or ext == '.rc':
+ # these need to be compiled to object files
+ obj_names.append (os.path.join (output_dir,
+ base + ext + self.obj_extension))
+ else:
+ obj_names.append (os.path.join (output_dir,
+ base + self.obj_extension))
+ return obj_names
+
+ # object_filenames ()
+
+
+def build_import_library():
+ """ Build the import libraries for Mingw32-gcc on Windows
+ """
+ if os.name != 'nt':
+ return
+ lib_name = "python%d%d.lib" % tuple(sys.version_info[:2])
+ lib_file = os.path.join(sys.prefix,'libs',lib_name)
+ out_name = "libpython%d%d.a" % tuple(sys.version_info[:2])
+ out_file = os.path.join(sys.prefix,'libs',out_name)
+ if not os.path.isfile(lib_file):
+ log.warn('Cannot build import library: "%s" not found' % (lib_file))
+ return
+ if os.path.isfile(out_file):
+ log.debug('Skip building import library: "%s" exists' % (out_file))
+ return
+ log.info('Building import library: "%s"' % (out_file))
+
+ from numpy.distutils import lib2def
+
+ def_name = "python%d%d.def" % tuple(sys.version_info[:2])
+ def_file = os.path.join(sys.prefix,'libs',def_name)
+ nm_cmd = '%s %s' % (lib2def.DEFAULT_NM, lib_file)
+ nm_output = lib2def.getnm(nm_cmd)
+ dlist, flist = lib2def.parse_nm(nm_output)
+ lib2def.output_def(dlist, flist, lib2def.DEF_HEADER, open(def_file, 'w'))
+
+ dll_name = "python%d%d.dll" % tuple(sys.version_info[:2])
+ args = (dll_name,def_file,out_file)
+ cmd = 'dlltool --dllname %s --def %s --output-lib %s' % args
+ status = os.system(cmd)
+ # for now, fail silently
+ if status:
+ log.warn('Failed to build import library for gcc. Linking will fail.')
+ #if not success:
+ # msg = "Couldn't find import library, and failed to build it."
+ # raise DistutilsPlatformError, msg
+ return
diff --git a/numpy/distutils/misc_util.py b/numpy/distutils/misc_util.py
new file mode 100644
index 000000000..488e0fc8e
--- /dev/null
+++ b/numpy/distutils/misc_util.py
@@ -0,0 +1,1451 @@
+import os
+import re
+import sys
+import imp
+import copy
+import glob
+
+try:
+ set
+except NameError:
+ from sets import Set as set
+
+__all__ = ['Configuration', 'get_numpy_include_dirs', 'default_config_dict',
+ 'dict_append', 'appendpath', 'generate_config_py',
+ 'get_cmd', 'allpath', 'get_mathlibs',
+ 'terminal_has_colors', 'red_text', 'green_text', 'yellow_text',
+ 'blue_text', 'cyan_text', 'cyg2win32','mingw32','all_strings',
+ 'has_f_sources', 'has_cxx_sources', 'filter_sources',
+ 'get_dependencies', 'is_local_src_dir', 'get_ext_source_files',
+ 'get_script_files', 'get_lib_source_files', 'get_data_files',
+ 'dot_join', 'get_frame', 'minrelpath','njoin',
+ 'is_sequence', 'is_string', 'as_list', 'gpaths', 'get_language']
+
+def allpath(name):
+ "Convert a /-separated pathname to one using the OS's path separator."
+ splitted = name.split('/')
+ return os.path.join(*splitted)
+
+def rel_path(path, parent_path):
+ """ Return path relative to parent_path.
+ """
+ pd = os.path.abspath(parent_path)
+ apath = os.path.abspath(path)
+ if len(apath)<len(pd):
+ return path
+ if apath==pd:
+ return ''
+ if pd == apath[:len(pd)]:
+ assert apath[len(pd)] in [os.sep],`path,apath[len(pd)]`
+ path = apath[len(pd)+1:]
+ return path
+
+def get_path_from_frame(frame, parent_path=None):
+ """ Return path of the module given a frame object from the call stack.
+
+ Returned path is relative to parent_path when given,
+ otherwise it is absolute path.
+ """
+
+ # First, try to find if the file name is in the frame.
+ try:
+ caller_file = eval('__file__', frame.f_globals, frame.f_locals)
+ d = os.path.dirname(os.path.abspath(caller_file))
+ except NameError:
+ # __file__ is not defined, so let's try __name__. We try this second
+ # because setuptools spoofs __name__ to be '__main__' even though
+ # sys.modules['__main__'] might be something else, like easy_install(1).
+ caller_name = eval('__name__', frame.f_globals, frame.f_locals)
+ __import__(caller_name)
+ mod = sys.modules[caller_name]
+ if hasattr(mod, '__file__'):
+ d = os.path.dirname(os.path.abspath(mod.__file__))
+ else:
+ # we're probably running setup.py as execfile("setup.py")
+ # (likely we're building an egg)
+ d = os.path.abspath('.')
+ # hmm, should we use sys.argv[0] like in __builtin__ case?
+
+ if parent_path is not None:
+ d = rel_path(d, parent_path)
+
+ return d or '.'
+
+def njoin(*path):
+ """ Join two or more pathname components +
+ - convert a /-separated pathname to one using the OS's path separator.
+ - resolve `..` and `.` from path.
+
+ Either passing n arguments as in njoin('a','b'), or a sequence
+ of n names as in njoin(['a','b']) is handled, or a mixture of such arguments.
+ """
+ paths = []
+ for p in path:
+ if is_sequence(p):
+ # njoin(['a', 'b'], 'c')
+ paths.append(njoin(*p))
+ else:
+ assert is_string(p)
+ paths.append(p)
+ path = paths
+ if not path:
+ # njoin()
+ joined = ''
+ else:
+ # njoin('a', 'b')
+ joined = os.path.join(*path)
+ if os.path.sep != '/':
+ joined = joined.replace('/',os.path.sep)
+ return minrelpath(joined)
+
+def get_mathlibs(path=None):
+ """ Return the MATHLIB line from config.h
+ """
+ if path is None:
+ path = get_numpy_include_dirs()[0]
+ config_file = os.path.join(path,'config.h')
+ fid = open(config_file)
+ mathlibs = []
+ s = '#define MATHLIB'
+ for line in fid.readlines():
+ if line.startswith(s):
+ value = line[len(s):].strip()
+ if value:
+ mathlibs.extend(value.split(','))
+ fid.close()
+ return mathlibs
+
+def minrelpath(path):
+ """ Resolve `..` and '.' from path.
+ """
+ if not is_string(path):
+ return path
+ if '.' not in path:
+ return path
+ l = path.split(os.sep)
+ while l:
+ try:
+ i = l.index('.',1)
+ except ValueError:
+ break
+ del l[i]
+ j = 1
+ while l:
+ try:
+ i = l.index('..',j)
+ except ValueError:
+ break
+ if l[i-1]=='..':
+ j += 1
+ else:
+ del l[i],l[i-1]
+ j = 1
+ if not l:
+ return ''
+ return os.sep.join(l)
+
+def _fix_paths(paths,local_path,include_non_existing):
+ assert is_sequence(paths), repr(type(paths))
+ new_paths = []
+ assert not is_string(paths),`paths`
+ for n in paths:
+ if is_string(n):
+ if '*' in n or '?' in n:
+ p = glob.glob(n)
+ p2 = glob.glob(njoin(local_path,n))
+ if p2:
+ new_paths.extend(p2)
+ elif p:
+ new_paths.extend(p)
+ else:
+ if include_non_existing:
+ new_paths.append(n)
+ print 'could not resolve pattern in %r: %r' \
+ % (local_path,n)
+ else:
+ n2 = njoin(local_path,n)
+ if os.path.exists(n2):
+ new_paths.append(n2)
+ else:
+ if os.path.exists(n):
+ new_paths.append(n)
+ elif include_non_existing:
+ new_paths.append(n)
+ if not os.path.exists(n):
+ print 'non-existing path in %r: %r' \
+ % (local_path,n)
+
+ elif is_sequence(n):
+ new_paths.extend(_fix_paths(n,local_path,include_non_existing))
+ else:
+ new_paths.append(n)
+ return map(minrelpath,new_paths)
+
+def gpaths(paths, local_path='', include_non_existing=True):
+ """ Apply glob to paths and prepend local_path if needed.
+ """
+ if is_string(paths):
+ paths = (paths,)
+ return _fix_paths(paths,local_path, include_non_existing)
+
+
+# Hooks for colored terminal output.
+# See also http://www.livinglogic.de/Python/ansistyle
+def terminal_has_colors():
+ if sys.platform=='cygwin' and not os.environ.has_key('USE_COLOR'):
+ # Avoid importing curses that causes illegal operation
+ # with a message:
+ # PYTHON2 caused an invalid page fault in
+ # module CYGNURSES7.DLL as 015f:18bbfc28
+ # Details: Python 2.3.3 [GCC 3.3.1 (cygming special)]
+ # ssh to Win32 machine from debian
+ # curses.version is 2.2
+ # CYGWIN_98-4.10, release 1.5.7(0.109/3/2))
+ return 0
+ if hasattr(sys.stdout,'isatty') and sys.stdout.isatty():
+ try:
+ import curses
+ curses.setupterm()
+ if (curses.tigetnum("colors") >= 0
+ and curses.tigetnum("pairs") >= 0
+ and ((curses.tigetstr("setf") is not None
+ and curses.tigetstr("setb") is not None)
+ or (curses.tigetstr("setaf") is not None
+ and curses.tigetstr("setab") is not None)
+ or curses.tigetstr("scp") is not None)):
+ return 1
+ except Exception,msg:
+ pass
+ return 0
+
+if terminal_has_colors():
+ def red_text(s): return '\x1b[31m%s\x1b[0m'%s
+ def green_text(s): return '\x1b[32m%s\x1b[0m'%s
+ def yellow_text(s): return '\x1b[33m%s\x1b[0m'%s
+ def blue_text(s): return '\x1b[34m%s\x1b[0m'%s
+ def cyan_text(s): return '\x1b[35m%s\x1b[0m'%s
+else:
+ def red_text(s): return s
+ def green_text(s): return s
+ def yellow_text(s): return s
+ def cyan_text(s): return s
+ def blue_text(s): return s
+
+#########################
+
+def cyg2win32(path):
+ if sys.platform=='cygwin' and path.startswith('/cygdrive'):
+ path = path[10] + ':' + os.path.normcase(path[11:])
+ return path
+
+def mingw32():
+ """ Return true when using mingw32 environment.
+ """
+ if sys.platform=='win32':
+ if os.environ.get('OSTYPE','')=='msys':
+ return True
+ if os.environ.get('MSYSTEM','')=='MINGW32':
+ return True
+ return False
+
+def msvc_runtime_library():
+ "return name of MSVC runtime library if Python was built with MSVC >= 7"
+ msc_pos = sys.version.find('MSC v.')
+ if msc_pos != -1:
+ msc_ver = sys.version[msc_pos+6:msc_pos+10]
+ lib = {'1300' : 'msvcr70', # MSVC 7.0
+ '1310' : 'msvcr71', # MSVC 7.1
+ '1400' : 'msvcr80', # MSVC 8
+ }.get(msc_ver, None)
+ else:
+ lib = None
+ return lib
+
+#########################
+
+#XXX need support for .C that is also C++
+cxx_ext_match = re.compile(r'.*[.](cpp|cxx|cc)\Z',re.I).match
+fortran_ext_match = re.compile(r'.*[.](f90|f95|f77|for|ftn|f)\Z',re.I).match
+f90_ext_match = re.compile(r'.*[.](f90|f95)\Z',re.I).match
+f90_module_name_match = re.compile(r'\s*module\s*(?P<name>[\w_]+)',re.I).match
+def _get_f90_modules(source):
+ """ Return a list of Fortran f90 module names that
+ given source file defines.
+ """
+ if not f90_ext_match(source):
+ return []
+ modules = []
+ f = open(source,'r')
+ f_readlines = getattr(f,'xreadlines',f.readlines)
+ for line in f_readlines():
+ m = f90_module_name_match(line)
+ if m:
+ name = m.group('name')
+ modules.append(name)
+ # break # XXX can we assume that there is one module per file?
+ f.close()
+ return modules
+
+def is_string(s):
+ return isinstance(s, str)
+
+def all_strings(lst):
+ """ Return True if all items in lst are string objects. """
+ for item in lst:
+ if not is_string(item):
+ return False
+ return True
+
+def is_sequence(seq):
+ if is_string(seq):
+ return False
+ try:
+ len(seq)
+ except:
+ return False
+ return True
+
+def is_glob_pattern(s):
+ return is_string(s) and ('*' in s or '?' is s)
+
+def as_list(seq):
+ if is_sequence(seq):
+ return list(seq)
+ else:
+ return [seq]
+
+def get_language(sources):
+ # not used in numpy/scipy packages, use build_ext.detect_language instead
+ """ Determine language value (c,f77,f90) from sources """
+ language = None
+ for source in sources:
+ if isinstance(source, str):
+ if f90_ext_match(source):
+ language = 'f90'
+ break
+ elif fortran_ext_match(source):
+ language = 'f77'
+ return language
+
+def has_f_sources(sources):
+ """ Return True if sources contains Fortran files """
+ for source in sources:
+ if fortran_ext_match(source):
+ return True
+ return False
+
+def has_cxx_sources(sources):
+ """ Return True if sources contains C++ files """
+ for source in sources:
+ if cxx_ext_match(source):
+ return True
+ return False
+
+def filter_sources(sources):
+ """ Return four lists of filenames containing
+ C, C++, Fortran, and Fortran 90 module sources,
+ respectively.
+ """
+ c_sources = []
+ cxx_sources = []
+ f_sources = []
+ fmodule_sources = []
+ for source in sources:
+ if fortran_ext_match(source):
+ modules = _get_f90_modules(source)
+ if modules:
+ fmodule_sources.append(source)
+ else:
+ f_sources.append(source)
+ elif cxx_ext_match(source):
+ cxx_sources.append(source)
+ else:
+ c_sources.append(source)
+ return c_sources, cxx_sources, f_sources, fmodule_sources
+
+
+def _get_headers(directory_list):
+ # get *.h files from list of directories
+ headers = []
+ for d in directory_list:
+ head = glob.glob(os.path.join(d,"*.h")) #XXX: *.hpp files??
+ headers.extend(head)
+ return headers
+
+def _get_directories(list_of_sources):
+ # get unique directories from list of sources.
+ direcs = []
+ for f in list_of_sources:
+ d = os.path.split(f)
+ if d[0] != '' and not d[0] in direcs:
+ direcs.append(d[0])
+ return direcs
+
+def get_dependencies(sources):
+ #XXX scan sources for include statements
+ return _get_headers(_get_directories(sources))
+
+def is_local_src_dir(directory):
+ """ Return true if directory is local directory.
+ """
+ if not is_string(directory):
+ return False
+ abs_dir = os.path.abspath(directory)
+ c = os.path.commonprefix([os.getcwd(),abs_dir])
+ new_dir = abs_dir[len(c):].split(os.sep)
+ if new_dir and not new_dir[0]:
+ new_dir = new_dir[1:]
+ if new_dir and new_dir[0]=='build':
+ return False
+ new_dir = os.sep.join(new_dir)
+ return os.path.isdir(new_dir)
+
+def general_source_files(top_path):
+ pruned_directories = {'CVS':1, '.svn':1, 'build':1}
+ prune_file_pat = re.compile(r'(?:[~#]|\.py[co]|\.o)$')
+ for dirpath, dirnames, filenames in os.walk(top_path, topdown=True):
+ pruned = [ d for d in dirnames if d not in pruned_directories ]
+ dirnames[:] = pruned
+ for f in filenames:
+ if not prune_file_pat.search(f):
+ yield os.path.join(dirpath, f)
+
+def general_source_directories_files(top_path):
+ """ Return a directory name relative to top_path and
+ files contained.
+ """
+ pruned_directories = ['CVS','.svn','build']
+ prune_file_pat = re.compile(r'(?:[~#]|\.py[co]|\.o)$')
+ for dirpath, dirnames, filenames in os.walk(top_path, topdown=True):
+ pruned = [ d for d in dirnames if d not in pruned_directories ]
+ dirnames[:] = pruned
+ for d in dirnames:
+ dpath = os.path.join(dirpath, d)
+ rpath = rel_path(dpath, top_path)
+ files = []
+ for f in os.listdir(dpath):
+ fn = os.path.join(dpath,f)
+ if os.path.isfile(fn) and not prune_file_pat.search(fn):
+ files.append(fn)
+ yield rpath, files
+ dpath = top_path
+ rpath = rel_path(dpath, top_path)
+ filenames = [os.path.join(dpath,f) for f in os.listdir(dpath) \
+ if not prune_file_pat.search(f)]
+ files = [f for f in filenames if os.path.isfile(f)]
+ yield rpath, files
+
+
+def get_ext_source_files(ext):
+ # Get sources and any include files in the same directory.
+ filenames = []
+ sources = filter(is_string, ext.sources)
+ filenames.extend(sources)
+ filenames.extend(get_dependencies(sources))
+ for d in ext.depends:
+ if is_local_src_dir(d):
+ filenames.extend(list(general_source_files(d)))
+ elif os.path.isfile(d):
+ filenames.append(d)
+ return filenames
+
+def get_script_files(scripts):
+ scripts = filter(is_string, scripts)
+ return scripts
+
+def get_lib_source_files(lib):
+ filenames = []
+ sources = lib[1].get('sources',[])
+ sources = filter(is_string, sources)
+ filenames.extend(sources)
+ filenames.extend(get_dependencies(sources))
+ depends = lib[1].get('depends',[])
+ for d in depends:
+ if is_local_src_dir(d):
+ filenames.extend(list(general_source_files(d)))
+ elif os.path.isfile(d):
+ filenames.append(d)
+ return filenames
+
+def get_data_files(data):
+ if is_string(data):
+ return [data]
+ sources = data[1]
+ filenames = []
+ for s in sources:
+ if callable(s):
+ continue
+ if is_local_src_dir(s):
+ filenames.extend(list(general_source_files(s)))
+ elif is_string(s):
+ if os.path.isfile(s):
+ filenames.append(s)
+ else:
+ print 'Not existing data file:',s
+ else:
+ raise TypeError,repr(s)
+ return filenames
+
+def dot_join(*args):
+ return '.'.join([a for a in args if a])
+
+def get_frame(level=0):
+ """ Return frame object from call stack with given level.
+ """
+ try:
+ return sys._getframe(level+1)
+ except AttributeError:
+ frame = sys.exc_info()[2].tb_frame
+ for _ in range(level+1):
+ frame = frame.f_back
+ return frame
+
+######################
+
+class Configuration(object):
+
+ _list_keys = ['packages', 'ext_modules', 'data_files', 'include_dirs',
+ 'libraries', 'headers', 'scripts', 'py_modules']
+ _dict_keys = ['package_dir']
+ _extra_keys = ['name', 'version']
+
+ numpy_include_dirs = []
+
+ def __init__(self,
+ package_name=None,
+ parent_name=None,
+ top_path=None,
+ package_path=None,
+ caller_level=1,
+ **attrs):
+ """ Construct configuration instance of a package.
+
+ package_name -- name of the package
+ Ex.: 'distutils'
+ parent_name -- name of the parent package
+ Ex.: 'numpy'
+ top_path -- directory of the toplevel package
+ Ex.: the directory where the numpy package source sits
+ package_path -- directory of package. Will be computed by magic from the
+ directory of the caller module if not specified
+ Ex.: the directory where numpy.distutils is
+ caller_level -- frame level to caller namespace, internal parameter.
+ """
+ self.name = dot_join(parent_name, package_name)
+ self.version = None
+
+ caller_frame = get_frame(caller_level)
+ self.local_path = get_path_from_frame(caller_frame, top_path)
+ # local_path -- directory of a file (usually setup.py) that
+ # defines a configuration() function.
+ # local_path -- directory of a file (usually setup.py) that
+ # defines a configuration() function.
+ if top_path is None:
+ top_path = self.local_path
+ if package_path is None:
+ package_path = self.local_path
+ elif os.path.isdir(njoin(self.local_path,package_path)):
+ package_path = njoin(self.local_path,package_path)
+ if not os.path.isdir(package_path):
+ raise ValueError("%r is not a directory" % (package_path,))
+ self.top_path = top_path
+ self.package_path = package_path
+ # this is the relative path in the installed package
+ self.path_in_package = os.path.join(*self.name.split('.'))
+
+ self.list_keys = self._list_keys[:]
+ self.dict_keys = self._dict_keys[:]
+
+ for n in self.list_keys:
+ v = copy.copy(attrs.get(n, []))
+ setattr(self, n, as_list(v))
+
+ for n in self.dict_keys:
+ v = copy.copy(attrs.get(n, {}))
+ setattr(self, n, v)
+
+ known_keys = self.list_keys + self.dict_keys
+ self.extra_keys = self._extra_keys[:]
+ for n in attrs.keys():
+ if n in known_keys:
+ continue
+ a = attrs[n]
+ setattr(self,n,a)
+ if isinstance(a, list):
+ self.list_keys.append(n)
+ elif isinstance(a, dict):
+ self.dict_keys.append(n)
+ else:
+ self.extra_keys.append(n)
+
+ if os.path.exists(njoin(package_path,'__init__.py')):
+ self.packages.append(self.name)
+ self.package_dir[self.name] = package_path
+
+ self.options = dict(
+ ignore_setup_xxx_py = False,
+ assume_default_configuration = False,
+ delegate_options_to_subpackages = False,
+ quiet = False,
+ )
+
+ caller_instance = None
+ for i in range(1,3):
+ try:
+ f = get_frame(i)
+ except ValueError:
+ break
+ try:
+ caller_instance = eval('self',f.f_globals,f.f_locals)
+ break
+ except NameError:
+ pass
+ if isinstance(caller_instance, self.__class__):
+ if caller_instance.options['delegate_options_to_subpackages']:
+ self.set_options(**caller_instance.options)
+
+ def todict(self):
+ """ Return configuration distionary suitable for passing
+ to distutils.core.setup() function.
+ """
+ self._optimize_data_files()
+ d = {}
+ known_keys = self.list_keys + self.dict_keys + self.extra_keys
+ for n in known_keys:
+ a = getattr(self,n)
+ if a:
+ d[n] = a
+ return d
+
+ def info(self, message):
+ if not self.options['quiet']:
+ print message
+
+ def warn(self, message):
+ print>>sys.stderr, blue_text('Warning: %s' % (message,))
+
+ def set_options(self, **options):
+ """ Configure Configuration instance.
+
+ The following options are available:
+ - ignore_setup_xxx_py
+ - assume_default_configuration
+ - delegate_options_to_subpackages
+ - quiet
+ """
+ for key, value in options.items():
+ if self.options.has_key(key):
+ self.options[key] = value
+ else:
+ raise ValueError,'Unknown option: '+key
+
+ def get_distribution(self):
+ from numpy.distutils.core import get_distribution
+ return get_distribution()
+
+ def _wildcard_get_subpackage(self, subpackage_name,
+ parent_name,
+ caller_level = 1):
+ l = subpackage_name.split('.')
+ subpackage_path = njoin([self.local_path]+l)
+ dirs = filter(os.path.isdir,glob.glob(subpackage_path))
+ config_list = []
+ for d in dirs:
+ if not os.path.isfile(njoin(d,'__init__.py')):
+ continue
+ if 'build' in d.split(os.sep):
+ continue
+ n = '.'.join(d.split(os.sep)[-len(l):])
+ c = self.get_subpackage(n,
+ parent_name = parent_name,
+ caller_level = caller_level+1)
+ config_list.extend(c)
+ return config_list
+
+ def _get_configuration_from_setup_py(self, setup_py,
+ subpackage_name,
+ subpackage_path,
+ parent_name,
+ caller_level = 1):
+ # In case setup_py imports local modules:
+ sys.path.insert(0,os.path.dirname(setup_py))
+ try:
+ fo_setup_py = open(setup_py, 'U')
+ setup_name = os.path.splitext(os.path.basename(setup_py))[0]
+ n = dot_join(self.name,subpackage_name,setup_name)
+ setup_module = imp.load_module('_'.join(n.split('.')),
+ fo_setup_py,
+ setup_py,
+ ('.py', 'U', 1))
+ fo_setup_py.close()
+ if not hasattr(setup_module,'configuration'):
+ if not self.options['assume_default_configuration']:
+ self.warn('Assuming default configuration '\
+ '(%s does not define configuration())'\
+ % (setup_module))
+ config = Configuration(subpackage_name, parent_name,
+ self.top_path, subpackage_path,
+ caller_level = caller_level + 1)
+ else:
+ pn = dot_join(*([parent_name] + subpackage_name.split('.')[:-1]))
+ args = (pn,)
+ if setup_module.configuration.func_code.co_argcount > 1:
+ args = args + (self.top_path,)
+ config = setup_module.configuration(*args)
+ if config.name!=dot_join(parent_name,subpackage_name):
+ self.warn('Subpackage %r configuration returned as %r' % \
+ (dot_join(parent_name,subpackage_name), config.name))
+ finally:
+ del sys.path[0]
+ return config
+
+ def get_subpackage(self,subpackage_name,
+ subpackage_path=None,
+ parent_name=None,
+ caller_level = 1):
+ """ Return list of subpackage configurations.
+
+ '*' in subpackage_name is handled as a wildcard.
+ """
+ if subpackage_name is None:
+ if subpackage_path is None:
+ raise ValueError(
+ "either subpackage_name or subpackage_path must be specified")
+ subpackage_name = os.path.basename(subpackage_path)
+
+ # handle wildcards
+ l = subpackage_name.split('.')
+ if subpackage_path is None and '*' in subpackage_name:
+ return self._wildcard_get_subpackage(subpackage_name,
+ parent_name,
+ caller_level = caller_level+1)
+ assert '*' not in subpackage_name,`subpackage_name, subpackage_path,parent_name`
+ if subpackage_path is None:
+ subpackage_path = njoin([self.local_path] + l)
+ else:
+ subpackage_path = njoin([subpackage_path] + l[:-1])
+ subpackage_path = self.paths([subpackage_path])[0]
+ setup_py = njoin(subpackage_path, 'setup.py')
+ if not self.options['ignore_setup_xxx_py']:
+ if not os.path.isfile(setup_py):
+ setup_py = njoin(subpackage_path,
+ 'setup_%s.py' % (subpackage_name))
+ if not os.path.isfile(setup_py):
+ if not self.options['assume_default_configuration']:
+ self.warn('Assuming default configuration '\
+ '(%s/{setup_%s,setup}.py was not found)' \
+ % (os.path.dirname(setup_py), subpackage_name))
+ config = Configuration(subpackage_name, parent_name,
+ self.top_path, subpackage_path,
+ caller_level = caller_level+1)
+ else:
+ config = self._get_configuration_from_setup_py(
+ setup_py,
+ subpackage_name,
+ subpackage_path,
+ parent_name,
+ caller_level = caller_level + 1)
+ if config:
+ return [config]
+ else:
+ return []
+
+ def add_subpackage(self,subpackage_name,
+ subpackage_path=None,
+ standalone = False):
+ """ Add subpackage to configuration.
+ """
+ if standalone:
+ parent_name = None
+ else:
+ parent_name = self.name
+ config_list = self.get_subpackage(subpackage_name,subpackage_path,
+ parent_name = parent_name,
+ caller_level = 2)
+ if not config_list:
+ self.warn('No configuration returned, assuming unavailable.')
+ for config in config_list:
+ d = config
+ if isinstance(config, Configuration):
+ d = config.todict()
+ assert isinstance(d,dict),`type(d)`
+
+ self.info('Appending %s configuration to %s' \
+ % (d.get('name'), self.name))
+ self.dict_append(**d)
+
+ dist = self.get_distribution()
+ if dist is not None:
+ self.warn('distutils distribution has been initialized,'\
+ ' it may be too late to add a subpackage '+ subpackage_name)
+ return
+
+ def add_data_dir(self,data_path):
+ """ Recursively add files under data_path to data_files list.
+ Argument can be either
+ - 2-sequence (<datadir suffix>,<path to data directory>)
+ - path to data directory where python datadir suffix defaults
+ to package dir.
+
+ Rules for installation paths:
+ foo/bar -> (foo/bar, foo/bar) -> parent/foo/bar
+ (gun, foo/bar) -> parent/gun
+ foo/* -> (foo/a, foo/a), (foo/b, foo/b) -> parent/foo/a, parent/foo/b
+ (gun, foo/*) -> (gun, foo/a), (gun, foo/b) -> gun
+ (gun/*, foo/*) -> parent/gun/a, parent/gun/b
+ /foo/bar -> (bar, /foo/bar) -> parent/bar
+ (gun, /foo/bar) -> parent/gun
+ (fun/*/gun/*, sun/foo/bar) -> parent/fun/foo/gun/bar
+ """
+ if is_sequence(data_path):
+ d, data_path = data_path
+ else:
+ d = None
+ if is_sequence(data_path):
+ [self.add_data_dir((d,p)) for p in data_path]
+ return
+ if not is_string(data_path):
+ raise TypeError("not a string: %r" % (data_path,))
+ if d is None:
+ if os.path.isabs(data_path):
+ return self.add_data_dir((os.path.basename(data_path), data_path))
+ return self.add_data_dir((data_path, data_path))
+ paths = self.paths(data_path, include_non_existing=False)
+ if is_glob_pattern(data_path):
+ if is_glob_pattern(d):
+ pattern_list = allpath(d).split(os.sep)
+ pattern_list.reverse()
+ # /a/*//b/ -> /a/*/b
+ rl = range(len(pattern_list)-1); rl.reverse()
+ for i in rl:
+ if not pattern_list[i]:
+ del pattern_list[i]
+ #
+ for path in paths:
+ if not os.path.isdir(path):
+ print 'Not a directory, skipping',path
+ continue
+ rpath = rel_path(path, self.local_path)
+ path_list = rpath.split(os.sep)
+ path_list.reverse()
+ target_list = []
+ i = 0
+ for s in pattern_list:
+ if is_glob_pattern(s):
+ if i>=len(path_list):
+ raise ValueError,'cannot fill pattern %r with %r' \
+ % (d, path)
+ target_list.append(path_list[i])
+ else:
+ assert s==path_list[i],`s,path_list[i],data_path,d,path,rpath`
+ target_list.append(s)
+ i += 1
+ if path_list[i:]:
+ self.warn('mismatch of pattern_list=%s and path_list=%s'\
+ % (pattern_list,path_list))
+ target_list.reverse()
+ self.add_data_dir((os.sep.join(target_list),path))
+ else:
+ for path in paths:
+ self.add_data_dir((d,path))
+ return
+ assert not is_glob_pattern(d),`d`
+
+ dist = self.get_distribution()
+ if dist is not None and dist.data_files is not None:
+ data_files = dist.data_files
+ else:
+ data_files = self.data_files
+
+ for path in paths:
+ for d1,f in list(general_source_directories_files(path)):
+ target_path = os.path.join(self.path_in_package,d,d1)
+ data_files.append((target_path, f))
+ return
+
+ def _optimize_data_files(self):
+ data_dict = {}
+ for p,files in self.data_files:
+ if not data_dict.has_key(p):
+ data_dict[p] = set()
+ map(data_dict[p].add,files)
+ self.data_files[:] = [(p,list(files)) for p,files in data_dict.items()]
+ return
+
+ def add_data_files(self,*files):
+ """ Add data files to configuration data_files.
+ Argument(s) can be either
+ - 2-sequence (<datadir prefix>,<path to data file(s)>)
+ - paths to data files where python datadir prefix defaults
+ to package dir.
+
+ Rules for installation paths:
+ file.txt -> (., file.txt)-> parent/file.txt
+ foo/file.txt -> (foo, foo/file.txt) -> parent/foo/file.txt
+ /foo/bar/file.txt -> (., /foo/bar/file.txt) -> parent/file.txt
+ *.txt -> parent/a.txt, parent/b.txt
+ foo/*.txt -> parent/foo/a.txt, parent/foo/b.txt
+ */*.txt -> (*, */*.txt) -> parent/c/a.txt, parent/d/b.txt
+ (sun, file.txt) -> parent/sun/file.txt
+ (sun, bar/file.txt) -> parent/sun/file.txt
+ (sun, /foo/bar/file.txt) -> parent/sun/file.txt
+ (sun, *.txt) -> parent/sun/a.txt, parent/sun/b.txt
+ (sun, bar/*.txt) -> parent/sun/a.txt, parent/sun/b.txt
+ (sun/*, */*.txt) -> parent/sun/c/a.txt, parent/d/b.txt
+ """
+
+ if len(files)>1:
+ map(self.add_data_files, files)
+ return
+ assert len(files)==1
+ if is_sequence(files[0]):
+ d,files = files[0]
+ else:
+ d = None
+ if is_string(files):
+ filepat = files
+ elif is_sequence(files):
+ if len(files)==1:
+ filepat = files[0]
+ else:
+ for f in files:
+ self.add_data_files((d,f))
+ return
+ else:
+ raise TypeError,`type(files)`
+
+ if d is None:
+ if callable(filepat):
+ d = ''
+ elif os.path.isabs(filepat):
+ d = ''
+ else:
+ d = os.path.dirname(filepat)
+ self.add_data_files((d,files))
+ return
+
+ paths = self.paths(filepat, include_non_existing=False)
+ if is_glob_pattern(filepat):
+ if is_glob_pattern(d):
+ pattern_list = d.split(os.sep)
+ pattern_list.reverse()
+ for path in paths:
+ path_list = path.split(os.sep)
+ path_list.reverse()
+ path_list.pop() # filename
+ target_list = []
+ i = 0
+ for s in pattern_list:
+ if is_glob_pattern(s):
+ target_list.append(path_list[i])
+ i += 1
+ else:
+ target_list.append(s)
+ target_list.reverse()
+ self.add_data_files((os.sep.join(target_list), path))
+ else:
+ self.add_data_files((d,paths))
+ return
+ assert not is_glob_pattern(d),`d,filepat`
+
+ dist = self.get_distribution()
+ if dist is not None and dist.data_files is not None:
+ data_files = dist.data_files
+ else:
+ data_files = self.data_files
+
+ data_files.append((os.path.join(self.path_in_package,d),paths))
+ return
+
+ ### XXX Implement add_py_modules
+
+ def add_include_dirs(self,*paths):
+ """ Add paths to configuration include directories.
+ """
+ include_dirs = self.paths(paths)
+ dist = self.get_distribution()
+ if dist is not None:
+ dist.include_dirs.extend(include_dirs)
+ else:
+ self.include_dirs.extend(include_dirs)
+ return
+
+ def add_numarray_include_dirs(self):
+ import numpy.numarray.util as nnu
+ self.add_include_dirs(*nnu.get_numarray_include_dirs())
+
+ def add_headers(self,*files):
+ """ Add installable headers to configuration.
+ Argument(s) can be either
+ - 2-sequence (<includedir suffix>,<path to header file(s)>)
+ - path(s) to header file(s) where python includedir suffix will default
+ to package name.
+ """
+ headers = []
+ for path in files:
+ if is_string(path):
+ [headers.append((self.name,p)) for p in self.paths(path)]
+ else:
+ if not isinstance(path, (tuple, list)) or len(path) != 2:
+ raise TypeError(repr(path))
+ [headers.append((path[0],p)) for p in self.paths(path[1])]
+ dist = self.get_distribution()
+ if dist is not None:
+ dist.headers.extend(headers)
+ else:
+ self.headers.extend(headers)
+ return
+
+ def paths(self,*paths,**kws):
+ """ Apply glob to paths and prepend local_path if needed.
+ """
+ include_non_existing = kws.get('include_non_existing',True)
+ return gpaths(paths,
+ local_path = self.local_path,
+ include_non_existing=include_non_existing)
+
+ def _fix_paths_dict(self,kw):
+ for k in kw.keys():
+ v = kw[k]
+ if k in ['sources','depends','include_dirs','library_dirs',
+ 'module_dirs','extra_objects']:
+ new_v = self.paths(v)
+ kw[k] = new_v
+ return
+
+ def add_extension(self,name,sources,**kw):
+ """ Add extension to configuration.
+
+ Keywords:
+ include_dirs, define_macros, undef_macros,
+ library_dirs, libraries, runtime_library_dirs,
+ extra_objects, extra_compile_args, extra_link_args,
+ export_symbols, swig_opts, depends, language,
+ f2py_options, module_dirs
+ extra_info - dict or list of dict of keywords to be
+ appended to keywords.
+ """
+ ext_args = copy.copy(kw)
+ ext_args['name'] = dot_join(self.name,name)
+ ext_args['sources'] = sources
+
+ if ext_args.has_key('extra_info'):
+ extra_info = ext_args['extra_info']
+ del ext_args['extra_info']
+ if isinstance(extra_info, dict):
+ extra_info = [extra_info]
+ for info in extra_info:
+ assert isinstance(info, dict), repr(info)
+ dict_append(ext_args,**info)
+
+ self._fix_paths_dict(ext_args)
+
+ # Resolve out-of-tree dependencies
+ libraries = ext_args.get('libraries',[])
+ libnames = []
+ ext_args['libraries'] = []
+ for libname in libraries:
+ if isinstance(libname,tuple):
+ self._fix_paths_dict(libname[1])
+
+ # Handle library names of the form libname@relative/path/to/library
+ if '@' in libname:
+ lname,lpath = libname.split('@',1)
+ lpath = os.path.abspath(njoin(self.local_path,lpath))
+ if os.path.isdir(lpath):
+ c = self.get_subpackage(None,lpath,
+ caller_level = 2)
+ if isinstance(c,Configuration):
+ c = c.todict()
+ for l in [l[0] for l in c.get('libraries',[])]:
+ llname = l.split('__OF__',1)[0]
+ if llname == lname:
+ c.pop('name',None)
+ dict_append(ext_args,**c)
+ break
+ continue
+ libnames.append(libname)
+
+ ext_args['libraries'] = libnames + ext_args['libraries']
+
+ from numpy.distutils.core import Extension
+ ext = Extension(**ext_args)
+ self.ext_modules.append(ext)
+
+ dist = self.get_distribution()
+ if dist is not None:
+ self.warn('distutils distribution has been initialized,'\
+ ' it may be too late to add an extension '+name)
+ return ext
+
+ def add_library(self,name,sources,**build_info):
+ """ Add library to configuration.
+
+ Valid keywords for build_info:
+ depends
+ macros
+ include_dirs
+ extra_compiler_args
+ f2py_options
+ language
+ """
+ build_info = copy.copy(build_info)
+ name = name #+ '__OF__' + self.name
+ build_info['sources'] = sources
+
+ self._fix_paths_dict(build_info)
+
+ self.libraries.append((name,build_info))
+
+ dist = self.get_distribution()
+ if dist is not None:
+ self.warn('distutils distribution has been initialized,'\
+ ' it may be too late to add a library '+ name)
+ return
+
+ def add_scripts(self,*files):
+ """ Add scripts to configuration.
+ """
+ scripts = self.paths(files)
+ dist = self.get_distribution()
+ if dist is not None:
+ dist.scripts.extend(scripts)
+ else:
+ self.scripts.extend(scripts)
+ return
+
+ def dict_append(self,**dict):
+ for key in self.list_keys:
+ a = getattr(self,key)
+ a.extend(dict.get(key,[]))
+ for key in self.dict_keys:
+ a = getattr(self,key)
+ a.update(dict.get(key,{}))
+ known_keys = self.list_keys + self.dict_keys + self.extra_keys
+ for key in dict.keys():
+ if key not in known_keys:
+ a = getattr(self, key, None)
+ if a and a==dict[key]: continue
+ self.warn('Inheriting attribute %r=%r from %r' \
+ % (key,dict[key],dict.get('name','?')))
+ setattr(self,key,dict[key])
+ self.extra_keys.append(key)
+ elif key in self.extra_keys:
+ self.info('Ignoring attempt to set %r (from %r to %r)' \
+ % (key, getattr(self,key), dict[key]))
+ elif key in known_keys:
+ # key is already processed above
+ pass
+ else:
+ raise ValueError, "Don't know about key=%r" % (key)
+ return
+
+ def __str__(self):
+ from pprint import pformat
+ known_keys = self.list_keys + self.dict_keys + self.extra_keys
+ s = '<'+5*'-' + '\n'
+ s += 'Configuration of '+self.name+':\n'
+ known_keys.sort()
+ for k in known_keys:
+ a = getattr(self,k,None)
+ if a:
+ s += '%s = %s\n' % (k,pformat(a))
+ s += 5*'-' + '>'
+ return s
+
+ def get_config_cmd(self):
+ cmd = get_cmd('config')
+ cmd.ensure_finalized()
+ cmd.dump_source = 0
+ cmd.noisy = 0
+ old_path = os.environ.get('PATH')
+ if old_path:
+ path = os.pathsep.join(['.',old_path])
+ os.environ['PATH'] = path
+ return cmd
+
+ def get_build_temp_dir(self):
+ cmd = get_cmd('build')
+ cmd.ensure_finalized()
+ return cmd.build_temp
+
+ def have_f77c(self):
+ """ Check for availability of Fortran 77 compiler.
+ Use it inside source generating function to ensure that
+ setup distribution instance has been initialized.
+ """
+ simple_fortran_subroutine = '''
+ subroutine simple
+ end
+ '''
+ config_cmd = self.get_config_cmd()
+ flag = config_cmd.try_compile(simple_fortran_subroutine,lang='f77')
+ return flag
+
+ def have_f90c(self):
+ """ Check for availability of Fortran 90 compiler.
+ Use it inside source generating function to ensure that
+ setup distribution instance has been initialized.
+ """
+ simple_fortran_subroutine = '''
+ subroutine simple
+ end
+ '''
+ config_cmd = self.get_config_cmd()
+ flag = config_cmd.try_compile(simple_fortran_subroutine,lang='f90')
+ return flag
+
+ def append_to(self, extlib):
+ """ Append libraries, include_dirs to extension or library item.
+ """
+ if is_sequence(extlib):
+ lib_name, build_info = extlib
+ dict_append(build_info,
+ libraries=self.libraries,
+ include_dirs=self.include_dirs)
+ else:
+ from numpy.distutils.core import Extension
+ assert isinstance(extlib,Extension), repr(extlib)
+ extlib.libraries.extend(self.libraries)
+ extlib.include_dirs.extend(self.include_dirs)
+ return
+
+ def _get_svn_revision(self,path):
+ """ Return path's SVN revision number.
+ """
+ revision = None
+ m = None
+ try:
+ sin, sout = os.popen4('svnversion')
+ m = re.match(r'(?P<revision>\d+)', sout.read())
+ except:
+ pass
+ if m:
+ revision = int(m.group('revision'))
+ return revision
+ if sys.platform=='win32' and os.environ.get('SVN_ASP_DOT_NET_HACK',None):
+ entries = njoin(path,'_svn','entries')
+ else:
+ entries = njoin(path,'.svn','entries')
+ if os.path.isfile(entries):
+ f = open(entries)
+ fstr = f.read()
+ f.close()
+ if fstr[:5] == '<?xml': # pre 1.4
+ m = re.search(r'revision="(?P<revision>\d+)"',fstr)
+ if m:
+ revision = int(m.group('revision'))
+ else: # non-xml entries file --- check to be sure that
+ m = re.search(r'dir[\n\r]+(?P<revision>\d+)', fstr)
+ if m:
+ revision = int(m.group('revision'))
+ return revision
+
+ def get_version(self, version_file=None, version_variable=None):
+ """ Try to get version string of a package.
+ """
+ version = getattr(self,'version',None)
+ if version is not None:
+ return version
+
+ # Get version from version file.
+ if version_file is None:
+ files = ['__version__.py',
+ self.name.split('.')[-1]+'_version.py',
+ 'version.py',
+ '__svn_version__.py']
+ else:
+ files = [version_file]
+ if version_variable is None:
+ version_vars = ['version',
+ '__version__',
+ self.name.split('.')[-1]+'_version']
+ else:
+ version_vars = [version_variable]
+ for f in files:
+ fn = njoin(self.local_path,f)
+ if os.path.isfile(fn):
+ info = (open(fn),fn,('.py','U',1))
+ name = os.path.splitext(os.path.basename(fn))[0]
+ n = dot_join(self.name,name)
+ try:
+ version_module = imp.load_module('_'.join(n.split('.')),*info)
+ except ImportError,msg:
+ self.warn(str(msg))
+ version_module = None
+ if version_module is None:
+ continue
+
+ for a in version_vars:
+ version = getattr(version_module,a,None)
+ if version is not None:
+ break
+ if version is not None:
+ break
+
+ if version is not None:
+ self.version = version
+ return version
+
+ # Get version as SVN revision number
+ revision = self._get_svn_revision(self.local_path)
+ if revision is not None:
+ version = str(revision)
+ self.version = version
+
+ return version
+
+ def make_svn_version_py(self, delete=True):
+ """ Generate package __svn_version__.py file from SVN revision number,
+ it will be removed after python exits but will be available
+ when sdist, etc commands are executed.
+
+ If __svn_version__.py existed before, nothing is done.
+ """
+ target = njoin(self.local_path,'__svn_version__.py')
+ revision = self._get_svn_revision(self.local_path)
+ if os.path.isfile(target) or revision is None:
+ return
+ else:
+ def generate_svn_version_py():
+ if not os.path.isfile(target):
+ version = str(revision)
+ self.info('Creating %s (version=%r)' % (target,version))
+ f = open(target,'w')
+ f.write('version = %r\n' % (version))
+ f.close()
+
+ import atexit
+ def rm_file(f=target,p=self.info):
+ if delete:
+ try: os.remove(f); p('removed '+f)
+ except OSError: pass
+ try: os.remove(f+'c'); p('removed '+f+'c')
+ except OSError: pass
+
+ atexit.register(rm_file)
+
+ return target
+
+ self.add_data_files(('', generate_svn_version_py()))
+
+ def make_config_py(self,name='__config__'):
+ """ Generate package __config__.py file containing system_info
+ information used during building the package.
+ """
+ self.py_modules.append((self.name,name,generate_config_py))
+ return
+
+ def get_info(self,*names):
+ """ Get resources information.
+ """
+ from system_info import get_info, dict_append
+ info_dict = {}
+ for a in names:
+ dict_append(info_dict,**get_info(a))
+ return info_dict
+
+
+def get_cmd(cmdname, _cache={}):
+ if not _cache.has_key(cmdname):
+ import distutils.core
+ dist = distutils.core._setup_distribution
+ if dist is None:
+ from distutils.errors import DistutilsInternalError
+ raise DistutilsInternalError(
+ 'setup distribution instance not initialized')
+ cmd = dist.get_command_obj(cmdname)
+ _cache[cmdname] = cmd
+ return _cache[cmdname]
+
+def get_numpy_include_dirs():
+ # numpy_include_dirs are set by numpy/core/setup.py, otherwise []
+ include_dirs = Configuration.numpy_include_dirs[:]
+ if not include_dirs:
+ import numpy
+ include_dirs = [ numpy.get_include() ]
+ # else running numpy/core/setup.py
+ return include_dirs
+
+#########################
+
+def default_config_dict(name = None, parent_name = None, local_path=None):
+ """ Return a configuration dictionary for usage in
+ configuration() function defined in file setup_<name>.py.
+ """
+ import warnings
+ warnings.warn('Use Configuration(%r,%r,top_path=%r) instead of '\
+ 'deprecated default_config_dict(%r,%r,%r)'
+ % (name, parent_name, local_path,
+ name, parent_name, local_path,
+ ))
+ c = Configuration(name, parent_name, local_path)
+ return c.todict()
+
+
+def dict_append(d, **kws):
+ for k, v in kws.items():
+ if d.has_key(k):
+ ov = d[k]
+ if isinstance(ov,str):
+ d[k] = v
+ else:
+ d[k].extend(v)
+ else:
+ d[k] = v
+
+def appendpath(prefix, path):
+ if os.path.sep != '/':
+ prefix = prefix.replace('/', os.path.sep)
+ path = path.replace('/', os.path.sep)
+ drive = ''
+ if os.path.isabs(path):
+ drive = os.path.splitdrive(prefix)[0]
+ absprefix = os.path.splitdrive(os.path.abspath(prefix))[1]
+ pathdrive, path = os.path.splitdrive(path)
+ d = os.path.commonprefix([absprefix, path])
+ if os.path.join(absprefix[:len(d)], absprefix[len(d):]) != absprefix \
+ or os.path.join(path[:len(d)], path[len(d):]) != path:
+ # Handle invalid paths
+ d = os.path.dirname(d)
+ subpath = path[len(d):]
+ if os.path.isabs(subpath):
+ subpath = subpath[1:]
+ else:
+ subpath = path
+ return os.path.normpath(njoin(drive + prefix, subpath))
+
+def generate_config_py(target):
+ """ Generate config.py file containing system_info information
+ used during building the package.
+
+ Usage:\
+ config['py_modules'].append((packagename, '__config__',generate_config_py))
+ """
+ from numpy.distutils.system_info import system_info
+ from distutils.dir_util import mkpath
+ mkpath(os.path.dirname(target))
+ f = open(target, 'w')
+ f.write('# This file is generated by %s\n' % (os.path.abspath(sys.argv[0])))
+ f.write('# It contains system_info results at the time of building this package.\n')
+ f.write('__all__ = ["get_info","show"]\n\n')
+ for k, i in system_info.saved_results.items():
+ f.write('%s=%r\n' % (k, i))
+ f.write('\ndef get_info(name):\n g=globals()\n return g.get(name,g.get(name+"_info",{}))\n')
+ f.write('''
+def show():
+ for name,info_dict in globals().items():
+ if name[0]=="_" or type(info_dict) is not type({}): continue
+ print name+":"
+ if not info_dict:
+ print " NOT AVAILABLE"
+ for k,v in info_dict.items():
+ v = str(v)
+ if k==\'sources\' and len(v)>200: v = v[:60]+\' ...\\n... \'+v[-60:]
+ print \' %s = %s\'%(k,v)
+ print
+ return
+ ''')
+
+ f.close()
+ return target
diff --git a/numpy/distutils/setup.py b/numpy/distutils/setup.py
new file mode 100644
index 000000000..b16225f41
--- /dev/null
+++ b/numpy/distutils/setup.py
@@ -0,0 +1,15 @@
+#!/usr/bin/env python
+
+def configuration(parent_package='',top_path=None):
+ from numpy.distutils.misc_util import Configuration
+ config = Configuration('distutils',parent_package,top_path)
+ config.add_subpackage('command')
+ config.add_subpackage('fcompiler')
+ config.add_data_dir('tests')
+ config.add_data_files('site.cfg')
+ config.make_config_py()
+ return config
+
+if __name__ == '__main__':
+ from numpy.distutils.core import setup
+ setup(configuration=configuration)
diff --git a/numpy/distutils/system_info.py b/numpy/distutils/system_info.py
new file mode 100644
index 000000000..a3a037e2a
--- /dev/null
+++ b/numpy/distutils/system_info.py
@@ -0,0 +1,1919 @@
+#!/bin/env python
+"""
+This file defines a set of system_info classes for getting
+information about various resources (libraries, library directories,
+include directories, etc.) in the system. Currently, the following
+classes are available:
+
+ atlas_info
+ atlas_threads_info
+ atlas_blas_info
+ atlas_blas_threads_info
+ lapack_atlas_info
+ blas_info
+ lapack_info
+ blas_opt_info # usage recommended
+ lapack_opt_info # usage recommended
+ fftw_info,dfftw_info,sfftw_info
+ fftw_threads_info,dfftw_threads_info,sfftw_threads_info
+ djbfft_info
+ x11_info
+ lapack_src_info
+ blas_src_info
+ numpy_info
+ numarray_info
+ numpy_info
+ boost_python_info
+ agg2_info
+ wx_info
+ gdk_pixbuf_xlib_2_info
+ gdk_pixbuf_2_info
+ gdk_x11_2_info
+ gtkp_x11_2_info
+ gtkp_2_info
+ xft_info
+ freetype2_info
+ umfpack_info
+
+Usage:
+ info_dict = get_info(<name>)
+ where <name> is a string 'atlas','x11','fftw','lapack','blas',
+ 'lapack_src', 'blas_src', etc. For a complete list of allowed names,
+ see the definition of get_info() function below.
+
+ Returned info_dict is a dictionary which is compatible with
+ distutils.setup keyword arguments. If info_dict == {}, then the
+ asked resource is not available (system_info could not find it).
+
+ Several *_info classes specify an environment variable to specify
+ the locations of software. When setting the corresponding environment
+ variable to 'None' then the software will be ignored, even when it
+ is available in system.
+
+Global parameters:
+ system_info.search_static_first - search static libraries (.a)
+ in precedence to shared ones (.so, .sl) if enabled.
+ system_info.verbosity - output the results to stdout if enabled.
+
+The file 'site.cfg' is looked for in
+
+1) Directory of main setup.py file being run.
+2) Home directory of user running the setup.py file as ~/.numpy-site.cfg
+3) System wide directory (location of this file...)
+
+The first one found is used to get system configuration options The
+format is that used by ConfigParser (i.e., Windows .INI style). The
+section DEFAULT has options that are the default for each section. The
+available sections are fftw, atlas, and x11. Appropiate defaults are
+used if nothing is specified.
+
+The order of finding the locations of resources is the following:
+ 1. environment variable
+ 2. section in site.cfg
+ 3. DEFAULT section in site.cfg
+Only the first complete match is returned.
+
+Example:
+----------
+[DEFAULT]
+library_dirs = /usr/lib:/usr/local/lib:/opt/lib
+include_dirs = /usr/include:/usr/local/include:/opt/include
+src_dirs = /usr/local/src:/opt/src
+# search static libraries (.a) in preference to shared ones (.so)
+search_static_first = 0
+
+[fftw]
+fftw_libs = rfftw, fftw
+fftw_opt_libs = rfftw_threaded, fftw_threaded
+# if the above aren't found, look for {s,d}fftw_libs and {s,d}fftw_opt_libs
+
+[atlas]
+library_dirs = /usr/lib/3dnow:/usr/lib/3dnow/atlas
+# for overriding the names of the atlas libraries
+atlas_libs = lapack, f77blas, cblas, atlas
+
+[x11]
+library_dirs = /usr/X11R6/lib
+include_dirs = /usr/X11R6/include
+----------
+
+Authors:
+ Pearu Peterson <pearu@cens.ioc.ee>, February 2002
+ David M. Cooke <cookedm@physics.mcmaster.ca>, April 2002
+
+Copyright 2002 Pearu Peterson all rights reserved,
+Pearu Peterson <pearu@cens.ioc.ee>
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy (BSD style) license. See LICENSE.txt that came with
+this distribution for specifics.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+"""
+
+import sys
+import os
+import re
+import copy
+import warnings
+from glob import glob
+import ConfigParser
+
+from distutils.errors import DistutilsError
+from distutils.dist import Distribution
+import distutils.sysconfig
+from distutils import log
+
+from numpy.distutils.exec_command import \
+ find_executable, exec_command, get_pythonexe
+from numpy.distutils.misc_util import is_sequence, is_string
+from numpy.distutils.command.config import config as cmd_config
+
+if sys.platform == 'win32':
+ default_lib_dirs = ['C:\\',
+ os.path.join(distutils.sysconfig.EXEC_PREFIX,
+ 'libs')]
+ default_include_dirs = []
+ default_src_dirs = ['.']
+ default_x11_lib_dirs = []
+ default_x11_include_dirs = []
+else:
+ default_lib_dirs = ['/usr/local/lib', '/opt/lib', '/usr/lib',
+ '/opt/local/lib', '/sw/lib']
+ default_include_dirs = ['/usr/local/include',
+ '/opt/include', '/usr/include',
+ '/opt/local/include', '/sw/include']
+ default_src_dirs = ['.','/usr/local/src', '/opt/src','/sw/src']
+ default_x11_lib_dirs = ['/usr/X11R6/lib','/usr/X11/lib','/usr/lib']
+ default_x11_include_dirs = ['/usr/X11R6/include','/usr/X11/include',
+ '/usr/include']
+
+if os.path.join(sys.prefix, 'lib') not in default_lib_dirs:
+ default_lib_dirs.insert(0,os.path.join(sys.prefix, 'lib'))
+ default_include_dirs.append(os.path.join(sys.prefix, 'include'))
+ default_src_dirs.append(os.path.join(sys.prefix, 'src'))
+
+default_lib_dirs = filter(os.path.isdir, default_lib_dirs)
+default_include_dirs = filter(os.path.isdir, default_include_dirs)
+default_src_dirs = filter(os.path.isdir, default_src_dirs)
+
+so_ext = distutils.sysconfig.get_config_vars('SO')[0] or ''
+
+def get_standard_file(fname):
+ """Returns a list of files named 'fname' from
+ 1) System-wide directory (directory-location of this module)
+ 2) Users HOME directory (os.environ['HOME'])
+ 3) Local directory
+ """
+ # System-wide file
+ filenames = []
+ try:
+ f = __file__
+ except NameError:
+ f = sys.argv[0]
+ else:
+ sysfile = os.path.join(os.path.split(os.path.abspath(f))[0],
+ fname)
+ if os.path.isfile(sysfile):
+ filenames.append(sysfile)
+
+ # Home directory
+ # And look for the user config file
+ try:
+ f = os.environ['HOME']
+ except KeyError:
+ pass
+ else:
+ user_file = os.path.join(f, fname)
+ if os.path.isfile(user_file):
+ filenames.append(user_file)
+
+ # Local file
+ if os.path.isfile(fname):
+ filenames.append(os.path.abspath(fname))
+
+ return filenames
+
+def get_info(name,notfound_action=0):
+ """
+ notfound_action:
+ 0 - do nothing
+ 1 - display warning message
+ 2 - raise error
+ """
+ cl = {'atlas':atlas_info, # use lapack_opt or blas_opt instead
+ 'atlas_threads':atlas_threads_info, # ditto
+ 'atlas_blas':atlas_blas_info,
+ 'atlas_blas_threads':atlas_blas_threads_info,
+ 'lapack_atlas':lapack_atlas_info, # use lapack_opt instead
+ 'lapack_atlas_threads':lapack_atlas_threads_info, # ditto
+ 'mkl':mkl_info,
+ 'lapack_mkl':lapack_mkl_info, # use lapack_opt instead
+ 'blas_mkl':blas_mkl_info, # use blas_opt instead
+ 'x11':x11_info,
+ 'fft_opt':fft_opt_info,
+ 'fftw':fftw_info,
+ 'fftw2':fftw2_info,
+ 'fftw3':fftw3_info,
+ 'dfftw':dfftw_info,
+ 'sfftw':sfftw_info,
+ 'fftw_threads':fftw_threads_info,
+ 'dfftw_threads':dfftw_threads_info,
+ 'sfftw_threads':sfftw_threads_info,
+ 'djbfft':djbfft_info,
+ 'blas':blas_info, # use blas_opt instead
+ 'lapack':lapack_info, # use lapack_opt instead
+ 'lapack_src':lapack_src_info,
+ 'blas_src':blas_src_info,
+ 'numpy':numpy_info,
+ 'f2py':f2py_info,
+ 'Numeric':Numeric_info,
+ 'numeric':Numeric_info,
+ 'numarray':numarray_info,
+ 'numerix':numerix_info,
+ 'lapack_opt':lapack_opt_info,
+ 'blas_opt':blas_opt_info,
+ 'boost_python':boost_python_info,
+ 'agg2':agg2_info,
+ 'wx':wx_info,
+ 'gdk_pixbuf_xlib_2':gdk_pixbuf_xlib_2_info,
+ 'gdk-pixbuf-xlib-2.0':gdk_pixbuf_xlib_2_info,
+ 'gdk_pixbuf_2':gdk_pixbuf_2_info,
+ 'gdk-pixbuf-2.0':gdk_pixbuf_2_info,
+ 'gdk':gdk_info,
+ 'gdk_2':gdk_2_info,
+ 'gdk-2.0':gdk_2_info,
+ 'gdk_x11_2':gdk_x11_2_info,
+ 'gdk-x11-2.0':gdk_x11_2_info,
+ 'gtkp_x11_2':gtkp_x11_2_info,
+ 'gtk+-x11-2.0':gtkp_x11_2_info,
+ 'gtkp_2':gtkp_2_info,
+ 'gtk+-2.0':gtkp_2_info,
+ 'xft':xft_info,
+ 'freetype2':freetype2_info,
+ 'umfpack':umfpack_info,
+ 'amd':amd_info,
+ }.get(name.lower(),system_info)
+ return cl().get_info(notfound_action)
+
+class NotFoundError(DistutilsError):
+ """Some third-party program or library is not found."""
+
+class AtlasNotFoundError(NotFoundError):
+ """
+ Atlas (http://math-atlas.sourceforge.net/) libraries not found.
+ Directories to search for the libraries can be specified in the
+ numpy/distutils/site.cfg file (section [atlas]) or by setting
+ the ATLAS environment variable."""
+
+class LapackNotFoundError(NotFoundError):
+ """
+ Lapack (http://www.netlib.org/lapack/) libraries not found.
+ Directories to search for the libraries can be specified in the
+ numpy/distutils/site.cfg file (section [lapack]) or by setting
+ the LAPACK environment variable."""
+
+class LapackSrcNotFoundError(LapackNotFoundError):
+ """
+ Lapack (http://www.netlib.org/lapack/) sources not found.
+ Directories to search for the sources can be specified in the
+ numpy/distutils/site.cfg file (section [lapack_src]) or by setting
+ the LAPACK_SRC environment variable."""
+
+class BlasNotFoundError(NotFoundError):
+ """
+ Blas (http://www.netlib.org/blas/) libraries not found.
+ Directories to search for the libraries can be specified in the
+ numpy/distutils/site.cfg file (section [blas]) or by setting
+ the BLAS environment variable."""
+
+class BlasSrcNotFoundError(BlasNotFoundError):
+ """
+ Blas (http://www.netlib.org/blas/) sources not found.
+ Directories to search for the sources can be specified in the
+ numpy/distutils/site.cfg file (section [blas_src]) or by setting
+ the BLAS_SRC environment variable."""
+
+class FFTWNotFoundError(NotFoundError):
+ """
+ FFTW (http://www.fftw.org/) libraries not found.
+ Directories to search for the libraries can be specified in the
+ numpy/distutils/site.cfg file (section [fftw]) or by setting
+ the FFTW environment variable."""
+
+class DJBFFTNotFoundError(NotFoundError):
+ """
+ DJBFFT (http://cr.yp.to/djbfft.html) libraries not found.
+ Directories to search for the libraries can be specified in the
+ numpy/distutils/site.cfg file (section [djbfft]) or by setting
+ the DJBFFT environment variable."""
+
+class NumericNotFoundError(NotFoundError):
+ """
+ Numeric (http://www.numpy.org/) module not found.
+ Get it from above location, install it, and retry setup.py."""
+
+class X11NotFoundError(NotFoundError):
+ """X11 libraries not found."""
+
+class UmfpackNotFoundError(NotFoundError):
+ """
+ UMFPACK sparse solver (http://www.cise.ufl.edu/research/sparse/umfpack/)
+ not found. Directories to search for the libraries can be specified in the
+ numpy/distutils/site.cfg file (section [umfpack]) or by setting
+ the UMFPACK environment variable."""
+
+class system_info:
+
+ """ get_info() is the only public method. Don't use others.
+ """
+ section = 'DEFAULT'
+ dir_env_var = None
+ search_static_first = 0 # XXX: disabled by default, may disappear in
+ # future unless it is proved to be useful.
+ verbosity = 1
+ saved_results = {}
+
+ notfounderror = NotFoundError
+
+ def __init__ (self,
+ default_lib_dirs=default_lib_dirs,
+ default_include_dirs=default_include_dirs,
+ verbosity = 1,
+ ):
+ self.__class__.info = {}
+ self.local_prefixes = []
+ defaults = {}
+ defaults['libraries'] = ''
+ defaults['library_dirs'] = os.pathsep.join(default_lib_dirs)
+ defaults['include_dirs'] = os.pathsep.join(default_include_dirs)
+ defaults['src_dirs'] = os.pathsep.join(default_src_dirs)
+ defaults['search_static_first'] = str(self.search_static_first)
+ self.cp = ConfigParser.ConfigParser(defaults)
+ self.files = []
+ self.files.extend(get_standard_file('.numpy-site.cfg'))
+ self.files.extend(get_standard_file('site.cfg'))
+ self.parse_config_files()
+ self.search_static_first = self.cp.getboolean(self.section,
+ 'search_static_first')
+ assert isinstance(self.search_static_first, int)
+
+ def parse_config_files(self):
+ self.cp.read(self.files)
+ if not self.cp.has_section(self.section):
+ self.cp.add_section(self.section)
+
+ def calc_libraries_info(self):
+ libs = self.get_libraries()
+ dirs = self.get_lib_dirs()
+ info = {}
+ for lib in libs:
+ i = None
+ for d in dirs:
+ i = self.check_libs(d,[lib])
+ if i is not None:
+ break
+ if i is not None:
+ dict_append(info,**i)
+ else:
+ log.info('Library %s was not found. Ignoring' % (lib))
+ return info
+
+ def set_info(self,**info):
+ if info:
+ lib_info = self.calc_libraries_info()
+ dict_append(info,**lib_info)
+ self.saved_results[self.__class__.__name__] = info
+
+ def has_info(self):
+ return self.saved_results.has_key(self.__class__.__name__)
+
+ def get_info(self,notfound_action=0):
+ """ Return a dictonary with items that are compatible
+ with numpy.distutils.setup keyword arguments.
+ """
+ flag = 0
+ if not self.has_info():
+ flag = 1
+ log.info(self.__class__.__name__ + ':')
+ if hasattr(self, 'calc_info'):
+ self.calc_info()
+ if notfound_action:
+ if not self.has_info():
+ if notfound_action==1:
+ warnings.warn(self.notfounderror.__doc__)
+ elif notfound_action==2:
+ raise self.notfounderror,self.notfounderror.__doc__
+ else:
+ raise ValueError(repr(notfound_action))
+
+ if not self.has_info():
+ log.info(' NOT AVAILABLE')
+ self.set_info()
+ else:
+ log.info(' FOUND:')
+
+ res = self.saved_results.get(self.__class__.__name__)
+ if self.verbosity>0 and flag:
+ for k,v in res.items():
+ v = str(v)
+ if k=='sources' and len(v)>200: v = v[:60]+' ...\n... '+v[-60:]
+ log.info(' %s = %s', k, v)
+ log.info('')
+
+ return copy.deepcopy(res)
+
+ def get_paths(self, section, key):
+ dirs = self.cp.get(section, key).split(os.pathsep)
+ env_var = self.dir_env_var
+ if env_var:
+ if is_sequence(env_var):
+ e0 = env_var[-1]
+ for e in env_var:
+ if os.environ.has_key(e):
+ e0 = e
+ break
+ if not env_var[0]==e0:
+ log.info('Setting %s=%s' % (env_var[0],e0))
+ env_var = e0
+ if env_var and os.environ.has_key(env_var):
+ d = os.environ[env_var]
+ if d=='None':
+ log.info('Disabled %s: %s',self.__class__.__name__,'(%s is None)' \
+ % (env_var,))
+ return []
+ if os.path.isfile(d):
+ dirs = [os.path.dirname(d)] + dirs
+ l = getattr(self,'_lib_names',[])
+ if len(l)==1:
+ b = os.path.basename(d)
+ b = os.path.splitext(b)[0]
+ if b[:3]=='lib':
+ log.info('Replacing _lib_names[0]==%r with %r' \
+ % (self._lib_names[0], b[3:]))
+ self._lib_names[0] = b[3:]
+ else:
+ ds = d.split(os.pathsep)
+ ds2 = []
+ for d in ds:
+ if os.path.isdir(d):
+ ds2.append(d)
+ for dd in ['include','lib']:
+ d1 = os.path.join(d,dd)
+ if os.path.isdir(d1):
+ ds2.append(d1)
+ dirs = ds2 + dirs
+ default_dirs = self.cp.get('DEFAULT', key).split(os.pathsep)
+ dirs.extend(default_dirs)
+ ret = []
+ for d in dirs:
+ if os.path.isdir(d) and d not in ret:
+ ret.append(d)
+ log.debug('( %s = %s )', key, ':'.join(ret))
+ return ret
+
+ def get_lib_dirs(self, key='library_dirs'):
+ return self.get_paths(self.section, key)
+
+ def get_include_dirs(self, key='include_dirs'):
+ return self.get_paths(self.section, key)
+
+ def get_src_dirs(self, key='src_dirs'):
+ return self.get_paths(self.section, key)
+
+ def get_libs(self, key, default):
+ try:
+ libs = self.cp.get(self.section, key)
+ except ConfigParser.NoOptionError:
+ if not default:
+ return []
+ if is_string(default):
+ return [default]
+ return default
+ return [b for b in [a.strip() for a in libs.split(',')] if b]
+
+ def get_libraries(self, key='libraries'):
+ return self.get_libs(key,'')
+
+ def library_extensions(self):
+ static_exts = ['.a']
+ if sys.platform == 'win32':
+ static_exts.append('.lib') # .lib is used by MSVC
+ if self.search_static_first:
+ exts = static_exts + [so_ext]
+ else:
+ exts = [so_ext] + static_exts
+ if sys.platform == 'cygwin':
+ exts.append('.dll.a')
+ if sys.platform == 'darwin':
+ exts.append('.dylib')
+ return exts
+
+ def check_libs(self,lib_dir,libs,opt_libs =[]):
+ """If static or shared libraries are available then return
+ their info dictionary.
+
+ Checks for all libraries as shared libraries first, then
+ static (or vice versa if self.search_static_first is True).
+ """
+ exts = self.library_extensions()
+ info = None
+ for ext in exts:
+ info = self._check_libs(lib_dir,libs,opt_libs,[ext])
+ if info is not None:
+ break
+ if not info:
+ log.info(' libraries %s not found in %s', ','.join(libs), lib_dir)
+ return info
+
+ def check_libs2(self, lib_dir, libs, opt_libs =[]):
+ """If static or shared libraries are available then return
+ their info dictionary.
+
+ Checks each library for shared or static.
+ """
+ exts = self.library_extensions()
+ info = self._check_libs(lib_dir,libs,opt_libs,exts)
+ if not info:
+ log.info(' libraries %s not found in %s', ','.join(libs), lib_dir)
+ return info
+
+ def _lib_list(self, lib_dir, libs, exts):
+ assert is_string(lib_dir)
+ liblist = []
+ # under windows first try without 'lib' prefix
+ if sys.platform == 'win32':
+ lib_prefixes = ['', 'lib']
+ else:
+ lib_prefixes = ['lib']
+ # for each library name, see if we can find a file for it.
+ for l in libs:
+ for ext in exts:
+ for prefix in lib_prefixes:
+ p = self.combine_paths(lib_dir, prefix+l+ext)
+ if p:
+ break
+ if p:
+ assert len(p)==1
+ # ??? splitext on p[0] would do this for cygwin
+ # doesn't seem correct
+ if ext == '.dll.a':
+ l += '.dll'
+ liblist.append(l)
+ break
+ return liblist
+
+ def _check_libs(self, lib_dir, libs, opt_libs, exts):
+ found_libs = self._lib_list(lib_dir, libs, exts)
+ if len(found_libs) == len(libs):
+ info = {'libraries' : found_libs, 'library_dirs' : [lib_dir]}
+ opt_found_libs = self._lib_list(lib_dir, opt_libs, exts)
+ if len(opt_found_libs) == len(opt_libs):
+ info['libraries'].extend(opt_found_libs)
+ return info
+ else:
+ return None
+
+ def combine_paths(self,*args):
+ """Return a list of existing paths composed by all combinations
+ of items from the arguments.
+ """
+ return combine_paths(*args,**{'verbosity':self.verbosity})
+
+
+class fft_opt_info(system_info):
+
+ def calc_info(self):
+ info = {}
+ fftw_info = get_info('fftw3') or get_info('fftw2') or get_info('dfftw')
+ djbfft_info = get_info('djbfft')
+ if fftw_info:
+ dict_append(info,**fftw_info)
+ if djbfft_info:
+ dict_append(info,**djbfft_info)
+ self.set_info(**info)
+ return
+
+
+class fftw_info(system_info):
+ #variables to override
+ section = 'fftw'
+ dir_env_var = 'FFTW'
+ notfounderror = FFTWNotFoundError
+ ver_info = [ { 'name':'fftw3',
+ 'libs':['fftw3'],
+ 'includes':['fftw3.h'],
+ 'macros':[('SCIPY_FFTW3_H',None)]},
+ { 'name':'fftw2',
+ 'libs':['rfftw', 'fftw'],
+ 'includes':['fftw.h','rfftw.h'],
+ 'macros':[('SCIPY_FFTW_H',None)]}]
+
+ def __init__(self):
+ system_info.__init__(self)
+
+ def calc_ver_info(self,ver_param):
+ """Returns True on successful version detection, else False"""
+ lib_dirs = self.get_lib_dirs()
+ incl_dirs = self.get_include_dirs()
+ incl_dir = None
+ libs = self.get_libs(self.section+'_libs', ver_param['libs'])
+ info = None
+ for d in lib_dirs:
+ r = self.check_libs(d,libs)
+ if r is not None:
+ info = r
+ break
+ if info is not None:
+ flag = 0
+ for d in incl_dirs:
+ if len(self.combine_paths(d,ver_param['includes']))==len(ver_param['includes']):
+ dict_append(info,include_dirs=[d])
+ flag = 1
+ incl_dirs = [d]
+ incl_dir = d
+ break
+ if flag:
+ dict_append(info,define_macros=ver_param['macros'])
+ else:
+ info = None
+ if info is not None:
+ self.set_info(**info)
+ return True
+ else:
+ log.info(' %s not found' % (ver_param['name']))
+ return False
+
+ def calc_info(self):
+ for i in self.ver_info:
+ if self.calc_ver_info(i):
+ break
+
+class fftw2_info(fftw_info):
+ #variables to override
+ section = 'fftw'
+ dir_env_var = 'FFTW'
+ notfounderror = FFTWNotFoundError
+ ver_info = [ { 'name':'fftw2',
+ 'libs':['rfftw', 'fftw'],
+ 'includes':['fftw.h','rfftw.h'],
+ 'macros':[('SCIPY_FFTW_H',None)]}
+ ]
+
+class fftw3_info(fftw_info):
+ #variables to override
+ section = 'fftw3'
+ dir_env_var = 'FFTW3'
+ notfounderror = FFTWNotFoundError
+ ver_info = [ { 'name':'fftw3',
+ 'libs':['fftw3'],
+ 'includes':['fftw3.h'],
+ 'macros':[('SCIPY_FFTW3_H',None)]},
+ ]
+
+class dfftw_info(fftw_info):
+ section = 'fftw'
+ dir_env_var = 'FFTW'
+ ver_info = [ { 'name':'dfftw',
+ 'libs':['drfftw','dfftw'],
+ 'includes':['dfftw.h','drfftw.h'],
+ 'macros':[('SCIPY_DFFTW_H',None)]} ]
+
+class sfftw_info(fftw_info):
+ section = 'fftw'
+ dir_env_var = 'FFTW'
+ ver_info = [ { 'name':'sfftw',
+ 'libs':['srfftw','sfftw'],
+ 'includes':['sfftw.h','srfftw.h'],
+ 'macros':[('SCIPY_SFFTW_H',None)]} ]
+
+class fftw_threads_info(fftw_info):
+ section = 'fftw'
+ dir_env_var = 'FFTW'
+ ver_info = [ { 'name':'fftw threads',
+ 'libs':['rfftw_threads','fftw_threads'],
+ 'includes':['fftw_threads.h','rfftw_threads.h'],
+ 'macros':[('SCIPY_FFTW_THREADS_H',None)]} ]
+
+class dfftw_threads_info(fftw_info):
+ section = 'fftw'
+ dir_env_var = 'FFTW'
+ ver_info = [ { 'name':'dfftw threads',
+ 'libs':['drfftw_threads','dfftw_threads'],
+ 'includes':['dfftw_threads.h','drfftw_threads.h'],
+ 'macros':[('SCIPY_DFFTW_THREADS_H',None)]} ]
+
+class sfftw_threads_info(fftw_info):
+ section = 'fftw'
+ dir_env_var = 'FFTW'
+ ver_info = [ { 'name':'sfftw threads',
+ 'libs':['srfftw_threads','sfftw_threads'],
+ 'includes':['sfftw_threads.h','srfftw_threads.h'],
+ 'macros':[('SCIPY_SFFTW_THREADS_H',None)]} ]
+
+class djbfft_info(system_info):
+ section = 'djbfft'
+ dir_env_var = 'DJBFFT'
+ notfounderror = DJBFFTNotFoundError
+
+ def get_paths(self, section, key):
+ pre_dirs = system_info.get_paths(self, section, key)
+ dirs = []
+ for d in pre_dirs:
+ dirs.extend(self.combine_paths(d,['djbfft'])+[d])
+ return [ d for d in dirs if os.path.isdir(d) ]
+
+ def calc_info(self):
+ lib_dirs = self.get_lib_dirs()
+ incl_dirs = self.get_include_dirs()
+ info = None
+ for d in lib_dirs:
+ p = self.combine_paths (d,['djbfft.a'])
+ if p:
+ info = {'extra_objects':p}
+ break
+ p = self.combine_paths (d,['libdjbfft.a','libdjbfft'+so_ext])
+ if p:
+ info = {'libraries':['djbfft'],'library_dirs':[d]}
+ break
+ if info is None:
+ return
+ for d in incl_dirs:
+ if len(self.combine_paths(d,['fftc8.h','fftfreq.h']))==2:
+ dict_append(info,include_dirs=[d],
+ define_macros=[('SCIPY_DJBFFT_H',None)])
+ self.set_info(**info)
+ return
+ return
+
+class mkl_info(system_info):
+ section = 'mkl'
+ dir_env_var = 'MKL'
+ _lib_mkl = ['mkl','vml','guide']
+
+ def get_mkl_rootdir(self):
+ mklroot = os.environ.get('MKLROOT',None)
+ if mklroot is not None:
+ return mklroot
+ paths = os.environ.get('LD_LIBRARY_PATH','').split(os.pathsep)
+ ld_so_conf = '/etc/ld.so.conf'
+ if os.path.isfile(ld_so_conf):
+ for d in open(ld_so_conf,'r').readlines():
+ d = d.strip()
+ if d: paths.append(d)
+ intel_mkl_dirs = []
+ for path in paths:
+ path_atoms = path.split(os.sep)
+ for m in path_atoms:
+ if m.startswith('mkl'):
+ d = os.sep.join(path_atoms[:path_atoms.index(m)+2])
+ intel_mkl_dirs.append(d)
+ break
+ for d in paths:
+ dirs = glob(os.path.join(d,'mkl','*')) + glob(os.path.join(d,'mkl*'))
+ for d in dirs:
+ if os.path.isdir(os.path.join(d,'lib')):
+ return d
+ return None
+
+ def __init__(self):
+ mklroot = self.get_mkl_rootdir()
+ if mklroot is None:
+ system_info.__init__(self)
+ else:
+ from cpuinfo import cpu
+ l = 'mkl' # use shared library
+ if cpu.is_Itanium():
+ plt = '64'
+ #l = 'mkl_ipf'
+ elif cpu.is_Xeon():
+ plt = 'em64t'
+ #l = 'mkl_em64t'
+ else:
+ plt = '32'
+ #l = 'mkl_ia32'
+ if l not in self._lib_mkl:
+ self._lib_mkl.insert(0,l)
+ system_info.__init__(self,
+ default_lib_dirs=[os.path.join(mklroot,'lib',plt)],
+ default_include_dirs=[os.path.join(mklroot,'include')])
+
+ def calc_info(self):
+ lib_dirs = self.get_lib_dirs()
+ incl_dirs = self.get_include_dirs()
+ mkl_libs = self.get_libs('mkl_libs',self._lib_mkl)
+ mkl = None
+ for d in lib_dirs:
+ mkl = self.check_libs2(d,mkl_libs)
+ if mkl is not None:
+ break
+ if mkl is None:
+ return
+ info = {}
+ dict_append(info,**mkl)
+ dict_append(info,
+ define_macros=[('SCIPY_MKL_H',None)],
+ include_dirs = incl_dirs)
+ if sys.platform == 'win32':
+ pass # win32 has no pthread library
+ else:
+ dict_append(info, libraries=['pthread'])
+ self.set_info(**info)
+
+class lapack_mkl_info(mkl_info):
+
+ def calc_info(self):
+ mkl = get_info('mkl')
+ if not mkl:
+ return
+ if sys.platform == 'win32':
+ lapack_libs = self.get_libs('lapack_libs',['mkl_lapack'])
+ else:
+ lapack_libs = self.get_libs('lapack_libs',['mkl_lapack32','mkl_lapack64'])
+
+ info = {'libraries': lapack_libs}
+ dict_append(info,**mkl)
+ self.set_info(**info)
+
+class blas_mkl_info(mkl_info):
+ pass
+
+class atlas_info(system_info):
+ section = 'atlas'
+ dir_env_var = 'ATLAS'
+ _lib_names = ['f77blas','cblas']
+ if sys.platform[:7]=='freebsd':
+ _lib_atlas = ['atlas_r']
+ _lib_lapack = ['alapack_r']
+ else:
+ _lib_atlas = ['atlas']
+ _lib_lapack = ['lapack']
+
+ notfounderror = AtlasNotFoundError
+
+ def get_paths(self, section, key):
+ pre_dirs = system_info.get_paths(self, section, key)
+ dirs = []
+ for d in pre_dirs:
+ dirs.extend(self.combine_paths(d,['atlas*','ATLAS*',
+ 'sse','3dnow','sse2'])+[d])
+ return [ d for d in dirs if os.path.isdir(d) ]
+
+ def calc_info(self):
+ lib_dirs = self.get_lib_dirs()
+ info = {}
+ atlas_libs = self.get_libs('atlas_libs',
+ self._lib_names + self._lib_atlas)
+ lapack_libs = self.get_libs('lapack_libs',self._lib_lapack)
+ atlas = None
+ lapack = None
+ atlas_1 = None
+ for d in lib_dirs:
+ atlas = self.check_libs2(d,atlas_libs,[])
+ lapack_atlas = self.check_libs2(d,['lapack_atlas'],[])
+ if atlas is not None:
+ lib_dirs2 = [d] + self.combine_paths(d,['atlas*','ATLAS*'])
+ for d2 in lib_dirs2:
+ lapack = self.check_libs2(d2,lapack_libs,[])
+ if lapack is not None:
+ break
+ else:
+ lapack = None
+ if lapack is not None:
+ break
+ if atlas:
+ atlas_1 = atlas
+ log.info(self.__class__)
+ if atlas is None:
+ atlas = atlas_1
+ if atlas is None:
+ return
+ include_dirs = self.get_include_dirs()
+ h = (self.combine_paths(lib_dirs+include_dirs,'cblas.h') or [None])[0]
+ if h:
+ h = os.path.dirname(h)
+ dict_append(info,include_dirs=[h])
+ info['language'] = 'c'
+ if lapack is not None:
+ dict_append(info,**lapack)
+ dict_append(info,**atlas)
+ elif 'lapack_atlas' in atlas['libraries']:
+ dict_append(info,**atlas)
+ dict_append(info,define_macros=[('ATLAS_WITH_LAPACK_ATLAS',None)])
+ self.set_info(**info)
+ return
+ else:
+ dict_append(info,**atlas)
+ dict_append(info,define_macros=[('ATLAS_WITHOUT_LAPACK',None)])
+ message = """
+*********************************************************************
+ Could not find lapack library within the ATLAS installation.
+*********************************************************************
+"""
+ warnings.warn(message)
+ self.set_info(**info)
+ return
+
+ # Check if lapack library is complete, only warn if it is not.
+ lapack_dir = lapack['library_dirs'][0]
+ lapack_name = lapack['libraries'][0]
+ lapack_lib = None
+ lib_prefixes = ['lib']
+ if sys.platform == 'win32':
+ lib_prefixes.append('')
+ for e in self.library_extensions():
+ for prefix in lib_prefixes:
+ fn = os.path.join(lapack_dir,prefix+lapack_name+e)
+ if os.path.exists(fn):
+ lapack_lib = fn
+ break
+ if lapack_lib:
+ break
+ if lapack_lib is not None:
+ sz = os.stat(lapack_lib)[6]
+ if sz <= 4000*1024:
+ message = """
+*********************************************************************
+ Lapack library (from ATLAS) is probably incomplete:
+ size of %s is %sk (expected >4000k)
+
+ Follow the instructions in the KNOWN PROBLEMS section of the file
+ numpy/INSTALL.txt.
+*********************************************************************
+""" % (lapack_lib,sz/1024)
+ warnings.warn(message)
+ else:
+ info['language'] = 'f77'
+
+ self.set_info(**info)
+
+class atlas_blas_info(atlas_info):
+ _lib_names = ['f77blas','cblas']
+
+ def calc_info(self):
+ lib_dirs = self.get_lib_dirs()
+ info = {}
+ atlas_libs = self.get_libs('atlas_libs',
+ self._lib_names + self._lib_atlas)
+ atlas = None
+ for d in lib_dirs:
+ atlas = self.check_libs2(d,atlas_libs,[])
+ if atlas is not None:
+ break
+ if atlas is None:
+ return
+ include_dirs = self.get_include_dirs()
+ h = (self.combine_paths(lib_dirs+include_dirs,'cblas.h') or [None])[0]
+ if h:
+ h = os.path.dirname(h)
+ dict_append(info,include_dirs=[h])
+ info['language'] = 'c'
+
+ dict_append(info,**atlas)
+
+ self.set_info(**info)
+ return
+
+
+class atlas_threads_info(atlas_info):
+ dir_env_var = ['PTATLAS','ATLAS']
+ _lib_names = ['ptf77blas','ptcblas']
+
+class atlas_blas_threads_info(atlas_blas_info):
+ dir_env_var = ['PTATLAS','ATLAS']
+ _lib_names = ['ptf77blas','ptcblas']
+
+class lapack_atlas_info(atlas_info):
+ _lib_names = ['lapack_atlas'] + atlas_info._lib_names
+
+class lapack_atlas_threads_info(atlas_threads_info):
+ _lib_names = ['lapack_atlas'] + atlas_threads_info._lib_names
+
+class lapack_info(system_info):
+ section = 'lapack'
+ dir_env_var = 'LAPACK'
+ _lib_names = ['lapack']
+ notfounderror = LapackNotFoundError
+
+ def calc_info(self):
+ lib_dirs = self.get_lib_dirs()
+
+ lapack_libs = self.get_libs('lapack_libs', self._lib_names)
+ for d in lib_dirs:
+ lapack = self.check_libs(d,lapack_libs,[])
+ if lapack is not None:
+ info = lapack
+ break
+ else:
+ return
+ info['language'] = 'f77'
+ self.set_info(**info)
+
+class lapack_src_info(system_info):
+ section = 'lapack_src'
+ dir_env_var = 'LAPACK_SRC'
+ notfounderror = LapackSrcNotFoundError
+
+ def get_paths(self, section, key):
+ pre_dirs = system_info.get_paths(self, section, key)
+ dirs = []
+ for d in pre_dirs:
+ dirs.extend([d] + self.combine_paths(d,['LAPACK*/SRC','SRC']))
+ return [ d for d in dirs if os.path.isdir(d) ]
+
+ def calc_info(self):
+ src_dirs = self.get_src_dirs()
+ src_dir = ''
+ for d in src_dirs:
+ if os.path.isfile(os.path.join(d,'dgesv.f')):
+ src_dir = d
+ break
+ if not src_dir:
+ #XXX: Get sources from netlib. May be ask first.
+ return
+ # The following is extracted from LAPACK-3.0/SRC/Makefile
+ allaux='''
+ ilaenv ieeeck lsame lsamen xerbla
+ ''' # *.f
+ laux = '''
+ bdsdc bdsqr disna labad lacpy ladiv lae2 laebz laed0 laed1
+ laed2 laed3 laed4 laed5 laed6 laed7 laed8 laed9 laeda laev2
+ lagtf lagts lamch lamrg lanst lapy2 lapy3 larnv larrb larre
+ larrf lartg laruv las2 lascl lasd0 lasd1 lasd2 lasd3 lasd4
+ lasd5 lasd6 lasd7 lasd8 lasd9 lasda lasdq lasdt laset lasq1
+ lasq2 lasq3 lasq4 lasq5 lasq6 lasr lasrt lassq lasv2 pttrf
+ stebz stedc steqr sterf
+ ''' # [s|d]*.f
+ lasrc = '''
+ gbbrd gbcon gbequ gbrfs gbsv gbsvx gbtf2 gbtrf gbtrs gebak
+ gebal gebd2 gebrd gecon geequ gees geesx geev geevx gegs gegv
+ gehd2 gehrd gelq2 gelqf gels gelsd gelss gelsx gelsy geql2
+ geqlf geqp3 geqpf geqr2 geqrf gerfs gerq2 gerqf gesc2 gesdd
+ gesv gesvd gesvx getc2 getf2 getrf getri getrs ggbak ggbal
+ gges ggesx ggev ggevx ggglm gghrd gglse ggqrf ggrqf ggsvd
+ ggsvp gtcon gtrfs gtsv gtsvx gttrf gttrs gtts2 hgeqz hsein
+ hseqr labrd lacon laein lags2 lagtm lahqr lahrd laic1 lals0
+ lalsa lalsd langb lange langt lanhs lansb lansp lansy lantb
+ lantp lantr lapll lapmt laqgb laqge laqp2 laqps laqsb laqsp
+ laqsy lar1v lar2v larf larfb larfg larft larfx largv larrv
+ lartv larz larzb larzt laswp lasyf latbs latdf latps latrd
+ latrs latrz latzm lauu2 lauum pbcon pbequ pbrfs pbstf pbsv
+ pbsvx pbtf2 pbtrf pbtrs pocon poequ porfs posv posvx potf2
+ potrf potri potrs ppcon ppequ pprfs ppsv ppsvx pptrf pptri
+ pptrs ptcon pteqr ptrfs ptsv ptsvx pttrs ptts2 spcon sprfs
+ spsv spsvx sptrf sptri sptrs stegr stein sycon syrfs sysv
+ sysvx sytf2 sytrf sytri sytrs tbcon tbrfs tbtrs tgevc tgex2
+ tgexc tgsen tgsja tgsna tgsy2 tgsyl tpcon tprfs tptri tptrs
+ trcon trevc trexc trrfs trsen trsna trsyl trti2 trtri trtrs
+ tzrqf tzrzf
+ ''' # [s|c|d|z]*.f
+ sd_lasrc = '''
+ laexc lag2 lagv2 laln2 lanv2 laqtr lasy2 opgtr opmtr org2l
+ org2r orgbr orghr orgl2 orglq orgql orgqr orgr2 orgrq orgtr
+ orm2l orm2r ormbr ormhr orml2 ormlq ormql ormqr ormr2 ormr3
+ ormrq ormrz ormtr rscl sbev sbevd sbevx sbgst sbgv sbgvd sbgvx
+ sbtrd spev spevd spevx spgst spgv spgvd spgvx sptrd stev stevd
+ stevr stevx syev syevd syevr syevx sygs2 sygst sygv sygvd
+ sygvx sytd2 sytrd
+ ''' # [s|d]*.f
+ cz_lasrc = '''
+ bdsqr hbev hbevd hbevx hbgst hbgv hbgvd hbgvx hbtrd hecon heev
+ heevd heevr heevx hegs2 hegst hegv hegvd hegvx herfs hesv
+ hesvx hetd2 hetf2 hetrd hetrf hetri hetrs hpcon hpev hpevd
+ hpevx hpgst hpgv hpgvd hpgvx hprfs hpsv hpsvx hptrd hptrf
+ hptri hptrs lacgv lacp2 lacpy lacrm lacrt ladiv laed0 laed7
+ laed8 laesy laev2 lahef lanhb lanhe lanhp lanht laqhb laqhe
+ laqhp larcm larnv lartg lascl laset lasr lassq pttrf rot spmv
+ spr stedc steqr symv syr ung2l ung2r ungbr unghr ungl2 unglq
+ ungql ungqr ungr2 ungrq ungtr unm2l unm2r unmbr unmhr unml2
+ unmlq unmql unmqr unmr2 unmr3 unmrq unmrz unmtr upgtr upmtr
+ ''' # [c|z]*.f
+ #######
+ sclaux = laux + ' econd ' # s*.f
+ dzlaux = laux + ' secnd ' # d*.f
+ slasrc = lasrc + sd_lasrc # s*.f
+ dlasrc = lasrc + sd_lasrc # d*.f
+ clasrc = lasrc + cz_lasrc + ' srot srscl ' # c*.f
+ zlasrc = lasrc + cz_lasrc + ' drot drscl ' # z*.f
+ oclasrc = ' icmax1 scsum1 ' # *.f
+ ozlasrc = ' izmax1 dzsum1 ' # *.f
+ sources = ['s%s.f'%f for f in (sclaux+slasrc).split()] \
+ + ['d%s.f'%f for f in (dzlaux+dlasrc).split()] \
+ + ['c%s.f'%f for f in (clasrc).split()] \
+ + ['z%s.f'%f for f in (zlasrc).split()] \
+ + ['%s.f'%f for f in (allaux+oclasrc+ozlasrc).split()]
+ sources = [os.path.join(src_dir,f) for f in sources]
+ #XXX: should we check here actual existence of source files?
+ info = {'sources':sources,'language':'f77'}
+ self.set_info(**info)
+
+atlas_version_c_text = r'''
+/* This file is generated from numpy/distutils/system_info.py */
+void ATL_buildinfo(void);
+int main(void) {
+ ATL_buildinfo();
+ return 0;
+}
+'''
+
+_cached_atlas_version = {}
+def get_atlas_version(**config):
+ libraries = config.get('libraries', [])
+ library_dirs = config.get('library_dirs', [])
+ key = (tuple(libraries), tuple(library_dirs))
+ if _cached_atlas_version.has_key(key):
+ return _cached_atlas_version[key]
+ c = cmd_config(Distribution())
+ atlas_version = None
+ try:
+ s, o = c.get_output(atlas_version_c_text,
+ libraries=libraries, library_dirs=library_dirs)
+ except: # failed to get version from file -- maybe on Windows
+ # look at directory name
+ for o in library_dirs:
+ m = re.search(r'ATLAS_(?P<version>\d+[.]\d+[.]\d+)_',o)
+ if m:
+ atlas_version = m.group('version')
+ if atlas_version is not None:
+ break
+ # final choice --- look at ATLAS_VERSION environment
+ # variable
+ if atlas_version is None:
+ atlas_version = os.environ.get('ATLAS_VERSION',None)
+ return atlas_version or '?.?.?'
+
+ if not s:
+ m = re.search(r'ATLAS version (?P<version>\d+[.]\d+[.]\d+)',o)
+ if m:
+ atlas_version = m.group('version')
+ if atlas_version is None:
+ if re.search(r'undefined symbol: ATL_buildinfo',o,re.M):
+ atlas_version = '3.2.1_pre3.3.6'
+ else:
+ log.info('Status: %d', s)
+ log.info('Output: %s', o)
+ _cached_atlas_version[key] = atlas_version
+ return atlas_version
+
+from distutils.util import get_platform
+
+class lapack_opt_info(system_info):
+
+ notfounderror = LapackNotFoundError
+
+ def calc_info(self):
+
+ if sys.platform=='darwin' and not os.environ.get('ATLAS',None):
+ args = []
+ link_args = []
+ if get_platform()[-4:] == 'i386':
+ intel = 1
+ else:
+ intel = 0
+ if os.path.exists('/System/Library/Frameworks/Accelerate.framework/'):
+ if intel:
+ args.extend(['-msse3'])
+ else:
+ args.extend(['-faltivec'])
+ link_args.extend(['-Wl,-framework','-Wl,Accelerate'])
+ elif os.path.exists('/System/Library/Frameworks/vecLib.framework/'):
+ if intel:
+ args.extend(['-msse3'])
+ else:
+ args.extend(['-faltivec'])
+ link_args.extend(['-Wl,-framework','-Wl,vecLib'])
+ if args:
+ self.set_info(extra_compile_args=args,
+ extra_link_args=link_args,
+ define_macros=[('NO_ATLAS_INFO',3)])
+ return
+
+ lapack_mkl_info = get_info('lapack_mkl')
+ if lapack_mkl_info:
+ self.set_info(**lapack_mkl_info)
+ return
+
+ atlas_info = get_info('atlas_threads')
+ if not atlas_info:
+ atlas_info = get_info('atlas')
+ #atlas_info = {} ## uncomment for testing
+ atlas_version = None
+ need_lapack = 0
+ need_blas = 0
+ info = {}
+ if atlas_info:
+ version_info = atlas_info.copy()
+ atlas_version = get_atlas_version(**version_info)
+ if not atlas_info.has_key('define_macros'):
+ atlas_info['define_macros'] = []
+ if atlas_version is None:
+ atlas_info['define_macros'].append(('NO_ATLAS_INFO',2))
+ else:
+ atlas_info['define_macros'].append(('ATLAS_INFO',
+ '"\\"%s\\""' % atlas_version))
+ if atlas_version=='3.2.1_pre3.3.6':
+ atlas_info['define_macros'].append(('NO_ATLAS_INFO',4))
+ l = atlas_info.get('define_macros',[])
+ if ('ATLAS_WITH_LAPACK_ATLAS',None) in l \
+ or ('ATLAS_WITHOUT_LAPACK',None) in l:
+ need_lapack = 1
+ info = atlas_info
+ else:
+ warnings.warn(AtlasNotFoundError.__doc__)
+ need_blas = 1
+ need_lapack = 1
+ dict_append(info,define_macros=[('NO_ATLAS_INFO',1)])
+
+ if need_lapack:
+ lapack_info = get_info('lapack')
+ #lapack_info = {} ## uncomment for testing
+ if lapack_info:
+ dict_append(info,**lapack_info)
+ else:
+ warnings.warn(LapackNotFoundError.__doc__)
+ lapack_src_info = get_info('lapack_src')
+ if not lapack_src_info:
+ warnings.warn(LapackSrcNotFoundError.__doc__)
+ return
+ dict_append(info,libraries=[('flapack_src',lapack_src_info)])
+
+ if need_blas:
+ blas_info = get_info('blas')
+ #blas_info = {} ## uncomment for testing
+ if blas_info:
+ dict_append(info,**blas_info)
+ else:
+ warnings.warn(BlasNotFoundError.__doc__)
+ blas_src_info = get_info('blas_src')
+ if not blas_src_info:
+ warnings.warn(BlasSrcNotFoundError.__doc__)
+ return
+ dict_append(info,libraries=[('fblas_src',blas_src_info)])
+
+ self.set_info(**info)
+ return
+
+
+class blas_opt_info(system_info):
+
+ notfounderror = BlasNotFoundError
+
+ def calc_info(self):
+
+ if sys.platform=='darwin' and not os.environ.get('ATLAS',None):
+ args = []
+ link_args = []
+ if get_platform()[-4:] == 'i386':
+ intel = 1
+ else:
+ intel = 0
+ if os.path.exists('/System/Library/Frameworks/Accelerate.framework/'):
+ if intel:
+ args.extend(['-msse3'])
+ else:
+ args.extend(['-faltivec'])
+ args.extend([
+ '-I/System/Library/Frameworks/vecLib.framework/Headers'])
+ link_args.extend(['-Wl,-framework','-Wl,Accelerate'])
+ elif os.path.exists('/System/Library/Frameworks/vecLib.framework/'):
+ if intel:
+ args.extend(['-msse3'])
+ else:
+ args.extend(['-faltivec'])
+ args.extend([
+ '-I/System/Library/Frameworks/vecLib.framework/Headers'])
+ link_args.extend(['-Wl,-framework','-Wl,vecLib'])
+ if args:
+ self.set_info(extra_compile_args=args,
+ extra_link_args=link_args,
+ define_macros=[('NO_ATLAS_INFO',3)])
+ return
+
+ blas_mkl_info = get_info('blas_mkl')
+ if blas_mkl_info:
+ self.set_info(**blas_mkl_info)
+ return
+
+ atlas_info = get_info('atlas_blas_threads')
+ if not atlas_info:
+ atlas_info = get_info('atlas_blas')
+ atlas_version = None
+ need_blas = 0
+ info = {}
+ if atlas_info:
+ version_info = atlas_info.copy()
+ atlas_version = get_atlas_version(**version_info)
+ if not atlas_info.has_key('define_macros'):
+ atlas_info['define_macros'] = []
+ if atlas_version is None:
+ atlas_info['define_macros'].append(('NO_ATLAS_INFO',2))
+ else:
+ atlas_info['define_macros'].append(('ATLAS_INFO',
+ '"\\"%s\\""' % atlas_version))
+ info = atlas_info
+ else:
+ warnings.warn(AtlasNotFoundError.__doc__)
+ need_blas = 1
+ dict_append(info,define_macros=[('NO_ATLAS_INFO',1)])
+
+ if need_blas:
+ blas_info = get_info('blas')
+ if blas_info:
+ dict_append(info,**blas_info)
+ else:
+ warnings.warn(BlasNotFoundError.__doc__)
+ blas_src_info = get_info('blas_src')
+ if not blas_src_info:
+ warnings.warn(BlasSrcNotFoundError.__doc__)
+ return
+ dict_append(info,libraries=[('fblas_src',blas_src_info)])
+
+ self.set_info(**info)
+ return
+
+
+class blas_info(system_info):
+ section = 'blas'
+ dir_env_var = 'BLAS'
+ _lib_names = ['blas']
+ notfounderror = BlasNotFoundError
+
+ def calc_info(self):
+ lib_dirs = self.get_lib_dirs()
+
+ blas_libs = self.get_libs('blas_libs', self._lib_names)
+ for d in lib_dirs:
+ blas = self.check_libs(d,blas_libs,[])
+ if blas is not None:
+ info = blas
+ break
+ else:
+ return
+ info['language'] = 'f77' # XXX: is it generally true?
+ self.set_info(**info)
+
+
+class blas_src_info(system_info):
+ section = 'blas_src'
+ dir_env_var = 'BLAS_SRC'
+ notfounderror = BlasSrcNotFoundError
+
+ def get_paths(self, section, key):
+ pre_dirs = system_info.get_paths(self, section, key)
+ dirs = []
+ for d in pre_dirs:
+ dirs.extend([d] + self.combine_paths(d,['blas']))
+ return [ d for d in dirs if os.path.isdir(d) ]
+
+ def calc_info(self):
+ src_dirs = self.get_src_dirs()
+ src_dir = ''
+ for d in src_dirs:
+ if os.path.isfile(os.path.join(d,'daxpy.f')):
+ src_dir = d
+ break
+ if not src_dir:
+ #XXX: Get sources from netlib. May be ask first.
+ return
+ blas1 = '''
+ caxpy csscal dnrm2 dzasum saxpy srotg zdotc ccopy cswap drot
+ dznrm2 scasum srotm zdotu cdotc dasum drotg icamax scnrm2
+ srotmg zdrot cdotu daxpy drotm idamax scopy sscal zdscal crotg
+ dcabs1 drotmg isamax sdot sswap zrotg cscal dcopy dscal izamax
+ snrm2 zaxpy zscal csrot ddot dswap sasum srot zcopy zswap
+ '''
+ blas2 = '''
+ cgbmv chpmv ctrsv dsymv dtrsv sspr2 strmv zhemv ztpmv cgemv
+ chpr dgbmv dsyr lsame ssymv strsv zher ztpsv cgerc chpr2 dgemv
+ dsyr2 sgbmv ssyr xerbla zher2 ztrmv cgeru ctbmv dger dtbmv
+ sgemv ssyr2 zgbmv zhpmv ztrsv chbmv ctbsv dsbmv dtbsv sger
+ stbmv zgemv zhpr chemv ctpmv dspmv dtpmv ssbmv stbsv zgerc
+ zhpr2 cher ctpsv dspr dtpsv sspmv stpmv zgeru ztbmv cher2
+ ctrmv dspr2 dtrmv sspr stpsv zhbmv ztbsv
+ '''
+ blas3 = '''
+ cgemm csymm ctrsm dsyrk sgemm strmm zhemm zsyr2k chemm csyr2k
+ dgemm dtrmm ssymm strsm zher2k zsyrk cher2k csyrk dsymm dtrsm
+ ssyr2k zherk ztrmm cherk ctrmm dsyr2k ssyrk zgemm zsymm ztrsm
+ '''
+ sources = [os.path.join(src_dir,f+'.f') \
+ for f in (blas1+blas2+blas3).split()]
+ #XXX: should we check here actual existence of source files?
+ info = {'sources':sources,'language':'f77'}
+ self.set_info(**info)
+
+class x11_info(system_info):
+ section = 'x11'
+ notfounderror = X11NotFoundError
+
+ def __init__(self):
+ system_info.__init__(self,
+ default_lib_dirs=default_x11_lib_dirs,
+ default_include_dirs=default_x11_include_dirs)
+
+ def calc_info(self):
+ if sys.platform in ['win32']:
+ return
+ lib_dirs = self.get_lib_dirs()
+ include_dirs = self.get_include_dirs()
+ x11_libs = self.get_libs('x11_libs', ['X11'])
+ for lib_dir in lib_dirs:
+ info = self.check_libs(lib_dir, x11_libs, [])
+ if info is not None:
+ break
+ else:
+ return
+ inc_dir = None
+ for d in include_dirs:
+ if self.combine_paths(d, 'X11/X.h'):
+ inc_dir = d
+ break
+ if inc_dir is not None:
+ dict_append(info, include_dirs=[inc_dir])
+ self.set_info(**info)
+
+class _numpy_info(system_info):
+ section = 'Numeric'
+ modulename = 'Numeric'
+ notfounderror = NumericNotFoundError
+
+ def __init__(self):
+ include_dirs = []
+ try:
+ module = __import__(self.modulename)
+ prefix = []
+ for name in module.__file__.split(os.sep):
+ if name=='lib':
+ break
+ prefix.append(name)
+ include_dirs.append(distutils.sysconfig.get_python_inc(
+ prefix=os.sep.join(prefix)))
+ except ImportError:
+ pass
+ py_incl_dir = distutils.sysconfig.get_python_inc()
+ include_dirs.append(py_incl_dir)
+ for d in default_include_dirs:
+ d = os.path.join(d, os.path.basename(py_incl_dir))
+ if d not in include_dirs:
+ include_dirs.append(d)
+ system_info.__init__(self,
+ default_lib_dirs=[],
+ default_include_dirs=include_dirs)
+
+ def calc_info(self):
+ try:
+ module = __import__(self.modulename)
+ except ImportError:
+ return
+ info = {}
+ macros = []
+ for v in ['__version__','version']:
+ vrs = getattr(module,v,None)
+ if vrs is None:
+ continue
+ macros = [(self.modulename.upper()+'_VERSION',
+ '"\\"%s\\""' % (vrs)),
+ (self.modulename.upper(),None)]
+ break
+## try:
+## macros.append(
+## (self.modulename.upper()+'_VERSION_HEX',
+## hex(vstr2hex(module.__version__))),
+## )
+## except Exception,msg:
+## print msg
+ dict_append(info, define_macros = macros)
+ include_dirs = self.get_include_dirs()
+ inc_dir = None
+ for d in include_dirs:
+ if self.combine_paths(d,
+ os.path.join(self.modulename,
+ 'arrayobject.h')):
+ inc_dir = d
+ break
+ if inc_dir is not None:
+ dict_append(info, include_dirs=[inc_dir])
+ if info:
+ self.set_info(**info)
+ return
+
+class numarray_info(_numpy_info):
+ section = 'numarray'
+ modulename = 'numarray'
+
+class Numeric_info(_numpy_info):
+ section = 'Numeric'
+ modulename = 'Numeric'
+
+class numpy_info(_numpy_info):
+ section = 'numpy'
+ modulename = 'numpy'
+
+class numerix_info(system_info):
+ section = 'numerix'
+ def calc_info(self):
+ which = None, None
+ if os.getenv("NUMERIX"):
+ which = os.getenv("NUMERIX"), "environment var"
+ # If all the above fail, default to numpy.
+ if which[0] is None:
+ which = "numpy", "defaulted"
+ try:
+ import numpy
+ which = "numpy", "defaulted"
+ except ImportError,msg1:
+ try:
+ import Numeric
+ which = "numeric", "defaulted"
+ except ImportError,msg2:
+ try:
+ import numarray
+ which = "numarray", "defaulted"
+ except ImportError,msg3:
+ log.info(msg1)
+ log.info(msg2)
+ log.info(msg3)
+ which = which[0].strip().lower(), which[1]
+ if which[0] not in ["numeric", "numarray", "numpy"]:
+ raise ValueError("numerix selector must be either 'Numeric' "
+ "or 'numarray' or 'numpy' but the value obtained"
+ " from the %s was '%s'." % (which[1], which[0]))
+ os.environ['NUMERIX'] = which[0]
+ self.set_info(**get_info(which[0]))
+
+class f2py_info(system_info):
+ def calc_info(self):
+ try:
+ import numpy.f2py as f2py
+ except ImportError:
+ return
+ f2py_dir = os.path.join(os.path.dirname(f2py.__file__),'src')
+ self.set_info(sources = [os.path.join(f2py_dir,'fortranobject.c')],
+ include_dirs = [f2py_dir])
+ return
+
+class boost_python_info(system_info):
+ section = 'boost_python'
+ dir_env_var = 'BOOST'
+
+ def get_paths(self, section, key):
+ pre_dirs = system_info.get_paths(self, section, key)
+ dirs = []
+ for d in pre_dirs:
+ dirs.extend([d] + self.combine_paths(d,['boost*']))
+ return [ d for d in dirs if os.path.isdir(d) ]
+
+ def calc_info(self):
+ src_dirs = self.get_src_dirs()
+ src_dir = ''
+ for d in src_dirs:
+ if os.path.isfile(os.path.join(d,'libs','python','src','module.cpp')):
+ src_dir = d
+ break
+ if not src_dir:
+ return
+ py_incl_dir = distutils.sysconfig.get_python_inc()
+ srcs_dir = os.path.join(src_dir,'libs','python','src')
+ bpl_srcs = glob(os.path.join(srcs_dir,'*.cpp'))
+ bpl_srcs += glob(os.path.join(srcs_dir,'*','*.cpp'))
+ info = {'libraries':[('boost_python_src',{'include_dirs':[src_dir,py_incl_dir],
+ 'sources':bpl_srcs})],
+ 'include_dirs':[src_dir],
+ }
+ if info:
+ self.set_info(**info)
+ return
+
+class agg2_info(system_info):
+ section = 'agg2'
+ dir_env_var = 'AGG2'
+
+ def get_paths(self, section, key):
+ pre_dirs = system_info.get_paths(self, section, key)
+ dirs = []
+ for d in pre_dirs:
+ dirs.extend([d] + self.combine_paths(d,['agg2*']))
+ return [ d for d in dirs if os.path.isdir(d) ]
+
+ def calc_info(self):
+ src_dirs = self.get_src_dirs()
+ src_dir = ''
+ for d in src_dirs:
+ if os.path.isfile(os.path.join(d,'src','agg_affine_matrix.cpp')):
+ src_dir = d
+ break
+ if not src_dir:
+ return
+ if sys.platform=='win32':
+ agg2_srcs = glob(os.path.join(src_dir,'src','platform','win32','agg_win32_bmp.cpp'))
+ else:
+ agg2_srcs = glob(os.path.join(src_dir,'src','*.cpp'))
+ agg2_srcs += [os.path.join(src_dir,'src','platform','X11','agg_platform_support.cpp')]
+
+ info = {'libraries':[('agg2_src',{'sources':agg2_srcs,
+ 'include_dirs':[os.path.join(src_dir,'include')],
+ })],
+ 'include_dirs':[os.path.join(src_dir,'include')],
+ }
+ if info:
+ self.set_info(**info)
+ return
+
+class _pkg_config_info(system_info):
+ section = None
+ config_env_var = 'PKG_CONFIG'
+ default_config_exe = 'pkg-config'
+ append_config_exe = ''
+ version_macro_name = None
+ release_macro_name = None
+ version_flag = '--modversion'
+ cflags_flag = '--cflags'
+
+ def get_config_exe(self):
+ if os.environ.has_key(self.config_env_var):
+ return os.environ[self.config_env_var]
+ return self.default_config_exe
+ def get_config_output(self, config_exe, option):
+ s,o = exec_command(config_exe+' '+self.append_config_exe+' '+option,use_tee=0)
+ if not s:
+ return o
+
+ def calc_info(self):
+ config_exe = find_executable(self.get_config_exe())
+ if not config_exe:
+ log.warn('File not found: %s. Cannot determine %s info.' \
+ % (config_exe, self.section))
+ return
+ info = {}
+ macros = []
+ libraries = []
+ library_dirs = []
+ include_dirs = []
+ extra_link_args = []
+ extra_compile_args = []
+ version = self.get_config_output(config_exe,self.version_flag)
+ if version:
+ macros.append((self.__class__.__name__.split('.')[-1].upper(),
+ '"\\"%s\\""' % (version)))
+ if self.version_macro_name:
+ macros.append((self.version_macro_name+'_%s' % (version.replace('.','_')),None))
+ if self.release_macro_name:
+ release = self.get_config_output(config_exe,'--release')
+ if release:
+ macros.append((self.release_macro_name+'_%s' % (release.replace('.','_')),None))
+ opts = self.get_config_output(config_exe,'--libs')
+ if opts:
+ for opt in opts.split():
+ if opt[:2]=='-l':
+ libraries.append(opt[2:])
+ elif opt[:2]=='-L':
+ library_dirs.append(opt[2:])
+ else:
+ extra_link_args.append(opt)
+ opts = self.get_config_output(config_exe,self.cflags_flag)
+ if opts:
+ for opt in opts.split():
+ if opt[:2]=='-I':
+ include_dirs.append(opt[2:])
+ elif opt[:2]=='-D':
+ if '=' in opt:
+ n,v = opt[2:].split('=')
+ macros.append((n,v))
+ else:
+ macros.append((opt[2:],None))
+ else:
+ extra_compile_args.append(opt)
+ if macros: dict_append(info, define_macros = macros)
+ if libraries: dict_append(info, libraries = libraries)
+ if library_dirs: dict_append(info, library_dirs = library_dirs)
+ if include_dirs: dict_append(info, include_dirs = include_dirs)
+ if extra_link_args: dict_append(info, extra_link_args = extra_link_args)
+ if extra_compile_args: dict_append(info, extra_compile_args = extra_compile_args)
+ if info:
+ self.set_info(**info)
+ return
+
+class wx_info(_pkg_config_info):
+ section = 'wx'
+ config_env_var = 'WX_CONFIG'
+ default_config_exe = 'wx-config'
+ append_config_exe = ''
+ version_macro_name = 'WX_VERSION'
+ release_macro_name = 'WX_RELEASE'
+ version_flag = '--version'
+ cflags_flag = '--cxxflags'
+
+class gdk_pixbuf_xlib_2_info(_pkg_config_info):
+ section = 'gdk_pixbuf_xlib_2'
+ append_config_exe = 'gdk-pixbuf-xlib-2.0'
+ version_macro_name = 'GDK_PIXBUF_XLIB_VERSION'
+
+class gdk_pixbuf_2_info(_pkg_config_info):
+ section = 'gdk_pixbuf_2'
+ append_config_exe = 'gdk-pixbuf-2.0'
+ version_macro_name = 'GDK_PIXBUF_VERSION'
+
+class gdk_x11_2_info(_pkg_config_info):
+ section = 'gdk_x11_2'
+ append_config_exe = 'gdk-x11-2.0'
+ version_macro_name = 'GDK_X11_VERSION'
+
+class gdk_2_info(_pkg_config_info):
+ section = 'gdk_2'
+ append_config_exe = 'gdk-2.0'
+ version_macro_name = 'GDK_VERSION'
+
+class gdk_info(_pkg_config_info):
+ section = 'gdk'
+ append_config_exe = 'gdk'
+ version_macro_name = 'GDK_VERSION'
+
+class gtkp_x11_2_info(_pkg_config_info):
+ section = 'gtkp_x11_2'
+ append_config_exe = 'gtk+-x11-2.0'
+ version_macro_name = 'GTK_X11_VERSION'
+
+
+class gtkp_2_info(_pkg_config_info):
+ section = 'gtkp_2'
+ append_config_exe = 'gtk+-2.0'
+ version_macro_name = 'GTK_VERSION'
+
+class xft_info(_pkg_config_info):
+ section = 'xft'
+ append_config_exe = 'xft'
+ version_macro_name = 'XFT_VERSION'
+
+class freetype2_info(_pkg_config_info):
+ section = 'freetype2'
+ append_config_exe = 'freetype2'
+ version_macro_name = 'FREETYPE2_VERSION'
+
+class amd_info(system_info):
+ section = 'amd'
+ dir_env_var = 'AMD'
+ _lib_names = ['amd']
+
+ def calc_info(self):
+ lib_dirs = self.get_lib_dirs()
+
+ amd_libs = self.get_libs('amd_libs', self._lib_names)
+ for d in lib_dirs:
+ amd = self.check_libs(d,amd_libs,[])
+ if amd is not None:
+ info = amd
+ break
+ else:
+ return
+
+ include_dirs = self.get_include_dirs()
+
+ inc_dir = None
+ for d in include_dirs:
+ p = self.combine_paths(d,'amd.h')
+ if p:
+ inc_dir = os.path.dirname(p[0])
+ break
+ if inc_dir is not None:
+ dict_append(info, include_dirs=[inc_dir],
+ define_macros=[('SCIPY_AMD_H',None)],
+ swig_opts = ['-I' + inc_dir])
+
+ self.set_info(**info)
+ return
+
+class umfpack_info(system_info):
+ section = 'umfpack'
+ dir_env_var = 'UMFPACK'
+ notfounderror = UmfpackNotFoundError
+ _lib_names = ['umfpack']
+
+ def calc_info(self):
+ lib_dirs = self.get_lib_dirs()
+
+ umfpack_libs = self.get_libs('umfpack_libs', self._lib_names)
+ for d in lib_dirs:
+ umf = self.check_libs(d,umfpack_libs,[])
+ if umf is not None:
+ info = umf
+ break
+ else:
+ return
+
+ include_dirs = self.get_include_dirs()
+
+ inc_dir = None
+ for d in include_dirs:
+ p = self.combine_paths(d,['','umfpack'],'umfpack.h')
+ if p:
+ inc_dir = os.path.dirname(p[0])
+ break
+ if inc_dir is not None:
+ dict_append(info, include_dirs=[inc_dir],
+ define_macros=[('SCIPY_UMFPACK_H',None)],
+ swig_opts = ['-I' + inc_dir])
+
+ amd = get_info('amd')
+ dict_append(info, **get_info('amd'))
+
+ self.set_info(**info)
+ return
+
+## def vstr2hex(version):
+## bits = []
+## n = [24,16,8,4,0]
+## r = 0
+## for s in version.split('.'):
+## r |= int(s) << n[0]
+## del n[0]
+## return r
+
+#--------------------------------------------------------------------
+
+def combine_paths(*args,**kws):
+ """ Return a list of existing paths composed by all combinations of
+ items from arguments.
+ """
+ r = []
+ for a in args:
+ if not a: continue
+ if is_string(a):
+ a = [a]
+ r.append(a)
+ args = r
+ if not args: return []
+ if len(args)==1:
+ result = reduce(lambda a,b:a+b,map(glob,args[0]),[])
+ elif len (args)==2:
+ result = []
+ for a0 in args[0]:
+ for a1 in args[1]:
+ result.extend(glob(os.path.join(a0,a1)))
+ else:
+ result = combine_paths(*(combine_paths(args[0],args[1])+args[2:]))
+ verbosity = kws.get('verbosity',1)
+ log.debug('(paths: %s)', ','.join(result))
+ return result
+
+language_map = {'c':0,'c++':1,'f77':2,'f90':3}
+inv_language_map = {0:'c',1:'c++',2:'f77',3:'f90'}
+def dict_append(d,**kws):
+ languages = []
+ for k,v in kws.items():
+ if k=='language':
+ languages.append(v)
+ continue
+ if d.has_key(k):
+ if k in ['library_dirs','include_dirs','define_macros']:
+ [d[k].append(vv) for vv in v if vv not in d[k]]
+ else:
+ d[k].extend(v)
+ else:
+ d[k] = v
+ if languages:
+ l = inv_language_map[max([language_map.get(l,0) for l in languages])]
+ d['language'] = l
+ return
+
+def parseCmdLine(argv=(None,)):
+ import optparse
+ parser = optparse.OptionParser("usage: %prog [-v] [info objs]")
+ parser.add_option('-v', '--verbose', action='store_true', dest='verbose',
+ default=False,
+ help='be verbose and print more messages')
+
+ opts, args = parser.parse_args(args=argv[1:])
+ return opts, args
+
+def show_all(argv=None):
+ import inspect
+ if argv is None:
+ argv = sys.argv
+ opts, args = parseCmdLine(argv)
+ if opts.verbose:
+ log.set_threshold(log.DEBUG)
+ else:
+ log.set_threshold(log.INFO)
+ show_only = []
+ for n in args:
+ if n[-5:] != '_info':
+ n = n + '_info'
+ show_only.append(n)
+ show_all = not show_only
+ _gdict_ = globals().copy()
+ for name, c in _gdict_.iteritems():
+ if not inspect.isclass(c):
+ continue
+ if not issubclass(c, system_info) or c is system_info:
+ continue
+ if not show_all:
+ if name not in show_only:
+ continue
+ del show_only[show_only.index(name)]
+ conf = c()
+ conf.verbosity = 2
+ r = conf.get_info()
+ if show_only:
+ log.info('Info classes not defined: %s',','.join(show_only))
+
+if __name__ == "__main__":
+ show_all()
diff --git a/numpy/distutils/tests/f2py_ext/__init__.py b/numpy/distutils/tests/f2py_ext/__init__.py
new file mode 100644
index 000000000..e69de29bb
--- /dev/null
+++ b/numpy/distutils/tests/f2py_ext/__init__.py
diff --git a/numpy/distutils/tests/f2py_ext/setup.py b/numpy/distutils/tests/f2py_ext/setup.py
new file mode 100644
index 000000000..e3dfddb74
--- /dev/null
+++ b/numpy/distutils/tests/f2py_ext/setup.py
@@ -0,0 +1,11 @@
+#!/usr/bin/env python
+def configuration(parent_package='',top_path=None):
+ from numpy.distutils.misc_util import Configuration
+ config = Configuration('f2py_ext',parent_package,top_path)
+ config.add_extension('fib2', ['src/fib2.pyf','src/fib1.f'])
+ config.add_data_dir('tests')
+ return config
+
+if __name__ == "__main__":
+ from numpy.distutils.core import setup
+ setup(configuration=configuration)
diff --git a/numpy/distutils/tests/f2py_ext/src/fib1.f b/numpy/distutils/tests/f2py_ext/src/fib1.f
new file mode 100644
index 000000000..cfbb1eea0
--- /dev/null
+++ b/numpy/distutils/tests/f2py_ext/src/fib1.f
@@ -0,0 +1,18 @@
+C FILE: FIB1.F
+ SUBROUTINE FIB(A,N)
+C
+C CALCULATE FIRST N FIBONACCI NUMBERS
+C
+ INTEGER N
+ REAL*8 A(N)
+ DO I=1,N
+ IF (I.EQ.1) THEN
+ A(I) = 0.0D0
+ ELSEIF (I.EQ.2) THEN
+ A(I) = 1.0D0
+ ELSE
+ A(I) = A(I-1) + A(I-2)
+ ENDIF
+ ENDDO
+ END
+C END FILE FIB1.F
diff --git a/numpy/distutils/tests/f2py_ext/src/fib2.pyf b/numpy/distutils/tests/f2py_ext/src/fib2.pyf
new file mode 100644
index 000000000..90a8cf00c
--- /dev/null
+++ b/numpy/distutils/tests/f2py_ext/src/fib2.pyf
@@ -0,0 +1,9 @@
+! -*- f90 -*-
+python module fib2
+ interface
+ subroutine fib(a,n)
+ real*8 dimension(n),intent(out),depend(n) :: a
+ integer intent(in) :: n
+ end subroutine fib
+ end interface
+end python module fib2
diff --git a/numpy/distutils/tests/f2py_ext/tests/test_fib2.py b/numpy/distutils/tests/f2py_ext/tests/test_fib2.py
new file mode 100644
index 000000000..cbb0498d2
--- /dev/null
+++ b/numpy/distutils/tests/f2py_ext/tests/test_fib2.py
@@ -0,0 +1,13 @@
+import sys
+from numpy.testing import *
+set_package_path()
+from f2py_ext import fib2
+del sys.path[0]
+
+class test_fib2(NumpyTestCase):
+
+ def check_fib(self):
+ assert_array_equal(fib2.fib(6),[0,1,1,2,3,5])
+
+if __name__ == "__main__":
+ NumpyTest(fib2).run()
diff --git a/numpy/distutils/tests/f2py_f90_ext/__init__.py b/numpy/distutils/tests/f2py_f90_ext/__init__.py
new file mode 100644
index 000000000..e69de29bb
--- /dev/null
+++ b/numpy/distutils/tests/f2py_f90_ext/__init__.py
diff --git a/numpy/distutils/tests/f2py_f90_ext/include/body.f90 b/numpy/distutils/tests/f2py_f90_ext/include/body.f90
new file mode 100644
index 000000000..90b44e29d
--- /dev/null
+++ b/numpy/distutils/tests/f2py_f90_ext/include/body.f90
@@ -0,0 +1,5 @@
+ subroutine bar13(a)
+ !f2py intent(out) a
+ integer a
+ a = 13
+ end subroutine bar13
diff --git a/numpy/distutils/tests/f2py_f90_ext/setup.py b/numpy/distutils/tests/f2py_f90_ext/setup.py
new file mode 100644
index 000000000..ee56cc3a6
--- /dev/null
+++ b/numpy/distutils/tests/f2py_f90_ext/setup.py
@@ -0,0 +1,16 @@
+#!/usr/bin/env python
+def configuration(parent_package='',top_path=None):
+ from numpy.distutils.misc_util import Configuration
+ config = Configuration('f2py_f90_ext',parent_package,top_path)
+ config.add_extension('foo',
+ ['src/foo_free.f90'],
+ include_dirs=['include'],
+ f2py_options=['--include_paths',
+ config.paths('include')[0]]
+ )
+ config.add_data_dir('tests')
+ return config
+
+if __name__ == "__main__":
+ from numpy.distutils.core import setup
+ setup(configuration=configuration)
diff --git a/numpy/distutils/tests/f2py_f90_ext/src/foo_free.f90 b/numpy/distutils/tests/f2py_f90_ext/src/foo_free.f90
new file mode 100644
index 000000000..c7713be59
--- /dev/null
+++ b/numpy/distutils/tests/f2py_f90_ext/src/foo_free.f90
@@ -0,0 +1,6 @@
+module foo_free
+contains
+
+include "body.f90"
+
+end module foo_free
diff --git a/numpy/distutils/tests/f2py_f90_ext/tests/test_foo.py b/numpy/distutils/tests/f2py_f90_ext/tests/test_foo.py
new file mode 100644
index 000000000..da52c8aff
--- /dev/null
+++ b/numpy/distutils/tests/f2py_f90_ext/tests/test_foo.py
@@ -0,0 +1,13 @@
+import sys
+from numpy.testing import *
+set_package_path()
+from f2py_f90_ext import foo
+del sys.path[0]
+
+class test_foo(NumpyTestCase):
+
+ def check_foo_free(self):
+ assert_equal(foo.foo_free.bar13(),13)
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/distutils/tests/gen_ext/__init__.py b/numpy/distutils/tests/gen_ext/__init__.py
new file mode 100644
index 000000000..e69de29bb
--- /dev/null
+++ b/numpy/distutils/tests/gen_ext/__init__.py
diff --git a/numpy/distutils/tests/gen_ext/setup.py b/numpy/distutils/tests/gen_ext/setup.py
new file mode 100644
index 000000000..bf029062c
--- /dev/null
+++ b/numpy/distutils/tests/gen_ext/setup.py
@@ -0,0 +1,47 @@
+#!/usr/bin/env python
+
+fib3_f = '''
+C FILE: FIB3.F
+ SUBROUTINE FIB(A,N)
+C
+C CALCULATE FIRST N FIBONACCI NUMBERS
+C
+ INTEGER N
+ REAL*8 A(N)
+Cf2py intent(in) n
+Cf2py intent(out) a
+Cf2py depend(n) a
+ DO I=1,N
+ IF (I.EQ.1) THEN
+ A(I) = 0.0D0
+ ELSEIF (I.EQ.2) THEN
+ A(I) = 1.0D0
+ ELSE
+ A(I) = A(I-1) + A(I-2)
+ ENDIF
+ ENDDO
+ END
+C END FILE FIB3.F
+'''
+
+def source_func(ext, build_dir):
+ import os
+ from distutils.dep_util import newer
+ target = os.path.join(build_dir,'fib3.f')
+ if newer(__file__, target):
+ f = open(target,'w')
+ f.write(fib3_f)
+ f.close()
+ return [target]
+
+def configuration(parent_package='',top_path=None):
+ from numpy.distutils.misc_util import Configuration
+ config = Configuration('gen_ext',parent_package,top_path)
+ config.add_extension('fib3',
+ [source_func]
+ )
+ return config
+
+if __name__ == "__main__":
+ from numpy.distutils.core import setup
+ setup(configuration=configuration)
diff --git a/numpy/distutils/tests/gen_ext/tests/test_fib3.py b/numpy/distutils/tests/gen_ext/tests/test_fib3.py
new file mode 100644
index 000000000..e1c1ff070
--- /dev/null
+++ b/numpy/distutils/tests/gen_ext/tests/test_fib3.py
@@ -0,0 +1,13 @@
+import sys
+from numpy.testing import *
+set_package_path()
+from gen_ext import fib3
+del sys.path[0]
+
+class test_fib3(NumpyTestCase):
+
+ def check_fib(self):
+ assert_array_equal(fib3.fib(6),[0,1,1,2,3,5])
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/distutils/tests/pyrex_ext/__init__.py b/numpy/distutils/tests/pyrex_ext/__init__.py
new file mode 100644
index 000000000..e69de29bb
--- /dev/null
+++ b/numpy/distutils/tests/pyrex_ext/__init__.py
diff --git a/numpy/distutils/tests/pyrex_ext/primes.pyx b/numpy/distutils/tests/pyrex_ext/primes.pyx
new file mode 100644
index 000000000..2ada0c5a0
--- /dev/null
+++ b/numpy/distutils/tests/pyrex_ext/primes.pyx
@@ -0,0 +1,22 @@
+#
+# Calculate prime numbers
+#
+
+def primes(int kmax):
+ cdef int n, k, i
+ cdef int p[1000]
+ result = []
+ if kmax > 1000:
+ kmax = 1000
+ k = 0
+ n = 2
+ while k < kmax:
+ i = 0
+ while i < k and n % p[i] <> 0:
+ i = i + 1
+ if i == k:
+ p[k] = n
+ k = k + 1
+ result.append(n)
+ n = n + 1
+ return result
diff --git a/numpy/distutils/tests/pyrex_ext/setup.py b/numpy/distutils/tests/pyrex_ext/setup.py
new file mode 100644
index 000000000..5b348b916
--- /dev/null
+++ b/numpy/distutils/tests/pyrex_ext/setup.py
@@ -0,0 +1,12 @@
+#!/usr/bin/env python
+def configuration(parent_package='',top_path=None):
+ from numpy.distutils.misc_util import Configuration
+ config = Configuration('pyrex_ext',parent_package,top_path)
+ config.add_extension('primes',
+ ['primes.pyx'])
+ config.add_data_dir('tests')
+ return config
+
+if __name__ == "__main__":
+ from numpy.distutils.core import setup
+ setup(configuration=configuration)
diff --git a/numpy/distutils/tests/pyrex_ext/tests/test_primes.py b/numpy/distutils/tests/pyrex_ext/tests/test_primes.py
new file mode 100644
index 000000000..bb1e4c332
--- /dev/null
+++ b/numpy/distutils/tests/pyrex_ext/tests/test_primes.py
@@ -0,0 +1,13 @@
+import sys
+from numpy.testing import *
+
+set_package_path()
+from pyrex_ext.primes import primes
+restore_path()
+
+class test_primes(NumpyTestCase):
+ def check_simple(self, level=1):
+ l = primes(10)
+ assert_equal(l, [2, 3, 5, 7, 11, 13, 17, 19, 23, 29])
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/distutils/tests/setup.py b/numpy/distutils/tests/setup.py
new file mode 100644
index 000000000..89d73800e
--- /dev/null
+++ b/numpy/distutils/tests/setup.py
@@ -0,0 +1,14 @@
+#!/usr/bin/env python
+def configuration(parent_package='',top_path=None):
+ from numpy.distutils.misc_util import Configuration
+ config = Configuration('testnumpydistutils',parent_package,top_path)
+ config.add_subpackage('pyrex_ext')
+ config.add_subpackage('f2py_ext')
+ #config.add_subpackage('f2py_f90_ext')
+ config.add_subpackage('swig_ext')
+ config.add_subpackage('gen_ext')
+ return config
+
+if __name__ == "__main__":
+ from numpy.distutils.core import setup
+ setup(configuration=configuration)
diff --git a/numpy/distutils/tests/swig_ext/__init__.py b/numpy/distutils/tests/swig_ext/__init__.py
new file mode 100644
index 000000000..e69de29bb
--- /dev/null
+++ b/numpy/distutils/tests/swig_ext/__init__.py
diff --git a/numpy/distutils/tests/swig_ext/setup.py b/numpy/distutils/tests/swig_ext/setup.py
new file mode 100644
index 000000000..7f0dbe627
--- /dev/null
+++ b/numpy/distutils/tests/swig_ext/setup.py
@@ -0,0 +1,18 @@
+#!/usr/bin/env python
+def configuration(parent_package='',top_path=None):
+ from numpy.distutils.misc_util import Configuration
+ config = Configuration('swig_ext',parent_package,top_path)
+ config.add_extension('_example',
+ ['src/example.i','src/example.c']
+ )
+ config.add_extension('_example2',
+ ['src/zoo.i','src/zoo.cc'],
+ depends=['src/zoo.h'],
+ include_dirs=['src']
+ )
+ config.add_data_dir('tests')
+ return config
+
+if __name__ == "__main__":
+ from numpy.distutils.core import setup
+ setup(configuration=configuration)
diff --git a/numpy/distutils/tests/swig_ext/src/example.c b/numpy/distutils/tests/swig_ext/src/example.c
new file mode 100644
index 000000000..7bbb661dd
--- /dev/null
+++ b/numpy/distutils/tests/swig_ext/src/example.c
@@ -0,0 +1,14 @@
+/* File : example.c */
+
+double My_variable = 3.0;
+
+/* Compute factorial of n */
+int fact(int n) {
+ if (n <= 1) return 1;
+ else return n*fact(n-1);
+}
+
+/* Compute n mod m */
+int my_mod(int n, int m) {
+ return(n % m);
+}
diff --git a/numpy/distutils/tests/swig_ext/src/example.i b/numpy/distutils/tests/swig_ext/src/example.i
new file mode 100644
index 000000000..f4fc11e66
--- /dev/null
+++ b/numpy/distutils/tests/swig_ext/src/example.i
@@ -0,0 +1,14 @@
+/* -*- c -*- */
+
+/* File : example.i */
+%module example
+%{
+/* Put headers and other declarations here */
+extern double My_variable;
+extern int fact(int);
+extern int my_mod(int n, int m);
+%}
+
+extern double My_variable;
+extern int fact(int);
+extern int my_mod(int n, int m);
diff --git a/numpy/distutils/tests/swig_ext/src/zoo.cc b/numpy/distutils/tests/swig_ext/src/zoo.cc
new file mode 100644
index 000000000..0a643d1e5
--- /dev/null
+++ b/numpy/distutils/tests/swig_ext/src/zoo.cc
@@ -0,0 +1,23 @@
+#include "zoo.h"
+#include <cstdio>
+#include <cstring>
+
+Zoo::Zoo()
+{
+ n = 0;
+}
+
+void Zoo::shut_up(char *animal)
+{
+ if (n < 10) {
+ strcpy(animals[n], animal);
+ n++;
+ }
+}
+
+void Zoo::display()
+{
+ int i;
+ for(i = 0; i < n; i++)
+ printf("%s\n", animals[i]);
+}
diff --git a/numpy/distutils/tests/swig_ext/src/zoo.h b/numpy/distutils/tests/swig_ext/src/zoo.h
new file mode 100644
index 000000000..cb26e6cef
--- /dev/null
+++ b/numpy/distutils/tests/swig_ext/src/zoo.h
@@ -0,0 +1,9 @@
+
+class Zoo{
+ int n;
+ char animals[10][50];
+public:
+ Zoo();
+ void shut_up(char *animal);
+ void display();
+};
diff --git a/numpy/distutils/tests/swig_ext/src/zoo.i b/numpy/distutils/tests/swig_ext/src/zoo.i
new file mode 100644
index 000000000..a029c03e8
--- /dev/null
+++ b/numpy/distutils/tests/swig_ext/src/zoo.i
@@ -0,0 +1,10 @@
+// -*- c++ -*-
+// Example copied from http://linuxgazette.net/issue49/pramode.html
+
+%module example2
+
+%{
+#include "zoo.h"
+%}
+
+%include "zoo.h"
diff --git a/numpy/distutils/tests/swig_ext/tests/test_example.py b/numpy/distutils/tests/swig_ext/tests/test_example.py
new file mode 100644
index 000000000..71cb3d2c5
--- /dev/null
+++ b/numpy/distutils/tests/swig_ext/tests/test_example.py
@@ -0,0 +1,18 @@
+import sys
+from numpy.testing import *
+set_package_path()
+from swig_ext import example
+restore_path()
+
+class test_example(NumpyTestCase):
+
+ def check_fact(self):
+ assert_equal(example.fact(10),3628800)
+
+ def check_cvar(self):
+ assert_equal(example.cvar.My_variable,3.0)
+ example.cvar.My_variable = 5
+ assert_equal(example.cvar.My_variable,5.0)
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/distutils/tests/swig_ext/tests/test_example2.py b/numpy/distutils/tests/swig_ext/tests/test_example2.py
new file mode 100644
index 000000000..1d8e73a12
--- /dev/null
+++ b/numpy/distutils/tests/swig_ext/tests/test_example2.py
@@ -0,0 +1,17 @@
+import sys
+from numpy.testing import *
+set_package_path()
+from swig_ext import example2
+restore_path()
+
+class test_example2(NumpyTestCase):
+
+ def check_zoo(self):
+ z = example2.Zoo()
+ z.shut_up('Tiger')
+ z.shut_up('Lion')
+ z.display()
+
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/distutils/tests/test_fcompiler_gnu.py b/numpy/distutils/tests/test_fcompiler_gnu.py
new file mode 100644
index 000000000..c6ccea054
--- /dev/null
+++ b/numpy/distutils/tests/test_fcompiler_gnu.py
@@ -0,0 +1,52 @@
+from numpy.testing import *
+
+set_package_path()
+import numpy.distutils.fcompiler
+restore_path()
+
+g77_version_strings = [
+ ('GNU Fortran 0.5.25 20010319 (prerelease)', '0.5.25'),
+ ('GNU Fortran (GCC 3.2) 3.2 20020814 (release)', '3.2'),
+ ('GNU Fortran (GCC) 3.3.3 20040110 (prerelease) (Debian)', '3.3.3'),
+ ('GNU Fortran (GCC) 3.3.3 (Debian 20040401)', '3.3.3'),
+ ('GNU Fortran (GCC 3.2.2 20030222 (Red Hat Linux 3.2.2-5)) 3.2.2'
+ ' 20030222 (Red Hat Linux 3.2.2-5)', '3.2.2'),
+]
+
+gfortran_version_strings = [
+ ('GNU Fortran 95 (GCC 4.0.3 20051023 (prerelease) (Debian 4.0.2-3))',
+ '4.0.3'),
+ ('GNU Fortran 95 (GCC) 4.1.0', '4.1.0'),
+ ('GNU Fortran 95 (GCC) 4.2.0 20060218 (experimental)', '4.2.0'),
+ ('GNU Fortran (GCC) 4.3.0 20070316 (experimental)', '4.3.0'),
+]
+
+class test_g77_versions(NumpyTestCase):
+ def test_g77_version(self):
+ fc = numpy.distutils.fcompiler.new_fcompiler(compiler='gnu')
+ for vs, version in g77_version_strings:
+ v = fc.version_match(vs)
+ assert v == version, (vs, v)
+
+ def test_not_g77(self):
+ fc = numpy.distutils.fcompiler.new_fcompiler(compiler='gnu')
+ for vs, _ in gfortran_version_strings:
+ v = fc.version_match(vs)
+ assert v is None, (vs, v)
+
+class test_gortran_versions(NumpyTestCase):
+ def test_gfortran_version(self):
+ fc = numpy.distutils.fcompiler.new_fcompiler(compiler='gnu95')
+ for vs, version in gfortran_version_strings:
+ v = fc.version_match(vs)
+ assert v == version, (vs, v)
+
+ def test_not_gfortran(self):
+ fc = numpy.distutils.fcompiler.new_fcompiler(compiler='gnu95')
+ for vs, _ in g77_version_strings:
+ v = fc.version_match(vs)
+ assert v is None, (vs, v)
+
+
+if __name__ == '__main__':
+ NumpyTest.run()
diff --git a/numpy/distutils/tests/test_misc_util.py b/numpy/distutils/tests/test_misc_util.py
new file mode 100644
index 000000000..b75eb8cf2
--- /dev/null
+++ b/numpy/distutils/tests/test_misc_util.py
@@ -0,0 +1,60 @@
+#!/usr/bin/env python
+
+import os
+import sys
+from numpy.testing import *
+from numpy.distutils.misc_util import appendpath, minrelpath, gpaths, rel_path
+from os.path import join, sep
+
+ajoin = lambda *paths: join(*((sep,)+paths))
+
+class test_appendpath(NumpyTestCase):
+
+ def check_1(self):
+ assert_equal(appendpath('prefix','name'),join('prefix','name'))
+ assert_equal(appendpath('/prefix','name'),ajoin('prefix','name'))
+ assert_equal(appendpath('/prefix','/name'),ajoin('prefix','name'))
+ assert_equal(appendpath('prefix','/name'),join('prefix','name'))
+
+ def check_2(self):
+ assert_equal(appendpath('prefix/sub','name'),
+ join('prefix','sub','name'))
+ assert_equal(appendpath('prefix/sub','sup/name'),
+ join('prefix','sub','sup','name'))
+ assert_equal(appendpath('/prefix/sub','/prefix/name'),
+ ajoin('prefix','sub','name'))
+
+ def check_3(self):
+ assert_equal(appendpath('/prefix/sub','/prefix/sup/name'),
+ ajoin('prefix','sub','sup','name'))
+ assert_equal(appendpath('/prefix/sub/sub2','/prefix/sup/sup2/name'),
+ ajoin('prefix','sub','sub2','sup','sup2','name'))
+ assert_equal(appendpath('/prefix/sub/sub2','/prefix/sub/sup/name'),
+ ajoin('prefix','sub','sub2','sup','name'))
+
+class test_minrelpath(NumpyTestCase):
+
+ def check_1(self):
+ import os
+ n = lambda path: path.replace('/',os.path.sep)
+ assert_equal(minrelpath(n('aa/bb')),n('aa/bb'))
+ assert_equal(minrelpath('..'),'..')
+ assert_equal(minrelpath(n('aa/..')),'')
+ assert_equal(minrelpath(n('aa/../bb')),'bb')
+ assert_equal(minrelpath(n('aa/bb/..')),'aa')
+ assert_equal(minrelpath(n('aa/bb/../..')),'')
+ assert_equal(minrelpath(n('aa/bb/../cc/../dd')),n('aa/dd'))
+ assert_equal(minrelpath(n('.././..')),n('../..'))
+ assert_equal(minrelpath(n('aa/bb/.././../dd')),n('dd'))
+
+class test_gpaths(NumpyTestCase):
+
+ def check_gpaths(self):
+ local_path = minrelpath(os.path.join(os.path.dirname(__file__),'..'))
+ ls = gpaths('command/*.py', local_path)
+ assert os.path.join(local_path,'command','build_src.py') in ls,`ls`
+ f = gpaths('system_info.py', local_path)
+ assert os.path.join(local_path,'system_info.py')==f[0],`f`
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/distutils/unixccompiler.py b/numpy/distutils/unixccompiler.py
new file mode 100644
index 000000000..c205a3da6
--- /dev/null
+++ b/numpy/distutils/unixccompiler.py
@@ -0,0 +1,65 @@
+"""
+unixccompiler - can handle very long argument lists for ar.
+"""
+
+import os
+import sys
+import new
+
+from distutils.errors import DistutilsExecError, LinkError, CompileError
+from distutils.unixccompiler import *
+
+
+import log
+
+# Note that UnixCCompiler._compile appeared in Python 2.3
+def UnixCCompiler__compile(self, obj, src, ext, cc_args, extra_postargs, pp_opts):
+ display = '%s: %s' % (os.path.basename(self.compiler_so[0]),src)
+ try:
+ self.spawn(self.compiler_so + cc_args + [src, '-o', obj] +
+ extra_postargs, display = display)
+ except DistutilsExecError, msg:
+ raise CompileError, msg
+UnixCCompiler._compile = new.instancemethod(UnixCCompiler__compile,
+ None,
+ UnixCCompiler)
+
+
+def UnixCCompile_create_static_lib(self, objects, output_libname,
+ output_dir=None, debug=0, target_lang=None):
+ objects, output_dir = self._fix_object_args(objects, output_dir)
+
+ output_filename = \
+ self.library_filename(output_libname, output_dir=output_dir)
+
+ if self._need_link(objects, output_filename):
+ self.mkpath(os.path.dirname(output_filename))
+ tmp_objects = objects + self.objects
+ while tmp_objects:
+ objects = tmp_objects[:50]
+ tmp_objects = tmp_objects[50:]
+ display = '%s: adding %d object files to %s' % (os.path.basename(self.archiver[0]),
+ len(objects),output_filename)
+ self.spawn(self.archiver + [output_filename] + objects,
+ display = display)
+
+ # Not many Unices required ranlib anymore -- SunOS 4.x is, I
+ # think the only major Unix that does. Maybe we need some
+ # platform intelligence here to skip ranlib if it's not
+ # needed -- or maybe Python's configure script took care of
+ # it for us, hence the check for leading colon.
+ if self.ranlib:
+ display = '%s:@ %s' % (os.path.basename(self.ranlib[0]),
+ output_filename)
+ try:
+ self.spawn(self.ranlib + [output_filename],
+ display = display)
+ except DistutilsExecError, msg:
+ raise LibError, msg
+ else:
+ log.debug("skipping %s (up-to-date)", output_filename)
+ return
+
+UnixCCompiler.create_static_lib = \
+ new.instancemethod(UnixCCompile_create_static_lib,
+ None,UnixCCompiler)
diff --git a/numpy/doc/CAPI.txt b/numpy/doc/CAPI.txt
new file mode 100644
index 000000000..92032bf39
--- /dev/null
+++ b/numpy/doc/CAPI.txt
@@ -0,0 +1,311 @@
+===============
+C-API for NumPy
+===============
+
+:Author: Travis Oliphant
+:Discussions to: scipy-dev@scipy.org
+:Created: October 2005
+
+The C API of NumPy is (mostly) backward compatible with Numeric.
+
+There are a few non-standard Numeric usages (that were not really part
+of the API) that will need to be changed:
+
+* If you used any of the function pointers in the ``PyArray_Descr``
+ structure you will have to modify your usage of those. First,
+ the pointers are all under the member named ``f``. So ``descr->cast``
+ is now ``descr->f->cast``. In addition, the
+ casting functions have eliminated the strides argument (use
+ ``PyArray_CastTo`` if you need strided casting). All functions have
+ one or two ``PyArrayObject *`` arguments at the end. This allows the
+ flexible arrays and mis-behaved arrays to be handled.
+
+* The ``descr->zero`` and ``descr->one`` constants have been replaced with
+ function calls, ``PyArray_Zero``, and ``PyArray_One`` (be sure to read the
+ code and free the resulting memory if you use these calls).
+
+* If you passed ``array->dimensions`` and ``array->strides`` around
+ to functions, you will need to fix some code. These are now
+ ``npy_intp*`` pointers. On 32-bit systems there won't be a problem.
+ However, on 64-bit systems, you will need to make changes to avoid
+ errors and segfaults.
+
+
+The header files ``arrayobject.h`` and ``ufuncobject.h`` contain many defines
+that you may find useful. The files ``__ufunc_api.h`` and
+``__multiarray_api.h`` contain the available C-API function calls with
+their function signatures.
+
+All of these headers are installed to
+``<YOUR_PYTHON_LOCATION>/site-packages/numpy/core/include``
+
+
+Getting arrays in C-code
+=========================
+
+All new arrays can be created using ``PyArray_NewFromDescr``. A simple interface
+equivalent to ``PyArray_FromDims`` is ``PyArray_SimpleNew(nd, dims, typenum)``
+and to ``PyArray_FromDimsAndData`` is
+``PyArray_SimpleNewFromData(nd, dims, typenum, data)``.
+
+This is a very flexible function.
+
+::
+
+ PyObject * PyArray_NewFromDescr(PyTypeObject *subtype, PyArray_Descr *descr,
+ int nd, npy_intp *dims,
+ npy_intp *strides, char *data,
+ int flags, PyObject *obj);
+
+``subtype`` : ``PyTypeObject *``
+ The subtype that should be created (either pass in
+ ``&PyArray_Type``, ``&PyBigArray_Type``, or ``obj->ob_type``,
+ where ``obj`` is a an instance of a subtype (or subclass) of
+ ``PyArray_Type`` or ``PyBigArray_Type``).
+
+``descr`` : ``PyArray_Descr *``
+ The type descriptor for the array. This is a Python object (this
+ function steals a reference to it). The easiest way to get one is
+ using ``PyArray_DescrFromType(<typenum>)``. If you want to use a
+ flexible size array, then you need to use
+ ``PyArray_DescrNewFromType(<flexible typenum>)`` and set its ``elsize``
+ paramter to the desired size. The typenum in both of these cases
+ is one of the ``PyArray_XXXX`` enumerated types.
+
+``nd`` : ``int``
+ The number of dimensions (<``MAX_DIMS``)
+
+``*dims`` : ``npy_intp *``
+ A pointer to the size in each dimension. Information will be
+ copied from here.
+
+``*strides`` : ``npy_intp *``
+ The strides this array should have. For new arrays created by this
+ routine, this should be ``NULL``. If you pass in memory for this array
+ to use, then you can pass in the strides information as well
+ (otherwise it will be created for you and default to C-contiguous
+ or Fortran contiguous). Any strides will be copied into the array
+ structure. Do not pass in bad strides information!!!!
+
+ ``PyArray_CheckStrides(...)`` can help but you must call it if you are
+ unsure. You cannot pass in strides information when data is ``NULL``
+ and this routine is creating its own memory.
+
+``*data`` : ``char *``
+ ``NULL`` for creating brand-new memory. If you want this array to wrap
+ another memory area, then pass the pointer here. You are
+ responsible for deleting the memory in that case, but do not do so
+ until the new array object has been deleted. The best way to
+ handle that is to get the memory from another Python object,
+ ``INCREF`` that Python object after passing it's data pointer to this
+ routine, and set the ``->base`` member of the returned array to the
+ Python object. *You are responsible for* setting ``PyArray_BASE(ret)``
+ to the base object. Failure to do so will create a memory leak.
+
+ If you pass in a data buffer, the ``flags`` argument will be the flags
+ of the new array. If you create a new array, a non-zero flags
+ argument indicates that you want the array to be in Fortran order.
+
+``flags`` : ``int``
+ Either the flags showing how to interpret the data buffer passed
+ in, or if a new array is created, nonzero to indicate a Fortran
+ order array. See below for an explanation of the flags.
+
+``obj`` : ``PyObject *``
+ If subtypes is ``&PyArray_Type`` or ``&PyBigArray_Type``, this argument is
+ ignored. Otherwise, the ``__array_finalize__`` method of the subtype
+ is called (if present) and passed this object. This is usually an
+ array of the type to be created (so the ``__array_finalize__`` method
+ must handle an array argument. But, it can be anything...)
+
+Note: The returned array object will be unitialized unless the type is
+``PyArray_OBJECT`` in which case the memory will be set to ``NULL``.
+
+``PyArray_SimpleNew(nd, dims, typenum)`` is a drop-in replacement for
+``PyArray_FromDims`` (except it takes ``npy_intp*`` dims instead of ``int*`` dims
+which matters on 64-bit systems) and it does not initialize the memory
+to zero.
+
+``PyArray_SimpleNew`` is just a macro for ``PyArray_New`` with default arguments.
+Use ``PyArray_FILLWBYTE(arr, 0)`` to fill with zeros.
+
+The ``PyArray_FromDims`` and family of functions are still available and
+are loose wrappers around this function. These functions still take
+``int *`` arguments. This should be fine on 32-bit systems, but on 64-bit
+systems you may run into trouble if you frequently passed
+``PyArray_FromDims`` the dimensions member of the old ``PyArrayObject`` structure
+because ``sizeof(npy_intp) != sizeof(int)``.
+
+
+Getting an arrayobject from an arbitrary Python object
+======================================================
+
+``PyArray_FromAny(...)``
+
+This function replaces ``PyArray_ContiguousFromObject`` and friends (those
+function calls still remain but they are loose wrappers around the
+``PyArray_FromAny`` call).
+
+::
+
+ static PyObject *
+ PyArray_FromAny(PyObject *op, PyArray_Descr *dtype, int min_depth,
+ int max_depth, int requires, PyObject *context)
+
+
+``op`` : ``PyObject *``
+ The Python object to "convert" to an array object
+
+``dtype`` : ``PyArray_Descr *``
+ The desired data-type descriptor. This can be ``NULL``, if the
+ descriptor should be determined by the object. Unless ``FORCECAST`` is
+ present in ``flags``, this call will generate an error if the data
+ type cannot be safely obtained from the object.
+
+``min_depth`` : ``int``
+ The minimum depth of array needed or 0 if doesn't matter
+
+``max_depth`` : ``int``
+ The maximum depth of array allowed or 0 if doesn't matter
+
+``requires`` : ``int``
+ A flag indicating the "requirements" of the returned array. These
+ are the usual ndarray flags (see `NDArray flags`_ below). In
+ addition, there are three flags used only for the ``FromAny``
+ family of functions:
+
+ - ``ENSURECOPY``: always copy the array. Returned arrays always
+ have ``CONTIGUOUS``, ``ALIGNED``, and ``WRITEABLE`` set.
+ - ``ENSUREARRAY``: ensure the returned array is an ndarray (or a
+ bigndarray if ``op`` is one).
+ - ``FORCECAST``: cause a cast to occur regardless of whether or
+ not it is safe.
+
+``context`` : ``PyObject *``
+ If the Python object ``op`` is not an numpy array, but has an
+ ``__array__`` method, context is passed as the second argument to
+ that method (the first is the typecode). Almost always this
+ parameter is ``NULL``.
+
+
+``PyArray_ContiguousFromAny(op, typenum, min_depth, max_depth)`` is
+equivalent to ``PyArray_ContiguousFromObject(...)`` (which is still
+available), except it will return the subclass if op is already a
+subclass of the ndarray. The ``ContiguousFromObject`` version will
+always return an ndarray (or a bigndarray).
+
+Passing Data Type information to C-code
+=======================================
+
+All datatypes are handled using the ``PyArray_Descr *`` structure.
+This structure can be obtained from a Python object using
+``PyArray_DescrConverter`` and ``PyArray_DescrConverter2``. The former
+returns the default ``PyArray_LONG`` descriptor when the input object
+is None, while the latter returns ``NULL`` when the input object is ``None``.
+
+See the ``arraymethods.c`` and ``multiarraymodule.c`` files for many
+examples of usage.
+
+Getting at the structure of the array.
+--------------------------------------
+
+You should use the ``#defines`` provided to access array structure portions:
+
+- ``PyArray_DATA(obj)`` : returns a ``void *`` to the array data
+- ``PyArray_BYTES(obj)`` : return a ``char *`` to the array data
+- ``PyArray_ITEMSIZE(obj)``
+- ``PyArray_NDIM(obj)``
+- ``PyArray_DIMS(obj)``
+- ``PyArray_DIM(obj, n)``
+- ``PyArray_STRIDES(obj)``
+- ``PyArray_STRIDE(obj,n)``
+- ``PyArray_DESCR(obj)``
+- ``PyArray_BASE(obj)``
+
+see more in ``arrayobject.h``
+
+
+NDArray Flags
+=============
+
+The ``flags`` attribute of the ``PyArrayObject`` structure contains important
+information about the memory used by the array (pointed to by the data member)
+This flags information must be kept accurate or strange results and even
+segfaults may result.
+
+There are 6 (binary) flags that describe the memory area used by the
+data buffer. These constants are defined in ``arrayobject.h`` and
+determine the bit-position of the flag. Python exposes a nice attribute-
+based interface as well as a dictionary-like interface for getting
+(and, if appropriate, setting) these flags.
+
+Memory areas of all kinds can be pointed to by an ndarray, necessitating
+these flags. If you get an arbitrary ``PyArrayObject`` in C-code,
+you need to be aware of the flags that are set.
+If you need to guarantee a certain kind of array
+(like ``NPY_CONTIGUOUS`` and ``NPY_BEHAVED``), then pass these requirements into the
+PyArray_FromAny function.
+
+
+``NPY_CONTIGUOUS``
+ True if the array is (C-style) contiguous in memory.
+``NPY_FORTRAN``
+ True if the array is (Fortran-style) contiguous in memory.
+
+Notice that contiguous 1-d arrays are always both ``NPY_FORTRAN`` contiguous
+and C contiguous. Both of these flags can be checked and are convenience
+flags only as whether or not an array is ``NPY_CONTIGUOUS`` or ``NPY_FORTRAN``
+can be determined by the ``strides``, ``dimensions``, and ``itemsize``
+attributes.
+
+``NPY_OWNDATA``
+ True if the array owns the memory (it will try and free it using
+ ``PyDataMem_FREE()`` on deallocation --- so it better really own it).
+
+These three flags facilitate using a data pointer that is a memory-mapped
+array, or part of some larger record array. But, they may have other uses...
+
+``NPY_ALIGNED``
+ True if the data buffer is aligned for the type and the strides
+ are multiples of the alignment factor as well. This can be
+ checked.
+
+``NPY_WRITEABLE``
+ True only if the data buffer can be "written" to.
+
+``NPY_UPDATEIFCOPY``
+ This is a special flag that is set if this array represents a copy
+ made because a user required certain flags in ``PyArray_FromAny`` and
+ a copy had to be made of some other array (and the user asked for
+ this flag to be set in such a situation). The base attribute then
+ points to the "misbehaved" array (which is set read_only). When
+ the array with this flag set is deallocated, it will copy its
+ contents back to the "misbehaved" array (casting if necessary) and
+ will reset the "misbehaved" array to ``WRITEABLE``. If the
+ "misbehaved" array was not ``WRITEABLE`` to begin with then
+ ``PyArray_FromAny`` would have returned an error because ``UPDATEIFCOPY``
+ would not have been possible.
+
+
+``PyArray_UpdateFlags(obj, flags)`` will update the ``obj->flags`` for
+``flags`` which can be any of ``NPY_CONTIGUOUS``, ``NPY_FORTRAN``, ``NPY_ALIGNED``, or
+``NPY_WRITEABLE``.
+
+Some useful combinations of these flags:
+
+- ``NPY_BEHAVED = NPY_ALIGNED | NPY_WRITEABLE``
+- ``NPY_CARRAY = NPY_DEFAULT = NPY_CONTIGUOUS | NPY_BEHAVED``
+- ``NPY_CARRAY_RO = NPY_CONTIGUOUS | NPY_ALIGNED``
+- ``NPY_FARRAY = NPY_FORTRAN | NPY_BEHAVED``
+- ``NPY_FARRAY_RO = NPY_FORTRAN | NPY_ALIGNED``
+
+The macro ``PyArray_CHECKFLAGS(obj, flags)`` can test any combination of flags.
+There are several default combinations defined as macros already
+(see ``arrayobject.h``)
+
+In particular, there are ``ISBEHAVED``, ``ISBEHAVED_RO``, ``ISCARRAY``
+and ``ISFARRAY`` macros that also check to make sure the array is in
+native byte order (as determined) by the data-type descriptor.
+
+There are more C-API enhancements which you can discover in the code,
+or buy the book (http://www.trelgol.com)
diff --git a/numpy/doc/DISTUTILS.txt b/numpy/doc/DISTUTILS.txt
new file mode 100644
index 000000000..5443c7cf8
--- /dev/null
+++ b/numpy/doc/DISTUTILS.txt
@@ -0,0 +1,573 @@
+.. -*- rest -*-
+
+NumPy Distutils - Users Guide
+=============================
+
+:Author: Pearu Peterson <pearu@cens.ioc.ee>
+:Discussions to: scipy-dev@scipy.org
+:Created: October 2005
+:Revision: $LastChangedRevision$
+:SVN source: $HeadURL$
+
+.. contents::
+
+SciPy structure
+'''''''''''''''
+
+Currently SciPy project consists of two packages:
+
+- NumPy (previously called SciPy core) --- it provides packages like:
+
+ + numpy.distutils - extension to Python distutils
+ + numpy.f2py - a tool to bind Fortran/C codes to Python
+ + numpy.core - future replacement of Numeric and numarray packages
+ + numpy.lib - extra utility functions
+ + numpy.testing - numpy-style tools for unit testing
+ + etc
+
+- SciPy --- a collection of scientific tools for Python.
+
+The aim of this document is to describe how to add new tools to SciPy.
+
+
+Requirements for SciPy packages
+'''''''''''''''''''''''''''''''
+
+SciPy consists of Python packages, called SciPy packages, that are
+available to Python users via ``scipy`` name space. Each SciPy package
+may contain other SciPy packages. And so on. So, SciPy directory tree
+is a tree of packages with arbitrary depth and width. Any SciPy
+package may depend on NumPy packages but the dependence on other
+SciPy packages should be kept minimal or zero.
+
+A SciPy package contains in addition to its sources, the following
+files and directories:
+
+ ``setup.py`` --- building script
+ ``info.py`` --- contains documentation and import flags
+ ``__init__.py`` --- package initializer
+ ``tests/`` --- directory of unittests
+
+Their contents will be described below.
+
+The ``setup.py`` file
+'''''''''''''''''''''
+
+In order to add a Python package to SciPy, its building script (the
+``setup.py`` file) must meet certain requirements. The minimal and the
+most important one is that it must define a function
+``configuration(parent_package='',top_path=None)`` that returns a
+dictionary suitable for passing to ``numpy.distutils.core.setup(..)``
+function. In order to simplify the construction of such an distionary,
+``numpy.distutils.misc_util`` provides a class ``Configuration``, the
+usage of will be described below.
+
+SciPy pure Python package example
+---------------------------------
+
+Here follows a minimal example for a pure Python SciPy package
+``setup.py`` file that will be explained in detail below::
+
+ #!/usr/bin/env python
+ def configuration(parent_package='',top_path=None):
+ from numpy.distutils.misc_util import Configuration
+ config = Configuration('mypackage',parent_package,top_path)
+ return config
+
+ if __name__ == "__main__":
+ from numpy.distutils.core import setup
+ #setup(**configuration(top_path='').todict())
+ setup(configuration=configuration)
+
+The first argument ``parent_package`` of the main configuration
+function will contain a name of the parent SciPy package and the
+second argument ``top_path`` contains the name of the directory where
+the main ``setup.py`` script is located. Both arguments should be
+passed to the ``Configuration`` constructor after the name of the
+current package.
+
+The ``Configuration`` constructor has also fourth optional argument,
+``package_path``, that can be used when package files are located in
+some other location than the directory of the ``setup.py`` file.
+
+Remaining ``Configuration`` arguments are all keyword arguments that will
+be used to initialize attributes of ``Configuration``
+instance. Usually, these keywords are the same as the ones that
+``setup(..)`` function would expect, for example, ``packages``,
+``ext_modules``, ``data_files``, ``include_dirs``, ``libraries``,
+``headers``, ``scripts``, ``package_dir``, etc. However, the direct
+specification of these keywords is not recommended as the content of
+these keyword arguments will not be processed or checked for the
+consistency of SciPy building system.
+
+Finally, ``Configuration`` has ``.todict()`` method that returns all
+the configuration data as a dictionary suitable for passing on to the
+``setup(..)`` function.
+
+``Configuration`` instance attributes
+-------------------------------------
+
+In addition to attributes that can be specified via keyword arguments
+to ``Configuration`` constructor, ``Configuration`` instance (let us
+denote as ``config``) has the following attributes that can be useful
+in writing setup scripts:
+
++ ``config.name`` - full name of the current package. The names of parent
+ packages can be extracted as ``config.name.split('.')``.
+
++ ``config.local_path`` - path to the location of current ``setup.py`` file.
+
++ ``config.top_path`` - path to the location of main ``setup.py`` file.
+
+``Configuration`` instance methods
+----------------------------------
+
++ ``config.todict()`` --- returns configuration distionary suitable for
+ passing to ``numpy.distutils.core.setup(..)`` function.
+
++ ``config.paths(*paths) --- applies ``glob.glob(..)`` to items of
+ ``paths`` if necessary. Fixes ``paths`` item that is relative to
+ ``config.local_path``.
+
++ ``config.get_subpackage(subpackage_name,subpackage_path=None)`` ---
+ returns a list of subpackage configurations. Subpackage is looked in the
+ current directory under the name ``subpackage_name`` but the path
+ can be specified also via optional ``subpackage_path`` argument.
+ If ``subpackage_name`` is specified as ``None`` then the subpackage
+ name will be taken the basename of ``subpackage_path``.
+ Any ``*`` used for subpackage names are expanded as wildcards.
+
++ ``config.add_subpackage(subpackage_name,subpackage_path=None)`` ---
+ add SciPy subpackage configuration to the current one. The meaning
+ and usage of arguments is explained above, see
+ ``config.get_subpackage()`` method.
+
++ ``config.add_data_files(*files)`` --- prepend ``files`` to ``data_files``
+ list. If ``files`` item is a tuple then its first element defines
+ the suffix of where data files are copied relative to package installation
+ directory and the second element specifies the path to data
+ files. By default data files are copied under package installation
+ directory. For example,
+
+ ::
+
+ config.add_data_files('foo.dat',
+ ('fun',['gun.dat','nun/pun.dat','/tmp/sun.dat']),
+ 'bar/car.dat'.
+ '/full/path/to/can.dat',
+ )
+
+ will install data files to the following locations
+
+ ::
+
+ <installation path of config.name package>/
+ foo.dat
+ fun/
+ gun.dat
+ pun.dat
+ sun.dat
+ bar/
+ car.dat
+ can.dat
+
+ Path to data files can be a function taking no arguments and
+ returning path(s) to data files -- this is a useful when data files
+ are generated while building the package. (XXX: explain the step
+ when this function are called exactly)
+
++ ``config.add_data_dir(data_path)`` --- add directory ``data_path``
+ recursively to ``data_files``. The whole directory tree starting at
+ ``data_path`` will be copied under package installation directory.
+ If ``data_path`` is a tuple then its first element defines
+ the suffix of where data files are copied relative to package installation
+ directory and the second element specifies the path to data directory.
+ By default, data directory are copied under package installation
+ directory under the basename of ``data_path``. For example,
+
+ ::
+
+ config.add_data_dir('fun') # fun/ contains foo.dat bar/car.dat
+ config.add_data_dir(('sun','fun'))
+ config.add_data_dir(('gun','/full/path/to/fun'))
+
+ will install data files to the following locations
+
+ ::
+
+ <installation path of config.name package>/
+ fun/
+ foo.dat
+ bar/
+ car.dat
+ sun/
+ foo.dat
+ bar/
+ car.dat
+ gun/
+ foo.dat
+ bar/
+ car.dat
+
++ ``config.add_include_dirs(*paths)`` --- prepend ``paths`` to
+ ``include_dirs`` list. This list will be visible to all extension
+ modules of the current package.
+
++ ``config.add_headers(*files)`` --- prepend ``files`` to ``headers``
+ list. By default, headers will be installed under
+ ``<prefix>/include/pythonX.X/<config.name.replace('.','/')>/``
+ directory. If ``files`` item is a tuple then it's first argument
+ specifies the installation suffix relative to
+ ``<prefix>/include/pythonX.X/`` path. This is a Python distutils
+ method; its use is discouraged for NumPy and SciPy in favour of
+ ``config.add_data_files(*files)``.
+
++ ``config.add_scripts(*files)`` --- prepend ``files`` to ``scripts``
+ list. Scripts will be installed under ``<prefix>/bin/`` directory.
+
++ ``config.add_extension(name,sources,*kw)`` --- create and add an
+ ``Extension`` instance to ``ext_modules`` list. The first argument
+ ``name`` defines the name of the extension module that will be
+ installed under ``config.name`` package. The second argument is
+ a list of sources. ``add_extension`` method takes also keyword
+ arguments that are passed on to the ``Extension`` constructor.
+ The list of allowed keywords is the following: ``include_dirs``,
+ ``define_macros``, ``undef_macros``, ``library_dirs``, ``libraries``,
+ ``runtime_library_dirs``, ``extra_objects``, ``extra_compile_args``,
+ ``extra_link_args``, ``export_symbols``, ``swig_opts``, ``depends``,
+ ``language``, ``f2py_options``, ``module_dirs``, ``extra_info``.
+
+ Note that ``config.paths`` method is applied to all lists that
+ may contain paths. ``extra_info`` is a dictionary or a list
+ of dictionaries that content will be appended to keyword arguments.
+ The list ``depends`` contains paths to files or directories
+ that the sources of the extension module depend on. If any path
+ in the ``depends`` list is newer than the extension module, then
+ the module will be rebuilt.
+
+ The list of sources may contain functions ('source generators')
+ with a pattern ``def <funcname>(ext, build_dir): return
+ <source(s) or None>``. If ``funcname`` returns ``None``, no sources
+ are generated. And if the ``Extension`` instance has no sources
+ after processing all source generators, no extension module will
+ be built. This is the recommended way to conditionally define
+ extension modules. Source generator functions are called by the
+ ``build_src`` command of ``numpy.distutils``.
+
+ For example, here is a typical source generator function::
+
+ def generate_source(ext,build_dir):
+ import os
+ from distutils.dep_util import newer
+ target = os.path.join(build_dir,'somesource.c')
+ if newer(target,__file__):
+ # create target file
+ return target
+
+ The first argument contains the Extension instance that can be
+ useful to access its attributes like ``depends``, ``sources``,
+ etc. lists and modify them during the building process.
+ The second argument gives a path to a build directory that must
+ be used when creating files to a disk.
+
++ ``config.add_library(name, sources, **build_info)`` --- add
+ a library to ``libraries`` list. Allowed keywords arguments
+ are ``depends``, ``macros``, ``include_dirs``,
+ ``extra_compiler_args``, ``f2py_options``. See ``.add_extension()``
+ method for more information on arguments.
+
++ ``config.have_f77c()`` --- return True if Fortran 77 compiler is
+ available (read: a simple Fortran 77 code compiled succesfully).
+
++ ``config.have_f90c()`` --- return True if Fortran 90 compiler is
+ available (read: a simple Fortran 90 code compiled succesfully).
+
++ ``config.get_version()`` --- return version string of the current package,
+ ``None`` if version information could not be detected. This methods
+ scans files ``__version__.py``, ``<packagename>_version.py``,
+ ``version.py``, ``__svn_version__.py`` for string variables
+ ``version``, ``__version__``, ``<packagename>_version``.
+
++ ``config.make_svn_version_py()`` --- appends a data function to
+ ``data_files`` list that will generate ``__svn_version__.py`` file
+ to the current package directory. The file will be removed from
+ the source directory when Python exits.
+
++ ``config.get_build_temp_dir()`` --- return a path to a temporary
+ directory. This is the place where one should build temporary
+ files.
+
++ ``config.get_distribution()`` --- return distutils ``Distribution``
+ instance.
+
++ ``config.get_config_cmd()`` --- returns ``numpy.distutils`` config
+ command instance.
+
++ ``config.get_info(*names)`` ---
+
+Template files
+--------------
+
+XXX: Describe how files with extensions ``.f.src``, ``.pyf.src``,
+``.c.src``, etc. are pre-processed by the ``build_src`` command.
+
+Useful functions in ``numpy.distutils.misc_util``
+-------------------------------------------------
+
++ ``get_numpy_include_dirs()`` --- return a list of NumPy base
+ include directories. NumPy base include directories contain
+ header files such as ``numpy/arrayobject.h``, ``numpy/funcobject.h``
+ etc. For installed NumPy the returned list has length 1
+ but when building NumPy the list may contain more directories,
+ for example, a path to ``config.h`` file that
+ ``numpy/base/setup.py`` file generates and is used by ``numpy``
+ header files.
+
++ ``append_path(prefix,path)`` --- smart append ``path`` to ``prefix``.
+
++ ``gpaths(paths, local_path='')`` --- apply glob to paths and prepend
+ ``local_path`` if needed.
+
++ ``njoin(*path)`` --- join pathname components + convert ``/``-separated path
+ to ``os.sep``-separated path and resolve ``..``, ``.`` from paths.
+ Ex. ``njoin('a',['b','./c'],'..','g') -> os.path.join('a','b','g')``.
+
++ ``minrelpath(path)`` --- resolves dots in ``path``.
+
++ ``rel_path(path, parent_path)`` --- return ``path`` relative to ``parent_path``.
+
++ ``def get_cmd(cmdname,_cache={})`` --- returns ``numpy.distutils``
+ command instance.
+
++ ``all_strings(lst)``
+
++ ``has_f_sources(sources)``
+
++ ``has_cxx_sources(sources)``
+
++ ``filter_sources(sources)`` --- return ``c_sources, cxx_sources,
+ f_sources, fmodule_sources``
+
++ ``get_dependencies(sources)``
+
++ ``is_local_src_dir(directory)``
+
++ ``get_ext_source_files(ext)``
+
++ ``get_script_files(scripts)``
+
++ ``get_lib_source_files(lib)``
+
++ ``get_data_files(data)``
+
++ ``dot_join(*args)`` --- join non-zero arguments with a dot.
+
++ ``get_frame(level=0)`` --- return frame object from call stack with given level.
+
++ ``cyg2win32(path)``
+
++ ``mingw32()`` --- return ``True`` when using mingw32 environment.
+
++ ``terminal_has_colors()``, ``red_text(s)``, ``green_text(s)``,
+ ``yellow_text(s)``, ``blue_text(s)``, ``cyan_text(s)``
+
++ ``get_path(mod_name,parent_path=None)`` --- return path of a module
+ relative to parent_path when given. Handles also ``__main__`` and
+ ``__builtin__`` modules.
+
++ ``allpath(name)`` --- replaces ``/`` with ``os.sep`` in ``name``.
+
++ ``cxx_ext_match``, ``fortran_ext_match``, ``f90_ext_match``,
+ ``f90_module_name_match``
+
+``numpy.distutils.system_info`` module
+--------------------------------------
+
++ ``get_info(name,notfound_action=0)``
++ ``combine_paths(*args,**kws)``
++ ``show_all()``
+
+``numpy.distutils.cpuinfo`` module
+----------------------------------
+
++ ``cpuinfo``
+
+``numpy.distutils.log`` module
+------------------------------
+
++ ``set_verbosity(v)``
+
+
+``numpy.distutils.exec_command`` module
+---------------------------------------
+
++ ``get_pythonexe()``
++ ``splitcmdline(line)``
++ ``find_executable(exe, path=None)``
++ ``exec_command( command, execute_in='', use_shell=None, use_tee=None, **env )``
+
+The ``info.py`` file
+''''''''''''''''''''
+
+Scipy package import hooks assume that each Scipy package contains
+``info.py`` file that contains overall documentation about the package
+and some variables defining the order of package imports, dependence
+relations between packages, etc.
+
+The following information will be looked in the ``info.py`` file:
+
+__doc__
+ The documentation string of the package.
+
+__doc_title__
+ The title of the package. If not defined then the first non-empty
+ line of ``__doc__`` will be used.
+
+__all__
+ List of symbols that package exports. Optional.
+
+global_symbols
+ List of names that should be imported to numpy name space. To import
+ all symbols to ``numpy`` namespace, define ``global_symbols=['*']``.
+
+depends
+ List of names that the package depends on. Prefix ``numpy.``
+ will be automatically added to package names. For example,
+ use ``testing`` to indicate dependence on ``numpy.testing``
+ package. Default value is ``[]``.
+
+postpone_import
+ Boolean variable indicating that importing the package should be
+ postponed until the first attempt of its usage. Default value is ``False``.
+ Depreciated.
+
+The ``__init__.py`` file
+''''''''''''''''''''''''
+
+To speed up the import time as well as to minimize memory usage, numpy
+uses ppimport hooks to transparently postpone importing large modules
+that might not be used during the Scipy usage session. But in order to
+have an access to the documentation of all Scipy packages, including
+of the postponed packages, the documentation string of a package (that would
+usually reside in ``__init__.py`` file) should be copied also
+to ``info.py`` file.
+
+So, the header a typical ``__init__.py`` file is::
+
+ #
+ # Package ... - ...
+ #
+
+ from info import __doc__
+ ...
+
+ from numpy.testing import NumpyTest
+ test = NumpyTest().test
+
+The ``tests/`` directory
+''''''''''''''''''''''''
+
+Ideally, every Python code, extension module, or subpackage in Scipy
+package directory should have the corresponding ``test_<name>.py``
+file in ``tests/`` directory. This file should define classes
+derived from ``NumpyTestCase`` (or from ``unittest.TestCase``) class
+and have names starting with ``test``. The methods of these classes
+which names start with ``bench``, ``check``, or ``test``, are passed
+on to unittest machinery. In addition, the value of the first optional
+argument of these methods determine the level of the corresponding
+test. Default level is 1.
+
+A minimal example of a ``test_yyy.py`` file that implements tests for
+a Scipy package module ``numpy.xxx.yyy`` containing a function
+``zzz()``, is shown below::
+
+ import sys
+ from numpy.testing import *
+
+ set_package_path()
+ # import xxx symbols
+ from xxx.yyy import zzz
+ restore_path()
+
+ #Optional:
+ set_local_path()
+ # import modules that are located in the same directory as this file.
+ restore_path()
+
+ class test_zzz(NumpyTestCase):
+ def check_simple(self, level=1):
+ assert zzz()=='Hello from zzz'
+ #...
+
+ if __name__ == "__main__":
+ NumpyTest().run()
+
+``NumpyTestCase`` is derived from ``unittest.TestCase`` and it
+basically only implements an additional method ``measure(self,
+code_str, times=1)``.
+
+Note that all classes that are inherited from ``TestCase`` class, are
+picked up by the test runner when using ``testoob``.
+
+``numpy.testing`` module provides also the following convenience
+functions::
+
+ assert_equal(actual,desired,err_msg='',verbose=1)
+ assert_almost_equal(actual,desired,decimal=7,err_msg='',verbose=1)
+ assert_approx_equal(actual,desired,significant=7,err_msg='',verbose=1)
+ assert_array_equal(x,y,err_msg='')
+ assert_array_almost_equal(x,y,decimal=6,err_msg='')
+ rand(*shape) # returns random array with a given shape
+
+``NumpyTest`` can be used for running ``tests/test_*.py`` scripts.
+For instance, to run all test scripts of the module ``xxx``, execute
+in Python:
+
+ >>> NumpyTest('xxx').test(level=1,verbosity=1)
+
+or equivalently,
+
+ >>> import xxx
+ >>> NumpyTest(xxx).test(level=1,verbosity=1)
+
+To run only tests for ``xxx.yyy`` module, execute:
+
+ >>> NumpyTest('xxx.yyy').test(level=1,verbosity=1)
+
+To take the level and verbosity parameters for tests from
+``sys.argv``, use ``NumpyTest.run()`` method (this is supported only
+when ``optparse`` is installed).
+
+Extra features in NumPy Distutils
+'''''''''''''''''''''''''''''''''
+
+Specifing config_fc options for libraries in setup.py script
+------------------------------------------------------------
+
+It is possible to specify config_fc options in setup.py scripts.
+For example, using
+
+ config.add_library('library',
+ sources=[...],
+ config_fc={'noopt':(__file__,1)})
+
+will compile the ``library`` sources without optimization flags.
+
+It's recommended to specify only those config_fc options in such a way
+that are compiler independent.
+
+Getting extra Fortran 77 compiler options from source
+-----------------------------------------------------
+
+Some old Fortran codes need special compiler options in order to
+work correctly. In order to specify compiler options per source
+file, ``numpy.distutils`` Fortran compiler looks for the following
+pattern::
+
+ CF77FLAGS(<fcompiler type>) = <fcompiler f77flags>
+
+in the first 20 lines of the source and use the ``f77flags`` for
+specified type of the fcompiler (the first character ``C`` is optional).
+
+TODO: This feature can be easily extended for Fortran 90 codes as
+well. Let us know if you would need such a feature.
diff --git a/numpy/doc/HOWTO_DOCUMENT.txt b/numpy/doc/HOWTO_DOCUMENT.txt
new file mode 100644
index 000000000..4527af50f
--- /dev/null
+++ b/numpy/doc/HOWTO_DOCUMENT.txt
@@ -0,0 +1,112 @@
+
+Both NumPy and SciPy follow a convention for docstrings that provide
+for some consistency while also allowing epydoc to produce
+nicely-formatted reference guides.
+
+The docstring format uses reST syntax as interpreted by epydoc
+(which should understand how to process some of our conventions at
+some point)
+
+Here is an example:
+
+"""
+one-line summary or signature
+
+Several sentences providing an extended description
+
+:Parameters:
+ var1 : type information
+ Explanation
+ var2 : type information
+ Explanation
+ long_variable_name :
+ Explanation
+
+:Returns:
+ named : type
+ Explanation
+ list :
+ Explanation
+ of :
+ Explanation
+ outputs :
+ even more explaining
+
+:OtherParameters:
+ only_seldom_used_keywords : type
+ Explanation
+ common_parametrs_listed_above : type
+ Explanation
+
+:SeeAlso:
+ - otherfunc : relationship (optional)
+ - newfunc : relationship (optional)
+
+
+Notes
+-----
+
+Notes about the implementation algorithm (if needed).
+
+This can have multiple paragraphs as can all sections.
+
+Examples
+--------
+
+examples in doctest format
+
+>>> a=[1,2,3]
+>>> [x + 3 for x in a]
+[4,5,6]
+"""
+
+Comments:
+
+1) The first line of the signature should **not** copy the signature.
+If the function is written in C, then this first line should be the
+signature. If the function signature is generic (uses *args or **kwds),
+then a function signature can be included
+
+2) Use optional in the "type" field for parameters that are
+non-keyword optional for C-functions.
+
+3) The OtherParameters section is for functions taking a lot of keywords
+which are not always used or neeeded and whose description would clutter
+then main purpose of the function.
+
+4) The See Also section can list additional related functions. The
+purpose of this section is to direct users to other functions they may
+not be aware of or have easy means to discover (i.e. by looking at the
+docstring of the module). Thus, repeating functions that are in the
+same module is not useful and can create a cluttered document. Please
+use judgement when listing additional functions. Routines that
+provide additional information in their docstrings for this function are
+useful to include here.
+
+5) The Notes section can contain algorithmic information if that is useful.
+
+6) The Examples section is strongly encouraged. The examples can provide a mini-tutorial as well as additional regression testing.
+
+
+Common reST concepts:
+
+A reST-documented module should define
+
+ __docformat__ = 'restructuredtext'
+
+at the top level in accordance with PEP 258. Note that the
+__docformat__ variable in a package's __init__.py file does not apply
+to objects defined in subpackages and submodules.
+
+For paragraphs, indentation is significant and indicates indentation
+in the output. New paragraphs are marked with blank line.
+
+Use *italics*, **bold**, and ``courier`` if needed in any explanations
+(but not for variable names and doctest code or multi-line code)
+
+Use :lm:`eqn` for in-line math in latex format (remember to use the
+raw-format for your text string or escape any '\' symbols). Use
+:m:`eqn` for non-latex math.
+
+A more extensive example of reST markup can be found here:
+http://docutils.sourceforge.net/docs/user/rst/demo.txt
diff --git a/numpy/doc/README.txt b/numpy/doc/README.txt
new file mode 100644
index 000000000..eacc3659e
--- /dev/null
+++ b/numpy/doc/README.txt
@@ -0,0 +1,15 @@
+Very complete documentation is available from the primary developer of
+NumPy for a small fee. After a brief period, that documentation
+will become freely available. See http://www.trelgol.com for
+details. The fee and restriction period is intended to allow people
+and to encourage companies to easily contribute to the development of
+NumPy.
+
+This directory will contain all public documentation that becomes available.
+
+Very good documentation is also available using Python's (and
+especially IPython's) own help system. Most of the functions have
+docstrings that provide usage assistance.
+
+
+
diff --git a/numpy/doc/pep_buffer.txt b/numpy/doc/pep_buffer.txt
new file mode 100644
index 000000000..b516bdd9d
--- /dev/null
+++ b/numpy/doc/pep_buffer.txt
@@ -0,0 +1,871 @@
+PEP: 3118
+Title: Revising the buffer protocol
+Version: $Revision$
+Last-Modified: $Date$
+Authors: Travis Oliphant <oliphant@ee.byu.edu>, Carl Banks <pythondev@aerojockey.com>
+Status: Draft
+Type: Standards Track
+Content-Type: text/x-rst
+Created: 28-Aug-2006
+Python-Version: 3000
+
+Abstract
+========
+
+This PEP proposes re-designing the buffer interface (PyBufferProcs
+function pointers) to improve the way Python allows memory sharing
+in Python 3.0
+
+In particular, it is proposed that the character buffer portion
+of the API be elminated and the multiple-segment portion be
+re-designed in conjunction with allowing for strided memory
+to be shared. In addition, the new buffer interface will
+allow the sharing of any multi-dimensional nature of the
+memory and what data-format the memory contains.
+
+This interface will allow any extension module to either
+create objects that share memory or create algorithms that
+use and manipulate raw memory from arbitrary objects that
+export the interface.
+
+
+Rationale
+=========
+
+The Python 2.X buffer protocol allows different Python types to
+exchange a pointer to a sequence of internal buffers. This
+functionality is *extremely* useful for sharing large segments of
+memory between different high-level objects, but it is too limited and
+has issues:
+
+1. There is the little used "sequence-of-segments" option
+ (bf_getsegcount) that is not well motivated.
+
+2. There is the apparently redundant character-buffer option
+ (bf_getcharbuffer)
+
+3. There is no way for a consumer to tell the buffer-API-exporting
+ object it is "finished" with its view of the memory and
+ therefore no way for the exporting object to be sure that it is
+ safe to reallocate the pointer to the memory that it owns (for
+ example, the array object reallocating its memory after sharing
+ it with the buffer object which held the original pointer led
+ to the infamous buffer-object problem).
+
+4. Memory is just a pointer with a length. There is no way to
+ describe what is "in" the memory (float, int, C-structure, etc.)
+
+5. There is no shape information provided for the memory. But,
+ several array-like Python types could make use of a standard
+ way to describe the shape-interpretation of the memory
+ (wxPython, GTK, pyQT, CVXOPT, PyVox, Audio and Video
+ Libraries, ctypes, NumPy, data-base interfaces, etc.)
+
+6. There is no way to share discontiguous memory (except through
+ the sequence of segments notion).
+
+ There are two widely used libraries that use the concept of
+ discontiguous memory: PIL and NumPy. Their view of discontiguous
+ arrays is different, though. The proposed buffer interface allows
+ sharing of either memory model. Exporters will use only one
+ approach and consumers may choose to support discontiguous
+ arrays of each type however they choose.
+
+ NumPy uses the notion of constant striding in each dimension as its
+ basic concept of an array. With this concept, a simple sub-region
+ of a larger array can be described without copying the data.
+ Thus, stride information is the additional information that must be
+ shared.
+
+ The PIL uses a more opaque memory representation. Sometimes an
+ image is contained in a contiguous segment of memory, but sometimes
+ it is contained in an array of pointers to the contiguous segments
+ (usually lines) of the image. The PIL is where the idea of multiple
+ buffer segments in the original buffer interface came from.
+
+ NumPy's strided memory model is used more often in computational
+ libraries and because it is so simple it makes sense to support
+ memory sharing using this model. The PIL memory model is sometimes
+ used in C-code where a 2-d array can be then accessed using double
+ pointer indirection: e.g. image[i][j].
+
+ The buffer interface should allow the object to export either of these
+ memory models. Consumers are free to either require contiguous memory
+ or write code to handle one or both of these memory models.
+
+Proposal Overview
+=================
+
+* Eliminate the char-buffer and multiple-segment sections of the
+ buffer-protocol.
+
+* Unify the read/write versions of getting the buffer.
+
+* Add a new function to the interface that should be called when
+ the consumer object is "done" with the memory area.
+
+* Add a new variable to allow the interface to describe what is in
+ memory (unifying what is currently done now in struct and
+ array)
+
+* Add a new variable to allow the protocol to share shape information
+
+* Add a new variable for sharing stride information
+
+* Add a new mechanism for sharing arrays that must
+ be accessed using pointer indirection.
+
+* Fix all objects in the core and the standard library to conform
+ to the new interface
+
+* Extend the struct module to handle more format specifiers
+
+* Extend the buffer object into a new memory object which places
+ a Python veneer around the buffer interface.
+
+* Add a few functions to make it easy to copy contiguous data
+ in and out of object supporting the buffer interface.
+
+Specification
+=============
+
+While the new specification allows for complicated memory sharing.
+Simple contiguous buffers of bytes can still be obtained from an
+object. In fact, the new protocol allows a standard mechanism for
+doing this even if the original object is not represented as a
+contiguous chunk of memory.
+
+The easiest way to obtain a simple contiguous chunk of memory is
+to use the provided C-API to obtain a chunk of memory.
+
+
+Change the PyBufferProcs structure to
+
+::
+
+ typedef struct {
+ getbufferproc bf_getbuffer;
+ releasebufferproc bf_releasebuffer;
+ }
+
+
+::
+
+ typedef int (*getbufferproc)(PyObject *obj, PyBuffer *view, int flags)
+
+This function returns 0 on success and -1 on failure (and raises an
+error). The first variable is the "exporting" object. The second
+argument is the address to a bufferinfo structure. If view is NULL,
+then no information is returned but a lock on the memory is still
+obtained. In this case, the corresponding releasebuffer should also
+be called with NULL.
+
+The third argument indicates what kind of buffer the exporter is
+allowed to return. It essentially tells the exporter what kind of
+memory area the consumer can deal with. It also indicates what
+members of the PyBuffer structure the consumer is going to care about.
+
+The exporter can use this information to simplify how much of the PyBuffer
+structure is filled in and/or raise an error if the object can't support
+a simpler view of its memory.
+
+Thus, the caller can request a simple "view" and either receive it or
+have an error raised if it is not possible.
+
+All of the following assume that at least buf, len, and readonly
+will always be utilized by the caller.
+
+Py_BUF_SIMPLE
+
+ The returned buffer will be assumed to be readable (the object may
+ or may not have writeable memory). Only the buf, len, and readonly
+ variables may be accessed. The format will be assumed to be
+ unsigned bytes . This is a "stand-alone" flag constant. It never
+ needs to be |'d to the others. The exporter will raise an
+ error if it cannot provide such a contiguous buffer.
+
+Py_BUF_WRITEABLE
+
+ The returned buffer must be writeable. If it is not writeable,
+ then raise an error.
+
+Py_BUF_READONLY
+
+ The returned buffer must be readonly. If the object is already
+ read-only or it can make its memory read-only (and there are no
+ other views on the object) then it should do so and return the
+ buffer information. If the object does not have read-only memory
+ (or cannot make it read-only), then an error should be raised.
+
+Py_BUF_FORMAT
+
+ The returned buffer must have true format information. This would
+ be used when the consumer is going to be checking for what 'kind'
+ of data is actually stored. An exporter should always be able
+ to provide this information if requested.
+
+Py_BUF_SHAPE
+
+ The returned buffer must have shape information. The memory will
+ be assumed C-style contiguous (last dimension varies the fastest).
+ The exporter may raise an error if it cannot provide this kind
+ of contiguous buffer.
+
+Py_BUF_STRIDES (implies Py_BUF_SHAPE)
+
+ The returned buffer must have strides information. This would be
+ used when the consumer can handle strided, discontiguous arrays.
+ Handling strides automatically assumes you can handle shape.
+ The exporter may raise an error if cannot provide a strided-only
+ representation of the data (i.e. without the suboffsets).
+
+Py_BUF_OFFSETS (implies Py_BUF_STRIDES)
+
+ The returned buffer must have suboffsets information. This would
+ be used when the consumer can handle indirect array referencing
+ implied by these suboffsets.
+
+Py_BUF_FULL (Py_BUF_OFFSETS | Py_BUF_WRITEABLE | Py_BUF_FORMAT)
+
+Thus, the consumer simply wanting a contiguous chunk of bytes from
+the object would use Py_BUF_SIMPLE, while a consumer that understands
+how to make use of the most complicated cases could use Py_BUF_INDIRECT.
+
+If format information is going to be probed, then Py_BUF_FORMAT must
+be |'d to the flags otherwise the consumer assumes it is unsigned
+bytes.
+
+There is a C-API that simple exporting objects can use to fill-in the
+buffer info structure correctly according to the provided flags if a
+contiguous chunk of "unsigned bytes" is all that can be exported.
+
+
+The bufferinfo structure is::
+
+ struct bufferinfo {
+ void *buf;
+ Py_ssize_t len;
+ int readonly;
+ const char *format;
+ int ndims;
+ Py_ssize_t *shape;
+ Py_ssize_t *strides;
+ Py_ssize_t *suboffsets;
+ int itemsize;
+ void *internal;
+ } PyBuffer;
+
+Before calling this function, the bufferinfo structure can be filled
+with whatever. Upon return from getbufferproc, the bufferinfo
+structure is filled in with relevant information about the buffer.
+This same bufferinfo structure must be passed to bf_releasebuffer (if
+available) when the consumer is done with the memory. The caller is
+responsible for keeping a reference to obj until releasebuffer is
+called (i.e. this call does not alter the reference count of obj).
+
+The members of the bufferinfo structure are:
+
+buf
+ a pointer to the start of the memory for the object
+
+len
+ the total bytes of memory the object uses. This should be the
+ same as the product of the shape array multiplied by the number of
+ bytes per item of memory.
+
+readonly
+ an integer variable to hold whether or not the memory is
+ readonly. 1 means the memory is readonly, zero means the
+ memory is writeable.
+
+format
+ a NULL-terminated format-string (following the struct-style syntax
+ including extensions) indicating what is in each element of
+ memory. The number of elements is len / itemsize, where itemsize
+ is the number of bytes implied by the format. For standard
+ unsigned bytes use a format string of "B".
+
+ndims
+ a variable storing the number of dimensions the memory represents.
+ Must be >=0.
+
+shape
+ an array of ``Py_ssize_t`` of length ``ndims`` indicating the
+ shape of the memory as an N-D array. Note that ``((*shape)[0] *
+ ... * (*shape)[ndims-1])*itemsize = len``. If ndims is 0 (indicating
+ a scalar), then this must be NULL.
+
+strides
+ address of a ``Py_ssize_t*`` variable that will be filled with a
+ pointer to an array of ``Py_ssize_t`` of length ``ndims`` (or NULL
+ if ndims is 0). indicating the number of bytes to skip to get to
+ the next element in each dimension. If this is not requested by
+ the caller (BUF_STRIDES is not set), then this member of the
+ structure will not be used and the consumer is assuming the array
+ is C-style contiguous. If this is not the case, then an error
+ should be raised. If this member is requested by the caller
+ (BUF_STRIDES is set), then it must be filled in.
+
+
+suboffsets
+ address of a ``Py_ssize_t *`` variable that will be filled with a
+ pointer to an array of ``Py_ssize_t`` of length ``*ndims``. If
+ these suboffset numbers are >=0, then the value stored along the
+ indicated dimension is a pointer and the suboffset value dictates
+ how many bytes to add to the pointer after de-referencing. A
+ suboffset value that it negative indicates that no de-referencing
+ should occur (striding in a contiguous memory block). If all
+ suboffsets are negative (i.e. no de-referencing is needed, then
+ this must be NULL.
+
+ For clarity, here is a function that returns a pointer to the
+ element in an N-D array pointed to by an N-dimesional index when
+ there are both strides and suboffsets.::
+
+ void* get_item_pointer(int ndim, void* buf, Py_ssize_t* strides,
+ Py_ssize_t* suboffsets, Py_ssize_t *indices) {
+ char* pointer = (char*)buf;
+ int i;
+ for (i = 0; i < ndim; i++) {
+ pointer += strides[i]*indices[i];
+ if (suboffsets[i] >=0 ) {
+ pointer = *((char**)pointer) + suboffsets[i];
+ }
+ }
+ return (void*)pointer;
+ }
+
+ Notice the suboffset is added "after" the dereferencing occurs.
+ Thus slicing in the ith dimension would add to the suboffsets in
+ the (i-1)st dimension. Slicing in the first dimension would change
+ the location of the starting pointer directly (i.e. buf would
+ be modified).
+
+itemsize
+ This is a storage for the itemsize of each element of the shared
+ memory. It can be obtained using PyBuffer_SizeFromFormat but an
+ exporter may know it without making this call and thus storing it
+ is more convenient and faster.
+
+internal
+ This is for use internally by the exporting object. For example,
+ this might be re-cast as an integer by the exporter and used to
+ store flags about whether or not the shape, strides, and suboffsets
+ arrays must be freed when the buffer is released. The consumer
+ should never touch this value.
+
+
+The exporter is responsible for making sure the memory pointed to by
+buf, format, shape, strides, and suboffsets is valid until
+releasebuffer is called. If the exporter wants to be able to change
+shape, strides, and/or suboffsets before releasebuffer is called then
+it should allocate those arrays when getbuffer is called (pointing to
+them in the buffer-info structure provided) and free them when
+releasebuffer is called.
+
+
+The same bufferinfo struct should be used in the release-buffer
+interface call. The caller is responsible for the memory of the
+bufferinfo structure itself.
+
+``typedef int (*releasebufferproc)(PyObject *obj, PyBuffer *view)``
+ Callers of getbufferproc must make sure that this function is
+ called when memory previously acquired from the object is no
+ longer needed. The exporter of the interface must make sure that
+ any memory pointed to in the bufferinfo structure remains valid
+ until releasebuffer is called.
+
+ Both of these routines are optional for a type object
+
+ If the releasebuffer function is not provided then it does not ever
+ need to be called.
+
+Exporters will need to define a releasebuffer function if they can
+re-allocate their memory, strides, shape, suboffsets, or format
+variables which they might share through the struct bufferinfo.
+Several mechanisms could be used to keep track of how many getbuffer
+calls have been made and shared. Either a single variable could be
+used to keep track of how many "views" have been exported, or a
+linked-list of bufferinfo structures filled in could be maintained in
+each object.
+
+All that is specifically required by the exporter, however, is to
+ensure that any memory shared through the bufferinfo structure remains
+valid until releasebuffer is called on the bufferinfo structure.
+
+
+New C-API calls are proposed
+============================
+
+::
+
+ int PyObject_CheckBuffer(PyObject *obj)
+
+Return 1 if the getbuffer function is available otherwise 0.
+
+::
+
+ int PyObject_GetBuffer(PyObject *obj, PyBuffer *view,
+ int flags)
+
+This is a C-API version of the getbuffer function call. It checks to
+make sure object has the required function pointer and issues the
+call. Returns -1 and raises an error on failure and returns 0 on
+success.
+
+::
+ int PyObject_ReleaseBuffer(PyObject *obj, PyBuffer *view)
+
+This is a C-API version of the releasebuffer function call. It checks
+to make sure the object has the required function pointer and issues
+the call. Returns 0 on success and -1 (with an error raised) on
+failure. This function always succeeds if there is no releasebuffer
+function for the object.
+
+::
+
+ PyObject *PyObject_GetMemoryView(PyObject *obj)
+
+Return a memory-view object from an object that defines the buffer interface.
+
+A memory-view object is an extended buffer object that could replace
+the buffer object (but doesn't have to). It's C-structure is
+
+::
+
+ typedef struct {
+ PyObject_HEAD
+ PyObject *base;
+ int ndims;
+ Py_ssize_t *starts; /* slice starts */
+ Py_ssize_t *stops; /* slice stops */
+ Py_ssize_t *steps; /* slice steps */
+ } PyMemoryViewObject;
+
+This is functionally similar to the current buffer object except only
+a reference to base is kept. The actual memory for base must be
+re-grabbed using the buffer-protocol, whenever it is needed.
+
+The getbuffer and releasebuffer for this object use the underlying
+base object (adjusted using the slice information). If the number of
+dimensions of the base object (or the strides or the size) has changed
+when a new view is requested, then the getbuffer will trigger an error.
+
+This memory-view object will support mult-dimensional slicing. Slices
+of the memory-view object are other memory-view objects. When an
+"element" from the memory-view is returned it is always a tuple of
+bytes object + format string which can then be interpreted using the
+struct module if desired.
+
+::
+
+ int PyBuffer_SizeFromFormat(const char *)
+
+Return the implied itemsize of the data-format area from a struct-style
+description.
+
+::
+
+ int PyObject_GetContiguous(PyObject *obj, void **buf, Py_ssize_t *len,
+ char **format, char fortran)
+
+Return a contiguous chunk of memory representing the buffer. If a
+copy is made then return 1. If no copy was needed return 0. If an
+error occurred in probing the buffer interface, then return -1. The
+contiguous chunk of memory is pointed to by ``*buf`` and the length of
+that memory is ``*len``. If the object is multi-dimensional, then if
+fortran is 'F', the first dimension of the underlying array will vary
+the fastest in the buffer. If fortran is 'C', then the last dimension
+will vary the fastest (C-style contiguous). If fortran is 'A', then it
+does not matter and you will get whatever the object decides is more
+efficient.
+
+::
+
+ int PyObject_CopyToObject(PyObject *obj, void *buf, Py_ssize_t len,
+ char fortran)
+
+Copy ``len`` bytes of data pointed to by the contiguous chunk of
+memory pointed to by ``buf`` into the buffer exported by obj. Return
+0 on success and return -1 and raise an error on failure. If the
+object does not have a writeable buffer, then an error is raised. If
+fortran is 'F', then if the object is multi-dimensional, then the data
+will be copied into the array in Fortran-style (first dimension varies
+the fastest). If fortran is 'C', then the data will be copied into the
+array in C-style (last dimension varies the fastest). If fortran is 'A', then
+it does not matter and the copy will be made in whatever way is more
+efficient.
+
+::
+
+ void PyBuffer_FreeMem(void *buf)
+
+This function frees the memory returned by PyObject_GetContiguous if a
+copy was made. Do not call this function unless
+PyObject_GetContiguous returns a 1 indicating that new memory was
+created.
+
+
+These last three C-API calls allow a standard way of getting data in and
+out of Python objects into contiguous memory areas no matter how it is
+actually stored. These calls use the extended buffer interface to perform
+their work.
+
+::
+
+ int PyBuffer_IsContiguous(PyBuffer *view, char fortran);
+
+Return 1 if the memory defined by the view object is C-style (fortran = 'C')
+or Fortran-style (fortran = 'A') contiguous. Return 0 otherwise.
+
+::
+
+ void PyBuffer_FillContiguousStrides(int *ndims, Py_ssize_t *shape,
+ int itemsize,
+ Py_ssize_t *strides, char fortran)
+
+Fill the strides array with byte-strides of a contiguous (C-style if
+fortran is 0 or Fortran-style if fortran is 1) array of the given
+shape with the given number of bytes per element.
+
+::
+ int PyBuffer_FillInfo(PyBuffer *view, void *buf,
+ Py_ssize_t len, int readonly, int infoflags)
+
+Fills in a buffer-info structure correctly for an exporter that can
+only share a contiguous chunk of memory of "unsigned bytes" of the
+given length. Returns 0 on success and -1 (with raising an error) on
+error.
+
+
+Additions to the struct string-syntax
+=====================================
+
+The struct string-syntax is missing some characters to fully
+implement data-format descriptions already available elsewhere (in
+ctypes and NumPy for example). The Python 2.5 specification is
+at http://docs.python.org/lib/module-struct.html
+
+Here are the proposed additions:
+
+
+================ ===========
+Character Description
+================ ===========
+'t' bit (number before states how many bits)
+'?' platform _Bool type
+'g' long double
+'c' ucs-1 (latin-1) encoding
+'u' ucs-2
+'w' ucs-4
+'O' pointer to Python Object
+'Z' complex (whatever the next specifier is)
+'&' specific pointer (prefix before another charater)
+'T{}' structure (detailed layout inside {})
+'(k1,k2,...,kn)' multi-dimensional array of whatever follows
+':name:' optional name of the preceeding element
+'X{}' pointer to a function (optional function
+ signature inside {})
+' \n\t' ignored (allow better readability)
+ -- this may already be true
+================ ===========
+
+The struct module will be changed to understand these as well and
+return appropriate Python objects on unpacking. Unpacking a
+long-double will return a decimal object or a ctypes long-double.
+Unpacking 'u' or 'w' will return Python unicode. Unpacking a
+multi-dimensional array will return a list (of lists if >1d).
+Unpacking a pointer will return a ctypes pointer object. Unpacking a
+function pointer will return a ctypes call-object (perhaps). Unpacking
+a bit will return a Python Bool. White-space in the struct-string
+syntax will be ignored if it isn't already. Unpacking a named-object
+will return some kind of named-tuple-like object that acts like a
+tuple but whose entries can also be accessed by name. Unpacking a
+nested structure will return a nested tuple.
+
+Endian-specification ('!', '@','=','>','<', '^') is also allowed
+inside the string so that it can change if needed. The
+previously-specified endian string is in force until changed. The
+default endian is '@' which means native data-types and alignment. If
+un-aligned, native data-types are requested, then the endian
+specification is '^'.
+
+According to the struct-module, a number can preceed a character
+code to specify how many of that type there are. The
+(k1,k2,...,kn) extension also allows specifying if the data is
+supposed to be viewed as a (C-style contiguous, last-dimension
+varies the fastest) multi-dimensional array of a particular format.
+
+Functions should be added to ctypes to create a ctypes object from
+a struct description, and add long-double, and ucs-2 to ctypes.
+
+Examples of Data-Format Descriptions
+====================================
+
+Here are some examples of C-structures and how they would be
+represented using the struct-style syntax.
+
+<named> is the constructor for a named-tuple (not-specified yet).
+
+float
+ 'f' <--> Python float
+complex double
+ 'Zd' <--> Python complex
+RGB Pixel data
+ 'BBB' <--> (int, int, int)
+ 'B:r: B:g: B:b:' <--> <named>((int, int, int), ('r','g','b'))
+
+Mixed endian (weird but possible)
+ '>i:big: <i:little:' <--> <named>((int, int), ('big', 'little'))
+
+Nested structure
+ ::
+
+ struct {
+ int ival;
+ struct {
+ unsigned short sval;
+ unsigned char bval;
+ unsigned char cval;
+ } sub;
+ }
+ """i:ival:
+ T{
+ H:sval:
+ B:bval:
+ B:cval:
+ }:sub:
+ """
+Nested array
+ ::
+
+ struct {
+ int ival;
+ double data[16*4];
+ }
+ """i:ival:
+ (16,4)d:data:
+ """
+
+
+Code to be affected
+===================
+
+All objects and modules in Python that export or consume the old
+buffer interface will be modified. Here is a partial list.
+
+* buffer object
+* bytes object
+* string object
+* array module
+* struct module
+* mmap module
+* ctypes module
+
+Anything else using the buffer API.
+
+
+Issues and Details
+==================
+
+It is intended that this PEP will be back-ported to Python 2.6 by
+adding the C-API and the two functions to the existing buffer
+protocol.
+
+The proposed locking mechanism relies entirely on the exporter object
+to not invalidate any of the memory pointed to by the buffer structure
+until a corresponding releasebuffer is called. If it wants to be able
+to change its own shape and/or strides arrays, then it needs to create
+memory for these in the bufferinfo structure and copy information
+over.
+
+The sharing of strided memory and suboffsets is new and can be seen as
+a modification of the multiple-segment interface. It is motivated by
+NumPy and the PIL. NumPy objects should be able to share their
+strided memory with code that understands how to manage strided memory
+because strided memory is very common when interfacing with compute
+libraries.
+
+Also, with this approach it should be possible to write generic code
+that works with both kinds of memory.
+
+Memory management of the format string, the shape array, the strides
+array, and the suboffsets array in the bufferinfo structure is always
+the responsibility of the exporting object. The consumer should not
+set these pointers to any other memory or try to free them.
+
+Several ideas were discussed and rejected:
+
+ Having a "releaser" object whose release-buffer was called. This
+ was deemed unacceptable because it caused the protocol to be
+ asymmetric (you called release on something different than you
+ "got" the buffer from). It also complicated the protocol without
+ providing a real benefit.
+
+ Passing all the struct variables separately into the function.
+ This had the advantage that it allowed one to set NULL to
+ variables that were not of interest, but it also made the function
+ call more difficult. The flags variable allows the same
+ ability of consumers to be "simple" in how they call the protocol.
+
+Code
+========
+
+The authors of the PEP promise to contribute and maintain the code for
+this proposal but will welcome any help.
+
+
+
+
+Examples
+=========
+
+Ex. 1
+-----------
+
+This example shows how an image object that uses contiguous lines might expose its buffer.::
+
+::
+
+ struct rgba {
+ unsigned char r, g, b, a;
+ };
+
+ struct ImageObject {
+ PyObject_HEAD;
+ ...
+ struct rgba** lines;
+ Py_ssize_t height;
+ Py_ssize_t width;
+ Py_ssize_t shape_array[2];
+ Py_ssize_t stride_array[2];
+ Py_ssize_t view_count;
+ };
+
+"lines" points to malloced 1-D array of (struct rgba*). Each pointer
+in THAT block points to a seperately malloced array of (struct rgba).
+
+In order to access, say, the red value of the pixel at x=30, y=50, you'd use "lines[50][30].r".
+
+So what does ImageObject's getbuffer do? Leaving error checking out::
+
+::
+
+ int Image_getbuffer(PyObject *self, PyBuffer *view, int flags) {
+
+ static Py_ssize_t suboffsets[2] = { -1, 0 };
+
+ view->buf = self->lines;
+ view->len = self->height*self->width;
+ view->readonly = 0;
+ view->ndims = 2;
+ self->shape_array[0] = height;
+ self->shape_array[1] = width;
+ view->shape = &self->shape_array;
+ self->stride_array[0] = sizeof(struct rgba*);
+ self->stride_array[1] = sizeof(struct rgba);
+ view->strides = &self->stride_array;
+ view->suboffsets = suboffsets;
+
+ self->view_count ++;
+
+ return 0;
+ }
+
+
+ int Image_releasebuffer(PyObject *self, PyBuffer *view) {
+ self->view_count--;
+ return 0;
+ }
+
+
+Ex. 2
+-----------
+
+This example shows how an object that wants to expose a contiguous
+chunk of memory (which will never be re-allocated while the object is
+alive) would do that.
+
+::
+
+ int myobject_getbuffer(PyObject *self, PyBuffer *view, int flags) {
+
+ void *buf;
+ Py_ssize_t len;
+ int readonly=0;
+
+ buf = /* Point to buffer */
+ len = /* Set to size of buffer */
+ readonly = /* Set to 1 if readonly */
+
+ return PyObject_FillBufferInfo(view, buf, len, readonly, flags);
+ }
+
+/* No releasebuffer is necessary because the memory will never
+be re-allocated so the locking mechanism is not needed
+*/
+
+Ex. 3
+-----------
+
+A consumer that wants to only get a simple contiguous chunk of bytes
+from a Python object, obj would do the following:
+
+::
+
+ PyBuffer view;
+ int ret;
+
+ if (PyObject_GetBuffer(obj, &view, Py_BUF_SIMPLE) < 0) {
+ /* error return */
+ }
+
+ /* Now, view.buf is the pointer to memory
+ view.len is the length
+ view.readonly is whether or not the memory is read-only.
+ */
+
+
+ /* After using the information and you don't need it anymore */
+
+ if (PyObject_ReleaseBuffer(obj, &view) < 0) {
+ /* error return */
+ }
+
+
+Ex. 4
+-----------
+
+A consumer that wants to be able to use any object's memory but is
+writing an algorithm that only handle contiguous memory could do the following:
+
+::
+
+ void *buf;
+ Py_ssize_t len;
+ char *format;
+
+ if (PyObject_GetContiguous(obj, &buf, &len, &format, 0) < 0) {
+ /* error return */
+ }
+
+ /* process memory pointed to by buffer if format is correct */
+
+ /* Optional:
+
+ if, after processing, we want to copy data from buffer back
+ into the the object
+
+ we could do
+ */
+
+ if (PyObject_CopyToObject(obj, buf, len, 0) < 0) {
+ /* error return */
+ }
+
+
+Copyright
+=========
+
+This PEP is placed in the public domain
+
diff --git a/numpy/doc/pyrex/MANIFEST b/numpy/doc/pyrex/MANIFEST
new file mode 100644
index 000000000..feb3ec22a
--- /dev/null
+++ b/numpy/doc/pyrex/MANIFEST
@@ -0,0 +1,2 @@
+numpyx.pyx
+setup.py
diff --git a/numpy/doc/pyrex/Makefile b/numpy/doc/pyrex/Makefile
new file mode 100644
index 000000000..b5905e7be
--- /dev/null
+++ b/numpy/doc/pyrex/Makefile
@@ -0,0 +1,9 @@
+all:
+ python setup.py build_ext --inplace
+
+test: all
+ python run_test.py
+
+.PHONY: clean
+clean:
+ rm -rf *~ *.so *.c *.o build
diff --git a/numpy/doc/pyrex/c_numpy.pxd b/numpy/doc/pyrex/c_numpy.pxd
new file mode 100644
index 000000000..511acc4b1
--- /dev/null
+++ b/numpy/doc/pyrex/c_numpy.pxd
@@ -0,0 +1,125 @@
+# :Author: Travis Oliphant
+
+cdef extern from "numpy/arrayobject.h":
+
+ cdef enum NPY_TYPES:
+ NPY_BOOL
+ NPY_BYTE
+ NPY_UBYTE
+ NPY_SHORT
+ NPY_USHORT
+ NPY_INT
+ NPY_UINT
+ NPY_LONG
+ NPY_ULONG
+ NPY_LONGLONG
+ NPY_ULONGLONG
+ NPY_FLOAT
+ NPY_DOUBLE
+ NPY_LONGDOUBLE
+ NPY_CFLOAT
+ NPY_CDOUBLE
+ NPY_CLONGDOUBLE
+ NPY_OBJECT
+ NPY_STRING
+ NPY_UNICODE
+ NPY_VOID
+ NPY_NTYPES
+ NPY_NOTYPE
+
+ cdef enum requirements:
+ NPY_CONTIGUOUS
+ NPY_FORTRAN
+ NPY_OWNDATA
+ NPY_FORCECAST
+ NPY_ENSURECOPY
+ NPY_ENSUREARRAY
+ NPY_ELEMENTSTRIDES
+ NPY_ALIGNED
+ NPY_NOTSWAPPED
+ NPY_WRITEABLE
+ NPY_UPDATEIFCOPY
+ NPY_ARR_HAS_DESCR
+
+ NPY_BEHAVED
+ NPY_BEHAVED_NS
+ NPY_CARRAY
+ NPY_CARRAY_RO
+ NPY_FARRAY
+ NPY_FARRAY_RO
+ NPY_DEFAULT
+
+ NPY_IN_ARRAY
+ NPY_OUT_ARRAY
+ NPY_INOUT_ARRAY
+ NPY_IN_FARRAY
+ NPY_OUT_FARRAY
+ NPY_INOUT_FARRAY
+
+ NPY_UPDATE_ALL
+
+ cdef enum defines:
+ # Note: as of Pyrex 0.9.5, enums are type-checked more strictly, so this
+ # can't be used as an integer.
+ NPY_MAXDIMS
+
+ ctypedef struct npy_cdouble:
+ double real
+ double imag
+
+ ctypedef struct npy_cfloat:
+ double real
+ double imag
+
+ ctypedef int npy_intp
+
+ ctypedef extern class numpy.dtype [object PyArray_Descr]:
+ cdef int type_num, elsize, alignment
+ cdef char type, kind, byteorder, hasobject
+ cdef object fields, typeobj
+
+ ctypedef extern class numpy.ndarray [object PyArrayObject]:
+ cdef char *data
+ cdef int nd
+ cdef npy_intp *dimensions
+ cdef npy_intp *strides
+ cdef object base
+ cdef dtype descr
+ cdef int flags
+
+ ctypedef extern class numpy.flatiter [object PyArrayIterObject]:
+ cdef int nd_m1
+ cdef npy_intp index, size
+ cdef ndarray ao
+ cdef char *dataptr
+
+ ctypedef extern class numpy.broadcast [object PyArrayMultiIterObject]:
+ cdef int numiter
+ cdef npy_intp size, index
+ cdef int nd
+ # These next two should be arrays of [NPY_MAXITER], but that is
+ # difficult to cleanly specify in Pyrex. Fortunately, it doesn't matter.
+ cdef npy_intp *dimensions
+ cdef void **iters
+
+ object PyArray_ZEROS(int ndims, npy_intp* dims, NPY_TYPES type_num, int fortran)
+ object PyArray_EMPTY(int ndims, npy_intp* dims, NPY_TYPES type_num, int fortran)
+ dtype PyArray_DescrFromTypeNum(NPY_TYPES type_num)
+ object PyArray_SimpleNew(int ndims, npy_intp* dims, NPY_TYPES type_num)
+ int PyArray_Check(object obj)
+ object PyArray_ContiguousFromAny(object obj, NPY_TYPES type,
+ int mindim, int maxdim)
+ npy_intp PyArray_SIZE(ndarray arr)
+ npy_intp PyArray_NBYTES(ndarray arr)
+ void *PyArray_DATA(ndarray arr)
+ object PyArray_FromAny(object obj, dtype newtype, int mindim, int maxdim,
+ int requirements, object context)
+ object PyArray_FROMANY(object obj, NPY_TYPES type_num, int min,
+ int max, int requirements)
+ object PyArray_NewFromDescr(object subtype, dtype newtype, int nd,
+ npy_intp* dims, npy_intp* strides, void* data,
+ int flags, object parent)
+
+ void PyArray_ITER_NEXT(flatiter it)
+
+ void import_array()
diff --git a/numpy/doc/pyrex/c_python.pxd b/numpy/doc/pyrex/c_python.pxd
new file mode 100644
index 000000000..53f6d9b19
--- /dev/null
+++ b/numpy/doc/pyrex/c_python.pxd
@@ -0,0 +1,20 @@
+# -*- Mode: Python -*- Not really, but close enough
+
+# Expose as much of the Python C API as we need here
+
+cdef extern from "stdlib.h":
+ ctypedef int size_t
+
+cdef extern from "Python.h":
+ ctypedef int Py_intptr_t
+ void* PyMem_Malloc(size_t)
+ void* PyMem_Realloc(void *p, size_t n)
+ void PyMem_Free(void *p)
+ char* PyString_AsString(object string)
+ object PyString_FromString(char *v)
+ object PyString_InternFromString(char *v)
+ int PyErr_CheckSignals()
+ object PyFloat_FromDouble(double v)
+ void Py_XINCREF(object o)
+ void Py_XDECREF(object o)
+ void Py_CLEAR(object o) # use instead of decref
diff --git a/numpy/doc/pyrex/notes b/numpy/doc/pyrex/notes
new file mode 100644
index 000000000..301581cee
--- /dev/null
+++ b/numpy/doc/pyrex/notes
@@ -0,0 +1,3 @@
+- cimport with a .pxd file vs 'include foo.pxi'?
+
+- the need to repeat: pyrex does NOT parse C headers. \ No newline at end of file
diff --git a/numpy/doc/pyrex/numpyx.c b/numpy/doc/pyrex/numpyx.c
new file mode 100644
index 000000000..e250eae19
--- /dev/null
+++ b/numpy/doc/pyrex/numpyx.c
@@ -0,0 +1,1037 @@
+/* Generated by Pyrex 0.9.5.1 on Wed Jan 31 11:57:10 2007 */
+
+#include "Python.h"
+#include "structmember.h"
+#ifndef PY_LONG_LONG
+ #define PY_LONG_LONG LONG_LONG
+#endif
+#ifdef __cplusplus
+#define __PYX_EXTERN_C extern "C"
+#else
+#define __PYX_EXTERN_C extern
+#endif
+__PYX_EXTERN_C double pow(double, double);
+#include "stdlib.h"
+#include "numpy/arrayobject.h"
+
+
+typedef struct {PyObject **p; char *s;} __Pyx_InternTabEntry; /*proto*/
+typedef struct {PyObject **p; char *s; long n;} __Pyx_StringTabEntry; /*proto*/
+
+static PyObject *__pyx_m;
+static PyObject *__pyx_b;
+static int __pyx_lineno;
+static char *__pyx_filename;
+static char **__pyx_f;
+
+static int __Pyx_ArgTypeTest(PyObject *obj, PyTypeObject *type, int none_allowed, char *name); /*proto*/
+
+static PyObject *__Pyx_Import(PyObject *name, PyObject *from_list); /*proto*/
+
+static int __Pyx_PrintItem(PyObject *); /*proto*/
+static int __Pyx_PrintNewline(void); /*proto*/
+
+static PyObject *__Pyx_GetName(PyObject *dict, PyObject *name); /*proto*/
+
+static int __Pyx_InternStrings(__Pyx_InternTabEntry *t); /*proto*/
+
+static int __Pyx_InitStrings(__Pyx_StringTabEntry *t); /*proto*/
+
+static PyTypeObject *__Pyx_ImportType(char *module_name, char *class_name, long size); /*proto*/
+
+static void __Pyx_AddTraceback(char *funcname); /*proto*/
+
+/* Declarations from c_python */
+
+
+/* Declarations from c_numpy */
+
+static PyTypeObject *__pyx_ptype_7c_numpy_dtype = 0;
+static PyTypeObject *__pyx_ptype_7c_numpy_ndarray = 0;
+static PyTypeObject *__pyx_ptype_7c_numpy_flatiter = 0;
+static PyTypeObject *__pyx_ptype_7c_numpy_broadcast = 0;
+
+/* Declarations from numpyx */
+
+static PyObject *(__pyx_f_6numpyx_print_elements(char (*),Py_intptr_t (*),Py_intptr_t (*),int ,int ,PyObject *)); /*proto*/
+
+
+/* Implementation of numpyx */
+
+
+static PyObject *__pyx_n_c_python;
+static PyObject *__pyx_n_c_numpy;
+static PyObject *__pyx_n_numpy;
+static PyObject *__pyx_n_print_array_info;
+static PyObject *__pyx_n_test_methods;
+static PyObject *__pyx_n_test;
+
+static PyObject *__pyx_n_dtype;
+
+static PyObject *__pyx_k2p;
+static PyObject *__pyx_k3p;
+static PyObject *__pyx_k4p;
+static PyObject *__pyx_k5p;
+static PyObject *__pyx_k6p;
+static PyObject *__pyx_k7p;
+static PyObject *__pyx_k8p;
+static PyObject *__pyx_k9p;
+
+static char (__pyx_k2[]) = "-=";
+static char (__pyx_k3[]) = "printing array info for ndarray at 0x%0lx";
+static char (__pyx_k4[]) = "print number of dimensions:";
+static char (__pyx_k5[]) = "address of strides: 0x%0lx";
+static char (__pyx_k6[]) = "strides:";
+static char (__pyx_k7[]) = " stride %d:";
+static char (__pyx_k8[]) = "memory dump:";
+static char (__pyx_k9[]) = "-=";
+
+static PyObject *__pyx_f_6numpyx_print_array_info(PyObject *__pyx_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static PyObject *__pyx_f_6numpyx_print_array_info(PyObject *__pyx_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyArrayObject *__pyx_v_arr = 0;
+ int __pyx_v_i;
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ PyObject *__pyx_2 = 0;
+ int __pyx_3;
+ static char *__pyx_argnames[] = {"arr",0};
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O", __pyx_argnames, &__pyx_v_arr)) return 0;
+ Py_INCREF(__pyx_v_arr);
+ if (!__Pyx_ArgTypeTest(((PyObject *)__pyx_v_arr), __pyx_ptype_7c_numpy_ndarray, 1, "arr")) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 10; goto __pyx_L1;}
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":13 */
+ __pyx_1 = PyInt_FromLong(10); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 13; goto __pyx_L1;}
+ __pyx_2 = PyNumber_Multiply(__pyx_k2p, __pyx_1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 13; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ if (__Pyx_PrintItem(__pyx_2) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 13; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__Pyx_PrintNewline() < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 13; goto __pyx_L1;}
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":14 */
+ __pyx_1 = PyInt_FromLong(((int )__pyx_v_arr)); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 14; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 14; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_1);
+ __pyx_1 = 0;
+ __pyx_1 = PyNumber_Remainder(__pyx_k3p, __pyx_2); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 14; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__Pyx_PrintItem(__pyx_1) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 14; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ if (__Pyx_PrintNewline() < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 14; goto __pyx_L1;}
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":15 */
+ if (__Pyx_PrintItem(__pyx_k4p) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 15; goto __pyx_L1;}
+ __pyx_2 = PyInt_FromLong(__pyx_v_arr->nd); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 15; goto __pyx_L1;}
+ if (__Pyx_PrintItem(__pyx_2) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 15; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__Pyx_PrintNewline() < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 15; goto __pyx_L1;}
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":16 */
+ __pyx_1 = PyInt_FromLong(((int )__pyx_v_arr->strides)); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 16; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 16; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_1);
+ __pyx_1 = 0;
+ __pyx_1 = PyNumber_Remainder(__pyx_k5p, __pyx_2); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 16; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__Pyx_PrintItem(__pyx_1) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 16; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ if (__Pyx_PrintNewline() < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 16; goto __pyx_L1;}
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":17 */
+ if (__Pyx_PrintItem(__pyx_k6p) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 17; goto __pyx_L1;}
+ if (__Pyx_PrintNewline() < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 17; goto __pyx_L1;}
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":18 */
+ __pyx_3 = __pyx_v_arr->nd;
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_3; ++__pyx_v_i) {
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":20 */
+ __pyx_2 = PyInt_FromLong(__pyx_v_i); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 20; goto __pyx_L1;}
+ __pyx_1 = PyNumber_Remainder(__pyx_k7p, __pyx_2); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 20; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__Pyx_PrintItem(__pyx_1) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 20; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_2 = PyInt_FromLong(((int )(__pyx_v_arr->strides[__pyx_v_i]))); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 20; goto __pyx_L1;}
+ if (__Pyx_PrintItem(__pyx_2) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 20; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__Pyx_PrintNewline() < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 20; goto __pyx_L1;}
+ }
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":21 */
+ if (__Pyx_PrintItem(__pyx_k8p) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 21; goto __pyx_L1;}
+ if (__Pyx_PrintNewline() < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 21; goto __pyx_L1;}
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":22 */
+ __pyx_1 = PyObject_GetAttr(((PyObject *)__pyx_v_arr), __pyx_n_dtype); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 23; goto __pyx_L1;}
+ __pyx_2 = __pyx_f_6numpyx_print_elements(__pyx_v_arr->data,__pyx_v_arr->strides,__pyx_v_arr->dimensions,__pyx_v_arr->nd,(sizeof(double )),__pyx_1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 22; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":24 */
+ __pyx_1 = PyInt_FromLong(10); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 24; goto __pyx_L1;}
+ __pyx_2 = PyNumber_Multiply(__pyx_k9p, __pyx_1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 24; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ if (__Pyx_PrintItem(__pyx_2) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 24; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__Pyx_PrintNewline() < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 24; goto __pyx_L1;}
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":25 */
+ if (__Pyx_PrintNewline() < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 25; goto __pyx_L1;}
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ Py_XDECREF(__pyx_2);
+ __Pyx_AddTraceback("numpyx.print_array_info");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_arr);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_n_object_;
+static PyObject *__pyx_n_float64;
+static PyObject *__pyx_n_name;
+
+static PyObject *__pyx_k10p;
+static PyObject *__pyx_k11p;
+static PyObject *__pyx_k12p;
+static PyObject *__pyx_k13p;
+static PyObject *__pyx_k14p;
+
+static char (__pyx_k10[]) = " print_elements() not (yet) implemented for dtype %s";
+static char (__pyx_k11[]) = " ";
+static char (__pyx_k12[]) = " ";
+static char (__pyx_k13[]) = " ";
+static char (__pyx_k14[]) = " ";
+
+static PyObject *__pyx_f_6numpyx_print_elements(char (*__pyx_v_data),Py_intptr_t (*__pyx_v_strides),Py_intptr_t (*__pyx_v_dimensions),int __pyx_v_nd,int __pyx_v_elsize,PyObject *__pyx_v_dtype) {
+ Py_intptr_t __pyx_v_i;
+ void (*__pyx_v_elptr);
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ int __pyx_5;
+ Py_intptr_t __pyx_6;
+ Py_INCREF(__pyx_v_dtype);
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":36 */
+ __pyx_1 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 36; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_1, __pyx_n_dtype); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 36; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_1 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 36; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_1, __pyx_n_object_); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 36; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_1 = PyTuple_New(1); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 36; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_1, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_2, __pyx_1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 36; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 37; goto __pyx_L1;}
+ __pyx_1 = PyObject_GetAttr(__pyx_2, __pyx_n_dtype); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 37; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 37; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_2, __pyx_n_float64); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 37; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 37; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 37; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyList_New(2); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 36; goto __pyx_L1;}
+ PyList_SET_ITEM(__pyx_1, 0, __pyx_3);
+ PyList_SET_ITEM(__pyx_1, 1, __pyx_4);
+ __pyx_3 = 0;
+ __pyx_4 = 0;
+ __pyx_5 = PySequence_Contains(__pyx_1, __pyx_v_dtype); if (__pyx_5 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 36; goto __pyx_L1;}
+ __pyx_5 = !__pyx_5;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ if (__pyx_5) {
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":38 */
+ __pyx_2 = PyObject_GetAttr(__pyx_v_dtype, __pyx_n_name); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 38; goto __pyx_L1;}
+ __pyx_3 = PyNumber_Remainder(__pyx_k10p, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 38; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__Pyx_PrintItem(__pyx_3) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 38; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ if (__Pyx_PrintNewline() < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 38; goto __pyx_L1;}
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":39 */
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":41 */
+ __pyx_5 = (__pyx_v_nd == 0);
+ if (__pyx_5) {
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":42 */
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 42; goto __pyx_L1;}
+ __pyx_1 = PyObject_GetAttr(__pyx_4, __pyx_n_dtype); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 42; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 42; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_object_); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 42; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 42; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_1, __pyx_4); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 42; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ if (PyObject_Cmp(__pyx_v_dtype, __pyx_2, &__pyx_5) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 42; goto __pyx_L1;}
+ __pyx_5 = __pyx_5 == 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__pyx_5) {
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":43 */
+ __pyx_v_elptr = (((void (*(*)))__pyx_v_data)[0]);
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":44 */
+ if (__Pyx_PrintItem(__pyx_k11p) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 44; goto __pyx_L1;}
+ __pyx_3 = (PyObject *)__pyx_v_elptr;
+ Py_INCREF(__pyx_3);
+ if (__Pyx_PrintItem(__pyx_3) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 44; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ if (__Pyx_PrintNewline() < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 44; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_1 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 45; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_1, __pyx_n_dtype); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 45; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 45; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_float64); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 45; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyTuple_New(1); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 45; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_1, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 45; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ if (PyObject_Cmp(__pyx_v_dtype, __pyx_2, &__pyx_5) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 45; goto __pyx_L1;}
+ __pyx_5 = __pyx_5 == 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__pyx_5) {
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":46 */
+ if (__Pyx_PrintItem(__pyx_k12p) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 46; goto __pyx_L1;}
+ __pyx_3 = PyFloat_FromDouble((((double (*))__pyx_v_data)[0])); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 46; goto __pyx_L1;}
+ if (__Pyx_PrintItem(__pyx_3) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 46; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ if (__Pyx_PrintNewline() < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 46; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+ goto __pyx_L3;
+ }
+ __pyx_5 = (__pyx_v_nd == 1);
+ if (__pyx_5) {
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":48 */
+ __pyx_6 = (__pyx_v_dimensions[0]);
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_6; ++__pyx_v_i) {
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":49 */
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 49; goto __pyx_L1;}
+ __pyx_1 = PyObject_GetAttr(__pyx_4, __pyx_n_dtype); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 49; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 49; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_object_); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 49; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 49; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_1, __pyx_4); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 49; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ if (PyObject_Cmp(__pyx_v_dtype, __pyx_2, &__pyx_5) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 49; goto __pyx_L1;}
+ __pyx_5 = __pyx_5 == 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__pyx_5) {
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":50 */
+ __pyx_v_elptr = (((void (*(*)))__pyx_v_data)[0]);
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":51 */
+ if (__Pyx_PrintItem(__pyx_k13p) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 51; goto __pyx_L1;}
+ __pyx_3 = (PyObject *)__pyx_v_elptr;
+ Py_INCREF(__pyx_3);
+ if (__Pyx_PrintItem(__pyx_3) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 51; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ if (__Pyx_PrintNewline() < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 51; goto __pyx_L1;}
+ goto __pyx_L7;
+ }
+ __pyx_1 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 52; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_1, __pyx_n_dtype); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 52; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 52; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_float64); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 52; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyTuple_New(1); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 52; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_1, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 52; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ if (PyObject_Cmp(__pyx_v_dtype, __pyx_2, &__pyx_5) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 52; goto __pyx_L1;}
+ __pyx_5 = __pyx_5 == 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__pyx_5) {
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":53 */
+ if (__Pyx_PrintItem(__pyx_k14p) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 53; goto __pyx_L1;}
+ __pyx_3 = PyFloat_FromDouble((((double (*))__pyx_v_data)[0])); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 53; goto __pyx_L1;}
+ if (__Pyx_PrintItem(__pyx_3) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 53; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ if (__Pyx_PrintNewline() < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 53; goto __pyx_L1;}
+ goto __pyx_L7;
+ }
+ __pyx_L7:;
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":54 */
+ __pyx_v_data = (__pyx_v_data + (__pyx_v_strides[0]));
+ }
+ goto __pyx_L3;
+ }
+ /*else*/ {
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":56 */
+ __pyx_6 = (__pyx_v_dimensions[0]);
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_6; ++__pyx_v_i) {
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":57 */
+ __pyx_4 = __pyx_f_6numpyx_print_elements(__pyx_v_data,(__pyx_v_strides + 1),(__pyx_v_dimensions + 1),(__pyx_v_nd - 1),__pyx_v_elsize,__pyx_v_dtype); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 57; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":58 */
+ __pyx_v_data = (__pyx_v_data + (__pyx_v_strides[0]));
+ }
+ }
+ __pyx_L3:;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ __Pyx_AddTraceback("numpyx.print_elements");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_dtype);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_n_any;
+
+static PyObject *__pyx_k15p;
+static PyObject *__pyx_k16p;
+static PyObject *__pyx_k17p;
+
+static char (__pyx_k15[]) = "arr.any() :";
+static char (__pyx_k16[]) = "arr.nd :";
+static char (__pyx_k17[]) = "arr.flags :";
+
+static PyObject *__pyx_f_6numpyx_test_methods(PyObject *__pyx_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6numpyx_test_methods[] = "Test a few attribute accesses for an array.\n \n This illustrates how the pyrex-visible object is in practice a strange\n hybrid of the C PyArrayObject struct and the python object. Some\n properties (like .nd) are visible here but not in python, while others\n like flags behave very differently: in python flags appears as a separate,\n object while here we see the raw int holding the bit pattern.\n\n This makes sense when we think of how pyrex resolves arr.foo: if foo is\n listed as a field in the c_numpy.ndarray struct description, it will be\n directly accessed as a C variable without going through Python at all.\n This is why for arr.flags, we see the actual int which holds all the flags\n as bit fields. However, for any other attribute not listed in the struct,\n it simply forwards the attribute lookup to python at runtime, just like\n python would (which means that AttributeError can be raised for\n non-existent attributes, for example).";
+static PyObject *__pyx_f_6numpyx_test_methods(PyObject *__pyx_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyArrayObject *__pyx_v_arr = 0;
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ PyObject *__pyx_2 = 0;
+ static char *__pyx_argnames[] = {"arr",0};
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O", __pyx_argnames, &__pyx_v_arr)) return 0;
+ Py_INCREF(__pyx_v_arr);
+ if (!__Pyx_ArgTypeTest(((PyObject *)__pyx_v_arr), __pyx_ptype_7c_numpy_ndarray, 1, "arr")) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 60; goto __pyx_L1;}
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":78 */
+ if (__Pyx_PrintItem(__pyx_k15p) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 78; goto __pyx_L1;}
+ __pyx_1 = PyObject_GetAttr(((PyObject *)__pyx_v_arr), __pyx_n_any); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 78; goto __pyx_L1;}
+ __pyx_2 = PyObject_CallObject(__pyx_1, 0); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 78; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ if (__Pyx_PrintItem(__pyx_2) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 78; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__Pyx_PrintNewline() < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 78; goto __pyx_L1;}
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":79 */
+ if (__Pyx_PrintItem(__pyx_k16p) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 79; goto __pyx_L1;}
+ __pyx_1 = PyInt_FromLong(__pyx_v_arr->nd); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 79; goto __pyx_L1;}
+ if (__Pyx_PrintItem(__pyx_1) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 79; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ if (__Pyx_PrintNewline() < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 79; goto __pyx_L1;}
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":80 */
+ if (__Pyx_PrintItem(__pyx_k17p) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 80; goto __pyx_L1;}
+ __pyx_2 = PyInt_FromLong(__pyx_v_arr->flags); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 80; goto __pyx_L1;}
+ if (__Pyx_PrintItem(__pyx_2) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 80; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__Pyx_PrintNewline() < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 80; goto __pyx_L1;}
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ Py_XDECREF(__pyx_2);
+ __Pyx_AddTraceback("numpyx.test_methods");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_arr);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_n_array;
+static PyObject *__pyx_n_arange;
+static PyObject *__pyx_n_shape;
+static PyObject *__pyx_n_one;
+static PyObject *__pyx_n_two;
+
+
+static PyObject *__pyx_f_6numpyx_test(PyObject *__pyx_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6numpyx_test[] = "this function is pure Python";
+static PyObject *__pyx_f_6numpyx_test(PyObject *__pyx_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_arr1;
+ PyObject *__pyx_v_arr2;
+ PyObject *__pyx_v_arr3;
+ PyObject *__pyx_v_four;
+ PyObject *__pyx_v_arr4;
+ PyObject *__pyx_v_arr5;
+ PyObject *__pyx_v_arr;
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {0};
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "", __pyx_argnames)) return 0;
+ __pyx_v_arr1 = Py_None; Py_INCREF(Py_None);
+ __pyx_v_arr2 = Py_None; Py_INCREF(Py_None);
+ __pyx_v_arr3 = Py_None; Py_INCREF(Py_None);
+ __pyx_v_four = Py_None; Py_INCREF(Py_None);
+ __pyx_v_arr4 = Py_None; Py_INCREF(Py_None);
+ __pyx_v_arr5 = Py_None; Py_INCREF(Py_None);
+ __pyx_v_arr = Py_None; Py_INCREF(Py_None);
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":84 */
+ __pyx_1 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 84; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_1, __pyx_n_array); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 84; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_1 = PyFloat_FromDouble((-1e-30)); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 84; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 84; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_1);
+ __pyx_1 = 0;
+ __pyx_1 = PyDict_New(); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 84; goto __pyx_L1;}
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 84; goto __pyx_L1;}
+ __pyx_5 = PyObject_GetAttr(__pyx_4, __pyx_n_float64); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 84; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ if (PyDict_SetItem(__pyx_1, __pyx_n_dtype, __pyx_5) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 84; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_4 = PyEval_CallObjectWithKeywords(__pyx_2, __pyx_3, __pyx_1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 84; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_v_arr1);
+ __pyx_v_arr1 = __pyx_4;
+ __pyx_4 = 0;
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":85 */
+ __pyx_5 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 85; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_5, __pyx_n_array); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 85; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_3 = PyFloat_FromDouble(1.0); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 85; goto __pyx_L1;}
+ __pyx_1 = PyFloat_FromDouble(2.0); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 85; goto __pyx_L1;}
+ __pyx_4 = PyFloat_FromDouble(3.0); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 85; goto __pyx_L1;}
+ __pyx_5 = PyList_New(3); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 85; goto __pyx_L1;}
+ PyList_SET_ITEM(__pyx_5, 0, __pyx_3);
+ PyList_SET_ITEM(__pyx_5, 1, __pyx_1);
+ PyList_SET_ITEM(__pyx_5, 2, __pyx_4);
+ __pyx_3 = 0;
+ __pyx_1 = 0;
+ __pyx_4 = 0;
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 85; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_1 = PyDict_New(); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 85; goto __pyx_L1;}
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 85; goto __pyx_L1;}
+ __pyx_5 = PyObject_GetAttr(__pyx_4, __pyx_n_float64); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 85; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ if (PyDict_SetItem(__pyx_1, __pyx_n_dtype, __pyx_5) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 85; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_4 = PyEval_CallObjectWithKeywords(__pyx_2, __pyx_3, __pyx_1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 85; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_v_arr2);
+ __pyx_v_arr2 = __pyx_4;
+ __pyx_4 = 0;
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":87 */
+ __pyx_5 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 87; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_5, __pyx_n_arange); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 87; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_3 = PyInt_FromLong(9); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 87; goto __pyx_L1;}
+ __pyx_1 = PyTuple_New(1); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 87; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_1, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_4 = PyDict_New(); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 87; goto __pyx_L1;}
+ __pyx_5 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 87; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_5, __pyx_n_float64); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 87; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (PyDict_SetItem(__pyx_4, __pyx_n_dtype, __pyx_3) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 87; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_5 = PyEval_CallObjectWithKeywords(__pyx_2, __pyx_1, __pyx_4); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 87; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_v_arr3);
+ __pyx_v_arr3 = __pyx_5;
+ __pyx_5 = 0;
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":88 */
+ __pyx_3 = PyInt_FromLong(3); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 88; goto __pyx_L1;}
+ __pyx_2 = PyInt_FromLong(3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 88; goto __pyx_L1;}
+ __pyx_1 = PyTuple_New(2); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 88; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_1, 0, __pyx_3);
+ PyTuple_SET_ITEM(__pyx_1, 1, __pyx_2);
+ __pyx_3 = 0;
+ __pyx_2 = 0;
+ if (PyObject_SetAttr(__pyx_v_arr3, __pyx_n_shape, __pyx_1) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 88; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":90 */
+ __pyx_4 = PyInt_FromLong(4); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 90; goto __pyx_L1;}
+ Py_DECREF(__pyx_v_four);
+ __pyx_v_four = __pyx_4;
+ __pyx_4 = 0;
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":91 */
+ __pyx_5 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 91; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_5, __pyx_n_array); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 91; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = PyInt_FromLong(3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 91; goto __pyx_L1;}
+ __pyx_1 = PyList_New(4); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 91; goto __pyx_L1;}
+ Py_INCREF(__pyx_n_one);
+ PyList_SET_ITEM(__pyx_1, 0, __pyx_n_one);
+ Py_INCREF(__pyx_n_two);
+ PyList_SET_ITEM(__pyx_1, 1, __pyx_n_two);
+ PyList_SET_ITEM(__pyx_1, 2, __pyx_2);
+ Py_INCREF(__pyx_v_four);
+ PyList_SET_ITEM(__pyx_1, 3, __pyx_v_four);
+ __pyx_2 = 0;
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 91; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_1);
+ __pyx_1 = 0;
+ __pyx_5 = PyDict_New(); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 91; goto __pyx_L1;}
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 91; goto __pyx_L1;}
+ __pyx_1 = PyObject_GetAttr(__pyx_2, __pyx_n_object_); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 91; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (PyDict_SetItem(__pyx_5, __pyx_n_dtype, __pyx_1) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 91; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_2 = PyEval_CallObjectWithKeywords(__pyx_3, __pyx_4, __pyx_5); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 91; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_v_arr4);
+ __pyx_v_arr4 = __pyx_2;
+ __pyx_2 = 0;
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":93 */
+ __pyx_1 = __Pyx_GetName(__pyx_m, __pyx_n_numpy); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 93; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_1, __pyx_n_array); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 93; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_4 = PyInt_FromLong(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 93; goto __pyx_L1;}
+ __pyx_5 = PyInt_FromLong(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 93; goto __pyx_L1;}
+ __pyx_2 = PyInt_FromLong(3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 93; goto __pyx_L1;}
+ __pyx_1 = PyList_New(3); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 93; goto __pyx_L1;}
+ PyList_SET_ITEM(__pyx_1, 0, __pyx_4);
+ PyList_SET_ITEM(__pyx_1, 1, __pyx_5);
+ PyList_SET_ITEM(__pyx_1, 2, __pyx_2);
+ __pyx_4 = 0;
+ __pyx_5 = 0;
+ __pyx_2 = 0;
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 93; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_1);
+ __pyx_1 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_4); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 93; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_v_arr5);
+ __pyx_v_arr5 = __pyx_5;
+ __pyx_5 = 0;
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":95 */
+ __pyx_2 = PyList_New(5); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 95; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_arr1);
+ PyList_SET_ITEM(__pyx_2, 0, __pyx_v_arr1);
+ Py_INCREF(__pyx_v_arr2);
+ PyList_SET_ITEM(__pyx_2, 1, __pyx_v_arr2);
+ Py_INCREF(__pyx_v_arr3);
+ PyList_SET_ITEM(__pyx_2, 2, __pyx_v_arr3);
+ Py_INCREF(__pyx_v_arr4);
+ PyList_SET_ITEM(__pyx_2, 3, __pyx_v_arr4);
+ Py_INCREF(__pyx_v_arr5);
+ PyList_SET_ITEM(__pyx_2, 4, __pyx_v_arr5);
+ __pyx_1 = PyObject_GetIter(__pyx_2); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 95; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ for (;;) {
+ __pyx_3 = PyIter_Next(__pyx_1);
+ if (!__pyx_3) {
+ if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 95; goto __pyx_L1;}
+ break;
+ }
+ Py_DECREF(__pyx_v_arr);
+ __pyx_v_arr = __pyx_3;
+ __pyx_3 = 0;
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":96 */
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n_print_array_info); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 96; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(1); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 96; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_arr);
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_v_arr);
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_5); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 96; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ }
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("numpyx.test");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_arr1);
+ Py_DECREF(__pyx_v_arr2);
+ Py_DECREF(__pyx_v_arr3);
+ Py_DECREF(__pyx_v_four);
+ Py_DECREF(__pyx_v_arr4);
+ Py_DECREF(__pyx_v_arr5);
+ Py_DECREF(__pyx_v_arr);
+ return __pyx_r;
+}
+
+static __Pyx_InternTabEntry __pyx_intern_tab[] = {
+ {&__pyx_n_any, "any"},
+ {&__pyx_n_arange, "arange"},
+ {&__pyx_n_array, "array"},
+ {&__pyx_n_c_numpy, "c_numpy"},
+ {&__pyx_n_c_python, "c_python"},
+ {&__pyx_n_dtype, "dtype"},
+ {&__pyx_n_float64, "float64"},
+ {&__pyx_n_name, "name"},
+ {&__pyx_n_numpy, "numpy"},
+ {&__pyx_n_object_, "object_"},
+ {&__pyx_n_one, "one"},
+ {&__pyx_n_print_array_info, "print_array_info"},
+ {&__pyx_n_shape, "shape"},
+ {&__pyx_n_test, "test"},
+ {&__pyx_n_test_methods, "test_methods"},
+ {&__pyx_n_two, "two"},
+ {0, 0}
+};
+
+static __Pyx_StringTabEntry __pyx_string_tab[] = {
+ {&__pyx_k2p, __pyx_k2, sizeof(__pyx_k2)},
+ {&__pyx_k3p, __pyx_k3, sizeof(__pyx_k3)},
+ {&__pyx_k4p, __pyx_k4, sizeof(__pyx_k4)},
+ {&__pyx_k5p, __pyx_k5, sizeof(__pyx_k5)},
+ {&__pyx_k6p, __pyx_k6, sizeof(__pyx_k6)},
+ {&__pyx_k7p, __pyx_k7, sizeof(__pyx_k7)},
+ {&__pyx_k8p, __pyx_k8, sizeof(__pyx_k8)},
+ {&__pyx_k9p, __pyx_k9, sizeof(__pyx_k9)},
+ {&__pyx_k10p, __pyx_k10, sizeof(__pyx_k10)},
+ {&__pyx_k11p, __pyx_k11, sizeof(__pyx_k11)},
+ {&__pyx_k12p, __pyx_k12, sizeof(__pyx_k12)},
+ {&__pyx_k13p, __pyx_k13, sizeof(__pyx_k13)},
+ {&__pyx_k14p, __pyx_k14, sizeof(__pyx_k14)},
+ {&__pyx_k15p, __pyx_k15, sizeof(__pyx_k15)},
+ {&__pyx_k16p, __pyx_k16, sizeof(__pyx_k16)},
+ {&__pyx_k17p, __pyx_k17, sizeof(__pyx_k17)},
+ {0, 0, 0}
+};
+
+static struct PyMethodDef __pyx_methods[] = {
+ {"print_array_info", (PyCFunction)__pyx_f_6numpyx_print_array_info, METH_VARARGS|METH_KEYWORDS, 0},
+ {"test_methods", (PyCFunction)__pyx_f_6numpyx_test_methods, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6numpyx_test_methods},
+ {"test", (PyCFunction)__pyx_f_6numpyx_test, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6numpyx_test},
+ {0, 0, 0, 0}
+};
+
+static void __pyx_init_filenames(void); /*proto*/
+
+PyMODINIT_FUNC initnumpyx(void); /*proto*/
+PyMODINIT_FUNC initnumpyx(void) {
+ PyObject *__pyx_1 = 0;
+ __pyx_init_filenames();
+ __pyx_m = Py_InitModule4("numpyx", __pyx_methods, 0, 0, PYTHON_API_VERSION);
+ if (!__pyx_m) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 3; goto __pyx_L1;};
+ __pyx_b = PyImport_AddModule("__builtin__");
+ if (!__pyx_b) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 3; goto __pyx_L1;};
+ if (PyObject_SetAttrString(__pyx_m, "__builtins__", __pyx_b) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 3; goto __pyx_L1;};
+ if (__Pyx_InternStrings(__pyx_intern_tab) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 3; goto __pyx_L1;};
+ if (__Pyx_InitStrings(__pyx_string_tab) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 3; goto __pyx_L1;};
+ __pyx_ptype_7c_numpy_dtype = __Pyx_ImportType("numpy", "dtype", sizeof(PyArray_Descr)); if (!__pyx_ptype_7c_numpy_dtype) {__pyx_filename = __pyx_f[1]; __pyx_lineno = 76; goto __pyx_L1;}
+ __pyx_ptype_7c_numpy_ndarray = __Pyx_ImportType("numpy", "ndarray", sizeof(PyArrayObject)); if (!__pyx_ptype_7c_numpy_ndarray) {__pyx_filename = __pyx_f[1]; __pyx_lineno = 81; goto __pyx_L1;}
+ __pyx_ptype_7c_numpy_flatiter = __Pyx_ImportType("numpy", "flatiter", sizeof(PyArrayIterObject)); if (!__pyx_ptype_7c_numpy_flatiter) {__pyx_filename = __pyx_f[1]; __pyx_lineno = 90; goto __pyx_L1;}
+ __pyx_ptype_7c_numpy_broadcast = __Pyx_ImportType("numpy", "broadcast", sizeof(PyArrayMultiIterObject)); if (!__pyx_ptype_7c_numpy_broadcast) {__pyx_filename = __pyx_f[1]; __pyx_lineno = 96; goto __pyx_L1;}
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":5 */
+ __pyx_1 = __Pyx_Import(__pyx_n_numpy, 0); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 5; goto __pyx_L1;}
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_numpy, __pyx_1) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 5; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":8 */
+ import_array();
+
+ /* "/Users/rkern/svn/numpy/numpy/doc/pyrex/numpyx.pyx":82 */
+ return;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ __Pyx_AddTraceback("numpyx");
+}
+
+static char *__pyx_filenames[] = {
+ "numpyx.pyx",
+ "c_numpy.pxd",
+};
+
+/* Runtime support code */
+
+static void __pyx_init_filenames(void) {
+ __pyx_f = __pyx_filenames;
+}
+
+static int __Pyx_ArgTypeTest(PyObject *obj, PyTypeObject *type, int none_allowed, char *name) {
+ if (!type) {
+ PyErr_Format(PyExc_SystemError, "Missing type object");
+ return 0;
+ }
+ if ((none_allowed && obj == Py_None) || PyObject_TypeCheck(obj, type))
+ return 1;
+ PyErr_Format(PyExc_TypeError,
+ "Argument '%s' has incorrect type (expected %s, got %s)",
+ name, type->tp_name, obj->ob_type->tp_name);
+ return 0;
+}
+
+static PyObject *__Pyx_Import(PyObject *name, PyObject *from_list) {
+ PyObject *__import__ = 0;
+ PyObject *empty_list = 0;
+ PyObject *module = 0;
+ PyObject *global_dict = 0;
+ PyObject *empty_dict = 0;
+ PyObject *list;
+ __import__ = PyObject_GetAttrString(__pyx_b, "__import__");
+ if (!__import__)
+ goto bad;
+ if (from_list)
+ list = from_list;
+ else {
+ empty_list = PyList_New(0);
+ if (!empty_list)
+ goto bad;
+ list = empty_list;
+ }
+ global_dict = PyModule_GetDict(__pyx_m);
+ if (!global_dict)
+ goto bad;
+ empty_dict = PyDict_New();
+ if (!empty_dict)
+ goto bad;
+ module = PyObject_CallFunction(__import__, "OOOO",
+ name, global_dict, empty_dict, list);
+bad:
+ Py_XDECREF(empty_list);
+ Py_XDECREF(__import__);
+ Py_XDECREF(empty_dict);
+ return module;
+}
+
+static PyObject *__Pyx_GetStdout(void) {
+ PyObject *f = PySys_GetObject("stdout");
+ if (!f) {
+ PyErr_SetString(PyExc_RuntimeError, "lost sys.stdout");
+ }
+ return f;
+}
+
+static int __Pyx_PrintItem(PyObject *v) {
+ PyObject *f;
+
+ if (!(f = __Pyx_GetStdout()))
+ return -1;
+ if (PyFile_SoftSpace(f, 1)) {
+ if (PyFile_WriteString(" ", f) < 0)
+ return -1;
+ }
+ if (PyFile_WriteObject(v, f, Py_PRINT_RAW) < 0)
+ return -1;
+ if (PyString_Check(v)) {
+ char *s = PyString_AsString(v);
+ int len = PyString_Size(v);
+ if (len > 0 &&
+ isspace(Py_CHARMASK(s[len-1])) &&
+ s[len-1] != ' ')
+ PyFile_SoftSpace(f, 0);
+ }
+ return 0;
+}
+
+static int __Pyx_PrintNewline(void) {
+ PyObject *f;
+
+ if (!(f = __Pyx_GetStdout()))
+ return -1;
+ if (PyFile_WriteString("\n", f) < 0)
+ return -1;
+ PyFile_SoftSpace(f, 0);
+ return 0;
+}
+
+static PyObject *__Pyx_GetName(PyObject *dict, PyObject *name) {
+ PyObject *result;
+ result = PyObject_GetAttr(dict, name);
+ if (!result)
+ PyErr_SetObject(PyExc_NameError, name);
+ return result;
+}
+
+static int __Pyx_InternStrings(__Pyx_InternTabEntry *t) {
+ while (t->p) {
+ *t->p = PyString_InternFromString(t->s);
+ if (!*t->p)
+ return -1;
+ ++t;
+ }
+ return 0;
+}
+
+static int __Pyx_InitStrings(__Pyx_StringTabEntry *t) {
+ while (t->p) {
+ *t->p = PyString_FromStringAndSize(t->s, t->n - 1);
+ if (!*t->p)
+ return -1;
+ ++t;
+ }
+ return 0;
+}
+
+static PyTypeObject *__Pyx_ImportType(char *module_name, char *class_name,
+ long size)
+{
+ PyObject *py_module_name = 0;
+ PyObject *py_class_name = 0;
+ PyObject *py_name_list = 0;
+ PyObject *py_module = 0;
+ PyObject *result = 0;
+
+ py_module_name = PyString_FromString(module_name);
+ if (!py_module_name)
+ goto bad;
+ py_class_name = PyString_FromString(class_name);
+ if (!py_class_name)
+ goto bad;
+ py_name_list = PyList_New(1);
+ if (!py_name_list)
+ goto bad;
+ Py_INCREF(py_class_name);
+ if (PyList_SetItem(py_name_list, 0, py_class_name) < 0)
+ goto bad;
+ py_module = __Pyx_Import(py_module_name, py_name_list);
+ if (!py_module)
+ goto bad;
+ result = PyObject_GetAttr(py_module, py_class_name);
+ if (!result)
+ goto bad;
+ if (!PyType_Check(result)) {
+ PyErr_Format(PyExc_TypeError,
+ "%s.%s is not a type object",
+ module_name, class_name);
+ goto bad;
+ }
+ if (((PyTypeObject *)result)->tp_basicsize != size) {
+ PyErr_Format(PyExc_ValueError,
+ "%s.%s does not appear to be the correct type object",
+ module_name, class_name);
+ goto bad;
+ }
+ goto done;
+bad:
+ Py_XDECREF(result);
+ result = 0;
+done:
+ Py_XDECREF(py_module_name);
+ Py_XDECREF(py_class_name);
+ Py_XDECREF(py_name_list);
+ return (PyTypeObject *)result;
+}
+
+#include "compile.h"
+#include "frameobject.h"
+#include "traceback.h"
+
+static void __Pyx_AddTraceback(char *funcname) {
+ PyObject *py_srcfile = 0;
+ PyObject *py_funcname = 0;
+ PyObject *py_globals = 0;
+ PyObject *empty_tuple = 0;
+ PyObject *empty_string = 0;
+ PyCodeObject *py_code = 0;
+ PyFrameObject *py_frame = 0;
+
+ py_srcfile = PyString_FromString(__pyx_filename);
+ if (!py_srcfile) goto bad;
+ py_funcname = PyString_FromString(funcname);
+ if (!py_funcname) goto bad;
+ py_globals = PyModule_GetDict(__pyx_m);
+ if (!py_globals) goto bad;
+ empty_tuple = PyTuple_New(0);
+ if (!empty_tuple) goto bad;
+ empty_string = PyString_FromString("");
+ if (!empty_string) goto bad;
+ py_code = PyCode_New(
+ 0, /*int argcount,*/
+ 0, /*int nlocals,*/
+ 0, /*int stacksize,*/
+ 0, /*int flags,*/
+ empty_string, /*PyObject *code,*/
+ empty_tuple, /*PyObject *consts,*/
+ empty_tuple, /*PyObject *names,*/
+ empty_tuple, /*PyObject *varnames,*/
+ empty_tuple, /*PyObject *freevars,*/
+ empty_tuple, /*PyObject *cellvars,*/
+ py_srcfile, /*PyObject *filename,*/
+ py_funcname, /*PyObject *name,*/
+ __pyx_lineno, /*int firstlineno,*/
+ empty_string /*PyObject *lnotab*/
+ );
+ if (!py_code) goto bad;
+ py_frame = PyFrame_New(
+ PyThreadState_Get(), /*PyThreadState *tstate,*/
+ py_code, /*PyCodeObject *code,*/
+ py_globals, /*PyObject *globals,*/
+ 0 /*PyObject *locals*/
+ );
+ if (!py_frame) goto bad;
+ py_frame->f_lineno = __pyx_lineno;
+ PyTraceBack_Here(py_frame);
+bad:
+ Py_XDECREF(py_srcfile);
+ Py_XDECREF(py_funcname);
+ Py_XDECREF(empty_tuple);
+ Py_XDECREF(empty_string);
+ Py_XDECREF(py_code);
+ Py_XDECREF(py_frame);
+}
diff --git a/numpy/doc/pyrex/numpyx.pyx b/numpy/doc/pyrex/numpyx.pyx
new file mode 100644
index 000000000..8089fbc38
--- /dev/null
+++ b/numpy/doc/pyrex/numpyx.pyx
@@ -0,0 +1,97 @@
+# -*- Mode: Python -*- Not really, but close enough
+
+cimport c_python
+cimport c_numpy
+import numpy
+
+# Numpy must be initialized
+c_numpy.import_array()
+
+def print_array_info(c_numpy.ndarray arr):
+ cdef int i
+
+ print '-='*10
+ print 'printing array info for ndarray at 0x%0lx'%(<c_python.Py_intptr_t>arr,)
+ print 'print number of dimensions:',arr.nd
+ print 'address of strides: 0x%0lx'%(<c_python.Py_intptr_t>arr.strides,)
+ print 'strides:'
+ for i from 0<=i<arr.nd:
+ # print each stride
+ print ' stride %d:'%i,<c_python.Py_intptr_t>arr.strides[i]
+ print 'memory dump:'
+ print_elements( arr.data, arr.strides, arr.dimensions,
+ arr.nd, sizeof(double), arr.dtype )
+ print '-='*10
+ print
+
+cdef print_elements(char *data,
+ c_python.Py_intptr_t* strides,
+ c_python.Py_intptr_t* dimensions,
+ int nd,
+ int elsize,
+ object dtype):
+ cdef c_python.Py_intptr_t i,j
+ cdef void* elptr
+
+ if dtype not in [numpy.dtype(numpy.object_),
+ numpy.dtype(numpy.float64)]:
+ print ' print_elements() not (yet) implemented for dtype %s'%dtype.name
+ return
+
+ if nd ==0:
+ if dtype==numpy.dtype(numpy.object_):
+ elptr = (<void**>data)[0] #[0] dereferences pointer in Pyrex
+ print ' ',<object>elptr
+ elif dtype==numpy.dtype(numpy.float64):
+ print ' ',(<double*>data)[0]
+ elif nd == 1:
+ for i from 0<=i<dimensions[0]:
+ if dtype==numpy.dtype(numpy.object_):
+ elptr = (<void**>data)[0]
+ print ' ',<object>elptr
+ elif dtype==numpy.dtype(numpy.float64):
+ print ' ',(<double*>data)[0]
+ data = data + strides[0]
+ else:
+ for i from 0<=i<dimensions[0]:
+ print_elements(data, strides+1, dimensions+1, nd-1, elsize, dtype)
+ data = data + strides[0]
+
+def test_methods(c_numpy.ndarray arr):
+ """Test a few attribute accesses for an array.
+
+ This illustrates how the pyrex-visible object is in practice a strange
+ hybrid of the C PyArrayObject struct and the python object. Some
+ properties (like .nd) are visible here but not in python, while others
+ like flags behave very differently: in python flags appears as a separate,
+ object while here we see the raw int holding the bit pattern.
+
+ This makes sense when we think of how pyrex resolves arr.foo: if foo is
+ listed as a field in the c_numpy.ndarray struct description, it will be
+ directly accessed as a C variable without going through Python at all.
+ This is why for arr.flags, we see the actual int which holds all the flags
+ as bit fields. However, for any other attribute not listed in the struct,
+ it simply forwards the attribute lookup to python at runtime, just like
+ python would (which means that AttributeError can be raised for
+ non-existent attributes, for example)."""
+
+ print 'arr.any() :',arr.any()
+ print 'arr.nd :',arr.nd
+ print 'arr.flags :',arr.flags
+
+def test():
+ """this function is pure Python"""
+ arr1 = numpy.array(-1e-30,dtype=numpy.float64)
+ arr2 = numpy.array([1.0,2.0,3.0],dtype=numpy.float64)
+
+ arr3 = numpy.arange(9,dtype=numpy.float64)
+ arr3.shape = 3,3
+
+ four = 4
+ arr4 = numpy.array(['one','two',3,four],dtype=numpy.object_)
+
+ arr5 = numpy.array([1,2,3]) # int types not (yet) supported by print_elements
+
+ for arr in [arr1,arr2,arr3,arr4,arr5]:
+ print_array_info(arr)
+
diff --git a/numpy/doc/pyrex/run_test.py b/numpy/doc/pyrex/run_test.py
new file mode 100755
index 000000000..96388011e
--- /dev/null
+++ b/numpy/doc/pyrex/run_test.py
@@ -0,0 +1,3 @@
+#!/usr/bin/env python
+from numpyx import test
+test()
diff --git a/numpy/doc/pyrex/setup.py b/numpy/doc/pyrex/setup.py
new file mode 100644
index 000000000..79fa363fa
--- /dev/null
+++ b/numpy/doc/pyrex/setup.py
@@ -0,0 +1,42 @@
+#!/usr/bin/env python
+"""Install file for example on how to use Pyrex with Numpy.
+
+For more details, see:
+http://www.scipy.org/Cookbook/Pyrex_and_NumPy
+http://www.scipy.org/Cookbook/ArrayStruct_and_Pyrex
+"""
+
+from distutils.core import setup
+from distutils.extension import Extension
+
+# Make this usable by people who don't have pyrex installed (I've committed
+# the generated C sources to SVN).
+try:
+ from Pyrex.Distutils import build_ext
+ has_pyrex = True
+except ImportError:
+ has_pyrex = False
+
+import numpy
+
+# Define a pyrex-based extension module, using the generated sources if pyrex
+# is not available.
+if has_pyrex:
+ pyx_sources = ['numpyx.pyx']
+ cmdclass = {'build_ext': build_ext}
+else:
+ pyx_sources = ['numpyx.c']
+ cmdclass = {}
+
+
+pyx_ext = Extension('numpyx',
+ pyx_sources,
+ include_dirs = [numpy.get_include()])
+
+# Call the routine which does the real work
+setup(name = 'numpyx',
+ description = 'Small example on using Pyrex to write a Numpy extension',
+ url = 'http://www.scipy.org/Cookbook/Pyrex_and_NumPy',
+ ext_modules = [pyx_ext],
+ cmdclass = cmdclass,
+ )
diff --git a/numpy/doc/records.txt b/numpy/doc/records.txt
new file mode 100644
index 000000000..faa0bfe3b
--- /dev/null
+++ b/numpy/doc/records.txt
@@ -0,0 +1,86 @@
+
+The ndarray supports records intrinsically.
+None of the default descriptors have fields defined, but you can create new
+descriptors easily. The ndarray even supports nested arrays of records inside
+of a record. Any record that the array protocol can describe can be represented.
+The ndarray also supports partial field descriptors. Not every byte has to be
+accounted for.
+
+This was done by adding to the established PyArray_Descr * structure:
+
+1) a PyObject *fields member which contains a dictionary of
+"field name" : (PyArray_Descr *field-type, offset, [optional field title]).
+If a title is given, then it is also inserted into the dictionary and used to
+key the same entry.
+
+2) A byteorder member. By default this is '=' (native), or '|' (not-applicable).
+
+3) An additional PyArray_ArrDescr *member of the structure which
+contains a simple representation of an array of another base-type.
+types. The PyArray_ArrayDescr structure has members PyArray_Descr *,
+PyObject *, for holding a reference to the base-type and the shape of
+the sub-array.
+
+4) The PyArray_Descr * as official Python object that fully describes
+a region of memory for the data
+
+
+Data type conversions: We can support additional data-type
+conversions. The data-type passed in is converted to a PyArray_Descr*
+object.
+
+New possibilities for the "data-type"
+
+List [data-type 1, data-type 2, ..., data-type n]
+===============================
+Equivalent to {'names':['f1','f2',...,'fn'],
+ 'formats': [data-type 1, data-type 2, ..., data-type n]}
+
+This is a quick way to specify a record format with default field names.
+
+
+Tuple (flexible type, itemsize)
+ (fixed type, shape)
+===============================
+
+Get converted to a new PyArray_Descr * object with a flexible
+type. The latter structure also sets the PyArray_ArrayDescr field of the
+returned PyArray_Descr *.
+
+
+Dictionary (keys "names", "titles", and "formats")
+===============================
+
+This will be converted to a PyArray_VOID type with corresponding
+fields parameter (the formats list will be converted to actual
+PyArray_Descr * objects).
+
+
+Objects (anything with an .itemsize and .fields attribute)
+===============================
+
+If its an instance of (a sub-class of) void type, then a new
+PyArray_Descr* structure is created corresponding to its typeobject
+(and PyArray_VOID) typenumber. If the type is registered, then the
+registered type-number is used.
+
+otherwise a new PyArray_VOID PyArray_Descr* structure is created and
+filled ->elsize and ->fields filled in appropriately.
+
+The itemsize attribute must return a number > 0
+The fields attribute must return a dictionary with at least
+"names" and "formats" entries. The "formats" entry will be
+converted to a "proper" descr->fields entry (all generic data-types
+converted to PyArray_Descr * structure).
+
+
+Reference counting for PyArray_Descr * objects.
+
+Most functions that take PyArary_Descr * as arguments and return a PyObject *
+steal the reference unless otherwise noted in the code:
+
+Functions that return PyArray_Descr * objects return a new reference.
+
+There is a new function and a new method of array objects both labelled
+dtypescr which can be used to try out the PyArray_DescrConverter.
+
diff --git a/numpy/doc/swig/Makefile b/numpy/doc/swig/Makefile
new file mode 100644
index 000000000..fc99a959f
--- /dev/null
+++ b/numpy/doc/swig/Makefile
@@ -0,0 +1,62 @@
+# SWIG
+INTERFACES = Vector.i Matrix.i Tensor.i
+WRAPPERS = $(INTERFACES:.i=_wrap.cxx)
+PROXIES = $(INTERFACES:.i=.py )
+
+# ReStructured Text
+RST2HTML = rst2html.py
+RST2LATEX = rst2latex.py
+RFLAGS = --generator --time
+HTML_FLAGS = --no-xml-declaration
+LATEX_FLAGS =
+LATEX = pdflatex
+
+# Web pages that need to be made
+WEB_PAGES = numpy_swig.html testing.html
+
+# LaTeX files that need to be made
+LATEX_FILES = numpy_swig.tex testing.tex
+
+# PDF files that need to be made
+PDF_FILES = numpy_swig.pdf testing.pdf
+
+# List all of the subdirectories here for recursive make
+SUBDIRS =
+
+all: $(WRAPPERS) Vector.cxx Vector.h Matrix.cxx Matrix.h Tensor.cxx Tensor.h
+ ./setup.py build
+
+test: all
+ testVector.py
+ testMatrix.py
+ testTensor.py
+
+doc: html pdf
+
+%_wrap.cxx: %.i %.h numpy.i
+ swig -c++ -python $<
+
+html: $(WEB_PAGES)
+
+%.html: %.txt
+ $(RST2HTML) $(RFLAGS) $(HTML_FLAGS) $< $@
+
+tex: $(LATEX_FILES)
+
+%.tex: %.txt
+ $(RST2LATEX) $(RFLAGS) $(LATEX_FLAGS) $< $@
+
+pdf: $(PDF_FILES)
+
+%.pdf: %.tex
+ $(LATEX) $<
+ $(LATEX) $<
+
+clean:
+ $(RM) -r build
+ $(RM) $(WRAPPERS)
+ $(RM) $(PROXIES)
+ $(RM) $(LATEX_FILES)
+ $(RM) *.pyc *.aux *.dvi *.log *.out *~
+
+.PHONY : all test doc html tex pdf clean
diff --git a/numpy/doc/swig/Matrix.cxx b/numpy/doc/swig/Matrix.cxx
new file mode 100644
index 000000000..b953d7017
--- /dev/null
+++ b/numpy/doc/swig/Matrix.cxx
@@ -0,0 +1,112 @@
+#include <stdlib.h>
+#include <math.h>
+#include <iostream>
+#include "Matrix.h"
+
+// The following macro defines a family of functions that work with 2D
+// arrays with the forms
+//
+// TYPE SNAMEDet( TYPE matrix[2][2]);
+// TYPE SNAMEMax( TYPE * matrix, int rows, int cols);
+// TYPE SNAMEMin( int rows, int cols, TYPE * matrix);
+// void SNAMEScale( TYPE matrix[3][3]);
+// void SNAMEFloor( TYPE * array, int rows, int cols, TYPE floor);
+// void SNAMECeil( int rows, int cols, TYPE * array, TYPE ceil);
+// void SNAMELUSplit(TYPE in[3][3], TYPE lower[3][3], TYPE upper[3][3]);
+//
+// for any specified type TYPE (for example: short, unsigned int, long
+// long, etc.) with given short name SNAME (for example: short, uint,
+// longLong, etc.). The macro is then expanded for the given
+// TYPE/SNAME pairs. The resulting functions are for testing numpy
+// interfaces, respectively, for:
+//
+// * 2D input arrays, hard-coded length
+// * 2D input arrays
+// * 2D input arrays, data last
+// * 2D in-place arrays, hard-coded lengths
+// * 2D in-place arrays
+// * 2D in-place arrays, data last
+// * 2D argout arrays, hard-coded length
+//
+#define TEST_FUNCS(TYPE, SNAME) \
+\
+TYPE SNAME ## Det(TYPE matrix[2][2]) { \
+ return matrix[0][0]*matrix[1][1] - matrix[0][1]*matrix[1][0]; \
+} \
+\
+TYPE SNAME ## Max(TYPE * matrix, int rows, int cols) { \
+ int i, j, index; \
+ TYPE result = matrix[0]; \
+ for (j=0; j<cols; ++j) { \
+ for (i=0; i<rows; ++i) { \
+ index = j*rows + i; \
+ if (matrix[index] > result) result = matrix[index]; \
+ } \
+ } \
+ return result; \
+} \
+\
+TYPE SNAME ## Min(int rows, int cols, TYPE * matrix) { \
+ int i, j, index; \
+ TYPE result = matrix[0]; \
+ for (j=0; j<cols; ++j) { \
+ for (i=0; i<rows; ++i) { \
+ index = j*rows + i; \
+ if (matrix[index] < result) result = matrix[index]; \
+ } \
+ } \
+ return result; \
+} \
+\
+void SNAME ## Scale(TYPE array[3][3], TYPE val) { \
+ for (int i=0; i<3; ++i) \
+ for (int j=0; j<3; ++j) \
+ array[i][j] *= val; \
+} \
+\
+void SNAME ## Floor(TYPE * array, int rows, int cols, TYPE floor) { \
+ int i, j, index; \
+ for (j=0; j<cols; ++j) { \
+ for (i=0; i<rows; ++i) { \
+ index = j*rows + i; \
+ if (array[index] < floor) array[index] = floor; \
+ } \
+ } \
+} \
+\
+void SNAME ## Ceil(int rows, int cols, TYPE * array, TYPE ceil) { \
+ int i, j, index; \
+ for (j=0; j<cols; ++j) { \
+ for (i=0; i<rows; ++i) { \
+ index = j*rows + i; \
+ if (array[index] > ceil) array[index] = ceil; \
+ } \
+ } \
+} \
+\
+void SNAME ## LUSplit(TYPE matrix[3][3], TYPE lower[3][3], TYPE upper[3][3]) { \
+ for (int i=0; i<3; ++i) { \
+ for (int j=0; j<3; ++j) { \
+ if (i >= j) { \
+ lower[i][j] = matrix[i][j]; \
+ upper[i][j] = 0; \
+ } else { \
+ lower[i][j] = 0; \
+ upper[i][j] = matrix[i][j]; \
+ } \
+ } \
+ } \
+}
+
+TEST_FUNCS(signed char , schar )
+TEST_FUNCS(unsigned char , uchar )
+TEST_FUNCS(short , short )
+TEST_FUNCS(unsigned short , ushort )
+TEST_FUNCS(int , int )
+TEST_FUNCS(unsigned int , uint )
+TEST_FUNCS(long , long )
+TEST_FUNCS(unsigned long , ulong )
+TEST_FUNCS(long long , longLong )
+TEST_FUNCS(unsigned long long, ulongLong)
+TEST_FUNCS(float , float )
+TEST_FUNCS(double , double )
diff --git a/numpy/doc/swig/Matrix.h b/numpy/doc/swig/Matrix.h
new file mode 100644
index 000000000..f37836cc4
--- /dev/null
+++ b/numpy/doc/swig/Matrix.h
@@ -0,0 +1,52 @@
+#ifndef MATRIX_H
+#define MATRIX_H
+
+// The following macro defines the prototypes for a family of
+// functions that work with 2D arrays with the forms
+//
+// TYPE SNAMEDet( TYPE matrix[2][2]);
+// TYPE SNAMEMax( TYPE * matrix, int rows, int cols);
+// TYPE SNAMEMin( int rows, int cols, TYPE * matrix);
+// void SNAMEScale( TYPE array[3][3]);
+// void SNAMEFloor( TYPE * array, int rows, int cols, TYPE floor);
+// void SNAMECeil( int rows, int cols, TYPE * array, TYPE ceil );
+// void SNAMELUSplit(TYPE in[3][3], TYPE lower[3][3], TYPE upper[3][3]);
+//
+// for any specified type TYPE (for example: short, unsigned int, long
+// long, etc.) with given short name SNAME (for example: short, uint,
+// longLong, etc.). The macro is then expanded for the given
+// TYPE/SNAME pairs. The resulting functions are for testing numpy
+// interfaces, respectively, for:
+//
+// * 2D input arrays, hard-coded lengths
+// * 2D input arrays
+// * 2D input arrays, data last
+// * 2D in-place arrays, hard-coded lengths
+// * 2D in-place arrays
+// * 2D in-place arrays, data last
+// * 2D argout arrays, hard-coded length
+//
+#define TEST_FUNC_PROTOS(TYPE, SNAME) \
+\
+TYPE SNAME ## Det( TYPE matrix[2][2]); \
+TYPE SNAME ## Max( TYPE * matrix, int rows, int cols); \
+TYPE SNAME ## Min( int rows, int cols, TYPE * matrix); \
+void SNAME ## Scale( TYPE array[3][3], TYPE val); \
+void SNAME ## Floor( TYPE * array, int rows, int cols, TYPE floor); \
+void SNAME ## Ceil( int rows, int cols, TYPE * array, TYPE ceil ); \
+void SNAME ## LUSplit(TYPE matrix[3][3], TYPE lower[3][3], TYPE upper[3][3]);
+
+TEST_FUNC_PROTOS(signed char , schar )
+TEST_FUNC_PROTOS(unsigned char , uchar )
+TEST_FUNC_PROTOS(short , short )
+TEST_FUNC_PROTOS(unsigned short , ushort )
+TEST_FUNC_PROTOS(int , int )
+TEST_FUNC_PROTOS(unsigned int , uint )
+TEST_FUNC_PROTOS(long , long )
+TEST_FUNC_PROTOS(unsigned long , ulong )
+TEST_FUNC_PROTOS(long long , longLong )
+TEST_FUNC_PROTOS(unsigned long long, ulongLong)
+TEST_FUNC_PROTOS(float , float )
+TEST_FUNC_PROTOS(double , double )
+
+#endif
diff --git a/numpy/doc/swig/Matrix.i b/numpy/doc/swig/Matrix.i
new file mode 100644
index 000000000..4e14b138d
--- /dev/null
+++ b/numpy/doc/swig/Matrix.i
@@ -0,0 +1,45 @@
+// -*- c++ -*-
+%module Matrix
+
+%{
+#define SWIG_FILE_WITH_INIT
+#include "Matrix.h"
+%}
+
+// Get the NumPy typemaps
+%include "numpy.i"
+
+%init %{
+ import_array();
+%}
+
+%define %apply_numpy_typemaps(TYPE)
+
+%apply (TYPE IN_ARRAY2[ANY][ANY]) {(TYPE matrix[ANY][ANY])};
+%apply (TYPE* IN_ARRAY2, int DIM1, int DIM2) {(TYPE* matrix, int rows, int cols)};
+%apply (int DIM1, int DIM2, TYPE* IN_ARRAY2) {(int rows, int cols, TYPE* matrix)};
+
+%apply (TYPE INPLACE_ARRAY2[ANY][ANY]) {(TYPE array[3][3])};
+%apply (TYPE* INPLACE_ARRAY2, int DIM1, int DIM2) {(TYPE* array, int rows, int cols)};
+%apply (int DIM1, int DIM2, TYPE* INPLACE_ARRAY2) {(int rows, int cols, TYPE* array)};
+
+%apply (TYPE ARGOUT_ARRAY2[ANY][ANY]) {(TYPE lower[3][3])};
+%apply (TYPE ARGOUT_ARRAY2[ANY][ANY]) {(TYPE upper[3][3])};
+
+%enddef /* %apply_numpy_typemaps() macro */
+
+%apply_numpy_typemaps(signed char )
+%apply_numpy_typemaps(unsigned char )
+%apply_numpy_typemaps(short )
+%apply_numpy_typemaps(unsigned short )
+%apply_numpy_typemaps(int )
+%apply_numpy_typemaps(unsigned int )
+%apply_numpy_typemaps(long )
+%apply_numpy_typemaps(unsigned long )
+%apply_numpy_typemaps(long long )
+%apply_numpy_typemaps(unsigned long long)
+%apply_numpy_typemaps(float )
+%apply_numpy_typemaps(double )
+
+// Include the header file to be wrapped
+%include "Matrix.h"
diff --git a/numpy/doc/swig/README b/numpy/doc/swig/README
new file mode 100644
index 000000000..40d7f9636
--- /dev/null
+++ b/numpy/doc/swig/README
@@ -0,0 +1,121 @@
+Notes for the numpy/doc/swig directory
+======================================
+
+This set of files is for developing and testing file numpy.i, which is
+intended to be a set of typemaps for helping SWIG interface between C
+and C++ code that uses C arrays and the python module NumPy. It is
+ultimately hoped that numpy.i will be included as part of the SWIG
+distribution.
+
+In the spirit of "writing your tests first", I will begin by
+describing the tests, as they are a good example of what we are trying
+to do with numpy.i. The files related to testing are::
+
+ Vector.h
+ Vector.cxx
+ Vector.i
+ testVector.py
+
+ Matrix.h
+ Matrix.cxx
+ Matrix.i
+ testMatrix.py
+
+ Tensor.h
+ Tensor.cxx
+ Tensor.i
+ testTensor.py
+
+The header files contain prototypes for functions that illustrate the
+wrapping issues we wish to address. Right now, this consists of
+functions with argument signatures of the following forms. Vector.h::
+
+ (type IN_ARRAY1[ANY])
+ (type* IN_ARRAY1, int DIM1)
+ (int DIM1, type* IN_ARRAY1)
+
+ (type INPLACE_ARRAY1[ANY])
+ (type* INPLACE_ARRAY1, int DIM1)
+ (int DIM1, type* INPLACE_ARRAY1)
+
+ (type ARGOUT_ARRAY1[ANY])
+ (type* ARGOUT_ARRAY1, int DIM1)
+ (int DIM1, type* ARGOUT_ARRAY1)
+
+Matrix.h::
+
+ (type IN_ARRAY2[ANY][ANY])
+ (type* IN_ARRAY2, int DIM1, int DIM2)
+ (int DIM1, int DIM2, type* IN_ARRAY2)
+
+ (type INPLACE_ARRAY2[ANY][ANY])
+ (type* INPLACE_ARRAY2, int DIM1, int DIM2)
+ (int DIM1, int DIM2, type* INPLACE_ARRAY2)
+
+ (type ARGOUT_ARRAY2[ANY][ANY])
+
+Tensor.h::
+
+ (type IN_ARRAY3[ANY][ANY][ANY])
+ (type* IN_ARRAY3, int DIM1, int DIM2, int DIM3)
+ (int DIM1, int DIM2, int DIM3, type* IN_ARRAY3)
+
+ (type INPLACE_ARRAY3[ANY][ANY][ANY])
+ (type* INPLACE_ARRAY3, int DIM1, int DIM2, int DIM3)
+ (int DIM1, int DIM2, int DIM3, type* INPLACE_ARRAY3)
+
+ (type ARGOUT_ARRAY3[ANY][ANY][ANY])
+
+These function signatures take a pointer to an array of type "type",
+whose length is specified by the integer(s) DIM1 (and DIM2, and DIM3).
+
+The objective for the IN_ARRAY signatures is for SWIG to generate
+python wrappers that take a container that constitutes a valid
+argument to the numpy array constructor, and can be used to build an
+array of type "type". Currently, types "signed char", "unsigned
+char", "short", "unsigned short", "int", "unsigned int", "long",
+"unsigned long", "long long", "unsigned long long", "float", and
+"double" are supported and tested.
+
+The objective for the INPLACE_ARRAY signatures is for SWIG to generate
+python wrappers that accept a numpy array of any of the above-listed
+types.
+
+The source files Vector.cxx, Matrix.cxx and Tensor.cxx contain the
+actual implementations of the functions described in Vector.h,
+Matrix.h and Tensor.h. The python scripts testVector.py,
+testMatrix.py and testTensor.py test the resulting python wrappers
+using the unittest module.
+
+The SWIG interface files Vector.i, Matrix.i and Tensor.i are used to
+generate the wrapper code. The SWIG_FILE_WITH_INIT macro allows
+numpy.i to be used with multiple python modules. If it is specified,
+then the %init block found in Vector.i, Matrix.i and Tensor.i are
+required. The other things done in Vector.i, Matrix.i and Tensor.i
+are the inclusion of the appropriate header file and numpy.i file, and
+the "%apply" directives to force the functions to use the typemaps.
+
+The setup.py script is a standard python distutils script. It defines
+_Vector, _Matrix and _Tensor extension modules and Vector, Matrix and
+Tensor python modules. The Makefile automates everything, setting up
+the dependencies, calling swig to generate the wrappers, and calling
+setup.py to compile the wrapper code and generate the shared objects.
+Targets "all" (default), "test", "doc" and "clean" are supported. The
+"doc" target creates HTML documentation (with make target "html"), and
+PDF documentation (with make targets "tex" and "pdf").
+
+To build and run the test code, simply execute from the shell::
+
+ $ make
+ $ make test
+
+================================================================================
+
+ToDo
+----
+
+ * Add ARGOUT typemaps that assume the function allocates the buffers
+ internally.
+
+ * Add "naked" typemaps for argument lists that do not specify
+ dimensions.
diff --git a/numpy/doc/swig/Tensor.cxx b/numpy/doc/swig/Tensor.cxx
new file mode 100644
index 000000000..dce595291
--- /dev/null
+++ b/numpy/doc/swig/Tensor.cxx
@@ -0,0 +1,131 @@
+#include <stdlib.h>
+#include <math.h>
+#include <iostream>
+#include "Tensor.h"
+
+// The following macro defines a family of functions that work with 3D
+// arrays with the forms
+//
+// TYPE SNAMENorm( TYPE tensor[2][2][2]);
+// TYPE SNAMEMax( TYPE * tensor, int rows, int cols, int num);
+// TYPE SNAMEMin( int rows, int cols, int num, TYPE * tensor);
+// void SNAMEScale( TYPE tensor[3][3][3]);
+// void SNAMEFloor( TYPE * array, int rows, int cols, int num, TYPE floor);
+// void SNAMECeil( int rows, int cols, int num, TYPE * array, TYPE ceil);
+// void SNAMELUSplit(TYPE in[2][2][2], TYPE lower[2][2][2], TYPE upper[2][2][2]);
+//
+// for any specified type TYPE (for example: short, unsigned int, long
+// long, etc.) with given short name SNAME (for example: short, uint,
+// longLong, etc.). The macro is then expanded for the given
+// TYPE/SNAME pairs. The resulting functions are for testing numpy
+// interfaces, respectively, for:
+//
+// * 3D input arrays, hard-coded length
+// * 3D input arrays
+// * 3D input arrays, data last
+// * 3D in-place arrays, hard-coded lengths
+// * 3D in-place arrays
+// * 3D in-place arrays, data last
+// * 3D argout arrays, hard-coded length
+//
+#define TEST_FUNCS(TYPE, SNAME) \
+\
+TYPE SNAME ## Norm(TYPE tensor[2][2][2]) { \
+ double result = 0; \
+ for (int k=0; k<2; ++k) \
+ for (int j=0; j<2; ++j) \
+ for (int i=0; i<2; ++i) \
+ result += tensor[i][j][k] * tensor[i][j][k]; \
+ return (TYPE)sqrt(result/8); \
+} \
+\
+TYPE SNAME ## Max(TYPE * tensor, int rows, int cols, int num) { \
+ int i, j, k, index; \
+ TYPE result = tensor[0]; \
+ for (k=0; k<num; ++k) { \
+ for (j=0; j<cols; ++j) { \
+ for (i=0; i<rows; ++i) { \
+ index = k*rows*cols + j*rows + i; \
+ if (tensor[index] > result) result = tensor[index]; \
+ } \
+ } \
+ } \
+ return result; \
+} \
+\
+TYPE SNAME ## Min(int rows, int cols, int num, TYPE * tensor) { \
+ int i, j, k, index; \
+ TYPE result = tensor[0]; \
+ for (k=0; k<num; ++k) { \
+ for (j=0; j<cols; ++j) { \
+ for (i=0; i<rows; ++i) { \
+ index = k*rows*cols + j*rows + i; \
+ if (tensor[index] < result) result = tensor[index]; \
+ } \
+ } \
+ } \
+ return result; \
+} \
+\
+void SNAME ## Scale(TYPE array[3][3][3], TYPE val) { \
+ for (int i=0; i<3; ++i) \
+ for (int j=0; j<3; ++j) \
+ for (int k=0; k<3; ++k) \
+ array[i][j][k] *= val; \
+} \
+\
+void SNAME ## Floor(TYPE * array, int rows, int cols, int num, TYPE floor) { \
+ int i, j, k, index; \
+ for (k=0; k<num; ++k) { \
+ for (j=0; j<cols; ++j) { \
+ for (i=0; i<rows; ++i) { \
+ index = k*cols*rows + j*rows + i; \
+ if (array[index] < floor) array[index] = floor; \
+ } \
+ } \
+ } \
+} \
+\
+void SNAME ## Ceil(int rows, int cols, int num, TYPE * array, TYPE ceil) { \
+ int i, j, k, index; \
+ for (k=0; k<num; ++k) { \
+ for (j=0; j<cols; ++j) { \
+ for (i=0; i<rows; ++i) { \
+ index = j*rows + i; \
+ if (array[index] > ceil) array[index] = ceil; \
+ } \
+ } \
+ } \
+} \
+\
+void SNAME ## LUSplit(TYPE tensor[2][2][2], TYPE lower[2][2][2], \
+ TYPE upper[2][2][2]) { \
+ int sum; \
+ for (int k=0; k<2; ++k) { \
+ for (int j=0; j<2; ++j) { \
+ for (int i=0; i<2; ++i) { \
+ sum = i + j + k; \
+ if (sum < 2) { \
+ lower[i][j][k] = tensor[i][j][k]; \
+ upper[i][j][k] = 0; \
+ } else { \
+ upper[i][j][k] = tensor[i][j][k]; \
+ lower[i][j][k] = 0; \
+ } \
+ } \
+ } \
+ } \
+}
+
+TEST_FUNCS(signed char , schar )
+TEST_FUNCS(unsigned char , uchar )
+TEST_FUNCS(short , short )
+TEST_FUNCS(unsigned short , ushort )
+TEST_FUNCS(int , int )
+TEST_FUNCS(unsigned int , uint )
+TEST_FUNCS(long , long )
+TEST_FUNCS(unsigned long , ulong )
+TEST_FUNCS(long long , longLong )
+TEST_FUNCS(unsigned long long, ulongLong)
+TEST_FUNCS(float , float )
+TEST_FUNCS(double , double )
diff --git a/numpy/doc/swig/Tensor.h b/numpy/doc/swig/Tensor.h
new file mode 100644
index 000000000..d60eb2d2e
--- /dev/null
+++ b/numpy/doc/swig/Tensor.h
@@ -0,0 +1,52 @@
+#ifndef TENSOR_H
+#define TENSOR_H
+
+// The following macro defines the prototypes for a family of
+// functions that work with 3D arrays with the forms
+//
+// TYPE SNAMENorm( TYPE tensor[2][2][2]);
+// TYPE SNAMEMax( TYPE * tensor, int rows, int cols, int num);
+// TYPE SNAMEMin( int rows, int cols, int num, TYPE * tensor);
+// void SNAMEScale( TYPE array[3][3][3]);
+// void SNAMEFloor( TYPE * array, int rows, int cols, int num, TYPE floor);
+// void SNAMECeil( int rows, int cols, int num, TYPE * array, TYPE ceil );
+// void SNAMELUSplit(TYPE in[3][3][3], TYPE lower[3][3][3], TYPE upper[3][3][3]);
+//
+// for any specified type TYPE (for example: short, unsigned int, long
+// long, etc.) with given short name SNAME (for example: short, uint,
+// longLong, etc.). The macro is then expanded for the given
+// TYPE/SNAME pairs. The resulting functions are for testing numpy
+// interfaces, respectively, for:
+//
+// * 3D input arrays, hard-coded lengths
+// * 3D input arrays
+// * 3D input arrays, data last
+// * 3D in-place arrays, hard-coded lengths
+// * 3D in-place arrays
+// * 3D in-place arrays, data last
+// * 3D argout arrays, hard-coded length
+//
+#define TEST_FUNC_PROTOS(TYPE, SNAME) \
+\
+TYPE SNAME ## Norm( TYPE tensor[2][2][2]); \
+TYPE SNAME ## Max( TYPE * tensor, int rows, int cols, int num); \
+TYPE SNAME ## Min( int rows, int cols, int num, TYPE * tensor); \
+void SNAME ## Scale( TYPE array[3][3][3], TYPE val); \
+void SNAME ## Floor( TYPE * array, int rows, int cols, int num, TYPE floor); \
+void SNAME ## Ceil( int rows, int cols, int num, TYPE * array, TYPE ceil ); \
+void SNAME ## LUSplit(TYPE tensor[2][2][2], TYPE lower[2][2][2], TYPE upper[2][2][2]);
+
+TEST_FUNC_PROTOS(signed char , schar )
+TEST_FUNC_PROTOS(unsigned char , uchar )
+TEST_FUNC_PROTOS(short , short )
+TEST_FUNC_PROTOS(unsigned short , ushort )
+TEST_FUNC_PROTOS(int , int )
+TEST_FUNC_PROTOS(unsigned int , uint )
+TEST_FUNC_PROTOS(long , long )
+TEST_FUNC_PROTOS(unsigned long , ulong )
+TEST_FUNC_PROTOS(long long , longLong )
+TEST_FUNC_PROTOS(unsigned long long, ulongLong)
+TEST_FUNC_PROTOS(float , float )
+TEST_FUNC_PROTOS(double , double )
+
+#endif
diff --git a/numpy/doc/swig/Tensor.i b/numpy/doc/swig/Tensor.i
new file mode 100644
index 000000000..24c906d29
--- /dev/null
+++ b/numpy/doc/swig/Tensor.i
@@ -0,0 +1,49 @@
+// -*- c++ -*-
+%module Tensor
+
+%{
+#define SWIG_FILE_WITH_INIT
+#include "Tensor.h"
+%}
+
+// Get the NumPy typemaps
+%include "numpy.i"
+
+%init %{
+ import_array();
+%}
+
+%define %apply_numpy_typemaps(TYPE)
+
+%apply (TYPE IN_ARRAY3[ANY][ANY][ANY]) {(TYPE tensor[ANY][ANY][ANY])};
+%apply (TYPE* IN_ARRAY3, int DIM1, int DIM2, int DIM3)
+ {(TYPE* tensor, int rows, int cols, int num)};
+%apply (int DIM1, int DIM2, int DIM3, TYPE* IN_ARRAY3)
+ {(int rows, int cols, int num, TYPE* tensor)};
+
+%apply (TYPE INPLACE_ARRAY3[ANY][ANY][ANY]) {(TYPE array[3][3][3])};
+%apply (TYPE* INPLACE_ARRAY3, int DIM1, int DIM2, int DIM3)
+ {(TYPE* array, int rows, int cols, int num)};
+%apply (int DIM1, int DIM2, int DIM3, TYPE* INPLACE_ARRAY3)
+ {(int rows, int cols, int num, TYPE* array)};
+
+%apply (TYPE ARGOUT_ARRAY3[ANY][ANY][ANY]) {(TYPE lower[2][2][2])};
+%apply (TYPE ARGOUT_ARRAY3[ANY][ANY][ANY]) {(TYPE upper[2][2][2])};
+
+%enddef /* %apply_numpy_typemaps() macro */
+
+%apply_numpy_typemaps(signed char )
+%apply_numpy_typemaps(unsigned char )
+%apply_numpy_typemaps(short )
+%apply_numpy_typemaps(unsigned short )
+%apply_numpy_typemaps(int )
+%apply_numpy_typemaps(unsigned int )
+%apply_numpy_typemaps(long )
+%apply_numpy_typemaps(unsigned long )
+%apply_numpy_typemaps(long long )
+%apply_numpy_typemaps(unsigned long long)
+%apply_numpy_typemaps(float )
+%apply_numpy_typemaps(double )
+
+// Include the header file to be wrapped
+%include "Tensor.h"
diff --git a/numpy/doc/swig/Vector.cxx b/numpy/doc/swig/Vector.cxx
new file mode 100644
index 000000000..2c90404da
--- /dev/null
+++ b/numpy/doc/swig/Vector.cxx
@@ -0,0 +1,100 @@
+#include <stdlib.h>
+#include <math.h>
+#include <iostream>
+#include "Vector.h"
+
+// The following macro defines a family of functions that work with 1D
+// arrays with the forms
+//
+// TYPE SNAMELength( TYPE vector[3]);
+// TYPE SNAMEProd( TYPE * series, int size);
+// TYPE SNAMESum( int size, TYPE * series);
+// void SNAMEReverse(TYPE array[3]);
+// void SNAMEOnes( TYPE * array, int size);
+// void SNAMEZeros( int size, TYPE * array);
+// void SNAMEEOSplit(TYPE vector[3], TYPE even[3], odd[3]);
+// void SNAMETwos( TYPE * twoVec, int size);
+// void SNAMEThrees( int size, TYPE * threeVec);
+//
+// for any specified type TYPE (for example: short, unsigned int, long
+// long, etc.) with given short name SNAME (for example: short, uint,
+// longLong, etc.). The macro is then expanded for the given
+// TYPE/SNAME pairs. The resulting functions are for testing numpy
+// interfaces, respectively, for:
+//
+// * 1D input arrays, hard-coded length
+// * 1D input arrays
+// * 1D input arrays, data last
+// * 1D in-place arrays, hard-coded length
+// * 1D in-place arrays
+// * 1D in-place arrays, data last
+// * 1D argout arrays, hard-coded length
+// * 1D argout arrays
+// * 1D argout arrays, data last
+//
+#define TEST_FUNCS(TYPE, SNAME) \
+\
+TYPE SNAME ## Length(TYPE vector[3]) { \
+ double result = 0; \
+ for (int i=0; i<3; ++i) result += vector[i]*vector[i]; \
+ return (TYPE)sqrt(result); \
+} \
+\
+TYPE SNAME ## Prod(TYPE * series, int size) { \
+ TYPE result = 1; \
+ for (int i=0; i<size; ++i) result *= series[i]; \
+ return result; \
+} \
+\
+TYPE SNAME ## Sum(int size, TYPE * series) { \
+ TYPE result = 0; \
+ for (int i=0; i<size; ++i) result += series[i]; \
+ return result; \
+} \
+\
+void SNAME ## Reverse(TYPE array[3]) { \
+ TYPE temp = array[0]; \
+ array[0] = array[2]; \
+ array[2] = temp; \
+} \
+\
+void SNAME ## Ones(TYPE * array, int size) { \
+ for (int i=0; i<size; ++i) array[i] = 1; \
+} \
+\
+void SNAME ## Zeros(int size, TYPE * array) { \
+ for (int i=0; i<size; ++i) array[i] = 0; \
+} \
+\
+void SNAME ## EOSplit(TYPE vector[3], TYPE even[3], TYPE odd[3]) { \
+ for (int i=0; i<3; ++i) { \
+ if (i % 2 == 0) { \
+ even[i] = vector[i]; \
+ odd[ i] = 0; \
+ } else { \
+ even[i] = 0; \
+ odd[ i] = vector[i]; \
+ } \
+ } \
+} \
+\
+void SNAME ## Twos(TYPE* twoVec, int size) { \
+ for (int i=0; i<size; ++i) twoVec[i] = 2; \
+} \
+\
+void SNAME ## Threes(int size, TYPE* threeVec) { \
+ for (int i=0; i<size; ++i) threeVec[i] = 3; \
+}
+
+TEST_FUNCS(signed char , schar )
+TEST_FUNCS(unsigned char , uchar )
+TEST_FUNCS(short , short )
+TEST_FUNCS(unsigned short , ushort )
+TEST_FUNCS(int , int )
+TEST_FUNCS(unsigned int , uint )
+TEST_FUNCS(long , long )
+TEST_FUNCS(unsigned long , ulong )
+TEST_FUNCS(long long , longLong )
+TEST_FUNCS(unsigned long long, ulongLong)
+TEST_FUNCS(float , float )
+TEST_FUNCS(double , double )
diff --git a/numpy/doc/swig/Vector.h b/numpy/doc/swig/Vector.h
new file mode 100644
index 000000000..01da361c6
--- /dev/null
+++ b/numpy/doc/swig/Vector.h
@@ -0,0 +1,58 @@
+#ifndef VECTOR_H
+#define VECTOR_H
+
+// The following macro defines the prototypes for a family of
+// functions that work with 1D arrays with the forms
+//
+// TYPE SNAMELength( TYPE vector[3]);
+// TYPE SNAMEProd( TYPE * series, int size);
+// TYPE SNAMESum( int size, TYPE * series);
+// void SNAMEReverse(TYPE array[3]);
+// void SNAMEOnes( TYPE * array, int size);
+// void SNAMEZeros( int size, TYPE * array);
+// void SNAMEEOSplit(TYPE vector[3], TYPE even[3], TYPE odd[3]);
+// void SNAMETwos( TYPE * twoVec, int size);
+// void SNAMEThrees( int size, TYPE * threeVec);
+//
+// for any specified type TYPE (for example: short, unsigned int, long
+// long, etc.) with given short name SNAME (for example: short, uint,
+// longLong, etc.). The macro is then expanded for the given
+// TYPE/SNAME pairs. The resulting functions are for testing numpy
+// interfaces, respectively, for:
+//
+// * 1D input arrays, hard-coded length
+// * 1D input arrays
+// * 1D input arrays, data last
+// * 1D in-place arrays, hard-coded length
+// * 1D in-place arrays
+// * 1D in-place arrays, data last
+// * 1D argout arrays, hard-coded length
+// * 1D argout arrays
+// * 1D argout arrays, data last
+//
+#define TEST_FUNC_PROTOS(TYPE, SNAME) \
+\
+TYPE SNAME ## Length( TYPE vector[3]); \
+TYPE SNAME ## Prod( TYPE * series, int size); \
+TYPE SNAME ## Sum( int size, TYPE * series); \
+void SNAME ## Reverse(TYPE array[3]); \
+void SNAME ## Ones( TYPE * array, int size); \
+void SNAME ## Zeros( int size, TYPE * array); \
+void SNAME ## EOSplit(TYPE vector[3], TYPE even[3], TYPE odd[3]); \
+void SNAME ## Twos( TYPE * twoVec, int size); \
+void SNAME ## Threes( int size, TYPE * threeVec); \
+
+TEST_FUNC_PROTOS(signed char , schar )
+TEST_FUNC_PROTOS(unsigned char , uchar )
+TEST_FUNC_PROTOS(short , short )
+TEST_FUNC_PROTOS(unsigned short , ushort )
+TEST_FUNC_PROTOS(int , int )
+TEST_FUNC_PROTOS(unsigned int , uint )
+TEST_FUNC_PROTOS(long , long )
+TEST_FUNC_PROTOS(unsigned long , ulong )
+TEST_FUNC_PROTOS(long long , longLong )
+TEST_FUNC_PROTOS(unsigned long long, ulongLong)
+TEST_FUNC_PROTOS(float , float )
+TEST_FUNC_PROTOS(double , double )
+
+#endif
diff --git a/numpy/doc/swig/Vector.i b/numpy/doc/swig/Vector.i
new file mode 100644
index 000000000..1cb689250
--- /dev/null
+++ b/numpy/doc/swig/Vector.i
@@ -0,0 +1,47 @@
+// -*- c++ -*-
+%module Vector
+
+%{
+#define SWIG_FILE_WITH_INIT
+#include "Vector.h"
+%}
+
+// Get the NumPy typemaps
+%include "numpy.i"
+
+%init %{
+ import_array();
+%}
+
+%define %apply_numpy_typemaps(TYPE)
+
+%apply (TYPE IN_ARRAY1[ANY]) {(TYPE vector[3])};
+%apply (TYPE* IN_ARRAY1, int DIM1) {(TYPE* series, int size)};
+%apply (int DIM1, TYPE* IN_ARRAY1) {(int size, TYPE* series)};
+
+%apply (TYPE INPLACE_ARRAY1[ANY]) {(TYPE array[3])};
+%apply (TYPE* INPLACE_ARRAY1, int DIM1) {(TYPE* array, int size)};
+%apply (int DIM1, TYPE* INPLACE_ARRAY1) {(int size, TYPE* array)};
+
+%apply (TYPE ARGOUT_ARRAY1[ANY]) {(TYPE even[3])};
+%apply (TYPE ARGOUT_ARRAY1[ANY]) {(TYPE odd[ 3])};
+%apply (TYPE* ARGOUT_ARRAY1, int DIM1) {(TYPE* twoVec, int size)};
+%apply (int DIM1, TYPE* ARGOUT_ARRAY1) {(int size, TYPE* threeVec)};
+
+%enddef /* %apply_numpy_typemaps() macro */
+
+%apply_numpy_typemaps(signed char )
+%apply_numpy_typemaps(unsigned char )
+%apply_numpy_typemaps(short )
+%apply_numpy_typemaps(unsigned short )
+%apply_numpy_typemaps(int )
+%apply_numpy_typemaps(unsigned int )
+%apply_numpy_typemaps(long )
+%apply_numpy_typemaps(unsigned long )
+%apply_numpy_typemaps(long long )
+%apply_numpy_typemaps(unsigned long long)
+%apply_numpy_typemaps(float )
+%apply_numpy_typemaps(double )
+
+// Include the header file to be wrapped
+%include "Vector.h"
diff --git a/numpy/doc/swig/numpy.i b/numpy/doc/swig/numpy.i
new file mode 100644
index 000000000..69c947af3
--- /dev/null
+++ b/numpy/doc/swig/numpy.i
@@ -0,0 +1,975 @@
+/* -*- C -*- (not really, but good for syntax highlighting) */
+#ifdef SWIGPYTHON
+
+%{
+#ifndef SWIG_FILE_WITH_INIT
+# define NO_IMPORT_ARRAY
+#endif
+#include "stdio.h"
+#include <numpy/arrayobject.h>
+
+/* The following code originally appeared in
+ * enthought/kiva/agg/src/numeric.i written by Eric Jones. It was
+ * translated from C++ to C by John Hunter. Bill Spotz has modified
+ * it slightly to fix some minor bugs, upgrade to numpy (all
+ * versions), add some comments and some functionality.
+ */
+
+/* Macros to extract array attributes.
+ */
+#define is_array(a) ((a) && PyArray_Check((PyArrayObject *)a))
+#define array_type(a) (int)(PyArray_TYPE(a))
+#define array_numdims(a) (((PyArrayObject *)a)->nd)
+#define array_dimensions(a) (((PyArrayObject *)a)->dimensions)
+#define array_size(a,i) (((PyArrayObject *)a)->dimensions[i])
+#define array_data(a) (((PyArrayObject *)a)->data)
+#define array_is_contiguous(a) (PyArray_ISCONTIGUOUS(a))
+#define array_is_native(a) (PyArray_ISNOTSWAPPED(a))
+
+/* Support older NumPy data type names
+*/
+#if NDARRAY_VERSION < 0x01000000
+#define NPY_BOOL PyArray_BOOL
+#define NPY_BYTE PyArray_BYTE
+#define NPY_UBYTE PyArray_UBYTE
+#define NPY_SHORT PyArray_SHORT
+#define NPY_USHORT PyArray_USHORT
+#define NPY_INT PyArray_INT
+#define NPY_UINT PyArray_UINT
+#define NPY_LONG PyArray_LONG
+#define NPY_ULONG PyArray_ULONG
+#define NPY_LONGLONG PyArray_LONGLONG
+#define NPY_ULONGLONG PyArray_ULONGLONG
+#define NPY_FLOAT PyArray_FLOAT
+#define NPY_DOUBLE PyArray_DOUBLE
+#define NPY_LONGDOUBLE PyArray_LONGDOUBLE
+#define NPY_CFLOAT PyArray_CFLOAT
+#define NPY_CDOUBLE PyArray_CDOUBLE
+#define NPY_CLONGDOUBLE PyArray_CLONGDOUBLE
+#define NPY_OBJECT PyArray_OBJECT
+#define NPY_STRING PyArray_STRING
+#define NPY_UNICODE PyArray_UNICODE
+#define NPY_VOID PyArray_VOID
+#define NPY_NTYPES PyArray_NTYPES
+#define NPY_NOTYPE PyArray_NOTYPE
+#define NPY_CHAR PyArray_CHAR
+#define NPY_USERDEF PyArray_USERDEF
+#define npy_intp intp
+#endif
+
+/* Given a PyObject, return a string describing its type.
+ */
+char* pytype_string(PyObject* py_obj) {
+ if (py_obj == NULL ) return "C NULL value";
+ if (py_obj == Py_None ) return "Python None" ;
+ if (PyCallable_Check(py_obj)) return "callable" ;
+ if (PyString_Check( py_obj)) return "string" ;
+ if (PyInt_Check( py_obj)) return "int" ;
+ if (PyFloat_Check( py_obj)) return "float" ;
+ if (PyDict_Check( py_obj)) return "dict" ;
+ if (PyList_Check( py_obj)) return "list" ;
+ if (PyTuple_Check( py_obj)) return "tuple" ;
+ if (PyFile_Check( py_obj)) return "file" ;
+ if (PyModule_Check( py_obj)) return "module" ;
+ if (PyInstance_Check(py_obj)) return "instance" ;
+
+ return "unkown type";
+}
+
+/* Given a NumPy typecode, return a string describing the type.
+ */
+char* typecode_string(int typecode) {
+ static char* type_names[25] = {"bool", "byte", "unsigned byte",
+ "short", "unsigned short", "int",
+ "unsigned int", "long", "unsigned long",
+ "long long", "unsigned long long",
+ "float", "double", "long double",
+ "complex float", "complex double",
+ "complex long double", "object",
+ "string", "unicode", "void", "ntypes",
+ "notype", "char", "unknown"};
+ return typecode < 24 ? type_names[typecode] : type_names[24];
+}
+
+/* Make sure input has correct numpy type. Allow character and byte
+ * to match. Also allow int and long to match. This is deprecated.
+ * You should use PyArray_EquivTypenums() instead.
+ */
+int type_match(int actual_type, int desired_type) {
+ return PyArray_EquivTypenums(actual_type, desired_type);
+}
+
+/* Given a PyObject pointer, cast it to a PyArrayObject pointer if
+ * legal. If not, set the python error string appropriately and
+ * return NULL.
+ */
+PyArrayObject* obj_to_array_no_conversion(PyObject* input, int typecode) {
+ PyArrayObject* ary = NULL;
+ if (is_array(input) && (typecode == NPY_NOTYPE ||
+ PyArray_EquivTypenums(array_type(input), typecode))) {
+ ary = (PyArrayObject*) input;
+ }
+ else if is_array(input) {
+ char* desired_type = typecode_string(typecode);
+ char* actual_type = typecode_string(array_type(input));
+ PyErr_Format(PyExc_TypeError,
+ "Array of type '%s' required. Array of type '%s' given",
+ desired_type, actual_type);
+ ary = NULL;
+ }
+ else {
+ char * desired_type = typecode_string(typecode);
+ char * actual_type = pytype_string(input);
+ PyErr_Format(PyExc_TypeError,
+ "Array of type '%s' required. A '%s' was given",
+ desired_type, actual_type);
+ ary = NULL;
+ }
+ return ary;
+}
+
+/* Convert the given PyObject to a NumPy array with the given
+ * typecode. On success, return a valid PyArrayObject* with the
+ * correct type. On failure, the python error string will be set and
+ * the routine returns NULL.
+ */
+PyArrayObject* obj_to_array_allow_conversion(PyObject* input, int typecode,
+ int* is_new_object) {
+ PyArrayObject* ary = NULL;
+ PyObject* py_obj;
+ if (is_array(input) && (typecode == NPY_NOTYPE ||
+ PyArray_EquivTypenums(array_type(input),typecode))) {
+ ary = (PyArrayObject*) input;
+ *is_new_object = 0;
+ }
+ else {
+ py_obj = PyArray_FromObject(input, typecode, 0, 0);
+ /* If NULL, PyArray_FromObject will have set python error value.*/
+ ary = (PyArrayObject*) py_obj;
+ *is_new_object = 1;
+ }
+ return ary;
+}
+
+/* Given a PyArrayObject, check to see if it is contiguous. If so,
+ * return the input pointer and flag it as not a new object. If it is
+ * not contiguous, create a new PyArrayObject using the original data,
+ * flag it as a new object and return the pointer.
+ */
+PyArrayObject* make_contiguous(PyArrayObject* ary, int* is_new_object,
+ int min_dims, int max_dims) {
+ PyArrayObject* result;
+ if (array_is_contiguous(ary)) {
+ result = ary;
+ *is_new_object = 0;
+ }
+ else {
+ result = (PyArrayObject*) PyArray_ContiguousFromObject((PyObject*)ary,
+ array_type(ary),
+ min_dims,
+ max_dims);
+ *is_new_object = 1;
+ }
+ return result;
+}
+
+/* Convert a given PyObject to a contiguous PyArrayObject of the
+ * specified type. If the input object is not a contiguous
+ * PyArrayObject, a new one will be created and the new object flag
+ * will be set.
+ */
+PyArrayObject* obj_to_array_contiguous_allow_conversion(PyObject* input,
+ int typecode,
+ int* is_new_object) {
+ int is_new1 = 0;
+ int is_new2 = 0;
+ PyArrayObject* ary2;
+ PyArrayObject* ary1 = obj_to_array_allow_conversion(input, typecode,
+ &is_new1);
+ if (ary1) {
+ ary2 = make_contiguous(ary1, &is_new2, 0, 0);
+ if ( is_new1 && is_new2) {
+ Py_DECREF(ary1);
+ }
+ ary1 = ary2;
+ }
+ *is_new_object = is_new1 || is_new2;
+ return ary1;
+}
+
+/* Test whether a python object is contiguous. If array is
+ * contiguous, return 1. Otherwise, set the python error string and
+ * return 0.
+ */
+int require_contiguous(PyArrayObject* ary) {
+ int contiguous = 1;
+ if (!array_is_contiguous(ary)) {
+ PyErr_SetString(PyExc_TypeError,
+ "Array must be contiguous. A non-contiguous array was given");
+ contiguous = 0;
+ }
+ return contiguous;
+}
+
+/* Require that a numpy array is not byte-swapped. If the array is
+ * not byte-swapped, return 1. Otherwise, set the python error string
+ * and return 0.
+ */
+int require_native(PyArrayObject* ary) {
+ int native = 1;
+ if (!array_is_native(ary)) {
+ PyErr_SetString(PyExc_TypeError,
+ "Array must have native byteorder. A byte-swapped array was given");
+ native = 0;
+ }
+ return native;
+}
+
+/* Require the given PyArrayObject to have a specified number of
+ * dimensions. If the array has the specified number of dimensions,
+ * return 1. Otherwise, set the python error string and return 0.
+ */
+int require_dimensions(PyArrayObject* ary, int exact_dimensions) {
+ int success = 1;
+ if (array_numdims(ary) != exact_dimensions) {
+ PyErr_Format(PyExc_TypeError,
+ "Array must have %d dimensions. Given array has %d dimensions",
+ exact_dimensions, array_numdims(ary));
+ success = 0;
+ }
+ return success;
+}
+
+/* Require the given PyArrayObject to have one of a list of specified
+ * number of dimensions. If the array has one of the specified number
+ * of dimensions, return 1. Otherwise, set the python error string
+ * and return 0.
+ */
+int require_dimensions_n(PyArrayObject* ary, int* exact_dimensions, int n) {
+ int success = 0;
+ int i;
+ char dims_str[255] = "";
+ char s[255];
+ for (i = 0; i < n && !success; i++) {
+ if (array_numdims(ary) == exact_dimensions[i]) {
+ success = 1;
+ }
+ }
+ if (!success) {
+ for (i = 0; i < n-1; i++) {
+ sprintf(s, "%d, ", exact_dimensions[i]);
+ strcat(dims_str,s);
+ }
+ sprintf(s, " or %d", exact_dimensions[n-1]);
+ strcat(dims_str,s);
+ PyErr_Format(PyExc_TypeError,
+ "Array must be have %s dimensions. Given array has %d dimensions",
+ dims_str, array_numdims(ary));
+ }
+ return success;
+}
+
+/* Require the given PyArrayObject to have a specified shape. If the
+ * array has the specified shape, return 1. Otherwise, set the python
+ * error string and return 0.
+ */
+int require_size(PyArrayObject* ary, npy_intp* size, int n) {
+ int i;
+ int success = 1;
+ int len;
+ char desired_dims[255] = "[";
+ char s[255];
+ char actual_dims[255] = "[";
+ for(i=0; i < n;i++) {
+ if (size[i] != -1 && size[i] != array_size(ary,i)) {
+ success = 0;
+ }
+ }
+ if (!success) {
+ for (i = 0; i < n; i++) {
+ if (size[i] == -1) {
+ sprintf(s, "*,");
+ }
+ else
+ {
+ sprintf(s, "%d,", size[i]);
+ }
+ strcat(desired_dims,s);
+ }
+ len = strlen(desired_dims);
+ desired_dims[len-1] = ']';
+ for (i = 0; i < n; i++) {
+ sprintf(s, "%d,", array_size(ary,i));
+ strcat(actual_dims,s);
+ }
+ len = strlen(actual_dims);
+ actual_dims[len-1] = ']';
+ PyErr_Format(PyExc_TypeError,
+ "Array must be have shape of %s. Given array has shape of %s",
+ desired_dims, actual_dims);
+ }
+ return success;
+}
+
+/* End John Hunter translation (with modifications by Bill Spotz)
+ */
+
+%}
+
+/* %numpy_typemaps() macro
+ *
+ * This macro defines a family of typemaps that allow pure input C
+ * arguments of the form
+ *
+ * (DATA_TYPE IN_ARRAY1[ANY])
+ * (DATA_TYPE* IN_ARRAY1, DIM_TYPE DIM1)
+ * (DIM_TYPE DIM1, DATA_TYPE* IN_ARRAY1)
+ *
+ * (DATA_TYPE IN_ARRAY2[ANY][ANY])
+ * (DATA_TYPE* IN_ARRAY2, DIM_TYPE DIM1, DIM_TYPE DIM2)
+ * (DIM_TYPE DIM1, DIM_TYPE DIM2, DATA_TYPE* IN_ARRAY2)
+ *
+ * (DATA_TYPE INPLACE_ARRAY1[ANY])
+ * (DATA_TYPE* INPLACE_ARRAY1, DIM_TYPE DIM1)
+ * (DIM_TYPE DIM1, DATA_TYPE* INPLACE_ARRAY1)
+ *
+ * (DATA_TYPE INPLACE_ARRAY2[ANY][ANY])
+ * (DATA_TYPE* INPLACE_ARRAY2, DIM_TYPE DIM1, DIM_TYPE DIM2)
+ * (DIM_TYPE DIM1, DIM_TYPE DIM2, DATA_TYPE* INPLACE_ARRAY2)
+ *
+ * (DATA_TYPE ARGOUT_ARRAY1[ANY])
+ * (DATA_TYPE* ARGOUT_ARRAY1, DIM_TYPE DIM1)
+ * (DIM_TYPE DIM1, DATA_TYPE* ARGOUT_ARRAY1)
+ *
+ * (DATA_TYPE ARGOUT_ARRAY2[ANY][ANY])
+ *
+ * where "DATA_TYPE" is any type supported by the NumPy module, and
+ * "DIM_TYPE" is any int-like type suitable for specifying dimensions.
+ * In python, the dimensions will not need to be specified (except for
+ * the "DATA_TYPE* ARGOUT_ARRAY1" typemaps). The IN_ARRAYs can be a
+ * numpy array or any sequence that can be converted to a numpy array
+ * of the specified type. The INPLACE_ARRAYs must be numpy arrays of
+ * the appropriate type. The ARGOUT_ARRAYs will be returned as numpy
+ * arrays of the appropriate type.
+ *
+ * These typemaps can be applied to existing functions using the
+ * %apply directive:
+ *
+ * %apply (double IN_ARRAY1[ANY]) {(double vector[ANY])};
+ * double length(double vector[3]);
+ *
+ * %apply (double* IN_ARRAY1, int DIM1) {(double* series, int length)};
+ * double prod(double* series, int length);
+ *
+ * %apply (int DIM1, double* IN_ARRAY1) {(int length, double* series)}
+ * double sum(int length, double* series)
+ *
+ * %apply (double IN_ARRAY2[ANY][ANY]) {(double matrix[2][2])};
+ * double det(double matrix[2][2]);
+ *
+ * %apply (double* IN_ARRAY2, int DIM1, int DIM2) {(double* matrix, int rows, int cols)};
+ * double max(double* matrix, int rows, int cols);
+ *
+ * %apply (int DIM1, int DIM2, double* IN_ARRAY2) {(int rows, int cols, double* matrix)}
+ * double min(int length, double* series)
+ *
+ * %apply (double INPLACE_ARRAY1[ANY]) {(double vector[3])};
+ * void reverse(double vector[3]);
+ *
+ * %apply (double* INPLACE_ARRAY1, int DIM1) {(double* series, int length)};
+ * void ones(double* series, int length);
+ *
+ * %apply (int DIM1, double* INPLACE_ARRAY1) {(int length, double* series)}
+ * double zeros(int length, double* series)
+ *
+ * %apply (double INPLACE_ARRAY2[ANY][ANY]) {(double matrix[3][3])};
+ * void scale(double matrix[3][3]);
+ *
+ * %apply (double* INPLACE_ARRAY2, int DIM1, int DIM2) {(double* matrix, int rows, int cols)};
+ * void floor(double* matrix, int rows, int cols);
+ *
+ * %apply (int DIM1, int DIM2, double* INPLACE_ARRAY2) {(int rows, int cols, double* matrix)};
+ * void ceil(int rows, int cols, double* matrix);
+ *
+ * %apply (double IN_ARRAY1[ANY] ) {(double vector[ANY])};
+ * %apply (double ARGOUT_ARRAY1[ANY]) {(double even[ 3])};
+ * %apply (double ARGOUT_ARRAY1[ANY]) {(double odd[ 3])};
+ * void eoSplit(double vector[3], double even[3], double odd[3]);
+ *
+ * %apply (double* ARGOUT_ARRAY1, int DIM1) {(double* twoVec, int size)};
+ * void twos(double* twoVec, int size);
+ *
+ * %apply (int DIM1, double* ARGOUT_ARRAY1) {(int size, double* threeVec)};
+ * void threes(int size, double* threeVec);
+ *
+ * %apply (double IN_ARRAY2[ANY][ANY]) {(double matrix[2][2])};
+ * %apply (double ARGOUT_ARRAY2[ANY][ANY]) {(double upper[ 3][3])};
+ * %apply (double ARGOUT_ARRAY2[ANY][ANY]) {(double lower[ 3][3])};
+ * void luSplit(double matrix[3][3], double upper[3][3], double lower[3][3]);
+ *
+ * or directly with
+ *
+ * double length(double IN_ARRAY1[ANY]);
+ * double prod(double* IN_ARRAY1, int DIM1);
+ * double sum( int DIM1, double* IN_ARRAY1)
+ *
+ * double det(double IN_ARRAY2[ANY][ANY]);
+ * double max(double* IN_ARRAY2, int DIM1, int DIM2);
+ * double min(int DIM1, int DIM2, double* IN_ARRAY2)
+ *
+ * void reverse(double INPLACE_ARRAY1[ANY]);
+ * void ones( double* INPLACE_ARRAY1, int DIM1);
+ * void zeros(int DIM1, double* INPLACE_ARRAY1)
+ *
+ * void scale(double INPLACE_ARRAY2[ANY][ANY]);
+ * void floor(double* INPLACE_ARRAY2, int DIM1, int DIM2, double floor);
+ * void ceil( int DIM1, int DIM2, double* INPLACE_ARRAY2, double ceil );
+ *
+ * void eoSplit(double IN_ARRAY1[ANY], double ARGOUT_ARRAY1[ANY],
+ * double ARGOUT_ARRAY1[ANY]);
+ * void twos(double* ARGOUT_ARRAY1, int DIM1)
+ * void threes(int DIM1, double* ARGOUT_ARRAY1)
+ *
+ * void luSplit(double IN_ARRAY2[ANY][ANY], double ARGOUT_ARRAY2[ANY][ANY],
+ * double ARGOUT_ARRAY2[ANY][ANY]);
+ */
+
+%define %numpy_typemaps(DATA_TYPE, DATA_TYPECODE, DIM_TYPE)
+
+/************************/
+/* Input Array Typemaps */
+/************************/
+
+/* Typemap suite for (DATA_TYPE IN_ARRAY1[ANY])
+ */
+%typecheck(SWIG_TYPECHECK_DOUBLE_ARRAY)
+ (DATA_TYPE IN_ARRAY1[ANY])
+{
+ $1 = is_array($input) || PySequence_Check($input);
+}
+%typemap(in)
+ (DATA_TYPE IN_ARRAY1[ANY])
+ (PyArrayObject* array=NULL, int is_new_object=0)
+{
+ array = obj_to_array_contiguous_allow_conversion($input, DATA_TYPECODE, &is_new_object);
+ npy_intp size[1] = { $1_dim0 };
+ if (!array || !require_dimensions(array, 1) || !require_size(array, size, 1)) SWIG_fail;
+ $1 = ($1_ltype) array_data(array);
+}
+%typemap(freearg)
+ (DATA_TYPE IN_ARRAY1[ANY])
+{
+ if (is_new_object$argnum && array$argnum) Py_DECREF(array$argnum);
+}
+
+/* Typemap suite for (DATA_TYPE* IN_ARRAY1, DIM_TYPE DIM1)
+ */
+%typecheck(SWIG_TYPECHECK_DOUBLE_ARRAY)
+ (DATA_TYPE* IN_ARRAY1, DIM_TYPE DIM1)
+{
+ $1 = is_array($input) || PySequence_Check($input);
+}
+%typemap(in)
+ (DATA_TYPE* IN_ARRAY1, DIM_TYPE DIM1)
+ (PyArrayObject* array=NULL, int is_new_object=0)
+{
+ array = obj_to_array_contiguous_allow_conversion($input, DATA_TYPECODE, &is_new_object);
+ npy_intp size[1] = { -1 };
+ if (!array || !require_dimensions(array, 1) || !require_size(array, size, 1)) SWIG_fail;
+ $1 = (DATA_TYPE*) array_data(array);
+ $2 = (DIM_TYPE) array_size(array,0);
+}
+%typemap(freearg)
+ (DATA_TYPE* IN_ARRAY1, DIM_TYPE DIM1)
+{
+ if (is_new_object$argnum && array$argnum) Py_DECREF(array$argnum);
+}
+
+/* Typemap suite for (DIM_TYPE DIM1, DATA_TYPE* IN_ARRAY1)
+ */
+%typecheck(SWIG_TYPECHECK_DOUBLE_ARRAY)
+ (DIM_TYPE DIM1, DATA_TYPE* IN_ARRAY1)
+{
+ $1 = is_array($input) || PySequence_Check($input);
+}
+%typemap(in)
+ (DIM_TYPE DIM1, DATA_TYPE* IN_ARRAY1)
+ (PyArrayObject* array=NULL, int is_new_object=0)
+{
+ array = obj_to_array_contiguous_allow_conversion($input, DATA_TYPECODE, &is_new_object);
+ npy_intp size[1] = {-1};
+ if (!array || !require_dimensions(array, 1) || !require_size(array, size, 1)) SWIG_fail;
+ $1 = (DIM_TYPE) array_size(array,0);
+ $2 = (DATA_TYPE*) array_data(array);
+}
+%typemap(freearg)
+ (DIM_TYPE DIM1, DATA_TYPE* IN_ARRAY1)
+{
+ if (is_new_object$argnum && array$argnum) Py_DECREF(array$argnum);
+}
+
+/* Typemap suite for (DATA_TYPE IN_ARRAY2[ANY][ANY])
+ */
+%typecheck(SWIG_TYPECHECK_DOUBLE_ARRAY)
+ (DATA_TYPE IN_ARRAY2[ANY][ANY])
+{
+ $1 = is_array($input) || PySequence_Check($input);
+}
+%typemap(in)
+ (DATA_TYPE IN_ARRAY2[ANY][ANY])
+ (PyArrayObject* array=NULL, int is_new_object=0)
+{
+ array = obj_to_array_contiguous_allow_conversion($input, DATA_TYPECODE, &is_new_object);
+ npy_intp size[2] = { $1_dim0, $1_dim1 };
+ if (!array || !require_dimensions(array, 2) || !require_size(array, size, 2)) SWIG_fail;
+ $1 = ($1_ltype) array_data(array);
+}
+%typemap(freearg)
+ (DATA_TYPE IN_ARRAY2[ANY][ANY])
+{
+ if (is_new_object$argnum && array$argnum) Py_DECREF(array$argnum);
+}
+
+/* Typemap suite for (DATA_TYPE* IN_ARRAY2, DIM_TYPE DIM1, DIM_TYPE DIM2)
+ */
+%typecheck(SWIG_TYPECHECK_DOUBLE_ARRAY)
+ (DATA_TYPE* IN_ARRAY2, DIM_TYPE DIM1, DIM_TYPE DIM2)
+{
+ $1 = is_array($input) || PySequence_Check($input);
+}
+%typemap(in)
+ (DATA_TYPE* IN_ARRAY2, DIM_TYPE DIM1, DIM_TYPE DIM2)
+ (PyArrayObject* array=NULL, int is_new_object=0)
+{
+ array = obj_to_array_contiguous_allow_conversion($input, DATA_TYPECODE, &is_new_object);
+ npy_intp size[2] = { -1, -1 };
+ if (!array || !require_dimensions(array, 2) || !require_size(array, size, 2)) SWIG_fail;
+ $1 = (DATA_TYPE*) array_data(array);
+ $2 = (DIM_TYPE) array_size(array,0);
+ $3 = (DIM_TYPE) array_size(array,1);
+}
+%typemap(freearg)
+ (DATA_TYPE* IN_ARRAY2, DIM_TYPE DIM1, DIM_TYPE DIM2)
+{
+ if (is_new_object$argnum && array$argnum) Py_DECREF(array$argnum);
+}
+
+/* Typemap suite for (DIM_TYPE DIM1, DIM_TYPE DIM2, DATA_TYPE* IN_ARRAY2)
+ */
+%typecheck(SWIG_TYPECHECK_DOUBLE_ARRAY)
+ (DIM_TYPE DIM1, DIM_TYPE DIM2, DATA_TYPE* IN_ARRAY2)
+{
+ $1 = is_array($input) || PySequence_Check($input);
+}
+%typemap(in)
+ (DIM_TYPE DIM1, DIM_TYPE DIM2, DATA_TYPE* IN_ARRAY2)
+ (PyArrayObject* array=NULL, int is_new_object=0)
+{
+ array = obj_to_array_contiguous_allow_conversion($input, DATA_TYPECODE, &is_new_object);
+ npy_intp size[2] = { -1, -1 };
+ if (!array || !require_dimensions(array, 2) || !require_size(array, size, 2)) SWIG_fail;
+ $1 = (DIM_TYPE) array_size(array,0);
+ $2 = (DIM_TYPE) array_size(array,1);
+ $3 = (DATA_TYPE*) array_data(array);
+}
+%typemap(freearg)
+ (DIM_TYPE DIM1, DIM_TYPE DIM2, DATA_TYPE* IN_ARRAY2)
+{
+ if (is_new_object$argnum && array$argnum) Py_DECREF(array$argnum);
+}
+
+/* Typemap suite for (DATA_TYPE IN_ARRAY3[ANY][ANY][ANY])
+ */
+%typecheck(SWIG_TYPECHECK_DOUBLE_ARRAY)
+ (DATA_TYPE IN_ARRAY3[ANY][ANY][ANY])
+{
+ $1 = is_array($input) || PySequence_Check($input);
+}
+%typemap(in)
+ (DATA_TYPE IN_ARRAY3[ANY][ANY][ANY])
+ (PyArrayObject* array=NULL, int is_new_object=0)
+{
+ array = obj_to_array_contiguous_allow_conversion($input, DATA_TYPECODE, &is_new_object);
+ npy_intp size[3] = { $1_dim0, $1_dim1, $1_dim2 };
+ if (!array || !require_dimensions(array, 3) || !require_size(array, size, 3)) SWIG_fail;
+ $1 = ($1_ltype) array_data(array);
+}
+%typemap(freearg)
+ (DATA_TYPE IN_ARRAY3[ANY][ANY][ANY])
+{
+ if (is_new_object$argnum && array$argnum) Py_DECREF(array$argnum);
+}
+
+/* Typemap suite for (DATA_TYPE* IN_ARRAY3, DIM_TYPE DIM1, DIM_TYPE DIM2,
+ * DIM_TYPE DIM3)
+ */
+%typecheck(SWIG_TYPECHECK_DOUBLE_ARRAY)
+ (DATA_TYPE* IN_ARRAY3, DIM_TYPE DIM1, DIM_TYPE DIM2, DIM_TYPE DIM3)
+{
+ $1 = is_array($input) || PySequence_Check($input);
+}
+%typemap(in)
+ (DATA_TYPE* IN_ARRAY3, DIM_TYPE DIM1, DIM_TYPE DIM2, DIM_TYPE DIM3)
+ (PyArrayObject* array=NULL, int is_new_object=0)
+{
+ array = obj_to_array_contiguous_allow_conversion($input, DATA_TYPECODE, &is_new_object);
+ npy_intp size[3] = { -1, -1, -1 };
+ if (!array || !require_dimensions(array, 3) || !require_size(array, size, 3)) SWIG_fail;
+ $1 = (DATA_TYPE*) array_data(array);
+ $2 = (DIM_TYPE) array_size(array,0);
+ $3 = (DIM_TYPE) array_size(array,1);
+ $4 = (DIM_TYPE) array_size(array,2);
+}
+%typemap(freearg)
+ (DATA_TYPE* IN_ARRAY3, DIM_TYPE DIM1, DIM_TYPE DIM2, DIM_TYPE DIM3)
+{
+ if (is_new_object$argnum && array$argnum) Py_DECREF(array$argnum);
+}
+
+/* Typemap suite for (DIM_TYPE DIM1, DIM_TYPE DIM2, DIM_TYPE DIM3,
+ * DATA_TYPE* IN_ARRAY3)
+ */
+%typecheck(SWIG_TYPECHECK_DOUBLE_ARRAY)
+ (DIM_TYPE DIM1, DIM_TYPE DIM2, DIM_TYPE DIM3, DATA_TYPE* IN_ARRAY3)
+{
+ $1 = is_array($input) || PySequence_Check($input);
+}
+%typemap(in)
+ (DIM_TYPE DIM1, DIM_TYPE DIM2, DIM_TYPE DIM3, DATA_TYPE* IN_ARRAY3)
+ (PyArrayObject* array=NULL, int is_new_object=0)
+{
+ array = obj_to_array_contiguous_allow_conversion($input, DATA_TYPECODE, &is_new_object);
+ npy_intp size[3] = { -1, -1, -1 };
+ if (!array || !require_dimensions(array, 3) || !require_size(array, size, 3)) SWIG_fail;
+ $1 = (DIM_TYPE) array_size(array,0);
+ $2 = (DIM_TYPE) array_size(array,1);
+ $3 = (DIM_TYPE) array_size(array,2);
+ $4 = (DATA_TYPE*) array_data(array);
+}
+%typemap(freearg)
+ (DIM_TYPE DIM1, DIM_TYPE DIM2, DIM_TYPE DIM3, DATA_TYPE* IN_ARRAY3)
+{
+ if (is_new_object$argnum && array$argnum) Py_DECREF(array$argnum);
+}
+
+/***************************/
+/* In-Place Array Typemaps */
+/***************************/
+
+/* Typemap suite for (DATA_TYPE INPLACE_ARRAY1[ANY])
+ */
+%typecheck(SWIG_TYPECHECK_DOUBLE_ARRAY)
+ (DATA_TYPE INPLACE_ARRAY1[ANY])
+{
+ $1 = is_array($input) && PyArray_EquivTypenums(array_type($input),DATA_TYPECODE);
+}
+%typemap(in)
+ (DATA_TYPE INPLACE_ARRAY1[ANY])
+ (PyArrayObject* array=NULL)
+{
+ array = obj_to_array_no_conversion($input, DATA_TYPECODE);
+ npy_intp size[1] = { $1_dim0 };
+ if (!array || !require_dimensions(array,1) || !require_size(array, size, 1)
+ || !require_contiguous(array) || !require_native(array)) SWIG_fail;
+ $1 = ($1_ltype) array_data(array);
+}
+
+/* Typemap suite for (DATA_TYPE* INPLACE_ARRAY1, DIM_TYPE DIM1)
+ */
+%typecheck(SWIG_TYPECHECK_DOUBLE_ARRAY)
+ (DATA_TYPE* INPLACE_ARRAY1, DIM_TYPE DIM1)
+{
+ $1 = is_array($input) && PyArray_EquivTypenums(array_type($input),DATA_TYPECODE);
+}
+%typemap(in)
+ (DATA_TYPE* INPLACE_ARRAY1, DIM_TYPE DIM1)
+ (PyArrayObject* array=NULL)
+{
+ array = obj_to_array_no_conversion($input, DATA_TYPECODE);
+ if (!array || !require_dimensions(array,1) || !require_contiguous(array)
+ || !require_native(array)) SWIG_fail;
+ $1 = (DATA_TYPE*) array_data(array);
+ $2 = 1;
+ for (int i=0; i < array_numdims(array); ++i) $2 *= array_size(array,i);
+}
+
+/* Typemap suite for (DIM_TYPE DIM1, DATA_TYPE* INPLACE_ARRAY1)
+ */
+%typecheck(SWIG_TYPECHECK_DOUBLE_ARRAY)
+ (DIM_TYPE DIM1, DATA_TYPE* INPLACE_ARRAY1)
+{
+ $1 = is_array($input) && PyArray_EquivTypenums(array_type($input),DATA_TYPECODE);
+}
+%typemap(in)
+ (DIM_TYPE DIM1, DATA_TYPE* INPLACE_ARRAY1)
+ (PyArrayObject* array=NULL)
+{
+ array = obj_to_array_no_conversion($input, DATA_TYPECODE);
+ if (!array || !require_dimensions(array,1) || !require_contiguous(array)
+ || !require_native(array)) SWIG_fail;
+ $1 = 1;
+ for (int i=0; i < array_numdims(array); ++i) $1 *= array_size(array,i);
+ $2 = (DATA_TYPE*) array_data(array);
+}
+
+/* Typemap suite for (DATA_TYPE INPLACE_ARRAY2[ANY][ANY])
+ */
+%typecheck(SWIG_TYPECHECK_DOUBLE_ARRAY)
+ (DATA_TYPE INPLACE_ARRAY2[ANY][ANY])
+{
+ $1 = is_array($input) && PyArray_EquivTypenums(array_type($input),DATA_TYPECODE);
+}
+%typemap(in)
+ (DATA_TYPE INPLACE_ARRAY2[ANY][ANY])
+ (PyArrayObject* array=NULL)
+{
+ array = obj_to_array_no_conversion($input, DATA_TYPECODE);
+ npy_intp size[2] = { $1_dim0, $1_dim1 };
+ if (!array || !require_dimensions(array,2) || !require_size(array, size, 2)
+ || !require_contiguous(array) || !require_native(array)) SWIG_fail;
+ $1 = ($1_ltype) array_data(array);
+}
+
+/* Typemap suite for (DATA_TYPE* INPLACE_ARRAY2, DIM_TYPE DIM1, DIM_TYPE DIM2)
+ */
+%typecheck(SWIG_TYPECHECK_DOUBLE_ARRAY)
+ (DATA_TYPE* INPLACE_ARRAY2, DIM_TYPE DIM1, DIM_TYPE DIM2)
+{
+ $1 = is_array($input) && PyArray_EquivTypenums(array_type($input),DATA_TYPECODE);
+}
+%typemap(in)
+ (DATA_TYPE* INPLACE_ARRAY2, DIM_TYPE DIM1, DIM_TYPE DIM2)
+ (PyArrayObject* array=NULL)
+{
+ array = obj_to_array_no_conversion($input, DATA_TYPECODE);
+ if (!array || !require_dimensions(array,2) || !require_contiguous(array)
+ || !require_native(array)) SWIG_fail;
+ $1 = (DATA_TYPE*) array_data(array);
+ $2 = (DIM_TYPE) array_size(array,0);
+ $3 = (DIM_TYPE) array_size(array,1);
+}
+
+/* Typemap suite for (DIM_TYPE DIM1, DIM_TYPE DIM2, DATA_TYPE* INPLACE_ARRAY2)
+ */
+%typecheck(SWIG_TYPECHECK_DOUBLE_ARRAY)
+ (DIM_TYPE DIM1, DIM_TYPE DIM2, DATA_TYPE* INPLACE_ARRAY2)
+{
+ $1 = is_array($input) && PyArray_EquivTypenums(array_type($input),DATA_TYPECODE);
+}
+%typemap(in)
+ (DIM_TYPE DIM1, DIM_TYPE DIM2, DATA_TYPE* INPLACE_ARRAY2)
+ (PyArrayObject* array=NULL)
+{
+ array = obj_to_array_no_conversion($input, DATA_TYPECODE);
+ if (!array || !require_dimensions(array,2) || !require_contiguous(array)
+ || !require_native(array)) SWIG_fail;
+ $1 = (DIM_TYPE) array_size(array,0);
+ $2 = (DIM_TYPE) array_size(array,1);
+ $3 = (DATA_TYPE*) array_data(array);
+}
+
+/* Typemap suite for (DATA_TYPE INPLACE_ARRAY3[ANY][ANY][ANY])
+ */
+%typecheck(SWIG_TYPECHECK_DOUBLE_ARRAY)
+ (DATA_TYPE INPLACE_ARRAY3[ANY][ANY][ANY])
+{
+ $1 = is_array($input) && PyArray_EquivTypenums(array_type($input),DATA_TYPECODE);
+}
+%typemap(in)
+ (DATA_TYPE INPLACE_ARRAY3[ANY][ANY][ANY])
+ (PyArrayObject* array=NULL)
+{
+ array = obj_to_array_no_conversion($input, DATA_TYPECODE);
+ npy_intp size[3] = { $1_dim0, $1_dim1, $1_dim2 };
+ if (!array || !require_dimensions(array,3) || !require_size(array, size, 3)
+ || !require_contiguous(array) || !require_native(array)) SWIG_fail;
+ $1 = ($1_ltype) array_data(array);
+}
+
+/* Typemap suite for (DATA_TYPE* INPLACE_ARRAY3, DIM_TYPE DIM1, DIM_TYPE DIM2,
+ * DIM_TYPE DIM3)
+ */
+%typecheck(SWIG_TYPECHECK_DOUBLE_ARRAY)
+ (DATA_TYPE* INPLACE_ARRAY3, DIM_TYPE DIM1, DIM_TYPE DIM2, DIM_TYPE DIM3)
+{
+ $1 = is_array($input) && PyArray_EquivTypenums(array_type($input),DATA_TYPECODE);
+}
+%typemap(in)
+ (DATA_TYPE* INPLACE_ARRAY3, DIM_TYPE DIM1, DIM_TYPE DIM2, DIM_TYPE DIM3)
+ (PyArrayObject* array=NULL)
+{
+ array = obj_to_array_no_conversion($input, DATA_TYPECODE);
+ if (!array || !require_dimensions(array,3) || !require_contiguous(array)
+ || !require_native(array)) SWIG_fail;
+ $1 = (DATA_TYPE*) array_data(array);
+ $2 = (DIM_TYPE) array_size(array,0);
+ $3 = (DIM_TYPE) array_size(array,1);
+ $4 = (DIM_TYPE) array_size(array,2);
+}
+
+/* Typemap suite for (DIM_TYPE DIM1, DIM_TYPE DIM2, DIM_TYPE DIM3,
+ * DATA_TYPE* INPLACE_ARRAY3)
+ */
+%typecheck(SWIG_TYPECHECK_DOUBLE_ARRAY)
+ (DIM_TYPE DIM1, DIM_TYPE DIM2, DIM_TYPE DIM3, DATA_TYPE* INPLACE_ARRAY3)
+{
+ $1 = is_array($input) && PyArray_EquivTypenums(array_type($input),DATA_TYPECODE);
+}
+%typemap(in)
+ (DIM_TYPE DIM1, DIM_TYPE DIM2, DIM_TYPE DIM3, DATA_TYPE* INPLACE_ARRAY3)
+ (PyArrayObject* array=NULL)
+{
+ array = obj_to_array_no_conversion($input, DATA_TYPECODE);
+ if (!array || !require_dimensions(array,3) || !require_contiguous(array)
+ || !require_native(array)) SWIG_fail;
+ $1 = (DIM_TYPE) array_size(array,0);
+ $2 = (DIM_TYPE) array_size(array,1);
+ $3 = (DIM_TYPE) array_size(array,2);
+ $4 = (DATA_TYPE*) array_data(array);
+}
+
+/*************************/
+/* Argout Array Typemaps */
+/*************************/
+
+/* Typemap suite for (DATA_TYPE ARGOUT_ARRAY1[ANY])
+ */
+%typemap(in,numinputs=0)
+ (DATA_TYPE ARGOUT_ARRAY1[ANY])
+ (PyObject * array = NULL)
+{
+ npy_intp dims[1] = { $1_dim0 };
+ array = PyArray_SimpleNew(1, dims, DATA_TYPECODE);
+ $1 = ($1_ltype) array_data(array);
+}
+%typemap(argout)
+ (DATA_TYPE ARGOUT_ARRAY1[ANY])
+{
+ $result = SWIG_Python_AppendOutput($result,array$argnum);
+}
+
+/* Typemap suite for (DATA_TYPE* ARGOUT_ARRAY1, DIM_TYPE DIM1)
+ */
+%typemap(in,numinputs=1)
+ (DATA_TYPE* ARGOUT_ARRAY1, DIM_TYPE DIM1)
+ (PyObject * array = NULL)
+{
+ if (!PyInt_Check($input)) {
+ char* typestring = pytype_string($input);
+ PyErr_Format(PyExc_TypeError,
+ "Int dimension expected. '%s' given.",
+ typestring);
+ SWIG_fail;
+ }
+ $2 = (DIM_TYPE) PyInt_AsLong($input);
+ npy_intp dims[1] = { (npy_intp) $2 };
+ array = PyArray_SimpleNew(1, dims, DATA_TYPECODE);
+ $1 = (DATA_TYPE*) array_data(array);
+}
+%typemap(argout)
+ (DATA_TYPE* ARGOUT_ARRAY1, DIM_TYPE DIM1)
+{
+ $result = SWIG_Python_AppendOutput($result,array$argnum);
+}
+
+/* Typemap suite for (DIM_TYPE DIM1, DATA_TYPE* ARGOUT_ARRAY1)
+ */
+%typemap(in,numinputs=1)
+ (DIM_TYPE DIM1, DATA_TYPE* ARGOUT_ARRAY1)
+ (PyObject * array = NULL)
+{
+ if (!PyInt_Check($input)) {
+ char* typestring = pytype_string($input);
+ PyErr_Format(PyExc_TypeError,
+ "Int dimension expected. '%s' given.",
+ typestring);
+ SWIG_fail;
+ }
+ $1 = (DIM_TYPE) PyInt_AsLong($input);
+ npy_intp dims[1] = { (npy_intp) $1 };
+ array = PyArray_SimpleNew(1, dims, DATA_TYPECODE);
+ $2 = (DATA_TYPE*) array_data(array);
+}
+%typemap(argout)
+ (DIM_TYPE DIM1, DATA_TYPE* ARGOUT_ARRAY1)
+{
+ $result = SWIG_Python_AppendOutput($result,array$argnum);
+}
+
+/* Typemap suite for (DATA_TYPE ARGOUT_ARRAY2[ANY][ANY])
+ */
+%typemap(in,numinputs=0)
+ (DATA_TYPE ARGOUT_ARRAY2[ANY][ANY])
+ (PyObject * array = NULL)
+{
+ npy_intp dims[2] = { $1_dim0, $1_dim1 };
+ array = PyArray_SimpleNew(2, dims, DATA_TYPECODE);
+ $1 = ($1_ltype) array_data(array);
+}
+%typemap(argout)
+ (DATA_TYPE ARGOUT_ARRAY2[ANY][ANY])
+{
+ $result = SWIG_Python_AppendOutput($result,array$argnum);
+}
+
+/* Typemap suite for (DATA_TYPE ARGOUT_ARRAY3[ANY][ANY][ANY])
+ */
+%typemap(in,numinputs=0)
+ (DATA_TYPE ARGOUT_ARRAY3[ANY][ANY][ANY])
+ (PyObject * array = NULL)
+{
+ npy_intp dims[3] = { $1_dim0, $1_dim1, $1_dim2 };
+ array = PyArray_SimpleNew(3, dims, DATA_TYPECODE);
+ $1 = ($1_ltype) array_data(array);
+}
+%typemap(argout)
+ (DATA_TYPE ARGOUT_ARRAY3[ANY][ANY][ANY])
+{
+ $result = SWIG_Python_AppendOutput($result,array$argnum);
+}
+
+%enddef /* %numpy_typemaps() macro */
+
+
+/* Concrete instances of the %numpy_typemaps() macro: Each invocation
+ * below applies all of the typemaps above to the specified data type.
+ */
+%numpy_typemaps(signed char , NPY_BYTE , int)
+%numpy_typemaps(unsigned char , NPY_UBYTE , int)
+%numpy_typemaps(short , NPY_SHORT , int)
+%numpy_typemaps(unsigned short , NPY_USHORT , int)
+%numpy_typemaps(int , NPY_INT , int)
+%numpy_typemaps(unsigned int , NPY_UINT , int)
+%numpy_typemaps(long , NPY_LONG , int)
+%numpy_typemaps(unsigned long , NPY_ULONG , int)
+%numpy_typemaps(long long , NPY_LONGLONG , int)
+%numpy_typemaps(unsigned long long, NPY_ULONGLONG, int)
+%numpy_typemaps(float , NPY_FLOAT , int)
+%numpy_typemaps(double , NPY_DOUBLE , int)
+
+/* ***************************************************************
+ * The follow macro expansion does not work, because C++ bool is 4
+ * bytes and NPY_BOOL is 1 byte
+ */
+/*%numpy_typemaps(bool, NPY_BOOL)
+ */
+
+/* ***************************************************************
+ * On my Mac, I get the following warning for this macro expansion:
+ * 'swig/python detected a memory leak of type 'long double *', no destructor found.'
+ */
+/*%numpy_typemaps(long double, NPY_LONGDOUBLE)
+ */
+
+/* ***************************************************************
+ * Swig complains about a syntax error for the following macros
+ * expansions:
+ */
+/*%numpy_typemaps(complex float, NPY_CFLOAT , int)
+ */
+/*%numpy_typemaps(complex double, NPY_CDOUBLE, int)
+ */
+/*%numpy_typemaps(complex long double, NPY_CLONGDOUBLE)
+ */
+
+#endif /* SWIGPYTHON */
diff --git a/numpy/doc/swig/numpy_swig.html b/numpy/doc/swig/numpy_swig.html
new file mode 100644
index 000000000..90706ac84
--- /dev/null
+++ b/numpy/doc/swig/numpy_swig.html
@@ -0,0 +1,1061 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+<meta name="generator" content="Docutils 0.4: http://docutils.sourceforge.net/" />
+<title>numpy.i: a SWIG Interface File for NumPy</title>
+<meta name="author" content="Bill Spotz" />
+<meta name="date" content="13 April, 2007" />
+<style type="text/css">
+
+/*
+:Author: David Goodger
+:Contact: goodger@users.sourceforge.net
+:Date: $Date: 2005-12-18 01:56:14 +0100 (Sun, 18 Dec 2005) $
+:Revision: $Revision: 4224 $
+:Copyright: This stylesheet has been placed in the public domain.
+
+Default cascading style sheet for the HTML output of Docutils.
+
+See http://docutils.sf.net/docs/howto/html-stylesheets.html for how to
+customize this style sheet.
+*/
+
+/* used to remove borders from tables and images */
+.borderless, table.borderless td, table.borderless th {
+ border: 0 }
+
+table.borderless td, table.borderless th {
+ /* Override padding for "table.docutils td" with "! important".
+ The right padding separates the table cells. */
+ padding: 0 0.5em 0 0 ! important }
+
+.first {
+ /* Override more specific margin styles with "! important". */
+ margin-top: 0 ! important }
+
+.last, .with-subtitle {
+ margin-bottom: 0 ! important }
+
+.hidden {
+ display: none }
+
+a.toc-backref {
+ text-decoration: none ;
+ color: black }
+
+blockquote.epigraph {
+ margin: 2em 5em ; }
+
+dl.docutils dd {
+ margin-bottom: 0.5em }
+
+/* Uncomment (and remove this text!) to get bold-faced definition list terms
+dl.docutils dt {
+ font-weight: bold }
+*/
+
+div.abstract {
+ margin: 2em 5em }
+
+div.abstract p.topic-title {
+ font-weight: bold ;
+ text-align: center }
+
+div.admonition, div.attention, div.caution, div.danger, div.error,
+div.hint, div.important, div.note, div.tip, div.warning {
+ margin: 2em ;
+ border: medium outset ;
+ padding: 1em }
+
+div.admonition p.admonition-title, div.hint p.admonition-title,
+div.important p.admonition-title, div.note p.admonition-title,
+div.tip p.admonition-title {
+ font-weight: bold ;
+ font-family: sans-serif }
+
+div.attention p.admonition-title, div.caution p.admonition-title,
+div.danger p.admonition-title, div.error p.admonition-title,
+div.warning p.admonition-title {
+ color: red ;
+ font-weight: bold ;
+ font-family: sans-serif }
+
+/* Uncomment (and remove this text!) to get reduced vertical space in
+ compound paragraphs.
+div.compound .compound-first, div.compound .compound-middle {
+ margin-bottom: 0.5em }
+
+div.compound .compound-last, div.compound .compound-middle {
+ margin-top: 0.5em }
+*/
+
+div.dedication {
+ margin: 2em 5em ;
+ text-align: center ;
+ font-style: italic }
+
+div.dedication p.topic-title {
+ font-weight: bold ;
+ font-style: normal }
+
+div.figure {
+ margin-left: 2em ;
+ margin-right: 2em }
+
+div.footer, div.header {
+ clear: both;
+ font-size: smaller }
+
+div.line-block {
+ display: block ;
+ margin-top: 1em ;
+ margin-bottom: 1em }
+
+div.line-block div.line-block {
+ margin-top: 0 ;
+ margin-bottom: 0 ;
+ margin-left: 1.5em }
+
+div.sidebar {
+ margin-left: 1em ;
+ border: medium outset ;
+ padding: 1em ;
+ background-color: #ffffee ;
+ width: 40% ;
+ float: right ;
+ clear: right }
+
+div.sidebar p.rubric {
+ font-family: sans-serif ;
+ font-size: medium }
+
+div.system-messages {
+ margin: 5em }
+
+div.system-messages h1 {
+ color: red }
+
+div.system-message {
+ border: medium outset ;
+ padding: 1em }
+
+div.system-message p.system-message-title {
+ color: red ;
+ font-weight: bold }
+
+div.topic {
+ margin: 2em }
+
+h1.section-subtitle, h2.section-subtitle, h3.section-subtitle,
+h4.section-subtitle, h5.section-subtitle, h6.section-subtitle {
+ margin-top: 0.4em }
+
+h1.title {
+ text-align: center }
+
+h2.subtitle {
+ text-align: center }
+
+hr.docutils {
+ width: 75% }
+
+img.align-left {
+ clear: left }
+
+img.align-right {
+ clear: right }
+
+ol.simple, ul.simple {
+ margin-bottom: 1em }
+
+ol.arabic {
+ list-style: decimal }
+
+ol.loweralpha {
+ list-style: lower-alpha }
+
+ol.upperalpha {
+ list-style: upper-alpha }
+
+ol.lowerroman {
+ list-style: lower-roman }
+
+ol.upperroman {
+ list-style: upper-roman }
+
+p.attribution {
+ text-align: right ;
+ margin-left: 50% }
+
+p.caption {
+ font-style: italic }
+
+p.credits {
+ font-style: italic ;
+ font-size: smaller }
+
+p.label {
+ white-space: nowrap }
+
+p.rubric {
+ font-weight: bold ;
+ font-size: larger ;
+ color: maroon ;
+ text-align: center }
+
+p.sidebar-title {
+ font-family: sans-serif ;
+ font-weight: bold ;
+ font-size: larger }
+
+p.sidebar-subtitle {
+ font-family: sans-serif ;
+ font-weight: bold }
+
+p.topic-title {
+ font-weight: bold }
+
+pre.address {
+ margin-bottom: 0 ;
+ margin-top: 0 ;
+ font-family: serif ;
+ font-size: 100% }
+
+pre.literal-block, pre.doctest-block {
+ margin-left: 2em ;
+ margin-right: 2em ;
+ background-color: #eeeeee }
+
+span.classifier {
+ font-family: sans-serif ;
+ font-style: oblique }
+
+span.classifier-delimiter {
+ font-family: sans-serif ;
+ font-weight: bold }
+
+span.interpreted {
+ font-family: sans-serif }
+
+span.option {
+ white-space: nowrap }
+
+span.pre {
+ white-space: pre }
+
+span.problematic {
+ color: red }
+
+span.section-subtitle {
+ /* font-size relative to parent (h1..h6 element) */
+ font-size: 80% }
+
+table.citation {
+ border-left: solid 1px gray;
+ margin-left: 1px }
+
+table.docinfo {
+ margin: 2em 4em }
+
+table.docutils {
+ margin-top: 0.5em ;
+ margin-bottom: 0.5em }
+
+table.footnote {
+ border-left: solid 1px black;
+ margin-left: 1px }
+
+table.docutils td, table.docutils th,
+table.docinfo td, table.docinfo th {
+ padding-left: 0.5em ;
+ padding-right: 0.5em ;
+ vertical-align: top }
+
+table.docutils th.field-name, table.docinfo th.docinfo-name {
+ font-weight: bold ;
+ text-align: left ;
+ white-space: nowrap ;
+ padding-left: 0 }
+
+h1 tt.docutils, h2 tt.docutils, h3 tt.docutils,
+h4 tt.docutils, h5 tt.docutils, h6 tt.docutils {
+ font-size: 100% }
+
+tt.docutils {
+ background-color: #eeeeee }
+
+ul.auto-toc {
+ list-style-type: none }
+
+</style>
+</head>
+<body>
+<div class="document" id="numpy-i-a-swig-interface-file-for-numpy">
+<h1 class="title">numpy.i: a SWIG Interface File for NumPy</h1>
+<table class="docinfo" frame="void" rules="none">
+<col class="docinfo-name" />
+<col class="docinfo-content" />
+<tbody valign="top">
+<tr><th class="docinfo-name">Author:</th>
+<td>Bill Spotz</td></tr>
+<tr class="field"><th class="docinfo-name">Institution:</th><td class="field-body">Sandia National Laboratories</td>
+</tr>
+<tr><th class="docinfo-name">Date:</th>
+<td>13 April, 2007</td></tr>
+</tbody>
+</table>
+<div class="contents topic">
+<p class="topic-title first"><a id="contents" name="contents">Contents</a></p>
+<ul class="simple">
+<li><a class="reference" href="#introduction" id="id1" name="id1">Introduction</a></li>
+<li><a class="reference" href="#using-numpy-i" id="id2" name="id2">Using numpy.i</a></li>
+<li><a class="reference" href="#available-typemaps" id="id3" name="id3">Available Typemaps</a><ul>
+<li><a class="reference" href="#input-arrays" id="id4" name="id4">Input Arrays</a></li>
+<li><a class="reference" href="#in-place-arrays" id="id5" name="id5">In-Place Arrays</a></li>
+<li><a class="reference" href="#argout-arrays" id="id6" name="id6">Argout Arrays</a></li>
+<li><a class="reference" href="#output-arrays" id="id7" name="id7">Output Arrays</a></li>
+<li><a class="reference" href="#other-common-types-bool" id="id8" name="id8">Other Common Types: bool</a></li>
+<li><a class="reference" href="#other-common-types-complex" id="id9" name="id9">Other Common Types: complex</a></li>
+</ul>
+</li>
+<li><a class="reference" href="#helper-functions" id="id10" name="id10">Helper Functions</a><ul>
+<li><a class="reference" href="#macros" id="id11" name="id11">Macros</a></li>
+<li><a class="reference" href="#routines" id="id12" name="id12">Routines</a></li>
+</ul>
+</li>
+<li><a class="reference" href="#beyond-the-provided-typemaps" id="id13" name="id13">Beyond the Provided Typemaps</a><ul>
+<li><a class="reference" href="#a-common-example" id="id14" name="id14">A Common Example</a></li>
+<li><a class="reference" href="#other-situations" id="id15" name="id15">Other Situations</a></li>
+<li><a class="reference" href="#a-final-note" id="id16" name="id16">A Final Note</a></li>
+</ul>
+</li>
+<li><a class="reference" href="#summary" id="id17" name="id17">Summary</a></li>
+<li><a class="reference" href="#acknowledgements" id="id18" name="id18">Acknowledgements</a></li>
+</ul>
+</div>
+<div class="section">
+<h1><a class="toc-backref" href="#id1" id="introduction" name="introduction">Introduction</a></h1>
+<p>The Simple Wrapper and Interface Generator (or <a class="reference" href="http://www.swig.org">SWIG</a>) is a powerful tool for generating wrapper
+code for interfacing to a wide variety of scripting languages.
+<a class="reference" href="http://www.swig.org">SWIG</a> can parse header files, and using only the code prototypes,
+create an interface to the target language. But <a class="reference" href="http://www.swig.org">SWIG</a> is not
+omnipotent. For example, it cannot know from the prototype:</p>
+<pre class="literal-block">
+double rms(double* seq, int n);
+</pre>
+<p>what exactly <tt class="docutils literal"><span class="pre">seq</span></tt> is. Is it a single value to be altered in-place?
+Is it an array, and if so what is its length? Is it input-only?
+Output-only? Input-output? <a class="reference" href="http://www.swig.org">SWIG</a> cannot determine these details,
+and does not attempt to do so.</p>
+<p>Making an educated guess, humans can conclude that this is probably a
+routine that takes an input-only array of length <tt class="docutils literal"><span class="pre">n</span></tt> of <tt class="docutils literal"><span class="pre">double</span></tt>
+values called <tt class="docutils literal"><span class="pre">seq</span></tt> and returns the root mean square. The default
+behavior of <a class="reference" href="http://www.swig.org">SWIG</a>, however, will be to create a wrapper function
+that compiles, but is nearly impossible to use from the scripting
+language in the way the C routine was intended.</p>
+<p>For <a class="reference" href="http://www.python.org">python</a>, the preferred way of handling
+contiguous (or technically, <em>strided</em>) blocks of homogeneous data is
+with the module <a class="reference" href="http://numpy.scipy.org">NumPy</a>, which provides full
+object-oriented access to arrays of data. Therefore, the most logical
+<a class="reference" href="http://www.python.org">python</a> interface for the <tt class="docutils literal"><span class="pre">rms</span></tt> function would be (including doc
+string):</p>
+<pre class="literal-block">
+def rms(seq):
+ &quot;&quot;&quot;
+ rms: return the root mean square of a sequence
+ rms(numpy.ndarray) -&gt; double
+ rms(list) -&gt; double
+ rms(tuple) -&gt; double
+ &quot;&quot;&quot;
+</pre>
+<p>where <tt class="docutils literal"><span class="pre">seq</span></tt> would be a <a class="reference" href="http://numpy.scipy.org">NumPy</a> array of <tt class="docutils literal"><span class="pre">double</span></tt> values, and its
+length <tt class="docutils literal"><span class="pre">n</span></tt> would be extracted from <tt class="docutils literal"><span class="pre">seq</span></tt> internally before being
+passed to the C routine. Even better, since <a class="reference" href="http://numpy.scipy.org">NumPy</a> supports
+construction of arrays from arbitrary <a class="reference" href="http://www.python.org">python</a> sequences, <tt class="docutils literal"><span class="pre">seq</span></tt>
+itself could be a nearly arbitrary sequence (so long as each element
+can be converted to a <tt class="docutils literal"><span class="pre">double</span></tt>) and the wrapper code would
+internally convert it to a <a class="reference" href="http://numpy.scipy.org">NumPy</a> array before extracting its data
+and length.</p>
+<p><a class="reference" href="http://www.swig.org">SWIG</a> allows these types of conversions to be defined via a
+mechanism called typemaps. This document provides information on how
+to use <tt class="docutils literal"><span class="pre">numpy.i</span></tt>, a <a class="reference" href="http://www.swig.org">SWIG</a> interface file that defines a series of
+typemaps intended to make the type of array-related conversions
+described above relatively simple to implement. For example, suppose
+that the <tt class="docutils literal"><span class="pre">rms</span></tt> function prototype defined above was in a header file
+named <tt class="docutils literal"><span class="pre">rms.h</span></tt>. To obtain the <a class="reference" href="http://www.python.org">python</a> interface discussed above,
+your <a class="reference" href="http://www.swig.org">SWIG</a> interface file would need the following:</p>
+<pre class="literal-block">
+%{
+#define SWIG_FILE_WITH_INIT
+#include &quot;rms.h&quot;
+%}
+
+%include &quot;numpy.i&quot;
+
+%init %{
+import_array();
+%}
+
+%apply (double* IN_ARRAY1, int DIM1) {(double* seq, int n)};
+%include &quot;rms.h&quot;
+</pre>
+<p>Typemaps are keyed off a list of one or more function arguments,
+either by type or by type and name. We will refer to such lists as
+<em>signatures</em>. One of the many typemaps defined by <tt class="docutils literal"><span class="pre">numpy.i</span></tt> is used
+above and has the signature <tt class="docutils literal"><span class="pre">(double*</span> <span class="pre">IN_ARRAY1,</span> <span class="pre">int</span> <span class="pre">DIM1)</span></tt>. The
+argument names are intended to suggest that the <tt class="docutils literal"><span class="pre">double*</span></tt> argument
+is an input array of one dimension and that the <tt class="docutils literal"><span class="pre">int</span></tt> represents
+that dimension. This is precisely the pattern in the <tt class="docutils literal"><span class="pre">rms</span></tt>
+prototype.</p>
+<p>Most likely, no actual prototypes to be wrapped will have the argument
+names <tt class="docutils literal"><span class="pre">IN_ARRAY1</span></tt> and <tt class="docutils literal"><span class="pre">DIM1</span></tt>. We use the <tt class="docutils literal"><span class="pre">%apply</span></tt> directive to
+apply the typemap for one-dimensional input arrays of type <tt class="docutils literal"><span class="pre">double</span></tt>
+to the actual prototype used by <tt class="docutils literal"><span class="pre">rms</span></tt>. Using <tt class="docutils literal"><span class="pre">numpy.i</span></tt>
+effectively, therefore, requires knowing what typemaps are available
+and what they do.</p>
+<p>A <a class="reference" href="http://www.swig.org">SWIG</a> interface file that includes the <a class="reference" href="http://www.swig.org">SWIG</a> directives given
+above will produce wrapper code that looks something like:</p>
+<pre class="literal-block">
+ 1 PyObject *_wrap_rms(PyObject *args) {
+ 2 PyObject *resultobj = 0;
+ 3 double *arg1 = (double *) 0 ;
+ 4 int arg2 ;
+ 5 double result;
+ 6 PyArrayObject *array1 = NULL ;
+ 7 int is_new_object1 = 0 ;
+ 8 PyObject * obj0 = 0 ;
+ 9
+10 if (!PyArg_ParseTuple(args,(char *)&quot;O:rms&quot;,&amp;obj0)) SWIG_fail;
+11 {
+12 array1 = obj_to_array_contiguous_allow_conversion(
+13 obj0, NPY_DOUBLE, &amp;is_new_object1);
+14 npy_intp size[1] = {
+15 -1
+16 };
+17 if (!array1 || !require_dimensions(array1, 1) ||
+18 !require_size(array1, size, 1)) SWIG_fail;
+19 arg1 = (double*) array1-&gt;data;
+20 arg2 = (int) array1-&gt;dimensions[0];
+21 }
+22 result = (double)rms(arg1,arg2);
+23 resultobj = SWIG_From_double((double)(result));
+24 {
+25 if (is_new_object1 &amp;&amp; array1) Py_DECREF(array1);
+26 }
+27 return resultobj;
+28 fail:
+29 {
+30 if (is_new_object1 &amp;&amp; array1) Py_DECREF(array1);
+31 }
+32 return NULL;
+33 }
+</pre>
+<p>The typemaps from <tt class="docutils literal"><span class="pre">numpy.i</span></tt> are responsible for the following lines
+of code: 12--20, 25 and 30. Line 10 parses the input to the <tt class="docutils literal"><span class="pre">rms</span></tt>
+function. From the format string <tt class="docutils literal"><span class="pre">&quot;O:rms&quot;</span></tt>, we can see that the
+argument list is expected to be a single <a class="reference" href="http://www.python.org">python</a> object (specified
+by the <tt class="docutils literal"><span class="pre">O</span></tt> before the colon) and whose pointer is stored in
+<tt class="docutils literal"><span class="pre">obj0</span></tt>. A number of functions, supplied by <tt class="docutils literal"><span class="pre">numpy.i</span></tt>, are called
+to make and check the (possible) conversion from a generic <a class="reference" href="http://www.python.org">python</a>
+object to a <a class="reference" href="http://numpy.scipy.org">NumPy</a> array. These functions are explained in the
+section <a class="reference" href="#helper-functions">Helper Functions</a>, but hopefully their names are
+self-explanatory. At line 12 we use <tt class="docutils literal"><span class="pre">obj0</span></tt> to construct a <a class="reference" href="http://numpy.scipy.org">NumPy</a>
+array. At line 17, we check the validity of the result: that it is
+non-null and that it has a single dimension of arbitrary length. Once
+these states are verified, we extract the data buffer and length in
+lines 19 and 20 so that we can call the underlying C function at line
+22. Line 25 performs memory management for the case where we have
+created a new array that is no longer needed.</p>
+<p>This code has a significant amount of error handling. Note the
+<tt class="docutils literal"><span class="pre">SWIG_fail</span></tt> is a macro for <tt class="docutils literal"><span class="pre">goto</span> <span class="pre">fail</span></tt>, refering to the label at
+line 28. If the user provides the wrong number of arguments, this
+will be caught at line 10. If construction of the <a class="reference" href="http://numpy.scipy.org">NumPy</a> array
+fails or produces an array with the wrong number of dimensions, these
+errors are caught at line 17. And finally, if an error is detected,
+memory is still managed correctly at line 30.</p>
+<p>Note that if the C function signature was in a different order:</p>
+<pre class="literal-block">
+double rms(int n, double* seq);
+</pre>
+<p>that <a class="reference" href="http://www.swig.org">SWIG</a> would not match the typemap signature given above with
+the argument list for <tt class="docutils literal"><span class="pre">rms</span></tt>. Fortunately, <tt class="docutils literal"><span class="pre">numpy.i</span></tt> has a set of
+typemaps with the data pointer given last:</p>
+<pre class="literal-block">
+%apply (int DIM1, double* IN_ARRAY1) {(int n, double* seq)};
+</pre>
+<p>This simply has the effect of switching the definitions of <tt class="docutils literal"><span class="pre">arg1</span></tt>
+and <tt class="docutils literal"><span class="pre">arg2</span></tt> in lines 3 and 4 of the generated code above, and their
+assignments in lines 19 and 20.</p>
+</div>
+<div class="section">
+<h1><a class="toc-backref" href="#id2" id="using-numpy-i" name="using-numpy-i">Using numpy.i</a></h1>
+<p>The <tt class="docutils literal"><span class="pre">numpy.i</span></tt> file is currently located in the <tt class="docutils literal"><span class="pre">numpy/docs/swig</span></tt>
+sub-directory under the <tt class="docutils literal"><span class="pre">numpy</span></tt> installation directory. Typically,
+you will want to copy it to the directory where you are developing
+your wrappers. If it is ever adopted by <a class="reference" href="http://www.swig.org">SWIG</a> developers, then it
+will be installed in a standard place where <a class="reference" href="http://www.swig.org">SWIG</a> can find it.</p>
+<p>A simple module that only uses a single <a class="reference" href="http://www.swig.org">SWIG</a> interface file should
+include the following:</p>
+<pre class="literal-block">
+%{
+#define SWIG_FILE_WITH_INIT
+%}
+%include &quot;numpy.i&quot;
+%init %{
+import_array();
+%}
+</pre>
+<p>Within a compiled <a class="reference" href="http://www.python.org">python</a> module, <tt class="docutils literal"><span class="pre">import_array()</span></tt> should only get
+called once. This could be in a C/C++ file that you have written and
+is linked to the module. If this is the case, then none of your
+interface files should <tt class="docutils literal"><span class="pre">#define</span> <span class="pre">SWIG_FILE_WITH_INIT</span></tt> or call
+<tt class="docutils literal"><span class="pre">import_array()</span></tt>. Or, this initialization call could be in a
+wrapper file generated by <a class="reference" href="http://www.swig.org">SWIG</a> from an interface file that has the
+<tt class="docutils literal"><span class="pre">%init</span></tt> block as above. If this is the case, and you have more than
+one <a class="reference" href="http://www.swig.org">SWIG</a> interface file, then only one interface file should
+<tt class="docutils literal"><span class="pre">#define</span> <span class="pre">SWIG_FILE_WITH_INIT</span></tt> and call <tt class="docutils literal"><span class="pre">import_array()</span></tt>.</p>
+</div>
+<div class="section">
+<h1><a class="toc-backref" href="#id3" id="available-typemaps" name="available-typemaps">Available Typemaps</a></h1>
+<p>The typemap directives provided by <tt class="docutils literal"><span class="pre">numpy.i</span></tt> for arrays of different
+data types, say <tt class="docutils literal"><span class="pre">double</span></tt> and <tt class="docutils literal"><span class="pre">int</span></tt>, and dimensions of different
+types, say <tt class="docutils literal"><span class="pre">int</span></tt> or <tt class="docutils literal"><span class="pre">long</span></tt>, are identical to one another except
+for the C and <a class="reference" href="http://numpy.scipy.org">NumPy</a> type specifications. The typemaps are
+therefore implemented (typically behind the scenes) via a macro:</p>
+<pre class="literal-block">
+%numpy_typemaps(DATA_TYPE, DATA_TYPECODE, DIM_TYPE)
+</pre>
+<p>that can be invoked for appropriate <tt class="docutils literal"><span class="pre">(DATA_TYPE,</span> <span class="pre">DATA_TYPECODE,</span>
+<span class="pre">DIM_TYPE)</span></tt> triplets. For example:</p>
+<pre class="literal-block">
+%numpy_typemaps(double, NPY_DOUBLE, int)
+%numpy_typemaps(int, NPY_INT , int)
+</pre>
+<p>The <tt class="docutils literal"><span class="pre">numpy.i</span></tt> interface file uses the <tt class="docutils literal"><span class="pre">%numpy_typemaps</span></tt> macro to
+implement typemaps for the following C data types and <tt class="docutils literal"><span class="pre">int</span></tt>
+dimension types:</p>
+<blockquote>
+<ul class="simple">
+<li><tt class="docutils literal"><span class="pre">signed</span> <span class="pre">char</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">unsigned</span> <span class="pre">char</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">short</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">unsigned</span> <span class="pre">short</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">int</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">unsigned</span> <span class="pre">int</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">long</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">unsigned</span> <span class="pre">long</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">long</span> <span class="pre">long</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">unsigned</span> <span class="pre">long</span> <span class="pre">long</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">float</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">double</span></tt></li>
+</ul>
+</blockquote>
+<p>In the following descriptions, we reference a generic <tt class="docutils literal"><span class="pre">DATA_TYPE</span></tt>, which
+could be any of the C data types listed above.</p>
+<div class="section">
+<h2><a class="toc-backref" href="#id4" id="input-arrays" name="input-arrays">Input Arrays</a></h2>
+<p>Input arrays are defined as arrays of data that are passed into a
+routine but are not altered in-place or returned to the user. The
+<a class="reference" href="http://www.python.org">python</a> input array is therefore allowed to be almost any <a class="reference" href="http://www.python.org">python</a>
+sequence (such as a list) that can be converted to the requested type
+of array. The input array signatures are</p>
+<blockquote>
+<ul class="simple">
+<li><tt class="docutils literal"><span class="pre">(DATA_TYPE</span> <span class="pre">IN_ARRAY1[ANY])</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(DATA_TYPE*</span> <span class="pre">IN_ARRAY1,</span> <span class="pre">int</span> <span class="pre">DIM1)</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(int</span> <span class="pre">DIM1,</span> <span class="pre">DATA_TYPE*</span> <span class="pre">IN_ARRAY1)</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(DATA_TYPE</span> <span class="pre">IN_ARRAY2[ANY][ANY])</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(DATA_TYPE*</span> <span class="pre">IN_ARRAY2,</span> <span class="pre">int</span> <span class="pre">DIM1,</span> <span class="pre">int</span> <span class="pre">DIM2)</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(int</span> <span class="pre">DIM1,</span> <span class="pre">int</span> <span class="pre">DIM2,</span> <span class="pre">DATA_TYPE*</span> <span class="pre">IN_ARRAY2)</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(DATA_TYPE</span> <span class="pre">IN_ARRAY3[ANY][ANY][ANY])</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(DATA_TYPE*</span> <span class="pre">IN_ARRAY3,</span> <span class="pre">int</span> <span class="pre">DIM1,</span> <span class="pre">int</span> <span class="pre">DIM2,</span> <span class="pre">int</span> <span class="pre">DIM3)</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(int</span> <span class="pre">DIM1,</span> <span class="pre">int</span> <span class="pre">DIM2,</span> <span class="pre">int</span> <span class="pre">DIM3,</span> <span class="pre">DATA_TYPE*</span> <span class="pre">IN_ARRAY3)</span></tt></li>
+</ul>
+</blockquote>
+<p>The first signature listed, <tt class="docutils literal"><span class="pre">(DATA_TYPE</span> <span class="pre">IN_ARRAY[ANY])</span></tt> is for
+one-dimensional arrays with hard-coded dimensions. Likewise,
+<tt class="docutils literal"><span class="pre">(DATA_TYPE</span> <span class="pre">IN_ARRAY2[ANY][ANY])</span></tt> is for two-dimensional arrays with
+hard-coded dimensions, and similarly for three-dimensional.</p>
+</div>
+<div class="section">
+<h2><a class="toc-backref" href="#id5" id="in-place-arrays" name="in-place-arrays">In-Place Arrays</a></h2>
+<p>In-place arrays are defined as arrays that are modified in-place. The
+input values may or may not be used, but the values at the time the
+function returns are significant. The provided <a class="reference" href="http://www.python.org">python</a> argument
+must therefore be a <a class="reference" href="http://numpy.scipy.org">NumPy</a> array of the required type. The in-place
+signatures are</p>
+<blockquote>
+<ul class="simple">
+<li><tt class="docutils literal"><span class="pre">(DATA_TYPE</span> <span class="pre">INPLACE_ARRAY1[ANY])</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(DATA_TYPE*</span> <span class="pre">INPLACE_ARRAY1,</span> <span class="pre">int</span> <span class="pre">DIM1)</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(int</span> <span class="pre">DIM1,</span> <span class="pre">DATA_TYPE*</span> <span class="pre">INPLACE_ARRAY1)</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(DATA_TYPE</span> <span class="pre">INPLACE_ARRAY2[ANY][ANY])</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(DATA_TYPE*</span> <span class="pre">INPLACE_ARRAY2,</span> <span class="pre">int</span> <span class="pre">DIM1,</span> <span class="pre">int</span> <span class="pre">DIM2)</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(int</span> <span class="pre">DIM1,</span> <span class="pre">int</span> <span class="pre">DIM2,</span> <span class="pre">DATA_TYPE*</span> <span class="pre">INPLACE_ARRAY2)</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(DATA_TYPE</span> <span class="pre">INPLACE_ARRAY3[ANY][ANY][ANY])</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(DATA_TYPE*</span> <span class="pre">INPLACE_ARRAY3,</span> <span class="pre">int</span> <span class="pre">DIM1,</span> <span class="pre">int</span> <span class="pre">DIM2,</span> <span class="pre">int</span> <span class="pre">DIM3)</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(int</span> <span class="pre">DIM1,</span> <span class="pre">int</span> <span class="pre">DIM2,</span> <span class="pre">int</span> <span class="pre">DIM3,</span> <span class="pre">DATA_TYPE*</span> <span class="pre">INPLACE_ARRAY3)</span></tt></li>
+</ul>
+</blockquote>
+<p>These typemaps now check to make sure that the <tt class="docutils literal"><span class="pre">INPLACE_ARRAY</span></tt>
+arguments use native byte ordering. If not, an exception is raised.</p>
+</div>
+<div class="section">
+<h2><a class="toc-backref" href="#id6" id="argout-arrays" name="argout-arrays">Argout Arrays</a></h2>
+<p>Argout arrays are arrays that appear in the input arguments in C, but
+are in fact output arrays. This pattern occurs often when there is
+more than one output variable and the single return argument is
+therefore not sufficient. In <a class="reference" href="http://www.python.org">python</a>, the convential way to return
+multiple arguments is to pack them into a sequence (tuple, list, etc.)
+and return the sequence. This is what the argout typemaps do. If a
+wrapped function that uses these argout typemaps has more than one
+return argument, they are packed into a tuple or list, depending on
+the version of <a class="reference" href="http://www.python.org">python</a>. The <a class="reference" href="http://www.python.org">python</a> user does not pass these
+arrays in, they simply get returned. The argout signatures are</p>
+<blockquote>
+<ul class="simple">
+<li><tt class="docutils literal"><span class="pre">(DATA_TYPE</span> <span class="pre">ARGOUT_ARRAY1[ANY])</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(DATA_TYPE*</span> <span class="pre">ARGOUT_ARRAY1,</span> <span class="pre">int</span> <span class="pre">DIM1)</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(int</span> <span class="pre">DIM1,</span> <span class="pre">DATA_TYPE*</span> <span class="pre">ARGOUT_ARRAY1)</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(DATA_TYPE</span> <span class="pre">ARGOUT_ARRAY2[ANY][ANY])</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">(DATA_TYPE</span> <span class="pre">ARGOUT_ARRAY3[ANY][ANY][ANY])</span></tt></li>
+</ul>
+</blockquote>
+<p>These are typically used in situations where in C/C++, you would
+allocate a(n) array(s) on the heap, and call the function to fill the
+array(s) values. In <a class="reference" href="http://www.python.org">python</a>, the arrays are allocated for you and
+returned as new array objects.</p>
+<p>Note that we support <tt class="docutils literal"><span class="pre">DATA_TYPE*</span></tt> argout typemaps in 1D, but not 2D
+or 3D. This because of a quirk with the <a class="reference" href="http://www.swig.org">SWIG</a> typemap syntax and
+cannot be avoided. Note that for these types of 1D typemaps, the
+<a class="reference" href="http://www.python.org">python</a> function will take a single argument representing <tt class="docutils literal"><span class="pre">DIM1</span></tt>.</p>
+</div>
+<div class="section">
+<h2><a class="toc-backref" href="#id7" id="output-arrays" name="output-arrays">Output Arrays</a></h2>
+<p>The <tt class="docutils literal"><span class="pre">numpy.i</span></tt> interface file does not support typemaps for output
+arrays, for several reasons. First, C/C++ function return arguments
+do not have names, so signatures for <tt class="docutils literal"><span class="pre">%typemap(out)</span></tt> do not include
+names. This means that if <tt class="docutils literal"><span class="pre">numpy.i</span></tt> supported them, they would
+apply to all pointer return arguments for the supported numeric
+types. This seems too dangerous. Second, C/C++ return arguments are
+limited to a single value. This prevents obtaining dimension
+information in a general way. Third, arrays with hard-coded lengths
+are not permitted as return arguments. In other words:</p>
+<pre class="literal-block">
+double[3] newVector(double x, double y, double z);
+</pre>
+<p>is not legal C/C++ syntax. Therefore, we cannot provide typemaps of
+the form:</p>
+<pre class="literal-block">
+%typemap(out) (TYPE[ANY]);
+</pre>
+<p>If you run into a situation where a function or method is returning a
+pointer to an array, your best bet is to write your own version of the
+function to be wrapped, either with <tt class="docutils literal"><span class="pre">%extend</span></tt> for the case of class
+methods or <tt class="docutils literal"><span class="pre">%ignore</span></tt> and <tt class="docutils literal"><span class="pre">%rename</span></tt> for the case of functions.</p>
+</div>
+<div class="section">
+<h2><a class="toc-backref" href="#id8" id="other-common-types-bool" name="other-common-types-bool">Other Common Types: bool</a></h2>
+<p>Note that C++ type <tt class="docutils literal"><span class="pre">bool</span></tt> is not supported in the list in the
+<a class="reference" href="#available-typemaps">Available Typemaps</a> section. NumPy bools are a single byte, while
+the C++ <tt class="docutils literal"><span class="pre">bool</span></tt> is four bytes (at least on my system). Therefore:</p>
+<pre class="literal-block">
+%numpy_typemaps(bool, NPY_BOOL, int)
+</pre>
+<p>will result in typemaps that will produce code that reference
+improper data lengths. You can implement the following macro
+expansion:</p>
+<pre class="literal-block">
+%numpy_typemaps(bool, NPY_UINT, int)
+</pre>
+<p>to fix the data length problem, and <a class="reference" href="#input-arrays">Input Arrays</a> will work fine,
+but <a class="reference" href="#in-place-arrays">In-Place Arrays</a> might fail type-checking.</p>
+</div>
+<div class="section">
+<h2><a class="toc-backref" href="#id9" id="other-common-types-complex" name="other-common-types-complex">Other Common Types: complex</a></h2>
+<p>Typemap conversions for complex floating-point types is also not
+supported automatically. This is because <a class="reference" href="http://www.python.org">python</a> and <a class="reference" href="http://numpy.scipy.org">NumPy</a> are
+written in C, which does not have native complex types. Both
+<a class="reference" href="http://www.python.org">python</a> and <a class="reference" href="http://numpy.scipy.org">NumPy</a> implement their own (essentially equivalent)
+<tt class="docutils literal"><span class="pre">struct</span></tt> definitions for complex variables:</p>
+<pre class="literal-block">
+/* Python */
+typedef struct {double real; double imag;} Py_complex;
+
+/* NumPy */
+typedef struct {float real, imag;} npy_cfloat;
+typedef struct {double real, imag;} npy_cdouble;
+</pre>
+<p>We could have implemented:</p>
+<pre class="literal-block">
+%numpy_typemaps(Py_complex , NPY_CDOUBLE, int)
+%numpy_typemaps(npy_cfloat , NPY_CFLOAT , int)
+%numpy_typemaps(npy_cdouble, NPY_CDOUBLE, int)
+</pre>
+<p>which would have provided automatic type conversions for arrays of
+type <tt class="docutils literal"><span class="pre">Py_complex</span></tt>, <tt class="docutils literal"><span class="pre">npy_cfloat</span></tt> and <tt class="docutils literal"><span class="pre">npy_cdouble</span></tt>. However, it
+seemed unlikely that there would be any independent (non-<a class="reference" href="http://www.python.org">python</a>,
+non-<a class="reference" href="http://numpy.scipy.org">NumPy</a>) application code that people would be using <a class="reference" href="http://www.swig.org">SWIG</a> to
+generate a <a class="reference" href="http://www.python.org">python</a> interface to, that also used these definitions
+for complex types. More likely, these application codes will define
+their own complex types, or in the case of C++, use <tt class="docutils literal"><span class="pre">std::complex</span></tt>.
+Assuming these data structures are compatible with <a class="reference" href="http://www.python.org">python</a> and
+<a class="reference" href="http://numpy.scipy.org">NumPy</a> complex types, <tt class="docutils literal"><span class="pre">%numpy_typemap</span></tt> expansions as above (with
+the user's complex type substituted for the first argument) should
+work.</p>
+</div>
+</div>
+<div class="section">
+<h1><a class="toc-backref" href="#id10" id="helper-functions" name="helper-functions">Helper Functions</a></h1>
+<p>The <tt class="docutils literal"><span class="pre">numpy.i</span></tt> file containes several macros and routines that it
+uses internally to build its typemaps. However, these functions may
+be useful elsewhere in your interface file.</p>
+<div class="section">
+<h2><a class="toc-backref" href="#id11" id="macros" name="macros">Macros</a></h2>
+<blockquote>
+<dl class="docutils">
+<dt><strong>is_array(a)</strong></dt>
+<dd>Evaluates as true if <tt class="docutils literal"><span class="pre">a</span></tt> is non-<tt class="docutils literal"><span class="pre">NULL</span></tt> and can be cast to a
+<tt class="docutils literal"><span class="pre">PyArrayObject*</span></tt>.</dd>
+<dt><strong>array_type(a)</strong></dt>
+<dd>Evaluates to the integer data type code of <tt class="docutils literal"><span class="pre">a</span></tt>, assuming <tt class="docutils literal"><span class="pre">a</span></tt> can
+be cast to a <tt class="docutils literal"><span class="pre">PyArrayObject*</span></tt>.</dd>
+<dt><strong>array_numdims(a)</strong></dt>
+<dd>Evaluates to the integer number of dimensions of <tt class="docutils literal"><span class="pre">a</span></tt>, assuming
+<tt class="docutils literal"><span class="pre">a</span></tt> can be cast to a <tt class="docutils literal"><span class="pre">PyArrayObject*</span></tt>.</dd>
+<dt><strong>array_dimensions(a)</strong></dt>
+<dd>Evaluates to an array of type <tt class="docutils literal"><span class="pre">npy_intp</span></tt> and length
+<tt class="docutils literal"><span class="pre">array_numdims(a)</span></tt>, giving the lengths of all of the dimensions
+of <tt class="docutils literal"><span class="pre">a</span></tt>, assuming <tt class="docutils literal"><span class="pre">a</span></tt> can be cast to a <tt class="docutils literal"><span class="pre">PyArrayObject*</span></tt>.</dd>
+<dt><strong>array_size(a,i)</strong></dt>
+<dd>Evaluates to the <tt class="docutils literal"><span class="pre">i</span></tt>-th dimension size of <tt class="docutils literal"><span class="pre">a</span></tt>, assuming <tt class="docutils literal"><span class="pre">a</span></tt>
+can be cast to a <tt class="docutils literal"><span class="pre">PyArrayObject*</span></tt>.</dd>
+<dt><strong>array_data(a)</strong></dt>
+<dd>Evaluates to a pointer of type <tt class="docutils literal"><span class="pre">void*</span></tt> that points to the data
+buffer of <tt class="docutils literal"><span class="pre">a</span></tt>, assuming <tt class="docutils literal"><span class="pre">a</span></tt> can be cast to a <tt class="docutils literal"><span class="pre">PyArrayObject*</span></tt>.</dd>
+<dt><strong>array_is_contiguous(a)</strong></dt>
+<dd>Evaluates as true if <tt class="docutils literal"><span class="pre">a</span></tt> is a contiguous array. Equivalent to
+<tt class="docutils literal"><span class="pre">(PyArray_ISCONTIGUOUS(a))</span></tt>.</dd>
+<dt><strong>array_is_native(a)</strong></dt>
+<dd>Evaluates as true if the data buffer of <tt class="docutils literal"><span class="pre">a</span></tt> uses native byte
+order. Equivalent to <tt class="docutils literal"><span class="pre">(PyArray_ISNOTSWAPPED(a))</span></tt>.</dd>
+</dl>
+</blockquote>
+</div>
+<div class="section">
+<h2><a class="toc-backref" href="#id12" id="routines" name="routines">Routines</a></h2>
+<blockquote>
+<p><strong>pytype_string()</strong></p>
+<blockquote>
+<p>Return type: <tt class="docutils literal"><span class="pre">char*</span></tt></p>
+<p>Arguments:</p>
+<ul class="simple">
+<li><tt class="docutils literal"><span class="pre">PyObject*</span> <span class="pre">py_obj</span></tt>, a general <a class="reference" href="http://www.python.org">python</a> object.</li>
+</ul>
+<p>Return a string describing the type of <tt class="docutils literal"><span class="pre">py_obj</span></tt>.</p>
+</blockquote>
+<p><strong>typecode_string()</strong></p>
+<blockquote>
+<p>Return type: <tt class="docutils literal"><span class="pre">char*</span></tt></p>
+<p>Arguments:</p>
+<ul class="simple">
+<li><tt class="docutils literal"><span class="pre">int</span> <span class="pre">typecode</span></tt>, a <a class="reference" href="http://numpy.scipy.org">NumPy</a> integer typecode.</li>
+</ul>
+<p>Return a string describing the type corresponding to the <a class="reference" href="http://numpy.scipy.org">NumPy</a>
+<tt class="docutils literal"><span class="pre">typecode</span></tt>.</p>
+</blockquote>
+<p><strong>type_match()</strong></p>
+<blockquote>
+<p>Return type: <tt class="docutils literal"><span class="pre">int</span></tt></p>
+<p>Arguments:</p>
+<ul class="simple">
+<li><tt class="docutils literal"><span class="pre">int</span> <span class="pre">actual_type</span></tt>, the <a class="reference" href="http://numpy.scipy.org">NumPy</a> typecode of a <a class="reference" href="http://numpy.scipy.org">NumPy</a> array.</li>
+<li><tt class="docutils literal"><span class="pre">int</span> <span class="pre">desired_type</span></tt>, the desired <a class="reference" href="http://numpy.scipy.org">NumPy</a> typecode.</li>
+</ul>
+<p>Make sure that <tt class="docutils literal"><span class="pre">actual_type</span></tt> is compatible with
+<tt class="docutils literal"><span class="pre">desired_type</span></tt>. For example, this allows character and
+byte types, or int and long types, to match. This is now
+equivalent to <tt class="docutils literal"><span class="pre">PyArray_EquivTypenums()</span></tt>.</p>
+</blockquote>
+<p><strong>obj_to_array_no_conversion()</strong></p>
+<blockquote>
+<p>Return type: <tt class="docutils literal"><span class="pre">PyArrayObject*</span></tt></p>
+<p>Arguments:</p>
+<ul class="simple">
+<li><tt class="docutils literal"><span class="pre">PyObject*</span> <span class="pre">input</span></tt>, a general <a class="reference" href="http://www.python.org">python</a> object.</li>
+<li><tt class="docutils literal"><span class="pre">int</span> <span class="pre">typecode</span></tt>, the desired <a class="reference" href="http://numpy.scipy.org">NumPy</a> typecode.</li>
+</ul>
+<p>Cast <tt class="docutils literal"><span class="pre">input</span></tt> to a <tt class="docutils literal"><span class="pre">PyArrayObject*</span></tt> if legal, and ensure that
+it is of type <tt class="docutils literal"><span class="pre">typecode</span></tt>. If <tt class="docutils literal"><span class="pre">input</span></tt> cannot be cast, or the
+<tt class="docutils literal"><span class="pre">typecode</span></tt> is wrong, set a <a class="reference" href="http://www.python.org">python</a> error and return <tt class="docutils literal"><span class="pre">NULL</span></tt>.</p>
+</blockquote>
+<p><strong>obj_to_array_allow_conversion()</strong></p>
+<blockquote>
+<p>Return type: <tt class="docutils literal"><span class="pre">PyArrayObject*</span></tt></p>
+<p>Arguments:</p>
+<ul class="simple">
+<li><tt class="docutils literal"><span class="pre">PyObject*</span> <span class="pre">input</span></tt>, a general <a class="reference" href="http://www.python.org">python</a> object.</li>
+<li><tt class="docutils literal"><span class="pre">int</span> <span class="pre">typecode</span></tt>, the desired <a class="reference" href="http://numpy.scipy.org">NumPy</a> typecode of the resulting
+array.</li>
+<li><tt class="docutils literal"><span class="pre">int*</span> <span class="pre">is_new_object</span></tt>, returns a value of 0 if no conversion
+performed, else 1.</li>
+</ul>
+<p>Convert <tt class="docutils literal"><span class="pre">input</span></tt> to a <a class="reference" href="http://numpy.scipy.org">NumPy</a> array with the given <tt class="docutils literal"><span class="pre">typecode</span></tt>.
+On success, return a valid <tt class="docutils literal"><span class="pre">PyArrayObject*</span></tt> with the correct
+type. On failure, the <a class="reference" href="http://www.python.org">python</a> error string will be set and the
+routine returns <tt class="docutils literal"><span class="pre">NULL</span></tt>.</p>
+</blockquote>
+<p><strong>make_contiguous()</strong></p>
+<blockquote>
+<p>Return type: <tt class="docutils literal"><span class="pre">PyArrayObject*</span></tt></p>
+<p>Arguments:</p>
+<ul class="simple">
+<li><tt class="docutils literal"><span class="pre">PyArrayObject*</span> <span class="pre">ary</span></tt>, a <a class="reference" href="http://numpy.scipy.org">NumPy</a> array.</li>
+<li><tt class="docutils literal"><span class="pre">int*</span> <span class="pre">is_new_object</span></tt>, returns a value of 0 if no conversion
+performed, else 1.</li>
+<li><tt class="docutils literal"><span class="pre">int</span> <span class="pre">min_dims</span></tt>, minimum allowable dimensions.</li>
+<li><tt class="docutils literal"><span class="pre">int</span> <span class="pre">max_dims</span></tt>, maximum allowable dimensions.</li>
+</ul>
+<p>Check to see if <tt class="docutils literal"><span class="pre">ary</span></tt> is contiguous. If so, return the input
+pointer and flag it as not a new object. If it is not contiguous,
+create a new <tt class="docutils literal"><span class="pre">PyArrayObject*</span></tt> using the original data, flag it
+as a new object and return the pointer.</p>
+</blockquote>
+<p><strong>obj_to_array_contiguous_allow_conversion()</strong></p>
+<blockquote>
+<p>Return type: <tt class="docutils literal"><span class="pre">PyArrayObject*</span></tt></p>
+<p>Arguments:</p>
+<ul class="simple">
+<li><tt class="docutils literal"><span class="pre">PyObject*</span> <span class="pre">input</span></tt>, a general <a class="reference" href="http://www.python.org">python</a> object.</li>
+<li><tt class="docutils literal"><span class="pre">int</span> <span class="pre">typecode</span></tt>, the desired <a class="reference" href="http://numpy.scipy.org">NumPy</a> typecode of the resulting
+array.</li>
+<li><tt class="docutils literal"><span class="pre">int*</span> <span class="pre">is_new_object</span></tt>, returns a value of 0 if no conversion
+performed, else 1.</li>
+</ul>
+<p>Convert <tt class="docutils literal"><span class="pre">input</span></tt> to a contiguous <tt class="docutils literal"><span class="pre">PyArrayObject*</span></tt> of the
+specified type. If the input object is not a contiguous
+<tt class="docutils literal"><span class="pre">PyArrayObject*</span></tt>, a new one will be created and the new object
+flag will be set.</p>
+</blockquote>
+<p><strong>require_contiguous()</strong></p>
+<blockquote>
+<p>Return type: <tt class="docutils literal"><span class="pre">int</span></tt></p>
+<p>Arguments:</p>
+<ul class="simple">
+<li><tt class="docutils literal"><span class="pre">PyArrayObject*</span> <span class="pre">ary</span></tt>, a <a class="reference" href="http://numpy.scipy.org">NumPy</a> array.</li>
+</ul>
+<p>Test whether <tt class="docutils literal"><span class="pre">ary</span></tt> is contiguous. If so, return 1. Otherwise,
+set a <a class="reference" href="http://www.python.org">python</a> error and return 0.</p>
+</blockquote>
+<p><strong>require_native()</strong></p>
+<blockquote>
+<p>Return type: <tt class="docutils literal"><span class="pre">int</span></tt></p>
+<p>Arguments:</p>
+<ul class="simple">
+<li><tt class="docutils literal"><span class="pre">PyArray_Object*</span> <span class="pre">ary</span></tt>, a <a class="reference" href="http://numpy.scipy.org">NumPy</a> array.</li>
+</ul>
+<p>Require that <tt class="docutils literal"><span class="pre">ary</span></tt> is not byte-swapped. If the array is not
+byte-swapped, return 1. Otherwise, set a <a class="reference" href="http://www.python.org">python</a> error and
+return 0.</p>
+</blockquote>
+<p><strong>require_dimensions()</strong></p>
+<blockquote>
+<p>Return type: <tt class="docutils literal"><span class="pre">int</span></tt></p>
+<p>Arguments:</p>
+<ul class="simple">
+<li><tt class="docutils literal"><span class="pre">PyArrayObject*</span> <span class="pre">ary</span></tt>, a <a class="reference" href="http://numpy.scipy.org">NumPy</a> array.</li>
+<li><tt class="docutils literal"><span class="pre">int</span> <span class="pre">exact_dimensions</span></tt>, the desired number of dimensions.</li>
+</ul>
+<p>Require <tt class="docutils literal"><span class="pre">ary</span></tt> to have a specified number of dimensions. If the
+array has the specified number of dimensions, return 1.
+Otherwise, set a <a class="reference" href="http://www.python.org">python</a> error and return 0.</p>
+</blockquote>
+<p><strong>require_dimensions_n()</strong></p>
+<blockquote>
+<p>Return type: <tt class="docutils literal"><span class="pre">int</span></tt></p>
+<p>Arguments:</p>
+<ul class="simple">
+<li><tt class="docutils literal"><span class="pre">PyArrayObject*</span> <span class="pre">ary</span></tt>, a <a class="reference" href="http://numpy.scipy.org">NumPy</a> array.</li>
+<li><tt class="docutils literal"><span class="pre">int*</span> <span class="pre">exact_dimensions</span></tt>, an array of integers representing
+acceptable numbers of dimensions.</li>
+<li><tt class="docutils literal"><span class="pre">int</span> <span class="pre">n</span></tt>, the length of <tt class="docutils literal"><span class="pre">exact_dimensions</span></tt>.</li>
+</ul>
+<p>Require <tt class="docutils literal"><span class="pre">ary</span></tt> to have one of a list of specified number of
+dimensions. If the array has one of the specified number of
+dimensions, return 1. Otherwise, set the <a class="reference" href="http://www.python.org">python</a> error string
+and return 0.</p>
+</blockquote>
+<p><strong>require_size()</strong></p>
+<blockquote>
+<p>Return type: <tt class="docutils literal"><span class="pre">int</span></tt></p>
+<p>Arguments:</p>
+<ul class="simple">
+<li><tt class="docutils literal"><span class="pre">PyArrayObject*</span> <span class="pre">ary</span></tt>, a <a class="reference" href="http://numpy.scipy.org">NumPy</a> array.</li>
+<li><tt class="docutils literal"><span class="pre">npy_int*</span> <span class="pre">size</span></tt>, an array representing the desired lengths of
+each dimension.</li>
+<li><tt class="docutils literal"><span class="pre">int</span> <span class="pre">n</span></tt>, the length of <tt class="docutils literal"><span class="pre">size</span></tt>.</li>
+</ul>
+<p>Require <tt class="docutils literal"><span class="pre">ary</span></tt> to have a specified shape. If the array has the
+specified shape, return 1. Otherwise, set the <a class="reference" href="http://www.python.org">python</a> error
+string and return 0.</p>
+</blockquote>
+</blockquote>
+</div>
+</div>
+<div class="section">
+<h1><a class="toc-backref" href="#id13" id="beyond-the-provided-typemaps" name="beyond-the-provided-typemaps">Beyond the Provided Typemaps</a></h1>
+<p>There are many C or C++ array/<a class="reference" href="http://numpy.scipy.org">NumPy</a> array situations not covered by
+a simple <tt class="docutils literal"><span class="pre">%include</span> <span class="pre">&quot;numpy.i&quot;</span></tt> and subsequent <tt class="docutils literal"><span class="pre">%apply</span></tt> directives.</p>
+<div class="section">
+<h2><a class="toc-backref" href="#id14" id="a-common-example" name="a-common-example">A Common Example</a></h2>
+<p>Consider a reasonable prototype for a dot product function:</p>
+<pre class="literal-block">
+double dot(int len, double* vec1, double* vec2);
+</pre>
+<p>The <a class="reference" href="http://www.python.org">python</a> interface that we want is:</p>
+<pre class="literal-block">
+def dot(vec1, vec2):
+ &quot;&quot;&quot;
+ dot(PyObject,PyObject) -&gt; double
+ &quot;&quot;&quot;
+</pre>
+<p>The problem here is that there is one dimension argument and two array
+arguments, and our typemaps are set up for dimensions that apply to a
+single array (in fact, <a class="reference" href="http://www.swig.org">SWIG</a> does not provide a mechanism for
+associating <tt class="docutils literal"><span class="pre">len</span></tt> with <tt class="docutils literal"><span class="pre">vec2</span></tt> that takes two <a class="reference" href="http://www.python.org">python</a> input
+arguments). The recommended solution is the following:</p>
+<pre class="literal-block">
+%apply (int DIM1, double* IN_ARRAY1) {(int len1, double* vec1),
+ (int len2, double* vec2)}
+%rename (dot) my_dot;
+%inline %{
+double my_dot(int len1, double* vec1, int len2, double* vec2) {
+ if (len1 != len2) {
+ PyErr_Format(PyExc_ValueError,
+ &quot;Arrays of lengths (%d,%d) given&quot;,
+ len1, len2);
+ return 0.0;
+ }
+ return dot(len1, vec1, vec2);
+}
+%}
+</pre>
+<p>If the header file that contains the prototype for <tt class="docutils literal"><span class="pre">double</span> <span class="pre">dot()</span></tt>
+also contains other prototypes that you want to wrap, so that you need
+to <tt class="docutils literal"><span class="pre">%include</span></tt> this header file, then you will also need a <tt class="docutils literal"><span class="pre">%ignore</span>
+<span class="pre">dot;</span></tt> directive, placed after the <tt class="docutils literal"><span class="pre">%rename</span></tt> and before the
+<tt class="docutils literal"><span class="pre">%include</span></tt> directives. Or, if the function in question is a class
+method, you will want to use <tt class="docutils literal"><span class="pre">%extend</span></tt> rather than <tt class="docutils literal"><span class="pre">%inline</span></tt> in
+addition to <tt class="docutils literal"><span class="pre">%ignore</span></tt>.</p>
+</div>
+<div class="section">
+<h2><a class="toc-backref" href="#id15" id="other-situations" name="other-situations">Other Situations</a></h2>
+<p>There are other wrapping situations in which <tt class="docutils literal"><span class="pre">numpy.i</span></tt> may be
+helpful when you encounter them.</p>
+<blockquote>
+<ul>
+<li><p class="first">In some situations, it is possible that you could use the
+<tt class="docutils literal"><span class="pre">%numpy_templates</span></tt> macro to implement typemaps for your own
+types. See the <a class="reference" href="#other-common-types-bool">Other Common Types: bool</a> or <a class="reference" href="#other-common-types-complex">Other Common
+Types: complex</a> sections for examples. Another situation is if
+your dimensions are of a type other than <tt class="docutils literal"><span class="pre">int</span></tt> (say <tt class="docutils literal"><span class="pre">long</span></tt> for
+example):</p>
+<pre class="literal-block">
+%numpy_typemaps(double, NPY_DOUBLE, long)
+</pre>
+</li>
+<li><p class="first">You can use the code in <tt class="docutils literal"><span class="pre">numpy.i</span></tt> to write your own typemaps.
+For example, if you had a four-dimensional array as a function
+argument, you could cut-and-paste the appropriate
+three-dimensional typemaps into your interface file. The
+modifications for the fourth dimension would be trivial.</p>
+</li>
+<li><p class="first">Sometimes, the best approach is to use the <tt class="docutils literal"><span class="pre">%extend</span></tt> directive
+to define new methods for your classes (or overload existing ones)
+that take a <tt class="docutils literal"><span class="pre">PyObject*</span></tt> (that either is or can be converted to a
+<tt class="docutils literal"><span class="pre">PyArrayObject*</span></tt>) instead of a pointer to a buffer. In this
+case, the helper routines in <tt class="docutils literal"><span class="pre">numpy.i</span></tt> can be very useful.</p>
+</li>
+<li><p class="first">Writing typemaps can be a bit nonintuitive. If you have specific
+questions about writing <a class="reference" href="http://www.swig.org">SWIG</a> typemaps for <a class="reference" href="http://numpy.scipy.org">NumPy</a>, the
+developers of <tt class="docutils literal"><span class="pre">numpy.i</span></tt> do monitor the
+<a class="reference" href="mailto:Numpy-discussion&#64;scipy.org">Numpy-discussion</a> and
+<a class="reference" href="mailto:Swig-user&#64;lists.sourceforge.net">Swig-user</a> mail lists.</p>
+</li>
+</ul>
+</blockquote>
+</div>
+<div class="section">
+<h2><a class="toc-backref" href="#id16" id="a-final-note" name="a-final-note">A Final Note</a></h2>
+<p>When you use the <tt class="docutils literal"><span class="pre">%apply</span></tt> directive, as is usually necessary to use
+<tt class="docutils literal"><span class="pre">numpy.i</span></tt>, it will remain in effect until you tell <a class="reference" href="http://www.swig.org">SWIG</a> that it
+shouldn't be. If the arguments to the functions or methods that you
+are wrapping have common names, such as <tt class="docutils literal"><span class="pre">length</span></tt> or <tt class="docutils literal"><span class="pre">vector</span></tt>,
+these typemaps may get applied in situations you do not expect or
+want. Therefore, it is always a good idea to add a <tt class="docutils literal"><span class="pre">%clear</span></tt>
+directive after you are done with a specific typemap:</p>
+<pre class="literal-block">
+%apply (double* IN_ARRAY1, int DIM1) {(double* vector, int length)}
+%include &quot;my_header.h&quot;
+%clear (double* vector, int length);
+</pre>
+<p>In general, you should target these typemap signatures specifically
+where you want them, and then clear them after you are done.</p>
+</div>
+</div>
+<div class="section">
+<h1><a class="toc-backref" href="#id17" id="summary" name="summary">Summary</a></h1>
+<p>Out of the box, <tt class="docutils literal"><span class="pre">numpy.i</span></tt> provides typemaps that support conversion
+between <a class="reference" href="http://numpy.scipy.org">NumPy</a> arrays and C arrays:</p>
+<blockquote>
+<ul class="simple">
+<li>That can be one of 12 different scalar types: <tt class="docutils literal"><span class="pre">signed</span> <span class="pre">char</span></tt>,
+<tt class="docutils literal"><span class="pre">unsigned</span> <span class="pre">char</span></tt>, <tt class="docutils literal"><span class="pre">short</span></tt>, <tt class="docutils literal"><span class="pre">unsigned</span> <span class="pre">short</span></tt>, <tt class="docutils literal"><span class="pre">int</span></tt>,
+<tt class="docutils literal"><span class="pre">unsigned</span> <span class="pre">int</span></tt>, <tt class="docutils literal"><span class="pre">long</span></tt>, <tt class="docutils literal"><span class="pre">unsigned</span> <span class="pre">long</span></tt>, <tt class="docutils literal"><span class="pre">long</span> <span class="pre">long</span></tt>,
+<tt class="docutils literal"><span class="pre">unsigned</span> <span class="pre">long</span> <span class="pre">long</span></tt>, <tt class="docutils literal"><span class="pre">float</span></tt> and <tt class="docutils literal"><span class="pre">double</span></tt>.</li>
+<li>That support 23 different argument signatures for each data type,
+including:<ul>
+<li>One-dimensional, two-dimensional and three-dimensional arrays.</li>
+<li>Input-only, in-place, and argout behavior.</li>
+<li>Hard-coded dimensions, data-buffer-then-dimensions
+specification, and dimensions-then-data-buffer specification.</li>
+</ul>
+</li>
+</ul>
+</blockquote>
+<p>The <tt class="docutils literal"><span class="pre">numpy.i</span></tt> interface file also provides additional tools for
+wrapper developers, including:</p>
+<blockquote>
+<ul class="simple">
+<li>A <a class="reference" href="http://www.swig.org">SWIG</a> macro (<tt class="docutils literal"><span class="pre">%numpy_typemaps</span></tt>) with three arguments for
+implementing the 23 argument signatures for the user's choice of
+(1) C data type, (2) <a class="reference" href="http://numpy.scipy.org">NumPy</a> data type (assuming they match), and
+(3) dimension type.</li>
+<li>Seven C macros and eleven C functions that can be used to write
+specialized typemaps, extensions, or inlined functions that handle
+cases not covered by the provided typemaps.</li>
+</ul>
+</blockquote>
+</div>
+<div class="section">
+<h1><a class="toc-backref" href="#id18" id="acknowledgements" name="acknowledgements">Acknowledgements</a></h1>
+<p>Many people have worked to glue <a class="reference" href="http://www.swig.org">SWIG</a> and <a class="reference" href="http://numpy.scipy.org">NumPy</a> together (as well
+as <a class="reference" href="http://www.swig.org">SWIG</a> and the predecessors of <a class="reference" href="http://numpy.scipy.org">NumPy</a>, Numeric and numarray).
+The effort to standardize this work into <tt class="docutils literal"><span class="pre">numpy.i</span></tt> began at the 2005
+<a class="reference" href="http://scipy.org">SciPy</a> Conference with a conversation between
+Fernando Perez and myself. Fernando collected helper functions and
+typemaps from Michael Hunter, Anna Omelchenko and Michael Sanner.
+Sebastian Hasse has also provided additional error checking and use
+cases. The work of these contributors has made this end result
+possible.</p>
+</div>
+</div>
+<div class="footer">
+<hr class="footer" />
+Generated on: 2007-04-13 20:43 UTC.
+Generated by <a class="reference" href="http://docutils.sourceforge.net/">Docutils</a> from <a class="reference" href="http://docutils.sourceforge.net/rst.html">reStructuredText</a> source.
+
+</div>
+</body>
+</html>
diff --git a/numpy/doc/swig/numpy_swig.pdf b/numpy/doc/swig/numpy_swig.pdf
new file mode 100644
index 000000000..aadcc9fe4
--- /dev/null
+++ b/numpy/doc/swig/numpy_swig.pdf
Binary files differ
diff --git a/numpy/doc/swig/numpy_swig.txt b/numpy/doc/swig/numpy_swig.txt
new file mode 100644
index 000000000..d00ad6ff5
--- /dev/null
+++ b/numpy/doc/swig/numpy_swig.txt
@@ -0,0 +1,774 @@
+========================================
+numpy.i: a SWIG Interface File for NumPy
+========================================
+
+:Author: Bill Spotz
+:Institution: Sandia National Laboratories
+:Date: 13 April, 2007
+
+.. contents::
+
+Introduction
+============
+
+The Simple Wrapper and Interface Generator (or `SWIG
+<http://www.swig.org>`_) is a powerful tool for generating wrapper
+code for interfacing to a wide variety of scripting languages.
+`SWIG`_ can parse header files, and using only the code prototypes,
+create an interface to the target language. But `SWIG`_ is not
+omnipotent. For example, it cannot know from the prototype::
+
+ double rms(double* seq, int n);
+
+what exactly ``seq`` is. Is it a single value to be altered in-place?
+Is it an array, and if so what is its length? Is it input-only?
+Output-only? Input-output? `SWIG`_ cannot determine these details,
+and does not attempt to do so.
+
+Making an educated guess, humans can conclude that this is probably a
+routine that takes an input-only array of length ``n`` of ``double``
+values called ``seq`` and returns the root mean square. The default
+behavior of `SWIG`_, however, will be to create a wrapper function
+that compiles, but is nearly impossible to use from the scripting
+language in the way the C routine was intended.
+
+For `python <http://www.python.org>`_, the preferred way of handling
+contiguous (or technically, *strided*) blocks of homogeneous data is
+with the module `NumPy <http://numpy.scipy.org>`_, which provides full
+object-oriented access to arrays of data. Therefore, the most logical
+`python`_ interface for the ``rms`` function would be (including doc
+string)::
+
+ def rms(seq):
+ """
+ rms: return the root mean square of a sequence
+ rms(numpy.ndarray) -> double
+ rms(list) -> double
+ rms(tuple) -> double
+ """
+
+where ``seq`` would be a `NumPy`_ array of ``double`` values, and its
+length ``n`` would be extracted from ``seq`` internally before being
+passed to the C routine. Even better, since `NumPy`_ supports
+construction of arrays from arbitrary `python`_ sequences, ``seq``
+itself could be a nearly arbitrary sequence (so long as each element
+can be converted to a ``double``) and the wrapper code would
+internally convert it to a `NumPy`_ array before extracting its data
+and length.
+
+`SWIG`_ allows these types of conversions to be defined via a
+mechanism called typemaps. This document provides information on how
+to use ``numpy.i``, a `SWIG`_ interface file that defines a series of
+typemaps intended to make the type of array-related conversions
+described above relatively simple to implement. For example, suppose
+that the ``rms`` function prototype defined above was in a header file
+named ``rms.h``. To obtain the `python`_ interface discussed above,
+your `SWIG`_ interface file would need the following::
+
+ %{
+ #define SWIG_FILE_WITH_INIT
+ #include "rms.h"
+ %}
+
+ %include "numpy.i"
+
+ %init %{
+ import_array();
+ %}
+
+ %apply (double* IN_ARRAY1, int DIM1) {(double* seq, int n)};
+ %include "rms.h"
+
+Typemaps are keyed off a list of one or more function arguments,
+either by type or by type and name. We will refer to such lists as
+*signatures*. One of the many typemaps defined by ``numpy.i`` is used
+above and has the signature ``(double* IN_ARRAY1, int DIM1)``. The
+argument names are intended to suggest that the ``double*`` argument
+is an input array of one dimension and that the ``int`` represents
+that dimension. This is precisely the pattern in the ``rms``
+prototype.
+
+Most likely, no actual prototypes to be wrapped will have the argument
+names ``IN_ARRAY1`` and ``DIM1``. We use the ``%apply`` directive to
+apply the typemap for one-dimensional input arrays of type ``double``
+to the actual prototype used by ``rms``. Using ``numpy.i``
+effectively, therefore, requires knowing what typemaps are available
+and what they do.
+
+A `SWIG`_ interface file that includes the `SWIG`_ directives given
+above will produce wrapper code that looks something like::
+
+ 1 PyObject *_wrap_rms(PyObject *args) {
+ 2 PyObject *resultobj = 0;
+ 3 double *arg1 = (double *) 0 ;
+ 4 int arg2 ;
+ 5 double result;
+ 6 PyArrayObject *array1 = NULL ;
+ 7 int is_new_object1 = 0 ;
+ 8 PyObject * obj0 = 0 ;
+ 9
+ 10 if (!PyArg_ParseTuple(args,(char *)"O:rms",&obj0)) SWIG_fail;
+ 11 {
+ 12 array1 = obj_to_array_contiguous_allow_conversion(
+ 13 obj0, NPY_DOUBLE, &is_new_object1);
+ 14 npy_intp size[1] = {
+ 15 -1
+ 16 };
+ 17 if (!array1 || !require_dimensions(array1, 1) ||
+ 18 !require_size(array1, size, 1)) SWIG_fail;
+ 19 arg1 = (double*) array1->data;
+ 20 arg2 = (int) array1->dimensions[0];
+ 21 }
+ 22 result = (double)rms(arg1,arg2);
+ 23 resultobj = SWIG_From_double((double)(result));
+ 24 {
+ 25 if (is_new_object1 && array1) Py_DECREF(array1);
+ 26 }
+ 27 return resultobj;
+ 28 fail:
+ 29 {
+ 30 if (is_new_object1 && array1) Py_DECREF(array1);
+ 31 }
+ 32 return NULL;
+ 33 }
+
+The typemaps from ``numpy.i`` are responsible for the following lines
+of code: 12--20, 25 and 30. Line 10 parses the input to the ``rms``
+function. From the format string ``"O:rms"``, we can see that the
+argument list is expected to be a single `python`_ object (specified
+by the ``O`` before the colon) and whose pointer is stored in
+``obj0``. A number of functions, supplied by ``numpy.i``, are called
+to make and check the (possible) conversion from a generic `python`_
+object to a `NumPy`_ array. These functions are explained in the
+section `Helper Functions`_, but hopefully their names are
+self-explanatory. At line 12 we use ``obj0`` to construct a `NumPy`_
+array. At line 17, we check the validity of the result: that it is
+non-null and that it has a single dimension of arbitrary length. Once
+these states are verified, we extract the data buffer and length in
+lines 19 and 20 so that we can call the underlying C function at line
+22. Line 25 performs memory management for the case where we have
+created a new array that is no longer needed.
+
+This code has a significant amount of error handling. Note the
+``SWIG_fail`` is a macro for ``goto fail``, refering to the label at
+line 28. If the user provides the wrong number of arguments, this
+will be caught at line 10. If construction of the `NumPy`_ array
+fails or produces an array with the wrong number of dimensions, these
+errors are caught at line 17. And finally, if an error is detected,
+memory is still managed correctly at line 30.
+
+Note that if the C function signature was in a different order::
+
+ double rms(int n, double* seq);
+
+that `SWIG`_ would not match the typemap signature given above with
+the argument list for ``rms``. Fortunately, ``numpy.i`` has a set of
+typemaps with the data pointer given last::
+
+ %apply (int DIM1, double* IN_ARRAY1) {(int n, double* seq)};
+
+This simply has the effect of switching the definitions of ``arg1``
+and ``arg2`` in lines 3 and 4 of the generated code above, and their
+assignments in lines 19 and 20.
+
+Using numpy.i
+=============
+
+The ``numpy.i`` file is currently located in the ``numpy/docs/swig``
+sub-directory under the ``numpy`` installation directory. Typically,
+you will want to copy it to the directory where you are developing
+your wrappers. If it is ever adopted by `SWIG`_ developers, then it
+will be installed in a standard place where `SWIG`_ can find it.
+
+A simple module that only uses a single `SWIG`_ interface file should
+include the following::
+
+ %{
+ #define SWIG_FILE_WITH_INIT
+ %}
+ %include "numpy.i"
+ %init %{
+ import_array();
+ %}
+
+Within a compiled `python`_ module, ``import_array()`` should only get
+called once. This could be in a C/C++ file that you have written and
+is linked to the module. If this is the case, then none of your
+interface files should ``#define SWIG_FILE_WITH_INIT`` or call
+``import_array()``. Or, this initialization call could be in a
+wrapper file generated by `SWIG`_ from an interface file that has the
+``%init`` block as above. If this is the case, and you have more than
+one `SWIG`_ interface file, then only one interface file should
+``#define SWIG_FILE_WITH_INIT`` and call ``import_array()``.
+
+Available Typemaps
+==================
+
+The typemap directives provided by ``numpy.i`` for arrays of different
+data types, say ``double`` and ``int``, and dimensions of different
+types, say ``int`` or ``long``, are identical to one another except
+for the C and `NumPy`_ type specifications. The typemaps are
+therefore implemented (typically behind the scenes) via a macro::
+
+ %numpy_typemaps(DATA_TYPE, DATA_TYPECODE, DIM_TYPE)
+
+that can be invoked for appropriate ``(DATA_TYPE, DATA_TYPECODE,
+DIM_TYPE)`` triplets. For example::
+
+ %numpy_typemaps(double, NPY_DOUBLE, int)
+ %numpy_typemaps(int, NPY_INT , int)
+
+The ``numpy.i`` interface file uses the ``%numpy_typemaps`` macro to
+implement typemaps for the following C data types and ``int``
+dimension types:
+
+ * ``signed char``
+ * ``unsigned char``
+ * ``short``
+ * ``unsigned short``
+ * ``int``
+ * ``unsigned int``
+ * ``long``
+ * ``unsigned long``
+ * ``long long``
+ * ``unsigned long long``
+ * ``float``
+ * ``double``
+
+In the following descriptions, we reference a generic ``DATA_TYPE``, which
+could be any of the C data types listed above.
+
+Input Arrays
+------------
+
+Input arrays are defined as arrays of data that are passed into a
+routine but are not altered in-place or returned to the user. The
+`python`_ input array is therefore allowed to be almost any `python`_
+sequence (such as a list) that can be converted to the requested type
+of array. The input array signatures are
+
+ * ``(DATA_TYPE IN_ARRAY1[ANY])``
+ * ``(DATA_TYPE* IN_ARRAY1, int DIM1)``
+ * ``(int DIM1, DATA_TYPE* IN_ARRAY1)``
+ * ``(DATA_TYPE IN_ARRAY2[ANY][ANY])``
+ * ``(DATA_TYPE* IN_ARRAY2, int DIM1, int DIM2)``
+ * ``(int DIM1, int DIM2, DATA_TYPE* IN_ARRAY2)``
+ * ``(DATA_TYPE IN_ARRAY3[ANY][ANY][ANY])``
+ * ``(DATA_TYPE* IN_ARRAY3, int DIM1, int DIM2, int DIM3)``
+ * ``(int DIM1, int DIM2, int DIM3, DATA_TYPE* IN_ARRAY3)``
+
+The first signature listed, ``(DATA_TYPE IN_ARRAY[ANY])`` is for
+one-dimensional arrays with hard-coded dimensions. Likewise,
+``(DATA_TYPE IN_ARRAY2[ANY][ANY])`` is for two-dimensional arrays with
+hard-coded dimensions, and similarly for three-dimensional.
+
+In-Place Arrays
+---------------
+
+In-place arrays are defined as arrays that are modified in-place. The
+input values may or may not be used, but the values at the time the
+function returns are significant. The provided `python`_ argument
+must therefore be a `NumPy`_ array of the required type. The in-place
+signatures are
+
+ * ``(DATA_TYPE INPLACE_ARRAY1[ANY])``
+ * ``(DATA_TYPE* INPLACE_ARRAY1, int DIM1)``
+ * ``(int DIM1, DATA_TYPE* INPLACE_ARRAY1)``
+ * ``(DATA_TYPE INPLACE_ARRAY2[ANY][ANY])``
+ * ``(DATA_TYPE* INPLACE_ARRAY2, int DIM1, int DIM2)``
+ * ``(int DIM1, int DIM2, DATA_TYPE* INPLACE_ARRAY2)``
+ * ``(DATA_TYPE INPLACE_ARRAY3[ANY][ANY][ANY])``
+ * ``(DATA_TYPE* INPLACE_ARRAY3, int DIM1, int DIM2, int DIM3)``
+ * ``(int DIM1, int DIM2, int DIM3, DATA_TYPE* INPLACE_ARRAY3)``
+
+These typemaps now check to make sure that the ``INPLACE_ARRAY``
+arguments use native byte ordering. If not, an exception is raised.
+
+Argout Arrays
+-------------
+
+Argout arrays are arrays that appear in the input arguments in C, but
+are in fact output arrays. This pattern occurs often when there is
+more than one output variable and the single return argument is
+therefore not sufficient. In `python`_, the convential way to return
+multiple arguments is to pack them into a sequence (tuple, list, etc.)
+and return the sequence. This is what the argout typemaps do. If a
+wrapped function that uses these argout typemaps has more than one
+return argument, they are packed into a tuple or list, depending on
+the version of `python`_. The `python`_ user does not pass these
+arrays in, they simply get returned. The argout signatures are
+
+ * ``(DATA_TYPE ARGOUT_ARRAY1[ANY])``
+ * ``(DATA_TYPE* ARGOUT_ARRAY1, int DIM1)``
+ * ``(int DIM1, DATA_TYPE* ARGOUT_ARRAY1)``
+ * ``(DATA_TYPE ARGOUT_ARRAY2[ANY][ANY])``
+ * ``(DATA_TYPE ARGOUT_ARRAY3[ANY][ANY][ANY])``
+
+These are typically used in situations where in C/C++, you would
+allocate a(n) array(s) on the heap, and call the function to fill the
+array(s) values. In `python`_, the arrays are allocated for you and
+returned as new array objects.
+
+Note that we support ``DATA_TYPE*`` argout typemaps in 1D, but not 2D
+or 3D. This because of a quirk with the `SWIG`_ typemap syntax and
+cannot be avoided. Note that for these types of 1D typemaps, the
+`python`_ function will take a single argument representing ``DIM1``.
+
+Output Arrays
+-------------
+
+The ``numpy.i`` interface file does not support typemaps for output
+arrays, for several reasons. First, C/C++ function return arguments
+do not have names, so signatures for ``%typemap(out)`` do not include
+names. This means that if ``numpy.i`` supported them, they would
+apply to all pointer return arguments for the supported numeric
+types. This seems too dangerous. Second, C/C++ return arguments are
+limited to a single value. This prevents obtaining dimension
+information in a general way. Third, arrays with hard-coded lengths
+are not permitted as return arguments. In other words::
+
+ double[3] newVector(double x, double y, double z);
+
+is not legal C/C++ syntax. Therefore, we cannot provide typemaps of
+the form::
+
+ %typemap(out) (TYPE[ANY]);
+
+If you run into a situation where a function or method is returning a
+pointer to an array, your best bet is to write your own version of the
+function to be wrapped, either with ``%extend`` for the case of class
+methods or ``%ignore`` and ``%rename`` for the case of functions.
+
+Other Common Types: bool
+------------------------
+
+Note that C++ type ``bool`` is not supported in the list in the
+`Available Typemaps`_ section. NumPy bools are a single byte, while
+the C++ ``bool`` is four bytes (at least on my system). Therefore::
+
+ %numpy_typemaps(bool, NPY_BOOL, int)
+
+will result in typemaps that will produce code that reference
+improper data lengths. You can implement the following macro
+expansion::
+
+ %numpy_typemaps(bool, NPY_UINT, int)
+
+to fix the data length problem, and `Input Arrays`_ will work fine,
+but `In-Place Arrays`_ might fail type-checking.
+
+Other Common Types: complex
+---------------------------
+
+Typemap conversions for complex floating-point types is also not
+supported automatically. This is because `python`_ and `NumPy`_ are
+written in C, which does not have native complex types. Both
+`python`_ and `NumPy`_ implement their own (essentially equivalent)
+``struct`` definitions for complex variables::
+
+ /* Python */
+ typedef struct {double real; double imag;} Py_complex;
+
+ /* NumPy */
+ typedef struct {float real, imag;} npy_cfloat;
+ typedef struct {double real, imag;} npy_cdouble;
+
+We could have implemented::
+
+ %numpy_typemaps(Py_complex , NPY_CDOUBLE, int)
+ %numpy_typemaps(npy_cfloat , NPY_CFLOAT , int)
+ %numpy_typemaps(npy_cdouble, NPY_CDOUBLE, int)
+
+which would have provided automatic type conversions for arrays of
+type ``Py_complex``, ``npy_cfloat`` and ``npy_cdouble``. However, it
+seemed unlikely that there would be any independent (non-`python`_,
+non-`NumPy`_) application code that people would be using `SWIG`_ to
+generate a `python`_ interface to, that also used these definitions
+for complex types. More likely, these application codes will define
+their own complex types, or in the case of C++, use ``std::complex``.
+Assuming these data structures are compatible with `python`_ and
+`NumPy`_ complex types, ``%numpy_typemap`` expansions as above (with
+the user's complex type substituted for the first argument) should
+work.
+
+Helper Functions
+================
+
+The ``numpy.i`` file containes several macros and routines that it
+uses internally to build its typemaps. However, these functions may
+be useful elsewhere in your interface file.
+
+Macros
+------
+
+ **is_array(a)**
+ Evaluates as true if ``a`` is non-``NULL`` and can be cast to a
+ ``PyArrayObject*``.
+
+ **array_type(a)**
+ Evaluates to the integer data type code of ``a``, assuming ``a`` can
+ be cast to a ``PyArrayObject*``.
+
+ **array_numdims(a)**
+ Evaluates to the integer number of dimensions of ``a``, assuming
+ ``a`` can be cast to a ``PyArrayObject*``.
+
+ **array_dimensions(a)**
+ Evaluates to an array of type ``npy_intp`` and length
+ ``array_numdims(a)``, giving the lengths of all of the dimensions
+ of ``a``, assuming ``a`` can be cast to a ``PyArrayObject*``.
+
+ **array_size(a,i)**
+ Evaluates to the ``i``-th dimension size of ``a``, assuming ``a``
+ can be cast to a ``PyArrayObject*``.
+
+ **array_data(a)**
+ Evaluates to a pointer of type ``void*`` that points to the data
+ buffer of ``a``, assuming ``a`` can be cast to a ``PyArrayObject*``.
+
+ **array_is_contiguous(a)**
+ Evaluates as true if ``a`` is a contiguous array. Equivalent to
+ ``(PyArray_ISCONTIGUOUS(a))``.
+
+ **array_is_native(a)**
+ Evaluates as true if the data buffer of ``a`` uses native byte
+ order. Equivalent to ``(PyArray_ISNOTSWAPPED(a))``.
+
+Routines
+--------
+
+ **pytype_string()**
+
+ Return type: ``char*``
+
+ Arguments:
+
+ * ``PyObject* py_obj``, a general `python`_ object.
+
+ Return a string describing the type of ``py_obj``.
+
+
+ **typecode_string()**
+
+ Return type: ``char*``
+
+ Arguments:
+
+ * ``int typecode``, a `NumPy`_ integer typecode.
+
+ Return a string describing the type corresponding to the `NumPy`_
+ ``typecode``.
+
+ **type_match()**
+
+ Return type: ``int``
+
+ Arguments:
+
+ * ``int actual_type``, the `NumPy`_ typecode of a `NumPy`_ array.
+
+ * ``int desired_type``, the desired `NumPy`_ typecode.
+
+ Make sure that ``actual_type`` is compatible with
+ ``desired_type``. For example, this allows character and
+ byte types, or int and long types, to match. This is now
+ equivalent to ``PyArray_EquivTypenums()``.
+
+
+ **obj_to_array_no_conversion()**
+
+ Return type: ``PyArrayObject*``
+
+ Arguments:
+
+ * ``PyObject* input``, a general `python`_ object.
+
+ * ``int typecode``, the desired `NumPy`_ typecode.
+
+ Cast ``input`` to a ``PyArrayObject*`` if legal, and ensure that
+ it is of type ``typecode``. If ``input`` cannot be cast, or the
+ ``typecode`` is wrong, set a `python`_ error and return ``NULL``.
+
+
+ **obj_to_array_allow_conversion()**
+
+ Return type: ``PyArrayObject*``
+
+ Arguments:
+
+ * ``PyObject* input``, a general `python`_ object.
+
+ * ``int typecode``, the desired `NumPy`_ typecode of the resulting
+ array.
+
+ * ``int* is_new_object``, returns a value of 0 if no conversion
+ performed, else 1.
+
+ Convert ``input`` to a `NumPy`_ array with the given ``typecode``.
+ On success, return a valid ``PyArrayObject*`` with the correct
+ type. On failure, the `python`_ error string will be set and the
+ routine returns ``NULL``.
+
+
+ **make_contiguous()**
+
+ Return type: ``PyArrayObject*``
+
+ Arguments:
+
+ * ``PyArrayObject* ary``, a `NumPy`_ array.
+
+ * ``int* is_new_object``, returns a value of 0 if no conversion
+ performed, else 1.
+
+ * ``int min_dims``, minimum allowable dimensions.
+
+ * ``int max_dims``, maximum allowable dimensions.
+
+ Check to see if ``ary`` is contiguous. If so, return the input
+ pointer and flag it as not a new object. If it is not contiguous,
+ create a new ``PyArrayObject*`` using the original data, flag it
+ as a new object and return the pointer.
+
+
+ **obj_to_array_contiguous_allow_conversion()**
+
+ Return type: ``PyArrayObject*``
+
+ Arguments:
+
+ * ``PyObject* input``, a general `python`_ object.
+
+ * ``int typecode``, the desired `NumPy`_ typecode of the resulting
+ array.
+
+ * ``int* is_new_object``, returns a value of 0 if no conversion
+ performed, else 1.
+
+ Convert ``input`` to a contiguous ``PyArrayObject*`` of the
+ specified type. If the input object is not a contiguous
+ ``PyArrayObject*``, a new one will be created and the new object
+ flag will be set.
+
+
+ **require_contiguous()**
+
+ Return type: ``int``
+
+ Arguments:
+
+ * ``PyArrayObject* ary``, a `NumPy`_ array.
+
+ Test whether ``ary`` is contiguous. If so, return 1. Otherwise,
+ set a `python`_ error and return 0.
+
+
+ **require_native()**
+
+ Return type: ``int``
+
+ Arguments:
+
+ * ``PyArray_Object* ary``, a `NumPy`_ array.
+
+ Require that ``ary`` is not byte-swapped. If the array is not
+ byte-swapped, return 1. Otherwise, set a `python`_ error and
+ return 0.
+
+ **require_dimensions()**
+
+ Return type: ``int``
+
+ Arguments:
+
+ * ``PyArrayObject* ary``, a `NumPy`_ array.
+
+ * ``int exact_dimensions``, the desired number of dimensions.
+
+ Require ``ary`` to have a specified number of dimensions. If the
+ array has the specified number of dimensions, return 1.
+ Otherwise, set a `python`_ error and return 0.
+
+
+ **require_dimensions_n()**
+
+ Return type: ``int``
+
+ Arguments:
+
+ * ``PyArrayObject* ary``, a `NumPy`_ array.
+
+ * ``int* exact_dimensions``, an array of integers representing
+ acceptable numbers of dimensions.
+
+ * ``int n``, the length of ``exact_dimensions``.
+
+ Require ``ary`` to have one of a list of specified number of
+ dimensions. If the array has one of the specified number of
+ dimensions, return 1. Otherwise, set the `python`_ error string
+ and return 0.
+
+
+ **require_size()**
+
+ Return type: ``int``
+
+ Arguments:
+
+ * ``PyArrayObject* ary``, a `NumPy`_ array.
+
+ * ``npy_int* size``, an array representing the desired lengths of
+ each dimension.
+
+ * ``int n``, the length of ``size``.
+
+ Require ``ary`` to have a specified shape. If the array has the
+ specified shape, return 1. Otherwise, set the `python`_ error
+ string and return 0.
+
+
+Beyond the Provided Typemaps
+============================
+
+There are many C or C++ array/`NumPy`_ array situations not covered by
+a simple ``%include "numpy.i"`` and subsequent ``%apply`` directives.
+
+A Common Example
+----------------
+
+Consider a reasonable prototype for a dot product function::
+
+ double dot(int len, double* vec1, double* vec2);
+
+The `python`_ interface that we want is::
+
+ def dot(vec1, vec2):
+ """
+ dot(PyObject,PyObject) -> double
+ """
+
+The problem here is that there is one dimension argument and two array
+arguments, and our typemaps are set up for dimensions that apply to a
+single array (in fact, `SWIG`_ does not provide a mechanism for
+associating ``len`` with ``vec2`` that takes two `python`_ input
+arguments). The recommended solution is the following::
+
+ %apply (int DIM1, double* IN_ARRAY1) {(int len1, double* vec1),
+ (int len2, double* vec2)}
+ %rename (dot) my_dot;
+ %inline %{
+ double my_dot(int len1, double* vec1, int len2, double* vec2) {
+ if (len1 != len2) {
+ PyErr_Format(PyExc_ValueError,
+ "Arrays of lengths (%d,%d) given",
+ len1, len2);
+ return 0.0;
+ }
+ return dot(len1, vec1, vec2);
+ }
+ %}
+
+If the header file that contains the prototype for ``double dot()``
+also contains other prototypes that you want to wrap, so that you need
+to ``%include`` this header file, then you will also need a ``%ignore
+dot;`` directive, placed after the ``%rename`` and before the
+``%include`` directives. Or, if the function in question is a class
+method, you will want to use ``%extend`` rather than ``%inline`` in
+addition to ``%ignore``.
+
+Other Situations
+----------------
+
+There are other wrapping situations in which ``numpy.i`` may be
+helpful when you encounter them.
+
+ * In some situations, it is possible that you could use the
+ ``%numpy_templates`` macro to implement typemaps for your own
+ types. See the `Other Common Types: bool`_ or `Other Common
+ Types: complex`_ sections for examples. Another situation is if
+ your dimensions are of a type other than ``int`` (say ``long`` for
+ example)::
+
+ %numpy_typemaps(double, NPY_DOUBLE, long)
+
+ * You can use the code in ``numpy.i`` to write your own typemaps.
+ For example, if you had a four-dimensional array as a function
+ argument, you could cut-and-paste the appropriate
+ three-dimensional typemaps into your interface file. The
+ modifications for the fourth dimension would be trivial.
+
+ * Sometimes, the best approach is to use the ``%extend`` directive
+ to define new methods for your classes (or overload existing ones)
+ that take a ``PyObject*`` (that either is or can be converted to a
+ ``PyArrayObject*``) instead of a pointer to a buffer. In this
+ case, the helper routines in ``numpy.i`` can be very useful.
+
+ * Writing typemaps can be a bit nonintuitive. If you have specific
+ questions about writing `SWIG`_ typemaps for `NumPy`_, the
+ developers of ``numpy.i`` do monitor the
+ `Numpy-discussion <mailto:Numpy-discussion@scipy.org>`_ and
+ `Swig-user <mailto:Swig-user@lists.sourceforge.net>`_ mail lists.
+
+A Final Note
+------------
+
+When you use the ``%apply`` directive, as is usually necessary to use
+``numpy.i``, it will remain in effect until you tell `SWIG`_ that it
+shouldn't be. If the arguments to the functions or methods that you
+are wrapping have common names, such as ``length`` or ``vector``,
+these typemaps may get applied in situations you do not expect or
+want. Therefore, it is always a good idea to add a ``%clear``
+directive after you are done with a specific typemap::
+
+ %apply (double* IN_ARRAY1, int DIM1) {(double* vector, int length)}
+ %include "my_header.h"
+ %clear (double* vector, int length);
+
+In general, you should target these typemap signatures specifically
+where you want them, and then clear them after you are done.
+
+Summary
+=======
+
+Out of the box, ``numpy.i`` provides typemaps that support conversion
+between `NumPy`_ arrays and C arrays:
+
+ * That can be one of 12 different scalar types: ``signed char``,
+ ``unsigned char``, ``short``, ``unsigned short``, ``int``,
+ ``unsigned int``, ``long``, ``unsigned long``, ``long long``,
+ ``unsigned long long``, ``float`` and ``double``.
+
+ * That support 23 different argument signatures for each data type,
+ including:
+
+ + One-dimensional, two-dimensional and three-dimensional arrays.
+
+ + Input-only, in-place, and argout behavior.
+
+ + Hard-coded dimensions, data-buffer-then-dimensions
+ specification, and dimensions-then-data-buffer specification.
+
+The ``numpy.i`` interface file also provides additional tools for
+wrapper developers, including:
+
+ * A `SWIG`_ macro (``%numpy_typemaps``) with three arguments for
+ implementing the 23 argument signatures for the user's choice of
+ (1) C data type, (2) `NumPy`_ data type (assuming they match), and
+ (3) dimension type.
+
+ * Seven C macros and eleven C functions that can be used to write
+ specialized typemaps, extensions, or inlined functions that handle
+ cases not covered by the provided typemaps.
+
+Acknowledgements
+================
+
+Many people have worked to glue `SWIG`_ and `NumPy`_ together (as well
+as `SWIG`_ and the predecessors of `NumPy`_, Numeric and numarray).
+The effort to standardize this work into ``numpy.i`` began at the 2005
+`SciPy <http://scipy.org>`_ Conference with a conversation between
+Fernando Perez and myself. Fernando collected helper functions and
+typemaps from Michael Hunter, Anna Omelchenko and Michael Sanner.
+Sebastian Hasse has also provided additional error checking and use
+cases. The work of these contributors has made this end result
+possible.
diff --git a/numpy/doc/swig/setup.py b/numpy/doc/swig/setup.py
new file mode 100755
index 000000000..13bd7589e
--- /dev/null
+++ b/numpy/doc/swig/setup.py
@@ -0,0 +1,43 @@
+#! /usr/bin/env python
+
+# System imports
+from distutils.core import *
+from distutils import sysconfig
+
+# Third-party modules - we depend on numpy for everything
+import numpy
+
+# Obtain the numpy include directory. This logic works across numpy versions.
+try:
+ numpy_include = numpy.get_include()
+except AttributeError:
+ numpy_include = numpy.get_numpy_include()
+
+# _Vector extension module
+_Vector = Extension("_Vector",
+ ["Vector_wrap.cxx",
+ "vector.cxx"],
+ include_dirs = [numpy_include],
+ )
+
+# _Matrix extension module
+_Matrix = Extension("_Matrix",
+ ["Matrix_wrap.cxx",
+ "matrix.cxx"],
+ include_dirs = [numpy_include],
+ )
+
+# _Tensor extension module
+_Tensor = Extension("_Tensor",
+ ["Tensor_wrap.cxx",
+ "tensor.cxx"],
+ include_dirs = [numpy_include],
+ )
+
+# NumyTypemapTests setup
+setup(name = "NumpyTypemapTests",
+ description = "Functions that work on arrays",
+ author = "Bill Spotz",
+ py_modules = ["Vector", "Matrix", "Tensor"],
+ ext_modules = [_Vector , _Matrix , _Tensor ]
+ )
diff --git a/numpy/doc/swig/testMatrix.py b/numpy/doc/swig/testMatrix.py
new file mode 100755
index 000000000..933423fe9
--- /dev/null
+++ b/numpy/doc/swig/testMatrix.py
@@ -0,0 +1,365 @@
+#! /usr/bin/env python
+
+# System imports
+from distutils.util import get_platform
+import os
+import sys
+import unittest
+
+# Import NumPy
+import numpy as N
+major, minor = [ int(d) for d in N.__version__.split(".")[:2] ]
+if major == 0: BadListError = TypeError
+else: BadListError = ValueError
+
+# Add the distutils-generated build directory to the python search path and then
+# import the extension module
+libDir = "lib.%s-%s" % (get_platform(), sys.version[:3])
+sys.path.insert(0,os.path.join("build", libDir))
+import Matrix
+
+######################################################################
+
+class MatrixTestCase(unittest.TestCase):
+
+ def __init__(self, methodName="runTests"):
+ unittest.TestCase.__init__(self, methodName)
+ self.typeStr = "double"
+ self.typeCode = "d"
+
+ # Test (type IN_ARRAY2[ANY][ANY]) typemap
+ def testDet(self):
+ "Test det function"
+ print >>sys.stderr, self.typeStr, "... ",
+ det = Matrix.__dict__[self.typeStr + "Det"]
+ matrix = [[8,7],[6,9]]
+ self.assertEquals(det(matrix), 30)
+
+ # Test (type IN_ARRAY2[ANY][ANY]) typemap
+ def testDetBadList(self):
+ "Test det function with bad list"
+ print >>sys.stderr, self.typeStr, "... ",
+ det = Matrix.__dict__[self.typeStr + "Det"]
+ matrix = [[8,7], ["e", "pi"]]
+ self.assertRaises(BadListError, det, matrix)
+
+ # Test (type IN_ARRAY2[ANY][ANY]) typemap
+ def testDetWrongDim(self):
+ "Test det function with wrong dimensions"
+ print >>sys.stderr, self.typeStr, "... ",
+ det = Matrix.__dict__[self.typeStr + "Det"]
+ matrix = [8,7]
+ self.assertRaises(TypeError, det, matrix)
+
+ # Test (type IN_ARRAY2[ANY][ANY]) typemap
+ def testDetWrongSize(self):
+ "Test det function with wrong size"
+ print >>sys.stderr, self.typeStr, "... ",
+ det = Matrix.__dict__[self.typeStr + "Det"]
+ matrix = [[8,7,6], [5,4,3], [2,1,0]]
+ self.assertRaises(TypeError, det, matrix)
+
+ # Test (type IN_ARRAY2[ANY][ANY]) typemap
+ def testDetNonContainer(self):
+ "Test det function with non-container"
+ print >>sys.stderr, self.typeStr, "... ",
+ det = Matrix.__dict__[self.typeStr + "Det"]
+ self.assertRaises(TypeError, det, None)
+
+ # Test (type* IN_ARRAY2, int DIM1, int DIM2) typemap
+ def testMax(self):
+ "Test max function"
+ print >>sys.stderr, self.typeStr, "... ",
+ max = Matrix.__dict__[self.typeStr + "Max"]
+ matrix = [[6,5,4],[3,2,1]]
+ self.assertEquals(max(matrix), 6)
+
+ # Test (type* IN_ARRAY2, int DIM1, int DIM2) typemap
+ def testMaxBadList(self):
+ "Test max function with bad list"
+ print >>sys.stderr, self.typeStr, "... ",
+ max = Matrix.__dict__[self.typeStr + "Max"]
+ matrix = [[6,"five",4], ["three", 2, "one"]]
+ self.assertRaises(BadListError, max, matrix)
+
+ # Test (type* IN_ARRAY2, int DIM1, int DIM2) typemap
+ def testMaxNonContainer(self):
+ "Test max function with non-container"
+ print >>sys.stderr, self.typeStr, "... ",
+ max = Matrix.__dict__[self.typeStr + "Max"]
+ self.assertRaises(TypeError, max, None)
+
+ # Test (type* IN_ARRAY2, int DIM1, int DIM2) typemap
+ def testMaxWrongDim(self):
+ "Test max function with wrong dimensions"
+ print >>sys.stderr, self.typeStr, "... ",
+ max = Matrix.__dict__[self.typeStr + "Max"]
+ self.assertRaises(TypeError, max, [0, 1, 2, 3])
+
+ # Test (int DIM1, int DIM2, type* IN_ARRAY2) typemap
+ def testMin(self):
+ "Test min function"
+ print >>sys.stderr, self.typeStr, "... ",
+ min = Matrix.__dict__[self.typeStr + "Min"]
+ matrix = [[9,8],[7,6],[5,4]]
+ self.assertEquals(min(matrix), 4)
+
+ # Test (int DIM1, int DIM2, type* IN_ARRAY2) typemap
+ def testMinBadList(self):
+ "Test min function with bad list"
+ print >>sys.stderr, self.typeStr, "... ",
+ min = Matrix.__dict__[self.typeStr + "Min"]
+ matrix = [["nine","eight"], ["seven","six"]]
+ self.assertRaises(BadListError, min, matrix)
+
+ # Test (int DIM1, int DIM2, type* IN_ARRAY2) typemap
+ def testMinWrongDim(self):
+ "Test min function with wrong dimensions"
+ print >>sys.stderr, self.typeStr, "... ",
+ min = Matrix.__dict__[self.typeStr + "Min"]
+ self.assertRaises(TypeError, min, [1,3,5,7,9])
+
+ # Test (int DIM1, int DIM2, type* IN_ARRAY2) typemap
+ def testMinNonContainer(self):
+ "Test min function with non-container"
+ print >>sys.stderr, self.typeStr, "... ",
+ min = Matrix.__dict__[self.typeStr + "Min"]
+ self.assertRaises(TypeError, min, False)
+
+ # Test (type INPLACE_ARRAY2[ANY][ANY]) typemap
+ def testScale(self):
+ "Test scale function"
+ print >>sys.stderr, self.typeStr, "... ",
+ scale = Matrix.__dict__[self.typeStr + "Scale"]
+ matrix = N.array([[1,2,3],[2,1,2],[3,2,1]],self.typeCode)
+ scale(matrix,4)
+ self.assertEquals((matrix == [[4,8,12],[8,4,8],[12,8,4]]).all(), True)
+
+ # Test (type INPLACE_ARRAY2[ANY][ANY]) typemap
+ def testScaleWrongDim(self):
+ "Test scale function with wrong dimensions"
+ print >>sys.stderr, self.typeStr, "... ",
+ scale = Matrix.__dict__[self.typeStr + "Scale"]
+ matrix = N.array([1,2,2,1],self.typeCode)
+ self.assertRaises(TypeError, scale, matrix)
+
+ # Test (type INPLACE_ARRAY2[ANY][ANY]) typemap
+ def testScaleWrongSize(self):
+ "Test scale function with wrong size"
+ print >>sys.stderr, self.typeStr, "... ",
+ scale = Matrix.__dict__[self.typeStr + "Scale"]
+ matrix = N.array([[1,2],[2,1]],self.typeCode)
+ self.assertRaises(TypeError, scale, matrix)
+
+ # Test (type INPLACE_ARRAY2[ANY][ANY]) typemap
+ def testScaleWrongType(self):
+ "Test scale function with wrong type"
+ print >>sys.stderr, self.typeStr, "... ",
+ scale = Matrix.__dict__[self.typeStr + "Scale"]
+ matrix = N.array([[1,2,3],[2,1,2],[3,2,1]],'c')
+ self.assertRaises(TypeError, scale, matrix)
+
+ # Test (type INPLACE_ARRAY2[ANY][ANY]) typemap
+ def testScaleNonArray(self):
+ "Test scale function with non-array"
+ print >>sys.stderr, self.typeStr, "... ",
+ scale = Matrix.__dict__[self.typeStr + "Scale"]
+ matrix = [[1,2,3],[2,1,2],[3,2,1]]
+ self.assertRaises(TypeError, scale, matrix)
+
+ # Test (type* INPLACE_ARRAY2, int DIM1, int DIM2) typemap
+ def testFloor(self):
+ "Test floor function"
+ print >>sys.stderr, self.typeStr, "... ",
+ floor = Matrix.__dict__[self.typeStr + "Floor"]
+ matrix = N.array([[6,7],[8,9]],self.typeCode)
+ floor(matrix,7)
+ N.testing.assert_array_equal(matrix, N.array([[7,7],[8,9]]))
+
+ # Test (type* INPLACE_ARRAY2, int DIM1, int DIM2) typemap
+ def testFloorWrongDim(self):
+ "Test floor function with wrong dimensions"
+ print >>sys.stderr, self.typeStr, "... ",
+ floor = Matrix.__dict__[self.typeStr + "Floor"]
+ matrix = N.array([6,7,8,9],self.typeCode)
+ self.assertRaises(TypeError, floor, matrix)
+
+ # Test (type* INPLACE_ARRAY2, int DIM1, int DIM2) typemap
+ def testFloorWrongType(self):
+ "Test floor function with wrong type"
+ print >>sys.stderr, self.typeStr, "... ",
+ floor = Matrix.__dict__[self.typeStr + "Floor"]
+ matrix = N.array([[6,7], [8,9]],'c')
+ self.assertRaises(TypeError, floor, matrix)
+
+ # Test (type* INPLACE_ARRAY2, int DIM1, int DIM2) typemap
+ def testFloorNonArray(self):
+ "Test floor function with non-array"
+ print >>sys.stderr, self.typeStr, "... ",
+ floor = Matrix.__dict__[self.typeStr + "Floor"]
+ matrix = [[6,7], [8,9]]
+ self.assertRaises(TypeError, floor, matrix)
+
+ # Test (int DIM1, int DIM2, type* INPLACE_ARRAY2) typemap
+ def testCeil(self):
+ "Test ceil function"
+ print >>sys.stderr, self.typeStr, "... ",
+ ceil = Matrix.__dict__[self.typeStr + "Ceil"]
+ matrix = N.array([[1,2],[3,4]],self.typeCode)
+ ceil(matrix,3)
+ N.testing.assert_array_equal(matrix, N.array([[1,2],[3,3]]))
+
+ # Test (int DIM1, int DIM2, type* INPLACE_ARRAY2) typemap
+ def testCeilWrongDim(self):
+ "Test ceil function with wrong dimensions"
+ print >>sys.stderr, self.typeStr, "... ",
+ ceil = Matrix.__dict__[self.typeStr + "Ceil"]
+ matrix = N.array([1,2,3,4],self.typeCode)
+ self.assertRaises(TypeError, ceil, matrix)
+
+ # Test (int DIM1, int DIM2, type* INPLACE_ARRAY2) typemap
+ def testCeilWrongType(self):
+ "Test ceil function with wrong dimensions"
+ print >>sys.stderr, self.typeStr, "... ",
+ ceil = Matrix.__dict__[self.typeStr + "Ceil"]
+ matrix = N.array([[1,2], [3,4]],'c')
+ self.assertRaises(TypeError, ceil, matrix)
+
+ # Test (int DIM1, int DIM2, type* INPLACE_ARRAY2) typemap
+ def testCeilNonArray(self):
+ "Test ceil function with non-array"
+ print >>sys.stderr, self.typeStr, "... ",
+ ceil = Matrix.__dict__[self.typeStr + "Ceil"]
+ matrix = [[1,2], [3,4]]
+ self.assertRaises(TypeError, ceil, matrix)
+
+ # Test (type ARGOUT_ARRAY2[ANY][ANY]) typemap
+ def testLUSplit(self):
+ "Test luSplit function"
+ print >>sys.stderr, self.typeStr, "... ",
+ luSplit = Matrix.__dict__[self.typeStr + "LUSplit"]
+ lower, upper = luSplit([[1,2,3],[4,5,6],[7,8,9]])
+ self.assertEquals((lower == [[1,0,0],[4,5,0],[7,8,9]]).all(), True)
+ self.assertEquals((upper == [[0,2,3],[0,0,6],[0,0,0]]).all(), True)
+
+######################################################################
+
+class scharTestCase(MatrixTestCase):
+ def __init__(self, methodName="runTest"):
+ MatrixTestCase.__init__(self, methodName)
+ self.typeStr = "schar"
+ self.typeCode = "b"
+
+######################################################################
+
+class ucharTestCase(MatrixTestCase):
+ def __init__(self, methodName="runTest"):
+ MatrixTestCase.__init__(self, methodName)
+ self.typeStr = "uchar"
+ self.typeCode = "B"
+
+######################################################################
+
+class shortTestCase(MatrixTestCase):
+ def __init__(self, methodName="runTest"):
+ MatrixTestCase.__init__(self, methodName)
+ self.typeStr = "short"
+ self.typeCode = "h"
+
+######################################################################
+
+class ushortTestCase(MatrixTestCase):
+ def __init__(self, methodName="runTest"):
+ MatrixTestCase.__init__(self, methodName)
+ self.typeStr = "ushort"
+ self.typeCode = "H"
+
+######################################################################
+
+class intTestCase(MatrixTestCase):
+ def __init__(self, methodName="runTest"):
+ MatrixTestCase.__init__(self, methodName)
+ self.typeStr = "int"
+ self.typeCode = "i"
+
+######################################################################
+
+class uintTestCase(MatrixTestCase):
+ def __init__(self, methodName="runTest"):
+ MatrixTestCase.__init__(self, methodName)
+ self.typeStr = "uint"
+ self.typeCode = "I"
+
+######################################################################
+
+class longTestCase(MatrixTestCase):
+ def __init__(self, methodName="runTest"):
+ MatrixTestCase.__init__(self, methodName)
+ self.typeStr = "long"
+ self.typeCode = "l"
+
+######################################################################
+
+class ulongTestCase(MatrixTestCase):
+ def __init__(self, methodName="runTest"):
+ MatrixTestCase.__init__(self, methodName)
+ self.typeStr = "ulong"
+ self.typeCode = "L"
+
+######################################################################
+
+class longLongTestCase(MatrixTestCase):
+ def __init__(self, methodName="runTest"):
+ MatrixTestCase.__init__(self, methodName)
+ self.typeStr = "longLong"
+ self.typeCode = "q"
+
+######################################################################
+
+class ulongLongTestCase(MatrixTestCase):
+ def __init__(self, methodName="runTest"):
+ MatrixTestCase.__init__(self, methodName)
+ self.typeStr = "ulongLong"
+ self.typeCode = "Q"
+
+######################################################################
+
+class floatTestCase(MatrixTestCase):
+ def __init__(self, methodName="runTest"):
+ MatrixTestCase.__init__(self, methodName)
+ self.typeStr = "float"
+ self.typeCode = "f"
+
+######################################################################
+
+class doubleTestCase(MatrixTestCase):
+ def __init__(self, methodName="runTest"):
+ MatrixTestCase.__init__(self, methodName)
+ self.typeStr = "double"
+ self.typeCode = "d"
+
+######################################################################
+
+if __name__ == "__main__":
+
+ # Build the test suite
+ suite = unittest.TestSuite()
+ suite.addTest(unittest.makeSuite( scharTestCase))
+ suite.addTest(unittest.makeSuite( ucharTestCase))
+ suite.addTest(unittest.makeSuite( shortTestCase))
+ suite.addTest(unittest.makeSuite( ushortTestCase))
+ suite.addTest(unittest.makeSuite( intTestCase))
+ suite.addTest(unittest.makeSuite( uintTestCase))
+ suite.addTest(unittest.makeSuite( longTestCase))
+ suite.addTest(unittest.makeSuite( ulongTestCase))
+ suite.addTest(unittest.makeSuite( longLongTestCase))
+ suite.addTest(unittest.makeSuite(ulongLongTestCase))
+ suite.addTest(unittest.makeSuite( floatTestCase))
+ suite.addTest(unittest.makeSuite( doubleTestCase))
+
+ # Execute the test suite
+ print "Testing 2D Functions of Module Matrix"
+ print "NumPy version", N.__version__
+ print
+ result = unittest.TextTestRunner(verbosity=2).run(suite)
+ sys.exit(len(result.errors) + len(result.failures))
diff --git a/numpy/doc/swig/testTensor.py b/numpy/doc/swig/testTensor.py
new file mode 100755
index 000000000..f68e6b720
--- /dev/null
+++ b/numpy/doc/swig/testTensor.py
@@ -0,0 +1,405 @@
+#! /usr/bin/env python
+
+# System imports
+from distutils.util import get_platform
+from math import sqrt
+import os
+import sys
+import unittest
+
+# Import NumPy
+import numpy as N
+major, minor = [ int(d) for d in N.__version__.split(".")[:2] ]
+if major == 0: BadListError = TypeError
+else: BadListError = ValueError
+
+# Add the distutils-generated build directory to the python search path and then
+# import the extension module
+libDir = "lib.%s-%s" % (get_platform(), sys.version[:3])
+sys.path.insert(0,os.path.join("build", libDir))
+import Tensor
+
+######################################################################
+
+class TensorTestCase(unittest.TestCase):
+
+ def __init__(self, methodName="runTests"):
+ unittest.TestCase.__init__(self, methodName)
+ self.typeStr = "double"
+ self.typeCode = "d"
+ self.result = sqrt(28.0/8)
+
+ # Test (type IN_ARRAY3[ANY][ANY][ANY]) typemap
+ def testNorm(self):
+ "Test norm function"
+ print >>sys.stderr, self.typeStr, "... ",
+ norm = Tensor.__dict__[self.typeStr + "Norm"]
+ tensor = [[[0,1], [2,3]],
+ [[3,2], [1,0]]]
+ if isinstance(self.result, int):
+ self.assertEquals(norm(tensor), self.result)
+ else:
+ self.assertAlmostEqual(norm(tensor), self.result, 6)
+
+ # Test (type IN_ARRAY3[ANY][ANY][ANY]) typemap
+ def testNormBadList(self):
+ "Test norm function with bad list"
+ print >>sys.stderr, self.typeStr, "... ",
+ norm = Tensor.__dict__[self.typeStr + "Norm"]
+ tensor = [[[0,"one"],[2,3]],
+ [[3,"two"],[1,0]]]
+ self.assertRaises(BadListError, norm, tensor)
+
+ # Test (type IN_ARRAY3[ANY][ANY][ANY]) typemap
+ def testNormWrongDim(self):
+ "Test norm function with wrong dimensions"
+ print >>sys.stderr, self.typeStr, "... ",
+ norm = Tensor.__dict__[self.typeStr + "Norm"]
+ tensor = [[0,1,2,3],
+ [3,2,1,0]]
+ self.assertRaises(TypeError, norm, tensor)
+
+ # Test (type IN_ARRAY3[ANY][ANY][ANY]) typemap
+ def testNormWrongSize(self):
+ "Test norm function with wrong size"
+ print >>sys.stderr, self.typeStr, "... ",
+ norm = Tensor.__dict__[self.typeStr + "Norm"]
+ tensor = [[[0,1,0], [2,3,2]],
+ [[3,2,3], [1,0,1]]]
+ self.assertRaises(TypeError, norm, tensor)
+
+ # Test (type IN_ARRAY3[ANY][ANY][ANY]) typemap
+ def testNormNonContainer(self):
+ "Test norm function with non-container"
+ print >>sys.stderr, self.typeStr, "... ",
+ norm = Tensor.__dict__[self.typeStr + "Norm"]
+ self.assertRaises(TypeError, norm, None)
+
+ # Test (type* IN_ARRAY3, int DIM1, int DIM2, int DIM3) typemap
+ def testMax(self):
+ "Test max function"
+ print >>sys.stderr, self.typeStr, "... ",
+ max = Tensor.__dict__[self.typeStr + "Max"]
+ tensor = [[[1,2], [3,4]],
+ [[5,6], [7,8]]]
+ self.assertEquals(max(tensor), 8)
+
+ # Test (type* IN_ARRAY3, int DIM1, int DIM2, int DIM3) typemap
+ def testMaxBadList(self):
+ "Test max function with bad list"
+ print >>sys.stderr, self.typeStr, "... ",
+ max = Tensor.__dict__[self.typeStr + "Max"]
+ tensor = [[[1,"two"], [3,4]],
+ [[5,"six"], [7,8]]]
+ self.assertRaises(BadListError, max, tensor)
+
+ # Test (type* IN_ARRAY3, int DIM1, int DIM2, int DIM3) typemap
+ def testMaxNonContainer(self):
+ "Test max function with non-container"
+ print >>sys.stderr, self.typeStr, "... ",
+ max = Tensor.__dict__[self.typeStr + "Max"]
+ self.assertRaises(TypeError, max, None)
+
+ # Test (type* IN_ARRAY3, int DIM1, int DIM2, int DIM3) typemap
+ def testMaxWrongDim(self):
+ "Test max function with wrong dimensions"
+ print >>sys.stderr, self.typeStr, "... ",
+ max = Tensor.__dict__[self.typeStr + "Max"]
+ self.assertRaises(TypeError, max, [0, -1, 2, -3])
+
+ # Test (int DIM1, int DIM2, int DIM3, type* IN_ARRAY3) typemap
+ def testMin(self):
+ "Test min function"
+ print >>sys.stderr, self.typeStr, "... ",
+ min = Tensor.__dict__[self.typeStr + "Min"]
+ tensor = [[[9,8], [7,6]],
+ [[5,4], [3,2]]]
+ self.assertEquals(min(tensor), 2)
+
+ # Test (int DIM1, int DIM2, int DIM3, type* IN_ARRAY3) typemap
+ def testMinBadList(self):
+ "Test min function with bad list"
+ print >>sys.stderr, self.typeStr, "... ",
+ min = Tensor.__dict__[self.typeStr + "Min"]
+ tensor = [[["nine",8], [7,6]],
+ [["five",4], [3,2]]]
+ self.assertRaises(BadListError, min, tensor)
+
+ # Test (int DIM1, int DIM2, int DIM3, type* IN_ARRAY3) typemap
+ def testMinNonContainer(self):
+ "Test min function with non-container"
+ print >>sys.stderr, self.typeStr, "... ",
+ min = Tensor.__dict__[self.typeStr + "Min"]
+ self.assertRaises(TypeError, min, True)
+
+ # Test (int DIM1, int DIM2, int DIM3, type* IN_ARRAY3) typemap
+ def testMinWrongDim(self):
+ "Test min function with wrong dimensions"
+ print >>sys.stderr, self.typeStr, "... ",
+ min = Tensor.__dict__[self.typeStr + "Min"]
+ self.assertRaises(TypeError, min, [[1,3],[5,7]])
+
+ # Test (type INPLACE_ARRAY3[ANY][ANY][ANY]) typemap
+ def testScale(self):
+ "Test scale function"
+ print >>sys.stderr, self.typeStr, "... ",
+ scale = Tensor.__dict__[self.typeStr + "Scale"]
+ tensor = N.array([[[1,0,1], [0,1,0], [1,0,1]],
+ [[0,1,0], [1,0,1], [0,1,0]],
+ [[1,0,1], [0,1,0], [1,0,1]]],self.typeCode)
+ scale(tensor,4)
+ self.assertEquals((tensor == [[[4,0,4], [0,4,0], [4,0,4]],
+ [[0,4,0], [4,0,4], [0,4,0]],
+ [[4,0,4], [0,4,0], [4,0,4]]]).all(), True)
+
+ # Test (type INPLACE_ARRAY3[ANY][ANY][ANY]) typemap
+ def testScaleWrongType(self):
+ "Test scale function with wrong type"
+ print >>sys.stderr, self.typeStr, "... ",
+ scale = Tensor.__dict__[self.typeStr + "Scale"]
+ tensor = N.array([[[1,0,1], [0,1,0], [1,0,1]],
+ [[0,1,0], [1,0,1], [0,1,0]],
+ [[1,0,1], [0,1,0], [1,0,1]]],'c')
+ self.assertRaises(TypeError, scale, tensor)
+
+ # Test (type INPLACE_ARRAY3[ANY][ANY][ANY]) typemap
+ def testScaleWrongDim(self):
+ "Test scale function with wrong dimensions"
+ print >>sys.stderr, self.typeStr, "... ",
+ scale = Tensor.__dict__[self.typeStr + "Scale"]
+ tensor = N.array([[1,0,1], [0,1,0], [1,0,1],
+ [0,1,0], [1,0,1], [0,1,0]],self.typeCode)
+ self.assertRaises(TypeError, scale, tensor)
+
+ # Test (type INPLACE_ARRAY3[ANY][ANY][ANY]) typemap
+ def testScaleWrongSize(self):
+ "Test scale function with wrong size"
+ print >>sys.stderr, self.typeStr, "... ",
+ scale = Tensor.__dict__[self.typeStr + "Scale"]
+ tensor = N.array([[[1,0], [0,1], [1,0]],
+ [[0,1], [1,0], [0,1]],
+ [[1,0], [0,1], [1,0]]],self.typeCode)
+ self.assertRaises(TypeError, scale, tensor)
+
+ # Test (type INPLACE_ARRAY3[ANY][ANY][ANY]) typemap
+ def testScaleNonArray(self):
+ "Test scale function with non-array"
+ print >>sys.stderr, self.typeStr, "... ",
+ scale = Tensor.__dict__[self.typeStr + "Scale"]
+ self.assertRaises(TypeError, scale, True)
+
+ # Test (type* INPLACE_ARRAY3, int DIM1, int DIM2, int DIM3) typemap
+ def testFloor(self):
+ "Test floor function"
+ print >>sys.stderr, self.typeStr, "... ",
+ floor = Tensor.__dict__[self.typeStr + "Floor"]
+ tensor = N.array([[[1,2], [3,4]],
+ [[5,6], [7,8]]],self.typeCode)
+ floor(tensor,4)
+ N.testing.assert_array_equal(tensor, N.array([[[4,4], [4,4]],
+ [[5,6], [7,8]]]))
+
+ # Test (type* INPLACE_ARRAY3, int DIM1, int DIM2, int DIM3) typemap
+ def testFloorWrongType(self):
+ "Test floor function with wrong type"
+ print >>sys.stderr, self.typeStr, "... ",
+ floor = Tensor.__dict__[self.typeStr + "Floor"]
+ tensor = N.array([[[1,2], [3,4]],
+ [[5,6], [7,8]]],'c')
+ self.assertRaises(TypeError, floor, tensor)
+
+ # Test (type* INPLACE_ARRAY3, int DIM1, int DIM2, int DIM3) typemap
+ def testFloorWrongDim(self):
+ "Test floor function with wrong type"
+ print >>sys.stderr, self.typeStr, "... ",
+ floor = Tensor.__dict__[self.typeStr + "Floor"]
+ tensor = N.array([[1,2], [3,4], [5,6], [7,8]],self.typeCode)
+ self.assertRaises(TypeError, floor, tensor)
+
+ # Test (type* INPLACE_ARRAY3, int DIM1, int DIM2, int DIM3) typemap
+ def testFloorNonArray(self):
+ "Test floor function with non-array"
+ print >>sys.stderr, self.typeStr, "... ",
+ floor = Tensor.__dict__[self.typeStr + "Floor"]
+ self.assertRaises(TypeError, floor, object)
+
+ # Test (int DIM1, int DIM2, int DIM3, type* INPLACE_ARRAY3) typemap
+ def testCeil(self):
+ "Test ceil function"
+ print >>sys.stderr, self.typeStr, "... ",
+ ceil = Tensor.__dict__[self.typeStr + "Ceil"]
+ tensor = N.array([[[9,8], [7,6]],
+ [[5,4], [3,2]]],self.typeCode)
+ ceil(tensor,5)
+ N.testing.assert_array_equal(tensor, N.array([[[5,5], [5,5]],
+ [[5,4], [3,2]]]))
+
+ # Test (int DIM1, int DIM2, int DIM3, type* INPLACE_ARRAY3) typemap
+ def testCeilWrongType(self):
+ "Test ceil function with wrong type"
+ print >>sys.stderr, self.typeStr, "... ",
+ ceil = Tensor.__dict__[self.typeStr + "Ceil"]
+ tensor = N.array([[[9,8], [7,6]],
+ [[5,4], [3,2]]],'c')
+ self.assertRaises(TypeError, ceil, tensor)
+
+ # Test (int DIM1, int DIM2, int DIM3, type* INPLACE_ARRAY3) typemap
+ def testCeilWrongDim(self):
+ "Test ceil function with wrong dimensions"
+ print >>sys.stderr, self.typeStr, "... ",
+ ceil = Tensor.__dict__[self.typeStr + "Ceil"]
+ tensor = N.array([[9,8], [7,6], [5,4], [3,2]], self.typeCode)
+ self.assertRaises(TypeError, ceil, tensor)
+
+ # Test (int DIM1, int DIM2, int DIM3, type* INPLACE_ARRAY3) typemap
+ def testCeilNonArray(self):
+ "Test ceil function with non-array"
+ print >>sys.stderr, self.typeStr, "... ",
+ ceil = Tensor.__dict__[self.typeStr + "Ceil"]
+ tensor = [[[9,8], [7,6]],
+ [[5,4], [3,2]]]
+ self.assertRaises(TypeError, ceil, tensor)
+
+ # Test (type ARGOUT_ARRAY3[ANY][ANY][ANY]) typemap
+ def testLUSplit(self):
+ "Test luSplit function"
+ print >>sys.stderr, self.typeStr, "... ",
+ luSplit = Tensor.__dict__[self.typeStr + "LUSplit"]
+ lower, upper = luSplit([[[1,1], [1,1]],
+ [[1,1], [1,1]]])
+ self.assertEquals((lower == [[[1,1], [1,0]],
+ [[1,0], [0,0]]]).all(), True)
+ self.assertEquals((upper == [[[0,0], [0,1]],
+ [[0,1], [1,1]]]).all(), True)
+
+######################################################################
+
+class scharTestCase(TensorTestCase):
+ def __init__(self, methodName="runTest"):
+ TensorTestCase.__init__(self, methodName)
+ self.typeStr = "schar"
+ self.typeCode = "b"
+ self.result = int(self.result)
+
+######################################################################
+
+class ucharTestCase(TensorTestCase):
+ def __init__(self, methodName="runTest"):
+ TensorTestCase.__init__(self, methodName)
+ self.typeStr = "uchar"
+ self.typeCode = "B"
+ self.result = int(self.result)
+
+######################################################################
+
+class shortTestCase(TensorTestCase):
+ def __init__(self, methodName="runTest"):
+ TensorTestCase.__init__(self, methodName)
+ self.typeStr = "short"
+ self.typeCode = "h"
+ self.result = int(self.result)
+
+######################################################################
+
+class ushortTestCase(TensorTestCase):
+ def __init__(self, methodName="runTest"):
+ TensorTestCase.__init__(self, methodName)
+ self.typeStr = "ushort"
+ self.typeCode = "H"
+ self.result = int(self.result)
+
+######################################################################
+
+class intTestCase(TensorTestCase):
+ def __init__(self, methodName="runTest"):
+ TensorTestCase.__init__(self, methodName)
+ self.typeStr = "int"
+ self.typeCode = "i"
+ self.result = int(self.result)
+
+######################################################################
+
+class uintTestCase(TensorTestCase):
+ def __init__(self, methodName="runTest"):
+ TensorTestCase.__init__(self, methodName)
+ self.typeStr = "uint"
+ self.typeCode = "I"
+ self.result = int(self.result)
+
+######################################################################
+
+class longTestCase(TensorTestCase):
+ def __init__(self, methodName="runTest"):
+ TensorTestCase.__init__(self, methodName)
+ self.typeStr = "long"
+ self.typeCode = "l"
+ self.result = int(self.result)
+
+######################################################################
+
+class ulongTestCase(TensorTestCase):
+ def __init__(self, methodName="runTest"):
+ TensorTestCase.__init__(self, methodName)
+ self.typeStr = "ulong"
+ self.typeCode = "L"
+ self.result = int(self.result)
+
+######################################################################
+
+class longLongTestCase(TensorTestCase):
+ def __init__(self, methodName="runTest"):
+ TensorTestCase.__init__(self, methodName)
+ self.typeStr = "longLong"
+ self.typeCode = "q"
+ self.result = int(self.result)
+
+######################################################################
+
+class ulongLongTestCase(TensorTestCase):
+ def __init__(self, methodName="runTest"):
+ TensorTestCase.__init__(self, methodName)
+ self.typeStr = "ulongLong"
+ self.typeCode = "Q"
+ self.result = int(self.result)
+
+######################################################################
+
+class floatTestCase(TensorTestCase):
+ def __init__(self, methodName="runTest"):
+ TensorTestCase.__init__(self, methodName)
+ self.typeStr = "float"
+ self.typeCode = "f"
+
+######################################################################
+
+class doubleTestCase(TensorTestCase):
+ def __init__(self, methodName="runTest"):
+ TensorTestCase.__init__(self, methodName)
+ self.typeStr = "double"
+ self.typeCode = "d"
+
+######################################################################
+
+if __name__ == "__main__":
+
+ # Build the test suite
+ suite = unittest.TestSuite()
+ suite.addTest(unittest.makeSuite( scharTestCase))
+ suite.addTest(unittest.makeSuite( ucharTestCase))
+ suite.addTest(unittest.makeSuite( shortTestCase))
+ suite.addTest(unittest.makeSuite( ushortTestCase))
+ suite.addTest(unittest.makeSuite( intTestCase))
+ suite.addTest(unittest.makeSuite( uintTestCase))
+ suite.addTest(unittest.makeSuite( longTestCase))
+ suite.addTest(unittest.makeSuite( ulongTestCase))
+ suite.addTest(unittest.makeSuite( longLongTestCase))
+ suite.addTest(unittest.makeSuite(ulongLongTestCase))
+ suite.addTest(unittest.makeSuite( floatTestCase))
+ suite.addTest(unittest.makeSuite( doubleTestCase))
+
+ # Execute the test suite
+ print "Testing 3D Functions of Module Tensor"
+ print "NumPy version", N.__version__
+ print
+ result = unittest.TextTestRunner(verbosity=2).run(suite)
+ sys.exit(len(result.errors) + len(result.failures))
diff --git a/numpy/doc/swig/testVector.py b/numpy/doc/swig/testVector.py
new file mode 100755
index 000000000..82a922e25
--- /dev/null
+++ b/numpy/doc/swig/testVector.py
@@ -0,0 +1,384 @@
+#! /usr/bin/env python
+
+# System imports
+from distutils.util import get_platform
+import os
+import sys
+import unittest
+
+# Import NumPy
+import numpy as N
+major, minor = [ int(d) for d in N.__version__.split(".")[:2] ]
+if major == 0: BadListError = TypeError
+else: BadListError = ValueError
+
+# Add the distutils-generated build directory to the python search path and then
+# import the extension module
+libDir = "lib.%s-%s" % (get_platform(), sys.version[:3])
+sys.path.insert(0,os.path.join("build", libDir))
+import Vector
+
+######################################################################
+
+class VectorTestCase(unittest.TestCase):
+
+ def __init__(self, methodName="runTest"):
+ unittest.TestCase.__init__(self, methodName)
+ self.typeStr = "double"
+ self.typeCode = "d"
+
+ # Test the (type IN_ARRAY1[ANY]) typemap
+ def testLength(self):
+ "Test length function"
+ print >>sys.stderr, self.typeStr, "... ",
+ length = Vector.__dict__[self.typeStr + "Length"]
+ self.assertEquals(length([5, 12, 0]), 13)
+
+ # Test the (type IN_ARRAY1[ANY]) typemap
+ def testLengthBadList(self):
+ "Test length function with bad list"
+ print >>sys.stderr, self.typeStr, "... ",
+ length = Vector.__dict__[self.typeStr + "Length"]
+ self.assertRaises(BadListError, length, [5, "twelve", 0])
+
+ # Test the (type IN_ARRAY1[ANY]) typemap
+ def testLengthWrongSize(self):
+ "Test length function with wrong size"
+ print >>sys.stderr, self.typeStr, "... ",
+ length = Vector.__dict__[self.typeStr + "Length"]
+ self.assertRaises(TypeError, length, [5, 12])
+
+ # Test the (type IN_ARRAY1[ANY]) typemap
+ def testLengthWrongDim(self):
+ "Test length function with wrong dimensions"
+ print >>sys.stderr, self.typeStr, "... ",
+ length = Vector.__dict__[self.typeStr + "Length"]
+ self.assertRaises(TypeError, length, [[1,2], [3,4]])
+
+ # Test the (type IN_ARRAY1[ANY]) typemap
+ def testLengthNonContainer(self):
+ "Test length function with non-container"
+ print >>sys.stderr, self.typeStr, "... ",
+ length = Vector.__dict__[self.typeStr + "Length"]
+ self.assertRaises(TypeError, length, None)
+
+ # Test the (type* IN_ARRAY1, int DIM1) typemap
+ def testProd(self):
+ "Test prod function"
+ print >>sys.stderr, self.typeStr, "... ",
+ prod = Vector.__dict__[self.typeStr + "Prod"]
+ self.assertEquals(prod([1,2,3,4]), 24)
+
+ # Test the (type* IN_ARRAY1, int DIM1) typemap
+ def testProdBadList(self):
+ "Test prod function with bad list"
+ print >>sys.stderr, self.typeStr, "... ",
+ prod = Vector.__dict__[self.typeStr + "Prod"]
+ self.assertRaises(BadListError, prod, [[1,"two"], ["e","pi"]])
+
+ # Test the (type* IN_ARRAY1, int DIM1) typemap
+ def testProdWrongDim(self):
+ "Test prod function with wrong dimensions"
+ print >>sys.stderr, self.typeStr, "... ",
+ prod = Vector.__dict__[self.typeStr + "Prod"]
+ self.assertRaises(TypeError, prod, [[1,2], [8,9]])
+
+ # Test the (type* IN_ARRAY1, int DIM1) typemap
+ def testProdNonContainer(self):
+ "Test prod function with non-container"
+ print >>sys.stderr, self.typeStr, "... ",
+ prod = Vector.__dict__[self.typeStr + "Prod"]
+ self.assertRaises(TypeError, prod, None)
+
+ # Test the (int DIM1, type* IN_ARRAY1) typemap
+ def testSum(self):
+ "Test sum function"
+ print >>sys.stderr, self.typeStr, "... ",
+ sum = Vector.__dict__[self.typeStr + "Sum"]
+ self.assertEquals(sum([5,6,7,8]), 26)
+
+ # Test the (int DIM1, type* IN_ARRAY1) typemap
+ def testSumBadList(self):
+ "Test sum function with bad list"
+ print >>sys.stderr, self.typeStr, "... ",
+ sum = Vector.__dict__[self.typeStr + "Sum"]
+ self.assertRaises(BadListError, sum, [3,4, 5, "pi"])
+
+ # Test the (int DIM1, type* IN_ARRAY1) typemap
+ def testSumWrongDim(self):
+ "Test sum function with wrong dimensions"
+ print >>sys.stderr, self.typeStr, "... ",
+ sum = Vector.__dict__[self.typeStr + "Sum"]
+ self.assertRaises(TypeError, sum, [[3,4], [5,6]])
+
+ # Test the (int DIM1, type* IN_ARRAY1) typemap
+ def testSumNonContainer(self):
+ "Test sum function with non-container"
+ print >>sys.stderr, self.typeStr, "... ",
+ sum = Vector.__dict__[self.typeStr + "Sum"]
+ self.assertRaises(TypeError, sum, True)
+
+ # Test the (type INPLACE_ARRAY1[ANY]) typemap
+ def testReverse(self):
+ "Test reverse function"
+ print >>sys.stderr, self.typeStr, "... ",
+ reverse = Vector.__dict__[self.typeStr + "Reverse"]
+ vector = N.array([1,2,4],self.typeCode)
+ reverse(vector)
+ self.assertEquals((vector == [4,2,1]).all(), True)
+
+ # Test the (type INPLACE_ARRAY1[ANY]) typemap
+ def testReverseWrongDim(self):
+ "Test reverse function with wrong dimensions"
+ print >>sys.stderr, self.typeStr, "... ",
+ reverse = Vector.__dict__[self.typeStr + "Reverse"]
+ vector = N.array([[1,2], [3,4]],self.typeCode)
+ self.assertRaises(TypeError, reverse, vector)
+
+ # Test the (type INPLACE_ARRAY1[ANY]) typemap
+ def testReverseWrongSize(self):
+ "Test reverse function with wrong size"
+ print >>sys.stderr, self.typeStr, "... ",
+ reverse = Vector.__dict__[self.typeStr + "Reverse"]
+ vector = N.array([9,8,7,6,5,4],self.typeCode)
+ self.assertRaises(TypeError, reverse, vector)
+
+ # Test the (type INPLACE_ARRAY1[ANY]) typemap
+ def testReverseWrongType(self):
+ "Test reverse function with wrong type"
+ print >>sys.stderr, self.typeStr, "... ",
+ reverse = Vector.__dict__[self.typeStr + "Reverse"]
+ vector = N.array([1,2,4],'c')
+ self.assertRaises(TypeError, reverse, vector)
+
+ # Test the (type INPLACE_ARRAY1[ANY]) typemap
+ def testReverseNonArray(self):
+ "Test reverse function with non-array"
+ print >>sys.stderr, self.typeStr, "... ",
+ reverse = Vector.__dict__[self.typeStr + "Reverse"]
+ self.assertRaises(TypeError, reverse, [2,4,6])
+
+ # Test the (type* INPLACE_ARRAY1, int DIM1) typemap
+ def testOnes(self):
+ "Test ones function"
+ print >>sys.stderr, self.typeStr, "... ",
+ ones = Vector.__dict__[self.typeStr + "Ones"]
+ vector = N.zeros(5,self.typeCode)
+ ones(vector)
+ N.testing.assert_array_equal(vector, N.array([1,1,1,1,1]))
+
+ # Test the (type* INPLACE_ARRAY1, int DIM1) typemap
+ def testOnesWrongDim(self):
+ "Test ones function with wrong dimensions"
+ print >>sys.stderr, self.typeStr, "... ",
+ ones = Vector.__dict__[self.typeStr + "Ones"]
+ vector = N.zeros((5,5),self.typeCode)
+ self.assertRaises(TypeError, ones, vector)
+
+ # Test the (type* INPLACE_ARRAY1, int DIM1) typemap
+ def testOnesWrongType(self):
+ "Test ones function with wrong type"
+ print >>sys.stderr, self.typeStr, "... ",
+ ones = Vector.__dict__[self.typeStr + "Ones"]
+ vector = N.zeros((5,5),'c')
+ self.assertRaises(TypeError, ones, vector)
+
+ # Test the (type* INPLACE_ARRAY1, int DIM1) typemap
+ def testOnesNonArray(self):
+ "Test ones function with non-array"
+ print >>sys.stderr, self.typeStr, "... ",
+ ones = Vector.__dict__[self.typeStr + "Ones"]
+ self.assertRaises(TypeError, ones, [2,4,6,8])
+
+ # Test the (int DIM1, type* INPLACE_ARRAY1) typemap
+ def testZeros(self):
+ "Test zeros function"
+ print >>sys.stderr, self.typeStr, "... ",
+ zeros = Vector.__dict__[self.typeStr + "Zeros"]
+ vector = N.ones(5,self.typeCode)
+ zeros(vector)
+ N.testing.assert_array_equal(vector, N.array([0,0,0,0,0]))
+
+ # Test the (int DIM1, type* INPLACE_ARRAY1) typemap
+ def testZerosWrongDim(self):
+ "Test zeros function with wrong dimensions"
+ print >>sys.stderr, self.typeStr, "... ",
+ zeros = Vector.__dict__[self.typeStr + "Zeros"]
+ vector = N.ones((5,5),self.typeCode)
+ self.assertRaises(TypeError, zeros, vector)
+
+ # Test the (int DIM1, type* INPLACE_ARRAY1) typemap
+ def testZerosWrongType(self):
+ "Test zeros function with wrong type"
+ print >>sys.stderr, self.typeStr, "... ",
+ zeros = Vector.__dict__[self.typeStr + "Zeros"]
+ vector = N.ones(6,'c')
+ self.assertRaises(TypeError, zeros, vector)
+
+ # Test the (int DIM1, type* INPLACE_ARRAY1) typemap
+ def testZerosNonArray(self):
+ "Test zeros function with non-array"
+ print >>sys.stderr, self.typeStr, "... ",
+ zeros = Vector.__dict__[self.typeStr + "Zeros"]
+ self.assertRaises(TypeError, zeros, [1,3,5,7,9])
+
+ # Test the (type ARGOUT_ARRAY1[ANY]) typemap
+ def testEOSplit(self):
+ "Test eoSplit function"
+ print >>sys.stderr, self.typeStr, "... ",
+ eoSplit = Vector.__dict__[self.typeStr + "EOSplit"]
+ even, odd = eoSplit([1,2,3])
+ self.assertEquals((even == [1,0,3]).all(), True)
+ self.assertEquals((odd == [0,2,0]).all(), True)
+
+ # Test the (type* ARGOUT_ARRAY1, int DIM1) typemap
+ def testTwos(self):
+ "Test twos function"
+ print >>sys.stderr, self.typeStr, "... ",
+ twos = Vector.__dict__[self.typeStr + "Twos"]
+ vector = twos(5)
+ self.assertEquals((vector == [2,2,2,2,2]).all(), True)
+
+ # Test the (type* ARGOUT_ARRAY1, int DIM1) typemap
+ def testTwosNonInt(self):
+ "Test twos function with non-integer dimension"
+ print >>sys.stderr, self.typeStr, "... ",
+ twos = Vector.__dict__[self.typeStr + "Twos"]
+ self.assertRaises(TypeError, twos, 5.0)
+
+ # Test the (int DIM1, type* ARGOUT_ARRAY1) typemap
+ def testThrees(self):
+ "Test threes function"
+ print >>sys.stderr, self.typeStr, "... ",
+ threes = Vector.__dict__[self.typeStr + "Threes"]
+ vector = threes(6)
+ self.assertEquals((vector == [3,3,3,3,3,3]).all(), True)
+
+ # Test the (type* ARGOUT_ARRAY1, int DIM1) typemap
+ def testThreesNonInt(self):
+ "Test threes function with non-integer dimension"
+ print >>sys.stderr, self.typeStr, "... ",
+ threes = Vector.__dict__[self.typeStr + "Threes"]
+ self.assertRaises(TypeError, threes, "threes")
+
+######################################################################
+
+class scharTestCase(VectorTestCase):
+ def __init__(self, methodName="runTest"):
+ VectorTestCase.__init__(self, methodName)
+ self.typeStr = "schar"
+ self.typeCode = "b"
+
+######################################################################
+
+class ucharTestCase(VectorTestCase):
+ def __init__(self, methodName="runTest"):
+ VectorTestCase.__init__(self, methodName)
+ self.typeStr = "uchar"
+ self.typeCode = "B"
+
+######################################################################
+
+class shortTestCase(VectorTestCase):
+ def __init__(self, methodName="runTest"):
+ VectorTestCase.__init__(self, methodName)
+ self.typeStr = "short"
+ self.typeCode = "h"
+
+######################################################################
+
+class ushortTestCase(VectorTestCase):
+ def __init__(self, methodName="runTest"):
+ VectorTestCase.__init__(self, methodName)
+ self.typeStr = "ushort"
+ self.typeCode = "H"
+
+######################################################################
+
+class intTestCase(VectorTestCase):
+ def __init__(self, methodName="runTest"):
+ VectorTestCase.__init__(self, methodName)
+ self.typeStr = "int"
+ self.typeCode = "i"
+
+######################################################################
+
+class uintTestCase(VectorTestCase):
+ def __init__(self, methodName="runTest"):
+ VectorTestCase.__init__(self, methodName)
+ self.typeStr = "uint"
+ self.typeCode = "I"
+
+######################################################################
+
+class longTestCase(VectorTestCase):
+ def __init__(self, methodName="runTest"):
+ VectorTestCase.__init__(self, methodName)
+ self.typeStr = "long"
+ self.typeCode = "l"
+
+######################################################################
+
+class ulongTestCase(VectorTestCase):
+ def __init__(self, methodName="runTest"):
+ VectorTestCase.__init__(self, methodName)
+ self.typeStr = "ulong"
+ self.typeCode = "L"
+
+######################################################################
+
+class longLongTestCase(VectorTestCase):
+ def __init__(self, methodName="runTest"):
+ VectorTestCase.__init__(self, methodName)
+ self.typeStr = "longLong"
+ self.typeCode = "q"
+
+######################################################################
+
+class ulongLongTestCase(VectorTestCase):
+ def __init__(self, methodName="runTest"):
+ VectorTestCase.__init__(self, methodName)
+ self.typeStr = "ulongLong"
+ self.typeCode = "Q"
+
+######################################################################
+
+class floatTestCase(VectorTestCase):
+ def __init__(self, methodName="runTest"):
+ VectorTestCase.__init__(self, methodName)
+ self.typeStr = "float"
+ self.typeCode = "f"
+
+######################################################################
+
+class doubleTestCase(VectorTestCase):
+ def __init__(self, methodName="runTest"):
+ VectorTestCase.__init__(self, methodName)
+ self.typeStr = "double"
+ self.typeCode = "d"
+
+######################################################################
+
+if __name__ == "__main__":
+
+ # Build the test suite
+ suite = unittest.TestSuite()
+ suite.addTest(unittest.makeSuite( scharTestCase))
+ suite.addTest(unittest.makeSuite( ucharTestCase))
+ suite.addTest(unittest.makeSuite( shortTestCase))
+ suite.addTest(unittest.makeSuite( ushortTestCase))
+ suite.addTest(unittest.makeSuite( intTestCase))
+ suite.addTest(unittest.makeSuite( uintTestCase))
+ suite.addTest(unittest.makeSuite( longTestCase))
+ suite.addTest(unittest.makeSuite( ulongTestCase))
+ suite.addTest(unittest.makeSuite( longLongTestCase))
+ suite.addTest(unittest.makeSuite(ulongLongTestCase))
+ suite.addTest(unittest.makeSuite( floatTestCase))
+ suite.addTest(unittest.makeSuite( doubleTestCase))
+
+ # Execute the test suite
+ print "Testing 1D Functions of Module Vector"
+ print "NumPy version", N.__version__
+ print
+ result = unittest.TextTestRunner(verbosity=2).run(suite)
+ sys.exit(len(result.errors) + len(result.failures))
diff --git a/numpy/doc/swig/testing.html b/numpy/doc/swig/testing.html
new file mode 100644
index 000000000..3622550df
--- /dev/null
+++ b/numpy/doc/swig/testing.html
@@ -0,0 +1,482 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+<meta name="generator" content="Docutils 0.4: http://docutils.sourceforge.net/" />
+<title>Testing the numpy.i Typemaps</title>
+<meta name="author" content="Bill Spotz" />
+<meta name="date" content="6 April, 2007" />
+<style type="text/css">
+
+/*
+:Author: David Goodger
+:Contact: goodger@users.sourceforge.net
+:Date: $Date: 2005-12-18 01:56:14 +0100 (Sun, 18 Dec 2005) $
+:Revision: $Revision: 4224 $
+:Copyright: This stylesheet has been placed in the public domain.
+
+Default cascading style sheet for the HTML output of Docutils.
+
+See http://docutils.sf.net/docs/howto/html-stylesheets.html for how to
+customize this style sheet.
+*/
+
+/* used to remove borders from tables and images */
+.borderless, table.borderless td, table.borderless th {
+ border: 0 }
+
+table.borderless td, table.borderless th {
+ /* Override padding for "table.docutils td" with "! important".
+ The right padding separates the table cells. */
+ padding: 0 0.5em 0 0 ! important }
+
+.first {
+ /* Override more specific margin styles with "! important". */
+ margin-top: 0 ! important }
+
+.last, .with-subtitle {
+ margin-bottom: 0 ! important }
+
+.hidden {
+ display: none }
+
+a.toc-backref {
+ text-decoration: none ;
+ color: black }
+
+blockquote.epigraph {
+ margin: 2em 5em ; }
+
+dl.docutils dd {
+ margin-bottom: 0.5em }
+
+/* Uncomment (and remove this text!) to get bold-faced definition list terms
+dl.docutils dt {
+ font-weight: bold }
+*/
+
+div.abstract {
+ margin: 2em 5em }
+
+div.abstract p.topic-title {
+ font-weight: bold ;
+ text-align: center }
+
+div.admonition, div.attention, div.caution, div.danger, div.error,
+div.hint, div.important, div.note, div.tip, div.warning {
+ margin: 2em ;
+ border: medium outset ;
+ padding: 1em }
+
+div.admonition p.admonition-title, div.hint p.admonition-title,
+div.important p.admonition-title, div.note p.admonition-title,
+div.tip p.admonition-title {
+ font-weight: bold ;
+ font-family: sans-serif }
+
+div.attention p.admonition-title, div.caution p.admonition-title,
+div.danger p.admonition-title, div.error p.admonition-title,
+div.warning p.admonition-title {
+ color: red ;
+ font-weight: bold ;
+ font-family: sans-serif }
+
+/* Uncomment (and remove this text!) to get reduced vertical space in
+ compound paragraphs.
+div.compound .compound-first, div.compound .compound-middle {
+ margin-bottom: 0.5em }
+
+div.compound .compound-last, div.compound .compound-middle {
+ margin-top: 0.5em }
+*/
+
+div.dedication {
+ margin: 2em 5em ;
+ text-align: center ;
+ font-style: italic }
+
+div.dedication p.topic-title {
+ font-weight: bold ;
+ font-style: normal }
+
+div.figure {
+ margin-left: 2em ;
+ margin-right: 2em }
+
+div.footer, div.header {
+ clear: both;
+ font-size: smaller }
+
+div.line-block {
+ display: block ;
+ margin-top: 1em ;
+ margin-bottom: 1em }
+
+div.line-block div.line-block {
+ margin-top: 0 ;
+ margin-bottom: 0 ;
+ margin-left: 1.5em }
+
+div.sidebar {
+ margin-left: 1em ;
+ border: medium outset ;
+ padding: 1em ;
+ background-color: #ffffee ;
+ width: 40% ;
+ float: right ;
+ clear: right }
+
+div.sidebar p.rubric {
+ font-family: sans-serif ;
+ font-size: medium }
+
+div.system-messages {
+ margin: 5em }
+
+div.system-messages h1 {
+ color: red }
+
+div.system-message {
+ border: medium outset ;
+ padding: 1em }
+
+div.system-message p.system-message-title {
+ color: red ;
+ font-weight: bold }
+
+div.topic {
+ margin: 2em }
+
+h1.section-subtitle, h2.section-subtitle, h3.section-subtitle,
+h4.section-subtitle, h5.section-subtitle, h6.section-subtitle {
+ margin-top: 0.4em }
+
+h1.title {
+ text-align: center }
+
+h2.subtitle {
+ text-align: center }
+
+hr.docutils {
+ width: 75% }
+
+img.align-left {
+ clear: left }
+
+img.align-right {
+ clear: right }
+
+ol.simple, ul.simple {
+ margin-bottom: 1em }
+
+ol.arabic {
+ list-style: decimal }
+
+ol.loweralpha {
+ list-style: lower-alpha }
+
+ol.upperalpha {
+ list-style: upper-alpha }
+
+ol.lowerroman {
+ list-style: lower-roman }
+
+ol.upperroman {
+ list-style: upper-roman }
+
+p.attribution {
+ text-align: right ;
+ margin-left: 50% }
+
+p.caption {
+ font-style: italic }
+
+p.credits {
+ font-style: italic ;
+ font-size: smaller }
+
+p.label {
+ white-space: nowrap }
+
+p.rubric {
+ font-weight: bold ;
+ font-size: larger ;
+ color: maroon ;
+ text-align: center }
+
+p.sidebar-title {
+ font-family: sans-serif ;
+ font-weight: bold ;
+ font-size: larger }
+
+p.sidebar-subtitle {
+ font-family: sans-serif ;
+ font-weight: bold }
+
+p.topic-title {
+ font-weight: bold }
+
+pre.address {
+ margin-bottom: 0 ;
+ margin-top: 0 ;
+ font-family: serif ;
+ font-size: 100% }
+
+pre.literal-block, pre.doctest-block {
+ margin-left: 2em ;
+ margin-right: 2em ;
+ background-color: #eeeeee }
+
+span.classifier {
+ font-family: sans-serif ;
+ font-style: oblique }
+
+span.classifier-delimiter {
+ font-family: sans-serif ;
+ font-weight: bold }
+
+span.interpreted {
+ font-family: sans-serif }
+
+span.option {
+ white-space: nowrap }
+
+span.pre {
+ white-space: pre }
+
+span.problematic {
+ color: red }
+
+span.section-subtitle {
+ /* font-size relative to parent (h1..h6 element) */
+ font-size: 80% }
+
+table.citation {
+ border-left: solid 1px gray;
+ margin-left: 1px }
+
+table.docinfo {
+ margin: 2em 4em }
+
+table.docutils {
+ margin-top: 0.5em ;
+ margin-bottom: 0.5em }
+
+table.footnote {
+ border-left: solid 1px black;
+ margin-left: 1px }
+
+table.docutils td, table.docutils th,
+table.docinfo td, table.docinfo th {
+ padding-left: 0.5em ;
+ padding-right: 0.5em ;
+ vertical-align: top }
+
+table.docutils th.field-name, table.docinfo th.docinfo-name {
+ font-weight: bold ;
+ text-align: left ;
+ white-space: nowrap ;
+ padding-left: 0 }
+
+h1 tt.docutils, h2 tt.docutils, h3 tt.docutils,
+h4 tt.docutils, h5 tt.docutils, h6 tt.docutils {
+ font-size: 100% }
+
+tt.docutils {
+ background-color: #eeeeee }
+
+ul.auto-toc {
+ list-style-type: none }
+
+</style>
+</head>
+<body>
+<div class="document" id="testing-the-numpy-i-typemaps">
+<h1 class="title">Testing the numpy.i Typemaps</h1>
+<table class="docinfo" frame="void" rules="none">
+<col class="docinfo-name" />
+<col class="docinfo-content" />
+<tbody valign="top">
+<tr><th class="docinfo-name">Author:</th>
+<td>Bill Spotz</td></tr>
+<tr class="field"><th class="docinfo-name">Institution:</th><td class="field-body">Sandia National Laboratories</td>
+</tr>
+<tr><th class="docinfo-name">Date:</th>
+<td>6 April, 2007</td></tr>
+</tbody>
+</table>
+<div class="contents topic">
+<p class="topic-title first"><a id="contents" name="contents">Contents</a></p>
+<ul class="simple">
+<li><a class="reference" href="#introduction" id="id1" name="id1">Introduction</a></li>
+<li><a class="reference" href="#testing-organization" id="id2" name="id2">Testing Organization</a></li>
+<li><a class="reference" href="#testing-header-files" id="id3" name="id3">Testing Header Files</a></li>
+<li><a class="reference" href="#testing-source-files" id="id4" name="id4">Testing Source Files</a></li>
+<li><a class="reference" href="#testing-swig-interface-files" id="id5" name="id5">Testing SWIG Interface Files</a></li>
+<li><a class="reference" href="#testing-python-scripts" id="id6" name="id6">Testing Python Scripts</a></li>
+</ul>
+</div>
+<div class="section">
+<h1><a class="toc-backref" href="#id1" id="introduction" name="introduction">Introduction</a></h1>
+<p>Writing tests for the <tt class="docutils literal"><span class="pre">numpy.i</span></tt> <a class="reference" href="http://www.swig.org">SWIG</a>
+interface file is a combinatorial headache. At present, 12 different
+data types are supported, each with 23 different argument signatures,
+for a total of 276 typemaps supported &quot;out of the box&quot;. Each of these
+typemaps, in turn, might require several unit tests in order to verify
+expected behavior for both proper and improper inputs. Currently,
+this results in 1,020 individual unit tests that are performed when
+<tt class="docutils literal"><span class="pre">make</span> <span class="pre">test</span></tt> is run in the <tt class="docutils literal"><span class="pre">numpy/docs/swig</span></tt> subdirectory.</p>
+<p>To facilitate this many similar unit tests, some high-level
+programming techniques are employed, including C and <a class="reference" href="http://www.swig.org">SWIG</a> macros,
+as well as <a class="reference" href="http://www.python.org">python</a> inheritance. The
+purpose of this document is to describe the testing infrastructure
+employed to verify that the <tt class="docutils literal"><span class="pre">numpy.i</span></tt> typemaps are working as
+expected.</p>
+</div>
+<div class="section">
+<h1><a class="toc-backref" href="#id2" id="testing-organization" name="testing-organization">Testing Organization</a></h1>
+<p>There are three indepedent testing frameworks supported, for one-,
+two-, and three-dimensional arrays respectively. For one-dimensional
+arrays, there are two C++ files, a header and a source, named:</p>
+<pre class="literal-block">
+Vector.h
+Vector.cxx
+</pre>
+<p>that contain prototypes and code for a variety of functions that have
+one-dimensional arrays as function arguments. The file:</p>
+<pre class="literal-block">
+Vector.i
+</pre>
+<p>is a <a class="reference" href="http://www.swig.org">SWIG</a> interface file that defines a python module <tt class="docutils literal"><span class="pre">Vector</span></tt>
+that wraps the functions in <tt class="docutils literal"><span class="pre">Vector.h</span></tt> while utilizing the typemaps
+in <tt class="docutils literal"><span class="pre">numpy.i</span></tt> to correctly handle the C arrays.</p>
+<p>The <tt class="docutils literal"><span class="pre">Makefile</span></tt> calls <tt class="docutils literal"><span class="pre">swig</span></tt> to generate <tt class="docutils literal"><span class="pre">Vector.py</span></tt> and
+<tt class="docutils literal"><span class="pre">Vector_wrap.cxx</span></tt>, and also executes the <tt class="docutils literal"><span class="pre">setup.py</span></tt> script that
+compiles <tt class="docutils literal"><span class="pre">Vector_wrap.cxx</span></tt> and links together the extension module
+<tt class="docutils literal"><span class="pre">_Vector.so</span></tt> or <tt class="docutils literal"><span class="pre">_Vector.dylib</span></tt>, depending on the platform. This
+extension module and the proxy file <tt class="docutils literal"><span class="pre">Vector.py</span></tt> are both placed in a
+subdirectory under the <tt class="docutils literal"><span class="pre">build</span></tt> directory.</p>
+<p>The actual testing takes place with a <a class="reference" href="http://www.python.org">python</a> script named:</p>
+<pre class="literal-block">
+testVector.py
+</pre>
+<p>that uses the standard <a class="reference" href="http://www.python.org">python</a> library module <tt class="docutils literal"><span class="pre">unittest</span></tt>, which
+performs several tests of each function defined in <tt class="docutils literal"><span class="pre">Vector.h</span></tt> for
+each data type supported.</p>
+<p>Two-dimensional arrays are tested in exactly the same manner. The
+above description applies, but with <tt class="docutils literal"><span class="pre">Matrix</span></tt> substituted for
+<tt class="docutils literal"><span class="pre">Vector</span></tt>. For three-dimensional tests, substitute <tt class="docutils literal"><span class="pre">Tensor</span></tt> for
+<tt class="docutils literal"><span class="pre">Vector</span></tt>. For the descriptions that follow, we will reference the
+<tt class="docutils literal"><span class="pre">Vector</span></tt> tests, but the same information applies to <tt class="docutils literal"><span class="pre">Matrix</span></tt> and
+<tt class="docutils literal"><span class="pre">Tensor</span></tt> tests.</p>
+<p>The command <tt class="docutils literal"><span class="pre">make</span> <span class="pre">test</span></tt> will ensure that all of the test software is
+built and then run all three test scripts.</p>
+</div>
+<div class="section">
+<h1><a class="toc-backref" href="#id3" id="testing-header-files" name="testing-header-files">Testing Header Files</a></h1>
+<p><tt class="docutils literal"><span class="pre">Vector.h</span></tt> is a C++ header file that defines a C macro called
+<tt class="docutils literal"><span class="pre">TEST_FUNC_PROTOS</span></tt> that takes two arguments: <tt class="docutils literal"><span class="pre">TYPE</span></tt>, which is a
+data type name such as <tt class="docutils literal"><span class="pre">unsigned</span> <span class="pre">int</span></tt>; and <tt class="docutils literal"><span class="pre">SNAME</span></tt>, which is a
+short name for the same data type with no spaces, e.g. <tt class="docutils literal"><span class="pre">uint</span></tt>. This
+macro defines several function prototypes that have the prefix
+<tt class="docutils literal"><span class="pre">SNAME</span></tt> and have at least one argument that is an array of type
+<tt class="docutils literal"><span class="pre">TYPE</span></tt>. Those functions that have return arguments return a
+<tt class="docutils literal"><span class="pre">TYPE</span></tt> value.</p>
+<p><tt class="docutils literal"><span class="pre">TEST_FUNC_PROTOS</span></tt> is then implemented for all of the data types
+supported by <tt class="docutils literal"><span class="pre">numpy.i</span></tt>:</p>
+<blockquote>
+<ul class="simple">
+<li><tt class="docutils literal"><span class="pre">signed</span> <span class="pre">char</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">unsigned</span> <span class="pre">char</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">short</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">unsigned</span> <span class="pre">short</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">int</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">unsigned</span> <span class="pre">int</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">long</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">unsigned</span> <span class="pre">long</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">long</span> <span class="pre">long</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">unsigned</span> <span class="pre">long</span> <span class="pre">long</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">float</span></tt></li>
+<li><tt class="docutils literal"><span class="pre">double</span></tt></li>
+</ul>
+</blockquote>
+</div>
+<div class="section">
+<h1><a class="toc-backref" href="#id4" id="testing-source-files" name="testing-source-files">Testing Source Files</a></h1>
+<p><tt class="docutils literal"><span class="pre">Vector.cxx</span></tt> is a C++ source file that implements compilable code
+for each of the function prototypes specified in <tt class="docutils literal"><span class="pre">Vector.h</span></tt>. It
+defines a C macro <tt class="docutils literal"><span class="pre">TEST_FUNCS</span></tt> that has the same arguments and works
+in the same way as <tt class="docutils literal"><span class="pre">TEST_FUNC_PROTOS</span></tt> does in <tt class="docutils literal"><span class="pre">Vector.h</span></tt>.
+<tt class="docutils literal"><span class="pre">TEST_FUNCS</span></tt> is implemented for each of the 12 data types as above.</p>
+</div>
+<div class="section">
+<h1><a class="toc-backref" href="#id5" id="testing-swig-interface-files" name="testing-swig-interface-files">Testing SWIG Interface Files</a></h1>
+<p><tt class="docutils literal"><span class="pre">Vector.i</span></tt> is a <a class="reference" href="http://www.swig.org">SWIG</a> interface file that defines python module
+<tt class="docutils literal"><span class="pre">Vector</span></tt>. It follows the conventions for using <tt class="docutils literal"><span class="pre">numpy.i</span></tt> as
+described in the <a class="reference" href="numpy_swig.html">numpy.i documentation</a>. It
+defines a <a class="reference" href="http://www.swig.org">SWIG</a> macro <tt class="docutils literal"><span class="pre">%apply_numpy_typemaps</span></tt> that has a single
+argument <tt class="docutils literal"><span class="pre">TYPE</span></tt>. It uses the <a class="reference" href="http://www.swig.org">SWIG</a> directive <tt class="docutils literal"><span class="pre">%apply</span></tt> as
+described in the <a class="reference" href="numpy_swig.html">numpy.i documentation</a> to apply the provided
+typemaps to the argument signatures found in <tt class="docutils literal"><span class="pre">Vector.h</span></tt>. This macro
+is then implemented for all of the data types supported by
+<tt class="docutils literal"><span class="pre">numpy.i</span></tt>. It then does a <tt class="docutils literal"><span class="pre">%include</span> <span class="pre">&quot;Vector.h&quot;</span></tt> to wrap all of
+the function prototypes in <tt class="docutils literal"><span class="pre">Vector.h</span></tt> using the typemaps in
+<tt class="docutils literal"><span class="pre">numpy.i</span></tt>.</p>
+</div>
+<div class="section">
+<h1><a class="toc-backref" href="#id6" id="testing-python-scripts" name="testing-python-scripts">Testing Python Scripts</a></h1>
+<p>After <tt class="docutils literal"><span class="pre">make</span></tt> is used to build the testing extension modules,
+<tt class="docutils literal"><span class="pre">testVector.py</span></tt> can be run to execute the tests. As with other
+scripts that use <tt class="docutils literal"><span class="pre">unittest</span></tt> to facilitate unit testing,
+<tt class="docutils literal"><span class="pre">testVector.py</span></tt> defines a class that inherits from
+<tt class="docutils literal"><span class="pre">unittest.TestCase</span></tt>:</p>
+<pre class="literal-block">
+class VectorTestCase(unittest.TestCase):
+</pre>
+<p>However, this class is not run directly. Rather, it serves as a base
+class to several other python classes, each one specific to a
+particular data type. The <tt class="docutils literal"><span class="pre">VectorTestCase</span></tt> class stores two strings
+for typing information:</p>
+<blockquote>
+<dl class="docutils">
+<dt><strong>self.typeStr</strong></dt>
+<dd>A string that matches one of the <tt class="docutils literal"><span class="pre">SNAME</span></tt> prefixes used in
+<tt class="docutils literal"><span class="pre">Vector.h</span></tt> and <tt class="docutils literal"><span class="pre">Vector.cxx</span></tt>. For example, <tt class="docutils literal"><span class="pre">&quot;double&quot;</span></tt>.</dd>
+<dt><strong>self.typeCode</strong></dt>
+<dd>A short (typically single-character) string that represents a
+data type in numpy and corresponds to <tt class="docutils literal"><span class="pre">self.typeStr</span></tt>. For
+example, if <tt class="docutils literal"><span class="pre">self.typeStr</span></tt> is <tt class="docutils literal"><span class="pre">&quot;double&quot;</span></tt>, then
+<tt class="docutils literal"><span class="pre">self.typeCode</span></tt> should be <tt class="docutils literal"><span class="pre">&quot;d&quot;</span></tt>.</dd>
+</dl>
+</blockquote>
+<p>Each test defined by the <tt class="docutils literal"><span class="pre">VectorTestCase</span></tt> class extracts the python
+function it is trying to test by accessing the <tt class="docutils literal"><span class="pre">Vector</span></tt> module's
+dictionary:</p>
+<pre class="literal-block">
+length = Vector.__dict__[self.typeStr + &quot;Length&quot;]
+</pre>
+<p>In the case of double precision tests, this will return the python
+function <tt class="docutils literal"><span class="pre">Vector.doubleLength</span></tt>.</p>
+<p>We then define a new test case class for each supported data type with
+a short definition such as:</p>
+<pre class="literal-block">
+class doubleTestCase(VectorTestCase):
+ def __init__(self, methodName=&quot;runTest&quot;):
+ VectorTestCase.__init__(self, methodName)
+ self.typeStr = &quot;double&quot;
+ self.typeCode = &quot;d&quot;
+</pre>
+<p>Each of these 12 classes is collected into a <tt class="docutils literal"><span class="pre">unittest.TestSuite</span></tt>,
+which is then executed. Errors and failures are summed together and
+returned as the exit argument. Any non-zero result indicates that at
+least one test did not pass.</p>
+</div>
+</div>
+<div class="footer">
+<hr class="footer" />
+Generated on: 2007-04-06 21:21 UTC.
+Generated by <a class="reference" href="http://docutils.sourceforge.net/">Docutils</a> from <a class="reference" href="http://docutils.sourceforge.net/rst.html">reStructuredText</a> source.
+
+</div>
+</body>
+</html>
diff --git a/numpy/doc/swig/testing.pdf b/numpy/doc/swig/testing.pdf
new file mode 100644
index 000000000..57af9b6fd
--- /dev/null
+++ b/numpy/doc/swig/testing.pdf
Binary files differ
diff --git a/numpy/doc/swig/testing.txt b/numpy/doc/swig/testing.txt
new file mode 100644
index 000000000..bfd5218e8
--- /dev/null
+++ b/numpy/doc/swig/testing.txt
@@ -0,0 +1,173 @@
+============================
+Testing the numpy.i Typemaps
+============================
+
+:Author: Bill Spotz
+:Institution: Sandia National Laboratories
+:Date: 6 April, 2007
+
+.. contents::
+
+Introduction
+============
+
+Writing tests for the ``numpy.i`` `SWIG <http://www.swig.org>`_
+interface file is a combinatorial headache. At present, 12 different
+data types are supported, each with 23 different argument signatures,
+for a total of 276 typemaps supported "out of the box". Each of these
+typemaps, in turn, might require several unit tests in order to verify
+expected behavior for both proper and improper inputs. Currently,
+this results in 1,020 individual unit tests that are performed when
+``make test`` is run in the ``numpy/docs/swig`` subdirectory.
+
+To facilitate this many similar unit tests, some high-level
+programming techniques are employed, including C and `SWIG`_ macros,
+as well as `python <http://www.python.org>`_ inheritance. The
+purpose of this document is to describe the testing infrastructure
+employed to verify that the ``numpy.i`` typemaps are working as
+expected.
+
+Testing Organization
+====================
+
+There are three indepedent testing frameworks supported, for one-,
+two-, and three-dimensional arrays respectively. For one-dimensional
+arrays, there are two C++ files, a header and a source, named::
+
+ Vector.h
+ Vector.cxx
+
+that contain prototypes and code for a variety of functions that have
+one-dimensional arrays as function arguments. The file::
+
+ Vector.i
+
+is a `SWIG`_ interface file that defines a python module ``Vector``
+that wraps the functions in ``Vector.h`` while utilizing the typemaps
+in ``numpy.i`` to correctly handle the C arrays.
+
+The ``Makefile`` calls ``swig`` to generate ``Vector.py`` and
+``Vector_wrap.cxx``, and also executes the ``setup.py`` script that
+compiles ``Vector_wrap.cxx`` and links together the extension module
+``_Vector.so`` or ``_Vector.dylib``, depending on the platform. This
+extension module and the proxy file ``Vector.py`` are both placed in a
+subdirectory under the ``build`` directory.
+
+The actual testing takes place with a `python`_ script named::
+
+ testVector.py
+
+that uses the standard `python`_ library module ``unittest``, which
+performs several tests of each function defined in ``Vector.h`` for
+each data type supported.
+
+Two-dimensional arrays are tested in exactly the same manner. The
+above description applies, but with ``Matrix`` substituted for
+``Vector``. For three-dimensional tests, substitute ``Tensor`` for
+``Vector``. For the descriptions that follow, we will reference the
+``Vector`` tests, but the same information applies to ``Matrix`` and
+``Tensor`` tests.
+
+The command ``make test`` will ensure that all of the test software is
+built and then run all three test scripts.
+
+Testing Header Files
+====================
+
+``Vector.h`` is a C++ header file that defines a C macro called
+``TEST_FUNC_PROTOS`` that takes two arguments: ``TYPE``, which is a
+data type name such as ``unsigned int``; and ``SNAME``, which is a
+short name for the same data type with no spaces, e.g. ``uint``. This
+macro defines several function prototypes that have the prefix
+``SNAME`` and have at least one argument that is an array of type
+``TYPE``. Those functions that have return arguments return a
+``TYPE`` value.
+
+``TEST_FUNC_PROTOS`` is then implemented for all of the data types
+supported by ``numpy.i``:
+
+ * ``signed char``
+ * ``unsigned char``
+ * ``short``
+ * ``unsigned short``
+ * ``int``
+ * ``unsigned int``
+ * ``long``
+ * ``unsigned long``
+ * ``long long``
+ * ``unsigned long long``
+ * ``float``
+ * ``double``
+
+Testing Source Files
+====================
+
+``Vector.cxx`` is a C++ source file that implements compilable code
+for each of the function prototypes specified in ``Vector.h``. It
+defines a C macro ``TEST_FUNCS`` that has the same arguments and works
+in the same way as ``TEST_FUNC_PROTOS`` does in ``Vector.h``.
+``TEST_FUNCS`` is implemented for each of the 12 data types as above.
+
+Testing SWIG Interface Files
+============================
+
+``Vector.i`` is a `SWIG`_ interface file that defines python module
+``Vector``. It follows the conventions for using ``numpy.i`` as
+described in the `numpy.i documentation <numpy_swig.html>`_. It
+defines a `SWIG`_ macro ``%apply_numpy_typemaps`` that has a single
+argument ``TYPE``. It uses the `SWIG`_ directive ``%apply`` as
+described in the `numpy.i documentation`_ to apply the provided
+typemaps to the argument signatures found in ``Vector.h``. This macro
+is then implemented for all of the data types supported by
+``numpy.i``. It then does a ``%include "Vector.h"`` to wrap all of
+the function prototypes in ``Vector.h`` using the typemaps in
+``numpy.i``.
+
+Testing Python Scripts
+======================
+
+After ``make`` is used to build the testing extension modules,
+``testVector.py`` can be run to execute the tests. As with other
+scripts that use ``unittest`` to facilitate unit testing,
+``testVector.py`` defines a class that inherits from
+``unittest.TestCase``::
+
+ class VectorTestCase(unittest.TestCase):
+
+However, this class is not run directly. Rather, it serves as a base
+class to several other python classes, each one specific to a
+particular data type. The ``VectorTestCase`` class stores two strings
+for typing information:
+
+ **self.typeStr**
+ A string that matches one of the ``SNAME`` prefixes used in
+ ``Vector.h`` and ``Vector.cxx``. For example, ``"double"``.
+
+ **self.typeCode**
+ A short (typically single-character) string that represents a
+ data type in numpy and corresponds to ``self.typeStr``. For
+ example, if ``self.typeStr`` is ``"double"``, then
+ ``self.typeCode`` should be ``"d"``.
+
+Each test defined by the ``VectorTestCase`` class extracts the python
+function it is trying to test by accessing the ``Vector`` module's
+dictionary::
+
+ length = Vector.__dict__[self.typeStr + "Length"]
+
+In the case of double precision tests, this will return the python
+function ``Vector.doubleLength``.
+
+We then define a new test case class for each supported data type with
+a short definition such as::
+
+ class doubleTestCase(VectorTestCase):
+ def __init__(self, methodName="runTest"):
+ VectorTestCase.__init__(self, methodName)
+ self.typeStr = "double"
+ self.typeCode = "d"
+
+Each of these 12 classes is collected into a ``unittest.TestSuite``,
+which is then executed. Errors and failures are summed together and
+returned as the exit argument. Any non-zero result indicates that at
+least one test did not pass.
diff --git a/numpy/doc/ufuncs.txt b/numpy/doc/ufuncs.txt
new file mode 100644
index 000000000..345aa0a72
--- /dev/null
+++ b/numpy/doc/ufuncs.txt
@@ -0,0 +1,101 @@
+
+BUFFERED General Ufunc explanation:
+
+Note: This was implemented already, but the notes are kept here for historical
+ and explanatory purposes.
+
+We need to optimize the section of ufunc code that handles mixed-type
+and misbehaved arrays. In particular, we need to fix it so that items
+are not copied into the buffer if they don't have to be.
+
+Right now, all data is copied into the buffers (even scalars are copied
+multiple times into the buffers even if they are not going to be cast).
+
+Some benchmarks show that this results in a significant slow-down
+(factor of 4) over similar numarray code.
+
+The approach is therefore, to loop over the largest-dimension (just like
+the NO_BUFFER) portion of the code. All arrays will either have N or
+1 in this last dimension (or their would be a mis-match error). The
+buffer size is B.
+
+If N <= B (and only if needed), we copy the entire last-dimension into
+the buffer as fast as possible using the single-stride information.
+
+Also we only copy into output arrays if needed as well (other-wise the
+output arrays are used directly in the ufunc code).
+
+Call the function using the appropriate strides information from all the input
+arrays. Only set the strides to the element-size for arrays that will be copied.
+
+If N > B, then we have to do the above operation in a loop (with an extra loop
+at the end with a different buffer size).
+
+Both of these cases are handled with the following code:
+
+Compute N = quotient * B + remainder.
+ quotient = N / B # integer math
+ (store quotient + 1) as the number of innerloops
+ remainder = N % B # integer remainder
+
+On the inner-dimension we will have (quotient + 1) loops where
+the size of the inner function is B for all but the last when the niter size is
+remainder.
+
+So, the code looks very similar to NOBUFFER_LOOP except the inner loop is
+replaced with...
+
+for(k=0; i<quotient+1; k++) {
+ if (k==quotient+1) make itersize remainder size
+ copy only needed items to buffer.
+ swap input buffers if needed
+ cast input buffers if needed
+ call function()
+ cast outputs in buffers if needed
+ swap outputs in buffers if needed
+ copy only needed items back to output arrays.
+ update all data-pointers by strides*niter
+}
+
+
+Reference counting for OBJECT arrays:
+
+If there are object arrays involved then loop->obj gets set to 1. Then there are two cases:
+
+1) The loop function is an object loop:
+
+ Inputs:
+ - castbuf starts as NULL and then gets filled with new references.
+ - function gets called and doesn't alter the reference count in castbuf
+ - on the next iteration (next value of k), the casting function will
+ DECREF what is present in castbuf already and place a new object.
+
+ - At the end of the inner loop (for loop over k), the final new-references
+ in castbuf must be DECREF'd. If its a scalar then a single DECREF suffices
+ Otherwise, "bufsize" DECREF's are needed (unless there was only one
+ loop, then "remainder" DECREF's are needed).
+
+ Outputs:
+ - castbuf contains a new reference as the result of the function call. This
+ gets converted to the type of interest and. This new reference in castbuf
+ will be DECREF'd by later calls to the function. Thus, only after the
+ inner most loop do we need to DECREF the remaining references in castbuf.
+
+2) The loop function is of a different type:
+
+ Inputs:
+
+ - The PyObject input is copied over to buffer which receives a "borrowed"
+ reference. This reference is then used but not altered by the cast
+ call. Nothing needs to be done.
+
+ Outputs:
+
+ - The buffer[i] memory receives the PyObject input after the cast. This is
+ a new reference which will be "stolen" as it is copied over into memory.
+ The only problem is that what is presently in memory must be DECREF'd first.
+
+
+
+
+
diff --git a/numpy/dual.py b/numpy/dual.py
new file mode 100644
index 000000000..c47f8f820
--- /dev/null
+++ b/numpy/dual.py
@@ -0,0 +1,57 @@
+# This module should be used for functions both in numpy and scipy if
+# you want to use the numpy version if available but the scipy version
+# otherwise.
+# Usage --- from numpy.dual import fft, inv
+
+__all__ = ['fft','ifft','fftn','ifftn','fft2','ifft2',
+ 'norm','inv','svd','solve','det','eig','eigvals',
+ 'eigh','eigvalsh','lstsq', 'pinv','cholesky','i0']
+
+import numpy.linalg as linpkg
+import numpy.fft as fftpkg
+from numpy.lib import i0
+import sys
+
+
+fft = fftpkg.fft
+ifft = fftpkg.ifft
+fftn = fftpkg.fftn
+ifftn = fftpkg.ifftn
+fft2 = fftpkg.fft2
+ifft2 = fftpkg.ifft2
+
+norm = linpkg.norm
+inv = linpkg.inv
+svd = linpkg.svd
+solve = linpkg.solve
+det = linpkg.det
+eig = linpkg.eig
+eigvals = linpkg.eigvals
+eigh = linpkg.eigh
+eigvalsh = linpkg.eigvalsh
+lstsq = linpkg.lstsq
+pinv = linpkg.pinv
+cholesky = linpkg.cholesky
+
+_restore_dict = {}
+
+def register_func(name, func):
+ if name not in __all__:
+ raise ValueError, "%s not a dual function." % name
+ f = sys._getframe(0).f_globals
+ _restore_dict[name] = f[name]
+ f[name] = func
+
+def restore_func(name):
+ if name not in __all__:
+ raise ValueError, "%s not a dual function." % name
+ try:
+ val = _restore_dict[name]
+ except KeyError:
+ return
+ else:
+ sys._getframe(0).f_globals[name] = val
+
+def restore_all():
+ for name in _restore_dict.keys():
+ restore_func(name)
diff --git a/numpy/f2py/BUGS.txt b/numpy/f2py/BUGS.txt
new file mode 100644
index 000000000..ee08863bb
--- /dev/null
+++ b/numpy/f2py/BUGS.txt
@@ -0,0 +1,55 @@
+December 1, 2002:
+
+C FILE: STRING.F
+ SUBROUTINE FOO
+ END
+C END OF FILE STRING.F
+does not build with
+ f2py -c -m string string.f
+Cause: string is mapped to string_bn
+**************************************************************************
+August 16, 2001:
+1) re in Python 2.x is **three** times slower than the re in Python 1.5.
+**************************************************************************
+HP-UX B.10.20 A 9000/780:
+Fortran function returning character*(*) (id=7) ... failed(core dump)
+Fortran function returning logical*8 (id=21) ... expected .true. but got 0
+Callback function returning real (id=45) ... expected 34.56 but got 14087495680.0
+Callback function returning real*4 (id=46) ... expected 34.56 but got 14087495680.0
+Callback function returning logical*8 (id=55) ... expected .true. but got 0
+ C compiler: gcc ('gcc 2.x.x' 2.95.2) (from .f2py_get_compiler_CC)
+ Fortran compiler: g77 ('g77 2.x.x' 2.95.2) (from .f2py_get_compiler_FC)
+ Linker: ld ('HP-UX ld' 92453-07 linker linker ld B.10.24 961204) (from .f2py_get_compiler_LD)
+**************************************************************************
+Linux 2.2.13-0.9 #1 Thu Dec 9 17:03:57 EST 1999 alpha unknown:
+Fortran function returning character*(*) (id=7) ... expected 'abcdefgh' but got 'abcdefgh \201' (o?k)
+Callback function returning complex (id=48) ... failed(core dump)
+ Trying with -DF2PY_CB_RETURNCOMPLEX ... failed(core dump)
+Callback function returning complex*8 (id=49) ... failed(core dump)
+ Trying with -DF2PY_CB_RETURNCOMPLEX ... failed(core dump)
+Callback function returning complex*16 (id=50) ... failed(core dump)
+ Trying with -DF2PY_CB_RETURNCOMPLEX ... failed(core dump)
+ C compiler: cc ('Compaq C' V6.2-002) (from .f2py_get_compiler_CC)
+ Fortran compiler: fort ('Compaq Fortran' V1.0-920) (from .f2py_get_compiler_FC)
+ Linker: fort ('Compaq Fortran' V1.0-920) (from .f2py_get_compiler_LD)
+**************************************************************************
+Linux 2.2.14-15mdk #1 Tue Jan 4 22:24:20 CET 2000 i686 unknown:
+Callback function returning logical*8 (id=55) ... failed
+ C compiler: cc ('gcc 2.x.x' 2.95.2)
+ Fortran compiler: f90 ('Absoft F90' 3.0)
+ Linker: ld ('GNU ld' 2.9.5)
+**************************************************************************
+IRIX64 6.5 04151556 IP30:
+Testing integer, intent(inout) ...failed # not f2py problem
+Testing integer, intent(inout,out) ...failed
+Testing integer*1, intent(inout) ...failed
+Testing integer*1, intent(inout,out) ...failed
+Testing integer*8, intent(inout) ...failed
+Testing integer*8, intent(inout,out) ...failed
+cc-1140 cc: WARNING File = genmodule.c, Line = 114
+ A value of type "void *" cannot be used to initialize an entity of type
+ "void (*)()".
+ {"foo",-1,{-1},0,(char *)F_FUNC(foo,FOO),(void *)gen_foo,doc_gen_foo},
+ C compiler: cc ('MIPSpro 7 Compilers' 7.30)
+ Fortran compiler: f77 ('MIPSpro 7 Compilers' 7.30)
+ Linker: ld ('Linker for MIPSpro 7 Compilers' 7.30.)
diff --git a/numpy/f2py/Makefile b/numpy/f2py/Makefile
new file mode 100644
index 000000000..4e53ac471
--- /dev/null
+++ b/numpy/f2py/Makefile
@@ -0,0 +1,173 @@
+# Makefile for f2py2e
+#
+# Use GNU make for making.
+# $Revision: 1.46 $
+# $Date: 2005/01/30 17:22:55 $
+# Pearu Peterson <pearu@ioc.ee>
+
+PYTHON=python
+MAJOR=2
+F2PY2E_CVSROOT=:pserver:anonymous@cens.ioc.ee:/home/cvs
+SCIPY_CVSROOT=:pserver:anonymous@numpy.org:/home/cvsroot
+
+UPLOADCMD = scp -r
+UPLOADDIR = pearu@kev.ioc.ee:/net/cens/home/www/unsecure/projects/f2py2e/
+
+REV=`python -c 'from __version__ import *;print version'`
+SCIPY_DISTUTILS_REV=`cd numpy_distutils && $(PYTHON) -c 'from numpy_distutils_version import *;print numpy_distutils_version' && cd ..`
+
+SRC_FILES = F2PY-$(MAJOR)-latest.tar.gz numpy_distutils-latest.tar.gz F2PY-$(MAJOR)-latest.win32.exe numpy_distutils-latest.win32.exe
+
+HTML_FILES = index.html FAQ.html HISTORY.html THANKS.html TESTING.html OLDNEWS.html
+FAQ_DEPS = simple.f pytest.py pyforttest.pyf simple_session.dat
+README_DEPS = hello.f
+UG_FILES = index.html f2py_usersguide.pdf
+UG_FILES_DEP = $(shell cd docs/usersguide && ls *.{f,f90,dat,pyf,py})
+
+WWW_SRC_FILES = $(SRC_FILES:%=upload/www/$(MAJOR).x/%)
+WWW_WEB_FILES = $(HTML_FILES:%=upload/www/%) $(README_DEPS:%=upload/www/%)
+WWW_UG_FILES = $(UG_FILES:%=upload/www/usersguide/%) $(UG_FILES_DEP:%=upload/www/usersguide/%)
+
+TMP_WEB_FILES = $(HTML_FILES:%=upload/tmp/%) $(README_DEPS:%=upload/tmp/%)
+
+##############################################################################
+
+all:
+ @echo "Use 'make install' to install f2py"
+ @echo "Use 'make generate' to build f2py docs to upload/tmp"
+install:
+ $(PYTHON) setup.py install
+test:
+ cd tests && $(PYTHON) run_all.py
+
+##############################################################################
+# Create F2PY tar-balls
+##############################################################################
+f2py2e:
+ test -d f2py2e && (cd f2py2e && cvs -d $(F2PY2E_CVSROOT) -z7 update -Pd && cd -) || cvs -d $(F2PY2E_CVSROOT) checkout f2py2e
+
+upload/tmp/$(MAJOR).x/F2PY-$(MAJOR)-latest.tar.gz: f2py2e
+ cd f2py2e && python setup.py sdist -f
+ mkdir -p upload/tmp/$(MAJOR).x
+ cp f2py2e/dist/F2PY-$(REV).tar.gz upload/tmp/$(MAJOR).x
+ ln -sf F2PY-$(REV).tar.gz F2PY-$(MAJOR)-latest.tar.gz
+ mv F2PY-$(MAJOR)-latest.tar.gz upload/tmp/$(MAJOR).x
+upload/tmp/$(MAJOR).x/F2PY-$(MAJOR)-latest.win32.exe: f2py2e
+ cd f2py2e && python setup.py bdist_wininst
+ mkdir -p upload/tmp/$(MAJOR).x
+ cp f2py2e/dist/F2PY-$(REV).win32.exe upload/tmp/$(MAJOR).x
+ ln -sf F2PY-$(REV).win32.exe F2PY-$(MAJOR)-latest.win32.exe
+ mv F2PY-$(MAJOR)-latest.win32.exe upload/tmp/$(MAJOR).x
+f2py2e_latest: upload/tmp/$(MAJOR).x/F2PY-$(MAJOR)-latest.tar.gz upload/tmp/$(MAJOR).x/F2PY-$(MAJOR)-latest.win32.exe
+
+##############################################################################
+# Create Scipy_distutils tar-balls
+##############################################################################
+
+numpy_distutils:
+ test -d numpy_distutils && (cd numpy_distutils && cvs -d $(SCIPY_CVSROOT) -z7 update -Pd && cd -) || cvs -d $(SCIPY_CVSROOT) checkout numpy_distutils
+
+upload/tmp/$(MAJOR).x/numpy_distutils-latest.tar.gz: numpy_distutils
+ cd numpy_distutils && python setup.py sdist -f
+ mkdir -p upload/tmp/$(MAJOR).x
+ cp numpy_distutils/dist/numpy_distutils-$(SCIPY_DISTUTILS_REV).tar.gz upload/tmp/$(MAJOR).x
+ ln -sf numpy_distutils-$(SCIPY_DISTUTILS_REV).tar.gz numpy_distutils-latest.tar.gz
+ mv numpy_distutils-latest.tar.gz upload/tmp/$(MAJOR).x
+upload/tmp/$(MAJOR).x/numpy_distutils-latest.win32.exe: numpy_distutils
+ cd numpy_distutils && python setup.py bdist_wininst
+ mkdir -p upload/tmp/$(MAJOR).x
+ cp numpy_distutils/dist/numpy_distutils-$(SCIPY_DISTUTILS_REV).win32.exe upload/tmp/$(MAJOR).x
+ ln -sf numpy_distutils-$(SCIPY_DISTUTILS_REV).win32.exe numpy_distutils-latest.win32.exe
+ mv numpy_distutils-latest.win32.exe upload/tmp/$(MAJOR).x
+
+numpy_distutils_latest: upload/tmp/$(MAJOR).x/numpy_distutils-latest.tar.gz upload/tmp/$(MAJOR).x/numpy_distutils-latest.win32.exe
+
+latest: f2py2e_latest numpy_distutils_latest
+
+##############################################################################
+# Upload files.
+##############################################################################
+
+upload/www/$(MAJOR).x/F2PY-$(MAJOR)-latest.tar.gz: upload/tmp/$(MAJOR).x/F2PY-$(MAJOR)-latest.tar.gz
+ -mkdir -p `dirname $@`
+ cp -P upload/tmp/$(MAJOR).x/F2PY-{$(MAJOR)-latest,$(REV)}.tar.gz upload/www/$(MAJOR).x
+ $(UPLOADCMD) upload/tmp/$(MAJOR).x/F2PY-{$(MAJOR)-latest,$(REV)}.tar.gz $(UPLOADDIR)/$(MAJOR).x/
+upload/www/$(MAJOR).x/numpy_distutils-latest.tar.gz: upload/tmp/$(MAJOR).x/numpy_distutils-latest.tar.gz
+ -mkdir -p `dirname $@`
+ cp -P upload/tmp/$(MAJOR).x/numpy_distutils-{latest,$(SCIPY_DISTUTILS_REV)}.tar.gz upload/www/$(MAJOR).x/
+ $(UPLOADCMD) upload/tmp/$(MAJOR).x/numpy_distutils-{latest,$(SCIPY_DISTUTILS_REV)}.tar.gz $(UPLOADDIR)/$(MAJOR).x
+upload/www/$(MAJOR).x/F2PY-$(MAJOR)-latest.win32.exe: upload/tmp/$(MAJOR).x/F2PY-$(MAJOR)-latest.win32.exe
+ -mkdir -p `dirname $@`
+ cp -P upload/tmp/$(MAJOR).x/F2PY-{$(MAJOR)-latest,$(REV)}.win32.exe upload/www/$(MAJOR).x
+ $(UPLOADCMD) upload/tmp/$(MAJOR).x/F2PY-{$(MAJOR)-latest,$(REV)}.win32.exe $(UPLOADDIR)/$(MAJOR).x/
+upload/www/$(MAJOR).x/numpy_distutils-latest.win32.exe: upload/tmp/$(MAJOR).x/numpy_distutils-latest.win32.exe
+ -mkdir -p `dirname $@`
+ cp -P upload/tmp/$(MAJOR).x/numpy_distutils-{latest,$(SCIPY_DISTUTILS_REV)}.win32.exe upload/www/$(MAJOR).x
+ $(UPLOADCMD) upload/tmp/$(MAJOR).x/numpy_distutils-{latest,$(SCIPY_DISTUTILS_REV)}.win32.exe $(UPLOADDIR)/$(MAJOR).x/
+
+upload/tmp/usersguide/index.html: docs/usersguide/index.txt $(UG_FILES_DEP:%=upload/www/usersguide/%)
+ -mkdir -p upload/tmp/usersguide
+ rest2html $< $@
+upload/tmp/usersguide/f2py_usersguide.tex: docs/usersguide/index.txt $(UG_FILES_DEP:%=upload/www/usersguide/%)
+ -mkdir -p upload/tmp/usersguide
+ rest2latex $< $@
+upload/tmp/usersguide/f2py_usersguide.pdf: upload/tmp/usersguide/f2py_usersguide.tex
+ cd `dirname $@` && pdflatex `basename $<`
+upload/tmp/usersguide/%.f: docs/usersguide/%.f
+ -mkdir -p upload/tmp/usersguide
+ cp $< $@
+upload/tmp/usersguide/%.f90: docs/usersguide/%.f90
+ -mkdir -p upload/tmp/usersguide
+ cp $< $@
+upload/tmp/usersguide/%.dat: docs/usersguide/%.dat
+ -mkdir -p upload/tmp/usersguide
+ cp $< $@
+upload/tmp/usersguide/%.pyf: docs/usersguide/%.pyf
+ -mkdir -p upload/tmp/usersguide
+ cp $< $@
+upload/tmp/usersguide/%.py: docs/usersguide/%.py
+ -mkdir -p upload/tmp/usersguide
+ cp $< $@
+upload/www/usersguide/%: upload/tmp/usersguide/%
+ -mkdir -p `dirname $@`
+ cp -P $< $@
+ $(UPLOADCMD) $@ $(UPLOADDIR)/usersguide
+
+upload/tmp/FAQ.html: docs/FAQ.txt $(FAQ_DEPS:%=docs/%)
+ -mkdir -p upload/tmp
+ rest2html $< $@
+upload/tmp/index.html: docs/README.txt $(README_DEPS:%=docs/%)
+ -mkdir -p upload/tmp
+ rest2html $< $@
+upload/tmp/%.f: docs/%.f
+ -mkdir -p upload/tmp
+ cp $< $@
+upload/tmp/%.html: docs/%.txt
+ -mkdir -p upload/tmp
+ rest2html $< $@
+upload/www/%: upload/tmp/%
+ -mkdir -p `dirname $@`
+ cp -P $< $@
+ $(UPLOADCMD) $@ $(UPLOADDIR)/
+
+upload_web: $(WWW_WEB_FILES)
+upload_ug: $(WWW_UG_FILES)
+upload_src: $(WWW_SRC_FILES)
+upload: upload_src upload_ug upload_web
+
+generate_web: $(TMP_WEB_FILES)
+generate: generate_web
+
+##############################################################################
+# Clean up
+##############################################################################
+clean:
+ rm -f {tests/,tests/{f77,f90,mixed}/,docs/,docs/usersguide/,}*.{o,a,so,sl,pyc}
+ rm -f {tests/,tests/{f77,f90,mixed}/,docs/,docs/usersguide/,}*~
+distclean: clean
+ rm -f {tests/,src/,}*~
+ rm -f tests/*.{f,f90}
+ rm -rf dist {docs/,docs/usersguide/,}build f2py2e numpy_distutils upload
+ rm -f MANIFEST f2py?.? f2py
+
+.PHONY: install test
diff --git a/numpy/f2py/NEWS.txt b/numpy/f2py/NEWS.txt
new file mode 100644
index 000000000..a4a254405
--- /dev/null
+++ b/numpy/f2py/NEWS.txt
@@ -0,0 +1,2 @@
+
+Read docs/HISTORY.txt \ No newline at end of file
diff --git a/numpy/f2py/README.txt b/numpy/f2py/README.txt
new file mode 100644
index 000000000..ebe7e8c88
--- /dev/null
+++ b/numpy/f2py/README.txt
@@ -0,0 +1,5 @@
+======================================================================
+ F2PY - Fortran to Python Interface Generator
+======================================================================
+
+Read docs/README.txt
diff --git a/numpy/f2py/TODO.txt b/numpy/f2py/TODO.txt
new file mode 100644
index 000000000..093f0119e
--- /dev/null
+++ b/numpy/f2py/TODO.txt
@@ -0,0 +1,67 @@
+Determine fixed/free format Fortran 90 dialect from the
+contents of Fortran files. See numpy_distutils/command/build_flib.py.
+
+[DONE]
+========================================================================
+Wrapping F90 code as follows:
+
+subroutine foo
+print*,"In foo"
+end subroutine foo
+subroutine bar(func)
+ interface aa ! bug: this interface block is ignored
+ subroutine foo
+ end subroutine foo
+ end interface
+ !external foo
+ external func
+ call func(foo)
+end subroutine bar
+subroutine gun(a)
+ external a
+ call a()
+end subroutine gun
+subroutine fun
+ call bar(gun)
+end subroutine fun
+
+=========================================================================
+Users Guide needs major revision.
+
+[DONE]
+=========================================================================
+On Thu, 27 Sep 2001, José Luis Gómez Dans wrote:
+
+> Hi,
+> just one question: does f2py supporte derived types in F90 code?
+> Stuff like something%or and things like that.
+
+Not yet.
+
+=========================================================================
+Date: Tue, 28 Aug 2001 22:23:04 -0700
+From: Patrick LeGresley <plegresl@ape.stanford.edu>
+To: f2py-users@cens.ioc.ee
+Subject: [f2py] Strange initialization of allocatable arrays
+
+I've noticed an odd behavior when setting an allocatable, multidimensional
+array in a module. If the rank of the array is odd, the initialization is
+fine. However, if the rank is even only the first element of the array is
+set properly. See the attached sample code for example.
+
+=========================================================================
+On Wed, 22 Aug 2001, Patrick LeGresley wrote:
+
+> I've noticed that if a parameter is defined in terms of another parameter,
+> that the parameter is replaced not by a number but by another parameter
+> (try the attached subroutine for example). Is there any way to have f2py
+> automatically recognize the dependencies and generate a signature file
+> without parameter variables ?
+
+It is certainly possible. In fact, f2py has only a basic support for
+PARAMETER statements and it fails in your 'advanced' example to produce a
+robust signature file.
+I am sorry but you have to wait until I'll get back from my travel tour
+(somewhere in the middle of September) and get a chance to work on it.
+
+[DONE]
diff --git a/numpy/f2py/__init__.py b/numpy/f2py/__init__.py
new file mode 100644
index 000000000..09b0c6e65
--- /dev/null
+++ b/numpy/f2py/__init__.py
@@ -0,0 +1,42 @@
+#!/usr/bin/env python
+
+__all__ = ['run_main','compile','f2py_testing']
+
+import os
+import sys
+import commands
+
+from info import __doc__
+
+import f2py2e
+run_main = f2py2e.run_main
+main = f2py2e.main
+import f2py_testing
+
+def compile(source,
+ modulename = 'untitled',
+ extra_args = '',
+ verbose = 1,
+ source_fn = None
+ ):
+ ''' Build extension module from processing source with f2py.
+ Read the source of this function for more information.
+ '''
+ from numpy.distutils.exec_command import exec_command
+ import tempfile
+ if source_fn is None:
+ fname = os.path.join(tempfile.mktemp()+'.f')
+ else:
+ fname = source_fn
+
+ f = open(fname,'w')
+ f.write(source)
+ f.close()
+
+ args = ' -c -m %s %s %s'%(modulename,fname,extra_args)
+ c = '%s -c "import numpy.f2py as f2py2e;f2py2e.main()" %s' %(sys.executable,args)
+ s,o = exec_command(c)
+ if source_fn is None:
+ try: os.remove(fname)
+ except OSError: pass
+ return s
diff --git a/numpy/f2py/__version__.py b/numpy/f2py/__version__.py
new file mode 100644
index 000000000..88a39f378
--- /dev/null
+++ b/numpy/f2py/__version__.py
@@ -0,0 +1,8 @@
+major = 2
+
+try:
+ from __svn_version__ import version
+ version_info = (major, version)
+ version = '%s_%s' % version_info
+except ImportError:
+ version = str(major)
diff --git a/numpy/f2py/auxfuncs.py b/numpy/f2py/auxfuncs.py
new file mode 100644
index 000000000..b097cc3b0
--- /dev/null
+++ b/numpy/f2py/auxfuncs.py
@@ -0,0 +1,487 @@
+#!/usr/bin/env python
+"""
+
+Auxiliary functions for f2py2e.
+
+Copyright 1999,2000 Pearu Peterson all rights reserved,
+Pearu Peterson <pearu@ioc.ee>
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy (BSD style) LICENSE.
+
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+$Date: 2005/07/24 19:01:55 $
+Pearu Peterson
+"""
+__version__ = "$Revision: 1.65 $"[10:-1]
+
+import __version__
+f2py_version = __version__.version
+
+import pprint
+import sys,string,time,types,os
+import cfuncs
+
+
+errmess=sys.stderr.write
+#outmess=sys.stdout.write
+show=pprint.pprint
+
+options={}
+debugoptions=[]
+wrapfuncs = 1
+
+def outmess(t):
+ if options.get('verbose',1):
+ sys.stdout.write(t)
+
+def debugcapi(var): return 'capi' in debugoptions
+def _isstring(var):
+ return var.has_key('typespec') and var['typespec']=='character' and (not isexternal(var))
+def isstring(var):
+ return _isstring(var) and not isarray(var)
+def ischaracter(var):
+ return isstring(var) and not (var.has_key('charselector'))
+def isstringarray(var):
+ return isarray(var) and _isstring(var)
+def isarrayofstrings(var):
+ # leaving out '*' for now so that
+ # `character*(*) a(m)` and `character a(m,*)`
+ # are treated differently. Luckily `character**` is illegal.
+ return isstringarray(var) and var['dimension'][-1]=='(*)'
+def isarray(var): return var.has_key('dimension') and (not isexternal(var))
+def isscalar(var): return not (isarray(var) or isstring(var) or isexternal(var))
+def iscomplex(var):
+ return isscalar(var) and var.get('typespec') in ['complex','double complex']
+def islogical(var):
+ return isscalar(var) and var.get('typespec')=='logical'
+def isinteger(var):
+ return isscalar(var) and var.get('typespec')=='integer'
+def isreal(var):
+ return isscalar(var) and var.get('typespec')=='real'
+def get_kind(var):
+ try: return var['kindselector']['*']
+ except KeyError:
+ try: return var['kindselector']['kind']
+ except KeyError: pass
+def islong_long(var):
+ if not isscalar(var): return 0
+ if var.get('typespec') not in ['integer','logical']: return 0
+ return get_kind(var)=='8'
+def isunsigned_char(var):
+ if not isscalar(var): return 0
+ if var.get('typespec') != 'integer': return 0
+ return get_kind(var)=='-1'
+def isunsigned_short(var):
+ if not isscalar(var): return 0
+ if var.get('typespec') != 'integer': return 0
+ return get_kind(var)=='-2'
+def isunsigned(var):
+ if not isscalar(var): return 0
+ if var.get('typespec') != 'integer': return 0
+ return get_kind(var)=='-4'
+def isunsigned_long_long(var):
+ if not isscalar(var): return 0
+ if var.get('typespec') != 'integer': return 0
+ return get_kind(var)=='-8'
+def isdouble(var):
+ if not isscalar(var): return 0
+ if not var.get('typespec')=='real': return 0
+ return get_kind(var)=='8'
+def islong_double(var):
+ if not isscalar(var): return 0
+ if not var.get('typespec')=='real': return 0
+ return get_kind(var)=='16'
+def islong_complex(var):
+ if not iscomplex(var): return 0
+ return get_kind(var)=='32'
+
+def iscomplexarray(var): return isarray(var) and var.get('typespec') in ['complex','double complex']
+def isint1array(var): return isarray(var) and var.get('typespec')=='integer' \
+ and get_kind(var)=='1'
+def isunsigned_chararray(var): return isarray(var) and var.get('typespec')=='integer' and get_kind(var)=='-1'
+def isunsigned_shortarray(var): return isarray(var) and var.get('typespec')=='integer' and get_kind(var)=='-2'
+def isunsignedarray(var): return isarray(var) and var.get('typespec')=='integer' and get_kind(var)=='-4'
+def isunsigned_long_longarray(var): return isarray(var) and var.get('typespec')=='integer' and get_kind(var)=='-8'
+def isallocatable(var):
+ return var.has_key('attrspec') and 'allocatable' in var['attrspec']
+def ismutable(var): return not (not var.has_key('dimension') or isstring(var))
+def ismoduleroutine(rout): return rout.has_key('modulename')
+def ismodule(rout): return (rout.has_key('block') and 'module'==rout['block'])
+def isfunction(rout): return (rout.has_key('block') and 'function'==rout['block'])
+#def isfunction_wrap(rout):
+# return wrapfuncs and (iscomplexfunction(rout) or isstringfunction(rout)) and (not isexternal(rout))
+def isfunction_wrap(rout):
+ if isintent_c(rout): return 0
+ return wrapfuncs and isfunction(rout) and (not isexternal(rout))
+def issubroutine(rout): return (rout.has_key('block') and 'subroutine'==rout['block'])
+def isroutine(rout): return isfunction(rout) or issubroutine(rout)
+def islogicalfunction(rout):
+ if not isfunction(rout): return 0
+ if rout.has_key('result'): a=rout['result']
+ else: a=rout['name']
+ if rout['vars'].has_key(a): return islogical(rout['vars'][a])
+ return 0
+def islong_longfunction(rout):
+ if not isfunction(rout): return 0
+ if rout.has_key('result'): a=rout['result']
+ else: a=rout['name']
+ if rout['vars'].has_key(a): return islong_long(rout['vars'][a])
+ return 0
+def islong_doublefunction(rout):
+ if not isfunction(rout): return 0
+ if rout.has_key('result'): a=rout['result']
+ else: a=rout['name']
+ if rout['vars'].has_key(a): return islong_double(rout['vars'][a])
+ return 0
+def iscomplexfunction(rout):
+ if not isfunction(rout): return 0
+ if rout.has_key('result'): a=rout['result']
+ else: a=rout['name']
+ if rout['vars'].has_key(a): return iscomplex(rout['vars'][a])
+ return 0
+def iscomplexfunction_warn(rout):
+ if iscomplexfunction(rout):
+ outmess("""\
+ **************************************************************
+ Warning: code with a function returning complex value
+ may not work correctly with your Fortran compiler.
+ Run the following test before using it in your applications:
+ $(f2py install dir)/test-site/{b/runme_scalar,e/runme}
+ When using GNU gcc/g77 compilers, codes should work correctly.
+ **************************************************************\n""")
+ return 1
+ return 0
+def isstringfunction(rout):
+ if not isfunction(rout): return 0
+ if rout.has_key('result'): a=rout['result']
+ else: a=rout['name']
+ if rout['vars'].has_key(a): return isstring(rout['vars'][a])
+ return 0
+def hasexternals(rout): return rout.has_key('externals') and rout['externals']
+def isthreadsafe(rout): return rout.has_key('f2pyenhancements') and rout['f2pyenhancements'].has_key('threadsafe')
+def hasvariables(rout): return rout.has_key('vars') and rout['vars']
+def isoptional(var): return (var.has_key('attrspec') and 'optional' in var['attrspec'] and 'required' not in var['attrspec']) and isintent_nothide(var)
+def isexternal(var): return (var.has_key('attrspec') and 'external' in var['attrspec'])
+def isrequired(var): return not isoptional(var) and isintent_nothide(var)
+def isintent_in(var):
+ if not var.has_key('intent'): return 1
+ if 'hide' in var['intent']: return 0
+ if 'inplace' in var['intent']: return 0
+ if 'in' in var['intent']: return 1
+ if 'out' in var['intent']: return 0
+ if 'inout' in var['intent']: return 0
+ if 'outin' in var['intent']: return 0
+ return 1
+def isintent_inout(var): return var.has_key('intent') and ('inout' in var['intent'] or 'outin' in var['intent']) and 'in' not in var['intent'] and 'hide' not in var['intent'] and 'inplace' not in var['intent']
+def isintent_out(var):
+ return 'out' in var.get('intent',[])
+def isintent_hide(var): return (var.has_key('intent') and ('hide' in var['intent'] or ('out' in var['intent'] and 'in' not in var['intent'] and (not l_or(isintent_inout,isintent_inplace)(var)))))
+def isintent_nothide(var): return not isintent_hide(var)
+def isintent_c(var):
+ return 'c' in var.get('intent',[])
+# def isintent_f(var):
+# return not isintent_c(var)
+def isintent_cache(var):
+ return 'cache' in var.get('intent',[])
+def isintent_copy(var):
+ return 'copy' in var.get('intent',[])
+def isintent_overwrite(var):
+ return 'overwrite' in var.get('intent',[])
+def isintent_callback(var):
+ return 'callback' in var.get('intent',[])
+def isintent_inplace(var):
+ return 'inplace' in var.get('intent',[])
+def isintent_aux(var):
+ return 'aux' in var.get('intent',[])
+
+isintent_dict = {isintent_in:'INTENT_IN',isintent_inout:'INTENT_INOUT',
+ isintent_out:'INTENT_OUT',isintent_hide:'INTENT_HIDE',
+ isintent_cache:'INTENT_CACHE',
+ isintent_c:'INTENT_C',isoptional:'OPTIONAL',
+ isintent_inplace:'INTENT_INPLACE'
+ }
+
+def isprivate(var):
+ return var.has_key('attrspec') and 'private' in var['attrspec']
+
+def hasinitvalue(var): return var.has_key('=')
+def hasinitvalueasstring(var):
+ if not hasinitvalue(var): return 0
+ return var['='][0] in ['"',"'"]
+def hasnote(var):
+ return var.has_key('note')
+def hasresultnote(rout):
+ if not isfunction(rout): return 0
+ if rout.has_key('result'): a=rout['result']
+ else: a=rout['name']
+ if rout['vars'].has_key(a): return hasnote(rout['vars'][a])
+ return 0
+def hascommon(rout):
+ return rout.has_key('common')
+def containscommon(rout):
+ if hascommon(rout): return 1
+ if hasbody(rout):
+ for b in rout['body']:
+ if containscommon(b): return 1
+ return 0
+def containsmodule(block):
+ if ismodule(block): return 1
+ if not hasbody(block): return 0
+ for b in block['body']:
+ if containsmodule(b): return 1
+ return 0
+def hasbody(rout):
+ return rout.has_key('body')
+def hascallstatement(rout):
+ return getcallstatement(rout) is not None
+
+def istrue(var): return 1
+def isfalse(var): return 0
+
+class F2PYError(Exception):
+ pass
+
+class throw_error:
+ def __init__(self,mess):
+ self.mess = mess
+ def __call__(self,var):
+ mess = '\n\n var = %s\n Message: %s\n' % (var,self.mess)
+ raise F2PYError,mess
+
+def l_and(*f):
+ l,l2='lambda v',[]
+ for i in range(len(f)):
+ l='%s,f%d=f[%d]'%(l,i,i)
+ l2.append('f%d(v)'%(i))
+ return eval('%s:%s'%(l,string.join(l2,' and ')))
+def l_or(*f):
+ l,l2='lambda v',[]
+ for i in range(len(f)):
+ l='%s,f%d=f[%d]'%(l,i,i)
+ l2.append('f%d(v)'%(i))
+ return eval('%s:%s'%(l,string.join(l2,' or ')))
+def l_not(f):
+ return eval('lambda v,f=f:not f(v)')
+
+def isdummyroutine(rout):
+ try:
+ return rout['f2pyenhancements']['fortranname']==''
+ except KeyError:
+ return 0
+
+def getfortranname(rout):
+ try:
+ name = rout['f2pyenhancements']['fortranname']
+ if name=='':
+ raise KeyError
+ if not name:
+ errmess('Failed to use fortranname from %s\n'%(rout['f2pyenhancements']))
+ raise KeyError
+ except KeyError:
+ name = rout['name']
+ return name
+
+def getmultilineblock(rout,blockname,comment=1,counter=0):
+ try:
+ r = rout['f2pyenhancements'].get(blockname)
+ except KeyError:
+ return
+ if not r: return
+ if counter>0 and type(r) is type(''):
+ return
+ if type(r) is type([]):
+ if counter>=len(r): return
+ r = r[counter]
+ if r[:3]=="'''":
+ if comment:
+ r = '\t/* start ' + blockname + ' multiline ('+`counter`+') */\n' + r[3:]
+ else:
+ r = r[3:]
+ if r[-3:]=="'''":
+ if comment:
+ r = r[:-3] + '\n\t/* end multiline ('+`counter`+')*/'
+ else:
+ r = r[:-3]
+ else:
+ errmess("%s multiline block should end with `'''`: %s\n" \
+ % (blockname,repr(r)))
+ return r
+
+def getcallstatement(rout):
+ return getmultilineblock(rout,'callstatement')
+
+def getcallprotoargument(rout,cb_map={}):
+ r = getmultilineblock(rout,'callprotoargument',comment=0)
+ if r: return r
+ if hascallstatement(rout):
+ outmess('warning: callstatement is defined without callprotoargument\n')
+ return
+ from capi_maps import getctype
+ arg_types,arg_types2 = [],[]
+ if l_and(isstringfunction,l_not(isfunction_wrap))(rout):
+ arg_types.extend(['char*','size_t'])
+ for n in rout['args']:
+ var = rout['vars'][n]
+ if isintent_callback(var):
+ continue
+ if cb_map.has_key(n):
+ ctype = cb_map[n]+'_typedef'
+ else:
+ ctype = getctype(var)
+ if l_and(isintent_c,l_or(isscalar,iscomplex))(var):
+ pass
+ elif isstring(var):
+ pass
+ #ctype = 'void*'
+ else:
+ ctype = ctype+'*'
+ if isstring(var) or isarrayofstrings(var):
+ arg_types2.append('size_t')
+ arg_types.append(ctype)
+
+ proto_args = string.join(arg_types+arg_types2,',')
+ if not proto_args:
+ proto_args = 'void'
+ #print proto_args
+ return proto_args
+
+def getusercode(rout):
+ return getmultilineblock(rout,'usercode')
+def getusercode1(rout):
+ return getmultilineblock(rout,'usercode',counter=1)
+
+def getpymethoddef(rout):
+ return getmultilineblock(rout,'pymethoddef')
+
+def getargs(rout):
+ sortargs,args=[],[]
+ if rout.has_key('args'):
+ args=rout['args']
+ if rout.has_key('sortvars'):
+ for a in rout['sortvars']:
+ if a in args: sortargs.append(a)
+ for a in args:
+ if a not in sortargs:
+ sortargs.append(a)
+ else: sortargs=rout['args']
+ return args,sortargs
+
+def getargs2(rout):
+ sortargs,args=[],rout.get('args',[])
+ auxvars = [a for a in rout['vars'].keys() if isintent_aux(rout['vars'][a])\
+ and a not in args]
+ args = auxvars + args
+ if rout.has_key('sortvars'):
+ for a in rout['sortvars']:
+ if a in args: sortargs.append(a)
+ for a in args:
+ if a not in sortargs:
+ sortargs.append(a)
+ else: sortargs=auxvars + rout['args']
+ return args,sortargs
+
+def getrestdoc(rout):
+ if not rout.has_key('f2pymultilines'):
+ return None
+ k = None
+ if rout['block']=='python module':
+ k = rout['block'],rout['name']
+ return rout['f2pymultilines'].get(k,None)
+
+def gentitle(name):
+ l=(80-len(name)-6)/2
+ return '/*%s %s %s*/'%(l*'*',name,l*'*')
+def flatlist(l):
+ if type(l)==types.ListType:
+ return reduce(lambda x,y,f=flatlist:x+f(y),l,[])
+ return [l]
+def stripcomma(s):
+ if s and s[-1]==',': return s[:-1]
+ return s
+def replace(str,dict,defaultsep=''):
+ if type(dict)==types.ListType:
+ return map(lambda d,f=replace,sep=defaultsep,s=str:f(s,d,sep),dict)
+ if type(str)==types.ListType:
+ return map(lambda s,f=replace,sep=defaultsep,d=dict:f(s,d,sep),str)
+ for k in 2*dict.keys():
+ if k=='separatorsfor': continue
+ if dict.has_key('separatorsfor') and dict['separatorsfor'].has_key(k):
+ sep=dict['separatorsfor'][k]
+ else:
+ sep=defaultsep
+ if type(dict[k])==types.ListType:
+ str=string.replace(str,'#%s#'%(k),string.join(flatlist(dict[k]),sep))
+ else:
+ str=string.replace(str,'#%s#'%(k),dict[k])
+ return str
+
+def dictappend(rd,ar):
+ if type(ar)==types.ListType:
+ for a in ar: rd=dictappend(rd,a)
+ return rd
+ for k in ar.keys():
+ if k[0]=='_': continue
+ if rd.has_key(k):
+ if type(rd[k])==types.StringType: rd[k]=[rd[k]]
+ if type(rd[k])==types.ListType:
+ if type(ar[k])==types.ListType: rd[k]=rd[k]+ar[k]
+ else: rd[k].append(ar[k])
+ elif type(rd[k])==types.DictType:
+ if type(ar[k])==types.DictType:
+ if k=='separatorsfor':
+ for k1 in ar[k].keys():
+ if not rd[k].has_key(k1): rd[k][k1]=ar[k][k1]
+ else: rd[k]=dictappend(rd[k],ar[k])
+ else: rd[k]=ar[k]
+ return rd
+
+def applyrules(rules,dict,var={}):
+ ret={}
+ if type(rules)==types.ListType:
+ for r in rules:
+ rr=applyrules(r,dict,var)
+ ret=dictappend(ret,rr)
+ if rr.has_key('_break'): break
+ return ret
+ if rules.has_key('_check') and (not rules['_check'](var)): return ret
+ if rules.has_key('need'):
+ res = applyrules({'needs':rules['need']},dict,var)
+ if res.has_key('needs'):
+ cfuncs.append_needs(res['needs'])
+
+ for k in rules.keys():
+ if k=='separatorsfor': ret[k]=rules[k]; continue
+ if type(rules[k])==types.StringType:
+ ret[k]=replace(rules[k],dict)
+ elif type(rules[k])==types.ListType:
+ ret[k]=[]
+ for i in rules[k]:
+ ar=applyrules({k:i},dict,var)
+ if ar.has_key(k): ret[k].append(ar[k])
+ elif k[0]=='_':
+ continue
+ elif type(rules[k])==types.DictType:
+ ret[k]=[]
+ for k1 in rules[k].keys():
+ if type(k1)==types.FunctionType and k1(var):
+ if type(rules[k][k1])==types.ListType:
+ for i in rules[k][k1]:
+ if type(i)==types.DictType:
+ res=applyrules({'supertext':i},dict,var)
+ if res.has_key('supertext'): i=res['supertext']
+ else: i=''
+ ret[k].append(replace(i,dict))
+ else:
+ i=rules[k][k1]
+ if type(i)==types.DictType:
+ res=applyrules({'supertext':i},dict)
+ if res.has_key('supertext'): i=res['supertext']
+ else: i=''
+ ret[k].append(replace(i,dict))
+ else:
+ errmess('applyrules: ignoring rule %s.\n'%`rules[k]`)
+ if type(ret[k])==types.ListType:
+ if len(ret[k])==1: ret[k]=ret[k][0]
+ if ret[k]==[]: del ret[k]
+ return ret
diff --git a/numpy/f2py/capi_maps.py b/numpy/f2py/capi_maps.py
new file mode 100644
index 000000000..b57339cbb
--- /dev/null
+++ b/numpy/f2py/capi_maps.py
@@ -0,0 +1,728 @@
+#!/usr/bin/env python
+"""
+
+Copyright 1999,2000 Pearu Peterson all rights reserved,
+Pearu Peterson <pearu@ioc.ee>
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+$Date: 2005/05/06 10:57:33 $
+Pearu Peterson
+"""
+
+__version__ = "$Revision: 1.60 $"[10:-1]
+
+import __version__
+f2py_version = __version__.version
+
+import string,copy,re,os
+from auxfuncs import *
+from crackfortran import markoutercomma
+import cb_rules
+
+# Numarray and Numeric users should set this False
+using_newcore = True
+
+depargs=[]
+lcb_map={}
+lcb2_map={}
+# forced casting: mainly caused by the fact that Python or Numeric
+# C/APIs do not support the corresponding C types.
+c2py_map={'double':'float',
+ 'float':'float', # forced casting
+ 'long_double':'float', # forced casting
+ 'char':'int', # forced casting
+ 'signed_char':'int', # forced casting
+ 'unsigned_char':'int', # forced casting
+ 'short':'int', # forced casting
+ 'unsigned_short':'int', # forced casting
+ 'int':'int', # (forced casting)
+ 'long':'int',
+ 'long_long':'long',
+ 'unsigned':'int', # forced casting
+ 'complex_float':'complex', # forced casting
+ 'complex_double':'complex',
+ 'complex_long_double':'complex', # forced casting
+ 'string':'string',
+ }
+c2capi_map={'double':'PyArray_DOUBLE',
+ 'float':'PyArray_FLOAT',
+ 'long_double':'PyArray_DOUBLE', # forced casting
+ 'char':'PyArray_CHAR',
+ 'unsigned_char':'PyArray_UBYTE',
+ 'signed_char':'PyArray_SBYTE',
+ 'short':'PyArray_SHORT',
+ 'unsigned_short':'PyArray_USHORT',
+ 'int':'PyArray_INT',
+ 'unsigned':'PyArray_UINT',
+ 'long':'PyArray_LONG',
+ 'long_long':'PyArray_LONG', # forced casting
+ 'complex_float':'PyArray_CFLOAT',
+ 'complex_double':'PyArray_CDOUBLE',
+ 'complex_long_double':'PyArray_CDOUBLE', # forced casting
+ 'string':'PyArray_CHAR'}
+
+#These new maps aren't used anyhere yet, but should be by default
+# unless building numeric or numarray extensions.
+if using_newcore:
+ c2capi_map={'double':'PyArray_DOUBLE',
+ 'float':'PyArray_FLOAT',
+ 'long_double':'PyArray_LONGDOUBLE',
+ 'char':'PyArray_BYTE',
+ 'unsigned_char':'PyArray_UBYTE',
+ 'signed_char':'PyArray_BYTE',
+ 'short':'PyArray_SHORT',
+ 'unsigned_short':'PyArray_USHORT',
+ 'int':'PyArray_INT',
+ 'unsigned':'PyArray_UINT',
+ 'long':'PyArray_LONG',
+ 'unsigned_long':'PyArray_ULONG',
+ 'long_long':'PyArray_LONGLONG',
+ 'unsigned_long_long':'Pyarray_ULONGLONG',
+ 'complex_float':'PyArray_CFLOAT',
+ 'complex_double':'PyArray_CDOUBLE',
+ 'complex_long_double':'PyArray_CDOUBLE',
+ 'string':'PyArray_CHAR', # f2py 2e is not ready for PyArray_STRING (must set itemisize etc)
+ #'string':'PyArray_STRING'
+
+ }
+c2pycode_map={'double':'d',
+ 'float':'f',
+ 'long_double':'d', # forced casting
+ 'char':'1',
+ 'signed_char':'1',
+ 'unsigned_char':'b',
+ 'short':'s',
+ 'unsigned_short':'w',
+ 'int':'i',
+ 'unsigned':'u',
+ 'long':'l',
+ 'long_long':'L',
+ 'complex_float':'F',
+ 'complex_double':'D',
+ 'complex_long_double':'D', # forced casting
+ 'string':'c'
+ }
+if using_newcore:
+ c2pycode_map={'double':'d',
+ 'float':'f',
+ 'long_double':'g',
+ 'char':'b',
+ 'unsigned_char':'B',
+ 'signed_char':'b',
+ 'short':'h',
+ 'unsigned_short':'H',
+ 'int':'i',
+ 'unsigned':'I',
+ 'long':'l',
+ 'unsigned_long':'L',
+ 'long_long':'q',
+ 'unsigned_long_long':'Q',
+ 'complex_float':'F',
+ 'complex_double':'D',
+ 'complex_long_double':'G',
+ 'string':'S'}
+c2buildvalue_map={'double':'d',
+ 'float':'f',
+ 'char':'b',
+ 'signed_char':'b',
+ 'short':'h',
+ 'int':'i',
+ 'long':'l',
+ 'long_long':'L',
+ 'complex_float':'N',
+ 'complex_double':'N',
+ 'complex_long_double':'N',
+ 'string':'z'}
+if using_newcore:
+ #c2buildvalue_map=???
+ pass
+
+f2cmap_all={'real':{'':'float','4':'float','8':'double','12':'long_double','16':'long_double'},
+ 'integer':{'':'int','1':'signed_char','2':'short','4':'int','8':'long_long',
+ '-1':'unsigned_char','-2':'unsigned_short','-4':'unsigned',
+ '-8':'unsigned_long_long'},
+ 'complex':{'':'complex_float','8':'complex_float',
+ '16':'complex_double','24':'complex_long_double',
+ '32':'complex_long_double'},
+ 'complexkind':{'':'complex_float','4':'complex_float',
+ '8':'complex_double','12':'complex_long_double',
+ '16':'complex_long_double'},
+ 'logical':{'':'int','1':'char','2':'short','4':'int','8':'long_long'},
+ 'double complex':{'':'complex_double'},
+ 'double precision':{'':'double'},
+ 'byte':{'':'char'},
+ 'character':{'':'string'}
+ }
+
+if os.path.isfile('.f2py_f2cmap'):
+ # User defined additions to f2cmap_all.
+ # .f2py_f2cmap must contain a dictionary of dictionaries, only.
+ # For example, {'real':{'low':'float'}} means that Fortran 'real(low)' is
+ # interpreted as C 'float'.
+ # This feature is useful for F90/95 users if they use PARAMETERSs
+ # in type specifications.
+ try:
+ outmess('Reading .f2py_f2cmap ...\n')
+ f = open('.f2py_f2cmap','r')
+ d = eval(f.read(),{},{})
+ f.close()
+ for k,d1 in d.items():
+ for k1 in d1.keys():
+ d1[string.lower(k1)] = d1[k1]
+ d[string.lower(k)] = d[k]
+ for k in d.keys():
+ if not f2cmap_all.has_key(k): f2cmap_all[k]={}
+ for k1 in d[k].keys():
+ if c2py_map.has_key(d[k][k1]):
+ if f2cmap_all[k].has_key(k1):
+ outmess("\tWarning: redefinition of {'%s':{'%s':'%s'->'%s'}}\n"%(k,k1,f2cmap_all[k][k1],d[k][k1]))
+ f2cmap_all[k][k1] = d[k][k1]
+ outmess('\tMapping "%s(kind=%s)" to "%s"\n' % (k,k1,d[k][k1]))
+ else:
+ errmess("\tIgnoring map {'%s':{'%s':'%s'}}: '%s' must be in %s\n"%(k,k1,d[k][k1],d[k][k1],c2py_map.keys()))
+ outmess('Succesfully applied user defined changes from .f2py_f2cmap\n')
+ except:
+ errmess('Failed to apply user defined changes from .f2py_f2cmap. Skipping.\n')
+cformat_map={'double':'%g',
+ 'float':'%g',
+ 'long_double':'%Lg',
+ 'char':'%d',
+ 'signed_char':'%d',
+ 'unsigned_char':'%hhu',
+ 'short':'%hd',
+ 'unsigned_short':'%hu',
+ 'int':'%d',
+ 'unsigned':'%u',
+ 'long':'%ld',
+ 'unsigned_long':'%lu',
+ 'long_long':'%ld',
+ 'complex_float':'(%g,%g)',
+ 'complex_double':'(%g,%g)',
+ 'complex_long_double':'(%Lg,%Lg)',
+ 'string':'%s',
+ }
+
+############### Auxiliary functions
+def getctype(var):
+ """
+ Determines C type
+ """
+ ctype='void'
+ if isfunction(var):
+ if var.has_key('result'): a=var['result']
+ else: a=var['name']
+ if var['vars'].has_key(a): return getctype(var['vars'][a])
+ else: errmess('getctype: function %s has no return value?!\n'%a)
+ elif issubroutine(var):
+ return ctype
+ elif var.has_key('typespec') and f2cmap_all.has_key(string.lower(var['typespec'])):
+ typespec = string.lower(var['typespec'])
+ f2cmap=f2cmap_all[typespec]
+ ctype=f2cmap[''] # default type
+ if var.has_key('kindselector'):
+ if var['kindselector'].has_key('*'):
+ try:
+ ctype=f2cmap[var['kindselector']['*']]
+ except KeyError:
+ errmess('getctype: "%s %s %s" not supported.\n'%(var['typespec'],'*',var['kindselector']['*']))
+ elif var['kindselector'].has_key('kind'):
+ if f2cmap_all.has_key(typespec+'kind'):
+ f2cmap=f2cmap_all[typespec+'kind']
+ try:
+ ctype=f2cmap[var['kindselector']['kind']]
+ except KeyError:
+ if f2cmap_all.has_key(typespec):
+ f2cmap=f2cmap_all[typespec]
+ try:
+ ctype=f2cmap[str(var['kindselector']['kind'])]
+ except KeyError:
+ errmess('getctype: "%s(kind=%s)" not supported (use .f2py_f2cmap).\n'\
+ %(typespec,var['kindselector']['kind']))
+
+ else:
+ if not isexternal(var):
+ errmess('getctype: No C-type found in "%s", assuming void.\n'%var)
+ return ctype
+def getstrlength(var):
+ if isstringfunction(var):
+ if var.has_key('result'): a=var['result']
+ else: a=var['name']
+ if var['vars'].has_key(a): return getstrlength(var['vars'][a])
+ else: errmess('getstrlength: function %s has no return value?!\n'%a)
+ if not isstring(var):
+ errmess('getstrlength: expected a signature of a string but got: %s\n'%(`var`))
+ len='1'
+ if var.has_key('charselector'):
+ a=var['charselector']
+ if a.has_key('*'): len=a['*']
+ elif a.has_key('len'): len=a['len']
+ if re.match(r'\(\s*([*]|[:])\s*\)',len) or re.match(r'([*]|[:])',len):
+ #if len in ['(*)','*','(:)',':']:
+ if isintent_hide(var):
+ errmess('getstrlength:intent(hide): expected a string with defined length but got: %s\n'%(`var`))
+ len='-1'
+ return len
+def getarrdims(a,var,verbose=0):
+ global depargs
+ ret={}
+ if isstring(var) and not isarray(var):
+ ret['dims']=getstrlength(var)
+ ret['size']=ret['dims']
+ ret['rank']='1'
+ elif isscalar(var):
+ ret['size']='1'
+ ret['rank']='0'
+ ret['dims']=''
+ elif isarray(var):
+# if not isintent_c(var):
+# var['dimension'].reverse()
+ dim=copy.copy(var['dimension'])
+ ret['size']=string.join(dim,'*')
+ try: ret['size']=`eval(ret['size'])`
+ except: pass
+ ret['dims']=string.join(dim,',')
+ ret['rank']=`len(dim)`
+ ret['rank*[-1]']=`len(dim)*[-1]`[1:-1]
+ for i in range(len(dim)): # solve dim for dependecies
+ v=[]
+ if dim[i] in depargs: v=[dim[i]]
+ else:
+ for va in depargs:
+ if re.match(r'.*?\b%s\b.*'%va,dim[i]):
+ v.append(va)
+ for va in v:
+ if depargs.index(va)>depargs.index(a):
+ dim[i]='*'
+ break
+ ret['setdims'],i='',-1
+ for d in dim:
+ i=i+1
+ if d not in ['*',':','(*)','(:)']:
+ ret['setdims']='%s#varname#_Dims[%d]=%s,'%(ret['setdims'],i,d)
+ if ret['setdims']: ret['setdims']=ret['setdims'][:-1]
+ ret['cbsetdims'],i='',-1
+ for d in var['dimension']:
+ i=i+1
+ if d not in ['*',':','(*)','(:)']:
+ ret['cbsetdims']='%s#varname#_Dims[%d]=%s,'%(ret['cbsetdims'],i,d)
+ elif isintent_in(var):
+ outmess('getarrdims:warning: assumed shape array, using 0 instead of %r\n' \
+ % (d))
+ ret['cbsetdims']='%s#varname#_Dims[%d]=%s,'%(ret['cbsetdims'],i,0)
+ elif verbose :
+ errmess('getarrdims: If in call-back function: array argument %s must have bounded dimensions: got %s\n'%(`a`,`d`))
+ if ret['cbsetdims']: ret['cbsetdims']=ret['cbsetdims'][:-1]
+# if not isintent_c(var):
+# var['dimension'].reverse()
+ return ret
+def getpydocsign(a,var):
+ global lcb_map
+ if isfunction(var):
+ if var.has_key('result'): af=var['result']
+ else: af=var['name']
+ if var['vars'].has_key(af): return getpydocsign(af,var['vars'][af])
+ else: errmess('getctype: function %s has no return value?!\n'%af)
+ return '',''
+ sig,sigout=a,a
+ opt=''
+ if isintent_in(var): opt='input'
+ elif isintent_inout(var): opt='in/output'
+ out_a = a
+ if isintent_out(var):
+ for k in var['intent']:
+ if k[:4]=='out=':
+ out_a = k[4:]
+ break
+ init=''
+ ctype=getctype(var)
+
+ if hasinitvalue(var):
+ init,showinit=getinit(a,var)
+ init='= %s'%(showinit)
+ if isscalar(var):
+ if isintent_inout(var):
+ sig='%s :%s %s rank-0 array(%s,\'%s\')'%(a,init,opt,c2py_map[ctype],
+ c2pycode_map[ctype],)
+ else:
+ sig='%s :%s %s %s'%(a,init,opt,c2py_map[ctype])
+ sigout='%s : %s'%(out_a,c2py_map[ctype])
+ elif isstring(var):
+ if isintent_inout(var):
+ sig='%s :%s %s rank-0 array(string(len=%s),\'c\')'%(a,init,opt,getstrlength(var))
+ else:
+ sig='%s :%s %s string(len=%s)'%(a,init,opt,getstrlength(var))
+ sigout='%s : string(len=%s)'%(out_a,getstrlength(var))
+ elif isarray(var):
+ dim=var['dimension']
+ rank=`len(dim)`
+ sig='%s :%s %s rank-%s array(\'%s\') with bounds (%s)'%(a,init,opt,rank,
+ c2pycode_map[ctype],
+ string.join(dim,','))
+ if a==out_a:
+ sigout='%s : rank-%s array(\'%s\') with bounds (%s)'\
+ %(a,rank,c2pycode_map[ctype],string.join(dim,','))
+ else:
+ sigout='%s : rank-%s array(\'%s\') with bounds (%s) and %s storage'\
+ %(out_a,rank,c2pycode_map[ctype],string.join(dim,','),a)
+ elif isexternal(var):
+ ua=''
+ if lcb_map.has_key(a) and lcb2_map.has_key(lcb_map[a]) and lcb2_map[lcb_map[a]].has_key('argname'):
+ ua=lcb2_map[lcb_map[a]]['argname']
+ if not ua==a: ua=' => %s'%ua
+ else: ua=''
+ sig='%s : call-back function%s'%(a,ua)
+ sigout=sig
+ else:
+ errmess('getpydocsign: Could not resolve docsignature for "%s".\\n'%a)
+ return sig,sigout
+def getarrdocsign(a,var):
+ ctype=getctype(var)
+ if isstring(var) and (not isarray(var)):
+ sig='%s : rank-0 array(string(len=%s),\'c\')'%(a,getstrlength(var))
+ elif isscalar(var):
+ sig='%s : rank-0 array(%s,\'%s\')'%(a,c2py_map[ctype],
+ c2pycode_map[ctype],)
+ elif isarray(var):
+ dim=var['dimension']
+ rank=`len(dim)`
+ sig='%s : rank-%s array(\'%s\') with bounds (%s)'%(a,rank,
+ c2pycode_map[ctype],
+ string.join(dim,','))
+ return sig
+
+def getinit(a,var):
+ if isstring(var): init,showinit='""',"''"
+ else: init,showinit='',''
+ if hasinitvalue(var):
+ init=var['=']
+ showinit=init
+ if iscomplex(var) or iscomplexarray(var):
+ ret={}
+
+ try:
+ v = var["="]
+ if ',' in v:
+ ret['init.r'],ret['init.i']=string.split(markoutercomma(v[1:-1]),'@,@')
+ else:
+ v = eval(v,{},{})
+ ret['init.r'],ret['init.i']=str(v.real),str(v.imag)
+ except: raise 'sign2map: expected complex number `(r,i)\' but got `%s\' as initial value of %s.'%(init,`a`)
+ if isarray(var):
+ init='(capi_c.r=%s,capi_c.i=%s,capi_c)'%(ret['init.r'],ret['init.i'])
+ elif isstring(var):
+ if not init: init,showinit='""',"''"
+ if init[0]=="'":
+ init='"%s"'%(string.replace(init[1:-1],'"','\\"'))
+ if init[0]=='"': showinit="'%s'"%(init[1:-1])
+ return init,showinit
+
+def sign2map(a,var):
+ """
+ varname,ctype,atype
+ init,init.r,init.i,pytype
+ vardebuginfo,vardebugshowvalue,varshowvalue
+ varrfromat
+ intent
+ """
+ global lcb_map,cb_map
+ out_a = a
+ if isintent_out(var):
+ for k in var['intent']:
+ if k[:4]=='out=':
+ out_a = k[4:]
+ break
+ ret={'varname':a,'outvarname':out_a}
+ ret['ctype']=getctype(var)
+ intent_flags = []
+ for f,s in isintent_dict.items():
+ if f(var): intent_flags.append('F2PY_%s'%s)
+ if intent_flags:
+ #XXX: Evaluate intent_flags here.
+ ret['intent'] = string.join(intent_flags,'|')
+ else:
+ ret['intent'] = 'F2PY_INTENT_IN'
+ if isarray(var): ret['varrformat']='N'
+ elif c2buildvalue_map.has_key(ret['ctype']):
+ ret['varrformat']=c2buildvalue_map[ret['ctype']]
+ else: ret['varrformat']='O'
+ ret['init'],ret['showinit']=getinit(a,var)
+ if hasinitvalue(var) and iscomplex(var) and not isarray(var):
+ ret['init.r'],ret['init.i'] = string.split(markoutercomma(ret['init'][1:-1]),'@,@')
+ if isexternal(var):
+ ret['cbnamekey']=a
+ if lcb_map.has_key(a):
+ ret['cbname']=lcb_map[a]
+ ret['maxnofargs']=lcb2_map[lcb_map[a]]['maxnofargs']
+ ret['nofoptargs']=lcb2_map[lcb_map[a]]['nofoptargs']
+ ret['cbdocstr']=lcb2_map[lcb_map[a]]['docstr']
+ ret['cblatexdocstr']=lcb2_map[lcb_map[a]]['latexdocstr']
+ else:
+ ret['cbname']=a
+ errmess('sign2map: Confused: external %s is not in lcb_map%s.\n'%(a,lcb_map.keys()))
+ if isstring(var):
+ ret['length']=getstrlength(var)
+ if isarray(var):
+ ret=dictappend(ret,getarrdims(a,var))
+ dim=copy.copy(var['dimension'])
+ if c2capi_map.has_key(ret['ctype']): ret['atype']=c2capi_map[ret['ctype']]
+ # Debug info
+ if debugcapi(var):
+ il=[isintent_in,'input',isintent_out,'output',
+ isintent_inout,'inoutput',isrequired,'required',
+ isoptional,'optional',isintent_hide,'hidden',
+ iscomplex,'complex scalar',
+ l_and(isscalar,l_not(iscomplex)),'scalar',
+ isstring,'string',isarray,'array',
+ iscomplexarray,'complex array',isstringarray,'string array',
+ iscomplexfunction,'complex function',
+ l_and(isfunction,l_not(iscomplexfunction)),'function',
+ isexternal,'callback',
+ isintent_callback,'callback',
+ isintent_aux,'auxiliary',
+ #ismutable,'mutable',l_not(ismutable),'immutable',
+ ]
+ rl=[]
+ for i in range(0,len(il),2):
+ if il[i](var): rl.append(il[i+1])
+ if isstring(var):
+ rl.append('slen(%s)=%s'%(a,ret['length']))
+ if isarray(var):
+# if not isintent_c(var):
+# var['dimension'].reverse()
+ ddim=string.join(map(lambda x,y:'%s|%s'%(x,y),var['dimension'],dim),',')
+ rl.append('dims(%s)'%ddim)
+# if not isintent_c(var):
+# var['dimension'].reverse()
+ if isexternal(var):
+ ret['vardebuginfo']='debug-capi:%s=>%s:%s'%(a,ret['cbname'],string.join(rl,','))
+ else:
+ ret['vardebuginfo']='debug-capi:%s %s=%s:%s'%(ret['ctype'],a,ret['showinit'],string.join(rl,','))
+ if isscalar(var):
+ if cformat_map.has_key(ret['ctype']):
+ ret['vardebugshowvalue']='debug-capi:%s=%s'%(a,cformat_map[ret['ctype']])
+ if isstring(var):
+ ret['vardebugshowvalue']='debug-capi:slen(%s)=%%d %s=\\"%%s\\"'%(a,a)
+ if isexternal(var):
+ ret['vardebugshowvalue']='debug-capi:%s=%%p'%(a)
+ if cformat_map.has_key(ret['ctype']):
+ ret['varshowvalue']='#name#:%s=%s'%(a,cformat_map[ret['ctype']])
+ ret['showvalueformat']='%s'%(cformat_map[ret['ctype']])
+ if isstring(var):
+ ret['varshowvalue']='#name#:slen(%s)=%%d %s=\\"%%s\\"'%(a,a)
+ ret['pydocsign'],ret['pydocsignout']=getpydocsign(a,var)
+ if hasnote(var):
+ ret['note']=var['note']
+ return ret
+
+def routsign2map(rout):
+ """
+ name,NAME,begintitle,endtitle
+ rname,ctype,rformat
+ routdebugshowvalue
+ """
+ global lcb_map
+ name = rout['name']
+ fname = getfortranname(rout)
+ ret={'name':name,
+ 'texname':string.replace(name,'_','\\_'),
+ 'name_lower':string.lower(name),
+ 'NAME':string.upper(name),
+ 'begintitle':gentitle(name),
+ 'endtitle':gentitle('end of %s'%name),
+ 'fortranname':fname,
+ 'FORTRANNAME':string.upper(fname),
+ 'callstatement':getcallstatement(rout) or '',
+ 'usercode':getusercode(rout) or '',
+ 'usercode1':getusercode1(rout) or '',
+ }
+ if '_' in fname:
+ ret['F_FUNC'] = 'F_FUNC_US'
+ else:
+ ret['F_FUNC'] = 'F_FUNC'
+ if '_' in name:
+ ret['F_WRAPPEDFUNC'] = 'F_WRAPPEDFUNC_US'
+ else:
+ ret['F_WRAPPEDFUNC'] = 'F_WRAPPEDFUNC'
+ lcb_map={}
+ if rout.has_key('use'):
+ for u in rout['use'].keys():
+ if cb_rules.cb_map.has_key(u):
+ for un in cb_rules.cb_map[u]:
+ ln=un[0]
+ if rout['use'][u].has_key('map'):
+ for k in rout['use'][u]['map'].keys():
+ if rout['use'][u]['map'][k]==un[0]: ln=k;break
+ lcb_map[ln]=un[1]
+ #else:
+ # errmess('routsign2map: cb_map does not contain module "%s" used in "use" statement.\n'%(u))
+ elif rout.has_key('externals') and rout['externals']:
+ errmess('routsign2map: Confused: function %s has externals %s but no "use" statement.\n'%(ret['name'],`rout['externals']`))
+ ret['callprotoargument'] = getcallprotoargument(rout,lcb_map) or ''
+ if isfunction(rout):
+ if rout.has_key('result'): a=rout['result']
+ else: a=rout['name']
+ ret['rname']=a
+ ret['pydocsign'],ret['pydocsignout']=getpydocsign(a,rout)
+ ret['ctype']=getctype(rout['vars'][a])
+ if hasresultnote(rout):
+ ret['resultnote']=rout['vars'][a]['note']
+ rout['vars'][a]['note']=['See elsewhere.']
+ if c2buildvalue_map.has_key(ret['ctype']):
+ ret['rformat']=c2buildvalue_map[ret['ctype']]
+ else:
+ ret['rformat']='O'
+ errmess('routsign2map: no c2buildvalue key for type %s\n'%(`ret['ctype']`))
+ if debugcapi(rout):
+ if cformat_map.has_key(ret['ctype']):
+ ret['routdebugshowvalue']='debug-capi:%s=%s'%(a,cformat_map[ret['ctype']])
+ if isstringfunction(rout):
+ ret['routdebugshowvalue']='debug-capi:slen(%s)=%%d %s=\\"%%s\\"'%(a,a)
+ if isstringfunction(rout):
+ ret['rlength']=getstrlength(rout['vars'][a])
+ if ret['rlength']=='-1':
+ errmess('routsign2map: expected explicit specification of the length of the string returned by the fortran function %s; taking 10.\n'%(`rout['name']`))
+ ret['rlength']='10'
+ if hasnote(rout):
+ ret['note']=rout['note']
+ rout['note']=['See elsewhere.']
+ return ret
+
+def modsign2map(m):
+ """
+ modulename
+ """
+ if ismodule(m):
+ ret={'f90modulename':m['name'],
+ 'F90MODULENAME':string.upper(m['name']),
+ 'texf90modulename':string.replace(m['name'],'_','\\_')}
+ else:
+ ret={'modulename':m['name'],
+ 'MODULENAME':string.upper(m['name']),
+ 'texmodulename':string.replace(m['name'],'_','\\_')}
+ ret['restdoc'] = getrestdoc(m) or []
+ if hasnote(m):
+ ret['note']=m['note']
+ #m['note']=['See elsewhere.']
+ ret['usercode'] = getusercode(m) or ''
+ ret['usercode1'] = getusercode1(m) or ''
+ if m['body']:
+ ret['interface_usercode'] = getusercode(m['body'][0]) or ''
+ else:
+ ret['interface_usercode'] = ''
+ ret['pymethoddef'] = getpymethoddef(m) or ''
+ return ret
+
+def cb_sign2map(a,var):
+ ret={'varname':a}
+ ret['ctype']=getctype(var)
+ if c2capi_map.has_key(ret['ctype']):
+ ret['atype']=c2capi_map[ret['ctype']]
+ if cformat_map.has_key(ret['ctype']):
+ ret['showvalueformat']='%s'%(cformat_map[ret['ctype']])
+ if isarray(var):
+ ret=dictappend(ret,getarrdims(a,var))
+ ret['pydocsign'],ret['pydocsignout']=getpydocsign(a,var)
+ if hasnote(var):
+ ret['note']=var['note']
+ var['note']=['See elsewhere.']
+ return ret
+
+def cb_routsign2map(rout,um):
+ """
+ name,begintitle,endtitle,argname
+ ctype,rctype,maxnofargs,nofoptargs,returncptr
+ """
+ ret={'name':'cb_%s_in_%s'%(rout['name'],um),
+ 'returncptr':''}
+ if isintent_callback(rout):
+ if '_' in rout['name']:
+ F_FUNC='F_FUNC_US'
+ else:
+ F_FUNC='F_FUNC'
+ ret['callbackname'] = '%s(%s,%s)' \
+ % (F_FUNC,
+ rout['name'].lower(),
+ rout['name'].upper(),
+ )
+ ret['static'] = 'extern'
+ else:
+ ret['callbackname'] = ret['name']
+ ret['static'] = 'static'
+ ret['argname']=rout['name']
+ ret['begintitle']=gentitle(ret['name'])
+ ret['endtitle']=gentitle('end of %s'%ret['name'])
+ ret['ctype']=getctype(rout)
+ ret['rctype']='void'
+ if ret['ctype']=='string': ret['rctype']='void'
+ else:
+ ret['rctype']=ret['ctype']
+ if ret['rctype']!='void':
+ if iscomplexfunction(rout):
+ ret['returncptr'] = """
+#ifdef F2PY_CB_RETURNCOMPLEX
+return_value=
+#endif
+"""
+ else:
+ ret['returncptr'] = 'return_value='
+ if cformat_map.has_key(ret['ctype']):
+ ret['showvalueformat']='%s'%(cformat_map[ret['ctype']])
+ if isstringfunction(rout):
+ ret['strlength']=getstrlength(rout)
+ if isfunction(rout):
+ if rout.has_key('result'): a=rout['result']
+ else: a=rout['name']
+ if hasnote(rout['vars'][a]):
+ ret['note']=rout['vars'][a]['note']
+ rout['vars'][a]['note']=['See elsewhere.']
+ ret['rname']=a
+ ret['pydocsign'],ret['pydocsignout']=getpydocsign(a,rout)
+ if iscomplexfunction(rout):
+ ret['rctype']="""
+#ifdef F2PY_CB_RETURNCOMPLEX
+#ctype#
+#else
+void
+#endif
+"""
+ else:
+ if hasnote(rout):
+ ret['note']=rout['note']
+ rout['note']=['See elsewhere.']
+ nofargs=0
+ nofoptargs=0
+ if rout.has_key('args') and rout.has_key('vars'):
+ for a in rout['args']:
+ var=rout['vars'][a]
+ if l_or(isintent_in,isintent_inout)(var):
+ nofargs=nofargs+1
+ if isoptional(var):
+ nofoptargs=nofoptargs+1
+ ret['maxnofargs']=`nofargs`
+ ret['nofoptargs']=`nofoptargs`
+ if hasnote(rout) and isfunction(rout) and rout.has_key('result'):
+ ret['routnote']=rout['note']
+ rout['note']=['See elsewhere.']
+ return ret
+
+def common_sign2map(a,var): # obsolute
+ ret={'varname':a}
+ ret['ctype']=getctype(var)
+ if isstringarray(var): ret['ctype']='char'
+ if c2capi_map.has_key(ret['ctype']):
+ ret['atype']=c2capi_map[ret['ctype']]
+ if cformat_map.has_key(ret['ctype']):
+ ret['showvalueformat']='%s'%(cformat_map[ret['ctype']])
+ if isarray(var):
+ ret=dictappend(ret,getarrdims(a,var))
+ elif isstring(var):
+ ret['size']=getstrlength(var)
+ ret['rank']='1'
+ ret['pydocsign'],ret['pydocsignout']=getpydocsign(a,var)
+ if hasnote(var):
+ ret['note']=var['note']
+ var['note']=['See elsewhere.']
+ ret['arrdocstr']=getarrdocsign(a,var) # for strings this returns 0-rank but actually is 1-rank
+ return ret
diff --git a/numpy/f2py/cb_rules.py b/numpy/f2py/cb_rules.py
new file mode 100644
index 000000000..273ea4a7c
--- /dev/null
+++ b/numpy/f2py/cb_rules.py
@@ -0,0 +1,529 @@
+#!/usr/bin/env python
+"""
+
+Build call-back mechanism for f2py2e.
+
+Copyright 2000 Pearu Peterson all rights reserved,
+Pearu Peterson <pearu@ioc.ee>
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+$Date: 2005/07/20 11:27:58 $
+Pearu Peterson
+"""
+
+__version__ = "$Revision: 1.53 $"[10:-1]
+
+import __version__
+f2py_version = __version__.version
+
+
+import pprint
+import sys,string,time,types,copy
+errmess=sys.stderr.write
+outmess=sys.stdout.write
+show=pprint.pprint
+
+from auxfuncs import *
+import capi_maps
+#from capi_maps import *
+import cfuncs
+
+################## Rules for callback function ##############
+
+cb_routine_rules={
+ 'cbtypedefs':'typedef #rctype#(*#name#_typedef)(#optargs_td##args_td##strarglens_td##noargs#);',
+ 'body':"""
+#begintitle#
+PyObject *#name#_capi = NULL;/*was Py_None*/
+PyTupleObject *#name#_args_capi = NULL;
+int #name#_nofargs = 0;
+jmp_buf #name#_jmpbuf;
+/*typedef #rctype#(*#name#_typedef)(#optargs_td##args_td##strarglens_td##noargs#);*/
+#static# #rctype# #callbackname# (#optargs##args##strarglens##noargs#) {
+\tPyTupleObject *capi_arglist = #name#_args_capi;
+\tPyObject *capi_return = NULL;
+\tPyObject *capi_tmp = NULL;
+\tint capi_j,capi_i = 0;
+\tint capi_longjmp_ok = 1;
+#decl#
+#ifdef F2PY_REPORT_ATEXIT
+f2py_cb_start_clock();
+#endif
+\tCFUNCSMESS(\"cb:Call-back function #name# (maxnofargs=#maxnofargs#(-#nofoptargs#))\\n\");
+\tCFUNCSMESSPY(\"cb:#name#_capi=\",#name#_capi);
+\tif (#name#_capi==NULL) {
+\t\tcapi_longjmp_ok = 0;
+\t\t#name#_capi = PyObject_GetAttrString(#modulename#_module,\"#argname#\");
+\t}
+\tif (#name#_capi==NULL) {
+\t\tPyErr_SetString(#modulename#_error,\"cb: Callback #argname# not defined (as an argument or module #modulename# attribute).\\n\");
+\t\tgoto capi_fail;
+\t}
+\tif (PyCObject_Check(#name#_capi)) {
+\t#name#_typedef #name#_cptr;
+\t#name#_cptr = PyCObject_AsVoidPtr(#name#_capi);
+\t#returncptr#(*#name#_cptr)(#optargs_nm##args_nm##strarglens_nm#);
+\t#return#
+\t}
+\tif (capi_arglist==NULL) {
+\t\tcapi_longjmp_ok = 0;
+\t\tcapi_tmp = PyObject_GetAttrString(#modulename#_module,\"#argname#_extra_args\");
+\t\tif (capi_tmp) {
+\t\t\tcapi_arglist = (PyTupleObject *)PySequence_Tuple(capi_tmp);
+\t\t\tif (capi_arglist==NULL) {
+\t\t\t\tPyErr_SetString(#modulename#_error,\"Failed to convert #modulename#.#argname#_extra_args to tuple.\\n\");
+\t\t\t\tgoto capi_fail;
+\t\t\t}
+\t\t} else {
+\t\t\tPyErr_Clear();
+\t\t\tcapi_arglist = (PyTupleObject *)Py_BuildValue(\"()\");
+\t\t}
+\t}
+\tif (capi_arglist == NULL) {
+\t\tPyErr_SetString(#modulename#_error,\"Callback #argname# argument list is not set.\\n\");
+\t\tgoto capi_fail;
+\t}
+#setdims#
+#pyobjfrom#
+\tCFUNCSMESSPY(\"cb:capi_arglist=\",capi_arglist);
+\tCFUNCSMESS(\"cb:Call-back calling Python function #argname#.\\n\");
+#ifdef F2PY_REPORT_ATEXIT
+f2py_cb_start_call_clock();
+#endif
+\tcapi_return = PyObject_CallObject(#name#_capi,(PyObject *)capi_arglist);
+#ifdef F2PY_REPORT_ATEXIT
+f2py_cb_stop_call_clock();
+#endif
+\tCFUNCSMESSPY(\"cb:capi_return=\",capi_return);
+\tif (capi_return == NULL) {
+\t\tfprintf(stderr,\"capi_return is NULL\\n\");
+\t\tgoto capi_fail;
+\t}
+\tif (capi_return == Py_None) {
+\t\tPy_DECREF(capi_return);
+\t\tcapi_return = Py_BuildValue(\"()\");
+\t}
+\telse if (!PyTuple_Check(capi_return)) {
+\t\tcapi_return = Py_BuildValue(\"(N)\",capi_return);
+\t}
+\tcapi_j = PyTuple_Size(capi_return);
+\tcapi_i = 0;
+#frompyobj#
+\tCFUNCSMESS(\"cb:#name#:successful\\n\");
+\tPy_DECREF(capi_return);
+#ifdef F2PY_REPORT_ATEXIT
+f2py_cb_stop_clock();
+#endif
+\tgoto capi_return_pt;
+capi_fail:
+\tfprintf(stderr,\"Call-back #name# failed.\\n\");
+\tPy_XDECREF(capi_return);
+\tif (capi_longjmp_ok)
+\t\tlongjmp(#name#_jmpbuf,-1);
+capi_return_pt:
+\t;
+#return#
+}
+#endtitle#
+""",
+ 'need':['setjmp.h','CFUNCSMESS'],
+ 'maxnofargs':'#maxnofargs#',
+ 'nofoptargs':'#nofoptargs#',
+ 'docstr':"""\
+\tdef #argname#(#docsignature#): return #docreturn#\\n\\
+#docstrsigns#""",
+ 'latexdocstr':"""
+{{}\\verb@def #argname#(#latexdocsignature#): return #docreturn#@{}}
+#routnote#
+
+#latexdocstrsigns#""",
+ 'docstrshort':'def #argname#(#docsignature#): return #docreturn#'
+ }
+cb_rout_rules=[
+ {# Init
+ 'separatorsfor':{'decl':'\n',
+ 'args':',','optargs':'','pyobjfrom':'\n','freemem':'\n',
+ 'args_td':',','optargs_td':'',
+ 'args_nm':',','optargs_nm':'',
+ 'frompyobj':'\n','setdims':'\n',
+ 'docstrsigns':'\\n"\n"',
+ 'latexdocstrsigns':'\n',
+ 'latexdocstrreq':'\n','latexdocstropt':'\n',
+ 'latexdocstrout':'\n','latexdocstrcbs':'\n',
+ },
+ 'decl':'/*decl*/','pyobjfrom':'/*pyobjfrom*/','frompyobj':'/*frompyobj*/',
+ 'args':[],'optargs':'','return':'','strarglens':'','freemem':'/*freemem*/',
+ 'args_td':[],'optargs_td':'','strarglens_td':'',
+ 'args_nm':[],'optargs_nm':'','strarglens_nm':'',
+ 'noargs':'',
+ 'setdims':'/*setdims*/',
+ 'docstrsigns':'','latexdocstrsigns':'',
+ 'docstrreq':'\tRequired arguments:',
+ 'docstropt':'\tOptional arguments:',
+ 'docstrout':'\tReturn objects:',
+ 'docstrcbs':'\tCall-back functions:',
+ 'docreturn':'','docsign':'','docsignopt':'',
+ 'latexdocstrreq':'\\noindent Required arguments:',
+ 'latexdocstropt':'\\noindent Optional arguments:',
+ 'latexdocstrout':'\\noindent Return objects:',
+ 'latexdocstrcbs':'\\noindent Call-back functions:',
+ 'routnote':{hasnote:'--- #note#',l_not(hasnote):''},
+ },{ # Function
+ 'decl':'\t#ctype# return_value;',
+ 'frompyobj':[{debugcapi:'\tCFUNCSMESS("cb:Getting return_value->");'},
+ '\tif (capi_j>capi_i)\n\t\tGETSCALARFROMPYTUPLE(capi_return,capi_i++,&return_value,#ctype#,"#ctype#_from_pyobj failed in converting return_value of call-back function #name# to C #ctype#\\n");',
+ {debugcapi:'\tfprintf(stderr,"#showvalueformat#.\\n",return_value);'}
+ ],
+ 'need':['#ctype#_from_pyobj',{debugcapi:'CFUNCSMESS'},'GETSCALARFROMPYTUPLE'],
+ 'return':'\treturn return_value;',
+ '_check':l_and(isfunction,l_not(isstringfunction),l_not(iscomplexfunction))
+ },
+ {# String function
+ 'pyobjfrom':{debugcapi:'\tfprintf(stderr,"debug-capi:cb:#name#:%d:\\n",return_value_len);'},
+ 'args':'#ctype# return_value,int return_value_len',
+ 'args_nm':'return_value,&return_value_len',
+ 'args_td':'#ctype# ,int',
+ 'frompyobj':[{debugcapi:'\tCFUNCSMESS("cb:Getting return_value->\\"");'},
+ """\tif (capi_j>capi_i)
+\t\tGETSTRFROMPYTUPLE(capi_return,capi_i++,return_value,return_value_len);""",
+ {debugcapi:'\tfprintf(stderr,"#showvalueformat#\\".\\n",return_value);'}
+ ],
+ 'need':['#ctype#_from_pyobj',{debugcapi:'CFUNCSMESS'},
+ 'string.h','GETSTRFROMPYTUPLE'],
+ 'return':'return;',
+ '_check':isstringfunction
+ },
+ {# Complex function
+ 'optargs':"""
+#ifndef F2PY_CB_RETURNCOMPLEX
+#ctype# *return_value
+#endif
+""",
+ 'optargs_nm':"""
+#ifndef F2PY_CB_RETURNCOMPLEX
+return_value
+#endif
+""",
+ 'optargs_td':"""
+#ifndef F2PY_CB_RETURNCOMPLEX
+#ctype# *
+#endif
+""",
+ 'decl':"""
+#ifdef F2PY_CB_RETURNCOMPLEX
+\t#ctype# return_value;
+#endif
+""",
+ 'frompyobj':[{debugcapi:'\tCFUNCSMESS("cb:Getting return_value->");'},
+ """\
+\tif (capi_j>capi_i)
+#ifdef F2PY_CB_RETURNCOMPLEX
+\t\tGETSCALARFROMPYTUPLE(capi_return,capi_i++,&return_value,#ctype#,\"#ctype#_from_pyobj failed in converting return_value of call-back function #name# to C #ctype#\\n\");
+#else
+\t\tGETSCALARFROMPYTUPLE(capi_return,capi_i++,return_value,#ctype#,\"#ctype#_from_pyobj failed in converting return_value of call-back function #name# to C #ctype#\\n\");
+#endif
+""",
+ {debugcapi:"""
+#ifdef F2PY_CB_RETURNCOMPLEX
+\tfprintf(stderr,\"#showvalueformat#.\\n\",(return_value).r,(return_value).i);
+#else
+\tfprintf(stderr,\"#showvalueformat#.\\n\",(*return_value).r,(*return_value).i);
+#endif
+
+"""}
+ ],
+ 'return':"""
+#ifdef F2PY_CB_RETURNCOMPLEX
+\treturn return_value;
+#else
+\treturn;
+#endif
+""",
+ 'need':['#ctype#_from_pyobj',{debugcapi:'CFUNCSMESS'},
+ 'string.h','GETSCALARFROMPYTUPLE','#ctype#'],
+ '_check':iscomplexfunction
+ },
+ {'docstrout':'\t\t#pydocsignout#',
+ 'latexdocstrout':['\\item[]{{}\\verb@#pydocsignout#@{}}',
+ {hasnote:'--- #note#'}],
+ 'docreturn':'#rname#,',
+ '_check':isfunction},
+ {'_check':issubroutine,'return':'return;'}
+ ]
+
+cb_arg_rules=[
+ { # Doc
+ 'docstropt':{l_and(isoptional,isintent_nothide):'\t\t#pydocsign#'},
+ 'docstrreq':{l_and(isrequired,isintent_nothide):'\t\t#pydocsign#'},
+ 'docstrout':{isintent_out:'\t\t#pydocsignout#'},
+ 'latexdocstropt':{l_and(isoptional,isintent_nothide):['\\item[]{{}\\verb@#pydocsign#@{}}',
+ {hasnote:'--- #note#'}]},
+ 'latexdocstrreq':{l_and(isrequired,isintent_nothide):['\\item[]{{}\\verb@#pydocsign#@{}}',
+ {hasnote:'--- #note#'}]},
+ 'latexdocstrout':{isintent_out:['\\item[]{{}\\verb@#pydocsignout#@{}}',
+ {l_and(hasnote,isintent_hide):'--- #note#',
+ l_and(hasnote,isintent_nothide):'--- See above.'}]},
+ 'docsign':{l_and(isrequired,isintent_nothide):'#varname#,'},
+ 'docsignopt':{l_and(isoptional,isintent_nothide):'#varname#,'},
+ 'depend':''
+ },
+ {
+ 'args':{
+ l_and (isscalar,isintent_c):'#ctype# #varname#',
+ l_and (isscalar,l_not(isintent_c)):'#ctype# *#varname#_cb_capi',
+ isarray:'#ctype# *#varname#',
+ isstring:'#ctype# #varname#'
+ },
+ 'args_nm':{
+ l_and (isscalar,isintent_c):'#varname#',
+ l_and (isscalar,l_not(isintent_c)):'#varname#_cb_capi',
+ isarray:'#varname#',
+ isstring:'#varname#'
+ },
+ 'args_td':{
+ l_and (isscalar,isintent_c):'#ctype#',
+ l_and (isscalar,l_not(isintent_c)):'#ctype# *',
+ isarray:'#ctype# *',
+ isstring:'#ctype#'
+ },
+ 'strarglens':{isstring:',int #varname#_cb_len'}, # untested with multiple args
+ 'strarglens_td':{isstring:',int'}, # untested with multiple args
+ 'strarglens_nm':{isstring:',#varname#_cb_len'}, # untested with multiple args
+ },
+ { # Scalars
+ 'decl':{l_not(isintent_c):'\t#ctype# #varname#=(*#varname#_cb_capi);'},
+ 'error': {l_and(isintent_c,isintent_out,
+ throw_error('intent(c,out) is forbidden for callback scalar arguments')):\
+ ''},
+ 'frompyobj':[{debugcapi:'\tCFUNCSMESS("cb:Getting #varname#->");'},
+ {isintent_out:'\tif (capi_j>capi_i)\n\t\tGETSCALARFROMPYTUPLE(capi_return,capi_i++,#varname#_cb_capi,#ctype#,"#ctype#_from_pyobj failed in converting argument #varname# of call-back function #name# to C #ctype#\\n");'},
+ {l_and(debugcapi,l_and(l_not(iscomplex),isintent_c)):'\tfprintf(stderr,"#showvalueformat#.\\n",#varname#);'},
+ {l_and(debugcapi,l_and(l_not(iscomplex),l_not(isintent_c))):'\tfprintf(stderr,"#showvalueformat#.\\n",*#varname#_cb_capi);'},
+ {l_and(debugcapi,l_and(iscomplex,isintent_c)):'\tfprintf(stderr,"#showvalueformat#.\\n",(#varname#).r,(#varname#).i);'},
+ {l_and(debugcapi,l_and(iscomplex,l_not(isintent_c))):'\tfprintf(stderr,"#showvalueformat#.\\n",(*#varname#_cb_capi).r,(*#varname#_cb_capi).i);'},
+ ],
+ 'need':[{isintent_out:['#ctype#_from_pyobj','GETSCALARFROMPYTUPLE']},
+ {debugcapi:'CFUNCSMESS'}],
+ '_check':isscalar
+ },{
+ 'pyobjfrom':[{isintent_in:"""\
+\tif (#name#_nofargs>capi_i)
+\t\tif (PyTuple_SetItem((PyObject *)capi_arglist,capi_i++,pyobj_from_#ctype#1(#varname#)))
+\t\t\tgoto capi_fail;"""},
+ {isintent_inout:"""\
+\tif (#name#_nofargs>capi_i)
+\t\tif (PyTuple_SetItem((PyObject *)capi_arglist,capi_i++,pyarr_from_p_#ctype#1(#varname#_cb_capi)))
+\t\t\tgoto capi_fail;"""}],
+ 'need':[{isintent_in:'pyobj_from_#ctype#1'},
+ {isintent_inout:'pyarr_from_p_#ctype#1'},
+ {iscomplex:'#ctype#'}],
+ '_check':l_and(isscalar,isintent_nothide),
+ '_optional':''
+ },{# String
+ 'frompyobj':[{debugcapi:'\tCFUNCSMESS("cb:Getting #varname#->\\"");'},
+ """\tif (capi_j>capi_i)
+\t\tGETSTRFROMPYTUPLE(capi_return,capi_i++,#varname#,#varname#_cb_len);""",
+ {debugcapi:'\tfprintf(stderr,"#showvalueformat#\\":%d:.\\n",#varname#,#varname#_cb_len);'},
+ ],
+ 'need':['#ctype#','GETSTRFROMPYTUPLE',
+ {debugcapi:'CFUNCSMESS'},'string.h'],
+ '_check':l_and(isstring,isintent_out)
+ },{
+ 'pyobjfrom':[{debugcapi:'\tfprintf(stderr,"debug-capi:cb:#varname#=\\"#showvalueformat#\\":%d:\\n",#varname#,#varname#_cb_len);'},
+ {isintent_in:"""\
+\tif (#name#_nofargs>capi_i)
+\t\tif (PyTuple_SetItem((PyObject *)capi_arglist,capi_i++,pyobj_from_#ctype#1(#varname#)))
+\t\t\tgoto capi_fail;"""},
+ {isintent_inout:"""\
+\tif (#name#_nofargs>capi_i) {
+\t\tint #varname#_cb_dims[] = {#varname#_cb_len};
+\t\tif (PyTuple_SetItem((PyObject *)capi_arglist,capi_i++,pyarr_from_p_#ctype#1(#varname#,#varname#_cb_dims)))
+\t\t\tgoto capi_fail;
+\t}"""}],
+ 'need':[{isintent_in:'pyobj_from_#ctype#1'},
+ {isintent_inout:'pyarr_from_p_#ctype#1'}],
+ '_check':l_and(isstring,isintent_nothide),
+ '_optional':''
+ },
+# Array ...
+ {
+ 'decl':'\tnpy_intp #varname#_Dims[#rank#] = {#rank*[-1]#};',
+ 'setdims':'\t#cbsetdims#;',
+ '_check':isarray,
+ '_depend':''
+ },
+ {
+ 'pyobjfrom':[{debugcapi:'\tfprintf(stderr,"debug-capi:cb:#varname#\\n");'},
+ {isintent_c:"""\
+\tif (#name#_nofargs>capi_i) {
+\t\tPyArrayObject *tmp_arr = (PyArrayObject *)PyArray_New(&PyArray_Type,#rank#,#varname#_Dims,#atype#,NULL,(char*)#varname#,0,NPY_CARRAY,NULL); /*XXX: Hmm, what will destroy this array??? */
+""",
+ l_not(isintent_c):"""\
+\tif (#name#_nofargs>capi_i) {
+\t\tPyArrayObject *tmp_arr = (PyArrayObject *)PyArray_New(&PyArray_Type,#rank#,#varname#_Dims,#atype#,NULL,(char*)#varname#,0,NPY_FARRAY,NULL); /*XXX: Hmm, what will destroy this array??? */
+""",
+ },
+ """
+\t\tif (tmp_arr==NULL)
+\t\t\tgoto capi_fail;
+\t\tif (PyTuple_SetItem((PyObject *)capi_arglist,capi_i++,(PyObject *)tmp_arr))
+\t\t\tgoto capi_fail;
+}"""],
+ '_check':l_and(isarray,isintent_nothide,l_or(isintent_in,isintent_inout)),
+ '_optional':'',
+ },{
+ 'frompyobj':[{debugcapi:'\tCFUNCSMESS("cb:Getting #varname#->");'},
+ """\tif (capi_j>capi_i) {
+\t\tPyArrayObject *rv_cb_arr = NULL;
+\t\tif ((capi_tmp = PyTuple_GetItem(capi_return,capi_i++))==NULL) goto capi_fail;
+\t\trv_cb_arr = array_from_pyobj(#atype#,#varname#_Dims,#rank#,F2PY_INTENT_IN""",
+ {isintent_c:'|F2PY_INTENT_C'},
+ """,capi_tmp);
+\t\tif (rv_cb_arr == NULL) {
+\t\t\tfprintf(stderr,\"rv_cb_arr is NULL\\n\");
+\t\t\tgoto capi_fail;
+\t\t}
+\t\tMEMCOPY(#varname#,rv_cb_arr->data,PyArray_NBYTES(rv_cb_arr));
+\t\tif (capi_tmp != (PyObject *)rv_cb_arr) {
+\t\t\tPy_DECREF(rv_cb_arr);
+\t\t}
+\t}""",
+ {debugcapi:'\tfprintf(stderr,"<-.\\n");'},
+ ],
+ 'need':['MEMCOPY',{iscomplexarray:'#ctype#'}],
+ '_check':l_and(isarray,isintent_out)
+ },{
+ 'docreturn':'#varname#,',
+ '_check':isintent_out
+ }
+ ]
+
+################## Build call-back module #############
+cb_map={}
+def buildcallbacks(m):
+ global cb_map
+ cb_map[m['name']]=[]
+ for bi in m['body']:
+ if bi['block']=='interface':
+ for b in bi['body']:
+ if b:
+ buildcallback(b,m['name'])
+ else:
+ errmess('warning: empty body for %s\n' % (m['name']))
+
+def buildcallback(rout,um):
+ global cb_map
+ outmess('\tConstructing call-back function "cb_%s_in_%s"\n'%(rout['name'],um))
+ args,depargs=getargs(rout)
+ capi_maps.depargs=depargs
+ var=rout['vars']
+ vrd=capi_maps.cb_routsign2map(rout,um)
+ rd=dictappend({},vrd)
+ cb_map[um].append([rout['name'],rd['name']])
+ for r in cb_rout_rules:
+ if (r.has_key('_check') and r['_check'](rout)) or (not r.has_key('_check')):
+ ar=applyrules(r,vrd,rout)
+ rd=dictappend(rd,ar)
+ savevrd={}
+ for a in args:
+ vrd=capi_maps.cb_sign2map(a,var[a])
+ savevrd[a]=vrd
+ for r in cb_arg_rules:
+ if r.has_key('_depend'): continue
+ if r.has_key('_optional') and isoptional(var[a]): continue
+ if (r.has_key('_check') and r['_check'](var[a])) or (not r.has_key('_check')):
+ ar=applyrules(r,vrd,var[a])
+ rd=dictappend(rd,ar)
+ if r.has_key('_break'): break
+ for a in args:
+ vrd=savevrd[a]
+ for r in cb_arg_rules:
+ if r.has_key('_depend'): continue
+ if (not r.has_key('_optional')) or (r.has_key('_optional') and isrequired(var[a])): continue
+ if (r.has_key('_check') and r['_check'](var[a])) or (not r.has_key('_check')):
+ ar=applyrules(r,vrd,var[a])
+ rd=dictappend(rd,ar)
+ if r.has_key('_break'): break
+ for a in depargs:
+ vrd=savevrd[a]
+ for r in cb_arg_rules:
+ if not r.has_key('_depend'): continue
+ if r.has_key('_optional'): continue
+ if (r.has_key('_check') and r['_check'](var[a])) or (not r.has_key('_check')):
+ ar=applyrules(r,vrd,var[a])
+ rd=dictappend(rd,ar)
+ if r.has_key('_break'): break
+ if rd.has_key('args') and rd.has_key('optargs'):
+ if type(rd['optargs'])==type([]):
+ rd['optargs']=rd['optargs']+["""
+#ifndef F2PY_CB_RETURNCOMPLEX
+,
+#endif
+"""]
+ rd['optargs_nm']=rd['optargs_nm']+["""
+#ifndef F2PY_CB_RETURNCOMPLEX
+,
+#endif
+"""]
+ rd['optargs_td']=rd['optargs_td']+["""
+#ifndef F2PY_CB_RETURNCOMPLEX
+,
+#endif
+"""]
+ if type(rd['docreturn'])==types.ListType:
+ rd['docreturn']=stripcomma(replace('#docreturn#',{'docreturn':rd['docreturn']}))
+ optargs=stripcomma(replace('#docsignopt#',
+ {'docsignopt':rd['docsignopt']}
+ ))
+ if optargs=='':
+ rd['docsignature']=stripcomma(replace('#docsign#',{'docsign':rd['docsign']}))
+ else:
+ rd['docsignature']=replace('#docsign#[#docsignopt#]',
+ {'docsign':rd['docsign'],
+ 'docsignopt':optargs,
+ })
+ rd['latexdocsignature']=string.replace(rd['docsignature'],'_','\\_')
+ rd['latexdocsignature']=string.replace(rd['latexdocsignature'],',',', ')
+ rd['docstrsigns']=[]
+ rd['latexdocstrsigns']=[]
+ for k in ['docstrreq','docstropt','docstrout','docstrcbs']:
+ if rd.has_key(k) and type(rd[k])==types.ListType:
+ rd['docstrsigns']=rd['docstrsigns']+rd[k]
+ k='latex'+k
+ if rd.has_key(k) and type(rd[k])==types.ListType:
+ rd['latexdocstrsigns']=rd['latexdocstrsigns']+rd[k][0:1]+\
+ ['\\begin{description}']+rd[k][1:]+\
+ ['\\end{description}']
+ if not rd.has_key('args'):
+ rd['args']=''
+ rd['args_td']=''
+ rd['args_nm']=''
+ if not (rd.get('args') or rd.get('optargs') or rd.get('strarglens')):
+ rd['noargs'] = 'void'
+
+ ar=applyrules(cb_routine_rules,rd)
+ cfuncs.callbacks[rd['name']]=ar['body']
+ if type(ar['need'])==types.StringType:
+ ar['need']=[ar['need']]
+
+ if rd.has_key('need'):
+ for t in cfuncs.typedefs.keys():
+ if t in rd['need']:
+ ar['need'].append(t)
+
+ cfuncs.typedefs_generated[rd['name']+'_typedef'] = ar['cbtypedefs']
+ ar['need'].append(rd['name']+'_typedef')
+ cfuncs.needs[rd['name']]=ar['need']
+
+ capi_maps.lcb2_map[rd['name']]={'maxnofargs':ar['maxnofargs'],
+ 'nofoptargs':ar['nofoptargs'],
+ 'docstr':ar['docstr'],
+ 'latexdocstr':ar['latexdocstr'],
+ 'argname':rd['argname']
+ }
+ outmess('\t %s\n'%(ar['docstrshort']))
+ #print ar['body']
+ return
+################## Build call-back function #############
diff --git a/numpy/f2py/cfuncs.py b/numpy/f2py/cfuncs.py
new file mode 100644
index 000000000..48373678f
--- /dev/null
+++ b/numpy/f2py/cfuncs.py
@@ -0,0 +1,1141 @@
+#!/usr/bin/env python
+"""
+
+C declarations, CPP macros, and C functions for f2py2e.
+Only required declarations/macros/functions will be used.
+
+Copyright 1999,2000 Pearu Peterson all rights reserved,
+Pearu Peterson <pearu@ioc.ee>
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+$Date: 2005/05/06 11:42:34 $
+Pearu Peterson
+"""
+
+__version__ = "$Revision: 1.75 $"[10:-1]
+
+import __version__
+f2py_version = __version__.version
+
+import types,sys,copy,os
+errmess=sys.stderr.write
+
+##################### Definitions ##################
+
+outneeds={'includes0':[],'includes':[],'typedefs':[],'typedefs_generated':[],
+ 'userincludes':[],
+ 'cppmacros':[],'cfuncs':[],'callbacks':[],'f90modhooks':[],
+ 'commonhooks':[]}
+needs={}
+includes0={'includes0':'/*need_includes0*/'}
+includes={'includes':'/*need_includes*/'}
+userincludes={'userincludes':'/*need_userincludes*/'}
+typedefs={'typedefs':'/*need_typedefs*/'}
+typedefs_generated={'typedefs_generated':'/*need_typedefs_generated*/'}
+cppmacros={'cppmacros':'/*need_cppmacros*/'}
+cfuncs={'cfuncs':'/*need_cfuncs*/'}
+callbacks={'callbacks':'/*need_callbacks*/'}
+f90modhooks={'f90modhooks':'/*need_f90modhooks*/',
+ 'initf90modhooksstatic':'/*initf90modhooksstatic*/',
+ 'initf90modhooksdynamic':'/*initf90modhooksdynamic*/',
+ }
+commonhooks={'commonhooks':'/*need_commonhooks*/',
+ 'initcommonhooks':'/*need_initcommonhooks*/',
+ }
+
+############ Includes ###################
+
+includes0['math.h']='#include <math.h>'
+includes0['string.h']='#include <string.h>'
+includes0['setjmp.h']='#include <setjmp.h>'
+
+includes['Python.h']='#include "Python.h"'
+needs['arrayobject.h']=['Python.h']
+includes['arrayobject.h']='''#define PY_ARRAY_UNIQUE_SYMBOL PyArray_API
+#include "arrayobject.h"'''
+
+includes['arrayobject.h']='#include "fortranobject.h"'
+
+############# Type definitions ###############
+
+typedefs['unsigned_char']='typedef unsigned char unsigned_char;'
+typedefs['unsigned_short']='typedef unsigned short unsigned_short;'
+typedefs['unsigned_long']='typedef unsigned long unsigned_long;'
+typedefs['signed_char']='typedef signed char signed_char;'
+typedefs['long_long']="""\
+#ifdef _WIN32
+typedef __int64 long_long;
+#else
+typedef long long long_long;
+typedef unsigned long long unsigned_long_long;
+#endif
+"""
+typedefs['insinged_long_long']="""\
+#ifdef _WIN32
+typedef __uint64 long_long;
+#else
+typedef unsigned long long unsigned_long_long;
+#endif
+"""
+typedefs['long_double']="""\
+#ifndef _LONG_DOUBLE
+typedef long double long_double;
+#endif
+"""
+typedefs['complex_long_double']='typedef struct {long double r,i;} complex_long_double;'
+typedefs['complex_float']='typedef struct {float r,i;} complex_float;'
+typedefs['complex_double']='typedef struct {double r,i;} complex_double;'
+typedefs['string']="""typedef char * string;"""
+
+
+############### CPP macros ####################
+cppmacros['CFUNCSMESS']="""\
+#ifdef DEBUGCFUNCS
+#define CFUNCSMESS(mess) fprintf(stderr,\"debug-capi:\"mess);
+#define CFUNCSMESSPY(mess,obj) CFUNCSMESS(mess) \\
+\tPyObject_Print((PyObject *)obj,stderr,Py_PRINT_RAW);\\
+\tfprintf(stderr,\"\\n\");
+#else
+#define CFUNCSMESS(mess)
+#define CFUNCSMESSPY(mess,obj)
+#endif
+"""
+cppmacros['F_FUNC']="""\
+#if defined(PREPEND_FORTRAN)
+#if defined(NO_APPEND_FORTRAN)
+#if defined(UPPERCASE_FORTRAN)
+#define F_FUNC(f,F) _##F
+#else
+#define F_FUNC(f,F) _##f
+#endif
+#else
+#if defined(UPPERCASE_FORTRAN)
+#define F_FUNC(f,F) _##F##_
+#else
+#define F_FUNC(f,F) _##f##_
+#endif
+#endif
+#else
+#if defined(NO_APPEND_FORTRAN)
+#if defined(UPPERCASE_FORTRAN)
+#define F_FUNC(f,F) F
+#else
+#define F_FUNC(f,F) f
+#endif
+#else
+#if defined(UPPERCASE_FORTRAN)
+#define F_FUNC(f,F) F##_
+#else
+#define F_FUNC(f,F) f##_
+#endif
+#endif
+#endif
+#if defined(UNDERSCORE_G77)
+#define F_FUNC_US(f,F) F_FUNC(f##_,F##_)
+#else
+#define F_FUNC_US(f,F) F_FUNC(f,F)
+#endif
+"""
+cppmacros['F_WRAPPEDFUNC']="""\
+#if defined(PREPEND_FORTRAN)
+#if defined(NO_APPEND_FORTRAN)
+#if defined(UPPERCASE_FORTRAN)
+#define F_WRAPPEDFUNC(f,F) _F2PYWRAP##F
+#else
+#define F_WRAPPEDFUNC(f,F) _f2pywrap##f
+#endif
+#else
+#if defined(UPPERCASE_FORTRAN)
+#define F_WRAPPEDFUNC(f,F) _F2PYWRAP##F##_
+#else
+#define F_WRAPPEDFUNC(f,F) _f2pywrap##f##_
+#endif
+#endif
+#else
+#if defined(NO_APPEND_FORTRAN)
+#if defined(UPPERCASE_FORTRAN)
+#define F_WRAPPEDFUNC(f,F) F2PYWRAP##F
+#else
+#define F_WRAPPEDFUNC(f,F) f2pywrap##f
+#endif
+#else
+#if defined(UPPERCASE_FORTRAN)
+#define F_WRAPPEDFUNC(f,F) F2PYWRAP##F##_
+#else
+#define F_WRAPPEDFUNC(f,F) f2pywrap##f##_
+#endif
+#endif
+#endif
+#if defined(UNDERSCORE_G77)
+#define F_WRAPPEDFUNC_US(f,F) F_WRAPPEDFUNC(f##_,F##_)
+#else
+#define F_WRAPPEDFUNC_US(f,F) F_WRAPPEDFUNC(f,F)
+#endif
+"""
+cppmacros['F_MODFUNC']="""\
+#if defined(F90MOD2CCONV1) /*E.g. Compaq Fortran */
+#if defined(NO_APPEND_FORTRAN)
+#define F_MODFUNCNAME(m,f) $ ## m ## $ ## f
+#else
+#define F_MODFUNCNAME(m,f) $ ## m ## $ ## f ## _
+#endif
+#endif
+
+#if defined(F90MOD2CCONV2) /*E.g. IBM XL Fortran, not tested though */
+#if defined(NO_APPEND_FORTRAN)
+#define F_MODFUNCNAME(m,f) __ ## m ## _MOD_ ## f
+#else
+#define F_MODFUNCNAME(m,f) __ ## m ## _MOD_ ## f ## _
+#endif
+#endif
+
+#if defined(F90MOD2CCONV3) /*E.g. MIPSPro Compilers */
+#if defined(NO_APPEND_FORTRAN)
+#define F_MODFUNCNAME(m,f) f ## .in. ## m
+#else
+#define F_MODFUNCNAME(m,f) f ## .in. ## m ## _
+#endif
+#endif
+/*
+#if defined(UPPERCASE_FORTRAN)
+#define F_MODFUNC(m,M,f,F) F_MODFUNCNAME(M,F)
+#else
+#define F_MODFUNC(m,M,f,F) F_MODFUNCNAME(m,f)
+#endif
+*/
+
+#define F_MODFUNC(m,f) (*(f2pymodstruct##m##.##f))
+"""
+cppmacros['SWAPUNSAFE']="""\
+#define SWAP(a,b) (size_t)(a) = ((size_t)(a) ^ (size_t)(b));\\
+ (size_t)(b) = ((size_t)(a) ^ (size_t)(b));\\
+ (size_t)(a) = ((size_t)(a) ^ (size_t)(b))
+"""
+cppmacros['SWAP']="""\
+#define SWAP(a,b,t) {\\
+\tt *c;\\
+\tc = a;\\
+\ta = b;\\
+\tb = c;}
+"""
+#cppmacros['ISCONTIGUOUS']='#define ISCONTIGUOUS(m) ((m)->flags & NPY_CONTIGUOUS)'
+cppmacros['PRINTPYOBJERR']="""\
+#define PRINTPYOBJERR(obj)\\
+\tfprintf(stderr,\"#modulename#.error is related to \");\\
+\tPyObject_Print((PyObject *)obj,stderr,Py_PRINT_RAW);\\
+\tfprintf(stderr,\"\\n\");
+"""
+cppmacros['MINMAX']="""\
+#ifndef MAX
+#define MAX(a,b) ((a > b) ? (a) : (b))
+#endif
+#ifndef MIN
+#define MIN(a,b) ((a < b) ? (a) : (b))
+#endif
+"""
+cppmacros['len..']="""\
+#define rank(var) var ## _Rank
+#define shape(var,dim) var ## _Dims[dim]
+#define old_rank(var) (((PyArrayObject *)(capi_ ## var ## _tmp))->nd)
+#define old_shape(var,dim) (((PyArrayObject *)(capi_ ## var ## _tmp))->dimensions[dim])
+#define fshape(var,dim) shape(var,rank(var)-dim-1)
+#define len(var) shape(var,0)
+#define flen(var) fshape(var,0)
+#define size(var) PyArray_SIZE((PyArrayObject *)(capi_ ## var ## _tmp))
+/* #define index(i) capi_i ## i */
+#define slen(var) capi_ ## var ## _len
+"""
+
+cppmacros['pyobj_from_char1']='#define pyobj_from_char1(v) (PyInt_FromLong(v))'
+cppmacros['pyobj_from_short1']='#define pyobj_from_short1(v) (PyInt_FromLong(v))'
+needs['pyobj_from_int1']=['signed_char']
+cppmacros['pyobj_from_int1']='#define pyobj_from_int1(v) (PyInt_FromLong(v))'
+cppmacros['pyobj_from_long1']='#define pyobj_from_long1(v) (PyLong_FromLong(v))'
+needs['pyobj_from_long_long1']=['long_long']
+cppmacros['pyobj_from_long_long1']="""\
+#ifdef HAVE_LONG_LONG
+#define pyobj_from_long_long1(v) (PyLong_FromLongLong(v))
+#else
+#warning HAVE_LONG_LONG is not available. Redefining pyobj_from_long_long.
+#define pyobj_from_long_long1(v) (PyLong_FromLong(v))
+#endif
+"""
+needs['pyobj_from_long_double1']=['long_double']
+cppmacros['pyobj_from_long_double1']='#define pyobj_from_long_double1(v) (PyFloat_FromDouble(v))'
+cppmacros['pyobj_from_double1']='#define pyobj_from_double1(v) (PyFloat_FromDouble(v))'
+cppmacros['pyobj_from_float1']='#define pyobj_from_float1(v) (PyFloat_FromDouble(v))'
+needs['pyobj_from_complex_long_double1']=['complex_long_double']
+cppmacros['pyobj_from_complex_long_double1']='#define pyobj_from_complex_long_double1(v) (PyComplex_FromDoubles(v.r,v.i))'
+needs['pyobj_from_complex_double1']=['complex_double']
+cppmacros['pyobj_from_complex_double1']='#define pyobj_from_complex_double1(v) (PyComplex_FromDoubles(v.r,v.i))'
+needs['pyobj_from_complex_float1']=['complex_float']
+cppmacros['pyobj_from_complex_float1']='#define pyobj_from_complex_float1(v) (PyComplex_FromDoubles(v.r,v.i))'
+needs['pyobj_from_string1']=['string']
+cppmacros['pyobj_from_string1']='#define pyobj_from_string1(v) (PyString_FromString((char *)v))'
+needs['TRYPYARRAYTEMPLATE']=['PRINTPYOBJERR']
+cppmacros['TRYPYARRAYTEMPLATE']="""\
+/* New SciPy */
+#define TRYPYARRAYTEMPLATECHAR case PyArray_STRING: *(char *)(arr->data)=*v; break;
+#define TRYPYARRAYTEMPLATELONG case PyArray_LONG: *(long *)(arr->data)=*v; break;
+#define TRYPYARRAYTEMPLATEOBJECT case PyArray_OBJECT: (arr->descr->f->setitem)(pyobj_from_ ## ctype ## 1(*v),arr->data); break;
+
+#define TRYPYARRAYTEMPLATE(ctype,typecode) \\
+ PyArrayObject *arr = NULL;\\
+ if (!obj) return -2;\\
+ if (!PyArray_Check(obj)) return -1;\\
+ if (!(arr=(PyArrayObject *)obj)) {fprintf(stderr,\"TRYPYARRAYTEMPLATE:\");PRINTPYOBJERR(obj);return 0;}\\
+ if (arr->descr->type==typecode) {*(ctype *)(arr->data)=*v; return 1;}\\
+ switch (arr->descr->type_num) {\\
+ case PyArray_DOUBLE: *(double *)(arr->data)=*v; break;\\
+ case PyArray_INT: *(int *)(arr->data)=*v; break;\\
+ case PyArray_LONG: *(long *)(arr->data)=*v; break;\\
+ case PyArray_FLOAT: *(float *)(arr->data)=*v; break;\\
+ case PyArray_CDOUBLE: *(double *)(arr->data)=*v; break;\\
+ case PyArray_CFLOAT: *(float *)(arr->data)=*v; break;\\
+ case PyArray_BOOL: *(npy_bool *)(arr->data)=(*v!=0); break;\\
+ case PyArray_UBYTE: *(unsigned char *)(arr->data)=*v; break;\\
+ case PyArray_BYTE: *(signed char *)(arr->data)=*v; break;\\
+ case PyArray_SHORT: *(short *)(arr->data)=*v; break;\\
+ case PyArray_USHORT: *(npy_ushort *)(arr->data)=*v; break;\\
+ case PyArray_UINT: *(npy_uint *)(arr->data)=*v; break;\\
+ case PyArray_ULONG: *(npy_ulong *)(arr->data)=*v; break;\\
+ case PyArray_LONGLONG: *(npy_longlong *)(arr->data)=*v; break;\\
+ case PyArray_ULONGLONG: *(npy_ulonglong *)(arr->data)=*v; break;\\
+ case PyArray_LONGDOUBLE: *(npy_longdouble *)(arr->data)=*v; break;\\
+ case PyArray_CLONGDOUBLE: *(npy_longdouble *)(arr->data)=*v; break;\\
+ case PyArray_OBJECT: (arr->descr->f->setitem)(pyobj_from_ ## ctype ## 1(*v),arr->data, arr); break;\\
+ default: return -2;\\
+ };\\
+ return 1
+"""
+
+needs['TRYCOMPLEXPYARRAYTEMPLATE']=['PRINTPYOBJERR']
+cppmacros['TRYCOMPLEXPYARRAYTEMPLATE']="""\
+#define TRYCOMPLEXPYARRAYTEMPLATEOBJECT case PyArray_OBJECT: (arr->descr->f->setitem)(pyobj_from_complex_ ## ctype ## 1((*v)),arr->data, arr); break;
+#define TRYCOMPLEXPYARRAYTEMPLATE(ctype,typecode)\\
+ PyArrayObject *arr = NULL;\\
+ if (!obj) return -2;\\
+ if (!PyArray_Check(obj)) return -1;\\
+ if (!(arr=(PyArrayObject *)obj)) {fprintf(stderr,\"TRYCOMPLEXPYARRAYTEMPLATE:\");PRINTPYOBJERR(obj);return 0;}\\
+ if (arr->descr->type==typecode) {\\
+ *(ctype *)(arr->data)=(*v).r;\\
+ *(ctype *)(arr->data+sizeof(ctype))=(*v).i;\\
+ return 1;\\
+ }\\
+ switch (arr->descr->type_num) {\\
+ case PyArray_CDOUBLE: *(double *)(arr->data)=(*v).r;*(double *)(arr->data+sizeof(double))=(*v).i;break;\\
+ case PyArray_CFLOAT: *(float *)(arr->data)=(*v).r;*(float *)(arr->data+sizeof(float))=(*v).i;break;\\
+ case PyArray_DOUBLE: *(double *)(arr->data)=(*v).r; break;\\
+ case PyArray_LONG: *(long *)(arr->data)=(*v).r; break;\\
+ case PyArray_FLOAT: *(float *)(arr->data)=(*v).r; break;\\
+ case PyArray_INT: *(int *)(arr->data)=(*v).r; break;\\
+ case PyArray_SHORT: *(short *)(arr->data)=(*v).r; break;\\
+ case PyArray_UBYTE: *(unsigned char *)(arr->data)=(*v).r; break;\\
+ case PyArray_BYTE: *(signed char *)(arr->data)=(*v).r; break;\\
+ case PyArray_BOOL: *(npy_bool *)(arr->data)=((*v).r!=0 && (*v).i!=0)); break;\\
+ case PyArray_UBYTE: *(unsigned char *)(arr->data)=(*v).r; break;\\
+ case PyArray_BYTE: *(signed char *)(arr->data)=(*v).r; break;\\
+ case PyArray_SHORT: *(short *)(arr->data)=(*v).r; break;\\
+ case PyArray_USHORT: *(npy_ushort *)(arr->data)=(*v).r; break;\\
+ case PyArray_UINT: *(npy_uint *)(arr->data)=(*v).r; break;\\
+ case PyArray_ULONG: *(npy_ulong *)(arr->data)=(*v).r; break;\\
+ case PyArray_LONGLONG: *(npy_longlong *)(arr->data)=(*v).r; break;\\
+ case PyArray_ULONGLONG: *(npy_ulonglong *)(arr->data)=(*v).r; break;\\
+ case PyArray_LONGDOUBLE: *(npy_longdouble *)(arr->data)=(*v).r; break;\\
+ case PyArray_CLONGDOUBLE: *(npy_longdouble *)(arr->data)=(*v).r;*(npy_longdouble *)(arr->data+sizeof(npy_longdouble))=(*v).i;break;\\
+ case PyArray_OBJECT: (arr->descr->f->setitem)(pyobj_from_complex_ ## ctype ## 1((*v)),arr->data, arr); break;\\
+ default: return -2;\\
+ };\\
+ return -1;
+"""
+## cppmacros['NUMFROMARROBJ']="""\
+## #define NUMFROMARROBJ(typenum,ctype) \\
+## \tif (PyArray_Check(obj)) arr = (PyArrayObject *)obj;\\
+## \telse arr = (PyArrayObject *)PyArray_ContiguousFromObject(obj,typenum,0,0);\\
+## \tif (arr) {\\
+## \t\tif (arr->descr->type_num==PyArray_OBJECT) {\\
+## \t\t\tif (!ctype ## _from_pyobj(v,(arr->descr->getitem)(arr->data),\"\"))\\
+## \t\t\tgoto capi_fail;\\
+## \t\t} else {\\
+## \t\t\t(arr->descr->cast[typenum])(arr->data,1,(char*)v,1,1);\\
+## \t\t}\\
+## \t\tif ((PyObject *)arr != obj) { Py_DECREF(arr); }\\
+## \t\treturn 1;\\
+## \t}
+## """
+## #XXX: Note that CNUMFROMARROBJ is identical with NUMFROMARROBJ
+## cppmacros['CNUMFROMARROBJ']="""\
+## #define CNUMFROMARROBJ(typenum,ctype) \\
+## \tif (PyArray_Check(obj)) arr = (PyArrayObject *)obj;\\
+## \telse arr = (PyArrayObject *)PyArray_ContiguousFromObject(obj,typenum,0,0);\\
+## \tif (arr) {\\
+## \t\tif (arr->descr->type_num==PyArray_OBJECT) {\\
+## \t\t\tif (!ctype ## _from_pyobj(v,(arr->descr->getitem)(arr->data),\"\"))\\
+## \t\t\tgoto capi_fail;\\
+## \t\t} else {\\
+## \t\t\t(arr->descr->cast[typenum])((void *)(arr->data),1,(void *)(v),1,1);\\
+## \t\t}\\
+## \t\tif ((PyObject *)arr != obj) { Py_DECREF(arr); }\\
+## \t\treturn 1;\\
+## \t}
+## """
+
+
+needs['GETSTRFROMPYTUPLE']=['STRINGCOPYN','PRINTPYOBJERR']
+cppmacros['GETSTRFROMPYTUPLE']="""\
+#define GETSTRFROMPYTUPLE(tuple,index,str,len) {\\
+\t\tPyObject *rv_cb_str = PyTuple_GetItem((tuple),(index));\\
+\t\tif (rv_cb_str == NULL)\\
+\t\t\tgoto capi_fail;\\
+\t\tif (PyString_Check(rv_cb_str)) {\\
+\t\t\tstr[len-1]='\\0';\\
+\t\t\tSTRINGCOPYN((str),PyString_AS_STRING((PyStringObject*)rv_cb_str),(len));\\
+\t\t} else {\\
+\t\t\tPRINTPYOBJERR(rv_cb_str);\\
+\t\t\tPyErr_SetString(#modulename#_error,\"string object expected\");\\
+\t\t\tgoto capi_fail;\\
+\t\t}\\
+\t}
+"""
+cppmacros['GETSCALARFROMPYTUPLE']="""\
+#define GETSCALARFROMPYTUPLE(tuple,index,var,ctype,mess) {\\
+\t\tif ((capi_tmp = PyTuple_GetItem((tuple),(index)))==NULL) goto capi_fail;\\
+\t\tif (!(ctype ## _from_pyobj((var),capi_tmp,mess)))\\
+\t\t\tgoto capi_fail;\\
+\t}
+"""
+
+cppmacros['FAILNULL']="""\\
+#define FAILNULL(p) do { \\
+ if ((p) == NULL) { \\
+ PyErr_SetString(PyExc_MemoryError, "NULL pointer found"); \\
+ goto capi_fail; \\
+ } \\
+} while (0)
+"""
+needs['MEMCOPY']=['string.h', 'FAILNULL']
+cppmacros['MEMCOPY']="""\
+#define MEMCOPY(to,from,n)\\
+ do { FAILNULL(to); FAILNULL(from); (void)memcpy(to,from,n); } while (0)
+"""
+cppmacros['STRINGMALLOC']="""\
+#define STRINGMALLOC(str,len)\\
+\tif ((str = (string)malloc(sizeof(char)*(len+1))) == NULL) {\\
+\t\tPyErr_SetString(PyExc_MemoryError, \"out of memory\");\\
+\t\tgoto capi_fail;\\
+\t} else {\\
+\t\t(str)[len] = '\\0';\\
+\t}
+"""
+cppmacros['STRINGFREE']="""\
+#define STRINGFREE(str) do {if (!(str == NULL)) free(str);} while (0)
+"""
+needs['STRINGCOPYN']=['string.h', 'FAILNULL']
+cppmacros['STRINGCOPYN']="""\
+#define STRINGCOPYN(to,from,buf_size) \\
+ do { \\
+ int _m = (buf_size); \\
+ char *_to = (to); \\
+ char *_from = (from); \\
+ FAILNULL(_to); FAILNULL(_from); \\
+ (void)strncpy(_to, _from, sizeof(char)*_m); \\
+ _to[_m-1] = '\\0'; \\
+ /* Padding with spaces instead of nulls */ \\
+ for (_m -= 2; _m >= 0 && _to[_m] == '\\0'; _m--) { \\
+ _to[_m] = ' '; \\
+ } \\
+ } while (0)
+"""
+needs['STRINGCOPY']=['string.h', 'FAILNULL']
+cppmacros['STRINGCOPY']="""\
+#define STRINGCOPY(to,from)\\
+ do { FAILNULL(to); FAILNULL(from); (void)strcpy(to,from); } while (0)
+"""
+cppmacros['CHECKGENERIC']="""\
+#define CHECKGENERIC(check,tcheck,name) \\
+\tif (!(check)) {\\
+\t\tPyErr_SetString(#modulename#_error,\"(\"tcheck\") failed for \"name);\\
+\t\t/*goto capi_fail;*/\\
+\t} else """
+cppmacros['CHECKARRAY']="""\
+#define CHECKARRAY(check,tcheck,name) \\
+\tif (!(check)) {\\
+\t\tPyErr_SetString(#modulename#_error,\"(\"tcheck\") failed for \"name);\\
+\t\t/*goto capi_fail;*/\\
+\t} else """
+cppmacros['CHECKSTRING']="""\
+#define CHECKSTRING(check,tcheck,name,show,var)\\
+\tif (!(check)) {\\
+\t\tPyErr_SetString(#modulename#_error,\"(\"tcheck\") failed for \"name);\\
+\t\tfprintf(stderr,show\"\\n\",slen(var),var);\\
+\t\t/*goto capi_fail;*/\\
+\t} else """
+cppmacros['CHECKSCALAR']="""\
+#define CHECKSCALAR(check,tcheck,name,show,var)\\
+\tif (!(check)) {\\
+\t\tPyErr_SetString(#modulename#_error,\"(\"tcheck\") failed for \"name);\\
+\t\tfprintf(stderr,show\"\\n\",var);\\
+\t\t/*goto capi_fail;*/\\
+\t} else """
+## cppmacros['CHECKDIMS']="""\
+## #define CHECKDIMS(dims,rank) \\
+## \tfor (int i=0;i<(rank);i++)\\
+## \t\tif (dims[i]<0) {\\
+## \t\t\tfprintf(stderr,\"Unspecified array argument requires a complete dimension specification.\\n\");\\
+## \t\t\tgoto capi_fail;\\
+## \t\t}
+## """
+cppmacros['ARRSIZE']='#define ARRSIZE(dims,rank) (_PyArray_multiply_list(dims,rank))'
+cppmacros['OLDPYNUM']="""\
+#ifdef OLDPYNUM
+#error You need to intall Numeric Python version 13 or higher. Get it from http:/sourceforge.net/project/?group_id=1369
+#endif
+"""
+################# C functions ###############
+
+cfuncs['calcarrindex']="""\
+static int calcarrindex(int *i,PyArrayObject *arr) {
+\tint k,ii = i[0];
+\tfor (k=1; k < arr->nd; k++)
+\t\tii += (ii*(arr->dimensions[k] - 1)+i[k]); /* assuming contiguous arr */
+\treturn ii;
+}"""
+cfuncs['calcarrindextr']="""\
+static int calcarrindextr(int *i,PyArrayObject *arr) {
+\tint k,ii = i[arr->nd-1];
+\tfor (k=1; k < arr->nd; k++)
+\t\tii += (ii*(arr->dimensions[arr->nd-k-1] - 1)+i[arr->nd-k-1]); /* assuming contiguous arr */
+\treturn ii;
+}"""
+cfuncs['forcomb']="""\
+static struct { int nd;npy_intp *d;int *i,*i_tr,tr; } forcombcache;
+static int initforcomb(npy_intp *dims,int nd,int tr) {
+ int k;
+ if (dims==NULL) return 0;
+ if (nd<0) return 0;
+ forcombcache.nd = nd;
+ forcombcache.d = dims;
+ forcombcache.tr = tr;
+ if ((forcombcache.i = (int *)malloc(sizeof(int)*nd))==NULL) return 0;
+ if ((forcombcache.i_tr = (int *)malloc(sizeof(int)*nd))==NULL) return 0;
+ for (k=1;k<nd;k++) {
+ forcombcache.i[k] = forcombcache.i_tr[nd-k-1] = 0;
+ }
+ forcombcache.i[0] = forcombcache.i_tr[nd-1] = -1;
+ return 1;
+}
+static int *nextforcomb(void) {
+ int j,*i,*i_tr,k;
+ int nd=forcombcache.nd;
+ if ((i=forcombcache.i) == NULL) return NULL;
+ if ((i_tr=forcombcache.i_tr) == NULL) return NULL;
+ if (forcombcache.d == NULL) return NULL;
+ i[0]++;
+ if (i[0]==forcombcache.d[0]) {
+ j=1;
+ while ((j<nd) && (i[j]==forcombcache.d[j]-1)) j++;
+ if (j==nd) {
+ free(i);
+ free(i_tr);
+ return NULL;
+ }
+ for (k=0;k<j;k++) i[k] = i_tr[nd-k-1] = 0;
+ i[j]++;
+ i_tr[nd-j-1]++;
+ } else
+ i_tr[nd-1]++;
+ if (forcombcache.tr) return i_tr;
+ return i;
+}"""
+needs['try_pyarr_from_string']=['STRINGCOPYN','PRINTPYOBJERR','string']
+cfuncs['try_pyarr_from_string']="""\
+static int try_pyarr_from_string(PyObject *obj,const string str) {
+\tPyArrayObject *arr = NULL;
+\tif (PyArray_Check(obj) && (!((arr = (PyArrayObject *)obj) == NULL)))
+\t\t{ STRINGCOPYN(arr->data,str,PyArray_NBYTES(arr)); }
+\treturn 1;
+capi_fail:
+\tPRINTPYOBJERR(obj);
+\tPyErr_SetString(#modulename#_error,\"try_pyarr_from_string failed\");
+\treturn 0;
+}
+"""
+needs['string_from_pyobj']=['string','STRINGMALLOC','STRINGCOPYN']
+cfuncs['string_from_pyobj']="""\
+static int string_from_pyobj(string *str,int *len,const string inistr,PyObject *obj,const char *errmess) {
+\tPyArrayObject *arr = NULL;
+\tPyObject *tmp = NULL;
+#ifdef DEBUGCFUNCS
+fprintf(stderr,\"string_from_pyobj(str='%s',len=%d,inistr='%s',obj=%p)\\n\",(char*)str,*len,(char *)inistr,obj);
+#endif
+\tif (obj == Py_None) {
+\t\tif (*len == -1)
+\t\t\t*len = strlen(inistr); /* Will this cause problems? */
+\t\tSTRINGMALLOC(*str,*len);
+\t\tSTRINGCOPYN(*str,inistr,*len+1);
+\t\treturn 1;
+\t}
+\tif (PyArray_Check(obj)) {
+\t\tif ((arr = (PyArrayObject *)obj) == NULL)
+\t\t\tgoto capi_fail;
+\t\tif (!ISCONTIGUOUS(arr)) {
+\t\t\tPyErr_SetString(PyExc_ValueError,\"array object is non-contiguous.\");
+\t\t\tgoto capi_fail;
+\t\t}
+\t\tif (*len == -1)
+\t\t\t*len = (arr->descr->elsize)*PyArray_SIZE(arr);
+\t\tSTRINGMALLOC(*str,*len);
+\t\tSTRINGCOPYN(*str,arr->data,*len+1);
+\t\treturn 1;
+\t}
+\tif (PyString_Check(obj)) {
+\t\ttmp = obj;
+\t\tPy_INCREF(tmp);
+\t}
+\telse
+\t\ttmp = PyObject_Str(obj);
+\tif (tmp == NULL) goto capi_fail;
+\tif (*len == -1)
+\t\t*len = PyString_GET_SIZE(tmp);
+\tSTRINGMALLOC(*str,*len);
+\tSTRINGCOPYN(*str,PyString_AS_STRING(tmp),*len+1);
+\tPy_DECREF(tmp);
+\treturn 1;
+capi_fail:
+\tPy_XDECREF(tmp);
+\t{
+\t\tPyObject* err = PyErr_Occurred();
+\t\tif (err==NULL) err = #modulename#_error;
+\t\tPyErr_SetString(err,errmess);
+\t}
+\treturn 0;
+}
+"""
+needs['char_from_pyobj']=['int_from_pyobj']
+cfuncs['char_from_pyobj']="""\
+static int char_from_pyobj(char* v,PyObject *obj,const char *errmess) {
+\tint i=0;
+\tif (int_from_pyobj(&i,obj,errmess)) {
+\t\t*v = (char)i;
+\t\treturn 1;
+\t}
+\treturn 0;
+}
+"""
+needs['signed_char_from_pyobj']=['int_from_pyobj','signed_char']
+cfuncs['signed_char_from_pyobj']="""\
+static int signed_char_from_pyobj(signed_char* v,PyObject *obj,const char *errmess) {
+\tint i=0;
+\tif (int_from_pyobj(&i,obj,errmess)) {
+\t\t*v = (signed_char)i;
+\t\treturn 1;
+\t}
+\treturn 0;
+}
+"""
+needs['short_from_pyobj']=['int_from_pyobj']
+cfuncs['short_from_pyobj']="""\
+static int short_from_pyobj(short* v,PyObject *obj,const char *errmess) {
+\tint i=0;
+\tif (int_from_pyobj(&i,obj,errmess)) {
+\t\t*v = (short)i;
+\t\treturn 1;
+\t}
+\treturn 0;
+}
+"""
+cfuncs['int_from_pyobj']="""\
+static int int_from_pyobj(int* v,PyObject *obj,const char *errmess) {
+\tPyObject* tmp = NULL;
+\tif (PyInt_Check(obj)) {
+\t\t*v = (int)PyInt_AS_LONG(obj);
+\t\treturn 1;
+\t}
+\ttmp = PyNumber_Int(obj);
+\tif (tmp) {
+\t\t*v = PyInt_AS_LONG(tmp);
+\t\tPy_DECREF(tmp);
+\t\treturn 1;
+\t}
+\tif (PyComplex_Check(obj))
+\t\ttmp = PyObject_GetAttrString(obj,\"real\");
+\telse if (PyString_Check(obj))
+\t\t/*pass*/;
+\telse if (PySequence_Check(obj))
+\t\ttmp = PySequence_GetItem(obj,0);
+\tif (tmp) {
+\t\tPyErr_Clear();
+\t\tif (int_from_pyobj(v,tmp,errmess)) {Py_DECREF(tmp); return 1;}
+\t\tPy_DECREF(tmp);
+\t}
+\t{
+\t\tPyObject* err = PyErr_Occurred();
+\t\tif (err==NULL) err = #modulename#_error;
+\t\tPyErr_SetString(err,errmess);
+\t}
+\treturn 0;
+}
+"""
+cfuncs['long_from_pyobj']="""\
+static int long_from_pyobj(long* v,PyObject *obj,const char *errmess) {
+\tPyObject* tmp = NULL;
+\tif (PyInt_Check(obj)) {
+\t\t*v = PyInt_AS_LONG(obj);
+\t\treturn 1;
+\t}
+\ttmp = PyNumber_Int(obj);
+\tif (tmp) {
+\t\t*v = PyInt_AS_LONG(tmp);
+\t\tPy_DECREF(tmp);
+\t\treturn 1;
+\t}
+\tif (PyComplex_Check(obj))
+\t\ttmp = PyObject_GetAttrString(obj,\"real\");
+\telse if (PyString_Check(obj))
+\t\t/*pass*/;
+\telse if (PySequence_Check(obj))
+\t\ttmp = PySequence_GetItem(obj,0);
+\tif (tmp) {
+\t\tPyErr_Clear();
+\t\tif (long_from_pyobj(v,tmp,errmess)) {Py_DECREF(tmp); return 1;}
+\t\tPy_DECREF(tmp);
+\t}
+\t{
+\t\tPyObject* err = PyErr_Occurred();
+\t\tif (err==NULL) err = #modulename#_error;
+\t\tPyErr_SetString(err,errmess);
+\t}
+\treturn 0;
+}
+"""
+needs['long_long_from_pyobj']=['long_long']
+cfuncs['long_long_from_pyobj']="""\
+static int long_long_from_pyobj(long_long* v,PyObject *obj,const char *errmess) {
+\tPyObject* tmp = NULL;
+\tif (PyLong_Check(obj)) {
+\t\t*v = PyLong_AsLongLong(obj);
+\t\treturn (!PyErr_Occurred());
+\t}
+\tif (PyInt_Check(obj)) {
+\t\t*v = (long_long)PyInt_AS_LONG(obj);
+\t\treturn 1;
+\t}
+\ttmp = PyNumber_Long(obj);
+\tif (tmp) {
+\t\t*v = PyLong_AsLongLong(tmp);
+\t\tPy_DECREF(tmp);
+\t\treturn (!PyErr_Occurred());
+\t}
+\tif (PyComplex_Check(obj))
+\t\ttmp = PyObject_GetAttrString(obj,\"real\");
+\telse if (PyString_Check(obj))
+\t\t/*pass*/;
+\telse if (PySequence_Check(obj))
+\t\ttmp = PySequence_GetItem(obj,0);
+\tif (tmp) {
+\t\tPyErr_Clear();
+\t\tif (long_long_from_pyobj(v,tmp,errmess)) {Py_DECREF(tmp); return 1;}
+\t\tPy_DECREF(tmp);
+\t}
+\t{
+\t\tPyObject* err = PyErr_Occurred();
+\t\tif (err==NULL) err = #modulename#_error;
+\t\tPyErr_SetString(err,errmess);
+\t}
+\treturn 0;
+}
+"""
+needs['long_double_from_pyobj']=['double_from_pyobj','long_double']
+cfuncs['long_double_from_pyobj']="""\
+static int long_double_from_pyobj(long_double* v,PyObject *obj,const char *errmess) {
+\tdouble d=0;
+\tif (PyArray_CheckScalar(obj)){
+\t\tif PyArray_IsScalar(obj, LongDouble) {
+\t\t\tPyArray_ScalarAsCtype(obj, v);
+\t\t\treturn 1;
+\t\t}
+\t\telse if (PyArray_Check(obj) && PyArray_TYPE(obj)==PyArray_LONGDOUBLE) {
+\t\t\t(*v) = *((npy_longdouble *)PyArray_DATA(obj))
+\t\t\treturn 1;
+\t\t}
+\t}
+\tif (double_from_pyobj(&d,obj,errmess)) {
+\t\t*v = (long_double)d;
+\t\treturn 1;
+\t}
+\treturn 0;
+}
+"""
+cfuncs['double_from_pyobj']="""\
+static int double_from_pyobj(double* v,PyObject *obj,const char *errmess) {
+\tPyObject* tmp = NULL;
+\tif (PyFloat_Check(obj)) {
+#ifdef __sgi
+\t\t*v = PyFloat_AsDouble(obj);
+#else
+\t\t*v = PyFloat_AS_DOUBLE(obj);
+#endif
+\t\treturn 1;
+\t}
+\ttmp = PyNumber_Float(obj);
+\tif (tmp) {
+#ifdef __sgi
+\t\t*v = PyFloat_AsDouble(tmp);
+#else
+\t\t*v = PyFloat_AS_DOUBLE(tmp);
+#endif
+\t\tPy_DECREF(tmp);
+\t\treturn 1;
+\t}
+\tif (PyComplex_Check(obj))
+\t\ttmp = PyObject_GetAttrString(obj,\"real\");
+\telse if (PyString_Check(obj))
+\t\t/*pass*/;
+\telse if (PySequence_Check(obj))
+\t\ttmp = PySequence_GetItem(obj,0);
+\tif (tmp) {
+\t\tPyErr_Clear();
+\t\tif (double_from_pyobj(v,tmp,errmess)) {Py_DECREF(tmp); return 1;}
+\t\tPy_DECREF(tmp);
+\t}
+\t{
+\t\tPyObject* err = PyErr_Occurred();
+\t\tif (err==NULL) err = #modulename#_error;
+\t\tPyErr_SetString(err,errmess);
+\t}
+\treturn 0;
+}
+"""
+needs['float_from_pyobj']=['double_from_pyobj']
+cfuncs['float_from_pyobj']="""\
+static int float_from_pyobj(float* v,PyObject *obj,const char *errmess) {
+\tdouble d=0.0;
+\tif (double_from_pyobj(&d,obj,errmess)) {
+\t\t*v = (float)d;
+\t\treturn 1;
+\t}
+\treturn 0;
+}
+"""
+needs['complex_long_double_from_pyobj']=['complex_long_double','long_double',
+ 'complex_double_from_pyobj']
+cfuncs['complex_long_double_from_pyobj']="""\
+static int complex_long_double_from_pyobj(complex_long_double* v,PyObject *obj,const char *errmess) {
+\tcomplex_double cd={0.0,0.0};
+\tif (PyArray_CheckScalar(obj)){
+\t\tif PyArray_IsScalar(obj, CLongDouble) {
+\t\t\tPyArray_ScalarAsCtype(obj, v);
+\t\t\treturn 1;
+\t\t}
+\t\telse if (PyArray_Check(obj) && PyArray_TYPE(obj)==PyArray_CLONGDOUBLE) {
+\t\t\t(*v).r = ((npy_clongdouble *)PyArray_DATA(obj))->real;
+\t\t\t(*v).i = ((npy_clongdouble *)PyArray_DATA(obj))->imag;
+\t\t\treturn 1;
+\t\t}
+\t}
+\tif (complex_double_from_pyobj(&cd,obj,errmess)) {
+\t\t(*v).r = (long_double)cd.r;
+\t\t(*v).i = (long_double)cd.i;
+\t\treturn 1;
+\t}
+\treturn 0;
+}
+"""
+needs['complex_double_from_pyobj']=['complex_double']
+cfuncs['complex_double_from_pyobj']="""\
+static int complex_double_from_pyobj(complex_double* v,PyObject *obj,const char *errmess) {
+\tPy_complex c;
+\tif (PyComplex_Check(obj)) {
+\t\tc=PyComplex_AsCComplex(obj);
+\t\t(*v).r=c.real, (*v).i=c.imag;
+\t\treturn 1;
+\t}
+\tif (PyArray_IsScalar(obj, ComplexFloating)) {
+\t\tif (PyArray_IsScalar(obj, CFloat)) {
+\t\t\tnpy_cfloat new;
+\t\t\tPyArray_ScalarAsCtype(obj, &new);
+\t\t\t(*v).r = (double)new.real;
+\t\t\t(*v).i = (double)new.imag;
+\t\t}
+\t\telse if (PyArray_IsScalar(obj, CLongDouble)) {
+\t\t\tnpy_clongdouble new;
+\t\t\tPyArray_ScalarAsCtype(obj, &new);
+\t\t\t(*v).r = (double)new.real;
+\t\t\t(*v).i = (double)new.imag;
+\t\t}
+\t\telse { /* if (PyArray_IsScalar(obj, CDouble)) */
+\t\t\tPyArray_ScalarAsCtype(obj, v);
+\t\t}
+\t\treturn 1;
+\t}
+\tif (PyArray_CheckScalar(obj)) { /* 0-dim array or still array scalar */
+\t\tPyObject *arr;
+\t\tif (PyArray_Check(obj)) {
+\t\t\tarr = PyArray_Cast((PyArrayObject *)obj, PyArray_CDOUBLE);
+\t\t}
+\t\telse {
+\t\t\tarr = PyArray_FromScalar(obj, PyArray_DescrFromType(PyArray_CDOUBLE));
+\t\t}
+\t\tif (arr==NULL) return 0;
+\t\t(*v).r = ((npy_cdouble *)PyArray_DATA(arr))->real;
+\t\t(*v).i = ((npy_cdouble *)PyArray_DATA(arr))->imag;
+\t\treturn 1;
+\t}
+\t/* Python does not provide PyNumber_Complex function :-( */
+\t(*v).i=0.0;
+\tif (PyFloat_Check(obj)) {
+#ifdef __sgi
+\t\t(*v).r = PyFloat_AsDouble(obj);
+#else
+\t\t(*v).r = PyFloat_AS_DOUBLE(obj);
+#endif
+\t\treturn 1;
+\t}
+\tif (PyInt_Check(obj)) {
+\t\t(*v).r = (double)PyInt_AS_LONG(obj);
+\t\treturn 1;
+\t}
+\tif (PyLong_Check(obj)) {
+\t\t(*v).r = PyLong_AsDouble(obj);
+\t\treturn (!PyErr_Occurred());
+\t}
+\tif (PySequence_Check(obj) && (!PyString_Check(obj))) {
+\t\tPyObject *tmp = PySequence_GetItem(obj,0);
+\t\tif (tmp) {
+\t\t\tif (complex_double_from_pyobj(v,tmp,errmess)) {
+\t\t\t\tPy_DECREF(tmp);
+\t\t\t\treturn 1;
+\t\t\t}
+\t\t\tPy_DECREF(tmp);
+\t\t}
+\t}
+\t{
+\t\tPyObject* err = PyErr_Occurred();
+\t\tif (err==NULL)
+\t\t\terr = PyExc_TypeError;
+\t\tPyErr_SetString(err,errmess);
+\t}
+\treturn 0;
+}
+"""
+needs['complex_float_from_pyobj']=['complex_float','complex_double_from_pyobj']
+cfuncs['complex_float_from_pyobj']="""\
+static int complex_float_from_pyobj(complex_float* v,PyObject *obj,const char *errmess) {
+\tcomplex_double cd={0.0,0.0};
+\tif (complex_double_from_pyobj(&cd,obj,errmess)) {
+\t\t(*v).r = (float)cd.r;
+\t\t(*v).i = (float)cd.i;
+\t\treturn 1;
+\t}
+\treturn 0;
+}
+"""
+needs['try_pyarr_from_char']=['pyobj_from_char1','TRYPYARRAYTEMPLATE']
+cfuncs['try_pyarr_from_char']='static int try_pyarr_from_char(PyObject* obj,char* v) {\n\tTRYPYARRAYTEMPLATE(char,\'c\');\n}\n'
+needs['try_pyarr_from_signed_char']=['TRYPYARRAYTEMPLATE','unsigned_char']
+cfuncs['try_pyarr_from_unsigned_char']='static int try_pyarr_from_unsigned_char(PyObject* obj,unsigned_char* v) {\n\tTRYPYARRAYTEMPLATE(unsigned_char,\'b\');\n}\n'
+needs['try_pyarr_from_signed_char']=['TRYPYARRAYTEMPLATE','signed_char']
+cfuncs['try_pyarr_from_signed_char']='static int try_pyarr_from_signed_char(PyObject* obj,signed_char* v) {\n\tTRYPYARRAYTEMPLATE(signed_char,\'1\');\n}\n'
+needs['try_pyarr_from_short']=['pyobj_from_short1','TRYPYARRAYTEMPLATE']
+cfuncs['try_pyarr_from_short']='static int try_pyarr_from_short(PyObject* obj,short* v) {\n\tTRYPYARRAYTEMPLATE(short,\'s\');\n}\n'
+needs['try_pyarr_from_int']=['pyobj_from_int1','TRYPYARRAYTEMPLATE']
+cfuncs['try_pyarr_from_int']='static int try_pyarr_from_int(PyObject* obj,int* v) {\n\tTRYPYARRAYTEMPLATE(int,\'i\');\n}\n'
+needs['try_pyarr_from_long']=['pyobj_from_long1','TRYPYARRAYTEMPLATE']
+cfuncs['try_pyarr_from_long']='static int try_pyarr_from_long(PyObject* obj,long* v) {\n\tTRYPYARRAYTEMPLATE(long,\'l\');\n}\n'
+needs['try_pyarr_from_long_long']=['pyobj_from_long_long1','TRYPYARRAYTEMPLATE','long_long']
+cfuncs['try_pyarr_from_long_long']='static int try_pyarr_from_long_long(PyObject* obj,long_long* v) {\n\tTRYPYARRAYTEMPLATE(long_long,\'L\');\n}\n'
+needs['try_pyarr_from_float']=['pyobj_from_float1','TRYPYARRAYTEMPLATE']
+cfuncs['try_pyarr_from_float']='static int try_pyarr_from_float(PyObject* obj,float* v) {\n\tTRYPYARRAYTEMPLATE(float,\'f\');\n}\n'
+needs['try_pyarr_from_double']=['pyobj_from_double1','TRYPYARRAYTEMPLATE']
+cfuncs['try_pyarr_from_double']='static int try_pyarr_from_double(PyObject* obj,double* v) {\n\tTRYPYARRAYTEMPLATE(double,\'d\');\n}\n'
+needs['try_pyarr_from_complex_float']=['pyobj_from_complex_float1','TRYCOMPLEXPYARRAYTEMPLATE','complex_float']
+cfuncs['try_pyarr_from_complex_float']='static int try_pyarr_from_complex_float(PyObject* obj,complex_float* v) {\n\tTRYCOMPLEXPYARRAYTEMPLATE(float,\'F\');\n}\n'
+needs['try_pyarr_from_complex_double']=['pyobj_from_complex_double1','TRYCOMPLEXPYARRAYTEMPLATE','complex_double']
+cfuncs['try_pyarr_from_complex_double']='static int try_pyarr_from_complex_double(PyObject* obj,complex_double* v) {\n\tTRYCOMPLEXPYARRAYTEMPLATE(double,\'D\');\n}\n'
+
+needs['create_cb_arglist']=['CFUNCSMESS','PRINTPYOBJERR','MINMAX']
+cfuncs['create_cb_arglist']="""\
+static int create_cb_arglist(PyObject* fun,PyTupleObject* xa,const int maxnofargs,const int nofoptargs,int *nofargs,PyTupleObject **args,const char *errmess) {
+\tPyObject *tmp = NULL;
+\tPyObject *tmp_fun = NULL;
+\tint tot,opt,ext,siz,i,di=0;
+\tCFUNCSMESS(\"create_cb_arglist\\n\");
+\ttot=opt=ext=siz=0;
+\t/* Get the total number of arguments */
+\tif (PyFunction_Check(fun))
+\t\ttmp_fun = fun;
+\telse {
+\t\tdi = 1;
+\t\tif (PyObject_HasAttrString(fun,\"im_func\")) {
+\t\t\ttmp_fun = PyObject_GetAttrString(fun,\"im_func\");
+\t\t}
+\t\telse if (PyObject_HasAttrString(fun,\"__call__\")) {
+\t\t\ttmp = PyObject_GetAttrString(fun,\"__call__\");
+\t\t\tif (PyObject_HasAttrString(tmp,\"im_func\"))
+\t\t\t\ttmp_fun = PyObject_GetAttrString(tmp,\"im_func\");
+\t\t\telse {
+\t\t\t\ttmp_fun = fun; /* built-in function */
+\t\t\t\ttot = maxnofargs;
+\t\t\t\tif (xa != NULL)
+\t\t\t\t\ttot += PyTuple_Size((PyObject *)xa);
+\t\t\t}
+\t\t\tPy_XDECREF(tmp);
+\t\t}
+\t\telse if (PyFortran_Check(fun) || PyFortran_Check1(fun)) {
+\t\t\ttot = maxnofargs;
+\t\t\tif (xa != NULL)
+\t\t\t\ttot += PyTuple_Size((PyObject *)xa);
+\t\t\ttmp_fun = fun;
+\t\t}
+\t\telse if (PyCObject_Check(fun)) {
+\t\t\ttot = maxnofargs;
+\t\t\tif (xa != NULL)
+\t\t\t\text = PyTuple_Size((PyObject *)xa);
+\t\t\tif(ext>0) {
+\t\t\t\tfprintf(stderr,\"extra arguments tuple cannot be used with CObject call-back\\n\");
+\t\t\t\tgoto capi_fail;
+\t\t\t}
+\t\t\ttmp_fun = fun;
+\t\t}
+\t}
+if (tmp_fun==NULL) {
+fprintf(stderr,\"Call-back argument must be function|instance|instance.__call__|f2py-function but got %s.\\n\",(fun==NULL?\"NULL\":fun->ob_type->tp_name));
+goto capi_fail;
+}
+\tif (PyObject_HasAttrString(tmp_fun,\"func_code\")) {
+\t\tif (PyObject_HasAttrString(tmp = PyObject_GetAttrString(tmp_fun,\"func_code\"),\"co_argcount\"))
+\t\t\ttot = PyInt_AsLong(PyObject_GetAttrString(tmp,\"co_argcount\")) - di;
+\t\tPy_XDECREF(tmp);
+\t}
+\t/* Get the number of optional arguments */
+\tif (PyObject_HasAttrString(tmp_fun,\"func_defaults\"))
+\t\tif (PyTuple_Check(tmp = PyObject_GetAttrString(tmp_fun,\"func_defaults\")))
+\t\t\topt = PyTuple_Size(tmp);
+\t\tPy_XDECREF(tmp);
+\t/* Get the number of extra arguments */
+\tif (xa != NULL)
+\t\text = PyTuple_Size((PyObject *)xa);
+\t/* Calculate the size of call-backs argument list */
+\tsiz = MIN(maxnofargs+ext,tot);
+\t*nofargs = MAX(0,siz-ext);
+#ifdef DEBUGCFUNCS
+\tfprintf(stderr,\"debug-capi:create_cb_arglist:maxnofargs(-nofoptargs),tot,opt,ext,siz,nofargs=%d(-%d),%d,%d,%d,%d,%d\\n\",maxnofargs,nofoptargs,tot,opt,ext,siz,*nofargs);
+#endif
+\tif (siz<tot-opt) {
+\t\tfprintf(stderr,\"create_cb_arglist: Failed to build argument list (siz) with enough arguments (tot-opt) required by user-supplied function (siz,tot,opt=%d,%d,%d).\\n\",siz,tot,opt);
+\t\tgoto capi_fail;
+\t}
+\t/* Initialize argument list */
+\t*args = (PyTupleObject *)PyTuple_New(siz);
+\tfor (i=0;i<*nofargs;i++) {
+\t\tPy_INCREF(Py_None);
+\t\tPyTuple_SET_ITEM((PyObject *)(*args),i,Py_None);
+\t}
+\tif (xa != NULL)
+\t\tfor (i=(*nofargs);i<siz;i++) {
+\t\t\ttmp = PyTuple_GetItem((PyObject *)xa,i-(*nofargs));
+\t\t\tPy_INCREF(tmp);
+\t\t\tPyTuple_SET_ITEM(*args,i,tmp);
+\t\t}
+\tCFUNCSMESS(\"create_cb_arglist-end\\n\");
+\treturn 1;
+capi_fail:
+\tif ((PyErr_Occurred())==NULL)
+\t\tPyErr_SetString(#modulename#_error,errmess);
+\treturn 0;
+}
+"""
+
+def buildcfuncs():
+ from capi_maps import c2capi_map
+ for k in c2capi_map.keys():
+ m='pyarr_from_p_%s1'%k
+ cppmacros[m]='#define %s(v) (PyArray_SimpleNewFromData(0,NULL,%s,(char *)v))'%(m,c2capi_map[k])
+ k='string'
+ m='pyarr_from_p_%s1'%k
+ cppmacros[m]='#define %s(v,dims) (PyArray_SimpleNewFromData(1,dims,PyArray_CHAR,(char *)v))'%(m)
+
+
+############ Auxiliary functions for sorting needs ###################
+
+def append_needs(need,flag=1):
+ global outneeds,needs
+ if type(need)==types.ListType:
+ for n in need:
+ append_needs(n,flag)
+ elif type(need)==types.StringType:
+ if not need: return
+ if includes0.has_key(need): n = 'includes0'
+ elif includes.has_key(need): n = 'includes'
+ elif typedefs.has_key(need): n = 'typedefs'
+ elif typedefs_generated.has_key(need): n = 'typedefs_generated'
+ elif cppmacros.has_key(need): n = 'cppmacros'
+ elif cfuncs.has_key(need): n = 'cfuncs'
+ elif callbacks.has_key(need): n = 'callbacks'
+ elif f90modhooks.has_key(need): n = 'f90modhooks'
+ elif commonhooks.has_key(need): n = 'commonhooks'
+ else:
+ errmess('append_needs: unknown need %s\n'%(`need`))
+ return
+ if need in outneeds[n]: return
+ if flag:
+ tmp={}
+ if needs.has_key(need):
+ for nn in needs[need]:
+ t=append_needs(nn,0)
+ if type(t)==types.DictType:
+ for nnn in t.keys():
+ if tmp.has_key(nnn): tmp[nnn]=tmp[nnn]+t[nnn]
+ else: tmp[nnn]=t[nnn]
+ for nn in tmp.keys():
+ for nnn in tmp[nn]:
+ if nnn not in outneeds[nn]:
+ outneeds[nn]=[nnn]+outneeds[nn]
+ outneeds[n].append(need)
+ else:
+ tmp={}
+ if needs.has_key(need):
+ for nn in needs[need]:
+ t=append_needs(nn,flag)
+ if type(t)==types.DictType:
+ for nnn in t.keys():
+ if tmp.has_key(nnn): tmp[nnn]=t[nnn]+tmp[nnn]
+ else: tmp[nnn]=t[nnn]
+ if not tmp.has_key(n): tmp[n]=[]
+ tmp[n].append(need)
+ return tmp
+ else:
+ errmess('append_needs: expected list or string but got :%s\n'%(`need`))
+
+def get_needs():
+ global outneeds,needs
+ res={}
+ for n in outneeds.keys():
+ out=[]
+ saveout=copy.copy(outneeds[n])
+ while len(outneeds[n])>0:
+ if not needs.has_key(outneeds[n][0]):
+ out.append(outneeds[n][0])
+ del outneeds[n][0]
+ else:
+ flag=0
+ for k in outneeds[n][1:]:
+ if k in needs[outneeds[n][0]]:
+ flag=1
+ break
+ if flag:
+ outneeds[n]=outneeds[n][1:]+[outneeds[n][0]]
+ else:
+ out.append(outneeds[n][0])
+ del outneeds[n][0]
+ if saveout and (0 not in map(lambda x,y:x==y,saveout,outneeds[n])):
+ print n,saveout
+ errmess('get_needs: no progress in sorting needs, probably circular dependence, skipping.\n')
+ out=out+saveout
+ break
+ saveout=copy.copy(outneeds[n])
+ if out==[]: out=[n]
+ res[n]=out
+ return res
diff --git a/numpy/f2py/common_rules.py b/numpy/f2py/common_rules.py
new file mode 100644
index 000000000..d97a89cf8
--- /dev/null
+++ b/numpy/f2py/common_rules.py
@@ -0,0 +1,131 @@
+#!/usr/bin/env python
+"""
+
+Build common block mechanism for f2py2e.
+
+Copyright 2000 Pearu Peterson all rights reserved,
+Pearu Peterson <pearu@ioc.ee>
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+$Date: 2005/05/06 10:57:33 $
+Pearu Peterson
+"""
+
+__version__ = "$Revision: 1.19 $"[10:-1]
+
+import __version__
+f2py_version = __version__.version
+
+import pprint
+import sys,string,time,types,copy
+errmess=sys.stderr.write
+outmess=sys.stdout.write
+show=pprint.pprint
+
+from auxfuncs import *
+import capi_maps
+import cfuncs
+import func2subr
+from crackfortran import rmbadname
+##############
+
+def findcommonblocks(block,top=1):
+ ret = []
+ if hascommon(block):
+ for n in block['common'].keys():
+ vars={}
+ for v in block['common'][n]:
+ vars[v]=block['vars'][v]
+ ret.append((n,block['common'][n],vars))
+ elif hasbody(block):
+ for b in block['body']:
+ ret=ret+findcommonblocks(b,0)
+ if top:
+ tret=[]
+ names=[]
+ for t in ret:
+ if t[0] not in names:
+ names.append(t[0])
+ tret.append(t)
+ return tret
+ return ret
+
+def buildhooks(m):
+ ret = {'commonhooks':[],'initcommonhooks':[],'docs':['"COMMON blocks:\\n"']}
+ fwrap = ['']
+ def fadd(line,s=fwrap): s[0] = '%s\n %s'%(s[0],line)
+ chooks = ['']
+ def cadd(line,s=chooks): s[0] = '%s\n%s'%(s[0],line)
+ ihooks = ['']
+ def iadd(line,s=ihooks): s[0] = '%s\n%s'%(s[0],line)
+ doc = ['']
+ def dadd(line,s=doc): s[0] = '%s\n%s'%(s[0],line)
+ for (name,vnames,vars) in findcommonblocks(m):
+ lower_name = string.lower(name)
+ hnames,inames = [],[]
+ for n in vnames:
+ if isintent_hide(vars[n]): hnames.append(n)
+ else: inames.append(n)
+ if hnames:
+ outmess('\t\tConstructing COMMON block support for "%s"...\n\t\t %s\n\t\t Hidden: %s\n'%(name,string.join(inames,','),string.join(hnames,',')))
+ else:
+ outmess('\t\tConstructing COMMON block support for "%s"...\n\t\t %s\n'%(name,string.join(inames,',')))
+ fadd('subroutine f2pyinit%s(setupfunc)'%name)
+ fadd('external setupfunc')
+ for n in vnames:
+ fadd(func2subr.var2fixfortran(vars,n))
+ if name=='_BLNK_':
+ fadd('common %s'%(string.join(vnames,',')))
+ else:
+ fadd('common /%s/ %s'%(name,string.join(vnames,',')))
+ fadd('call setupfunc(%s)'%(string.join(inames,',')))
+ fadd('end\n')
+ cadd('static FortranDataDef f2py_%s_def[] = {'%(name))
+ idims=[]
+ for n in inames:
+ ct = capi_maps.getctype(vars[n])
+ at = capi_maps.c2capi_map[ct]
+ dm = capi_maps.getarrdims(n,vars[n])
+ if dm['dims']: idims.append('(%s)'%(dm['dims']))
+ else: idims.append('')
+ dms=string.strip(dm['dims'])
+ if not dms: dms='-1'
+ cadd('\t{\"%s\",%s,{{%s}},%s},'%(n,dm['rank'],dms,at))
+ cadd('\t{NULL}\n};')
+ inames1 = rmbadname(inames)
+ inames1_tps = string.join(map(lambda s:'char *'+s,inames1),',')
+ cadd('static void f2py_setup_%s(%s) {'%(name,inames1_tps))
+ cadd('\tint i_f2py=0;')
+ for n in inames1:
+ cadd('\tf2py_%s_def[i_f2py++].data = %s;'%(name,n))
+ cadd('}')
+ if '_' in lower_name:
+ F_FUNC='F_FUNC_US'
+ else:
+ F_FUNC='F_FUNC'
+ cadd('extern void %s(f2pyinit%s,F2PYINIT%s)(void(*)(%s));'\
+ %(F_FUNC,lower_name,string.upper(name),
+ string.join(['char*']*len(inames1),',')))
+ cadd('static void f2py_init_%s(void) {'%name)
+ cadd('\t%s(f2pyinit%s,F2PYINIT%s)(f2py_setup_%s);'\
+ %(F_FUNC,lower_name,string.upper(name),name))
+ cadd('}\n')
+ iadd('\tF2PyDict_SetItemString(d, \"%s\", PyFortranObject_New(f2py_%s_def,f2py_init_%s));'%(name,name,name))
+ tname = string.replace(name,'_','\\_')
+ dadd('\\subsection{Common block \\texttt{%s}}\n'%(tname))
+ dadd('\\begin{description}')
+ for n in inames:
+ dadd('\\item[]{{}\\verb@%s@{}}'%(capi_maps.getarrdocsign(n,vars[n])))
+ if hasnote(vars[n]):
+ note = vars[n]['note']
+ if type(note) is type([]): note=string.join(note,'\n')
+ dadd('--- %s'%(note))
+ dadd('\\end{description}')
+ ret['docs'].append('"\t/%s/ %s\\n"'%(name,string.join(map(lambda v,d:v+d,inames,idims),',')))
+ ret['commonhooks']=chooks
+ ret['initcommonhooks']=ihooks
+ ret['latexdoc']=doc[0]
+ if len(ret['docs'])<=1: ret['docs']=''
+ return ret,fwrap[0]
diff --git a/numpy/f2py/crackfortran.py b/numpy/f2py/crackfortran.py
new file mode 100755
index 000000000..3765a4b1b
--- /dev/null
+++ b/numpy/f2py/crackfortran.py
@@ -0,0 +1,2673 @@
+#!/usr/bin/env python
+"""
+crackfortran --- read fortran (77,90) code and extract declaration information.
+ Usage is explained in the comment block below.
+
+Copyright 1999-2004 Pearu Peterson all rights reserved,
+Pearu Peterson <pearu@ioc.ee>
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+$Date: 2005/09/27 07:13:49 $
+Pearu Peterson
+"""
+__version__ = "$Revision: 1.177 $"[10:-1]
+
+import __version__
+f2py_version = __version__.version
+
+"""
+ Usage of crackfortran:
+ ======================
+ Command line keys: -quiet,-verbose,-fix,-f77,-f90,-show,-h <pyffilename>
+ -m <module name for f77 routines>,--ignore-contains
+ Functions: crackfortran, crack2fortran
+ The following Fortran statements/constructions are supported
+ (or will be if needed):
+ block data,byte,call,character,common,complex,contains,data,
+ dimension,double complex,double precision,end,external,function,
+ implicit,integer,intent,interface,intrinsic,
+ logical,module,optional,parameter,private,public,
+ program,real,(sequence?),subroutine,type,use,virtual,
+ include,pythonmodule
+ Note: 'virtual' is mapped to 'dimension'.
+ Note: 'implicit integer (z) static (z)' is 'implicit static (z)' (this is minor bug).
+ Note: code after 'contains' will be ignored until its scope ends.
+ Note: 'common' statement is extended: dimensions are moved to variable definitions
+ Note: f2py directive: <commentchar>f2py<line> is read as <line>
+ Note: pythonmodule is introduced to represent Python module
+
+ Usage:
+ `postlist=crackfortran(files,funcs)`
+ `postlist` contains declaration information read from the list of files `files`.
+ `crack2fortran(postlist)` returns a fortran code to be saved to pyf-file
+
+ `postlist` has the following structure:
+ *** it is a list of dictionaries containing `blocks':
+ B = {'block','body','vars','parent_block'[,'name','prefix','args','result',
+ 'implicit','externals','interfaced','common','sortvars',
+ 'commonvars','note']}
+ B['block'] = 'interface' | 'function' | 'subroutine' | 'module' |
+ 'program' | 'block data' | 'type' | 'pythonmodule'
+ B['body'] --- list containing `subblocks' with the same structure as `blocks'
+ B['parent_block'] --- dictionary of a parent block:
+ C['body'][<index>]['parent_block'] is C
+ B['vars'] --- dictionary of variable definitions
+ B['sortvars'] --- dictionary of variable definitions sorted by dependence (independent first)
+ B['name'] --- name of the block (not if B['block']=='interface')
+ B['prefix'] --- prefix string (only if B['block']=='function')
+ B['args'] --- list of argument names if B['block']== 'function' | 'subroutine'
+ B['result'] --- name of the return value (only if B['block']=='function')
+ B['implicit'] --- dictionary {'a':<variable definition>,'b':...} | None
+ B['externals'] --- list of variables being external
+ B['interfaced'] --- list of variables being external and defined
+ B['common'] --- dictionary of common blocks (list of objects)
+ B['commonvars'] --- list of variables used in common blocks (dimensions are moved to variable definitions)
+ B['from'] --- string showing the 'parents' of the current block
+ B['use'] --- dictionary of modules used in current block:
+ {<modulename>:{['only':<0|1>],['map':{<local_name1>:<use_name1>,...}]}}
+ B['note'] --- list of LaTeX comments on the block
+ B['f2pyenhancements'] --- optional dictionary
+ {'threadsafe':'','fortranname':<name>,
+ 'callstatement':<C-expr>|<multi-line block>,
+ 'callprotoargument':<C-expr-list>,
+ 'usercode':<multi-line block>|<list of multi-line blocks>,
+ 'pymethoddef:<multi-line block>'
+ }
+ B['entry'] --- dictionary {entryname:argslist,..}
+ B['varnames'] --- list of variable names given in the order of reading the
+ Fortran code, useful for derived types.
+ *** Variable definition is a dictionary
+ D = B['vars'][<variable name>] =
+ {'typespec'[,'attrspec','kindselector','charselector','=','typename']}
+ D['typespec'] = 'byte' | 'character' | 'complex' | 'double complex' |
+ 'double precision' | 'integer' | 'logical' | 'real' | 'type'
+ D['attrspec'] --- list of attributes (e.g. 'dimension(<arrayspec>)',
+ 'external','intent(in|out|inout|hide|c|callback|cache)',
+ 'optional','required', etc)
+ K = D['kindselector'] = {['*','kind']} (only if D['typespec'] =
+ 'complex' | 'integer' | 'logical' | 'real' )
+ C = D['charselector'] = {['*','len','kind']}
+ (only if D['typespec']=='character')
+ D['='] --- initialization expression string
+ D['typename'] --- name of the type if D['typespec']=='type'
+ D['dimension'] --- list of dimension bounds
+ D['intent'] --- list of intent specifications
+ D['depend'] --- list of variable names on which current variable depends on
+ D['check'] --- list of C-expressions; if C-expr returns zero, exception is raised
+ D['note'] --- list of LaTeX comments on the variable
+ *** Meaning of kind/char selectors (few examples):
+ D['typespec>']*K['*']
+ D['typespec'](kind=K['kind'])
+ character*C['*']
+ character(len=C['len'],kind=C['kind'])
+ (see also fortran type declaration statement formats below)
+
+ Fortran 90 type declaration statement format (F77 is subset of F90)
+====================================================================
+ (Main source: IBM XL Fortran 5.1 Language Reference Manual)
+ type declaration = <typespec> [[<attrspec>]::] <entitydecl>
+ <typespec> = byte |
+ character[<charselector>] |
+ complex[<kindselector>] |
+ double complex |
+ double precision |
+ integer[<kindselector>] |
+ logical[<kindselector>] |
+ real[<kindselector>] |
+ type(<typename>)
+ <charselector> = * <charlen> |
+ ([len=]<len>[,[kind=]<kind>]) |
+ (kind=<kind>[,len=<len>])
+ <kindselector> = * <intlen> |
+ ([kind=]<kind>)
+ <attrspec> = comma separated list of attributes.
+ Only the following attributes are used in
+ building up the interface:
+ external
+ (parameter --- affects '=' key)
+ optional
+ intent
+ Other attributes are ignored.
+ <intentspec> = in | out | inout
+ <arrayspec> = comma separated list of dimension bounds.
+ <entitydecl> = <name> [[*<charlen>][(<arrayspec>)] | [(<arrayspec>)]*<charlen>]
+ [/<init_expr>/ | =<init_expr>] [,<entitydecl>]
+
+ In addition, the following attributes are used: check,depend,note
+
+ TODO:
+ * Apply 'parameter' attribute (e.g. 'integer parameter :: i=2' 'real x(i)'
+ -> 'real x(2)')
+ The above may be solved by creating appropriate preprocessor program, for example.
+"""
+#
+import sys,string,fileinput,re,pprint,os,copy
+from auxfuncs import *
+
+# Global flags:
+strictf77=1 # Ignore `!' comments unless line[0]=='!'
+sourcecodeform='fix' # 'fix','free'
+quiet=0 # Be verbose if 0 (Obsolete: not used any more)
+verbose=1 # Be quiet if 0, extra verbose if > 1.
+tabchar=4*' '
+pyffilename=''
+f77modulename=''
+skipemptyends=0 # for old F77 programs without 'program' statement
+ignorecontains=1
+dolowercase=1
+debug=[]
+## do_analyze = 1
+
+###### global variables
+
+## use reload(crackfortran) to reset these variables
+
+groupcounter=0
+grouplist={groupcounter:[]}
+neededmodule=-1
+expectbegin=1
+skipblocksuntil=-1
+usermodules=[]
+f90modulevars={}
+gotnextfile=1
+filepositiontext=''
+currentfilename=''
+skipfunctions=[]
+skipfuncs=[]
+onlyfuncs=[]
+include_paths=[]
+previous_context = None
+
+###### Some helper functions
+def show(o,f=0):pprint.pprint(o)
+errmess=sys.stderr.write
+def outmess(line,flag=1):
+ global filepositiontext
+ if not verbose: return
+ if not quiet:
+ if flag:sys.stdout.write(filepositiontext)
+ sys.stdout.write(line)
+re._MAXCACHE=50
+defaultimplicitrules={}
+for c in "abcdefghopqrstuvwxyz$_": defaultimplicitrules[c]={'typespec':'real'}
+for c in "ijklmn": defaultimplicitrules[c]={'typespec':'integer'}
+del c
+badnames={}
+invbadnames={}
+for n in ['int','double','float','char','short','long','void','case','while',
+ 'return','signed','unsigned','if','for','typedef','sizeof','union',
+ 'struct','static','register','new','break','do','goto','switch',
+ 'continue','else','inline','extern','delete','const','auto',
+ 'len','rank','shape','index','slen','size','_i',
+ 'flen','fshape',
+ 'string','complex_double','float_double','stdin','stderr','stdout',
+ 'type','default']:
+ badnames[n]=n+'_bn'
+ invbadnames[n+'_bn']=n
+def rmbadname1(name):
+ if badnames.has_key(name):
+ errmess('rmbadname1: Replacing "%s" with "%s".\n'%(name,badnames[name]))
+ return badnames[name]
+ return name
+def rmbadname(names): return map(rmbadname1,names)
+
+def undo_rmbadname1(name):
+ if invbadnames.has_key(name):
+ errmess('undo_rmbadname1: Replacing "%s" with "%s".\n'\
+ %(name,invbadnames[name]))
+ return invbadnames[name]
+ return name
+def undo_rmbadname(names): return map(undo_rmbadname1,names)
+
+def getextension(name):
+ i=string.rfind(name,'.')
+ if i==-1: return ''
+ if '\\' in name[i:]: return ''
+ if '/' in name[i:]: return ''
+ return name[i+1:]
+
+is_f_file = re.compile(r'.*[.](for|ftn|f77|f)\Z',re.I).match
+_has_f_header = re.compile(r'-[*]-\s*fortran\s*-[*]-',re.I).search
+_has_f90_header = re.compile(r'-[*]-\s*f90\s*-[*]-',re.I).search
+_has_fix_header = re.compile(r'-[*]-\s*fix\s*-[*]-',re.I).search
+_free_f90_start = re.compile(r'[^c*]\s*[^\s\d\t]',re.I).match
+def is_free_format(file):
+ """Check if file is in free format Fortran."""
+ # f90 allows both fixed and free format, assuming fixed unless
+ # signs of free format are detected.
+ result = 0
+ f = open(file,'r')
+ line = f.readline()
+ n = 15 # the number of non-comment lines to scan for hints
+ if _has_f_header(line):
+ n = 0
+ elif _has_f90_header(line):
+ n = 0
+ result = 1
+ while n>0 and line:
+ if line[0]!='!':
+ n -= 1
+ if (line[0]!='\t' and _free_f90_start(line[:5])) or line[-2:-1]=='&':
+ result = 1
+ break
+ line = f.readline()
+ f.close()
+ return result
+
+
+####### Read fortran (77,90) code
+def readfortrancode(ffile,dowithline=show,istop=1):
+ """
+ Read fortran codes from files and
+ 1) Get rid of comments, line continuations, and empty lines; lower cases.
+ 2) Call dowithline(line) on every line.
+ 3) Recursively call itself when statement \"include '<filename>'\" is met.
+ """
+ global gotnextfile,filepositiontext,currentfilename,sourcecodeform,strictf77,\
+ beginpattern,quiet,verbose,dolowercase,include_paths
+ if not istop:
+ saveglobals=gotnextfile,filepositiontext,currentfilename,sourcecodeform,strictf77,\
+ beginpattern,quiet,verbose,dolowercase
+ if ffile==[]: return
+ localdolowercase = dolowercase
+ cont=0
+ finalline=''
+ ll=''
+ commentline=re.compile(r'(?P<line>([^"]*"[^"]*"[^"!]*|[^\']*\'[^\']*\'[^\'!]*|[^!]*))!{1}(?P<rest>.*)')
+ includeline=re.compile(r'\s*include\s*(\'|")(?P<name>[^\'"]*)(\'|")',re.I)
+ cont1=re.compile(r'(?P<line>.*)&\s*\Z')
+ cont2=re.compile(r'(\s*&|)(?P<line>.*)')
+ mline_mark = re.compile(r".*?'''")
+ if istop: dowithline('',-1)
+ ll,l1='',''
+ spacedigits=[' ']+map(str,range(10))
+ filepositiontext=''
+ fin=fileinput.FileInput(ffile)
+ while 1:
+ l=fin.readline()
+ if not l: break
+ if fin.isfirstline():
+ filepositiontext=''
+ currentfilename=fin.filename()
+ gotnextfile=1
+ l1=l
+ strictf77=0
+ sourcecodeform='fix'
+ ext = os.path.splitext(currentfilename)[1]
+ if is_f_file(currentfilename) and \
+ not (_has_f90_header(l) or _has_fix_header(l)):
+ strictf77=1
+ elif is_free_format(currentfilename) and not _has_fix_header(l):
+ sourcecodeform='free'
+ if strictf77: beginpattern=beginpattern77
+ else: beginpattern=beginpattern90
+ outmess('\tReading file %s (format:%s%s)\n'\
+ %(`currentfilename`,sourcecodeform,
+ strictf77 and ',strict' or ''))
+
+ l=string.expandtabs(l).replace('\xa0',' ')
+ while not l=='': # Get rid of newline characters
+ if l[-1] not in "\n\r\f": break
+ l=l[:-1]
+ if not strictf77:
+ r=commentline.match(l)
+ if r:
+ l=r.group('line')+' ' # Strip comments starting with `!'
+ rl=r.group('rest')
+ if string.lower(rl[:4])=='f2py': # f2py directive
+ l = l + 4*' '
+ r=commentline.match(rl[4:])
+ if r: l=l+r('line')
+ else: l = l + rl[4:]
+ if string.strip(l)=='': # Skip empty line
+ cont=0
+ continue
+ if sourcecodeform=='fix':
+ if l[0] in ['*','c','!','C','#']:
+ if string.lower(l[1:5])=='f2py': # f2py directive
+ l=' '+l[5:]
+ else: # Skip comment line
+ cont=0
+ continue
+ elif strictf77:
+ if len(l)>72: l=l[:72]
+ if not (l[0] in spacedigits):
+ raise 'readfortrancode: Found non-(space,digit) char in the first column.\n\tAre you sure that this code is in fix form?\n\tline=%s'%`l`
+
+ if (not cont or strictf77) and (len(l)>5 and not l[5]==' '):
+ # Continuation of a previous line
+ ll=ll+l[6:]
+ finalline=''
+ origfinalline=''
+ else:
+ if not strictf77:
+ # F90 continuation
+ r=cont1.match(l)
+ if r: l=r.group('line') # Continuation follows ..
+ if cont:
+ ll=ll+cont2.match(l).group('line')
+ finalline=''
+ origfinalline=''
+ else:
+ l=' '+l[5:] # clean up line beginning from possible digits.
+ if localdolowercase: finalline=string.lower(ll)
+ else: finalline=ll
+ origfinalline=ll
+ ll=l
+ cont=(r is not None)
+ else:
+ l=' '+l[5:] # clean up line beginning from possible digits.
+ if localdolowercase: finalline=string.lower(ll)
+ else: finalline=ll
+ origfinalline =ll
+ ll=l
+
+ elif sourcecodeform=='free':
+ if not cont and ext=='.pyf' and mline_mark.match(l):
+ l = l + '\n'
+ while 1:
+ lc = fin.readline()
+ if not lc:
+ errmess('Unexpected end of file when reading multiline\n')
+ break
+ l = l + lc
+ if mline_mark.match(lc):
+ break
+ l = l.rstrip()
+ r=cont1.match(l)
+ if r: l=r.group('line') # Continuation follows ..
+ if cont:
+ ll=ll+cont2.match(l).group('line')
+ finalline=''
+ origfinalline=''
+ else:
+ if localdolowercase: finalline=string.lower(ll)
+ else: finalline=ll
+ origfinalline =ll
+ ll=l
+ cont=(r is not None)
+ else:
+ raise ValueError,"Flag sourcecodeform must be either 'fix' or 'free': %s"%`sourcecodeform`
+ filepositiontext='Line #%d in %s:"%s"\n\t' % (fin.filelineno()-1,currentfilename,l1)
+ m=includeline.match(origfinalline)
+ if m:
+ fn=m.group('name')
+ if os.path.isfile(fn):
+ readfortrancode(fn,dowithline=dowithline,istop=0)
+ else:
+ include_dirs = [os.path.dirname(currentfilename)] + include_paths
+ foundfile = 0
+ for inc_dir in include_dirs:
+ fn1 = os.path.join(inc_dir,fn)
+ if os.path.isfile(fn1):
+ foundfile = 1
+ readfortrancode(fn1,dowithline=dowithline,istop=0)
+ break
+ if not foundfile:
+ outmess('readfortrancode: could not find include file %s. Ignoring.\n'%(`fn`))
+ else:
+ dowithline(finalline)
+ l1=ll
+ if localdolowercase:
+ finalline=string.lower(ll)
+ else: finalline=ll
+ origfinalline = ll
+ filepositiontext='Line #%d in %s:"%s"\n\t' % (fin.filelineno()-1,currentfilename,l1)
+ m=includeline.match(origfinalline)
+ if m:
+ fn=m.group('name')
+ fn1=os.path.join(os.path.dirname(currentfilename),fn)
+ if os.path.isfile(fn):
+ readfortrancode(fn,dowithline=dowithline,istop=0)
+ elif os.path.isfile(fn1):
+ readfortrancode(fn1,dowithline=dowithline,istop=0)
+ else:
+ outmess('readfortrancode: could not find include file %s. Ignoring.\n'%(`fn`))
+ else:
+ dowithline(finalline)
+ filepositiontext=''
+ fin.close()
+ if istop: dowithline('',1)
+ else:
+ gotnextfile,filepositiontext,currentfilename,sourcecodeform,strictf77,\
+ beginpattern,quiet,verbose,dolowercase=saveglobals
+
+########### Crack line
+beforethisafter=r'\s*(?P<before>%s(?=\s*(\b(%s)\b)))'+ \
+ r'\s*(?P<this>(\b(%s)\b))'+ \
+ r'\s*(?P<after>%s)\s*\Z'
+##
+fortrantypes='character|logical|integer|real|complex|double\s*(precision\s*(complex|)|complex)|type(?=\s*\([\w\s,=(*)]*\))|byte'
+typespattern=re.compile(beforethisafter%('',fortrantypes,fortrantypes,'.*'),re.I),'type'
+typespattern4implicit=re.compile(beforethisafter%('',fortrantypes+'|static|automatic|undefined',fortrantypes+'|static|automatic|undefined','.*'),re.I)
+#
+functionpattern=re.compile(beforethisafter%('([a-z]+[\w\s(=*+-/)]*?|)','function','function','.*'),re.I),'begin'
+subroutinepattern=re.compile(beforethisafter%('[a-z\s]*?','subroutine','subroutine','.*'),re.I),'begin'
+#modulepattern=re.compile(beforethisafter%('[a-z\s]*?','module','module','.*'),re.I),'begin'
+#
+groupbegins77=r'program|block\s*data'
+beginpattern77=re.compile(beforethisafter%('',groupbegins77,groupbegins77,'.*'),re.I),'begin'
+groupbegins90=groupbegins77+r'|module|python\s*module|interface|type(?!\s*\()'
+beginpattern90=re.compile(beforethisafter%('',groupbegins90,groupbegins90,'.*'),re.I),'begin'
+groupends=r'end|endprogram|endblockdata|endmodule|endpythonmodule|endinterface'
+endpattern=re.compile(beforethisafter%('',groupends,groupends,'[\w\s]*'),re.I),'end'
+#endifs='end\s*(if|do|where|select|while|forall)'
+endifs='(end\s*(if|do|where|select|while|forall))|(module\s*procedure)'
+endifpattern=re.compile(beforethisafter%('[\w]*?',endifs,endifs,'[\w\s]*'),re.I),'endif'
+#
+implicitpattern=re.compile(beforethisafter%('','implicit','implicit','.*'),re.I),'implicit'
+dimensionpattern=re.compile(beforethisafter%('','dimension|virtual','dimension|virtual','.*'),re.I),'dimension'
+externalpattern=re.compile(beforethisafter%('','external','external','.*'),re.I),'external'
+optionalpattern=re.compile(beforethisafter%('','optional','optional','.*'),re.I),'optional'
+requiredpattern=re.compile(beforethisafter%('','required','required','.*'),re.I),'required'
+publicpattern=re.compile(beforethisafter%('','public','public','.*'),re.I),'public'
+privatepattern=re.compile(beforethisafter%('','private','private','.*'),re.I),'private'
+intrisicpattern=re.compile(beforethisafter%('','intrisic','intrisic','.*'),re.I),'intrisic'
+intentpattern=re.compile(beforethisafter%('','intent|depend|note|check','intent|depend|note|check','\s*\(.*?\).*'),re.I),'intent'
+parameterpattern=re.compile(beforethisafter%('','parameter','parameter','\s*\(.*'),re.I),'parameter'
+datapattern=re.compile(beforethisafter%('','data','data','.*'),re.I),'data'
+callpattern=re.compile(beforethisafter%('','call','call','.*'),re.I),'call'
+entrypattern=re.compile(beforethisafter%('','entry','entry','.*'),re.I),'entry'
+callfunpattern=re.compile(beforethisafter%('','callfun','callfun','.*'),re.I),'callfun'
+commonpattern=re.compile(beforethisafter%('','common','common','.*'),re.I),'common'
+usepattern=re.compile(beforethisafter%('','use','use','.*'),re.I),'use'
+containspattern=re.compile(beforethisafter%('','contains','contains',''),re.I),'contains'
+formatpattern=re.compile(beforethisafter%('','format','format','.*'),re.I),'format'
+## Non-fortran and f2py-specific statements
+f2pyenhancementspattern=re.compile(beforethisafter%('','threadsafe|fortranname|callstatement|callprotoargument|usercode|pymethoddef','threadsafe|fortranname|callstatement|callprotoargument|usercode|pymethoddef','.*'),re.I|re.S),'f2pyenhancements'
+multilinepattern = re.compile(r"\s*(?P<before>''')(?P<this>.*?)(?P<after>''')\s*\Z",re.S),'multiline'
+##
+
+def _simplifyargs(argsline):
+ a = []
+ for n in string.split(markoutercomma(argsline),'@,@'):
+ for r in '(),':
+ n = string.replace(n,r,'_')
+ a.append(n)
+ return string.join(a,',')
+
+crackline_re_1 = re.compile(r'\s*(?P<result>\b[a-z]+[\w]*\b)\s*[=].*',re.I)
+def crackline(line,reset=0):
+ """
+ reset=-1 --- initialize
+ reset=0 --- crack the line
+ reset=1 --- final check if mismatch of blocks occured
+
+ Cracked data is saved in grouplist[0].
+ """
+ global beginpattern,groupcounter,groupname,groupcache,grouplist,gotnextfile,\
+ filepositiontext,currentfilename,neededmodule,expectbegin,skipblocksuntil,\
+ skipemptyends,previous_context
+ if ';' in line and not (f2pyenhancementspattern[0].match(line) or
+ multilinepattern[0].match(line)):
+ for l in line.split(';'):
+ assert reset==0,`reset` # XXX: non-zero reset values need testing
+ crackline(l,reset)
+ return
+ if reset<0:
+ groupcounter=0
+ groupname={groupcounter:''}
+ groupcache={groupcounter:{}}
+ grouplist={groupcounter:[]}
+ groupcache[groupcounter]['body']=[]
+ groupcache[groupcounter]['vars']={}
+ groupcache[groupcounter]['block']=''
+ groupcache[groupcounter]['name']=''
+ neededmodule=-1
+ skipblocksuntil=-1
+ return
+ if reset>0:
+ fl=0
+ if f77modulename and neededmodule==groupcounter: fl=2
+ while groupcounter>fl:
+ outmess('crackline: groupcounter=%s groupname=%s\n'%(`groupcounter`,`groupname`))
+ outmess('crackline: Mismatch of blocks encountered. Trying to fix it by assuming "end" statement.\n')
+ grouplist[groupcounter-1].append(groupcache[groupcounter])
+ grouplist[groupcounter-1][-1]['body']=grouplist[groupcounter]
+ del grouplist[groupcounter]
+ groupcounter=groupcounter-1
+ if f77modulename and neededmodule==groupcounter:
+ grouplist[groupcounter-1].append(groupcache[groupcounter])
+ grouplist[groupcounter-1][-1]['body']=grouplist[groupcounter]
+ del grouplist[groupcounter]
+ groupcounter=groupcounter-1 # end interface
+ grouplist[groupcounter-1].append(groupcache[groupcounter])
+ grouplist[groupcounter-1][-1]['body']=grouplist[groupcounter]
+ del grouplist[groupcounter]
+ groupcounter=groupcounter-1 # end module
+ neededmodule=-1
+ return
+ if line=='': return
+ flag=0
+ for pat in [dimensionpattern,externalpattern,intentpattern,optionalpattern,
+ requiredpattern,
+ parameterpattern,datapattern,publicpattern,privatepattern,
+ intrisicpattern,
+ endifpattern,endpattern,
+ formatpattern,
+ beginpattern,functionpattern,subroutinepattern,
+ implicitpattern,typespattern,commonpattern,
+ callpattern,usepattern,containspattern,
+ entrypattern,
+ f2pyenhancementspattern,
+ multilinepattern
+ ]:
+ m = pat[0].match(line)
+ if m:
+ break
+ flag=flag+1
+ if not m:
+ re_1 = crackline_re_1
+ if 0<=skipblocksuntil<=groupcounter:return
+ if groupcache[groupcounter].has_key('externals'):
+ for name in groupcache[groupcounter]['externals']:
+ if invbadnames.has_key(name):
+ name=invbadnames[name]
+ if groupcache[groupcounter].has_key('interfaced') and name in groupcache[groupcounter]['interfaced']: continue
+ m1=re.match(r'(?P<before>[^"]*)\b%s\b\s*@\(@(?P<args>[^@]*)@\)@.*\Z'%name,markouterparen(line),re.I)
+ if m1:
+ m2 = re_1.match(m1.group('before'))
+ a = _simplifyargs(m1.group('args'))
+ if m2:
+ line='callfun %s(%s) result (%s)'%(name,a,m2.group('result'))
+ else: line='callfun %s(%s)'%(name,a)
+ m = callfunpattern[0].match(line)
+ if not m:
+ outmess('crackline: could not resolve function call for line=%s.\n'%`line`)
+ return
+ analyzeline(m,'callfun',line)
+ return
+ if verbose>1:
+ previous_context = None
+ outmess('crackline:%d: No pattern for line\n'%(groupcounter))
+ return
+ elif pat[1]=='end':
+ if 0<=skipblocksuntil<groupcounter:
+ groupcounter=groupcounter-1
+ if skipblocksuntil<=groupcounter: return
+ if groupcounter<=0:
+ raise 'crackline: groupcounter(=%s) is nonpositive. Check the blocks.'\
+ % (groupcounter)
+ m1 = beginpattern[0].match((line))
+ if (m1) and (not m1.group('this')==groupname[groupcounter]):
+ raise 'crackline: End group %s does not match with previous Begin group %s\n\t%s'%(`m1.group('this')`,`groupname[groupcounter]`,filepositiontext)
+ if skipblocksuntil==groupcounter:
+ skipblocksuntil=-1
+ grouplist[groupcounter-1].append(groupcache[groupcounter])
+ grouplist[groupcounter-1][-1]['body']=grouplist[groupcounter]
+ del grouplist[groupcounter]
+ groupcounter=groupcounter-1
+ if not skipemptyends:
+ expectbegin=1
+ elif pat[1] == 'begin':
+ if 0<=skipblocksuntil<=groupcounter:
+ groupcounter=groupcounter+1
+ return
+ gotnextfile=0
+ analyzeline(m,pat[1],line)
+ expectbegin=0
+ elif pat[1]=='endif':
+ pass
+ elif pat[1]=='contains':
+ if ignorecontains: return
+ if 0<=skipblocksuntil<=groupcounter: return
+ skipblocksuntil=groupcounter
+ else:
+ if 0<=skipblocksuntil<=groupcounter:return
+ analyzeline(m,pat[1],line)
+
+def markouterparen(line):
+ l='';f=0
+ for c in line:
+ if c=='(':
+ f=f+1
+ if f==1: l=l+'@(@'; continue
+ elif c==')':
+ f=f-1
+ if f==0: l=l+'@)@'; continue
+ l=l+c
+ return l
+def markoutercomma(line,comma=','):
+ l='';f=0
+ cc=''
+ for c in line:
+ if (not cc or cc==')') and c=='(':
+ f=f+1
+ cc = ')'
+ elif not cc and c=='\'' and (not l or l[-1]!='\\'):
+ f=f+1
+ cc = '\''
+ elif c==cc:
+ f=f-1
+ if f==0:
+ cc=''
+ elif c==comma and f==0:
+ l=l+'@'+comma+'@'
+ continue
+ l=l+c
+ assert not f,`f,line,l,cc`
+ return l
+def unmarkouterparen(line):
+ r = string.replace(string.replace(line,'@(@','('),'@)@',')')
+ return r
+def appenddecl(decl,decl2,force=1):
+ if not decl: decl={}
+ if not decl2: return decl
+ if decl is decl2: return decl
+ for k in decl2.keys():
+ if k=='typespec':
+ if force or not decl.has_key(k): decl[k]=decl2[k]
+ elif k=='attrspec':
+ for l in decl2[k]:
+ decl=setattrspec(decl,l,force)
+ elif k=='kindselector':
+ decl=setkindselector(decl,decl2[k],force)
+ elif k=='charselector':
+ decl=setcharselector(decl,decl2[k],force)
+ elif k in ['=','typename']:
+ if force or not decl.has_key(k): decl[k]=decl2[k]
+ elif k=='note':
+ pass
+ elif k in ['intent','check','dimension','optional','required']:
+ errmess('appenddecl: "%s" not implemented.\n'%k)
+ else:
+ raise 'appenddecl: Unknown variable definition key:', k
+ return decl
+
+selectpattern=re.compile(r'\s*(?P<this>(@\(@.*?@\)@|[*][\d*]+|[*]\s*@\(@.*?@\)@|))(?P<after>.*)\Z',re.I)
+nameargspattern=re.compile(r'\s*(?P<name>\b[\w$]+\b)\s*(@\(@\s*(?P<args>[\w\s,]*)\s*@\)@|)\s*(result(\s*@\(@\s*(?P<result>\b[\w$]+\b)\s*@\)@|))*\s*\Z',re.I)
+callnameargspattern=re.compile(r'\s*(?P<name>\b[\w$]+\b)\s*@\(@\s*(?P<args>.*)\s*@\)@\s*\Z',re.I)
+real16pattern = re.compile(r'([-+]?(?:\d+(?:\.\d*)?|\d*\.\d+))[dD]((?:[-+]?\d+)?)')
+real8pattern = re.compile(r'([-+]?((?:\d+(?:\.\d*)?|\d*\.\d+))[eE]((?:[-+]?\d+)?)|(\d+\.\d*))')
+
+_intentcallbackpattern = re.compile(r'intent\s*\(.*?\bcallback\b',re.I)
+def _is_intent_callback(vdecl):
+ for a in vdecl.get('attrspec',[]):
+ if _intentcallbackpattern.match(a):
+ return 1
+ return 0
+
+def _resolvenameargspattern(line):
+ line = markouterparen(line)
+ m1=nameargspattern.match(line)
+ if m1: return m1.group('name'),m1.group('args'),m1.group('result')
+ m1=callnameargspattern.match(line)
+ if m1: return m1.group('name'),m1.group('args'),None
+ return None,[],None
+
+def analyzeline(m,case,line):
+ global groupcounter,groupname,groupcache,grouplist,filepositiontext,\
+ currentfilename,f77modulename,neededinterface,neededmodule,expectbegin,\
+ gotnextfile,previous_context
+ block=m.group('this')
+ if case != 'multiline':
+ previous_context = None
+ if expectbegin and case not in ['begin','call','callfun','type'] \
+ and not skipemptyends and groupcounter<1:
+ newname=string.split(os.path.basename(currentfilename),'.')[0]
+ outmess('analyzeline: no group yet. Creating program group with name "%s".\n'%newname)
+ gotnextfile=0
+ groupcounter=groupcounter+1
+ groupname[groupcounter]='program'
+ groupcache[groupcounter]={}
+ grouplist[groupcounter]=[]
+ groupcache[groupcounter]['body']=[]
+ groupcache[groupcounter]['vars']={}
+ groupcache[groupcounter]['block']='program'
+ groupcache[groupcounter]['name']=newname
+ groupcache[groupcounter]['from']='fromsky'
+ expectbegin=0
+ if case in ['begin','call','callfun']:
+ # Crack line => block,name,args,result
+ block = block.lower()
+ if re.match(r'block\s*data',block,re.I): block='block data'
+ if re.match(r'python\s*module',block,re.I): block='python module'
+ name,args,result = _resolvenameargspattern(m.group('after'))
+ if name is None:
+ if block=='block data':
+ name = '_BLOCK_DATA_'
+ else:
+ name = ''
+ if block not in ['interface','block data']:
+ outmess('analyzeline: No name/args pattern found for line.\n')
+
+ previous_context = (block,name,groupcounter)
+ if args: args=rmbadname(map(string.strip,string.split(markoutercomma(args),'@,@')))
+ else: args=[]
+ if '' in args:
+ while '' in args:
+ args.remove('')
+ outmess('analyzeline: argument list is malformed (missing argument).\n')
+
+ # end of crack line => block,name,args,result
+ needmodule=0
+ needinterface=0
+
+ if case in ['call','callfun']:
+ needinterface=1
+ if not groupcache[groupcounter].has_key('args'): return
+ if name not in groupcache[groupcounter]['args']:
+ return
+ for it in grouplist[groupcounter]:
+ if it['name']==name: return
+ if name in groupcache[groupcounter]['interfaced']: return
+ block={'call':'subroutine','callfun':'function'}[case]
+ if f77modulename and neededmodule==-1 and groupcounter<=1:
+ neededmodule=groupcounter+2
+ needmodule=1
+ needinterface=1
+ # Create new block(s)
+ groupcounter=groupcounter+1
+ groupcache[groupcounter]={}
+ grouplist[groupcounter]=[]
+ if needmodule:
+ if verbose>1:
+ outmess('analyzeline: Creating module block %s\n'%`f77modulename`,0)
+ groupname[groupcounter]='module'
+ groupcache[groupcounter]['block']='python module'
+ groupcache[groupcounter]['name']=f77modulename
+ groupcache[groupcounter]['from']=''
+ groupcache[groupcounter]['body']=[]
+ groupcache[groupcounter]['externals']=[]
+ groupcache[groupcounter]['interfaced']=[]
+ groupcache[groupcounter]['vars']={}
+ groupcounter=groupcounter+1
+ groupcache[groupcounter]={}
+ grouplist[groupcounter]=[]
+ if needinterface:
+ if verbose>1:
+ outmess('analyzeline: Creating additional interface block.\n',0)
+ groupname[groupcounter]='interface'
+ groupcache[groupcounter]['block']='interface'
+ groupcache[groupcounter]['name']='unknown_interface'
+ groupcache[groupcounter]['from']='%s:%s'%(groupcache[groupcounter-1]['from'],groupcache[groupcounter-1]['name'])
+ groupcache[groupcounter]['body']=[]
+ groupcache[groupcounter]['externals']=[]
+ groupcache[groupcounter]['interfaced']=[]
+ groupcache[groupcounter]['vars']={}
+ groupcounter=groupcounter+1
+ groupcache[groupcounter]={}
+ grouplist[groupcounter]=[]
+ groupname[groupcounter]=block
+ groupcache[groupcounter]['block']=block
+ if not name: name='unknown_'+block
+ groupcache[groupcounter]['prefix']=m.group('before')
+ groupcache[groupcounter]['name']=rmbadname1(name)
+ groupcache[groupcounter]['result']=result
+ if groupcounter==1:
+ groupcache[groupcounter]['from']=currentfilename
+ else:
+ if f77modulename and groupcounter==3:
+ groupcache[groupcounter]['from']='%s:%s'%(groupcache[groupcounter-1]['from'],currentfilename)
+ else:
+ groupcache[groupcounter]['from']='%s:%s'%(groupcache[groupcounter-1]['from'],groupcache[groupcounter-1]['name'])
+ for k in groupcache[groupcounter].keys():
+ if not groupcache[groupcounter][k]: del groupcache[groupcounter][k]
+ groupcache[groupcounter]['args']=args
+ groupcache[groupcounter]['body']=[]
+ groupcache[groupcounter]['externals']=[]
+ groupcache[groupcounter]['interfaced']=[]
+ groupcache[groupcounter]['vars']={}
+ groupcache[groupcounter]['entry']={}
+ # end of creation
+ if block=='type':
+ groupcache[groupcounter]['varnames'] = []
+
+ if case in ['call','callfun']: # set parents variables
+ if name not in groupcache[groupcounter-2]['externals']:
+ groupcache[groupcounter-2]['externals'].append(name)
+ groupcache[groupcounter]['vars']=copy.deepcopy(groupcache[groupcounter-2]['vars'])
+ #try: del groupcache[groupcounter]['vars'][groupcache[groupcounter-2]['name']]
+ #except: pass
+ try: del groupcache[groupcounter]['vars'][name][groupcache[groupcounter]['vars'][name]['attrspec'].index('external')]
+ except: pass
+ if block in ['function','subroutine']: # set global attributes
+ try: groupcache[groupcounter]['vars'][name]=appenddecl(groupcache[groupcounter]['vars'][name],groupcache[groupcounter-2]['vars'][''])
+ except: pass
+ if case=='callfun': # return type
+ if result and groupcache[groupcounter]['vars'].has_key(result):
+ if not name==result:
+ groupcache[groupcounter]['vars'][name]=appenddecl(groupcache[groupcounter]['vars'][name],groupcache[groupcounter]['vars'][result])
+ #if groupcounter>1: # name is interfaced
+ try: groupcache[groupcounter-2]['interfaced'].append(name)
+ except: pass
+ if block=='function':
+ t=typespattern[0].match(m.group('before')+' '+name)
+ if t:
+ typespec,selector,attr,edecl=cracktypespec0(t.group('this'),t.group('after'))
+ updatevars(typespec,selector,attr,edecl)
+ if case in ['call','callfun']:
+ grouplist[groupcounter-1].append(groupcache[groupcounter])
+ grouplist[groupcounter-1][-1]['body']=grouplist[groupcounter]
+ del grouplist[groupcounter]
+ groupcounter=groupcounter-1 # end routine
+ grouplist[groupcounter-1].append(groupcache[groupcounter])
+ grouplist[groupcounter-1][-1]['body']=grouplist[groupcounter]
+ del grouplist[groupcounter]
+ groupcounter=groupcounter-1 # end interface
+ elif case=='entry':
+ name,args,result=_resolvenameargspattern(m.group('after'))
+ if name is not None:
+ if args:
+ args=rmbadname(map(string.strip,string.split(markoutercomma(args),'@,@')))
+ else: args=[]
+ assert result is None,`result`
+ groupcache[groupcounter]['entry'][name] = args
+ previous_context = ('entry',name,groupcounter)
+ elif case=='type':
+ typespec,selector,attr,edecl=cracktypespec0(block,m.group('after'))
+ last_name = updatevars(typespec,selector,attr,edecl)
+ if last_name is not None:
+ previous_context = ('variable',last_name,groupcounter)
+ elif case in ['dimension','intent','optional','required','external','public','private','intrisic']:
+ edecl=groupcache[groupcounter]['vars']
+ ll=m.group('after').strip()
+ i=string.find(ll,'::')
+ if i<0 and case=='intent':
+ i=string.find(markouterparen(ll),'@)@')-2
+ ll=ll[:i+1]+'::'+ll[i+1:]
+ i=string.find(ll,'::')
+ if ll[i:]=='::' and groupcache[groupcounter].has_key('args'):
+ outmess('All arguments will have attribute %s%s\n'%(m.group('this'),ll[:i]))
+ ll = ll + string.join(groupcache[groupcounter]['args'],',')
+ if i<0:i=0;pl=''
+ else: pl=string.strip(ll[:i]);ll=ll[i+2:]
+ ch = string.split(markoutercomma(pl),'@,@')
+ if len(ch)>1:
+ pl = ch[0]
+ outmess('analyzeline: cannot handle multiple attributes without type specification. Ignoring %r.\n' % (','.join(ch[1:])))
+ last_name = None
+ for e in map(string.strip,string.split(markoutercomma(ll),'@,@')):
+ m1=namepattern.match(e)
+ if not m1:
+ if case in ['public','private']: k=''
+ else:
+ print m.groupdict()
+ outmess('analyzeline: no name pattern found in %s statement for %s. Skipping.\n'%(case,`e`))
+ continue
+ else:
+ k=rmbadname1(m1.group('name'))
+ if not edecl.has_key(k): edecl[k]={}
+ if case=='dimension': ap=case+m1.group('after')
+ if case=='intent':
+ ap=m.group('this')+pl
+ if _intentcallbackpattern.match(ap):
+ if k not in groupcache[groupcounter]['args']:
+ if groupcounter>1 and \
+ string.find(groupcache[groupcounter-2]['name'],
+ '__user__')==-1:
+ outmess('analyzeline: appending intent(callback) %s'\
+ ' to %s arguments\n' % (k,groupcache[groupcounter]['name']))
+ groupcache[groupcounter]['args'].append(k)
+ else:
+ errmess('analyzeline: intent(callback) %s is already'\
+ ' in argument list' % (k))
+ if case in ['optional','required','public','external','private','intrisic']: ap=case
+ if edecl[k].has_key('attrspec'): edecl[k]['attrspec'].append(ap)
+ else: edecl[k]['attrspec']=[ap]
+ if case=='external':
+ if groupcache[groupcounter]['block']=='program':
+ outmess('analyzeline: ignoring program arguments\n')
+ continue
+ if k not in groupcache[groupcounter]['args']:
+ #outmess('analyzeline: ignoring external %s (not in arguments list)\n'%(`k`))
+ continue
+ if not groupcache[groupcounter].has_key('externals'):
+ groupcache[groupcounter]['externals']=[]
+ groupcache[groupcounter]['externals'].append(k)
+ last_name = k
+ groupcache[groupcounter]['vars']=edecl
+ if last_name is not None:
+ previous_context = ('variable',last_name,groupcounter)
+ elif case=='parameter':
+ edecl=groupcache[groupcounter]['vars']
+ ll=string.strip(m.group('after'))[1:-1]
+ last_name = None
+ for e in string.split(markoutercomma(ll),'@,@'):
+ try:
+ k,initexpr=map(string.strip,string.split(e,'='))
+ except:
+ outmess('analyzeline: could not extract name,expr in parameter statement "%s" of "%s"\n'%(e,ll));continue
+ params = get_parameters(edecl)
+ k=rmbadname1(k)
+ if not edecl.has_key(k): edecl[k]={}
+ if edecl[k].has_key('=') and (not edecl[k]['=']==initexpr):
+ outmess('analyzeline: Overwriting the value of parameter "%s" ("%s") with "%s".\n'%(k,edecl[k]['='],initexpr))
+ t = determineexprtype(initexpr,params)
+ if t:
+ if t.get('typespec')=='real':
+ tt = list(initexpr)
+ for m in real16pattern.finditer(initexpr):
+ tt[m.start():m.end()] = list(\
+ initexpr[m.start():m.end()].lower().replace('d', 'e'))
+ initexpr = "".join(tt)
+ elif t.get('typespec')=='complex':
+ initexpr = initexpr[1:].lower().replace('d','e').\
+ replace(',','+1j*(')
+ try:
+ v = eval(initexpr,{},params)
+ except (SyntaxError,NameError),msg:
+ errmess('analyzeline: Failed to evaluate %r. Ignoring: %s\n'\
+ % (initexpr, msg))
+ continue
+ edecl[k]['='] = repr(v)
+ if edecl[k].has_key('attrspec'):
+ edecl[k]['attrspec'].append('parameter')
+ else: edecl[k]['attrspec']=['parameter']
+ last_name = k
+ groupcache[groupcounter]['vars']=edecl
+ if last_name is not None:
+ previous_context = ('variable',last_name,groupcounter)
+ elif case=='implicit':
+ if string.lower(string.strip(m.group('after')))=='none':
+ groupcache[groupcounter]['implicit']=None
+ elif m.group('after'):
+ if groupcache[groupcounter].has_key('implicit'):
+ impl=groupcache[groupcounter]['implicit']
+ else: impl={}
+ if impl is None:
+ outmess('analyzeline: Overwriting earlier "implicit none" statement.\n')
+ impl={}
+ for e in string.split(markoutercomma(m.group('after')),'@,@'):
+ decl={}
+ m1=re.match(r'\s*(?P<this>.*?)\s*(\(\s*(?P<after>[a-z-, ]+)\s*\)\s*|)\Z',e,re.I)
+ if not m1:
+ outmess('analyzeline: could not extract info of implicit statement part "%s"\n'%(e));continue
+ m2=typespattern4implicit.match(m1.group('this'))
+ if not m2:
+ outmess('analyzeline: could not extract types pattern of implicit statement part "%s"\n'%(e));continue
+ typespec,selector,attr,edecl=cracktypespec0(m2.group('this'),m2.group('after'))
+ kindselect,charselect,typename=cracktypespec(typespec,selector)
+ decl['typespec']=typespec
+ decl['kindselector']=kindselect
+ decl['charselector']=charselect
+ decl['typename']=typename
+ for k in decl.keys():
+ if not decl[k]: del decl[k]
+ for r in string.split(markoutercomma(m1.group('after')),'@,@'):
+ if '-' in r:
+ try: begc,endc=map(string.strip,string.split(r,'-'))
+ except:
+ outmess('analyzeline: expected "<char>-<char>" instead of "%s" in range list of implicit statement\n'%r);continue
+ else: begc=endc=string.strip(r)
+ if not len(begc)==len(endc)==1:
+ outmess('analyzeline: expected "<char>-<char>" instead of "%s" in range list of implicit statement (2)\n'%r);continue
+ for o in range(ord(begc),ord(endc)+1):
+ impl[chr(o)]=decl
+ groupcache[groupcounter]['implicit']=impl
+ elif case=='data':
+ ll=[]
+ dl='';il='';f=0;fc=1;inp=0
+ for c in m.group('after'):
+ if not inp:
+ if c=="'": fc=not fc
+ if c=='/' and fc: f=f+1;continue
+ if c=='(': inp = inp + 1
+ elif c==')': inp = inp - 1
+ if f==0: dl=dl+c
+ elif f==1: il=il+c
+ elif f==2:
+ dl = dl.strip()
+ if dl.startswith(','):
+ dl = dl[1:].strip()
+ ll.append([dl,il])
+ dl=c;il='';f=0
+ if f==2:
+ dl = dl.strip()
+ if dl.startswith(','):
+ dl = dl[1:].strip()
+ ll.append([dl,il])
+ vars={}
+ if groupcache[groupcounter].has_key('vars'):
+ vars=groupcache[groupcounter]['vars']
+ last_name = None
+ for l in ll:
+ l=map(string.strip,l)
+ if l[0][0]==',':l[0]=l[0][1:]
+ if l[0][0]=='(':
+ outmess('analyzeline: implied-DO list "%s" is not supported. Skipping.\n'%l[0])
+ continue
+ #if '(' in l[0]:
+ # #outmess('analyzeline: ignoring this data statement.\n')
+ # continue
+ i=0;j=0;llen=len(l[1])
+ for v in rmbadname(map(string.strip,string.split(markoutercomma(l[0]),'@,@'))):
+ if v[0]=='(':
+ outmess('analyzeline: implied-DO list "%s" is not supported. Skipping.\n'%v)
+ # XXX: subsequent init expressions may get wrong values.
+ # Ignoring since data statements are irrelevant for wrapping.
+ continue
+ fc=0
+ while (i<llen) and (fc or not l[1][i]==','):
+ if l[1][i]=="'": fc=not fc
+ i=i+1
+ i=i+1
+ #v,l[1][j:i-1]=name,initvalue
+ if not vars.has_key(v):
+ vars[v]={}
+ if vars[v].has_key('=') and not vars[v]['=']==l[1][j:i-1]:
+ outmess('analyzeline: changing init expression of "%s" ("%s") to "%s"\n'%(v,vars[v]['='],l[1][j:i-1]))
+ vars[v]['=']=l[1][j:i-1]
+ j=i
+ last_name = v
+ groupcache[groupcounter]['vars']=vars
+ if last_name is not None:
+ previous_context = ('variable',last_name,groupcounter)
+ elif case=='common':
+ line=string.strip(m.group('after'))
+ if not line[0]=='/':line='//'+line
+ cl=[]
+ f=0;bn='';ol=''
+ for c in line:
+ if c=='/':f=f+1;continue
+ if f>=3:
+ bn = string.strip(bn)
+ if not bn: bn='_BLNK_'
+ cl.append([bn,ol])
+ f=f-2;bn='';ol=''
+ if f%2: bn=bn+c
+ else: ol=ol+c
+ bn = string.strip(bn)
+ if not bn: bn='_BLNK_'
+ cl.append([bn,ol])
+ commonkey={}
+ if groupcache[groupcounter].has_key('common'):
+ commonkey=groupcache[groupcounter]['common']
+ for c in cl:
+ if commonkey.has_key(c[0]):
+ outmess('analyzeline: previously defined common block encountered. Skipping.\n')
+ continue
+ commonkey[c[0]]=[]
+ for i in map(string.strip,string.split(markoutercomma(c[1]),'@,@')):
+ if i: commonkey[c[0]].append(i)
+ groupcache[groupcounter]['common']=commonkey
+ previous_context = ('common',bn,groupcounter)
+ elif case=='use':
+ m1=re.match(r'\A\s*(?P<name>\b[\w]+\b)\s*((,(\s*\bonly\b\s*:|(?P<notonly>))\s*(?P<list>.*))|)\s*\Z',m.group('after'),re.I)
+ if m1:
+ mm=m1.groupdict()
+ if not groupcache[groupcounter].has_key('use'): groupcache[groupcounter]['use']={}
+ name=m1.group('name')
+ groupcache[groupcounter]['use'][name]={}
+ isonly=0
+ if mm.has_key('list') and mm['list'] is not None:
+ if mm.has_key('notonly') and mm['notonly'] is None:isonly=1
+ groupcache[groupcounter]['use'][name]['only']=isonly
+ ll=map(string.strip,string.split(mm['list'],','))
+ rl={}
+ for l in ll:
+ if '=' in l:
+ m2=re.match(r'\A\s*(?P<local>\b[\w]+\b)\s*=\s*>\s*(?P<use>\b[\w]+\b)\s*\Z',l,re.I)
+ if m2: rl[string.strip(m2.group('local'))]=string.strip(m2.group('use'))
+ else:
+ outmess('analyzeline: Not local=>use pattern found in %s\n'%`l`)
+ else:
+ rl[l]=l
+ groupcache[groupcounter]['use'][name]['map']=rl
+ else:
+ pass
+
+ else:
+ print m.groupdict()
+ outmess('analyzeline: Could not crack the use statement.\n')
+ elif case in ['f2pyenhancements']:
+ if not groupcache[groupcounter].has_key ('f2pyenhancements'):
+ groupcache[groupcounter]['f2pyenhancements'] = {}
+ d = groupcache[groupcounter]['f2pyenhancements']
+ if m.group('this')=='usercode' and d.has_key('usercode'):
+ if type(d['usercode']) is type(''):
+ d['usercode'] = [d['usercode']]
+ d['usercode'].append(m.group('after'))
+ else:
+ d[m.group('this')] = m.group('after')
+ elif case=='multiline':
+ if previous_context is None:
+ if verbose:
+ outmess('analyzeline: No context for multiline block.\n')
+ return
+ gc = groupcounter
+ #gc = previous_context[2]
+ appendmultiline(groupcache[gc],
+ previous_context[:2],
+ m.group('this'))
+ else:
+ if verbose>1:
+ print m.groupdict()
+ outmess('analyzeline: No code implemented for line.\n')
+
+def appendmultiline(group, context_name,ml):
+ if not group.has_key('f2pymultilines'):
+ group['f2pymultilines'] = {}
+ d = group['f2pymultilines']
+ if not d.has_key(context_name):
+ d[context_name] = []
+ d[context_name].append(ml)
+ return
+
+def cracktypespec0(typespec,ll):
+ selector=None
+ attr=None
+ if re.match(r'double\s*complex',typespec,re.I): typespec='double complex'
+ elif re.match(r'double\s*precision',typespec,re.I): typespec='double precision'
+ else: typespec=string.lower(string.strip(typespec))
+ m1=selectpattern.match(markouterparen(ll))
+ if not m1:
+ outmess('cracktypespec0: no kind/char_selector pattern found for line.\n')
+ return
+ d=m1.groupdict()
+ for k in d.keys(): d[k]=unmarkouterparen(d[k])
+ if typespec in ['complex','integer','logical','real','character','type']:
+ selector=d['this']
+ ll=d['after']
+ i=string.find(ll,'::')
+ if i>=0:
+ attr=string.strip(ll[:i])
+ ll=ll[i+2:]
+ return typespec,selector,attr,ll
+#####
+namepattern=re.compile(r'\s*(?P<name>\b[\w]+\b)\s*(?P<after>.*)\s*\Z',re.I)
+kindselector=re.compile(r'\s*(\(\s*(kind\s*=)?\s*(?P<kind>.*)\s*\)|[*]\s*(?P<kind2>.*?))\s*\Z',re.I)
+charselector=re.compile(r'\s*(\((?P<lenkind>.*)\)|[*]\s*(?P<charlen>.*))\s*\Z',re.I)
+lenkindpattern=re.compile(r'\s*(kind\s*=\s*(?P<kind>.*?)\s*(@,@\s*len\s*=\s*(?P<len>.*)|)|(len\s*=\s*|)(?P<len2>.*?)\s*(@,@\s*(kind\s*=\s*|)(?P<kind2>.*)|))\s*\Z',re.I)
+lenarraypattern=re.compile(r'\s*(@\(@\s*(?!/)\s*(?P<array>.*?)\s*@\)@\s*[*]\s*(?P<len>.*?)|([*]\s*(?P<len2>.*?)|)\s*(@\(@\s*(?!/)\s*(?P<array2>.*?)\s*@\)@|))\s*(=\s*(?P<init>.*?)|(@\(@|)/\s*(?P<init2>.*?)\s*/(@\)@|)|)\s*\Z',re.I)
+def removespaces(expr):
+ expr=string.strip(expr)
+ if len(expr)<=1: return expr
+ expr2=expr[0]
+ for i in range(1,len(expr)-1):
+ if expr[i]==' ' and \
+ ((expr[i+1] in "()[]{}= ") or (expr[i-1] in "()[]{}= ")): continue
+ expr2=expr2+expr[i]
+ expr2=expr2+expr[-1]
+ return expr2
+def markinnerspaces(line):
+ l='';f=0
+ cc='\''
+ cc1='"'
+ cb=''
+ for c in line:
+ if cb=='\\' and c in ['\\','\'','"']:
+ l=l+c;
+ cb=c
+ continue
+ if f==0 and c in ['\'','"']: cc=c; cc1={'\'':'"','"':'\''}[c]
+ if c==cc:f=f+1
+ elif c==cc:f=f-1
+ elif c==' ' and f==1: l=l+'@_@'; continue
+ l=l+c;cb=c
+ return l
+def updatevars(typespec,selector,attrspec,entitydecl):
+ global groupcache,groupcounter
+ last_name = None
+ kindselect,charselect,typename=cracktypespec(typespec,selector)
+ if attrspec:
+ attrspec=map(string.strip,string.split(markoutercomma(attrspec),'@,@'))
+ l = []
+ c = re.compile(r'(?P<start>[a-zA-Z]+)')
+ for a in attrspec:
+ m = c.match(a)
+ if m:
+ s = string.lower(m.group('start'))
+ a = s + a[len(s):]
+ l.append(a)
+ attrspec = l
+ el=map(string.strip,string.split(markoutercomma(entitydecl),'@,@'))
+ el1=[]
+ for e in el:
+ for e1 in map(string.strip,string.split(markoutercomma(removespaces(markinnerspaces(e)),comma=' '),'@ @')):
+ if e1: el1.append(string.replace(e1,'@_@',' '))
+ for e in el1:
+ m=namepattern.match(e)
+ if not m:
+ outmess('updatevars: no name pattern found for entity=%s. Skipping.\n'%(`e`))
+ continue
+ ename=rmbadname1(m.group('name'))
+ edecl={}
+ if groupcache[groupcounter]['vars'].has_key(ename):
+ edecl=groupcache[groupcounter]['vars'][ename].copy()
+ has_typespec = edecl.has_key('typespec')
+ if not has_typespec:
+ edecl['typespec']=typespec
+ elif typespec and (not typespec==edecl['typespec']):
+ outmess('updatevars: attempt to change the type of "%s" ("%s") to "%s". Ignoring.\n' % (ename,edecl['typespec'],typespec))
+ if not edecl.has_key('kindselector'):
+ edecl['kindselector']=copy.copy(kindselect)
+ elif kindselect:
+ for k in kindselect.keys():
+ if edecl['kindselector'].has_key(k) and (not kindselect[k]==edecl['kindselector'][k]):
+ outmess('updatevars: attempt to change the kindselector "%s" of "%s" ("%s") to "%s". Ignoring.\n' % (k,ename,edecl['kindselector'][k],kindselect[k]))
+ else: edecl['kindselector'][k]=copy.copy(kindselect[k])
+ if not edecl.has_key('charselector') and charselect:
+ if not has_typespec:
+ edecl['charselector']=charselect
+ else:
+ errmess('updatevars:%s: attempt to change empty charselector to %r. Ignoring.\n' \
+ %(ename,charselect))
+ elif charselect:
+ for k in charselect.keys():
+ if edecl['charselector'].has_key(k) and (not charselect[k]==edecl['charselector'][k]):
+ outmess('updatevars: attempt to change the charselector "%s" of "%s" ("%s") to "%s". Ignoring.\n' % (k,ename,edecl['charselector'][k],charselect[k]))
+ else: edecl['charselector'][k]=copy.copy(charselect[k])
+ if not edecl.has_key('typename'):
+ edecl['typename']=typename
+ elif typename and (not edecl['typename']==typename):
+ outmess('updatevars: attempt to change the typename of "%s" ("%s") to "%s". Ignoring.\n' % (ename,edecl['typename'],typename))
+ if not edecl.has_key('attrspec'):
+ edecl['attrspec']=copy.copy(attrspec)
+ elif attrspec:
+ for a in attrspec:
+ if a not in edecl['attrspec']:
+ edecl['attrspec'].append(a)
+ else:
+ edecl['typespec']=copy.copy(typespec)
+ edecl['kindselector']=copy.copy(kindselect)
+ edecl['charselector']=copy.copy(charselect)
+ edecl['typename']=typename
+ edecl['attrspec']=copy.copy(attrspec)
+ if m.group('after'):
+ m1=lenarraypattern.match(markouterparen(m.group('after')))
+ if m1:
+ d1=m1.groupdict()
+ for lk in ['len','array','init']:
+ if d1[lk+'2'] is not None: d1[lk]=d1[lk+'2']; del d1[lk+'2']
+ for k in d1.keys():
+ if d1[k] is not None: d1[k]=unmarkouterparen(d1[k])
+ else: del d1[k]
+ if d1.has_key('len') and d1.has_key('array'):
+ if d1['len']=='':
+ d1['len']=d1['array']
+ del d1['array']
+ else:
+ d1['array']=d1['array']+','+d1['len']
+ del d1['len']
+ errmess('updatevars: "%s %s" is mapped to "%s %s(%s)"\n'%(typespec,e,typespec,ename,d1['array']))
+ if d1.has_key('array'):
+ dm = 'dimension(%s)'%d1['array']
+ if not edecl.has_key('attrspec') or (not edecl['attrspec']):
+ edecl['attrspec']=[dm]
+ else:
+ edecl['attrspec'].append(dm)
+ for dm1 in edecl['attrspec']:
+ if dm1[:9]=='dimension' and dm1!=dm:
+ del edecl['attrspec'][-1]
+ errmess('updatevars:%s: attempt to change %r to %r. Ignoring.\n' \
+ % (ename,dm1,dm))
+ break
+
+ if d1.has_key('len'):
+ if typespec in ['complex','integer','logical','real']:
+ if (not edecl.has_key('kindselector')) or (not edecl['kindselector']):
+ edecl['kindselector']={}
+ edecl['kindselector']['*']=d1['len']
+ elif typespec == 'character':
+ if (not edecl.has_key('charselector')) or (not edecl['charselector']): edecl['charselector']={}
+ if edecl['charselector'].has_key('len'): del edecl['charselector']['len']
+ edecl['charselector']['*']=d1['len']
+ if d1.has_key('init'):
+ if edecl.has_key('=') and (not edecl['=']==d1['init']):
+ outmess('updatevars: attempt to change the init expression of "%s" ("%s") to "%s". Ignoring.\n' % (ename,edecl['='],d1['init']))
+ else:
+ edecl['=']=d1['init']
+ else:
+ outmess('updatevars: could not crack entity declaration "%s". Ignoring.\n'%(ename+m.group('after')))
+ for k in edecl.keys():
+ if not edecl[k]: del edecl[k]
+ groupcache[groupcounter]['vars'][ename]=edecl
+ if groupcache[groupcounter].has_key('varnames'):
+ groupcache[groupcounter]['varnames'].append(ename)
+ last_name = ename
+ return last_name
+
+def cracktypespec(typespec,selector):
+ kindselect=None
+ charselect=None
+ typename=None
+ if selector:
+ if typespec in ['complex','integer','logical','real']:
+ kindselect=kindselector.match(selector)
+ if not kindselect:
+ outmess('cracktypespec: no kindselector pattern found for %s\n'%(`selector`))
+ return
+ kindselect=kindselect.groupdict()
+ kindselect['*']=kindselect['kind2']
+ del kindselect['kind2']
+ for k in kindselect.keys():
+ if not kindselect[k]: del kindselect[k]
+ for k,i in kindselect.items():
+ kindselect[k] = rmbadname1(i)
+ elif typespec=='character':
+ charselect=charselector.match(selector)
+ if not charselect:
+ outmess('cracktypespec: no charselector pattern found for %s\n'%(`selector`))
+ return
+ charselect=charselect.groupdict()
+ charselect['*']=charselect['charlen']
+ del charselect['charlen']
+ if charselect['lenkind']:
+ lenkind=lenkindpattern.match(markoutercomma(charselect['lenkind']))
+ lenkind=lenkind.groupdict()
+ for lk in ['len','kind']:
+ if lenkind[lk+'2']:
+ lenkind[lk]=lenkind[lk+'2']
+ charselect[lk]=lenkind[lk]
+ del lenkind[lk+'2']
+ del charselect['lenkind']
+ for k in charselect.keys():
+ if not charselect[k]: del charselect[k]
+ for k,i in charselect.items():
+ charselect[k] = rmbadname1(i)
+ elif typespec=='type':
+ typename=re.match(r'\s*\(\s*(?P<name>\w+)\s*\)',selector,re.I)
+ if typename: typename=typename.group('name')
+ else: outmess('cracktypespec: no typename found in %s\n'%(`typespec+selector`))
+ else:
+ outmess('cracktypespec: no selector used for %s\n'%(`selector`))
+ return kindselect,charselect,typename
+######
+def setattrspec(decl,attr,force=0):
+ if not decl: decl={}
+ if not attr: return decl
+ if not decl.has_key('attrspec'):
+ decl['attrspec']=[attr]
+ return decl
+ if force: decl['attrspec'].append(attr)
+ if attr in decl['attrspec']: return decl
+ if attr=='static' and 'automatic' not in decl['attrspec']:
+ decl['attrspec'].append(attr)
+ elif attr=='automatic' and 'static' not in decl['attrspec']:
+ decl['attrspec'].append(attr)
+ elif attr=='public' and 'private' not in decl['attrspec']:
+ decl['attrspec'].append(attr)
+ elif attr=='private' and 'public' not in decl['attrspec']:
+ decl['attrspec'].append(attr)
+ else:
+ decl['attrspec'].append(attr)
+ return decl
+def setkindselector(decl,sel,force=0):
+ if not decl: decl={}
+ if not sel: return decl
+ if not decl.has_key('kindselector'):
+ decl['kindselector']=sel
+ return decl
+ for k in sel.keys():
+ if force or not decl['kindselector'].has_key(k):
+ decl['kindselector'][k]=sel[k]
+ return decl
+def setcharselector(decl,sel,force=0):
+ if not decl: decl={}
+ if not sel: return decl
+ if not decl.has_key('charselector'):
+ decl['charselector']=sel
+ return decl
+ for k in sel.keys():
+ if force or not decl['charselector'].has_key(k):
+ decl['charselector'][k]=sel[k]
+ return decl
+def getblockname(block,unknown='unknown'):
+ if block.has_key('name'): return block['name']
+ return unknown
+###### post processing
+def setmesstext(block):
+ global filepositiontext
+ try: filepositiontext='In: %s:%s\n'%(block['from'],block['name'])
+ except: pass
+
+def get_usedict(block):
+ usedict = {}
+ if block.has_key('parent_block'):
+ usedict = get_usedict(block['parent_block'])
+ if block.has_key('use'):
+ usedict.update(block['use'])
+ return usedict
+
+def get_useparameters(block, param_map=None):
+ global f90modulevars
+ if param_map is None:
+ param_map = {}
+ usedict = get_usedict(block)
+ if not usedict:
+ return param_map
+ for usename,mapping in usedict.items():
+ usename = string.lower(usename)
+ if not f90modulevars.has_key(usename):
+ continue
+ mvars = f90modulevars[usename]
+ params = get_parameters(mvars)
+ if not params:
+ continue
+ # XXX: apply mapping
+ if mapping:
+ errmess('get_useparameters: mapping for %s not impl.' % (mapping))
+ for k,v in params.items():
+ if param_map.has_key(k):
+ outmess('get_useparameters: overriding parameter %s with'\
+ ' value from module %s' % (`k`,`usename`))
+ param_map[k] = v
+ return param_map
+
+def postcrack2(block,tab='',param_map=None):
+ global f90modulevars
+ if not f90modulevars:
+ return block
+ if type(block)==types.ListType:
+ ret = []
+ for g in block:
+ g = postcrack2(g,tab=tab+'\t',param_map=param_map)
+ ret.append(g)
+ return ret
+ setmesstext(block)
+ outmess('%sBlock: %s\n'%(tab,block['name']),0)
+
+ if param_map is None:
+ param_map = get_useparameters(block)
+
+ if param_map is not None and block.has_key('vars'):
+ vars = block['vars']
+ for n in vars.keys():
+ var = vars[n]
+ if var.has_key('kindselector'):
+ kind = var['kindselector']
+ if kind.has_key('kind'):
+ val = kind['kind']
+ if param_map.has_key(val):
+ kind['kind'] = param_map[val]
+ new_body = []
+ for b in block['body']:
+ b = postcrack2(b,tab=tab+'\t',param_map=param_map)
+ new_body.append(b)
+ block['body'] = new_body
+
+ return block
+
+def postcrack(block,args=None,tab=''):
+ """
+ TODO:
+ function return values
+ determine expression types if in argument list
+ """
+ global usermodules,onlyfunctions
+ if type(block)==types.ListType:
+ gret=[]
+ uret=[]
+ for g in block:
+ setmesstext(g)
+ g=postcrack(g,tab=tab+'\t')
+ if g.has_key('name') and string.find(g['name'],'__user__')>=0: # sort user routines to appear first
+ uret.append(g)
+ else:
+ gret.append(g)
+ return uret+gret
+ setmesstext(block)
+ if (not type(block)==types.DictType) and not block.has_key('block'):
+ raise 'postcrack: Expected block dictionary instead of ',block
+ if block.has_key('name') and not block['name']=='unknown_interface':
+ outmess('%sBlock: %s\n'%(tab,block['name']),0)
+ blocktype=block['block']
+ block=analyzeargs(block)
+ block=analyzecommon(block)
+ block['vars']=analyzevars(block)
+ block['sortvars']=sortvarnames(block['vars'])
+ if block.has_key('args') and block['args']:
+ args=block['args']
+ block['body']=analyzebody(block,args,tab=tab)
+
+ userisdefined=[]
+## fromuser = []
+ if block.has_key('use'):
+ useblock=block['use']
+ for k in useblock.keys():
+ if string.find(k,'__user__')>=0:
+ userisdefined.append(k)
+## if useblock[k].has_key('map'):
+## for n in useblock[k]['map'].values():
+## if n not in fromuser: fromuser.append(n)
+ else: useblock={}
+ name=''
+ if block.has_key('name'):name=block['name']
+ if block.has_key('externals') and block['externals']:# and not userisdefined: # Build a __user__ module
+ interfaced=[]
+ if block.has_key('interfaced'): interfaced=block['interfaced']
+ mvars=copy.copy(block['vars'])
+ if name: mname=name+'__user__routines'
+ else: mname='unknown__user__routines'
+ if mname in userisdefined:
+ i=1
+ while '%s_%i'%(mname,i) in userisdefined: i=i+1
+ mname='%s_%i'%(mname,i)
+ interface={'block':'interface','body':[],'vars':{},'name':name+'_user_interface'}
+ for e in block['externals']:
+## if e in fromuser:
+## outmess(' Skipping %s that is defined explicitly in another use statement\n'%(`e`))
+## continue
+ if e in interfaced:
+ edef=[]
+ j=-1
+ for b in block['body']:
+ j=j+1
+ if b['block']=='interface':
+ i=-1
+ for bb in b['body']:
+ i=i+1
+ if bb.has_key('name') and bb['name']==e:
+ edef=copy.copy(bb)
+ del b['body'][i]
+ break
+ if edef:
+ if not b['body']: del block['body'][j]
+ del interfaced[interfaced.index(e)]
+ break
+ interface['body'].append(edef)
+ else:
+ if mvars.has_key(e) and not isexternal(mvars[e]):
+ interface['vars'][e]=mvars[e]
+ if interface['vars'] or interface['body']:
+ block['interfaced']=interfaced
+ mblock={'block':'python module','body':[interface],'vars':{},'name':mname,'interfaced':block['externals']}
+ useblock[mname]={}
+ usermodules.append(mblock)
+ if useblock:
+ block['use']=useblock
+ return block
+
+def sortvarnames(vars):
+ indep = []
+ dep = []
+ for v in vars.keys():
+ if vars[v].has_key('depend') and vars[v]['depend']:
+ dep.append(v)
+ #print '%s depends on %s'%(v,vars[v]['depend'])
+ else: indep.append(v)
+ n = len(dep)
+ i = 0
+ while dep: #XXX: How to catch dependence cycles correctly?
+ v = dep[0]
+ fl = 0
+ for w in dep[1:]:
+ if w in vars[v]['depend']:
+ fl = 1
+ break
+ if fl:
+ dep = dep[1:]+[v]
+ i = i + 1
+ if i>n:
+ errmess('sortvarnames: failed to compute dependencies because'
+ ' of cyclic dependencies between '
+ +string.join(dep,', ')+'\n')
+ indep = indep + dep
+ break
+ else:
+ indep.append(v)
+ dep = dep[1:]
+ n = len(dep)
+ i = 0
+ #print indep
+ return indep
+
+def analyzecommon(block):
+ if not hascommon(block): return block
+ commonvars=[]
+ for k in block['common'].keys():
+ comvars=[]
+ for e in block['common'][k]:
+ m=re.match(r'\A\s*\b(?P<name>.*?)\b\s*(\((?P<dims>.*?)\)|)\s*\Z',e,re.I)
+ if m:
+ dims=[]
+ if m.group('dims'):
+ dims=map(string.strip,string.split(markoutercomma(m.group('dims')),'@,@'))
+ n=string.strip(m.group('name'))
+ if block['vars'].has_key(n):
+ if block['vars'][n].has_key('attrspec'):
+ block['vars'][n]['attrspec'].append('dimension(%s)'%(string.join(dims,',')))
+ else:
+ block['vars'][n]['attrspec']=['dimension(%s)'%(string.join(dims,','))]
+ else:
+ if dims:
+ block['vars'][n]={'attrspec':['dimension(%s)'%(string.join(dims,','))]}
+ else: block['vars'][n]={}
+ if n not in commonvars: commonvars.append(n)
+ else:
+ n=e
+ errmess('analyzecommon: failed to extract "<name>[(<dims>)]" from "%s" in common /%s/.\n'%(e,k))
+ comvars.append(n)
+ block['common'][k]=comvars
+ if not block.has_key('commonvars'):
+ block['commonvars']=commonvars
+ else:
+ block['commonvars']=block['commonvars']+commonvars
+ return block
+def analyzebody(block,args,tab=''):
+ global usermodules,skipfuncs,onlyfuncs,f90modulevars
+ setmesstext(block)
+ body=[]
+ for b in block['body']:
+ b['parent_block'] = block
+ if b['block'] in ['function','subroutine']:
+ if args is not None and b['name'] not in args:
+ continue
+ else:
+ as_=b['args']
+ if b['name'] in skipfuncs:
+ continue
+ if onlyfuncs and b['name'] not in onlyfuncs:
+ continue
+ else: as_=args
+ b=postcrack(b,as_,tab=tab+'\t')
+ if b['block']=='interface' and not b['body']:
+ if not b.has_key('f2pyenhancements'):
+ continue
+ if string.replace(b['block'],' ','')=='pythonmodule':
+ usermodules.append(b)
+ else:
+ if b['block']=='module':
+ f90modulevars[b['name']] = b['vars']
+ body.append(b)
+ return body
+def buildimplicitrules(block):
+ setmesstext(block)
+ implicitrules=defaultimplicitrules
+ attrrules={}
+ if block.has_key('implicit'):
+ if block['implicit'] is None:
+ implicitrules=None
+ if verbose>1:
+ outmess('buildimplicitrules: no implicit rules for routine %s.\n'%`block['name']`)
+ else:
+ for k in block['implicit'].keys():
+ if block['implicit'][k].get('typespec') not in ['static','automatic']:
+ implicitrules[k]=block['implicit'][k]
+ else:
+ attrrules[k]=block['implicit'][k]['typespec']
+ return implicitrules,attrrules
+
+def myeval(e,g=None,l=None):
+ r = eval(e,g,l)
+ if type(r) in [type(0),type(0.0)]:
+ return r
+ raise ValueError,'r=%r' % (r)
+
+getlincoef_re_1 = re.compile(r'\A\b\w+\b\Z',re.I)
+def getlincoef(e,xset): # e = a*x+b ; x in xset
+ try:
+ c = int(myeval(e,{},{}))
+ return 0,c,None
+ except: pass
+ if getlincoef_re_1.match(e):
+ return 1,0,e
+ len_e = len(e)
+ for x in xset:
+ if len(x)>len_e: continue
+ re_1 = re.compile(r'(?P<before>.*?)\b'+x+r'\b(?P<after>.*)',re.I)
+ m = re_1.match(e)
+ if m:
+ try:
+ m1 = re_1.match(e)
+ while m1:
+ ee = '%s(%s)%s'%(m1.group('before'),0,m1.group('after'))
+ m1 = re_1.match(ee)
+ b = myeval(ee,{},{})
+ m1 = re_1.match(e)
+ while m1:
+ ee = '%s(%s)%s'%(m1.group('before'),1,m1.group('after'))
+ m1 = re_1.match(ee)
+ a = myeval(ee,{},{}) - b
+ m1 = re_1.match(e)
+ while m1:
+ ee = '%s(%s)%s'%(m1.group('before'),0.5,m1.group('after'))
+ m1 = re_1.match(ee)
+ c = myeval(ee,{},{})
+ if (a*0.5+b==c):
+ return a,b,x
+ except: pass
+ break
+ return None,None,None
+
+_varname_match = re.compile(r'\A[a-z]\w*\Z').match
+def getarrlen(dl,args,star='*'):
+ edl = []
+ try: edl.append(myeval(dl[0],{},{}))
+ except: edl.append(dl[0])
+ try: edl.append(myeval(dl[1],{},{}))
+ except: edl.append(dl[1])
+ if type(edl[0]) is type(0):
+ p1 = 1-edl[0]
+ if p1==0: d = str(dl[1])
+ elif p1<0: d = '%s-%s'%(dl[1],-p1)
+ else: d = '%s+%s'%(dl[1],p1)
+ elif type(edl[1]) is type(0):
+ p1 = 1+edl[1]
+ if p1==0: d='-(%s)' % (dl[0])
+ else: d='%s-(%s)' % (p1,dl[0])
+ else: d = '%s-(%s)+1'%(dl[1],dl[0])
+ try: return `myeval(d,{},{})`,None,None
+ except: pass
+ d1,d2=getlincoef(dl[0],args),getlincoef(dl[1],args)
+ if None not in [d1[0],d2[0]]:
+ if (d1[0],d2[0])==(0,0):
+ return `d2[1]-d1[1]+1`,None,None
+ b = d2[1] - d1[1] + 1
+ d1 = (d1[0],0,d1[2])
+ d2 = (d2[0],b,d2[2])
+ if d1[0]==0 and d2[2] in args:
+ if b<0: return '%s * %s - %s'%(d2[0],d2[2],-b),d2[2],'+%s)/(%s)'%(-b,d2[0])
+ elif b: return '%s * %s + %s'%(d2[0],d2[2],b),d2[2],'-%s)/(%s)'%(b,d2[0])
+ else: return '%s * %s'%(d2[0],d2[2]),d2[2],')/(%s)'%(d2[0])
+ if d2[0]==0 and d1[2] in args:
+
+ if b<0: return '%s * %s - %s'%(-d1[0],d1[2],-b),d1[2],'+%s)/(%s)'%(-b,-d1[0])
+ elif b: return '%s * %s + %s'%(-d1[0],d1[2],b),d1[2],'-%s)/(%s)'%(b,-d1[0])
+ else: return '%s * %s'%(-d1[0],d1[2]),d1[2],')/(%s)'%(-d1[0])
+ if d1[2]==d2[2] and d1[2] in args:
+ a = d2[0] - d1[0]
+ if not a: return `b`,None,None
+ if b<0: return '%s * %s - %s'%(a,d1[2],-b),d2[2],'+%s)/(%s)'%(-b,a)
+ elif b: return '%s * %s + %s'%(a,d1[2],b),d2[2],'-%s)/(%s)'%(b,a)
+ else: return '%s * %s'%(a,d1[2]),d2[2],')/(%s)'%(a)
+ if d1[0]==d2[0]==1:
+ c = str(d1[2])
+ if c not in args:
+ if _varname_match(c):
+ outmess('\tgetarrlen:variable "%s" undefined\n' % (c))
+ c = '(%s)'%c
+ if b==0: d='%s-%s' % (d2[2],c)
+ elif b<0: d='%s-%s-%s' % (d2[2],c,-b)
+ else: d='%s-%s+%s' % (d2[2],c,b)
+ elif d1[0]==0:
+ c2 = str(d2[2])
+ if c2 not in args:
+ if _varname_match(c2):
+ outmess('\tgetarrlen:variable "%s" undefined\n' % (c2))
+ c2 = '(%s)'%c2
+ if d2[0]==1: pass
+ elif d2[0]==-1: c2='-%s' %c2
+ else: c2='%s*%s'%(d2[0],c2)
+
+ if b==0: d=c2
+ elif b<0: d='%s-%s' % (c2,-b)
+ else: d='%s+%s' % (c2,b)
+ elif d2[0]==0:
+ c1 = str(d1[2])
+ if c1 not in args:
+ if _varname_match(c1):
+ outmess('\tgetarrlen:variable "%s" undefined\n' % (c1))
+ c1 = '(%s)'%c1
+ if d1[0]==1: c1='-%s'%c1
+ elif d1[0]==-1: c1='+%s'%c1
+ elif d1[0]<0: c1='+%s*%s'%(-d1[0],c1)
+ else: c1 = '-%s*%s' % (d1[0],c1)
+
+ if b==0: d=c1
+ elif b<0: d='%s-%s' % (c1,-b)
+ else: d='%s+%s' % (c1,b)
+ else:
+ c1 = str(d1[2])
+ if c1 not in args:
+ if _varname_match(c1):
+ outmess('\tgetarrlen:variable "%s" undefined\n' % (c1))
+ c1 = '(%s)'%c1
+ if d1[0]==1: c1='-%s'%c1
+ elif d1[0]==-1: c1='+%s'%c1
+ elif d1[0]<0: c1='+%s*%s'%(-d1[0],c1)
+ else: c1 = '-%s*%s' % (d1[0],c1)
+
+ c2 = str(d2[2])
+ if c2 not in args:
+ if _varname_match(c2):
+ outmess('\tgetarrlen:variable "%s" undefined\n' % (c2))
+ c2 = '(%s)'%c2
+ if d2[0]==1: pass
+ elif d2[0]==-1: c2='-%s' %c2
+ else: c2='%s*%s'%(d2[0],c2)
+
+ if b==0: d='%s%s' % (c2,c1)
+ elif b<0: d='%s%s-%s' % (c2,c1,-b)
+ else: d='%s%s+%s' % (c2,c1,b)
+ return d,None,None
+
+word_pattern = re.compile(r'\b[a-z][\w$]*\b',re.I)
+
+def _get_depend_dict(name, vars, deps):
+ if vars.has_key(name):
+ words = vars[name].get('depend',[])
+
+ if vars[name].has_key('=') and not isstring(vars[name]):
+ for word in word_pattern.findall(vars[name]['=']):
+ if word not in words and vars.has_key(word):
+ words.append(word)
+ for word in words[:]:
+ for w in deps.get(word,[]) \
+ or _get_depend_dict(word, vars, deps):
+ if w not in words:
+ words.append(w)
+ else:
+ outmess('_get_depend_dict: no dependence info for %s\n' % (`name`))
+ words = []
+ deps[name] = words
+ return words
+
+def _calc_depend_dict(vars):
+ names = vars.keys()
+ depend_dict = {}
+ for n in names:
+ _get_depend_dict(n, vars, depend_dict)
+ return depend_dict
+
+def get_sorted_names(vars):
+ """
+ """
+ depend_dict = _calc_depend_dict(vars)
+ names = []
+ for name in depend_dict.keys():
+ if not depend_dict[name]:
+ names.append(name)
+ del depend_dict[name]
+ while depend_dict:
+ for name, lst in depend_dict.items():
+ new_lst = [n for n in lst if depend_dict.has_key(n)]
+ if not new_lst:
+ names.append(name)
+ del depend_dict[name]
+ else:
+ depend_dict[name] = new_lst
+ return [name for name in names if vars.has_key(name)]
+
+def _kind_func(string):
+ #XXX: return something sensible.
+ if string[0] in "'\"":
+ string = string[1:-1]
+ if real16pattern.match(string):
+ return 16
+ elif real8pattern.match(string):
+ return 8
+ return 'kind('+string+')'
+
+def _selected_int_kind_func(r):
+ #XXX: This should be processor dependent
+ m = 10**r
+ if m<=2**8: return 1
+ if m<=2**16: return 2
+ if m<=2**32: return 4
+ if m<=2**64: return 8
+ if m<=2**128: return 16
+ return -1
+
+def get_parameters(vars, global_params={}):
+ params = copy.copy(global_params)
+ g_params = copy.copy(global_params)
+ for name,func in [('kind',_kind_func),
+ ('selected_int_kind',_selected_int_kind_func),
+ ]:
+ if not g_params.has_key(name):
+ g_params[name] = func
+ param_names = []
+ for n in get_sorted_names(vars):
+ if vars[n].has_key('attrspec') and 'parameter' in vars[n]['attrspec']:
+ param_names.append(n)
+ kind_re = re.compile(r'\bkind\s*\(\s*(?P<value>.*)\s*\)',re.I)
+ selected_int_kind_re = re.compile(r'\bselected_int_kind\s*\(\s*(?P<value>.*)\s*\)',re.I)
+ for n in param_names:
+ if vars[n].has_key('='):
+ v = vars[n]['=']
+ if islogical(vars[n]):
+ v = v.lower()
+ for repl in [
+ ('.false.','False'),
+ ('.true.','True'),
+ #TODO: test .eq., .neq., etc replacements.
+ ]:
+ v = v.replace(*repl)
+ v = kind_re.sub(r'kind("\1")',v)
+ v = selected_int_kind_re.sub(r'selected_int_kind(\1)',v)
+ if isinteger(vars[n]) and not selected_int_kind_re.match(v):
+ v = v.split('_')[0]
+ if isdouble(vars[n]):
+ tt = list(v)
+ for m in real16pattern.finditer(v):
+ tt[m.start():m.end()] = list(\
+ v[m.start():m.end()].lower().replace('d', 'e'))
+ v = string.join(tt,'')
+ if iscomplex(vars[n]):
+ if v[0]=='(' and v[-1]==')':
+ l = markoutercomma(v[1:-1]).split('@,@')
+ print n,params
+ try:
+ params[n] = eval(v,g_params,params)
+ except Exception,msg:
+ params[n] = v
+ #print params
+ outmess('get_parameters: got "%s" on %s\n' % (msg,`v`))
+ if isstring(vars[n]) and type(params[n]) is type(0):
+ params[n] = chr(params[n])
+ nl = string.lower(n)
+ if nl!=n:
+ params[nl] = params[n]
+ else:
+ print vars[n]
+ outmess('get_parameters:parameter %s does not have value?!\n'%(`n`))
+ return params
+
+def _eval_length(length,params):
+ if length in ['(:)','(*)','*']:
+ return '(*)'
+ return _eval_scalar(length,params)
+
+_is_kind_number = re.compile('\d+_').match
+
+def _eval_scalar(value,params):
+ if _is_kind_number(value):
+ value = value.split('_')[0]
+ try:
+ value = str(eval(value,{},params))
+ except (NameError, SyntaxError):
+ return value
+ except Exception,msg:
+ errmess('"%s" in evaluating %r '\
+ '(available names: %s)\n' \
+ % (msg,value,params.keys()))
+ return value
+
+def analyzevars(block):
+ global f90modulevars
+ setmesstext(block)
+ implicitrules,attrrules=buildimplicitrules(block)
+ vars=copy.copy(block['vars'])
+ if block['block']=='function' and not vars.has_key(block['name']):
+ vars[block['name']]={}
+ if block['vars'].has_key(''):
+ del vars['']
+ if block['vars'][''].has_key('attrspec'):
+ gen=block['vars']['']['attrspec']
+ for n in vars.keys():
+ for k in ['public','private']:
+ if k in gen:
+ vars[n]=setattrspec(vars[n],k)
+ svars=[]
+ args = block['args']
+ for a in args:
+ try:
+ vars[a]
+ svars.append(a)
+ except KeyError:
+ pass
+ for n in vars.keys():
+ if n not in args: svars.append(n)
+
+ params = get_parameters(vars, get_useparameters(block))
+
+ dep_matches = {}
+ name_match = re.compile(r'\w[\w\d_$]*').match
+ for v in vars.keys():
+ m = name_match(v)
+ if m:
+ n = v[m.start():m.end()]
+ try:
+ dep_matches[n]
+ except KeyError:
+ dep_matches[n] = re.compile(r'.*\b%s\b'%(v),re.I).match
+ for n in svars:
+ if n[0] in attrrules.keys():
+ vars[n]=setattrspec(vars[n],attrrules[n[0]])
+ if not vars[n].has_key('typespec'):
+ if not(vars[n].has_key('attrspec') and 'external' in vars[n]['attrspec']):
+ if implicitrules:
+ ln0 = string.lower(n[0])
+ for k in implicitrules[ln0].keys():
+ if k=='typespec' and implicitrules[ln0][k]=='undefined':
+ continue
+ if not vars[n].has_key(k):
+ vars[n][k]=implicitrules[ln0][k]
+ elif k=='attrspec':
+ for l in implicitrules[ln0][k]:
+ vars[n]=setattrspec(vars[n],l)
+ elif n in block['args']:
+ outmess('analyzevars: typespec of variable %s is not defined in routine %s.\n'%(`n`,block['name']))
+
+ if vars[n].has_key('charselector'):
+ if vars[n]['charselector'].has_key('len'):
+ l = vars[n]['charselector']['len']
+ try:
+ l = str(eval(l,{},params))
+ except:
+ pass
+ vars[n]['charselector']['len'] = l
+
+ if vars[n].has_key('kindselector'):
+ if vars[n]['kindselector'].has_key('kind'):
+ l = vars[n]['kindselector']['kind']
+ try:
+ l = str(eval(l,{},params))
+ except:
+ pass
+ vars[n]['kindselector']['kind'] = l
+
+ savelindims = {}
+ if vars[n].has_key('attrspec'):
+ attr=vars[n]['attrspec']
+ attr.reverse()
+ vars[n]['attrspec']=[]
+ dim,intent,depend,check,note=None,None,None,None,None
+ for a in attr:
+ if a[:9]=='dimension': dim=(string.strip(a[9:]))[1:-1]
+ elif a[:6]=='intent': intent=(string.strip(a[6:]))[1:-1]
+ elif a[:6]=='depend': depend=(string.strip(a[6:]))[1:-1]
+ elif a[:5]=='check': check=(string.strip(a[5:]))[1:-1]
+ elif a[:4]=='note': note=(string.strip(a[4:]))[1:-1]
+ else: vars[n]=setattrspec(vars[n],a)
+ if intent:
+ if not vars[n].has_key('intent'): vars[n]['intent']=[]
+ for c in map(string.strip,string.split(markoutercomma(intent),'@,@')):
+ if not c in vars[n]['intent']:
+ vars[n]['intent'].append(c)
+ intent=None
+ if note:
+ note=string.replace(note,'\\n\\n','\n\n')
+ note=string.replace(note,'\\n ','\n')
+ if not vars[n].has_key('note'): vars[n]['note']=[note]
+ else: vars[n]['note'].append(note)
+ note=None
+ if depend is not None:
+ if not vars[n].has_key('depend'): vars[n]['depend']=[]
+ for c in rmbadname(map(string.strip,string.split(markoutercomma(depend),'@,@'))):
+ if c not in vars[n]['depend']:
+ vars[n]['depend'].append(c)
+ depend=None
+ if check is not None:
+ if not vars[n].has_key('check'): vars[n]['check']=[]
+ for c in map(string.strip,string.split(markoutercomma(check),'@,@')):
+ if not c in vars[n]['check']:
+ vars[n]['check'].append(c)
+ check=None
+ if dim and not vars[n].has_key('dimension'):
+ vars[n]['dimension']=[]
+ for d in rmbadname(map(string.strip,string.split(markoutercomma(dim),'@,@'))):
+ star = '*'
+ if d==':': star=':'
+ if params.has_key(d):
+ d = str(params[d])
+ for p in params.keys():
+ m = re.match(r'(?P<before>.*?)\b'+p+r'\b(?P<after>.*)',d,re.I)
+ if m:
+ #outmess('analyzevars:replacing parameter %s in %s (dimension of %s) with %s\n'%(`p`,`d`,`n`,`params[p]`))
+ d = m.group('before')+str(params[p])+m.group('after')
+ if d==star:
+ dl = [star]
+ else:
+ dl=string.split(markoutercomma(d,':'),'@:@')
+ if len(dl)==2 and '*' in dl: # e.g. dimension(5:*)
+ dl = ['*']
+ d = '*'
+ if len(dl)==1 and not dl[0]==star: dl = ['1',dl[0]]
+ if len(dl)==2:
+ d,v,di = getarrlen(dl,block['vars'].keys())
+ if d[:4] == '1 * ': d = d[4:]
+ if di and di[-4:] == '/(1)': di = di[:-4]
+ if v: savelindims[d] = v,di
+ vars[n]['dimension'].append(d)
+ if vars[n].has_key('dimension'):
+ if isintent_c(vars[n]):
+ shape_macro = 'shape'
+ else:
+ shape_macro = 'shape'#'fshape'
+ if isstringarray(vars[n]):
+ if vars[n].has_key('charselector'):
+ d = vars[n]['charselector']
+ if d.has_key('*'):
+ d = d['*']
+ errmess('analyzevars: character array "character*%s %s(%s)" is considered as "character %s(%s)"; "intent(c)" is forced.\n'\
+ %(d,n,
+ ','.join(vars[n]['dimension']),
+ n,','.join(vars[n]['dimension']+[d])))
+ vars[n]['dimension'].append(d)
+ del vars[n]['charselector']
+ if not vars[n].has_key('intent'):
+ vars[n]['intent'] = []
+ if 'c' not in vars[n]['intent']:
+ vars[n]['intent'].append('c')
+ else:
+ errmess("analyzevars: charselector=%r unhandled." % (d))
+ if not vars[n].has_key('check') and block.has_key('args') and n in block['args']:
+ flag=not vars[n].has_key('depend')
+ if flag: vars[n]['depend']=[]
+ vars[n]['check']=[]
+ if vars[n].has_key('dimension'):
+ #/----< no check
+ #vars[n]['check'].append('rank(%s)==%s'%(n,len(vars[n]['dimension'])))
+ i=-1; ni=len(vars[n]['dimension'])
+ for d in vars[n]['dimension']:
+ ddeps=[] # dependecies of 'd'
+ ad=''
+ pd=''
+ #origd = d
+ if not vars.has_key(d):
+ if savelindims.has_key(d):
+ pd,ad='(',savelindims[d][1]
+ d = savelindims[d][0]
+ else:
+ for r in block['args']:
+ #for r in block['vars'].keys():
+ if not vars.has_key(r): continue
+ if re.match(r'.*?\b'+r+r'\b',d,re.I):
+ ddeps.append(r)
+ if vars.has_key(d):
+ if vars[d].has_key('attrspec'):
+ for aa in vars[d]['attrspec']:
+ if aa[:6]=='depend':
+ ddeps=ddeps+string.split((string.strip(aa[6:]))[1:-1],',')
+ if vars[d].has_key('depend'):
+ ddeps=ddeps+vars[d]['depend']
+ i=i+1
+ if vars.has_key(d) and (not vars[d].has_key('depend')) \
+ and (not vars[d].has_key('=')) and (d not in vars[n]['depend']) \
+ and l_or(isintent_in,isintent_inout,isintent_inplace)(vars[n]):
+ vars[d]['depend']=[n]
+ if ni>1:
+ vars[d]['=']='%s%s(%s,%s)%s'% (pd,shape_macro,n,i,ad)
+ else:
+ vars[d]['=']='%slen(%s)%s'% (pd,n,ad)
+ # /---< no check
+ if 1 and not vars[d].has_key('check'):
+ if ni>1:
+ vars[d]['check']=['%s%s(%s,%i)%s==%s'\
+ %(pd,shape_macro,n,i,ad,d)]
+ else:
+ vars[d]['check']=['%slen(%s)%s>=%s'%(pd,n,ad,d)]
+ if not vars[d].has_key('attrspec'): vars[d]['attrspec']=['optional']
+ if ('optional' not in vars[d]['attrspec']) and\
+ ('required' not in vars[d]['attrspec']):
+ vars[d]['attrspec'].append('optional')
+ elif d not in ['*',':']:
+ #/----< no check
+ #if ni>1: vars[n]['check'].append('shape(%s,%i)==%s'%(n,i,d))
+ #else: vars[n]['check'].append('len(%s)>=%s'%(n,d))
+ if flag:
+ if vars.has_key(d):
+ if n not in ddeps:
+ vars[n]['depend'].append(d)
+ else:
+ vars[n]['depend'] = vars[n]['depend'] + ddeps
+ elif isstring(vars[n]):
+ length='1'
+ if vars[n].has_key('charselector'):
+ if vars[n]['charselector'].has_key('*'):
+ length = _eval_length(vars[n]['charselector']['*'],
+ params)
+ vars[n]['charselector']['*']=length
+ elif vars[n]['charselector'].has_key('len'):
+ length = _eval_length(vars[n]['charselector']['len'],
+ params)
+ del vars[n]['charselector']['len']
+ vars[n]['charselector']['*']=length
+
+ if not vars[n]['check']: del vars[n]['check']
+ if flag and not vars[n]['depend']: del vars[n]['depend']
+ if vars[n].has_key('='):
+ if not vars[n].has_key('attrspec'): vars[n]['attrspec']=[]
+ if ('optional' not in vars[n]['attrspec']) and \
+ ('required' not in vars[n]['attrspec']):
+ vars[n]['attrspec'].append('optional')
+ if not vars[n].has_key('depend'):
+ vars[n]['depend']=[]
+ for v,m in dep_matches.items():
+ if m(vars[n]['=']): vars[n]['depend'].append(v)
+ if not vars[n]['depend']: del vars[n]['depend']
+ if isscalar(vars[n]):
+ vars[n]['='] = _eval_scalar(vars[n]['='],params)
+
+ for n in vars.keys():
+ if n==block['name']: # n is block name
+ if vars[n].has_key('note'):
+ block['note']=vars[n]['note']
+ if block['block']=='function':
+ if block.has_key('result') and vars.has_key(block['result']):
+ vars[n]=appenddecl(vars[n],vars[block['result']])
+ if block.has_key('prefix'):
+ pr=block['prefix']; ispure=0; isrec=1
+ pr1=string.replace(pr,'pure','')
+ ispure=(not pr==pr1)
+ pr=string.replace(pr1,'recursive','')
+ isrec=(not pr==pr1)
+ m=typespattern[0].match(pr)
+ if m:
+ typespec,selector,attr,edecl=cracktypespec0(m.group('this'),m.group('after'))
+ kindselect,charselect,typename=cracktypespec(typespec,selector)
+ vars[n]['typespec']=typespec
+ if kindselect:
+ if kindselect.has_key('kind'):
+ try:
+ kindselect['kind'] = eval(kindselect['kind'],{},params)
+ except:
+ pass
+ vars[n]['kindselector']=kindselect
+ if charselect: vars[n]['charselector']=charselect
+ if typename: vars[n]['typename']=typename
+ if ispure: vars[n]=setattrspec(vars[n],'pure')
+ if isrec: vars[n]=setattrspec(vars[n],'recursive')
+ else:
+ outmess('analyzevars: prefix (%s) were not used\n'%`block['prefix']`)
+ if not block['block'] in ['module','pythonmodule','python module','block data']:
+ if block.has_key('commonvars'):
+ neededvars=copy.copy(block['args']+block['commonvars'])
+ else:
+ neededvars=copy.copy(block['args'])
+ for n in vars.keys():
+ if l_or(isintent_callback,isintent_aux)(vars[n]):
+ neededvars.append(n)
+ if block.has_key('entry'):
+ neededvars.extend(block['entry'].keys())
+ for k in block['entry'].keys():
+ for n in block['entry'][k]:
+ if n not in neededvars:
+ neededvars.append(n)
+ if block['block']=='function':
+ if block.has_key('result'):
+ neededvars.append(block['result'])
+ else:
+ neededvars.append(block['name'])
+ if block['block'] in ['subroutine','function']:
+ name = block['name']
+ if vars.has_key(name) and vars[name].has_key('intent'):
+ block['intent'] = vars[name]['intent']
+ if block['block'] == 'type':
+ neededvars.extend(vars.keys())
+ for n in vars.keys():
+ if n not in neededvars:
+ del vars[n]
+ return vars
+analyzeargs_re_1 = re.compile(r'\A[a-z]+[\w$]*\Z',re.I)
+def analyzeargs(block):
+ setmesstext(block)
+ implicitrules,attrrules=buildimplicitrules(block)
+ if not block.has_key('args'): block['args']=[]
+ args=[]
+ re_1 = analyzeargs_re_1
+ for a in block['args']:
+ if not re_1.match(a): # `a` is an expression
+ at=determineexprtype(a,block['vars'],implicitrules)
+ na='e_'
+ for c in a:
+ if c not in string.lowercase+string.digits: c='_'
+ na=na+c
+ if na[-1]=='_': na=na+'e'
+ else: na=na+'_e'
+ a=na
+ while block['vars'].has_key(a) or a in block['args']: a=a+'r'
+ block['vars'][a]=at
+ args.append(a)
+ if not block['vars'].has_key(a):
+ block['vars'][a]={}
+ if block.has_key('externals') and a in block['externals']+block['interfaced']:
+ block['vars'][a]=setattrspec(block['vars'][a],'external')
+ block['args']=args
+
+ if block.has_key('entry'):
+ for k,args1 in block['entry'].items():
+ for a in args1:
+ if not block['vars'].has_key(a):
+ block['vars'][a]={}
+
+ for b in block['body']:
+ if b['name'] in args:
+ if not block.has_key('externals'): block['externals']=[]
+ if b['name'] not in block['externals']:
+ block['externals'].append(b['name'])
+ if block.has_key('result') and not block['vars'].has_key(block['result']):
+ block['vars'][block['result']]={}
+ return block
+determineexprtype_re_1 = re.compile(r'\A\(.+?[,].+?\)\Z',re.I)
+determineexprtype_re_2 = re.compile(r'\A[+-]?\d+(_(P<name>[\w]+)|)\Z',re.I)
+determineexprtype_re_3 = re.compile(r'\A[+-]?[\d.]+[\d+-de.]*(_(P<name>[\w]+)|)\Z',re.I)
+determineexprtype_re_4 = re.compile(r'\A\(.*\)\Z',re.I)
+determineexprtype_re_5 = re.compile(r'\A(?P<name>\w+)\s*\(.*?\)\s*\Z',re.I)
+def _ensure_exprdict(r):
+ if type(r) is type(0):
+ return {'typespec':'integer'}
+ if type(r) is type(0.0):
+ return {'typespec':'real'}
+ if type(r) is type(0j):
+ return {'typespec':'complex'}
+ assert type(r) is type({}),`r`
+ return r
+
+def determineexprtype(expr,vars,rules={}):
+ if vars.has_key(expr):
+ return _ensure_exprdict(vars[expr])
+ expr=string.strip(expr)
+ if determineexprtype_re_1.match(expr):
+ return {'typespec':'complex'}
+ m=determineexprtype_re_2.match(expr)
+ if m:
+ if m.groupdict().has_key('name') and m.group('name'):
+ outmess('determineexprtype: selected kind types not supported (%s)\n'%`expr`)
+ return {'typespec':'integer'}
+ m = determineexprtype_re_3.match(expr)
+ if m:
+ if m.groupdict().has_key('name') and m.group('name'):
+ outmess('determineexprtype: selected kind types not supported (%s)\n'%`expr`)
+ return {'typespec':'real'}
+ for op in ['+','-','*','/']:
+ for e in map(string.strip,string.split(markoutercomma(expr,comma=op),'@'+op+'@')):
+ if vars.has_key(e):
+ return _ensure_exprdict(vars[e])
+ t={}
+ if determineexprtype_re_4.match(expr): # in parenthesis
+ t=determineexprtype(expr[1:-1],vars,rules)
+ else:
+ m = determineexprtype_re_5.match(expr)
+ if m:
+ rn=m.group('name')
+ t=determineexprtype(m.group('name'),vars,rules)
+ if t and t.has_key('attrspec'): del t['attrspec']
+ if not t:
+ if rules.has_key(rn[0]):
+ return _ensure_exprdict(rules[rn[0]])
+ if expr[0] in '\'"':
+ return {'typespec':'character','charselector':{'*':'*'}}
+ if not t:
+ outmess('determineexprtype: could not determine expressions (%s) type.\n'%(`expr`))
+ return t
+######
+def crack2fortrangen(block,tab='\n'):
+ global skipfuncs, onlyfuncs
+ setmesstext(block)
+ ret=''
+ if type(block) is type([]):
+ for g in block:
+ if g['block'] in ['function','subroutine']:
+ if g['name'] in skipfuncs:
+ continue
+ if onlyfuncs and g['name'] not in onlyfuncs:
+ continue
+ ret=ret+crack2fortrangen(g,tab)
+ return ret
+ prefix=''
+ name=''
+ args=''
+ blocktype=block['block']
+ if blocktype=='program': return ''
+ al=[]
+ if block.has_key('name'): name=block['name']
+ if block.has_key('args'):
+ vars = block['vars']
+ al = [a for a in block['args'] if not isintent_callback(vars[a])]
+ if block['block']=='function' or al:
+ args='(%s)'%string.join(al,',')
+ f2pyenhancements = ''
+ if block.has_key('f2pyenhancements'):
+ for k in block['f2pyenhancements'].keys():
+ f2pyenhancements = '%s%s%s %s'%(f2pyenhancements,tab+tabchar,k,block['f2pyenhancements'][k])
+ intent_lst = block.get('intent',[])[:]
+ if blocktype=='function' and 'callback' in intent_lst:
+ intent_lst.remove('callback')
+ if intent_lst:
+ f2pyenhancements = '%s%sintent(%s) %s'%\
+ (f2pyenhancements,tab+tabchar,
+ string.join(intent_lst,','),name)
+ use=''
+ if block.has_key('use'):
+ use=use2fortran(block['use'],tab+tabchar)
+ common=''
+ if block.has_key('common'):
+ common=common2fortran(block['common'],tab+tabchar)
+ if name=='unknown_interface': name=''
+ result=''
+ if block.has_key('result'):
+ result=' result (%s)'%block['result']
+ if block['result'] not in al:
+ al.append(block['result'])
+ #if block.has_key('prefix'): prefix=block['prefix']+' '
+ body=crack2fortrangen(block['body'],tab+tabchar)
+ vars=vars2fortran(block,block['vars'],al,tab+tabchar)
+ mess=''
+ if block.has_key('from'):
+ mess='! in %s'%block['from']
+ if block.has_key('entry'):
+ entry_stmts = ''
+ for k,i in block['entry'].items():
+ entry_stmts = '%s%sentry %s(%s)' \
+ % (entry_stmts,tab+tabchar,k,string.join(i,','))
+ body = body + entry_stmts
+ if blocktype=='block data' and name=='_BLOCK_DATA_':
+ name = ''
+ ret='%s%s%s %s%s%s %s%s%s%s%s%s%send %s %s'%(tab,prefix,blocktype,name,args,result,mess,f2pyenhancements,use,vars,common,body,tab,blocktype,name)
+ return ret
+def common2fortran(common,tab=''):
+ ret=''
+ for k in common.keys():
+ if k=='_BLNK_':
+ ret='%s%scommon %s'%(ret,tab,string.join(common[k],','))
+ else:
+ ret='%s%scommon /%s/ %s'%(ret,tab,k,string.join(common[k],','))
+ return ret
+def use2fortran(use,tab=''):
+ ret=''
+ for m in use.keys():
+ ret='%s%suse %s,'%(ret,tab,m)
+ if use[m]=={}:
+ if ret and ret[-1]==',': ret=ret[:-1]
+ continue
+ if use[m].has_key('only') and use[m]['only']:
+ ret='%s,only:'%(ret)
+ if use[m].has_key('map') and use[m]['map']:
+ c=' '
+ for k in use[m]['map'].keys():
+ if k==use[m]['map'][k]:
+ ret='%s%s%s'%(ret,c,k); c=','
+ else:
+ ret='%s%s%s=>%s'%(ret,c,k,use[m]['map'][k]); c=','
+ if ret and ret[-1]==',': ret=ret[:-1]
+ return ret
+def true_intent_list(var):
+ lst = var['intent']
+ ret = []
+ for intent in lst:
+ try:
+ exec('c = isintent_%s(var)' % intent)
+ except NameError:
+ c = 0
+ if c:
+ ret.append(intent)
+ return ret
+def vars2fortran(block,vars,args,tab=''):
+ """
+ TODO:
+ public sub
+ ...
+ """
+ setmesstext(block)
+ ret=''
+ nout=[]
+ for a in args:
+ if block['vars'].has_key(a): nout.append(a)
+ if block.has_key('commonvars'):
+ for a in block['commonvars']:
+ if vars.has_key(a):
+ if a not in nout: nout.append(a)
+ else: errmess('vars2fortran: Confused?!: "%s" is not defined in vars.\n'%a)
+ if block.has_key('varnames'):
+ nout.extend(block['varnames'])
+ for a in vars.keys():
+ if a not in nout: nout.append(a)
+ for a in nout:
+ if vars[a].has_key('depend'):
+ for d in vars[a]['depend']:
+ if vars.has_key(d) and vars[d].has_key('depend') and a in vars[d]['depend']:
+ errmess('vars2fortran: Warning: cross-dependence between variables "%s" and "%s"\n'%(a,d))
+ if block.has_key('externals') and a in block['externals']:
+ if isintent_callback(vars[a]):
+ ret='%s%sintent(callback) %s'%(ret,tab,a)
+ ret='%s%sexternal %s'%(ret,tab,a)
+ if isoptional(vars[a]):
+ ret='%s%soptional %s'%(ret,tab,a)
+ if vars.has_key(a) and not vars[a].has_key('typespec'):
+ continue
+ cont=1
+ for b in block['body']:
+ if a==b['name'] and b['block']=='function': cont=0;break
+ if cont: continue
+ if not vars.has_key(a):
+ show(vars)
+ outmess('vars2fortran: No definition for argument "%s".\n'%a)
+ continue
+ if a==block['name'] and not block['block']=='function':
+ continue
+ if not vars[a].has_key('typespec'):
+ if vars[a].has_key('attrspec') and 'external' in vars[a]['attrspec']:
+ if a in args:
+ ret='%s%sexternal %s'%(ret,tab,a)
+ continue
+ show(vars[a])
+ outmess('vars2fortran: No typespec for argument "%s".\n'%a)
+ continue
+ vardef=vars[a]['typespec']
+ if vardef=='type' and vars[a].has_key('typename'):
+ vardef='%s(%s)'%(vardef,vars[a]['typename'])
+ selector={}
+ if vars[a].has_key('kindselector'): selector=vars[a]['kindselector']
+ elif vars[a].has_key('charselector'): selector=vars[a]['charselector']
+ if selector.has_key('*'):
+ if selector['*'] in ['*',':']:
+ vardef='%s*(%s)'%(vardef,selector['*'])
+ else:
+ vardef='%s*%s'%(vardef,selector['*'])
+ else:
+ if selector.has_key('len'):
+ vardef='%s(len=%s'%(vardef,selector['len'])
+ if selector.has_key('kind'):
+ vardef='%s,kind=%s)'%(vardef,selector['kind'])
+ else:
+ vardef='%s)'%(vardef)
+ elif selector.has_key('kind'):
+ vardef='%s(kind=%s)'%(vardef,selector['kind'])
+ c=' '
+ if vars[a].has_key('attrspec'):
+ attr=[]
+ for l in vars[a]['attrspec']:
+ if l not in ['external']:
+ attr.append(l)
+ if attr:
+ vardef='%s %s'%(vardef,string.join(attr,','))
+ c=','
+ if vars[a].has_key('dimension'):
+# if not isintent_c(vars[a]):
+# vars[a]['dimension'].reverse()
+ vardef='%s%sdimension(%s)'%(vardef,c,string.join(vars[a]['dimension'],','))
+ c=','
+ if vars[a].has_key('intent'):
+ lst = true_intent_list(vars[a])
+ if lst:
+ vardef='%s%sintent(%s)'%(vardef,c,string.join(lst,','))
+ c=','
+ if vars[a].has_key('check'):
+ vardef='%s%scheck(%s)'%(vardef,c,string.join(vars[a]['check'],','))
+ c=','
+ if vars[a].has_key('depend'):
+ vardef='%s%sdepend(%s)'%(vardef,c,string.join(vars[a]['depend'],','))
+ c=','
+ if vars[a].has_key('='):
+ v = vars[a]['=']
+ if vars[a]['typespec'] in ['complex','double complex']:
+ try:
+ v = eval(v)
+ v = '(%s,%s)' % (v.real,v.imag)
+ except:
+ pass
+ vardef='%s :: %s=%s'%(vardef,a,v)
+ else:
+ vardef='%s :: %s'%(vardef,a)
+ ret='%s%s%s'%(ret,tab,vardef)
+ return ret
+######
+
+def crackfortran(files):
+ global usermodules
+ outmess('Reading fortran codes...\n',0)
+ readfortrancode(files,crackline)
+ outmess('Post-processing...\n',0)
+ usermodules=[]
+ postlist=postcrack(grouplist[0])
+ outmess('Post-processing (stage 2)...\n',0)
+ postlist=postcrack2(postlist)
+ return usermodules+postlist
+def crack2fortran(block):
+ global f2py_version
+ pyf=crack2fortrangen(block)+'\n'
+ header="""! -*- f90 -*-
+! Note: the context of this file is case sensitive.
+"""
+ footer="""
+! This file was auto-generated with f2py (version:%s).
+! See http://cens.ioc.ee/projects/f2py2e/
+"""%(f2py_version)
+ return header+pyf+footer
+
+if __name__ == "__main__":
+ files=[]
+ funcs=[]
+ f=1;f2=0;f3=0
+ showblocklist=0
+ for l in sys.argv[1:]:
+ if l=='': pass
+ elif l[0]==':':
+ f=0
+ elif l=='-quiet':
+ quiet=1
+ verbose=0
+ elif l=='-verbose':
+ verbose=2
+ quiet=0
+ elif l=='-fix':
+ if strictf77:
+ outmess('Use option -f90 before -fix if Fortran 90 code is in fix form.\n',0)
+ skipemptyends=1
+ sourcecodeform='fix'
+ elif l=='-skipemptyends':
+ skipemptyends=1
+ elif l=='--ignore-contains':
+ ignorecontains=1
+ elif l=='-f77':
+ strictf77=1
+ sourcecodeform='fix'
+ elif l=='-f90':
+ strictf77=0
+ sourcecodeform='free'
+ skipemptyends=1
+ elif l=='-h':
+ f2=1
+ elif l=='-show':
+ showblocklist=1
+ elif l=='-m':
+ f3=1
+ elif l[0]=='-':
+ errmess('Unknown option %s\n'%`l`)
+ elif f2:
+ f2=0
+ pyffilename=l
+ elif f3:
+ f3=0
+ f77modulename=l
+ elif f:
+ try:
+ open(l).close()
+ files.append(l)
+ except IOError,detail:
+ errmess('IOError: %s\n'%str(detail))
+ else:
+ funcs.append(l)
+ if not strictf77 and f77modulename and not skipemptyends:
+ outmess("""\
+ Warning: You have specifyied module name for non Fortran 77 code
+ that should not need one (expect if you are scanning F90 code
+ for non module blocks but then you should use flag -skipemptyends
+ and also be sure that the files do not contain programs without program statement).
+""",0)
+
+ postlist=crackfortran(files,funcs)
+ if pyffilename:
+ outmess('Writing fortran code to file %s\n'%`pyffilename`,0)
+ pyf=crack2fortran(postlist)
+ f=open(pyffilename,'w')
+ f.write(pyf)
+ f.close()
+ if showblocklist:
+ show(postlist)
diff --git a/numpy/f2py/diagnose.py b/numpy/f2py/diagnose.py
new file mode 100644
index 000000000..c270c597c
--- /dev/null
+++ b/numpy/f2py/diagnose.py
@@ -0,0 +1,166 @@
+#!/usr/bin/env python
+
+import os,sys,tempfile
+
+def run_command(cmd):
+ print 'Running %r:' % (cmd)
+ s = os.system(cmd)
+ print '------'
+def run():
+ _path = os.getcwd()
+ os.chdir(tempfile.gettempdir())
+ print '------'
+ print 'os.name=%r' % (os.name)
+ print '------'
+ print 'sys.platform=%r' % (sys.platform)
+ print '------'
+ print 'sys.version:'
+ print sys.version
+ print '------'
+ print 'sys.prefix:'
+ print sys.prefix
+ print '------'
+ print 'sys.path=%r' % (':'.join(sys.path))
+ print '------'
+ try:
+ import Numeric
+ has_Numeric = 1
+ except ImportError:
+ print 'Failed to import Numeric:',sys.exc_value
+ has_Numeric = 0
+ try:
+ import numarray
+ has_numarray = 1
+ except ImportError:
+ print 'Failed to import numarray:',sys.exc_value
+ has_numarray = 0
+ try:
+ import numpy
+ has_newnumpy = 1
+ except ImportError:
+ print 'Failed to import new numpy:', sys.exc_value
+ has_newnumpy = 0
+ try:
+ import f2py2e
+ has_f2py2e = 1
+ except ImportError:
+ print 'Failed to import f2py2e:',sys.exc_value
+ has_f2py2e = 0
+ try:
+ import numpy.distutils
+ has_numpy_distutils = 2
+ except ImportError:
+ try:
+ import numpy_distutils
+ has_numpy_distutils = 1
+ except ImportError:
+ print 'Failed to import numpy_distutils:',sys.exc_value
+ has_numpy_distutils = 0
+ if has_Numeric:
+ try:
+ print 'Found Numeric version %r in %s' % \
+ (Numeric.__version__,Numeric.__file__)
+ except Exception,msg:
+ print 'error:',msg
+ print '------'
+ if has_numarray:
+ try:
+ print 'Found numarray version %r in %s' % \
+ (numarray.__version__,numarray.__file__)
+ except Exception,msg:
+ print 'error:',msg
+ print '------'
+ if has_newnumpy:
+ try:
+ print 'Found new numpy version %r in %s' % \
+ (numpy.__version__, numpy.__file__)
+ except Exception,msg:
+ print 'error:', msg
+ print '------'
+ if has_f2py2e:
+ try:
+ print 'Found f2py2e version %r in %s' % \
+ (f2py2e.__version__.version,f2py2e.__file__)
+ except Exception,msg:
+ print 'error:',msg
+ print '------'
+ if has_numpy_distutils:
+ try:
+ if has_numpy_distutils==2:
+ print 'Found numpy.distutils version %r in %r' % (\
+ numpy.distutils.__version__,
+ numpy.distutils.__file__)
+ else:
+ print 'Found numpy_distutils version %r in %r' % (\
+ numpy_distutils.numpy_distutils_version.numpy_distutils_version,
+ numpy_distutils.__file__)
+ print '------'
+ except Exception,msg:
+ print 'error:',msg
+ print '------'
+ try:
+ if has_numpy_distutils==1:
+ print 'Importing numpy_distutils.command.build_flib ...',
+ import numpy_distutils.command.build_flib as build_flib
+ print 'ok'
+ print '------'
+ try:
+ print 'Checking availability of supported Fortran compilers:'
+ for compiler_class in build_flib.all_compilers:
+ compiler_class(verbose=1).is_available()
+ print '------'
+ except Exception,msg:
+ print 'error:',msg
+ print '------'
+ except Exception,msg:
+ print 'error:',msg,'(ignore it, build_flib is obsolute for numpy.distutils 0.2.2 and up)'
+ print '------'
+ try:
+ if has_numpy_distutils==2:
+ print 'Importing numpy.distutils.fcompiler ...',
+ import numpy.distutils.fcompiler as fcompiler
+ else:
+ print 'Importing numpy_distutils.fcompiler ...',
+ import numpy_distutils.fcompiler as fcompiler
+ print 'ok'
+ print '------'
+ try:
+ print 'Checking availability of supported Fortran compilers:'
+ fcompiler.show_fcompilers()
+ print '------'
+ except Exception,msg:
+ print 'error:',msg
+ print '------'
+ except Exception,msg:
+ print 'error:',msg
+ print '------'
+ try:
+ if has_numpy_distutils==2:
+ print 'Importing numpy.distutils.cpuinfo ...',
+ from numpy.distutils.cpuinfo import cpuinfo
+ print 'ok'
+ print '------'
+ else:
+ try:
+ print 'Importing numpy_distutils.command.cpuinfo ...',
+ from numpy_distutils.command.cpuinfo import cpuinfo
+ print 'ok'
+ print '------'
+ except Exception,msg:
+ print 'error:',msg,'(ignore it)'
+ print 'Importing numpy_distutils.cpuinfo ...',
+ from numpy_distutils.cpuinfo import cpuinfo
+ print 'ok'
+ print '------'
+ cpu = cpuinfo()
+ print 'CPU information:',
+ for name in dir(cpuinfo):
+ if name[0]=='_' and name[1]!='_' and getattr(cpu,name[1:])():
+ print name[1:],
+ print '------'
+ except Exception,msg:
+ print 'error:',msg
+ print '------'
+ os.chdir(_path)
+if __name__ == "__main__":
+ run()
diff --git a/numpy/f2py/doc/Makefile b/numpy/f2py/doc/Makefile
new file mode 100644
index 000000000..2f241da0a
--- /dev/null
+++ b/numpy/f2py/doc/Makefile
@@ -0,0 +1,76 @@
+# Makefile for compiling f2py2e documentation (dvi, ps, html)
+# Pearu Peterson <pearu@ioc.ee>
+
+REL=4
+TOP = usersguide
+LATEXSRC = bugs.tex commands.tex f2py2e.tex intro.tex notes.tex signaturefile.tex
+MAINLATEX = f2py2e
+
+LATEX = latex
+PDFLATEX = pdflatex
+
+COLLECTINPUT = ./collectinput.py
+INSTALLDATA = install -m 644 -c
+
+TTH = tth
+TTHFILTER = sed -e "s/{{}\\\verb@/\\\texttt{/g" | sed -e "s/@{}}/}/g" | $(TTH) -L$(MAINLATEX) -i
+TTHFILTER2 = sed -e "s/{{}\\\verb@/\\\texttt{/g" | sed -e "s/@{}}/}/g" | $(TTH) -Lpython9 -i
+TTHFILTER3 = sed -e "s/{{}\\\verb@/\\\texttt{/g" | sed -e "s/@{}}/}/g" | $(TTH) -Lfortranobject -i
+TTHMISSING = "\
+***************************************************************\n\
+Warning: Could not find tth (a TeX to HTML translator) \n\
+ or an error arised was by tth\n\
+You can download tth from http://hutchinson.belmont.ma.us/tth/ \n\
+or\n\
+use your favorite LaTeX to HTML translator on file tmp_main.tex\n\
+***************************************************************\
+"
+
+all: dvi ps html clean
+$(MAINLATEX).dvi: $(LATEXSRC)
+ $(LATEX) $(MAINLATEX).tex
+ $(LATEX) $(MAINLATEX).tex
+ $(LATEX) $(MAINLATEX).tex
+ $(PDFLATEX) $(MAINLATEX).tex
+$(TOP).dvi: $(MAINLATEX).dvi
+ cp -f $(MAINLATEX).dvi $(TOP).dvi
+ mv -f $(MAINLATEX).pdf $(TOP).pdf
+$(TOP).ps: $(TOP).dvi
+ dvips $(TOP).dvi -o
+$(TOP).html: $(LATEXSRC)
+ $(COLLECTINPUT) < $(MAINLATEX).tex > tmp_$(MAINLATEX).tex
+ @test `which $(TTH)` && cat tmp_$(MAINLATEX).tex | $(TTHFILTER) > $(TOP).html\
+ || echo -e $(TTHMISSING)
+dvi: $(TOP).dvi
+ps: $(TOP).ps
+ gzip -f $(TOP).ps
+html: $(TOP).html
+
+python9:
+ cp -f python9.tex f2python9-final/src/
+ cd f2python9-final && mk_html.sh
+ cd f2python9-final && mk_ps.sh
+ cd f2python9-final && mk_pdf.sh
+pyfobj:
+ $(LATEX) fortranobject.tex
+ $(LATEX) fortranobject.tex
+ $(LATEX) fortranobject.tex
+ @test `which $(TTH)` && cat fortranobject.tex | $(TTHFILTER3) > pyfobj.html\
+ || echo -e $(TTHMISSING)
+ dvips fortranobject.dvi -o pyfobj.ps
+ gzip -f pyfobj.ps
+ pdflatex fortranobject.tex
+ mv fortranobject.pdf pyfobj.pdf
+
+WWWDIR=/net/cens/home/www/unsecure/projects/f2py2e/
+wwwpage: all
+ $(INSTALLDATA) index.html $(TOP).html $(TOP).ps.gz $(TOP).dvi $(TOP).pdf \
+ Release-$(REL).x.txt ../NEWS.txt win32_notes.txt $(WWWDIR)
+ $(INSTALLDATA) pyfobj.{ps.gz,pdf,html} $(WWWDIR)
+ $(INSTALLDATA) f2python9-final/f2python9.{ps.gz,pdf,html} f2python9-final/{flow,structure,aerostructure}.jpg $(WWWDIR)
+clean:
+ rm -f tmp_$(MAINLATEX).* $(MAINLATEX).{aux,dvi,log,toc}
+distclean:
+ rm -f tmp_$(MAINLATEX).* $(MAINLATEX).{aux,dvi,log,toc}
+ rm -f $(TOP).{ps,dvi,html,pdf,ps.gz}
+ rm -f *~
diff --git a/numpy/f2py/doc/Release-1.x.txt b/numpy/f2py/doc/Release-1.x.txt
new file mode 100644
index 000000000..46d6fbf09
--- /dev/null
+++ b/numpy/f2py/doc/Release-1.x.txt
@@ -0,0 +1,27 @@
+
+I am pleased to announce the first public release of f2py 1.116:
+
+Writing Python C/API wrappers for Fortran routines can be a very
+tedious task, especially if a Fortran routine takes more than 20
+arguments but only few of them are relevant for the problems that they
+solve.
+
+The Fortran to Python Interface Generator, or FPIG for short, is a
+command line tool (f2py) for generating Python C/API modules for
+wrapping Fortran 77 routines, accessing common blocks from Python, and
+calling Python functions from Fortran (call-backs).
+
+The tool can be downloaded from
+
+ http://cens.ioc.ee/projects/f2py2e/
+
+where you can find also information about f2py features and its User's
+Guide.
+
+f2py is released under the LGPL license.
+
+With regards,
+ Pearu Peterson <pearu@ioc.ee>
+
+<P><A HREF="http://cens.ioc.ee/projects/f2py2e/">f2py 1.116</A> - The
+Fortran to Python Interface Generator (25-Jan-00)
diff --git a/numpy/f2py/doc/Release-2.x.txt b/numpy/f2py/doc/Release-2.x.txt
new file mode 100644
index 000000000..807eb0ca8
--- /dev/null
+++ b/numpy/f2py/doc/Release-2.x.txt
@@ -0,0 +1,77 @@
+
+FPIG - Fortran to Python Interface Generator
+
+I am pleased to announce the second public release of f2py
+(version 2.264):
+
+ http://cens.ioc.ee/projects/f2py2e/
+
+f2py is a command line tool for binding Python and Fortran codes. It
+scans Fortran 77/90/95 codes and generates a Python C/API module that
+makes it possible to call Fortran routines from Python. No Fortran or
+C expertise is required for using this tool.
+
+Features include:
+
+ *** All basic Fortran types are supported:
+ integer[ | *1 | *2 | *4 | *8 ], logical[ | *1 | *2 | *4 | *8 ],
+ character[ | *(*) | *1 | *2 | *3 | ... ]
+ real[ | *4 | *8 | *16 ], double precision,
+ complex[ | *8 | *16 | *32 ]
+
+ *** Multi-dimensional arrays of (almost) all basic types.
+ Dimension specifications:
+ <dim> | <start>:<end> | * | :
+
+ *** Supported attributes:
+ intent([ in | inout | out | hide | in,out | inout,out ])
+ dimension(<dimspec>)
+ depend([<names>])
+ check([<C-booleanexpr>])
+ note(<LaTeX text>)
+ optional, required, external
+
+ *** Calling Fortran 77/90/95 subroutines and functions. Also
+ Fortran 90/95 module routines. Internal initialization of
+ optional arguments.
+
+ *** Accessing COMMON blocks from Python. Accessing Fortran 90/95
+ module data coming soon.
+
+ *** Call-back functions: calling Python functions from Fortran with
+ very flexible hooks.
+
+ *** In Python, arguments of the interfaced functions may be of
+ different type - necessary type conversations are done
+ internally in C level.
+
+ *** Automatically generates documentation (__doc__,LaTeX) for
+ interface functions.
+
+ *** Automatically generates signature files --- user has full
+ control over the interface constructions. Automatically
+ detects the signatures of call-back functions, solves argument
+ dependencies, etc.
+
+ *** Automatically generates Makefile for compiling Fortran and C
+ codes and linking them to a shared module. Many compilers are
+ supported: gcc, Compaq Fortran, VAST/f90 Fortran, Absoft
+ F77/F90, MIPSpro 7 Compilers, etc. Platforms: Intel/Alpha
+ Linux, HP-UX, IRIX64.
+
+ *** Complete User's Guide in various formats (html,ps,pdf,dvi).
+
+ *** f2py users list is available for support, feedback, etc.
+
+More information about f2py, see
+
+ http://cens.ioc.ee/projects/f2py2e/
+
+f2py is released under the LGPL license.
+
+Sincerely,
+ Pearu Peterson <pearu@ioc.ee>
+ September 12, 2000
+
+<P><A HREF="http://cens.ioc.ee/projects/f2py2e/">f2py 2.264</A> - The
+Fortran to Python Interface Generator (12-Sep-00)
diff --git a/numpy/f2py/doc/Release-3.x.txt b/numpy/f2py/doc/Release-3.x.txt
new file mode 100644
index 000000000..940771015
--- /dev/null
+++ b/numpy/f2py/doc/Release-3.x.txt
@@ -0,0 +1,87 @@
+
+F2PY - Fortran to Python Interface Generator
+
+I am pleased to announce the third public release of f2py
+(version 2.3.321):
+
+ http://cens.ioc.ee/projects/f2py2e/
+
+f2py is a command line tool for binding Python and Fortran codes. It
+scans Fortran 77/90/95 codes and generates a Python C/API module that
+makes it possible to call Fortran subroutines from Python. No Fortran or
+C expertise is required for using this tool.
+
+Features include:
+
+ *** All basic Fortran types are supported:
+ integer[ | *1 | *2 | *4 | *8 ], logical[ | *1 | *2 | *4 | *8 ],
+ character[ | *(*) | *1 | *2 | *3 | ... ]
+ real[ | *4 | *8 | *16 ], double precision,
+ complex[ | *8 | *16 | *32 ]
+
+ *** Multi-dimensional arrays of (almost) all basic types.
+ Dimension specifications:
+ <dim> | <start>:<end> | * | :
+
+ *** Supported attributes and statements:
+ intent([ in | inout | out | hide | in,out | inout,out ])
+ dimension(<dimspec>)
+ depend([<names>])
+ check([<C-booleanexpr>])
+ note(<LaTeX text>)
+ optional, required, external
+NEW: intent(c), threadsafe, fortranname
+
+ *** Calling Fortran 77/90/95 subroutines and functions. Also
+ Fortran 90/95 module subroutines are supported. Internal
+ initialization of optional arguments.
+
+ *** Accessing COMMON blocks from Python.
+NEW: Accessing Fortran 90/95 module data.
+
+ *** Call-back functions: calling Python functions from Fortran with
+ very flexible hooks.
+
+ *** In Python, arguments of the interfaced functions may be of
+ different type - necessary type conversations are done
+ internally in C level.
+
+ *** Automatically generates documentation (__doc__,LaTeX) for
+ interfaced functions.
+
+ *** Automatically generates signature files --- user has full
+ control over the interface constructions. Automatically
+ detects the signatures of call-back functions, solves argument
+ dependencies, etc.
+
+NEW: * Automatically generates setup_<modulename>.py for building
+ extension modules using tools from distutils and
+ fortran_support module (SciPy).
+
+ *** Automatically generates Makefile for compiling Fortran and C
+ codes and linking them to a shared module. Many compilers are
+ supported: gcc, Compaq Fortran, VAST/f90 Fortran, Absoft
+ F77/F90, MIPSpro 7 Compilers, etc. Platforms: Intel/Alpha
+ Linux, HP-UX, IRIX64.
+
+ *** Complete User's Guide in various formats (html,ps,pdf,dvi).
+
+ *** f2py users list is available for support, feedback, etc.
+
+NEW: * Installation with distutils.
+
+ *** And finally, many bugs are fixed.
+
+More information about f2py, see
+
+ http://cens.ioc.ee/projects/f2py2e/
+
+LICENSE:
+ f2py is released under the LGPL.
+
+Sincerely,
+ Pearu Peterson <pearu@cens.ioc.ee>
+ December 4, 2001
+
+<P><A HREF="http://cens.ioc.ee/projects/f2py2e/">f2py 2.3.321</A> - The
+Fortran to Python Interface Generator (04-Dec-01)
diff --git a/numpy/f2py/doc/Release-4.x.txt b/numpy/f2py/doc/Release-4.x.txt
new file mode 100644
index 000000000..ed071a0cb
--- /dev/null
+++ b/numpy/f2py/doc/Release-4.x.txt
@@ -0,0 +1,91 @@
+
+F2PY - Fortran to Python Interface Generator
+
+I am pleased to announce the fourth public release of f2py
+(version 2.4.366):
+
+ http://cens.ioc.ee/projects/f2py2e/
+
+f2py is a command line tool for binding Python and Fortran codes. It
+scans Fortran 77/90/95 codes and generates a Python C/API module that
+makes it possible to call Fortran subroutines from Python. No Fortran or
+C expertise is required for using this tool.
+
+New features:
+ *** Win32 support.
+ *** Better Python C/API generated code (-Wall is much less verbose).
+
+Features include:
+
+ *** All basic Fortran types are supported:
+ integer[ | *1 | *2 | *4 | *8 ], logical[ | *1 | *2 | *4 | *8 ],
+ character[ | *(*) | *1 | *2 | *3 | ... ]
+ real[ | *4 | *8 | *16 ], double precision,
+ complex[ | *8 | *16 | *32 ]
+
+ *** Multi-dimensional arrays of (almost) all basic types.
+ Dimension specifications:
+ <dim> | <start>:<end> | * | :
+
+ *** Supported attributes and statements:
+ intent([ in | inout | out | hide | in,out | inout,out ])
+ dimension(<dimspec>)
+ depend([<names>])
+ check([<C-booleanexpr>])
+ note(<LaTeX text>)
+ optional, required, external
+ intent(c), threadsafe, fortranname
+
+ *** Calling Fortran 77/90/95 subroutines and functions. Also
+ Fortran 90/95 module subroutines are supported. Internal
+ initialization of optional arguments.
+
+ *** Accessing COMMON blocks from Python.
+ Accessing Fortran 90/95 module data.
+
+ *** Call-back functions: calling Python functions from Fortran with
+ very flexible hooks.
+
+ *** In Python, arguments of the interfaced functions may be of
+ different type - necessary type conversations are done
+ internally in C level.
+
+ *** Automatically generates documentation (__doc__,LaTeX) for
+ interfaced functions.
+
+ *** Automatically generates signature files --- user has full
+ control over the interface constructions. Automatically
+ detects the signatures of call-back functions, solves argument
+ dependencies, etc.
+
+ *** Automatically generates setup_<modulename>.py for building
+ extension modules using tools from distutils and
+ fortran_support module (SciPy).
+
+ *** Automatically generates Makefile for compiling Fortran and C
+ codes and linking them to a shared module. Many compilers are
+ supported: gcc, Compaq Fortran, VAST/f90 Fortran, Absoft
+ F77/F90, MIPSpro 7 Compilers, etc. Platforms: Intel/Alpha
+ Linux, HP-UX, IRIX64.
+
+ *** Complete User's Guide in various formats (html,ps,pdf,dvi).
+
+ *** f2py users list is available for support, feedback, etc.
+
+ *** Installation with distutils.
+
+ *** And finally, many bugs are fixed.
+
+More information about f2py, see
+
+ http://cens.ioc.ee/projects/f2py2e/
+
+LICENSE:
+ f2py is released under the LGPL.
+
+Sincerely,
+ Pearu Peterson <pearu@cens.ioc.ee>
+ December 17, 2001
+
+<P><A HREF="http://cens.ioc.ee/projects/f2py2e/">f2py 2.4.366</A> - The
+Fortran to Python Interface Generator (17-Dec-01)
diff --git a/numpy/f2py/doc/apps.tex b/numpy/f2py/doc/apps.tex
new file mode 100644
index 000000000..513c048bd
--- /dev/null
+++ b/numpy/f2py/doc/apps.tex
@@ -0,0 +1,71 @@
+
+\section{Applications}
+\label{sec:apps}
+
+
+\subsection{Example: wrapping C library \texttt{fftw}}
+\label{sec:wrapfftw}
+
+Here follows a simple example how to use \fpy to generate a wrapper
+for C functions. Let us create a FFT code using the functions in FFTW
+library. I'll assume that the library \texttt{fftw} is configured with
+\texttt{-{}-enable-shared} option.
+
+Here is the wrapper for the typical usage of FFTW:
+\begin{verbatim}
+/* File: wrap_dfftw.c */
+#include <dfftw.h>
+
+extern void dfftw_one(fftw_complex *in,fftw_complex *out,int *n) {
+ fftw_plan p;
+ p = fftw_create_plan(*n,FFTW_FORWARD,FFTW_ESTIMATE);
+ fftw_one(p,in,out);
+ fftw_destroy_plan(p);
+}
+\end{verbatim}
+and here follows the corresponding siganture file (created manually):
+\begin{verbatim}
+!%f90
+! File: fftw.f90
+module fftw
+ interface
+ subroutine dfftw_one(in,out,n)
+ integer n
+ complex*16 in(n),out(n)
+ intent(out) out
+ intent(hide) n
+ end subroutine dfftw_one
+ end interface
+end module fftw
+\end{verbatim}
+
+Now let us generate the Python C/API module with \fpy:
+\begin{verbatim}
+f2py fftw.f90
+\end{verbatim}
+and compile it
+\begin{verbatim}
+gcc -shared -I/numeric/include -I`f2py -I` -L/numeric/lib -ldfftw \
+ -o fftwmodule.so -DNO_APPEND_FORTRAN fftwmodule.c wrap_dfftw.c
+\end{verbatim}
+
+In Python:
+\begin{verbatim}
+>>> from Numeric import *
+>>> from fftw import *
+>>> print dfftw_one.__doc__
+Function signature:
+ out = dfftw_one(in)
+Required arguments:
+ in : input rank-1 array('D') with bounds (n)
+Return objects:
+ out : rank-1 array('D') with bounds (n)
+>>> print dfftw_one([1,2,3,4])
+[ 10.+0.j -2.+2.j -2.+0.j -2.-2.j]
+>>>
+\end{verbatim}
+
+%%% Local Variables:
+%%% mode: latex
+%%% TeX-master: "f2py2e"
+%%% End:
diff --git a/numpy/f2py/doc/bugs.tex b/numpy/f2py/doc/bugs.tex
new file mode 100644
index 000000000..699ecf530
--- /dev/null
+++ b/numpy/f2py/doc/bugs.tex
@@ -0,0 +1,109 @@
+
+\section{Bugs, Plans, and Feedback}
+\label{sec:bugs}
+
+Currently no bugs have found that I was not able to fix. I will be
+happy to receive bug reports from you (so that I could fix them and
+keep the first sentence of this paragraph as true as possible ;-).
+Note that \fpy is developed to work properly with gcc/g77
+compilers.
+\begin{description}
+\item[NOTE:] Wrapping callback functions returning \texttt{COMPLEX}
+ may fail on some systems. Workaround: avoid it by using callback
+ subroutines.
+\end{description}
+
+Here follows a list of things that I plan to implement in (near) future:
+\begin{enumerate}
+\item recognize file types by their extension (signatures:
+ \texttt{*.pyf}, Fortran 77, Fortran 90 fixed: \texttt{*.f, *.for, *.F, *.FOR},
+ Fortran 90 free: \texttt{*.F90, *.f90, *.m, *.f95, *.F95}); [DONE]
+\item installation using \texttt{distutils} (when it will be stable);
+\item put out to the web examples of \fpy usages in real situations:
+ wrapping \texttt{vode}, for example;
+\item implement support for \texttt{PARAMETER} statement; [DONE]
+\item rewrite test-site;
+\item ...
+\end{enumerate}
+and here are things that I plan to do in future:
+\begin{enumerate}
+\item implement \texttt{intent(cache)} attribute for an optional work
+ arrays with a feature of allocating additional memory if needed;
+\item use \fpy for wrapping Fortran 90/95 codes. \fpy should scan
+ Fortran 90/95 codes with no problems, what needs to be done is find
+ out how to call a Fortran 90/95 function (from a module) from
+ C. Anybody there willing to test \fpy with Fortran 90/95 modules? [DONE]
+\item implement support for Fortran 90/95 module data; [DONE]
+\item implement support for \texttt{BLOCK DATA} blocks (if needed);
+\item test/document \fpy for \texttt{CHARACTER} arrays;
+\item decide whether internal transposition of multi-dimensional
+ arrays is reasonable (need efficient code then), even if this is
+ controlled by the user trough some additional keyword; need
+ consistent and safe policy here;
+\item use \fpy for generating wrapper functions also for C programs (a
+ kind of SWIG, only between Python and C). For that \fpy needs a
+ command line switch to inform itself that C scalars are passed in by
+ their value, not by their reference, for instance;
+\item introduce a counter that counts the number of inefficient usages
+ of wrapper functions (copying caused by type-casting, non-contiguous
+ arrays);
+\item if needed, make \texttt{DATA} statement to work properly for
+ arrays;
+\item rewrite \texttt{COMMON} wrapper; [DONE]
+\item ...
+\end{enumerate}
+I'll appreciate any feedback that will improve \fpy (bug reports,
+suggestions, etc). If you find a correct Fortran code that fails with
+\fpy, try to send me a minimal version of it so that I could track
+down the cause of the failure. Note also that there is no sense to
+send me files that are auto-generated with \fpy (I can generate them
+myself); the version of \fpy that you are using (run \texttt{\fpy\
+ -v}), and the relevant fortran codes or modified signature files
+should be enough information to fix the bugs. Also add some
+information on compilers and linkers that you use to the bug report.
+
+
+\section{History of \fpy}
+\label{sec:history}
+
+\begin{enumerate}
+\item I was driven to start developing a tool such as \fpy after I had
+ wrote several Python C/API modules for interfacing various Fortran
+ routines from the Netlib. This work was tedious (some of functions
+ had more than 20 arguments, only few of them made sense for the
+ problems that they solved). I realized that most of the writing
+ could be done automatically.
+\item On 9th of July, 1999, the first lines of the tool was written. A
+ prototype of the tool was ready to use in only three weeks. During
+ this time Travis Oliphant joined to the project and shared his
+ valuable knowledge and experience; the call-back mechanism is his
+ major contribution. Then I gave the tool to public under the name
+ FPIG --- \emph{Fortran to Python Interface Generator}. The tool contained
+ only one file \texttt{f2py.py}.
+\item By autumn, it was clear that a better implementation was needed
+ as the debugging process became very tedious. So, I reserved some
+ time and rewrote the tool from scratch. The most important result of
+ this rewriting was the code that reads real Fortran codes and
+ determines the signatures of the Fortran routines. The main
+ attention was payed in particular to this part so that the tool
+ could read arbitrary Fortran~77/90/95 codes. As a result, the other
+ side of the tools task, that is, generating Python C/API functions,
+ was not so great. In public, this version of the tool was called
+ \texttt{f2py2e} --- \emph{Fortran to Python C/API generator, the
+ Second Edition}.
+\item So, a month before The New Year 2000, I started the third
+ iteration of the \fpy development. Now the main attention was to
+ have a good C/API module constructing code. By 21st of January,
+ 2000, the tool of generating wrapper functions for Fortran routines
+ was ready. It had many new features and was more robust than ever.
+\item In 25th of January, 2000, the first public release of \fpy was
+ announced (version 1.116).
+\item In 12th of September, 2000, the second public release of \fpy was
+ announced (version 2.264). It now has among other changes a support
+ for Fortran 90/95 module routines.
+\end{enumerate}
+
+%%% Local Variables:
+%%% mode: latex
+%%% TeX-master: "f2py2e"
+%%% End:
diff --git a/numpy/f2py/doc/collectinput.py b/numpy/f2py/doc/collectinput.py
new file mode 100755
index 000000000..2e3a09d9d
--- /dev/null
+++ b/numpy/f2py/doc/collectinput.py
@@ -0,0 +1,74 @@
+#!/usr/bin/env python
+"""
+collectinput - Collects all files that are included to a main Latex document
+ with \input or \include commands. These commands must be
+ in separate lines.
+
+Copyright 1999 Pearu Peterson all rights reserved,
+Pearu Peterson <pearu@ioc.ee>
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+
+Pearu Peterson
+
+Usage:
+ collectinput <infile> <outfile>
+ collectinput <infile> # <outfile>=inputless_<infile>
+ collectinput # in and out are stdin and stdout
+"""
+
+__version__ = "0.0"
+
+stdoutflag=0
+import sys,os,string,fileinput,re,commands
+
+try: fn=sys.argv[2]
+except:
+ try: fn='inputless_'+sys.argv[1]
+ except: stdoutflag=1
+try: fi=sys.argv[1]
+except: fi=()
+if not stdoutflag:
+ sys.stdout=open(fn,'w')
+
+nonverb=r'[\w\s\\&=\^\*\.\{\(\)\[\?\+\$/]*(?!\\verb.)'
+input=re.compile(nonverb+r'\\(input|include)\*?\s*\{?.*}?')
+comment=re.compile(r'[^%]*%')
+
+for l in fileinput.input(fi):
+ l=l[:-1]
+ l1=''
+ if comment.match(l):
+ m=comment.match(l)
+ l1=l[m.end()-1:]
+ l=l[:m.end()-1]
+ m=input.match(l)
+ if m:
+ l=string.strip(l)
+ if l[-1]=='}': l=l[:-1]
+ i=m.end()-2
+ sys.stderr.write('>>>>>>')
+ while i>-1 and (l[i] not in [' ','{']): i=i-1
+ if i>-1:
+ fn=l[i+1:]
+ try: f=open(fn,'r'); flag=1; f.close()
+ except:
+ try: f=open(fn+'.tex','r'); flag=1;fn=fn+'.tex'; f.close()
+ except: flag=0
+ if flag==0:
+ sys.stderr.write('Could not open a file: '+fn+'\n')
+ print l+l1
+ continue
+ elif flag==1:
+ sys.stderr.write(fn+'\n')
+ print '%%%%% Begin of '+fn
+ print commands.getoutput(sys.argv[0]+' < '+fn)
+ print '%%%%% End of '+fn
+ else:
+ sys.stderr.write('Could not extract a file name from: '+l)
+ print l+l1
+ else:
+ print l+l1
+sys.stdout.close()
diff --git a/numpy/f2py/doc/commands.tex b/numpy/f2py/doc/commands.tex
new file mode 100644
index 000000000..5101a9ff5
--- /dev/null
+++ b/numpy/f2py/doc/commands.tex
@@ -0,0 +1,20 @@
+\usepackage{xspace}
+\usepackage{verbatim}
+
+%%tth:\newcommand{\xspace}{ }
+
+\newcommand{\fpy}{\texttt{f2py}\xspace}
+
+\newcommand{\bs}{\symbol{`\\}}
+% need bs here:
+%%tth:\newcommand{\bs}{\texttt{<backslash>}}
+
+\newcommand{\shell}[1]{\hspace*{1em}\texttt{sh> \begin{minipage}[t]{0.8\textwidth}#1\end{minipage}}}
+
+
+%%% Local Variables:
+%%% mode: latex
+%%% TeX-master: "f2py2e"
+%%% End:
+
+
diff --git a/numpy/f2py/doc/ex1/arr.f b/numpy/f2py/doc/ex1/arr.f
new file mode 100644
index 000000000..c4e49988f
--- /dev/null
+++ b/numpy/f2py/doc/ex1/arr.f
@@ -0,0 +1,4 @@
+ subroutine arr(l,m,n,a)
+ integer l,m,n
+ real*8 a(l,m,n)
+ end
diff --git a/numpy/f2py/doc/ex1/bar.f b/numpy/f2py/doc/ex1/bar.f
new file mode 100644
index 000000000..c723b5af1
--- /dev/null
+++ b/numpy/f2py/doc/ex1/bar.f
@@ -0,0 +1,4 @@
+ function bar(a,b)
+ integer a,b,bar
+ bar = a + b
+ end
diff --git a/numpy/f2py/doc/ex1/foo.f b/numpy/f2py/doc/ex1/foo.f
new file mode 100644
index 000000000..cdcac4103
--- /dev/null
+++ b/numpy/f2py/doc/ex1/foo.f
@@ -0,0 +1,5 @@
+ subroutine foo(a)
+ integer a
+cf2py intent(in,out) :: a
+ a = a + 5
+ end
diff --git a/numpy/f2py/doc/ex1/foobar-smart.f90 b/numpy/f2py/doc/ex1/foobar-smart.f90
new file mode 100644
index 000000000..61385a685
--- /dev/null
+++ b/numpy/f2py/doc/ex1/foobar-smart.f90
@@ -0,0 +1,24 @@
+!%f90
+module foobar ! in
+ note(This module contains two examples that are used in &
+ \texttt{f2py} documentation.) foobar
+ interface ! in :foobar
+ subroutine foo(a) ! in :foobar:foo.f
+ note(Example of a wrapper function of a Fortran subroutine.) foo
+ integer intent(inout),&
+ note(5 is added to the variable {{}\verb@a@{}} ``in place''.) :: a
+ end subroutine foo
+ function bar(a,b) result (ab) ! in :foobar:bar.f
+ integer :: a
+ integer :: b
+ integer :: ab
+ note(The first value.) a
+ note(The second value.) b
+ note(Add two values.) bar
+ note(The result.) ab
+ end function bar
+ end interface
+end module foobar
+
+! This file was auto-generated with f2py (version:0.95).
+! See http://cens.ioc.ee/projects/f2py2e/
diff --git a/numpy/f2py/doc/ex1/foobar.f90 b/numpy/f2py/doc/ex1/foobar.f90
new file mode 100644
index 000000000..53ac5b506
--- /dev/null
+++ b/numpy/f2py/doc/ex1/foobar.f90
@@ -0,0 +1,16 @@
+!%f90
+module foobar ! in
+ interface ! in :foobar
+ subroutine foo(a) ! in :foobar:foo.f
+ integer intent(inout) :: a
+ end subroutine foo
+ function bar(a,b) ! in :foobar:bar.f
+ integer :: a
+ integer :: b
+ integer :: bar
+ end function bar
+ end interface
+end module foobar
+
+! This file was auto-generated with f2py (version:0.95).
+! See http://cens.ioc.ee/projects/f2py2e/
diff --git a/numpy/f2py/doc/ex1/foobarmodule.tex b/numpy/f2py/doc/ex1/foobarmodule.tex
new file mode 100644
index 000000000..32411ec03
--- /dev/null
+++ b/numpy/f2py/doc/ex1/foobarmodule.tex
@@ -0,0 +1,36 @@
+% This file is auto-generated with f2py (version:2.266)
+\section{Module \texttt{foobar}}
+
+This module contains two examples that are used in \texttt{f2py} documentation.
+
+\subsection{Wrapper function \texttt{foo}}
+
+
+\noindent{{}\verb@foo@{}}\texttt{(a)}
+--- Example of a wrapper function of a Fortran subroutine.
+
+\noindent Required arguments:
+\begin{description}
+\item[]{{}\verb@a : in/output rank-0 array(int,'i')@{}}
+--- 5 is added to the variable {{}\verb@a@{}} ``in place''.
+\end{description}
+
+\subsection{Wrapper function \texttt{bar}}
+
+
+\noindent{{}\verb@bar = bar@{}}\texttt{(a, b)}
+--- Add two values.
+
+\noindent Required arguments:
+\begin{description}
+\item[]{{}\verb@a : input int@{}}
+--- The first value.
+\item[]{{}\verb@b : input int@{}}
+--- The second value.
+\end{description}
+\noindent Return objects:
+\begin{description}
+\item[]{{}\verb@bar : int@{}}
+--- See elsewhere.
+\end{description}
+
diff --git a/numpy/f2py/doc/ex1/runme b/numpy/f2py/doc/ex1/runme
new file mode 100755
index 000000000..2aac6158e
--- /dev/null
+++ b/numpy/f2py/doc/ex1/runme
@@ -0,0 +1,18 @@
+#!/bin/sh
+
+f2py2e='python ../../f2py2e.py'
+PYINC=`$f2py2e -pyinc`
+$f2py2e foobar-smart.pyf --short-latex --overwrite-makefile -makefile foo.f bar.f
+gmake -f Makefile-foobar
+#gcc -O3 -I$PYINC -I$PYINC/Numeric -shared -o foobarmodule.so foobarmodule.c foo.f bar.f
+python -c '
+import foobar
+print foobar.__doc__
+print foobar.bar(2,3)
+from Numeric import *
+a=array(3)
+print a,foobar.foo(a),a
+print foobar.foo.__doc__
+print foobar.bar.__doc__
+print "ok"
+'
diff --git a/numpy/f2py/doc/f2py2e.tex b/numpy/f2py/doc/f2py2e.tex
new file mode 100644
index 000000000..6e3e9d68c
--- /dev/null
+++ b/numpy/f2py/doc/f2py2e.tex
@@ -0,0 +1,50 @@
+\documentclass{article}
+\usepackage{a4wide}
+
+\input commands
+
+\title{\fpy\\Fortran to Python Interface Generator\\{\large Second Edition}}
+\author{Pearu Peterson \texttt{<pearu@ioc.ee>}}
+\date{$Revision: 1.16 $\\\today}
+\begin{document}
+\special{html: <font size=-1>If equations does not show Greek letters or large
+ brackets correctly, then your browser configuration needs some
+ adjustment. Read the notes for <A
+ href=http://hutchinson.belmont.ma.us/tth/Xfonts.html>Enabling Symbol
+ Fonts in Netscape under X </A>. In addition, the browser must be set
+ to use document fonts. </font>
+}
+
+\maketitle
+\begin{abstract}
+ \fpy is a Python program that generates Python C/API modules for
+ wrapping Fortran~77/90/95 codes to Python. The user can influence the
+ process by modifying the signature files that \fpy generates when
+ scanning the Fortran codes. This document describes the syntax of
+ the signature files and the ways how the user can dictate the tool
+ to produce wrapper functions with desired Python signatures. Also
+ how to call the wrapper functions from Python is discussed.
+
+ See \texttt{http://cens.ioc.ee/projects/f2py2e/} for updates of this
+ document and the tool.
+\end{abstract}
+
+\tableofcontents
+
+\input intro
+\input signaturefile
+\input notes
+\input options
+\input bugs
+
+\appendix
+\input ex1/foobarmodule
+\input apps
+\end{document}
+
+%%% Local Variables:
+%%% mode: latex
+%%% TeX-master: t
+%%% End:
+
+
diff --git a/numpy/f2py/doc/f2python9-final/README.txt b/numpy/f2py/doc/f2python9-final/README.txt
new file mode 100644
index 000000000..b907216b6
--- /dev/null
+++ b/numpy/f2py/doc/f2python9-final/README.txt
@@ -0,0 +1,38 @@
+
+This directory contains the source of the paper
+
+ "Fortran to Python Interface Generator with an Application
+ to Aerospace Engineering"
+
+by
+ Pearu Peterson <pearu@cens.ioc.ee> (the corresponding author)
+ Joaquim R. R. A. Martins <joaquim.martins@stanford.edu>
+ Juan J. Alonso <jjalonso@stanford.edu>
+
+for The 9th International Python Conference, March 5-8, 2001, Long Beach, California.
+
+The paper is provided here is in the HTML format:
+
+ f2python9.html (size=48151 bytes)
+
+Note that this file includes the following JPG images
+
+ flow.jpg (size=13266)
+ structure.jpg (size=17860)
+ aerostructure.jpg (size=72247)
+
+PS:
+The HTML file f2python9.html is generated using TTH (http://hutchinson.belmont.ma.us/tth/)
+from the LaTeX source file `python9.tex'. The source can be found in the
+ src/
+directory. This directory contains also the following EPS files
+ flow.eps
+ structure.eps
+ aerostructure.eps
+and the text files
+ examples/{exp1.f,exp1mess.txt,exp1session.txt,foo.pyf,foom.pyf}
+that are used by the LaTeX source python9.tex.
+
+Regards,
+ Pearu
+January 15, 2001
diff --git a/numpy/f2py/doc/f2python9-final/aerostructure.jpg b/numpy/f2py/doc/f2python9-final/aerostructure.jpg
new file mode 100644
index 000000000..896ad6e12
--- /dev/null
+++ b/numpy/f2py/doc/f2python9-final/aerostructure.jpg
Binary files differ
diff --git a/numpy/f2py/doc/f2python9-final/flow.jpg b/numpy/f2py/doc/f2python9-final/flow.jpg
new file mode 100644
index 000000000..cfe0f85f3
--- /dev/null
+++ b/numpy/f2py/doc/f2python9-final/flow.jpg
Binary files differ
diff --git a/numpy/f2py/doc/f2python9-final/mk_html.sh b/numpy/f2py/doc/f2python9-final/mk_html.sh
new file mode 100755
index 000000000..944110e93
--- /dev/null
+++ b/numpy/f2py/doc/f2python9-final/mk_html.sh
@@ -0,0 +1,13 @@
+#!/bin/sh
+cd src
+
+test -f aerostructure.eps || convert ../aerostructure.jpg aerostructure.eps
+test -f flow.eps || convert ../flow.jpg flow.eps
+test -f structure.eps || convert ../structure.jpg structure.eps
+
+latex python9.tex
+latex python9.tex
+latex python9.tex
+
+test `which tth` && cat python9.tex | sed -e "s/{{}\\\verb@/\\\texttt{/g" | sed -e "s/@{}}/}/g" | tth -Lpython9 -i > ../f2python9.html
+cd ..
diff --git a/numpy/f2py/doc/f2python9-final/mk_pdf.sh b/numpy/f2py/doc/f2python9-final/mk_pdf.sh
new file mode 100755
index 000000000..b773028b7
--- /dev/null
+++ b/numpy/f2py/doc/f2python9-final/mk_pdf.sh
@@ -0,0 +1,13 @@
+#!/bin/sh
+cd src
+
+test -f aerostructure.pdf || convert ../aerostructure.jpg aerostructure.pdf
+test -f flow.pdf || convert ../flow.jpg flow.pdf
+test -f structure.pdf || convert ../structure.jpg structure.pdf
+
+cat python9.tex | sed -e "s/eps,/pdf,/g" > python9pdf.tex
+pdflatex python9pdf.tex
+pdflatex python9pdf.tex
+pdflatex python9pdf.tex
+
+mv python9pdf.pdf ../f2python9.pdf \ No newline at end of file
diff --git a/numpy/f2py/doc/f2python9-final/mk_ps.sh b/numpy/f2py/doc/f2python9-final/mk_ps.sh
new file mode 100755
index 000000000..4b0863fcd
--- /dev/null
+++ b/numpy/f2py/doc/f2python9-final/mk_ps.sh
@@ -0,0 +1,14 @@
+#!/bin/sh
+cd src
+
+test -f aerostructure.eps || convert ../aerostructure.jpg aerostructure.eps
+test -f flow.eps || convert ../flow.jpg flow.eps
+test -f structure.eps || convert ../structure.jpg structure.eps
+
+latex python9.tex
+latex python9.tex
+latex python9.tex
+
+dvips python9.dvi -o ../f2python9.ps
+cd ..
+gzip -f f2python9.ps
diff --git a/numpy/f2py/doc/f2python9-final/src/examples/exp1.f b/numpy/f2py/doc/f2python9-final/src/examples/exp1.f
new file mode 100644
index 000000000..36bee50b0
--- /dev/null
+++ b/numpy/f2py/doc/f2python9-final/src/examples/exp1.f
@@ -0,0 +1,26 @@
+ subroutine exp1(l,u,n)
+C Input: n is number of iterations
+C Output: l,u are such that
+C l(1)/l(2) < exp(1) < u(1)/u(2)
+C
+Cf2py integer*4 :: n = 1
+Cf2py intent(out) l,u
+ integer*4 n,i
+ real*8 l(2),u(2),t,t1,t2,t3,t4
+ l(2) = 1
+ l(1) = 0
+ u(2) = 0
+ u(1) = 1
+ do 10 i=0,n
+ t1 = 4 + 32*(1+i)*i
+ t2 = 11 + (40+32*i)*i
+ t3 = 3 + (24+32*i)*i
+ t4 = 8 + 32*(1+i)*i
+ t = u(1)
+ u(1) = l(1)*t1 + t*t2
+ l(1) = l(1)*t3 + t*t4
+ t = u(2)
+ u(2) = l(2)*t1 + t*t2
+ l(2) = l(2)*t3 + t*t4
+ 10 continue
+ end
diff --git a/numpy/f2py/doc/f2python9-final/src/examples/exp1mess.txt b/numpy/f2py/doc/f2python9-final/src/examples/exp1mess.txt
new file mode 100644
index 000000000..ae1545718
--- /dev/null
+++ b/numpy/f2py/doc/f2python9-final/src/examples/exp1mess.txt
@@ -0,0 +1,17 @@
+Reading fortran codes...
+ Reading file 'exp1.f'
+Post-processing...
+ Block: foo
+ Block: exp1
+Creating 'Makefile-foo'...
+ Linker: ld ('GNU ld' 2.9.5)
+ Fortran compiler: f77 ('g77 2.x.x' 2.95.2)
+ C compiler: cc ('gcc 2.x.x' 2.95.2)
+Building modules...
+ Building module "foo"...
+ Constructing wrapper function "exp1"...
+ l,u = exp1([n])
+ Wrote C/API module "foo" to file "foomodule.c"
+ Documentation is saved to file "foomodule.tex"
+Run GNU make to build shared modules:
+ gmake -f Makefile-<modulename> [test]
diff --git a/numpy/f2py/doc/f2python9-final/src/examples/exp1session.txt b/numpy/f2py/doc/f2python9-final/src/examples/exp1session.txt
new file mode 100644
index 000000000..9bec9198e
--- /dev/null
+++ b/numpy/f2py/doc/f2python9-final/src/examples/exp1session.txt
@@ -0,0 +1,20 @@
+>>> import foo,Numeric
+>>> print foo.exp1.__doc__
+exp1 - Function signature:
+ l,u = exp1([n])
+Optional arguments:
+ n := 1 input int
+Return objects:
+ l : rank-1 array('d') with bounds (2)
+ u : rank-1 array('d') with bounds (2)
+
+>>> l,u = foo.exp1()
+>>> print l,u
+[ 1264. 465.] [ 1457. 536.]
+>>> print l[0]/l[1], u[0]/u[1]-l[0]/l[1]
+2.71827956989 2.25856657199e-06
+>>> l,u = foo.exp1(2)
+>>> print l,u
+[ 517656. 190435.] [ 566827. 208524.]
+>>> print l[0]/l[1], u[0]/u[1]-l[0]/l[1]
+2.71828182845 1.36437527942e-11 \ No newline at end of file
diff --git a/numpy/f2py/doc/f2python9-final/src/examples/foo.pyf b/numpy/f2py/doc/f2python9-final/src/examples/foo.pyf
new file mode 100644
index 000000000..516bb292f
--- /dev/null
+++ b/numpy/f2py/doc/f2python9-final/src/examples/foo.pyf
@@ -0,0 +1,13 @@
+!%f90 -*- f90 -*-
+python module foo
+ interface
+ subroutine exp1(l,u,n)
+ real*8 dimension(2) :: l
+ real*8 dimension(2) :: u
+ integer*4 :: n
+ end subroutine exp1
+ end interface
+end python module foo
+! This file was auto-generated with f2py
+! (version:2.298).
+! See http://cens.ioc.ee/projects/f2py2e/
diff --git a/numpy/f2py/doc/f2python9-final/src/examples/foom.pyf b/numpy/f2py/doc/f2python9-final/src/examples/foom.pyf
new file mode 100644
index 000000000..6392ebc95
--- /dev/null
+++ b/numpy/f2py/doc/f2python9-final/src/examples/foom.pyf
@@ -0,0 +1,14 @@
+!%f90 -*- f90 -*-
+python module foo
+ interface
+ subroutine exp1(l,u,n)
+ real*8 dimension(2) :: l
+ real*8 dimension(2) :: u
+ intent(out) l,u
+ integer*4 optional :: n = 1
+ end subroutine exp1
+ end interface
+end python module foo
+! This file was auto-generated with f2py
+! (version:2.298) and modified by pearu.
+! See http://cens.ioc.ee/projects/f2py2e/
diff --git a/numpy/f2py/doc/f2python9-final/structure.jpg b/numpy/f2py/doc/f2python9-final/structure.jpg
new file mode 100644
index 000000000..9aa691339
--- /dev/null
+++ b/numpy/f2py/doc/f2python9-final/structure.jpg
Binary files differ
diff --git a/numpy/f2py/doc/fortranobject.tex b/numpy/f2py/doc/fortranobject.tex
new file mode 100644
index 000000000..dbb244cdd
--- /dev/null
+++ b/numpy/f2py/doc/fortranobject.tex
@@ -0,0 +1,574 @@
+\documentclass{article}
+
+\headsep=0pt
+\topmargin=0pt
+\headheight=0pt
+\oddsidemargin=0pt
+\textwidth=6.5in
+\textheight=9in
+
+\usepackage{xspace}
+\usepackage{verbatim}
+\newcommand{\fpy}{\texttt{f2py}\xspace}
+\newcommand{\bs}{\symbol{`\\}}
+\newcommand{\email}[1]{\special{html:<A href="mailto:#1">}\texttt{<#1>}\special{html:</A>}}
+\title{\texttt{PyFortranObject} --- example usages}
+\author{
+\large Pearu Peterson\\
+\small \email{pearu@cens.ioc.ee}
+}
+
+\begin{document}
+
+\maketitle
+
+\special{html: Other formats of this document:
+<A href=pyfobj.ps.gz>Gzipped PS</A>,
+<A href=pyfobj.pdf>PDF</A>
+}
+
+\tableofcontents
+
+\section{Introduction}
+\label{sec:intro}
+
+Fortran language defines the following concepts that we would like to
+access from Python: functions, subroutines, data in \texttt{COMMON} blocks,
+F90 module functions and subroutines, F90 module data (both static and
+allocatable arrays).
+
+In the following we shall assume that we know the signatures (full
+specifications of routine arguments and variables) of these concepts
+from their Fortran source codes. Now, in order to call or use them
+from C, one needs to have pointers to the corresponding objects. The
+pointers to Fortran 77 objects (routines, data in \texttt{COMMON}
+blocks) are readily available to C codes (there are various sources
+available about mixing Fortran 77 and C codes). On the other hand, F90
+module specifications are highly compiler dependent and sometimes it
+is not even possible to access F90 module objects from C (at least,
+not directly, see remark about MIPSPro 7 Compilers). But using some
+tricks (described below), the pointers to F90 module objects can be
+determined in runtime providing a compiler independent solution.
+
+To use Fortran objects from Python in unified manner, \fpy introduces
+\texttt{PyFortranObject} to hold pointers of the Fortran objects and
+the corresponing wrapper functions. In fact, \texttt{PyFortranObject}
+does much more: it generates documentation strings in run-time (for
+items in \texttt{COMMON} blocks and data in F90 modules), provides
+methods for accessing Fortran data and for calling Fortran routines,
+etc.
+
+\section{\texttt{PyFortranObject}}
+\label{sec:pyfortobj}
+
+\texttt{PyFortranObject} is defined as follows
+\begin{verbatim}
+typedef struct {
+ PyObject_HEAD
+ int len; /* Number of attributes */
+ FortranDataDef *defs; /* An array of FortranDataDef's */
+ PyObject *dict; /* Fortran object attribute dictionary */
+} PyFortranObject;
+\end{verbatim}
+where \texttt{FortranDataDef} is
+\begin{verbatim}
+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 {int d[F2PY_MAX_DIMS];} dims; /* dimensions of the array, || not used */
+ int type; /* PyArray_<type> || not used */
+ char *data; /* pointer to array || Fortran routine */
+ void (*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;
+\end{verbatim}
+In the following we demonstrate typical usages of
+\texttt{PyFortranObject}. Just relevant code fragments will be given.
+
+
+\section{Fortran 77 subroutine}
+\label{sec:f77subrout}
+
+Consider Fortran 77 subroutine
+\begin{verbatim}
+subroutine bar()
+end
+\end{verbatim}
+The corresponding \texttt{PyFortranObject} is defined in C as follows:
+\begin{verbatim}
+static char doc_bar[] = "bar()";
+static PyObject *c_bar(PyObject *self, PyObject *args,
+ PyObject *keywds, void (*f2py_func)()) {
+ static char *capi_kwlist[] = {NULL};
+ if (!PyArg_ParseTupleAndKeywords(args,keywds,"|:bar",capi_kwlist))
+ return NULL;
+ (*f2py_func)();
+ return Py_BuildValue("");
+}
+extern void F_FUNC(bar,BAR)();
+static FortranDataDef f2py_routines_def[] = {
+ {"bar",-1, {-1}, 0, (char *)F_FUNC(bar,BAR),(void*)c_bar,doc_bar},
+ {NULL}
+};
+void initfoo() {
+ <snip>
+ d = PyModule_GetDict(m);
+ PyDict_SetItemString(d, f2py_routines_def[0].name,
+ PyFortranObject_NewAsAttr(&f2py_routines_def[0]));
+}
+\end{verbatim}
+where CPP macro \texttt{F\_FUNC} defines how Fortran 77 routines are
+seen in C.
+In Python, Fortran subroutine \texttt{bar} is called as follows
+\begin{verbatim}
+>>> import foo
+>>> foo.bar()
+\end{verbatim}
+
+\section{Fortran 77 function}
+\label{sec:f77func}
+Consider Fortran 77 function
+\begin{verbatim}
+function bar()
+complex bar
+end
+\end{verbatim}
+The corresponding \texttt{PyFortranObject} is defined in C as in
+previous example but with the following changes:
+\begin{verbatim}
+static char doc_bar[] = "bar = bar()";
+static PyObject *c_bar(PyObject *self, PyObject *args,
+ PyObject *keywds, void (*f2py_func)()) {
+ complex_float bar;
+ static char *capi_kwlist[] = {NULL};
+ if (!PyArg_ParseTupleAndKeywords(args,keywds,"|:bar",capi_kwlist))
+ return NULL;
+ (*f2py_func)(&bar);
+ return Py_BuildValue("O",pyobj_from_complex_float1(bar));
+}
+extern void F_WRAPPEDFUNC(bar,BAR)();
+static FortranDataDef f2py_routines_def[] = {
+ {"bar",-1,{-1},0,(char *)F_WRAPPEDFUNC(bar,BAR),(void *)c_bar,doc_bar},
+ {NULL}
+};
+\end{verbatim}
+where CPP macro \texttt{F\_WRAPPEDFUNC} gives the pointer to the following
+Fortran 77 subroutine:
+\begin{verbatim}
+subroutine f2pywrapbar (barf2pywrap)
+external bar
+complex bar, barf2pywrap
+barf2pywrap = bar()
+end
+\end{verbatim}
+With these hooks, calling Fortran functions returning composed types
+becomes platform/compiler independent.
+
+
+\section{\texttt{COMMON} block data}
+\label{sec:commondata}
+
+Consider Fortran 77 \texttt{COMMON} block
+\begin{verbatim}
+integer i
+COMMON /bar/ i
+\end{verbatim}
+In order to access the variable \texttt{i} from Python,
+\texttt{PyFortranObject} is defined as follows:
+\begin{verbatim}
+static FortranDataDef f2py_bar_def[] = {
+ {"i",0,{-1},PyArray_INT},
+ {NULL}
+};
+static void f2py_setup_bar(char *i) {
+ f2py_bar_def[0].data = i;
+}
+extern void F_FUNC(f2pyinitbar,F2PYINITBAR)();
+static void f2py_init_bar() {
+ F_FUNC(f2pyinitbar,F2PYINITBAR)(f2py_setup_bar);
+}
+void initfoo() {
+ <snip>
+ PyDict_SetItemString(d, "bar", PyFortranObject_New(f2py_bar_def,f2py_init_bar));
+}
+\end{verbatim}
+where auxiliary Fortran function \texttt{f2pyinitbar} is defined as follows
+\begin{verbatim}
+subroutine f2pyinitbar(setupfunc)
+external setupfunc
+integer i
+common /bar/ i
+call setupfunc(i)
+end
+\end{verbatim}
+and it is called in \texttt{PyFortranObject\_New}.
+
+
+\section{Fortran 90 module subroutine}
+\label{sec:f90modsubrout}
+
+Consider
+\begin{verbatim}
+module fun
+ subroutine bar()
+ end subroutine bar
+end module fun
+\end{verbatim}
+\texttt{PyFortranObject} is defined as follows
+\begin{verbatim}
+static char doc_fun_bar[] = "fun.bar()";
+static PyObject *c_fun_bar(PyObject *self, PyObject *args,
+ PyObject *keywds, void (*f2py_func)()) {
+ static char *kwlist[] = {NULL};
+ if (!PyArg_ParseTupleAndKeywords(args,keywds,"",kwlist))
+ return NULL;
+ (*f2py_func)();
+ return Py_BuildValue("");
+}
+static FortranDataDef f2py_fun_def[] = {
+ {"bar",-1,{-1},0,NULL,(void *)c_fun_bar,doc_fun_bar},
+ {NULL}
+};
+static void f2py_setup_fun(char *bar) {
+ f2py_fun_def[0].data = bar;
+}
+extern void F_FUNC(f2pyinitfun,F2PYINITFUN)();
+static void f2py_init_fun() {
+ F_FUNC(f2pyinitfun,F2PYINITFUN)(f2py_setup_fun);
+}
+void initfoo () {
+ <snip>
+ PyDict_SetItemString(d, "fun", PyFortranObject_New(f2py_fun_def,f2py_init_fun));
+}
+\end{verbatim}
+where auxiliary Fortran function \texttt{f2pyinitfun} is defined as
+follows
+\begin{verbatim}
+subroutine f2pyinitfun(f2pysetupfunc)
+use fun
+external f2pysetupfunc
+call f2pysetupfunc(bar)
+end subroutine f2pyinitfun
+\end{verbatim}
+The following Python session demonstrates how to call Fortran 90
+module function \texttt{bar}:
+\begin{verbatim}
+>>> import foo
+>>> foo.fun.bar()
+\end{verbatim}
+
+\section{Fortran 90 module function}
+\label{sec:f90modfunc}
+
+Consider
+\begin{verbatim}
+module fun
+ function bar()
+ complex bar
+ end subroutine bar
+end module fun
+\end{verbatim}
+\texttt{PyFortranObject} is defined as follows
+\begin{verbatim}
+static char doc_fun_bar[] = "bar = fun.bar()";
+static PyObject *c_fun_bar(PyObject *self, PyObject *args,
+ PyObject *keywds, void (*f2py_func)()) {
+ complex_float bar;
+ static char *kwlist[] = {NULL};
+ if (!PyArg_ParseTupleAndKeywords(args,keywds,"",kwlist))
+ return NULL;
+ (*f2py_func)(&bar);
+ return Py_BuildValue("O",pyobj_from_complex_float1(bar));
+}
+static FortranDataDef f2py_fun_def[] = {
+ {"bar",-1,{-1},0,NULL,(void *)c_fun_bar,doc_fun_bar},
+ {NULL}
+};
+static void f2py_setup_fun(char *bar) {
+ f2py_fun_def[0].data = bar;
+}
+extern void F_FUNC(f2pyinitfun,F2PYINITFUN)();
+static void f2py_init_fun() {
+ F_FUNC(f2pyinitfun,F2PYINITFUN)(f2py_setup_fun);
+}
+void initfoo() {
+ <snip>
+ PyDict_SetItemString(d, "fun", PyFortranObject_New(f2py_fun_def,f2py_init_fun));
+}
+\end{verbatim}
+where
+\begin{verbatim}
+subroutine f2pywrap_fun_bar (barf2pywrap)
+use fun
+complex barf2pywrap
+barf2pywrap = bar()
+end
+
+subroutine f2pyinitfun(f2pysetupfunc)
+external f2pysetupfunc,f2pywrap_fun_bar
+call f2pysetupfunc(f2pywrap_fun_bar)
+end
+\end{verbatim}
+
+
+\section{Fortran 90 module data}
+\label{sec:f90moddata}
+
+Consider
+\begin{verbatim}
+module fun
+ integer i
+end module fun
+\end{verbatim}
+Then
+\begin{verbatim}
+static FortranDataDef f2py_fun_def[] = {
+ {"i",0,{-1},PyArray_INT},
+ {NULL}
+};
+static void f2py_setup_fun(char *i) {
+ f2py_fun_def[0].data = i;
+}
+extern void F_FUNC(f2pyinitfun,F2PYINITFUN)();
+static void f2py_init_fun() {
+ F_FUNC(f2pyinitfun,F2PYINITFUN)(f2py_setup_fun);
+}
+void initfoo () {
+ <snip>
+ PyDict_SetItemString(d, "fun",
+ PyFortranObject_New(f2py_fun_def,f2py_init_fun));
+}
+\end{verbatim}
+where
+\begin{verbatim}
+subroutine f2pyinitfun(f2pysetupfunc)
+use fun
+external f2pysetupfunc
+call f2pysetupfunc(i)
+end subroutine f2pyinitfun
+\end{verbatim}
+Example usage in Python:
+\begin{verbatim}
+>>> import foo
+>>> foo.fun.i = 4
+\end{verbatim}
+
+\section{Fortran 90 module allocatable array}
+\label{sec:f90modallocarr}
+
+Consider
+\begin{verbatim}
+module fun
+ real, allocatable :: r(:)
+end module fun
+\end{verbatim}
+Then
+\begin{verbatim}
+static FortranDataDef f2py_fun_def[] = {
+ {"r",1,{-1},PyArray_FLOAT},
+ {NULL}
+};
+static void f2py_setup_fun(void (*r)()) {
+ f2py_fun_def[0].func = r;
+}
+extern void F_FUNC(f2pyinitfun,F2PYINITFUN)();
+static void f2py_init_fun() {
+ F_FUNC(f2pyinitfun,F2PYINITFUN)(f2py_setup_fun);
+}
+void initfoo () {
+ <snip>
+ PyDict_SetItemString(d, "fun", PyFortranObject_New(f2py_fun_def,f2py_init_fun));
+}
+\end{verbatim}
+where
+\begin{verbatim}
+subroutine f2py_fun_getdims_r(r,s,f2pysetdata)
+use fun, only: d => r
+external f2pysetdata
+logical ns
+integer s(*),r,i,j
+ns = .FALSE.
+if (allocated(d)) then
+ do i=1,r
+ if ((size(d,r-i+1).ne.s(i)).and.(s(i).ge.0)) then
+ ns = .TRUE.
+ end if
+ end do
+ if (ns) then
+ deallocate(d)
+ end if
+end if
+if ((.not.allocated(d)).and.(s(1).ge.1)) then
+ allocate(d(s(1)))
+end if
+if (allocated(d)) then
+ do i=1,r
+ s(i) = size(d,r-i+1)
+ end do
+end if
+call f2pysetdata(d,allocated(d))
+end subroutine f2py_fun_getdims_r
+
+subroutine f2pyinitfun(f2pysetupfunc)
+use fun
+external f2pysetupfunc,f2py_fun_getdims_r
+call f2pysetupfunc(f2py_fun_getdims_r)
+end subroutine f2pyinitfun
+\end{verbatim}
+Usage in Python:
+\begin{verbatim}
+>>> import foo
+>>> foo.fun.r = [1,2,3,4]
+\end{verbatim}
+
+\section{Callback subroutine}
+\label{sec:cbsubr}
+
+Thanks to Travis Oliphant for working out the basic idea of the
+following callback mechanism.
+
+Consider
+\begin{verbatim}
+subroutine fun(bar)
+external bar
+call bar(1)
+end
+\end{verbatim}
+Then
+\begin{verbatim}
+static char doc_foo8_fun[] = "
+Function signature:
+ fun(bar,[bar_extra_args])
+Required arguments:
+ bar : call-back function
+Optional arguments:
+ bar_extra_args := () input tuple
+Call-back functions:
+ def bar(e_1_e): return
+ Required arguments:
+ e_1_e : input int";
+static PyObject *foo8_fun(PyObject *capi_self, PyObject *capi_args,
+ PyObject *capi_keywds, void (*f2py_func)()) {
+ PyObject *capi_buildvalue = NULL;
+ PyObject *bar_capi = Py_None;
+ PyTupleObject *bar_xa_capi = NULL;
+ PyTupleObject *bar_args_capi = NULL;
+ jmp_buf bar_jmpbuf;
+ int bar_jmpbuf_flag = 0;
+ int bar_nofargs_capi = 0;
+ static char *capi_kwlist[] = {"bar","bar_extra_args",NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(capi_args,capi_keywds,\
+ "O!|O!:foo8.fun",\
+ capi_kwlist,&PyFunction_Type,&bar_capi,&PyTuple_Type,&bar_xa_capi))
+ goto capi_fail;
+
+ bar_nofargs_capi = cb_bar_in_fun__user__routines_nofargs;
+ if (create_cb_arglist(bar_capi,bar_xa_capi,1,0,
+ &cb_bar_in_fun__user__routines_nofargs,&bar_args_capi)) {
+ if ((PyErr_Occurred())==NULL)
+ PyErr_SetString(foo8_error,"failed in processing argument list for call-back bar." );
+ goto capi_fail;
+ }
+
+ SWAP(bar_capi,cb_bar_in_fun__user__routines_capi,PyObject);
+ SWAP(bar_args_capi,cb_bar_in_fun__user__routines_args_capi,PyTupleObject);
+ memcpy(&bar_jmpbuf,&cb_bar_in_fun__user__routines_jmpbuf,sizeof(jmp_buf));
+ bar_jmpbuf_flag = 1;
+
+ if ((setjmp(cb_bar_in_fun__user__routines_jmpbuf))) {
+ if ((PyErr_Occurred())==NULL)
+ PyErr_SetString(foo8_error,"Failure of a callback function");
+ goto capi_fail;
+ } else
+ (*f2py_func)(cb_bar_in_fun__user__routines);
+
+ capi_buildvalue = Py_BuildValue("");
+capi_fail:
+
+ if (bar_jmpbuf_flag) {
+ cb_bar_in_fun__user__routines_capi = bar_capi;
+ Py_DECREF(cb_bar_in_fun__user__routines_args_capi);
+ cb_bar_in_fun__user__routines_args_capi = bar_args_capi;
+ cb_bar_in_fun__user__routines_nofargs = bar_nofargs_capi;
+ memcpy(&cb_bar_in_fun__user__routines_jmpbuf,&bar_jmpbuf,sizeof(jmp_buf));
+ bar_jmpbuf_flag = 0;
+ }
+ return capi_buildvalue;
+}
+extern void F_FUNC(fun,FUN)();
+static FortranDataDef f2py_routine_defs[] = {
+ {"fun",-1,{-1},0,(char *)F_FUNC(fun,FUN),(void *)foo8_fun,doc_foo8_fun},
+ {NULL}
+};
+void initfoo8 () {
+ <snip>
+ PyDict_SetItemString(d, f2py_routine_defs[0].name,
+ PyFortranObject_NewAsAttr(&f2py_routine_defs[0]));
+}
+\end{verbatim}
+where
+\begin{verbatim}
+PyObject *cb_bar_in_fun__user__routines_capi = Py_None;
+PyTupleObject *cb_bar_in_fun__user__routines_args_capi = NULL;
+int cb_bar_in_fun__user__routines_nofargs = 0;
+jmp_buf cb_bar_in_fun__user__routines_jmpbuf;
+static void cb_bar_in_fun__user__routines (int *e_1_e_cb_capi) {
+ PyTupleObject *capi_arglist = cb_bar_in_fun__user__routines_args_capi;
+ PyObject *capi_return = NULL;
+ PyObject *capi_tmp = NULL;
+ int capi_j,capi_i = 0;
+
+ int e_1_e=(*e_1_e_cb_capi);
+ if (capi_arglist == NULL)
+ goto capi_fail;
+ if (cb_bar_in_fun__user__routines_nofargs>capi_i)
+ if (PyTuple_SetItem((PyObject *)capi_arglist,capi_i++,pyobj_from_int1(e_1_e)))
+ goto capi_fail;
+
+ capi_return = PyEval_CallObject(cb_bar_in_fun__user__routines_capi,
+ (PyObject *)capi_arglist);
+
+ if (capi_return == NULL)
+ goto capi_fail;
+ if (capi_return == Py_None) {
+ Py_DECREF(capi_return);
+ capi_return = Py_BuildValue("()");
+ }
+ else if (!PyTuple_Check(capi_return)) {
+ capi_tmp = capi_return;
+ capi_return = Py_BuildValue("(O)",capi_tmp);
+ Py_DECREF(capi_tmp);
+ }
+ capi_j = PyTuple_Size(capi_return);
+ capi_i = 0;
+ goto capi_return_pt;
+capi_fail:
+ fprintf(stderr,"Call-back cb_bar_in_fun__user__routines failed.\n");
+ Py_XDECREF(capi_return);
+ longjmp(cb_bar_in_fun__user__routines_jmpbuf,-1);
+capi_return_pt:
+ ;
+}
+\end{verbatim}
+Usage in Python:
+\begin{verbatim}
+>>> import foo8 as foo
+>>> def bar(i): print 'In bar i=',i
+...
+>>> foo.fun(bar)
+In bar i= 1
+\end{verbatim}
+
+\end{document}
+
+
+%%% Local Variables:
+%%% mode: latex
+%%% TeX-master: t
+%%% End:
diff --git a/numpy/f2py/doc/index.html b/numpy/f2py/doc/index.html
new file mode 100644
index 000000000..e162ed41a
--- /dev/null
+++ b/numpy/f2py/doc/index.html
@@ -0,0 +1,264 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+<META name="Author" content="Pearu Peterson">
+<!-- You may add here some keywords (comma separeted list) -->
+<META name="Keywords" content="fortran,python,interface,f2py,f2py2e,wrapper,fpig">
+<TITLE>F2PY - Fortran to Python Interface Generator</TITLE>
+<LINK rel="stylesheet" type="text/css" href="/styles/userstyle.css">
+</HEAD>
+
+<BODY>
+<!-- Begin of user text -->
+<H1>F2PY &shy; Fortran to Python Interface Generator</H1>
+by <em>Pearu Peterson</em>
+
+<h2>What's new?</h2>
+
+See <a href="NEWS.txt">NEWS.txt</a> for the latest changes in <code>f2py</code>.
+<dl>
+ <dt> July ??, 2002
+ <dd> Implemented prototype calculator, complete tests for scalar F77
+ functions, --help-compiler option. Fixed number of bugs and
+ removed obsolete features.
+ <dt> April 4, 2002
+ <dd> Fixed a nasty bug of copying one-dimensional non-contiguous arrays.
+ (Thanks to Travis O. for pointing this out).
+ <dt> March 26, 2002
+ <dd> Bug fixes, turned off F2PY_REPORT_ATEXIT by default.
+ <dt> March 13, 2002
+ <dd> MAC support, fixed incomplete dependency calculator, minor bug fixes.
+ <dt> March 3, 2002
+ <dd> Fixed memory leak and copying of multi-dimensional complex arrays.
+ <dt> <a href="oldnews.html">Old news</a>.
+</dl>
+
+<h2>Introduction</h2>
+
+Writing Python C/API wrappers for Fortran routines can be a very
+tedious task, especially if a Fortran routine takes more than 20
+arguments but only few of them are relevant for the problems that they
+solve. So, I have developed a tool that generates the C/API modules
+containing wrapper functions of Fortran routines. I call this
+tool as <em>F2PY &shy; Fortran to Python Interface Generator</em>.
+It is completely written in <a href="http://www.python.org">Python</a>
+language and can be called from the command line as <code>f2py</code>.
+<em>F2PY</em> (in NumPy) is released under the terms of the NumPy License.
+
+
+<h2><code>f2py</code>, Second Edition</h2>
+
+The development of <code>f2py</code> started in summer of 1999.
+For now (January, 2000) it has reached to stage of being a
+complete tool: it scans real Fortran code, creates signature file
+that the user can modify, constructs C/API module that can be
+complied and imported to Python, and it creates LaTeX documentation
+for wrapper functions. Below is a bit longer list of
+<code>f2py</code> features:
+<ol>
+ <li> <code>f2py</code> scans real Fortran codes and produces the signature files.
+ The syntax of the signature files is borrowed from the Fortran 90/95
+ language specification with some extensions.
+ <li> <code>f2py</code> generates a GNU Makefile that can be used
+ for building shared modules (see below for a list of supported
+ platforms/compilers). Starting from the third release,
+ <code>f2py</code> generates <code>setup_modulename.py</code> for
+ building extension modules using <code>distutils</code> tools.
+ <li> <code>f2py</code> uses the signature files to produce the wrappers for
+ Fortran 77 routines and their <code>COMMON</code> blocks.
+ <li> For <code>external</code> arguments <code>f2py</code> constructs a very flexible
+ call-back mechanism so that Python functions can be called from
+ Fortran.
+ <li> You can pass in almost arbitrary Python objects to wrapper
+ functions. If needed, <code>f2py</code> takes care of type-casting and
+ non-contiguous arrays.
+ <li> You can modify the signature files so that <code>f2py</code> will generate
+ wrapper functions with desired signatures. <code>depend()</code>
+ attribute is introduced to control the initialization order of the
+ variables. <code>f2py</code> introduces <code>intent(hide)</code>
+ attribute to remove
+ the particular argument from the argument list of the wrapper
+ function and <code>intent(c)</code> that is useful for wrapping C
+libraries. In addition, <code>optional</code> and
+<code>required</code>
+ attributes are introduced and employed.
+ <li> <code>f2py</code> supports almost all standard Fortran 77/90/95 constructs
+ and understands all basic Fortran types, including
+ (multi-dimensional, complex) arrays and character strings with
+ adjustable and assumed sizes/lengths.
+ <li> <code>f2py</code> generates a LaTeX document containing the
+ documentations of the wrapped functions (argument types, dimensions,
+ etc). The user can easily add some human readable text to the
+ documentation by inserting <code>note(&lt;LaTeX text&gt;)</code> attribute to
+ the definition of routine signatures.
+ <li> With <code>f2py</code> one can access also Fortran 90/95
+ module subroutines from Python.
+</ol>
+
+For more information, see the <a href="usersguide.html">User's
+Guide</a> of the tool. Windows users should also take a look at
+<a href="win32_notes.txt">f2py HOWTO for Win32</a> (its latest version
+can be found <a
+href="http://www.numpy.org/Members/eric/f2py_win32">here</a>).
+
+<h3>Requirements</h3>
+<ol>
+ <li> You'll need <a
+ href="http://www.python.org/download/">Python</a>
+ (1.5.2 or later, 2.2 is recommended) to run <code>f2py</code>
+ (because it uses exchanged module <code>re</code>).
+ To build generated extension modules with distutils setup script,
+ you'll need Python 2.x.
+ <li> You'll need <a
+ href="http://sourceforge.net/project/?group_id=1369">Numerical
+ Python</a>
+ (version 13 or later, 20.3 is recommended) to compile
+ C/API modules (because they use function
+ <code>PyArray_FromDimsAndDataAndDescr</code>)
+</ol>
+
+<h3>Download</h3>
+
+<dl>
+ <dt> User's Guide:
+ <dd> <a href="usersguide.html">usersguide.html</a>,
+ <a href="usersguide.pdf">usersguide.pdf</a>,
+ <a href="usersguide.ps.gz">usersguide.ps.gz</a>,
+ <a href="usersguide.dvi">usersguide.dvi</a>.
+ <dt> Snapshots of the fifth public release:
+ <dd> <a href="2.x">2.x</a>/<a href="2.x/F2PY-2-latest.tar.gz">F2PY-2-latest.tar.gz</a>
+ <dt> Snapshots of earlier releases:
+ <dd> <a href="rel-5.x">rel-5.x</a>, <a href="rel-4.x">rel-4.x</a>,
+ <a href="rel-3.x">rel-3.x</a>,
+ <a href="rel-2.x">rel-2.x</a>,<a href="rel-1.x">rel-1.x</a>,
+ <a href="rel-0.x">rel-0.x</a>
+</dl>
+
+<h3>Installation</h3>
+
+Unpack the source file, change to directory <code>f2py-?-???</code>
+and run <code>python setup.py install</code>. That's it!
+
+<h3>Platform/Compiler Related Notes</h3>
+
+<code>f2py</code> has been successfully tested on
+<ul>
+ <li> Intel Linux (MD7.0,RH6.1,RH4.2,Debian woody), Athlon Linux (RH6.1), Alpha Linux (RH5.2,RH6.1) with <a
+href="http://gcc.gnu.org/">gcc</a> (versions egcs-2.91.60,egcs-2.91.66, and 2.95.2).
+ <li> Intel Linux (MD7.0) with <a
+ href="http://www.psrv.com/index.html">Pacific-Sierra
+ Research</a> <a href="http://www.psrv.com/lnxf90.html">Personal
+ Linux VAST/f90 Fortran 90 compiler</a> (version V3.4N5).
+ <li> Intel Linux (RH6.1) with <a href="http://www.absoft.com/">Absoft F77/F90</a> compilers for Linux.
+ <li> IRIX64 with <a href="http://gcc.gnu.org/">gcc</a> (2.95.2) and <a
+href="http://www.sgi.com/developers/devtools/languages/mipspro.html">MIPSpro
+7 Compilers</a> (f77,f90,cc versions 7.30).
+ <li> Alpha Linux (RH5.2,RH6.1) with <a href="http://www.digital.com/fortran/linux/">Compaq Fortran </a> compiler (version V1.0-920).
+ <li> Linux with <a href="http://www.nag.co.uk/">NAGWare</a> Fortran
+ 95 compiler.
+ <li> <a href="http://developer.intel.com/software/products/compilers/f50/linux/">
+ Intel(R) Fortran Compiler for Linux</a>
+ <li> Windows 2000 with <a href="http://www.mingw.org">mingw32</a>.
+</ul>
+<code>f2py</code> will probably run on other UN*X systems as
+well. Additions to the list of platforms/compilers where
+<code>f2py</code> has been successfully used are most welcome.
+<P>
+<em>Note:</em>
+Using Compaq Fortran
+compiler on Alpha Linux is succesful unless when
+wrapping Fortran callback functions returning
+<code>COMPLEX</code>. This applies also for IRIX64.
+<P>
+<em>Note:</em>
+Fortran 90/95 module support is currently tested with Absoft F90, VAST/f90, Intel F90 compilers on Linux (MD7.0,Debian woody).
+
+
+<h3><a name="f2py-users">Mailing list</a></h3>
+
+There is a mailing list <a
+href="http://cens.ioc.ee/pipermail/f2py-users/">f2py-users</a>
+available for the users of the <code>f2py</code>
+program and it is open for discussion, questions, and answers. You can subscribe
+the list <a href="http://cens.ioc.ee/mailman/listinfo/f2py-users">here</a>.
+
+<h3><a href="http://cens.ioc.ee/cgi-bin/cvsweb/python/f2py2e/">CVS Repository</a></h3>
+
+<code>f2py</code> is being developed under <a href="http://www.sourcegear.com/CVS">CVS</a> and those who are
+interested in the really latest version of <code>f2py</code> (possibly
+unstable) can get it from the repository as follows:
+<ol>
+ <li> First you need to login (the password is <code>guest</code>):
+<pre>
+> cvs -d :pserver:anonymous@cens.ioc.ee:/home/cvs login
+</pre>
+ <li> and then do the checkout:
+<pre>
+> cvs -z6 -d :pserver:anonymous@cens.ioc.ee:/home/cvs checkout f2py2e
+</pre>
+ <li> In the directory <code>f2py2e</code> you can get the updates by hitting
+<pre>
+> cvs -z6 update -P -d
+</pre>
+</ol>
+You can browse <code>f2py</code> CVS repository <a href="http://cens.ioc.ee/cgi-bin/cvsweb/python/f2py2e/">here</a>.
+
+<h2>Related sites</h2>
+
+<ol>
+ <li> <a href="http://pfdubois.com/numpy/" target="_top">Numerical Python</a>.
+ <li> <a href="http://pyfortran.sourceforge.net/" target="_top">Pyfort</a> -- The Python-Fortran connection tool.
+ <li> <a href="http://starship.python.net/crew/hinsen/scientific.html" target="_top">Scientific Python</a>.
+ <li> <a href="http://numpy.org/" target="_top">SciPy</a> -- Scientific tools for Python (includes Multipack).
+ <li> <a href="http://www.fortran.com/fortran/" target="_top">The Fortran Company</a>.
+ <li> <a href="http://www.j3-fortran.org/" target="_top">Fortran Standards</a>.
+
+ <li> <a href="http://www.fortran.com/fortran/F77_std/rjcnf.html">American National Standard Programming Language FORTRAN ANSI(R) X3.9-1978</a>
+ <li> <a href="http://www.mathtools.net" target="_top">Mathtools.net</a> -- A technical computing portal for all scientific and engineering needs.
+
+</ol>
+
+<!-- End of user text -->
+<HR>
+<ADDRESS>
+<A href="http://validator.w3.org/"><IMG border=0 align=right src="/icons/vh40.gif" alt="Valid HTML 4.0!" height=31 width=88></A>
+<A href="http://cens.ioc.ee/~pearu/" target="_top">Pearu Peterson</A>
+<A href="mailto:pearu(at)ioc.ee">&lt;pearu(at)ioc.ee&gt;</A><BR>
+<!-- hhmts start -->
+Last modified: Fri Jan 20 14:55:12 MST 2006
+<!-- hhmts end -->
+</ADDRESS>
+<!-- You may want to comment the following line out when the document is final-->
+<!-- Check that the reference is right -->
+<!--A href="http://validator.w3.org/check?uri=http://cens.ioc.ee/projects/f2py2e/index.html;ss"> Submit this page for validation</A-->
+
+<p>
+<center>
+This <a href="http://www.ctv.es/USERS/irmina/pythonring.html">Python
+ring</a> site owned by <a href="mailto:pearu(at)ioc.ee">Pearu Peterson</a>.
+<br>
+[
+ <a href="http://nav.webring.org/cgi-bin/navcgi?ring=python_ring;id=12;prev5">Previous 5 Sites</a>
+|
+ <a href="http://nav.webring.org/cgi-bin/navcgi?ring=python_ring;id=12;prev">Previous</a>
+|
+ <a href="http://nav.webring.org/cgi-bin/navcgi?ring=python_ring;id=12;next">Next</a>
+|
+ <a href="http://nav.webring.org/cgi-bin/navcgi?ring=python_ring;id=12;next5">Next 5 Sites</a>
+|
+ <a href="http://nav.webring.org/cgi-bin/navcgi?ring=python_ring;random">Random Site</a>
+|
+ <a href="http://nav.webring.org/cgi-bin/navcgi?ring=python_ring;list">List Sites</a>
+]
+</center>
+<p>
+
+
+
+</BODY>
+
+
+</HTML>
+
+
+
diff --git a/numpy/f2py/doc/intro.tex b/numpy/f2py/doc/intro.tex
new file mode 100644
index 000000000..d9625b09c
--- /dev/null
+++ b/numpy/f2py/doc/intro.tex
@@ -0,0 +1,158 @@
+
+\section{Introduction}
+\label{sec:intro}
+
+\fpy is a command line tool that generates Python C/API modules for
+interfacing Fortran~77/90/95 codes and Fortran~90/95 modules from
+Python. In general, using \fpy an
+interface is produced in three steps:
+\begin{itemize}
+\item[(i)] \fpy scans Fortran sources and creates the so-called
+ \emph{signature} file; the signature file contains the signatures of
+ Fortran routines; the signatures are given in the free format of the
+ Fortran~90/95 language specification. Latest version of \fpy
+ generates also a make file for building shared module.
+ About currently supported compilers see the \fpy home page
+\item[(ii)] Optionally, the signature files can be modified manually
+ in order to dictate how the Fortran routines should be called or
+ seemed from the Python environment.
+\item[(iii)] \fpy reads the signature files and generates Python C/API
+ modules that can be compiled and imported to Python code. In
+ addition, a LaTeX document is generated that contains the
+ documentation of wrapped functions.
+\end{itemize}
+(Note that if you are satisfied with the default signature that \fpy
+generates in step (i), all three steps can be covered with just
+one call to \fpy --- by not specifying `\texttt{-h}' flag).
+Latest versions of \fpy support so-called \fpy directive that allows
+inserting various information about wrapping directly to Fortran
+source code as comments (\texttt{<comment char>f2py <signature statement>}).
+
+The following diagram illustrates the usage of the tool:
+\begin{verbatim}
+! Fortran file foo.f:
+ subroutine foo(a)
+ integer a
+ a = a + 5
+ end
+\end{verbatim}
+\begin{verbatim}
+! Fortran file bar.f:
+ function bar(a,b)
+ integer a,b,bar
+ bar = a + b
+ end
+\end{verbatim}
+\begin{itemize}
+\item[(i)] \shell{\fpy foo.f bar.f -m foobar -h foobar.pyf}
+\end{itemize}
+\begin{verbatim}
+!%f90
+! Signature file: foobar.pyf
+python module foobar ! in
+ interface ! in :foobar
+ subroutine foo(a) ! in :foobar:foo.f
+ integer intent(inout) :: a
+ end subroutine foo
+ function bar(a,b) ! in :foobar:bar.f
+ integer :: a
+ integer :: b
+ integer :: bar
+ end function bar
+ end interface
+end python module foobar
+\end{verbatim}
+\begin{itemize}
+\item[(ii)] Edit the signature file (here I made \texttt{foo}s
+ argument \texttt{a} to be \texttt{intent(inout)}, see
+ Sec.~\ref{sec:attributes}).
+\item[(iii)] \shell{\fpy foobar.pyf}
+\end{itemize}
+\begin{verbatim}
+/* Python C/API module: foobarmodule.c */
+...
+\end{verbatim}
+\begin{itemize}
+\item[(iv)] \shell{make -f Makefile-foobar}
+%\shell{gcc -shared -I/usr/include/python1.5/ foobarmodule.c\bs\\
+%foo.f bar.f -o foobarmodule.so}
+\end{itemize}
+\begin{verbatim}
+Python shared module: foobarmodule.so
+\end{verbatim}
+\begin{itemize}
+\item[(v)] Usage in Python:
+\end{itemize}
+\vspace*{-4ex}
+\begin{verbatim}
+>>> import foobar
+>>> print foobar.__doc__
+This module 'foobar' is auto-generated with f2py (version:1.174).
+The following functions are available:
+ foo(a)
+ bar = bar(a,b)
+.
+>>> print foobar.bar(2,3)
+5
+>>> from Numeric import *
+>>> a = array(3)
+>>> print a,foobar.foo(a),a
+3 None 8
+\end{verbatim}
+Information about how to call \fpy (steps (i) and (iii)) can be
+obtained by executing\\
+\shell{\fpy}\\
+This will print the usage instructions.
+ Step (iv) is system dependent
+(compiler and the locations of the header files \texttt{Python.h} and
+\texttt{arrayobject.h}), and so you must know how to compile a shared
+module for Python in you system.
+
+The next Section describes the step (ii) in more detail in order to
+explain how you can influence to the process of interface generation
+so that the users can enjoy more writing Python programs using your
+wrappers that call Fortran routines. Step (v) is covered in
+Sec.~\ref{sec:notes}.
+
+
+\subsection{Features}
+\label{sec:features}
+
+\fpy has the following features:
+\begin{enumerate}
+\item \fpy scans real Fortran codes and produces the signature files.
+ The syntax of the signature files is borrowed from the Fortran~90/95
+ language specification with some extensions.
+\item \fpy uses the signature files to produce the wrappers for
+ Fortran~77 routines and their \texttt{COMMON} blocks.
+\item For \texttt{external} arguments \fpy constructs a very flexible
+ call-back mechanism so that Python functions can be called from
+ Fortran.
+\item You can pass in almost arbitrary Python objects to wrapper
+ functions. If needed, \fpy takes care of type-casting and
+ non-contiguous arrays.
+\item You can modify the signature files so that \fpy will generate
+ wrapper functions with desired signatures. \texttt{depend()}
+ attribute is introduced to control the initialization order of the
+ variables. \fpy introduces \texttt{intent(hide)} attribute to remove
+ the particular argument from the argument list of the wrapper
+ function. In addition, \texttt{optional} and \texttt{required}
+ attributes are introduced and employed.
+\item \fpy supports almost all standard Fortran~77/90/95 constructs
+ and understands all basic Fortran types, including
+ (multi-dimensional, complex) arrays and character strings with
+ adjustable and assumed sizes/lengths.
+\item \fpy generates a LaTeX document containing the
+ documentations of the wrapped functions (argument types, dimensions,
+ etc). The user can easily add some human readable text to the
+ documentation by inserting \texttt{note(<LaTeX text>)} attribute to
+ the definition of routine signatures.
+\item \fpy generates a GNU make file that can be used for building
+ shared modules calling Fortran functions.
+\item \fpy supports wrapping Fortran 90/95 module routines.
+\end{enumerate}
+
+%%% Local Variables:
+%%% mode: latex
+%%% TeX-master: "f2py2e"
+%%% End:
diff --git a/numpy/f2py/doc/multiarray/array_from_pyobj.c b/numpy/f2py/doc/multiarray/array_from_pyobj.c
new file mode 100644
index 000000000..7e0de9a74
--- /dev/null
+++ b/numpy/f2py/doc/multiarray/array_from_pyobj.c
@@ -0,0 +1,323 @@
+/*
+ * File: array_from_pyobj.c
+ *
+ * Description:
+ * ------------
+ * Provides array_from_pyobj function that returns a contigious 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: array_from_pyobj.c,v 1.1 2002/01/16 18:57:33 pearu Exp $
+ */
+
+
+#define ARR_IS_NULL(arr,mess) \
+if (arr==NULL) { \
+ fprintf(stderr,"array_from_pyobj:" mess); \
+ return NULL; \
+}
+
+#define CHECK_DIMS_DEFINED(rank,dims,mess) \
+if (count_nonpos(rank,dims)) { \
+ fprintf(stderr,"array_from_pyobj:" mess); \
+ return NULL; \
+}
+
+#define HAS_PROPER_ELSIZE(arr,type_num) \
+ ((PyArray_DescrFromType(type_num)->elsize) == (arr)->descr->elsize)
+
+/* static */
+/* void f2py_show_args(const int type_num, */
+/* const int *dims, */
+/* const int rank, */
+/* const int intent) { */
+/* int i; */
+/* fprintf(stderr,"array_from_pyobj:\n\ttype_num=%d\n\trank=%d\n\tintent=%d\n",\ */
+/* type_num,rank,intent); */
+/* for (i=0;i<rank;++i) */
+/* fprintf(stderr,"\tdims[%d]=%d\n",i,dims[i]); */
+/* } */
+
+static
+int count_nonpos(const int rank,
+ const int *dims) {
+ int i=0,r=0;
+ while (i<rank) {
+ if (dims[i] <= 0) ++r;
+ ++i;
+ }
+ return r;
+}
+
+static void lazy_transpose(PyArrayObject* arr);
+static int check_and_fix_dimensions(const PyArrayObject* arr,
+ const int rank,
+ int *dims);
+static
+int array_has_column_major_storage(const PyArrayObject *ap);
+
+static
+PyArrayObject* array_from_pyobj(const int type_num,
+ int *dims,
+ const int rank,
+ const int intent,
+ PyObject *obj) {
+ /* 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).
+ */
+
+/* f2py_show_args(type_num,dims,rank,intent); */
+
+ if (intent & F2PY_INTENT_CACHE) {
+ /* Don't expect correct storage order or anything reasonable when
+ returning cache array. */
+ if ((intent & F2PY_INTENT_HIDE)
+ || (obj==Py_None)) {
+ PyArrayObject *arr = NULL;
+ CHECK_DIMS_DEFINED(rank,dims,"optional,intent(cache) must"
+ " have defined dimensions.\n");
+ arr = (PyArrayObject *)PyArray_FromDims(rank,dims,type_num);
+ ARR_IS_NULL(arr,"FromDims failed: optional,intent(cache)\n");
+ if (intent & F2PY_INTENT_OUT)
+ Py_INCREF(arr);
+ return arr;
+ }
+ if (PyArray_Check(obj)
+ && ISCONTIGUOUS((PyArrayObject *)obj)
+ && HAS_PROPER_ELSIZE((PyArrayObject *)obj,type_num)
+ ) {
+ if (check_and_fix_dimensions((PyArrayObject *)obj,rank,dims))
+ return NULL; /*XXX: set exception */
+ if (intent & F2PY_INTENT_OUT)
+ Py_INCREF(obj);
+ return (PyArrayObject *)obj;
+ }
+ ARR_IS_NULL(NULL,"intent(cache) must be contiguous array with a proper elsize.\n");
+ }
+
+ if (intent & F2PY_INTENT_HIDE) {
+ PyArrayObject *arr = NULL;
+ CHECK_DIMS_DEFINED(rank,dims,"intent(hide) must have defined dimensions.\n");
+ arr = (PyArrayObject *)PyArray_FromDims(rank,dims,type_num);
+ ARR_IS_NULL(arr,"FromDims failed: intent(hide)\n");
+ if (intent & F2PY_INTENT_OUT) {
+ if ((!(intent & F2PY_INTENT_C)) && (rank>1)) {
+ lazy_transpose(arr);
+ arr->flags &= ~CONTIGUOUS;
+ }
+ Py_INCREF(arr);
+ }
+ return arr;
+ }
+
+ if (PyArray_Check(obj)) { /* here we have always intent(in) or
+ intent(inout) */
+
+ PyArrayObject *arr = (PyArrayObject *)obj;
+ int is_cont = (intent & F2PY_INTENT_C) ?
+ (ISCONTIGUOUS(arr)) : (array_has_column_major_storage(arr));
+
+ if (check_and_fix_dimensions(arr,rank,dims))
+ return NULL; /*XXX: set exception */
+
+ if ((intent & F2PY_INTENT_COPY)
+ || (! (is_cont
+ && HAS_PROPER_ELSIZE(arr,type_num)
+ && PyArray_CanCastSafely(arr->descr->type_num,type_num)))) {
+ PyArrayObject *tmp_arr = NULL;
+ if (intent & F2PY_INTENT_INOUT) {
+ ARR_IS_NULL(NULL,"intent(inout) array must be contiguous and"
+ " with a proper type and size.\n")
+ }
+ if ((rank>1) && (! (intent & F2PY_INTENT_C)))
+ lazy_transpose(arr);
+ if (PyArray_CanCastSafely(arr->descr->type_num,type_num)) {
+ tmp_arr = (PyArrayObject *)PyArray_CopyFromObject(obj,type_num,0,0);
+ ARR_IS_NULL(arr,"CopyFromObject failed: array.\n");
+ } else {
+ tmp_arr = (PyArrayObject *)PyArray_FromDims(arr->nd,
+ arr->dimensions,
+ type_num);
+ ARR_IS_NULL(tmp_arr,"FromDims failed: array with unsafe cast.\n");
+ if (copy_ND_array(arr,tmp_arr))
+ ARR_IS_NULL(NULL,"copy_ND_array failed: array with unsafe cast.\n");
+ }
+ if ((rank>1) && (! (intent & F2PY_INTENT_C))) {
+ lazy_transpose(arr);
+ lazy_transpose(tmp_arr);
+ tmp_arr->flags &= ~CONTIGUOUS;
+ }
+ arr = tmp_arr;
+ }
+ if (intent & F2PY_INTENT_OUT)
+ Py_INCREF(arr);
+ return arr;
+ }
+
+ if ((obj==Py_None) && (intent & F2PY_OPTIONAL)) {
+ PyArrayObject *arr = NULL;
+ CHECK_DIMS_DEFINED(rank,dims,"optional must have defined dimensions.\n");
+ arr = (PyArrayObject *)PyArray_FromDims(rank,dims,type_num);
+ ARR_IS_NULL(arr,"FromDims failed: optional.\n");
+ if (intent & F2PY_INTENT_OUT) {
+ if ((!(intent & F2PY_INTENT_C)) && (rank>1)) {
+ lazy_transpose(arr);
+ arr->flags &= ~CONTIGUOUS;
+ }
+ Py_INCREF(arr);
+ }
+ return arr;
+ }
+
+ if (intent & F2PY_INTENT_INOUT) {
+ ARR_IS_NULL(NULL,"intent(inout) argument must be an array.\n");
+ }
+
+ {
+ PyArrayObject *arr = (PyArrayObject *) \
+ PyArray_ContiguousFromObject(obj,type_num,0,0);
+ ARR_IS_NULL(arr,"ContiguousFromObject failed: not a sequence.\n");
+ if (check_and_fix_dimensions(arr,rank,dims))
+ return NULL; /*XXX: set exception */
+ if ((rank>1) && (! (intent & F2PY_INTENT_C))) {
+ PyArrayObject *tmp_arr = NULL;
+ lazy_transpose(arr);
+ arr->flags &= ~CONTIGUOUS;
+ tmp_arr = (PyArrayObject *) PyArray_CopyFromObject((PyObject *)arr,type_num,0,0);
+ Py_DECREF(arr);
+ arr = tmp_arr;
+ ARR_IS_NULL(arr,"CopyFromObject(Array) failed: intent(fortran)\n");
+ lazy_transpose(arr);
+ arr->flags &= ~CONTIGUOUS;
+ }
+ if (intent & F2PY_INTENT_OUT)
+ Py_INCREF(arr);
+ return arr;
+ }
+
+}
+
+ /*****************************************/
+ /* Helper functions for array_from_pyobj */
+ /*****************************************/
+
+static
+int array_has_column_major_storage(const PyArrayObject *ap) {
+ /* array_has_column_major_storage(a) is equivalent to
+ transpose(a).iscontiguous() but more efficient.
+
+ This function can be used in order to decide whether to use a
+ Fortran or C version of a wrapped function. This is relevant, for
+ example, in choosing a clapack or flapack function depending on
+ the storage order of array arguments.
+ */
+ int sd;
+ int i;
+ sd = ap->descr->elsize;
+ for (i=0;i<ap->nd;++i) {
+ if (ap->dimensions[i] == 0) return 1;
+ if (ap->strides[i] != sd) return 0;
+ sd *= ap->dimensions[i];
+ }
+ return 1;
+}
+
+static
+void lazy_transpose(PyArrayObject* arr) {
+ /*
+ Changes the order of array strides and dimensions. This
+ corresponds to the lazy transpose of a Numeric array in-situ.
+ Note that this function is assumed to be used even times for a
+ given array. Otherwise, the caller should set flags &= ~CONTIGUOUS.
+ */
+ int rank,i,s,j;
+ rank = arr->nd;
+ if (rank < 2) return;
+
+ for(i=0,j=rank-1;i<rank/2;++i,--j) {
+ s = arr->strides[i];
+ arr->strides[i] = arr->strides[j];
+ arr->strides[j] = s;
+ s = arr->dimensions[i];
+ arr->dimensions[i] = arr->dimensions[j];
+ arr->dimensions[j] = s;
+ }
+}
+
+static
+int check_and_fix_dimensions(const PyArrayObject* arr,const int rank,int *dims) {
+ /*
+ 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.
+ */
+ const int arr_size = (arr->nd)?PyArray_Size((PyObject *)arr):1;
+
+ if (rank > arr->nd) { /* [1,2] -> [[1],[2]]; 1 -> [[1]] */
+ int new_size = 1;
+ int free_axe = -1;
+ int i;
+ /* Fill dims where -1 or 0; check dimensions; calc new_size; */
+ for(i=0;i<arr->nd;++i) {
+ if (dims[i] >= 0) {
+ if (dims[i]!=arr->dimensions[i]) {
+ fprintf(stderr,"%d-th dimension must be fixed to %d but got %d\n",
+ i,dims[i],arr->dimensions[i]);
+ return 1;
+ }
+ if (!dims[i]) dims[i] = 1;
+ } else {
+ dims[i] = arr->dimensions[i] ? arr->dimensions[i] : 1;
+ }
+ new_size *= dims[i];
+ }
+ for(i=arr->nd;i<rank;++i)
+ if (dims[i]>1) {
+ fprintf(stderr,"%d-th dimension must be %d 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) {
+ fprintf(stderr,"confused: new_size=%d, arr_size=%d (maybe too many free"
+ " indices)\n",new_size,arr_size);
+ return 1;
+ }
+ } else {
+ int i;
+ for (i=rank;i<arr->nd;++i)
+ if (arr->dimensions[i]>1) {
+ fprintf(stderr,"too many axes: %d, expected rank=%d\n",arr->nd,rank);
+ return 1;
+ }
+ for (i=0;i<rank;++i)
+ if (dims[i]>=0) {
+ if (arr->dimensions[i]!=dims[i]) {
+ fprintf(stderr,"%d-th dimension must be fixed to %d but got %d\n",
+ i,dims[i],arr->dimensions[i]);
+ return 1;
+ }
+ if (!dims[i]) dims[i] = 1;
+ } else
+ dims[i] = arr->dimensions[i];
+ }
+ return 0;
+}
+
+/* End of file: array_from_pyobj.c */
diff --git a/numpy/f2py/doc/multiarray/bar.c b/numpy/f2py/doc/multiarray/bar.c
new file mode 100644
index 000000000..350636ea6
--- /dev/null
+++ b/numpy/f2py/doc/multiarray/bar.c
@@ -0,0 +1,15 @@
+
+#include <stdio.h>
+
+void bar(int *a,int m,int n) {
+ int i,j;
+ printf("C:");
+ printf("m=%d, n=%d\n",m,n);
+ for (i=0;i<m;++i) {
+ printf("Row %d:\n",i+1);
+ for (j=0;j<n;++j)
+ printf("a(i=%d,j=%d)=%d\n",i,j,a[n*i+j]);
+ }
+ if (m*n)
+ a[0] = 7777;
+}
diff --git a/numpy/f2py/doc/multiarray/foo.f b/numpy/f2py/doc/multiarray/foo.f
new file mode 100644
index 000000000..f8c39c4d1
--- /dev/null
+++ b/numpy/f2py/doc/multiarray/foo.f
@@ -0,0 +1,13 @@
+ subroutine foo(a,m,n)
+ integer a(m,n), m,n,i,j
+ print*, "F77:"
+ print*, "m=",m,", n=",n
+ do 100,i=1,m
+ print*, "Row ",i,":"
+ do 50,j=1,n
+ print*, "a(i=",i,",j=",j,") = ",a(i,j)
+ 50 continue
+ 100 continue
+ if (m*n.gt.0) a(1,1) = 77777
+ end
+
diff --git a/numpy/f2py/doc/multiarray/fortran_array_from_pyobj.txt b/numpy/f2py/doc/multiarray/fortran_array_from_pyobj.txt
new file mode 100644
index 000000000..c7b945c84
--- /dev/null
+++ b/numpy/f2py/doc/multiarray/fortran_array_from_pyobj.txt
@@ -0,0 +1,284 @@
+
+ _____________________________________________________________
+ / Proposed internal structure for f2py generated extension \
+ < modules regarding the issues with different storage-orders >
+ \ of multi-dimensional matrices in Fortran and C. /
+ =============================================================
+
+Author: Pearu Peterson
+Date: 14 January, 2001
+
+Definitions:
+============
+
+In the following I will use the following definitions:
+
+1) A matrix is a mathematical object that represents a collection of
+ objects (elements), usually visualized in a table form, and one can
+ define a set of various (algebraic,etc) operations for matrices.
+ One can think of a matrix as a defintion of a certain mapping:
+ (i) |--> A(i)
+ where i belongs to the set of indices (an index itself can be a
+ sequence of objects, for example, a sequence of integers) and A(i)
+ is an element from a specified set, for example, a set of fruits.
+ Symbol A then denotes a matrix of fruits.
+
+2) An array is a storage object that represents a collection of
+ objects stored in a certain systematic way, for example, as an
+ ordered sequence in computer memory.
+
+In order to manipulate matrices using computers, one must store matrix
+elements in computer memory. In the following, I will assume that the
+elements of a matrix is stored as an array. There is no unique way in
+which order one should save matrix elements in the array. However, in
+C and Fortran programming languages, two, unfortunately different,
+conventions are used.
+
+Aim:
+====
+
+The purpose of this writing is to work out an interface for Python
+language so that C and Fortran routines can be called without
+bothering about how multi-dimensional matrices are stored in memory.
+For example, accessing a matrix element A[i,j] in Python will be
+equivalent to accessing the same matrix in C, using A[i][j], or in
+Fortran, using A(i,j).
+
+External conditions:
+====================
+
+In C programming language, it is custom to think that matrices are
+stored in the so-called row-major order, that is, a matrix is stored
+row by row, each row is as a contiguous array in computer memory.
+
+In Fortran programming language, matrices are stored in the
+column-major order: each column is a contiguous array in computer
+memory.
+
+In Python programming language, matrices can be stored using Python
+Numeric array() function that uses internally C approach, that is,
+elements of matrices are stored in row-major order. For example,
+A = array([[1,2,3],[4,5,6]]) represents a 2-by-3 matrix
+
+ / 1 2 3 \
+ | |
+ \ 4 5 6 /
+
+and its elements are stored in computer memory as the following array:
+
+ 1 2 3 4 5 6
+
+The same matrix, if used in Fortran, would be stored in computer
+memory as the following array:
+
+ 1 4 2 5 3 6
+
+Problem and solution:
+=====================
+
+A problem arises if one wants to use the same matrix both in C and in
+Fortran functions. Then the difference in storage order of a matrix
+elements must be taken into account. This technical detail can be very
+confusing even for an experienced programmer. This is because when
+passing a matrix to a Fortran subroutine, you must (mentally or
+programmically) transpose the matrix and when the subroutine returns,
+you must transpose it back.
+
+As will be discussed below, there is a way to overcome these
+difficulties in Python by creating an interface between Python and
+Fortran code layers that takes care of this transition internally. So
+that if you will read the manual pages of the Fortran codes, then you
+need not to think about how matrices are actually stored, the storage
+order will be the same, seemingly.
+
+Python / C / Fortran interface:
+===============================
+
+The interface between Python and Fortran codes will use the following
+Python Numeric feature: transposing a Numeric array does not involve
+copying of its data but just permuting the dimensions and strides of
+the array (the so-called lazy transpose).
+
+However, when passing a Numeric array data pointer to Fortran or C
+function, the data must be contiguous in memory. If it is not, then
+data is rearranged inplace. I don't think that it can be avoided.
+This is certainly a penalty hit to performance. However, one can
+easily avoid it by creating a Numeric array with the right storage
+order, so that after transposing, the array data will be contiguous in
+memory and the data pointer can safely passed on to the Fortran
+subroutine. This lazy-transpose operation will be done within the
+interface and users need not to bother about this detail anymore (that
+is, after they initialize Numeric array with matrix elements using the
+proper order. Of course, the proper order depends on the target
+function: C or Fortran). The interface should be smart enough to
+minimize the need of real-transpose operations and the need to
+additional memory storage as well.
+
+Statement of the problem:
+=========================
+
+Consider a M-by-N matrix A of integers, where M and N are the number A
+rows and columns, respectively.
+
+In Fortran language, the storing array of this matrix can be defined
+as follows:
+
+ integer A(M,N)
+
+in C:
+
+ int A[M][N];
+
+and in Python:
+
+ A = Numeric.zeros((M,N),'i')
+
+Consider also the corresponding Fortran and C functions that
+that use matrix arguments:
+
+Fortran:
+ subroutine FUN(A,M,N)
+ integer A(M,N)
+ ...
+ end
+C:
+ void cun(int *a,int m,int n) {
+ ...
+ }
+
+and the corresponding Python interface signatures:
+
+ def py_fun(a):
+ ...
+ def py_cun(a):
+ ...
+
+Main goal:
+==========
+
+Our goal is to generate Python C/API functions py_fun and py_cun such
+that their usage in Python would be identical. The cruical part of
+their implementation are in functions that take a PyObject and
+return a PyArrayObject such that it is contiguous and its data pointer
+is suitable for passing on to the arguments of C or Fortran functions.
+The prototypes of these functions are:
+
+PyArrayObject* fortran_array_from_pyobj(
+ int typecode,
+ int *dims,
+ int rank,
+ int intent,
+ PyObject *obj);
+
+and
+
+PyArrayObject* c_array_from_pyobj(
+ int typecode,
+ int *dims,
+ int rank,
+ int intent,
+ PyObject *obj);
+
+for wrapping Fortran and C functions, respectively.
+
+Pseudo-code for fortran_array_from_pyobj:
+=========================================
+
+if type(obj) is ArrayType:
+ #raise not check(len(ravel(obj)) >= dims[0]*dims[1]*...*dims[rank-1])
+ if obj.typecode is typecode:
+ if is_contiguous(obj):
+ transpose_data_inplace(obj) # real-transpose
+ set_transpose_strides(obj) # lazy-transpose
+ Py_INCREF(obj);
+ return obj
+ set_transpose_strides(obj)
+ if is_contiguous(obj):
+ set_transpose_strides(obj)
+ Py_INCREF(obj);
+ return obj
+ else:
+ tmp_obj = PyArray_ContiguousFromObject(obj,typecode,0,0)
+ swap_datapointer_and_typeinfo(obj,tmp_obj)
+ Py_DECREF(tmp_obj);
+ set_transpose_strides(obj)
+ Py_INCREF(obj);
+ return obj
+ else:
+ tmp_obj = PyArray_FromDims(rank,dims,typecode)
+ set_transpose_strides(tmp_obj)
+ if intent in [in,inout]:
+ copy_ND_array(obj,tmp_obj)
+ swap_datapointer_and_typeinfo(obj,tmp_obj)
+ Py_DECREF(tmp_obj);
+ Py_INCREF(obj);
+ return obj
+elif obj is None: # happens when only intent is 'hide'
+ tmp_obj = PyArray_FromDims(rank,dims,typecode)
+ if intent is out:
+ set_transpose_strides(tmp_obj)
+ # otherwise tmp_obj->data is used as a work array
+ Py_INCREF(tmp_obj)
+ return tmp_obj
+else:
+ tmp_obj = PyArray_ContiguousFromObject(obj,typecode,0,0)
+ #raise not check(len(ravel(obj)) >= dims[0]*dims[1]*...*dims[rank-1])
+ set_transpose_strides(tmp_obj)
+ transpose_data_inplace(tmp_obj)
+ Py_INCREF(tmp_obj)
+ return tmp_obj
+
+Notes:
+ 1) CPU expensive tasks are in transpose_data_inplace and
+ copy_ND_array, PyArray_ContiguousFromObject.
+ 2) Memory expensive tasks are in PyArray_FromDims,
+ PyArray_ContiguousFromObject
+ 3) Side-effects are expected when set_transpose_strides and
+ transpose_data_inplace are used. For example:
+ >>> a = Numeric([[1,2,3],[4,5,6]],'d')
+ >>> a.is_contiguous()
+ 1
+ >>> py_fun(a)
+ >>> a.typecode()
+ 'i'
+ >>> a.is_contiguous()
+ 0
+ >>> transpose(a).is_contiguous()
+ 1
+
+Pseudo-code for c_array_from_pyobj:
+===================================
+
+if type(obj) is ArrayType:
+ #raise not check(len(ravel(obj)) >= dims[0]*dims[1]*...*dims[rank-1])
+ if obj.typecode is typecode:
+ if is_contiguous(obj):
+ Py_INCREF(obj);
+ return obj
+ else:
+ tmp_obj = PyArray_ContiguousFromObject(obj,typecode,0,0)
+ swap_datapointer_and_typeinfo(obj,tmp_obj)
+ Py_DECREF(tmp_obj);
+ Py_INCREF(obj);
+ return obj
+ else:
+ tmp_obj = PyArray_FromDims(rank,dims,typecode)
+ if intent in [in,inout]:
+ copy_ND_array(obj,tmp_obj)
+ swap_datapointer_and_typeinfo(obj,tmp_obj)
+ Py_DECREF(tmp_obj);
+ Py_INCREF(obj);
+ return obj
+elif obj is None: # happens when only intent is 'hide'
+ tmp_obj = PyArray_FromDims(rank,dims,typecode)
+ Py_INCREF(tmp_obj)
+ return tmp_obj
+else:
+ tmp_obj = PyArray_ContiguousFromObject(obj,typecode,0,0)
+ #raise not check(len(ravel(obj)) >= dims[0]*dims[1]*...*dims[rank-1])
+ Py_INCREF(tmp_obj)
+ return tmp_obj
+
+
+14 January, 2002
+Pearu Peterson <pearu@cens.ioc.ee> \ No newline at end of file
diff --git a/numpy/f2py/doc/multiarray/fun.pyf b/numpy/f2py/doc/multiarray/fun.pyf
new file mode 100644
index 000000000..ed5d1923f
--- /dev/null
+++ b/numpy/f2py/doc/multiarray/fun.pyf
@@ -0,0 +1,89 @@
+!%f90 -*- f90 -*-
+
+! Example:
+! Using f2py for wrapping multi-dimensional Fortran and C arrays
+! [NEW APPROACH, use it with f2py higher than 2.8.x]
+! $Id: fun.pyf,v 1.3 2002/01/18 10:06:50 pearu Exp $
+
+! Usage (with gcc compiler):
+! f2py -c fun.pyf foo.f bar.c
+
+python module fun ! in
+ interface ! in :fun
+
+! >>> from Numeric import *
+! >>> import fun
+! >>> a=array([[1,2,3],[4,5,6]])
+
+ subroutine foo(a,m,n) ! in :fun:foo.f
+ integer dimension(m,n) :: a
+ intent(in,out,copy) :: a
+ integer optional,check(shape(a,0)==m),depend(a) :: m=shape(a,0)
+ integer optional,check(shape(a,1)==n),depend(a) :: n=shape(a,1)
+ end subroutine foo
+
+! >>> print fun.foo.__doc__
+! foo - Function signature:
+! a = foo(a,[m,n])
+! Required arguments:
+! a : input rank-2 array('i') with bounds (m,n)
+! Optional arguments:
+! m := shape(a,0) input int
+! n := shape(a,1) input int
+! Return objects:
+! a : rank-2 array('i') with bounds (m,n)
+
+! >>> print fun.foo(a)
+! F77:
+! m= 2, n= 3
+! Row 1:
+! a(i= 1,j= 1) = 1
+! a(i= 1,j= 2) = 2
+! a(i= 1,j= 3) = 3
+! Row 2:
+! a(i= 2,j= 1) = 4
+! a(i= 2,j= 2) = 5
+! a(i= 2,j= 3) = 6
+! [[77777 2 3]
+! [ 4 5 6]]
+
+
+ subroutine bar(a,m,n)
+ intent(c)
+ intent(c) bar
+ integer dimension(m,n) :: a
+ intent(in,out) :: a
+ integer optional,check(shape(a,0)==m),depend(a) :: m=shape(a,0)
+ integer optional,check(shape(a,1)==n),depend(a) :: n=shape(a,1)
+ intent(in) m,n
+ end subroutine bar
+
+! >>> print fun.bar.__doc__
+! bar - Function signature:
+! a = bar(a,[m,n])
+! Required arguments:
+! a : input rank-2 array('i') with bounds (m,n)
+! Optional arguments:
+! m := shape(a,0) input int
+! n := shape(a,1) input int
+! Return objects:
+! a : rank-2 array('i') with bounds (m,n)
+
+! >>> print fun.bar(a)
+! C:m=2, n=3
+! Row 1:
+! a(i=0,j=0)=1
+! a(i=0,j=1)=2
+! a(i=0,j=2)=3
+! Row 2:
+! a(i=1,j=0)=4
+! a(i=1,j=1)=5
+! a(i=1,j=2)=6
+! [[7777 2 3]
+! [ 4 5 6]]
+
+ end interface
+end python module fun
+
+! This file was auto-generated with f2py (version:2.9.166).
+! See http://cens.ioc.ee/projects/f2py2e/
diff --git a/numpy/f2py/doc/multiarray/run.pyf b/numpy/f2py/doc/multiarray/run.pyf
new file mode 100644
index 000000000..bb12a439b
--- /dev/null
+++ b/numpy/f2py/doc/multiarray/run.pyf
@@ -0,0 +1,91 @@
+!%f90 -*- f90 -*-
+
+! Example:
+! Using f2py for wrapping multi-dimensional Fortran and C arrays
+! [OLD APPROACH, do not use it with f2py higher than 2.8.x]
+! $Id: run.pyf,v 1.1 2002/01/14 15:49:46 pearu Exp $
+
+! Usage (with gcc compiler):
+! f2py -c run.pyf foo.f bar.c -DNO_APPEND_FORTRAN
+
+python module run ! in
+ interface ! in :run
+
+! >>> from Numeric import *
+! >>> import run
+! >>> a=array([[1,2,3],[4,5,6]],'i')
+
+ subroutine foo(a,m,n)
+ fortranname foo_
+ integer dimension(m,n) :: a
+ integer optional,check(shape(a,1)==m),depend(a) :: m=shape(a,1)
+ integer optional,check(shape(a,0)==n),depend(a) :: n=shape(a,0)
+ end subroutine foo
+
+! >>> print run.foo.__doc__
+! foo - Function signature:
+! foo(a,[m,n])
+! Required arguments:
+! a : input rank-2 array('i') with bounds (n,m)
+! Optional arguments:
+! m := shape(a,1) input int
+! n := shape(a,0) input int
+
+! >>> run.foo(a)
+! F77:
+! m= 3, n= 2
+! Row 1:
+! a(i= 1,j= 1) = 1
+! a(i= 1,j= 2) = 4
+! Row 2:
+! a(i= 2,j= 1) = 2
+! a(i= 2,j= 2) = 5
+! Row 3:
+! a(i= 3,j= 1) = 3
+! a(i= 3,j= 2) = 6
+
+! >>> run.foo(transpose(a))
+! F77:
+! m= 2, n= 3
+! Row 1:
+! a(i= 1,j= 1) = 1
+! a(i= 1,j= 2) = 2
+! a(i= 1,j= 3) = 3
+! Row 2:
+! a(i= 2,j= 1) = 4
+! a(i= 2,j= 2) = 5
+! a(i= 2,j= 3) = 6
+
+ subroutine bar(a,m,n)
+ intent(c)
+ integer dimension(m,n) :: a
+ integer optional,check(shape(a,0)==m),depend(a) :: m=shape(a,0)
+ integer optional,check(shape(a,1)==n),depend(a) :: n=shape(a,1)
+ end subroutine bar
+
+! >>> print run.bar.__doc__
+! bar - Function signature:
+! bar(a,[m,n])
+! Required arguments:
+! a : rank-2 array('i') with bounds (m,n)
+! Optional arguments:
+! m := shape(a,0) int
+! n := shape(a,1) int
+
+! >>> run.bar(a)
+! C:m=2, n=3
+! Row 1:
+! a(i=0,j=0)=1
+! a(i=0,j=1)=2
+! a(i=0,j=2)=3
+! Row 2:
+! a(i=1,j=0)=4
+! a(i=1,j=1)=5
+! a(i=1,j=2)=6
+
+
+ end interface
+end python module run
+
+! This file was auto-generated with f2py (version:2.8.172).
+! See http://cens.ioc.ee/projects/f2py2e/
diff --git a/numpy/f2py/doc/multiarray/transpose.txt b/numpy/f2py/doc/multiarray/transpose.txt
new file mode 100644
index 000000000..a8d41e6df
--- /dev/null
+++ b/numpy/f2py/doc/multiarray/transpose.txt
@@ -0,0 +1,1127 @@
+From: Phil Garner (garner@signal.dra.hmg.gb)
+ Subject: In place matrix transpose
+ Newsgroups: sci.math.num-analysis
+ Date: 1993-08-05 06:35:06 PST
+
+
+Someone was talking about matrix transposes earlier on. It's a
+curious subject. I found that an in-place transpose is about 12 times
+slower than the trivial copying method.
+
+Here's somthing I nicked from netlib and translated into C to do the
+in-place one for those that are interested: (matrix must be in one
+block)
+
+
+typedef float scalar; /* float -> double for double precision */
+
+/*
+ * In Place Matrix Transpose
+ * From: Algorithm 380 collected algorithms from ACM.
+ * Converted to C by Phil Garner
+ *
+ * Algorithm appeared in comm. ACM, vol. 13, no. 05,
+ * p. 324.
+ */
+int trans(scalar *a, unsigned m, unsigned n, int *move, int iwrk)
+{
+ scalar b;
+ int i, j, k, i1, i2, ia, ib, ncount, kmi, Max, mn;
+
+ /*
+ * a is a one-dimensional array of length mn=m*n, which
+ * contains the m by n matrix to be transposed.
+ * move is a one-dimensional array of length iwrk
+ * used to store information to speed up the process. the
+ * value iwrk=(m+n)/2 is recommended. Return val indicates the
+ * success or failure of the routine.
+ * normal return = 0
+ * errors
+ * -2, iwrk negative or zero.
+ * ret > 0, (should never occur). in this case
+ * we set ret equal to the final value of i when the search
+ * is completed but some loops have not been moved.
+ * check arguments and initialise
+ */
+
+ /* Function Body */
+ if (n < 2 || m < 2)
+ return 0;
+ if (iwrk < 1)
+ return -2;
+
+ /* If matrix is square, exchange elements a(i,j) and a(j,i). */
+ if (n == m)
+ {
+ for (i = 0; i < m - 1; ++i)
+ for (j = i + 1; j < m; ++j)
+ {
+ i1 = i + j * m;
+ i2 = j + i * m;
+ b = a[i1];
+ a[i1] = a[i2];
+ a[i2] = b;
+ } return 0;
+ }
+
+ /* Non square matrix */
+ ncount = 2;
+ for (i = 0; i < iwrk; ++i)
+ move[i] = 0;
+
+ if (n > 2)
+ /* Count number,ncount, of single points. */
+ for (ia = 1; ia < n - 1; ++ia)
+ {
+ ib = ia * (m - 1) / (n - 1);
+ if (ia * (m - 1) != ib * (n - 1))
+ continue;
+ ++ncount;
+ i = ia * m + ib;
+ if (i > iwrk)
+ continue;
+ move[i] = 1;
+ }
+
+ /* Set initial values for search. */
+ mn = m * n;
+ k = mn - 1;
+ kmi = k - 1;
+ Max = mn;
+ i = 1;
+
+ while (1)
+ {
+ /* Rearrange elements of a loop. */
+ /* At least one loop must be re-arranged. */
+ i1 = i;
+ while (1)
+ {
+ b = a[i1];
+ while (1)
+ {
+ i2 = n * i1 - k * (i1 / m);
+ if (i1 <= iwrk)
+ move[i1 - 1] = 2;
+ ++ncount;
+ if (i2 == i || i2 >= kmi)
+ {
+ if (Max == kmi || i2 == i)
+ break;
+ Max = kmi;
+ }
+ a[i1] = a[i2];
+ i1 = i2;
+ }
+
+ /* Test for symmetric pair of loops. */
+ a[i1] = b;
+ if (ncount >= mn)
+ return 0;
+ if (i2 == Max || Max == kmi)
+ break;
+ Max = kmi;
+ i1 = Max;
+ }
+
+ /* Search for loops to be rearranged. */
+ while (1)
+ {
+ Max = k - i;
+ ++i;
+ kmi = k - i;
+ if (i > Max)
+ return i;
+ if (i <= iwrk)
+ {
+ if (move[i-1] < 1)
+ break;
+ continue;
+ }
+ if (i == n * i - k * (i / m))
+ continue;
+ i1 = i;
+ while (1)
+ {
+ i2 = n * i1 - k * (i1 / m);
+ if (i2 <= i || i2 >= Max)
+ break;
+ i1 = i2;
+ }
+ if (i2 == i)
+ break;
+ }
+ } /* End never reached */
+}
+
+--
+ ,----------------------------- ______
+ ____ | Phil Garner. \___| |/ \ \ ____
+/__/ `--, _L__L\_ | garner@signal.dra.hmg.gb | _|`---' \_/__/ `--,
+`-0---0-' `-0--0-' `--OO-------------------O-----' `---0---' `-0---0-'
+
+ From: Murray Dow (mld900@anusf.anu.edu.au)
+ Subject: Re: In place matrix transpose
+ Newsgroups: sci.math.num-analysis
+ Date: 1993-08-09 19:45:57 PST
+
+
+In article <23qmp3INN3gl@mentor.dra.hmg.gb>, garner@signal.dra.hmg.gb (Phil Garner) writes:
+|> Someone was talking about matrix transposes earlier on. It's a
+|> curious subject. I found that an in-place transpose is about 12 times
+|> slower than the trivial copying method.
+|>
+
+Algorithm 380 from CACM is sloweer than ALG 467. Here are my times
+from a VP2200 vector computer. Note that the CACM algorithms are scalar.
+Times are in seconds, for a 900*904 matrix:
+
+380 NAG 467 disc copy
+1.03 1.14 .391 .177
+
+Compare two vector algortihms, one I wrote and the second a matrix
+copy:
+
+My Alg Matrix copy
+.0095 .0097
+
+Conclusions: dont use Alg 380 from Netlib. If you have the available memory,
+do a matrix copy. If you don't have the memory, I will send you my algorithm
+when I have published it.
+--
+Murray Dow GPO Box 4 Canberra ACT 2601 Australia
+Supercomputer Facility Phone: +61 6 2495028
+Australian National University Fax: +61 6 2473425
+mld900@anusf.anu.edu.au
+
+=============================================================================
+
+From: Mark Smotherman (mark@hubcap.clemson.edu)
+ Subject: Matrix transpose benchmark [was Re: MIPS R8000 == TFP?]
+ Newsgroups: comp.arch, comp.benchmarks, comp.sys.super
+ Date: 1994-07-01 06:35:51 PST
+
+
+mccalpin@perelandra.cms.udel.edu (John D. McCalpin) writes:
+
+>
+>Of course, these results are all for the naive algorithm. I would be
+>interested to see what an efficient blocked algorithm looks like.
+>Anyone care to offer one? There is clearly a lot of performance
+>to be gained by the effort....
+
+Here is a matrix transpose benchmark generator. Enter something like
+
+ 10d10eij;
+
+and you get a benchmark program with tiles of size 10 for the i and j
+inner loops. Please email code improvements and flames.
+
+Enjoy!
+
+
+/*---------------------------------------------------------------------------
+
+ Matrix Transpose Generator
+
+ Copyright 1993, Dept. of Computer Science, Clemson University
+
+ Permission to use, copy, modify, and distribute this software and
+ its documentation for any purpose and without fee is hereby granted,
+ provided that the above copyright notice appears in all copies.
+
+ Clemson University and its Dept. of Computer Science make no
+ representations about the suitability of this software for any
+ purpose. It is provided "as is" without express or implied warranty.
+
+ Original author: Mark Smotherman
+
+ -------------------------------------------------------------------------*/
+
+
+/* tpgen.c version 1.0
+ *
+ * generate a matrix transpose loop nest, with tiling and unrolling
+ * (timing code using getrusage is included in the generated program)
+ *
+ * mark smotherman
+ * mark@cs.clemson.edu
+ * clemson university
+ * 9 july 1993
+ *
+ * a loop nest can be described by the order of its loop indices, so
+ * this program takes as input a simple language describing these indices:
+ * <number>d ==> generate tiling loop for index i with step size of <number>
+ * <number>e ==> generate tiling loop for index j with step size of <number>
+ * <number>i ==> generate loop for index i with unrolling factor of <number>
+ * <number>j ==> generate loop for index j with unrolling factor of <number>
+ * ; ==> input terminator (required)
+ * rules are:
+ * i,j tokens must appear
+ * if d appears, it must appear before i
+ * if e appears, it must appear before j
+ * ; must appear
+ * matrix size is controlled by #define N in this program.
+ *
+ * this code was adapted from mmgen.c v1.2 and extended to generate pre-
+ * condition loops for unrolling factors that do not evenly divide the
+ * matrix size (or the tiling step size for loop nests with a tiling loop).
+ * note that this program only provides a preconditioning loop for the
+ * innermost loop. unrolling factors for non-innermost loops that do not
+ * evenly divide the matrix size (or step size) are not supported.
+ *
+ * my interest in this program generator is to hook it to a sentence
+ * generator and a minimum execution time finder, that is
+ * while((sentence=sgen())!=NULL){
+ * genprogram=tpgen(sentence);
+ * system("cc -O4 genprogram.c");
+ * system("a.out >> tpresults");
+ * }
+ * findmintime(tpresults);
+ * this will find the optimum algorithm for the host system via an
+ * exhaustive search.
+ *
+ * please report bugs and suggestions for enhancements to me.
+ */
+
+#include <stdio.h>
+#include <string.h>
+#include <ctype.h>
+#define N 500
+
+#define ALLOC1 temp1=(struct line *)malloc(sizeof(struct line));\
+temp1->indentcnt=indentcnt;
+
+#define LINK1 temp1->next=insertbefore;\
+insertafter->next=temp1;\
+insertafter=temp1;
+
+#define INSERT1 temp1->next=start;\
+start=temp1;
+
+#define ALLOC2 temp1=(struct line *)malloc(sizeof(struct line));\
+temp2=(struct line *)malloc(sizeof(struct line));\
+temp1->indentcnt=indentcnt;\
+temp2->indentcnt=indentcnt++;
+
+#define LINK2 temp1->next=temp2;\
+temp2->next=insertbefore;\
+insertafter->next=temp1;\
+insertafter=temp1;\
+insertbefore=temp2;
+
+struct line{ int indentcnt; char line[256]; struct line *next; };
+
+int indentcnt;
+int iflag,jflag;
+int ijflag,jiflag;
+int dflag,eflag;
+int counter;
+int iistep,jjstep;
+int iunroll,junroll;
+int precond;
+
+char c;
+int i,ttp,nt;
+char *p0;
+char tptype[80];
+char number[10];
+
+struct line *start,*head,*insertafter,*insertbefore,*temp1,*temp2;
+
+void processloop();
+void processstmt();
+
+main(){
+
+ indentcnt=0;
+ iflag=jflag=0;
+ ijflag=jiflag=0;
+ dflag=eflag=0;
+ iunroll=junroll=0;
+ counter=1;
+ precond=0;
+ ttp=0;
+
+ start=NULL;
+ ALLOC2
+ sprintf(temp1->line,"/* begin */\nt_start=second();\n");
+ sprintf(temp2->line,"/* end */\nt_end = second();\n");
+ head=temp1; temp1->next=temp2; temp2->next=NULL;
+ insertafter=temp1; insertbefore=temp2;
+
+ while((c=getchar())!=';'){
+ tptype[ttp++]=c;
+ if(isdigit(c)){
+ nt=0;
+ while(isdigit(c)){
+ number[nt++]=c;
+ c=getchar();
+ if(c==';'){ fprintf(stderr,"unexpected ;!\n"); exit(1); }
+ tptype[ttp++]=c;
+ }
+ number[nt]='\0';
+ sscanf(number,"%d",&counter);
+ }
+ switch(c){
+ case 'd':
+ if(iflag){ fprintf(stderr,"d cannot appear after i!\n"); exit(1); }
+ dflag++;
+ ALLOC1
+ sprintf(temp1->line,"#define IISTEP %d\n",counter);
+ INSERT1
+ iistep=counter;
+ counter=1;
+ ALLOC2
+ sprintf(temp1->line,"for(ii=0;ii<%d;ii+=IISTEP){\n",N);
+ sprintf(temp2->line,"}\n",N);
+ LINK2
+ ALLOC1
+ sprintf(temp1->line,"it=min(ii+IISTEP,%d);\n",N);
+ LINK1
+ break;
+ case 'e':
+ if(jflag){ fprintf(stderr,"e cannot appear after j!\n"); exit(1); }
+ eflag++;
+ ALLOC1
+ sprintf(temp1->line,"#define JJSTEP %d\n",counter);
+ INSERT1
+ jjstep=counter;
+ counter=1;
+ ALLOC2
+ sprintf(temp1->line,"for(jj=0;jj<%d;jj+=JJSTEP){\n",N);
+ sprintf(temp2->line,"}\n",N);
+ LINK2
+ ALLOC1
+ sprintf(temp1->line,"jt=min(jj+JJSTEP,%d);\n",N);
+ LINK1
+ break;
+ case 'i':
+ iunroll=counter;
+ counter=1;
+ iflag++; if(jflag) jiflag++;
+ if(dflag) precond=iistep%iunroll; else precond=N%iunroll;
+ if(precond&&(jiflag==0)){
+ fprintf(stderr,"unrolling factor for outer loop i\n");
+ fprintf(stderr," does not evenly divide matrix/step size!\n");
+ exit(1);
+ }
+ if(dflag&&(iunroll>1)&&(N%iistep)){
+ fprintf(stderr,"with unrolling of i, step size for tiled loop ii\n");
+ fprintf(stderr," does not evenly divide matrix size!\n");
+ exit(1);
+ }
+ processloop('i',dflag,iunroll,precond,junroll);
+ break;
+ case 'j':
+ junroll=counter;
+ counter=1;
+ jflag++; if(iflag) ijflag++;
+ if(eflag) precond=jjstep%junroll; else precond=N%junroll;
+ if(precond&&(ijflag==0)){
+ fprintf(stderr,"unrolling factor for outer loop j\n");
+ fprintf(stderr," does not evenly divide matrix/step size!\n");
+ exit(1);
+ }
+ if(eflag&&(junroll>1)&&(N%jjstep)){
+ fprintf(stderr,"with unrolling of j, step size for tiled loop jj\n");
+ fprintf(stderr," does not evenly divide matrix size!\n");
+ exit(1);
+ }
+ processloop('j',eflag,junroll,precond,iunroll);
+ break;
+ default: break;
+ }
+ }
+ processstmt();
+
+ tptype[ttp++]=c;
+
+ if((iflag==0)||(jflag==0)){
+ fprintf(stderr,
+ "one of the loops (i,j) was not specified!\n");
+ exit(1);
+ }
+
+ temp1=start;
+ while(temp1!=NULL){
+ printf("%s",temp1->line);
+ temp1=temp1->next;
+ }
+ printf("#include <stdio.h>\n");
+ printf("#include <sys/time.h>\n");
+ printf("#include <sys/resource.h>\n");
+ if(dflag|eflag) printf("#define min(a,b) ((a)<=(b)?(a):(b))\n");
+ printf("double second();\n");
+ printf("double t_start,t_end,t_total;\n");
+ printf("int times;\n");
+ printf("\ndouble b[%d][%d],dummy[10000],bt[%d][%d];\n\nmain(){\n"
+ ,N,N,N,N);
+ if(precond) printf(" int i,j,n;\n"); else printf(" int i,j;\n");
+ if(dflag) printf(" int ii,it;\n");
+ if(eflag) printf(" int jj,jt;\n");
+ printf("/* set coefficients so that result matrix should have \n");
+ printf(" * column entries equal to column index\n");
+ printf(" */\n");
+ printf(" for (i=0;i<%d;i++){\n",N);
+ printf(" for (j=0;j<%d;j++){\n",N);
+ printf(" b[i][j] = (double) i;\n");
+ printf(" }\n");
+ printf(" }\n");
+ printf("\n t_total=0.0;\n for(times=0;times<10;times++){\n\n",N);
+ printf("/* try to flush cache */\n");
+ printf(" for(i=0;i<10000;i++){\n",N);
+ printf(" dummy[i] = 0.0;\n");
+ printf(" }\n");
+ printf("%s",head->line);
+ temp1=head->next;
+ while(temp1!=NULL){
+ for(i=0;i<temp1->indentcnt;i++) printf(" ");
+ while((p0=strstr(temp1->line,"+0"))!=NULL){
+ *p0++=' '; *p0=' ';
+ }
+ printf("%s",temp1->line);
+ temp1=temp1->next;
+ }
+ printf("\n t_total+=t_end-t_start;\n }\n");
+ printf("/* check result */\n");
+ printf(" for (j=0;j<%d;j++){\n",N);
+ printf(" for (i=0;i<%d;i++){\n",N);
+ printf(" if (bt[i][j]!=((double)j)){\n");
+ printf(" fprintf(stderr,\"error in bt[%cd][%cd]",'%','%');
+ printf("\\n\",i,j);\n");
+ printf(" fprintf(stderr,\" for %s\\n\");\n",tptype);
+ printf(" exit(1);\n");
+ printf(" }\n");
+ printf(" }\n");
+ printf(" }\n");
+ tptype[ttp]='\0';
+ printf(" printf(\"%c10.2f secs\",t_total);\n",'%');
+ printf(" printf(\" for 10 runs of %s\\n\");\n",tptype);
+ printf("}\n");
+ printf("double second(){\n");
+ printf(" void getrusage();\n");
+ printf(" struct rusage ru;\n");
+ printf(" double t;\n");
+ printf(" getrusage(RUSAGE_SELF,&ru);\n");
+ printf(" t = ((double)ru.ru_utime.tv_sec) +\n");
+ printf(" ((double)ru.ru_utime.tv_usec)/1.0e6;\n");
+ printf(" return t;\n");
+ printf("}\n");
+
+}
+
+void processloop(index,flag,unroll,precond,unroll2)
+char index;
+int flag,unroll,precond,unroll2;
+{
+ char build[80],temp[40];
+ int n;
+ if(precond){
+ ALLOC1
+ sprintf(temp1->line,"/* preconditioning loop for unrolling factor */\n");
+ LINK1
+ if(unroll2==1){
+ build[0]='\0';
+ if(flag){
+ if(index='i')
+ sprintf(temp,"n=IISTEP%c%d; ",'%',unroll);
+ else
+ sprintf(temp,"n=JJSTEP%c%d; ",'%',unroll);
+ strcat(build,temp);
+ sprintf(temp,"for(%c=%c%c;%c<%c%c+n;%c++) ",index,index,index,
+ index,index,index,index);
+ strcat(build,temp);
+ }else{
+ sprintf(temp,"n=%d%c%d; ",N,'%',unroll);
+ strcat(build,temp);
+ sprintf(temp,"for(%c=0;%c<n;%c++) ",index,index,index);
+ strcat(build,temp);
+ }
+ sprintf(temp,"bt[i][j]=b[j][i];\n");
+ strcat(build,temp);
+ ALLOC1
+ sprintf(temp1->line,"%s\n",build);
+ LINK1
+ }else{
+ if(flag){
+ ALLOC1
+ if(index=='i')
+ sprintf(temp1->line,"n=IISTEP%c%d;\n",'%',unroll);
+ else
+ sprintf(temp1->line,"n=JJSTEP%c%d;\n",'%',unroll);
+ LINK1
+ ALLOC1
+ sprintf(temp1->line,"for(%c=%c%c;%c<%c%c+n;%c++){\n",index,index,index,
+ index,index,index,index);
+ LINK1
+ }else{
+ ALLOC1
+ sprintf(temp1->line,"n=%d%c%d;\n",N,'%',unroll);
+ LINK1
+ ALLOC1
+ sprintf(temp1->line,"for(%c=0;%c<n;%c++){\n",index,index,index);
+ LINK1
+ }
+ if(index=='i'){
+ for(n=0;n<unroll2;n++){
+ ALLOC1
+ sprintf(temp1->line," bt[i][j+%d]=b[j+%d][i];\n",n,n);
+ LINK1
+ }
+ }else{
+ for(n=0;n<unroll2;n++){
+ ALLOC1
+ sprintf(temp1->line," bt[i+%d][j]=b[j][i+%d];\n",n,n);
+ LINK1
+ }
+ }
+ ALLOC1
+ sprintf(temp1->line,"}\n");
+ LINK1
+ }
+ ALLOC2
+ if(flag){
+ sprintf(temp1->line,"for(%c=%c%c+n;%c<%ct;%c+=%d){\n",index,index,index,
+ index,index,index,unroll);
+ }else{
+ sprintf(temp1->line,"for(%c=n;%c<%d;%c+=%d){\n",index,index,N,index,
+ unroll);
+ }
+ sprintf(temp2->line,"}\n",N);
+ LINK2
+ }else{
+ ALLOC2
+ if(unroll==1){
+ if(flag){
+ sprintf(temp1->line,"for(%c=%c%c;%c<%ct;%c++){\n",index,index,index,
+ index,index,index);
+ }else{
+ sprintf(temp1->line,"for(%c=0;%c<%d;%c++){\n",index,index,N,index);
+ }
+ }else{
+ if(flag){
+ sprintf(temp1->line,"for(%c=%c%c;%c<%ct;%c+=%d){\n",index,index,index,
+ index,index,index,unroll);
+ }else{
+ sprintf(temp1->line,"for(%c=0;%c<%d;%c+=%d){\n",index,index,N,index,
+ unroll);
+ }
+ }
+ sprintf(temp2->line,"}\n",N);
+ LINK2
+ }
+}
+
+void processstmt()
+{
+ int i,j;
+ for(i=0;i<iunroll;i++){
+ for(j=0;j<junroll;j++){
+ ALLOC1
+ sprintf(temp1->line,"bt[i+%d][j+%d]=b[j+%d][i+%d];\n",i,j,j,i);
+ LINK1
+ }
+ }
+}
+--
+Mark Smotherman, Computer Science Dept., Clemson University, Clemson, SC
+
+=======================================================================
+From: has (h.genceli@bre.com)
+ Subject: transpose of a nxm matrix stored in a vector !!!
+ Newsgroups: sci.math.num-analysis
+ Date: 2000/07/25
+
+
+If I have a matrix nrows x ncols, I can store it in a vector.
+so A(i,j) is really a[i*ncols+j]. So really TRANS of A
+(say B) is really is also a vector B where
+
+0<=i b[j*nrows+i] <nrows, 0<=j<ncols
+b[j*nrows+i] = a[i*ncols+j].
+
+Fine but I want to use only one array a to do this transformation.
+
+i.e a[j*nrows+i] = a[i*ncols+j]. this will itself
+erase some elements so each time a swap is necessary in a loop.
+
+temp = a[j*nrows+i]
+a[j*nrows+i] = a[i*ncols+j]
+a[i*ncols+j] = temp
+
+but still this will lose some info as it is, so indexing
+should have more intelligence in it ???? anybody
+can give me a lead here, thanks.
+
+Has
+
+ From: wei-choon ng (wng@ux8.cso.uiuc.edu)
+ Subject: Re: transpose of a nxm matrix stored in a vector !!!
+ Newsgroups: sci.math.num-analysis
+ Date: 2000/07/25
+
+
+has <h.genceli@bre.com> wrote:
+> If I have a matrix nrows x ncols, I can store it in a vector.
+> so A(i,j) is really a[i*ncols+j]. So really TRANS of A
+> (say B) is really is also a vector B where
+
+[snip]
+
+Hey, if you just want to do a transpose-matrix vector multiply, there is
+no need to explicitly store the transpose matrix in another array and
+doubling the storage!
+
+W.C.
+--
+
+ From: Robin Becker (robin@jessikat.fsnet.co.uk)
+ Subject: Re: transpose of a nxm matrix stored in a vector !!!
+ Newsgroups: sci.math.num-analysis
+ Date: 2000/07/25
+
+
+In article <snr532fo3j1180@corp.supernews.com>, has <h.genceli@bre.com>
+writes
+>If I have a matrix nrows x ncols, I can store it in a vector.
+>so A(i,j) is really a[i*ncols+j]. So really TRANS of A
+>(say B) is really is also a vector B where
+>
+>0<=i b[j*nrows+i] <nrows, 0<=j<ncols
+>b[j*nrows+i] = a[i*ncols+j].
+>
+>Fine but I want to use only one array a to do this transformation.
+>
+>i.e a[j*nrows+i] = a[i*ncols+j]. this will itself
+>erase some elements so each time a swap is necessary in a loop.
+>
+>temp = a[j*nrows+i]
+>a[j*nrows+i] = a[i*ncols+j]
+>a[i*ncols+j] = temp
+>
+>but still this will lose some info as it is, so indexing
+>should have more intelligence in it ???? anybody
+>can give me a lead here, thanks.
+>
+>Has
+>
+>
+>
+
+void dmx_transpose(unsigned n, unsigned m, double* a, double* b)
+{
+ unsigned size = m*n;
+ if(b!=a){
+ real *bmn, *aij, *anm;
+ bmn = b + size; /*b+n*m*/
+ anm = a + size;
+ while(b<bmn) for(aij=a++;aij<anm; aij+=n ) *b++ = *aij;
+ }
+ else if(size>3){
+ unsigned i,row,column,current;
+ for(i=1, size -= 2;i<size;i++){
+ current = i;
+ do {
+ /*current = row+n*column*/
+ column = current/m;
+ row = current%m;
+ current = n*row + column;
+ } while(current < i);
+
+ if (current >i) {
+ real temp = a[i];
+ a[i] = a[current];
+ a[current] = temp;
+ }
+ }
+ }
+}
+--
+Robin Becker
+
+ From: E. Robert Tisdale (edwin@netwood.net)
+ Subject: Re: transpose of a nxm matrix stored in a vector !!!
+ Newsgroups: sci.math.num-analysis
+ Date: 2000/07/25
+
+
+Take a look at
+The C++ Scalar, Vector, Matrix and Tensor class library
+
+ http://www.netwood.net/~edwin/svmt/
+
+<Type><System>SubVector&
+ <Type><System>SubVector::transpose(Extent p, Extent q) {
+ <Type><System>SubVector&
+ v = *this;
+ if (1 < p && 1 < q) {
+ // A vector v of extent n = qp is viewed as a q by p matrix U and
+ // a p by q matrix V where U_{ij} = v_{p*i+j} and V_{ij} = v_{q*i+j}.
+ // The vector v is modified in-place so that V is the transpose of U.
+ // The algorithm searches for every sequence k_s of S indices
+ // such that a circular shift of elements v_{k_s} <-- v_{k_{s+1}}
+ // and v_{k_{S-1}} <-- v_{k_0} effects an in-place transpose.
+ Extent n = q*p;
+ Extent m = 0; // count up to n-2
+ Offset l = 0; // 1 <= l <= n-2
+ while (++l < n-1 && m < n-2) {
+ Offset k = l;
+ Offset j = k;
+ while (l < (k = (j%p)*q + j/p)) { // Search backward for k < l.
+ j = k;
+ }
+ // If a sequence of indices beginning with l has any index k < l,
+ // it has already been transposed. The sequence length S = 1
+ // and diagonal element v_k is its own transpose if k = j.
+ // Skip every index sequence that has already been transposed.
+ if (k == l) { // a new sequence
+ if (k < j) { // with 1 < S
+ TYPE x = v[k]; // save v_{k_0}
+ do {
+ v[k] = v[j]; // v_{k_{s}} <-- v_{k_{s+1}}
+ k = j;
+ ++m;
+ } while (l < (j = (k%q)*p + k/q));
+ v[k] = x; // v_{k_{S-1}} <-- v_{k_0}
+ }
+ ++m;
+ }
+ }
+ } return v;
+ }
+
+
+
+<Type><System>SubVector&
+
+Read the rest of this message... (50 more lines)
+
+ From: Victor Eijkhout (eijkhout@disco.cs.utk.edu)
+ Subject: Re: transpose of a nxm matrix stored in a vector !!!
+ Newsgroups: sci.math.num-analysis
+ Date: 2000/07/25
+
+
+"Alan Miller" <amiller @ vic.bigpond.net.au> writes:
+
+> The attached routine does an in situ transpose.
+> begin 666 Dtip.f90
+> M4U5"4D]55$E.12!D=&EP("AA+"!N,2P@;C(L(&YD:6TI#0HA("TM+2TM+2TM
+
+Hm. F90? You're not silently allocating a temporary I hope?
+
+(Why did you have to encode this? Now I have to save, this decode, ...
+and all for plain ascii?)
+
+--
+Victor Eijkhout
+"When I was coming up, [..] we knew exactly who the they were. It was us
+versus them, and it was clear who the them was were. Today, we are not
+so sure who the they are, but we know they're there." [G.W. Bush]
+
+ From: Alan Miller (amiller_@_vic.bigpond.net.au)
+ Subject: Re: transpose of a nxm matrix stored in a vector !!!
+ Newsgroups: sci.math.num-analysis
+ Date: 2000/07/25
+
+
+Victor Eijkhout wrote in message ...
+>"Alan Miller" <amiller @ vic.bigpond.net.au> writes:
+>
+>> The attached routine does an in situ transpose.
+>> begin 666 Dtip.f90
+>> M4U5"4D]55$E.12!D=&EP("AA+"!N,2P@;C(L(&YD:6TI#0HA("TM+2TM+2TM
+>
+>Hm. F90? You're not silently allocating a temporary I hope?
+>
+>(Why did you have to encode this? Now I have to save, this decode, ...
+>and all for plain ascii?)
+>
+
+I know the problem.
+I sometimes use a Unix system, and have to use decode64 to read
+attachments. On the other hand, Windows wraps lines around,
+formats then and generally makes the code unreadable.
+
+The straight code for dtip (double transpose in place) is attached
+this time.
+
+>--
+>Victor Eijkhout
+
+
+--
+Alan Miller, Retired Scientist (Statistician)
+CSIRO Mathematical & Information Sciences
+Alan.Miller -at- vic.cmis.csiro.au
+http://www.ozemail.com.au/~milleraj
+http://users.bigpond.net.au/amiller/
+
+
+=================================================================
+
+From: Darran Edmundson (dedmunds@sfu.ca)
+ Subject: array reordering algorithm?
+ Newsgroups: sci.math.num-analysis
+ Date: 1995/04/30
+
+
+A code I've written refers to a complex array as two separate real arrays.
+However, I have a canned subroutine which expects a single array where the
+real and imaginary values alternate. Essentially I have a case of mismatched
+data structures, yet for reasons that I'd rather not go into, I'm stuck with them.
+
+Assuming that the two real arrays A and B are sequential in memory, and
+that the single array of alternating real/imaginary values C shares the same
+space, what I need is a porting subroutine that remaps the data from one format
+to the other - using as little space as possible.
+
+I think of the problem as follows. Imagine an array of dimension 10 containing
+the values 1,3,5,7,9,2,4,6,8,10 in this order.
+
+ A(1) / 1 \ C(1)
+ A(2) | 3 | C(2)
+ A(3) | 5 | C(3)
+ A(4) | 7 | C(4)
+ A(5) \ 9 | C(5)
+ |
+ B(1) / 2 | C(6)
+ B(2) | 4 | C(7)
+ B(3) | 6 | C(8)
+ B(4) | 8 | C(9)
+ B(5) \ 10 / C(10)
+
+Given that I know this initial pattern, I want to sort the array C in-place *without
+making comparisons*. That is, the algorithm can only depend on the initial
+knowledge of the pattern. Do you see what a sort is going to do? It will
+make the A and B arrays alternate, i.e. C(1)=A(1), C(2)=B(1), C(3)=A(2),
+C(4)=B(2), etc. It's not a real sort though because I can't actually refer to the
+values above (i.e. no comparisons) because A and B will be holding real data,
+not this contrived pattern. The pattern above exists though - it's the
+natural ordering in memory of A and B.
+
+Either pair swapping only or a small amount of workspace can be used. The
+in-place is important - imagine scaling this problem up to an
+array of 32 or 64 million double precision values and you can easily see how
+duplicating the array is not a feasible solution.
+
+Any ideas? I've been stumped on this for a day and a half now.
+
+Darran Edmundson
+dedmunds@sfu.ca
+
+ From: Roger Critchlow (rec@elf115.elf.org)
+ Subject: Re: array reordering algorithm?
+ Newsgroups: sci.math.num-analysis
+ Date: 1995/04/30
+
+
+ Any ideas? I've been stumped on this for a day and a half now.
+
+Here's some code for in situ permutations of arrays that I wrote
+a few years ago. It all started from the in situ transposition
+algorithms in the Collected Algorithms of the ACM, the references
+for which always get lost during the decryption from fortran.
+
+This is the minimum space algorithm. All you need to supply is
+a function which computes the new order array index from the old
+order array index.
+
+If you can spare n*m bits to record the indexes of elements which
+have been permuted, then you can speed things up.
+
+-- rec --
+
+------------------------------------------------------------------------
+/*
+** Arbitrary in situ permutations of an m by n array of base type TYPE.
+** Copyright 1995 by Roger E Critchlow Jr, rec@elf.org, San Francisco, CA.
+** Fair use permitted, caveat emptor.
+*/
+typedef int TYPE;
+
+int transposition(int ij, int m, int n) /* transposition about diagonal from upper left to lower right */
+{ return ((ij%m)*n+ (ij/m)); }
+
+int countertrans(int ij, int m, int n) /* transposition about diagonal from upper right to lower left */
+{ return ((m-1-(ij%m))*n+ (n-1-(ij/m))); }
+
+int rotate90cw(int ij, int m, int n) /* 90 degree clockwise rotation */
+{ return ((m-1-(ij%m))*n+ (ij/m)); }
+
+int rotate90ccw(int ij, int m, int n) /* 90 degree counter clockwise rotation */
+{ return ((ij%m)*n+ (n-1-(ij/m))); }
+
+int rotate180(int ij, int m, int n) /* 180 degree rotation */
+{ return ((m-1-(ij/n))*n+ (n-1-(ij%n))); }
+
+int reflecth(int ij, int m, int n) /* reflection across horizontal plane */
+{ return ((m-1-(ij/n))*n+ (ij%n)); }
+
+int reflectv(int ij, int m, int n) /* reflection across vertical plane */
+{ return ((ij/n)*n+ (n-1-(ij%n))); }
+
+int in_situ_permutation(TYPE a[], int m, int n, int (*origination)(int ij, int m, int n))
+{
+ int ij, oij, dij, n_to_do;
+ TYPE b;
+ n_to_do = m*n;
+ for (ij = 0; ij < m*n && n_to_do > 0; ij += 1) {
+ /* Test for previously permuted */
+ for (oij = origination(ij,m,n); oij > ij; oij = origination(oij,m,n))
+ ;
+ if (oij < ij)
+ continue;
+ /* Chase the cycle */
+ dij = ij;
+ b = a[ij];
+ for (oij = origination(dij,m,n); oij != ij; oij = origination(dij,m,n)) {
+ a[dij] = a[oij];
+ dij = oij;
+ n_to_do -= 1;
+ }
+ a[dij] = b;
+ n_to_do -= 1;
+ } return 0;
+}
+
+#define TESTING 1
+#if TESTING
+
+/* fill a matrix with sequential numbers, row major ordering */
+void fill_matrix_rows(a, m, n) TYPE *a; int m, n;
+{
+ int i, j;
+ for (i = 0; i < m; i += 1)
+ for (j = 0; j < n; j += 1)
+ a[i*n+j] = i*n+j;
+}
+
+/* fill a matrix with sequential numbers, column major ordering */
+void fill_matrix_cols(a, m, n) TYPE *a; int m, n;
+{
+ int i, j;
+ for (i = 0; i < m; i += 1)
+ for (j = 0; j < n; j += 1)
+ a[i*n+j] = j*m+i;
+}
+
+/* test a matrix for sequential numbers, row major ordering */
+int test_matrix_rows(a, m, n) TYPE *a; int m, n;
+{
+ int i, j, o;
+ for (o = i = 0; i < m; i += 1)
+ for (j = 0; j < n; j += 1)
+ o += a[i*n+j] != i*n+j;
+ return o;
+}
+
+/* test a matrix for sequential numbers, column major ordering */
+int test_matrix_cols(a, m, n) TYPE *a; int m, n;
+{
+ int i, j, o;
+ for (o = i = 0; i < m; i += 1)
+ for (j = 0; j < n; j += 1)
+ o += a[i*n+j] != j*m+i;
+ return o;
+}
+
+/* print a matrix */
+void print_matrix(a, m, n) TYPE *a; int m, n;
+{
+ char *format;
+ int i, j;
+ if (m*n < 10) format = "%2d";
+ if (m*n < 100) format = "%3d";
+ if (m*n < 1000) format = "%4d";
+ if (m*n < 10000) format = "%5d";
+ for (i = 0; i < m; i += 1) {
+ for (j = 0; j < n; j += 1)
+ printf(format, a[i*n+j]);
+ printf("\n");
+ }
+}
+
+#if TEST_TRANSPOSE
+#define MAXSIZE 1000
+
+main()
+{
+ int i, j, m, n, o;
+ TYPE a[MAXSIZE];
+ for (m = 1; m < sizeof(a)/sizeof(a[0]); m += 1)
+ for (n = 1; m*n < sizeof(a)/sizeof(a[0]); n += 1) {
+ fill_matrix_rows(a, m, n); /* {0 1} {2 3} */
+ if (o = transpose(a, m, n))
+ printf(">> transpose returned %d for a[%d][%d], row major\n", o, m, n);
+ if ((o = test_matrix_cols(a, n, m)) != 0) /* {0 2} {1 3} */
+ printf(">> transpose made %d mistakes for a[%d][%d], row major\n", o, m, n);
+ /* column major */
+ fill_matrix_rows(a, m, n);
+ if (o = transpose(a, m, n))
+ printf(">> transpose returned %d for a[%d][%d], column major\n", o, m, n);
+ if ((o = test_matrix_cols(a, n, m)) != 0)
+ printf(">> transpose made %d mistakes for a[%d][%d], column major\n", o, m, n);
+ } return 0;
+}
+#endif /* TEST_TRANSPOSE */
+
+
+#define TEST_DISPLAY 1
+#if TEST_DISPLAY
+main(argc, argv) int argc; char *argv[];
+{
+ TYPE *a;
+ int m = 5, n = 5;
+ extern void *malloc();
+ if (argc > 1) {
+ m = atoi(argv[1]);
+ if (argc > 2)
+ n = atoi(argv[2]);
+ }
+ a = malloc(m*n*sizeof(TYPE));
+
+ printf("matrix\n");
+ fill_matrix_rows(a, m, n);
+ print_matrix(a, m, n);
+ printf("transposition\n");
+ in_situ_permutation(a, m, n, transposition);
+ print_matrix(a, n, m);
+
+ printf("counter transposition\n");
+ fill_matrix_rows(a, m, n);
+ in_situ_permutation(a, m, n, countertrans);
+ print_matrix(a, n, m);
+
+ printf("rotate 90 degrees clockwise\n");
+ fill_matrix_rows(a, m, n);
+ in_situ_permutation(a, m, n, rotate90cw);
+ print_matrix(a, n, m);
+
+ printf("rotate 90 degrees counterclockwise\n");
+ fill_matrix_rows(a, m, n);
+ in_situ_permutation(a, m, n, rotate90ccw);
+ print_matrix(a, n, m);
+
+ printf("rotate 180 degrees\n");
+ fill_matrix_rows(a, m, n);
+ in_situ_permutation(a, m, n, rotate180);
+ print_matrix(a, m, n);
+
+ printf("reflect across horizontal\n");
+ fill_matrix_rows(a, m, n);
+ in_situ_permutation(a, m, n, reflecth);
+ print_matrix(a, m, n);
+
+ printf("reflect across vertical\n");
+ fill_matrix_rows(a, m, n);
+ in_situ_permutation(a, m, n, reflectv);
+ print_matrix(a, m, n);
+
+ return 0;
+}
+
+#endif
+#endif
+
diff --git a/numpy/f2py/doc/multiarrays.txt b/numpy/f2py/doc/multiarrays.txt
new file mode 100644
index 000000000..704208976
--- /dev/null
+++ b/numpy/f2py/doc/multiarrays.txt
@@ -0,0 +1,120 @@
+From pearu@ioc.ee Thu Dec 30 09:58:01 1999
+Date: Fri, 26 Nov 1999 12:02:42 +0200 (EET)
+From: Pearu Peterson <pearu@ioc.ee>
+To: Users of f2py2e -- Curtis Jensen <cjensen@be-research.ucsd.edu>,
+ Vladimir Janku <vjanku@kvet.sk>,
+ Travis Oliphant <Oliphant.Travis@mayo.edu>
+Subject: Multidimensional arrays in f2py2e
+
+
+Hi!
+
+Below I will describe how f2py2e wraps Fortran multidimensional arrays as
+it constantly causes confusion. As for example, consider Fortran code
+
+ subroutine foo(l,m,n,a)
+ integer l,m,n
+ real*8 a(l,m,n)
+ ..
+ end
+Running f2py2e with -h flag, it generates the following signature
+
+subroutine foo(l,m,n,a)
+ integer optional,check(shape(a,2)==l),depend(a) :: l=shape(a,2)
+ integer optional,check(shape(a,1)==m),depend(a) :: m=shape(a,1)
+ integer optional,check(shape(a,0)==n),depend(a) :: n=shape(a,0)
+ real*8 dimension(l,m,n),check(rank(a)==3) :: a
+end subroutine foo
+
+where parameters l,m,n are considered optional and they are initialized in
+Python C/API code using the array a. Note that a can be also a proper
+list, that is, asarray(a) should result in a rank-3 array. But then there
+is an automatic restriction that elements of a (in Python) are not
+changeable (in place) even if Fortran subroutine changes the array a (in
+C,Fortran).
+
+Hint: you can attribute the array a with 'intent(out)' which causes foo to
+return the array a (in Python) if you are to lazy to define a=asarray(a)
+before the call to foo (in Python).
+
+Calling f2py2e without the switch -h, a Python C/API module will be
+generated. After compiling it and importing it to Python
+>>> print foo.__doc__
+shows
+None = foo(a,l=shape(a,2),m=shape(a,1),n=shape(a,0))
+
+You will notice that f2py2e has changed the order of arguments putting the
+optional ones at the end of the argument list.
+Now, you have to be careful when specifying the parameters l,m,n (though
+situations where you need this should be rare). A proper definition
+of the array a should be, say
+
+ a = zeros(n,m,l)
+
+Note that the dimensions l,m,n are in reverse, that is, the array a should
+be transposed when feeding it to the wrapper.
+
+Hint (and a performance hit): To be always consistent with fortran
+arrays, you can define, for example
+ a = zeros(l,m,n)
+and call from Python
+ foo(transpose(a),l,m,n)
+which is equivalent with the given Fortran call
+ call foo(l,m,n,a)
+
+Another hint (not recommended, though): If you don't like optional
+arguments feature at all and want to be strictly consistent with Fortran
+signature, that is, you want to call foo from Python as
+ foo(l,m,n,a)
+then you should edit the signature to
+subroutine foo(l,m,n,a)
+ integer :: l
+ integer :: m
+ integer :: n
+ real*8 dimension(l,m,n),check(rank(a)==3),depend(l,m,n), &
+ check(shape(a,2)==l,shape(a,1)==m,shape(a,0)==n):: a
+end
+Important! Note that now the array a should depend on l,m,n
+so that the checks can be performed in the proper order.
+(you cannot check, say, shape(a,2)==l before initializing a or l)
+(There are other ways to edit the signature in order to get the same
+effect but they are not so safe and I will not discuss about them here).
+
+Hint: If the array a should be a work array (as used frequently in
+Fortran) and you a too lazy (its good lazyness;) to provide it (in Python)
+then you can define it as optional by ediding the signature:
+subroutine foo(l,m,n,a)
+ integer :: l
+ integer :: m
+ integer :: n
+ real*8 dimension(l,m,n),check(rank(a)==3),depend(l,m,n), &
+ check(shape(a,2)==l,shape(a,1)==m,shape(a,0)==n):: a
+ optional a
+end
+Note again that the array a must depend on l,m,n. Then the array a will be
+allocated in the Python C/API module. Not also that
+>>> print foo.__doc__
+shows then
+None = foo(l,m,n,a=)
+Performance hint: If you call the given foo lots of times from Python then
+you don't want to allocate/deallocate the memory in each call. So, it is
+then recommended to define a temporary array in Python, for instance
+>>> tmp = zeros(n,m,l)
+>>> for i in ...:
+>>> foo(l,m,n,a=tmp)
+
+Important! It is not good at all to define
+ >>> tmp = transpose(zeros(l,m,n))
+because tmp will be then a noncontiguous array and there will be a
+huge performance hit as in Python C/API a new array will be allocated and
+also a copying of arrays will be performed elementwise!
+But
+ >>> tmp = asarray(transpose(zeros(l,m,n)))
+is still ok.
+
+I hope that the above answers lots of your (possible) questions about
+wrapping Fortran multidimensional arrays with f2py2e.
+
+Regards,
+ Pearu
+
diff --git a/numpy/f2py/doc/notes.tex b/numpy/f2py/doc/notes.tex
new file mode 100644
index 000000000..2746b049d
--- /dev/null
+++ b/numpy/f2py/doc/notes.tex
@@ -0,0 +1,310 @@
+
+\section{Calling wrapper functions from Python}
+\label{sec:notes}
+
+\subsection{Scalar arguments}
+\label{sec:scalars}
+
+In general, for scalar argument you can pass in in
+addition to ordinary Python scalars (like integers, floats, complex
+values) also arbitrary sequence objects (lists, arrays, strings) ---
+then the first element of a sequence is passed in to the Fortran routine.
+
+It is recommended that you always pass in scalars of required type. This
+ensures the correctness as no type-casting is needed.
+However, no exception is raised if type-casting would produce
+inaccurate or incorrect results! For example, in place of an expected
+complex value you can give an integer, or vice-versa (in the latter case only
+a rounded real part of the complex value will be used).
+
+If the argument is \texttt{intent(inout)} then Fortran routine can change the
+value ``in place'' only if you pass in a sequence object, for
+instance, rank-0 array. Also make sure that the type of an array is of
+correct type. Otherwise type-casting will be performed and you may
+get inaccurate or incorrect results. The following example illustrates this
+\begin{verbatim}
+>>> a = array(0)
+>>> calculate_pi(a)
+>>> print a
+3
+\end{verbatim}
+
+If you pass in an ordinary Python scalar in place of
+\texttt{intent(inout)} variable, it will be used as an input argument
+since
+Python
+scalars cannot not be changed ``in place'' (all Python scalars
+are immutable objects).
+
+\subsection{String arguments}
+\label{sec:strings}
+
+You can pass in strings of arbitrary length. If the length is greater than
+required, only a required part of the string is used. If the length
+is smaller than required, additional memory is allocated and fulfilled
+with `\texttt{\bs0}'s.
+
+Because Python strings are immutable, \texttt{intent(inout)} argument
+expects an array version of a string --- an array of chars:
+\texttt{array("<string>")}.
+Otherwise, the change ``in place'' has no effect.
+
+
+\subsection{Array arguments}
+\label{sec:arrays}
+
+If the size of an array is relatively large, it is \emph{highly
+ recommended} that you pass in arrays of required type. Otherwise,
+type-casting will be performed which includes the creation of new
+arrays and their copying. If the argument is also
+\texttt{intent(inout)}, the wasted time is doubled. So, pass in arrays
+of required type!
+
+On the other hand, there are situations where it is perfectly all
+right to ignore this recommendation: if the size of an array is
+relatively small or the actual time spent in Fortran routine takes
+much longer than copying an array. Anyway, if you want to optimize
+your Python code, start using arrays of required types.
+
+Another source of performance hit is when you use non-contiguous
+arrays. The performance hit will be exactly the same as when using
+incorrect array types. This is because a contiguous copy is created
+to be passed in to the Fortran routine.
+
+\fpy provides a feature such that the ranks of array arguments need
+not to match --- only the correct total size matters. For example, if
+the wrapper function expects a rank-1 array \texttt{array([...])},
+then it is correct to pass in rank-2 (or higher) arrays
+\texttt{array([[...],...,[...]])} assuming that the sizes will match.
+This is especially useful when the arrays should contain only one
+element (size is 1). Then you can pass in arrays \texttt{array(0)},
+\texttt{array([0])}, \texttt{array([[0]])}, etc and all cases are
+handled correctly. In this case it is correct to pass in a Python
+scalar in place of an array (but then ``change in place'' is ignored,
+of course).
+
+\subsubsection{Multidimensional arrays}
+
+If you are using rank-2 or higher rank arrays, you must always
+remember that indexing in Fortran starts from the lowest dimension
+while in Python (and in C) the indexing starts from the highest
+dimension (though some compilers have switches to change this). As a
+result, if you pass in a 2-dimensional array then the Fortran routine
+sees it as the transposed version of the array (in multi-dimensional
+case the indexes are reversed).
+
+You must take this matter into account also when modifying the
+signature file and interpreting the generated Python signatures:
+
+\begin{itemize}
+\item First, when initializing an array using \texttt{init\_expr}, the index
+vector \texttt{\_i[]} changes accordingly to Fortran convention.
+\item Second, the result of CPP-macro \texttt{shape(<array>,0)}
+ corresponds to the last dimension of the Fortran array, etc.
+\end{itemize}
+Let me illustrate this with the following example:\\
+\begin{verbatim}
+! Fortran file: arr.f
+ subroutine arr(l,m,n,a)
+ integer l,m,n
+ real*8 a(l,m,n)
+ ...
+ end
+\end{verbatim}
+\fpy will generate the following signature file:\\
+\begin{verbatim}
+!%f90
+! Signature file: arr.f90
+python module arr ! in
+ interface ! in :arr
+ subroutine arr(l,m,n,a) ! in :arr:arr.f
+ integer optional,check(shape(a,2)==l),depend(a) :: l=shape(a,2)
+ integer optional,check(shape(a,1)==m),depend(a) :: m=shape(a,1)
+ integer optional,check(shape(a,0)==n),depend(a) :: n=shape(a,0)
+ real*8 dimension(l,m,n) :: a
+ end subroutine arr
+ end interface
+end python module arr
+\end{verbatim}
+and the following wrapper function will be produced
+\begin{verbatim}
+None = arr(a,l=shape(a,2),m=shape(a,1),n=shape(a,0))
+\end{verbatim}
+
+In general, I would suggest not to specify the given optional
+variables \texttt{l,m,n} when calling the wrapper function --- let the
+interface find the values of the variables \texttt{l,m,n}. But there
+are occasions when you need to specify the dimensions in Python.
+
+So, in Python a proper way to create an array from the given
+dimensions is
+\begin{verbatim}
+>>> a = zeros(n,m,l,'d')
+\end{verbatim}
+(note that the dimensions are reversed and correct type is specified),
+and then a complete call to \texttt{arr} is
+\begin{verbatim}
+>>> arr(a,l,m,n)
+\end{verbatim}
+
+From the performance point of view, always be consistent with Fortran
+indexing convention, that is, use transposed arrays. But if you do the
+following
+\begin{verbatim}
+>>> a = transpose(zeros(l,m,n,'d'))
+>>> arr(a)
+\end{verbatim}
+then you will get a performance hit! The reason is that here the
+transposition is not actually performed. Instead, the array \texttt{a}
+will be non-contiguous which means that before calling a Fortran
+routine, internally a contiguous array is created which
+includes memory allocation and copying. In addition, if
+the argument array is also \texttt{intent(inout)}, the results are
+copied back to the initial array which doubles the
+performance hit!
+
+So, to improve the performance: always pass in
+arrays that are contiguous.
+
+\subsubsection{Work arrays}
+
+Often Fortran routines use the so-called work arrays. The
+corresponding arguments can be declared as optional arguments, but be
+sure that all dimensions are specified (bounded) and defined before
+the initialization (dependence relations).
+
+On the other hand, if you call the Fortran routine many times then you
+don't want to allocate/deallocate the memory of the work arrays on
+every call. In this case it is recommended that you create temporary
+arrays with proper sizes in Python and use them as work arrays. But be
+careful when specifying the required type and be sure that the
+temporary arrays are contiguous. Otherwise the performance hit would
+be even harder than the hit when not using the temporary arrays from
+Python!
+
+
+
+\subsection{Call-back arguments}
+\label{sec:cbargs}
+
+\fpy builds a very flexible call-back mechanisms for call-back
+arguments. If the wrapper function expects a call-back function \texttt{fun}
+with the following Python signature to be passed in
+\begin{verbatim}
+def fun(a_1,...,a_n):
+ ...
+ return x_1,...,x_k
+\end{verbatim}
+but the user passes in a function \texttt{gun} with the signature
+\begin{verbatim}
+def gun(b_1,...,b_m):
+ ...
+ return y_1,...,y_l
+\end{verbatim}
+and the following extra arguments (specified as additional optional
+argument for the wrapper function):
+\begin{verbatim}
+fun_extra_args = (e_1,...,e_p)
+\end{verbatim}
+then the actual call-back is constructed accordingly to the following rules:
+\begin{itemize}
+\item if \texttt{p==0} then \texttt{gun(a\_1,...,a\_q)}, where
+ \texttt{q=min(m,n)};
+\item if \texttt{n+p<=m} then \texttt{gun(a\_1,...,a\_n,e\_1,...,e\_p)};
+\item if \texttt{p<=m<n+p} then \texttt{gun(a\_1,...,a\_q,e\_1,...,e\_p)},
+ where \texttt{q=m-p};
+\item if \texttt{p>m} then \texttt{gun(e\_1,...,e\_m)};
+\item if \texttt{n+p} is less than the number of required arguments
+ of the function \texttt{gun}, an exception is raised.
+\end{itemize}
+
+A call-back function \texttt{gun} may return any number of objects as a tuple:
+if \texttt{k<l}, then objects \texttt{y\_k+1,...,y\_l} are ignored;
+if \texttt{k>l}, then only objects \texttt{x\_1,...,x\_l} are set.
+
+
+\subsection{Obtaining information on wrapper functions}
+\label{sec:info}
+
+From the previous sections we learned that it is useful for the
+performance to pass in arguments of expected type, if possible. To
+know what are the expected types, \fpy generates a complete
+documentation strings for all wrapper functions. You can read them
+from Python by printing out \texttt{\_\_doc\_\_} attributes of the
+wrapper functions. For the example in Sec.~\ref{sec:intro}:
+\begin{verbatim}
+>>> print foobar.foo.__doc__
+Function signature:
+ foo(a)
+Required arguments:
+ a : in/output rank-0 array(int,'i')
+>>> print foobar.bar.__doc__
+Function signature:
+ bar = bar(a,b)
+Required arguments:
+ a : input int
+ b : input int
+Return objects:
+ bar : int
+\end{verbatim}
+
+In addition, \fpy generates a LaTeX document
+(\texttt{<modulename>module.tex}) containing a bit more information on
+the wrapper functions. See for example Appendix that contains a result
+of the documentation generation for the example module
+\texttt{foobar}. Here the file \texttt{foobar-smart.f90} (modified
+version of \texttt{foobar.f90}) is used --- it contains
+\texttt{note(<LaTeX text>)} attributes for specifying some additional
+information.
+
+\subsection{Wrappers for common blocks}
+\label{sec:wrapcomblock}
+
+[See examples \texttt{test-site/e/runme*}]
+
+What follows is obsolute for \fpy version higher that 2.264.
+
+\fpy generates wrapper functions for common blocks. For every common
+block with a name \texttt{<commonname>} a function
+\texttt{get\_<commonname>()} is constructed that takes no arguments
+and returns a dictionary. The dictionary represents maps between the
+names of common block fields and the arrays containing the common
+block fields (multi-dimensional arrays are transposed). So, in order
+to access to the common block fields, you must first obtain the
+references
+\begin{verbatim}
+commonblock = get_<commonname>()
+\end{verbatim}
+and then the fields are available through the arrays
+\texttt{commonblock["<fieldname>"]}.
+To change the values of common block fields, you can use for scalars
+\begin{verbatim}
+commonblock["<fieldname>"][0] = <new value>
+\end{verbatim}
+and for arrays
+\begin{verbatim}
+commonblock["<fieldname>"][:] = <new array>
+\end{verbatim}
+for example.
+
+For more information on the particular common block wrapping, see
+\texttt{get\_<commonname>.\_\_doc\_\_}.
+
+\subsection{Wrappers for F90/95 module data and routines}
+\label{sec:wrapf90modules}
+
+[See example \texttt{test-site/mod/runme\_mod}]
+
+\subsection{Examples}
+\label{sec:examples}
+
+Examples on various aspects of wrapping Fortran routines to Python can
+be found in directories \texttt{test-site/d/} and
+\texttt{test-site/e/}: study the shell scripts \texttt{runme\_*}. See
+also files in \texttt{doc/ex1/}.
+
+
+%%% Local Variables:
+%%% mode: latex
+%%% TeX-master: "f2py2e"
+%%% End:
diff --git a/numpy/f2py/doc/oldnews.html b/numpy/f2py/doc/oldnews.html
new file mode 100644
index 000000000..0e09c032f
--- /dev/null
+++ b/numpy/f2py/doc/oldnews.html
@@ -0,0 +1,121 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+<META name="Author" content="Pearu Peterson">
+<!-- You may add here some keywords (comma separeted list) -->
+<META name="Keywords" content="fortran,python,interface,f2py,f2py2e,wrapper,fpig">
+<TITLE>F2PY - Fortran to Python Interface Generator</TITLE>
+<LINK rel="stylesheet" type="text/css" href="/styles/userstyle.css">
+</HEAD>
+
+<body>
+<h2><a href="http://cens.ioc.ee/projects/f2py2e">F2PY</a> old news.</h2>
+
+<dl>
+ <dt> February 23, 2002
+ <dd> Fixed a bug of incorrect shapes of multi-dimensional arrays
+ when returning from Fortran routine (thanks to Eric for pointing
+ this out).
+ <code>F2PY_REPORT_ATEXIT</code> is disabled by default under Win32.
+ <dt> February 14, 2002
+ <dd> Introduced <code>callprotoargument</code> statement so that
+ proper prototypes can be specified (this fixes SEGFAULTs when
+ wrapping C functions with <code>f2py</code>, see <a
+ href="NEWS.txt">NEWS.txt</a> for more details). Updated for the
+ latest <code>numpy_distutils</code>. Fixed few bugs.
+ <dt> February 3, 2002
+ <dd> Introduced <code>intent(overwrite),intent(out=name)</code>
+ attributes, <code>callstatement C-expr;</code> statement, and
+ reviewed reference counting in callback mechanism. Fixed bugs.
+ <dt> January 18, 2002
+ <dd> Introduced extra keyword argument <code>copy_#varname#=1</code>
+ for <code>intent(copy)</code> variables,
+ <code>-DF2PY_REPORT_ATEXIT</code> for reporting <code>f2py</code>
+ performance,
+ <code>has_column_major_storage</code> member function for generated
+ modules, and <a href="http://dmalloc.com/">dmalloc</a> support.
+ <dt> January 16, 2002
+ <dd> BREAKING NEWS! Solved long lasted dilemma of wrapping
+ multi-dimensional arrays where different
+ storage orders in C and Fortran come into account. From now on
+ this difference is dealt automatically by the f2py generated
+ module and in a very efficient way. For example, the corresponding
+ element A(i,j) of a Fortran array can be accessed in Python as
+ A[i,j].
+ <dt> January 13, 2002
+ <dd> Fifth Public Release is coming soon..., a snapshot is available
+ for download, now with updates.
+ <dt> December 17, 2001
+ <dd> <a href="Release-4.x.txt">Fourth Public Release</a>: Win32 support.
+ <dd> Making <code>f2py2e</code> a module. Currently it has only one
+ member function <code>run_main(comline_list)</code>.
+ <dd> Removed command line arguments <code>-fix,-f90,-f77</code>
+ and introduced many new ones. See <a href="NEWS.txt">NEWS.txt</a>.
+ <dd> <code>intent(..)</code> statement with empty name list defines
+ default <code>intent(..)</code> attribute for all routine arguments.
+ <dd> Refinements in Win32 support. Eric Jones has provided a f2py
+ HOWTO for Windows users. See <a href="win32_notes.txt">win32_notes.txt</a>.
+ <dd> Major rewrote of the code generator to achieve
+ a higher quality of generated C/API modules (-Wall messages are
+ considerably reduced, especially for callback functions).
+ <dd> Many bugs were fixed.
+ <dt> December 12, 2001
+ <dd> Win32 support (thanks to Eric Jones and Tiffany Kamm). Minor
+ cleanups and fixes.
+ <dt> December 4, 2001
+ <dd> <a href="Release-3.x.txt">Third Public Release</a>: <code>f2py</code> supports <code>distutils</code>. It can be
+ installed with one and it generates <code>setup_modulename.py</code>
+ to be used for building Python extension modules.
+ <dd> Introduced <code>threadsafe</code>, <code>fortranname</code>,
+ and <code>intent(c)</code> statements.
+ <dt> August 13, 2001
+ <dd> Changed the name FPIG to F2PY for avoiding confusion with project names.
+ <dd> Updated <code>f2py</code> for use with Numeric version 20.x.
+ <dt> January 12, 2001
+ <dd> Example usages of <a href="pyfobj.html"><code>PyFortranObject</code></a>.
+ Fixed bugs. Updated the
+ <a href="f2python9.html">Python 9 Conference paper</a> (F2PY paper).
+ <dt> December 9, 2000
+ <dd> Implemented support for <code>PARAMETER</code> statement.
+ <dt> November 6, 2000
+ <dd> Submitted a paper for 9th Python Conference (accepted). It is available in <a
+ href="f2python9.html">html</a>, <a href="f2python9.pdf">PDF</a>,
+ and <a href="f2python9.ps.gz">Gzipped PS</a> formats.
+ <dt> September 17, 2000
+ <dd> Support for F90/95 module data and routines. COMMON block
+ wrapping is rewritten. New signature file syntax:
+ <code>pythonmodule</code>. Signature files generated with
+ f2py-2.264 or earlier, are incompatible (need replacement
+ <code>module</code> with
+ <code>pythonmodule</code>).
+ <dt> September 12, 2000
+ <dd> The second public release of <code>f2py</code> is out. See <a
+ href="Release-2.x.txt">Release notes</a>.
+ <dt> September 11, 2000
+ <dd> Now <code>f2py</code> supports wrapping Fortran 90/95 module routines
+ (support for F90/95 module data coming soon)
+ <dt> June 12, 2000
+ <dd> Now <code>f2py</code> has a mailing list <a
+href="#f2py-users">f2py-users</a> open for discussion.
+
+</dl>
+
+
+<!-- End of user text -->
+<HR>
+<ADDRESS>
+<A href="http://validator.w3.org/"><IMG border=0 align=right src="/icons/vh40.gif" alt="Valid HTML 4.0!" height=31 width=88></A>
+<A href="http://cens.ioc.ee/~pearu/" target="_top">Pearu Peterson</A>
+<A href="mailto:pearu (at) ioc.ee">&lt;pearu(at)ioc.ee&gt;</A><BR>
+<!-- hhmts start -->
+Last modified: Mon Dec 3 19:40:26 EET 2001
+<!-- hhmts end -->
+</ADDRESS>
+<!-- You may want to comment the following line out when the document is final-->
+<!-- Check that the reference is right -->
+<!--A href="http://validator.w3.org/check?uri=http://cens.ioc.ee/projects/f2py2e/index.html;ss"> Submit this page for validation</A-->
+
+</BODY>
+
+
+</HTML>
diff --git a/numpy/f2py/doc/options.tex b/numpy/f2py/doc/options.tex
new file mode 100644
index 000000000..84d9410f8
--- /dev/null
+++ b/numpy/f2py/doc/options.tex
@@ -0,0 +1,63 @@
+
+\section{\fpy command line options}
+\label{sec:opts}
+
+\fpy has the following command line syntax (run \fpy without arguments
+to get up to date options!!!):
+\begin{verbatim}
+f2py [<options>] <fortran files> [[[only:]||[skip:]] <fortran functions> ]\
+ [: <fortran files> ...]
+\end{verbatim}
+where
+\begin{description}
+\item[\texttt{<options>}] --- the following options are available:
+ \begin{description}
+ \item[\texttt{-f77}] --- \texttt{<fortran files>} are in Fortran~77
+ fixed format (default).
+ \item[\texttt{-f90}] --- \texttt{<fortran files>} are in
+ Fortran~90/95 free format (default for signature files).
+ \item[\texttt{-fix}] --- \texttt{<fortran files>} are in
+ Fortran~90/95 fixed format.
+ \item[\texttt{-h <filename>}] --- after scanning the
+ \texttt{<fortran files>} write the signatures of Fortran routines
+ to file \texttt{<filename>} and exit. If \texttt{<filename>}
+ exists, \fpy quits without overwriting the file. Use
+ \texttt{-{}-overwrite-signature} to overwrite.
+ \item[\texttt{-m <modulename>}] --- specify the name of the module
+ when scanning Fortran~77 codes for the first time. \fpy will
+ generate Python C/API module source \texttt{<modulename>module.c}.
+ \item[\texttt{-{}-lower/-{}-no-lower}] --- lower/do not lower the cases
+ when scanning the \texttt{<fortran files>}. Default when
+ \texttt{-h} flag is specified/unspecified (that is for Fortran~77
+ codes/signature files).
+ \item[\texttt{-{}-short-latex}] --- use this flag when you want to
+ include the generated LaTeX document to another LaTeX document.
+ \item[\texttt{-{}-debug-capi}] --- create a very verbose C/API
+ code. Useful for debbuging.
+% \item[\texttt{-{}-h-force}] --- if \texttt{-h <filename>} is used then
+% overwrite the file \texttt{<filename>} (if it exists) and continue
+% with constructing the C/API module source.
+ \item[\texttt{-makefile <options>}] --- run \fpy without arguments
+ for more information.
+ \item[\texttt{-{}-use-libs}] --- see \texttt{-makefile}.
+ \item[\texttt{-{}-overwrite-makefile}] --- overwrite existing
+ \texttt{Makefile-<modulename>}.
+ \item[\texttt{-v}] --- print \fpy version number and exit.
+ \item[\texttt{-pyinc}] --- print Python include path and exit.
+ \end{description}
+\item[\texttt{<fortran files>}] --- are the paths to Fortran files or
+ to signature files that will be scanned for \texttt{<fortran
+ functions>} in order to determine their signatures.
+\item[\texttt{<fortran functons>}] --- are the names of Fortran
+ routines for which Python C/API wrapper functions will be generated.
+ Default is all that are found in \texttt{<fortran files>}.
+\item[\texttt{only:}/\texttt{skip:}] --- are flags for filtering
+ in/out the names of fortran routines to be wrapped. Run \fpy without
+ arguments for more information about the usage of these flags.
+\end{description}
+
+
+%%% Local Variables:
+%%% mode: latex
+%%% TeX-master: "f2py2e"
+%%% End:
diff --git a/numpy/f2py/doc/python9.tex b/numpy/f2py/doc/python9.tex
new file mode 100644
index 000000000..cda3cd18b
--- /dev/null
+++ b/numpy/f2py/doc/python9.tex
@@ -0,0 +1,1046 @@
+\documentclass[twocolumn]{article}
+\usepackage{epsfig}
+\usepackage{xspace}
+\usepackage{verbatim}
+
+
+\headsep=0pt
+\topmargin=0pt
+\headheight=0pt
+\oddsidemargin=0pt
+\textwidth=6.5in
+\textheight=9in
+%%tth:\newcommand{\xspace}{ }
+\newcommand{\fpy}{\texttt{f2py}\xspace}
+\newcommand{\bs}{\symbol{`\\}}
+% need bs here:
+%%tth:\newcommand{\bs}{\texttt{<backslash>}}
+
+\newcommand{\tthhide}[1]{#1}
+\newcommand{\latexhide}[1]{}
+%%tth:\newcommand{\tthhide}[1]{}
+%%tth:\newcommand{\latexhide}[1]{#1}
+
+\newcommand{\shell}[1]{
+\latexhide{
+ \special{html:
+<BLOCKQUOTE>
+<pre>
+sh> #1
+</pre>
+</BLOCKQUOTE>}
+}
+\tthhide{
+ \\[1ex]
+ \hspace*{1em}
+ \texttt{sh> \begin{minipage}[t]{0.8\textwidth}#1\end{minipage}}\\[1ex]
+}
+}
+
+\newcommand{\email}[1]{\special{html:<A href="mailto:#1">}\texttt{<#1>}\special{html:</A>}}
+\newcommand{\wwwsite}[1]{\special{html:<A href="#1">}{#1}\special{html:</A>}}
+\title{Fortran to Python Interface Generator with
+an Application to Aerospace Engineering}
+\author{
+\large Pearu Peterson\\
+\small \email{pearu@cens.ioc.ee}\\
+\small Center of Nonlinear Studies\\
+\small Institute of Cybernetics at TTU\\
+\small Akadeemia Rd 21, 12618 Tallinn, ESTONIA\\[2ex]
+\large Joaquim R. R. A. Martins and Juan J. Alonso\\
+\small \email{joaquim.martins@stanford.edu}, \email{jjalonso@stanford.edu}\\
+\small Department of Aeronautics and Astronautics\\
+\small Stanford University, CA
+}
+\date{$Revision: 1.17 $\\\today}
+\begin{document}
+
+\maketitle
+
+\special{html: Other formats of this document:
+<A href=f2python9.ps.gz>Gzipped PS</A>,
+<A href=f2python9.pdf>PDF</A>
+}
+
+\begin{abstract}
+ FPIG --- Fortran to Python Interface Generator --- is a tool for
+ generating Python C/API extension modules that interface
+ Fortran~77/90/95 codes with Python. This tool automates the process
+ of interface generation by scanning the Fortran source code to
+ determine the signatures of Fortran routines and creating a
+ Python C/API module that contains the corresponding interface
+ functions. FPIG also attempts to find dependence relations between
+ the arguments of a Fortran routine call (e.g. an array and its
+ dimensions) and constructs interface functions with potentially
+ fewer arguments. The tool is extremely flexible since the user has
+ control over the generation process of the interface by specifying the
+ desired function signatures. The home page for FPIG can be found at
+ \wwwsite{http://cens.ioc.ee/projects/f2py2e/}.
+
+ FPIG has been used successfully to wrap a large number of Fortran
+ programs and libraries. Advances in computational science have led
+ to large improvements in the modeling of physical systems which are
+ often a result of the coupling of a variety of physical models that
+ were typically run in isolation. Since a majority of the available
+ physical models have been previously written in Fortran, the
+ importance of FPIG in accomplishing these couplings cannot be
+ understated. In this paper, we present an application of FPIG to
+ create an object-oriented framework for aero-structural analysis and
+ design of aircraft.
+\end{abstract}
+
+%%tth:
+\tableofcontents
+
+\section{Preface}
+\label{sec:preface}
+
+The use of high-performance computing has made it possible to tackle
+many important problems and discover new physical phenomena in science
+and engineering. These accomplishments would not have been achieved
+without the computer's ability to process large amounts of data in a
+reasonably short time. It can safely be said that the computer has
+become an essential tool for scientists and engineers. However, the
+diversity of problems in science and engineering has left its mark as
+computer programs have been developed in different programming
+languages, including languages developed to describe certain specific
+classes of problems.
+
+In interdisciplinary fields it is not uncommon for scientists and
+engineers to face problems that have already been solved in a
+different programming environment from the one they are familiar with.
+Unfortunately, researchers may not have the time or willingness to
+learn a new programming language and typically end up developing the
+corresponding tools in the language that they normally use. This
+approach to the development of new software can substantially impact
+the time to develop and the quality of the resulting product: firstly,
+it usually takes longer to develop and test a new tool than to learn a
+new programming environment, and secondly it is very unlikely that a
+non-specialist in a given field can produce a program that is more
+efficient than more established tools.
+
+To avoid situations such as the one described above, one alternative
+would be to provide automatic or semi-automatic interfaces between programming
+languages. Another possibility would be to provide language
+translators, but these obviously require more work than interface
+generators --- a translator must understand all language constructs
+while an interface generator only needs to understand a subset of these
+constructs. With an automatic interface between two languages, scientists or
+engineers can effectively use programs written in other programming
+languages without ever having to learn them.
+
+Although it is clear that it is impossible to interface arbitrary programming
+languages with each other, there is no reason for doing so. Low-level languages such as C and Fortran are well known for
+their speed and are therefore suitable for applications where
+performance is critical. High-level scripting languages, on the other
+hand, are generally slower but much easier to learn and use,
+especially when performing interactive analysis. Therefore, it makes
+sense to create interfaces only in one direction: from lower-level
+languages to higher-level languages.
+
+In an ideal world, scientists and engineers would use higher-level
+languages for the manipulation of the mathematical formulas in a problem
+rather than having to struggle with tedious programming details. For tasks
+that are computationally demanding, they would use interfaces to
+high-performance routines that are written in a lower-level language
+optimized for execution speed.
+
+
+\section{Introduction}
+\label{sec:intro}
+
+This paper presents a tool that has been developed for the creation of
+interfaces between Fortran and Python.
+
+
+The Fortran language is popular in
+scientific computing, and is used mostly in applications that use
+extensive matrix manipulations (e.g. linear algebra). Since Fortran
+ has been the standard language among scientists and engineers for
+ at least three decades, there is a large number of legacy codes available that
+ perform a variety of tasks using very sophisticated algorithms (see
+e.g. \cite{netlib}).
+
+The Python language \cite{python}, on the other hand, is a relatively
+new programming language. It is a very high-level scripting language
+that supports object-oriented programming. What makes Python
+especially appealing is its very clear and natural syntax, which makes it
+easy to learn and use. With Python one can implement relatively
+complicated algorithms and tasks in a short time with very compact
+source code.
+
+Although there are ongoing projects for extending Python's usage in
+scientific computation, it lacks reliable tools that are common in
+scientific and engineering such as ODE integrators, equation solvers,
+tools for FEM, etc. The implementation of all of these tools in Python
+would be not only too time-consuming but also inefficient. On the
+other hand, these tools are already developed in other,
+computationally more efficient languages such as Fortran or C.
+Therefore, the perfect role for Python in the context of scientific
+computing would be that of a ``gluing'' language. That is, the role
+of providing high-level interfaces to C, C++ and Fortran libraries.
+
+There are a number of widely-used tools that can be used for interfacing
+software libraries to Python. For binding C libraries with various
+scripting languages, including Python, the tool most often used is
+SWIG \cite{swig}. Wrapping Fortran routines with Python is less
+popular, mainly because there are many platform and compiler-specific
+issues that need to be addressed. Nevertheless, there is great
+interest in interfacing Fortran libraries because they provide
+invaluable tools for scientific computing. At LLNL, for example, a tool
+called PyFort has been developed for connecting Fortran and
+Python~\cite{pyfort}.
+
+The tools mentioned above require an input file describing signatures
+of functions to be interfaced. To create these input files, one needs
+to have a good knowledge of either C or Fortran. In addition,
+binding libraries that have thousands of routines can certainly constitute a
+very tedious task, even with these tools.
+
+The tool that is introduced in this paper, FPIG (Fortran to Python
+Interface Generator)~\cite{fpig}, automatically generates interfaces
+between Fortran and Python. It is different from the tools mentioned
+above in that FPIG can create signature files automatically by
+scanning the source code of the libraries and then construct Python
+C/API extension modules. Note that the user need not be experienced
+in C or even Fortran. In addition, FPIG is designed to wrap large
+Fortran libraries containing many routines with only one or two
+commands. This process is very flexible since one can always modify
+the generated signature files to insert additional attributes in order
+to achieve more sophisticated interface functions such as taking care
+of optional arguments, predicting the sizes of array arguments and
+performing various checks on the correctness of the input arguments.
+
+The organization of this paper is as follows. First, a simple example
+of FPIG usage is given. Then FPIG's basic features are described and
+solutions to platform and compiler specific issues are discussed.
+Unsolved problems and future work on FPIG's development are also
+addressed. Finally, an application to a large aero-structural solver
+is presented as real-world example of FPIG's usage.
+
+\section{Getting Started}
+\label{sec:getstart}
+
+To get acquainted with FPIG, let us consider the simple Fortran~77
+subroutine shown in Fig. \ref{fig:exp1.f}.
+\begin{figure}[htb]
+ \latexhide{\label{fig:exp1.f}}
+ \special{html:<BLOCKQUOTE>}
+ \verbatiminput{examples/exp1.f}
+ \special{html:</BLOCKQUOTE>}
+ \caption{Example Fortran code \texttt{exp1.f}. This routine calculates
+ the simplest rational lower and upper approximations to $e$ (for
+ details of
+ the algorithm see \cite{graham-etal}, p.122)}
+ \tthhide{\label{fig:exp1.f}}
+\end{figure}
+In the sections that follow, two ways of creating interfaces to this
+Fortran subroutine are described. The first and simplest way is
+suitable for Fortran codes that are developed in connection with \fpy.
+The second and not much more difficult method, is suitable for
+interfacing existing Fortran libraries which might have been developed
+by other programmers.
+
+Numerical Python~\cite{numpy} is needed in order to compile extension
+modules generated by FPIG.
+
+\subsection{Interfacing Simple Routines}
+\label{sec:example1}
+
+In order to call the Fortran routine \texttt{exp1} from Python, let us
+create an interface to it by using \fpy (FPIG's front-end program). In
+order to do this, we issue the following command, \shell{f2py -m foo
+exp1.f} where the option \texttt{-m foo} sets the name of the Python
+C/API extension module that \fpy will create to
+\texttt{foo}. To learn more about the \fpy command line options, run \fpy
+without arguments.
+
+The output messages in Fig. \ref{fig:f2pyoutmess}
+illustrate the procedure followed by \fpy:
+ (i) it scans the Fortran source code specified in the command line,
+ (ii) it analyses and determines the routine signatures,
+ (iii) it constructs the corresponding Python C/API extension modules,
+ (iv) it writes documentation to a LaTeX file, and
+ (v) it creates a GNU Makefile for building the shared modules.
+\begin{figure}[htb]
+ \latexhide{\label{fig:f2pyoutmess}}
+ \special{html:<BLOCKQUOTE>}
+ {\tthhide{\small}
+ \verbatiminput{examples/exp1mess.txt}
+ }
+ \special{html:</BLOCKQUOTE>}
+ \caption{Output messages of \texttt{f2py -m foo exp1.f}.}
+ \tthhide{\label{fig:f2pyoutmess}}
+\end{figure}
+
+Now we can build the \texttt{foo} module:
+\shell{make -f Makefile-foo}
+
+Figure \ref{fig:exp1session} illustrates a sample session for
+ calling the Fortran routine \texttt{exp1} from Python.
+\begin{figure}[htb]
+ \latexhide{\label{fig:exp1session}}
+ \special{html:<BLOCKQUOTE>}
+ \verbatiminput{examples/exp1session.txt}
+ \special{html:</BLOCKQUOTE>}
+ \caption{Calling Fortran routine \texttt{exp1} from Python. Here
+ \texttt{l[0]/l[1]} gives an estimate to $e$ with absolute error
+ less than \texttt{u[0]/u[1]-l[0]/l[1]} (this value may depend on
+ the platform and compiler used).}
+ \tthhide{\label{fig:exp1session}}
+\end{figure}
+
+Note the difference between the signatures of the Fortran routine
+\texttt{exp1(l,u,n)} and the corresponding wrapper function
+\texttt{l,u=exp1([n])}. Clearly, the later is more informative to
+the user: \texttt{exp1} takes one optional argument \texttt{n} and it
+returns \texttt{l}, \texttt{u}. This exchange of signatures is
+achieved by special comment lines (starting with \texttt{Cf2py}) in
+the Fortran source code --- these lines are interpreted by \fpy as
+normal Fortran code. Therefore, in the given example the line \texttt{Cf2py
+ integer*4 :: n = 1} informs \fpy that the variable \texttt{n} is
+optional with a default value equal to one. The line \texttt{Cf2py
+ intent(out) l,u} informs \fpy that the variables \texttt{l,u} are to be
+returned to Python after calling Fortran function \texttt{exp1}.
+
+\subsection{Interfacing Libraries}
+\label{sec:example2}
+
+In our example the Fortran source \texttt{exp1.f} contains \fpy
+specific information, though only as comments. When interfacing
+libraries from other parties, it is not recommended to modify their
+source. Instead, one should use a special auxiliary file to collect
+the signatures of all Fortran routines and insert \fpy specific
+declaration and attribute statements in that file. This auxiliary file
+is called a \emph{signature file} and is identified by the extension
+\texttt{.pyf}.
+
+We can use \fpy to generate these signature files by using the
+\texttt{-h <filename>.pyf} option.
+In our example, \fpy could have been called as follows,
+\shell{f2py -m foo -h foo.pyf exp1.f}
+where the option \texttt{-h foo.pyf} requests \fpy to read the
+routine signatures, save them to the file \texttt{foo.pyf}, and then
+exit.
+If \texttt{exp1.f} in Fig.~\ref{fig:exp1.f} were to
+contain no lines starting with \texttt{Cf2py}, the corresponding
+signature file \texttt{foo.pyf} would be as shown in Fig.~\ref{fig:foo.pyf}.
+In order to obtain the exchanged and more convenient signature
+\texttt{l,u=foo.exp1([n])}, we would edit \texttt{foo.pyf} as shown in
+Fig.~\ref{fig:foom.pyf}.
+The Python C/API extension module \texttt{foo} can be constructed by
+applying \fpy to the signature file with the following command:
+\shell{f2py foo.pyf}
+The procedure for building the corresponding shared module and using
+it in Python is identical to the one described in the previous section.
+
+\begin{figure}[htb]
+ \latexhide{\label{fig:foo.pyf}}
+ \special{html:<BLOCKQUOTE>}
+ \verbatiminput{examples/foo.pyf}
+ \special{html:</BLOCKQUOTE>}
+ \caption{Raw signature file \texttt{foo.pyf} generated with
+ \texttt{f2py -m foo -h foo.pyf exp1.f}}
+ \tthhide{\label{fig:foo.pyf}}
+\end{figure}
+\begin{figure}[htb]
+ \latexhide{\label{fig:foom.pyf}}
+ \special{html:<BLOCKQUOTE>}
+ \verbatiminput{examples/foom.pyf}
+ \special{html:</BLOCKQUOTE>}
+ \caption{Modified signature file \texttt{foo.pyf}}
+ \tthhide{\label{fig:foom.pyf}}
+\end{figure}
+
+As we can see, the syntax of the signature file is an
+extension of the Fortran~90/95 syntax. This means that only a few new
+constructs are introduced for \fpy in addition to all standard Fortran
+constructs; signature files can even be written in fixed form. A
+complete set of constructs that are used when creating interfaces, is
+described in the \fpy User's Guide \cite{f2py-ug}.
+
+
+\section{Basic Features}
+\label{sec:features}
+
+In this section a short overview of \fpy features is given.
+\begin{enumerate}
+\item All basic Fortran types are supported. They include
+the following type specifications:
+\begin{verbatim}
+integer[ | *1 | *2 | *4 | *8 ]
+logical[ | *1 | *2 | *4 | *8 ]
+real[ | *4 | *8 | *16 ]
+complex[ | *8 | *16 | *32 ]
+double precision, double complex
+character[ |*(*)|*1|*2|*3|...]
+\end{verbatim}
+In addition, they can all be in the kind-selector form
+(e.g. \texttt{real(kind=8)}) or char-selector form
+(e.g. \texttt{character(len=5)}).
+\item Arrays of all basic types are supported. Dimension
+ specifications can be of form \texttt{<dimension>} or
+ \texttt{<start>:<end>}. In addition, \texttt{*} and \texttt{:}
+ dimension specifications can be used for input arrays.
+ Dimension specifications may contain also \texttt{PARAMETER}'s.
+\item The following attributes are supported:
+ \begin{itemize}
+ \item
+ \texttt{intent(in)}: used for input-only arguments.
+ \item
+ \texttt{intent(inout)}: used for arguments that are changed in
+ place.
+ \item
+ \texttt{intent(out)}: used for return arguments.
+ \item
+ \texttt{intent(hide)}: used for arguments to be removed from
+ the signature of the Python function.
+ \item
+ \texttt{intent(in,out)}, \texttt{intent(inout,out)}: used for
+ arguments with combined behavior.
+ \item
+ \texttt{dimension(<dimspec>)}
+ \item
+ \texttt{depend([<names>])}: used
+ for arguments that depend on other arguments in \texttt{<names>}.
+ \item
+ \texttt{check([<C booleanexpr>])}: used for checking the
+ correctness of input arguments.
+ \item
+ \texttt{note(<LaTeX text>)}: used for
+ adding notes to the module documentation.
+ \item
+ \texttt{optional}, \texttt{required}
+ \item
+ \texttt{external}: used for call-back arguments.
+ \item
+ \texttt{allocatable}: used for Fortran 90/95 allocatable arrays.
+ \end{itemize}
+\item Using \fpy one can call arbitrary Fortran~77/90/95 subroutines
+ and functions from Python, including Fortran 90/95 module routines.
+\item Using \fpy one can access data in Fortran~77 COMMON blocks and
+ variables in Fortran 90/95 modules, including allocatable arrays.
+\item Using \fpy one can call Python functions from Fortran (call-back
+ functions). \fpy supports very flexible hooks for call-back functions.
+\item Wrapper functions perform the necessary type conversations for their
+ arguments resulting in contiguous Numeric arrays that are suitable for
+ passing to Fortran routines.
+\item \fpy generates documentation strings
+for \texttt{\_\_doc\_\_} attributes of the wrapper functions automatically.
+\item \fpy scans Fortran codes and creates the signature
+ files. It automatically detects the signatures of call-back functions,
+ solves argument dependencies, decides the order of initialization of
+ optional arguments, etc.
+\item \fpy automatically generates GNU Makefiles for compiling Fortran
+ and C codes, and linking them to a shared module.
+ \fpy detects available Fortran and C compilers. The
+ supported compilers include the GNU project C Compiler (gcc), Compaq
+ Fortran, VAST/f90 Fortran, Absoft F77/F90, and MIPSpro 7 Compilers, etc.
+ \fpy has been tested to work on the following platforms: Intel/Alpha
+ Linux, HP-UX, IRIX64.
+\item Finally, the complete \fpy User's Guide is available in various
+ formats (ps, pdf, html, dvi). A mailing list,
+ \email{f2py-users@cens.ioc.ee}, is open for support and feedback. See
+ the FPIG's home page for more information \cite{fpig}.
+\end{enumerate}
+
+
+\section{Implementation Issues}
+\label{sec:impl}
+
+The Fortran to Python interface can be thought of as a three layer
+``sandwich'' of different languages: Python, C, and Fortran. This
+arrangement has two interfaces: Python-C and C-Fortran. Since Python
+itself is written in C, there are no basic difficulties in
+implementing the Python-C interface~\cite{python-doc:ext}. The C-Fortran
+interface, on the other hand, results in many platform and compiler specific
+issues that have to be dealt with. We will now discuss these issues
+in some detail and describe how they are solved in FPIG.
+
+\subsection{Mapping Fortran Types to C Types}
+\label{sec:mapF2Ctypes}
+
+Table \ref{tab:mapf2c} defines how Fortran types are mapped to C types
+in \fpy.
+\begin{table}[htb]
+ \begin{center}
+ \begin{tabular}[c]{l|l}
+ Fortran type & C type \\\hline
+ \texttt{integer *1} & \texttt{char}\\
+ \texttt{byte} & \texttt{char}\\
+ \texttt{integer *2} & \texttt{short}\\
+ \texttt{integer[ | *4]} & \texttt{int}\\
+ \texttt{integer *8} & \texttt{long long}\\
+ \texttt{logical *1} & \texttt{char}\\
+ \texttt{logical *2} & \texttt{short}\\
+ \texttt{logical[ | *4]} & \texttt{int}\\
+ \texttt{logical *8} & \texttt{int}\\
+ \texttt{real[ | *4]} & \texttt{float}\\
+ \texttt{real *8} & \texttt{double}\\
+ \texttt{real *16} & \texttt{long double}\\
+ \texttt{complex[ | *8]} & \texttt{struct \{float r,i;\}}\\
+ \texttt{complex *16} & \texttt{struct \{double r,i;\}}\\
+ \texttt{complex *32} & \texttt{struct \{long double r,i;\}}\\
+ \texttt{character[*...]} & \texttt{char *}\\
+ \end{tabular}
+ \caption{Mapping Fortran types to C types.}
+ \label{tab:mapf2c}
+ \end{center}
+\end{table}
+Users may redefine these mappings by creating a \texttt{.f2py\_f2cmap}
+file in the working directory. This file should contain a Python
+dictionary of dictionaries, e.g. \texttt{\{'real':\{'low':'float'\}\}},
+that informs \fpy to map Fortran type \texttt{real(low)}
+to C type \texttt{float} (here \texttt{PARAMETER low = ...}).
+
+
+\subsection{Calling Fortran (Module) Routines}
+\label{sec:callrout}
+
+When mixing Fortran and C codes, one has to know how function names
+are mapped to low-level symbols in their object files. Different
+compilers may use different conventions for this purpose. For example, gcc
+appends the underscore \texttt{\_} to a Fortran routine name. Other
+compilers may use upper case names, prepend or append different
+symbols to Fortran routine names or both. In any case, if the
+low-level symbols corresponding to Fortran routines are valid for the
+C language specification, compiler specific issues can be solved by
+using CPP macro features.
+
+Unfortunately, there are Fortran compilers that use symbols in
+constructing low-level routine names that are not valid for C. For
+example, the (IRIX64) MIPSpro 7 Compilers use `\$' character in the
+low-level names of module routines which makes it impossible (at
+least directly) to call such routines from C when using the MIPSpro 7
+C Compiler.
+
+In order to overcome this difficulty, FPIG introduces an unique
+solution: instead of using low-level symbols for calling Fortran
+module routines from C, the references to such routines are determined
+at run-time by using special wrappers. These wrappers are called once
+during the initialization of an extension module. They are simple
+Fortran subroutines that use a Fortran module and call another C
+function with Fortran module routines as arguments in order to save
+their references to C global variables that are later used for calling
+the corresponding Fortran module routines. This arrangement is
+set up as follows. Consider the following Fortran 90 module with the
+subroutine \texttt{bar}:
+\special{html:<BLOCKQUOTE>}
+\begin{verbatim}
+module fun
+ subroutine bar()
+ end
+end
+\end{verbatim}
+\special{html:</BLOCKQUOTE>}
+Figure \ref{fig:capi-sketch} illustrates a Python C/API extension
+module for accessing the F90 module subroutine \texttt{bar} from Python.
+When the Python module \texttt{foo} is loaded, \texttt{finitbar} is
+called. \texttt{finitbar} calls \texttt{init\_bar} by passing the
+reference of the Fortran 90 module subroutine \texttt{bar} to C where it is
+saved to the variable \texttt{bar\_ptr}. Now, when one executes \texttt{foo.bar()}
+from Python, \texttt{bar\_ptr} is used in \texttt{bar\_capi} to call
+the F90 module subroutine \texttt{bar}.
+\begin{figure}[htb]
+ \latexhide{\label{fig:capi-sketch}}
+ \special{html:<BLOCKQUOTE>}
+\begin{verbatim}
+#include "Python.h"
+...
+char *bar_ptr;
+void init_bar(char *bar) {
+ bar_ptr = bar;
+}
+static PyObject *
+bar_capi(PyObject *self,PyObject *args) {
+ ...
+ (*((void *)bar_ptr))();
+ ...
+}
+static PyMethodDef
+foo_module_methods[] = {
+ {"bar",bar_capi,METH_VARARGS},
+ {NULL,NULL}
+};
+extern void finitbar_; /* GCC convention */
+void initfoo() {
+ ...
+ finitbar_(init_bar);
+ Py_InitModule("foo",foo_module_methods);
+ ...
+}
+\end{verbatim}
+ \special{html:</BLOCKQUOTE>}
+ \caption{Sketch of Python C/API for accessing F90 module subroutine
+ \texttt{bar}. The Fortran function \texttt{finitbar} is defined in
+ Fig.~\ref{fig:wrapbar}.}
+ \tthhide{\label{fig:capi-sketch}}
+\end{figure}
+\begin{figure}[ht]
+ \latexhide{\label{fig:wrapbar}}
+\special{html:<BLOCKQUOTE>}
+\begin{verbatim}
+ subroutine finitbar(cinit)
+ use fun
+ extern cinit
+ call cinit(bar)
+ end
+\end{verbatim}
+\special{html:</BLOCKQUOTE>}
+ \caption{Wrapper for passing the reference of \texttt{bar} to C code.}
+ \tthhide{\label{fig:wrapbar}}
+\end{figure}
+
+Surprisingly, mixing C code and Fortran modules in this way is as
+portable and compiler independent as mixing C and ordinary Fortran~77
+code.
+
+Note that extension modules generated by \fpy actually use
+\texttt{PyFortranObject} that implements above described scheme with
+exchanged functionalities (see Section \ref{sec:PFO}).
+
+
+\subsection{Wrapping Fortran Functions}
+\label{sec:wrapfunc}
+
+The Fortran language has two types of routines: subroutines and
+functions. When a Fortran function returns a composed type such as
+\texttt{COMPLEX} or \texttt{CHARACTER}-array then calling this
+function directly from C may not work for all compilers, as C
+functions are not supposed to return such references. In order to
+avoid this, FPIG constructs an additional Fortran wrapper subroutine
+for each such Fortran function. These wrappers call just the
+corresponding functions in the Fortran layer and return the result to
+C through its first argument.
+
+
+\subsection{Accessing Fortran Data}
+\label{sec:accsdata}
+
+In Fortran one can use \texttt{COMMON} blocks and Fortran module
+variables to save data that is accessible from other routines. Using
+FPIG, one can also access these data containers from Python. To achieve
+this, FPIG uses special wrapper functions (similar to the ones used
+for wrapping Fortran module routines) to save the references to these
+data containers so that they can later be used from C.
+
+FPIG can also handle \texttt{allocatable} arrays. For example, if a
+Fortran array is not yet allocated, then by assigning it in Python,
+the Fortran to Python interface will allocate and initialize the
+array. For example, the F90 module allocatable array \texttt{bar}
+defined in
+\special{html:<BLOCKQUOTE>}
+\begin{verbatim}
+module fun
+ integer, allocatable :: bar(:)
+end module
+\end{verbatim}
+\special{html:</BLOCKQUOTE>}
+can be allocated from Python as follows
+\special{html:<BLOCKQUOTE>}
+\begin{verbatim}
+>>> import foo
+>>> foo.fun.bar = [1,2,3,4]
+\end{verbatim}
+\special{html:</BLOCKQUOTE>}
+
+\subsection{\texttt{PyFortranObject}}
+\label{sec:PFO}
+
+In general, we would like to access from Python the following Fortran
+objects:
+\begin{itemize}
+\item subroutines and functions,
+\item F90 module subroutines and functions,
+\item items in COMMON blocks,
+\item F90 module data.
+\end{itemize}
+Assuming that the Fortran source is available, we can determine the signatures
+of these objects (the full specification of routine arguments, the
+layout of Fortran data, etc.). In fact, \fpy gets this information
+while scanning the Fortran source.
+
+In order to access these Fortran objects from C, we need to determine
+their references. Note that the direct access of F90 module objects is
+extremely compiler dependent and in some cases even impossible.
+Therefore, FPIG uses various wrapper functions for obtaining the
+references to Fortran objects. These wrapper functions are ordinary
+F77 subroutines that can easily access objects from F90 modules and
+that pass the references to Fortran objects as C variables.
+
+
+\fpy generated Python C/API extension modules use
+\texttt{PyFortranObject} to store the references of Fortran objects.
+In addition to the storing functionality, the \texttt{PyFortranObject}
+also provides methods for accessing/calling Fortran objects from
+Python in a user-friendly manner. For example, the item \texttt{a} in
+\texttt{COMMON /bar/ a(2)} can be accessed from Python as
+\texttt{foo.bar.a}.
+
+Detailed examples of \texttt{PyFortranObject} usage can be found in
+\cite{PFO}.
+
+\subsection{Callback Functions}
+\label{sec:callback}
+
+Fortran routines may have arguments specified as \texttt{external}.
+These arguments are functions or subroutines names that the receiving Fortran routine
+will call from its body. For such arguments FPIG
+constructs a call-back mechanism (originally contributed by Travis
+Oliphant) that allows Fortran routines to call Python functions. This
+is actually realized using a C layer between Python and
+Fortran. Currently, the call-back mechanism is compiler independent
+unless a call-back function needs to return a composed type
+(e.g. \texttt{COMPLEX}).
+
+The signatures of call-back functions are determined when \fpy scans
+the Fortran source code. To illustrate this, consider the following
+example:
+\special{html:<BLOCKQUOTE>}
+\begin{verbatim}
+ subroutine foo(bar, fun, boo)
+ integer i
+ real r
+ external bar,fun,boo
+ call bar(i, 1.2)
+ r = fun()
+ call sun(boo)
+ end
+\end{verbatim}
+\special{html:</BLOCKQUOTE>}
+\fpy recognizes the signatures of the user routines \texttt{bar} and
+\texttt{fun} using the information contained in the lines \texttt{call
+ bar(i, 1.2)} and \texttt{r = fun()}:
+\special{html:<BLOCKQUOTE>}
+\begin{verbatim}
+subroutine bar(a,b)
+ integer a
+ real b
+end
+function fun()
+ real fun
+end
+\end{verbatim}
+\special{html:</BLOCKQUOTE>}
+But \fpy cannot determine the signature of the user routine
+\texttt{boo} because the source contains no information at all about
+the \texttt{boo} specification. Here user needs to provide the
+signature of \texttt{boo} manually.
+
+\section{Future Work}
+\label{sec:future}
+
+FPIG can be used to wrap almost any Fortran code. However, there are
+still issues that need to be resolved. Some of them are listed below:
+\begin{enumerate}
+\item One of the FPIG's goals is to become as platform and compiler
+ independent as possible. Currently FPIG can be used on
+ any UN*X platform that has gcc installed in it. In the future, FPIG
+ should be also tested on Windows systems.
+\item Another goal of FPIG is to become as simple to use as
+ possible. To achieve that, FPIG should start using the facilities of
+ \texttt{distutils}, the new Python standard to distribute and build
+ Python modules. Therefore, a contribution to \texttt{distutils}
+ that can handle Fortran extensions should be developed.
+\item Currently users must be aware of
+ the fact that multi-dimensional arrays are stored differently in C
+ and Fortran (they must provide transposed multi-dimensional arrays
+ to wrapper functions). In the future a solution should be found such
+ that users do not need to worry about this rather
+ confusing and technical detail.
+\item Finally, a repository of signature files for widely-used Fortran
+ libraries (e.g. BLAS, LAPACK, MINPACK, ODEPACK, EISPACK, LINPACK) should be
+ provided.
+\end{enumerate}
+
+
+\section{Application to a Large Aero-Structural Analysis Framework}
+\label{sec:app}
+
+
+\subsection{The Need for Python and FPIG}
+\label{sec:appsub1}
+
+As a demonstration of the power and usefulness of FPIG, we will
+present work that has been done at the Aerospace Computing Laboratory
+at Stanford University. The focus of the research is on aircraft
+design optimization using high-fidelity analysis tools such as
+Computational Fluid Dynamics (CFD) and Computational Structural
+Mechanics (CSM)~\cite{reno99}.
+
+The group's analysis programs are written mainly in Fortran and are the result
+of many years of development. Until now, any researcher that needed
+to use these tools would have to learn a less than user-friendly
+interface and become relatively familiar with the inner workings of
+the codes before starting the research itself. The need to
+couple analyses of different disciplines revealed the additional
+inconvenience of gluing and scripting the different codes with
+Fortran.
+
+It was therefore decided that the existing tools should be wrapped
+using an object-oriented language in order to improve their ease of
+use and versatility. The use of several different languages such as
+C++, Java and Perl was investigated but Python seemed to provide the
+best solution. The fact that it combines scripting capability
+with a fully-featured object-oriented programming language, and that
+it has a clean syntax were factors that determined our choice. The
+introduction of tools that greatly facilitate the task of wrapping
+Fortran with Python provided the final piece needed to realize our
+objective.
+
+\subsection{Wrapping the Fortran Programs}
+
+In theory, it would have been possible to wrap our Fortran programs
+with C and then with Python by hand. However, this would have been a
+labor intensive task that would detract from our research. The use of
+tools that automate the task of wrapping has been extremely useful.
+
+The first such tool that we used was PyFort. This tool created the C
+wrappers and Python modules automatically, based on signature files
+(\texttt{.pyf}) provided by the user. Although it made the task of
+wrapping considerably easier, PyFort was limited by the fact that any
+Fortran data that was needed at the Python level had to be passed in
+the argument list of the Fortran subroutine. Since the bulk of the
+data in our programs is shared by using Fortran~77 common blocks and
+Fortran~90 modules, this required adding many more arguments to the
+subroutine headers. Furthermore, since Fortran does not allow common
+block variables or module data to be specified in a subroutine
+argument list, a dummy pointer for each desired variable had to be
+created and initialized.
+
+The search for a better solution to this problem led us to \fpy.
+Since \fpy provides a solution for accessing common block and module
+variables, there was no need to change the Fortran source anymore,
+making the wrapping process even easier. With \fpy we also
+experienced an increased level of automation since it produces the
+signature files automatically, as well as a Makefile for the joint
+compilation of the original Fortran and C wrapper codes. This increased
+automation did not detract from its flexibility since it was always
+possible to edit the signature files to provide different functionality.
+
+Once Python interfaces were created for each Fortran application
+by running \fpy, it was just a matter of using Python to achieve the
+final objective of developing an object-oriented framework for our
+multidisciplinary solvers. The Python modules that we designed are
+discussed in the following section.
+
+
+\subsection{Module Design}
+\label{ssec:module}
+
+The first objective of this effort was to design the classes for each
+type of analysis, each representing an independent Python module. In
+our case, we are interested in performing aero-structural analysis and
+optimization of aircraft wings. We therefore needed an analysis tool
+for the flow (CFD), another for analyzing the structure (CSM), as well
+as a geometry database. In addition, we needed to interface these two
+tools in order to analyze the coupled system. The object design for
+each of these modules should be general enough that the underlying
+analysis code in Fortran can be changed without changing the Python
+interface. Another requirement was that the modules be usable on
+their own for single discipline analysis.
+
+\subsubsection{Geometry}
+
+The \emph{Geometry} class provides a database for the outer mold
+geometry of the aircraft. This database needs to be accessed by both
+the flow and structural solvers. It contains a parametric description
+of the aircraft's surface as well as methods that extract and update
+this information.
+
+
+\subsubsection{Flow}
+
+The flow solver was wrapped in a class called \emph{Flow}. The class
+was designed so that it can wrap any type of CFD solver. It contains
+two main objects: the computational mesh and a solver object. A graph
+showing the hierarchy of the objects in \emph{Flow} is shown in
+Fig.~\ref{fig:flow}.
+\tthhide{
+\begin{figure}[h]
+ \centering
+ \epsfig{file=./flow.eps, angle=0, width=.7\linewidth}
+ \caption{The \emph{Flow} container class.}
+ \label{fig:flow}
+\end{figure}
+}
+\latexhide{
+\begin{figure}[h]
+ \label{fig:flow}
+\special{html:
+<CENTER>
+ <IMG SRC="flow.jpg" WIDTH="400">
+</CENTER>
+}
+ \caption{The \emph{Flow} container class.}
+\end{figure}
+}
+Methods in the flow class include those used for the initialization of
+all the class components as well as methods that write the current
+solution to a file.
+
+
+\subsubsection{Structure}
+
+The \emph{Structure} class wraps a structural analysis code. The class
+stores the information about the structure itself in an object called
+\emph{Model} which also provides methods for changing and exporting
+its information. A list of the objects contained in this class can be
+seen in Fig.~\ref{fig:structure}.
+\tthhide{
+\begin{figure}[h]
+ \centering
+ \epsfig{file=./structure.eps, angle=0, width=.7\linewidth}
+ \caption{The \emph{Structure} container class.}
+ \label{fig:structure}
+\end{figure}
+}
+\latexhide{
+\begin{figure}[h]
+ \label{fig:structure}
+\special{html:
+<CENTER>
+ <IMG SRC="structure.jpg" WIDTH="400">
+</CENTER>
+}
+ \caption{The \emph{Structure} container class.}
+\end{figure}
+}
+Since the \emph{Structure} class contains a
+dictionary of \emph{LoadCase} objects, it is able to store and solve
+multiple load cases, a capability that the original Fortran code
+does not have.
+
+
+\subsubsection{Aerostructure}
+
+The \emph{Aerostructure} class is the main class in the
+aero-structural analysis module and contains a \emph{Geometry}, a
+\emph{Flow} and a \emph{Structure}. In addition, the class defines
+all the functions that are necessary to translate aerodynamic
+loads to structural loads and structural displacements to
+geometry surface deformations.
+
+One of the main methods of this class is the one that solves the
+aeroelastic system. This method is printed below:
+\begin{verbatim}
+def Iterate(self, load_case):
+ """Iterates the aero-structural solution."""
+ self.flow.Iterate()
+ self._UpdateStructuralLoads()
+ self.structure.CalcDisplacements(load_case)
+ self.structure.CalcStresses(load_case)
+ self._UpdateFlowMesh()
+ return
+\end{verbatim}
+This is indeed a very readable script, thanks to Python, and any
+high-level changes to the solution procedure can be easily
+implemented.
+The \emph{Aerostructure} class also contains methods that export all
+the information on the current solution for visualization, an example
+of which is shown in the next section.
+
+
+\subsection{Results}
+
+In order to visualize results, and because we needed to view results
+from multiple disciplines simultaneously, we selected OpenDX. Output
+files in DX format are written at the Python level and the result can
+be seen in Fig.~\ref{fig:aerostructure} for the case of a transonic
+airliner configuration.
+\tthhide{
+\begin{figure*}[t]
+ \centering
+ \epsfig{file=./aerostructure.eps, angle=-90, width=\linewidth}
+ \caption{Aero-structural model and results.}
+ \label{fig:aerostructure}
+\end{figure*}
+}
+\latexhide{
+\begin{figure}[h]
+ \label{fig:aerostructure}
+\special{html:
+<CENTER>
+ <IMG SRC="aerostructure.jpg" WIDTH="600">
+</CENTER>
+}
+ \caption{Aero-structural model and results.}
+\end{figure}
+}
+
+
+The figure illustrates the multidisciplinary nature of the
+problem. The grid pictured in the background is the mesh used by the
+flow solver and is colored by the pressure values computed at the
+cell centers. The wing in the foreground and its outer surface is
+clipped to show the internal structural components which are colored
+by their stress value.
+
+In conclusion, \fpy and Python have been extremely useful tools in our
+pursuit for increasing the usability and flexibility of existing Fortran
+tools.
+
+
+\begin{thebibliography}{99}
+\bibitem{netlib}
+\newblock Netlib repository at UTK and ORNL.
+\newblock \\\wwwsite{http://www.netlib.org/}
+\bibitem{python}
+Python language.
+\newblock \\\wwwsite{http://www.python.org/}
+\bibitem{swig}
+SWIG --- Simplified Wrapper and Interface Generator.
+\newblock \\\wwwsite{http://www.swig.org/}
+\bibitem{pyfort}
+PyFort --- The Python-Fortran connection tool.
+\newblock \\\wwwsite{http://pyfortran.sourceforge.net/}
+\bibitem{fpig}
+FPIG --- Fortran to Python Interface Generator.
+\newblock \\\wwwsite{http://cens.ioc.ee/projects/f2py2e/}
+\bibitem{numpy}
+Numerical Extension to Python.
+\newblock \\\wwwsite{http://numpy.sourceforge.net/}
+\bibitem{graham-etal}
+R. L. Graham, D. E. Knuth, and O. Patashnik.
+\newblock {\em {C}oncrete {M}athematics: a foundation for computer science.}
+\newblock Addison-Wesley, 1988
+\bibitem{f2py-ug}
+P. Peterson.
+\newblock {\em {\tt f2py} - Fortran to Python Interface Generator. Second Edition.}
+\newblock 2000
+\newblock
+\\\wwwsite{http://cens.ioc.ee/projects/f2py2e/usersguide.html}
+\bibitem{python-doc:ext}
+Python Documentation: Extending and Embedding.
+\newblock \\\wwwsite{http://www.python.org/doc/ext/}
+\bibitem{PFO}
+P. Peterson. {\em {\tt PyFortranObject} example usages.}
+\newblock 2001
+\newblock \\\wwwsite{http://cens.ioc.ee/projects/f2py2e/pyfobj.html}
+\bibitem{reno99}
+Reuther, J., J. J. Alonso, J. R. R. A. Martins, and
+S. C. Smith.
+\newblock ``A Coupled Aero-Structural Optimization Method for
+ Complete Aircraft Configurations'',
+\newblock {\em Proceedings of the 37th Aerospace Sciences Meeting},
+\newblock AIAA Paper 1999-0187. Reno, NV, January, 1999
+\end{thebibliography}
+
+%\end{multicols}
+
+%\begin{figure}[htbp]
+% \begin{center}
+% \epsfig{file=aerostructure2b.ps,width=0.75\textwidth}
+% \end{center}
+%\end{figure}
+
+
+
+\end{document}
+
+%%% Local Variables:
+%%% mode: latex
+%%% TeX-master: t
+%%% End:
+
+
diff --git a/numpy/f2py/doc/signaturefile.tex b/numpy/f2py/doc/signaturefile.tex
new file mode 100644
index 000000000..3cd16d890
--- /dev/null
+++ b/numpy/f2py/doc/signaturefile.tex
@@ -0,0 +1,368 @@
+
+\section{Signature file}
+\label{sec:signaturefile}
+
+The syntax of a signature file is borrowed from the Fortran~90/95
+language specification. Almost all Fortran~90/95 standard constructs
+are understood. Recall that Fortran~77 is a subset of Fortran~90/95.
+This tool introduces also some new attributes that are used for
+controlling the process of Fortran to Python interface construction.
+In the following, a short overview of the constructs
+used in signature files will be given.
+
+
+\subsection{Module block}
+\label{sec:moduleblock}
+
+A signature file contains one or more \texttt{pythonmodule} blocks. A
+\texttt{pythonmodule} block has the following structure:
+\begin{verbatim}
+python module <modulename>
+ interface
+ <routine signatures>
+ end [interface]
+ interface
+ module <F90/95 modulename>
+ <F90 module data type declarations>
+ <F90 module routine signatures>
+ end [module [<F90/95 modulename>]]
+ end [interface]
+end [pythonmodule [<modulename>]]
+\end{verbatim}
+For each \texttt{pythonmodule} block \fpy will generate a C-file
+\texttt{<modulename>module.c} (see step (iii)). (This is not true if
+\texttt{<modulename>} contains substring \texttt{\_\_user\_\_}, see
+Sec.~\ref{sec:cbmodule} and \texttt{external} attribute).
+
+\subsection{Signatures of Fortran routines and Python functions}
+\label{sec:routineblock}
+
+
+The signature of a Fortran routine has the following structure:
+\begin{verbatim}
+[<typespec>] function|subroutine <routine name> [([<arguments>])] \
+ [result (<entityname>)]
+ [<argument type declarations>]
+ [<argument attribute statements>]
+ [<use statements>]
+ [<common block statements>]
+ [<other statements>]
+end [function|subroutine [<routine name>]]
+\end{verbatim}
+
+Let us introduce also the signature of the corresponding wrapper
+function:
+\begin{verbatim}
+def <routine name>(<required arguments>[,<optional arguments>]):
+ ...
+ return <return variables>
+\end{verbatim}
+
+Before you edit the signature file, you should first decide what is the
+desired signature of the corresponding Python function. \fpy offers
+many possibilities to control the interface construction process: you
+may want to insert/change/remove various attributes in the
+declarations of the arguments in order to change the appearance
+of the arguments in the Python wrapper function.
+
+\begin{itemize}
+\item
+The definition of the \texttt{<argument type declaration>} is
+\begin{verbatim}
+<typespec> [[<attrspec>]::] <entitydecl>
+\end{verbatim}
+where
+\begin{verbatim}
+<typespec> := byte | character[<charselector>]
+ | complex[<kindselector>] | real[<kindselector>]
+ | double complex | double precision
+ | integer[<kindselector>] | logical[<kindselector>]
+\end{verbatim}
+\begin{verbatim}
+<charselector> := *<charlen> | ([len=]<len>[,[kind]<kind>])
+ | (kind=<kind>[,len=<len>])
+<kindselector> := *<intlen> | ([kind=]<kind>)
+\end{verbatim}
+(there is no sense to modify \texttt{<typespec>}s generated by \fpy).
+\texttt{<attrspec>} is a comma separated list of attributes (see
+Sec.~\ref{sec:attributes});
+\begin{verbatim}
+<entitydecl> := <name> [[*<charlen>][(<arrayspec>)]
+ | [(<arrayspec>)]*<charlen>]
+ | [/<init_expr>/ | =<init_expr>] [,<entitydecl>]
+\end{verbatim}
+where \texttt{<arrayspec>} is a comma separated list of dimension
+bounds; \texttt{<init\_expr>} is a C-expression (see
+Sec.~\ref{sec:C-expr}). If an argument is not defined with
+\texttt{<argument type declaration>}, its type is determined by
+applying \texttt{implicit} rules (if it is not specifyied, then
+standard rules are applied).
+
+\item The definition of the \texttt{<argument attribute statement>} is
+a short form of the \texttt{<argument type declaration>}:
+\begin{verbatim}
+<attrspec> <entitydecl>
+\end{verbatim}
+
+\item \texttt{<use statement>} is defined as follows
+\begin{verbatim}
+use <modulename> [,<rename_list> | ,ONLY:<only_list>]
+<rename_list> := local_name=>use_name [,<rename_list>]
+\end{verbatim}
+ Currently the \texttt{use} statement is used to link call-back
+ modules (Sec.~\ref{sec:cbmodule}) and the \texttt{external}
+ arguments (call-back functions).
+
+\item \texttt{<common block statement>} is defined as follows
+\begin{verbatim}
+common /<commonname>/ <shortentitydecl>
+\end{verbatim}
+where
+\begin{verbatim}
+<shortentitydecl> := <name> [(<arrayspec>)] [,<shortentitydecl>]
+\end{verbatim}
+One \texttt{module} block should not contain two or more
+\texttt{common} blocks with the same name. Otherwise, the later ones
+are ignored. The types of variables in \texttt{<shortentitydecl>} can
+be defined in \texttt{<argument type declarations>}. Note that there
+you can specify also the array specifications; then you don't need to
+do that in \texttt{<shortentitydecl>}.
+\end{itemize}
+
+\subsection{Attributes}
+\label{sec:attributes}
+
+The following attributes are used by \fpy:
+\begin{description}
+\item[\texttt{optional}] --- the variable is moved to the end of
+ optional argument list of the wrapper function. Default value of an
+ optional argument can be specified using \texttt{<init\_expr>} in
+ \texttt{entitydecl}. You can use \texttt{optional} attribute also for
+ \texttt{external} arguments (call-back functions), but it is your
+ responsibility to ensure that it is given by the user if Fortran
+ routine wants to call it.
+\item[\texttt{required}] --- the variable is considered as a required
+ argument (that is default). You will need this in order to overwrite
+ the \texttt{optional} attribute that is automatically set when
+ \texttt{<init\_expr>} is used. However, usage of this attribute
+ should be rare.
+\item[\texttt{dimension(<arrayspec>)}] --- used when the variable is
+ an array. For unbounded dimensions symbols `\texttt{*}' or
+ `\texttt{:}' can be used (then internally the corresponding
+ dimensions are set to -1; you'll notice this when certain exceptions
+ are raised).
+\item[\texttt{external}] --- the variable is a call-back function. \fpy will
+ construct a call-back mechanism for this function. Also call-back
+ functions must be defined by their signatures, and there are several
+ ways to do that. In most cases, \fpy will be able to determine the signatures
+ of call-back functions from the Fortran source code; then it
+ builds an additional \texttt{module} block with a name containing
+ string `\texttt{\_\_user\_\_}' (see Sec.~\ref{sec:cbmodule}) and
+ includes \texttt{use} statement to the routines signature. Anyway,
+ you should check that the generated signature is correct.
+
+ Alternatively, you can specify the signature by inserting to the
+ routines block a ``model'' how the call-back function would be called
+ from Fortran. For subroutines you should use\\
+ \hspace*{2em}\texttt{call <call-back name>(<arguments>)}\\
+ and for functions\\%
+ \hspace*{2em}\texttt{<return value> = <call-back name>(<arguments>)}\\
+ The variables in \texttt{<arguments>} and \texttt{<return value>}
+ must be defined as well. You can use the arguments of the main
+ routine, for instance.
+\item[\texttt{intent(<intentspec>)}] --- this specifies the
+ ``intention'' of the variable. \texttt{<intentspec>} is a comma
+ separated list of the following specifications:
+ \begin{description}
+ \item[\texttt{in}] --- the variable is considered to be an input
+ variable (default). It means that the Fortran function uses only
+ the value(s) of the variable and is assumed not to change it.
+ \item[\texttt{inout}] --- the variable is considered to be an
+ input/output variable which means that Fortran routine may change
+ the value(s) of the variable. Note that in Python only array
+ objects can be changed ``in place''. (\texttt{intent(outin)} is
+ \texttt{intent(inout)}.)
+ \item[\texttt{out}] --- the value of the (output) variable is
+ returned by the wrapper function: it is appended to the list of
+ \texttt{<returned variables>}. If \texttt{out} is specified alone,
+ also \texttt{hide} is assumed.
+ \item[\texttt{hide}] --- use this if the variable \emph{should not}
+ or \emph{need not} to be in the list of wrapper function arguments
+ (not even in optional ones). For example, this is assumed if
+ \texttt{intent(out)} is used. You can ``hide'' an argument if it
+ has always a constant value specified in \texttt{<init\_expr>},
+ for instance.
+ \end{description}
+ The following rules apply:
+ \begin{itemize}
+ \item if no \texttt{intent} attribute is specified, \texttt{intent(in)} is
+ assumed;
+ \item \texttt{intent(in,inout)} is \texttt{intent(in)};
+ \item \texttt{intent(in,hide)}, \texttt{intent(inout,hide)} are \texttt{intent(hide)};
+ \item \texttt{intent(out)} is \texttt{intent(out,hide)};
+\item \texttt{intent(inout)} is NOT \texttt{intent(in,out)}.
+ \end{itemize}
+ In conclusion, the following combinations are ``minimal'':
+ \texttt{intent(in)}, \texttt{intent(inout)}, \texttt{intent(out)},
+ \texttt{intent(hide)}, \texttt{intent(in,out)}, and
+ \texttt{intent(inout,out)}.
+\item[\texttt{check([<C-booleanexpr>])}] --- if
+ \texttt{<C-booleanexpr>} evaluates to zero, an exception is raised
+ about incorrect value or size or any other incorrectness of the
+ variable. If \texttt{check()} or \texttt{check} is used then \fpy
+ will not try to guess the checks automatically.
+\item[\texttt{depend([<names>])}] --- the variable depends on other
+ variables listed in \texttt{<names>}. These dependence relations
+ determine the order of internal initialization of the variables. If
+ you need to change these relations then be careful not to break the
+ dependence relations of other relevant variables. If
+ \texttt{depend()} or \texttt{depend} is used then \fpy will not try
+ to guess the dependence relations automatically.
+\item[\texttt{note(<LaTeX text>)}] --- with this attribute you can
+ include human readable documentation strings to the LaTeX document
+ that \fpy generates. Do not insert here information that \fpy can
+ establish by itself, such as, types, sizes, lengths of the
+ variables. Here you can insert almost arbitrary LaTeX text. Note
+ that \texttt{<LaTeX text>} is mainly used inside the LaTeX
+ \texttt{description} environment. Hint: you can use
+ \texttt{\bs{}texttt\{<name>\}} for typesetting variable \texttt{<name>}
+ in LaTeX. In order to get a new line to the LaTeX document, use
+ \texttt{\bs{}n} followed by a space. For longer text, you may want
+ to use line continuation feature of Fortran 90/95 language: set
+ \texttt{\&} (ampersand)
+ to be the last character in a line.
+\item[\texttt{parameter}] --- the variable is parameter and it must
+ have a value. If the parameter is used in dimension specification,
+ it is replaced by its value. (Are there any other usages of
+ parameters except in dimension specifications? Let me know and I'll
+ add support for it).
+\end{description}
+
+
+\subsection{C-expressions}
+\label{sec:C-expr}
+
+The signature of a routine may contain C-expressions in
+\begin{itemize}
+\item \texttt{<init\_expr>} for initializing particular variable, or in
+\item \texttt{<C-booleanexpr>} of the \texttt{check} attribute, or in
+\item \texttt{<arrayspec>} of the \texttt{dimension} attribute.
+\end{itemize}
+A C-expression may contain
+\begin{itemize}
+\item standard C-statement,
+\item functions offered in \texttt{math.h},
+\item previously initialized variables (study
+the dependence relations) from the argument list, and
+\item the following CPP-macros:
+ \begin{description}
+ \item[\texttt{len(<name>)}] --- the length of an array \texttt{<name>};
+ \item[\texttt{shape(<name>,<n>)}] --- the $n$-th dimension of an array
+ \texttt{<name>};
+ \item[\texttt{rank(<name>)}] --- the rank of an array \texttt{<name>};
+ \item[\texttt{slen(<name>)}] --- the length of a string \texttt{<name>}.
+ \end{description}
+\end{itemize}
+
+
+In addition, when initializing arrays, an index vector \texttt{int
+ \_i[rank(<name>)];}
+is available: \texttt{\_i[0]} refers to
+the index of the first dimension, \texttt{\_i[1]} to the index of
+the second dimension, etc. For example, the argument type declaration\\
+\hspace*{2em}\texttt{integer a(10) = \_i[0]}\\
+is equivalent with the following Python statement\\
+\hspace*{2em}\texttt{a = array(range(10))}
+
+
+\subsection{Required/optional arguments}
+\label{sec:reqoptargs}
+
+When \texttt{optional} attribute is used (including the usage of
+\texttt{<init\_expr>} without the \texttt{required} attribute), the
+corresponding variable in the argument list of a Fortran routine is
+appended to the optional argument list of the wrapper function.
+
+For optional array argument all dimensions must be bounded (not
+\texttt{(*)} or \texttt{(:)}) and defined at the time of
+initialization (dependence relations).
+
+If the \texttt{None} object is passed in in place of a required array
+argument, it will be considered as optional: that is, the memory is
+allocated (of course, if it has unbounded dimensions, an exception
+will be raised), and if \texttt{<init\_expr>} is defined,
+initialization is carried out.
+
+
+\subsection{Internal checks}
+\label{sec:intchecks}
+
+All array arguments are checked against the correctness of their rank.
+If there is a mismatch, \fpy attempts to fix that by constructing an
+array with a correct rank from the given array argument (there will be
+no performance hit as no data is copied). The freedom to do so is
+given only if some dimensions are unbounded or their value is 1. An
+exception is raised when the sizes will not match.
+
+All bounded dimensions of an array are checked to be larger or equal
+to the dimensions specified in the signature.
+
+So, you don't need to give explicit \texttt{check} attributes to check
+these internal checks.
+
+
+\subsection{Call-back modules}
+\label{sec:cbmodule}
+
+A Fortran routine may have \texttt{external} arguments (call-back
+functions). The signatures of the call-back functions must be defined
+in a call-back \texttt{module} block (its name contains
+\texttt{\_\_user\_\_}), in general; other possibilities are described
+in the \texttt{external} attribute specification (see
+Sec.~\ref{sec:attributes}). For the signatures of call-back
+functions the following restrictions apply:
+\begin{itemize}
+\item Attributes \texttt{external}, \texttt{check(...)}, and
+ initialization statements are ignored.
+\item Attribute \texttt{optional} is used only for changing the order
+ of the arguments.
+\item For arrays all dimension bounds must be specified. They may be
+ C-expressions containing variables from the argument list.
+ Note that here CPP-macros \texttt{len}, \texttt{shape},
+ \texttt{rank}, and \texttt{slen} are not available.
+\end{itemize}
+
+
+\subsection{Common blocks}
+\label{sec:commonblocks}
+
+All fields in a common block are mapped to arrays of appropriate sizes
+and types. Scalars are mapped to rank-0 arrays. For multi-dimensional
+fields the corresponding arrays are transposed. In the type
+declarations of the variables representing the common block fields,
+only \texttt{dimension(<arrayspec>)}, \texttt{intent(hide)}, and
+\texttt{note(<LaTeX text>)} attributes are used, others are ignored.
+
+\subsection{Including files}
+\label{sec:include}
+
+You can include files to the signature file using
+\begin{verbatim}
+include '<filename>'
+\end{verbatim}
+statement. It can be used in any part of the signature file.
+If the file \texttt{<filename>} does not exists or it is not in the path,
+the \texttt{include} line is ignored.
+
+\subsection{\fpy directives}
+\label{sec:directives}
+
+You can insert signature statements directly to Fortran source codes
+as comments. Anything that follows \texttt{<comment char>f2py} is
+regarded as normal statement for \fpy.
+
+%%% Local Variables:
+%%% mode: latex
+%%% TeX-master: "f2py2e"
+%%% End:
+
diff --git a/numpy/f2py/doc/using_F_compiler.txt b/numpy/f2py/doc/using_F_compiler.txt
new file mode 100644
index 000000000..3067f0776
--- /dev/null
+++ b/numpy/f2py/doc/using_F_compiler.txt
@@ -0,0 +1,147 @@
+
+Title: Wrapping F compiled Fortran 90 modules with F2PY
+ ================================================
+
+Rationale: The F compiler does not support external procedures which
+ makes it impossible to use it in F2PY in a normal way.
+ This document describes a workaround to this problem so
+ that F compiled codes can be still wrapped with F2PY.
+
+Author: Pearu Peterson
+Date: May 8, 2002
+
+Acknowledgement: Thanks to Siegfried Gonzi who hammered me to produce
+ this document.
+
+Normally wrapping Fortran 90 modules to Python using F2PY is carried
+out with the following command
+
+ f2py -c -m fun foo.f90
+
+where file foo.f90 contains, for example,
+
+module foo
+ public :: bar
+ contains
+ subroutine bar (a)
+ integer,intent(inout) :: a
+ print *,"Hello from foo.bar"
+ print *,"a=",a
+ a = a + 5
+ print *,"a=",a
+ end subroutine bar
+end module foo
+
+Then with a supported F90 compiler (running `f2py -c --help-compiler'
+will display the found compilers) f2py will generate an extension
+module fun.so into the current directory and the Fortran module foo
+subroutine bar can be called from Python as follows
+
+>>> import fun
+>>> print fun.foo.bar.__doc__
+bar - Function signature:
+ bar(a)
+Required arguments:
+ a : in/output rank-0 array(int,'i')
+
+>>> from Numeric import array
+>>> a = array(3)
+>>> fun.foo.bar(a)
+ Hello from foo.bar
+ a= 3
+ a= 8
+>>> a
+8
+>>>
+
+This works nicely with all supported Fortran compilers.
+
+However, the F compiler (http://www.fortran.com/F/compilers.html) is
+an exception. Namely, the F compiler is designed to recognize only
+module procedures (and main programs, of course) but F2PY needs to
+compile also the so-called external procedures that it generates to
+facilitate accessing Fortran F90 module procedures from C and
+subsequently from Python. As a result, wrapping F compiled Fortran
+procedures to Python is _not_ possible using the simple procedure as
+described above. But, there is a workaround that I'll describe below
+in five steps.
+
+1) Compile foo.f90:
+
+ F -c foo.f90
+
+This creates an object file foo.o into the current directory.
+
+2) Create the signature file:
+
+ f2py foo.f90 -h foo.pyf
+
+This creates a file foo.pyf containing
+
+module foo ! in foo.f90
+ real public :: bar
+ subroutine bar(a) ! in foo.f90:foo
+ integer intent(inout) :: a
+ end subroutine bar
+end module foo
+
+3) Open the file foo.pyf with your favorite text editor and change the
+ above signature to
+
+python module foo
+ interface
+ subroutine bar(a)
+ fortranname foo_MP_bar
+ intent(c) bar
+ integer intent(in,out) :: a
+ end subroutine bar
+ end interface
+end python module foo
+
+The most important modifications are
+
+ a) adding `python' keyword everywhere before the `module' keyword
+
+ b) including an `interface' block around the all subroutine blocks.
+
+ c) specifying the real symbol name of the subroutine using
+ `fortranname' statement. F generated symbol names are in the form
+ <module name>_MP_<subroutine name>
+
+ d) specifying that subroutine is `intent(c)'.
+
+Notice that the `intent(inout)' attribute is changed to
+`intent(in,out)' that instructs the wrapper to return the modified
+value of `a'.
+
+4) Build the extension module
+
+ f2py -c foo.pyf foo.o --fcompiler=Gnu /opt/F/lib/quickfit.o \
+ /opt/F/lib/libf96.a
+
+This will create the extension module foo.so into the current
+directory. Notice that you must use Gnu compiler (gcc) for linking.
+And the paths to F specific object files and libraries may differ for
+your F installation.
+
+5) Finally, we can call the module subroutine `bar' from Python
+
+>>> import foo
+>>> print foo.bar.__doc__
+bar - Function signature:
+ a = bar(a)
+Required arguments:
+ a : input int
+Return objects:
+ a : int
+
+>>> foo.bar(3)
+8
+>>>
+
+Notice that the F compiled module procedures are called as ordinary
+external procedures. Also I/O seems to be lacking for F compiled
+Fortran modules.
+
+Enjoy,
+ Pearu
diff --git a/numpy/f2py/doc/win32_notes.txt b/numpy/f2py/doc/win32_notes.txt
new file mode 100644
index 000000000..1b7b9029c
--- /dev/null
+++ b/numpy/f2py/doc/win32_notes.txt
@@ -0,0 +1,85 @@
+The following notes are from Eric Jones.
+
+My Setup:
+
+For Python/Fortran development, I run Windows 2000 and use the mingw32
+(www.mingw.org) set of gcc/g77 compilers and tools (gcc 2.95.2) to build python
+extensions. I'll also ocassionally use MSVC for extension development, but
+rarely on projects that include Fortran code. This short HOWTO describes how
+I use f2py in the Windows environment. Pretty much everything is done from
+a CMD (DOS) prompt, so you'll need to be familiar with using shell commands.
+
+Installing f2py:
+
+Before installing f2py, you'll need to install python. I use python2.1 (maybe
+python2.2 will be out by the time you read this). Any version of Python beyond
+version 1.52 should be fine. See www.python.org for info on installing Python.
+
+You'll also need Numeric which is available at
+http://sourceforge.net/projects/numpy/. The latest version is 20.3.
+
+Since Pearu has moved to a setup.py script, installation is pretty easy. You
+can download f2py from http://cens.ioc.ee/projects/f2py2e/. The latest public
+release is http://cens.ioc.ee/projects/f2py2e/rel-3.x/f2py-3.latest.tgz. Even
+though this is a .tgz file instead of a .zip file, most standard compression
+utilities such as WinZip (www.winzip.com) handle unpacking .tgz files
+automatically. Here are the download steps:
+
+ 1. Download the latest version of f2py and save it to disk.
+
+ 2. Use WinZip or some other tool to open the "f2py.xxx.tgz" file.
+ a. When WinZip says archive contains one file, "f2py.xxx.tar"
+ and ask if it should open it, respond with "yes".
+ b. Extract (use the extract button at the top) all the files
+ in the archive into a file. I'll use c:\f2py2e
+
+ 3. Open a cmd prompt by clicking start->run and typing "cmd.exe".
+ Now type the following commands.
+
+ C:\WINDOWS\SYSTEM32> cd c:\f2py2e
+ C:\F2PY2E> python setup.py install
+
+ This will install f2py in the c:\python21\f2py2e directory. It
+ also copies a few scripts into the c:\python21\Scripts directory.
+ Thats all there is to installing f2py. Now lets set up the environment
+ so that f2py is easy to use.
+
+ 4. You need to set up a couple of environement variables. The path
+ "c:\python21\Scripts" needs to be added to your path variables.
+ To do this, go to the enviroment variables settings page. This is
+ where it is on windows 2000:
+
+ Desktop->(right click)My Computer->Properties->Advanced->
+ Environment Variables
+
+ a. Add "c:\python21\Scripts" to the end of the Path variable.
+ b. If it isn't already there, add ".py" to the PATHEXT variable.
+ This tells the OS to execute f2py.py even when just "f2py" is
+ typed at a command prompt.
+
+ 5. Well, there actually isn't anything to be done here. The Python
+ installation should have taken care of associating .py files with
+ Python for execution, so you shouldn't have to do anything to
+ registry settings.
+
+To test your installation, open a new cmd prompt, and type the following:
+
+ C:\WINDOWS\SYSTEM32> f2py
+ Usage:
+ f2py [<options>] <fortran files> [[[only:]||[skip:]] \
+ <fortran functions> ] \
+ [: <fortran files> ...]
+ ...
+
+This prints out the usage information for f2py. If it doesn't, there is
+something wrong with the installation.
+
+Testing:
+The f2py test scripts are kinda Unix-centric, so they don't work under windows.
+
+XXX include test script XXX.
+
+Compiler and setup.py issues:
+
+XXX
+
diff --git a/numpy/f2py/docs/FAQ.txt b/numpy/f2py/docs/FAQ.txt
new file mode 100644
index 000000000..416560e92
--- /dev/null
+++ b/numpy/f2py/docs/FAQ.txt
@@ -0,0 +1,615 @@
+
+======================================================================
+ F2PY Frequently Asked Questions
+======================================================================
+
+.. contents::
+
+General information
+===================
+
+Q: How to get started?
+----------------------
+
+First, install__ F2PY. Then check that F2PY installation works
+properly (see below__). Try out a `simple example`__.
+
+Read `F2PY Users Guide and Reference Manual`__. It contains lots
+of complete examples.
+
+If you have any questions/problems when using F2PY, don't hesitate to
+turn to `F2PY users mailing list`__ or directly to me.
+
+__ index.html#installation
+__ #testing
+__ index.html#usage
+__ usersguide/index.html
+__ index.html#mailing-list
+
+Q: When to report bugs?
+-----------------------
+
+* If F2PY scanning fails on Fortran sources that otherwise compile
+ fine.
+
+* After checking that you have the latest version of F2PY from its
+ CVS. It is possible that a bug has been fixed already. See also the
+ log entries in the file `HISTORY.txt`_ (`HISTORY.txt in CVS`_).
+
+* After checking that your Python and Numerical Python installations
+ work correctly.
+
+* After checking that your C and Fortran compilers work correctly.
+
+
+Q: How to report bugs?
+----------------------
+
+You can send bug reports directly to me. Please, include information
+about your platform (operating system, version) and
+compilers/linkers, e.g. the output (both stdout/stderr) of
+::
+
+ python -c 'import f2py2e.diagnose;f2py2e.diagnose.run()'
+
+Feel free to add any other relevant information. However, avoid
+sending the output of F2PY generated ``.pyf`` files (unless they are
+manually modified) or any binary files like shared libraries or object
+codes.
+
+While reporting bugs, you may find the following notes useful:
+
+* `How To Ask Questions The Smart Way`__ by E. S. Raymond and R. Moen.
+
+* `How to Report Bugs Effectively`__ by S. Tatham.
+
+__ http://www.catb.org/~esr/faqs/smart-questions.html
+__ http://www.chiark.greenend.org.uk/~sgtatham/bugs.html
+
+Installation
+============
+
+Q: How to use F2PY with different Python versions?
+--------------------------------------------------
+
+Run the installation command using the corresponding Python
+executable. For example,
+::
+
+ python2.1 setup.py install
+
+installs the ``f2py`` script as ``f2py2.1``.
+
+See `Distutils User Documentation`__ for more information how to
+install Python modules to non-standard locations.
+
+__ http://www.python.org/sigs/distutils-sig/doc/inst/inst.html
+
+
+Q: Why F2PY is not working after upgrading?
+-------------------------------------------
+
+If upgrading from F2PY version 2.3.321 or earlier then remove all f2py
+specific files from ``/path/to/python/bin`` directory before
+running installation command.
+
+Q: How to get/upgrade numpy_distutils when using F2PY from CVS?
+---------------------------------------------------------------
+
+To get numpy_distutils from SciPy CVS repository, run
+::
+
+ cd cvs/f2py2e/
+ make numpy_distutils
+
+This will checkout numpy_distutils to the current directory.
+
+You can upgrade numpy_distutils by executing
+::
+
+ cd cvs/f2py2e/numpy_distutils
+ cvs update -Pd
+
+and install it by executing
+::
+
+ cd cvs/f2py2e/numpy_distutils
+ python setup_numpy_distutils.py install
+
+In most of the time, f2py2e and numpy_distutils can be upgraded
+independently.
+
+Testing
+=======
+
+Q: How to test if F2PY is installed correctly?
+----------------------------------------------
+
+Run
+::
+
+ f2py
+
+without arguments. If F2PY is installed correctly then it should print
+the usage information for f2py.
+
+Q: How to test if F2PY is working correctly?
+--------------------------------------------
+
+For a quick test, try out an example problem from Usage__
+section in `README.txt`_.
+
+__ index.html#usage
+
+For running F2PY unit tests, see `TESTING.txt`_.
+
+
+Q: How to run tests and examples in f2py2e/test-suite/ directory?
+---------------------------------------------------------------------
+
+You shouldn't. These tests are obsolete and I have no intention to
+make them work. They will be removed in future.
+
+
+Compiler/Platform-specific issues
+=================================
+
+Q: What are supported platforms and compilers?
+----------------------------------------------
+
+F2PY is developed on Linux system with a GCC compiler (versions
+2.95.x, 3.x). Fortran 90 related hooks are tested against Intel
+Fortran Compiler. F2PY should work under any platform where Python and
+Numeric are installed and has supported Fortran compiler installed.
+
+To see a list of supported compilers, execute::
+
+ f2py -c --help-fcompiler
+
+Example output::
+
+ List of available Fortran compilers:
+ --fcompiler=gnu GNU Fortran Compiler (3.3.4)
+ --fcompiler=intel Intel Fortran Compiler for 32-bit apps (8.0)
+ List of unavailable Fortran compilers:
+ --fcompiler=absoft Absoft Corp Fortran Compiler
+ --fcompiler=compaq Compaq Fortran Compiler
+ --fcompiler=compaqv DIGITAL|Compaq Visual Fortran Compiler
+ --fcompiler=hpux HP Fortran 90 Compiler
+ --fcompiler=ibm IBM XL Fortran Compiler
+ --fcompiler=intele Intel Fortran Compiler for Itanium apps
+ --fcompiler=intelev Intel Visual Fortran Compiler for Itanium apps
+ --fcompiler=intelv Intel Visual Fortran Compiler for 32-bit apps
+ --fcompiler=lahey Lahey/Fujitsu Fortran 95 Compiler
+ --fcompiler=mips MIPSpro Fortran Compiler
+ --fcompiler=nag NAGWare Fortran 95 Compiler
+ --fcompiler=pg Portland Group Fortran Compiler
+ --fcompiler=sun Sun|Forte Fortran 95 Compiler
+ --fcompiler=vast Pacific-Sierra Research Fortran 90 Compiler
+ List of unimplemented Fortran compilers:
+ --fcompiler=f Fortran Company/NAG F Compiler
+ For compiler details, run 'config_fc --verbose' setup command.
+
+
+Q: How to use the F compiler in F2PY?
+-------------------------------------
+
+Read `f2py2e/doc/using_F_compiler.txt`__. It describes why the F
+compiler cannot be used in a normal way (i.e. using ``-c`` switch) to
+build F2PY generated modules. It also gives a workaround to this
+problem.
+
+__ http://cens.ioc.ee/cgi-bin/viewcvs.cgi/python/f2py2e/doc/using_F_compiler.txt?rev=HEAD&content-type=text/vnd.viewcvs-markup
+
+Q: How to use F2PY under Windows?
+---------------------------------
+
+F2PY can be used both within Cygwin__ and MinGW__ environments under
+Windows, F2PY can be used also in Windows native terminal.
+See the section `Setting up environment`__ for Cygwin and MinGW.
+
+__ http://cygwin.com/
+__ http://www.mingw.org/
+__ http://cens.ioc.ee/~pearu/numpy/BUILD_WIN32.html#setting-up-environment
+
+Install numpy_distutils and F2PY. Win32 installers of these packages
+are provided in `F2PY Download`__ section.
+
+__ http://cens.ioc.ee/projects/f2py2e/#download
+
+Use ``--compiler=`` and ``--fcompiler`` F2PY command line switches to
+to specify which C and Fortran compilers F2PY should use, respectively.
+
+Under MinGW environment, ``mingw32`` is default for a C compiler.
+
+Supported and Unsupported Features
+==================================
+
+Q: Does F2PY support ``ENTRY`` statements?
+------------------------------------------
+
+Yes, starting at F2PY version higher than 2.39.235_1706.
+
+Q: Does F2PY support derived types in F90 code?
+-----------------------------------------------
+
+Not yet. However I do have plans to implement support for F90 TYPE
+constructs in future. But note that the task in non-trivial and may
+require the next edition of F2PY for which I don't have resources to
+work with at the moment.
+
+Jeffrey Hagelberg from LLNL has made progress on adding
+support for derived types to f2py. He writes:
+
+ At this point, I have a version of f2py that supports derived types
+ for most simple cases. I have multidimensional arrays of derived
+ types and allocatable arrays of derived types working. I'm just now
+ starting to work on getting nested derived types to work. I also
+ haven't tried putting complex number in derived types yet.
+
+Hopefully he can contribute his changes to f2py soon.
+
+Q: Does F2PY support pointer data in F90 code?
+-----------------------------------------------
+
+No. I have never needed it and I haven't studied if there are any
+obstacles to add pointer data support to F2PY.
+
+Q: What if Fortran 90 code uses ``<type spec>(kind=KIND(..))``?
+---------------------------------------------------------------
+
+Currently, F2PY can handle only ``<type spec>(kind=<kindselector>)``
+declarations where ``<kindselector>`` is a numeric integer (e.g. 1, 2,
+4,...) but not a function call ``KIND(..)`` or any other
+expression. F2PY needs to know what would be the corresponding C type
+and a general solution for that would be too complicated to implement.
+
+However, F2PY provides a hook to overcome this difficulty, namely,
+users can define their own <Fortran type> to <C type> maps. For
+example, if Fortran 90 code contains::
+
+ REAL(kind=KIND(0.0D0)) ...
+
+then create a file ``.f2py_f2cmap`` (into the working directory)
+containing a Python dictionary::
+
+ {'real':{'KIND(0.0D0)':'double'}}
+
+for instance.
+
+Or more generally, the file ``.f2py_f2cmap`` must contain a dictionary
+with items::
+
+ <Fortran typespec> : {<selector_expr>:<C type>}
+
+that defines mapping between Fortran type::
+
+ <Fortran typespec>([kind=]<selector_expr>)
+
+and the corresponding ``<C type>``. ``<C type>`` can be one of the
+following::
+
+ char
+ signed_char
+ short
+ int
+ long_long
+ float
+ double
+ long_double
+ complex_float
+ complex_double
+ complex_long_double
+ string
+
+For more information, see ``f2py2e/capi_maps.py``.
+
+Related software
+================
+
+Q: How F2PY distinguishes from Pyfort?
+--------------------------------------
+
+F2PY and Pyfort have very similar aims and ideology of how they are
+targeted. Both projects started to evolve in the same year 1999
+independently. When we discovered each others projects, a discussion
+started to join the projects but that unfortunately failed for
+various reasons, e.g. both projects had evolved too far that merging
+the tools would have been impractical and giving up the efforts that
+the developers of both projects have made was unacceptable to both
+parties. And so, nowadays we have two tools for connecting Fortran
+with Python and this fact will hardly change in near future. To decide
+which one to choose is a matter of taste, I can only recommend to try
+out both to make up your choice.
+
+At the moment F2PY can handle more wrapping tasks than Pyfort,
+e.g. with F2PY one can wrap Fortran 77 common blocks, Fortran 90
+module routines, Fortran 90 module data (including allocatable
+arrays), one can call Python from Fortran, etc etc. F2PY scans Fortran
+codes to create signature (.pyf) files. F2PY is free from most of the
+limitations listed in in `the corresponding section of Pyfort
+Reference Manual`__.
+
+__ http://pyfortran.sourceforge.net/pyfort/pyfort_reference.htm#pgfId-296925
+
+There is a conceptual difference on how F2PY and Pyfort handle the
+issue of different data ordering in Fortran and C multi-dimensional
+arrays. Pyfort generated wrapper functions have optional arguments
+TRANSPOSE and MIRROR that can be used to control explicitly how the array
+arguments and their dimensions are passed to Fortran routine in order
+to deal with the C/Fortran data ordering issue. F2PY generated wrapper
+functions hide the whole issue from an end-user so that translation
+between Fortran and C/Python loops and array element access codes is
+one-to-one. How the F2PY generated wrappers deal with the issue is
+determined by a person who creates a signature file via using
+attributes like ``intent(c)``, ``intent(copy|overwrite)``,
+``intent(inout|in,out|inplace)`` etc.
+
+For example, let's consider a typical usage of both F2PY and Pyfort
+when wrapping the following simple Fortran code:
+
+.. include:: simple.f
+ :literal:
+
+The comment lines starting with ``cf2py`` are read by F2PY (so that we
+don't need to generate/handwrite an intermediate signature file in
+this simple case) while for a Fortran compiler they are just comment
+lines.
+
+And here is a Python version of the Fortran code:
+
+.. include:: pytest.py
+ :literal:
+
+To generate a wrapper for subroutine ``foo`` using F2PY, execute::
+
+ $ f2py -m f2pytest simple.f -c
+
+that will generate an extension module ``f2pytest`` into the current
+directory.
+
+To generate a wrapper using Pyfort, create the following file
+
+.. include:: pyforttest.pyf
+ :literal:
+
+and execute::
+
+ $ pyfort pyforttest
+
+In Pyfort GUI add ``simple.f`` to the list of Fortran sources and
+check that the signature file is in free format. And then copy
+``pyforttest.so`` from the build directory to the current directory.
+
+Now, in Python
+
+.. include:: simple_session.dat
+ :literal:
+
+Q: Can Pyfort .pyf files used with F2PY and vice versa?
+-------------------------------------------------------
+
+After some simple modifications, yes. You should take into account the
+following differences in Pyfort and F2PY .pyf files.
+
++ F2PY signature file contains ``python module`` and ``interface``
+ blocks that are equivalent to Pyfort ``module`` block usage.
+
++ F2PY attribute ``intent(inplace)`` is equivalent to Pyfort
+ ``intent(inout)``. F2PY ``intent(inout)`` is a strict (but safe)
+ version of ``intent(inplace)``, any mismatch in arguments with
+ expected type, size, or contiguouness will trigger an exception
+ while ``intent(inplace)`` (dangerously) modifies arguments
+ attributes in-place.
+
+Misc
+====
+
+Q: How to establish which Fortran compiler F2PY will use?
+---------------------------------------------------------
+
+This question may be releavant when using F2PY in Makefiles. Here
+follows a script demonstrating how to determine which Fortran compiler
+and flags F2PY will use::
+
+ # Using post-0.2.2 numpy_distutils
+ from numpy_distutils.fcompiler import new_fcompiler
+ compiler = new_fcompiler() # or new_fcompiler(compiler='intel')
+ compiler.dump_properties()
+
+ # Using pre-0.2.2 numpy_distutils
+ import os
+ from numpy_distutils.command.build_flib import find_fortran_compiler
+ def main():
+ fcompiler = os.environ.get('FC_VENDOR')
+ fcompiler_exec = os.environ.get('F77')
+ f90compiler_exec = os.environ.get('F90')
+ fc = find_fortran_compiler(fcompiler,
+ fcompiler_exec,
+ f90compiler_exec,
+ verbose = 0)
+ print 'FC=',fc.f77_compiler
+ print 'FFLAGS=',fc.f77_switches
+ print 'FOPT=',fc.f77_opt
+ if __name__ == "__main__":
+ main()
+
+Users feedback
+==============
+
+Q: Where to find additional information on using F2PY?
+------------------------------------------------------
+
+There are several F2PY related tutorials, slides, papers, etc
+available:
+
++ `Fortran to Python Interface Generator with an Application to
+ Aerospace Engineering`__ by P. Peterson, J. R. R. A. Martins, and
+ J. J. Alonso in `In Proceedings of the 9th International Python
+ Conference`__, Long Beach, California, 2001.
+
+__ http://www.python9.org/p9-cdrom/07/index.htm
+__ http://www.python9.org/
+
++ Section `Adding Fortran90 code`__ in the UG of `The Bolometer Data
+ Analysis Project`__.
+
+__ http://www.astro.rub.de/laboca/download/boa_master_doc/7_4Adding_Fortran90_code.html
+__ http://www.openboa.de/
+
++ Powerpoint presentation `Python for Scientific Computing`__ by Eric
+ Jones in `The Ninth International Python Conference`__.
+
+__ http://www.python9.org/p9-jones.ppt
+__ http://www.python9.org/
+
++ Paper `Scripting a Large Fortran Code with Python`__ by Alvaro Caceres
+ Calleja in `International Workshop on Software Engineering for High
+ Performance Computing System Applications`__.
+
+__ http://csdl.ics.hawaii.edu/se-hpcs/pdf/calleja.pdf
+__ http://csdl.ics.hawaii.edu/se-hpcs/
+
++ Section `Automatic building of C/Fortran extension for Python`__ by
+ Simon Lacoste-Julien in `Summer 2002 Report about Hybrid Systems
+ Modelling`__.
+
+__ http://moncs.cs.mcgill.ca/people/slacoste/research/report/SummerReport.html#tth_sEc3.4
+__ http://moncs.cs.mcgill.ca/people/slacoste/research/report/SummerReport.html
+
++ `Scripting for Computational Science`__ by Hans Petter Langtangen
+ (see the `Mixed language programming`__ and `NumPy array programming`__
+ sections for examples on using F2PY).
+
+__ http://www.ifi.uio.no/~inf3330/lecsplit/
+__ http://www.ifi.uio.no/~inf3330/lecsplit/slide662.html
+__ http://www.ifi.uio.no/~inf3330/lecsplit/slide718.html
+
++ Chapters 5 and 9 of `Python Scripting for Computational Science`__
+ by H. P. Langtangen for case studies on using F2PY.
+
+__ http://www.springeronline.com/3-540-43508-5
+
++ Section `Fortran Wrapping`__ in `Continuity`__, a computational tool
+ for continuum problems in bioengineering and physiology.
+
+__ http://www.continuity.ucsd.edu/cont6_html/docs_fram.html
+__ http://www.continuity.ucsd.edu/
+
++ Presentation `PYFORT and F2PY: 2 ways to bind C and Fortran with Python`__
+ by Reiner Vogelsang.
+
+__ http://www.prism.enes.org/WPs/WP4a/Slides/pyfort/pyfort.html
+
++ Lecture slides of `Extending Python: speed it up`__.
+
+__ http://www.astro.uni-bonn.de/~heith/lecture_pdf/friedrich5.pdf
+
++ Wiki topics on `Wrapping Tools`__ and `Wrapping Bemchmarks`__ for Climate
+ System Center at the University of Chicago.
+
+__ https://geodoc.uchicago.edu/climatewiki/DiscussWrappingTools
+__ https://geodoc.uchicago.edu/climatewiki/WrappingBenchmarks
+
++ `Performance Python with Weave`__ by Prabhu Ramachandran.
+
+__ http://www.numpy.org/documentation/weave/weaveperformance.html
+
++ `How To Install py-f2py on Mac OSX`__
+
+__ http://py-f2py.darwinports.com/
+
+Please, let me know if there are any other sites that document F2PY
+usage in one or another way.
+
+Q: What projects use F2PY?
+--------------------------
+
++ `SciPy: Scientific tools for Python`__
+
+__ http://www.numpy.org/
+
++ `The Bolometer Data Analysis Project`__
+
+__ http://www.openboa.de/
+
++ `pywavelet`__
+
+__ http://www.met.wau.nl/index.html?http://www.met.wau.nl/medewerkers/moenea/python/pywavelet.html
+
++ `PyARTS: an ARTS related Python package`__.
+
+__ http://www.met.ed.ac.uk/~cory/PyARTS/
+
++ `Python interface to PSPLINE`__, a collection of Spline and
+ Hermite interpolation tools for 1D, 2D, and 3D datasets on
+ rectilinear grids.
+
+__ http://pypspline.sourceforge.net
+
++ `Markovian Analysis Package for Python`__.
+
+__ http://pymc.sourceforge.net
+
++ `Modular toolkit for Data Processing (MDP)`__
+
+__ http://mdp-toolkit.sourceforge.net/
+
+
+Please, send me a note if you are using F2PY in your project.
+
+Q: What people think about F2PY?
+--------------------------------
+
+*F2PY is GOOD*:
+
+Here are some comments people have posted to f2py mailing list and c.l.py:
+
++ Ryan Krauss: I really appreciate f2py. It seems weird to say, but I
+ am excited about relearning FORTRAN to compliment my python stuff.
+
++ Fabien Wahl: f2py is great, and is used extensively over here...
+
++ Fernando Perez: Anyway, many many thanks for this amazing tool.
+
+ I haven't used pyfort, but I can definitely vouch for the amazing quality of
+ f2py. And since f2py is actively used by numpy, it won't go unmaintained.
+ It's quite impressive, and very easy to use.
+
++ Kevin Mueller: First off, thanks to those responsible for F2PY;
+ its been an integral tool of my research for years now.
+
++ David Linke: Best regards and thanks for the great tool!
+
++ Perrin Meyer: F2Py is really useful!
+
++ Hans Petter Langtangen: First of all, thank you for developing
+ F2py. This is a very important contribution to the scientific
+ computing community. We are using F2py a lot and are very happy with
+ it.
+
++ Berthold Höllmann: Thank's alot. It seems it is also working in my
+ 'real' application :-)
+
++ John Hunter: At first I wrapped them with f2py (unbelievably easy!)...
+
++ Cameron Laird: Among many other features, Python boasts a mature
+ f2py, which makes it particularly rewarding to yoke Fortran- and
+ Python-coded modules into finished applications.
+
++ Ryan Gutenkunst: f2py is sweet magic.
+
+*F2PY is BAD*:
+
++ `Is it worth using on a large scale python drivers for Fortran
+ subroutines, interfaced with f2py?`__
+
+__ http://sepwww.stanford.edu/internal/computing/python.html
+
+Additional comments on F2PY, good or bad, are welcome!
+
+.. References:
+.. _README.txt: index.html
+.. _HISTORY.txt: HISTORY.html
+.. _HISTORY.txt in CVS: http://cens.ioc.ee/cgi-bin/cvsweb/python/f2py2e/docs/HISTORY.txt?rev=HEAD&content-type=text/x-cvsweb-markup
+.. _TESTING.txt: TESTING.html
diff --git a/numpy/f2py/docs/HISTORY.txt b/numpy/f2py/docs/HISTORY.txt
new file mode 100644
index 000000000..72b683eb0
--- /dev/null
+++ b/numpy/f2py/docs/HISTORY.txt
@@ -0,0 +1,1044 @@
+.. -*- rest -*-
+
+=========================
+ F2PY History
+=========================
+
+:Author: Pearu Peterson <pearu@cens.ioc.ee>
+:Web-site: http://cens.ioc.ee/projects/f2py2e/
+:Date: $Date: 2005/09/16 08:36:45 $
+:Revision: $Revision: 1.191 $
+
+.. Contents::
+
+Release 2.46.243
+=====================
+
+* common_rules.py
+
+ - Fixed compiler warnings.
+
+* fortranobject.c
+
+ - Fixed another dims calculation bug.
+ - Fixed dims calculation bug and added the corresponding check.
+ - Accept higher dimensional arrays if their effective rank matches.
+ Effective rank is multiplication of non-unit dimensions.
+
+* f2py2e.py
+
+ - Added support for numpy.distutils version 0.4.0.
+
+* Documentation
+
+ - Added example about ``intent(callback,hide)`` usage. Updates.
+ - Updated FAQ.
+
+* cb_rules.py
+
+ - Fixed missing need kw error.
+ - Fixed getting callback non-existing extra arguments.
+ - External callback functions and extra_args can be set via
+ ext.module namespace.
+ - Avoid crash when external callback function is not set.
+
+* rules.py
+
+ - Enabled ``intent(out)`` for ``intent(aux)`` non-complex scalars.
+ - Fixed splitting lines in F90 fixed form mode.
+ - Fixed FORTRANAME typo, relevant when wrapping scalar functions with
+ ``--no-wrap-functions``.
+ - Improved failure handling for callback functions.
+ - Fixed bug in writting F90 wrapper functions when a line length
+ is exactly 66.
+
+* cfuncs.py
+
+ - Fixed dependency issue with typedefs.
+ - Introduced ``-DUNDERSCORE_G77`` that cause extra underscore to be
+ used for external names that contain an underscore.
+
+* capi_maps.py
+
+ - Fixed typos.
+ - Fixed using complex cb functions.
+
+* crackfortran.py
+
+ - Introduced parent_block key. Get ``use`` statements recursively
+ from parent blocks.
+ - Apply parameter values to kindselectors.
+ - Fixed bug evaluating ``selected_int_kind`` function.
+ - Ignore Name and Syntax errors when evaluating scalars.
+ - Treat ``<int>_intType`` as ``<int>`` in get_parameters.
+ - Added support for F90 line continuation in fix format mode.
+ - Include optional attribute of external to signature file.
+ - Add ``entry`` arguments to variable lists.
+ - Treat \xa0 character as space.
+ - Fixed bug where __user__ callback subroutine was added to its
+ argument list.
+ - In strict 77 mode read only the first 72 columns.
+ - Fixed parsing ``v(i) = func(r)``.
+ - Fixed parsing ``integer*4::``.
+ - Fixed parsing ``1.d-8`` when used as a parameter value.
+
+Release 2.45.241_1926
+=====================
+
+* diagnose.py
+
+ - Clean up output.
+
+* cb_rules.py
+
+ - Fixed ``_cpointer`` usage for subroutines.
+ - Fortran function ``_cpointer`` can be used for callbacks.
+
+* func2subr.py
+
+ - Use result name when wrapping functions with subroutines.
+
+* f2py2e.py
+
+ - Fixed ``--help-link`` switch.
+ - Fixed ``--[no-]lower`` usage with ``-c`` option.
+ - Added support for ``.pyf.src`` template files.
+
+* __init__.py
+
+ - Using ``exec_command`` in ``compile()``.
+
+* setup.py
+
+ - Clean up.
+ - Disabled ``need_numpy_distutils`` function. From now on it is assumed
+ that proper version of ``numpy_distutils`` is already installed.
+
+* capi_maps.py
+
+ - Added support for wrapping unsigned integers. In a .pyf file
+ ``integer(-1)``, ``integer(-2)``, ``integer(-4)`` correspond to
+ ``unsigned char``, ``unsigned short``, ``unsigned`` C types,
+ respectively.
+
+* tests/c/return_real.py
+
+ - Added tests to wrap C functions returning float/double.
+
+* fortranobject.c
+
+ - Added ``_cpointer`` attribute to wrapped objects.
+
+* rules.py
+
+ - ``_cpointer`` feature for wrapped module functions is not
+ functional at the moment.
+ - Introduced ``intent(aux)`` attribute. Useful to save a value
+ of a parameter to auxiliary C variable. Note that ``intent(aux)``
+ implies ``intent(c)``.
+ - Added ``usercode`` section. When ``usercode`` is used in ``python
+ module`` block twise then the contents of the second multi-line
+ block is inserted after the definition of external routines.
+ - Call-back function arguments can be CObjects.
+
+* cfuncs.py
+
+ - Allow call-back function arguments to be fortran objects.
+ - Allow call-back function arguments to be built-in functions.
+
+* crackfortran.py
+
+ - Fixed detection of a function signature from usage example.
+ - Cleaned up -h output for intent(callback) variables.
+ - Repair malformed argument list (missing argument name).
+ - Warn on the usage of multiple attributes without type specification.
+ - Evaluate only scalars ``<initexpr>`` (e.g. not of strings).
+ - Evaluate ``<initexpr>`` using parameters name space.
+ - Fixed resolving `<name>(<args>)[result(<result>)]` pattern.
+ - ``usercode`` can be used more than once in the same context.
+
+Release 2.43.239_1831
+=====================
+
+* auxfuncs.py
+
+ - Made ``intent(in,inplace)`` to mean ``intent(inplace)``.
+
+* f2py2e.py
+
+ - Intoduced ``--help-link`` and ``--link-<resource>``
+ switches to link generated extension module with system
+ ``<resource>`` as defined by numpy_distutils/system_info.py.
+
+* fortranobject.c
+
+ - Patch to make PyArray_CanCastSafely safe on 64-bit machines.
+ Fixes incorrect results when passing ``array('l')`` to
+ ``real*8 intent(in,out,overwrite)`` arguments.
+
+* rules.py
+
+ - Avoid empty continuation lines in Fortran wrappers.
+
+* cfuncs.py
+
+ - Adding ``\0`` at the end of a space-padded string, fixes tests
+ on 64-bit Gentoo.
+
+* crackfortran.py
+
+ - Fixed splitting lines with string parameters.
+
+Release 2.43.239_1806
+=====================
+
+* Tests
+
+ - Fixed test site that failed after padding strings with spaces
+ instead of zeros.
+
+* Documentation
+
+ - Documented ``intent(inplace)`` attribute.
+ - Documented ``intent(callback)`` attribute.
+ - Updated FAQ, added Users Feedback section.
+
+* cfuncs.py
+
+ - Padding longer (than provided from Python side) strings with spaces
+ (that is Fortran behavior) instead of nulls (that is C strncpy behavior).
+
+* f90mod_rules.py
+
+ - Undoing rmbadnames in Python and Fortran layers.
+
+* common_rules.py
+
+ - Renaming common block items that have names identical to C keywords.
+ - Fixed wrapping blank common blocks.
+
+* fortranobject.h
+
+ - Updated numarray (0.9, 1.0, 1.1) support (patch by Todd Miller).
+
+* fortranobject.c
+
+ - Introduced ``intent(inplace)`` feature.
+ - Fix numarray reference counts (patch by Todd).
+ - Updated numarray (0.9, 1.0, 1.1) support (patch by Todd Miller).
+ - Enabled F2PY_REPORT_ON_ARRAY_COPY for Numarray.
+
+* capi_maps.py
+
+ - Always normalize .f2py_f2cmap keys to lower case.
+
+* rules.py
+
+ - Disabled ``index`` macro as it conflicts with the one defined
+ in string.h.
+ - Moved ``externroutines`` up to make it visible to ``usercode``.
+ - Fixed bug in f90 code generation: no empty line continuation is
+ allowed.
+ - Fixed undefined symbols failure when ``fortranname`` is used
+ to rename a wrapped function.
+ - Support for ``entry`` statement.
+
+* auxfuncs.py
+
+ - Made is* functions more robust with respect to parameters that
+ have no typespec specified.
+ - Using ``size_t`` instead of ``int`` as the type of string
+ length. Fixes issues on 64-bit platforms.
+
+* setup.py
+
+ - Fixed bug of installing ``f2py`` script as ``.exe`` file.
+
+* f2py2e.py
+
+ - ``--compiler=`` and ``--fcompiler=`` can be specified at the same time.
+
+* crackfortran.py
+
+ - Fixed dependency detection for non-intent(in|inout|inplace) arguments.
+ They must depend on their dimensions, not vice-versa.
+ - Don't match ``!!f2py`` as a start of f2py directive.
+ - Only effective intent attributes will be output to ``-h`` target.
+ - Introduced ``intent(callback)`` to build interface between Python
+ functions and Fortran external routines.
+ - Avoid including external arguments to __user__ modules.
+ - Initial hooks to evaluate ``kind`` and ``selected_int_kind``.
+ - Evaluating parameters in {char,kind}selectors and applying rmbadname.
+ - Evaluating parameters using also module parameters. Fixed the order
+ of parameter evaluation.
+ - Fixed silly bug: when block name was not lower cased, it was not
+ recognized correctly.
+ - Applying mapping '.false.'->'False', '.true.'->'True' to logical
+ parameters. TODO: Support for logical expressions is needed.
+ - Added support for multiple statements in one line (separated with semicolon).
+ - Impl. get_useparameters function for using parameter values from
+ other f90 modules.
+ - Applied Bertholds patch to fix bug in evaluating expressions
+ like ``1.d0/dvar``.
+ - Fixed bug in reading string parameters.
+ - Evaluating parameters in charselector. Code cleanup.
+ - Using F90 module parameters to resolve kindselectors.
+ - Made the evaluation of module data init-expression more robust.
+ - Support for ``entry`` statement.
+ - Fixed ``determineexprtype`` that in the case of parameters
+ returned non-dictionary objects.
+ - Use ``-*- fix -*-`` to specify that a file is in fixed format.
+
+Release 2.39.235_1693
+=====================
+
+* fortranobject.{h,c}
+
+ - Support for allocatable string arrays.
+
+* cfuncs.py
+
+ - Call-back arguments can now be also instances that have ``__call__`` method
+ as well as instance methods.
+
+* f2py2e.py
+
+ - Introduced ``--include_paths <path1>:<path2>:..`` command line
+ option.
+ - Added ``--compiler=`` support to change the C/C++ compiler from
+ f2py command line.
+
+* capi_maps.py
+
+ - Handle ``XDY`` parameter constants.
+
+* crackfortran.py
+
+ - Handle ``XDY`` parameter constants.
+
+ - Introduced formatpattern to workaround a corner case where reserved
+ keywords are used in format statement. Other than that, format pattern
+ has no use.
+
+ - Parameters are now fully evaluated.
+
+* More splitting of documentation strings.
+
+* func2subr.py - fixed bug for function names that f77 compiler
+ would set ``integer`` type.
+
+Release 2.39.235_1660
+=====================
+
+* f2py2e.py
+
+ - Fixed bug in using --f90flags=..
+
+* f90mod_rules.py
+
+ - Splitted generated documentation strings (to avoid MSVC issue when
+ string length>2k)
+
+ - Ignore ``private`` module data.
+
+Release 2.39.235_1644
+=====================
+
+:Date:24 February 2004
+
+* Character arrays:
+
+ - Finished complete support for character arrays and arrays of strings.
+ - ``character*n a(m)`` is treated like ``character a(m,n)`` with ``intent(c)``.
+ - Character arrays are now considered as ordinary arrays (not as arrays
+ of strings which actually didn't work).
+
+* docs
+
+ - Initial f2py manpage file f2py.1.
+ - Updated usersguide and other docs when using numpy_distutils 0.2.2
+ and up.
+
+* capi_maps.py
+
+ - Try harder to use .f2py_f2cmap mappings when kind is used.
+
+* crackfortran.py
+
+ - Included files are first search in the current directory and
+ then from the source file directory.
+ - Ignoring dimension and character selector changes.
+ - Fixed bug in Fortran 90 comments of fixed format.
+ - Warn when .pyf signatures contain undefined symbols.
+ - Better detection of source code formats. Using ``-*- fortran -*-``
+ or ``-*- f90 -*-`` in the first line of a Fortran source file is
+ recommended to help f2py detect the format, fixed or free,
+ respectively, correctly.
+
+* cfuncs.py
+
+ - Fixed intent(inout) scalars when typecode=='l'.
+ - Fixed intent(inout) scalars when not using numarray.
+ - Fixed intent(inout) scalars when using numarray.
+
+* diagnose.py
+
+ - Updated for numpy_distutils 0.2.2 and up.
+ - Added numarray support to diagnose.
+
+* fortranobject.c
+
+ - Fixed nasty bug with intent(in,copy) complex slice arrays.
+ - Applied Todd's patch to support numarray's byteswapped or
+ misaligned arrays, requires numarray-0.8 or higher.
+
+* f2py2e.py
+
+ - Applying new hooks for numpy_distutils 0.2.2 and up, keeping
+ backward compatibility with depreciation messages.
+ - Using always os.system on non-posix platforms in f2py2e.compile
+ function.
+
+* rules.py
+
+ - Changed the order of buildcallback and usercode junks.
+
+* setup.cfg
+
+ - Added so that docs/ and tests/ directories are included to RPMs.
+
+* setup.py
+
+ - Installing f2py.py instead of f2py.bat under NT.
+ - Introduced ``--with-numpy_distutils`` that is useful when making
+ f2py tar-ball with numpy_distutils included.
+
+Release 2.37.233-1545
+=====================
+
+:Date: 11 September 2003
+
+* rules.py
+
+ - Introduced ``interface_usercode`` replacement. When ``usercode``
+ statement is used inside the first interface block, its contents
+ will be inserted at the end of initialization function of a F2PY
+ generated extension module (feature request: Berthold Höllmann).
+ - Introduced auxiliary function ``as_column_major_storage`` that
+ converts input array to an array with column major storage order
+ (feature request: Hans Petter Langtangen).
+
+* crackfortran.py
+
+ - Introduced ``pymethoddef`` statement.
+
+* cfuncs.py
+
+ - Fixed "#ifdef in #define TRYPYARRAYTEMPLATE" bug (patch thanks
+ to Bernhard Gschaider)
+
+* auxfuncs.py
+
+ - Introduced ``getpymethod`` function.
+ - Enabled multi-line blocks in ``callprotoargument`` statement.
+
+* f90mod_rules.py
+
+ - Undone "Fixed Warning 43 emitted by Intel Fortran compiler" that
+ causes (curios) segfaults.
+
+* fortranobject.c
+
+ - Fixed segfaults (that were introduced with recent memory leak
+ fixes) when using allocatable arrays.
+ - Introduced F2PY_REPORT_ON_ARRAY_COPY CPP macro int-variable. If defined
+ then a message is printed to stderr whenever a copy of an array is
+ made and arrays size is larger than F2PY_REPORT_ON_ARRAY_COPY.
+
+Release 2.35.229-1505
+=====================
+
+:Date: 5 August 2003
+
+* General
+
+ - Introduced ``usercode`` statement (dropped ``c_code`` hooks).
+
+* setup.py
+
+ - Updated the CVS location of numpy_distutils.
+
+* auxfuncs.py
+
+ - Introduced ``isint1array(var)`` for fixing ``integer*1 intent(out)``
+ support.
+
+* tests/f77/callback.py
+
+ Introduced some basic tests.
+
+* src/fortranobject.{c,h}
+
+ - Fixed memory leaks when getting/setting allocatable arrays.
+ (Bug report by Bernhard Gschaider)
+
+ - Initial support for numarray (Todd Miller's patch). Use -DNUMARRAY
+ on the f2py command line to enable numarray support. Note that
+ there is no character arrays support and these hooks are not
+ tested with F90 compilers yet.
+
+* cfuncs.py
+
+ - Fixed reference counting bug that appeared when constructing extra
+ argument list to callback functions.
+ - Added ``PyArray_LONG != PyArray_INT`` test.
+
+* f2py2e.py
+
+ Undocumented ``--f90compiler``.
+
+* crackfortran.py
+
+ - Introduced ``usercode`` statement.
+ - Fixed newlines when outputting multi-line blocks.
+ - Optimized ``getlincoef`` loop and ``analyzevars`` for cases where
+ len(vars) is large.
+ - Fixed callback string argument detection.
+ - Fixed evaluating expressions: only int|float expressions are
+ evaluated succesfully.
+
+* docs
+
+ Documented -DF2PY_REPORT_ATEXIT feature.
+
+* diagnose.py
+
+ Added CPU information and sys.prefix printout.
+
+* tests/run_all.py
+
+ Added cwd to PYTHONPATH.
+
+* tests/f??/return_{real,complex}.py
+
+ Pass "infinity" check in SunOS.
+
+* rules.py
+
+ - Fixed ``integer*1 intent(out)`` support
+ - Fixed free format continuation of f2py generated F90 files.
+
+* tests/mixed/
+
+ Introduced tests for mixing Fortran 77, Fortran 90 fixed and free
+ format codes in one module.
+
+* f90mod_rules.py
+
+ - Fixed non-prototype warnings.
+ - Fixed Warning 43 emitted by Intel Fortran compiler.
+ - Avoid long lines in Fortran codes to reduce possible problems with
+ continuations of lines.
+
+Public Release 2.32.225-1419
+============================
+
+:Date: 8 December 2002
+
+* docs/usersguide/
+
+ Complete revision of F2PY Users Guide
+
+* tests/run_all.py
+
+ - New file. A Python script to run all f2py unit tests.
+
+* Removed files: buildmakefile.py, buildsetup.py.
+
+* tests/f77/
+
+ - Added intent(out) scalar tests.
+
+* f2py_testing.py
+
+ - Introduced. It contains jiffies, memusage, run, cmdline functions
+ useful for f2py unit tests site.
+
+* setup.py
+
+ - Install numpy_distutils only if it is missing or is too old
+ for f2py.
+
+* f90modrules.py
+
+ - Fixed wrapping f90 module data.
+ - Fixed wrapping f90 module subroutines.
+ - Fixed f90 compiler warnings for wrapped functions by using interface
+ instead of external stmt for functions.
+
+* tests/f90/
+
+ - Introduced return_*.py tests.
+
+* func2subr.py
+
+ - Added optional signature argument to createfuncwrapper.
+ - In f2pywrappers routines, declare external, scalar, remaining
+ arguments in that order. Fixes compiler error 'Invalid declaration'
+ for::
+
+ real function foo(a,b)
+ integer b
+ real a(b)
+ end
+
+* crackfortran.py
+
+ - Removed first-line comment information support.
+ - Introduced multiline block. Currently usable only for
+ ``callstatement`` statement.
+ - Improved array length calculation in getarrlen(..).
+ - "From sky" program group is created only if ``groupcounter<1``.
+ See TODO.txt.
+ - Added support for ``dimension(n:*)``, ``dimension(*:n)``. They are
+ treated as ``dimesnion(*)`` by f2py.
+ - Fixed parameter substitution (this fixes TODO item by Patrick
+ LeGresley, 22 Aug 2001).
+
+* f2py2e.py
+
+ - Disabled all makefile, setup, manifest file generation hooks.
+ - Disabled --[no]-external-modroutines option. All F90 module
+ subroutines will have Fortran/C interface hooks.
+ - --build-dir can be used with -c option.
+ - only/skip modes can be used with -c option.
+ - Fixed and documented `-h stdout` feature.
+ - Documented extra options.
+ - Introduced --quiet and --verbose flags.
+
+* cb_rules.py
+
+ - Fixed debugcapi hooks for intent(c) scalar call-back arguments
+ (bug report: Pierre Schnizer).
+ - Fixed intent(c) for scalar call-back arguments.
+ - Improved failure reports.
+
+* capi_maps.py
+
+ - Fixed complex(kind=..) to C type mapping bug. The following hold
+ complex==complex(kind=4)==complex*8, complex(kind=8)==complex*16
+ - Using signed_char for integer*1 (bug report: Steve M. Robbins).
+ - Fixed logical*8 function bug: changed its C correspondence to
+ long_long.
+ - Fixed memory leak when returning complex scalar.
+
+* __init__.py
+
+ - Introduced a new function (for f2py test site, but could be useful
+ in general) ``compile(source[,modulename,extra_args])`` for
+ compiling fortran source codes directly from Python.
+
+* src/fortranobject.c
+
+ - Multi-dimensional common block members and allocatable arrays
+ are returned as Fortran-contiguous arrays.
+ - Fixed NULL return to Python without exception.
+ - Fixed memory leak in getattr(<fortranobj>,'__doc__').
+ - <fortranobj>.__doc__ is saved to <fortranobj>.__dict__ (previously
+ it was generated each time when requested).
+ - Fixed a nasty typo from the previous item that caused data
+ corruption and occasional SEGFAULTs.
+ - array_from_pyobj accepts arbitrary rank arrays if the last dimension
+ is undefined. E.g. dimension(3,*) accepts a(3,4,5) and the result is
+ array with dimension(3,20).
+ - Fixed (void*) casts to make g++ happy (bug report: eric).
+ - Changed the interface of ARR_IS_NULL macro to avoid "``NULL used in
+ arithmetics``" warnings from g++.
+
+* src/fortranobject.h
+
+ - Undone previous item. Defining NO_IMPORT_ARRAY for
+ src/fortranobject.c (bug report: travis)
+ - Ensured that PY_ARRAY_UNIQUE_SYMBOL is defined only for
+ src/fortranobject.c (bug report: eric).
+
+* rules.py
+
+ - Introduced dummy routine feature.
+ - F77 and F90 wrapper subroutines (if any) as saved to different
+ files, <modulename>-f2pywrappers.f and <modulename>-f2pywrappers2.f90,
+ respectively. Therefore, wrapping F90 requires numpy_distutils >=
+ 0.2.0_alpha_2.229.
+ - Fixed compiler warnings about meaningless ``const void (*f2py_func)(..)``.
+ - Improved error messages for ``*_from_pyobj``.
+ - Changed __CPLUSPLUS__ macros to __cplusplus (bug report: eric).
+ - Changed (void*) casts to (f2py_init_func) (bug report: eric).
+ - Removed unnecessary (void*) cast for f2py_has_column_major_storage
+ in f2py_module_methods definition (bug report: eric).
+ - Changed the interface of f2py_has_column_major_storage function:
+ removed const from the 1st argument.
+
+* cfuncs.py
+
+ - Introduced -DPREPEND_FORTRAN.
+ - Fixed bus error on SGI by using PyFloat_AsDouble when ``__sgi`` is defined.
+ This seems to be `know bug`__ with Python 2.1 and SGI.
+ - string_from_pyobj accepts only arrays whos elements size==sizeof(char).
+ - logical scalars (intent(in),function) are normalized to 0 or 1.
+ - Removed NUMFROMARROBJ macro.
+ - (char|short)_from_pyobj now use int_from_pyobj.
+ - (float|long_double)_from_pyobj now use double_from_pyobj.
+ - complex_(float|long_double)_from_pyobj now use complex_double_from_pyobj.
+ - Rewrote ``*_from_pyobj`` to be more robust. This fixes segfaults if
+ getting * from a string. Note that int_from_pyobj differs
+ from PyNumber_Int in that it accepts also complex arguments
+ (takes the real part) and sequences (takes the 1st element).
+ - Removed unnecessary void* casts in NUMFROMARROBJ.
+ - Fixed casts in ``*_from_pyobj`` functions.
+ - Replaced CNUMFROMARROBJ with NUMFROMARROBJ.
+
+.. __: http://sourceforge.net/tracker/index.php?func=detail&aid=435026&group_id=5470&atid=105470
+
+* auxfuncs.py
+
+ - Introduced isdummyroutine().
+ - Fixed islong_* functions.
+ - Fixed isintent_in for intent(c) arguments (bug report: Pierre Schnizer).
+ - Introduced F2PYError and throw_error. Using throw_error, f2py
+ rejects illegal .pyf file constructs that otherwise would cause
+ compilation failures or python crashes.
+ - Fixed islong_long(logical*8)->True.
+ - Introduced islogical() and islogicalfunction().
+ - Fixed prototype string argument (bug report: eric).
+
+* Updated README.txt and doc strings. Starting to use docutils.
+
+* Speed up for ``*_from_pyobj`` functions if obj is a sequence.
+
+* Fixed SegFault (reported by M.Braun) due to invalid ``Py_DECREF``
+ in ``GETSCALARFROMPYTUPLE``.
+
+Older Releases
+==============
+
+::
+
+ *** Fixed missing includes when wrapping F90 module data.
+ *** Fixed typos in docs of build_flib options.
+ *** Implemented prototype calculator if no callstatement or
+ callprotoargument statements are used. A warning is issued if
+ callstatement is used without callprotoargument.
+ *** Fixed transposing issue with array arguments in callback functions.
+ *** Removed -pyinc command line option.
+ *** Complete tests for Fortran 77 functions returning scalars.
+ *** Fixed returning character bug if --no-wrap-functions.
+ *** Described how to wrap F compiled Fortran F90 module procedures
+ with F2PY. See doc/using_F_compiler.txt.
+ *** Fixed the order of build_flib options when using --fcompiler=...
+ *** Recognize .f95 and .F95 files as Fortran sources with free format.
+ *** Cleaned up the output of 'f2py -h': removed obsolete items,
+ added build_flib options section.
+ *** Added --help-compiler option: it lists available Fortran compilers
+ as detected by numpy_distutils/command/build_flib.py. This option
+ is available only with -c option.
+
+
+:Release: 2.13.175-1250
+:Date: 4 April 2002
+
+::
+
+ *** Fixed copying of non-contigious 1-dimensional arrays bug.
+ (Thanks to Travis O.).
+
+
+:Release: 2.13.175-1242
+:Date: 26 March 2002
+
+::
+
+ *** Fixed ignoring type declarations.
+ *** Turned F2PY_REPORT_ATEXIT off by default.
+ *** Made MAX,MIN macros available by default so that they can be
+ always used in signature files.
+ *** Disabled F2PY_REPORT_ATEXIT for FreeBSD.
+
+
+:Release: 2.13.175-1233
+:Date: 13 March 2002
+
+::
+
+ *** Fixed Win32 port when using f2py.bat. (Thanks to Erik Wilsher).
+ *** F2PY_REPORT_ATEXIT is disabled for MACs.
+ *** Fixed incomplete dependency calculator.
+
+
+:Release: 2.13.175-1222
+:Date: 3 March 2002
+
+::
+
+ *** Plugged a memory leak for intent(out) arrays with overwrite=0.
+ *** Introduced CDOUBLE_to_CDOUBLE,.. functions for copy_ND_array.
+ These cast functions probably work incorrectly in Numeric.
+
+
+:Release: 2.13.175-1212
+:Date: 23 February 2002
+
+::
+
+ *** Updated f2py for the latest numpy_distutils.
+ *** A nasty bug with multi-dimensional Fortran arrays is fixed
+ (intent(out) arrays had wrong shapes). (Thanks to Eric for
+ pointing out this bug).
+ *** F2PY_REPORT_ATEXIT is disabled by default for __WIN32__.
+
+
+:Release: 2.11.174-1161
+:Date: 14 February 2002
+
+::
+
+ *** Updated f2py for the latest numpy_distutils.
+ *** Fixed raise error when f2py missed -m flag.
+ *** Script name `f2py' now depends on the name of python executable.
+ For example, `python2.2 setup.py install' will create a f2py
+ script with a name `f2py2.2'.
+ *** Introduced 'callprotoargument' statement so that proper prototypes
+ can be declared. This is crucial when wrapping C functions as it
+ will fix segmentation faults when these wrappers use non-pointer
+ arguments (thanks to R. Clint Whaley for explaining this to me).
+ Note that in f2py generated wrapper, the prototypes have
+ the following forms:
+ extern #rtype# #fortranname#(#callprotoargument#);
+ or
+ extern #rtype# F_FUNC(#fortranname#,#FORTRANNAME#)(#callprotoargument#);
+ *** Cosmetic fixes to F2PY_REPORT_ATEXIT feature.
+
+
+:Release: 2.11.174-1146
+:Date: 3 February 2002
+
+::
+
+ *** Reviewed reference counting in call-back mechanism. Fixed few bugs.
+ *** Enabled callstatement for complex functions.
+ *** Fixed bug with initializing capi_overwrite_<varname>
+ *** Introduced intent(overwrite) that is similar to intent(copy) but
+ has opposite effect. Renamed copy_<name>=1 to overwrite_<name>=0.
+ intent(overwrite) will make default overwrite_<name>=1.
+ *** Introduced intent(in|inout,out,out=<name>) attribute that renames
+ arguments name when returned. This renaming has effect only in
+ documentation strings.
+ *** Introduced 'callstatement' statement to pyf file syntax. With this
+ one can specify explicitly how wrapped function should be called
+ from the f2py generated module. WARNING: this is a dangerous feature
+ and should be used with care. It is introduced to provide a hack
+ to construct wrappers that may have very different signature
+ pattern from the wrapped function. Currently 'callstatement' can
+ be used only inside a subroutine or function block (it should be enough
+ though) and must be only in one continuous line. The syntax of the
+ statement is: callstatement <C-expression>;
+
+
+:Release: 2.11.174
+:Date: 18 January 2002
+
+::
+
+ *** Fixed memory-leak for PyFortranObject.
+ *** Introduced extra keyword argument copy_<varname> for intent(copy)
+ variables. It defaults to 1 and forces to make a copy for
+ intent(in) variables when passing on to wrapped functions (in case
+ they undesirably change the variable in-situ).
+ *** Introduced has_column_major_storage member function for all f2py
+ generated extension modules. It is equivalent to Python call
+ 'transpose(obj).iscontiguous()' but very efficient.
+ *** Introduced -DF2PY_REPORT_ATEXIT. If this is used when compiling,
+ a report is printed to stderr as python exits. The report includes
+ the following timings:
+ 1) time spent in all wrapped function calls;
+ 2) time spent in f2py generated interface around the wrapped
+ functions. This gives a hint whether one should worry
+ about storing data in proper order (C or Fortran).
+ 3) time spent in Python functions called by wrapped functions
+ through call-back interface.
+ 4) time spent in f2py generated call-back interface.
+ For now, -DF2PY_REPORT_ATEXIT is enabled by default. Use
+ -DF2PY_REPORT_ATEXIT_DISABLE to disable it (I am not sure if
+ Windows has needed tools, let me know).
+ Also, I appreciate if you could send me the output of 'F2PY
+ performance report' (with CPU and platform information) so that I
+ could optimize f2py generated interfaces for future releases.
+ *** Extension modules can be linked with dmalloc library. Use
+ -DDMALLOC when compiling.
+ *** Moved array_from_pyobj to fortranobject.c.
+ *** Usage of intent(inout) arguments is made more strict -- only
+ with proper type contiguous arrays are accepted. In general,
+ you should avoid using intent(inout) attribute as it makes
+ wrappers of C and Fortran functions asymmetric. I recommend using
+ intent(in,out) instead.
+ *** intent(..) has new keywords: copy,cache.
+ intent(copy,in) - forces a copy of an input argument; this
+ may be useful for cases where the wrapped function changes
+ the argument in situ and this may not be desired side effect.
+ Otherwise, it is safe to not use intent(copy) for the sake
+ of a better performance.
+ intent(cache,hide|optional) - just creates a junk of memory.
+ It does not care about proper storage order. Can be also
+ intent(in) but then the corresponding argument must be a
+ contiguous array with a proper elsize.
+ *** intent(c) can be used also for subroutine names so that
+ -DNO_APPEND_FORTRAN can be avoided for C functions.
+
+ *** IMPORTANT BREAKING GOOD ... NEWS!!!:
+
+ From now on you don't have to worry about the proper storage order
+ in multi-dimensional arrays that was earlier a real headache when
+ wrapping Fortran functions. Now f2py generated modules take care
+ of the proper conversations when needed. I have carefully designed
+ and optimized this interface to avoid any unnecessary memory usage
+ or copying of data. However, it is wise to use input arrays that
+ has proper storage order: for C arguments it is row-major and for
+ Fortran arguments it is column-major. But you don't need to worry
+ about that when developing your programs. The optimization of
+ initializing the program with proper data for possibly better
+ memory usage can be safely postponed until the program is working.
+
+ This change also affects the signatures in .pyf files. If you have
+ created wrappers that take multi-dimensional arrays in arguments,
+ it is better to let f2py re-generate these files. Or you have to
+ manually do the following changes: reverse the axes indices in all
+ 'shape' macros. For example, if you have defined an array A(n,m)
+ and n=shape(A,1), m=shape(A,0) then you must change the last
+ statements to n=shape(A,0), m=shape(A,1).
+
+
+:Release: 2.8.172
+:Date: 13 January 2002
+
+::
+
+ *** Fixed -c process. Removed pyf_extensions function and pyf_file class.
+ *** Reorganized setup.py. It generates f2py or f2py.bat scripts
+ depending on the OS and the location of the python executable.
+ *** Started to use update_version from numpy_distutils that makes
+ f2py startup faster. As a side effect, the version number system
+ changed.
+ *** Introduced test-site/test_f2py2e.py script that runs all
+ tests.
+ *** Fixed global variables initialization problem in crackfortran
+ when run_main is called several times.
+ *** Added 'import Numeric' to C/API init<module> function.
+ *** Fixed f2py.bat in setup.py.
+ *** Switched over to numpy_distutils and dropped fortran_support.
+ *** On Windows create f2py.bat file.
+ *** Introduced -c option: read fortran or pyf files, construct extension
+ modules, build, and save them to current directory.
+ In one word: do-it-all-in-one-call.
+ *** Introduced pyf_extensions(sources,f2py_opts) function. It simplifies
+ the extension building process considerably. Only for internal use.
+ *** Converted tests to use numpy_distutils in order to improve portability:
+ a,b,c
+ *** f2py2e.run_main() returns a pyf_file class instance containing
+ information about f2py generated files.
+ *** Introduced `--build-dir <dirname>' command line option.
+ *** Fixed setup.py for bdist_rpm command.
+ *** Added --numpy-setup command line option.
+ *** Fixed crackfortran that did not recognized capitalized type
+ specification with --no-lower flag.
+ *** `-h stdout' writes signature to stdout.
+ *** Fixed incorrect message for check() with empty name list.
+
+
+:Release: 2.4.366
+:Date: 17 December 2001
+
+::
+
+ *** Added command line option --[no-]manifest.
+ *** `make test' should run on Windows, but the results are not truthful.
+ *** Reorganized f2py2e.py a bit. Introduced run_main(comline_list) function
+ that can be useful when running f2py from another Python module.
+ *** Removed command line options -f77,-fix,-f90 as the file format
+ is determined from the extension of the fortran file
+ or from its header (first line starting with `!%' and containing keywords
+ free, fix, or f77). The later overrides the former one.
+ *** Introduced command line options --[no-]makefile,--[no-]latex-doc.
+ Users must explicitly use --makefile,--latex-doc if Makefile-<modulename>,
+ <modulename>module.tex is desired. --setup is default. Use --no-setup
+ to disable setup_<modulename>.py generation. --overwrite-makefile
+ will set --makefile.
+ *** Added `f2py_rout_' to #capiname# in rules.py.
+ *** intent(...) statement with empty namelist forces intent(...) attribute for
+ all arguments.
+ *** Dropped DL_IMPORT and DL_EXPORT in fortranobject.h.
+ *** Added missing PyFortran_Type.ob_type initialization.
+ *** Added gcc-3.0 support.
+ *** Raising non-existing/broken Numeric as a FatalError exception.
+ *** Fixed Python 2.x specific += construct in fortran_support.py.
+ *** Fixed copy_ND_array for 1-rank arrays that used to call calloc(0,..)
+ and caused core dump with a non-gcc compiler (Thanks to Pierre Schnizer
+ for reporting this bug).
+ *** Fixed "warning: variable `..' might be clobbered by `longjmp' or `vfork'":
+ - Reorganized the structure of wrapper functions to get rid of
+ `goto capi_fail' statements that caused the above warning.
+
+
+:Release: 2.3.343
+:Date: 12 December 2001
+
+::
+
+ *** Issues with the Win32 support (thanks to Eric Jones and Tiffany Kamm):
+ - Using DL_EXPORT macro for init#modulename#.
+ - Changed PyObject_HEAD_INIT(&PyType_Type) to PyObject_HEAD_INIT(0).
+ - Initializing #name#_capi=NULL instead of Py_None in cb hooks.
+ *** Fixed some 'warning: function declaration isn't a prototype', mainly
+ in fortranobject.{c,h}.
+ *** Fixed 'warning: missing braces around initializer'.
+ *** Fixed reading a line containing only a label.
+ *** Fixed nonportable 'cp -fv' to shutil.copy in f2py2e.py.
+ *** Replaced PyEval_CallObject with PyObject_CallObject in cb_rules.
+ *** Replaced Py_DECREF with Py_XDECREF when freeing hidden arguments.
+ (Reason: Py_DECREF caused segfault when an error was raised)
+ *** Impl. support for `include "file"' (in addition to `include 'file'')
+ *** Fixed bugs (buildsetup.py missing in Makefile, in generated MANIFEST.in)
+
+
+:Release: 2.3.327
+:Date: 4 December 2001
+
+::
+
+ *** Sending out the third public release of f2py.
+ *** Support for Intel(R) Fortran Compiler (thanks to Patrick LeGresley).
+ *** Introduced `threadsafe' statement to pyf-files (or to be used with
+ the 'f2py' directive in fortran codes) to force
+ Py_BEGIN|END_ALLOW_THREADS block around the Fortran subroutine
+ calling statement in Python C/API. `threadsafe' statement has
+ an effect only inside a subroutine block.
+ *** Introduced `fortranname <name>' statement to be used only within
+ pyf-files. This is useful when the wrapper (Python C/API) function
+ has different name from the wrapped (Fortran) function.
+ *** Introduced `intent(c)' directive and statement. It is useful when
+ wrapping C functions. Use intent(c) for arguments that are
+ scalars (not pointers) or arrays (with row-ordering of elements).
+
+
+:Release: 2.3.321
+:Date: 3 December 2001
+
+::
+
+ *** f2py2e can be installed using distutils (run `python setup.py install').
+ *** f2py builds setup_<modulename>.py. Use --[no-]setup to control this
+ feature. setup_<modulename>.py uses fortran_support module (from SciPy),
+ but for your convenience it is included also with f2py as an additional
+ package. Note that it has not as many compilers supported as with
+ using Makefile-<modulename>, but new compilers should be added to
+ fortran_support module, not to f2py2e package.
+ *** Fixed some compiler warnings about else statements.
+
diff --git a/numpy/f2py/docs/OLDNEWS.txt b/numpy/f2py/docs/OLDNEWS.txt
new file mode 100644
index 000000000..401d2dcee
--- /dev/null
+++ b/numpy/f2py/docs/OLDNEWS.txt
@@ -0,0 +1,63 @@
+
+.. topic:: Old F2PY NEWS
+
+ March 30, 2004
+ F2PY bug fix release (version 2.39.235-1693). Two new command line switches:
+ ``--compiler`` and ``--include_paths``. Support for allocatable string arrays.
+ Callback arguments may now be arbitrary callable objects. Win32 installers
+ for F2PY and Scipy_core are provided.
+ `Differences with the previous release (version 2.37.235-1660)`__.
+
+ __ http://cens.ioc.ee/cgi-bin/cvsweb/python/f2py2e/docs/HISTORY.txt.diff?r1=1.98&r2=1.87&f=h
+
+
+ March 9, 2004
+ F2PY bug fix release (version 2.39.235-1660).
+ `Differences with the previous release (version 2.37.235-1644)`__.
+
+ __ http://cens.ioc.ee/cgi-bin/cvsweb/python/f2py2e/docs/HISTORY.txt.diff?r1=1.87&r2=1.83&f=h
+
+ February 24, 2004
+ Latest F2PY release (version 2.39.235-1644).
+ Support for numpy_distutils 0.2.2 and up (e.g. compiler flags can be
+ changed via f2py command line options). Implemented support for
+ character arrays and arrays of strings (e.g. ``character*(*) a(m,..)``).
+ *Important bug fixes regarding complex arguments, upgrading is
+ highly recommended*. Documentation updates.
+ `Differences with the previous release (version 2.37.233-1545)`__.
+
+ __ http://cens.ioc.ee/cgi-bin/cvsweb/python/f2py2e/docs/HISTORY.txt.diff?r1=1.83&r2=1.58&f=h
+
+ September 11, 2003
+ Latest F2PY release (version 2.37.233-1545).
+ New statements: ``pymethoddef`` and ``usercode`` in interface blocks.
+ New function: ``as_column_major_storage``.
+ New CPP macro: ``F2PY_REPORT_ON_ARRAY_COPY``.
+ Bug fixes.
+ `Differences with the previous release (version 2.35.229-1505)`__.
+
+ __ http://cens.ioc.ee/cgi-bin/cvsweb/python/f2py2e/docs/HISTORY.txt.diff?r1=1.58&r2=1.49&f=h
+
+ August 2, 2003
+ Latest F2PY release (version 2.35.229-1505).
+ `Differences with the previous release (version 2.32.225-1419)`__.
+
+ __ http://cens.ioc.ee/cgi-bin/cvsweb/python/f2py2e/docs/HISTORY.txt.diff?r1=1.49&r2=1.28&f=h
+
+ April 2, 2003
+ Initial support for Numarray_ (thanks to Todd Miller).
+
+ December 8, 2002
+ Sixth public release of F2PY (version 2.32.225-1419). Comes with
+ revised `F2PY Users Guide`__, `new testing site`__, lots of fixes
+ and other improvements, see `HISTORY.txt`_ for details.
+
+ __ usersguide/index.html
+ __ TESTING.txt_
+
+.. References
+ ==========
+
+.. _HISTORY.txt: HISTORY.html
+.. _Numarray: http://www.stsci.edu/resources/software_hardware/numarray
+.. _TESTING.txt: TESTING.html \ No newline at end of file
diff --git a/numpy/f2py/docs/README.txt b/numpy/f2py/docs/README.txt
new file mode 100644
index 000000000..cec8a6ec0
--- /dev/null
+++ b/numpy/f2py/docs/README.txt
@@ -0,0 +1,461 @@
+.. -*- rest -*-
+
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ F2PY: Fortran to Python interface generator
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+:Author: Pearu Peterson <pearu@cens.ioc.ee>
+:License: NumPy License
+:Web-site: http://cens.ioc.ee/projects/f2py2e/
+:Discussions to: `f2py-users mailing list`_
+:Documentation: `User's Guide`__, FAQ__
+:Platforms: All
+:Date: $Date: 2005/01/30 18:54:53 $
+
+.. _f2py-users mailing list: http://cens.ioc.ee/mailman/listinfo/f2py-users/
+__ usersguide/index.html
+__ FAQ.html
+
+-------------------------------
+
+.. topic:: NEWS!!!
+
+ January 5, 2006
+
+ WARNING -- these notes are out of date! The package structure for NumPy and
+ SciPy has changed considerably. Much of this information is now incorrect.
+
+ January 30, 2005
+
+ Latest F2PY release (version 2.45.241_1926).
+ New features: wrapping unsigned integers, support for ``.pyf.src`` template files,
+ callback arguments can now be CObjects, fortran objects, built-in functions.
+ Introduced ``intent(aux)`` attribute. Wrapped objects have ``_cpointer``
+ attribute holding C pointer to wrapped functions or variables.
+ Many bug fixes and improvements, updated documentation.
+ `Differences with the previous release (version 2.43.239_1831)`__.
+
+ __ http://cens.ioc.ee/cgi-bin/cvsweb/python/f2py2e/docs/HISTORY.txt.diff?r1=1.163&r2=1.137&f=h
+
+ October 4, 2004
+ F2PY bug fix release (version 2.43.239_1831).
+ Better support for 64-bit platforms.
+ Introduced ``--help-link`` and ``--link-<resource>`` options.
+ Bug fixes.
+ `Differences with the previous release (version 2.43.239_1806)`__.
+
+ __ http://cens.ioc.ee/cgi-bin/cvsweb/python/f2py2e/docs/HISTORY.txt.diff?r1=1.137&r2=1.131&f=h
+
+ September 25, 2004
+ Latest F2PY release (version 2.43.239_1806).
+ Support for ``ENTRY`` statement. New attributes:
+ ``intent(inplace)``, ``intent(callback)``. Supports Numarray 1.1.
+ Introduced ``-*- fix -*-`` header content. Improved ``PARAMETER`` support.
+ Documentation updates. `Differences with the previous release
+ (version 2.39.235-1693)`__.
+
+ __ http://cens.ioc.ee/cgi-bin/cvsweb/python/f2py2e/docs/HISTORY.txt.diff?r1=1.131&r2=1.98&f=h
+
+ `History of NEWS`__
+
+ __ OLDNEWS.html
+
+-------------------------------
+
+.. Contents::
+
+==============
+ Introduction
+==============
+
+The purpose of the F2PY --*Fortran to Python interface generator*--
+project is to provide connection between Python_ and Fortran
+languages. F2PY is a Python extension tool for creating Python C/API
+modules from (handwritten or F2PY generated) signature files (or
+directly from Fortran sources). The generated extension modules
+facilitate:
+
+* Calling Fortran 77/90/95, Fortran 90/95 module, and C functions from
+ Python.
+
+* Accessing Fortran 77 ``COMMON`` blocks and Fortran 90/95 module
+ data (including allocatable arrays) from Python.
+
+* Calling Python functions from Fortran or C (call-backs).
+
+* Automatically handling the difference in the data storage order of
+ multi-dimensional Fortran and Numerical Python (i.e. C) arrays.
+
+In addition, F2PY can build the generated extension modules to shared
+libraries with one command. F2PY uses the ``numpy_distutils`` module
+from SciPy_ that supports number of major Fortran compilers.
+
+..
+ (see `COMPILERS.txt`_ for more information).
+
+F2PY generated extension modules depend on NumPy_ package that
+provides fast multi-dimensional array language facility to Python.
+
+
+---------------
+ Main features
+---------------
+
+Here follows a more detailed list of F2PY features:
+
+* F2PY scans real Fortran codes to produce the so-called signature
+ files (.pyf files). The signature files contain all the information
+ (function names, arguments and their types, etc.) that is needed to
+ construct Python bindings to Fortran (or C) functions.
+
+ The syntax of signature files is borrowed from the
+ Fortran 90/95 language specification and has some F2PY specific
+ extensions. The signature files can be modified to dictate how
+ Fortran (or C) programs are called from Python:
+
+ + F2PY solves dependencies between arguments (this is relevant for
+ the order of initializing variables in extension modules).
+
+ + Arguments can be specified to be optional or hidden that
+ simplifies calling Fortran programs from Python considerably.
+
+ + In principle, one can design any Python signature for a given
+ Fortran function, e.g. change the order arguments, introduce
+ auxiliary arguments, hide the arguments, process the arguments
+ before passing to Fortran, return arguments as output of F2PY
+ generated functions, etc.
+
+* F2PY automatically generates __doc__ strings (and optionally LaTeX
+ documentation) for extension modules.
+
+* F2PY generated functions accept arbitrary (but sensible) Python
+ objects as arguments. The F2PY interface automatically takes care of
+ type-casting and handling of non-contiguous arrays.
+
+* The following Fortran constructs are recognized by F2PY:
+
+ + All basic Fortran types::
+
+ integer[ | *1 | *2 | *4 | *8 ], logical[ | *1 | *2 | *4 | *8 ]
+ integer*([ -1 | -2 | -4 | -8 ])
+ character[ | *(*) | *1 | *2 | *3 | ... ]
+ real[ | *4 | *8 | *16 ], double precision
+ complex[ | *8 | *16 | *32 ]
+
+ Negative ``integer`` kinds are used to wrap unsigned integers.
+
+ + Multi-dimensional arrays of all basic types with the following
+ dimension specifications::
+
+ <dim> | <start>:<end> | * | :
+
+ + Attributes and statements::
+
+ intent([ in | inout | out | hide | in,out | inout,out | c |
+ copy | cache | callback | inplace | aux ])
+ dimension(<dimspec>)
+ common, parameter
+ allocatable
+ optional, required, external
+ depend([<names>])
+ check([<C-booleanexpr>])
+ note(<LaTeX text>)
+ usercode, callstatement, callprotoargument, threadsafe, fortranname
+ pymethoddef
+ entry
+
+* Because there are only little (and easily handleable) differences
+ between calling C and Fortran functions from F2PY generated
+ extension modules, then F2PY is also well suited for wrapping C
+ libraries to Python.
+
+* Practice has shown that F2PY generated interfaces (to C or Fortran
+ functions) are less error prone and even more efficient than
+ handwritten extension modules. The F2PY generated interfaces are
+ easy to maintain and any future optimization of F2PY generated
+ interfaces transparently apply to extension modules by just
+ regenerating them with the latest version of F2PY.
+
+* `F2PY Users Guide and Reference Manual`_
+
+
+===============
+ Prerequisites
+===============
+
+F2PY requires the following software installed:
+
+* Python_ (versions 1.5.2 or later; 2.1 and up are recommended).
+ You must have python-dev package installed.
+* NumPy_ (versions 13 or later; 20.x, 21.x, 22.x, 23.x are recommended)
+* Numarray_ (version 0.9 and up), optional, partial support.
+* Scipy_distutils (version 0.2.2 and up are recommended) from SciPy_
+ project. Get it from Scipy CVS or download it below.
+
+Python 1.x users also need distutils_.
+
+Of course, to build extension modules, you'll need also working C
+and/or Fortran compilers installed.
+
+==========
+ Download
+==========
+
+You can download the sources for the latest F2PY and numpy_distutils
+releases as:
+
+* `2.x`__/`F2PY-2-latest.tar.gz`__
+* `2.x`__/`numpy_distutils-latest.tar.gz`__
+
+Windows users might be interested in Win32 installer for F2PY and
+Scipy_distutils (these installers are built using Python 2.3):
+
+* `2.x`__/`F2PY-2-latest.win32.exe`__
+* `2.x`__/`numpy_distutils-latest.win32.exe`__
+
+Older releases are also available in the directories
+`rel-0.x`__, `rel-1.x`__, `rel-2.x`__, `rel-3.x`__, `rel-4.x`__, `rel-5.x`__,
+if you need them.
+
+.. __: 2.x/
+.. __: 2.x/F2PY-2-latest.tar.gz
+.. __: 2.x/
+.. __: 2.x/numpy_distutils-latest.tar.gz
+.. __: 2.x/
+.. __: 2.x/F2PY-2-latest.win32.exe
+.. __: 2.x/
+.. __: 2.x/numpy_distutils-latest.win32.exe
+.. __: rel-0.x
+.. __: rel-1.x
+.. __: rel-2.x
+.. __: rel-3.x
+.. __: rel-4.x
+.. __: rel-5.x
+
+Development version of F2PY from CVS is available as `f2py2e.tar.gz`__.
+
+__ http://cens.ioc.ee/cgi-bin/viewcvs.cgi/python/f2py2e/f2py2e.tar.gz?tarball=1
+
+Debian Sid users can simply install ``python-f2py`` package.
+
+==============
+ Installation
+==============
+
+Unpack the source file, change to directrory ``F2PY-?-???/`` and run
+(you may need to become a root)::
+
+ python setup.py install
+
+The F2PY installation installs a Python package ``f2py2e`` to your
+Python ``site-packages`` directory and a script ``f2py`` to your
+Python executable path.
+
+See also Installation__ section in `F2PY FAQ`_.
+
+.. __: FAQ.html#installation
+
+Similarly, to install ``numpy_distutils``, unpack its tar-ball and run::
+
+ python setup.py install
+
+=======
+ Usage
+=======
+
+To check if F2PY is installed correctly, run
+::
+
+ f2py
+
+without any arguments. This should print out the usage information of
+the ``f2py`` program.
+
+Next, try out the following three steps:
+
+1) Create a Fortran file `hello.f`__ that contains::
+
+ C File hello.f
+ subroutine foo (a)
+ integer a
+ print*, "Hello from Fortran!"
+ print*, "a=",a
+ end
+
+__ hello.f
+
+2) Run
+
+ ::
+
+ f2py -c -m hello hello.f
+
+ This will build an extension module ``hello.so`` (or ``hello.sl``,
+ or ``hello.pyd``, etc. depending on your platform) into the current
+ directory.
+
+3) Now in Python try::
+
+ >>> import hello
+ >>> print hello.__doc__
+ >>> print hello.foo.__doc__
+ >>> hello.foo(4)
+ Hello from Fortran!
+ a= 4
+ >>>
+
+If the above works, then you can try out more thorough
+`F2PY unit tests`__ and read the `F2PY Users Guide and Reference Manual`_.
+
+__ FAQ.html#q-how-to-test-if-f2py-is-working-correctly
+
+===============
+ Documentation
+===============
+
+The documentation of the F2PY project is collected in ``f2py2e/docs/``
+directory. It contains the following documents:
+
+`README.txt`_ (in CVS__)
+ The first thing to read about F2PY -- this document.
+
+__ http://cens.ioc.ee/cgi-bin/cvsweb/python/f2py2e/docs/README.txt?rev=HEAD&content-type=text/x-cvsweb-markup
+
+`usersguide/index.txt`_, `usersguide/f2py_usersguide.pdf`_
+ F2PY Users Guide and Reference Manual. Contains lots of examples.
+
+`FAQ.txt`_ (in CVS__)
+ F2PY Frequently Asked Questions.
+
+__ http://cens.ioc.ee/cgi-bin/cvsweb/python/f2py2e/docs/FAQ.txt?rev=HEAD&content-type=text/x-cvsweb-markup
+
+`TESTING.txt`_ (in CVS__)
+ About F2PY testing site. What tests are available and how to run them.
+
+__ http://cens.ioc.ee/cgi-bin/cvsweb/python/f2py2e/docs/TESTING.txt?rev=HEAD&content-type=text/x-cvsweb-markup
+
+`HISTORY.txt`_ (in CVS__)
+ A list of latest changes in F2PY. This is the most up-to-date
+ document on F2PY.
+
+__ http://cens.ioc.ee/cgi-bin/cvsweb/python/f2py2e/docs/HISTORY.txt?rev=HEAD&content-type=text/x-cvsweb-markup
+
+`THANKS.txt`_
+ Acknowledgments.
+
+..
+ `COMPILERS.txt`_
+ Compiler and platform specific notes.
+
+===============
+ Mailing list
+===============
+
+A mailing list f2py-users@cens.ioc.ee is open for F2PY releated
+discussion/questions/etc.
+
+* `Subscribe..`__
+* `Archives..`__
+
+__ http://cens.ioc.ee/mailman/listinfo/f2py-users
+__ http://cens.ioc.ee/pipermail/f2py-users
+
+
+=====
+ CVS
+=====
+
+F2PY is being developed under CVS_. The CVS version of F2PY can be
+obtained as follows:
+
+1) First you need to login (the password is ``guest``)::
+
+ cvs -d :pserver:anonymous@cens.ioc.ee:/home/cvs login
+
+2) and then do the checkout::
+
+ cvs -z6 -d :pserver:anonymous@cens.ioc.ee:/home/cvs checkout f2py2e
+
+3) You can update your local F2PY tree ``f2py2e/`` by executing::
+
+ cvs -z6 update -P -d
+
+You can browse the `F2PY CVS`_ repository.
+
+===============
+ Contributions
+===============
+
+* `A short introduction to F2PY`__ by Pierre Schnizer.
+
+* `F2PY notes`__ by Fernando Perez.
+
+* `Debian packages of F2PY`__ by José Fonseca. [OBSOLETE, Debian Sid
+ ships python-f2py package]
+
+__ http://fubphpc.tu-graz.ac.at/~pierre/f2py_tutorial.tar.gz
+__ http://cens.ioc.ee/pipermail/f2py-users/2003-April/000472.html
+__ http://jrfonseca.dyndns.org/debian/
+
+
+===============
+ Related sites
+===============
+
+* `Numerical Python`_ -- adds a fast array facility to the Python language.
+* Pyfort_ -- A Python-Fortran connection tool.
+* SciPy_ -- An open source library of scientific tools for Python.
+* `Scientific Python`_ -- A collection of Python modules that are
+ useful for scientific computing.
+* `The Fortran Company`_ -- A place to find products, services, and general
+ information related to the Fortran programming language.
+* `American National Standard Programming Language FORTRAN ANSI(R) X3.9-1978`__
+* `J3`_ -- The US Fortran standards committee.
+* SWIG_ -- A software development tool that connects programs written
+ in C and C++ with a variety of high-level programming languages.
+* `Mathtools.net`_ -- A technical computing portal for all scientific
+ and engineering needs.
+
+.. __: http://www.fortran.com/fortran/F77_std/rjcnf.html
+
+.. References
+ ==========
+
+
+.. _F2PY Users Guide and Reference Manual: usersguide/index.html
+.. _usersguide/index.txt: usersguide/index.html
+.. _usersguide/f2py_usersguide.pdf: usersguide/f2py_usersguide.pdf
+.. _README.txt: README.html
+.. _COMPILERS.txt: COMPILERS.html
+.. _F2PY FAQ:
+.. _FAQ.txt: FAQ.html
+.. _HISTORY.txt: HISTORY.html
+.. _HISTORY.txt from CVS: http://cens.ioc.ee/cgi-bin/cvsweb/python/f2py2e/docs/HISTORY.txt?rev=HEAD&content-type=text/x-cvsweb-markup
+.. _THANKS.txt: THANKS.html
+.. _TESTING.txt: TESTING.html
+.. _F2PY CVS2: http://cens.ioc.ee/cgi-bin/cvsweb/python/f2py2e/
+.. _F2PY CVS: http://cens.ioc.ee/cgi-bin/viewcvs.cgi/python/f2py2e/
+
+.. _CVS: http://www.cvshome.org/
+.. _Python: http://www.python.org/
+.. _SciPy: http://www.numpy.org/
+.. _NumPy: http://www.numpy.org/
+.. _Numarray: http://www.stsci.edu/resources/software_hardware/numarray
+.. _docutils: http://docutils.sourceforge.net/
+.. _distutils: http://www.python.org/sigs/distutils-sig/
+.. _Numerical Python: http://www.numpy.org/
+.. _Pyfort: http://pyfortran.sourceforge.net/
+.. _Scientific Python:
+ http://starship.python.net/crew/hinsen/scientific.html
+.. _The Fortran Company: http://www.fortran.com/fortran/
+.. _J3: http://www.j3-fortran.org/
+.. _Mathtools.net: http://www.mathtools.net/
+.. _SWIG: http://www.swig.org/
+
+..
+ Local Variables:
+ mode: indented-text
+ indent-tabs-mode: nil
+ sentence-end-double-space: t
+ fill-column: 70
+ End:
diff --git a/numpy/f2py/docs/TESTING.txt b/numpy/f2py/docs/TESTING.txt
new file mode 100644
index 000000000..d90521175
--- /dev/null
+++ b/numpy/f2py/docs/TESTING.txt
@@ -0,0 +1,108 @@
+
+=======================================================
+ F2PY unit testing site
+=======================================================
+
+.. Contents::
+
+Tests
+-----
+
+* To run all F2PY unit tests in one command::
+
+ cd tests
+ python run_all.py [<options>]
+
+ For example::
+
+ localhost:~/src_cvs/f2py2e/tests$ python2.2 run_all.py 100 --quiet
+ **********************************************
+ Running '/usr/bin/python2.2 f77/return_integer.py 100 --quiet'
+ run 1000 tests in 1.87 seconds
+ initial virtual memory size: 3952640 bytes
+ current virtual memory size: 3952640 bytes
+ ok
+ **********************************************
+ Running '/usr/bin/python2.2 f77/return_logical.py 100 --quiet'
+ run 1000 tests in 1.47 seconds
+ initial virtual memory size: 3952640 bytes
+ current virtual memory size: 3952640 bytes
+ ok
+ ...
+
+ If some tests fail, try to run the failing tests separately (without
+ the ``--quiet`` option) as described below to get more information
+ about the failure.
+
+* Test intent(in), intent(out) scalar arguments,
+ scalars returned by F77 functions
+ and F90 module functions::
+
+ tests/f77/return_integer.py
+ tests/f77/return_real.py
+ tests/f77/return_logical.py
+ tests/f77/return_complex.py
+ tests/f77/return_character.py
+ tests/f90/return_integer.py
+ tests/f90/return_real.py
+ tests/f90/return_logical.py
+ tests/f90/return_complex.py
+ tests/f90/return_character.py
+
+ Change to tests/ directory and run::
+
+ python f77/return_<type>.py [<options>]
+ python f90/return_<type>.py [<options>]
+
+ where ``<type>`` is integer, real, logical, complex, or character.
+ Test scripts options are described below.
+
+ A test is considered succesful if the last printed line is "ok".
+
+ If you get import errors like::
+
+ ImportError: No module named f77_ext_return_integer
+
+ but ``f77_ext_return_integer.so`` exists in the current directory then
+ it means that the current directory is not included in to `sys.path`
+ in your Python installation. As a fix, prepend ``.`` to ``PYTHONPATH``
+ environment variable and rerun the tests. For example::
+
+ PYTHONPATH=. python f77/return_integer.py
+
+* Test mixing Fortran 77, Fortran 90 fixed and free format codes::
+
+ tests/mixed/run.py
+
+* Test basic callback hooks::
+
+ tests/f77/callback.py
+
+Options
+-------
+
+You may want to use the following options when running the test
+scripts:
+
+``<integer>``
+ Run tests ``<integer>`` times. Useful for detecting memory leaks. Under
+ Linux tests scripts output virtual memory size state of the process
+ before and after calling the wrapped functions.
+
+``--quiet``
+ Suppress all messages. On success only "ok" should be displayed.
+
+``--fcompiler=<Gnu|Intel|...>``
+ Use::
+
+ f2py -c --help-fcompiler
+
+ to find out what compilers are available (or more precisely, which
+ ones are recognized by ``numpy_distutils``).
+
+Reporting failures
+------------------
+
+XXX: (1) make sure that failures are due to f2py and (2) send full
+stdout/stderr messages to me. Also add compiler,python,platform
+information.
diff --git a/numpy/f2py/docs/THANKS.txt b/numpy/f2py/docs/THANKS.txt
new file mode 100644
index 000000000..0a3f0b9d6
--- /dev/null
+++ b/numpy/f2py/docs/THANKS.txt
@@ -0,0 +1,63 @@
+
+=================
+ Acknowledgments
+=================
+
+F2PY__ is an open source Python package and command line tool developed and
+maintained by Pearu Peterson (me__).
+
+.. __: http://cens.ioc.ee/projects/f2py2e/
+.. __: http://cens.ioc.ee/~pearu/
+
+Many people have contributed to the F2PY project in terms of interest,
+encouragement, suggestions, criticism, bug reports, code
+contributions, and keeping me busy with developing F2PY. For all that
+I thank
+
+ James Amundson, John Barnard, David Beazley, Frank Bertoldi, Roman
+ Bertle, James Boyle, Moritz Braun, Rolv Erlend Bredesen, John
+ Chaffer, Fred Clare, Adam Collard, Ben Cornett, Jose L Gomez Dans,
+ Jaime D. Perea Duarte, Paul F Dubois, Thilo Ernst, Bonilla Fabian,
+ Martin Gelfand, Eduardo A. Gonzalez, Siegfried Gonzi, Bernhard
+ Gschaider, Charles Doutriaux, Jeff Hagelberg, Janko Hauser, Thomas
+ Hauser, Heiko Henkelmann, William Henney, Yueqiang Huang, Asim
+ Hussain, Berthold Höllmann, Vladimir Janku, Henk Jansen, Curtis
+ Jensen, Eric Jones, Tiffany Kamm, Andrey Khavryuchenko, Greg
+ Kochanski, Jochen Küpper, Simon Lacoste-Julien, Tim Lahey, Hans
+ Petter Langtangen, Jeff Layton, Matthew Lewis, Patrick LeGresley,
+ Joaquim R R A Martins, Paul Magwene Lionel Maziere, Craig McNeile,
+ Todd Miller, David C. Morrill, Dirk Muders, Kevin Mueller, Andrew
+ Mullhaupt, Vijayendra Munikoti, Travis Oliphant, Kevin O'Mara, Arno
+ Paehler, Fernando Perez, Didrik Pinte, Todd Alan Pitts, Prabhu
+ Ramachandran, Brad Reisfeld, Steve M. Robbins, Theresa Robinson,
+ Pedro Rodrigues, Les Schaffer, Christoph Scheurer, Herb Schilling,
+ Pierre Schnizer, Kevin Smith, Paulo Teotonio Sobrinho, José Rui
+ Faustino de Sousa, Andrew Swan, Dustin Tang, Charlie Taylor, Paul le
+ Texier, Michael Tiller, Semen Trygubenko, Ravi C Venkatesan, Peter
+ Verveer, Nils Wagner, R. Clint Whaley, Erik Wilsher, Martin
+ Wiechert, Gilles Zerah, SungPil Yoon.
+
+(This list may not be complete. Please forgive me if I have left you
+out and let me know, I'll add your name.)
+
+Special thanks are due to ...
+
+Eric Jones - he and Travis O. are responsible for starting the
+numpy_distutils project that allowed to move most of the platform and
+compiler specific codes out from F2PY. This simplified maintaining the
+F2PY project considerably.
+
+Joaquim R R A Martins - he made possible for me to test F2PY on IRIX64
+platform. He also presented our paper about F2PY in the 9th Python
+Conference that I planned to attend but had to cancel in very last
+minutes.
+
+Travis Oliphant - his knowledge and experience on Numerical Python
+C/API has been invaluable in early development of the F2PY program.
+His major contributions are call-back mechanism and copying N-D arrays
+of arbitrary types.
+
+Todd Miller - he is responsible for Numarray support in F2PY.
+
+Thanks!
+ Pearu
diff --git a/numpy/f2py/docs/default.css b/numpy/f2py/docs/default.css
new file mode 100644
index 000000000..9289e2826
--- /dev/null
+++ b/numpy/f2py/docs/default.css
@@ -0,0 +1,180 @@
+/*
+:Author: David Goodger
+:Contact: goodger@users.sourceforge.net
+:date: $Date: 2002/08/01 20:52:44 $
+:version: $Revision: 1.1 $
+:copyright: This stylesheet has been placed in the public domain.
+
+Default cascading style sheet for the HTML output of Docutils.
+*/
+
+body {
+ background: #FFFFFF ;
+ color: #000000
+}
+
+a.footnote-reference {
+ font-size: smaller ;
+ vertical-align: super }
+
+a.target {
+ color: blue }
+
+a.toc-backref {
+ text-decoration: none ;
+ color: black }
+
+dd {
+ margin-bottom: 0.5em }
+
+div.abstract {
+ margin: 2em 5em }
+
+div.abstract p.topic-title {
+ font-weight: bold ;
+ text-align: center }
+
+div.attention, div.caution, div.danger, div.error, div.hint,
+div.important, div.note, div.tip, div.warning {
+ margin: 2em ;
+ border: medium outset ;
+ padding: 1em }
+
+div.attention p.admonition-title, div.caution p.admonition-title,
+div.danger p.admonition-title, div.error p.admonition-title,
+div.warning p.admonition-title {
+ color: red ;
+ font-weight: bold ;
+ font-family: sans-serif }
+
+div.hint p.admonition-title, div.important p.admonition-title,
+div.note p.admonition-title, div.tip p.admonition-title {
+ font-weight: bold ;
+ font-family: sans-serif }
+
+div.dedication {
+ margin: 2em 5em ;
+ text-align: center ;
+ font-style: italic }
+
+div.dedication p.topic-title {
+ font-weight: bold ;
+ font-style: normal }
+
+div.figure {
+ margin-left: 2em }
+
+div.footer, div.header {
+ font-size: smaller }
+
+div.system-messages {
+ margin: 5em }
+
+div.system-messages h1 {
+ color: red }
+
+div.system-message {
+ border: medium outset ;
+ padding: 1em }
+
+div.system-message p.system-message-title {
+ color: red ;
+ font-weight: bold }
+
+div.topic {
+ margin: 2em }
+
+h1.title {
+ text-align: center }
+
+h2.subtitle {
+ text-align: center }
+
+hr {
+ width: 75% }
+
+ol.simple, ul.simple {
+ margin-bottom: 1em }
+
+ol.arabic {
+ list-style: decimal }
+
+ol.loweralpha {
+ list-style: lower-alpha }
+
+ol.upperalpha {
+ list-style: upper-alpha }
+
+ol.lowerroman {
+ list-style: lower-roman }
+
+ol.upperroman {
+ list-style: upper-roman }
+
+p.caption {
+ font-style: italic }
+
+p.credits {
+ font-style: italic ;
+ font-size: smaller }
+
+p.first {
+ margin-top: 0 }
+
+p.label {
+ white-space: nowrap }
+
+p.topic-title {
+ font-weight: bold }
+
+pre.literal-block, pre.doctest-block {
+ margin-left: 2em ;
+ margin-right: 2em ;
+ background-color: #eeeeee }
+
+span.classifier {
+ font-family: sans-serif ;
+ font-style: oblique }
+
+span.classifier-delimiter {
+ font-family: sans-serif ;
+ font-weight: bold }
+
+span.field-argument {
+ font-style: italic }
+
+span.interpreted {
+ font-family: sans-serif }
+
+span.option-argument {
+ font-style: italic }
+
+span.problematic {
+ color: red }
+
+table {
+ margin-top: 0.5em ;
+ margin-bottom: 0.5em }
+
+table.citation {
+ border-left: solid thin gray ;
+ padding-left: 0.5ex }
+
+table.docinfo {
+ margin: 2em 4em }
+
+table.footnote {
+ border-left: solid thin black ;
+ padding-left: 0.5ex }
+
+td, th {
+ padding-left: 0.5em ;
+ padding-right: 0.5em ;
+ vertical-align: baseline }
+
+td.docinfo-name {
+ font-weight: bold ;
+ text-align: right }
+
+td.field-name {
+ font-weight: bold }
diff --git a/numpy/f2py/docs/docutils.conf b/numpy/f2py/docs/docutils.conf
new file mode 100644
index 000000000..4e5a8425b
--- /dev/null
+++ b/numpy/f2py/docs/docutils.conf
@@ -0,0 +1,16 @@
+[general]
+
+# These entries affect all processing:
+#source-link: 1
+datestamp: %Y-%m-%d %H:%M UTC
+generator: 1
+
+# These entries affect HTML output:
+#stylesheet-path: pearu_style.css
+output-encoding: latin-1
+
+# These entries affect reStructuredText-style PEPs:
+#pep-template: pep-html-template
+#pep-stylesheet-path: stylesheets/pep.css
+#python-home: http://www.python.org
+#no-random: 1
diff --git a/numpy/f2py/docs/hello.f b/numpy/f2py/docs/hello.f
new file mode 100644
index 000000000..3e0dc6d21
--- /dev/null
+++ b/numpy/f2py/docs/hello.f
@@ -0,0 +1,7 @@
+C File hello.f
+ subroutine foo (a)
+ integer a
+ print*, "Hello from Fortran!"
+ print*, "a=",a
+ end
+
diff --git a/numpy/f2py/docs/pyforttest.pyf b/numpy/f2py/docs/pyforttest.pyf
new file mode 100644
index 000000000..79a9ae205
--- /dev/null
+++ b/numpy/f2py/docs/pyforttest.pyf
@@ -0,0 +1,5 @@
+subroutine foo(a,m,n)
+integer m = size(a,1)
+integer n = size(a,2)
+real, intent(inout) :: a(m,n)
+end subroutine foo
diff --git a/numpy/f2py/docs/pytest.py b/numpy/f2py/docs/pytest.py
new file mode 100644
index 000000000..abd3487df
--- /dev/null
+++ b/numpy/f2py/docs/pytest.py
@@ -0,0 +1,10 @@
+#File: pytest.py
+import Numeric
+def foo(a):
+ a = Numeric.array(a)
+ m,n = a.shape
+ for i in range(m):
+ for j in range(n):
+ a[i,j] = a[i,j] + 10*(i+1) + (j+1)
+ return a
+#eof
diff --git a/numpy/f2py/docs/simple.f b/numpy/f2py/docs/simple.f
new file mode 100644
index 000000000..ba468a509
--- /dev/null
+++ b/numpy/f2py/docs/simple.f
@@ -0,0 +1,13 @@
+cFile: simple.f
+ subroutine foo(a,m,n)
+ integer m,n,i,j
+ real a(m,n)
+cf2py intent(in,out) a
+cf2py intent(hide) m,n
+ do i=1,m
+ do j=1,n
+ a(i,j) = a(i,j) + 10*i+j
+ enddo
+ enddo
+ end
+cEOF
diff --git a/numpy/f2py/docs/simple_session.dat b/numpy/f2py/docs/simple_session.dat
new file mode 100644
index 000000000..10d9dc962
--- /dev/null
+++ b/numpy/f2py/docs/simple_session.dat
@@ -0,0 +1,51 @@
+>>> import pytest
+>>> import f2pytest
+>>> import pyforttest
+>>> print f2pytest.foo.__doc__
+foo - Function signature:
+ a = foo(a)
+Required arguments:
+ a : input rank-2 array('f') with bounds (m,n)
+Return objects:
+ a : rank-2 array('f') with bounds (m,n)
+
+>>> print pyforttest.foo.__doc__
+foo(a)
+
+>>> pytest.foo([[1,2],[3,4]])
+array([[12, 14],
+ [24, 26]])
+>>> f2pytest.foo([[1,2],[3,4]]) # F2PY can handle arbitrary input sequences
+array([[ 12., 14.],
+ [ 24., 26.]],'f')
+>>> pyforttest.foo([[1,2],[3,4]])
+Traceback (most recent call last):
+ File "<stdin>", line 1, in ?
+pyforttest.error: foo, argument A: Argument intent(inout) must be an array.
+
+>>> import Numeric
+>>> a=Numeric.array([[1,2],[3,4]],'f')
+>>> f2pytest.foo(a)
+array([[ 12., 14.],
+ [ 24., 26.]],'f')
+>>> a # F2PY makes a copy when input array is not Fortran contiguous
+array([[ 1., 2.],
+ [ 3., 4.]],'f')
+>>> a=Numeric.transpose(Numeric.array([[1,3],[2,4]],'f'))
+>>> a
+array([[ 1., 2.],
+ [ 3., 4.]],'f')
+>>> f2pytest.foo(a)
+array([[ 12., 14.],
+ [ 24., 26.]],'f')
+>>> a # F2PY passes Fortran contiguous input array directly to Fortran
+array([[ 12., 14.],
+ [ 24., 26.]],'f')
+# See intent(copy), intent(overwrite), intent(inplace), intent(inout)
+# attributes documentation to enhance the above behavior.
+
+>>> a=Numeric.array([[1,2],[3,4]],'f')
+>>> pyforttest.foo(a)
+>>> a # Huh? Pyfort 8.5 gives wrong results..
+array([[ 12., 23.],
+ [ 15., 26.]],'f')
diff --git a/numpy/f2py/docs/usersguide/allocarr.f90 b/numpy/f2py/docs/usersguide/allocarr.f90
new file mode 100644
index 000000000..e0d6c2ec8
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/allocarr.f90
@@ -0,0 +1,16 @@
+module mod
+ real, allocatable, dimension(:,:) :: b
+contains
+ subroutine foo
+ integer k
+ if (allocated(b)) then
+ print*, "b=["
+ do k = 1,size(b,1)
+ print*, b(k,1:size(b,2))
+ enddo
+ print*, "]"
+ else
+ print*, "b is not allocated"
+ endif
+ end subroutine foo
+end module mod
diff --git a/numpy/f2py/docs/usersguide/allocarr_session.dat b/numpy/f2py/docs/usersguide/allocarr_session.dat
new file mode 100644
index 000000000..fc91959b7
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/allocarr_session.dat
@@ -0,0 +1,27 @@
+>>> import allocarr
+>>> print allocarr.mod.__doc__
+b - 'f'-array(-1,-1), not allocated
+foo - Function signature:
+ foo()
+
+>>> allocarr.mod.foo()
+ b is not allocated
+>>> allocarr.mod.b = [[1,2,3],[4,5,6]] # allocate/initialize b
+>>> allocarr.mod.foo()
+ b=[
+ 1.000000 2.000000 3.000000
+ 4.000000 5.000000 6.000000
+ ]
+>>> allocarr.mod.b # b is Fortran-contiguous
+array([[ 1., 2., 3.],
+ [ 4., 5., 6.]],'f')
+>>> allocarr.mod.b = [[1,2,3],[4,5,6],[7,8,9]] # reallocate/initialize b
+>>> allocarr.mod.foo()
+ b=[
+ 1.000000 2.000000 3.000000
+ 4.000000 5.000000 6.000000
+ 7.000000 8.000000 9.000000
+ ]
+>>> allocarr.mod.b = None # deallocate array
+>>> allocarr.mod.foo()
+ b is not allocated
diff --git a/numpy/f2py/docs/usersguide/array.f b/numpy/f2py/docs/usersguide/array.f
new file mode 100644
index 000000000..ef20c9c20
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/array.f
@@ -0,0 +1,17 @@
+C FILE: ARRAY.F
+ SUBROUTINE FOO(A,N,M)
+C
+C INCREMENT THE FIRST ROW AND DECREMENT THE FIRST COLUMN OF A
+C
+ INTEGER N,M,I,J
+ REAL*8 A(N,M)
+Cf2py intent(in,out,copy) a
+Cf2py integer intent(hide),depend(a) :: n=shape(a,0), m=shape(a,1)
+ DO J=1,M
+ A(1,J) = A(1,J) + 1D0
+ ENDDO
+ DO I=1,N
+ A(I,1) = A(I,1) - 1D0
+ ENDDO
+ END
+C END OF FILE ARRAY.F
diff --git a/numpy/f2py/docs/usersguide/array_session.dat b/numpy/f2py/docs/usersguide/array_session.dat
new file mode 100644
index 000000000..f64933482
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/array_session.dat
@@ -0,0 +1,65 @@
+>>> import arr
+>>> from Numeric import array
+>>> print arr.foo.__doc__
+foo - Function signature:
+ a = foo(a,[overwrite_a])
+Required arguments:
+ a : input rank-2 array('d') with bounds (n,m)
+Optional arguments:
+ overwrite_a := 0 input int
+Return objects:
+ a : rank-2 array('d') with bounds (n,m)
+
+>>> a=arr.foo([[1,2,3],
+... [4,5,6]])
+copied an array using PyArray_CopyFromObject: size=6, elsize=8
+>>> print a
+[[ 1. 3. 4.]
+ [ 3. 5. 6.]]
+>>> a.iscontiguous(), arr.has_column_major_storage(a)
+(0, 1)
+>>> b=arr.foo(a) # even if a is proper-contiguous
+... # and has proper type, a copy is made
+... # forced by intent(copy) attribute
+... # to preserve its original contents
+...
+copied an array using copy_ND_array: size=6, elsize=8
+>>> print a
+[[ 1. 3. 4.]
+ [ 3. 5. 6.]]
+>>> print b
+[[ 1. 4. 5.]
+ [ 2. 5. 6.]]
+>>> b=arr.foo(a,overwrite_a=1) # a is passed directly to Fortran
+... # routine and its contents is discarded
+...
+>>> print a
+[[ 1. 4. 5.]
+ [ 2. 5. 6.]]
+>>> print b
+[[ 1. 4. 5.]
+ [ 2. 5. 6.]]
+>>> a is b # a and b are acctually the same objects
+1
+>>> print arr.foo([1,2,3]) # different rank arrays are allowed
+copied an array using PyArray_CopyFromObject: size=3, elsize=8
+[ 1. 1. 2.]
+>>> print arr.foo([[[1],[2],[3]]])
+copied an array using PyArray_CopyFromObject: size=3, elsize=8
+[ [[ 1.]
+ [ 3.]
+ [ 4.]]]
+>>>
+>>> # Creating arrays with column major data storage order:
+...
+>>> s = arr.as_column_major_storage(array([[1,2,3],[4,5,6]]))
+copied an array using copy_ND_array: size=6, elsize=4
+>>> arr.has_column_major_storage(s)
+1
+>>> print s
+[[1 2 3]
+ [4 5 6]]
+>>> s2 = arr.as_column_major_storage(s)
+>>> s2 is s # an array with column major storage order
+ # is returned immediately
+1 \ No newline at end of file
diff --git a/numpy/f2py/docs/usersguide/calculate.f b/numpy/f2py/docs/usersguide/calculate.f
new file mode 100644
index 000000000..1cda1c8dd
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/calculate.f
@@ -0,0 +1,14 @@
+ subroutine calculate(x,n)
+cf2py intent(callback) func
+ external func
+c The following lines define the signature of func for F2PY:
+cf2py real*8 y
+cf2py y = func(y)
+c
+cf2py intent(in,out,copy) x
+ integer n,i
+ real*8 x(n)
+ do i=1,n
+ x(i) = func(x(i))
+ end do
+ end
diff --git a/numpy/f2py/docs/usersguide/calculate_session.dat b/numpy/f2py/docs/usersguide/calculate_session.dat
new file mode 100644
index 000000000..2fe64f522
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/calculate_session.dat
@@ -0,0 +1,6 @@
+>>> import foo
+>>> foo.calculate(range(5), lambda x: x*x)
+array([ 0., 1., 4., 9., 16.])
+>>> import math
+>>> foo.calculate(range(5), math.exp)
+array([ 1. , 2.71828175, 7.38905621, 20.08553696, 54.59814835])
diff --git a/numpy/f2py/docs/usersguide/callback.f b/numpy/f2py/docs/usersguide/callback.f
new file mode 100644
index 000000000..6e9bfb920
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/callback.f
@@ -0,0 +1,12 @@
+C FILE: CALLBACK.F
+ SUBROUTINE FOO(FUN,R)
+ EXTERNAL FUN
+ INTEGER I
+ REAL*8 R
+Cf2py intent(out) r
+ R = 0D0
+ DO I=-5,5
+ R = R + FUN(I)
+ ENDDO
+ END
+C END OF FILE CALLBACK.F
diff --git a/numpy/f2py/docs/usersguide/callback2.pyf b/numpy/f2py/docs/usersguide/callback2.pyf
new file mode 100644
index 000000000..3d77eed24
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/callback2.pyf
@@ -0,0 +1,19 @@
+! -*- f90 -*-
+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
diff --git a/numpy/f2py/docs/usersguide/callback_session.dat b/numpy/f2py/docs/usersguide/callback_session.dat
new file mode 100644
index 000000000..cd2f26084
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/callback_session.dat
@@ -0,0 +1,23 @@
+>>> import callback
+>>> print callback.foo.__doc__
+foo - Function signature:
+ r = foo(fun,[fun_extra_args])
+Required arguments:
+ fun : call-back function
+Optional arguments:
+ fun_extra_args := () input tuple
+Return objects:
+ r : float
+Call-back functions:
+ def fun(i): return r
+ Required arguments:
+ i : input int
+ Return objects:
+ r : float
+
+>>> def f(i): return i*i
+...
+>>> print callback.foo(f)
+110.0
+>>> print callback.foo(lambda i:1)
+11.0
diff --git a/numpy/f2py/docs/usersguide/common.f b/numpy/f2py/docs/usersguide/common.f
new file mode 100644
index 000000000..b098ab20c
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/common.f
@@ -0,0 +1,13 @@
+C FILE: COMMON.F
+ SUBROUTINE FOO
+ INTEGER I,X
+ REAL A
+ COMMON /DATA/ I,X(4),A(2,3)
+ PRINT*, "I=",I
+ PRINT*, "X=[",X,"]"
+ PRINT*, "A=["
+ PRINT*, "[",A(1,1),",",A(1,2),",",A(1,3),"]"
+ PRINT*, "[",A(2,1),",",A(2,2),",",A(2,3),"]"
+ PRINT*, "]"
+ END
+C END OF COMMON.F
diff --git a/numpy/f2py/docs/usersguide/common_session.dat b/numpy/f2py/docs/usersguide/common_session.dat
new file mode 100644
index 000000000..846fdaa07
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/common_session.dat
@@ -0,0 +1,27 @@
+>>> import common
+>>> print common.data.__doc__
+i - 'i'-scalar
+x - 'i'-array(4)
+a - 'f'-array(2,3)
+
+>>> common.data.i = 5
+>>> common.data.x[1] = 2
+>>> common.data.a = [[1,2,3],[4,5,6]]
+>>> common.foo()
+ I= 5
+ X=[ 0 2 0 0]
+ A=[
+ [ 1., 2., 3.]
+ [ 4., 5., 6.]
+ ]
+>>> common.data.a[1] = 45
+>>> common.foo()
+ I= 5
+ X=[ 0 2 0 0]
+ A=[
+ [ 1., 2., 3.]
+ [ 45., 45., 45.]
+ ]
+>>> common.data.a # a is Fortran-contiguous
+array([[ 1., 2., 3.],
+ [ 45., 45., 45.]],'f')
diff --git a/numpy/f2py/docs/usersguide/compile_session.dat b/numpy/f2py/docs/usersguide/compile_session.dat
new file mode 100644
index 000000000..0d8408198
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/compile_session.dat
@@ -0,0 +1,11 @@
+>>> import f2py2e
+>>> fsource = '''
+... subroutine foo
+... print*, "Hello world!"
+... end
+... '''
+>>> f2py2e.compile(fsource,modulename='hello',verbose=0)
+0
+>>> import hello
+>>> hello.foo()
+ Hello world!
diff --git a/numpy/f2py/docs/usersguide/default.css b/numpy/f2py/docs/usersguide/default.css
new file mode 100644
index 000000000..bb7226161
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/default.css
@@ -0,0 +1,180 @@
+/*
+:Author: David Goodger
+:Contact: goodger@users.sourceforge.net
+:date: $Date: 2002/12/07 23:59:33 $
+:version: $Revision: 1.2 $
+:copyright: This stylesheet has been placed in the public domain.
+
+Default cascading style sheet for the HTML output of Docutils.
+*/
+
+body {
+ background: #FFFFFF ;
+ color: #000000
+}
+
+a.footnote-reference {
+ font-size: smaller ;
+ vertical-align: super }
+
+a.target {
+ color: blue }
+
+a.toc-backref {
+ text-decoration: none ;
+ color: black }
+
+dd {
+ margin-bottom: 0.5em }
+
+div.abstract {
+ margin: 2em 5em }
+
+div.abstract p.topic-title {
+ font-weight: bold ;
+ text-align: center }
+
+div.attention, div.caution, div.danger, div.error, div.hint,
+div.important, div.note, div.tip, div.warning {
+ margin: 2em ;
+ border: medium outset ;
+ padding: 1em }
+
+div.attention p.admonition-title, div.caution p.admonition-title,
+div.danger p.admonition-title, div.error p.admonition-title,
+div.warning p.admonition-title {
+ color: red ;
+ font-weight: bold ;
+ font-family: sans-serif }
+
+div.hint p.admonition-title, div.important p.admonition-title,
+div.note p.admonition-title, div.tip p.admonition-title {
+ font-weight: bold ;
+ font-family: sans-serif }
+
+div.dedication {
+ margin: 2em 5em ;
+ text-align: center ;
+ font-style: italic }
+
+div.dedication p.topic-title {
+ font-weight: bold ;
+ font-style: normal }
+
+div.figure {
+ margin-left: 2em }
+
+div.footer, div.header {
+ font-size: smaller }
+
+div.system-messages {
+ margin: 5em }
+
+div.system-messages h1 {
+ color: red }
+
+div.system-message {
+ border: medium outset ;
+ padding: 1em }
+
+div.system-message p.system-message-title {
+ color: red ;
+ font-weight: bold }
+
+div.topic {
+ margin: 2em }
+
+h1.title {
+ text-align: center }
+
+h2.subtitle {
+ text-align: center }
+
+hr {
+ width: 75% }
+
+ol.simple, ul.simple {
+ margin-bottom: 1em }
+
+ol.arabic {
+ list-style: decimal }
+
+ol.loweralpha {
+ list-style: lower-alpha }
+
+ol.upperalpha {
+ list-style: upper-alpha }
+
+ol.lowerroman {
+ list-style: lower-roman }
+
+ol.upperroman {
+ list-style: upper-roman }
+
+p.caption {
+ font-style: italic }
+
+p.credits {
+ font-style: italic ;
+ font-size: smaller }
+
+p.first {
+ margin-top: 0 }
+
+p.label {
+ white-space: nowrap }
+
+p.topic-title {
+ font-weight: bold }
+
+pre.literal-block, pre.doctest-block {
+ margin-left: 2em ;
+ margin-right: 2em ;
+ background-color: #ee9e9e }
+
+span.classifier {
+ font-family: sans-serif ;
+ font-style: oblique }
+
+span.classifier-delimiter {
+ font-family: sans-serif ;
+ font-weight: bold }
+
+span.field-argument {
+ font-style: italic }
+
+span.interpreted {
+ font-family: sans-serif }
+
+span.option-argument {
+ font-style: italic }
+
+span.problematic {
+ color: red }
+
+table {
+ margin-top: 0.5em ;
+ margin-bottom: 0.5em }
+
+table.citation {
+ border-left: solid thin gray ;
+ padding-left: 0.5ex }
+
+table.docinfo {
+ margin: 2em 4em }
+
+table.footnote {
+ border-left: solid thin black ;
+ padding-left: 0.5ex }
+
+td, th {
+ padding-left: 0.5em ;
+ padding-right: 0.5em ;
+ vertical-align: baseline }
+
+td.docinfo-name {
+ font-weight: bold ;
+ text-align: right }
+
+td.field-name {
+ font-weight: bold }
diff --git a/numpy/f2py/docs/usersguide/docutils.conf b/numpy/f2py/docs/usersguide/docutils.conf
new file mode 100644
index 000000000..b772fd137
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/docutils.conf
@@ -0,0 +1,16 @@
+[general]
+
+# These entries affect all processing:
+#source-link: 1
+datestamp: %Y-%m-%d %H:%M UTC
+generator: 1
+
+# These entries affect HTML output:
+#stylesheet-path: f2py_style.css
+output-encoding: latin-1
+
+# These entries affect reStructuredText-style PEPs:
+#pep-template: pep-html-template
+#pep-stylesheet-path: stylesheets/pep.css
+#python-home: http://www.python.org
+#no-random: 1
diff --git a/numpy/f2py/docs/usersguide/extcallback.f b/numpy/f2py/docs/usersguide/extcallback.f
new file mode 100644
index 000000000..9a800628e
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/extcallback.f
@@ -0,0 +1,14 @@
+ subroutine f1()
+ print *, "in f1, calling f2 twice.."
+ call f2()
+ call f2()
+ return
+ end
+
+ subroutine f2()
+cf2py intent(callback, hide) fpy
+ external fpy
+ print *, "in f2, calling f2py.."
+ call fpy()
+ return
+ end
diff --git a/numpy/f2py/docs/usersguide/extcallback_session.dat b/numpy/f2py/docs/usersguide/extcallback_session.dat
new file mode 100644
index 000000000..c22935ea0
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/extcallback_session.dat
@@ -0,0 +1,19 @@
+>>> import pfromf
+>>> pfromf.f2()
+Traceback (most recent call last):
+ File "<stdin>", line 1, in ?
+pfromf.error: Callback fpy not defined (as an argument or module pfromf attribute).
+
+>>> def f(): print "python f"
+...
+>>> pfromf.fpy = f
+>>> pfromf.f2()
+ in f2, calling f2py..
+python f
+>>> pfromf.f1()
+ in f1, calling f2 twice..
+ in f2, calling f2py..
+python f
+ in f2, calling f2py..
+python f
+>>> \ No newline at end of file
diff --git a/numpy/f2py/docs/usersguide/fib1.f b/numpy/f2py/docs/usersguide/fib1.f
new file mode 100644
index 000000000..cfbb1eea0
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/fib1.f
@@ -0,0 +1,18 @@
+C FILE: FIB1.F
+ SUBROUTINE FIB(A,N)
+C
+C CALCULATE FIRST N FIBONACCI NUMBERS
+C
+ INTEGER N
+ REAL*8 A(N)
+ DO I=1,N
+ IF (I.EQ.1) THEN
+ A(I) = 0.0D0
+ ELSEIF (I.EQ.2) THEN
+ A(I) = 1.0D0
+ ELSE
+ A(I) = A(I-1) + A(I-2)
+ ENDIF
+ ENDDO
+ END
+C END FILE FIB1.F
diff --git a/numpy/f2py/docs/usersguide/fib1.pyf b/numpy/f2py/docs/usersguide/fib1.pyf
new file mode 100644
index 000000000..3d6cc0a54
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/fib1.pyf
@@ -0,0 +1,12 @@
+! -*- f90 -*-
+python module fib2 ! in
+ interface ! in :fib2
+ subroutine fib(a,n) ! in :fib2:fib1.f
+ real*8 dimension(n) :: a
+ integer optional,check(len(a)>=n),depend(a) :: n=len(a)
+ end subroutine fib
+ end interface
+end python module fib2
+
+! This file was auto-generated with f2py (version:2.28.198-1366).
+! See http://cens.ioc.ee/projects/f2py2e/
diff --git a/numpy/f2py/docs/usersguide/fib2.pyf b/numpy/f2py/docs/usersguide/fib2.pyf
new file mode 100644
index 000000000..4a5ae29f1
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/fib2.pyf
@@ -0,0 +1,9 @@
+! -*- f90 -*-
+python module fib2
+ interface
+ subroutine fib(a,n)
+ real*8 dimension(n),intent(out),depend(n) :: a
+ integer intent(in) :: n
+ end subroutine fib
+ end interface
+end python module fib2
diff --git a/numpy/f2py/docs/usersguide/fib3.f b/numpy/f2py/docs/usersguide/fib3.f
new file mode 100644
index 000000000..08b050cd2
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/fib3.f
@@ -0,0 +1,21 @@
+C FILE: FIB3.F
+ SUBROUTINE FIB(A,N)
+C
+C CALCULATE FIRST N FIBONACCI NUMBERS
+C
+ INTEGER N
+ REAL*8 A(N)
+Cf2py intent(in) n
+Cf2py intent(out) a
+Cf2py depend(n) a
+ DO I=1,N
+ IF (I.EQ.1) THEN
+ A(I) = 0.0D0
+ ELSEIF (I.EQ.2) THEN
+ A(I) = 1.0D0
+ ELSE
+ A(I) = A(I-1) + A(I-2)
+ ENDIF
+ ENDDO
+ END
+C END FILE FIB3.F
diff --git a/numpy/f2py/docs/usersguide/ftype.f b/numpy/f2py/docs/usersguide/ftype.f
new file mode 100644
index 000000000..cabbb9e2d
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/ftype.f
@@ -0,0 +1,9 @@
+C FILE: FTYPE.F
+ SUBROUTINE FOO(N)
+ INTEGER N
+Cf2py integer optional,intent(in) :: n = 13
+ REAL A,X
+ COMMON /DATA/ A,X(3)
+ PRINT*, "IN FOO: N=",N," A=",A," X=[",X(1),X(2),X(3),"]"
+ END
+C END OF FTYPE.F
diff --git a/numpy/f2py/docs/usersguide/ftype_session.dat b/numpy/f2py/docs/usersguide/ftype_session.dat
new file mode 100644
index 000000000..01f9febaf
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/ftype_session.dat
@@ -0,0 +1,21 @@
+>>> import ftype
+>>> print ftype.__doc__
+This module 'ftype' is auto-generated with f2py (version:2.28.198-1366).
+Functions:
+ foo(n=13)
+COMMON blocks:
+ /data/ a,x(3)
+.
+>>> type(ftype.foo),type(ftype.data)
+(<type 'fortran'>, <type 'fortran'>)
+>>> ftype.foo()
+ IN FOO: N= 13 A= 0. X=[ 0. 0. 0.]
+>>> ftype.data.a = 3
+>>> ftype.data.x = [1,2,3]
+>>> ftype.foo()
+ IN FOO: N= 13 A= 3. X=[ 1. 2. 3.]
+>>> ftype.data.x[1] = 45
+>>> ftype.foo(24)
+ IN FOO: N= 24 A= 3. X=[ 1. 45. 3.]
+>>> ftype.data.x
+array([ 1., 45., 3.],'f')
diff --git a/numpy/f2py/docs/usersguide/index.txt b/numpy/f2py/docs/usersguide/index.txt
new file mode 100644
index 000000000..5a8d12c68
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/index.txt
@@ -0,0 +1,1772 @@
+.. -*- rest -*-
+
+//////////////////////////////////////////////////////////////////////
+ F2PY Users Guide and Reference Manual
+//////////////////////////////////////////////////////////////////////
+
+:Author: Pearu Peterson
+:Contact: pearu@cens.ioc.ee
+:Web site: http://cens.ioc.ee/projects/f2py2e/
+:Date: $Date: 2005/04/02 10:03:26 $
+:Revision: $Revision: 1.27 $
+
+
+.. section-numbering::
+
+.. Contents::
+
+
+================
+ Introduction
+================
+
+The purpose of the F2PY_ --*Fortran to Python interface generator*--
+project is to provide a connection between Python and Fortran
+languages. F2PY is a Python_ package (with a command line tool
+``f2py`` and a module ``f2py2e``) that facilitates creating/building
+Python C/API extension modules that make it possible
+
+* to call Fortran 77/90/95 external subroutines and Fortran 90/95
+ module subroutines as well as C functions;
+* to access Fortran 77 ``COMMON`` blocks and Fortran 90/95 module data,
+ including allocatable arrays
+
+from Python. See F2PY_ web site for more information and installation
+instructions.
+
+======================================
+ Three ways to wrap - getting started
+======================================
+
+Wrapping Fortran or C functions to Python using F2PY consists of the
+following steps:
+
+* Creating the so-called signature file that contains descriptions of
+ wrappers to Fortran or C functions, also called as signatures of the
+ functions. In the case of Fortran routines, F2PY can create initial
+ signature file by scanning Fortran source codes and
+ catching all relevant information needed to create wrapper
+ functions.
+
+* Optionally, F2PY created signature files can be edited to optimize
+ wrappers functions, make them "smarter" and more "Pythonic".
+
+* F2PY reads a signature file and writes a Python C/API module containing
+ Fortran/C/Python bindings.
+
+* F2PY compiles all sources and builds an extension module containing
+ the wrappers. In building extension modules, F2PY uses
+ ``numpy_distutils`` that supports a number of Fortran 77/90/95
+ compilers, including Gnu, Intel,
+ Sun Fortre, SGI MIPSpro, Absoft, NAG, Compaq etc. compilers.
+
+Depending on a particular situation, these steps can be carried out
+either by just in one command or step-by-step, some steps can be
+ommited or combined with others.
+
+Below I'll describe three typical approaches of using F2PY.
+The following `example Fortran 77 code`__ will be used for
+illustration:
+
+.. include:: fib1.f
+ :literal:
+
+__ fib1.f
+
+The quick way
+==============
+
+The quickest way to wrap the Fortran subroutine ``FIB`` to Python is
+to run
+
+::
+
+ f2py -c fib1.f -m fib1
+
+This command builds (see ``-c`` flag, execute ``f2py`` without
+arguments to see the explanation of command line options) an extension
+module ``fib1.so`` (see ``-m`` flag) to the current directory. Now, in
+Python the Fortran subroutine ``FIB`` is accessible via ``fib1.fib``::
+
+ >>> import Numeric
+ >>> import fib1
+ >>> print fib1.fib.__doc__
+ fib - Function signature:
+ fib(a,[n])
+ Required arguments:
+ a : input rank-1 array('d') with bounds (n)
+ Optional arguments:
+ n := len(a) input int
+
+ >>> a=Numeric.zeros(8,'d')
+ >>> fib1.fib(a)
+ >>> print a
+ [ 0. 1. 1. 2. 3. 5. 8. 13.]
+
+.. topic:: Comments
+
+ * Note that F2PY found that the second argument ``n`` is the
+ dimension of the first array argument ``a``. Since by default all
+ arguments are input-only arguments, F2PY concludes that ``n`` can
+ be optional with the default value ``len(a)``.
+
+ * One can use different values for optional ``n``::
+
+ >>> a1=Numeric.zeros(8,'d')
+ >>> fib1.fib(a1,6)
+ >>> print a1
+ [ 0. 1. 1. 2. 3. 5. 0. 0.]
+
+ but an exception is raised when it is incompatible with the input
+ array ``a``::
+
+ >>> fib1.fib(a,10)
+ fib:n=10
+ Traceback (most recent call last):
+ File "<stdin>", line 1, in ?
+ fib.error: (len(a)>=n) failed for 1st keyword n
+ >>>
+
+ This demonstrates one of the useful features in F2PY, that it,
+ F2PY implements basic compatibility checks between related
+ arguments in order to avoid any unexpected crashes.
+
+ * When a Numeric array, that is Fortran contiguous and has a typecode
+ corresponding to presumed Fortran type, is used as an input array
+ argument, then its C pointer is directly passed to Fortran.
+
+ Otherwise F2PY makes a contiguous copy (with a proper typecode) of
+ the input array and passes C pointer of the copy to Fortran
+ subroutine. As a result, any possible changes to the (copy of)
+ input array have no effect to the original argument, as
+ demonstrated below::
+
+ >>> a=Numeric.ones(8,'i')
+ >>> fib1.fib(a)
+ >>> print a
+ [1 1 1 1 1 1 1 1]
+
+ Clearly, this is not an expected behaviour. The fact that the
+ above example worked with ``typecode='d'`` is considered
+ accidental.
+
+ F2PY provides ``intent(inplace)`` attribute that would modify
+ the attributes of an input array so that any changes made by
+ Fortran routine will be effective also in input argument. For example,
+ if one specifies ``intent(inplace) a`` (see below, how), then
+ the example above would read:
+
+ >>> a=Numeric.ones(8,'i')
+ >>> fib1.fib(a)
+ >>> print a
+ [ 0. 1. 1. 2. 3. 5. 8. 13.]
+
+ However, the recommended way to get changes made by Fortran
+ subroutine back to python is to use ``intent(out)`` attribute. It
+ is more efficient and a cleaner solution.
+
+ * The usage of ``fib1.fib`` in Python is very similar to using
+ ``FIB`` in Fortran. However, using *in situ* output arguments in
+ Python indicates a poor style as there is no safety mechanism
+ in Python with respect to wrong argument types. When using Fortran
+ or C, compilers naturally discover any type mismatches during
+ compile time but in Python the types must be checked in
+ runtime. So, using *in situ* output arguments in Python may cause
+ difficult to find bugs, not to mention that the codes will be less
+ readable when all required type checks are implemented.
+
+ Though the demonstrated way of wrapping Fortran routines to Python
+ is very straightforward, it has several drawbacks (see the comments
+ above). These drawbacks are due to the fact that there is no way
+ that F2PY can determine what is the acctual intention of one or the
+ other argument, is it input or output argument, or both, or
+ something else. So, F2PY conservatively assumes that all arguments
+ are input arguments by default.
+
+ However, there are ways (see below) how to "teach" F2PY about the
+ true intentions (among other things) of function arguments; and then
+ F2PY is able to generate more Pythonic (more explicit, easier to
+ use, and less error prone) wrappers to Fortran functions.
+
+The smart way
+==============
+
+Let's apply the steps of wrapping Fortran functions to Python one by
+one.
+
+* First, we create a signature file from ``fib1.f`` by running
+
+ ::
+
+ f2py fib1.f -m fib2 -h fib1.pyf
+
+ The signature file is saved to ``fib1.pyf`` (see ``-h`` flag) and
+ its contents is shown below.
+
+ .. include:: fib1.pyf
+ :literal:
+
+* Next, we'll teach F2PY that the argument ``n`` is a input argument
+ (use ``intent(in)`` attribute) and that the result, i.e. the
+ contents of ``a`` after calling Fortran function ``FIB``, should be
+ returned to Python (use ``intent(out)`` attribute). In addition, an
+ array ``a`` should be created dynamically using the size given by
+ the input argument ``n`` (use ``depend(n)`` attribute to indicate
+ dependence relation).
+
+ The content of a modified version of ``fib1.pyf`` (saved as
+ ``fib2.pyf``) is as follows:
+
+ .. include:: fib2.pyf
+ :literal:
+
+* And finally, we build the extension module by running
+
+ ::
+
+ f2py -c fib2.pyf fib1.f
+
+In Python::
+
+ >>> import fib2
+ >>> print fib2.fib.__doc__
+ fib - Function signature:
+ a = fib(n)
+ Required arguments:
+ n : input int
+ Return objects:
+ a : rank-1 array('d') with bounds (n)
+
+ >>> print fib2.fib(8)
+ [ 0. 1. 1. 2. 3. 5. 8. 13.]
+
+.. topic:: Comments
+
+ * Clearly, the signature of ``fib2.fib`` now corresponds to the
+ intention of Fortran subroutine ``FIB`` more closely: given the
+ number ``n``, ``fib2.fib`` returns the first ``n`` Fibonacci numbers
+ as a Numeric array. Also, the new Python signature ``fib2.fib``
+ rules out any surprises that we experienced with ``fib1.fib``.
+
+ * Note that by default using single ``intent(out)`` also implies
+ ``intent(hide)``. Argument that has ``intent(hide)`` attribute
+ specified, will not be listed in the argument list of a wrapper
+ function.
+
+The quick and smart way
+========================
+
+The "smart way" of wrapping Fortran functions, as explained above, is
+suitable for wrapping (e.g. third party) Fortran codes for which
+modifications to their source codes are not desirable nor even
+possible.
+
+However, if editing Fortran codes is acceptable, then the generation
+of an intermediate signature file can be skipped in most
+cases. Namely, F2PY specific attributes can be inserted directly to
+Fortran source codes using the so-called F2PY directive. A F2PY
+directive defines special comment lines (starting with ``Cf2py``, for
+example) which are ignored by Fortran compilers but F2PY interprets
+them as normal lines.
+
+Here is shown a `modified version of the example Fortran code`__, saved
+as ``fib3.f``:
+
+.. include:: fib3.f
+ :literal:
+
+__ fib3.f
+
+Building the extension module can be now carried out in one command::
+
+ f2py -c -m fib3 fib3.f
+
+Notice that the resulting wrapper to ``FIB`` is as "smart" as in
+previous case::
+
+ >>> import fib3
+ >>> print fib3.fib.__doc__
+ fib - Function signature:
+ a = fib(n)
+ Required arguments:
+ n : input int
+ Return objects:
+ a : rank-1 array('d') with bounds (n)
+
+ >>> print fib3.fib(8)
+ [ 0. 1. 1. 2. 3. 5. 8. 13.]
+
+
+==================
+ Signature file
+==================
+
+The syntax specification for signature files (.pyf files) is borrowed
+from the Fortran 90/95 language specification. Almost all Fortran
+90/95 standard constructs are understood, both in free and fixed
+format (recall that Fortran 77 is a subset of Fortran 90/95). F2PY
+introduces also some extensions to Fortran 90/95 language
+specification that help designing Fortran to Python interface, make it
+more "Pythonic".
+
+Signature files may contain arbitrary Fortran code (so that Fortran
+codes can be considered as signature files). F2PY silently ignores
+Fortran constructs that are irrelevant for creating the interface.
+However, this includes also syntax errors. So, be careful not making
+ones;-).
+
+In general, the contents of signature files is case-sensitive. When
+scanning Fortran codes and writing a signature file, F2PY lowers all
+cases automatically except in multi-line blocks or when ``--no-lower``
+option is used.
+
+The syntax of signature files is overvied below.
+
+Python module block
+=====================
+
+A signature file may contain one (recommended) or more ``python
+module`` blocks. ``python module`` block describes the contents of
+a Python/C extension module ``<modulename>module.c`` that F2PY
+generates.
+
+Exception: if ``<modulename>`` contains a substring ``__user__``, then
+the corresponding ``python module`` block describes the signatures of
+so-called call-back functions (see `Call-back arguments`_).
+
+A ``python module`` block has the following structure::
+
+ python module <modulename>
+ [<usercode statement>]...
+ [
+ interface
+ <usercode statement>
+ <Fortran block data signatures>
+ <Fortran/C routine signatures>
+ end [interface]
+ ]...
+ [
+ interface
+ module <F90 modulename>
+ [<F90 module data type declarations>]
+ [<F90 module routine signatures>]
+ end [module [<F90 modulename>]]
+ end [interface]
+ ]...
+ end [python module [<modulename>]]
+
+Here brackets ``[]`` indicate a optional part, dots ``...`` indicate
+one or more of a previous part. So, ``[]...`` reads zero or more of a
+previous part.
+
+
+Fortran/C routine signatures
+=============================
+
+The signature of a Fortran routine has the following structure::
+
+ [<typespec>] function | subroutine <routine name> \
+ [ ( [<arguments>] ) ] [ result ( <entityname> ) ]
+ [<argument/variable type declarations>]
+ [<argument/variable attribute statements>]
+ [<use statements>]
+ [<common block statements>]
+ [<other statements>]
+ end [ function | subroutine [<routine name>] ]
+
+From a Fortran routine signature F2PY generates a Python/C extension
+function that has the following signature::
+
+ def <routine name>(<required arguments>[,<optional arguments>]):
+ ...
+ return <return variables>
+
+The signature of a Fortran block data has the following structure::
+
+ block data [ <block data name> ]
+ [<variable type declarations>]
+ [<variable attribute statements>]
+ [<use statements>]
+ [<common block statements>]
+ [<include statements>]
+ end [ block data [<block data name>] ]
+
+Type declarations
+-------------------
+
+ The definition of the ``<argument/variable type declaration>`` part
+ is
+
+ ::
+
+ <typespec> [ [<attrspec>] :: ] <entitydecl>
+
+ where
+
+ ::
+
+ <typespec> := byte | character [<charselector>]
+ | complex [<kindselector>] | real [<kindselector>]
+ | double complex | double precision
+ | integer [<kindselector>] | logical [<kindselector>]
+
+ <charselector> := * <charlen>
+ | ( [len=] <len> [ , [kind=] <kind>] )
+ | ( kind= <kind> [ , len= <len> ] )
+ <kindselector> := * <intlen> | ( [kind=] <kind> )
+
+ <entitydecl> := <name> [ [ * <charlen> ] [ ( <arrayspec> ) ]
+ | [ ( <arrayspec> ) ] * <charlen> ]
+ | [ / <init_expr> / | = <init_expr> ] \
+ [ , <entitydecl> ]
+
+ and
+
+ + ``<attrspec>`` is a comma separated list of attributes_;
+
+ + ``<arrayspec>`` is a comma separated list of dimension bounds;
+
+ + ``<init_expr>`` is a `C expression`__.
+
+ + ``<intlen>`` may be negative integer for ``integer`` type
+ specifications. In such cases ``integer*<negintlen>`` represents
+ unsigned C integers.
+
+__ `C expressions`_
+
+ If an argument has no ``<argument type declaration>``, its type is
+ determined by applying ``implicit`` rules to its name.
+
+
+Statements
+------------
+
+Attribute statements:
+
+ The ``<argument/variable attribute statement>`` is
+ ``<argument/variable type declaration>`` without ``<typespec>``.
+ In addition, in an attribute statement one cannot use other
+ attributes, also ``<entitydecl>`` can be only a list of names.
+
+Use statements:
+
+ The definition of the ``<use statement>`` part is
+
+ ::
+
+ use <modulename> [ , <rename_list> | , ONLY : <only_list> ]
+
+ where
+
+ ::
+
+ <rename_list> := <local_name> => <use_name> [ , <rename_list> ]
+
+ Currently F2PY uses ``use`` statement only for linking call-back
+ modules and ``external`` arguments (call-back functions), see
+ `Call-back arguments`_.
+
+Common block statements:
+
+ The definition of the ``<common block statement>`` part is
+
+ ::
+
+ common / <common name> / <shortentitydecl>
+
+ where
+
+ ::
+
+ <shortentitydecl> := <name> [ ( <arrayspec> ) ] [ , <shortentitydecl> ]
+
+ One ``python module`` block should not contain two or more
+ ``common`` blocks with the same name. Otherwise, the latter ones are
+ ignored. The types of variables in ``<shortentitydecl>`` are defined
+ using ``<argument type declarations>``. Note that the corresponding
+ ``<argument type declarations>`` may contain array specifications;
+ then you don't need to specify these in ``<shortentitydecl>``.
+
+Other statements:
+
+ The ``<other statement>`` part refers to any other Fortran language
+ constructs that are not described above. F2PY ignores most of them
+ except
+
+ + ``call`` statements and function calls of ``external`` arguments
+ (`more details`__?);
+
+__ external_
+
+ + ``include`` statements
+
+ ::
+
+ include '<filename>'
+ include "<filename>"
+
+ If a file ``<filename>`` does not exist, the ``include``
+ statement is ignored. Otherwise, the file ``<filename>`` is
+ included to a signature file. ``include`` statements can be used
+ in any part of a signature file, also outside the Fortran/C
+ routine signature blocks.
+
+ + ``implicit`` statements
+
+ ::
+
+ implicit none
+ implicit <list of implicit maps>
+
+ where
+
+ ::
+
+ <implicit map> := <typespec> ( <list of letters or range of letters> )
+
+ Implicit rules are used to deterimine the type specification of
+ a variable (from the first-letter of its name) if the variable
+ is not defined using ``<variable type declaration>``. Default
+ implicit rule is given by
+
+ ::
+
+ implicit real (a-h,o-z,$_), integer (i-m)
+
+ + ``entry`` statements
+
+ ::
+
+ entry <entry name> [([<arguments>])]
+
+ F2PY generates wrappers to all entry names using the signature
+ of the routine block.
+
+ Tip: ``entry`` statement can be used to describe the signature
+ of an arbitrary routine allowing F2PY to generate a number of
+ wrappers from only one routine block signature. There are few
+ restrictions while doing this: ``fortranname`` cannot be used,
+ ``callstatement`` and ``callprotoargument`` can be used only if
+ they are valid for all entry routines, etc.
+
+ In addition, F2PY introduces the following statements:
+
+ + ``threadsafe``
+ Use ``Py_BEGIN_ALLOW_THREADS .. Py_END_ALLOW_THREADS`` block
+ around the call to Fortran/C function.
+
+ + ``callstatement <C-expr|multi-line block>``
+ Replace F2PY generated call statement to Fortran/C function with
+ ``<C-expr|multi-line block>``. The wrapped Fortran/C function
+ is available as ``(*f2py_func)``. To raise an exception, set
+ ``f2py_success = 0`` in ``<C-expr|multi-line block>``.
+
+ + ``callprotoargument <C-typespecs>``
+ When ``callstatement`` statement is used then F2PY may not
+ generate proper prototypes for Fortran/C functions (because
+ ``<C-expr>`` may contain any function calls and F2PY has no way
+ to determine what should be the proper prototype). With this
+ statement you can explicitely specify the arguments of the
+ corresponding prototype::
+
+ extern <return type> FUNC_F(<routine name>,<ROUTINE NAME>)(<callprotoargument>);
+
+ + ``fortranname [<acctual Fortran/C routine name>]``
+ You can use arbitrary ``<routine name>`` for a given Fortran/C
+ function. Then you have to specify
+ ``<acctual Fortran/C routine name>`` with this statement.
+
+ If ``fortranname`` statement is used without
+ ``<acctual Fortran/C routine name>`` then a dummy wrapper is
+ generated.
+
+ + ``usercode <multi-line block>``
+ When used inside ``python module`` block, then given C code
+ will be inserted to generated C/API source just before
+ wrapper function definitions. Here you can define arbitrary
+ C functions to be used in initialization of optional arguments,
+ for example. If ``usercode`` is used twise inside ``python
+ module`` block then the second multi-line block is inserted
+ after the definition of external routines.
+
+ When used inside ``<routine singature>``, then given C code will
+ be inserted to the corresponding wrapper function just after
+ declaring variables but before any C statements. So, ``usercode``
+ follow-up can contain both declarations and C statements.
+
+ When used inside the first ``interface`` block, then given C
+ code will be inserted at the end of the initialization
+ function of the extension module. Here you can modify extension
+ modules dictionary. For example, for defining additional
+ variables etc.
+
+ + ``pymethoddef <multi-line block>``
+ Multiline block will be inserted to the definition of
+ module methods ``PyMethodDef``-array. It must be a
+ comma-separated list of C arrays (see `Extending and Embedding`__
+ Python documentation for details).
+ ``pymethoddef`` statement can be used only inside
+ ``python module`` block.
+
+ __ http://www.python.org/doc/current/ext/ext.html
+
+Attributes
+------------
+
+The following attributes are used by F2PY:
+
+``optional``
+ The corresponding argument is moved to the end of ``<optional
+ arguments>`` list. A default value for an optional argument can be
+ specified ``<init_expr>``, see ``entitydecl`` definition. Note that
+ the default value must be given as a valid C expression.
+
+ Note that whenever ``<init_expr>`` is used, ``optional`` attribute
+ is set automatically by F2PY.
+
+ For an optional array argument, all its dimensions must be bounded.
+
+``required``
+ The corresponding argument is considered as a required one. This is
+ default. You need to specify ``required`` only if there is a need to
+ disable automatic ``optional`` setting when ``<init_expr>`` is used.
+
+ If Python ``None`` object is used as an required argument, the
+ argument is treated as optional. That is, in the case of array
+ argument, the memory is allocated. And if ``<init_expr>`` is given,
+ the corresponding initialization is carried out.
+
+``dimension(<arrayspec>)``
+ The corresponding variable is considered as an array with given
+ dimensions in ``<arrayspec>``.
+
+``intent(<intentspec>)``
+ This specifies the "intention" of the corresponding
+ argument. ``<intentspec>`` is a comma separated list of the
+ following keys:
+
+ + ``in``
+ The argument is considered as an input-only argument. It means
+ that the value of the argument is passed to Fortran/C function and
+ that function is expected not to change the value of an argument.
+
+ + ``inout``
+ The argument is considered as an input/output or *in situ*
+ output argument. ``intent(inout)`` arguments can be only
+ "contiguous" Numeric arrays with proper type and size. Here
+ "contiguous" can be either in Fortran or C sense. The latter one
+ coincides with the contiguous concept used in Numeric and is
+ effective only if ``intent(c)`` is used. Fortran-contiguousness
+ is assumed by default.
+
+ Using ``intent(inout)`` is generally not recommended, use
+ ``intent(in,out)`` instead. See also ``intent(inplace)`` attribute.
+
+ + ``inplace``
+ The argument is considered as an input/output or *in situ*
+ output argument. ``intent(inplace)`` arguments must be
+ Numeric arrays with proper size. If the type of an array is
+ not "proper" or the array is non-contiguous then the array
+ will be changed in-place to fix the type and make it contiguous.
+
+ Using ``intent(inplace)`` is generally not recommended either.
+ For example, when slices have been taken from an
+ ``intent(inplace)`` argument then after in-place changes,
+ slices data pointers may point to unallocated memory area.
+
+ + ``out``
+ The argument is considered as an return variable. It is appended
+ to the ``<returned variables>`` list. Using ``intent(out)``
+ sets ``intent(hide)`` automatically, unless also
+ ``intent(in)`` or ``intent(inout)`` were used.
+
+ By default, returned multidimensional arrays are
+ Fortran-contiguous. If ``intent(c)`` is used, then returned
+ multi-dimensional arrays are C-contiguous.
+
+ + ``hide``
+ The argument is removed from the list of required or optional
+ arguments. Typically ``intent(hide)`` is used with ``intent(out)``
+ or when ``<init_expr>`` completely determines the value of the
+ argument like in the following example::
+
+ integer intent(hide),depend(a) :: n = len(a)
+ real intent(in),dimension(n) :: a
+
+ + ``c``
+ The argument is treated as a C scalar or C array argument. In
+ the case of a scalar argument, its value is passed to C function
+ as a C scalar argument (recall that Fortran scalar arguments are
+ actually C pointer arguments). In the case of an array
+ argument, the wrapper function is assumed to treat
+ multi-dimensional arrays as C-contiguous arrays.
+
+ There is no need to use ``intent(c)`` for one-dimensional
+ arrays, no matter if the wrapped function is either a Fortran or
+ a C function. This is because the concepts of Fortran- and
+ C-contiguousness overlap in one-dimensional cases.
+
+ If ``intent(c)`` is used as an statement but without entity
+ declaration list, then F2PY adds ``intent(c)`` attibute to all
+ arguments.
+
+ Also, when wrapping C functions, one must use ``intent(c)``
+ attribute for ``<routine name>`` in order to disable Fortran
+ specific ``F_FUNC(..,..)`` macros.
+
+ + ``cache``
+ The argument is treated as a junk of memory. No Fortran nor C
+ contiguousness checks are carried out. Using ``intent(cache)``
+ makes sense only for array arguments, also in connection with
+ ``intent(hide)`` or ``optional`` attributes.
+
+ + ``copy``
+ Ensure that the original contents of ``intent(in)`` argument is
+ preserved. Typically used in connection with ``intent(in,out)``
+ attribute. F2PY creates an optional argument
+ ``overwrite_<argument name>`` with the default value ``0``.
+
+ + ``overwrite``
+ The original contents of the ``intent(in)`` argument may be
+ altered by the Fortran/C function. F2PY creates an optional
+ argument ``overwrite_<argument name>`` with the default value
+ ``1``.
+
+ + ``out=<new name>``
+ Replace the return name with ``<new name>`` in the ``__doc__``
+ string of a wrapper function.
+
+ + ``callback``
+ Construct an external function suitable for calling Python function
+ from Fortran. ``intent(callback)`` must be specified before the
+ corresponding ``external`` statement. If 'argument' is not in
+ argument list then it will be added to Python wrapper but only
+ initializing external function.
+
+ Use ``intent(callback)`` in situations where a Fortran/C code
+ assumes that a user implements a function with given prototype
+ and links it to an executable. Don't use ``intent(callback)``
+ if function appears in the argument list of a Fortran routine.
+
+ With ``intent(hide)`` or ``optional`` attributes specified and
+ using a wrapper function without specifying the callback argument
+ in argument list then call-back function is looked in the
+ namespace of F2PY generated extension module where it can be
+ set as a module attribute by a user.
+
+ + ``aux``
+ Define auxiliary C variable in F2PY generated wrapper function.
+ Useful to save parameter values so that they can be accessed
+ in initialization expression of other variables. Note that
+ ``intent(aux)`` silently implies ``intent(c)``.
+
+ The following rules apply:
+
+ + If no ``intent(in | inout | out | hide)`` is specified,
+ ``intent(in)`` is assumed.
+ + ``intent(in,inout)`` is ``intent(in)``.
+ + ``intent(in,hide)`` or ``intent(inout,hide)`` is
+ ``intent(hide)``.
+ + ``intent(out)`` is ``intent(out,hide)`` unless ``intent(in)`` or
+ ``intent(inout)`` is specified.
+ + If ``intent(copy)`` or ``intent(overwrite)`` is used, then an
+ additional optional argument is introduced with a name
+ ``overwrite_<argument name>`` and a default value 0 or 1, respectively.
+ + ``intent(inout,inplace)`` is ``intent(inplace)``.
+ + ``intent(in,inplace)`` is ``intent(inplace)``.
+ + ``intent(hide)`` disables ``optional`` and ``required``.
+
+``check([<C-booleanexpr>])``
+ Perform consistency check of arguments by evaluating
+ ``<C-booleanexpr>``; if ``<C-booleanexpr>`` returns 0, an exception
+ is raised.
+
+ If ``check(..)`` is not used then F2PY generates few standard checks
+ (e.g. in a case of an array argument, check for the proper shape
+ and size) automatically. Use ``check()`` to disable checks generated
+ by F2PY.
+
+``depend([<names>])``
+ This declares that the corresponding argument depends on the values
+ of variables in the list ``<names>``. For example, ``<init_expr>``
+ may use the values of other arguments. Using information given by
+ ``depend(..)`` attributes, F2PY ensures that arguments are
+ initialized in a proper order. If ``depend(..)`` attribute is not
+ used then F2PY determines dependence relations automatically. Use
+ ``depend()`` to disable dependence relations generated by F2PY.
+
+ When you edit dependence relations that were initially generated by
+ F2PY, be careful not to break the dependence relations of other
+ relevant variables. Another thing to watch out is cyclic
+ dependencies. F2PY is able to detect cyclic dependencies
+ when constructing wrappers and it complains if any are found.
+
+``allocatable``
+ The corresponding variable is Fortran 90 allocatable array defined
+ as Fortran 90 module data.
+
+.. _external:
+
+``external``
+ The corresponding argument is a function provided by user. The
+ signature of this so-called call-back function can be defined
+
+ - in ``__user__`` module block,
+ - or by demonstrative (or real, if the signature file is a real Fortran
+ code) call in the ``<other statements>`` block.
+
+ For example, F2PY generates from
+
+ ::
+
+ external cb_sub, cb_fun
+ integer n
+ real a(n),r
+ call cb_sub(a,n)
+ r = cb_fun(4)
+
+ the following call-back signatures::
+
+ subroutine cb_sub(a,n)
+ real dimension(n) :: a
+ integer optional,check(len(a)>=n),depend(a) :: n=len(a)
+ end subroutine cb_sub
+ function cb_fun(e_4_e) result (r)
+ integer :: e_4_e
+ real :: r
+ end function cb_fun
+
+ The corresponding user-provided Python function are then::
+
+ def cb_sub(a,[n]):
+ ...
+ return
+ def cb_fun(e_4_e):
+ ...
+ return r
+
+ See also ``intent(callback)`` attribute.
+
+``parameter``
+ The corresponding variable is a parameter and it must have a fixed
+ value. F2PY replaces all parameter occurrences by their
+ corresponding values.
+
+Extensions
+============
+
+F2PY directives
+-----------------
+
+The so-called F2PY directives allow using F2PY signature file
+constructs also in Fortran 77/90 source codes. With this feature you
+can skip (almost) completely intermediate signature file generations
+and apply F2PY directly to Fortran source codes.
+
+F2PY directive has the following form::
+
+ <comment char>f2py ...
+
+where allowed comment characters for fixed and free format Fortran
+codes are ``cC*!#`` and ``!``, respectively. Everything that follows
+``<comment char>f2py`` is ignored by a compiler but read by F2PY as a
+normal Fortran (non-comment) line:
+
+ When F2PY finds a line with F2PY directive, the directive is first
+ replaced by 5 spaces and then the line is reread.
+
+For fixed format Fortran codes, ``<comment char>`` must be at the
+first column of a file, of course. For free format Fortran codes,
+F2PY directives can appear anywhere in a file.
+
+C expressions
+--------------
+
+C expressions are used in the following parts of signature files:
+
+* ``<init_expr>`` of variable initialization;
+* ``<C-booleanexpr>`` of the ``check`` attribute;
+* ``<arrayspec> of the ``dimension`` attribute;
+* ``callstatement`` statement, here also a C multi-line block can be used.
+
+A C expression may contain:
+
+* standard C constructs;
+* functions from ``math.h`` and ``Python.h``;
+* variables from the argument list, presumably initialized before
+ according to given dependence relations;
+* the following CPP macros:
+
+ ``rank(<name>)``
+ Returns the rank of an array ``<name>``.
+ ``shape(<name>,<n>)``
+ Returns the ``<n>``-th dimension of an array ``<name>``.
+ ``len(<name>)``
+ Returns the lenght of an array ``<name>``.
+ ``size(<name>)``
+ Returns the size of an array ``<name>``.
+ ``slen(<name>)``
+ Returns the length of a string ``<name>``.
+
+For initializing an array ``<array name>``, F2PY generates a loop over
+all indices and dimensions that executes the following
+pseudo-statement::
+
+ <array name>(_i[0],_i[1],...) = <init_expr>;
+
+where ``_i[<i>]`` refers to the ``<i>``-th index value and that runs
+from ``0`` to ``shape(<array name>,<i>)-1``.
+
+For example, a function ``myrange(n)`` generated from the following
+signature
+
+::
+
+ subroutine myrange(a,n)
+ fortranname ! myrange is a dummy wrapper
+ integer intent(in) :: n
+ real*8 intent(c,out),dimension(n),depend(n) :: a = _i[0]
+ end subroutine myrange
+
+is equivalent to ``Numeric.arange(n,typecode='d')``.
+
+.. topic:: Warning!
+
+ F2PY may lower cases also in C expressions when scanning Fortran codes
+ (see ``--[no]-lower`` option).
+
+Multi-line blocks
+------------------
+
+A multi-line block starts with ``'''`` (triple single-quotes) and ends
+with ``'''`` in some *strictly* subsequent line. Multi-line blocks can
+be used only within .pyf files. The contents of a multi-line block can
+be arbitrary (except that it cannot contain ``'''``) and no
+transformations (e.g. lowering cases) are applied to it.
+
+Currently, multi-line blocks can be used in the following constructs:
+
++ as a C expression of the ``callstatement`` statement;
+
++ as a C type specification of the ``callprotoargument`` statement;
+
++ as a C code block of the ``usercode`` statement;
+
++ as a list of C arrays of the ``pymethoddef`` statement;
+
++ as documentation string.
+
+==================================
+Using F2PY bindings in Python
+==================================
+
+All wrappers (to Fortran/C routines or to common blocks or to Fortran
+90 module data) generated by F2PY are exposed to Python as ``fortran``
+type objects. Routine wrappers are callable ``fortran`` type objects
+while wrappers to Fortran data have attributes referring to data
+objects.
+
+All ``fortran`` type object have attribute ``_cpointer`` that contains
+CObject referring to the C pointer of the corresponding Fortran/C
+function or variable in C level. Such CObjects can be used as an
+callback argument of F2PY generated functions to bypass Python C/API
+layer of calling Python functions from Fortran or C when the
+computational part of such functions is implemented in C or Fortran
+and wrapped with F2PY (or any other tool capable of providing CObject
+of a function).
+
+.. topic:: Example
+
+ Consider a `Fortran 77 file`__ ``ftype.f``:
+
+ .. include:: ftype.f
+ :literal:
+
+ and build a wrapper using::
+
+ f2py -c ftype.f -m ftype
+
+ __ ftype.f
+
+ In Python:
+
+ .. include:: ftype_session.dat
+ :literal:
+
+
+Scalar arguments
+=================
+
+In general, a scalar argument of a F2PY generated wrapper function can
+be ordinary Python scalar (integer, float, complex number) as well as
+an arbitrary sequence object (list, tuple, array, string) of
+scalars. In the latter case, the first element of the sequence object
+is passed to Fortran routine as a scalar argument.
+
+Note that when type-casting is required and there is possible loss of
+information (e.g. when type-casting float to integer or complex to
+float), F2PY does not raise any exception. In complex to real
+type-casting only the real part of a complex number is used.
+
+``intent(inout)`` scalar arguments are assumed to be array objects in
+order to *in situ* changes to be effective. It is recommended to use
+arrays with proper type but also other types work.
+
+.. topic:: Example
+
+ Consider the following `Fortran 77 code`__:
+
+ .. include:: scalar.f
+ :literal:
+
+ and wrap it using ``f2py -c -m scalar scalar.f``.
+
+ __ scalar.f
+
+ In Python:
+
+ .. include:: scalar_session.dat
+ :literal:
+
+
+String arguments
+=================
+
+F2PY generated wrapper functions accept (almost) any Python object as
+a string argument, ``str`` is applied for non-string objects.
+Exceptions are Numeric arrays that must have type code ``'c'`` or
+``'1'`` when used as string arguments.
+
+A string can have arbitrary length when using it as a string argument
+to F2PY generated wrapper function. If the length is greater than
+expected, the string is truncated. If the length is smaller that
+expected, additional memory is allocated and filled with ``\0``.
+
+Because Python strings are immutable, an ``intent(inout)`` argument
+expects an array version of a string in order to *in situ* changes to
+be effective.
+
+.. topic:: Example
+
+ Consider the following `Fortran 77 code`__:
+
+ .. include:: string.f
+ :literal:
+
+ and wrap it using ``f2py -c -m mystring string.f``.
+
+ __ string.f
+
+ Python session:
+
+ .. include:: string_session.dat
+ :literal:
+
+
+Array arguments
+================
+
+In general, array arguments of F2PY generated wrapper functions accept
+arbitrary sequences that can be transformed to Numeric array objects.
+An exception is ``intent(inout)`` array arguments that always must be
+proper-contiguous and have proper type, otherwise an exception is
+raised. Another exception is ``intent(inplace)`` array arguments that
+attributes will be changed in-situ if the argument has different type
+than expected (see ``intent(inplace)`` attribute for more
+information).
+
+In general, if a Numeric array is proper-contiguous and has a proper
+type then it is directly passed to wrapped Fortran/C function.
+Otherwise, an element-wise copy of an input array is made and the
+copy, being proper-contiguous and with proper type, is used as an
+array argument.
+
+There are two types of proper-contiguous Numeric arrays:
+
+* Fortran-contiguous arrays when data is stored column-wise,
+ i.e. indexing of data as stored in memory starts from the lowest
+ dimension;
+* C-contiguous or simply contiguous arrays when data is stored
+ row-wise, i.e. indexing of data as stored in memory starts from the
+ highest dimension.
+
+For one-dimensional arrays these notions coincide.
+
+For example, an 2x2 array ``A`` is Fortran-contiguous if its elements
+are stored in memory in the following order::
+
+ A[0,0] A[1,0] A[0,1] A[1,1]
+
+and C-contiguous if the order is as follows::
+
+ A[0,0] A[0,1] A[1,0] A[1,1]
+
+To test whether an array is C-contiguous, use ``.iscontiguous()``
+method of Numeric arrays. To test for Fortran-contiguousness, all
+F2PY generated extension modules provide a function
+``has_column_major_storage(<array>)``. This function is equivalent to
+``Numeric.transpose(<array>).iscontiguous()`` but more efficient.
+
+Usually there is no need to worry about how the arrays are stored in
+memory and whether the wrapped functions, being either Fortran or C
+functions, assume one or another storage order. F2PY automatically
+ensures that wrapped functions get arguments with proper storage
+order; the corresponding algorithm is designed to make copies of
+arrays only when absolutely necessary. However, when dealing with very
+large multi-dimensional input arrays with sizes close to the size of
+the physical memory in your computer, then a care must be taken to use
+always proper-contiguous and proper type arguments.
+
+To transform input arrays to column major storage order before passing
+them to Fortran routines, use a function
+``as_column_major_storage(<array>)`` that is provided by all F2PY
+generated extension modules.
+
+.. topic:: Example
+
+ Consider `Fortran 77 code`__:
+
+ .. include:: array.f
+ :literal:
+
+ and wrap it using ``f2py -c -m arr array.f -DF2PY_REPORT_ON_ARRAY_COPY=1``.
+
+ __ array.f
+
+ In Python:
+
+ .. include:: array_session.dat
+ :literal:
+
+Call-back arguments
+====================
+
+F2PY supports calling Python functions from Fortran or C codes.
+
+
+.. topic:: Example
+
+ Consider the following `Fortran 77 code`__
+
+ .. include:: callback.f
+ :literal:
+
+ and wrap it using ``f2py -c -m callback callback.f``.
+
+ __ callback.f
+
+ In Python:
+
+ .. include:: callback_session.dat
+ :literal:
+
+In the above example F2PY was able to guess accurately the signature
+of a call-back function. However, sometimes F2PY cannot establish the
+signature as one would wish and then the signature of a call-back
+function must be modified in the signature file manually. Namely,
+signature files may contain special modules (the names of such modules
+contain a substring ``__user__``) that collect various signatures of
+call-back functions. Callback arguments in routine signatures have
+attribute ``external`` (see also ``intent(callback)`` attribute). To
+relate a callback argument and its signature in ``__user__`` module
+block, use ``use`` statement as illustrated below. The same signature
+of a callback argument can be referred in different routine
+signatures.
+
+.. topic:: Example
+
+ We use the same `Fortran 77 code`__ as in previous example but now
+ we'll pretend that F2PY was not able to guess the signatures of
+ call-back arguments correctly. First, we create an initial signature
+ file ``callback2.pyf`` using F2PY::
+
+ f2py -m callback2 -h callback2.pyf callback.f
+
+ Then modify it as follows
+
+ .. include:: callback2.pyf
+ :literal:
+
+ Finally, build the extension module using::
+
+ f2py -c callback2.pyf callback.f
+
+ An example Python session would be identical to the previous example
+ except that argument names would differ.
+
+ __ callback.f
+
+Sometimes a Fortran package may require that users provide routines
+that the package will use. F2PY can construct an interface to such
+routines so that Python functions could be called from Fortran.
+
+.. topic:: Example
+
+ Consider the following `Fortran 77 subroutine`__ that takes an array
+ and applies a function ``func`` to its elements.
+
+ .. include:: calculate.f
+ :literal:
+
+ __ calculate.f
+
+ It is expected that function ``func`` has been defined
+ externally. In order to use a Python function as ``func``, it must
+ have an attribute ``intent(callback)`` (it must be specified before
+ the ``external`` statement).
+
+ Finally, build an extension module using::
+
+ f2py -c -m foo calculate.f
+
+ In Python:
+
+ .. include:: calculate_session.dat
+ :literal:
+
+The function is included as an argument to the python function call to
+the FORTRAN subroutine eventhough it was NOT in the FORTRAN subroutine argument
+list. The "external" refers to the C function generated by f2py, not the python
+function itself. The python function must be supplied to the C function.
+
+The callback function may also be explicitly set in the module.
+Then it is not necessary to pass the function in the argument list to
+the FORTRAN function. This may be desired if the FORTRAN function calling
+the python callback function is itself called by another FORTRAN function.
+
+.. topic:: Example
+
+ Consider the following `Fortran 77 subroutine`__.
+
+ .. include:: extcallback.f
+ :literal:
+
+ __ extcallback.f
+
+ and wrap it using ``f2py -c -m pfromf extcallback.f``.
+
+ In Python:
+
+ .. include:: extcallback_session.dat
+ :literal:
+
+Resolving arguments to call-back functions
+------------------------------------------
+
+F2PY generated interface is very flexible with respect to call-back
+arguments. For each call-back argument an additional optional
+argument ``<name>_extra_args`` is introduced by F2PY. This argument
+can be used to pass extra arguments to user provided call-back
+arguments.
+
+If a F2PY generated wrapper function expects the following call-back
+argument::
+
+ def fun(a_1,...,a_n):
+ ...
+ return x_1,...,x_k
+
+but the following Python function
+
+::
+
+ def gun(b_1,...,b_m):
+ ...
+ return y_1,...,y_l
+
+is provided by an user, and in addition,
+
+::
+
+ fun_extra_args = (e_1,...,e_p)
+
+is used, then the following rules are applied when a Fortran or C
+function calls the call-back argument ``gun``:
+
+* If ``p==0`` then ``gun(a_1,...,a_q)`` is called, here
+ ``q=min(m,n)``.
+* If ``n+p<=m`` then ``gun(a_1,...,a_n,e_1,...,e_p)`` is called.
+* If ``p<=m<n+p`` then ``gun(a_1,...,a_q,e_1,...,e_p)`` is called, here
+ ``q=m-p``.
+* If ``p>m`` then ``gun(e_1,...,e_m)`` is called.
+* If ``n+p`` is less than the number of required arguments to ``gun``
+ then an exception is raised.
+
+The function ``gun`` may return any number of objects as a tuple. Then
+following rules are applied:
+
+* If ``k<l``, then ``y_{k+1},...,y_l`` are ignored.
+* If ``k>l``, then only ``x_1,...,x_l`` are set.
+
+
+
+Common blocks
+==============
+
+F2PY generates wrappers to ``common`` blocks defined in a routine
+signature block. Common blocks are visible by all Fortran codes linked
+with the current extension module, but not to other extension modules
+(this restriction is due to how Python imports shared libraries). In
+Python, the F2PY wrappers to ``common`` blocks are ``fortran`` type
+objects that have (dynamic) attributes related to data members of
+common blocks. When accessed, these attributes return as Numeric array
+objects (multi-dimensional arrays are Fortran-contiguous) that
+directly link to data members in common blocks. Data members can be
+changed by direct assignment or by in-place changes to the
+corresponding array objects.
+
+.. topic:: Example
+
+ Consider the following `Fortran 77 code`__
+
+ .. include:: common.f
+ :literal:
+
+ and wrap it using ``f2py -c -m common common.f``.
+
+ __ common.f
+
+ In Python:
+
+ .. include:: common_session.dat
+ :literal:
+
+Fortran 90 module data
+=======================
+
+The F2PY interface to Fortran 90 module data is similar to Fortran 77
+common blocks.
+
+.. topic:: Example
+
+ Consider the following `Fortran 90 code`__
+
+ .. include:: moddata.f90
+ :literal:
+
+ and wrap it using ``f2py -c -m moddata moddata.f90``.
+
+ __ moddata.f90
+
+ In Python:
+
+ .. include:: moddata_session.dat
+ :literal:
+
+Allocatable arrays
+-------------------
+
+F2PY has basic support for Fortran 90 module allocatable arrays.
+
+.. topic:: Example
+
+ Consider the following `Fortran 90 code`__
+
+ .. include:: allocarr.f90
+ :literal:
+
+ and wrap it using ``f2py -c -m allocarr allocarr.f90``.
+
+ __ allocarr.f90
+
+ In Python:
+
+ .. include:: allocarr_session.dat
+ :literal:
+
+
+===========
+Using F2PY
+===========
+
+F2PY can be used either as a command line tool ``f2py`` or as a Python
+module ``f2py2e``.
+
+Command ``f2py``
+=================
+
+When used as a command line tool, ``f2py`` has three major modes,
+distinguished by the usage of ``-c`` and ``-h`` switches:
+
+1. To scan Fortran sources and generate a signature file, use
+
+ ::
+
+ f2py -h <filename.pyf> <options> <fortran files> \
+ [[ only: <fortran functions> : ] \
+ [ skip: <fortran functions> : ]]... \
+ [<fortran files> ...]
+
+ Note that a Fortran source file can contain many routines, and not
+ necessarily all routines are needed to be used from Python. So, you
+ can either specify which routines should be wrapped (in ``only: .. :``
+ part) or which routines F2PY should ignored (in ``skip: .. :`` part).
+
+ If ``<filename.pyf>`` is specified as ``stdout`` then signatures
+ are send to standard output instead of a file.
+
+ Among other options (see below), the following options can be used
+ in this mode:
+
+ ``--overwrite-signature``
+ Overwrite existing signature file.
+
+2. To construct an extension module, use
+
+ ::
+
+ f2py <options> <fortran files> \
+ [[ only: <fortran functions> : ] \
+ [ skip: <fortran functions> : ]]... \
+ [<fortran files> ...]
+
+ The constructed extension module is saved as
+ ``<modulename>module.c`` to the current directory.
+
+ Here ``<fortran files>`` may also contain signature files.
+ Among other options (see below), the following options can be used
+ in this mode:
+
+ ``--debug-capi``
+ Add debugging hooks to the extension module. When using this
+ extension module, various information about the wrapper is printed
+ to standard output, for example, the values of variables, the
+ steps taken, etc.
+
+ ``-include'<includefile>'``
+ Add a CPP ``#include`` statement to the extension module source.
+ ``<includefile>`` should be given in one of the following forms::
+
+ "filename.ext"
+ <filename.ext>
+
+ The include statement is inserted just before the wrapper
+ functions. This feature enables using arbitrary C functions
+ (defined in ``<includefile>``) in F2PY generated wrappers.
+
+ This option is deprecated. Use ``usercode`` statement to specify
+ C codelets directly in signature filess
+
+
+ ``--[no-]wrap-functions``
+
+ Create Fortran subroutine wrappers to Fortran functions.
+ ``--wrap-functions`` is default because it ensures maximum
+ portability and compiler independence.
+
+ ``--include-paths <path1>:<path2>:..``
+ Search include files from given directories.
+
+ ``--help-link [<list of resources names>]``
+ List system resources found by ``numpy_distutils/system_info.py``.
+ For example, try ``f2py --help-link lapack_opt``.
+
+3. To build an extension module, use
+
+ ::
+
+ f2py -c <options> <fortran files> \
+ [[ only: <fortran functions> : ] \
+ [ skip: <fortran functions> : ]]... \
+ [ <fortran/c source files> ] [ <.o, .a, .so files> ]
+
+ If ``<fortran files>`` contains a signature file, then a source for
+ an extension module is constructed, all Fortran and C sources are
+ compiled, and finally all object and library files are linked to the
+ extension module ``<modulename>.so`` which is saved into the current
+ directory.
+
+ If ``<fortran files>`` does not contain a signature file, then an
+ extension module is constructed by scanning all Fortran source codes
+ for routine signatures.
+
+ Among other options (see below) and options described in previous
+ mode, the following options can be used in this mode:
+
+ ``--help-fcompiler``
+ List available Fortran compilers.
+ ``--help-compiler`` [depreciated]
+ List available Fortran compilers.
+ ``--fcompiler=<Vendor>``
+ Specify Fortran compiler type by vendor.
+ ``--f77exec=<path>``
+ Specify the path to F77 compiler
+ ``--fcompiler-exec=<path>`` [depreciated]
+ Specify the path to F77 compiler
+ ``--f90exec=<path>``
+ Specify the path to F90 compiler
+ ``--f90compiler-exec=<path>`` [depreciated]
+ Specify the path to F90 compiler
+
+ ``--f77flags=<string>``
+ Specify F77 compiler flags
+ ``--f90flags=<string>``
+ Specify F90 compiler flags
+ ``--opt=<string>``
+ Specify optimization flags
+ ``--arch=<string>``
+ Specify architecture specific optimization flags
+ ``--noopt``
+ Compile without optimization
+ ``--noarch``
+ Compile without arch-dependent optimization
+ ``--debug``
+ Compile with debugging information
+
+ ``-l<libname>``
+ Use the library ``<libname>`` when linking.
+ ``-D<macro>[=<defn=1>]``
+ Define macro ``<macro>`` as ``<defn>``.
+ ``-U<macro>``
+ Define macro ``<macro>``
+ ``-I<dir>``
+ Append directory ``<dir>`` to the list of directories searched for
+ include files.
+ ``-L<dir>``
+ Add directory ``<dir>`` to the list of directories to be searched
+ for ``-l``.
+
+ ``link-<resource>``
+
+ Link extension module with <resource> as defined by
+ ``numpy_distutils/system_info.py``. E.g. to link with optimized
+ LAPACK libraries (vecLib on MacOSX, ATLAS elsewhere), use
+ ``--link-lapack_opt``. See also ``--help-link`` switch.
+
+ When building an extension module, a combination of the following
+ macros may be required for non-gcc Fortran compilers::
+
+ -DPREPEND_FORTRAN
+ -DNO_APPEND_FORTRAN
+ -DUPPERCASE_FORTRAN
+
+ To test the performance of F2PY generated interfaces, use
+ ``-DF2PY_REPORT_ATEXIT``. Then a report of various timings is
+ printed out at the exit of Python. This feature may not work on
+ all platforms, currently only Linux platform is supported.
+
+ To see whether F2PY generated interface performs copies of array
+ arguments, use ``-DF2PY_REPORT_ON_ARRAY_COPY=<int>``. When the size
+ of an array argument is larger than ``<int>``, a message about
+ the coping is sent to ``stderr``.
+
+Other options:
+
+``-m <modulename>``
+ Name of an extension module. Default is ``untitled``. Don't use this option
+ if a signature file (*.pyf) is used.
+``--[no-]lower``
+ Do [not] lower the cases in ``<fortran files>``. By default,
+ ``--lower`` is assumed with ``-h`` switch, and ``--no-lower``
+ without the ``-h`` switch.
+``--build-dir <dirname>``
+ All F2PY generated files are created in ``<dirname>``. Default is
+ ``tempfile.mktemp()``.
+``--quiet``
+ Run quietly.
+``--verbose``
+ Run with extra verbosity.
+``-v``
+ Print f2py version ID and exit.
+
+Execute ``f2py`` without any options to get an up-to-date list of
+available options.
+
+Python module ``f2py2e``
+=========================
+
+.. topic:: Warning
+
+ The current Python interface to ``f2py2e`` module is not mature and
+ may change in future depending on users needs.
+
+The following functions are provided by the ``f2py2e`` module:
+
+``run_main(<list>)``
+ Equivalent to running::
+
+ f2py <args>
+
+ where ``<args>=string.join(<list>,' ')``, but in Python. Unless
+ ``-h`` is used, this function returns a dictionary containing
+ information on generated modules and their dependencies on source
+ files. For example, the command ``f2py -m scalar scalar.f`` can be
+ executed from Python as follows
+
+ .. include:: run_main_session.dat
+ :literal:
+
+ You cannot build extension modules with this function, that is,
+ using ``-c`` is not allowed. Use ``compile`` command instead, see
+ below.
+
+``compile(source, modulename='untitled', extra_args='', verbose=1, source_fn=None)``
+
+ Build extension module from Fortran 77 source string ``source``.
+ Return 0 if successful.
+ Note that this function actually calls ``f2py -c ..`` from shell to
+ ensure safety of the current Python process.
+ For example,
+
+ .. include:: compile_session.dat
+ :literal:
+
+==========================
+Using ``numpy_distutils``
+==========================
+
+``numpy_distutils`` is part of the SciPy_ project and aims to extend
+standard Python ``distutils`` to deal with Fortran sources and F2PY
+signature files, e.g. compile Fortran sources, call F2PY to construct
+extension modules, etc.
+
+.. topic:: Example
+
+ Consider the following `setup file`__:
+
+ .. include:: setup_example.py
+ :literal:
+
+ Running
+
+ ::
+
+ python setup_example.py build
+
+ will build two extension modules ``scalar`` and ``fib2`` to the
+ build directory.
+
+ __ setup_example.py
+
+``numpy_distutils`` extends ``distutils`` with the following features:
+
+* ``Extension`` class argument ``sources`` may contain Fortran source
+ files. In addition, the list ``sources`` may contain at most one
+ F2PY signature file, and then the name of an Extension module must
+ match with the ``<modulename>`` used in signature file. It is
+ assumed that an F2PY signature file contains exactly one ``python
+ module`` block.
+
+ If ``sources`` does not contain a signature files, then F2PY is used
+ to scan Fortran source files for routine signatures to construct the
+ wrappers to Fortran codes.
+
+ Additional options to F2PY process can be given using ``Extension``
+ class argument ``f2py_options``.
+
+``numpy_distutils`` 0.2.2 and up
+================================
+
+* The following new ``distutils`` commands are defined:
+
+ ``build_src``
+ to construct Fortran wrapper extension modules, among many other things.
+ ``config_fc``
+ to change Fortran compiler options
+
+ as well as ``build_ext`` and ``build_clib`` commands are enhanced
+ to support Fortran sources.
+
+ Run
+
+ ::
+
+ python <setup.py file> config_fc build_src build_ext --help
+
+ to see available options for these commands.
+
+* When building Python packages containing Fortran sources, then one
+ can choose different Fortran compilers by using ``build_ext``
+ command option ``--fcompiler=<Vendor>``. Here ``<Vendor>`` can be one of the
+ following names::
+
+ absoft sun mips intel intelv intele intelev nag compaq compaqv gnu vast pg hpux
+
+ See ``numpy_distutils/fcompiler.py`` for up-to-date list of
+ supported compilers or run
+
+ ::
+
+ f2py -c --help-fcompiler
+
+``numpy_distutils`` pre 0.2.2
+=============================
+
+* The following new ``distutils`` commands are defined:
+
+ ``build_flib``
+ to build f77/f90 libraries used by Python extensions;
+ ``run_f2py``
+ to construct Fortran wrapper extension modules.
+
+ Run
+
+ ::
+
+ python <setup.py file> build_flib run_f2py --help
+
+ to see available options for these commands.
+
+* When building Python packages containing Fortran sources, then one
+ can choose different Fortran compilers either by using ``build_flib``
+ command option ``--fcompiler=<Vendor>`` or by defining environment
+ variable ``FC_VENDOR=<Vendor>``. Here ``<Vendor>`` can be one of the
+ following names::
+
+ Absoft Sun SGI Intel Itanium NAG Compaq Digital Gnu VAST PG
+
+ See ``numpy_distutils/command/build_flib.py`` for up-to-date list of
+ supported compilers.
+
+======================
+ Extended F2PY usages
+======================
+
+Adding self-written functions to F2PY generated modules
+=======================================================
+
+Self-written Python C/API functions can be defined inside
+signature files using ``usercode`` and ``pymethoddef`` statements
+(they must be used inside the ``python module`` block). For
+example, the following signature file ``spam.pyf``
+
+.. include:: spam.pyf
+ :literal:
+
+wraps the C library function ``system()``::
+
+ f2py -c spam.pyf
+
+In Python:
+
+.. include:: spam_session.dat
+ :literal:
+
+Modifying the dictionary of a F2PY generated module
+===================================================
+
+The following example illustrates how to add an user-defined
+variables to a F2PY generated extension module. Given the following
+signature file
+
+.. include:: var.pyf
+ :literal:
+
+compile it as ``f2py -c var.pyf``.
+
+Notice that the second ``usercode`` statement must be defined inside
+an ``interface`` block and where the module dictionary is available through
+the variable ``d`` (see ``f2py var.pyf``-generated ``varmodule.c`` for
+additional details).
+
+In Python:
+
+.. include:: var_session.dat
+ :literal:
+
+.. References
+ ==========
+.. _F2PY: http://cens.ioc.ee/projects/f2py2e/
+.. _Python: http://www.python.org/
+.. _NumPy: http://www.numpy.org/
+.. _SciPy: http://www.numpy.org/
diff --git a/numpy/f2py/docs/usersguide/moddata.f90 b/numpy/f2py/docs/usersguide/moddata.f90
new file mode 100644
index 000000000..0e98f0467
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/moddata.f90
@@ -0,0 +1,18 @@
+module mod
+ integer i
+ integer :: x(4)
+ real, dimension(2,3) :: a
+ real, allocatable, dimension(:,:) :: b
+contains
+ subroutine foo
+ integer k
+ print*, "i=",i
+ print*, "x=[",x,"]"
+ print*, "a=["
+ print*, "[",a(1,1),",",a(1,2),",",a(1,3),"]"
+ print*, "[",a(2,1),",",a(2,2),",",a(2,3),"]"
+ print*, "]"
+ print*, "Setting a(1,2)=a(1,2)+3"
+ a(1,2) = a(1,2)+3
+ end subroutine foo
+end module mod
diff --git a/numpy/f2py/docs/usersguide/moddata_session.dat b/numpy/f2py/docs/usersguide/moddata_session.dat
new file mode 100644
index 000000000..1ec212f8b
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/moddata_session.dat
@@ -0,0 +1,23 @@
+>>> import moddata
+>>> print moddata.mod.__doc__
+i - 'i'-scalar
+x - 'i'-array(4)
+a - 'f'-array(2,3)
+foo - Function signature:
+ foo()
+
+
+>>> moddata.mod.i = 5
+>>> moddata.mod.x[:2] = [1,2]
+>>> moddata.mod.a = [[1,2,3],[4,5,6]]
+>>> moddata.mod.foo()
+ i= 5
+ x=[ 1 2 0 0 ]
+ a=[
+ [ 1.000000 , 2.000000 , 3.000000 ]
+ [ 4.000000 , 5.000000 , 6.000000 ]
+ ]
+ Setting a(1,2)=a(1,2)+3
+>>> moddata.mod.a # a is Fortran-contiguous
+array([[ 1., 5., 3.],
+ [ 4., 5., 6.]],'f')
diff --git a/numpy/f2py/docs/usersguide/run_main_session.dat b/numpy/f2py/docs/usersguide/run_main_session.dat
new file mode 100644
index 000000000..29ecc3dfe
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/run_main_session.dat
@@ -0,0 +1,14 @@
+>>> import f2py2e
+>>> r=f2py2e.run_main(['-m','scalar','docs/usersguide/scalar.f'])
+Reading fortran codes...
+ Reading file 'docs/usersguide/scalar.f'
+Post-processing...
+ Block: scalar
+ Block: FOO
+Building modules...
+ Building module "scalar"...
+ Wrote C/API module "scalar" to file "./scalarmodule.c"
+>>> print r
+{'scalar': {'h': ['/home/users/pearu/src_cvs/f2py2e/src/fortranobject.h'],
+ 'csrc': ['./scalarmodule.c',
+ '/home/users/pearu/src_cvs/f2py2e/src/fortranobject.c']}}
diff --git a/numpy/f2py/docs/usersguide/scalar.f b/numpy/f2py/docs/usersguide/scalar.f
new file mode 100644
index 000000000..c22f639ed
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/scalar.f
@@ -0,0 +1,12 @@
+C FILE: SCALAR.F
+ SUBROUTINE FOO(A,B)
+ REAL*8 A, B
+Cf2py intent(in) a
+Cf2py intent(inout) b
+ PRINT*, " A=",A," B=",B
+ PRINT*, "INCREMENT A AND B"
+ A = A + 1D0
+ B = B + 1D0
+ PRINT*, "NEW A=",A," B=",B
+ END
+C END OF FILE SCALAR.F
diff --git a/numpy/f2py/docs/usersguide/scalar_session.dat b/numpy/f2py/docs/usersguide/scalar_session.dat
new file mode 100644
index 000000000..4fe8c03b1
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/scalar_session.dat
@@ -0,0 +1,21 @@
+>>> import scalar
+>>> print scalar.foo.__doc__
+foo - Function signature:
+ foo(a,b)
+Required arguments:
+ a : input float
+ b : in/output rank-0 array(float,'d')
+
+>>> scalar.foo(2,3)
+ A= 2. B= 3.
+ INCREMENT A AND B
+ NEW A= 3. B= 4.
+>>> import Numeric
+>>> a=Numeric.array(2) # these are integer rank-0 arrays
+>>> b=Numeric.array(3)
+>>> scalar.foo(a,b)
+ A= 2. B= 3.
+ INCREMENT A AND B
+ NEW A= 3. B= 4.
+>>> print a,b # note that only b is changed in situ
+2 4 \ No newline at end of file
diff --git a/numpy/f2py/docs/usersguide/setup_example.py b/numpy/f2py/docs/usersguide/setup_example.py
new file mode 100644
index 000000000..e5f5e8441
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/setup_example.py
@@ -0,0 +1,19 @@
+#!/usr/bin/env python
+# File: setup_example.py
+
+from numpy_distutils.core import Extension
+
+ext1 = Extension(name = 'scalar',
+ sources = ['scalar.f'])
+ext2 = Extension(name = 'fib2',
+ sources = ['fib2.pyf','fib1.f'])
+
+if __name__ == "__main__":
+ from numpy_distutils.core import setup
+ setup(name = 'f2py_example',
+ description = "F2PY Users Guide examples",
+ author = "Pearu Peterson",
+ author_email = "pearu@cens.ioc.ee",
+ ext_modules = [ext1,ext2]
+ )
+# End of setup_example.py
diff --git a/numpy/f2py/docs/usersguide/spam.pyf b/numpy/f2py/docs/usersguide/spam.pyf
new file mode 100644
index 000000000..21ea18b77
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/spam.pyf
@@ -0,0 +1,19 @@
+! -*- f90 -*-
+python module spam
+ usercode '''
+ static char doc_spam_system[] = "Execute a shell command.";
+ static PyObject *spam_system(PyObject *self, PyObject *args)
+ {
+ char *command;
+ int sts;
+
+ if (!PyArg_ParseTuple(args, "s", &command))
+ return NULL;
+ sts = system(command);
+ return Py_BuildValue("i", sts);
+ }
+ '''
+ pymethoddef '''
+ {"system", spam_system, METH_VARARGS, doc_spam_system},
+ '''
+end python module spam
diff --git a/numpy/f2py/docs/usersguide/spam_session.dat b/numpy/f2py/docs/usersguide/spam_session.dat
new file mode 100644
index 000000000..7f99d13f9
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/spam_session.dat
@@ -0,0 +1,5 @@
+>>> import spam
+>>> status = spam.system('whoami')
+pearu
+>> status = spam.system('blah')
+sh: line 1: blah: command not found \ No newline at end of file
diff --git a/numpy/f2py/docs/usersguide/string.f b/numpy/f2py/docs/usersguide/string.f
new file mode 100644
index 000000000..9246f02e7
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/string.f
@@ -0,0 +1,21 @@
+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
+ PRINT*, "A=",A
+ PRINT*, "B=",B
+ PRINT*, "C=",C
+ PRINT*, "D=",D
+ PRINT*, "CHANGE A,B,C,D"
+ A(1:1) = 'A'
+ B(1:1) = 'B'
+ C(1:1) = 'C'
+ D(1:1) = 'D'
+ PRINT*, "A=",A
+ PRINT*, "B=",B
+ PRINT*, "C=",C
+ PRINT*, "D=",D
+ END
+C END OF FILE STRING.F
diff --git a/numpy/f2py/docs/usersguide/string_session.dat b/numpy/f2py/docs/usersguide/string_session.dat
new file mode 100644
index 000000000..64ebcb3f4
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/string_session.dat
@@ -0,0 +1,27 @@
+>>> import mystring
+>>> print mystring.foo.__doc__
+foo - Function signature:
+ foo(a,b,c,d)
+Required arguments:
+ a : input string(len=5)
+ b : in/output rank-0 array(string(len=5),'c')
+ c : input string(len=-1)
+ d : in/output rank-0 array(string(len=-1),'c')
+
+>>> import Numeric
+>>> a=Numeric.array('123')
+>>> b=Numeric.array('123')
+>>> c=Numeric.array('123')
+>>> d=Numeric.array('123')
+>>> mystring.foo(a,b,c,d)
+ A=123
+ B=123
+ C=123
+ D=123
+ CHANGE A,B,C,D
+ A=A23
+ B=B23
+ C=C23
+ D=D23
+>>> a.tostring(),b.tostring(),c.tostring(),d.tostring()
+('123', 'B23', '123', 'D23') \ No newline at end of file
diff --git a/numpy/f2py/docs/usersguide/var.pyf b/numpy/f2py/docs/usersguide/var.pyf
new file mode 100644
index 000000000..8275ff3af
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/var.pyf
@@ -0,0 +1,11 @@
+! -*- f90 -*-
+python module var
+ usercode '''
+ int BAR = 5;
+ '''
+ interface
+ usercode '''
+ PyDict_SetItemString(d,"BAR",PyInt_FromLong(BAR));
+ '''
+ end interface
+end python module
diff --git a/numpy/f2py/docs/usersguide/var_session.dat b/numpy/f2py/docs/usersguide/var_session.dat
new file mode 100644
index 000000000..fb0f798bf
--- /dev/null
+++ b/numpy/f2py/docs/usersguide/var_session.dat
@@ -0,0 +1,3 @@
+>>> import var
+>>> var.BAR
+5 \ No newline at end of file
diff --git a/numpy/f2py/f2py.1 b/numpy/f2py/f2py.1
new file mode 100644
index 000000000..b8769a0cc
--- /dev/null
+++ b/numpy/f2py/f2py.1
@@ -0,0 +1,209 @@
+.TH "F2PY" 1
+.SH NAME
+f2py \- Fortran to Python interface generator
+.SH SYNOPSIS
+(1) To construct extension module sources:
+
+.B f2py
+[<options>] <fortran files> [[[only:]||[skip:]] <fortran functions> ] [: <fortran files> ...]
+
+(2) To compile fortran files and build extension modules:
+
+.B f2py
+-c [<options>, <config_fc options>, <extra options>] <fortran files>
+
+(3) To generate signature files:
+
+.B f2py
+-h <filename.pyf> ...< same options as in (1) >
+.SH DESCRIPTION
+This program generates a Python C/API file (<modulename>module.c)
+that contains wrappers for given Fortran or C functions so that they
+can be called from Python.
+With the -c option the corresponding
+extension modules are built.
+.SH OPTIONS
+.TP
+.B \-h <filename>
+Write signatures of the fortran routines to file <filename> and
+exit. You can then edit <filename> and use it instead of <fortran
+files>. If <filename>==stdout then the signatures are printed to
+stdout.
+.TP
+.B <fortran functions>
+Names of fortran routines for which Python C/API functions will be
+generated. Default is all that are found in <fortran files>.
+.TP
+.B skip:
+Ignore fortran functions that follow until `:'.
+.TP
+.B only:
+Use only fortran functions that follow until `:'.
+.TP
+.B :
+Get back to <fortran files> mode.
+.TP
+.B \-m <modulename>
+Name of the module; f2py generates a Python/C API file
+<modulename>module.c or extension module <modulename>. Default is
+\'untitled\'.
+.TP
+.B \-\-[no\-]lower
+Do [not] lower the cases in <fortran files>. By default, --lower is
+assumed with -h key, and --no-lower without -h key.
+.TP
+.B \-\-build\-dir <dirname>
+All f2py generated files are created in <dirname>. Default is tempfile.mktemp().
+.TP
+.B \-\-overwrite\-signature
+Overwrite existing signature file.
+.TP
+.B \-\-[no\-]latex\-doc
+Create (or not) <modulename>module.tex. Default is --no-latex-doc.
+.TP
+.B \-\-short\-latex
+Create 'incomplete' LaTeX document (without commands \\documentclass,
+\\tableofcontents, and \\begin{document}, \\end{document}).
+.TP
+.B \-\-[no\-]rest\-doc
+Create (or not) <modulename>module.rst. Default is --no-rest-doc.
+.TP
+.B \-\-debug\-capi
+Create C/API code that reports the state of the wrappers during
+runtime. Useful for debugging.
+.TP
+.B \-include\'<includefile>\'
+Add CPP #include statement to the C/API code. <includefile> should be
+in the format of either `"filename.ext"' or `<filename.ext>'. As a
+result <includefile> will be included just before wrapper functions
+part in the C/API code. The option is depreciated, use `usercode`
+statement in signature files instead.
+.TP
+.B \-\-[no\-]wrap\-functions
+Create Fortran subroutine wrappers to Fortran 77
+functions. --wrap-functions is default because it ensures maximum
+portability/compiler independence.
+.TP
+.B \-\-help\-link [..]
+List system resources found by system_info.py. [..] may contain
+a list of resources names. See also --link-<resource> switch below.
+.TP
+.B \-\-quiet
+Run quietly.
+.TP
+.B \-\-verbose
+Run with extra verbosity.
+.TP
+.B \-v
+Print f2py version ID and exit.
+.TP
+.B \-\-include_paths path1:path2:...
+Search include files (that f2py will scan) from the given directories.
+.SH "CONFIG_FC OPTIONS"
+The following options are effective only when -c switch is used.
+.TP
+.B \-\-help-compiler
+List available Fortran compilers [DEPRECIATED].
+.TP
+.B \-\-fcompiler=<name>
+Specify Fortran compiler type by vendor.
+.TP
+.B \-\-compiler=<name>
+Specify C compiler type (as defined by distutils)
+.TP
+.B \-\-fcompiler-exec=<path>
+Specify the path to F77 compiler [DEPRECIATED].
+.TP
+.B \-\-f90compiler\-exec=<path>
+Specify the path to F90 compiler [DEPRECIATED].
+.TP
+.B \-\-help\-fcompiler
+List available Fortran compilers and exit.
+.TP
+.B \-\-f77exec=<path>
+Specify the path to F77 compiler.
+.TP
+.B \-\-f90exec=<path>
+Specify the path to F90 compiler.
+.TP
+.B \-\-f77flags="..."
+Specify F77 compiler flags.
+.TP
+.B \-\-f90flags="..."
+Specify F90 compiler flags.
+.TP
+.B \-\-opt="..."
+Specify optimization flags.
+.TP
+.B \-\-arch="..."
+Specify architecture specific optimization flags.
+.TP
+.B \-\-noopt
+Compile without optimization.
+.TP
+.B \-\-noarch
+Compile without arch-dependent optimization.
+.TP
+.B \-\-debug
+Compile with debugging information.
+.SH "EXTRA OPTIONS"
+The following options are effective only when -c switch is used.
+.TP
+.B \-\-link-<resource>
+Link extension module with <resource> as defined by
+numpy_distutils/system_info.py. E.g. to link with optimized LAPACK
+libraries (vecLib on MacOSX, ATLAS elsewhere), use
+--link-lapack_opt. See also --help-link switch.
+
+.TP
+.B -L/path/to/lib/ -l<libname>
+.TP
+.B -D<define> -U<name> -I/path/to/include/
+.TP
+.B <filename>.o <filename>.so <filename>.a
+
+.TP
+.B -DPREPEND_FORTRAN -DNO_APPEND_FORTRAN -DUPPERCASE_FORTRAN -DUNDERSCORE_G77
+Macros that might be required with non-gcc Fortran compilers.
+
+.TP
+.B -DF2PY_REPORT_ATEXIT
+To print out a performance report of F2PY interface when python
+exits. Available for Linux.
+
+.TP
+.B -DF2PY_REPORT_ON_ARRAY_COPY=<int>
+To send a message to stderr whenever F2PY interface makes a copy of an
+array. Integer <int> sets the threshold for array sizes when a message
+should be shown.
+
+.SH REQUIREMENTS
+Python 1.5.2 or higher (2.x is supported).
+
+Numerical Python 13 or higher (20.x,21.x,22.x,23.x are supported).
+
+Optional Numarray 0.9 or higher partially supported.
+
+numpy_distutils from Scipy (can be downloaded from F2PY homepage)
+.SH "SEE ALSO"
+python(1)
+.SH BUGS
+For instructions on reporting bugs, see
+
+ http://cens.ioc.ee/projects/f2py2e/FAQ.html
+.SH AUTHOR
+Pearu Peterson <pearu@cens.ioc.ee>
+.SH "INTERNET RESOURCES"
+Main website: http://cens.ioc.ee/projects/f2py2e/
+
+User's Guide: http://cens.ioc.ee/projects/f2py2e/usersguide/
+
+Mailing list: http://cens.ioc.ee/mailman/listinfo/f2py-users/
+
+Scipy website: http://www.numpy.org
+.SH COPYRIGHT
+Copyright (c) 1999, 2000, 2001, 2002, 2003, 2004, 2005 Pearu Peterson
+.SH LICENSE
+NumPy License
+.SH VERSION
+2.45.241
diff --git a/numpy/f2py/f2py2e.py b/numpy/f2py/f2py2e.py
new file mode 100755
index 000000000..24987cb1a
--- /dev/null
+++ b/numpy/f2py/f2py2e.py
@@ -0,0 +1,560 @@
+#!/usr/bin/env python
+"""
+
+f2py2e - Fortran to Python C/API generator. 2nd Edition.
+ See __usage__ below.
+
+Copyright 1999--2005 Pearu Peterson all rights reserved,
+Pearu Peterson <pearu@cens.ioc.ee>
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+$Date: 2005/05/06 08:31:19 $
+Pearu Peterson
+"""
+__version__ = "$Revision: 1.90 $"[10:-1]
+
+import __version__
+f2py_version = __version__.version
+
+import sys,os,string,pprint,shutil,types,re
+errmess=sys.stderr.write
+#outmess=sys.stdout.write
+show=pprint.pprint
+
+import crackfortran
+import rules
+import cb_rules
+import common_rules
+import auxfuncs
+import cfuncs
+import capi_maps
+import func2subr
+import f90mod_rules
+
+outmess = auxfuncs.outmess
+
+try:
+ from numpy import __version__ as numpy_version
+except ImportError:
+ numpy_version = 'N/A'
+
+__usage__ = """\
+Usage:
+
+1) To construct extension module sources:
+
+ f2py [<options>] <fortran files> [[[only:]||[skip:]] \\
+ <fortran functions> ] \\
+ [: <fortran files> ...]
+
+2) To compile fortran files and build extension modules:
+
+ f2py -c [<options>, <build_flib options>, <extra options>] <fortran files>
+
+3) To generate signature files:
+
+ f2py -h <filename.pyf> ...< same options as in (1) >
+
+Description: This program generates a Python C/API file (<modulename>module.c)
+ that contains wrappers for given fortran functions so that they
+ can be called from Python. With the -c option the corresponding
+ extension modules are built.
+
+Options:
+
+ --g3-numpy Use numpy.f2py.lib tool, the 3rd generation of F2PY,
+ with NumPy support.
+ --2d-numpy Use numpy.f2py tool with NumPy support. [DEFAULT]
+ --2d-numeric Use f2py2e tool with Numeric support.
+ --2d-numarray Use f2py2e tool with Numarray support.
+
+ -h <filename> Write signatures of the fortran routines to file <filename>
+ and exit. You can then edit <filename> and use it instead
+ of <fortran files>. If <filename>==stdout then the
+ signatures are printed to stdout.
+ <fortran functions> Names of fortran routines for which Python C/API
+ functions will be generated. Default is all that are found
+ in <fortran files>.
+ <fortran files> Paths to fortran/signature files that will be scanned for
+ <fortran functions> in order to determine their signatures.
+ skip: Ignore fortran functions that follow until `:'.
+ only: Use only fortran functions that follow until `:'.
+ : Get back to <fortran files> mode.
+
+ -m <modulename> Name of the module; f2py generates a Python/C API
+ file <modulename>module.c or extension module <modulename>.
+ Default is 'untitled'.
+
+ --[no-]lower Do [not] lower the cases in <fortran files>. By default,
+ --lower is assumed with -h key, and --no-lower without -h key.
+
+ --build-dir <dirname> All f2py generated files are created in <dirname>.
+ Default is tempfile.mktemp().
+
+ --overwrite-signature Overwrite existing signature file.
+
+ --[no-]latex-doc Create (or not) <modulename>module.tex.
+ Default is --no-latex-doc.
+ --short-latex Create 'incomplete' LaTeX document (without commands
+ \\documentclass, \\tableofcontents, and \\begin{document},
+ \\end{document}).
+
+ --[no-]rest-doc Create (or not) <modulename>module.rst.
+ Default is --no-rest-doc.
+
+ --debug-capi Create C/API code that reports the state of the wrappers
+ during runtime. Useful for debugging.
+
+ --[no-]wrap-functions Create Fortran subroutine wrappers to Fortran 77
+ functions. --wrap-functions is default because it ensures
+ maximum portability/compiler independence.
+
+ --include_paths <path1>:<path2>:... Search include files from the given
+ directories.
+
+ --help-link [..] List system resources found by system_info.py. See also
+ --link-<resource> switch below. [..] is optional list
+ of resources names. E.g. try 'f2py --help-link lapack_opt'.
+
+ --quiet Run quietly.
+ --verbose Run with extra verbosity.
+ -v Print f2py version ID and exit.
+
+
+numpy.distutils options (only effective with -c):
+
+ --fcompiler= Specify Fortran compiler type by vendor
+ --compiler= Specify C compiler type (as defined by distutils)
+
+ --help-fcompiler List available Fortran compilers and exit
+ --f77exec= Specify the path to F77 compiler
+ --f90exec= Specify the path to F90 compiler
+ --f77flags= Specify F77 compiler flags
+ --f90flags= Specify F90 compiler flags
+ --opt= Specify optimization flags
+ --arch= Specify architecture specific optimization flags
+ --noopt Compile without optimization
+ --noarch Compile without arch-dependent optimization
+ --debug Compile with debugging information
+
+Extra options (only effective with -c):
+
+ --link-<resource> Link extension module with <resource> as defined
+ by numpy.distutils/system_info.py. E.g. to link
+ with optimized LAPACK libraries (vecLib on MacOSX,
+ ATLAS elsewhere), use --link-lapack_opt.
+ See also --help-link switch.
+
+ -L/path/to/lib/ -l<libname>
+ -D<define> -U<name>
+ -I/path/to/include/
+ <filename>.o <filename>.so <filename>.a
+
+ Using the following macros may be required with non-gcc Fortran
+ compilers:
+ -DPREPEND_FORTRAN -DNO_APPEND_FORTRAN -DUPPERCASE_FORTRAN
+ -DUNDERSCORE_G77
+
+ When using -DF2PY_REPORT_ATEXIT, a performance report of F2PY
+ interface is printed out at exit (platforms: Linux).
+
+ When using -DF2PY_REPORT_ON_ARRAY_COPY=<int>, a message is
+ sent to stderr whenever F2PY interface makes a copy of an
+ array. Integer <int> sets the threshold for array sizes when
+ a message should be shown.
+
+Version: %s
+numpy Version: %s
+Requires: Python 2.3 or higher.
+License: NumPy license (see LICENSE.txt in the NumPy source code)
+Copyright 1999 - 2005 Pearu Peterson all rights reserved.
+http://cens.ioc.ee/projects/f2py2e/"""%(f2py_version, numpy_version)
+
+
+def scaninputline(inputline):
+ files,funcs,skipfuncs,onlyfuncs,debug=[],[],[],[],[]
+ f,f2,f3,f4,f5,f6,f7=1,0,0,0,0,0,0
+ verbose = 1
+ dolc=-1
+ dolatexdoc = 0
+ dorestdoc = 0
+ wrapfuncs = 1
+ buildpath = '.'
+ include_paths = []
+ signsfile,modulename=None,None
+ options = {'buildpath':buildpath}
+ for l in inputline:
+ if l=='': pass
+ elif l=='only:': f=0
+ elif l=='skip:': f=-1
+ elif l==':': f=1;f4=0
+ elif l[:8]=='--debug-': debug.append(l[8:])
+ elif l=='--lower': dolc=1
+ elif l=='--build-dir': f6=1
+ elif l=='--no-lower': dolc=0
+ elif l=='--quiet': verbose = 0
+ elif l=='--verbose': verbose += 1
+ elif l=='--latex-doc': dolatexdoc=1
+ elif l=='--no-latex-doc': dolatexdoc=0
+ elif l=='--rest-doc': dorestdoc=1
+ elif l=='--no-rest-doc': dorestdoc=0
+ elif l=='--wrap-functions': wrapfuncs=1
+ elif l=='--no-wrap-functions': wrapfuncs=0
+ elif l=='--short-latex': options['shortlatex']=1
+ elif l=='--overwrite-signature': options['h-overwrite']=1
+ elif l=='-h': f2=1
+ elif l=='-m': f3=1
+ elif l[:2]=='-v':
+ print f2py_version
+ sys.exit()
+ elif l=='--show-compilers':
+ f5=1
+ elif l[:8]=='-include':
+ cfuncs.outneeds['userincludes'].append(l[9:-1])
+ cfuncs.userincludes[l[9:-1]]='#include '+l[8:]
+ elif l[:15]=='--include_paths':
+ f7=1
+ elif l[0]=='-':
+ errmess('Unknown option %s\n'%`l`)
+ sys.exit()
+ elif f2: f2=0;signsfile=l
+ elif f3: f3=0;modulename=l
+ elif f6: f6=0;buildpath=l
+ elif f7: f7=0;include_paths.extend(l.split(os.pathsep))
+ elif f==1:
+ try:
+ open(l).close()
+ files.append(l)
+ except IOError,detail:
+ errmess('IOError: %s. Skipping file "%s".\n'%(str(detail),l))
+ elif f==-1: skipfuncs.append(l)
+ elif f==0: onlyfuncs.append(l)
+ if not f5 and not files and not modulename:
+ print __usage__
+ sys.exit()
+ if not os.path.isdir(buildpath):
+ if not verbose:
+ outmess('Creating build directory %s'%(buildpath))
+ os.mkdir(buildpath)
+ if signsfile:
+ signsfile = os.path.join(buildpath,signsfile)
+ if signsfile and os.path.isfile(signsfile) and not options.has_key('h-overwrite'):
+ errmess('Signature file "%s" exists!!! Use --overwrite-signature to overwrite.\n'%(signsfile))
+ sys.exit()
+
+ options['debug']=debug
+ options['verbose']=verbose
+ if dolc==-1 and not signsfile: options['do-lower']=0
+ else: options['do-lower']=dolc
+ if modulename: options['module']=modulename
+ if signsfile: options['signsfile']=signsfile
+ if onlyfuncs: options['onlyfuncs']=onlyfuncs
+ if skipfuncs: options['skipfuncs']=skipfuncs
+ options['dolatexdoc'] = dolatexdoc
+ options['dorestdoc'] = dorestdoc
+ options['wrapfuncs'] = wrapfuncs
+ options['buildpath']=buildpath
+ options['include_paths']=include_paths
+ return files,options
+
+def callcrackfortran(files,options):
+ rules.options=options
+ funcs=[]
+ crackfortran.debug=options['debug']
+ crackfortran.verbose=options['verbose']
+ if options.has_key('module'):
+ crackfortran.f77modulename=options['module']
+ if options.has_key('skipfuncs'):
+ crackfortran.skipfuncs=options['skipfuncs']
+ if options.has_key('onlyfuncs'):
+ crackfortran.onlyfuncs=options['onlyfuncs']
+ crackfortran.include_paths[:]=options['include_paths']
+ crackfortran.dolowercase=options['do-lower']
+ postlist=crackfortran.crackfortran(files)
+ if options.has_key('signsfile'):
+ outmess('Saving signatures to file "%s"\n'%(options['signsfile']))
+ pyf=crackfortran.crack2fortran(postlist)
+ if options['signsfile'][-6:]=='stdout':
+ sys.stdout.write(pyf)
+ else:
+ f=open(options['signsfile'],'w')
+ f.write(pyf)
+ f.close()
+ return postlist
+
+def buildmodules(list):
+ cfuncs.buildcfuncs()
+ outmess('Building modules...\n')
+ modules,mnames,isusedby=[],[],{}
+ for i in range(len(list)):
+ if string.find(list[i]['name'],'__user__')>=0:
+ cb_rules.buildcallbacks(list[i])
+ else:
+ if list[i].has_key('use'):
+ for u in list[i]['use'].keys():
+ if not isusedby.has_key(u): isusedby[u]=[]
+ isusedby[u].append(list[i]['name'])
+ modules.append(list[i])
+ mnames.append(list[i]['name'])
+ ret = {}
+ for i in range(len(mnames)):
+ if isusedby.has_key(mnames[i]):
+ outmess('\tSkipping module "%s" which is used by %s.\n'%(mnames[i],string.join(map(lambda s:'"%s"'%s,isusedby[mnames[i]]),',')))
+ else:
+ um=[]
+ if modules[i].has_key('use'):
+ for u in modules[i]['use'].keys():
+ if isusedby.has_key(u) and u in mnames:
+ um.append(modules[mnames.index(u)])
+ else:
+ outmess('\tModule "%s" uses nonexisting "%s" which will be ignored.\n'%(mnames[i],u))
+ ret[mnames[i]] = {}
+ dict_append(ret[mnames[i]],rules.buildmodule(modules[i],um))
+ return ret
+
+def dict_append(d_out,d_in):
+ for (k,v) in d_in.items():
+ if not d_out.has_key(k):
+ d_out[k] = []
+ if type(v) is types.ListType:
+ d_out[k] = d_out[k] + v
+ else:
+ d_out[k].append(v)
+
+def run_main(comline_list):
+ """Run f2py as if string.join(comline_list,' ') is used as a command line.
+ In case of using -h flag, return None.
+ """
+ reload(crackfortran)
+ f2pydir=os.path.dirname(os.path.abspath(cfuncs.__file__))
+ fobjhsrc = os.path.join(f2pydir,'src','fortranobject.h')
+ fobjcsrc = os.path.join(f2pydir,'src','fortranobject.c')
+ files,options=scaninputline(comline_list)
+ auxfuncs.options=options
+ postlist=callcrackfortran(files,options)
+ isusedby={}
+ for i in range(len(postlist)):
+ if postlist[i].has_key('use'):
+ for u in postlist[i]['use'].keys():
+ if not isusedby.has_key(u): isusedby[u]=[]
+ isusedby[u].append(postlist[i]['name'])
+ for i in range(len(postlist)):
+ if postlist[i]['block']=='python module' and string.find(postlist[i]['name'],'__user__')<0:
+ if isusedby.has_key(postlist[i]['name']):
+ #if not quiet:
+ outmess('Skipping Makefile build for module "%s" which is used by %s\n'%(postlist[i]['name'],string.join(map(lambda s:'"%s"'%s,isusedby[postlist[i]['name']]),',')))
+ if options.has_key('signsfile'):
+ if options['verbose']>1:
+ outmess('Stopping. Edit the signature file and then run f2py on the signature file: ')
+ outmess('%s %s\n'%(os.path.basename(sys.argv[0]),options['signsfile']))
+ return
+ for i in range(len(postlist)):
+ if postlist[i]['block']!='python module':
+ if not options.has_key('python module'):
+ errmess('Tip: If your original code is Fortran source then you must use -m option.\n')
+ raise TypeError,'All blocks must be python module blocks but got %s'%(`postlist[i]['block']`)
+ auxfuncs.debugoptions=options['debug']
+ f90mod_rules.options=options
+ auxfuncs.wrapfuncs=options['wrapfuncs']
+
+ ret=buildmodules(postlist)
+
+ for mn in ret.keys():
+ dict_append(ret[mn],{'csrc':fobjcsrc,'h':fobjhsrc})
+ return ret
+
+def filter_files(prefix,suffix,files,remove_prefix=None):
+ """
+ Filter files by prefix and suffix.
+ """
+ filtered,rest = [],[]
+ match = re.compile(prefix+r'.*'+suffix+r'\Z').match
+ if remove_prefix:
+ ind = len(prefix)
+ else:
+ ind = 0
+ for file in map(string.strip,files):
+ if match(file): filtered.append(file[ind:])
+ else: rest.append(file)
+ return filtered,rest
+
+def get_prefix(module):
+ p = os.path.dirname(os.path.dirname(module.__file__))
+ return p
+
+def run_compile():
+ """
+ Do it all in one call!
+ """
+ import tempfile,os,shutil
+
+ i = sys.argv.index('-c')
+ del sys.argv[i]
+
+ remove_build_dir = 0
+ try: i = sys.argv.index('--build-dir')
+ except ValueError: i=None
+ if i is not None:
+ build_dir = sys.argv[i+1]
+ del sys.argv[i+1]
+ del sys.argv[i]
+ else:
+ remove_build_dir = 1
+ build_dir = os.path.join(tempfile.mktemp())
+
+ sysinfo_flags = filter(re.compile(r'[-][-]link[-]').match,sys.argv[1:])
+ sys.argv = filter(lambda a,flags=sysinfo_flags:a not in flags,sys.argv)
+ if sysinfo_flags:
+ sysinfo_flags = [f[7:] for f in sysinfo_flags]
+
+ f2py_flags = filter(re.compile(r'[-][-]((no[-]|)(wrap[-]functions|lower)|debug[-]capi|quiet)|[-]include').match,sys.argv[1:])
+ sys.argv = filter(lambda a,flags=f2py_flags:a not in flags,sys.argv)
+ f2py_flags2 = []
+ fl = 0
+ for a in sys.argv[1:]:
+ if a in ['only:','skip:']:
+ fl = 1
+ elif a==':':
+ fl = 0
+ if fl or a==':':
+ f2py_flags2.append(a)
+ if f2py_flags2 and f2py_flags2[-1]!=':':
+ f2py_flags2.append(':')
+ f2py_flags.extend(f2py_flags2)
+
+ sys.argv = filter(lambda a,flags=f2py_flags2:a not in flags,sys.argv)
+
+ flib_flags = filter(re.compile(r'[-][-]((f(90)?compiler([-]exec|)|compiler)=|help[-]compiler)').match,sys.argv[1:])
+ sys.argv = filter(lambda a,flags=flib_flags:a not in flags,sys.argv)
+ fc_flags = filter(re.compile(r'[-][-]((f(77|90)(flags|exec)|opt|arch)=|(debug|noopt|noarch|help[-]fcompiler))').match,sys.argv[1:])
+ sys.argv = filter(lambda a,flags=fc_flags:a not in flags,sys.argv)
+
+ if 1:
+ del_list = []
+ for s in flib_flags:
+ v = '--fcompiler='
+ if s[:len(v)]==v:
+ from numpy.distutils import fcompiler
+ allowed_keys = fcompiler.fcompiler_class.keys()
+ nv = ov = s[len(v):].lower()
+ if ov not in allowed_keys:
+ vmap = {} # XXX
+ try:
+ nv = vmap[ov]
+ except KeyError:
+ if ov not in vmap.values():
+ print 'Unknown vendor: "%s"' % (s[len(v):])
+ nv = ov
+ i = flib_flags.index(s)
+ flib_flags[i] = '--fcompiler=' + nv
+ continue
+ for s in del_list:
+ i = flib_flags.index(s)
+ del flib_flags[i]
+ assert len(flib_flags)<=2,`flib_flags`
+ setup_flags = filter(re.compile(r'[-][-](verbose)').match,sys.argv[1:])
+ sys.argv = filter(lambda a,flags=setup_flags:a not in flags,sys.argv)
+ if '--quiet' in f2py_flags:
+ setup_flags.append('--quiet')
+
+ modulename = 'untitled'
+ sources = sys.argv[1:]
+ if '-m' in sys.argv:
+ i = sys.argv.index('-m')
+ modulename = sys.argv[i+1]
+ del sys.argv[i+1],sys.argv[i]
+ sources = sys.argv[1:]
+ else:
+ from numpy.distutils.command.build_src import get_f2py_modulename
+ pyf_files,sources = filter_files('','[.]pyf([.]src|)',sources)
+ sources = pyf_files + sources
+ for f in pyf_files:
+ modulename = get_f2py_modulename(f)
+ if modulename:
+ break
+
+ extra_objects, sources = filter_files('','[.](o|a|so)',sources)
+ include_dirs, sources = filter_files('-I','',sources,remove_prefix=1)
+ library_dirs, sources = filter_files('-L','',sources,remove_prefix=1)
+ libraries, sources = filter_files('-l','',sources,remove_prefix=1)
+ undef_macros, sources = filter_files('-U','',sources,remove_prefix=1)
+ define_macros, sources = filter_files('-D','',sources,remove_prefix=1)
+ using_numarray = 0
+ using_numeric = 0
+ for i in range(len(define_macros)):
+ name_value = string.split(define_macros[i],'=',1)
+ if len(name_value)==1:
+ name_value.append(None)
+ if len(name_value)==2:
+ define_macros[i] = tuple(name_value)
+ else:
+ print 'Invalid use of -D:',name_value
+
+ from numpy.distutils.system_info import get_info
+
+ num_include_dir = None
+ num_info = {}
+ #import numpy
+ #n = 'numpy'
+ #p = get_prefix(numpy)
+ #from numpy.distutils.misc_util import get_numpy_include_dirs
+ #num_info = {'include_dirs': get_numpy_include_dirs()}
+
+ if num_info:
+ include_dirs.extend(num_info.get('include_dirs',[]))
+
+ from numpy.distutils.core import setup,Extension
+ ext_args = {'name':modulename,'sources':sources,
+ 'include_dirs': include_dirs,
+ 'library_dirs': library_dirs,
+ 'libraries': libraries,
+ 'define_macros': define_macros,
+ 'undef_macros': undef_macros,
+ 'extra_objects': extra_objects,
+ 'f2py_options': f2py_flags,
+ }
+
+ if sysinfo_flags:
+ from numpy.distutils.misc_util import dict_append
+ for n in sysinfo_flags:
+ i = get_info(n)
+ if not i:
+ outmess('No %s resources found in system'\
+ ' (try `f2py --help-link`)\n' % (`n`))
+ dict_append(ext_args,**i)
+
+ ext = Extension(**ext_args)
+ sys.argv = [sys.argv[0]] + setup_flags
+ sys.argv.extend(['build',
+ '--build-temp',build_dir,
+ '--build-base',build_dir,
+ '--build-platlib','.'])
+ if fc_flags:
+ sys.argv.extend(['config_fc']+fc_flags)
+ if flib_flags:
+ sys.argv.extend(['build_ext']+flib_flags)
+
+ setup(ext_modules = [ext])
+
+ if remove_build_dir and os.path.exists(build_dir):
+ outmess('Removing build directory %s\n'%(build_dir))
+ shutil.rmtree(build_dir)
+
+def main():
+ if '--help-link' in sys.argv[1:]:
+ sys.argv.remove('--help-link')
+ from numpy.distutils.system_info import show_all
+ show_all()
+ return
+ if '-c' in sys.argv[1:]:
+ run_compile()
+ else:
+ run_main(sys.argv[1:])
+
+#if __name__ == "__main__":
+# main()
+
+
+# EOF
diff --git a/numpy/f2py/f2py_testing.py b/numpy/f2py/f2py_testing.py
new file mode 100644
index 000000000..03085c28e
--- /dev/null
+++ b/numpy/f2py/f2py_testing.py
@@ -0,0 +1,73 @@
+import os,sys,re,time
+
+def cmdline():
+ m=re.compile(r'\A\d+\Z')
+ args = []
+ repeat = 1
+ for a in sys.argv[1:]:
+ if m.match(a):
+ repeat = eval(a)
+ else:
+ args.append(a)
+ f2py_opts = ' '.join(args)
+ return repeat,f2py_opts
+
+if sys.platform[:5]=='linux':
+ def jiffies(_proc_pid_stat = '/proc/%s/stat'%(os.getpid()),
+ _load_time=time.time()):
+ """ Return number of jiffies (1/100ths of a second) that this
+ process has been scheduled in user mode. See man 5 proc. """
+ try:
+ f=open(_proc_pid_stat,'r')
+ l = f.readline().split(' ')
+ f.close()
+ return int(l[13])
+ except:
+ return int(100*(time.time()-_load_time))
+
+ def memusage(_proc_pid_stat = '/proc/%s/stat'%(os.getpid())):
+ """ Return virtual memory size in bytes of the running python.
+ """
+ try:
+ f=open(_proc_pid_stat,'r')
+ l = f.readline().split(' ')
+ f.close()
+ return int(l[22])
+ except:
+ return
+else:
+ def jiffies(_load_time=time.time()):
+ """ Return number of jiffies (1/100ths of a second) that this
+ process has been scheduled in user mode. [Emulation with time.time]. """
+ return int(100*(time.time()-_load_time))
+
+ def memusage():
+ pass
+
+def run(runtest,test_functions,repeat=1):
+ l = [(t,repr(t.__doc__.split('\n')[1].strip())) for t in test_functions]
+ #l = [(t,'') for t in test_functions]
+ start_memusage = memusage()
+ diff_memusage = None
+ start_jiffies = jiffies()
+ i = 0
+ while i<repeat:
+ i += 1
+ for t,fname in l:
+ runtest(t)
+ if start_memusage is None: continue
+ if diff_memusage is None:
+ diff_memusage = memusage() - start_memusage
+ else:
+ diff_memusage2 = memusage() - start_memusage
+ if diff_memusage2!=diff_memusage:
+ print 'memory usage change at step %i:' % i,\
+ diff_memusage2-diff_memusage,\
+ fname
+ diff_memusage = diff_memusage2
+ current_memusage = memusage()
+ print 'run',repeat*len(test_functions),'tests',\
+ 'in %.2f seconds' % ((jiffies()-start_jiffies)/100.0)
+ if start_memusage:
+ print 'initial virtual memory size:',start_memusage,'bytes'
+ print 'current virtual memory size:',current_memusage,'bytes'
diff --git a/numpy/f2py/f90mod_rules.py b/numpy/f2py/f90mod_rules.py
new file mode 100644
index 000000000..ffd432b1d
--- /dev/null
+++ b/numpy/f2py/f90mod_rules.py
@@ -0,0 +1,240 @@
+#!/usr/bin/env python
+"""
+
+Build F90 module support for f2py2e.
+
+Copyright 2000 Pearu Peterson all rights reserved,
+Pearu Peterson <pearu@ioc.ee>
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+$Date: 2005/02/03 19:30:23 $
+Pearu Peterson
+"""
+
+__version__ = "$Revision: 1.27 $"[10:-1]
+
+f2py_version='See `f2py -v`'
+
+import pprint
+import sys,string,time,types,copy
+errmess=sys.stderr.write
+outmess=sys.stdout.write
+show=pprint.pprint
+
+from auxfuncs import *
+import numpy as N
+import capi_maps
+import cfuncs
+import rules
+import func2subr
+from crackfortran import undo_rmbadname, undo_rmbadname1
+
+options={}
+
+def findf90modules(m):
+ if ismodule(m): return [m]
+ if not hasbody(m): return []
+ ret = []
+ for b in m['body']:
+ if ismodule(b): ret.append(b)
+ else: ret=ret+findf90modules(b)
+ return ret
+
+fgetdims1 = """\
+ external f2pysetdata
+ logical ns
+ integer r,i,j
+ integer(%d) s(*)
+ ns = .FALSE.
+ if (allocated(d)) then
+ do i=1,r
+ if ((size(d,i).ne.s(i)).and.(s(i).ge.0)) then
+ ns = .TRUE.
+ end if
+ end do
+ if (ns) then
+ deallocate(d)
+ end if
+ end if
+ if ((.not.allocated(d)).and.(s(1).ge.1)) then""" % N.intp().itemsize
+
+fgetdims2="""\
+ end if
+ if (allocated(d)) then
+ do i=1,r
+ s(i) = size(d,i)
+ end do
+ end if
+ flag = 1
+ call f2pysetdata(d,allocated(d))"""
+
+fgetdims2_sa="""\
+ end if
+ if (allocated(d)) then
+ do i=1,r
+ s(i) = size(d,i)
+ end do
+ !s(r) must be equal to len(d(1))
+ end if
+ flag = 2
+ call f2pysetdata(d,allocated(d))"""
+
+
+def buildhooks(pymod):
+ global fgetdims1,fgetdims2
+ ret = {'f90modhooks':[],'initf90modhooks':[],'body':[],
+ 'need':['F_FUNC','arrayobject.h'],
+ 'separatorsfor':{'includes0':'\n','includes':'\n'},
+ 'docs':['"Fortran 90/95 modules:\\n"'],
+ 'latexdoc':[]}
+ fhooks=['']
+ def fadd(line,s=fhooks): s[0] = '%s\n %s'%(s[0],line)
+ doc = ['']
+ def dadd(line,s=doc): s[0] = '%s\n%s'%(s[0],line)
+ for m in findf90modules(pymod):
+ sargs,fargs,efargs,modobjs,notvars,onlyvars=[],[],[],[],[m['name']],[]
+ sargsp = []
+ ifargs = []
+ mfargs = []
+ if hasbody(m):
+ for b in m['body']: notvars.append(b['name'])
+ for n in m['vars'].keys():
+ var = m['vars'][n]
+ if (n not in notvars) and (not l_or(isintent_hide,isprivate)(var)):
+ onlyvars.append(n)
+ mfargs.append(n)
+ outmess('\t\tConstructing F90 module support for "%s"...\n'%(m['name']))
+ if onlyvars:
+ outmess('\t\t Variables: %s\n'%(string.join(onlyvars)))
+ chooks=['']
+ def cadd(line,s=chooks): s[0] = '%s\n%s'%(s[0],line)
+ ihooks=['']
+ def iadd(line,s=ihooks): s[0] = '%s\n%s'%(s[0],line)
+
+ vrd=capi_maps.modsign2map(m)
+ cadd('static FortranDataDef f2py_%s_def[] = {'%(m['name']))
+ dadd('\\subsection{Fortran 90/95 module \\texttt{%s}}\n'%(m['name']))
+ if hasnote(m):
+ note = m['note']
+ if type(note) is type([]): note=string.join(note,'\n')
+ dadd(note)
+ if onlyvars:
+ dadd('\\begin{description}')
+ for n in onlyvars:
+ var = m['vars'][n]
+ modobjs.append(n)
+ ct = capi_maps.getctype(var)
+ at = capi_maps.c2capi_map[ct]
+ dm = capi_maps.getarrdims(n,var)
+ dms = string.strip(string.replace(dm['dims'],'*','-1'))
+ dms = string.strip(string.replace(dms,':','-1'))
+ if not dms: dms='-1'
+ use_fgetdims2 = fgetdims2
+ if isstringarray(var):
+ if var.has_key('charselector') and var['charselector'].has_key('len'):
+ cadd('\t{"%s",%s,{{%s,%s}},%s},'\
+ %(undo_rmbadname1(n),dm['rank'],dms,var['charselector']['len'],at))
+ use_fgetdims2 = fgetdims2_sa
+ else:
+ cadd('\t{"%s",%s,{{%s}},%s},'%(undo_rmbadname1(n),dm['rank'],dms,at))
+ else:
+ cadd('\t{"%s",%s,{{%s}},%s},'%(undo_rmbadname1(n),dm['rank'],dms,at))
+ dadd('\\item[]{{}\\verb@%s@{}}'%(capi_maps.getarrdocsign(n,var)))
+ if hasnote(var):
+ note = var['note']
+ if type(note) is type([]): note=string.join(note,'\n')
+ dadd('--- %s'%(note))
+ if isallocatable(var):
+ fargs.append('f2py_%s_getdims_%s'%(m['name'],n))
+ efargs.append(fargs[-1])
+ sargs.append('void (*%s)(int*,int*,void(*)(char*,int*),int*)'%(n))
+ sargsp.append('void (*)(int*,int*,void(*)(char*,int*),int*)')
+ iadd('\tf2py_%s_def[i_f2py++].func = %s;'%(m['name'],n))
+ fadd('subroutine %s(r,s,f2pysetdata,flag)'%(fargs[-1]))
+ fadd('use %s, only: d => %s\n'%(m['name'],undo_rmbadname1(n)))
+ fadd('integer flag\n')
+ fhooks[0]=fhooks[0]+fgetdims1
+ dms = eval('range(1,%s+1)'%(dm['rank']))
+ fadd(' allocate(d(%s))\n'%(string.join(map(lambda i:'s(%s)'%i,dms),',')))
+ fhooks[0]=fhooks[0]+use_fgetdims2
+ fadd('end subroutine %s'%(fargs[-1]))
+ else:
+ fargs.append(n)
+ sargs.append('char *%s'%(n))
+ sargsp.append('char*')
+ iadd('\tf2py_%s_def[i_f2py++].data = %s;'%(m['name'],n))
+ if onlyvars:
+ dadd('\\end{description}')
+ if hasbody(m):
+ for b in m['body']:
+ if not isroutine(b):
+ print 'Skipping',b['block'],b['name']
+ continue
+ modobjs.append('%s()'%(b['name']))
+ b['modulename'] = m['name']
+ api,wrap=rules.buildapi(b)
+ if isfunction(b):
+ fhooks[0]=fhooks[0]+wrap
+ fargs.append('f2pywrap_%s_%s'%(m['name'],b['name']))
+ #efargs.append(fargs[-1])
+ ifargs.append(func2subr.createfuncwrapper(b,signature=1))
+ else:
+ fargs.append(b['name'])
+ mfargs.append(fargs[-1])
+ #if options.has_key('--external-modroutines') and options['--external-modroutines']:
+ # outmess('\t\t\tapplying --external-modroutines for %s\n'%(b['name']))
+ # efargs.append(fargs[-1])
+ api['externroutines']=[]
+ ar=applyrules(api,vrd)
+ ar['docs']=[]
+ ar['docshort']=[]
+ ret=dictappend(ret,ar)
+ cadd('\t{"%s",-1,{{-1}},0,NULL,(void *)f2py_rout_#modulename#_%s_%s,doc_f2py_rout_#modulename#_%s_%s},'%(b['name'],m['name'],b['name'],m['name'],b['name']))
+ sargs.append('char *%s'%(b['name']))
+ sargsp.append('char *')
+ iadd('\tf2py_%s_def[i_f2py++].data = %s;'%(m['name'],b['name']))
+ cadd('\t{NULL}\n};\n')
+ iadd('}')
+ ihooks[0]='static void f2py_setup_%s(%s) {\n\tint i_f2py=0;%s'%(m['name'],string.join(sargs,','),ihooks[0])
+ if '_' in m['name']:
+ F_FUNC='F_FUNC_US'
+ else:
+ F_FUNC='F_FUNC'
+ iadd('extern void %s(f2pyinit%s,F2PYINIT%s)(void (*)(%s));'\
+ %(F_FUNC,m['name'],string.upper(m['name']),string.join(sargsp,',')))
+ iadd('static void f2py_init_%s(void) {'%(m['name']))
+ iadd('\t%s(f2pyinit%s,F2PYINIT%s)(f2py_setup_%s);'\
+ %(F_FUNC,m['name'],string.upper(m['name']),m['name']))
+ iadd('}\n')
+ ret['f90modhooks']=ret['f90modhooks']+chooks+ihooks
+ ret['initf90modhooks']=['\tPyDict_SetItemString(d, "%s", PyFortranObject_New(f2py_%s_def,f2py_init_%s));'%(m['name'],m['name'],m['name'])]+ret['initf90modhooks']
+ fadd('')
+ fadd('subroutine f2pyinit%s(f2pysetupfunc)'%(m['name']))
+ #fadd('use %s'%(m['name']))
+ if mfargs:
+ for a in undo_rmbadname(mfargs):
+ fadd('use %s, only : %s'%(m['name'],a))
+ if ifargs:
+ fadd(string.join(['interface']+ifargs))
+ fadd('end interface')
+ fadd('external f2pysetupfunc')
+ if efargs:
+ for a in undo_rmbadname(efargs):
+ fadd('external %s'%(a))
+ fadd('call f2pysetupfunc(%s)'%(string.join(undo_rmbadname(fargs),',')))
+ fadd('end subroutine f2pyinit%s\n'%(m['name']))
+
+ dadd(string.replace(string.join(ret['latexdoc'],'\n'),r'\subsection{',r'\subsubsection{'))
+
+ ret['latexdoc']=[]
+ ret['docs'].append('"\t%s --- %s"'%(m['name'],
+ string.join(undo_rmbadname(modobjs),',')))
+
+ ret['routine_defs']=''
+ ret['doc']=[]
+ ret['docshort']=[]
+ ret['latexdoc']=doc[0]
+ if len(ret['docs'])<=1: ret['docs']=''
+ return ret,fhooks[0]
diff --git a/numpy/f2py/func2subr.py b/numpy/f2py/func2subr.py
new file mode 100644
index 000000000..4cec37032
--- /dev/null
+++ b/numpy/f2py/func2subr.py
@@ -0,0 +1,165 @@
+#!/usr/bin/env python
+"""
+
+Rules for building C/API module with f2py2e.
+
+Copyright 1999,2000 Pearu Peterson all rights reserved,
+Pearu Peterson <pearu@ioc.ee>
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+$Date: 2004/11/26 11:13:06 $
+Pearu Peterson
+"""
+
+__version__ = "$Revision: 1.16 $"[10:-1]
+
+f2py_version='See `f2py -v`'
+
+import pprint,copy
+import sys,string,time,types,copy
+errmess=sys.stderr.write
+outmess=sys.stdout.write
+show=pprint.pprint
+
+from auxfuncs import *
+def var2fixfortran(vars,a,fa=None,f90mode=None):
+ if fa is None:
+ fa = a
+ if not vars.has_key(a):
+ show(vars)
+ outmess('var2fixfortran: No definition for argument "%s".\n'%a)
+ return ''
+ if not vars[a].has_key('typespec'):
+ show(vars[a])
+ outmess('var2fixfortran: No typespec for argument "%s".\n'%a)
+ return ''
+ vardef=vars[a]['typespec']
+ if vardef=='type' and vars[a].has_key('typename'):
+ vardef='%s(%s)'%(vardef,vars[a]['typename'])
+ selector={}
+ lk = ''
+ if vars[a].has_key('kindselector'):
+ selector=vars[a]['kindselector']
+ lk = 'kind'
+ elif vars[a].has_key('charselector'):
+ selector=vars[a]['charselector']
+ lk = 'len'
+ if selector.has_key('*'):
+ if f90mode:
+ if selector['*'] in ['*',':','(*)']:
+ vardef='%s(len=*)'%(vardef)
+ else:
+ vardef='%s(%s=%s)'%(vardef,lk,selector['*'])
+ else:
+ if selector['*'] in ['*',':']:
+ vardef='%s*(%s)'%(vardef,selector['*'])
+ else:
+ vardef='%s*%s'%(vardef,selector['*'])
+ else:
+ if selector.has_key('len'):
+ vardef='%s(len=%s'%(vardef,selector['len'])
+ if selector.has_key('kind'):
+ vardef='%s,kind=%s)'%(vardef,selector['kind'])
+ else:
+ vardef='%s)'%(vardef)
+ elif selector.has_key('kind'):
+ vardef='%s(kind=%s)'%(vardef,selector['kind'])
+
+ vardef='%s %s'%(vardef,fa)
+ if vars[a].has_key('dimension'):
+ vardef='%s(%s)'%(vardef,string.join(vars[a]['dimension'],','))
+ return vardef
+
+def createfuncwrapper(rout,signature=0):
+ assert isfunction(rout)
+ ret = ['']
+ def add(line,ret=ret):
+ ret[0] = '%s\n %s'%(ret[0],line)
+ name = rout['name']
+ fortranname = getfortranname(rout)
+ f90mode = ismoduleroutine(rout)
+ newname = '%sf2pywrap'%(name)
+ vars = rout['vars']
+ if not vars.has_key(newname):
+ vars[newname] = vars[name]
+ args = [newname]+rout['args'][1:]
+ else:
+ args = [newname]+rout['args']
+
+ l = var2fixfortran(vars,name,newname,f90mode)
+ return_char_star = 0
+ if l[:13]=='character*(*)':
+ return_char_star = 1
+ if f90mode: l = 'character(len=10)'+l[13:]
+ else: l = 'character*10'+l[13:]
+ charselect = vars[name]['charselector']
+ if charselect.get('*','')=='(*)':
+ charselect['*'] = '10'
+ if f90mode:
+ sargs = string.join(args,', ')
+ add('subroutine f2pywrap_%s_%s (%s)'%(rout['modulename'],name,sargs))
+ if not signature:
+ add('use %s, only : %s'%(rout['modulename'],fortranname))
+ else:
+ add('subroutine f2pywrap%s (%s)'%(name,string.join(args,', ')))
+ add('external %s'%(fortranname))
+ #if not return_char_star:
+ l = l + ', '+fortranname
+ args = args[1:]
+ dumped_args = []
+ for a in args:
+ if isexternal(vars[a]):
+ add('external %s'%(a))
+ dumped_args.append(a)
+ for a in args:
+ if a in dumped_args: continue
+ if isscalar(vars[a]):
+ add(var2fixfortran(vars,a,f90mode=f90mode))
+ dumped_args.append(a)
+ for a in args:
+ if a in dumped_args: continue
+ add(var2fixfortran(vars,a,f90mode=f90mode))
+
+ add(l)
+
+ if not signature:
+ if islogicalfunction(rout):
+ add('%s = .not.(.not.%s(%s))'%(newname,fortranname,string.join(args,', ')))
+ else:
+ add('%s = %s(%s)'%(newname,fortranname,string.join(args,', ')))
+ if f90mode:
+ add('end subroutine f2pywrap_%s_%s'%(rout['modulename'],name))
+ else:
+ add('end')
+ #print '**'*10
+ #print ret[0]
+ #print '**'*10
+ return ret[0]
+
+def assubr(rout):
+ if not isfunction_wrap(rout): return rout,''
+ fortranname = getfortranname(rout)
+ name = rout['name']
+ outmess('\t\tCreating wrapper for Fortran function "%s"("%s")...\n'%(name,fortranname))
+ rout = copy.copy(rout)
+ fname = name
+ rname = fname
+ if rout.has_key('result'):
+ rname = rout['result']
+ rout['vars'][fname]=rout['vars'][rname]
+ fvar = rout['vars'][fname]
+ if not isintent_out(fvar):
+ if not fvar.has_key('intent'): fvar['intent']=[]
+ fvar['intent'].append('out')
+ flag=1
+ for i in fvar['intent']:
+ if i.startswith('out='):
+ flag = 0
+ break
+ if flag:
+ fvar['intent'].append('out=%s' % (rname))
+
+ rout['args'] = [fname] + rout['args']
+ return rout,createfuncwrapper(rout)
diff --git a/numpy/f2py/info.py b/numpy/f2py/info.py
new file mode 100644
index 000000000..8beaba228
--- /dev/null
+++ b/numpy/f2py/info.py
@@ -0,0 +1,5 @@
+"""Fortran to Python Interface Generator.
+
+"""
+
+postpone_import = True
diff --git a/numpy/f2py/lib/__init__.py b/numpy/f2py/lib/__init__.py
new file mode 100644
index 000000000..c3b40cb76
--- /dev/null
+++ b/numpy/f2py/lib/__init__.py
@@ -0,0 +1,14 @@
+"""
+F2PY G3 --- The third generation of Fortran to Python Interface Generator.
+
+Use api module for importing public symbols.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: Oct 2006
+-----
+"""
diff --git a/numpy/f2py/lib/api.py b/numpy/f2py/lib/api.py
new file mode 100644
index 000000000..0d21da28c
--- /dev/null
+++ b/numpy/f2py/lib/api.py
@@ -0,0 +1,14 @@
+"""
+Public API for F2PY G3.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: Oct 2006
+-----
+"""
+
+from main import main
diff --git a/numpy/f2py/lib/main.py b/numpy/f2py/lib/main.py
new file mode 100644
index 000000000..6c2e1415e
--- /dev/null
+++ b/numpy/f2py/lib/main.py
@@ -0,0 +1,534 @@
+"""
+Tools for building F2PY generated extension modules.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: Oct 2006
+-----
+"""
+
+import os
+import re
+import sys
+import tempfile
+
+try:
+ from numpy import __version__ as numpy_version
+except ImportError:
+ numpy_version = 'N/A'
+
+__all__ = ['main', 'compile']
+
+__usage__ = """
+F2PY G3 --- The third generation of Fortran to Python Interface Generator
+=========================================================================
+
+Description
+-----------
+
+f2py program generates a Python C/API file (<modulename>module.c) that
+contains wrappers for given Fortran functions and data so that they
+can be accessed from Python. With the -c option the corresponding
+extension modules are built.
+
+Options
+-------
+
+ --g3-numpy Use numpy.f2py.lib tool, the 3rd generation of F2PY,
+ with NumPy support.
+ --2d-numpy Use numpy.f2py tool with NumPy support. [DEFAULT]
+ --2d-numeric Use f2py2e tool with Numeric support.
+ --2d-numarray Use f2py2e tool with Numarray support.
+
+ -m <modulename> Name of the module; f2py generates a Python/C API
+ file <modulename>module.c or extension module <modulename>.
+ For wrapping Fortran 90 modules, f2py will use Fortran
+ module names.
+ --parse Parse Fortran files and print result to stdout.
+
+
+Options effective only with -h
+------------------------------
+
+ -h <filename> Write signatures of the fortran routines to file <filename>
+ and exit. You can then edit <filename> and use it instead
+ of <fortran files> for generating extension module source.
+ If <filename> is stdout or stderr then the signatures are
+ printed to the corresponding stream.
+
+ --overwrite-signature Overwrite existing signature file.
+
+Options effective only with -c
+------------------------------
+
+ -c Compile fortran sources and build extension module.
+
+ --build-dir <dirname> All f2py generated files are created in <dirname>.
+ Default is tempfile.mktemp() and it will be removed after
+ f2py stops unless <dirname> is specified via --build-dir
+ option.
+
+numpy.distutils options effective only with -c
+----------------------------------------------
+
+ --fcompiler=<name> Specify Fortran compiler type by vendor
+
+
+
+Extra options effective only with -c
+------------------------------------
+
+ -L/path/to/lib/ -l<libname>
+ -D<name[=define]> -U<name>
+ -I/path/to/include/
+ <filename>.o <filename>.(so|dynlib|dll) <filename>.a
+
+ Using the following macros may be required with non-gcc Fortran
+ compilers:
+ -DPREPEND_FORTRAN -DNO_APPEND_FORTRAN -DUPPERCASE_FORTRAN
+ -DUNDERSCORE_G77
+
+ -DF2PY_DEBUG_PYOBJ_TOFROM --- pyobj_(to|from)_<ctype> functions will
+ print debugging messages to stderr.
+
+"""
+
+import re
+import shutil
+import parser.api
+from parser.api import parse, PythonModule, EndStatement, Module, Subroutine, Function,\
+ get_reader
+
+def get_values(sys_argv, prefix='', suffix='', strip_prefix=False, strip_suffix=False):
+ """
+ Return a list of values with pattern
+ <prefix><value><suffix>.
+ The corresponding items will be removed from sys_argv.
+ """
+ match = re.compile(prefix + r'.*' + suffix + '\Z').match
+ ret = [item for item in sys_argv if match(item)]
+ [sys_argv.remove(item) for item in ret]
+ if strip_prefix and prefix:
+ i = len(prefix)
+ ret = [item[i:] for item in ret]
+ if strip_suffix and suffix:
+ i = len(suffix)
+ ret = [item[:-i] for item in ret]
+ return ret
+
+def get_option(sys_argv, option, default_return = None):
+ """
+ Return True if sys_argv has <option>.
+ If <option> is not in sys_argv, return default_return.
+ <option> (when present) will be removed from sys_argv.
+ """
+ try:
+ i = sys_argv.index(option)
+ except ValueError:
+ return default_return
+ del sys_argv[i]
+ return True
+
+def get_option_value(sys_argv, option, default_value = None, default_return = None):
+ """
+ Return <value> from
+ sys_argv = [...,<option>,<value>,...]
+ list.
+ If <option> is the last element, return default_value.
+ If <option> is not in sys_argv, return default_return.
+ Both <option> and <value> (when present) will be removed from sys_argv.
+ """
+ try:
+ i = sys_argv.index(option)
+ except ValueError:
+ return default_return
+ if len(sys_argv)-1==i:
+ del sys_argv[i]
+ return default_value
+ value = sys_argv[i+1]
+ del sys_argv[i+1]
+ del sys_argv[i]
+ return value
+
+def get_signature_output(sys_argv):
+ return get_option_value(sys_argv,'-h','stdout')
+
+
+def parse_files(sys_argv):
+ flag = 'file'
+ file_names = []
+ only_names = []
+ skip_names = []
+ options = []
+ for word in sys_argv:
+ if word=='': pass
+ elif word=='only:': flag = 'only'
+ elif word=='skip:': flag = 'skip'
+ elif word==':': flag = 'file'
+ elif word.startswith('--'): options.append(word)
+ else:
+ {'file': file_names,'only': only_names, 'skip': skip_names}[flag].append(word)
+
+ if options:
+ sys.stderr.write('Unused options: %s\n' % (', '.join(options)))
+ for filename in file_names:
+ if not os.path.isfile(filename):
+ sys.stderr.write('No or not a file %r. Skipping.\n' % (filename))
+ continue
+ sys.stderr.write('Parsing %r..\n' % (filename))
+ reader = parser.api.get_reader(filename)
+ print parser.api.Fortran2003.Program(reader)
+ return
+
+def dump_signature(sys_argv):
+ """ Read Fortran files and dump the signatures to file or stdout.
+ XXX: Not well tested.
+ """
+ signature_output = get_signature_output(sys_argv)
+
+ # initialize output stream
+ if signature_output in ['stdout','stderr']:
+ output_stream = getattr(sys, signature_output)
+ modulename = get_option_value(sys_argv,'-m','untitled','unknown')
+ else:
+ name,ext = os.path.splitext(signature_output)
+ if ext != '.pyf':
+ signature_output += '.pyf'
+ if os.path.isfile(signature_output):
+ overwrite = get_option(sys_argv, '--overwrite-signature', False)
+ if not overwrite:
+ print >> sys.stderr, 'Signature file %r exists. '\
+ 'Use --overwrite-signature to overwrite.' % (signature_output)
+ sys.exit()
+ modulename = get_option_value(sys_argv,'-m',os.path.basename(name),
+ os.path.basename(name))
+ output_stream = open(signature_output,'w')
+
+ flag = 'file'
+ file_names = []
+ only_names = []
+ skip_names = []
+ options = []
+ for word in sys_argv:
+ if word=='': pass
+ elif word=='only:': flag = 'only'
+ elif word=='skip:': flag = 'skip'
+ elif word==':': flag = 'file'
+ elif word.startswith('--'): options.append(word)
+ else:
+ {'file': file_names,'only': only_names,
+ 'skip': skip_names}[flag].append(word)
+
+ if options:
+ sys.stderr.write('Unused options: %s\n' % (', '.join(options)))
+
+ output_stream.write('''! -*- f90 -*-
+! Note: the context of this file is case sensitive.
+''')
+ output_stream.write('PYTHON MODULE %s\n' % (modulename))
+ output_stream.write(' INTERFACE\n\n')
+ for filename in file_names:
+ if not os.path.isfile(filename):
+ sys.stderr.write('No or not a file %r. Skipping.\n' % (filename))
+ continue
+ sys.stderr.write('Parsing %r..\n' % (filename))
+ block = parse(filename)
+ if block is None:
+ sys.exit(1)
+ output_stream.write('! File: %s, source mode = %r\n' % (filename, block.reader.mode))
+ if block.content and isinstance(block.content[0],PythonModule):
+ for subblock in block.content[0].content[0].content:
+ if isinstance(subblock, EndStatement):
+ break
+ output_stream.write(subblock.topyf(' ')+'\n')
+ else:
+ output_stream.write(block.topyf(' ')+'\n')
+ output_stream.write(' END INTERFACE\n')
+ output_stream.write('END PYTHON MODULE %s\n' % (modulename))
+
+ if signature_output not in ['stdout','stderr']:
+ output_stream.close()
+ return
+
+def construct_extension_sources(modulename, parse_files, include_dirs, build_dir):
+ """
+ Construct wrapper sources.
+ """
+ from py_wrap import PythonWrapperModule
+
+ f90_modules = []
+ external_subprograms = []
+ for filename in parse_files:
+ if not os.path.isfile(filename):
+ sys.stderr.write('No or not a file %r. Skipping.\n' % (filename))
+ continue
+ sys.stderr.write('Parsing %r..\n' % (filename))
+ for block in parse(filename, include_dirs=include_dirs).content:
+ if isinstance(block, Module):
+ f90_modules.append(block)
+ elif isinstance(block, (Subroutine, Function)):
+ external_subprograms.append(block)
+ else:
+ sys.stderr.write("Unhandled structure: %r\n" % (block.__class__))
+
+ module_infos = []
+
+ for block in f90_modules:
+ wrapper = PythonWrapperModule(block.name)
+ wrapper.add(block)
+ c_code = wrapper.c_code()
+ f_code = '! -*- f90 -*-\n' + wrapper.fortran_code()
+ c_fn = os.path.join(build_dir,'%smodule.c' % (block.name))
+ f_fn = os.path.join(build_dir,'%s_f_wrappers_f2py.f90' % (block.name))
+ f = open(c_fn,'w')
+ f.write(c_code)
+ f.close()
+ f = open(f_fn,'w')
+ f.write(f_code)
+ f.close()
+ #f_lib = '%s_f_wrappers_f2py' % (block.name)
+ module_info = {'name':block.name, 'c_sources':[c_fn],
+ 'f_sources':[f_fn], 'language':'f90'}
+ module_infos.append(module_info)
+
+ if external_subprograms:
+ wrapper = PythonWrapperModule(modulename)
+ for block in external_subprograms:
+ wrapper.add(block)
+ c_code = wrapper.c_code()
+ f_code = wrapper.fortran_code()
+ c_fn = os.path.join(build_dir,'%smodule.c' % (modulename))
+ ext = '.f'
+ language = 'f77'
+ if wrapper.isf90:
+ f_code = '! -*- f90 -*-\n' + f_code
+ ext = '.f90'
+ language = 'f90'
+ f_fn = os.path.join(build_dir,'%s_f_wrappers_f2py%s' % (modulename, ext))
+ f = open(c_fn,'w')
+ f.write(c_code)
+ f.close()
+ f = open(f_fn,'w')
+ f.write(f_code)
+ f.close()
+ module_info = {'name':modulename, 'c_sources':[c_fn],
+ 'f_sources':[f_fn], 'language':language}
+ module_infos.append(module_info)
+
+ return module_infos
+
+def build_extension(sys_argv, sources_only = False):
+ """
+ Build wrappers to Fortran 90 modules and external subprograms.
+ """
+ modulename = get_option_value(sys_argv,'-m','untitled','unspecified')
+
+ if sources_only:
+ build_dir = get_option_value(sys_argv,'--build-dir','.','')
+ else:
+ build_dir = get_option_value(sys_argv,'--build-dir','.',None)
+ if build_dir is None:
+ build_dir = tempfile.mktemp()
+ clean_build_dir = True
+ else:
+ clean_build_dir = False
+ if build_dir and not os.path.exists(build_dir): os.makedirs(build_dir)
+
+ include_dirs = get_values(sys_argv,'-I',strip_prefix=True)
+ library_dirs = get_values(sys_argv,'-L',strip_prefix=True)
+ libraries = get_values(sys_argv,'-l',strip_prefix=True)
+ _define_macros = get_values(sys_argv,'-D',strip_prefix=True)
+ undef_macros = get_values(sys_argv,'-U',strip_prefix=True)
+ extra_objects = get_values(sys_argv,'','[.](o|a|so|dll|dylib|sl)')
+
+ define_macros = []
+ for item in _define_macros:
+ name_value = item.split('=',1)
+ if len(name_value)==1:
+ name_value.append(None)
+ if len(name_value)==2:
+ define_macros.append(tuple(name_value))
+ else:
+ print 'Invalid use of -D:',name_value
+
+ pyf_files = get_values(sys_argv,'','[.]pyf')
+ fortran_files = get_values(sys_argv,'','[.](f|f90|F90|F)')
+ c_files = get_values(sys_argv,'','[.](c|cpp|C|CPP|c[+][+])')
+
+ fc_flags = get_values(sys_argv,'--fcompiler=')
+
+ options = get_values(sys_argv,'-')
+ if options:
+ sys.stderr.write('Unused options: %s\n' % (', '.join(options)))
+
+ if pyf_files:
+ parse_files = pyf_files
+ else:
+ parse_files = fortran_files + c_files
+
+ module_infos = construct_extension_sources(modulename, parse_files, include_dirs, build_dir)
+
+ if sources_only:
+ return
+
+ def configuration(parent_package='', top_path=None or ''):
+ from numpy.distutils.misc_util import Configuration
+ config = Configuration('',parent_package,top_path)
+ flibname = modulename + '_fortran_f2py'
+ if fortran_files:
+ config.add_library(flibname,
+ sources = fortran_files)
+ libraries.insert(0,flibname)
+
+ for module_info in module_infos:
+ name = module_info['name']
+ c_sources = module_info['c_sources']
+ f_sources = module_info['f_sources']
+ language = module_info['language']
+ if f_sources:
+ f_lib = '%s_f_wrappers_f2py' % (name)
+ config.add_library(f_lib, sources = f_sources)
+ libs = [f_lib] + libraries
+ else:
+ libs = libraries
+ config.add_extension(name,
+ sources=c_sources + c_files,
+ libraries = libs,
+ define_macros = define_macros,
+ undef_macros = undef_macros,
+ include_dirs = include_dirs,
+ extra_objects = extra_objects,
+ language = language,
+ )
+ return config
+
+ old_sys_argv = sys.argv[:]
+ build_dir_ext_temp = os.path.join(build_dir,'ext_temp')
+ build_dir_clib_temp = os.path.join(build_dir,'clib_temp')
+ build_dir_clib_clib = os.path.join(build_dir,'clib_clib')
+ new_sys_argv = [sys.argv[0]] + ['build_ext',
+ '--build-temp',build_dir_ext_temp,
+ '--build-lib',build_dir,
+ 'build_clib',
+ '--build-temp',build_dir_clib_temp,
+ '--build-clib',build_dir_clib_clib,
+ ]
+ temp_dirs = [build_dir_ext_temp, build_dir_clib_temp, build_dir_clib_clib]
+
+ if fc_flags:
+ new_sys_argv += ['config_fc'] + fc_flags
+ sys.argv[:] = new_sys_argv
+
+ sys.stderr.write('setup arguments: %r\n' % (' '.join(sys.argv)))
+
+ from numpy.distutils.core import setup
+ setup(configuration=configuration)
+
+ sys.argv[:] = old_sys_argv
+
+ if 1 or clean_build_dir:
+ for d in temp_dirs:
+ if os.path.exists(d):
+ sys.stderr.write('Removing build directory %s\n'%(d))
+ shutil.rmtree(d)
+ return
+
+def main(sys_argv = None):
+ """ Main function of f2py script.
+ """
+ if sys_argv is None:
+ sys_argv = sys.argv[1:]
+ if '--help-link' in sys_argv:
+ sys_argv.remove('--help-link')
+ from numpy.distutils.system_info import show_all
+ show_all()
+ return
+ if '-c' in sys_argv:
+ sys_argv.remove('-c')
+ build_extension(sys_argv)
+ return
+ if '--parse' in sys_argv:
+ sys_argv.remove('--parse')
+ parse_files(sys_argv)
+ return
+ if '-h' in sys_argv:
+ dump_signature(sys_argv)
+ return
+ if not sys_argv or '--help' in sys_argv:
+ print >> sys.stdout, __usage__
+
+ build_extension(sys_argv, sources_only = True)
+ return
+
+def compile(source,
+ jobname = 'untitled',
+ extra_args = [],
+ source_ext = None,
+ modulenames = None
+ ):
+ """
+ Build extension module from processing source with f2py.
+
+ jobname - the name of compile job. For non-module source
+ this will be also the name of extension module.
+ modulenames - the list of extension module names that
+ the given compilation job should create.
+ extra_args - a list of extra arguments for numpy style
+ setup.py command line.
+ source_ext - extension of the Fortran source file: .f90 or .f
+
+ Extension modules are saved to current working directory.
+ Returns a list of module objects according to modulenames
+ input.
+ """
+ from nary import encode
+ tempdir = tempfile.gettempdir()
+ s = 'f2pyjob_%s_%s' % (jobname, encode(source))
+ tmpdir = os.path.join(tempdir, s)
+ if source_ext is None:
+ reader = get_reader(source)
+ source_ext = {'free90':'.f90','fix90':'.f90','fix77':'.f','pyf':'.pyf'}[reader.mode]
+
+ if modulenames is None:
+ modulenames = jobname,
+ if os.path.isdir(tmpdir):
+ sys.path.insert(0, tmpdir)
+ try:
+ modules = []
+ for modulename in modulenames:
+ exec('import %s as m' % (modulename))
+ modules.append(m)
+ sys.path.pop(0)
+ return modules
+ except ImportError:
+ pass
+ sys.path.pop(0)
+ else:
+ os.mkdir(tmpdir)
+
+ fname = os.path.join(tmpdir,'%s_src%s' % (jobname, source_ext))
+
+ f = open(fname,'w')
+ f.write(source)
+ f.close()
+
+ sys_argv = []
+ sys_argv.extend(['--build-dir',tmpdir])
+ #sys_argv.extend(['-DF2PY_DEBUG_PYOBJ_TOFROM'])
+ sys_argv.extend(['-m',jobname, fname])
+
+ build_extension(sys_argv + extra_args)
+
+ sys.path.insert(0, tmpdir)
+ modules = []
+ for modulename in modulenames:
+ exec('import %s as m' % (modulename))
+ modules.append(m)
+ sys.path.pop(0)
+ return modules
+
+#EOF
diff --git a/numpy/f2py/lib/nary.py b/numpy/f2py/lib/nary.py
new file mode 100644
index 000000000..948672b8c
--- /dev/null
+++ b/numpy/f2py/lib/nary.py
@@ -0,0 +1,32 @@
+"""
+nary - convert integer to a number with an arbitrary base.
+"""
+
+__all__ = ['nary']
+
+_alphabet='0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'
+def _getalpha(r):
+ if r>=len(_alphabet):
+ return '_'+nary(r-len(_alphabet),len(_alphabet))
+ return _alphabet[r]
+
+def nary(number, base=64):
+ """
+ Return string representation of a number with a given base.
+ """
+ if isinstance(number, str):
+ number = eval(number)
+ n = number
+ s = ''
+ while n:
+ n1 = n // base
+ r = n - n1*base
+ n = n1
+ s = _getalpha(r) + s
+ return s
+
+def encode(string):
+ import md5
+ return nary('0x'+md5.new(string).hexdigest())
+
+#print nary(12345124254252525522512324,64)
diff --git a/numpy/f2py/lib/parser/Fortran2003.py b/numpy/f2py/lib/parser/Fortran2003.py
new file mode 100644
index 000000000..bfdb8cbba
--- /dev/null
+++ b/numpy/f2py/lib/parser/Fortran2003.py
@@ -0,0 +1,5889 @@
+#!/usr/bin/env python
+"""
+Fortran 2003 Syntax Rules.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: Oct 2006
+-----
+"""
+
+import re
+from splitline import string_replace_map
+import pattern_tools as pattern
+from readfortran import FortranReaderBase
+
+###############################################################################
+############################## BASE CLASSES ###################################
+###############################################################################
+
+class NoMatchError(Exception):
+ pass
+
+class ParseError(Exception):
+ pass
+
+class Base(object):
+ """ Base class for Fortran 2003 syntax rules.
+
+ All Base classes have the following attributes:
+ .string - original argument to construct a class instance, it's type
+ is either str or FortranReaderBase.
+ .item - Line instance (holds label) or None.
+ """
+ subclasses = {}
+
+ def __new__(cls, string, parent_cls = None):
+ """
+ """
+ if parent_cls is None:
+ parent_cls = [cls]
+ elif cls not in parent_cls:
+ parent_cls.append(cls)
+ #print '__new__:',cls.__name__,`string`
+ match = cls.__dict__.get('match', None)
+ if isinstance(string, FortranReaderBase) and not issubclass(cls, BlockBase) \
+ and match is not None:
+ reader = string
+ item = reader.get_item()
+ if item is None: return
+ try:
+ obj = cls(item.line, parent_cls = parent_cls)
+ except NoMatchError:
+ obj = None
+ if obj is None:
+ reader.put_item(item)
+ return
+ obj.item = item
+ return obj
+ errmsg = '%s: %r' % (cls.__name__, string)
+ if match is not None:
+ try:
+ result = cls.match(string)
+ except NoMatchError, msg:
+ if str(msg)==errmsg: # avoid recursion 1.
+ raise
+ result = None
+ else:
+ result = None
+
+ #print '__new__:result:',cls.__name__,`string,result`
+ if isinstance(result, tuple):
+ obj = object.__new__(cls)
+ obj.string = string
+ obj.item = None
+ if hasattr(cls, 'init'): obj.init(*result)
+ return obj
+ elif isinstance(result, Base):
+ return result
+ elif result is None:
+ for subcls in Base.subclasses.get(cls.__name__,[]):
+ if subcls in parent_cls: # avoid recursion 2.
+ continue
+ #print '%s:%s: %r' % (cls.__name__,subcls.__name__,string)
+ try:
+ obj = subcls(string, parent_cls = parent_cls)
+ except NoMatchError, msg:
+ obj = None
+ if obj is not None:
+ return obj
+ else:
+ raise AssertionError,`result`
+ raise NoMatchError,errmsg
+
+## def restore_reader(self):
+## self._item.reader.put_item(self._item)
+## return
+
+ def init(self, *items):
+ self.items = items
+ return
+ def torepr(self):
+ return '%s(%s)' % (self.__class__.__name__, ', '.join(map(repr,self.items)))
+ def compare(self, other):
+ return cmp(self.items,other.items)
+
+ def __str__(self): return self.tostr()
+
+ def __repr__(self): return self.torepr()
+
+ def __cmp__(self, other):
+ if self is other: return 0
+ if not isinstance(other, self.__class__): return cmp(self.__class__, other.__class__)
+ return self.compare(other)
+
+ def tofortran(self, tab='', isfix=None):
+ return tab + str(self)
+
+
+class BlockBase(Base):
+ """
+ <block-base> = [ <startcls> ]
+ [ <subcls> ]...
+ ...
+ [ <subcls> ]...
+ [ <endcls> ]
+ """
+ def match(startcls, subclasses, endcls, reader):
+ assert isinstance(reader,FortranReaderBase),`reader`
+ content = []
+ if startcls is not None:
+ try:
+ obj = startcls(reader)
+ except NoMatchError:
+ obj = None
+ if obj is None: return
+ content.append(obj)
+ if endcls is not None:
+ classes = subclasses + [endcls]
+ else:
+ classes = subclasses[:]
+ i = 0
+ while 1:
+ cls = classes[i]
+ try:
+ obj = cls(reader)
+ except NoMatchError:
+ obj = None
+ if obj is None:
+ j = i
+ for cls in classes[i+1:]:
+ j += 1
+ try:
+ obj = cls(reader)
+ except NoMatchError:
+ obj = None
+ if obj is not None:
+ break
+ if obj is not None:
+ i = j
+ if obj is not None:
+ content.append(obj)
+ if endcls is not None and isinstance(obj, endcls): break
+ continue
+ if endcls is not None:
+ item = reader.get_item()
+ if item is not None:
+ reader.error('failed to parse with %s, skipping.' % ('|'.join([c.__name__ for c in classes[i:]])), item)
+ continue
+ if hasattr(content[0],'name'):
+ reader.error('unexpected eof file while looking line for <%s> of %s.'\
+ % (classes[-1].__name__.lower().replace('_','-'), content[0].name))
+ else:
+ reader.error('unexpected eof file while looking line for <%s>.'\
+ % (classes[-1].__name__.lower().replace('_','-')))
+ break
+ if not content: return
+ if startcls is not None and endcls is not None:
+ # check names of start and end statements:
+ start_stmt = content[0]
+ end_stmt = content[-1]
+ if isinstance(end_stmt, endcls) and hasattr(end_stmt, 'get_name') and hasattr(start_stmt, 'get_name'):
+ if end_stmt.get_name() is not None:
+ if start_stmt.get_name() != end_stmt.get_name():
+ end_stmt._item.reader.error('expected <%s-name> is %s but got %s. Ignoring.'\
+ % (end_stmt.get_type().lower(), start_stmt.get_name(), end_stmt.get_name()))
+ else:
+ end_stmt.set_name(start_stmt.get_name())
+ return content,
+ match = staticmethod(match)
+
+ def init(self, content):
+ self.content = content
+ return
+ def compare(self, other):
+ return cmp(self.content,other.content)
+
+ def tostr(self):
+ return self.tofortran()
+ def torepr(self):
+ return '%s(%s)' % (self.__class__.__name__,', '.join(map(repr, self.content)))
+
+ def tofortran(self, tab='', isfix=None):
+ l = []
+ start = self.content[0]
+ end = self.content[-1]
+ extra_tab = ''
+ if isinstance(end, EndStmtBase):
+ extra_tab = ' '
+ l.append(start.tofortran(tab=tab,isfix=isfix))
+ for item in self.content[1:-1]:
+ l.append(item.tofortran(tab=tab+extra_tab,isfix=isfix))
+ if len(self.content)>1:
+ l.append(end.tofortran(tab=tab,isfix=isfix))
+ return '\n'.join(l)
+
+## def restore_reader(self):
+## content = self.content[:]
+## content.reverse()
+## for obj in content:
+## obj.restore_reader()
+## return
+
+class SequenceBase(Base):
+ """
+ <sequence-base> = <obj>, <obj> [ , <obj> ]...
+ """
+ def match(separator, subcls, string):
+ line, repmap = string_replace_map(string)
+ if isinstance(separator, str):
+ splitted = line.split(separator)
+ else:
+ splitted = separator[1].split(line)
+ separator = separator[0]
+ if len(splitted)<=1: return
+ lst = []
+ for p in splitted:
+ lst.append(subcls(repmap(p.strip())))
+ return separator, tuple(lst)
+ match = staticmethod(match)
+ def init(self, separator, items):
+ self.separator = separator
+ self.items = items
+ return
+ def tostr(self):
+ s = self.separator
+ if s==',': s = s + ' '
+ elif s==' ': pass
+ else: s = ' ' + s + ' '
+ return s.join(map(str, self.items))
+ def torepr(self): return '%s(%r, %r)' % (self.__class__.__name__, self.separator, self.items)
+ def compare(self, other):
+ return cmp((self.separator,self.items),(other.separator,self.items))
+
+class UnaryOpBase(Base):
+ """
+ <unary-op-base> = <unary-op> <rhs>
+ """
+ def tostr(self):
+ return '%s %s' % tuple(self.items)
+ def match(op_pattern, rhs_cls, string):
+ m = op_pattern.match(string)
+ if not m: return
+ #if not m: return rhs_cls(string)
+ rhs = string[m.end():].lstrip()
+ if not rhs: return
+ op = string[:m.end()].rstrip().upper()
+ return op, rhs_cls(rhs)
+ match = staticmethod(match)
+
+
+class BinaryOpBase(Base):
+ """
+ <binary-op-base> = <lhs> <op> <rhs>
+ <op> is searched from right by default.
+ """
+ def match(lhs_cls, op_pattern, rhs_cls, string, right=True):
+ line, repmap = string_replace_map(string)
+ if isinstance(op_pattern, str):
+ if right:
+ t = line.rsplit(op_pattern,1)
+ else:
+ t = line.split(op_pattern,1)
+ if len(t)!=2: return
+ lhs, rhs = t[0].rstrip(), t[1].lstrip()
+ op = op_pattern
+ else:
+ if right:
+ t = op_pattern.rsplit(line)
+ else:
+ t = op_pattern.lsplit(line)
+ if t is None or len(t)!=3: return
+ lhs, op, rhs = t
+ lhs = lhs.rstrip()
+ rhs = rhs.lstrip()
+ op = op.upper()
+ if not lhs: return
+ if not rhs: return
+ lhs_obj = lhs_cls(repmap(lhs))
+ rhs_obj = rhs_cls(repmap(rhs))
+ return lhs_obj, op, rhs_obj
+ match = staticmethod(match)
+ def tostr(self):
+ return '%s %s %s' % tuple(self.items)
+
+class SeparatorBase(Base):
+ """
+ <separator-base> = [ <lhs> ] : [ <rhs> ]
+ """
+ def match(lhs_cls, rhs_cls, string, require_lhs=False, require_rhs=False):
+ line, repmap = string_replace_map(string)
+ if ':' not in line: return
+ lhs,rhs = line.split(':',1)
+ lhs = lhs.rstrip()
+ rhs = rhs.lstrip()
+ lhs_obj, rhs_obj = None, None
+ if lhs:
+ if lhs_cls is None: return
+ lhs_obj = lhs_cls(repmap(lhs))
+ elif require_lhs:
+ return
+ if rhs:
+ if rhs_cls is None: return
+ rhs_obj = rhs_cls(repmap(rhs))
+ elif require_rhs:
+ return
+ return lhs_obj, rhs_obj
+ match = staticmethod(match)
+ def tostr(self):
+ s = ''
+ if self.items[0] is not None:
+ s += '%s :' % (self.items[0])
+ else:
+ s += ':'
+ if self.items[1] is not None:
+ s += ' %s' % (self.items[1])
+ return s
+
+class KeywordValueBase(Base):
+ """
+ <keyword-value-base> = [ <lhs> = ] <rhs>
+ """
+ def match(lhs_cls, rhs_cls, string, require_lhs = True, upper_lhs = False):
+ if require_lhs and '=' not in string: return
+ if isinstance(lhs_cls, (list, tuple)):
+ for s in lhs_cls:
+ try:
+ obj = KeywordValueBase.match(s, rhs_cls, string, require_lhs=require_lhs, upper_lhs=upper_lhs)
+ except NoMatchError:
+ obj = None
+ if obj is not None: return obj
+ return obj
+ lhs,rhs = string.split('=',1)
+ lhs = lhs.rstrip()
+ rhs = rhs.lstrip()
+ if not rhs: return
+ if not lhs:
+ if require_lhs: return
+ return None, rhs_cls(rhs)
+ if isinstance(lhs_cls, str):
+ if upper_lhs:
+ lhs = lhs.upper()
+ if lhs_cls!=lhs: return
+ return lhs, rhs_cls(rhs)
+ return lhs_cls(lhs),rhs_cls(rhs)
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[0] is None: return str(self.items[1])
+ return '%s = %s' % tuple(self.items)
+
+class BracketBase(Base):
+ """
+ <bracket-base> = <left-bracket-base> <something> <right-bracket>
+ """
+ def match(brackets, cls, string, require_cls=True):
+ i = len(brackets)/2
+ left = brackets[:i]
+ right = brackets[-i:]
+ if string.startswith(left) and string.endswith(right):
+ line = string[i:-i].strip()
+ if not line:
+ if require_cls:
+ return
+ return left,None,right
+ return left,cls(line),right
+ return
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[1] is None:
+ return '%s%s' % (self.items[0], self.items[2])
+ return '%s%s%s' % tuple(self.items)
+
+class NumberBase(Base):
+ """
+ <number-base> = <number> [ _ <kind-param> ]
+ """
+ def match(number_pattern, string):
+ m = number_pattern.match(string)
+ if m is None: return
+ return m.group('value').upper(),m.group('kind_param')
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[1] is None: return str(self.items[0])
+ return '%s_%s' % tuple(self.items)
+ def compare(self, other):
+ return cmp(self.items[0], other.items[0])
+
+class CallBase(Base):
+ """
+ <call-base> = <lhs> ( [ <rhs> ] )
+ """
+ def match(lhs_cls, rhs_cls, string, upper_lhs = False, require_rhs=False):
+ if not string.endswith(')'): return
+ line, repmap = string_replace_map(string)
+ i = line.find('(')
+ if i==-1: return
+ lhs = line[:i].rstrip()
+ if not lhs: return
+ rhs = line[i+1:-1].strip()
+ lhs = repmap(lhs)
+ if upper_lhs:
+ lhs = lhs.upper()
+ rhs = repmap(rhs)
+ if isinstance(lhs_cls, str):
+ if lhs_cls!=lhs: return
+ else:
+ lhs = lhs_cls(lhs)
+ if rhs:
+ if isinstance(rhs_cls, str):
+ if rhs_cls!=rhs: return
+ else:
+ rhs = rhs_cls(rhs)
+ return lhs, rhs
+ elif require_rhs:
+ return
+ return lhs, None
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[1] is None: return '%s()' % (self.items[0])
+ return '%s(%s)' % (self.items[0], self.items[1])
+
+class CALLBase(CallBase):
+ """
+ <CALL-base> = <LHS> ( [ <rhs> ] )
+ """
+ def match(lhs_cls, rhs_cls, string, require_rhs = False):
+ return CallBase.match(lhs_cls, rhs_cls, string, upper_lhs=True, require_rhs = require_rhs)
+ match = staticmethod(match)
+
+class StringBase(Base):
+ """
+ <string-base> = <xyz>
+ """
+ def match(pattern, string):
+ if isinstance(pattern, (list,tuple)):
+ for p in pattern:
+ obj = StringBase.match(p, string)
+ if obj is not None: return obj
+ return
+ if isinstance(pattern, str):
+ if len(pattern)==len(string) and pattern==string: return string,
+ return
+ if pattern.match(string): return string,
+ return
+ match = staticmethod(match)
+ def init(self, string):
+ self.string = string
+ return
+ def tostr(self): return str(self.string)
+ def torepr(self): return '%s(%r)' % (self.__class__.__name__, self.string)
+ def compare(self, other):
+ return cmp(self.string,other.string)
+
+class STRINGBase(StringBase):
+ """
+ <STRING-base> = <XYZ>
+ """
+ match = staticmethod(StringBase.match)
+ def match(pattern, string):
+ if isinstance(pattern, (list,tuple)):
+ for p in pattern:
+ obj = STRINGBase.match(p, string)
+ if obj is not None: return obj
+ return
+ STRING = string.upper()
+ if isinstance(pattern, str):
+ if len(pattern)==len(string) and pattern==STRING: return STRING,
+ return
+ if pattern.match(STRING): return STRING,
+ return
+ match = staticmethod(match)
+
+class StmtBase(Base):
+ """
+ [ <label> ] <stmt>
+ """
+ def tofortran(self, tab='', isfix=None):
+ label = None
+ if self.item is not None: label = self.item.label
+ if isfix:
+ colon = ''
+ c = ' '
+ else:
+ colon = ':'
+ c = ''
+ if label:
+ t = c + label + colon
+ if isfix:
+ while len(t)<6: t += ' '
+ else:
+ tab = tab[len(t):] or ' '
+ else:
+ t = ''
+ return t + tab + str(self)
+
+class EndStmtBase(StmtBase):
+ """
+ <end-stmt-base> = END [ <stmt> [ <stmt-name>] ]
+ """
+ def match(stmt_type, stmt_name, string, require_stmt_type=False):
+ start = string[:3].upper()
+ if start != 'END': return
+ line = string[3:].lstrip()
+ start = line[:len(stmt_type)].upper()
+ if start:
+ if start.replace(' ','') != stmt_type.replace(' ',''): return
+ line = line[len(stmt_type):].lstrip()
+ else:
+ if require_stmt_type: return
+ line = ''
+ if line:
+ if stmt_name is None: return
+ return stmt_type, stmt_name(line)
+ return stmt_type, None
+ match = staticmethod(match)
+ def init(self, stmt_type, stmt_name):
+ self.items = [stmt_type, stmt_name]
+ self.type, self.name = stmt_type, stmt_name
+ return
+ def get_name(self): return self.items[1]
+ def get_type(self): return self.items[0]
+ def set_name(self, name):
+ self.items[1] = name
+ def tostr(self):
+ if self.items[1] is not None:
+ return 'END %s %s' % tuple(self.items)
+ return 'END %s' % (self.items[0])
+ def torepr(self):
+ return '%s(%r, %r)' % (self.__class__.__name__, self.type, self.name)
+
+def isalnum(c): return c.isalnum() or c=='_'
+
+class WORDClsBase(Base):
+ """
+ <WORD-cls> = <WORD> [ [ :: ] <cls> ]
+ """
+ def match(pattern, cls, string, check_colons=False, require_cls=False):
+ if isinstance(pattern, (tuple,list)):
+ for p in pattern:
+ try:
+ obj = WORDClsBase.match(p, cls, string, check_colons=check_colons, require_cls=require_cls)
+ except NoMatchError:
+ obj = None
+ if obj is not None: return obj
+ return
+ if isinstance(pattern, str):
+ if string[:len(pattern)].upper()!=pattern: return
+ line = string[len(pattern):]
+ if not line: return pattern, None
+ if isalnum(line[0]): return
+ line = line.lstrip()
+ if check_colons and line.startswith('::'):
+ line = line[2:].lstrip()
+ if not line:
+ if require_cls: return
+ return pattern, None
+ if cls is None: return
+ return pattern, cls(line)
+ m = pattern.match(string)
+ if m is None: return
+ line = string[len(m.group()):]
+ if pattern.value is not None:
+ pattern_value = pattern.value
+ else:
+ pattern_value = m.group().upper()
+ if not line: return pattern_value, None
+ if isalnum(line[0]): return
+ line = line.lstrip()
+ if check_colons and line.startswith('::'):
+ line = line[2:].lstrip()
+ if not line:
+ if require_cls: return
+ return pattern_value, None
+ if cls is None: return
+ return pattern_value, cls(line)
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[1] is None: return str(self.items[0])
+ s = str(self.items[1])
+ if s and s[0] in '(*':
+ return '%s%s' % (self.items[0], s)
+ return '%s %s' % (self.items[0], s)
+ def tostr_a(self): # colons version of tostr
+ if self.items[1] is None: return str(self.items[0])
+ return '%s :: %s' % (self.items[0], self.items[1])
+
+###############################################################################
+############################### SECTION 1 ####################################
+###############################################################################
+
+#R101: <xyz-list> = <xyz> [ , <xyz> ]...
+#R102: <xyz-name> = <name>
+#R103: <scalar-xyz> = <xyz>
+
+###############################################################################
+############################### SECTION 2 ####################################
+###############################################################################
+
+class Program(BlockBase): # R201
+ """
+ <program> = <program-unit>
+ [ <program-unit> ] ...
+ """
+ subclass_names = []
+ use_names = ['Program_Unit']
+ def match(reader):
+ return BlockBase.match(Program_Unit, [Program_Unit], None, reader)
+ match = staticmethod(match)
+
+class Program_Unit(Base): # R202
+ """
+ <program-unit> = <main-program>
+ | <external-subprogram>
+ | <module>
+ | <block-data>
+ """
+ subclass_names = ['Main_Program', 'External_Subprogram', 'Module', 'Block_Data']
+
+class External_Subprogram(Base): # R203
+ """
+ <external-subprogram> = <function-subprogram>
+ | <subroutine-subprogram>
+ """
+ subclass_names = ['Function_Subprogram', 'Subroutine_Subprogram']
+
+
+class Specification_Part(BlockBase): # R204
+ """
+ <specification-part> = [ <use-stmt> ]...
+ [ <import-stmt> ]...
+ [ <implicit-part> ]
+ [ <declaration-construct> ]...
+ """
+ subclass_names = []
+ use_names = ['Use_Stmt', 'Import_Stmt', 'Implicit_Part', 'Declaration_Construct']
+ def match(reader):
+ return BlockBase.match(None, [Use_Stmt, Import_Stmt, Implicit_Part, Declaration_Construct], None, reader)
+ match = staticmethod(match)
+
+class Implicit_Part(Base): # R205
+ """
+ <implicit-part> = [ <implicit-part-stmt> ]...
+ <implicit-stmt>
+ """
+ subclass_names = []
+ use_names = ['Implicit_Part_Stmt', 'Implicit_Stmt']
+
+class Implicit_Part_Stmt(Base): # R206
+ """
+ <implicit-part-stmt> = <implicit-stmt>
+ | <parameter-stmt>
+ | <format-stmt>
+ | <entry-stmt>
+ """
+ subclass_names = ['Implicit_Stmt', 'Parameter_Stmt', 'Format_Stmt', 'Entry_Stmt']
+
+class Declaration_Construct(Base): # R207
+ """
+ <declaration-construct> = <derived-type-def>
+ | <entry-stmt>
+ | <enum-def>
+ | <format-stmt>
+ | <interface-block>
+ | <parameter-stmt>
+ | <procedure-declaration-stmt>
+ | <specification-stmt>
+ | <type-declaration-stmt>
+ | <stmt-function-stmt>
+ """
+ subclass_names = ['Derived_Type_Def', 'Entry_Stmt', 'Enum_Def', 'Format_Stmt',
+ 'Interface_Block', 'Parameter_Stmt', 'Procedure_Declaration_Stmt',
+ 'Specification_Stmt', 'Type_Declaration_Stmt', 'Stmt_Function_Stmt']
+
+class Execution_Part(BlockBase): # R208
+ """
+ <execution-part> = <executable-construct>
+ | [ <execution-part-construct> ]...
+
+ <execution-part> shall not contain <end-function-stmt>, <end-program-stmt>, <end-subroutine-stmt>
+ """
+ subclass_names = []
+ use_names = ['Executable_Construct_C201', 'Execution_Part_Construct_C201']
+ def match(string): return BlockBase.match(Executable_Construct_C201, [Execution_Part_Construct_C201], None, string)
+ match = staticmethod(match)
+
+class Execution_Part_Construct(Base): # R209
+ """
+ <execution-part-construct> = <executable-construct>
+ | <format-stmt>
+ | <entry-stmt>
+ | <data-stmt>
+ """
+ subclass_names = ['Executable_Construct', 'Format_Stmt', 'Entry_Stmt', 'Data_Stmt']
+
+class Execution_Part_Construct_C201(Base):
+ subclass_names = ['Executable_Construct_C201', 'Format_Stmt', 'Entry_Stmt', 'Data_Stmt']
+
+class Internal_Subprogram_Part(Base): # R210
+ """
+ <internal-subprogram-part> = <contains-stmt>
+ <internal-subprogram>
+ [ <internal-subprogram> ]...
+ """
+ subclass_names = []
+ use_names = ['Contains_Stmt', 'Internal_Subprogram']
+
+class Internal_Subprogram(Base): # R211
+ """
+ <internal-subprogram> = <function-subprogram>
+ | <subroutine-subprogram>
+ """
+ subclass_names = ['Function_Subprogram', 'Subroutine_Subprogram']
+
+class Specification_Stmt(Base):# R212
+ """
+ <specification-stmt> = <access-stmt>
+ | <allocatable-stmt>
+ | <asynchronous-stmt>
+ | <bind-stmt>
+ | <common-stmt>
+ | <data-stmt>
+ | <dimension-stmt>
+ | <equivalence-stmt>
+ | <external-stmt>
+ | <intent-stmt>
+ | <intrinsic-stmt>
+ | <namelist-stmt>
+ | <optional-stmt>
+ | <pointer-stmt>
+ | <protected-stmt>
+ | <save-stmt>
+ | <target-stmt>
+ | <volatile-stmt>
+ | <value-stmt>
+ """
+ subclass_names = ['Access_Stmt', 'Allocatable_Stmt', 'Asynchronous_Stmt','Bind_Stmt',
+ 'Common_Stmt', 'Data_Stmt', 'Dimension_Stmt', 'Equivalence_Stmt',
+ 'External_Stmt', 'Intent_Stmt', 'Intrinsic_Stmt', 'Namelist_Stmt',
+ 'Optional_Stmt','Pointer_Stmt','Protected_Stmt','Save_Stmt',
+ 'Target_Stmt','Volatile_Stmt', 'Value_Stmt']
+
+class Executable_Construct(Base):# R213
+ """
+ <executable-construct> = <action-stmt>
+ | <associate-stmt>
+ | <case-construct>
+ | <do-construct>
+ | <forall-construct>
+ | <if-construct>
+ | <select-type-construct>
+ | <where-construct>
+ """
+ subclass_names = ['Action_Stmt', 'Associate_Stmt', 'Case_Construct', 'Do_Construct',
+ 'Forall_Construct', 'If_Construct', 'Select_Type_Construct', 'Where_Construct']
+
+class Executable_Construct_C201(Base):
+ subclass_names = Executable_Construct.subclass_names[:]
+ subclass_names[subclass_names.index('Action_Stmt')] = 'Action_Stmt_C201'
+
+
+class Action_Stmt(Base):# R214
+ """
+ <action-stmt> = <allocate-stmt>
+ | <assignment-stmt>
+ | <backspace-stmt>
+ | <call-stmt>
+ | <close-stmt>
+ | <continue-stmt>
+ | <cycle-stmt>
+ | <deallocate-stmt>
+ | <endfile-stmt>
+ | <end-function-stmt>
+ | <end-program-stmt>
+ | <end-subroutine-stmt>
+ | <exit-stmt>
+ | <flush-stmt>
+ | <forall-stmt>
+ | <goto-stmt>
+ | <if-stmt>
+ | <inquire-stmt>
+ | <nullify-stmt>
+ | <open-stmt>
+ | <pointer-assignment-stmt>
+ | <print-stmt>
+ | <read-stmt>
+ | <return-stmt>
+ | <rewind-stmt>
+ | <stop-stmt>
+ | <wait-stmt>
+ | <where-stmt>
+ | <write-stmt>
+ | <arithmetic-if-stmt>
+ | <computed-goto-stmt>
+ """
+ subclass_names = ['Allocate_Stmt', 'Assignment_Stmt', 'Backspace_Stmt', 'Call_Stmt',
+ 'Close_Stmt', 'Continue_Stmt', 'Cycle_Stmt', 'Deallocate_Stmt',
+ 'Endfile_Stmt', 'End_Function_Stmt', 'End_Subroutine_Stmt', 'Exit_Stmt',
+ 'Flush_Stmt', 'Forall_Stmt', 'Goto_Stmt', 'If_Stmt', 'Inquire_Stmt',
+ 'Nullify_Stmt', 'Open_Stmt', 'Pointer_Assignment_Stmt', 'Print_Stmt',
+ 'Read_Stmt', 'Return_Stmt', 'Rewind_Stmt', 'Stop_Stmt', 'Wait_Stmt',
+ 'Where_Stmt', 'Write_Stmt', 'Arithmetic_If_Stmt', 'Computed_Goto_Stmt']
+
+class Action_Stmt_C201(Base):
+ """
+ <action-stmt-c201> = <action-stmt>
+ C201 is applied.
+ """
+ subclass_names = Action_Stmt.subclass_names[:]
+ subclass_names.remove('End_Function_Stmt')
+ subclass_names.remove('End_Subroutine_Stmt')
+ #subclass_names.remove('End_Program_Stmt')
+
+class Action_Stmt_C802(Base):
+ """
+ <action-stmt-c802> = <action-stmt>
+ C802 is applied.
+ """
+ subclass_names = Action_Stmt.subclass_names[:]
+ subclass_names.remove('End_Function_Stmt')
+ subclass_names.remove('End_Subroutine_Stmt')
+ subclass_names.remove('If_Stmt')
+
+class Action_Stmt_C824(Base):
+ """
+ <action-stmt-c824> = <action-stmt>
+ C824 is applied.
+ """
+ subclass_names = Action_Stmt.subclass_names[:]
+ subclass_names.remove('End_Function_Stmt')
+ subclass_names.remove('End_Subroutine_Stmt')
+ subclass_names.remove('Continue_Stmt')
+ subclass_names.remove('Goto_Stmt')
+ subclass_names.remove('Return_Stmt')
+ subclass_names.remove('Stop_Stmt')
+ subclass_names.remove('Exit_Stmt')
+ subclass_names.remove('Cycle_Stmt')
+ subclass_names.remove('Arithmetic_If_Stmt')
+
+class Keyword(Base): # R215
+ """
+ <keyword> = <name>
+ """
+ subclass_names = ['Name']
+
+###############################################################################
+############################### SECTION 3 ####################################
+###############################################################################
+
+#R301: <character> = <alphanumeric-character> | <special-character>
+#R302: <alphanumeric-character> = <letter> | <digit> | <underscore>
+#R303: <underscore> = _
+
+class Name(StringBase): # R304
+ """
+ <name> = <letter> [ <alphanumeric_character> ]...
+ """
+ subclass_names = []
+ def match(string): return StringBase.match(pattern.abs_name, string)
+ match = staticmethod(match)
+
+class Constant(Base): # R305
+ """
+ <constant> = <literal-constant>
+ | <named-constant>
+ """
+ subclass_names = ['Literal_Constant','Named_Constant']
+
+class Literal_Constant(Base): # R306
+ """
+ <literal-constant> = <int-literal-constant>
+ | <real-literal-constant>
+ | <complex-literal-constant>
+ | <logical-literal-constant>
+ | <char-literal-constant>
+ | <boz-literal-constant>
+ """
+ subclass_names = ['Int_Literal_Constant', 'Real_Literal_Constant','Complex_Literal_Constant',
+ 'Logical_Literal_Constant','Char_Literal_Constant','Boz_Literal_Constant']
+
+class Named_Constant(Base): # R307
+ """
+ <named-constant> = <name>
+ """
+ subclass_names = ['Name']
+
+class Int_Constant(Base): # R308
+ """
+ <int-constant> = <constant>
+ """
+ subclass_names = ['Constant']
+
+class Char_Constant(Base): # R309
+ """
+ <char-constant> = <constant>
+ """
+ subclass_names = ['Constant']
+
+#R310: <intrinsic-operator> = <power-op> | <mult-op> | <add-op> | <concat-op> | <rel-op> | <not-op> | <and-op> | <or-op> | <equiv-op>
+#R311: <defined-operator> = <defined-unary-op> | <defined-binary-op> | <extended-intrinsic-op>
+#R312: <extended-intrinsic-op> = <intrinsic-op>
+
+class Label(StringBase): # R313
+ """
+ <label> = <digit> [ <digit> [ <digit> [ <digit> [ <digit> ] ] ] ]
+ """
+ subclass_names = []
+ def match(string): return StringBase.match(pattern.abs_label, string)
+ match = staticmethod(match)
+
+###############################################################################
+############################### SECTION 4 ####################################
+###############################################################################
+
+class Type_Spec(Base): # R401
+ """
+ <type-spec> = <intrinsic-type-spec>
+ | <derived-type-spec>
+ """
+ subclass_names = ['Intrinsic_Type_Spec', 'Derived_Type_Spec']
+
+class Type_Param_Value(StringBase): # R402
+ """
+ <type-param-value> = <scalar-int-expr>
+ | *
+ | :
+ """
+ subclass_names = ['Scalar_Int_Expr']
+ use_names = []
+ def match(string): return StringBase.match(['*',':'], string)
+ match = staticmethod(match)
+
+class Intrinsic_Type_Spec(WORDClsBase): # R403
+ """
+ <intrinsic-type-spec> = INTEGER [ <kind-selector> ]
+ | REAL [ <kind-selector> ]
+ | DOUBLE COMPLEX
+ | COMPLEX [ <kind-selector> ]
+ | CHARACTER [ <char-selector> ]
+ | LOGICAL [ <kind-selector> ]
+ Extensions:
+ | DOUBLE PRECISION
+ | BYTE
+ """
+ subclass_names = []
+ use_names = ['Kind_Selector','Char_Selector']
+
+ def match(string):
+ for w,cls in [('INTEGER',Kind_Selector),
+ ('REAL',Kind_Selector),
+ ('COMPLEX',Kind_Selector),
+ ('LOGICAL',Kind_Selector),
+ ('CHARACTER',Char_Selector),
+ (pattern.abs_double_complex_name, None),
+ (pattern.abs_double_precision_name, None),
+ ('BYTE', None),
+ ]:
+ try:
+ obj = WORDClsBase.match(w,cls,string)
+ except NoMatchError:
+ obj = None
+ if obj is not None: return obj
+ return
+ match = staticmethod(match)
+
+
+class Kind_Selector(Base): # R404
+ """
+ <kind-selector> = ( [ KIND = ] <scalar-int-initialization-expr> )
+ Extensions:
+ | * <char-length>
+ """
+ subclass_names = []
+ use_names = ['Char_Length','Scalar_Int_Initialization_Expr']
+
+ def match(string):
+ if string[0]+string[-1] != '()':
+ if not string.startswith('*'): return
+ return '*',Char_Length(string[1:].lstrip())
+ line = string[1:-1].strip()
+ if line[:4].upper()=='KIND':
+ line = line[4:].lstrip()
+ if not line.startswith('='): return
+ line = line[1:].lstrip()
+ return '(',Scalar_Int_Initialization_Expr(line),')'
+ match = staticmethod(match)
+ def tostr(self):
+ if len(self.items)==2: return '%s%s' % tuple(self.items)
+ return '%sKIND = %s%s' % tuple(self.items)
+
+class Signed_Int_Literal_Constant(NumberBase): # R405
+ """
+ <signed-int-literal-constant> = [ <sign> ] <int-literal-constant>
+ """
+ subclass_names = ['Int_Literal_Constant'] # never used because sign is included in pattern
+ def match(string):
+ return NumberBase.match(pattern.abs_signed_int_literal_constant_named, string)
+ match = staticmethod(match)
+
+class Int_Literal_Constant(NumberBase): # R406
+ """
+ <int-literal-constant> = <digit-string> [ _ <kind-param> ]
+ """
+ subclass_names = []
+ def match(string):
+ return NumberBase.match(pattern.abs_int_literal_constant_named, string)
+ match = staticmethod(match)
+
+#R407: <kind-param> = <digit-string> | <scalar-int-constant-name>
+#R408: <signed-digit-string> = [ <sign> ] <digit-string>
+#R409: <digit-string> = <digit> [ <digit> ]...
+#R410: <sign> = + | -
+
+class Boz_Literal_Constant(Base): # R411
+ """
+ <boz-literal-constant> = <binary-constant>
+ | <octal-constant>
+ | <hex-constant>
+ """
+ subclass_names = ['Binary_Constant','Octal_Constant','Hex_Constant']
+
+class Binary_Constant(STRINGBase): # R412
+ """
+ <binary-constant> = B ' <digit> [ <digit> ]... '
+ | B \" <digit> [ <digit> ]... \"
+ """
+ subclass_names = []
+ def match(string): return STRINGBase.match(pattern.abs_binary_constant, string)
+ match = staticmethod(match)
+
+class Octal_Constant(STRINGBase): # R413
+ """
+ <octal-constant> = O ' <digit> [ <digit> ]... '
+ | O \" <digit> [ <digit> ]... \"
+ """
+ subclass_names = []
+ def match(string): return STRINGBase.match(pattern.abs_octal_constant, string)
+ match = staticmethod(match)
+
+class Hex_Constant(STRINGBase): # R414
+ """
+ <hex-constant> = Z ' <digit> [ <digit> ]... '
+ | Z \" <digit> [ <digit> ]... \"
+ """
+ subclass_names = []
+ def match(string): return STRINGBase.match(pattern.abs_hex_constant, string)
+ match = staticmethod(match)
+
+#R415: <hex-digit> = <digit> | A | B | C | D | E | F
+
+class Signed_Real_Literal_Constant(NumberBase): # R416
+ """
+ <signed-real-literal-constant> = [ <sign> ] <real-literal-constant>
+ """
+ subclass_names = ['Real_Literal_Constant'] # never used
+ def match(string):
+ return NumberBase.match(pattern.abs_signed_real_literal_constant_named, string)
+ match = staticmethod(match)
+
+class Real_Literal_Constant(NumberBase): # R417
+ """
+ """
+ subclass_names = []
+ def match(string):
+ return NumberBase.match(pattern.abs_real_literal_constant_named, string)
+ match = staticmethod(match)
+
+#R418: <significand> = <digit-string> . [ <digit-string> ] | . <digit-string>
+#R419: <exponent-letter> = E | D
+#R420: <exponent> = <signed-digit-string>
+
+class Complex_Literal_Constant(Base): # R421
+ """
+ <complex-literal-constant> = ( <real-part>, <imag-part> )
+ """
+ subclass_names = []
+ use_names = ['Real_Part','Imag_Part']
+ def match(string):
+ if not string or string[0]+string[-1]!='()': return
+ if not pattern.abs_complex_literal_constant.match(string):
+ return
+ r,i = string[1:-1].split(',')
+ return Real_Part(r.strip()), Imag_Part(i.strip())
+ match = staticmethod(match)
+ def tostr(self): return '(%s, %s)' % tuple(self.items)
+
+class Real_Part(Base): # R422
+ """
+ <real-part> = <signed-int-literal-constant>
+ | <signed-real-literal-constant>
+ | <named-constant>
+ """
+ subclass_names = ['Signed_Int_Literal_Constant','Signed_Real_Literal_Constant','Named_Constant']
+
+class Imag_Part(Base): # R423
+ """
+ <imag-part> = <real-part>
+ """
+ subclass_names = ['Signed_Int_Literal_Constant','Signed_Real_Literal_Constant','Named_Constant']
+
+class Char_Selector(Base): # R424
+ """
+ <char-selector> = <length-selector>
+ | ( LEN = <type-param-value> , KIND = <scalar-int-initialization-expr> )
+ | ( <type-param-value> , [ KIND = ] <scalar-int-initialization-expr> )
+ | ( KIND = <scalar-int-initialization-expr> [ , LEN = <type-param-value> ] )
+ """
+ subclass_names = ['Length_Selector']
+ use_names = ['Type_Param_Value','Scalar_Int_Initialization_Expr']
+ def match(string):
+ if string[0]+string[-1] != '()': return
+ line, repmap = string_replace_map(string[1:-1].strip())
+ if line[:3].upper()=='LEN':
+ line = line[3:].lstrip()
+ if not line.startswith('='): return
+ line = line[1:].lstrip()
+ i = line.find(',')
+ if i==-1: return
+ v = line[:i].rstrip()
+ line = line[i+1:].lstrip()
+ if line[:4].upper()!='KIND': return
+ line = line[4:].lstrip()
+ if not line.startswith('='): return
+ line = line[1:].lstrip()
+ v = repmap(v)
+ line = repmap(line)
+ return Type_Param_Value(v), Scalar_Int_Initialization_Expr(line)
+ elif line[:4].upper()=='KIND':
+ line = line[4:].lstrip()
+ if not line.startswith('='): return
+ line = line[1:].lstrip()
+ i = line.find(',')
+ if i==-1: return None,Scalar_Int_Initialization_Expr(line)
+ v = line[i+1:].lstrip()
+ line = line[:i].rstrip()
+ if v[:3].upper()!='LEN': return
+ v = v[3:].lstrip()
+ if not v.startswith('='): return
+ v = v[1:].lstrip()
+ return Type_Param_Value(v), Scalar_Int_Initialization_Expr(line)
+ else:
+ i = line.find(',')
+ if i==-1: return
+ v = line[:i].rstrip()
+ line = line[i+1:].lstrip()
+ if line[:4].upper()=='KIND':
+ line = line[4:].lstrip()
+ if not line.startswith('='): return
+ line = line[1:].lstrip()
+ return Type_Param_Value(v), Scalar_Int_Initialization_Expr(line)
+ return
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[0] is None:
+ return '(KIND = %s)' % (self.items[1])
+ return '(LEN = %s, KIND = %s)' % (self.items[0],self.items[1])
+
+class Length_Selector(Base): # R425
+ """
+ <length -selector> = ( [ LEN = ] <type-param-value> )
+ | * <char-length> [ , ]
+ """
+ subclass_names = []
+ use_names = ['Type_Param_Value','Char_Length']
+ def match(string):
+ if string[0]+string[-1] == '()':
+ line = string[1:-1].strip()
+ if line[:3].upper()=='LEN':
+ line = line[3:].lstrip()
+ if not line.startswith('='): return
+ line = line[1:].lstrip()
+ return '(',Type_Param_Value(line),')'
+ if not string.startswith('*'): return
+ line = string[1:].lstrip()
+ if string[-1]==',': line = line[:-1].rstrip()
+ return '*',Char_Length(line)
+ match = staticmethod(match)
+ def tostr(self):
+ if len(self.items)==2: return '%s%s' % tuple(self.items)
+ return '%sLEN = %s%s' % tuple(self.items)
+
+class Char_Length(BracketBase): # R426
+ """
+ <char-length> = ( <type-param-value> )
+ | <scalar-int-literal-constant>
+ """
+ subclass_names = ['Scalar_Int_Literal_Constant']
+ use_names = ['Type_Param_Value']
+ def match(string): return BracketBase.match('()',Type_Param_Value, string)
+ match = staticmethod(match)
+
+class Char_Literal_Constant(Base): # R427
+ """
+ <char-literal-constant> = [ <kind-param> _ ] ' <rep-char> '
+ | [ <kind-param> _ ] \" <rep-char> \"
+ """
+ subclass_names = []
+ rep = pattern.char_literal_constant
+ def match(string):
+ if string[-1] not in '"\'': return
+ if string[-1]=='"':
+ abs_a_n_char_literal_constant_named = pattern.abs_a_n_char_literal_constant_named2
+ else:
+ abs_a_n_char_literal_constant_named = pattern.abs_a_n_char_literal_constant_named1
+ line, repmap = string_replace_map(string)
+ m = abs_a_n_char_literal_constant_named.match(line)
+ if not m: return
+ kind_param = m.group('kind_param')
+ line = m.group('value')
+ line = repmap(line)
+ return line, kind_param
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[1] is None: return str(self.items[0])
+ return '%s_%s' % (self.items[1], self.items[0])
+
+class Logical_Literal_Constant(NumberBase): # R428
+ """
+ <logical-literal-constant> = .TRUE. [ _ <kind-param> ]
+ | .FALSE. [ _ <kind-param> ]
+ """
+ subclass_names = []
+ def match(string):
+ return NumberBase.match(pattern.abs_logical_literal_constant_named, string)
+ match = staticmethod(match)
+
+class Derived_Type_Def(Base): # R429
+ """
+ <derived-type-def> = <derived-type-stmt>
+ [ <type-param-def-stmt> ]...
+ [ <private-or-sequence> ]...
+ [ <component-part> ]
+ [ <type-bound-procedure-part> ]
+ <end-type-stmt>
+ """
+ subclass_names = []
+ use_names = ['Derived_Type_Stmt', 'Type_Param_Def_Stmt', 'Private_Or_Sequence',
+ 'Component_Part', 'Type_Bound_Procedure_Part', 'End_Type_Stmt']
+
+class Derived_Type_Stmt(StmtBase): # R430
+ """
+ <derived-type-stmt> = TYPE [ [ , <type-attr-spec-list> ] :: ] <type-name> [ ( <type-param-name-list> ) ]
+ """
+ subclass_names = []
+ use_names = ['Type_Attr_Spec_List', 'Type_Name', 'Type_Param_Name_List']
+ def match(string):
+ if string[:4].upper()!='TYPE': return
+ line = string[4:].lstrip()
+ i = line.find('::')
+ attr_specs = None
+ if i!=-1:
+ if line.startswith(','):
+ l = line[1:i].strip()
+ if not l: return
+ attr_specs = Type_Attr_Spec_List(l)
+ line = line[i+2:].lstrip()
+ m = pattern.name.match(line)
+ if m is None: return
+ name = Type_Name(m.group())
+ line = line[m.end():].lstrip()
+ if not line: return attr_specs, name, None
+ if line[0]+line[-1]!='()': return
+ return attr_specs, name, Type_Param_Name_List(line[1:-1].strip())
+ match = staticmethod(match)
+ def tostr(self):
+ s = 'TYPE'
+ if self.items[0] is not None:
+ s += ', %s :: %s' % (self.items[0], self.items[1])
+ else:
+ s += ' :: %s' % (self.items[1])
+ if self.items[2] is not None:
+ s += '(%s)' % (self.items[2])
+ return s
+
+class Type_Name(Name): # C424
+ """
+ <type-name> = <name>
+ <type-name> shall not be DOUBLEPRECISION or the name of intrinsic type
+ """
+ subclass_names = []
+ use_names = []
+ def match(string):
+ if pattern.abs_intrinsic_type_name.match(string): return
+ return Name.match(string)
+ match = staticmethod(match)
+
+class Type_EXTENDS_Parent_Type_Name(CALLBase):
+ """
+ <..> = EXTENDS ( <parent-type-name> )
+ """
+ subclass_names = []
+ use_names = ['Parent_Type_Name']
+ def match(string): return CALLBase.match('EXTENDS', Parent_Type_Name, string)
+ match = staticmethod(match)
+
+class Type_Attr_Spec(STRINGBase): # R431
+ """
+ <type-attr-spec> = <access-spec>
+ | EXTENDS ( <parent-type-name> )
+ | ABSTRACT
+ | BIND (C)
+ """
+ subclass_names = ['Access_Spec', 'Type_EXTENDS_Parent_Type_Name', 'Language_Binding_Spec']
+ def match(string): return STRINGBase.match('ABSTRACT', string)
+ match = staticmethod(match)
+
+class Private_Or_Sequence(Base): # R432
+ """
+ <private-or-sequence> = <private-components-stmt>
+ | <sequence-stmt>
+ """
+ subclass_names = ['Private_Components_Stmt', 'Sequence_Stmt']
+
+class End_Type_Stmt(EndStmtBase): # R433
+ """
+ <end-type-stmt> = END TYPE [ <type-name> ]
+ """
+ subclass_names = []
+ use_names = ['Type_Name']
+ def match(string): return EndStmtBase.match('TYPE',Type_Name, string, require_stmt_type=True)
+ match = staticmethod(match)
+
+class Sequence_Stmt(STRINGBase): # R434
+ """
+ <sequence-stmt> = SEQUENCE
+ """
+ subclass_names = []
+ def match(string): return STRINGBase.match('SEQUENCE', string)
+ match = staticmethod(match)
+
+class Type_Param_Def_Stmt(StmtBase): # R435
+ """
+ <type-param-def-stmt> = INTEGER [ <kind-selector> ] , <type-param-attr-spec> :: <type-param-decl-list>
+ """
+ subclass_names = []
+ use_names = ['Kind_Selector', 'Type_Param_Attr_Spec', 'Type_Param_Decl_List']
+ def match(string):
+ if string[:7].upper()!='INTEGER': return
+ line, repmap = string_replace_map(string[7:].lstrip())
+ if not line: return
+ i = line.find(',')
+ if i==-1: return
+ kind_selector = repmap(line[:i].rstrip()) or None
+ line = repmap(line[i+1:].lstrip())
+ i = line.find('::')
+ if i==-1: return
+ l1 = line[:i].rstrip()
+ l2 = line[i+2:].lstrip()
+ if not l1 or not l2: return
+ if kind_selector: kind_selector = Kind_Selector(kind_selector)
+ return kind_selector, Type_Param_Attr_Spec(l1), Type_Param_Decl_List(l2)
+ match = staticmethod(match)
+ def tostr(self):
+ s = 'INTEGER'
+ if self.items[0] is not None:
+ s += '%s, %s :: %s' % tuple(self.items)
+ else:
+ s += ', %s :: %s' % tuple(self.items[1:])
+ return s
+
+class Type_Param_Decl(BinaryOpBase): # R436
+ """
+ <type-param-decl> = <type-param-name> [ = <scalar-int-initialization-expr> ]
+ """
+ subclass_names = ['Type_Param_Name']
+ use_names = ['Scalar_Int_Initialization_Expr']
+ def match(string):
+ if '=' not in string: return
+ lhs,rhs = string.split('=',1)
+ lhs = lhs.rstrip()
+ rhs = rhs.lstrip()
+ if not lhs or not rhs: return
+ return Type_Param_Name(lhs),'=',Scalar_Int_Initialization_Expr(rhs)
+ match = staticmethod(match)
+
+class Type_Param_Attr_Spec(STRINGBase): # R437
+ """
+ <type-param-attr-spec> = KIND
+ | LEN
+ """
+ subclass_names = []
+ def match(string): return STRINGBase.match(['KIND', 'LEN'], string)
+ match = staticmethod(match)
+
+
+class Component_Part(BlockBase): # R438
+ """
+ <component-part> = [ <component-def-stmt> ]...
+ """
+ subclass_names = []
+ use_names = ['Component_Def_Stmt']
+ def match(reader):
+ content = []
+ while 1:
+ try:
+ obj = Component_Def_Stmt(reader)
+ except NoMatchError:
+ obj = None
+ if obj is None:
+ break
+ content.append(obj)
+ if content:
+ return content,
+ return
+ match = staticmethod(match)
+
+ def tofortran(self, tab='', isfix=None):
+ l = []
+ for item in self.content:
+ l.append(item.tofortran(tab=tab,isfix=isfix))
+ return '\n'.join(l)
+
+class Component_Def_Stmt(Base): # R439
+ """
+ <component-def-stmt> = <data-component-def-stmt>
+ | <proc-component-def-stmt>
+ """
+ subclass_names = ['Data_Component_Def_Stmt', 'Proc_Component_Def_Stmt']
+
+class Data_Component_Def_Stmt(StmtBase): # R440
+ """
+ <data-component-def-stmt> = <declaration-type-spec> [ [ , <component-attr-spec-list> ] :: ] <component-decl-list>
+ """
+ subclass_names = []
+ use_names = ['Declaration_Type_Spec', 'Component_Attr_Spec_List', 'Component_Decl_List']
+
+class Dimension_Component_Attr_Spec(CALLBase):
+ """
+ <dimension-component-attr-spec> = DIMENSION ( <component-array-spec> )
+ """
+ subclass_names = []
+ use_names = ['Component_Array_Spec']
+ def match(string): return CALLBase.match('DIMENSION', Component_Array_Spec, string)
+ match = staticmethod(match)
+
+class Component_Attr_Spec(STRINGBase): # R441
+ """
+ <component-attr-spec> = POINTER
+ | DIMENSION ( <component-array-spec> )
+ | ALLOCATABLE
+ | <access-spec>
+ """
+ subclass_names = ['Access_Spec', 'Dimension_Component_Attr_Spec']
+ use_names = []
+ def match(string): return STRINGBase.match(['POINTER', 'ALLOCATABLE'], string)
+ match = staticmethod(match)
+
+class Component_Decl(Base): # R442
+ """
+ <component-decl> = <component-name> [ ( <component-array-spec> ) ] [ * <char-length> ] [ <component-initialization> ]
+ """
+ subclass_names = []
+ use_names = ['Component_Name', 'Component_Array_Spec', 'Char_Length', 'Component_Initialization']
+ def match(string):
+ m = pattern.name.match(string)
+ if m is None: return
+ name = Component_Name(m.group())
+ newline = string[m.end():].lstrip()
+ if not newline: return name, None, None, None
+ array_spec = None
+ char_length = None
+ init = None
+ if newline.startswith('('):
+ line, repmap = string_replace_map(newline)
+ i = line.find(')')
+ if i==-1: return
+ array_spec = Component_Array_Spec(repmap(line[1:i].strip()))
+ newline = repmap(line[i+1:].lstrip())
+ if newline.startswith('*'):
+ line, repmap = string_replace_map(newline)
+ i = line.find('=')
+ if i!=-1:
+ char_length = repmap(line[1:i].strip())
+ newline = repmap(newline[i:].lstrip())
+ else:
+ char_length = repmap(newline[1:].strip())
+ newline = ''
+ char_length = Char_Length(char_length)
+ if newline.startswith('='):
+ init = Component_Initialization(newline)
+ else:
+ assert newline=='',`newline`
+ return name, array_spec, char_length, init
+ match = staticmethod(match)
+ def tostr(self):
+ s = str(self.items[0])
+ if self.items[1] is not None:
+ s += '(' + str(self.items[1]) + ')'
+ if self.items[2] is not None:
+ s += '*' + str(self.items[2])
+ if self.items[3] is not None:
+ s += ' ' + str(self.items[3])
+ return s
+
+class Component_Array_Spec(Base): # R443
+ """
+ <component-array-spec> = <explicit-shape-spec-list>
+ | <deferred-shape-spec-list>
+ """
+ subclass_names = ['Explicit_Shape_Spec_List', 'Deferred_Shape_Spec_List']
+
+class Component_Initialization(Base): # R444
+ """
+ <component-initialization> = = <initialization-expr>
+ | => <null-init>
+ """
+ subclass_names = []
+ use_names = ['Initialization_Expr', 'Null_Init']
+ def match(string):
+ if string.startswith('=>'):
+ return '=>', Null_Init(string[2:].lstrip())
+ if string.startswith('='):
+ return '=', Initialization_Expr(string[2:].lstrip())
+ return
+ match = staticmethod(match)
+ def tostr(self): return '%s %s' % tuple(self.items)
+
+
+class Proc_Component_Def_Stmt(StmtBase): # R445
+ """
+ <proc-component-def-stmt> = PROCEDURE ( [ <proc-interface> ] ) , <proc-component-attr-spec-list> :: <proc-decl-list>
+ """
+ subclass_names = []
+ use_names = ['Proc_Interface', 'Proc_Component_Attr_Spec_List', 'Proc_Decl_List']
+
+class Proc_Component_PASS_Arg_Name(CALLBase):
+ """
+ <proc-component-PASS-arg-name> = PASS ( <arg-name> )
+ """
+ subclass_names = []
+ use_names = ['Arg_Name']
+ def match(string): return CALLBase.match('PASS', Arg_Name, string)
+ match = staticmethod(match)
+
+class Proc_Component_Attr_Spec(STRINGBase): # R446
+ """
+ <proc-component-attr-spec> = POINTER
+ | PASS [ ( <arg-name> ) ]
+ | NOPASS
+ | <access-spec>
+ """
+ subclass_names = ['Access_Spec', 'Proc_Component_PASS_Arg_Name']
+ def match(string): return STRINGBase.match(['POINTER','PASS','NOPASS'], string)
+ match = staticmethod(match)
+
+class Private_Components_Stmt(StmtBase): # R447
+ """
+ <private-components-stmt> = PRIVATE
+ """
+ subclass_names = []
+ def match(string): return StringBase.match('PRIVATE', string)
+ match = staticmethod(match)
+
+class Type_Bound_Procedure_Part(Base): # R448
+ """
+ <type-bound-procedure-part> = <contains-stmt>
+ [ <binding-private-stmt> ]
+ <proc-binding-stmt>
+ [ <proc-binding-stmt> ]...
+ """
+ subclass_names = []
+ use_names = ['Contains_Stmt', 'Binding_Private_Stmt', 'Proc_Binding_Stmt']
+
+class Binding_Private_Stmt(StmtBase, STRINGBase): # R449
+ """
+ <binding-private-stmt> = PRIVATE
+ """
+ subclass_names = []
+ def match(string): return StringBase.match('PRIVATE', string)
+ match = staticmethod(match)
+
+class Proc_Binding_Stmt(Base): # R450
+ """
+ <proc-binding-stmt> = <specific-binding>
+ | <generic-binding>
+ | <final-binding>
+ """
+ subclass_names = ['Specific_Binding', 'Generic_Binding', 'Final_Binding']
+
+class Specific_Binding(StmtBase): # R451
+ """
+ <specific-binding> = PROCEDURE [ ( <interface-name> ) ] [ [ , <binding-attr-list> ] :: ] <binding-name> [ => <procedure-name> ]
+ """
+ subclass_names = []
+ use_names = ['Interface_Name', 'Binding_Attr_List', 'Binding_Name', 'Procedure_Name']
+
+class Generic_Binding(StmtBase): # R452
+ """
+ <generic-binding> = GENERIC [ , <access-spec> ] :: <generic-spec> => <binding-name-list>
+ """
+ subclass_names = []
+ use_names = ['Access_Spec', 'Generic_Spec', 'Binding_Name_List']
+
+class Binding_PASS_Arg_Name(CALLBase):
+ """
+ <binding-PASS-arg-name> = PASS ( <arg-name> )
+ """
+ subclass_names = []
+ use_names = ['Arg_Name']
+ def match(string): return CALLBase.match('PASS', Arg_Name, string)
+ match = staticmethod(match)
+
+class Binding_Attr(STRINGBase): # R453
+ """
+ <binding-attr> = PASS [ ( <arg-name> ) ]
+ | NOPASS
+ | NON_OVERRIDABLE
+ | <access-spec>
+ """
+ subclass_names = ['Access_Spec', 'Binding_PASS_Arg_Name']
+ def match(string): return STRINGBase.match(['PASS', 'NOPASS', 'NON_OVERRIDABLE'], string)
+ match = staticmethod(match)
+
+class Final_Binding(StmtBase, WORDClsBase): # R454
+ """
+ <final-binding> = FINAL [ :: ] <final-subroutine-name-list>
+ """
+ subclass_names = []
+ use_names = ['Final_Subroutine_Name_List']
+ def match(string): return WORDClsBase.match('FINAL',Final_Subroutine_Name_List,string,check_colons=True, require_cls=True)
+ match = staticmethod(match)
+ tostr = WORDClsBase.tostr_a
+
+class Derived_Type_Spec(CallBase): # R455
+ """
+ <derived-type-spec> = <type-name> [ ( <type-param-spec-list> ) ]
+ """
+ subclass_names = ['Type_Name']
+ use_names = ['Type_Param_Spec_List']
+ def match(string): return CallBase.match(Type_Name, Type_Param_Spec_List, string)
+ match = staticmethod(match)
+
+class Type_Param_Spec(KeywordValueBase): # R456
+ """
+ <type-param-spec> = [ <keyword> = ] <type-param-value>
+ """
+ subclass_names = ['Type_Param_Value']
+ use_names = ['Keyword']
+ def match(string): return KeywordValueBase.match(Keyword, Type_Param_Value, string)
+ match = staticmethod(match)
+
+class Structure_Constructor_2(KeywordValueBase): # R457.b
+ """
+ <structure-constructor-2> = [ <keyword> = ] <component-data-source>
+ """
+ subclass_names = ['Component_Data_Source']
+ use_names = ['Keyword']
+ def match(string): return KeywordValueBase.match(Keyword, Component_Data_Source, string)
+ match = staticmethod(match)
+
+class Structure_Constructor(CallBase): # R457
+ """
+ <structure-constructor> = <derived-type-spec> ( [ <component-spec-list> ] )
+ | <structure-constructor-2>
+ """
+ subclass_names = ['Structure_Constructor_2']
+ use_names = ['Derived_Type_Spec', 'Component_Spec_List']
+ def match(string): return CallBase.match(Derived_Type_Spec, Component_Spec_List, string)
+ match = staticmethod(match)
+
+class Component_Spec(KeywordValueBase): # R458
+ """
+ <component-spec> = [ <keyword> = ] <component-data-source>
+ """
+ subclass_names = ['Component_Data_Source']
+ use_names = ['Keyword']
+ def match(string): return KeywordValueBase.match(Keyword, Component_Data_Source, string)
+ match = staticmethod(match)
+
+class Component_Data_Source(Base): # R459
+ """
+ <component-data-source> = <expr>
+ | <data-target>
+ | <proc-target>
+ """
+ subclass_names = ['Proc_Target', 'Data_Target', 'Expr']
+
+class Enum_Def(Base): # R460
+ """
+ <enum-def> = <enum-def-stmt>
+ <enumerator-def-stmt>
+ [ <enumerator-def-stmt> ]...
+ <end-enum-stmt>
+ """
+ subclass_names = []
+ use_names = ['Enum_Def_Stmt', 'Enumerator_Def_Stmt', 'End_Enum_Stmt']
+
+class Enum_Def_Stmt(STRINGBase): # R461
+ """
+ <enum-def-stmt> = ENUM, BIND(C)
+ """
+ subclass_names = []
+ def match(string):
+ if string[:4].upper()!='ENUM': return
+ line = string[4:].lstrip()
+ if not line.startswith(','): return
+ line = line[1:].lstrip()
+ if line[:4].upper()!='BIND': return
+ line = line[4:].lstrip()
+ if not line or line[0]+line[-1]!='()': return
+ line = line[1:-1].strip()
+ if line!='C' or line!='c': return
+ return 'ENUM, BIND(C)',
+ match = staticmethod(match)
+
+class Enumerator_Def_Stmt(StmtBase, WORDClsBase): # R462
+ """
+ <enumerator-def-stmt> = ENUMERATOR [ :: ] <enumerator-list>
+ """
+ subclass_names = []
+ use_names = ['Enumerator_List']
+ def match(string): return WORDClsBase.match('ENUMERATOR',Enumerator_List,string,check_colons=True, require_cls=True)
+ match = staticmethod(match)
+ tostr = WORDClsBase.tostr_a
+
+class Enumerator(BinaryOpBase): # R463
+ """
+ <enumerator> = <named-constant> [ = <scalar-int-initialization-expr> ]
+ """
+ subclass_names = ['Named_Constant']
+ use_names = ['Scalar_Int_Initialization_Expr']
+ def match(string):
+ if '=' not in string: return
+ lhs,rhs = string.split('=',1)
+ return Named_Constant(lhs.rstrip()),'=',Scalar_Int_Initialization_Expr(rhs.lstrip())
+ match = staticmethod(match)
+
+class End_Enum_Stmt(EndStmtBase): # R464
+ """
+ <end-enum-stmt> = END ENUM
+ """
+ subclass_names = []
+ def match(string): return EndStmtBase.match('ENUM',None, string, requite_stmt_type=True)
+ match = staticmethod(match)
+
+class Array_Constructor(BracketBase): # R465
+ """
+ <array-constructor> = (/ <ac-spec> /)
+ | <left-square-bracket> <ac-spec> <right-square-bracket>
+
+ """
+ subclass_names = []
+ use_names = ['Ac_Spec']
+ def match(string):
+ try:
+ obj = BracketBase.match('(//)', Ac_Spec, string)
+ except NoMatchError:
+ obj = None
+ if obj is None:
+ obj = BracketBase.match('[]', Ac_Spec, string)
+ return obj
+ match = staticmethod(match)
+
+class Ac_Spec(Base): # R466
+ """
+ <ac-spec> = <type-spec> ::
+ | [ <type-spec> :: ] <ac-value-list>
+ """
+ subclass_names = ['Ac_Value_List']
+ use_names = ['Type_Spec']
+ def match(string):
+ if string.endswith('::'):
+ return Type_Spec(string[:-2].rstrip()),None
+ line, repmap = string_replace_map(string)
+ i = line.find('::')
+ if i==-1: return
+ ts = line[:i].rstrip()
+ line = line[i+2:].lstrip()
+ ts = repmap(ts)
+ line = repmap(line)
+ return Type_Spec(ts),Ac_Value_List(line)
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[0] is None:
+ return str(self.items[1])
+ if self.items[1] is None:
+ return str(self.items[0]) + ' ::'
+ return '%s :: %s' % self.items
+
+# R467: <left-square-bracket> = [
+# R468: <right-square-bracket> = ]
+
+class Ac_Value(Base): # R469
+ """
+ <ac-value> = <expr>
+ | <ac-implied-do>
+ """
+ subclass_names = ['Ac_Implied_Do','Expr']
+
+class Ac_Implied_Do(Base): # R470
+ """
+ <ac-implied-do> = ( <ac-value-list> , <ac-implied-do-control> )
+ """
+ subclass_names = []
+ use_names = ['Ac_Value_List','Ac_Implied_Do_Control']
+ def match(string):
+ if string[0]+string[-1] != '()': return
+ line, repmap = string_replace_map(string[1:-1].strip())
+ i = line.rfind('=')
+ if i==-1: return
+ j = line[:i].rfind(',')
+ assert j!=-1
+ s1 = repmap(line[:j].rstrip())
+ s2 = repmap(line[j+1:].lstrip())
+ return Ac_Value_List(s1),Ac_Implied_Do_Control(s2)
+ match = staticmethod(match)
+ def tostr(self): return '(%s, %s)' % tuple(self.items)
+
+class Ac_Implied_Do_Control(Base): # R471
+ """
+ <ac-implied-do-control> = <ac-do-variable> = <scalar-int-expr> , <scalar-int-expr> [ , <scalar-int-expr> ]
+ """
+ subclass_names = []
+ use_names = ['Ac_Do_Variable','Scalar_Int_Expr']
+ def match(string):
+ i = string.find('=')
+ if i==-1: return
+ s1 = string[:i].rstrip()
+ line, repmap = string_replace_map(string[i+1:].lstrip())
+ t = line.split(',')
+ if not (2<=len(t)<=3): return
+ t = [Scalar_Int_Expr(s.strip()) for s in t]
+ return Ac_Do_Variable(s1), t
+ match = staticmethod(match)
+ def tostr(self): return '%s = %s' % (self.items[0], ', '.join(map(str,self.items[1])))
+
+class Ac_Do_Variable(Base): # R472
+ """
+ <ac-do-variable> = <scalar-int-variable>
+ <ac-do-variable> shall be a named variable
+ """
+ subclass_names = ['Scalar_Int_Variable']
+
+###############################################################################
+############################### SECTION 5 ####################################
+###############################################################################
+
+class Type_Declaration_Stmt(Base): # R501
+ """
+ <type-declaration-stmt> = <declaration-type-spec> [ [ , <attr-spec> ]... :: ] <entity-decl-list>
+ """
+ subclass_names = []
+ use_names = ['Declaration_Type_Spec', 'Attr_Spec_List', 'Entity_Decl_List']
+
+ def match(string):
+ line, repmap = string_replace_map(string)
+ i = line.find('::')
+ if i!=-1:
+ j = line[:i].find(',')
+ if j!=-1:
+ i = j
+ else:
+ if line[:6].upper()=='DOUBLE':
+ m = re.search(r'\s[a-z_]',line[6:].lstrip(),re.I)
+ if m is None: return
+ i = m.start() + len(line)-len(line[6:].lstrip())
+ else:
+ m = re.search(r'\s[a-z_]',line,re.I)
+ if m is None: return
+ i = m.start()
+ type_spec = Declaration_Type_Spec(repmap(line[:i].rstrip()))
+ if type_spec is None: return
+ line = line[i:].lstrip()
+ if line.startswith(','):
+ i = line.find('::')
+ if i==-1: return
+ attr_specs = Attr_Spec_List(repmap(line[1:i].strip()))
+ if attr_specs is None: return
+ line = line[i:]
+ else:
+ attr_specs = None
+ if line.startswith('::'):
+ line = line[2:].lstrip()
+ entity_decls = Entity_Decl_List(repmap(line))
+ if entity_decls is None: return
+ return type_spec, attr_specs, entity_decls
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[1] is None:
+ return '%s :: %s' % (self.items[0], self.items[2])
+ else:
+ return '%s, %s :: %s' % self.items
+
+class Declaration_Type_Spec(Base): # R502
+ """
+ <declaration-type-spec> = <intrinsic-type-spec>
+ | TYPE ( <derived-type-spec> )
+ | CLASS ( <derived-type-spec> )
+ | CLASS ( * )
+ """
+ subclass_names = ['Intrinsic_Type_Spec']
+ use_names = ['Derived_Type_Spec']
+
+ def match(string):
+ if string[-1] != ')': return
+ start = string[:4].upper()
+ if start == 'TYPE':
+ line = string[4:].lstrip()
+ if not line.startswith('('): return
+ return 'TYPE',Derived_Type_Spec(line[1:-1].strip())
+ start = string[:5].upper()
+ if start == 'CLASS':
+ line = string[5:].lstrip()
+ if not line.startswith('('): return
+ line = line[1:-1].strip()
+ if line=='*': return 'CLASS','*'
+ return 'CLASS', Derived_Type_Spec(line)
+ return
+ match = staticmethod(match)
+ def tostr(self): return '%s(%s)' % self.items
+
+class Dimension_Attr_Spec(CALLBase): # R503.d
+ """
+ <dimension-attr-spec> = DIMENSION ( <array-spec> )
+ """
+ subclass_names = []
+ use_names = ['Array_Spec']
+ def match(string): return CALLBase.match('DIMENSION', Array_Spec, string)
+ match = staticmethod(match)
+
+class Intent_Attr_Spec(CALLBase): # R503.f
+ """
+ <intent-attr-spec> = INTENT ( <intent-spec> )
+ """
+ subclass_names = []
+ use_names = ['Intent_Spec']
+ def match(string): return CALLBase.match('INTENT', Intent_Spec, string)
+ match = staticmethod(match)
+
+class Attr_Spec(STRINGBase): # R503
+ """
+ <attr-spec> = <access-spec>
+ | ALLOCATABLE
+ | ASYNCHRONOUS
+ | DIMENSION ( <array-spec> )
+ | EXTERNAL
+ | INTENT ( <intent-spec> )
+ | INTRINSIC
+ | <language-binding-spec>
+ | OPTIONAL
+ | PARAMETER
+ | POINTER
+ | PROTECTED
+ | SAVE
+ | TARGET
+ | VALUE
+ | VOLATILE
+ """
+ subclass_names = ['Access_Spec', 'Language_Binding_Spec',
+ 'Dimension_Attr_Spec', 'Intent_Attr_Spec']
+ use_names = []
+ def match(string): return STRINGBase.match(pattern.abs_attr_spec, string)
+ match = staticmethod(match)
+
+class Entity_Decl(Base): # R504
+ """
+ <entity-decl> = <object-name> [ ( <array-spec> ) ] [ * <char-length> ] [ <initialization> ]
+ | <function-name> [ * <char-length> ]
+ """
+ subclass_names = []
+ use_names = ['Object_Name', 'Array_Spec', 'Char_Length', 'Initialization', 'Function_Name']
+ def match(string):
+ m = pattern.name.match(string)
+ if m is None: return
+ name = Name(m.group())
+ newline = string[m.end():].lstrip()
+ if not newline: return name, None, None, None
+ array_spec = None
+ char_length = None
+ init = None
+ if newline.startswith('('):
+ line, repmap = string_replace_map(newline)
+ i = line.find(')')
+ if i==-1: return
+ array_spec = Array_Spec(repmap(line[1:i].strip()))
+ newline = repmap(line[i+1:].lstrip())
+ if newline.startswith('*'):
+ line, repmap = string_replace_map(newline)
+ i = line.find('=')
+ if i!=-1:
+ char_length = repmap(line[1:i].strip())
+ newline = repmap(newline[i:].lstrip())
+ else:
+ char_length = repmap(newline[1:].strip())
+ newline = ''
+ char_length = Char_Length(char_length)
+ if newline.startswith('='):
+ init = Initialization(newline)
+ else:
+ assert newline=='',`newline`
+ return name, array_spec, char_length, init
+ match = staticmethod(match)
+ def tostr(self):
+ s = str(self.items[0])
+ if self.items[1] is not None:
+ s += '(' + str(self.items[1]) + ')'
+ if self.items[2] is not None:
+ s += '*' + str(self.items[2])
+ if self.items[3] is not None:
+ s += ' ' + str(self.items[3])
+ return s
+
+class Object_Name(Base): # R505
+ """
+ <object-name> = <name>
+ """
+ subclass_names = ['Name']
+
+class Initialization(Base): # R506
+ """
+ <initialization> = = <initialization-expr>
+ | => <null-init>
+ """
+ subclass_names = []
+ use_names = ['Initialization_Expr', 'Null_Init']
+ def match(string):
+ if string.startswith('=>'):
+ return '=>', Null_Init(string[2:].lstrip())
+ if string.startswith('='):
+ return '=', Initialization_Expr(string[2:].lstrip())
+ return
+ match = staticmethod(match)
+ def tostr(self): return '%s %s' % self.items
+
+class Null_Init(STRINGBase): # R507
+ """
+ <null-init> = <function-reference>
+
+ <function-reference> shall be a reference to the NULL intrinsic function with no arguments.
+ """
+ subclass_names = ['Function_Reference']
+ def match(string): return STRINGBase.match('NULL', string)
+ match = staticmethod(match)
+
+class Access_Spec(STRINGBase): # R508
+ """
+ <access-spec> = PUBLIC
+ | PRIVATE
+ """
+ subclass_names = []
+ def match(string): return STRINGBase.match(['PUBLIC','PRIVATE'], string)
+ match = staticmethod(match)
+
+class Language_Binding_Spec(Base): # R509
+ """
+ <language-binding-spec> = BIND ( C [ , NAME = <scalar-char-initialization-expr> ] )
+ """
+ subclass_names = []
+ use_names = ['Scalar_Char_Initialization_Expr']
+ def match(string):
+ start = string[:4].upper()
+ if start != 'BIND': return
+ line = string[4:].lstrip()
+ if not line or line[0]+line[-1]!='()': return
+ line = line[1:-1].strip()
+ if not line: return
+ start = line[0].upper()
+ if start!='C': return
+ line = line[1:].lstrip()
+ if not line: return None,
+ if not line.startswith(','): return
+ line = line[1:].lstrip()
+ start = line[:4].upper()
+ if start!='NAME': return
+ line=line[4:].lstrip()
+ if not line.startswith('='): return
+ return Scalar_Char_Initialization_Expr(line[1:].lstrip()),
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[0] is None: return 'BIND(C)'
+ return 'BIND(C, NAME = %s)' % (self.items[0])
+
+class Array_Spec(Base): # R510
+ """
+ <array-spec> = <explicit-shape-spec-list>
+ | <assumed-shape-spec-list>
+ | <deferred-shape-spec-list>
+ | <assumed-size-spec>
+ """
+ subclass_names = ['Assumed_Size_Spec', 'Explicit_Shape_Spec_List', 'Assumed_Shape_Spec_List',
+ 'Deferred_Shape_Spec_List']
+
+class Explicit_Shape_Spec(SeparatorBase): # R511
+ """
+ <explicit-shape-spec> = [ <lower-bound> : ] <upper-bound>
+ """
+ subclass_names = []
+ use_names = ['Lower_Bound', 'Upper_Bound']
+ def match(string):
+ line, repmap = string_replace_map(string)
+ if ':' not in line:
+ return None, Upper_Bound(string)
+ lower,upper = line.split(':',1)
+ lower = lower.rstrip()
+ upper = upper.lstrip()
+ if not upper: return
+ if not lower: return
+ return Lower_Bound(repmap(lower)), Upper_Bound(repmap(upper))
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[0] is None: return str(self.items[1])
+ return SeparatorBase.tostr(self)
+
+class Lower_Bound(Base): # R512
+ """
+ <lower-bound> = <specification-expr>
+ """
+ subclass_names = ['Specification_Expr']
+
+class Upper_Bound(Base): # R513
+ """
+ <upper-bound> = <specification-expr>
+ """
+ subclass_names = ['Specification_Expr']
+
+class Assumed_Shape_Spec(SeparatorBase): # R514
+ """
+ <assumed-shape-spec> = [ <lower-bound> ] :
+ """
+ subclass_names = []
+ use_names = ['Lower_Bound']
+ def match(string): return SeparatorBase.match(Lower_Bound, None, string)
+ match = staticmethod(match)
+
+class Deferred_Shape_Spec(SeparatorBase): # R515
+ """
+ <deferred_shape_spec> = :
+ """
+ subclass_names = []
+ def match(string):
+ if string==':': return None,None
+ return
+ match = staticmethod(match)
+
+class Assumed_Size_Spec(Base): # R516
+ """
+ <assumed-size-spec> = [ <explicit-shape-spec-list> , ] [ <lower-bound> : ] *
+ """
+ subclass_names = []
+ use_names = ['Explicit_Shape_Spec_List', 'Lower_Bound']
+ def match(string):
+ if not string.endswith('*'): return
+ line = string[:-1].rstrip()
+ if not line: return None,None
+ if line.endswith(':'):
+ line, repmap = string_replace_map(line[:-1].rstrip())
+ i = line.rfind(',')
+ if i==-1:
+ return None, Lower_Bound(repmap(line))
+ return Explicit_Shape_Spec_List(repmap(line[:i].rstrip())), Lower_Bound(repmap(line[i+1:].lstrip()))
+ if not line.endswith(','): return
+ line = line[:-1].rstrip()
+ return Explicit_Shape_Spec_List(line), None
+ match = staticmethod(match)
+ def tostr(self):
+ s = ''
+ if self.items[0] is not None:
+ s += str(self.items[0]) + ', '
+ if self.items[1] is not None:
+ s += str(self.items[1]) + ' : '
+ s += '*'
+ return s
+
+class Intent_Spec(STRINGBase): # R517
+ """
+ <intent-spec> = IN
+ | OUT
+ | INOUT
+ """
+ subclass_names = []
+ def match(string): return STRINGBase.match(pattern.abs_intent_spec, string)
+ match = staticmethod(match)
+
+class Access_Stmt(StmtBase, WORDClsBase): # R518
+ """
+ <access-stmt> = <access-spec> [ [ :: ] <access-id-list> ]
+ """
+ subclass_names = []
+ use_names = ['Access_Spec', 'Access_Id_List']
+ def match(string): return WORDClsBase.match(['PUBLIC', 'PRIVATE'],Access_Id_List,string,check_colons=True, require_cls=False)
+ match = staticmethod(match)
+ tostr = WORDClsBase.tostr_a
+
+class Access_Id(Base): # R519
+ """
+ <access-id> = <use-name>
+ | <generic-spec>
+ """
+ subclass_names = ['Use_Name', 'Generic_Spec']
+
+class Object_Name_Deferred_Shape_Spec_List_Item(CallBase):
+ """
+ <..> = <object-name> [ ( <deferred-shape-spec-list> ) ]
+ """
+ subclass_names = ['Object_Name']
+ use_names = ['Deferred_Shape_Spec_List']
+ def match(string): return CallBase.match(Object_Name, Deferred_Shape_Spec_List, string, require_rhs=True)
+ match = staticmethod(match)
+
+class Allocatable_Stmt(StmtBase, WORDClsBase): # R520
+ """
+ <allocateble-stmt> = ALLOCATABLE [ :: ] <object-name> [ ( <deferred-shape-spec-list> ) ] [ , <object-name> [ ( <deferred-shape-spec-list> ) ] ]...
+ """
+ subclass_names = []
+ use_names = ['Object_Name_Deferred_Shape_Spec_List_Item_List']
+ def match(string):
+ return WORDClsBase.match('ALLOCATABLE', Object_Name_Deferred_Shape_Spec_List_Item_List, string,
+ check_colons=True, require_cls=True)
+ match = staticmethod(match)
+
+class Asynchronous_Stmt(StmtBase, WORDClsBase): # R521
+ """
+ <asynchronous-stmt> = ASYNCHRONOUS [ :: ] <object-name-list>
+ """
+ subclass_names = []
+ use_names = ['Object_Name_List']
+ def match(string): return WORDClsBase.match('ASYNCHRONOUS',Object_Name_List,string,check_colons=True, require_cls=True)
+ match = staticmethod(match)
+
+
+class Bind_Stmt(StmtBase): # R522
+ """
+ <bind-stmt> = <language-binding-spec> [ :: ] <bind-entity-list>
+ """
+ subclass_names = []
+ use_names = ['Language_Binding_Spec', 'Bind_Entity_List']
+ def match(string):
+ i = string.find('::')
+ if i==-1:
+ i = string.find(')')
+ if i==-1: return
+ lhs. rhs = string[:i], string[i+1:]
+ else:
+ lhs, rhs = string.split('::',1)
+ lhs = lhs.rstrip()
+ rhs = rhs.lstrip()
+ if not lhs or not rhs: return
+ return Language_Binding_Spec(lhs), Bind_Entity_List(rhs)
+ match = staticmethod(match)
+ def tostr(self):
+ return '%s :: %s' % self.items
+
+
+class Bind_Entity(BracketBase): # R523
+ """
+ <bind-entity> = <entity-name>
+ | / <common-block-name> /
+ """
+ subclass_names = ['Entity_Name']
+ use_names = ['Common_Block_Name']
+ def match(string): return BracketBase.match('//',Common_Block_Name, string)
+ match = staticmethod(match)
+
+class Data_Stmt(StmtBase): # R524
+ """
+ <data-stmt> = DATA <data-stmt-set> [ [ , ] <data-stmt-set> ]...
+ """
+ subclass_names = []
+ use_names = ['Data_Stmt_Set']
+
+class Data_Stmt_Set(Base): # R525
+ """
+ <data-stmt-set> = <data-stmt-object-list> / <data-stmt-value-list> /
+ """
+ subclass_names = []
+ use_names = ['Data_Stmt_Object_List', 'Data_Stmt_Value_List']
+
+class Data_Stmt_Object(Base): # R526
+ """
+ <data-stmt-object> = <variable>
+ | <data-implied-do>
+ """
+ subclass_names = ['Variable', 'Data_Implied_Do']
+
+class Data_Implied_Do(Base): # R527
+ """
+ <data-implied-do> = ( <data-i-do-object-list> , <data-i-do-variable> = <scalar-int-expr > , <scalar-int-expr> [ , <scalar-int-expr> ] )
+ """
+ subclass_names = []
+ use_names = ['Data_I_Do_Object_List', 'Data_I_Do_Variable', 'Scalar_Int_Expr']
+
+class Data_I_Do_Object(Base): # R528
+ """
+ <data-i-do-object> = <array-element>
+ | <scalar-structure-component>
+ | <data-implied-do>
+ """
+ subclass_names = ['Array_Element', 'Scalar_Structure_Component', 'Data_Implied_Do']
+
+class Data_I_Do_Variable(Base): # R529
+ """
+ <data-i-do-variable> = <scalar-int-variable>
+ """
+ subclass_names = ['Scalar_Int_Variable']
+
+class Data_Stmt_Value(Base): # R530
+ """
+ <data-stmt-value> = [ <data-stmt-repeat> * ] <data-stmt-constant>
+ """
+ subclass_names = ['Data_Stmt_Constant']
+ use_names = ['Data_Stmt_Repeat']
+ def match(string):
+ line, repmap = string_replace_map(string)
+ s = line.split('*')
+ if len(s)!=2: return
+ lhs = repmap(s[0].rstrip())
+ rhs = repmap(s[1].lstrip())
+ if not lhs or not rhs: return
+ return Data_Stmt_Repeat(lhs), Data_Stmt_Constant(rhs)
+ match = staticmethod(match)
+ def tostr(self):
+ return '%s * %s' % self.items
+
+class Data_Stmt_Repeat(Base): # R531
+ """
+ <data-stmt-repeat> = <scalar-int-constant>
+ | <scalar-int-constant-subobject>
+ """
+ subclass_names = ['Scalar_Int_Constant', 'Scalar_Int_Constant_Subobject']
+
+class Data_Stmt_Constant(Base): # R532
+ """
+ <data-stmt-constant> = <scalar-constant>
+ | <scalar-constant-subobject>
+ | <signed-int-literal-constant>
+ | <signed-real-literal-constant>
+ | <null-init>
+ | <structure-constructor>
+ """
+ subclass_names = ['Scalar_Constant', 'Scalar_Constant_Subobject',
+ 'Signed_Int_Literal_Constant', 'Signed_Real_Literal_Constant',
+ 'Null_Init', 'Structure_Constructor']
+
+class Int_Constant_Subobject(Base): # R533
+ """
+ <int-constant-subobject> = <constant-subobject>
+ """
+ subclass_names = ['Constant_Subobject']
+
+class Constant_Subobject(Base): # R534
+ """
+ <constant-subobject> = <designator>
+ """
+ subclass_names = ['Designator']
+
+class Dimension_Stmt(StmtBase): # R535
+ """
+ <dimension-stmt> = DIMENSION [ :: ] <array-name> ( <array-spec> ) [ , <array-name> ( <array-spec> ) ]...
+ """
+ subclass_names = []
+ use_names = ['Array_Name', 'Array_Spec']
+ def match(string):
+ if string[:9].upper()!='DIMENSION': return
+ line, repmap = string_replace_map(string[9:].lstrip())
+ if line.startswith('::'): line = line[2:].lstrip()
+ decls = []
+ for s in line.split(','):
+ s = s.strip()
+ if not s.endswith(')'): return
+ i = s.find('(')
+ if i==-1: return
+ decls.append((Array_Name(repmap(s[:i].rstrip())), Array_Spec(repmap(s[i+1:-1].strip()))))
+ if not decls: return
+ return decls,
+ match = staticmethod(match)
+ def tostr(self):
+ return 'DIMENSION :: ' + ', '.join(['%s(%s)' % ns for ns in self.items[0]])
+
+class Intent_Stmt(StmtBase): # R536
+ """
+ <intent-stmt> = INTENT ( <intent-spec> ) [ :: ] <dummy-arg-name-list>
+ """
+ subclass_names = []
+ use_names = ['Intent_Spec', 'Dummy_Arg_Name_List']
+ def match(string):
+ if string[:6].upper()!='INTENT': return
+ line = string[6:].lstrip()
+ if not line or not line.startswith('('): return
+ i = line.rfind(')')
+ if i==-1: return
+ spec = line[1:i].strip()
+ if not spec: return
+ line = line[i+1:].lstrip()
+ if line.startswith('::'):
+ line = line[2:].lstrip()
+ if not line: return
+ return Intent_Spec(spec), Dummy_Arg_Name_List(line)
+ match = staticmethod(match)
+ def tostr(self):
+ return 'INTENT(%s) :: %s' % self.items
+
+class Optional_Stmt(StmtBase, WORDClsBase): # R537
+ """
+ <optional-stmt> = OPTIONAL [ :: ] <dummy-arg-name-list>
+ """
+ subclass_names = []
+ use_names = ['Dummy_Arg_Name_List']
+ def match(string): return WORDClsBase.match('OPTIONAL',Dummy_Arg_Name_List,string,check_colons=True, require_cls=True)
+ match = staticmethod(match)
+ tostr = WORDClsBase.tostr_a
+
+class Parameter_Stmt(StmtBase, CALLBase): # R538
+ """
+ <parameter-stmt> = PARAMETER ( <named-constant-def-list> )
+ """
+ subclass_names = []
+ use_names = ['Named_Constant_Def_List']
+ def match(string): return CALLBase.match('PARAMETER', Named_Constant_Def_List, string, require_rhs=True)
+ match = staticmethod(match)
+
+class Named_Constant_Def(KeywordValueBase): # R539
+ """
+ <named-constant-def> = <named-constant> = <initialization-expr>
+ """
+ subclass_names = []
+ use_names = ['Named_Constant', 'Initialization_Expr']
+ def match(string): return KeywordValueBase.match(Named_Constant, Initialization_Expr, string)
+ match = staticmethod(match)
+
+class Pointer_Stmt(StmtBase, WORDClsBase): # R540
+ """
+ <pointer-stmt> = POINTER [ :: ] <pointer-decl-list>
+ """
+ subclass_names = []
+ use_names = ['Pointer_Decl_List']
+ def match(string): return WORDClsBase.match('POINTER',Pointer_Decl_List,string,check_colons=True, require_cls=True)
+ match = staticmethod(match)
+ tostr = WORDClsBase.tostr_a
+
+class Pointer_Decl(CallBase): # R541
+ """
+ <pointer-decl> = <object-name> [ ( <deferred-shape-spec-list> ) ]
+ | <proc-entity-name>
+ """
+ subclass_names = ['Proc_Entity_Name', 'Object_Name']
+ use_names = ['Deferred_Shape_Spec_List']
+ def match(string): return CallBase.match(Object_Name, Deferred_Shape_Spec_List, string, require_rhs=True)
+ match = staticmethod(match)
+
+class Protected_Stmt(StmtBase, WORDClsBase): # R542
+ """
+ <protected-stmt> = PROTECTED [ :: ] <entity-name-list>
+ """
+ subclass_names = []
+ use_names = ['Entity_Name_List']
+ def match(string): return WORDClsBase.match('PROTECTED',Entity_Name_List,string,check_colons=True, require_cls=True)
+ match = staticmethod(match)
+ tostr = WORDClsBase.tostr_a
+
+class Save_Stmt(StmtBase, WORDClsBase): # R543
+ """
+ <save-stmt> = SAVE [ [ :: ] <saved-entity-list> ]
+ """
+ subclass_names = []
+ use_names = ['Saved_Entity_List']
+ def match(string): return WORDClsBase.match('SAVE',Saved_Entity_List,string,check_colons=True, require_cls=False)
+ match = staticmethod(match)
+ tostr = WORDClsBase.tostr_a
+
+class Saved_Entity(BracketBase): # R544
+ """
+ <saved-entity> = <object-name>
+ | <proc-pointer-name>
+ | / <common-block-name> /
+ """
+ subclass_names = ['Object_Name', 'Proc_Pointer_Name']
+ use_names = ['Common_Block_Name']
+ def match(string): return BracketBase.match('//',CommonBlockName, string)
+ match = staticmethod(match)
+
+class Proc_Pointer_Name(Base): # R545
+ """
+ <proc-pointer-name> = <name>
+ """
+ subclass_names = ['Name']
+
+class Target_Stmt(StmtBase): # R546
+ """
+ <target-stmt> = TARGET [ :: ] <object-name> [ ( <array-spec> ) ] [ , <object-name> [ ( <array-spec> ) ] ]...
+ """
+ subclass_names = []
+ use_names = ['Object_Name', 'Array_Spec']
+
+class Value_Stmt(StmtBase, WORDClsBase): # R547
+ """
+ <value-stmt> = VALUE [ :: ] <dummy-arg-name-list>
+ """
+ subclass_names = []
+ use_names = ['Dummy_Arg_Name_List']
+ def match(string): return WORDClsBase.match('VALUE',Dummy_Arg_Name_List,string,check_colons=True, require_cls=True)
+ match = staticmethod(match)
+ tostr = WORDClsBase.tostr_a
+
+class Volatile_Stmt(StmtBase, WORDClsBase): # R548
+ """
+ <volatile-stmt> = VOLATILE [ :: ] <object-name-list>
+ """
+ subclass_names = []
+ use_names = ['Object_Name_List']
+ def match(string): return WORDClsBase.match('VOLATILE',Object_Name_List,string,check_colons=True, require_cls=True)
+ match = staticmethod(match)
+ tostr = WORDClsBase.tostr_a
+
+class Implicit_Stmt(StmtBase, WORDClsBase): # R549
+ """
+ <implicit-stmt> = IMPLICIT <implicit-spec-list>
+ | IMPLICIT NONE
+ """
+ subclass_names = []
+ use_names = ['Implicit_Spec_List']
+ def match(string):
+ for w,cls in [(pattern.abs_implicit_none, None),
+ ('IMPLICIT', Implicit_Spec_List)]:
+ try:
+ obj = WORDClsBase.match(w, cls, string)
+ except NoMatchError:
+ obj = None
+ if obj is not None: return obj
+ return
+ match = staticmethod(match)
+
+class Implicit_Spec(CallBase): # R550
+ """
+ <implicit-spec> = <declaration-type-spec> ( <letter-spec-list> )
+ """
+ subclass_names = []
+ use_names = ['Declaration_Type_Spec', 'Letter_Spec_List']
+ def match(string):
+ if not string.endswith(')'): return
+ i = string.rfind('(')
+ if i==-1: return
+ s1 = string[:i].rstrip()
+ s2 = string[i+1:-1].strip()
+ if not s1 or not s2: return
+ return Declaration_Type_Spec(s1), Letter_Spec_List(s2)
+ match = staticmethod(match)
+
+class Letter_Spec(Base): # R551
+ """
+ <letter-spec> = <letter> [ - <letter> ]
+ """
+ subclass_names = []
+ def match(string):
+ if len(string)==1:
+ lhs = string.upper()
+ if 'A'<=lhs<='Z': return lhs, None
+ return
+ if '-' not in string: return
+ lhs,rhs = string.split('-',1)
+ lhs = lhs.strip().upper()
+ rhs = rhs.strip().upper()
+ if not len(lhs)==len(rhs)==1: return
+ if not ('A'<=lhs<=rhs<='Z'): return
+ return lhs,rhs
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[1] is None: return str(self.items[0])
+ return '%s - %s' % tuple(self.items)
+
+class Namelist_Stmt(StmtBase): # R552
+ """
+ <namelist-stmt> = NAMELIST / <namelist-group-name> / <namelist-group-object-list> [ [ , ] / <namelist-group-name> / <namelist-group-object-list> ]
+ """
+ subclass_names = []
+ use_names = ['Namelist_Group_Name', 'Namelist_Group_Object_List']
+
+class Namelist_Group_Object(Base): # R553
+ """
+ <namelist-group-object> = <variable-name>
+ """
+ subclass_names = ['Variable_Name']
+
+class Equivalence_Stmt(StmtBase, WORDClsBase): # R554
+ """
+ <equivalence-stmt> = EQUIVALENCE <equivalence-set-list>
+ """
+ subclass_names = []
+ use_names = ['Equivalence_Set_List']
+ def match(string): return WORDClsBase.match('EQUIVALENCE', Equivalence_Set_List, string)
+ match = staticmethod(match)
+
+class Equivalence_Set(Base): # R555
+ """
+ <equivalence-set> = ( <equivalence-object> , <equivalence-object-list> )
+ """
+ subclass_names = []
+ use_names = ['Equivalence_Object', 'Equivalence_Object_List']
+ def match(string):
+ if not string or string[0]+string[-1]!='()': return
+ line = string[1:-1].strip()
+ if not line: return
+ l = Equivalence_Object_List(line)
+ obj = l.items[0]
+ l.items = l.items[1:]
+ if not l.items: return
+ return obj, l
+ match = staticmethod(match)
+ def tostr(self): return '(%s, %s)' % tuple(self.items)
+
+class Equivalence_Object(Base): # R556
+ """
+ <equivalence-object> = <variable-name>
+ | <array-element>
+ | <substring>
+ """
+ subclass_names = ['Variable_Name', 'Array_Element', 'Substring']
+
+class Common_Stmt(StmtBase): # R557
+ """
+ <common-stmt> = COMMON [ / [ <common-block-name> ] / ] <common-block-object-list> [ [ , ] / [ <common-block-name> ] / <common-block-object-list> ]...
+ """
+ subclass_names = []
+ use_names = ['Common_Block_Name', 'Common_Block_Object_List']
+ def match(string):
+ if string[:6].upper()!='COMMON': return
+ line = string[6:]
+ if not line or 'A'<=line[0].upper()<='Z' or line[0]=='_': return
+ line, repmap = string_replace_map(line.lstrip())
+ items = []
+ if line.startswith('/'):
+ i = line.find('/',1)
+ if i==-1: return
+ name = line[1:i].strip() or None
+ if name is not None: name = Common_Block_Name(name)
+ line = line[i+1:].lstrip()
+ i = line.find('/')
+ if i==-1:
+ lst = Common_Block_Object_List(repmap(line))
+ line = ''
+ else:
+ l = line[:i].rstrip()
+ if l.endswith(','): l = l[:-1].rstrip()
+ if not l: return
+ lst = Common_Block_Object_List(repmap(l))
+ line = line[i:].lstrip()
+ else:
+ name = None
+ i = line.find('/')
+ if i==-1:
+ lst = Common_Block_Object_List(repmap(line))
+ line = ''
+ else:
+ l = line[:i].rstrip()
+ if l.endswith(','): l = l[:-1].rstrip()
+ if not l: return
+ lst = Common_Block_Object_List(repmap(l))
+ line = line[i:].lstrip()
+ items.append((name, lst))
+ while line:
+ if line.startswith(','): line = line[1:].lstrip()
+ if not line.startswith('/'): return
+ i = line.find('/',1)
+ name = line[1:i].strip() or None
+ if name is not None: name = Common_Block_Name(name)
+ line = line[i+1:].lstrip()
+ i = line.find('/')
+ if i==-1:
+ lst = Common_Block_Object_List(repmap(line))
+ line = ''
+ else:
+ l = line[:i].rstrip()
+ if l.endswith(','): l = l[:-1].rstrip()
+ if not l: return
+ lst = Common_Block_Object_List(repmap(l))
+ line = line[i:].lstrip()
+ items.append((name, lst))
+ return items,
+ match = staticmethod(match)
+ def tostr(self):
+ s = 'COMMON'
+ for (name, lst) in self.items[0]:
+ if name is not None:
+ s += ' /%s/ %s' % (name, lst)
+ else:
+ s += ' // %s' % (lst)
+ return s
+
+class Common_Block_Object(CallBase): # R558
+ """
+ <common-block-object> = <variable-name> [ ( <explicit-shape-spec-list> ) ]
+ | <proc-pointer-name>
+ """
+ subclass_names = ['Proc_Pointer_Name','Variable_Name']
+ use_names = ['Variable_Name', 'Explicit_Shape_Spec_List']
+ def match(string): return CallBase.match(Variable_Name, Explicit_Shape_Spec_List, string, require_rhs=True)
+ match = staticmethod(match)
+
+###############################################################################
+############################### SECTION 6 ####################################
+###############################################################################
+
+class Variable(Base): # R601
+ """
+ <variable> = <designator>
+ """
+ subclass_names = ['Designator']
+
+class Variable_Name(Base): # R602
+ """
+ <variable-name> = <name>
+ """
+ subclass_names = ['Name']
+
+class Designator(Base): # R603
+ """
+ <designator> = <object-name>
+ | <array-element>
+ | <array-section>
+ | <structure-component>
+ | <substring>
+ <substring-range> = [ <scalar-int-expr> ] : [ <scalar-int-expr> ]
+ <structure-component> = <data-ref>
+ """
+ subclass_names = ['Object_Name','Array_Section','Array_Element','Structure_Component',
+ 'Substring'
+ ]
+
+class Logical_Variable(Base): # R604
+ """
+ <logical-variable> = <variable>
+ """
+ subclass_names = ['Variable']
+
+class Default_Logical_Variable(Base): # R605
+ """
+ <default-logical-variable> = <variable>
+ """
+ subclass_names = ['Variable']
+
+class Char_Variable(Base): # R606
+ """
+ <char-variable> = <variable>
+ """
+ subclass_names = ['Variable']
+
+class Default_Char_Variable(Base): # R607
+ """
+ <default-char-variable> = <variable>
+ """
+ subclass_names = ['Variable']
+
+
+class Int_Variable(Base): # R608
+ """
+ <int-variable> = <variable>
+ """
+ subclass_names = ['Variable']
+
+
+class Substring(CallBase): # R609
+ """
+ <substring> = <parent-string> ( <substring-range> )
+ """
+ subclass_names = []
+ use_names = ['Parent_String','Substring_Range']
+ def match(string): return CallBase.match(Parent_String, Substring_Range, string, require_rhs=True)
+ match = staticmethod(match)
+
+class Parent_String(Base): # R610
+ """
+ <parent-string> = <scalar-variable-name>
+ | <array-element>
+ | <scalar-structure-component>
+ | <scalar-constant>
+ """
+ subclass_names = ['Scalar_Variable_Name', 'Array_Element', 'Scalar_Structure_Component', 'Scalar_Constant']
+
+class Substring_Range(SeparatorBase): # R611
+ """
+ <substring-range> = [ <scalar-int-expr> ] : [ <scalar-int-expr> ]
+ """
+ subclass_names = []
+ use_names = ['Scalar_Int_Expr']
+ def match(string):
+ return SeparatorBase.match(Scalar_Int_Expr, Scalar_Int_Expr, string)
+ match = staticmethod(match)
+
+class Data_Ref(SequenceBase): # R612
+ """
+ <data-ref> = <part-ref> [ % <part-ref> ]...
+ """
+ subclass_names = ['Part_Ref']
+ use_names = []
+ def match(string): return SequenceBase.match(r'%', Part_Ref, string)
+ match = staticmethod(match)
+
+class Part_Ref(CallBase): # R613
+ """
+ <part-ref> = <part-name> [ ( <section-subscript-list> ) ]
+ """
+ subclass_names = ['Part_Name']
+ use_names = ['Section_Subscript_List']
+ def match(string):
+ return CallBase.match(Part_Name, Section_Subscript_List, string, require_rhs=True)
+ match = staticmethod(match)
+
+class Structure_Component(Base): # R614
+ """
+ <structure-component> = <data-ref>
+ """
+ subclass_names = ['Data_Ref']
+
+class Type_Param_Inquiry(BinaryOpBase): # R615
+ """
+ <type-param-inquiry> = <designator> % <type-param-name>
+ """
+ subclass_names = []
+ use_names = ['Designator','Type_Param_Name']
+ def match(string):
+ return BinaryOpBase.match(\
+ Designator, pattern.percent_op.named(), Type_Param_Name, string)
+ match = staticmethod(match)
+
+class Array_Element(Base): # R616
+ """
+ <array-element> = <data-ref>
+ """
+ subclass_names = ['Data_Ref']
+
+class Array_Section(CallBase): # R617
+ """
+ <array-section> = <data-ref> [ ( <substring-range> ) ]
+ """
+ subclass_names = ['Data_Ref']
+ use_names = ['Substring_Range']
+ def match(string): return CallBase.match(Data_Ref, Substring_Range, string, require_rhs=True)
+ match = staticmethod(match)
+
+class Subscript(Base): # R618
+ """
+ <subscript> = <scalar-int-expr>
+ """
+ subclass_names = ['Scalar_Int_Expr']
+
+class Section_Subscript(Base): # R619
+ """
+ <section-subscript> = <subscript>
+ | <subscript-triplet>
+ | <vector-subscript>
+ """
+ subclass_names = ['Subscript_Triplet', 'Vector_Subscript', 'Subscript']
+
+class Subscript_Triplet(Base): # R620
+ """
+ <subscript-triplet> = [ <subscript> ] : [ <subscript> ] [ : <stride> ]
+ """
+ subclass_names = []
+ use_names = ['Subscript','Stride']
+ def match(string):
+ line, repmap = string_replace_map(string)
+ t = line.split(':')
+ if len(t)<=1 or len(t)>3: return
+ lhs_obj,rhs_obj, stride_obj = None, None, None
+ if len(t)==2:
+ lhs,rhs = t[0].rstrip(),t[1].lstrip()
+ else:
+ lhs,rhs,stride = t[0].rstrip(),t[1].strip(),t[2].lstrip()
+ if stride:
+ stride_obj = Stride(repmap(stride))
+ if lhs:
+ lhs_obj = Subscript(repmap(lhs))
+ if rhs:
+ rhs_obj = Subscript(repmap(rhs))
+ return lhs_obj, rhs_obj, stride_obj
+ match = staticmethod(match)
+ def tostr(self):
+ s = ''
+ if self.items[0] is not None:
+ s += str(self.items[0]) + ' :'
+ else:
+ s += ':'
+ if self.items[1] is not None:
+ s += ' ' + str(self.items[1])
+ if self.items[2] is not None:
+ s += ' : ' + str(self.items[2])
+ return s
+
+class Stride(Base): # R621
+ """
+ <stride> = <scalar-int-expr>
+ """
+ subclass_names = ['Scalar_Int_Expr']
+
+class Vector_Subscript(Base): # R622
+ """
+ <vector-subscript> = <int-expr>
+ """
+ subclass_names = ['Int_Expr']
+
+class Allocate_Stmt(StmtBase): # R623
+ """
+ <allocate-stmt> = ALLOCATE ( [ <type-spec> :: ] <allocation-list> [ , <alloc-opt-list> ] )
+ """
+ subclass_names = []
+ use_names = ['Type_Spec', 'Allocation_List', 'Alloc_Opt_List']
+
+class Alloc_Opt(KeywordValueBase):# R624
+ """
+ <alloc-opt> = STAT = <stat-variable>
+ | ERRMSG = <errmsg-variable>
+ | SOURCE = <source-expr>
+ """
+ subclass_names = []
+ use_names = ['Stat_Variable', 'Errmsg_Variable', 'Source_Expr']
+ def match(string):
+ for (k,v) in [('STAT', Stat_Variable),
+ ('ERRMSG', Errmsg_Variable),
+ ('SOURCE', Source_Expr)
+ ]:
+ try:
+ obj = KeywordValueBase.match(k, v, string, upper_lhs = True)
+ except NoMatchError:
+ obj = None
+ if obj is not None: return obj
+ return
+ match = staticmethod(match)
+
+
+class Stat_Variable(Base):# R625
+ """
+ <stat-variable> = <scalar-int-variable>
+ """
+ subclass_names = ['Scalar_Int_Variable']
+
+class Errmsg_Variable(Base):# R626
+ """
+ <errmsg-variable> = <scalar-default-char-variable>
+ """
+ subclass_names = ['Scalar_Default_Char_Variable']
+
+class Source_Expr(Base):# R627
+ """
+ <source-expr> = <expr>
+ """
+ subclass_names = ['Expr']
+
+class Allocation(CallBase):# R628
+ """
+ <allocation> = <allocate-object> [ ( <allocate-shape-spec-list> ) ]
+ | <variable-name>
+ """
+ subclass_names = ['Variable_Name', 'Allocate_Object']
+ use_names = ['Allocate_Shape_Spec_List']
+ def match(string):
+ return CallBase.match(Allocate_Object, Allocate_Shape_Spec_List, string, require_rhs = True)
+ match = staticmethod(match)
+
+class Allocate_Object(Base): # R629
+ """
+ <allocate-object> = <variable-name>
+ | <structure-component>
+ """
+ subclass_names = ['Variable_Name', 'Structure_Component']
+
+class Allocate_Shape_Spec(SeparatorBase): # R630
+ """
+ <allocate-shape-spec> = [ <lower-bound-expr> : ] <upper-bound-expr>
+ """
+ subclass_names = []
+ use_names = ['Lower_Bound_Expr', 'Upper_Bound_Expr']
+ def match(string):
+ line, repmap = string_replace_map(string)
+ if ':' not in line: return None, Upper_Bound_Expr(string)
+ lower,upper = line.split(':',1)
+ lower = lower.rstrip()
+ upper = upper.lstrip()
+ if not upper: return
+ if not lower: return
+ return Lower_Bound_Expr(repmap(lower)), Upper_Bound_Expr(repmap(upper))
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[0] is None: return str(self.items[1])
+ return SeparatorBase.tostr(self)
+
+
+class Lower_Bound_Expr(Base): # R631
+ """
+ <lower-bound-expr> = <scalar-int-expr>
+ """
+ subclass_names = ['Scalar_Int_Expr']
+
+class Upper_Bound_Expr(Base): # R632
+ """
+ <upper-bound-expr> = <scalar-int-expr>
+ """
+ subclass_names = ['Scalar_Int_Expr']
+
+class Nullify_Stmt(StmtBase, CALLBase): # R633
+ """
+ <nullify-stmt> = NULLIFY ( <pointer-object-list> )
+ """
+ subclass_names = []
+ use_names = ['Pointer_Object_List']
+ def match(string): return CALLBase.match('NULLIFY', Pointer_Object_List, string, require_rhs=True)
+ match = staticmethod(match)
+
+class Pointer_Object(Base): # R634
+ """
+ <pointer-object> = <variable-name>
+ | <structure-component>
+ | <proc-pointer-name>
+ """
+ subclass_names = ['Variable_Name', 'Structure_Component', 'Proc_Pointer_Name']
+
+class Deallocate_Stmt(StmtBase): # R635
+ """
+ <deallocate-stmt> = DEALLOCATE ( <allocate-object-list> [ , <dealloc-opt-list> ] )
+ """
+ subclass_names = []
+ use_names = ['Allocate_Object_List', 'Dealloc_Opt_List']
+
+class Dealloc_Opt(KeywordValueBase): # R636
+ """
+ <dealloc-opt> = STAT = <stat-variable>
+ | ERRMSG = <errmsg-variable>
+ """
+ subclass_names = []
+ use_names = ['Stat_Variable', 'Errmsg_Variable']
+ def match(string):
+ for (k,v) in [('STAT', Stat_Variable),
+ ('ERRMSG', Errmsg_Variable),
+ ]:
+ try:
+ obj = KeywordValueBase.match(k, v, string, upper_lhs = True)
+ except NoMatchError:
+ obj = None
+ if obj is not None: return obj
+ return
+ match = staticmethod(match)
+
+class Scalar_Char_Initialization_Expr(Base):
+ subclass_names = ['Char_Initialization_Expr']
+
+###############################################################################
+############################### SECTION 7 ####################################
+###############################################################################
+
+class Primary(Base): # R701
+ """
+ <primary> = <constant>
+ | <designator>
+ | <array-constructor>
+ | <structure-constructor>
+ | <function-reference>
+ | <type-param-inquiry>
+ | <type-param-name>
+ | ( <expr> )
+ """
+ subclass_names = ['Constant', 'Parenthesis', 'Designator','Array_Constructor',
+ 'Structure_Constructor',
+ 'Function_Reference', 'Type_Param_Inquiry', 'Type_Param_Name',
+ ]
+
+class Parenthesis(BracketBase): # R701.h
+ """
+ <parenthesis> = ( <expr> )
+ """
+ subclass_names = []
+ use_names = ['Expr']
+ def match(string): return BracketBase.match('()', Expr, string)
+ match = staticmethod(match)
+
+class Level_1_Expr(UnaryOpBase): # R702
+ """
+ <level-1-expr> = [ <defined-unary-op> ] <primary>
+ <defined-unary-op> = . <letter> [ <letter> ]... .
+ """
+ subclass_names = ['Primary']
+ use_names = []
+ def match(string):
+ if pattern.non_defined_binary_op.match(string):
+ raise NoMatchError,'%s: %r' % (Level_1_Expr.__name__, string)
+ return UnaryOpBase.match(\
+ pattern.defined_unary_op.named(),Primary,string)
+ match = staticmethod(match)
+
+class Defined_Unary_Op(STRINGBase): # R703
+ """
+ <defined-unary-op> = . <letter> [ <letter> ]... .
+ """
+ subclass_names = ['Defined_Op']
+
+
+class Defined_Op(STRINGBase): # R703, 723
+ """
+ <defined-op> = . <letter> [ <letter> ]... .
+ """
+ subclass_names = []
+ def match(string):
+ if pattern.non_defined_binary_op.match(string):
+ raise NoMatchError,'%s: %r' % (Defined_Unary_Op.__name__, string)
+ return STRINGBase.match(pattern.abs_defined_op, string)
+ match = staticmethod(match)
+
+class Mult_Operand(BinaryOpBase): # R704
+ """
+ <mult-operand> = <level-1-expr> [ <power-op> <mult-operand> ]
+ <power-op> = **
+ """
+ subclass_names = ['Level_1_Expr']
+ use_names = ['Mult_Operand']
+ def match(string):
+ return BinaryOpBase.match(\
+ Level_1_Expr,pattern.power_op.named(),Mult_Operand,string,right=False)
+ match = staticmethod(match)
+
+class Add_Operand(BinaryOpBase): # R705
+ """
+ <add-operand> = [ <add-operand> <mult-op> ] <mult-operand>
+ <mult-op> = *
+ | /
+ """
+ subclass_names = ['Mult_Operand']
+ use_names = ['Add_Operand','Mult_Operand']
+ def match(string):
+ return BinaryOpBase.match(Add_Operand,pattern.mult_op.named(),Mult_Operand,string)
+ match = staticmethod(match)
+
+class Level_2_Expr(BinaryOpBase): # R706
+ """
+ <level-2-expr> = [ [ <level-2-expr> ] <add-op> ] <add-operand>
+ <level-2-expr> = [ <level-2-expr> <add-op> ] <add-operand>
+ | <level-2-unary-expr>
+ <add-op> = +
+ | -
+ """
+ subclass_names = ['Level_2_Unary_Expr']
+ use_names = ['Level_2_Expr']
+ def match(string):
+ return BinaryOpBase.match(\
+ Level_2_Expr,pattern.add_op.named(),Add_Operand,string)
+ match = staticmethod(match)
+
+class Level_2_Unary_Expr(UnaryOpBase): # R706.c
+ """
+ <level-2-unary-expr> = [ <add-op> ] <add-operand>
+ """
+ subclass_names = ['Add_Operand']
+ use_names = []
+ def match(string): return UnaryOpBase.match(pattern.add_op.named(),Add_Operand,string)
+ match = staticmethod(match)
+
+#R707: <power-op> = **
+#R708: <mult-op> = * | /
+#R709: <add-op> = + | -
+
+class Level_3_Expr(BinaryOpBase): # R710
+ """
+ <level-3-expr> = [ <level-3-expr> <concat-op> ] <level-2-expr>
+ <concat-op> = //
+ """
+ subclass_names = ['Level_2_Expr']
+ use_names =['Level_3_Expr']
+ def match(string):
+ return BinaryOpBase.match(\
+ Level_3_Expr,pattern.concat_op.named(),Level_2_Expr,string)
+ match = staticmethod(match)
+
+#R711: <concat-op> = //
+
+class Level_4_Expr(BinaryOpBase): # R712
+ """
+ <level-4-expr> = [ <level-3-expr> <rel-op> ] <level-3-expr>
+ <rel-op> = .EQ. | .NE. | .LT. | .LE. | .GT. | .GE. | == | /= | < | <= | > | >=
+ """
+ subclass_names = ['Level_3_Expr']
+ use_names = []
+ def match(string):
+ return BinaryOpBase.match(\
+ Level_3_Expr,pattern.rel_op.named(),Level_3_Expr,string)
+ match = staticmethod(match)
+
+#R713: <rel-op> = .EQ. | .NE. | .LT. | .LE. | .GT. | .GE. | == | /= | < | <= | > | >=
+
+class And_Operand(UnaryOpBase): # R714
+ """
+ <and-operand> = [ <not-op> ] <level-4-expr>
+ <not-op> = .NOT.
+ """
+ subclass_names = ['Level_4_Expr']
+ use_names = []
+ def match(string):
+ return UnaryOpBase.match(\
+ pattern.not_op.named(),Level_4_Expr,string)
+ match = staticmethod(match)
+
+class Or_Operand(BinaryOpBase): # R715
+ """
+ <or-operand> = [ <or-operand> <and-op> ] <and-operand>
+ <and-op> = .AND.
+ """
+ subclass_names = ['And_Operand']
+ use_names = ['Or_Operand','And_Operand']
+ def match(string):
+ return BinaryOpBase.match(\
+ Or_Operand,pattern.and_op.named(),And_Operand,string)
+ match = staticmethod(match)
+
+class Equiv_Operand(BinaryOpBase): # R716
+ """
+ <equiv-operand> = [ <equiv-operand> <or-op> ] <or-operand>
+ <or-op> = .OR.
+ """
+ subclass_names = ['Or_Operand']
+ use_names = ['Equiv_Operand']
+ def match(string):
+ return BinaryOpBase.match(\
+ Equiv_Operand,pattern.or_op.named(),Or_Operand,string)
+ match = staticmethod(match)
+
+
+class Level_5_Expr(BinaryOpBase): # R717
+ """
+ <level-5-expr> = [ <level-5-expr> <equiv-op> ] <equiv-operand>
+ <equiv-op> = .EQV.
+ | .NEQV.
+ """
+ subclass_names = ['Equiv_Operand']
+ use_names = ['Level_5_Expr']
+ def match(string):
+ return BinaryOpBase.match(\
+ Level_5_Expr,pattern.equiv_op.named(),Equiv_Operand,string)
+ match = staticmethod(match)
+
+#R718: <not-op> = .NOT.
+#R719: <and-op> = .AND.
+#R720: <or-op> = .OR.
+#R721: <equiv-op> = .EQV. | .NEQV.
+
+class Expr(BinaryOpBase): # R722
+ """
+ <expr> = [ <expr> <defined-binary-op> ] <level-5-expr>
+ <defined-binary-op> = . <letter> [ <letter> ]... .
+ TODO: defined_binary_op must not be intrinsic_binary_op!!
+ """
+ subclass_names = ['Level_5_Expr']
+ use_names = ['Expr']
+ def match(string):
+ return BinaryOpBase.match(Expr, pattern.defined_binary_op.named(), Level_5_Expr,
+ string)
+ match = staticmethod(match)
+
+class Defined_Unary_Op(STRINGBase): # R723
+ """
+ <defined-unary-op> = . <letter> [ <letter> ]... .
+ """
+ subclass_names = ['Defined_Op']
+
+class Logical_Expr(Base): # R724
+ """
+ <logical-expr> = <expr>
+ """
+ subclass_names = ['Expr']
+
+class Char_Expr(Base): # R725
+ """
+ <char-expr> = <expr>
+ """
+ subclass_names = ['Expr']
+
+class Default_Char_Expr(Base): # R726
+ """
+ <default-char-expr> = <expr>
+ """
+ subclass_names = ['Expr']
+
+class Int_Expr(Base): # R727
+ """
+ <int-expr> = <expr>
+ """
+ subclass_names = ['Expr']
+
+class Numeric_Expr(Base): # R728
+ """
+ <numeric-expr> = <expr>
+ """
+ subclass_names = ['Expr']
+
+class Specification_Expr(Base): # R729
+ """
+ <specification-expr> = <scalar-int-expr>
+ """
+ subclass_names = ['Scalar_Int_Expr']
+
+class Initialization_Expr(Base): # R730
+ """
+ <initialization-expr> = <expr>
+ """
+ subclass_names = ['Expr']
+
+class Char_Initialization_Expr(Base): # R731
+ """
+ <char-initialization-expr> = <char-expr>
+ """
+ subclass_names = ['Char_Expr']
+
+class Int_Initialization_Expr(Base): # R732
+ """
+ <int-initialization-expr> = <int-expr>
+ """
+ subclass_names = ['Int_Expr']
+
+class Logical_Initialization_Expr(Base): # R733
+ """
+ <logical-initialization-expr> = <logical-expr>
+ """
+ subclass_names = ['Logical_Expr']
+
+class Assignment_Stmt(StmtBase, BinaryOpBase): # R734
+ """
+ <assignment-stmt> = <variable> = <expr>
+ """
+ subclass_names = []
+ use_names = ['Variable', 'Expr']
+ def match(string):
+ return BinaryOpBase.match(Variable, '=', Expr, string, right=False)
+ match = staticmethod(match)
+
+class Pointer_Assignment_Stmt(StmtBase): # R735
+ """
+ <pointer-assignment-stmt> = <data-pointer-object> [ ( <bounds-spec-list> ) ] => <data-target>
+ | <data-pointer-object> ( <bounds-remapping-list> ) => <data-target>
+ | <proc-pointer-object> => <proc-target>
+ """
+ subclass_names = []
+ use_names = ['Data_Pointer_Object', 'Bounds_Spec_List', 'Data_Target', 'Bounds_Remapping_List',
+ 'Proc_Pointer_Object', 'Proc_Target']
+
+class Data_Pointer_Object(BinaryOpBase): # R736
+ """
+ <data-pointer-object> = <variable-name>
+ | <variable> % <data-pointer-component-name>
+ """
+ subclass_names = ['Variable_Name']
+ use_names = ['Variable', 'Data_Pointer_Component_Name']
+ def match(string):
+ return BinaryOpBase.match(Variable, r'%', Data_Pointer_Component_Name, string)
+ match = staticmethod(match)
+
+class Bounds_Spec(SeparatorBase): # R737
+ """
+ <bounds-spec> = <lower-bound-expr> :
+ """
+ subclass_names = []
+ use_names = ['Lower_Bound_Expr']
+ def match(string): return SeparatorBase.match(Lower_Bound_Expr, None, string, require_lhs=True)
+ match = staticmethod(match)
+
+class Bounds_Remapping(SeparatorBase): # R738
+ """
+ <bounds-remapping> = <lower-bound-expr> : <upper-bound-expr>
+ """
+ subclass_names = []
+ use_classes = ['Lower_Bound_Expr', 'Upper_Bound_Expr']
+ def match(string): return SeparatorBase.match(Lower_Bound_Expr, Upper_Bound_Expr, string, require_lhs=True, require_rhs=True)
+ match = staticmethod(match)
+
+class Data_Target(Base): # R739
+ """
+ <data-target> = <variable>
+ | <expr>
+ """
+ subclass_names = ['Variable','Expr']
+
+class Proc_Pointer_Object(Base): # R740
+ """
+ <proc-pointer-object> = <proc-pointer-name>
+ | <proc-component-ref>
+ """
+ subclass_names = ['Proc_Pointer_Name', 'Proc_Component_Ref']
+
+class Proc_Component_Ref(BinaryOpBase): # R741
+ """
+ <proc-component-ref> = <variable> % <procedure-component-name>
+ """
+ subclass_names = []
+ use_names = ['Variable','Procedure_Component_Name']
+ def match(string):
+ return BinaryOpBase.match(Variable, r'%', Procedure_Component_Name, string)
+ match = staticmethod(match)
+
+class Proc_Target(Base): # R742
+ """
+ <proc-target> = <expr>
+ | <procedure-name>
+ | <proc-component-ref>
+ """
+ subclass_names = ['Proc_Component_Ref', 'Procedure_Name', 'Expr']
+
+
+class Where_Stmt(StmtBase): # R743
+ """
+ <where-stmt> = WHERE ( <mask-expr> ) <where-assignment-stmt>
+ """
+ subclass_names = []
+ use_names = ['Mask_Expr', 'Where_Assignment_Stmt']
+ def match(string):
+ if string[:5].upper()!='WHERE': return
+ line, repmap = string_replace_map(string[5:].lstrip())
+ if not line.startswith('('): return
+ i = line.find(')')
+ if i==-1: return
+ stmt = repmap(line[i+1:].lstrip())
+ if not stmt: return
+ expr = repmap(line[1:i].strip())
+ if not expr: return
+ return Mask_Expr(expr), Where_Assignment_Stmt(stmt)
+ match = staticmethod(match)
+ def tostr(self): return 'WHERE (%s) %s' % tuple(self.items)
+
+
+class Where_Construct(Base): # R744
+ """
+ <where-construct> = <where-construct-stmt>
+ [ <where-body-construct> ]...
+ [ <masked-elsewhere-stmt>
+ [ <where-body-construct> ]...
+ ]...
+ [ <elsewhere-stmt>
+ [ <where-body-construct> ]... ]
+ <end-where-stmt>
+ """
+ subclass_names = []
+ use_names = ['Where_Construct_Stmt', 'Where_Body_Construct',
+ 'Elsewhere_Stmt', 'End_Where_Stmt'
+ ]
+
+class Where_Construct_Stmt(StmtBase): # R745
+ """
+ <where-construct-stmt> = [ <where-construct-name> : ] WHERE ( <mask-expr> )
+ """
+ subclass_names = []
+ use_names = ['Where_Construct_Name', 'Mask_Expr']
+
+ def match(string):
+ if string[:5].upper()!='WHERE': return
+ line = string[5:].lstrip()
+ if not line: return
+ if line[0]+line[-1] != '()': return
+ line = line[1:-1].strip()
+ if not line: return
+ return Mask_Expr(line),
+ match = staticmethod(match)
+ def tostr(self): return 'WHERE (%s)' % tuple(self.items)
+
+class Where_Body_Construct(Base): # R746
+ """
+ <where-body-construct> = <where-assignment-stmt>
+ | <where-stmt>
+ | <where-construct>
+ """
+ subclass_names = ['Where_Assignment_Stmt', 'Where_Stmt', 'Where_Construct']
+
+class Where_Assignment_Stmt(Base): # R747
+ """
+ <where-assignment-stmt> = <assignment-stmt>
+ """
+ subclass_names = ['Assignment_Stmt']
+
+class Mask_Expr(Base): # R748
+ """
+ <mask-expr> = <logical-expr>
+ """
+ subclass_names = ['Logical_Expr']
+
+class Masked_Elsewhere_Stmt(StmtBase): # R749
+ """
+ <masked-elsewhere-stmt> = ELSEWHERE ( <mask-expr> ) [ <where-construct-name> ]
+ """
+ subclass_names = []
+ use_names = ['Mask_Expr', 'Where_Construct_Name']
+ def match(string):
+ if string[:9].upper()!='ELSEWHERE': return
+ line = string[9:].lstrip()
+ if not line.startswith('('): return
+ i = line.rfind(')')
+ if i==-1: return
+ expr = line[1:i].strip()
+ if not expr: return
+ line = line[i+1:].rstrip()
+ if line:
+ return Mask_Expr(expr), Where_Construct_Name(line)
+ return Mask_Expr(expr), None
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[1] is None: return 'ELSEWHERE(%s)' % (self.items[0])
+ return 'ELSEWHERE(%s) %s' % self.items
+
+class Elsewhere_Stmt(StmtBase, WORDClsBase): # R750
+ """
+ <elsewhere-stmt> = ELSEWHERE [ <where-construct-name> ]
+ """
+ subclass_names = []
+ use_names = ['Where_Construct_Name']
+ def match(string): return WORDClsBase.match('ELSEWHERE', Where_Construct_Name, string)
+ match = staticmethod(match)
+
+class End_Where_Stmt(EndStmtBase): # R751
+ """
+ <end-where-stmt> = END WHERE [ <where-construct-name> ]
+ """
+ subclass_names = []
+ use_names = ['Where_Construct_Name']
+ def match(string): return EndStmtBase.match('WHERE',Where_Construct_Name, string, require_stmt_type=True)
+ match = staticmethod(match)
+
+
+class Forall_Construct(Base): # R752
+ """
+ <forall-construct> = <forall-construct-stmt>
+ [ <forall-body-construct> ]...
+ <end-forall-stmt>
+ """
+ subclass_names = []
+ use_names = ['Forall_Construct_Stmt', 'Forall_Body_Construct', 'End_Forall_Stmt']
+
+class Forall_Construct_Stmt(StmtBase, WORDClsBase): # R753
+ """
+ <forall-construct-stmt> = [ <forall-construct-name> : ] FORALL <forall-header>
+ """
+ subclass_names = []
+ use_names = ['Forall_Construct_Name', 'Forall_Header']
+ def match(string): return WORDClsBase.match('FORALL', Forall_Header, string, require_cls = True)
+ match = staticmethod(match)
+
+class Forall_Header(Base): # R754
+ """
+ <forall-header> = ( <forall-triplet-spec-list> [ , <scalar-mask-expr> ] )
+ """
+ subclass_names = []
+ use_names = ['Forall_Triplet_Spec_List', 'Scalar_Mask_Expr']
+
+class Forall_Triplet_Spec(Base): # R755
+ """
+ <forall-triplet-spec> = <index-name> = <subscript> : <subscript> [ : <stride> ]
+ """
+ subclass_names = []
+ use_names = ['Index_Name', 'Subscript', 'Stride']
+
+class Forall_Body_Construct(Base): # R756
+ """
+ <forall-body-construct> = <forall-assignment-stmt>
+ | <where-stmt>
+ | <where-construct>
+ | <forall-construct>
+ | <forall-stmt>
+ """
+ subclass_names = ['Forall_Assignment_Stmt', 'Where_Stmt', 'Where_Construct',
+ 'Forall_Construct', 'Forall_Stmt']
+
+class Forall_Assignment_Stmt(Base): # R757
+ """
+ <forall-assignment-stmt> = <assignment-stmt>
+ | <pointer-assignment-stmt>
+ """
+ subclass_names = ['Assignment_Stmt', 'Pointer_Assignment_Stmt']
+
+class End_Forall_Stmt(EndStmtBase): # R758
+ """
+ <end-forall-stmt> = END FORALL [ <forall-construct-name> ]
+ """
+ subclass_names = []
+ use_names = ['Forall_Construct_Name']
+ def match(string): return EndStmtBase.match('FORALL',Forall_Construct_Name, string, require_stmt_type=True)
+ match = staticmethod(match)
+
+class Forall_Stmt(StmtBase): # R759
+ """
+ <forall-stmt> = FORALL <forall-header> <forall-assignment-stmt>
+ """
+ subclass_names = []
+ use_names = ['Forall_Header', 'Forall_Assignment_Stmt']
+ def match(string):
+ if string[:6].upper()!='FORALL': return
+ line, repmap = string_replace_map(string[6:].lstrip())
+ if not line.startswith(')'): return
+ i = line.find(')')
+ if i==-1: return
+ header = repmap(line[1:i].strip())
+ if not header: return
+ line = repmap(line[i+1:].lstrip())
+ if not line: return
+ return Forall_Header(header), Forall_Assignment_Stmt(line)
+ match = staticmethod(match)
+ def tostr(self): return 'FORALL %s %s' % self.items
+
+###############################################################################
+############################### SECTION 8 ####################################
+###############################################################################
+
+class Block(BlockBase): # R801
+ """
+ block = [ <execution-part-construct> ]...
+ """
+ subclass_names = []
+ use_names = ['Execution_Part_Construct']
+ def match(string): return BlockBase.match(None, [Execution_Part_Construct], None, string)
+ match = staticmethod(match)
+
+class If_Construct(BlockBase): # R802
+ """
+ <if-construct> = <if-then-stmt>
+ <block>
+ [ <else-if-stmt>
+ <block>
+ ]...
+ [ <else-stmt>
+ <block>
+ ]
+ <end-if-stmt>
+ """
+ subclass_names = []
+ use_names = ['If_Then_Stmt', 'Block', 'Else_If_Stmt', 'Else_Stmt', 'End_If_Stmt']
+
+ def match(reader):
+ content = []
+ try:
+ obj = If_Then_Stmt(reader)
+ except NoMatchError:
+ obj = None
+ if obj is None: return
+ content.append(obj)
+ obj = Block(reader)
+ if obj is None: return # todo: restore reader
+ content.append(obj)
+ while 1:
+ try:
+ obj = Else_If_Stmt(reader)
+ except NoMatchError:
+ obj = None
+ if obj is not None:
+ content.append(obj)
+ obj = Block(reader)
+ if obj is None: return # todo: restore reader
+ content.append(obj)
+ continue
+ try:
+ obj = Else_Stmt(reader)
+ except NoMatchError:
+ obj = None
+ if obj is not None:
+ content.append(obj)
+ obj = Block(reader)
+ if obj is None: return # todo: restore reader
+ content.append(obj)
+ break
+ try:
+ obj = End_If_Stmt(reader)
+ except NoMatchError:
+ obj = None
+ if obj is None: return # todo: restore reader
+ content.append(obj)
+ return content,
+ match = staticmethod(match)
+
+ def tofortran(self, tab='', isfix=None):
+ l = []
+ start = self.content[0]
+ end = self.content[-1]
+ l.append(start.tofortran(tab=tab,isfix=isfix))
+ for item in self.content[1:-1]:
+ if isinstance(item, (Else_If_Stmt, Else_Stmt)):
+ l.append(item.tofortran(tab=tab,isfix=isfix))
+ else:
+ l.append(item.tofortran(tab=tab+' ',isfix=isfix))
+ l.append(end.tofortran(tab=tab,isfix=isfix))
+ return '\n'.join(l)
+
+
+class If_Then_Stmt(StmtBase): # R803
+ """
+ <if-then-stmt> = [ <if-construct-name> : ] IF ( <scalar-logical-expr> ) THEN
+ """
+ subclass_names = []
+ use_names = ['If_Construct_Name', 'Scalar_Logical_Expr']
+ def match(string):
+ if string[:2].upper()!='IF': return
+ if string[-4:].upper()!='THEN': return
+ line = string[2:-4].strip()
+ if not line: return
+ if line[0]+line[-1]!='()': return
+ return Scalar_Logical_Expr(line[1:-1].strip()),
+ match = staticmethod(match)
+ def tostr(self): return 'IF (%s) THEN' % self.items
+
+class Else_If_Stmt(StmtBase): # R804
+ """
+ <else-if-stmt> = ELSE IF ( <scalar-logical-expr> ) THEN [ <if-construct-name> ]
+ """
+ subclass_names = []
+ use_names = ['Scalar_Logical_Expr', 'If_Construct_Name']
+
+ def match(string):
+ if string[:4].upper()!='ELSE': return
+ line = string[4:].lstrip()
+ if line[:2].upper()!='IF': return
+ line = line[2:].lstrip()
+ if not line.startswith('('): return
+ i = line.rfind(')')
+ if i==-1: return
+ expr = line[1:i].strip()
+ line = line[i+1:].lstrip()
+ if line[:4].upper()!='THEN': return
+ line = line[4:].lstrip()
+ if line: return Scalar_Logical_Expr(expr), If_Construct_Name(line)
+ return Scalar_Logical_Expr(expr), None
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[1] is None:
+ return 'ELSE IF (%s) THEN' % (self.items[0])
+ return 'ELSE IF (%s) THEN %s' % self.items
+
+class Else_Stmt(StmtBase): # R805
+ """
+ <else-stmt> = ELSE [ <if-construct-name> ]
+ """
+ subclass_names = []
+ use_names = ['If_Construct_Name']
+ def match(string):
+ if string[:4].upper()!='ELSE': return
+ line = string[4:].lstrip()
+ if line: return If_Construct_Name(line),
+ return None,
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[0] is None:
+ return 'ELSE'
+ return 'ELSE %s' % self.items
+
+class End_If_Stmt(EndStmtBase): # R806
+ """
+ <end-if-stmt> = END IF [ <if-construct-name> ]
+ """
+ subclass_names = []
+ use_names = ['If_Construct_Name']
+ def match(string): return EndStmtBase.match('IF',If_Construct_Name, string, require_stmt_type=True)
+ match = staticmethod(match)
+
+class If_Stmt(StmtBase): # R807
+ """
+ <if-stmt> = IF ( <scalar-logical-expr> ) <action-stmt>
+ """
+ subclass_names = []
+ use_names = ['Scalar_Logical_Expr', 'Action_Stmt_C802']
+ def match(string):
+ if string[:2].upper() != 'IF': return
+ line, repmap = string_replace_map(string)
+ line = line[2:].lstrip()
+ if not line.startswith('('): return
+ i = line.find(')')
+ if i==-1: return
+ expr = repmap(line[1:i].strip())
+ stmt = repmap(line[i+1:].lstrip())
+ return Scalar_Logical_Expr(expr), Action_Stmt_C802(stmt)
+ match = staticmethod(match)
+ def tostr(self): return 'IF (%s) %s' % self.items
+
+class Case_Construct(Base): # R808
+ """
+ <case-construct> = <select-case-stmt>
+ [ <case-stmt>
+ <block>
+ ]..
+ <end-select-stmt>
+ """
+ subclass_names = []
+ use_names = ['Select_Case_Stmt', 'Case_Stmt', 'End_Select_Stmt']
+
+class Select_Case_Stmt(StmtBase, CALLBase): # R809
+ """
+ <select-case-stmt> = [ <case-construct-name> : ] SELECT CASE ( <case-expr> )
+ """
+ subclass_names = []
+ use_names = ['Case_Construct_Name', 'Case_Expr']
+ def match(string): return CALLBase.match(pattter.abs_select_case, Case_Expr, string)
+ match = staticmethod(match)
+
+class Case_Stmt(StmtBase): # R810
+ """
+ <case-stmt> = CASE <case-selector> [ <case-construct-name> ]
+ """
+ subclass_names = []
+ use_names = ['Case_Selector', 'Case_Construct_Name']
+
+class End_Select_Stmt(EndStmtBase): # R811
+ """
+ <end-select-stmt> = END SELECT [ <case-construct-name> ]
+ """
+ subclass_names = []
+ use_names = ['Case_Construct_Name']
+ def match(string): return EndStmtBase.match('SELECT',Case_Construct_Name, string, require_stmt_type=True)
+ match = staticmethod(match)
+
+class Case_Expr(Base): # R812
+ """
+ <case-expr> = <scalar-int-expr>
+ | <scalar-char-expr>
+ | <scalar-logical-expr>
+ """
+ subclass_names = []
+ subclass_names = ['Scalar_Int_Expr', 'Scalar_Char_Expr', 'Scalar_Logical_Expr']
+
+class Case_Selector(Base): # R813
+ """
+ <case-selector> = ( <case-value-range-list> )
+ | DEFAULT
+ """
+ subclass_names = []
+ use_names = ['Case_Value_Range_List']
+
+class Case_Value_Range(SeparatorBase): # R814
+ """
+ <case-value-range> = <case-value>
+ | <case-value> :
+ | : <case-value>
+ | <case-value> : <case-value>
+ """
+ subclass_names = ['Case_Value']
+ def match(string): return SeparatorBase.match(Case_Value, Case_Value, string)
+ match = staticmethod(match)
+
+class Case_Value(Base): # R815
+ """
+ <case-value> = <scalar-int-initialization-expr>
+ | <scalar-char-initialization-expr>
+ | <scalar-logical-initialization-expr>
+ """
+ subclass_names = ['Scalar_Int_Initialization_Expr', 'Scalar_Char_Initialization_Expr', 'Scalar_Logical_Initialization_Expr']
+
+
+class Associate_Construct(Base): # R816
+ """
+ <associate-construct> = <associate-stmt>
+ <block>
+ <end-associate-stmt>
+ """
+ subclass_names = []
+ use_names = ['Associate_Stmt', 'Block', 'End_Associate_Stmt']
+
+class Associate_Stmt(StmtBase, CALLBase): # R817
+ """
+ <associate-stmt> = [ <associate-construct-name> : ] ASSOCIATE ( <association-list> )
+ """
+ subclass_names = []
+ use_names = ['Associate_Construct_Name', 'Association_List']
+ def match(string): return CALLBase.match('ASSOCIATE', Association_List, string)
+ match = staticmethod(match)
+
+class Association(BinaryOpBase): # R818
+ """
+ <association> = <associate-name> => <selector>
+ """
+ subclass_names = []
+ use_names = ['Associate_Name', 'Selector']
+ def match(string): return BinaryOpBase.match(Assiciate_Name, '=>', Selector, string)
+ match = staticmethod(match)
+
+class Selector(Base): # R819
+ """
+ <selector> = <expr>
+ | <variable>
+ """
+ subclass_names = ['Expr', 'Variable']
+
+class End_Associate_Stmt(EndStmtBase): # R820
+ """
+ <end-associate-stmt> = END ASSOCIATE [ <associate-construct-name> ]
+ """
+ subclass_names = []
+ use_names = ['Associate_Construct_Name']
+ def match(string): return EndStmtBase.match('ASSOCIATE',Associate_Construct_Name, string, require_stmt_type=True)
+ match = staticmethod(match)
+
+class Select_Type_Construct(Base): # R821
+ """
+ <select-type-construct> = <select-type-stmt>
+ [ <type-guard-stmt>
+ <block>
+ ]...
+ <end-select-type-stmt>
+ """
+ subclass_names = []
+ use_names = ['Select_Type_Stmt', 'Type_Guard_Stmt', 'Block', 'End_Select_Type_Stmt']
+
+class Select_Type_Stmt(StmtBase): # R822
+ """
+ <select-type-stmt> = [ <select-construct-name> : ] SELECT TYPE ( [ <associate-name> => ] <selector> )
+ """
+ subclass_names = []
+ use_names = ['Select_Construct_Name', 'Associate_Name', 'Selector']
+
+class Type_Guard_Stmt(StmtBase): # R823
+ """
+ <type-guard-stmt> = TYPE IS ( <type-spec> ) [ <select-construct-name> ]
+ | CLASS IS ( <type-spec> ) [ <select-construct-name> ]
+ | CLASS DEFAULT [ <select-construct-name> ]
+ """
+ subclass_names = []
+ use_names = ['Type_Spec', 'Select_Construct_Name']
+ def match(string):
+ if string[:4].upper()=='TYPE':
+ line = string[4:].lstrip()
+ if not line[:2].upper()=='IS': return
+ line = line[2:].lstrip()
+ kind = 'TYPE IS'
+ elif string[:5].upper()=='CLASS':
+ line = string[5:].lstrip()
+ if line[:2].upper()=='IS':
+ line = line[2:].lstrip()
+ kind = 'CLASS IS'
+ elif line[:7].upper()=='DEFAULT':
+ line = line[7:].lstrip()
+ if line:
+ if isalnum(line[0]): return
+ return 'CLASS DEFAULT', None, Select_Construct_Name(line)
+ return 'CLASS DEFAULT', None, None
+ else:
+ return
+ else:
+ return
+ if not line.startswith('('): return
+ i = line.rfind(')')
+ if i==-1: return
+ l = line[1:i].strip()
+ if not l: return
+ line = line[i+1:].lstrip()
+ if line:
+ return kind, Type_Spec(l), Select_Construct_Name(line)
+ return kind, Type_Spec(l), None
+ match = staticmethod(match)
+ def tostr(self):
+ s = str(self.items[0])
+ if self.items[1] is not None:
+ s += ' (%s)' % (self.items[0])
+ if self.items[2] is not None:
+ s += ' %s' % (self.items[2])
+ return s
+
+class End_Select_Type_Stmt(EndStmtBase): # R824
+ """
+ <end-select-type-stmt> = END SELECT [ <select-construct-name> ]
+ """
+ subclass_names = []
+ use_names = ['Select_Construct_Name']
+ def match(string): return EndStmtBase.match('SELECT',Select_Construct_Name, string, require_stmt_type=True)
+ match = staticmethod(match)
+
+class Do_Construct(Base): # R825
+ """
+ <do-construct> = <block-do-construct>
+ | <nonblock-do-construct>
+ """
+ subclass_names = ['Block_Do_Construct', 'Nonblock_Do_Construct']
+
+class Block_Do_Construct(BlockBase): # R826
+ """
+ <block-do-construct> = <do-stmt>
+ <do-block>
+ <end-do>
+ """
+ subclass_names = []
+ use_names = ['Do_Stmt', 'Do_Block', 'End_Do']
+ def match(reader):
+ assert isinstance(reader,FortranReaderBase),`reader`
+ content = []
+ try:
+ obj = Do_Stmt(reader)
+ except NoMatchError:
+ obj = None
+ if obj is None: return
+ content.append(obj)
+ if isinstance(obj, Label_Do_Stmt):
+ label = str(obj.dolabel)
+ while 1:
+ try:
+ obj = Execution_Part_Construct(reader)
+ except NoMatchError:
+ obj = None
+ if obj is None: break
+ content.append(obj)
+ if isinstance(obj, Continue_Stmt) and obj.item.label==label:
+ return content,
+ return
+ raise RuntimeError,'Expected continue stmt with specified label'
+ else:
+ obj = End_Do(reader)
+ content.append(obj)
+ raise NotImplementedError
+ return content,
+ match = staticmethod(match)
+
+ def tofortran(self, tab='', isfix=None):
+ if not isinstance(self.content[0], Label_Do_Stmt):
+ return BlockBase.tofortran(tab, isfix)
+ l = []
+ start = self.content[0]
+ end = self.content[-1]
+ extra_tab = ' '
+ l.append(start.tofortran(tab=tab,isfix=isfix))
+ for item in self.content[1:-1]:
+ l.append(item.tofortran(tab=tab+extra_tab,isfix=isfix))
+ if len(self.content)>1:
+ l.append(end.tofortran(tab=tab,isfix=isfix))
+ return '\n'.join(l)
+
+class Do_Stmt(Base): # R827
+ """
+ <do-stmt> = <label-do-stmt>
+ | <nonlabel-do-stmt>
+ """
+ subclass_names = ['Label_Do_Stmt', 'Nonlabel_Do_Stmt']
+
+class Label_Do_Stmt(StmtBase): # R828
+ """
+ <label-do-stmt> = [ <do-construct-name> : ] DO <label> [ <loop-control> ]
+ """
+ subclass_names = []
+ use_names = ['Do_Construct_Name', 'Label', 'Loop_Control']
+ def match(string):
+ if string[:2].upper()!='DO': return
+ line = string[2:].lstrip()
+ m = pattern.label.match(line)
+ if m is None: return
+ label = m.group()
+ line = line[m.end():].lstrip()
+ if line: return Label(label), Loop_Control(line)
+ return Label(label), None
+ match = staticmethod(match)
+ def tostr(self):
+ if self.itens[1] is None: return 'DO %s' % (self.items[0])
+ return 'DO %s %s' % self.items
+
+class Nonlabel_Do_Stmt(StmtBase, WORDClsBase): # R829
+ """
+ <nonlabel-do-stmt> = [ <do-construct-name> : ] DO [ <loop-control> ]
+ """
+ subclass_names = []
+ use_names = ['Do_Construct_Name', 'Loop_Control']
+ def match(string): return WORDClsBase.match('DO', Loop_Control, string)
+ match = staticmethod(match)
+
+class Loop_Control(Base): # R830
+ """
+ <loop-control> = [ , ] <do-variable> = <scalar-int-expr> , <scalar-int-expr> [ , <scalar-int-expr> ]
+ | [ , ] WHILE ( <scalar-logical-expr> )
+ """
+ subclass_names = []
+ use_names = ['Do_Variable', 'Scalar_Int_Expr', 'Scalar_Logical_Expr']
+ def match(string):
+ if string.startswith(','):
+ line, repmap = string_replace_map(string[1:].lstrip())
+ else:
+ line, repmap = string_replace_map(string)
+ if line[:5].upper()=='WHILE' and line[5:].lstrip().startswith('('):
+ l = line[5:].lstrip()
+ i = l.find(')')
+ if i!=-1 and i==len(l)-1:
+ return Scalar_Logical_Expr(repmap(l[1:i].strip())),
+ if line.count('=')!=1: return
+ var,rhs = line.split('=')
+ rhs = [s.strip() for s in rhs.lstrip().split(',')]
+ if not 2<=len(rhs)<=3: return
+ return Variable(repmap(var.rstrip())),map(Scalar_Int_Expr, map(repmap,rhs))
+ match = staticmethod(match)
+ def tostr(self):
+ if len(self.items)==1: return ', WHILE (%s)' % (self.items[0])
+ return ', %s = %s' % (self.items[0], ', '.join(map(str,self.items[1])))
+
+class Do_Variable(Base): # R831
+ """
+ <do-variable> = <scalar-int-variable>
+ """
+ subclass_names = ['Scalar_Int_Variable']
+
+class Do_Block(Base): # R832
+ """
+ <do-block> = <block>
+ """
+ subclass_names = ['Block']
+
+class End_Do(Base): # R833
+ """
+ <end-do> = <end-do-stmt>
+ | <continue-stmt>
+ """
+ subclass_names = ['End_Do_Stmt', 'Continue_Stmt']
+
+class End_Do_Stmt(EndStmtBase): # R834
+ """
+ <end-do-stmt> = END DO [ <do-construct-name> ]
+ """
+ subclass_names = []
+ use_names = ['Do_Construct_Name']
+ def match(string): return EndStmtBase.match('DO',Do_Construct_Name, string, require_stmt_type=True)
+ match = staticmethod(match)
+
+class Nonblock_Do_Construct(Base): # R835
+ """
+ <nonblock-do-stmt> = <action-term-do-construct>
+ | <outer-shared-do-construct>
+ """
+ subclass_names = ['Action_Term_Do_Construct', 'Outer_Shared_Do_Construct']
+
+class Action_Term_Do_Construct(BlockBase): # R836
+ """
+ <action-term-do-construct> = <label-do-stmt>
+ <do-body>
+ <do-term-action-stmt>
+ """
+ subclass_names = []
+ use_names = ['Label_Do_Stmt', 'Do_Body', 'Do_Term_Action_Stmt']
+ def match(reader):
+ content = []
+ for cls in [Label_Do_Stmt, Do_Body, Do_Term_Action_Stmt]:
+ obj = cls(reader)
+ if obj is None: # todo: restore reader
+ return
+ content.append(obj)
+ return content,
+ match = staticmethod(match)
+
+class Do_Body(BlockBase): # R837
+ """
+ <do-body> = [ <execution-part-construct> ]...
+ """
+ subclass_names = []
+ use_names = ['Execution_Part_Construct']
+ def match(string): return BlockBase.match(None, [Execution_Part_Construct], None, string)
+ match = staticmethod(match)
+
+class Do_Term_Action_Stmt(StmtBase): # R838
+ """
+ <do-term-action-stmt> = <action-stmt>
+ C824: <do-term-action-stmt> shall not be <continue-stmt>, <goto-stmt>, <return-stmt>, <stop-stmt>,
+ <exit-stmt>, <cycle-stmt>, <end-function-stmt>, <end-subroutine-stmt>,
+ <end-program-stmt>, <arithmetic-if-stmt>
+ """
+ subclass_names = ['Action_Stmt_C824']
+
+class Outer_Shared_Do_Construct(BlockBase): # R839
+ """
+ <outer-shared-do-construct> = <label-do-stmt>
+ <do-body>
+ <shared-term-do-construct>
+ """
+ subclass_names = []
+ use_names = ['Label_Do_Stmt', 'Do_Body', 'Shared_Term_Do_Construct']
+ def match(reader):
+ content = []
+ for cls in [Label_Do_Stmt, Do_Body, Shared_Term_Do_Construct]:
+ obj = cls(reader)
+ if obj is None: # todo: restore reader
+ return
+ content.append(obj)
+ return content,
+ match = staticmethod(match)
+
+class Shared_Term_Do_Construct(Base): # R840
+ """
+ <shared-term-do-construct> = <outer-shared-do-construct>
+ | <inner-shared-do-construct>
+ """
+ subclass_names = ['Outer_Shared_Do_Construct', 'Inner_Shared_Do_Construct']
+
+class Inner_Shared_Do_Construct(BlockBase): # R841
+ """
+ <inner-shared-do-construct> = <label-do-stmt>
+ <do-body>
+ <do-term-shared-stmt>
+ """
+ subclass_names = []
+ use_names = ['Label_Do_Stmt', 'Do_Body', 'Do_Term_Shared_Stmt']
+
+ def match(reader):
+ content = []
+ for cls in [Label_Do_Stmt, Do_Body, Do_Term_Shared_Stmt]:
+ obj = cls(reader)
+ if obj is None: # todo: restore reader
+ return
+ content.append(obj)
+ return content,
+ match = staticmethod(match)
+
+class Do_Term_Shared_Stmt(StmtBase): # R842
+ """
+ <do-term-shared-stmt> = <action-stmt>
+ C826: see C824 above.
+ """
+ subclass_names = ['Action_Stmt']
+
+class Cycle_Stmt(StmtBase, WORDClsBase): # R843
+ """
+ <cycle-stmt> = CYCLE [ <do-construct-name> ]
+ """
+ subclass_names = []
+ use_names = ['Do_Construct_Name']
+ def match(string): return WORDClsBase.match('CYCLE', Do_Construct_Name, string)
+ match = staticmethod(match)
+
+class Exit_Stmt(StmtBase, WORDClsBase): # R844
+ """
+ <exit-stmt> = EXIT [ <do-construct-name> ]
+ """
+ subclass_names = []
+ use_names = ['Do_Construct_Name']
+ def match(string): return WORDClsBase.match('EXIT', Do_Construct_Name, string)
+ match = staticmethod(match)
+
+class Goto_Stmt(StmtBase): # R845
+ """
+ <goto-stmt> = GO TO <label>
+ """
+ subclass_names = []
+ use_names = ['Label']
+ def match(string):
+ if string[:2].upper() != 'GO': return
+ line = string[2:].lstrip()
+ if line[:2].upper() != 'TO': return
+ return Label(line[2:].lstrip()),
+ match = staticmethod(match)
+ def tostr(self): return 'GO TO %s' % (self.items[0])
+
+class Computed_Goto_Stmt(StmtBase): # R846
+ """
+ <computed-goto-stmt> = GO TO ( <label-list> ) [ , ] <scalar-int-expr>
+ """
+ subclass_names = []
+ use_names = ['Label_List', 'Scalar_Int_Expr']
+ def match(string):
+ if string[:2].upper()!='GO': return
+ line = string[2:].lstrip()
+ if line[:2].upper()!='TO': return
+ line = line[2:].lstrip()
+ if not line.startswith('('): return
+ i = line.find(')')
+ if i==-1: return
+ lst = line[1:i].strip()
+ if not lst: return
+ line = line[i+1:].lstrip()
+ if line.startswith(','):
+ line = line[1:].lstrip()
+ if not line: return
+ return Label_List(lst), Scalar_Int_Expr(line)
+ match = staticmethod(match)
+ def tostr(self): return 'GO TO (%s), %s' % self.items
+
+class Arithmetic_If_Stmt(StmtBase): # R847
+ """
+ <arithmetic-if-stmt> = IF ( <scalar-numeric-expr> ) <label> , <label> , <label>
+ """
+ subclass_names = []
+ use_names = ['Scalar_Numeric_Expr', 'Label']
+ def match(string):
+ if string[:2].upper() != 'IF': return
+ line = string[2:].lstrip()
+ if not line.startswith('('): return
+ i = line.rfind(')')
+ if i==-1: return
+ labels = line[i+1:].lstrip().split(',')
+ if len(labels) != 3: return
+ labels = [Label(l.strip()) for l in labels]
+ return (Scalar_Numeric_Expr(line[1:i].strip()),) + tuple(labels)
+ match = staticmethod(match)
+ def tostr(self): return 'IF (%s) %s, %s, %s' % self.items
+
+class Continue_Stmt(StmtBase, STRINGBase): # R848
+ """
+ <continue-stmt> = CONTINUE
+ """
+ subclass_names = []
+ def match(string): return STRINGBase.match('CONTINUE', string)
+ match = staticmethod(match)
+
+
+class Stop_Stmt(StmtBase, WORDClsBase): # R849
+ """
+ <stop-stmt> = STOP [ <stop-code> ]
+ """
+ subclass_names = []
+ use_names = ['Stop_Code']
+ def match(string): return WORDClsBase.match('STOP', Stop_Code, string)
+ match = staticmethod(match)
+
+class Stop_Code(StringBase): # R850
+ """
+ <stop-code> = <scalar-char-constant>
+ | <digit> [ <digit> [ <digit> [ <digit> [ <digit> ] ] ] ]
+ """
+ subclass_names = ['Scalar_Char_Constant']
+ def match(string): return StringBase.match(pattern.abs_label, string)
+ match = staticmethod(match)
+
+
+###############################################################################
+############################### SECTION 9 ####################################
+###############################################################################
+
+class Io_Unit(StringBase): # R901
+ """
+ <io-unit> = <file-unit-number>
+ | *
+ | <internal-file-variable>
+ """
+ subclass_names = ['File_Unit_Number', 'Internal_File_Variable']
+ def match(string): return StringBase.match('*', string)
+ match = staticmethod(match)
+
+class File_Unit_Number(Base): # R902
+ """
+ <file-unit-number> = <scalar-int-expr>
+ """
+ subclass_names = ['Scalar_Int_Expr']
+
+class Internal_File_Variable(Base): # R903
+ """
+ <internal-file-variable> = <char-variable>
+ C901: <char-variable> shall not be an array section with a vector subscript.
+ """
+ subclass_names = ['Char_Variable']
+
+class Open_Stmt(StmtBase, CALLBase): # R904
+ """
+ <open-stmt> = OPEN ( <connect-spec-list> )
+ """
+ subclass_names = []
+ use_names = ['Connect_Spec_List']
+ def match(string): CALLBase.match('OPEN', Connect_Spec_List, string, require_rhs=True)
+ match = staticmethod(match)
+
+class Connect_Spec(KeywordValueBase): # R905
+ """
+ <connect-spec> = [ UNIT = ] <file-unit-number>
+ | ACCESS = <scalar-default-char-expr>
+ | ACTION = <scalar-default-char-expr>
+ | ASYNCHRONOUS = <scalar-default-char-expr>
+ | BLANK = <scalar-default-char-expr>
+ | DECIMAL = <scalar-default-char-expr>
+ | DELIM = <scalar-default-char-expr>
+ | ENCODING = <scalar-default-char-expr>
+ | ERR = <label>
+ | FILE = <file-name-expr>
+ | FORM = <scalar-default-char-expr>
+ | IOMSG = <iomsg-variable>
+ | IOSTAT = <scalar-int-variable>
+ | PAD = <scalar-default-char-expr>
+ | POSITION = <scalar-default-char-expr>
+ | RECL = <scalar-int-expr>
+ | ROUND = <scalar-default-char-expr>
+ | SIGN = <scalar-default-char-expr>
+ | STATUS = <scalar-default-char-expr>
+ """
+ subclass_names = []
+ use_names = ['File_Unit_Number', 'Scalar_Default_Char_Expr', 'Label', 'File_Name_Expr', 'Iomsg_Variable',
+ 'Scalar_Int_Expr', 'Scalar_Int_Variable']
+ def match(string):
+ for (k,v) in [\
+ (['ACCESS','ACTION','ASYNCHRONOUS','BLANK','DECIMAL','DELIM','ENCODING',
+ 'FORM','PAD','POSITION','ROUND','SIGN','STATUS'], Scalar_Default_Char_Expr),
+ ('ERR', Label),
+ ('FILE',File_Name_Expr),
+ ('IOSTAT', Scalar_Int_Variable),
+ ('IOMSG', Iomsg_Variable),
+ ('RECL', Scalar_Int_Expr),
+ ('UNIT', File_Unit_Number),
+ ]:
+ try:
+ obj = KeywordValueBase.match(k, v, string, upper_lhs = True)
+ except NoMatchError:
+ obj = None
+ if obj is not None: return obj
+ return 'UNIT', File_Unit_Number
+ match = staticmethod(match)
+
+
+class File_Name_Expr(Base): # R906
+ """
+ <file-name-expr> = <scalar-default-char-expr>
+ """
+ subclass_names = ['Scalar_Default_Char_Expr']
+
+class Iomsg_Variable(Base): # R907
+ """
+ <iomsg-variable> = <scalar-default-char-variable>
+ """
+ subclass_names = ['Scalar_Default_Char_Variable']
+
+class Close_Stmt(StmtBase, CALLBase): # R908
+ """
+ <close-stmt> = CLOSE ( <close-spec-list> )
+ """
+ subclass_names = []
+ use_names = ['Close_Spec_List']
+ def match(string): CALLBase.match('CLOSE', Close_Spec_List, string, require_rhs=True)
+ match = staticmethod(match)
+
+class Close_Spec(KeywordValueBase): # R909
+ """
+ <close-spec> = [ UNIT = ] <file-unit-number>
+ | IOSTAT = <scalar-int-variable>
+ | IOMSG = <iomsg-variable>
+ | ERR = <label>
+ | STATUS = <scalar-default-char-expr>
+ """
+ subclass_names = []
+ use_names = ['File_Unit_Number', 'Scalar_Default_Char_Expr', 'Label', 'Iomsg_Variable',
+ 'Scalar_Int_Variable']
+ def match(string):
+ for (k,v) in [\
+ ('ERR', Label),
+ ('IOSTAT', Scalar_Int_Variable),
+ ('IOMSG', Iomsg_Variable),
+ ('STATUS', Scalar_Default_Char_Expr),
+ ('UNIT', File_Unit_Number),
+ ]:
+ try:
+ obj = KeywordValueBase.match(k, v, string, upper_lhs = True)
+ except NoMatchError:
+ obj = None
+ if obj is not None: return obj
+ return 'UNIT', File_Unit_Number(string)
+ match = staticmethod(match)
+
+class Read_Stmt(StmtBase): # R910
+ """
+ <read-stmt> = READ ( <io-control-spec-list> ) [ <input-item-list> ]
+ | READ <format> [ , <input-item-list> ]
+ """
+ subclass_names = []
+ use_names = ['Io_Control_Spec_List', 'Input_Item_List', 'Format']
+
+class Write_Stmt(StmtBase): # R911
+ """
+ <write-stmt> = WRITE ( <io-control-spec-list> ) [ <output-item-list> ]
+ """
+ subclass_names = []
+ use_names = ['Io_Control_Spec_List', 'Output_Item_List']
+ def match(string):
+ if string[:5].upper()!='WRITE': return
+ line = string[5:].lstrip()
+ if not line.startswith('('): return
+ line, repmap = string_replace_map(line)
+ i = line.find(')')
+ if i==-1: return
+ l = line[1:i].strip()
+ if not l: return
+ l = repmap(l)
+ if i==len(line)-1:
+ return Io_Control_Spec_List(l),None
+ return Io_Control_Spec_List(l), Output_Item_List(repmap(line[i+1:].lstrip()))
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[1] is None: return 'WRITE(%s)' % (self.items[0])
+ return 'WRITE(%s) %s' % tuple(self.items)
+
+class Print_Stmt(StmtBase): # R912
+ """
+ <print-stmt> = PRINT <format> [ , <output-item-list> ]
+ """
+ subclass_names = []
+ use_names = ['Format', 'Output_Item_List']
+ def match(string):
+ if string[:5].upper()!='PRINT': return
+ line = string[5:]
+ if not line: return
+ c = line[0].upper()
+ if 'A'<=c<='Z' or c=='_' or '0'<=c<='9': return
+ line, repmap = string_replace_map(line.lstrip())
+ i = line.find(',')
+ if i==-1: return Format(repmap(line)), None
+ l = repmap(line[i+1:].lstrip())
+ if not l: return
+ return Format(repmap(line[:i].rstrip())), Output_Item_List(l)
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[1] is None: return 'PRINT %s' % (self.items[0])
+ return 'PRINT %s, %s' % tuple(self.items)
+
+class Io_Control_Spec_List(SequenceBase): # R913-list
+ """
+ <io-control-spec-list> is a list taking into account C910, C917, C918
+ """
+ subclass_names = []
+ use_names = ['Io_Control_Spec']
+ def match(string):
+ line, repmap = string_replace_map(string)
+ splitted = line.split(',')
+ if not splitted: return
+ lst = []
+ for i in range(len(splitted)):
+ p = splitted[i].strip()
+ if i==0:
+ if '=' not in p: p = 'UNIT=%s' % (repmap(p))
+ else: p = repmap(p)
+ elif i==1:
+ if '=' not in p:
+ p = repmap(p)
+ try:
+ f = Format(p)
+ # todo: make sure that f is char-expr, if not, raise NoMatchError
+ p = 'FMT=%s' % (Format(p))
+ except NoMatchError:
+ p = 'NML=%s' % (Namelist_Group_Name(p))
+ else:
+ p = repmap(p)
+ else:
+ p = repmap(p)
+ lst.append(Io_Control_Spec(p))
+ return ',', tuple(lst)
+ match = staticmethod(match)
+
+class Io_Control_Spec(KeywordValueBase): # R913
+ """
+ <io-control-spec> = [ UNIT = ] <io-unit>
+ | [ FMT = ] <format>
+ | [ NML = ] <namelist-group-name>
+ | ADVANCE = <scalar-default-char-expr>
+ | ASYNCHRONOUS = <scalar-char-initialization-expr>
+ | BLANK = <scalar-default-char-expr>
+ | DECIMAL = <scalar-default-char-expr>
+ | DELIM = <scalar-default-char-expr>
+ | END = <label>
+ | EOR = <label>
+ | ERR = <label>
+ | ID = <scalar-int-variable>
+ | IOMSG = <iomsg-variable>
+ | IOSTAT = <scalar-int-variable>
+ | PAD = <scalar-default-char-expr>
+ | POS = <scalar-int-expr>
+ | REC = <scalar-int-expr>
+ | ROUND = <scalar-default-char-expr>
+ | SIGN = <scalar-default-char-expr>
+ | SIZE = <scalar-int-variable>
+ """
+ subclass_names = []
+ use_names = ['Io_Unit', 'Format', 'Namelist_Group_Name', 'Scalar_Default_Char_Expr',
+ 'Scalar_Char_Initialization_Expr', 'Label', 'Scalar_Int_Variable',
+ 'Iomsg_Variable', 'Scalar_Int_Expr']
+ def match(string):
+ for (k,v) in [\
+ (['ADVANCE', 'BLANK', 'DECIMAL', 'DELIM', 'PAD', 'ROUND', 'SIGN'], Scalar_Default_Char_Expr),
+ ('ASYNCHRONOUS', Scalar_Char_Initialization_Expr),
+ (['END','EOR','ERR'], Label),
+ (['ID','IOSTAT','SIZE'], Scalar_Int_Variable),
+ ('IOMSG', Iomsg_Variable),
+ (['POS', 'REC'], Scalar_Int_Expr),
+ ('UNIT', Io_Unit),
+ ('FMT', Format),
+ ('NML', Namelist_Group_Name)
+ ]:
+ try:
+ obj = KeywordValueBase.match(k, v, string, upper_lhs = True)
+ except NoMatchError:
+ obj = None
+ if obj is not None: return obj
+ return
+ match = staticmethod(match)
+
+class Format(StringBase): # R914
+ """
+ <format> = <default-char-expr>
+ | <label>
+ | *
+ """
+ subclass_names = ['Label', 'Default_Char_Expr']
+ def match(string): return StringBase.match('*', string)
+ match = staticmethod(match)
+
+class Input_Item(Base): # R915
+ """
+ <input-item> = <variable>
+ | <io-implied-do>
+ """
+ subclass_names = ['Variable', 'Io_Implied_Do']
+
+class Output_Item(Base): # R916
+ """
+ <output-item> = <expr>
+ | <io-implied-do>
+ """
+ subclass_names = ['Expr', 'Io_Implied_Do']
+
+class Io_Implied_Do(Base): # R917
+ """
+ <io-implied-do> = ( <io-implied-do-object-list> , <io-implied-do-control> )
+ """
+ subclass_names = []
+ use_names = ['Io_Implied_Do_Object_List', 'Io_Implied_Do_Control']
+
+class Io_Implied_Do_Object(Base): # R918
+ """
+ <io-implied-do-object> = <input-item>
+ | <output-item>
+ """
+ subclass_names = ['Input_Item', 'Output_Item']
+
+class Io_Implied_Do_Control(Base): # R919
+ """
+ <io-implied-do-control> = <do-variable> = <scalar-int-expr> , <scalar-int-expr> [ , <scalar-int-expr> ]
+ """
+ subclass_names = []
+ use_names = ['Do_Variable', 'Scalar_Int_Expr']
+
+class Dtv_Type_Spec(CALLBase): # R920
+ """
+ <dtv-type-spec> = TYPE ( <derived-type-spec> )
+ | CLASS ( <derived-type-spec> )
+ """
+ subclass_names = []
+ use_names = ['Derived_Type_Spec']
+ def match(string): CALLStmt.match(['TYPE', 'CLASS'], Derived_Type_Spec, string, require_rhs=True)
+ match = staticmethod(match)
+
+class Wait_Stmt(StmtBase, CALLBase): # R921
+ """
+ <wait-stmt> = WAIT ( <wait-spec-list> )
+ """
+ subclass_names = []
+ use_names = ['Wait_Spec_List']
+ def match(string): return CALLBase.match('WAIT', Wait_Spec_List, string, require_rhs=True)
+ match = staticmethod(match)
+
+class Wait_Spec(KeywordValueBase): # R922
+ """
+ <wait-spec> = [ UNIT = ] <file-unit-number>
+ | END = <label>
+ | EOR = <label>
+ | ERR = <label>
+ | ID = <scalar-int-expr>
+ | IOMSG = <iomsg-variable>
+ | IOSTAT = <scalar-int-variable>
+ """
+ subclass_names = []
+ use_names = ['File_Unit_Number', 'Label', 'Scalar_Int_Expr', 'Iomsg_Variable', 'Scalar_Int_Variable']
+ def match(string):
+ for (k,v) in [\
+ (['END','EOR','ERR'], Label),
+ ('IOSTAT', Scalar_Int_Variable),
+ ('IOMSG', Iomsg_Variable),
+ ('ID', Scalar_Int_Expr),
+ ('UNIT', File_Unit_Number),
+ ]:
+ try:
+ obj = KeywordValueBase.match(k, v, string, upper_lhs = True)
+ except NoMatchError:
+ obj = None
+ if obj is not None: return obj
+ return 'UNIT', File_Unit_Number(string)
+
+ match = staticmethod(match)
+
+class Backspace_Stmt(StmtBase): # R923
+ """
+ <backspace-stmt> = BACKSPACE <file-unit-number>
+ | BACKSPACE ( <position-spec-list> )
+ """
+ subclass_names = []
+ use_names = ['File_Unit_Number', 'Position_Spec_List']
+
+class Endfile_Stmt(StmtBase): # R924
+ """
+ <endfile-stmt> = ENDFILE <file-unit-number>
+ | ENDFILE ( <position-spec-list> )
+ """
+ subclass_names = []
+ use_names = ['File_Unit_Number', 'Position_Spec_List']
+
+class Rewind_Stmt(StmtBase): # R925
+ """
+ <rewind-stmt> = REWIND <file-unit-number>
+ | REWIND ( <position-spec-list> )
+ """
+ subclass_names = []
+ use_names = ['File_Unit_Number', 'Position_Spec_List']
+
+class Position_Spec(KeywordValueBase): # R926
+ """
+ <position-spec> = [ UNIT = ] <file-unit-number>
+ | IOMSG = <iomsg-variable>
+ | IOSTAT = <scalar-int-variable>
+ | ERR = <label>
+ """
+ subclass_names = []
+ use_names = ['File_Unit_Number', 'Iomsg_Variable', 'Scalar_Int_Variable', 'Label']
+ def match(string):
+ for (k,v) in [\
+ ('ERR', Label),
+ ('IOSTAT', Scalar_Int_Variable),
+ ('IOMSG', Iomsg_Variable),
+ ('UNIT', File_Unit_Number),
+ ]:
+ try:
+ obj = KeywordValueBase.match(k, v, string, upper_lhs = True)
+ except NoMatchError:
+ obj = None
+ if obj is not None: return obj
+ return 'UNIT', File_Unit_Number(string)
+ match = staticmethod(match)
+
+
+class Flush_Stmt(StmtBase): # R927
+ """
+ <flush-stmt> = FLUSH <file-unit-number>
+ | FLUSH ( <position-spec-list> )
+ """
+ subclass_names = []
+ use_names = ['File_Unit_Number', 'Position_Spec_List']
+
+class Flush_Spec(KeywordValueBase): # R928
+ """
+ <flush-spec> = [ UNIT = ] <file-unit-number>
+ | IOMSG = <iomsg-variable>
+ | IOSTAT = <scalar-int-variable>
+ | ERR = <label>
+ """
+ subclass_names = []
+ use_names = ['File_Unit_Number', 'Iomsg_Variable', 'Scalar_Int_Variable', 'Label']
+ def match(string):
+ for (k,v) in [\
+ ('ERR', Label),
+ ('IOSTAT', Scalar_Int_Variable),
+ ('IOMSG', Iomsg_Variable),
+ ('UNIT', File_Unit_Number),
+ ]:
+ try:
+ obj = KeywordValueBase.match(k, v, string, upper_lhs = True)
+ except NoMatchError:
+ obj = None
+ if obj is not None: return obj
+ return 'UNIT', File_Unit_Number(string)
+ match = staticmethod(match)
+
+class Inquire_Stmt(StmtBase): # R929
+ """
+ <inquire-stmt> = INQUIRE ( <inquire-spec-list> )
+ | INQUIRE ( IOLENGTH = <scalar-int-variable> ) <output-item-list>
+ """
+ subclass_names = []
+ use_names = ['Inquire_Spec_List', 'Scalar_Int_Variable', 'Output_Item_List']
+
+class Inquire_Spec(KeywordValueBase): # R930
+ """
+ <inquire-spec> = [ UNIT = ] <file-unit-number>
+ | FILE = <file-name-expr>
+ | ACCESS = <scalar-default-char-variable>
+ | ACTION = <scalar-default-char-variable>
+ | ASYNCHRONOUS = <scalar-default-char-variable>
+ | BLANK = <scalar-default-char-variable>
+ | DECIMAL = <scalar-default-char-variable>
+ | DELIM = <scalar-default-char-variable>
+ | DIRECT = <scalar-default-char-variable>
+ | ENCODING = <scalar-default-char-variable>
+ | ERR = <label>
+ | EXIST = <scalar-default-logical-variable>
+ | FORM = <scalar-default-char-variable>
+ | FORMATTED = <scalar-default-char-variable>
+ | ID = <scalar-int-expr>
+ | IOMSG = <iomsg-variable>
+ | IOSTAT = <scalar-int-variable>
+ | NAME = <scalar-default-char-variable>
+ | NAMED = <scalar-default-logical-variable>
+ | NEXTREC = <scalar-int-variable>
+ | NUMBER = <scalar-int-variable>
+ | OPENED = <scalar-default-logical-variable>
+ | PAD = <scalar-default-char-variable>
+ | PENDING = <scalar-default-logical-variable>
+ | POS = <scalar-int-variable>
+ | POSITION = <scalar-default-char-variable>
+ | READ = <scalar-default-char-variable>
+ | READWRITE = <scalar-default-char-variable>
+ | RECL = <scalar-int-variable>
+ | ROUND = <scalar-default-char-variable>
+ | SEQUENTIAL = <scalar-default-char-variable>
+ | SIGN = <scalar-default-char-variable>
+ | SIZE = <scalar-int-variable>
+ | STREAM = <scalar-default-char-variable>
+ | UNFORMATTED = <scalar-default-char-variable>
+ | WRITE = <scalar-default-char-variable>
+ """
+ subclass_names = []
+ use_names = ['File_Unit_Number', 'File_Name_Expr', 'Scalar_Default_Char_Variable',
+ 'Scalar_Default_Logical_Variable', 'Scalar_Int_Variable', 'Scalar_Int_Expr',
+ 'Label', 'Iomsg_Variable']
+ def match(string):
+ for (k,v) in [\
+ (['ACCESS','ACTION','ASYNCHRONOUS', 'BLANK', 'DECIMAL', 'DELIM',
+ 'DIRECT','ENCODING','FORM','NAME','PAD', 'POSITION','READ','READWRITE',
+ 'ROUND', 'SEQUENTIAL', 'SIGN','STREAM','UNFORMATTED','WRITE'],
+ Scalar_Default_Char_Variable),
+ ('ERR', Label),
+ (['EXIST','NAMED','PENDING'], Scalar_Default_Logical_Variable),
+ ('ID', Scalar_Int_Expr),
+ (['IOSTAT','NEXTREC','NUMBER','POS','RECL','SIZE'], Scalar_Int_Variable),
+ ('IOMSG', Iomsg_Variable),
+ ('FILE', File_Name_Expr),
+ ('UNIT', File_Unit_Number),
+ ]:
+ try:
+ obj = KeywordValueBase.match(k, v, string, upper_lhs = True)
+ except NoMatchError:
+ obj = None
+ if obj is not None: return obj
+ return 'UNIT', File_Unit_Number(string)
+ return
+ match = staticmethod(match)
+
+###############################################################################
+############################### SECTION 10 ####################################
+###############################################################################
+
+class Format_Stmt(StmtBase, WORDClsBase): # R1001
+ """
+ <format-stmt> = FORMAT <format-specification>
+ """
+ subclass_names = []
+ use_names = ['Format_Specification']
+ def match(string): WORDClsBase.match('FORMAT', Format_Specification, string, require_cls=True)
+ match = staticmethod(match)
+
+class Format_Specification(BracketBase): # R1002
+ """
+ <format-specification> = ( [ <format-item-list> ] )
+ """
+ subclass_names = []
+ use_names = ['Format_Item_List']
+ def match(string): return BracketBase.match('()', Format_Item_List, string, require_cls=False)
+ match = staticmethod(match)
+
+class Format_Item(Base): # R1003
+ """
+ <format-item> = [ <r> ] <data-edit-desc>
+ | <control-edit-desc>
+ | <char-string-edit-desc>
+ | [ <r> ] ( <format-item-list> )
+ """
+ subclass_names = ['Control_Edit_Desc', 'Char_String_Edit_Desc']
+ use_names = ['R', 'Format_Item_List']
+
+class R(Base): # R1004
+ """
+ <r> = <int-literal-constant>
+ <r> shall be positive and without kind parameter specified.
+ """
+ subclass_names = ['Int_Literal_Constant']
+
+class Data_Edit_Desc(Base): # R1005
+ """
+ <data-edit-desc> = I <w> [ . <m> ]
+ | B <w> [ . <m> ]
+ | O <w> [ . <m> ]
+ | Z <w> [ . <m> ]
+ | F <w> . <d>
+ | E <w> . <d> [ E <e> ]
+ | EN <w> . <d> [ E <e> ]
+ | ES <w> . <d> [ E <e>]
+ | G <w> . <d> [ E <e> ]
+ | L <w>
+ | A [ <w> ]
+ | D <w> . <d>
+ | DT [ <char-literal-constant> ] [ ( <v-list> ) ]
+ """
+ subclass_names = []
+ use_names = ['W', 'M', 'D', 'E', 'Char_Literal_Constant', 'V_List']
+ def match(string):
+ c = string[0].upper()
+ if c in ['I','B','O','Z','D']:
+ line = string[1:].lstrip()
+ if '.' in line:
+ i1,i2 = line.split('.',1)
+ i1 = i1.rstrip()
+ i2 = i2.lstrip()
+ return c, W(i1), M(i2), None
+ return c,W(line), None, None
+ if c in ['E','G']:
+ line = string[1:].lstrip()
+ if line.count('.')==1:
+ i1,i2 = line.split('.',1)
+ i1 = i1.rstrip()
+ i2 = i2.lstrip()
+ return c, W(i1), D(i2), None
+ elif line.count('.')==2:
+ i1,i2,i3 = line.split('.',2)
+ i1 = i1.rstrip()
+ i2 = i2.lstrip()
+ i3 = i3.lstrip()
+ return c, W(i1), D(i2), E(i3)
+ else:
+ return
+ if c=='L':
+ line = string[1:].lstrip()
+ if not line: return
+ return c, W(line), None, None
+ if c=='A':
+ line = string[1:].lstrip()
+ if not line:
+ return c, None, None, None
+ return c, W(line), None, None
+ c = string[:2].upper()
+ if len(c)!=2: return
+ if c in ['EN','ES']:
+ line = string[2:].lstrip()
+ if line.count('.')==1:
+ i1,i2 = line.split('.',1)
+ i1 = i1.rstrip()
+ i2 = i2.lstrip()
+ return c, W(i1), D(i2), None
+ elif line.count('.')==2:
+ i1,i2,i3 = line.split('.',2)
+ i1 = i1.rstrip()
+ i2 = i2.lstrip()
+ i3 = i3.lstrip()
+ return c, W(i1), D(i2), E(i3)
+ else:
+ return
+ if c=='DT':
+ line = string[2:].lstrip()
+ if not line:
+ return c, None, None, None
+ lst = None
+ if line.endswith(')'):
+ i = line.rfind('(')
+ if i==-1: return
+ l = line[i+1:-1].strip()
+ if not l: return
+ lst = V_List(l)
+ line = line[:i].rstrip()
+ if not line:
+ return c, None, lst, None
+ return c, Char_Literal_Constant(line), lst, None
+ return
+ match = staticmethod(match)
+ def tostr(self):
+ c = selt.items[0]
+ if c in ['I', 'B', 'O', 'Z', 'F', 'D', 'A', 'L']:
+ if self.items[2] is None:
+ return '%s%s' % (c, self.items[1])
+ return '%s%s.%s' % (c, self.items[1], self.items[2])
+ if c in ['E', 'EN', 'ES', 'G']:
+ if self.items[3] is None:
+ return '%s%s.%s' % (c, self.items[1], self.items[2])
+ return '%s%s.%sE%s' % (c, self.items[1], self.items[2], self.items[3])
+ if c=='DT':
+ if self.items[1] is None:
+ if self.items[2] is None:
+ return c
+ else:
+ return '%s(%s)' % (c, self.items[2])
+ else:
+ if self.items[2] is None:
+ return '%s%s' % (c, self.items[1])
+ else:
+ return '%s%s(%s)' % (c, self.items[1], self.items[2])
+ raise NotImpletenetedError,`c`
+
+class W(Base): # R1006
+ """
+ <w> = <int-literal-constant>
+ """
+ subclass_names = ['Int_Literal_Constant']
+
+class M(Base): # R1007
+ """
+ <m> = <int-literal-constant>
+ """
+ subclass_names = ['Int_Literal_Constant']
+
+class D(Base): # R1008
+ """
+ <d> = <int-literal-constant>
+ """
+ subclass_names = ['Int_Literal_Constant']
+
+class E(Base): # R1009
+ """
+ <e> = <int-literal-constant>
+ """
+ subclass_names = ['Int_Literal_Constant']
+
+class V(Base): # R1010
+ """
+ <v> = <signed-int-literal-constant>
+ """
+ subclass_names = ['Signed_Int_Literal_Constant']
+
+class Control_Edit_Desc(Base): # R1011
+ """
+ <control-edit-desc> = <position-edit-desc>
+ | [ <r> ] /
+ | :
+ | <sign-edit-desc>
+ | <k> P
+ | <blank-interp-edit-desc>
+ | <round-edit-desc>
+ | <decimal-edit-desc>
+ """
+ subclass_names = ['Position_Edit_Desc', 'Sign_Edit_Desc', 'Blank_Interp_Edit_Desc', 'Round_Edit_Desc',
+ 'Decimal_Edit_Desc']
+ use_names = ['R', 'K']
+
+class K(Base): # R1012
+ """
+ <k> = <signed-int-literal-constant>
+ """
+ subclass_names = ['Signed_Int_Literal_Constant']
+
+class Position_Edit_Desc(Base): # R1013
+ """
+ <position-edit-desc> = T <n>
+ | TL <n>
+ | TR <n>
+ | <n> X
+ """
+ subclass_names = []
+ use_names = ['N']
+
+class N(Base): # R1014
+ """
+ <n> = <int-literal-constant>
+ """
+ subclass_names = ['Int_Literal_Constant']
+
+class Sign_Edit_Desc(STRINGBase): # R1015
+ """
+ <sign-edit-desc> = SS
+ | SP
+ | S
+ """
+ subclass_names = []
+ def match(string): return STRINGBase.match(['SS','SP','S'], string)
+ match = staticmethod(match)
+
+class Blank_Interp_Edit_Desc(STRINGBase): # R1016
+ """
+ <blank-interp-edit-desc> = BN
+ | BZ
+ """
+ subclass_names = []
+ def match(string): return STRINGBase.match(['BN','BZ',], string)
+ match = staticmethod(match)
+
+class Round_Edit_Desc(STRINGBase): # R1017
+ """
+ <round-edit-desc> = RU
+ | RD
+ | RZ
+ | RN
+ | RC
+ | RP
+ """
+ subclass_names = []
+ def match(string): return STRINGBase.match(['RU','RD','RZ','RN','RC','RP'], string)
+ match = staticmethod(match)
+
+class Decimal_Edit_Desc(STRINGBase): # R1018
+ """
+ <decimal-edit-desc> = DC
+ | DP
+ """
+ subclass_names = []
+ def match(string): return STRINGBase.match(['DC','DP'], string)
+ match = staticmethod(match)
+
+class Char_String_Edit_Desc(Base): # R1019
+ """
+ <char-string-edit-desc> = <char-literal-constant>
+ """
+ subclass_names = ['Char_Literal_Constant']
+
+###############################################################################
+############################### SECTION 11 ####################################
+###############################################################################
+
+class Main_Program(Base): # R1101
+ """
+ <main-program> = [ <program-stmt> ]
+ [ <specification-part> ]
+ [ <execution-part> ]
+ [ <internal-subprogram-part> ]
+ <end-program-stmt>
+ """
+ subclass_names = []
+ use_names = ['Program_Stmt', 'Specification_Part', 'Execution_Part', 'Internal_Subprogram_Part',
+ 'End_Program_Stmt']
+
+class Program_Stmt(StmtBase, WORDClsBase): # R1102
+ """
+ <program-stmt> = PROGRAM <program-name>
+ """
+ subclass_names = []
+ use_names = ['Program_Name']
+ def match(string): return WORDClsBase.match('PROGRAM',Program_Name, string, require_cls = True)
+ match = staticmethod(match)
+
+class End_Program_Stmt(EndStmtBase): # R1103
+ """
+ <end-program-stmt> = END [ PROGRAM [ <program-name> ] ]
+ """
+ subclass_names = []
+ use_names = ['Program_Name']
+ def match(string): return EndStmtBase.match('PROGRAM',Program_Name, string)
+ match = staticmethod(match)
+
+class Module(Base): # R1104
+ """
+ <module> = <module-stmt>
+ [ <specification-part> ]
+ [ <module-subprogram-part> ]
+ <end-module-stmt>
+ """
+ subclass_names = []
+ use_names = ['Module_Stmt', 'Specification_Part', 'Module_Subprogram_Part', 'End_Module_Stmt']
+
+class Module_Stmt(StmtBase, WORDClsBase): # R1105
+ """
+ <module-stmt> = MODULE <module-name>
+ """
+ subclass_names = []
+ use_names = ['Module_Name']
+ def match(string): return WORDClsBase.match('MODULE',Module_Name, string, require_cls = True)
+ match = staticmethod(match)
+
+class End_Module_Stmt(EndStmtBase): # R1106
+ """
+ <end-module-stmt> = END [ MODULE [ <module-name> ] ]
+ """
+ subclass_names = []
+ use_names = ['Module_Name']
+ def match(string): return EndStmtBase.match('MODULE',Module_Name, string, require_stmt_type=True)
+ match = staticmethod(match)
+
+class Module_Subprogram_Part(Base): # R1107
+ """
+ <module-subprogram-part> = <contains-stmt>
+ <module-subprogram>
+ [ <module-subprogram> ]...
+ """
+ subclass_names = []
+ use_names = ['Contains_Stmt', 'Module_Subprogram']
+
+class Module_Subprogram(Base): # R1108
+ """
+ <module-subprogram> = <function-subprogram>
+ | <subroutine-subprogram>
+ """
+ subclass_names = ['Function_Subprogram', 'Subroutine_Subprogram']
+
+class Use_Stmt(StmtBase): # R1109
+ """
+ <use-stmt> = USE [ [ , <module-nature> ] :: ] <module-name> [ , <rename-list> ]
+ | USE [ [ , <module-nature> ] :: ] <module-name> , ONLY: [ <only-list> ]
+ """
+ subclass_names = []
+ use_names = ['Module_Nature', 'Module_Name', 'Rename_List', 'Only_List']
+
+ def match(string):
+ if string[:3].upper() != 'USE': return
+ line = string[3:]
+ if not line: return
+ if isalnum(line[0]): return
+ line = line.lstrip()
+ i = line.find('::')
+ nature = None
+ if i!=-1:
+ if line.startswith(','):
+ l = line[1:i].strip()
+ if not l: return
+ nature = Module_Nature(l)
+ line = line[i+2:].lstrip()
+ if not line: return
+ i = line.find(',')
+ if i==-1: return nature, Module_Name(line), '', None
+ name = line[:i].rstrip()
+ if not name: return
+ name = Module_Name(name)
+ line = line[i+1:].lstrip()
+ if not line: return
+ if line[:5].upper()=='ONLY:':
+ line = line[5:].lstrip()
+ if not line:
+ return nature, name, ', ONLY:', None
+ return nature, name, ', ONLY:', Only_List(line)
+ return nature, name, ',', Rename_List(line)
+ match = staticmethod(match)
+ def tostr(self):
+ s = 'USE'
+ if self.items[0] is not None:
+ s += ', %s' % (self.items[0])
+ s += ' :: %s%s' % (self.items[1], self.items[2])
+ if self.items[3] is not None:
+ s += ' %s' % (self.items[3])
+ return s
+
+class Module_Nature(STRINGBase): # R1110
+ """
+ <module-nature> = INTRINSIC
+ | NON_INTRINSIC
+ """
+ subclass_names = []
+ def match(string): return STRINGBase.match(['INTRINSIC','NON_INTRINSIC'], string)
+ match = staticmethod(match)
+
+class Rename(Base): # R1111
+ """
+ <rename> = <local-name> => <use-name>
+ | OPERATOR(<local-defined-operator>) => OPERATOR(<use-defined-operator>)
+ """
+ subclass_names = []
+ use_names = ['Local_Name', 'Use_Name', 'Local_Defined_Operator', 'Use_Defined_Operator']
+ def match(string):
+ s = string.split('=>', 1)
+ if len(s) != 2: return
+ lhs, rhs = s[0].rstrip(), s[1].lstrip()
+ if not lhs or not rhs: return
+ if lhs[:8].upper()=='OPERATOR' and rhs[:8].upper()=='OPERATOR':
+ l = lhs[8:].lstrip()
+ r = rhs[8:].lstrip()
+ if l and r and l[0]+l[-1]=='()':
+ if r[0]+r[-1] != '()': return
+ l = l[1:-1].strip()
+ r = r[1:-1].strip()
+ if not l or not r: return
+ return 'OPERATOR', Local_Defined_Operator(l), Use_Defined_Operator(r)
+ return None, Local_Name(lhs), Use_Name(rhs)
+ match = staticmethod(match)
+ def tostr(self):
+ if not self.items[0]:
+ return '%s => %s' % self.items[1:]
+ return '%s(%s) => %s(%s)' % (self.items[0], self.items[1],self.items[0], self.items[2])
+
+class Only(Base): # R1112
+ """
+ <only> = <generic-spec>
+ | <only-use-name>
+ | <rename>
+ """
+ subclass_names = ['Generic_Spec', 'Only_Use_Name', 'Rename']
+
+class Only_Use_Name(Base): # R1113
+ """
+ <only-use-name> = <name>
+ """
+ subclass_names = ['Name']
+
+class Local_Defined_Operator(Base): # R1114
+ """
+ <local-defined-operator> = <defined-unary-op>
+ | <defined-binary-op>
+ """
+ subclass_names = ['Defined_Unary_Op', 'Defined_Binary_Op']
+
+class Use_Defined_Operator(Base): # R1115
+ """
+ <use-defined-operator> = <defined-unary-op>
+ | <defined-binary-op>
+ """
+ subclass_names = ['Defined_Unary_Op', 'Defined_Binary_Op']
+
+class Block_Data(Base): # R1116
+ """
+ <block-data> = <block-data-stmt>
+ [ <specification-part> ]
+ <end-block-data-stmt>
+ """
+ subclass_names = []
+ use_names = ['Block_Data_Stmt', 'Specification_Part', 'End_Block_Data_Stmt']
+
+class Block_Data_Stmt(StmtBase): # R1117
+ """
+ <block-data-stmt> = BLOCK DATA [ <block-data-name> ]
+ """
+ subclass_names = []
+ use_names = ['Block_Data_Name']
+ def match(string):
+ if string[:5].upper()!='BLOCK': return
+ line = string[5:].lstrip()
+ if line[:4].upper()!='DATA': return
+ line = line[4:].lstrip()
+ if not line: return None,
+ return Block_Data_Name(line),
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[0] is None: return 'BLOCK DATA'
+ return 'BLOCK DATA %s' % self.items
+
+class End_Block_Data_Stmt(EndStmtBase): # R1118
+ """
+ <end-block-data-stmt> = END [ BLOCK DATA [ <block-data-name> ] ]
+ """
+ subclass_names = []
+ use_names = ['Block_Data_Name']
+ def match(string): return EndStmtBase.match('BLOCK DATA',Block_Data_Name, string)
+ match = staticmethod(match)
+
+###############################################################################
+############################### SECTION 12 ####################################
+###############################################################################
+
+
+class Interface_Block(Base): # R1201
+ """
+ <interface-block> = <interface-stmt>
+ [ <interface-specification> ]...
+ <end-interface-stmt>
+ """
+ subclass_names = []
+ use_names = ['Interface_Stmt', 'Interface_Specification', 'End_Interface_Stmt']
+
+class Interface_Specification(Base): # R1202
+ """
+ <interface-specification> = <interface-body>
+ | <procedure-stmt>
+ """
+ subclass_names = ['Interface_Body', 'Procedure_Stmt']
+
+class Interface_Stmt(StmtBase): # R1203
+ """
+ <interface-stmt> = INTERFACE [ <generic-spec> ]
+ | ABSTRACT INTERFACE
+ """
+ subclass_names = []
+ use_names = ['Generic_Spec']
+
+class End_Interface_Stmt(EndStmtBase): # R1204
+ """
+ <end-interface-stmt> = END INTERFACE [ <generic-spec> ]
+ """
+ subclass_names = []
+ use_names = ['Generic_Spec']
+ def match(string): return EndStmtBase.match('INTERFACE',Generic_Spec, string, require_stmt_type=True)
+ match = staticmethod(match)
+
+class Interface_Body(Base): # R1205
+ """
+ <interface-body> = <function-stmt>
+ [ <specification-part> ]
+ <end-function-stmt>
+ | <subroutine-stmt>
+ [ <specification-part> ]
+ <end-subroutine-stmt>
+ """
+ subclass_names = []
+ use_names = ['Function_Stmt', 'Specification_Part', 'Subroutine_Stmt', 'End_Function_Stmt', 'End_Subroutine_Stmt']
+
+class Procedure_Stmt(StmtBase): # R1206
+ """
+ <procedure-stmt> = [ MODULE ] PROCEDURE <procedure-name-list>
+ """
+ subclass_names = []
+ use_names = ['Procedure_Name_List']
+
+class Generic_Spec(Base): # R1207
+ """
+ <generic-spec> = <generic-name>
+ | OPERATOR ( <defined-operator> )
+ | ASSIGNMENT ( = )
+ | <dtio-generic-spec>
+ """
+ subclass_names = ['Generic_Name', 'Dtio_Generic_Spec']
+ use_names = ['Defined_Operator']
+
+class Dtio_Generic_Spec(Base): # R1208
+ """
+ <dtio-generic-spec> = READ ( FORMATTED )
+ | READ ( UNFORMATTED )
+ | WRITE ( FORMATTED )
+ | WRITE ( UNFORMATTED )
+ """
+ subclass_names = []
+
+class Import_Stmt(StmtBase, WORDClsBase): # R1209
+ """
+ <import-stmt> = IMPORT [ :: ] <import-name-list>
+ """
+ subclass_names = []
+ use_names = ['Import_Name_List']
+ def match(string): return WORDClsBase.match('IMPORT',Import_Name_List,string,check_colons=True, require_cls=True)
+ match = staticmethod(match)
+ tostr = WORDClsBase.tostr_a
+
+class External_Stmt(StmtBase, WORDClsBase): # R1210
+ """
+ <external-stmt> = EXTERNAL [ :: ] <external-name-list>
+ """
+ subclass_names = []
+ use_names = ['External_Name_List']
+ def match(string): return WORDClsBase.match('EXTERNAL',External_Name_List,string,check_colons=True, require_cls=True)
+ match = staticmethod(match)
+ tostr = WORDClsBase.tostr_a
+
+class Procedure_Declaration_Stmt(StmtBase): # R1211
+ """
+ <procedure-declaration-stmt> = PROCEDURE ( [ <proc-interface> ] ) [ [ , <proc-attr-spec> ]... :: ] <proc-decl-list>
+ """
+ subclass_names = []
+ use_names = ['Proc_Interface', 'Proc_Attr_Spec', 'Proc_Decl_List']
+
+class Proc_Interface(Base): # R1212
+ """
+ <proc-interface> = <interface-name>
+ | <declaration-type-spec>
+ """
+ subclass_names = ['Interface_Name', 'Declaration_Type_Spec']
+
+class Proc_Attr_Spec(Base): # R1213
+ """
+ <proc-attr-spec> = <access-spec>
+ | <proc-language-binding-spec>
+ | INTENT ( <intent-spec> )
+ | OPTIONAL
+ | SAVE
+ """
+ subclass_names = ['Access_Spec', 'Proc_Language_Binding_Spec']
+ use_names = ['Intent_Spec']
+
+class Proc_Decl(BinaryOpBase): # R1214
+ """
+ <proc-decl> = <procedure-entity-name> [ => <null-init> ]
+ """
+ subclass_names = ['Procedure_Entity_Name']
+ use_names = ['Null_Init']
+ def match(string): return BinaryOpBase.match(Procedure_Entity_Name,'=>', Null_Init, string)
+ match = staticmethod(match)
+
+class Interface_Name(Base): # R1215
+ """
+ <interface-name> = <name>
+ """
+ subclass_names = ['Name']
+
+class Intrinsic_Stmt(StmtBase, WORDClsBase): # R1216
+ """
+ <intrinsic-stmt> = INTRINSIC [ :: ] <intrinsic-procedure-name-list>
+ """
+ subclass_names = []
+ use_names = ['Intrinsic_Procedure_Name_List']
+ def match(string): return WORDClsBase.match('INTRINSIC',Intrinsic_Procedure_Name_List,string,check_colons=True, require_cls=True)
+ match = staticmethod(match)
+ tostr = WORDClsBase.tostr_a
+
+class Function_Reference(CallBase): # R1217
+ """
+ <function-reference> = <procedure-designator> ( [ <actual-arg-spec-list> ] )
+ """
+ subclass_names = []
+ use_names = ['Procedure_Designator','Actual_Arg_Spec_List']
+ def match(string):
+ return CallBase.match(Procedure_Designator, Actual_Arg_Spec_List, string)
+ match = staticmethod(match)
+
+class Call_Stmt(StmtBase): # R1218
+ """
+ <call-stmt> = CALL <procedure-designator> [ ( [ <actual-arg-spec-list> ] ) ]
+ """
+ subclass_names = []
+ use_names = ['Procedure_Designator', 'Actual_Arg_Spec_List']
+ def match(string):
+ if string[:4].upper()!='CALL': return
+ line, repmap = string_replace_map(string[4:].lstrip())
+ if line.endswith(')'):
+ i = line.rfind('(')
+ if i==-1: return
+ args = repmap(line[i+1:-1].strip())
+ if args:
+ return Procedure_Designator(repmap(line[:i].rstrip())),Actual_Arg_Spec_List(args)
+ return Procedure_Designator(repmap(line[:i].rstrip())),None
+ return Procedure_Designator(string[4:].lstrip()),None
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[1] is None: return 'CALL %s' % (self.items[0])
+ return 'CALL %s(%s)' % self.items
+
+class Procedure_Designator(BinaryOpBase): # R1219
+ """
+ <procedure-designator> = <procedure-name>
+ | <proc-component-ref>
+ | <data-ref> % <binding-name>
+ """
+ subclass_names = ['Procedure_Name','Proc_Component_Ref']
+ use_names = ['Data_Ref','Binding_Name']
+ def match(string):
+ return BinaryOpBase.match(\
+ Data_Ref, pattern.percent_op.named(), Binding_Name, string)
+ match = staticmethod(match)
+
+class Actual_Arg_Spec(KeywordValueBase): # R1220
+ """
+ <actual-arg-spec> = [ <keyword> = ] <actual-arg>
+ """
+ subclass_names = ['Actual_Arg']
+ use_names = ['Keyword']
+ def match(string): return KeywordValueBase.match(Keyword, Actual_Arg, string)
+ match = staticmethod(match)
+
+class Actual_Arg(Base): # R1221
+ """
+ <actual-arg> = <expr>
+ | <variable>
+ | <procedure-name>
+ | <proc-component-ref>
+ | <alt-return-spec>
+ """
+ subclass_names = ['Procedure_Name','Proc_Component_Ref','Alt_Return_Spec', 'Variable', 'Expr']
+
+class Alt_Return_Spec(Base): # R1222
+ """
+ <alt-return-spec> = * <label>
+ """
+ subclass_names = []
+ use_names = ['Label']
+ def match(string):
+ if not string.startswith('*'): return
+ line = string[1:].lstrip()
+ if not line: return
+ return Label(line),
+ match = staticmethod(match)
+ def tostr(self): return '*%s' % (self.items[0])
+
+class Function_Subprogram(BlockBase): # R1223
+ """
+ <function-subprogram> = <function-stmt>
+ [ <specification-part> ]
+ [ <execution-part> ]
+ [ <internal-subprogram-part> ]
+ <end-function-stmt>
+ """
+ subclass_names = []
+ use_names = ['Function_Stmt', 'Specification_Part', 'Execution_Part',
+ 'Internal_Subprogram_Part', 'End_Function_Stmt']
+ def match(reader):
+ return BlockBase.match(Function_Stmt, [Specification_Part, Execution_Part, Internal_Subprogram_Part], End_Function_Stmt, reader)
+ match = staticmethod(match)
+
+class Function_Stmt(StmtBase): # R1224
+ """
+ <function-stmt> = [ <prefix> ] FUNCTION <function-name> ( [ <dummy-arg-name-list> ] ) [ <suffix> ]
+ """
+ subclass_names = []
+ use_names = ['Prefix','Function_Name','Dummy_Arg_Name_List', 'Suffix']
+
+class Proc_Language_Binding_Spec(Base): #1225
+ """
+ <proc-language-binding-spec> = <language-binding-spec>
+ """
+ subclass_names = ['Language_Binding_Spec']
+
+class Dummy_Arg_Name(Base): # R1226
+ """
+ <dummy-arg-name> = <name>
+ """
+ subclass_names = ['Name']
+
+class Prefix(SequenceBase): # R1227
+ """
+ <prefix> = <prefix-spec> [ <prefix-spec> ]..
+ """
+ subclass_names = ['Prefix_Spec']
+ _separator = (' ',re.compile(r'\s+(?=[a-z_])',re.I))
+ def match(string): return SequenceBase.match(Prefix._separator, Prefix_Spec, string)
+ match = staticmethod(match)
+
+class Prefix_Spec(STRINGBase): # R1228
+ """
+ <prefix-spec> = <declaration-type-spec>
+ | RECURSIVE
+ | PURE
+ | ELEMENTAL
+ """
+ subclass_names = ['Declaration_Type_Spec']
+ def match(string):
+ return STRINGBase.match(['RECURSIVE', 'PURE', 'ELEMENTAL'], string)
+ match = staticmethod(match)
+
+class Suffix(Base): # R1229
+ """
+ <suffix> = <proc-language-binding-spec> [ RESULT ( <result-name> ) ]
+ | RESULT ( <result-name> ) [ <proc-language-binding-spec> ]
+ """
+ subclass_names = ['Proc_Language_Binding_Spec']
+ use_names = ['Result_Name']
+
+ def match(string):
+ if string[:6].upper()=='RESULT':
+ line = string[6:].lstrip()
+ if not line.startswith('('): return
+ i = line.find(')')
+ if i==-1: return
+ name = line[1:i].strip()
+ if not name: return
+ line = line[i+1:].lstrip()
+ if line: return Result_Name(name), Proc_Language_Binding_Spec(line)
+ return Result_Name(name), None
+ if not string.endswith(')'): return
+ i = string.rfind('(')
+ if i==-1: return
+ name = string[i+1:-1].strip()
+ if not name: return
+ line = string[:i].rstrip()
+ if line[-6:].upper()!='RESULT': return
+ line = line[:-6].rstrip()
+ if not line: return
+ return Result_Name(name), Proc_Language_Binding_Spec(line)
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[1] is None:
+ return 'RESULT(%s)' % (self.items[0])
+ return 'RESULT(%s) %s' % self.items
+
+class End_Function_Stmt(EndStmtBase): # R1230
+ """
+ <end-function-stmt> = END [ FUNCTION [ <function-name> ] ]
+ """
+ subclass_names = []
+ use_names = ['Function_Name']
+ def match(string): return EndStmtBase.match('FUNCTION',Function_Name, string)
+ match = staticmethod(match)
+
+class Subroutine_Subprogram(BlockBase): # R1231
+ """
+ <subroutine-subprogram> = <subroutine-stmt>
+ [ <specification-part> ]
+ [ <execution-part> ]
+ [ <internal-subprogram-part> ]
+ <end-subroutine-stmt>
+ """
+ subclass_names = []
+ use_names = ['Subroutine_Stmt', 'Specification_Part', 'Execution_Part',
+ 'Internal_Subprogram_Part', 'End_Subroutine_Stmt']
+ def match(reader):
+ return BlockBase.match(Subroutine_Stmt, [Specification_Part, Execution_Part, Internal_Subprogram_Part], End_Subroutine_Stmt, reader)
+ match = staticmethod(match)
+
+class Subroutine_Stmt(StmtBase): # R1232
+ """
+ <subroutine-stmt> = [ <prefix> ] SUBROUTINE <subroutine-name> [ ( [ <dummy-arg-list> ] ) [ <proc-language-binding-spec> ] ]
+ """
+ subclass_names = []
+ use_names = ['Prefix', 'Subroutine_Name', 'Dummy_Arg_List', 'Proc_Language_Binding_Spec']
+ def match(string):
+ line, repmap = string_replace_map(string)
+ m = pattern.subroutine.search(line)
+ if m is None: return
+ prefix = line[:m.start()].rstrip() or None
+ if prefix is not None:
+ prefix = Prefix(repmap(prefix))
+ line = line[m.end():].lstrip()
+ m = pattern.name.match(line)
+ if m is None: return
+ name = Subroutine_Name(m.group())
+ line = line[m.end():].lstrip()
+ dummy_args = None
+ if line.startswith('('):
+ i = line.find(')')
+ if i==-1: return
+ dummy_args = line[1:i].strip() or None
+ if dummy_args is not None:
+ dummy_args = Dummy_Arg_List(repmap(dummy_args))
+ line = line[i+1:].lstrip()
+ binding_spec = None
+ if line:
+ binding_spec = Proc_Language_Binding_Spec(repmap(line))
+ return prefix, name, dummy_args, binding_spec
+ match = staticmethod(match)
+ def get_name(self): return self.items[1]
+ def tostr(self):
+ if self.items[0] is not None:
+ s = '%s SUBROUTINE %s' % (self.items[0], self.items[1])
+ else:
+ s = 'SUBROUTINE %s' % (self.items[1])
+ if self.items[2] is not None:
+ s += '(%s)' % (self.items[2])
+ if self.items[3] is not None:
+ s += ' %s' % (self.items[3])
+ return s
+
+class Dummy_Arg(StringBase): # R1233
+ """
+ <dummy-arg> = <dummy-arg-name>
+ | *
+ """
+ subclass_names = ['Dummy_Arg_Name']
+ def match(string): return StringBase.match('*', string)
+ match = staticmethod(match)
+
+class End_Subroutine_Stmt(EndStmtBase): # R1234
+ """
+ <end-subroutine-stmt> = END [ SUBROUTINE [ <subroutine-name> ] ]
+ """
+ subclass_names = []
+ use_names = ['Subroutine_Name']
+ def match(string): return EndStmtBase.match('SUBROUTINE', Subroutine_Name, string)
+ match = staticmethod(match)
+
+class Entry_Stmt(StmtBase): # R1235
+ """
+ <entry-stmt> = ENTRY <entry-name> [ ( [ <dummy-arg-list> ] ) [ <suffix> ] ]
+ """
+ subclass_names = []
+ use_names = ['Entry_Name', 'Dummy_Arg_List', 'Suffix']
+
+class Return_Stmt(StmtBase): # R1236
+ """
+ <return-stmt> = RETURN [ <scalar-int-expr> ]
+ """
+ subclass_names = []
+ use_names = ['Scalar_Int_Expr']
+ def match(string):
+ start = string[:6].upper()
+ if start!='RETURN': return
+ if len(string)==6: return None,
+ return Scalar_Int_Expr(string[6:].lstrip()),
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[0] is None: return 'RETURN'
+ return 'RETURN %s' % self.items
+
+class Contains_Stmt(StmtBase, STRINGBase): # R1237
+ """
+ <contains-stmt> = CONTAINS
+ """
+ subclass_names = []
+ def match(string): return STRINGBase.match('CONTAINS',string)
+ match = staticmethod(match)
+
+class Stmt_Function_Stmt(StmtBase): # R1238
+ """
+ <stmt-function-stmt> = <function-name> ( [ <dummy-arg-name-list> ] ) = Scalar_Expr
+ """
+ subclass_names = []
+ use_names = ['Function_Name', 'Dummy_Arg_Name_List', 'Scalar_Expr']
+
+ def match(string):
+ i = string.find('=')
+ if i==-1: return
+ expr = string[i+1:].lstrip()
+ if not expr: return
+ line = string[:i].rstrip()
+ if not line or not line.endswith(')'): return
+ i = line.find('(')
+ if i==-1: return
+ name = line[:i].rstrip()
+ if not name: return
+ args = line[i+1:-1].strip()
+ if args:
+ return Function_Name(name), Dummy_Arg_Name_List(args), Scalar_Expr(expr)
+ return Function_Name(name), None, Scalar_Expr(expr)
+ match = staticmethod(match)
+ def tostr(self):
+ if self.items[1] is None:
+ return '%s () = %s' % (self.items[0], self.items[2])
+ return '%s (%s) = %s' % self.items
+
+###############################################################################
+################ GENERATE Scalar_, _List, _Name CLASSES #######################
+###############################################################################
+
+ClassType = type(Base)
+_names = dir()
+for clsname in _names:
+ cls = eval(clsname)
+ if not (isinstance(cls, ClassType) and issubclass(cls, Base) and not cls.__name__.endswith('Base')): continue
+ names = getattr(cls, 'subclass_names', []) + getattr(cls, 'use_names', [])
+ for n in names:
+ if n in _names: continue
+ if n.endswith('_List'):
+ _names.append(n)
+ n = n[:-5]
+ #print 'Generating %s_List' % (n)
+ exec '''\
+class %s_List(SequenceBase):
+ subclass_names = [\'%s\']
+ use_names = []
+ def match(string): return SequenceBase.match(r\',\', %s, string)
+ match = staticmethod(match)
+''' % (n, n, n)
+ elif n.endswith('_Name'):
+ _names.append(n)
+ n = n[:-5]
+ #print 'Generating %s_Name' % (n)
+ exec '''\
+class %s_Name(Base):
+ subclass_names = [\'Name\']
+''' % (n)
+ elif n.startswith('Scalar_'):
+ _names.append(n)
+ n = n[7:]
+ #print 'Generating Scalar_%s' % (n)
+ exec '''\
+class Scalar_%s(Base):
+ subclass_names = [\'%s\']
+''' % (n,n)
+
+
+Base_classes = {}
+for clsname in dir():
+ cls = eval(clsname)
+ if isinstance(cls, ClassType) and issubclass(cls, Base) and not cls.__name__.endswith('Base'):
+ Base_classes[cls.__name__] = cls
+
+
+###############################################################################
+##################### OPTIMIZE subclass_names tree ############################
+###############################################################################
+
+if 1: # Optimize subclass tree:
+
+ def _rpl_list(clsname):
+ if not Base_classes.has_key(clsname):
+ print 'Not implemented:',clsname
+ return [] # remove this code when all classes are implemented
+ cls = Base_classes[clsname]
+ if cls.__dict__.has_key('match'): return [clsname]
+ l = []
+ for n in getattr(cls,'subclass_names',[]):
+ l1 = _rpl_list(n)
+ for n1 in l1:
+ if n1 not in l:
+ l.append(n1)
+ return l
+
+ for cls in Base_classes.values():
+ if not hasattr(cls, 'subclass_names'): continue
+ opt_subclass_names = []
+ for n in cls.subclass_names:
+ for n1 in _rpl_list(n):
+ if n1 not in opt_subclass_names: opt_subclass_names.append(n1)
+ if not opt_subclass_names==cls.subclass_names:
+ #print cls.__name__,':',', '.join(cls.subclass_names),'->',', '.join(opt_subclass_names)
+ cls.subclass_names[:] = opt_subclass_names
+ #else:
+ # print cls.__name__,':',opt_subclass_names
+
+
+# Initialize Base.subclasses dictionary:
+for clsname, cls in Base_classes.items():
+ subclass_names = getattr(cls, 'subclass_names', None)
+ if subclass_names is None:
+ print '%s class is missing subclass_names list' % (clsname)
+ continue
+ try:
+ l = Base.subclasses[clsname]
+ except KeyError:
+ Base.subclasses[clsname] = l = []
+ for n in subclass_names:
+ if Base_classes.has_key(n):
+ l.append(Base_classes[n])
+ else:
+ print '%s not implemented needed by %s' % (n,clsname)
+
+if 1:
+ for cls in Base_classes.values():
+ subclasses = Base.subclasses.get(cls.__name__,[])
+ subclasses_names = [c.__name__ for c in subclasses]
+ subclass_names = getattr(cls,'subclass_names', [])
+ use_names = getattr(cls,'use_names',[])
+ for n in subclasses_names:
+ break
+ if n not in subclass_names:
+ print '%s needs to be added to %s subclasses_name list' % (n,cls.__name__)
+ for n in subclass_names:
+ break
+ if n not in subclasses_names:
+ print '%s needs to be added to %s subclass_name list' % (n,cls.__name__)
+ for n in use_names + subclass_names:
+ if not Base_classes.has_key(n):
+ print '%s not defined used by %s' % (n, cls.__name__)
+
+
+#EOF
diff --git a/numpy/f2py/lib/parser/__init__.py b/numpy/f2py/lib/parser/__init__.py
new file mode 100644
index 000000000..9d707c01f
--- /dev/null
+++ b/numpy/f2py/lib/parser/__init__.py
@@ -0,0 +1,14 @@
+"""
+Tools for parsing Fortran 60/77/90/2003 codes into Statement tree.
+
+Use api module for importing public symbols.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: Oct 2006
+-----
+"""
diff --git a/numpy/f2py/lib/parser/api.py b/numpy/f2py/lib/parser/api.py
new file mode 100644
index 000000000..476c142e5
--- /dev/null
+++ b/numpy/f2py/lib/parser/api.py
@@ -0,0 +1,73 @@
+"""
+Public API for Fortran parser.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: Oct 2006
+-----
+"""
+
+import Fortran2003
+# import all Statement classes:
+from base_classes import EndStatement
+from block_statements import *
+
+# CHAR_BIT is used to convert object bit sizes to byte sizes
+from utils import CHAR_BIT
+
+def get_reader(input, isfree=None, isstrict=None, include_dirs = None):
+ import os
+ import re
+ from readfortran import FortranFileReader, FortranStringReader
+ from parsefortran import FortranParser
+ if os.path.isfile(input):
+ name,ext = os.path.splitext(input)
+ if ext.lower() in ['.c']:
+ # get signatures from C file comments starting with `/*f2py` and ending with `*/`.
+ # TODO: improve parser to take line number offset making line numbers in
+ # parser messages correct.
+ f2py_c_comments = re.compile('/[*]\s*f2py\s.*[*]/',re.I | re.M)
+ f = open(filename,'r')
+ c_input = ''
+ for s1 in f2py_c_comments.findall(f.read()):
+ c_input += s1[2:-2].lstrip()[4:] + '\n'
+ f.close()
+ if isfree is None: isfree = True
+ if isstrict is None: isstrict = True
+ return parse(c_input, isfree, isstrict, include_dirs)
+ reader = FortranFileReader(input,
+ include_dirs = include_dirs)
+ if isfree is None: isfree = reader.isfree
+ if isstrict is None: isstrict = reader.isstrict
+ reader.set_mode(isfree, isstrict)
+ elif isinstance(input, str):
+ if isfree is None: isfree = True
+ if isstrict is None: isstrict = False
+ reader = FortranStringReader(input,
+ isfree, isstrict,
+ include_dirs = include_dirs)
+ else:
+ raise TypeError,'Expected string or filename input but got %s' % (type(input))
+ return reader
+
+def parse(input, isfree=None, isstrict=None, include_dirs = None):
+ """ Parse input and return Statement tree.
+
+ input --- string or filename.
+ isfree, isstrict --- specify input Fortran format.
+ Defaults are True, False, respectively, or
+ determined from input.
+ include_dirs --- list of include directories.
+ Default contains current working directory
+ and the directory of file name.
+ """
+ from parsefortran import FortranParser
+ reader = get_reader(input, isfree, isstrict, include_dirs)
+ parser = FortranParser(reader)
+ parser.parse()
+ parser.analyze()
+ return parser.block
diff --git a/numpy/f2py/lib/parser/base_classes.py b/numpy/f2py/lib/parser/base_classes.py
new file mode 100644
index 000000000..68ea9c24a
--- /dev/null
+++ b/numpy/f2py/lib/parser/base_classes.py
@@ -0,0 +1,819 @@
+"""
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: May 2006
+-----
+"""
+
+__all__ = ['Statement','BeginStatement','EndStatement', 'Variable',
+ 'AttributeHolder','ProgramBlock']
+
+import re
+import sys
+import copy
+from readfortran import Line
+from numpy.distutils.misc_util import yellow_text, red_text
+from utils import split_comma, specs_split_comma, is_int_literal_constant
+
+class AttributeHolder:
+ # copied from symbolic.base module
+ """
+ Defines a object with predefined attributes. Only those attributes
+ are allowed that are specified as keyword arguments of a constructor.
+ When an argument is callable then the corresponding attribute will
+ be read-only and set by the value the callable object returns.
+ """
+ def __init__(self, **kws):
+ self._attributes = {}
+ self._readonly = []
+ for k,v in kws.items():
+ self._attributes[k] = v
+ if callable(v):
+ self._readonly.append(k)
+ return
+
+ def __getattr__(self, name):
+ if name not in self._attributes:
+ raise AttributeError,'%s instance has no attribute %r, '\
+ 'expected attributes: %s' \
+ % (self.__class__.__name__,name,
+ ','.join(self._attributes.keys()))
+ value = self._attributes[name]
+ if callable(value):
+ value = value()
+ self._attributes[name] = value
+ return value
+
+ def __setattr__(self, name, value):
+ if name in ['_attributes','_readonly']:
+ self.__dict__[name] = value
+ return
+ if name in self._readonly:
+ raise AttributeError,'%s instance attribute %r is readonly' \
+ % (self.__class__.__name__, name)
+ if name not in self._attributes:
+ raise AttributeError,'%s instance has no attribute %r, '\
+ 'expected attributes: %s' \
+ % (self.__class__.__name__,name,','.join(self._attributes.keys()))
+ self._attributes[name] = value
+
+ def isempty(self):
+ for k in self._attributes.keys():
+ v = getattr(self,k)
+ if v: return False
+ return True
+
+ def __repr__(self): return self.torepr()
+
+ def torepr(self, depth=-1, tab = ''):
+ if depth==0: return tab + self.__class__.__name__
+ l = [self.__class__.__name__+':']
+ ttab = tab + ' '
+ for k in self._attributes.keys():
+ v = getattr(self,k)
+ if v:
+ if isinstance(v,list):
+ l.append(ttab + '%s=<%s-list>' % (k,len(v)))
+ elif isinstance(v,dict):
+ l.append(ttab + '%s=<dict with keys %s>' % (k,v.keys()))
+ else:
+ l.append(ttab + '%s=<%s>' % (k,type(v)))
+ return '\n'.join(l)
+
+ def todict(self):
+ d = {}
+ for k in self._attributes.keys():
+ v = getattr(self, k)
+ d[k] = v
+ return d
+
+def get_base_classes(cls):
+ bases = ()
+ for c in cls.__bases__:
+ bases += get_base_classes(c)
+ return bases + cls.__bases__ + (cls,)
+
+class Variable:
+ """
+ Variable instance has attributes:
+ name
+ typedecl
+ dimension
+ attributes
+ intent
+ parent - Statement instances defining the variable
+ """
+ def __init__(self, parent, name):
+ self.parent = parent
+ self.parents = [parent]
+ self.name = name
+ self.typedecl = None
+ self.dimension = None
+ self.bounds = None
+ self.length = None
+ self.attributes = []
+ self.intent = None
+ self.bind = []
+ self.check = []
+ self.init = None
+
+ # after calling analyze the following additional attributes are set:
+ # .is_array:
+ # rank
+ # shape
+ return
+
+ def __repr__(self):
+ l = []
+ for a in ['name','typedecl','dimension','bounds','length','attributes','intent','bind','check','init']:
+ v = getattr(self,a)
+ if v:
+ l.append('%s=%r' % (a,v))
+ return 'Variable: ' + ', '.join(l)
+
+ def get_bit_size(self):
+ typesize = self.typedecl.get_bit_size()
+ if self.is_pointer():
+ # The size of pointer descriptor is compiler version dependent. Read:
+ # http://www.nersc.gov/vendor_docs/intel/f_ug1/pgwarray.htm
+ # https://www.cca-forum.org/pipermail/cca-fortran/2003-February/000123.html
+ # https://www.cca-forum.org/pipermail/cca-fortran/2003-February/000122.html
+ # On sgi descriptor size may be 128+ bits!
+ if self.is_array():
+ wordsize = 4 # XXX: on a 64-bit system it is 8.
+ rank = len(self.bounds or self.dimension)
+ return 6 * wordsize + 12 * rank
+ return typesize
+ if self.is_array():
+ size = reduce(lambda x,y:x*y,self.bounds or self.dimension,1)
+ if self.length:
+ size *= self.length
+ return size * typesize
+ if self.length:
+ return self.length * typesize
+ return typesize
+
+ def get_typedecl(self):
+ if self.typedecl is None:
+ self.set_type(self.parent.get_type(self.name))
+ return self.typedecl
+
+ def add_parent(self, parent):
+ if id(parent) not in map(id, self.parents):
+ self.parents.append(parent)
+ self.parent = parent
+ return
+
+ def set_type(self, typedecl):
+ if self.typedecl is not None:
+ if not self.typedecl==typedecl:
+ self.parent.warning(\
+ 'variable %r already has type %s,'\
+ ' resetting to %s' \
+ % (self.name, self.typedecl.tostr(),typedecl.tostr()))
+ assert typedecl is not None
+ self.typedecl = typedecl
+ return
+
+ def set_init(self, expr):
+ if self.init is not None:
+ if not self.init==expr:
+ self.parent.warning(\
+ 'variable %r already has initialization %r, '\
+ ' resetting to %r' % (self.name, self.expr, expr))
+ self.init = expr
+ return
+
+ def set_dimension(self, dims):
+ if self.dimension is not None:
+ if not self.dimension==dims:
+ self.parent.warning(\
+ 'variable %r already has dimension %r, '\
+ ' resetting to %r' % (self.name, self.dimension, dims))
+ self.dimension = dims
+ return
+
+ def set_bounds(self, bounds):
+ if self.bounds is not None:
+ if not self.bounds==bounds:
+ self.parent.warning(\
+ 'variable %r already has bounds %r, '\
+ ' resetting to %r' % (self.name, self.bounds, bounds))
+ self.bounds = bounds
+ return
+
+ def set_length(self, length):
+ if self.length is not None:
+ if not self.length==length:
+ self.parent.warning(\
+ 'variable %r already has length %r, '\
+ ' resetting to %r' % (self.name, self.length, length))
+ self.length = length
+ return
+
+ known_intent_specs = ['IN','OUT','INOUT','CACHE','HIDE', 'COPY',
+ 'OVERWRITE', 'CALLBACK', 'AUX', 'C', 'INPLACE',
+ 'OUT=']
+
+ def set_intent(self, intent):
+ if self.intent is None:
+ self.intent = []
+ for i in intent:
+ if i not in self.intent:
+ if i not in self.known_intent_specs:
+ self.parent.warning('unknown intent-spec %r for %r'\
+ % (i, self.name))
+ self.intent.append(i)
+ return
+
+ known_attributes = ['PUBLIC', 'PRIVATE', 'ALLOCATABLE', 'ASYNCHRONOUS',
+ 'EXTERNAL', 'INTRINSIC', 'OPTIONAL', 'PARAMETER',
+ 'POINTER', 'PROTECTED', 'SAVE', 'TARGET', 'VALUE',
+ 'VOLATILE', 'REQUIRED']
+
+ def is_intent_in(self):
+ if not self.intent: return True
+ if 'HIDE' in self.intent: return False
+ if 'INPLACE' in self.intent: return False
+ if 'IN' in self.intent: return True
+ if 'OUT' in self.intent: return False
+ if 'INOUT' in self.intent: return False
+ if 'OUTIN' in self.intent: return False
+ return True
+
+ def is_intent_inout(self):
+ if not self.intent: return False
+ if 'INOUT' in self.intent:
+ if 'IN' in self.intent or 'HIDE' in self.intent or 'INPLACE' in self.intent:
+ self.warning('INOUT ignored in INPUT(%s)' % (', '.join(self.intent)))
+ return False
+ return True
+ return False
+
+ def is_intent_hide(self):
+ if not self.intent: return False
+ if 'HIDE' in self.intent: return True
+ if 'OUT' in self.intent:
+ return 'IN' not in self.intent and 'INPLACE' not in self.intent and 'INOUT' not in self.intent
+ return False
+
+ def is_intent_inplace(self): return self.intent and 'INPLACE' in self.intent
+ def is_intent_out(self): return self.intent and 'OUT' in self.intent
+ def is_intent_c(self): return self.intent and 'C' in self.intent
+ def is_intent_cache(self): return self.intent and 'CACHE' in self.intent
+ def is_intent_copy(self): return self.intent and 'COPY' in self.intent
+ def is_intent_overwrite(self): return self.intent and 'OVERWRITE' in self.intent
+ def is_intent_callback(self): return self.intent and 'CALLBACK' in self.intent
+ def is_intent_aux(self): return self.intent and 'AUX' in self.intent
+
+ def is_private(self):
+ if 'PUBLIC' in self.attributes: return False
+ if 'PRIVATE' in self.attributes: return True
+ parent_attrs = self.parent.parent.a.attributes
+ if 'PUBLIC' in parent_attrs: return False
+ if 'PRIVATE' in parent_attrs: return True
+ return
+ def is_public(self): return not self.is_private()
+
+ def is_allocatable(self): return 'ALLOCATABLE' in self.attributes
+ def is_external(self): return 'EXTERNAL' in self.attributes
+ def is_intrinsic(self): return 'INTRINSIC' in self.attributes
+ def is_parameter(self): return 'PARAMETER' in self.attributes
+ def is_optional(self): return 'OPTIONAL' in self.attributes and 'REQUIRED' not in self.attributes and not self.is_intent_hide()
+ def is_required(self): return self.is_optional() and not self.is_intent_hide()
+ def is_pointer(self): return 'POINTER' in self.attributes
+
+ def is_array(self): return not not (self.bounds or self.dimension)
+ def is_scalar(self): return not self.is_array()
+
+ def update(self, *attrs):
+ attributes = self.attributes
+ if len(attrs)==1 and isinstance(attrs[0],(tuple,list)):
+ attrs = attrs[0]
+ for attr in attrs:
+ lattr = attr.lower()
+ uattr = attr.upper()
+ if lattr.startswith('dimension'):
+ assert self.dimension is None, `self.dimension,attr`
+ l = attr[9:].lstrip()
+ assert l[0]+l[-1]=='()',`l`
+ self.set_dimension(split_comma(l[1:-1].strip(), self.parent.item))
+ continue
+ if lattr.startswith('intent'):
+ l = attr[6:].lstrip()
+ assert l[0]+l[-1]=='()',`l`
+ self.set_intent(specs_split_comma(l[1:-1].strip(),
+ self.parent.item, upper=True))
+ continue
+ if lattr.startswith('bind'):
+ l = attr[4:].lstrip()
+ assert l[0]+l[-1]=='()',`l`
+ self.bind = specs_split_comma(l[1:-1].strip(), self.parent.item,
+ upper = True)
+ continue
+ if lattr.startswith('check'):
+ l = attr[5:].lstrip()
+ assert l[0]+l[-1]=='()',`l`
+ self.check.extend(split_comma(l[1:-1].strip()), self.parent.item)
+ continue
+ if uattr not in attributes:
+ if uattr not in self.known_attributes:
+ self.parent.warning('unknown attribute %r' % (attr))
+ attributes.append(uattr)
+ return
+
+ def __str__(self):
+ s = ''
+ typedecl = self.get_typedecl()
+ if typedecl is not None:
+ s += typedecl.tostr() + ' '
+ a = self.attributes[:]
+ if self.dimension is not None:
+ a.append('DIMENSION(%s)' % (', '.join(self.dimension)))
+ if self.intent is not None:
+ a.append('INTENT(%s)' % (', '.join(self.intent)))
+ if self.bind:
+ a.append('BIND(%s)' % (', '.join(self.bind)))
+ if self.check:
+ a.append('CHECK(%s)' % (', '.join(self.check)))
+ if a:
+ s += ', ' + ', '.join(a) + ' :: '
+ s += self.name
+ if self.bounds:
+ s += '(%s)' % (', '.join([':'.join(spec) for spec in self.bounds]))
+ if self.length:
+ if is_int_literal_constant(self.length):
+ s += '*%s' % (self.length)
+ else:
+ s += '*(%s)' % (self.length)
+ if self.init:
+ s += ' = ' + self.init
+ return s
+
+ def get_array_spec(self):
+ assert self.is_array(),'array_spec is available only for arrays'
+ if self.bounds:
+ if self.dimension:
+ self.parent.warning('both bounds=%r and dimension=%r are defined, ignoring dimension.' % (self.bounds, self.dimension))
+ array_spec = self.bounds
+ else:
+ array_spec = self.dimension
+ return array_spec
+
+ def is_deferred_shape_array(self):
+ if not self.is_array(): return False
+ return self.is_allocatable() or self.is_pointer()
+
+ def is_assumed_size_array(self):
+ if not self.is_array(): return False
+ return self.get_array_spec()[-1][-1]=='*'
+
+ def is_assumed_shape_array(self):
+ if not self.is_array(): return False
+ if self.is_deferred_shape_array(): return False
+ for spec in self.get_array_spec():
+ if not spec[-1]: return True
+ return False
+
+ def is_explicit_shape_array(self):
+ if not self.is_array(): return False
+ if self.is_deferred_shape_array(): return False
+ for spec in self.get_array_spec():
+ if not spec[-1] or spec[-1] == '*': return False
+ return True
+
+ def is_allocatable_array(self):
+ return self.is_array() and self.is_allocatable()
+
+ def is_array_pointer(self):
+ return self.is_array() and self.is_pointer()
+
+ def analyze(self):
+ typedecl = self.get_typedecl()
+ if self.is_array():
+ array_spec = self.get_array_spec()
+ self.rank = len(array_spec)
+ if self.is_deferred_shape_array(): # a(:,:)
+ pass
+ elif self.is_explicit_shape_array():
+ shape = []
+ for spec in array_spec:
+ if len(spec)==1:
+ shape.append(spec[0])
+ else:
+ shape.append(spec[1]-spec[0])
+ self.shape = shape
+ return
+
+class ProgramBlock:
+ pass
+
+class Statement:
+ """
+ Statement instance has attributes:
+ parent - Parent BeginStatement or FortranParser instance
+ item - Line instance containing the statement line
+ isvalid - boolean, when False, the Statement instance will be ignored
+ """
+ modes = ['free90','fix90','fix77','pyf']
+ _repr_attr_names = []
+
+ def __init__(self, parent, item):
+ self.parent = parent
+ if item is not None:
+ self.reader = item.reader
+ else:
+ self.reader = parent.reader
+ self.top = getattr(parent,'top',None) # the top of statement tree
+ self.item = item
+
+ if isinstance(parent, ProgramBlock):
+ self.programblock = parent
+ elif isinstance(self, ProgramBlock):
+ self.programblock = self
+ elif hasattr(parent,'programblock'):
+ self.programblock = parent.programblock
+ else:
+ #self.warning('%s.programblock attribute not set.' % (self.__class__.__name__))
+ pass
+
+ # when a statement instance is constructed by error, set isvalid to False
+ self.isvalid = True
+ # when a statement should be ignored, set ignore to True
+ self.ignore = False
+
+ # attribute a will hold analyze information.
+ a_dict = {}
+ for cls in get_base_classes(self.__class__):
+ if hasattr(cls,'a'):
+ a_dict.update(copy.deepcopy(cls.a.todict()))
+ self.a = AttributeHolder(**a_dict)
+ if hasattr(self.__class__,'a'):
+ assert self.a is not self.__class__.a
+
+ self.process_item()
+
+ return
+
+ def __repr__(self):
+ return self.torepr()
+
+ def torepr(self, depth=-1,incrtab=''):
+ tab = incrtab + self.get_indent_tab()
+ clsname = self.__class__.__name__
+ l = [tab + yellow_text(clsname)]
+ if depth==0:
+ return '\n'.join(l)
+ ttab = tab + ' '
+ for n in self._repr_attr_names:
+ attr = getattr(self, n, None)
+ if not attr: continue
+ if hasattr(attr, 'torepr'):
+ r = attr.torepr(depth-1,incrtab)
+ else:
+ r = repr(attr)
+ l.append(ttab + '%s=%s' % (n, r))
+ if self.item is not None: l.append(ttab + 'item=%r' % (self.item))
+ if not self.isvalid: l.append(ttab + 'isvalid=%r' % (self.isvalid))
+ if self.ignore: l.append(ttab + 'ignore=%r' % (self.ignore))
+ if not self.a.isempty():
+ l.append(ttab + 'a=' + self.a.torepr(depth-1,incrtab+' ').lstrip())
+ return '\n'.join(l)
+
+ def get_indent_tab(self,colon=None,deindent=False,isfix=None):
+ if isfix is None: isfix = self.reader.isfix
+ if isfix:
+ tab = ' '*6
+ else:
+ tab = ''
+ p = self.parent
+ while isinstance(p, Statement):
+ tab += ' '
+ p = p.parent
+ if deindent:
+ tab = tab[:-2]
+ if self.item is None:
+ return tab
+ s = self.item.label
+ if colon is None:
+ if isfix:
+ colon = ''
+ else:
+ colon = ':'
+ if s:
+ c = ''
+ if isfix:
+ c = ' '
+ tab = tab[len(c+s)+len(colon):]
+ if not tab: tab = ' '
+ tab = c + s + colon + tab
+ return tab
+
+ def __str__(self):
+ return self.tofortran()
+
+ def asfix(self):
+ lines = []
+ for line in self.tofortran(isfix=True).split('\n'):
+ if len(line)>72 and line[0]==' ':
+ lines.append(line[:72]+'&\n &')
+ line = line[72:]
+ while len(line)>66:
+ lines.append(line[:66]+'&\n &')
+ line = line[66:]
+ lines.append(line+'\n')
+ else: lines.append(line+'\n')
+ return ''.join(lines).replace('\n &\n','\n')
+
+ def format_message(self, kind, message):
+ if self.item is not None:
+ message = self.reader.format_message(kind, message,
+ self.item.span[0], self.item.span[1])
+ else:
+ return message
+ return message
+
+ def show_message(self, message, stream=sys.stderr):
+ print >> stream, message
+ stream.flush()
+ return
+
+ def error(self, message):
+ message = self.format_message('ERROR', red_text(message))
+ self.show_message(message)
+ return
+
+ def warning(self, message):
+ message = self.format_message('WARNING', yellow_text(message))
+ self.show_message(message)
+ return
+
+ def info(self, message):
+ message = self.format_message('INFO', message)
+ self.show_message(message)
+ return
+
+ def analyze(self):
+ self.warning('nothing analyzed')
+ return
+
+ def get_variable(self, name):
+ """ Return Variable instance of variable name.
+ """
+ mth = getattr(self,'get_variable_by_name', self.parent.get_variable)
+ return mth(name)
+
+ def get_type(self, name):
+ """ Return type declaration using implicit rules
+ for name.
+ """
+ mth = getattr(self,'get_type_by_name', self.parent.get_type)
+ return mth(name)
+
+ def get_type_decl(self, kind):
+ mth = getattr(self,'get_type_decl_by_kind', self.parent.get_type_decl)
+ return mth(kind)
+
+ def get_provides(self):
+ """ Returns dictonary containing statements that block provides or None when N/A.
+ """
+ return
+
+class BeginStatement(Statement):
+ """ <blocktype> <name>
+
+ BeginStatement instances have additional attributes:
+ name
+ blocktype
+
+ Block instance has attributes:
+ content - list of Line or Statement instances
+ name - name of the block, unnamed blocks are named
+ with the line label
+ parent - Block or FortranParser instance
+ item - Line instance containing the block start statement
+ get_item, put_item - methods to retrive/submit Line instances
+ from/to Fortran reader.
+ isvalid - boolean, when False, the Block instance will be ignored.
+
+ stmt_cls, end_stmt_cls
+
+ """
+ _repr_attr_names = ['blocktype','name'] + Statement._repr_attr_names
+ def __init__(self, parent, item=None):
+
+ self.content = []
+ self.get_item = parent.get_item # get line function
+ self.put_item = parent.put_item # put line function
+ if not hasattr(self, 'blocktype'):
+ self.blocktype = self.__class__.__name__.lower()
+ if not hasattr(self, 'name'):
+ # process_item may change this
+ self.name = '__'+self.blocktype.upper()+'__'
+ Statement.__init__(self, parent, item)
+ return
+
+ def tostr(self):
+ return self.blocktype.upper() + ' '+ self.name
+
+ def tofortran(self, isfix=None):
+ l=[self.get_indent_tab(colon=':', isfix=isfix) + self.tostr()]
+ for c in self.content:
+ l.append(c.tofortran(isfix=isfix))
+ return '\n'.join(l)
+
+ def torepr(self, depth=-1, incrtab=''):
+ tab = incrtab + self.get_indent_tab()
+ ttab = tab + ' '
+ l=[Statement.torepr(self, depth=depth,incrtab=incrtab)]
+ if depth==0 or not self.content:
+ return '\n'.join(l)
+ l.append(ttab+'content:')
+ for c in self.content:
+ if isinstance(c,EndStatement):
+ l.append(c.torepr(depth-1,incrtab))
+ else:
+ l.append(c.torepr(depth-1,incrtab + ' '))
+ return '\n'.join(l)
+
+ def process_item(self):
+ """ Process the line
+ """
+ item = self.item
+ if item is None: return
+ self.fill()
+ return
+
+ def fill(self, end_flag = False):
+ """
+ Fills blocks content until the end of block statement.
+ """
+
+ mode = self.reader.mode
+ classes = self.get_classes()
+ self.classes = [cls for cls in classes if mode in cls.modes]
+ self.pyf_classes = [cls for cls in classes if 'pyf' in cls.modes]
+
+ item = self.get_item()
+ while item is not None:
+ if isinstance(item, Line):
+ if self.process_subitem(item):
+ end_flag = True
+ break
+ item = self.get_item()
+
+ if not end_flag:
+ self.warning('failed to find the end of block')
+ return
+
+ def process_subitem(self, item):
+ """
+ Check is item is blocks start statement, if it is, read the block.
+
+ Return True to stop adding items to given block.
+ """
+ line = item.get_line()
+
+ # First check for the end of block
+ cls = self.end_stmt_cls
+ if cls.match(line):
+ stmt = cls(self, item)
+ if stmt.isvalid:
+ self.content.append(stmt)
+ return True
+
+ if item.is_f2py_directive:
+ classes = self.pyf_classes
+ else:
+ classes = self.classes
+
+ # Look for statement match
+ for cls in classes:
+ if cls.match(line):
+ stmt = cls(self, item)
+ if stmt.isvalid:
+ if not stmt.ignore:
+ self.content.append(stmt)
+ return False
+ # item may be cloned that changes the items line:
+ line = item.get_line()
+
+ # Check if f77 code contains inline comments or other f90
+ # constructs that got undetected by get_source_info.
+ if item.reader.isfix77:
+ i = line.find('!')
+ if i != -1:
+ message = item.reader.format_message(\
+ 'WARNING',
+ 'no parse pattern found for "%s" in %r block'\
+ ' maybe due to inline comment.'\
+ ' Trying to remove the comment.'\
+ % (item.get_line(),self.__class__.__name__),
+ item.span[0], item.span[1])
+ # .. but at the expense of loosing the comment.
+ self.show_message(message)
+ newitem = item.copy(line[:i].rstrip())
+ return self.process_subitem(newitem)
+
+ # try fix90 statement classes
+ f77_classes = self.classes
+ classes = []
+ for cls in self.get_classes():
+ if 'fix90' in cls.modes and cls not in f77_classes:
+ classes.append(cls)
+ if classes:
+ message = item.reader.format_message(\
+ 'WARNING',
+ 'no parse pattern found for "%s" in %r block'\
+ ' maybe due to strict f77 mode.'\
+ ' Trying f90 fix mode patterns..'\
+ % (item.get_line(),self.__class__.__name__),
+ item.span[0], item.span[1])
+ self.show_message(message)
+
+ item.reader.set_mode(False, False)
+ self.classes = classes
+
+ r = BeginStatement.process_subitem(self, item)
+ if r is None:
+ # restore f77 fix mode
+ self.classes = f77_classes
+ item.reader.set_mode(False, True)
+ else:
+ message = item.reader.format_message(\
+ 'INFORMATION',
+ 'The f90 fix mode resolved the parse pattern issue.'\
+ ' Setting reader to f90 fix mode.',
+ item.span[0], item.span[1])
+ self.show_message(message)
+ # set f90 fix mode
+ self.classes = f77_classes + classes
+ self.reader.set_mode(False, False)
+ return r
+
+ self.handle_unknown_item(item)
+ return
+
+ def handle_unknown_item(self, item):
+ message = item.reader.format_message(\
+ 'WARNING',
+ 'no parse pattern found for "%s" in %r block.'\
+ % (item.get_line(),self.__class__.__name__),
+ item.span[0], item.span[1])
+ self.show_message(message)
+ self.content.append(item)
+ #sys.exit()
+ return
+
+ def analyze(self):
+ for stmt in self.content:
+ stmt.analyze()
+ return
+
+class EndStatement(Statement):
+ """
+ END [<blocktype> [<name>]]
+
+ EndStatement instances have additional attributes:
+ name
+ blocktype
+ """
+ _repr_attr_names = ['blocktype','name'] + Statement._repr_attr_names
+
+ def __init__(self, parent, item):
+ if not hasattr(self, 'blocktype'):
+ self.blocktype = self.__class__.__name__.lower()[3:]
+ Statement.__init__(self, parent, item)
+
+ def process_item(self):
+ item = self.item
+ line = item.get_line().replace(' ','')[3:]
+ blocktype = self.blocktype
+ if line.lower().startswith(blocktype):
+ line = line[len(blocktype):].strip()
+ else:
+ if line:
+ # not the end of expected block
+ line = ''
+ self.isvalid = False
+ if line:
+ if not line==self.parent.name:
+ self.warning(\
+ 'expected the end of %r block but got the end of %r, skipping.'\
+ % (self.parent.name, line))
+ self.isvalid = False
+ self.name = self.parent.name
+
+ def analyze(self):
+ return
+
+ def get_indent_tab(self,colon=None,deindent=False,isfix=None):
+ return Statement.get_indent_tab(self, colon=colon, deindent=True,isfix=isfix)
+
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'END %s %s'\
+ % (self.blocktype.upper(),self.name or '')
diff --git a/numpy/f2py/lib/parser/block_statements.py b/numpy/f2py/lib/parser/block_statements.py
new file mode 100644
index 000000000..b3d29c911
--- /dev/null
+++ b/numpy/f2py/lib/parser/block_statements.py
@@ -0,0 +1,1229 @@
+"""
+Fortran block statements.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: May 2006
+-----
+"""
+
+__all__ = ['BeginSource','Module','PythonModule','Program','BlockData','Interface',
+ 'Subroutine','Function','Select','WhereConstruct','ForallConstruct',
+ 'IfThen','If','Do','Associate','TypeDecl','Enum',
+ 'EndSource','EndModule','EndPythonModule','EndProgram','EndBlockData','EndInterface',
+ 'EndSubroutine','EndFunction','EndSelect','EndWhere','EndForall',
+ 'EndIfThen','EndDo','EndAssociate','EndType','EndEnum',
+ ]
+
+import re
+import sys
+
+from base_classes import BeginStatement, EndStatement, Statement,\
+ AttributeHolder, ProgramBlock, Variable
+from readfortran import Line
+from utils import filter_stmts, parse_bind, parse_result, AnalyzeError, is_name
+
+class HasImplicitStmt:
+
+ a = AttributeHolder(implicit_rules = {})
+
+ def get_type_by_name(self, name):
+ implicit_rules = self.a.implicit_rules
+ if implicit_rules is None:
+ raise AnalyzeError,'Implicit rules mapping is null while getting %r type' % (name)
+ l = name[0].lower()
+ if implicit_rules.has_key(l):
+ return implicit_rules[l]
+ # default rules:
+ if l in 'ijklmn':
+ l = 'default_integer'
+ else:
+ l = 'default_real'
+ t = implicit_rules.get(l, None)
+ if t is None:
+ if l[8:]=='real':
+ implicit_rules[l] = t = Real(self, self.item.copy('real'))
+ else:
+ implicit_rules[l] = t = Integer(self, self.item.copy('integer'))
+ return t
+
+ def topyf(self, tab=' '):
+ implicit_rules = self.a.implicit_rules
+ if implicit_rules is None:
+ return tab + 'IMPLICIT NONE\n'
+ items = {}
+ for c,t in implicit_rules.items():
+ if c.startswith('default'):
+ continue
+ st = t.tostr()
+ if items.has_key(st):
+ items[st].append(c)
+ else:
+ items[st] = [c]
+ if not items:
+ return tab + '! default IMPLICIT rules apply\n'
+ s = 'IMPLICIT'
+ ls = []
+ for st,l in items.items():
+ l.sort()
+ ls.append(st + ' (%s)' % (', '.join(l)))
+ s += ' ' + ', '.join(ls)
+ return tab + s + '\n'
+
+class HasUseStmt:
+
+ a = AttributeHolder(use = {},
+ use_provides = {})
+
+ def get_entity(self, name):
+ for modname, modblock in self.top.a.module.items():
+ for stmt in modblock.content:
+ if getattr(stmt,'name','') == name:
+ return stmt
+ return
+
+ def topyf(self, tab=' '):
+ sys.stderr.write('HasUseStmt.topyf not implemented\n')
+ return ''
+
+class AccessSpecs:
+
+ a = AttributeHolder(private_id_list = [], public_id_list = [])
+
+ def topyf(self, tab=' '):
+ private_list = self.a.private_id_list
+ public_list = self.a.public_id_list
+ l = []
+ if '' in private_list: l.append(tab + 'PRIVATE\n')
+ if '' in public_list: l.append(tab + 'PUBLIC\n')
+ for a in private_list:
+ if not a: continue
+ l.append(tab + 'PRIVATE :: %s\n' % (a))
+ for a in public_list:
+ if not a: continue
+ l.append(tab + 'PUBLIC :: %s\n' % (a))
+ return ''.join(l)
+
+class HasVariables:
+
+ a = AttributeHolder(variables = {},
+ variable_names = [] # defines the order of declarations
+ )
+
+ def get_variable_by_name(self, name):
+ variables = self.a.variables
+ if variables.has_key(name):
+ var = variables[name]
+ else:
+ var = variables[name] = Variable(self, name)
+ self.a.variable_names.append(name)
+ return var
+
+ def topyf(self,tab='', only_variables = None):
+ s = ''
+ if only_variables is None:
+ only_variables = self.a.variables.keys()
+ for name in only_variables:
+ var = self.a.variables[name]
+ s += tab + str(var) + '\n'
+ return s
+
+class HasTypeDecls:
+
+ a = AttributeHolder(type_decls = {})
+
+ def topyf(self, tab=''):
+ s = ''
+ for name, stmt in self.a.type_decls.items():
+ s += stmt.topyf(tab=' '+tab)
+ return s
+
+ def get_type_decl_by_kind(self, kind):
+ type_decls = self.a.type_decls
+ type_decl = type_decls.get(kind, None)
+ if type_decl is None:
+ return self.get_entity(kind)
+ return type_decl
+
+class HasAttributes:
+
+ known_attributes = []
+ a = AttributeHolder(attributes = [])
+
+ def topyf(self, tab=''):
+ s = ''
+ for attr in self.a.attributes:
+ s += tab + attr + '\n'
+ return s
+
+ def update_attributes(self,*attrs):
+ attributes = self.a.attributes
+ known_attributes = self.known_attributes
+ if len(attrs)==1 and isinstance(attrs[0],(tuple,list)):
+ attrs = attrs[0]
+ for attr in attrs:
+ uattr = attr.upper()
+ if uattr not in attributes:
+ if isinstance(known_attributes,(list, tuple)):
+ if uattr not in known_attributes:
+ self.warning('unknown attribute %r' % (attr))
+ elif not known_attributes(uattr):
+ self.warning('unknown attribute %r' % (attr))
+ attributes.append(uattr)
+ return
+
+class HasModuleProcedures:
+
+ a = AttributeHolder(module_procedures = [])
+
+# File block
+
+class EndSource(EndStatement):
+ """
+ Dummy End statement for BeginSource.
+ """
+ match = staticmethod(lambda s: False)
+
+class BeginSource(BeginStatement):
+ """
+ Fortran source content.
+ """
+ match = staticmethod(lambda s: True)
+ end_stmt_cls = EndSource
+ a = AttributeHolder(module = {},
+ external_subprogram = {},
+ blockdata = {},
+ )
+
+ def tostr(self):
+ return '!' + self.blocktype.upper() + ' '+ self.name
+
+ def process_item(self):
+ self.name = self.reader.name
+ self.top = self
+ self.fill(end_flag = True)
+ return
+
+ def analyze(self):
+ for stmt in self.content:
+ if isinstance(stmt, Module):
+ stmt.analyze()
+ self.a.module[stmt.name] = stmt
+ elif isinstance(stmt, SubProgramStatement):
+ stmt.analyze()
+ self.a.external_subprogram[stmt.name] = stmt
+ elif isinstance(stmt, BlockData):
+ stmt.analyze()
+ self.a.blockdata[stmt.name] = stmt
+ else:
+ stmt.analyze()
+ return
+
+ def get_classes(self):
+ if self.reader.ispyf:
+ return [PythonModule] + program_unit
+ return program_unit
+
+ def process_subitem(self, item):
+ # MAIN block does not define start/end line conditions,
+ # so it should never end until all lines are read.
+ # However, sometimes F77 programs lack the PROGRAM statement,
+ # and here we fix that:
+ if self.reader.isfix77:
+ line = item.get_line()
+ if line=='end':
+ message = item.reader.format_message(\
+ 'WARNING',
+ 'assuming the end of undefined PROGRAM statement',
+ item.span[0],item.span[1])
+ print >> sys.stderr, message
+ p = Program(self)
+ p.content.extend(self.content)
+ p.content.append(EndProgram(p,item))
+ self.content[:] = [p]
+ return
+ return BeginStatement.process_subitem(self, item)
+
+ def topyf(self, tab=''): # XXXX
+ s = ''
+ for name, stmt in self.a.module.items():
+ s += stmt.topyf(tab=tab)
+ for name, stmt in self.a.external_subprogram.items():
+ s += stmt.topyf(tab=tab)
+ for name, stmt in self.a.blockdata.items():
+ s += stmt.topyf(tab=tab)
+ return s
+# Module
+
+class EndModule(EndStatement):
+ match = re.compile(r'end(\s*module\s*\w*|)\Z', re.I).match
+
+class Module(BeginStatement, HasAttributes,
+ HasImplicitStmt, HasUseStmt, HasVariables,
+ HasTypeDecls, AccessSpecs):
+ """
+ MODULE <name>
+ ..
+ END [MODULE [name]]
+ """
+ match = re.compile(r'module\s*\w+\Z', re.I).match
+ end_stmt_cls = EndModule
+
+ a = AttributeHolder(module_subprogram = {},
+ module_provides = {}, # all symbols that are public and so
+ # can be imported via USE statement
+ # by other blocks
+ module_interface = {}
+ )
+
+ known_attributes = ['PUBLIC', 'PRIVATE']
+
+ def get_classes(self):
+ return access_spec + specification_part + module_subprogram_part
+
+ def process_item(self):
+ name = self.item.get_line().replace(' ','')[len(self.blocktype):].strip()
+ self.name = name
+ return BeginStatement.process_item(self)
+
+ def get_provides(self):
+ return self.a.module_provides
+
+ def get_interface(self):
+ return self.a.module_interface
+
+ def analyze(self):
+ content = self.content[:]
+
+ while content:
+ stmt = content.pop(0)
+ if isinstance(stmt, Contains):
+ for stmt in filter_stmts(content, SubProgramStatement):
+ stmt.analyze()
+ self.a.module_subprogram[stmt.name] = stmt
+ stmt = content.pop(0)
+ assert isinstance(stmt, EndModule),`stmt`
+ continue
+ stmt.analyze()
+
+ if content:
+ self.show_message('Not analyzed content: %s' % content)
+
+ #module_provides = self.a.module_provides
+ #for name, var in self.a.variables.items():
+ # if var.is_public():
+ # if module_provides.has_key(name):
+ # self.warning('module data object name conflict with %s, overriding.' % (name))
+ # module_provides[name] = var
+
+ return
+
+ def topyf(self, tab=''):
+ s = tab + 'MODULE '+self.name + '\n'
+ s += HasImplicitStmt.topyf(self, tab=tab+' ')
+ s += AccessSpecs.topyf(self, tab=tab+' ')
+ s += HasAttributes.topyf(self, tab=tab+' ')
+ s += HasTypeDecls.topyf(self, tab=tab+' ')
+ s += HasVariables.topyf(self, tab=tab+' ')
+ for name, stmt in self.a.module_interface.items():
+ s += stmt.topyf(tab=tab+' ')
+ s += tab + ' CONTAINS\n'
+ for name, stmt in self.a.module_subprogram.items():
+ s += stmt.topyf(tab=tab+' ')
+ s += tab + 'END MODULE ' + self.name + '\n'
+ return s
+
+# Python Module
+
+class EndPythonModule(EndStatement):
+ match = re.compile(r'end(\s*python\s*module\s*\w*|)\Z', re.I).match
+
+class PythonModule(BeginStatement, HasImplicitStmt, HasUseStmt):
+ """
+ PYTHON MODULE <name>
+ ..
+ END [PYTHON MODULE [name]]
+ """
+ modes = ['pyf']
+ match = re.compile(r'python\s*module\s*\w+\Z', re.I).match
+ end_stmt_cls = EndPythonModule
+
+ def get_classes(self):
+ return [Interface, Function, Subroutine, Module]
+
+ def process_item(self):
+ self.name = self.item.get_line().replace(' ','')\
+ [len(self.blocktype):].strip()
+ return BeginStatement.process_item(self)
+
+# Program
+
+class EndProgram(EndStatement):
+ """
+ END [PROGRAM [name]]
+ """
+ match = re.compile(r'end(\s*program\s*\w*|)\Z', re.I).match
+
+class Program(BeginStatement, ProgramBlock,
+ #HasAttributes, # XXX: why Program needs .attributes?
+ HasImplicitStmt, HasUseStmt, AccessSpecs):
+ """ PROGRAM [name]
+ """
+ match = re.compile(r'program\s*\w*\Z', re.I).match
+ end_stmt_cls = EndProgram
+
+ def get_classes(self):
+ return specification_part + execution_part + internal_subprogram_part
+
+ def process_item(self):
+ if self.item is not None:
+ name = self.item.get_line().replace(' ','')\
+ [len(self.blocktype):].strip()
+ if name:
+ self.name = name
+ return BeginStatement.process_item(self)
+
+# BlockData
+
+class EndBlockData(EndStatement):
+ """
+ END [ BLOCK DATA [ <block-data-name> ] ]
+ """
+ match = re.compile(r'end(\s*block\s*data\s*\w*|)\Z', re.I).match
+ blocktype = 'blockdata'
+
+class BlockData(BeginStatement, HasImplicitStmt, HasUseStmt,
+ HasVariables, AccessSpecs):
+ """
+ BLOCK DATA [ <block-data-name> ]
+ """
+ end_stmt_cls = EndBlockData
+ match = re.compile(r'block\s*data\s*\w*\Z', re.I).match
+
+ def process_item(self):
+ self.name = self.item.get_line()[5:].lstrip()[4:].lstrip()
+ return BeginStatement.process_item(self)
+
+ def get_classes(self):
+ return specification_part
+
+# Interface
+
+class EndInterface(EndStatement):
+ match = re.compile(r'end\s*interface\s*\w*\Z', re.I).match
+ blocktype = 'interface'
+
+class Interface(BeginStatement, HasImplicitStmt, HasUseStmt,
+ HasModuleProcedures, AccessSpecs
+ ):
+ """
+ INTERFACE [<generic-spec>] | ABSTRACT INTERFACE
+ END INTERFACE [<generic-spec>]
+
+ <generic-spec> = <generic-name>
+ | OPERATOR ( <defined-operator> )
+ | ASSIGNMENT ( = )
+ | <dtio-generic-spec>
+ <dtio-generic-spec> = READ ( FORMATTED )
+ | READ ( UNFORMATTED )
+ | WRITE ( FORMATTED )
+ | WRITE ( UNFORMATTED )
+
+ """
+ modes = ['free90', 'fix90', 'pyf']
+ match = re.compile(r'(interface\s*(\w+\s*\(.*\)|\w*)|abstract\s*interface)\Z',re.I).match
+ end_stmt_cls = EndInterface
+ blocktype = 'interface'
+
+ a = AttributeHolder(interface_provides = {})
+
+ def get_classes(self):
+ l = intrinsic_type_spec + interface_specification
+ if self.reader.mode=='pyf':
+ return [Subroutine, Function] + l
+ return l
+
+ def process_item(self):
+ line = self.item.get_line()
+ self.isabstract = line.startswith('abstract')
+ if self.isabstract:
+ self.generic_spec = ''
+ else:
+ self.generic_spec = line[len(self.blocktype):].strip()
+ self.name = self.generic_spec # XXX
+ return BeginStatement.process_item(self)
+
+ def tostr(self):
+ if self.isabstract:
+ return 'ABSTRACT INTERFACE'
+ return 'INTERFACE '+ str(self.generic_spec)
+
+ #def get_provides(self):
+ # return self.a.interface_provides
+
+ def analyze(self):
+ content = self.content[:]
+
+ while content:
+ stmt = content.pop(0)
+ if isinstance(stmt, self.end_stmt_cls):
+ break
+ stmt.analyze()
+ #assert isinstance(stmt, SubProgramStatement),`stmt.__class__.__name__`
+ if content:
+ self.show_message('Not analyzed content: %s' % content)
+
+ if self.parent.a.variables.has_key(self.name):
+ var = self.parent.a.variables.pop(self.name)
+ self.update_attributes(var.attributes)
+
+ parent_interface = self.parent.get_interface()
+ if parent_interface.has_key(self.name):
+ p = parent_interface[self.name]
+ last = p.content.pop()
+ assert isinstance(last,EndInterface),`last.__class__`
+ p.content += self.content
+ p.update_attributes(self.a.attributes)
+ else:
+ parent_interface[self.name] = self
+ return
+
+ def topyf(self, tab=''):
+ s = tab + self.tostr() + '\n'
+ s += HasImplicitStmt.topyf(self, tab=tab+' ')
+ s += HasAttributes.topyf(self, tab=tab+' ')
+ s += HasUseStmt.topyf(self, tab=tab+' ')
+ s += tab + 'END' + self.tostr() + '\n'
+ return s
+
+# Subroutine
+
+class SubProgramStatement(BeginStatement, ProgramBlock,
+ HasImplicitStmt, HasAttributes,
+ HasUseStmt,
+ HasVariables, HasTypeDecls, AccessSpecs
+ ):
+ """
+ [ <prefix> ] <FUNCTION|SUBROUTINE> <name> [ ( <args> ) ] [ <suffix> ]
+ """
+
+ a = AttributeHolder(internal_subprogram = {})
+
+ def process_item(self):
+ clsname = self.__class__.__name__.lower()
+ item = self.item
+ line = item.get_line()
+ m = self.match(line)
+ i = line.lower().find(clsname)
+ assert i!=-1,`clsname, line`
+ self.prefix = line[:i].rstrip()
+ self.name = line[i:m.end()].lstrip()[len(clsname):].strip()
+ line = line[m.end():].lstrip()
+ args = []
+ if line.startswith('('):
+ i = line.find(')')
+ assert i!=-1,`line`
+ line2 = item.apply_map(line[:i+1])
+ for a in line2[1:-1].split(','):
+ a=a.strip()
+ if not a: continue
+ args.append(a)
+ line = line[i+1:].lstrip()
+ suffix = item.apply_map(line)
+ self.bind, suffix = parse_bind(suffix, item)
+ self.result = None
+ if isinstance(self, Function):
+ self.result, suffix = parse_result(suffix, item)
+ if suffix:
+ assert self.bind is None,`self.bind`
+ self.bind, suffix = parse_result(suffix, item)
+ if self.result is None:
+ self.result = self.name
+ assert not suffix,`suffix`
+ self.args = args
+ self.typedecl = None
+ return BeginStatement.process_item(self)
+
+ def tostr(self):
+ clsname = self.__class__.__name__.upper()
+ s = ''
+ if self.prefix:
+ s += self.prefix + ' '
+ if self.typedecl is not None:
+ assert isinstance(self, Function),`self.__class__.__name__`
+ s += self.typedecl.tostr() + ' '
+ s += clsname
+ suf = ''
+ if self.result and self.result!=self.name:
+ suf += ' RESULT ( %s )' % (self.result)
+ if self.bind:
+ suf += ' BIND ( %s )' % (', '.join(self.bind))
+ return '%s %s(%s)%s' % (s, self.name,', '.join(self.args),suf)
+
+ def get_classes(self):
+ return f2py_stmt + specification_part + execution_part \
+ + internal_subprogram_part
+
+ def analyze(self):
+ content = self.content[:]
+
+ if self.prefix:
+ self.update_attributes(prefix.upper().split())
+
+ variables = self.a.variables
+ for a in self.args:
+ assert not variables.has_key(a)
+ assert is_name(a)
+ variables[a] = Variable(self, a)
+
+ if isinstance(self, Function):
+ var = variables[self.result] = Variable(self, self.result)
+ if self.typedecl is not None:
+ var.set_type(self.typedecl)
+
+ while content:
+ stmt = content.pop(0)
+ if isinstance(stmt, Contains):
+ for stmt in filter_stmts(content, SubProgramStatement):
+ stmt.analyze()
+ self.a.internal_subprogram[stmt.name] = stmt
+ stmt = content.pop(0)
+ assert isinstance(stmt, self.end_stmt_cls),`stmt`
+ elif isinstance(stmt, self.end_stmt_cls):
+ continue
+ else:
+ stmt.analyze()
+
+ if content:
+ self.show_message('Not analyzed content: %s' % content)
+
+ #parent_provides = self.parent.get_provides()
+ #if parent_provides is not None:
+ # if self.is_public():
+ # if parent_provides.has_key(self.name):
+ # self.warning('module subprogram name conflict with %s, overriding.' % (self.name))
+ # parent_provides[self.name] = self
+
+ return
+
+ def topyf(self, tab=''):
+ s = tab + self.__class__.__name__.upper()
+ s += ' ' + self.name + ' (%s)' % (', '.join(self.args))
+ if isinstance(self, Function) and self.result != self.name:
+ s += ' RESULT (%s)' % (self.result)
+ s += '\n'
+ s += HasImplicitStmt.topyf(self, tab=tab+' ')
+ s += AccessSpecs.topyf(self, tab=tab+' ')
+ s += HasTypeDecls.topyf(self, tab=tab+' ')
+ s += HasVariables.topyf(self, tab=tab+' ', only_variables = self.args)
+ s += tab + 'END ' + self.__class__.__name__.upper() + ' ' + self.name + '\n'
+ return s
+
+class EndSubroutine(EndStatement):
+ """
+ END [SUBROUTINE [name]]
+ """
+ match = re.compile(r'end(\s*subroutine\s*\w*|)\Z', re.I).match
+
+
+class Subroutine(SubProgramStatement):
+ """
+ [ <prefix> ] SUBROUTINE <name> [ ( [ <dummy-arg-list> ] ) [ <proc-language-binding-spec> ]]
+ """
+ end_stmt_cls = EndSubroutine
+ match = re.compile(r'(recursive|pure|elemental|\s)*subroutine\s*\w+', re.I).match
+ _repr_attr_names = ['prefix','bind','suffix','args'] + Statement._repr_attr_names
+
+# Function
+
+class EndFunction(EndStatement):
+ """
+ END [FUNCTION [name]]
+ """
+ match = re.compile(r'end(\s*function\s*\w*|)\Z', re.I).match
+
+class Function(SubProgramStatement):
+ """
+ [ <prefix> ] FUNCTION <name> ( [<dummy-arg-list>] ) [<suffix>]
+ <prefix> = <prefix-spec> [ <prefix-spec> ]...
+ <prefix-spec> = <declaration-type-spec>
+ | RECURSIVE | PURE | ELEMENTAL
+ <suffix> = <proc-language-binding-spec> [ RESULT ( <result-name> ) ]
+ | RESULT ( <result-name> ) [ <proc-language-binding-spec> ]
+ """
+ end_stmt_cls = EndFunction
+ match = re.compile(r'(recursive|pure|elemental|\s)*function\s*\w+', re.I).match
+ _repr_attr_names = ['prefix','bind','suffix','args','typedecl'] + Statement._repr_attr_names
+
+ def subroutine_wrapper_code(self):
+ name = 'f2pywrap_' + self.name
+ args = ['f2pyvalue_'+self.result] + self.args
+ var = self.a.variables[self.result]
+ typedecl = var.get_typedecl().astypedecl()
+ lines = []
+ tab = ' '*6
+ lines.append('%sSUBROUTINE %s(%s)' % (tab, name, ', '.join(args)))
+ if isinstance(self.parent,Module):
+ lines.append('%s USE %s' % (tab, self.parent.name))
+ else:
+ if isinstance(typedecl, TypeStmt):
+ type_decl = typedecl.get_type_decl(typedecl.name)
+ if type_decl.parent is self:
+ for line in str(type_decl).split('\n'):
+ lines.append('%s %s' % (tab, line.lstrip()))
+ lines.append('%s EXTERNAL %s' % (tab, self.name))
+ lines.append('%s %s %s' % (tab, str(typedecl).lstrip(), self.name))
+ lines.append('%s %s %s' % (tab, str(typedecl).lstrip(), args[0]))
+ lines.append('!f2py intent(out) %s' % (args[0]))
+ for a in self.args:
+ v = self.a.variables[a]
+ lines.append('%s %s' % (tab, str(v).lstrip()))
+ lines.append('%s %s = %s(%s)' % (tab, args[0], self.name, ', '.join(self.args)))
+ #lines.append('%s print*,"%s=",%s' % (tab, args[0], args[0])) # debug line
+ lines.append('%sEND SUBROUTINE %s' % (tab, name))
+ return '\n'.join(lines)
+
+ def subroutine_wrapper(self):
+ code = self.subroutine_wrapper_code()
+ from api import parse
+ block = parse(code) # XXX: set include_dirs
+ while len(block.content)==1:
+ block = block.content[0]
+ return block
+
+# Handle subprogram prefixes
+
+class SubprogramPrefix(Statement):
+ """
+ <prefix> <declaration-type-spec> <function|subroutine> ...
+ """
+ match = re.compile(r'(pure|elemental|recursive|\s)+\b',re.I).match
+ def process_item(self):
+ line = self.item.get_line()
+ m = self.match(line)
+ prefix = line[:m.end()].rstrip()
+ rest = self.item.get_line()[m.end():].lstrip()
+ if rest:
+ self.parent.put_item(self.item.copy(prefix))
+ self.item.clone(rest)
+ self.isvalid = False
+ return
+ if self.parent.__class__ not in [Function, Subroutine]:
+ self.isvalid = False
+ return
+ prefix = prefix + ' ' + self.parent.prefix
+ self.parent.prefix = prefix.strip()
+ self.ignore = True
+ return
+
+# SelectCase
+
+class EndSelect(EndStatement):
+ match = re.compile(r'end\s*select\s*\w*\Z', re.I).match
+ blocktype = 'select'
+
+class Select(BeginStatement):
+ """
+ [ <case-construct-name> : ] SELECT CASE ( <case-expr> )
+
+ """
+ match = re.compile(r'select\s*case\s*\(.*\)\Z',re.I).match
+ end_stmt_cls = EndSelect
+ name = ''
+ def tostr(self):
+ return 'SELECT CASE ( %s )' % (self.expr)
+ def process_item(self):
+ self.expr = self.item.get_line()[6:].lstrip()[4:].lstrip()[1:-1].strip()
+ self.name = self.item.label
+ return BeginStatement.process_item(self)
+
+ def get_classes(self):
+ return [Case] + execution_part_construct
+
+# Where
+
+class EndWhere(EndStatement):
+ """
+ END WHERE [ <where-construct-name> ]
+ """
+ match = re.compile(r'end\s*\where\s*\w*\Z',re.I).match
+
+
+class Where(BeginStatement):
+ """
+ [ <where-construct-name> : ] WHERE ( <mask-expr> )
+ <mask-expr> = <logical-expr>
+ """
+ match = re.compile(r'where\s*\([^)]*\)\Z',re.I).match
+ end_stmt_cls = EndWhere
+ name = ''
+ def tostr(self):
+ return 'WHERE ( %s )' % (self.expr)
+ def process_item(self):
+ self.expr = self.item.get_line()[5:].lstrip()[1:-1].strip()
+ self.name = self.item.label
+ return BeginStatement.process_item(self)
+
+ def get_classes(self):
+ return [Assignment, WhereStmt,
+ WhereConstruct, ElseWhere
+ ]
+
+WhereConstruct = Where
+
+# Forall
+
+class EndForall(EndStatement):
+ """
+ END FORALL [ <forall-construct-name> ]
+ """
+ match = re.compile(r'end\s*forall\s*\w*\Z',re.I).match
+
+class Forall(BeginStatement):
+ """
+ [ <forall-construct-name> : ] FORALL <forall-header>
+ [ <forall-body-construct> ]...
+ <forall-body-construct> = <forall-assignment-stmt>
+ | <where-stmt>
+ | <where-construct>
+ | <forall-construct>
+ | <forall-stmt>
+ <forall-header> = ( <forall-triplet-spec-list> [ , <scalar-mask-expr> ] )
+ <forall-triplet-spec> = <index-name> = <subscript> : <subscript> [ : <stride> ]
+ <subscript|stride> = <scalar-int-expr>
+ <forall-assignment-stmt> = <assignment-stmt> | <pointer-assignment-stmt>
+ """
+ end_stmt_cls = EndForall
+ match = re.compile(r'forarr\s*\(.*\)\Z',re.I).match
+ name = ''
+ def process_item(self):
+ self.specs = self.item.get_line()[6:].lstrip()[1:-1].strip()
+ return BeginStatement.process_item(self)
+ def tostr(self):
+ return 'FORALL (%s)' % (self.specs)
+ def get_classes(self):
+ return [GeneralAssignment, WhereStmt, WhereConstruct,
+ ForallConstruct, ForallStmt]
+
+ForallConstruct = Forall
+
+# IfThen
+
+class EndIfThen(EndStatement):
+ """
+ END IF [ <if-construct-name> ]
+ """
+ match = re.compile(r'end\s*if\s*\w*\Z', re.I).match
+ blocktype = 'if'
+
+class IfThen(BeginStatement):
+ """
+ [<if-construct-name> :] IF ( <scalar-logical-expr> ) THEN
+
+ IfThen instance has the following attributes:
+ expr
+ """
+
+ match = re.compile(r'if\s*\(.*\)\s*then\Z',re.I).match
+ end_stmt_cls = EndIfThen
+ name = ''
+
+ def tostr(self):
+ return 'IF (%s) THEN' % (self.expr)
+
+ def process_item(self):
+ item = self.item
+ line = item.get_line()[2:-4].strip()
+ assert line[0]=='(' and line[-1]==')',`line`
+ self.expr = line[1:-1].strip()
+ self.name = item.label
+ return BeginStatement.process_item(self)
+
+ def get_classes(self):
+ return [Else, ElseIf] + execution_part_construct
+
+class If(BeginStatement):
+ """
+ IF ( <scalar-logical-expr> ) action-stmt
+ """
+
+ match = re.compile(r'if\s*\(',re.I).match
+
+ def process_item(self):
+ item = self.item
+ mode = self.reader.mode
+ classes = self.get_classes()
+ classes = [cls for cls in classes if mode in cls.modes]
+
+ line = item.get_line()[2:].lstrip()
+ i = line.find(')')
+ expr = line[1:i].strip()
+ line = line[i+1:].strip()
+ if line.lower()=='then':
+ self.isvalid = False
+ return
+ self.expr = item.apply_map(expr)
+
+ if not line:
+ newitem = self.get_item()
+ else:
+ newitem = item.copy(line)
+ newline = newitem.get_line()
+ for cls in classes:
+ if cls.match(newline):
+ stmt = cls(self, newitem)
+ if stmt.isvalid:
+ self.content.append(stmt)
+ return
+ if not line:
+ self.put_item(newitem)
+ self.isvalid = False
+ return
+
+ def tostr(self):
+ assert len(self.content)==1,`self.content`
+ return 'IF (%s) %s' % (self.expr, str(self.content[0]).lstrip())
+
+ def tofortran(self,isfix=None):
+ return self.get_indent_tab(colon=':',isfix=isfix) + self.tostr()
+
+ def get_classes(self):
+ return action_stmt
+
+# Do
+
+class EndDo(EndStatement):
+ """
+ END DO [ <do-construct-name> ]
+ """
+ match = re.compile(r'end\s*do\s*\w*\Z', re.I).match
+ blocktype = 'do'
+
+class Do(BeginStatement):
+ """
+ [ <do-construct-name> : ] DO label [loopcontrol]
+ [ <do-construct-name> : ] DO [loopcontrol]
+
+ """
+
+ match = re.compile(r'do\b\s*\d*',re.I).match
+ item_re = re.compile(r'do\b\s*(?P<label>\d*)\s*,?\s*(?P<loopcontrol>.*)\Z',re.I).match
+ end_stmt_cls = EndDo
+ name = ''
+
+ def tostr(self):
+ return 'DO %s %s' % (self.endlabel, self.loopcontrol)
+
+ def process_item(self):
+ item = self.item
+ line = item.get_line()
+ m = self.item_re(line)
+ self.endlabel = m.group('label').strip()
+ self.name = item.label
+ self.loopcontrol = m.group('loopcontrol').strip()
+ return BeginStatement.process_item(self)
+
+ def process_subitem(self, item):
+ r = False
+ if self.endlabel:
+ label = item.label
+ if label == self.endlabel:
+ r = True
+ if isinstance(self.parent, Do) and label==self.parent.endlabel:
+ # the same item label may be used for different block ends
+ self.put_item(item)
+ return BeginStatement.process_subitem(self, item) or r
+
+ def get_classes(self):
+ return execution_part_construct
+
+# Associate
+
+class EndAssociate(EndStatement):
+ """
+ END ASSOCIATE [ <associate-construct-name> ]
+ """
+ match = re.compile(r'end\s*associate\s*\w*\Z',re.I).match
+
+class Associate(BeginStatement):
+ """
+ [ <associate-construct-name> : ] ASSOCIATE ( <association-list> )
+ <block>
+
+ <association> = <associate-name> => <selector>
+ <selector> = <expr> | <variable>
+ """
+ match = re.compile(r'associate\s*\(.*\)\Z',re.I).match
+ end_stmt_cls = EndAssociate
+
+ def process_item(self):
+ line = self.item.get_line()[9:].lstrip()
+ self.associations = line[1:-1].strip()
+ return BeginStatement.process_item(self)
+ def tostr(self):
+ return 'ASSOCIATE (%s)' % (self.associations)
+ def get_classes(self):
+ return execution_part_construct
+
+# Type
+
+class EndType(EndStatement):
+ """
+ END TYPE [<type-name>]
+ """
+ match = re.compile(r'end\s*type\s*\w*\Z', re.I).match
+ blocktype = 'type'
+
+class Type(BeginStatement, HasVariables, HasAttributes, AccessSpecs):
+ """
+ TYPE [ [ , <type-attr-spec-list>] :: ] <type-name> [ ( <type-param-name-list> ) ]
+ <type-attr-spec> = <access-spec> | EXTENDS ( <parent-type-name> )
+ | ABSTRACT | BIND(C)
+ """
+ match = re.compile(r'type\b\s*').match
+ end_stmt_cls = EndType
+
+ a = AttributeHolder(extends = None,
+ parameters = {},
+ component_names = [], # specifies component order for sequence types
+ components = {}
+ )
+ known_attributes = re.compile(r'\A(PUBLIC|PRIVATE|SEQUENCE|ABSTRACT|BIND\s*\(.*\))\Z',re.I).match
+
+ def process_item(self):
+ line = self.item.get_line()[4:].lstrip()
+ if line.startswith('('):
+ self.isvalid = False
+ return
+ specs = []
+ i = line.find('::')
+ if i!=-1:
+ for s in line[:i].split(','):
+ s = s.strip()
+ if s: specs.append(s)
+ line = line[i+2:].lstrip()
+ self.specs = specs
+ i = line.find('(')
+ if i!=-1:
+ self.name = line[:i].rstrip()
+ assert line[-1]==')',`line`
+ self.params = split_comma(line[i+1:-1].lstrip())
+ else:
+ self.name = line
+ self.params = []
+ if not is_name(self.name):
+ self.isvalid = False
+ return
+ return BeginStatement.process_item(self)
+
+ def tostr(self):
+ s = 'TYPE'
+ if self.specs:
+ s += ', '.join(['']+self.specs) + ' ::'
+ s += ' ' + self.name
+ if self.params:
+ s += ' ('+', '.join(self.params)+')'
+ return s
+
+ def get_classes(self):
+ return [Integer] + private_or_sequence + component_part +\
+ type_bound_procedure_part
+
+ def analyze(self):
+ BeginStatement.analyze(self)
+ for spec in self.specs:
+ i = spec.find('(')
+ if i!=-1:
+ assert spec.endswith(')'),`spec`
+ s = spec[:i].rstrip().upper()
+ n = spec[i+1:-1].strip()
+ if s=='EXTENDS':
+ self.a.extends = n
+ continue
+ elif s=='BIND':
+ args,rest = parse_bind(spec)
+ assert not rest,`rest`
+ spec = 'BIND(%s)' % (', '.join(args))
+ else:
+ spec = '%s(%s)' % (s,n)
+ else:
+ spec = spec.upper()
+ self.update_attributes(spec)
+
+ component_names = self.a.component_names
+ content = self.content[:]
+ while content:
+ stmt = content.pop(0)
+ if isinstance(stmt, self.end_stmt_cls):
+ break
+ stmt.analyze()
+
+ if content:
+ self.show_message('Not analyzed content: %s' % content)
+
+ parameters = self.a.parameters
+ components = self.a.components
+ component_names = self.a.component_names
+ for name in self.a.variable_names:
+ var = self.a.variables[name]
+ if name in self.params:
+ parameters[name] = var
+ else:
+ component_names.append(name)
+ components[name] = var
+
+ self.parent.a.type_decls[self.name] = self
+
+ #parent_provides = self.parent.get_provides()
+ #if parent_provides is not None:
+ # if self.is_public():
+ # if parent_provides.has_key(self.name):
+ # self.warning('type declaration name conflict with %s, overriding.' % (self.name))
+ # parent_provides[self.name] = self
+
+ return
+
+ def topyf(self, tab=''):
+ s = tab + 'TYPE'
+ if self.a.extends is not None:
+ s += ', EXTENDS(%s) ::' % (self.a.extends)
+ s += ' ' + self.name
+ if self.a.parameters:
+ s += ' (%s)' % (', '.join(self.a.parameters))
+ s += '\n'
+ s += AccessSpecs.topyf(self, tab=tab+' ')
+ s += HasAttributes.topyf(self, tab=tab+' ')
+ s += HasVariables.topyf(self, tab=tab+' ')
+ s += tab + 'END TYPE ' + self.name + '\n'
+ return s
+
+ # Wrapper methods:
+
+ def get_bit_size(self, _cache={}):
+ try:
+ return _cache[id(self)]
+ except KeyError:
+ s = 0
+ for name,var in self.a.components.items():
+ s += var.get_bit_size()
+ _cache[id(self)] = s
+ return s
+
+TypeDecl = Type
+
+# Enum
+
+class EndEnum(EndStatement):
+ """
+ END ENUM
+ """
+ match = re.compile(r'end\s*enum\Z',re.I).match
+ blocktype = 'enum'
+
+class Enum(BeginStatement):
+ """
+ ENUM , BIND(C)
+ <enumerator-def-stmt>
+ [ <enumerator-def-stmt> ]...
+ """
+ blocktype = 'enum'
+ end_stmt_cls = EndEnum
+ match = re.compile(r'enum\s*,\s*bind\s*\(\s*c\s*\)\Z',re.I).match
+ def process_item(self):
+ return BeginStatement.process_item(self)
+ def get_classes(self):
+ return [Enumerator]
+
+###################################################
+
+import statements
+import typedecl_statements
+__all__.extend(statements.__all__)
+__all__.extend(typedecl_statements.__all__)
+
+from statements import *
+from typedecl_statements import *
+
+f2py_stmt = [Threadsafe, FortranName, Depend, Check, CallStatement,
+ CallProtoArgument]
+
+access_spec = [Public, Private]
+
+interface_specification = [Function, Subroutine,
+ ModuleProcedure
+ ]
+
+module_subprogram_part = [ Contains, Function, Subroutine ]
+
+specification_stmt = access_spec + [ Allocatable, Asynchronous, Bind,
+ Common, Data, Dimension, Equivalence, External, Intent, Intrinsic,
+ Namelist, Optional, Pointer, Protected, Save, Target, Volatile,
+ Value ]
+
+intrinsic_type_spec = [ SubprogramPrefix, Integer , Real,
+ DoublePrecision, Complex, DoubleComplex, Character, Logical, Byte
+ ]
+
+derived_type_spec = [ ]
+type_spec = intrinsic_type_spec + derived_type_spec
+declaration_type_spec = intrinsic_type_spec + [ TypeStmt, Class ]
+
+type_declaration_stmt = declaration_type_spec
+
+private_or_sequence = [ Private, Sequence ]
+
+component_part = declaration_type_spec + [ ModuleProcedure ]
+
+proc_binding_stmt = [SpecificBinding, GenericBinding, FinalBinding]
+
+type_bound_procedure_part = [Contains, Private] + proc_binding_stmt
+
+#R214
+action_stmt = [ Allocate, GeneralAssignment, Assign, Backspace, Call, Close,
+ Continue, Cycle, Deallocate, Endfile, Exit, Flush, ForallStmt,
+ Goto, If, Inquire, Nullify, Open, Print, Read, Return, Rewind,
+ Stop, Wait, WhereStmt, Write, ArithmeticIf, ComputedGoto,
+ AssignedGoto, Pause ]
+# GeneralAssignment = Assignment + PointerAssignment
+# EndFunction, EndProgram, EndSubroutine - part of the corresponding blocks
+
+executable_construct = [ Associate, Do, ForallConstruct, IfThen,
+ Select, WhereConstruct ] + action_stmt
+#Case, see Select
+
+execution_part_construct = executable_construct + [ Format, Entry,
+ Data ]
+
+execution_part = execution_part_construct[:]
+
+#C201, R208
+for cls in [EndFunction, EndProgram, EndSubroutine]:
+ try: execution_part.remove(cls)
+ except ValueError: pass
+
+internal_subprogram = [Function, Subroutine]
+
+internal_subprogram_part = [ Contains, ] + internal_subprogram
+
+declaration_construct = [ TypeDecl, Entry, Enum, Format, Interface,
+ Parameter, ModuleProcedure, ] + specification_stmt + \
+ type_declaration_stmt
+# stmt-function-stmt
+
+implicit_part = [ Implicit, Parameter, Format, Entry ]
+
+specification_part = [ Use, Import ] + implicit_part + \
+ declaration_construct
+
+
+external_subprogram = [Function, Subroutine]
+
+main_program = [Program] + specification_part + execution_part + \
+ internal_subprogram_part
+
+program_unit = main_program + external_subprogram + [Module,
+ BlockData ]
diff --git a/numpy/f2py/lib/parser/doc.txt b/numpy/f2py/lib/parser/doc.txt
new file mode 100644
index 000000000..0d20bf73f
--- /dev/null
+++ b/numpy/f2py/lib/parser/doc.txt
@@ -0,0 +1,365 @@
+.. -*- rest -*-
+
+Created: September 2006
+Author: Pearu Peterson <pearu.peterson@gmail.com>
+
+Fortran parser package structure
+================================
+
+numpy.f2py.lib.parser package contains the following files:
+
+api.py
+------
+
+Public API for Fortran parser.
+
+It exposes Statement classes, CHAR_BIT constant, and parse function.
+
+Function parse(<input>, ..) parses, analyzes and returns Statement
+tree of Fortran input. For example,
+
+::
+
+ >>> from api import parse
+ >>> code = """
+ ... c comment
+ ... subroutine foo(a)
+ ... integer a
+ ... print*,"a=",a
+ ... end
+ ... """
+ >>> tree = parse(code,isfree=False)
+ >>> print tree
+ !BEGINSOURCE <cStringIO.StringI object at 0xb75ac410> mode=fix90
+ SUBROUTINE foo(a)
+ INTEGER a
+ PRINT *, "a=", a
+ END SUBROUTINE foo
+ >>>
+ >>> tree
+ BeginSource
+ blocktype='beginsource'
+ name='<cStringIO.StringI object at 0xb75ac410> mode=fix90'
+ a=AttributeHolder:
+ external_subprogram=<dict with keys ['foo']>
+ content:
+ Subroutine
+ args=['a']
+ item=Line('subroutine foo(a)',(3, 3),'')
+ a=AttributeHolder:
+ variables=<dict with keys ['a']>
+ content:
+ Integer
+ selector=('', '')
+ entity_decls=['a']
+ item=Line('integer a',(4, 4),'')
+ Print
+ item=Line('print*,"a=",a',(5, 5),'')
+ EndSubroutine
+ blocktype='subroutine'
+ name='foo'
+ item=Line('end',(6, 6),'')
+
+readfortran.py
+--------------
+
+Tools for reading Fortran codes from file and string objects.
+
+To read Fortran code from a file, use FortranFileReader class.
+
+FortranFileReader class is iterator over Fortran code lines
+as is derived from FortranReaderBase class.
+It automatically handles line continuations and comments as
+well as detects if Fortran file is in free or fixed format.
+
+For example,
+
+::
+
+ >>> from readfortran import *
+ >>> import os
+ >>> reader = FortranFileReader(os.path.expanduser('~/src/blas/daxpy.f'))
+ >>> reader.next()
+ Line('subroutine daxpy(n,da,dx,incx,dy,incy)',(1, 1),'')
+ >>> reader.next()
+ Comment('c constant times a vector plus a vector.\nc uses unrolled loops for increments equal to one.\nc jack dongarra, linpack, 3/11/78.\nc modified 12/3/93, array(1) declarations changed to array(*)',(3, 6))
+ >>> reader.next()
+ Line('double precision dx(*),dy(*),da',(8, 8),'')
+ >>> reader.next()
+ Line('integer i,incx,incy,ix,iy,m,mp1,n',(9, 9),'')
+
+FortranReaderBase.next() method may return Line, SyntaxErrorLine, Comment, MultiLine,
+SyntaxErrorMultiLine instances.
+
+Line instance has the following attributes:
+
+ * .line - contains Fortran code line
+ * .span - a 2-tuple containing the span of line numbers containing
+ Fortran code in the original Fortran file
+ * .label - the label of Fortran code line
+ * .reader - the FortranReaderBase class instance
+ * .strline - if not None then contains Fortran code line with parenthesis
+ content and string literal constants saved in .strlinemap dictionary.
+ * .is_f2py_directive - True if line started with f2py directive comment.
+
+and the following methods:
+
+ * .get_line() - returns .strline (also evalutes it if None). Also
+ handles Hollerith contstants in fixed F77 mode.
+ * .isempty() - returns True if Fortran line contains no code.
+ * .copy(line=None, apply_map=False) - returns a Line instance
+ with given .span, .label, .reader information but line content
+ replaced with line (when not None) and applying .strlinemap
+ mapping (when apply_map is True).
+ * .apply_map(line) - apply .strlinemap mapping to line.
+ * .has_map() - returns True if .strlinemap mapping exists.
+
+For example,
+
+::
+
+ >>> item = reader.next()
+ >>> item
+ Line('if(n.le.0)return',(11, 11),'')
+ >>> item.line
+ 'if(n.le.0)return'
+ >>> item.strline
+ 'if(F2PY_EXPR_TUPLE_4)return'
+ >>> item.strlinemap
+ {'F2PY_EXPR_TUPLE_4': 'n.le.0'}
+ >>> item.label
+ ''
+ >>> item.span
+ (11, 11)
+ >>> item.get_line()
+ 'if(F2PY_EXPR_TUPLE_4)return'
+ >>> item.copy('if(F2PY_EXPR_TUPLE_4)pause',True)
+ Line('if(n.le.0)pause',(11, 11),'')
+
+Comment instance has the following attributes:
+
+ * .comment - comment string
+ * .span - a 2-tuple containing the span of line numbers containing
+ Fortran comment in the original Fortran file
+ * .reader - the FortranReaderBase class instance
+
+and .isempty() method.
+
+MultiLine class represents multiline syntax in .pyf files::
+
+ <prefix>'''<lines>'''<suffix>
+
+MultiLine instance has the following attributes:
+
+ * .prefix - the content of <prefix>
+ * .block - a list of lines
+ * .suffix - the content of <suffix>
+ * .span - a 2-tuple containing the span of line numbers containing
+ multiline syntax in the original Fortran file
+ * .reader - the FortranReaderBase class instance
+
+and .isempty() method.
+
+SyntaxErrorLine and SyntaxErrorMultiLine are like Line and MultiLine
+classes, respectively, with a functionality of issuing an error
+message to sys.stdout when constructing an instance of the corresponding
+class.
+
+To read a Fortran code from a string, use FortranStringReader class::
+
+ reader = FortranStringReader(<string>, <isfree>, <isstrict>)
+
+where the second and third arguments are used to specify the format
+of the given <string> content. When <isfree> and <isstrict> are both
+True, the content of a .pyf file is assumed. For example,
+
+::
+
+ >>> code = """
+ ... c comment
+ ... subroutine foo(a)
+ ... print*, "a=",a
+ ... end
+ ... """
+ >>> reader = FortranStringReader(code, False, True)
+ >>> reader.next()
+ Comment('c comment',(2, 2))
+ >>> reader.next()
+ Line('subroutine foo(a)',(3, 3),'')
+ >>> reader.next()
+ Line('print*, "a=",a',(4, 4),'')
+ >>> reader.next()
+ Line('end',(5, 5),'')
+
+FortranReaderBase has the following attributes:
+
+ * .source - a file-like object with .next() method to retrive
+ a source code line
+ * .source_lines - a list of read source lines
+ * .reader - a FortranReaderBase instance for reading files
+ from INCLUDE statements.
+ * .include_dirs - a list of directories where INCLUDE files
+ are searched. Default is ['.'].
+
+and the following methods:
+
+ * .set_mode(isfree, isstrict) - set Fortran code format information
+ * .close_source() - called when .next() raises StopIteration exception.
+
+parsefortran.py
+---------------
+
+Parse Fortran code from FortranReaderBase iterator.
+
+FortranParser class holds the parser information while
+iterating over items returned by FortranReaderBase iterator.
+The parsing information, collected when calling .parse() method,
+is saved in .block attribute as an instance
+of BeginSource class defined in block_statements.py file.
+
+For example,
+
+::
+
+ >>> reader = FortranStringReader(code, False, True)
+ >>> parser = FortranParser(reader)
+ >>> parser.parse()
+ >>> print parser.block
+ !BEGINSOURCE <cStringIO.StringI object at 0xb751d500> mode=fix77
+ SUBROUTINE foo(a)
+ PRINT *, "a=", a
+ END SUBROUTINE foo
+
+block_statements.py, base_classes.py, typedecl_statements.py, statements.py
+---------------------------------------------------------------------------
+
+The model for representing Fortran code statements consists of a tree of Statement
+classes defined in base_classes.py. There are two types of statements: one line
+statements and block statements. Block statements consists of start and end
+statements, and content statements in between that can be of both types again.
+
+Statement instance has the following attributes:
+
+ * .parent - it is either parent block-type statement or FortranParser instance.
+ * .item - Line instance containing Fortran statement line information, see above.
+ * .isvalid - when False then processing this Statement instance will be skipped,
+ for example, when the content of .item does not match with
+ the Statement class.
+ * .ignore - when True then the Statement instance will be ignored.
+ * .modes - a list of Fortran format modes where the Statement instance is valid.
+
+and the following methods:
+
+ * .info(message), .warning(message), .error(message) - to spit messages to
+ sys.stderr stream.
+ * .get_variable(name) - get Variable instance by name that is defined in
+ current namespace. If name is not defined, then the corresponding
+ Variable instance is created.
+ * .analyze() - calculate various information about the Statement, this information
+ is saved in .a attribute that is AttributeHolder instance.
+
+All statement classes are derived from Statement class. Block statements are
+derived from BeginStatement class and is assumed to end with EndStatement
+instance in .content attribute list. BeginStatement and EndStatement instances
+have the following attributes:
+
+ * .name - name of the block, blocks without names use line label
+ as the name.
+ * .blocktype - type of the block (derived from class name)
+ * .content - a list of Statement (or Line) instances.
+
+and the following methods:
+
+ * .__str__() - returns string representation of Fortran code.
+
+A number of statements may declare a variable that is used in other
+statement expressions. Variables are represented via Variable class
+and its instances have the following attributes:
+
+ * .name - name of the variable
+ * .typedecl - type declaration
+ * .dimension - list of dimensions
+ * .bounds - list of bounds
+ * .length - length specs
+ * .attributes - list of attributes
+ * .bind - list of bind information
+ * .intent - list of intent information
+ * .check - list of check expressions
+ * .init - initial value of the variable
+ * .parent - statement instance declaring the variable
+ * .parents - list of statements that specify variable information
+
+and the following methods:
+
+ * .is_private()
+ * .is_public()
+ * .is_allocatable()
+ * .is_external()
+ * .is_intrinsic()
+ * .is_parameter()
+ * .is_optional()
+ * .is_required()
+
+The following type declaration statements are defined in typedecl_statements.py:
+
+ Integer, Real, DoublePrecision, Complex, DoubleComplex, Logical,
+ Character, Byte, Type, Class
+
+and they have the following attributes:
+
+ * .selector - contains lenght and kind specs
+ * .entity_decls, .attrspec
+
+and methods:
+
+ * .tostr() - return string representation of Fortran type declaration
+ * .astypedecl() - pure type declaration instance, it has no .entity_decls
+ and .attrspec.
+ * .analyze() - processes .entity_decls and .attsspec attributes and adds
+ Variable instance to .parent.a.variables dictionary.
+
+The following block statements are defined in block_statements.py:
+
+ BeginSource, Module, PythonModule, Program, BlockData, Interface,
+ Subroutine, Function, Select, Where, Forall, IfThen, If, Do,
+ Associate, TypeDecl (Type), Enum
+
+Block statement classes may have different properties which are declared via
+deriving them from the following classes:
+
+ HasImplicitStmt, HasUseStmt, HasVariables, HasTypeDecls,
+ HasAttributes, HasModuleProcedures, ProgramBlock
+
+In summary, .a attribute may hold different information sets as follows:
+
+ * BeginSource - .module, .external_subprogram, .blockdata
+ * Module - .attributes, .implicit_rules, .use, .use_provides, .variables,
+ .type_decls, .module_subprogram, .module_data
+ * PythonModule - .implicit_rules, .use, .use_provides
+ * Program - .attributes, .implicit_rules, .use, .use_provides
+ * BlockData - .implicit_rules, .use, .use_provides, .variables
+ * Interface - .implicit_rules, .use, .use_provides, .module_procedures
+ * Function, Subroutine - .implicit_rules, .attributes, .use, .use_statements,
+ .variables, .type_decls, .internal_subprogram
+ * TypeDecl - .variables, .attributes
+
+Block statements have the following methods:
+
+ * .get_classes() - returns a list of Statement classes that are valid
+ as a content of given block statement.
+
+The following one line statements are defined:
+
+ Implicit, TypeDeclarationStatement derivatives (see above),
+ Assignment, PointerAssignment, Assign, Call, Goto, ComputedGoto,
+ AssignedGoto, Continue, Return, Stop, Print, Read, Write, Flush,
+ Wait, Contains, Allocate, Deallocate, ModuleProcedure, Access,
+ Public, Private, Close, Cycle, Backspace, Endfile, Reeinf, Open,
+ Format, Save, Data, Nullify, Use, Exit, Parameter, Equivalence,
+ Dimension, Target, Pointer, Protected, Volatile, Value,
+ ArithmeticIf, Intrinsic, Inquire, Sequence, External, Namelist,
+ Common, Optional, Intent, Entry, Import, Forall,
+ SpecificBinding, GenericBinding, FinalBinding, Allocatable,
+ Asynchronous, Bind, Else, ElseIf, Case, Where, ElseWhere,
+ Enumerator, FortranName, Threadsafe, Depend, Check,
+ CallStatement, CallProtoArgument, Pause
diff --git a/numpy/f2py/lib/parser/parsefortran.py b/numpy/f2py/lib/parser/parsefortran.py
new file mode 100644
index 000000000..08716e7c8
--- /dev/null
+++ b/numpy/f2py/lib/parser/parsefortran.py
@@ -0,0 +1,197 @@
+#!/usr/bin/env python
+"""
+Defines FortranParser.
+
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: May 2006
+"""
+
+__all__ = ['FortranParser']
+
+import re
+import sys
+import traceback
+from numpy.distutils.misc_util import yellow_text, red_text
+
+from readfortran import FortranFileReader, FortranStringReader
+from block_statements import BeginSource
+from utils import AnalyzeError
+
+class FortranParser:
+
+ cache = {}
+
+ def __init__(self, reader):
+ """
+ Parser of FortranReader structure.
+ Use .parse() method for parsing, parsing result is saved in .block attribute.
+ """
+ self.reader = reader
+ if self.cache.has_key(reader.id):
+ parser = self.cache[reader.id]
+ self.block = parser.block
+ self.is_analyzed = parser.is_analyzed
+ self.block.show_message('using cached %s' % (reader.id))
+ else:
+ self.cache[reader.id] = self
+ self.block = None
+ self.is_analyzed = False
+ return
+
+ def get_item(self):
+ try:
+ return self.reader.next(ignore_comments = True)
+ except StopIteration:
+ pass
+ return
+
+ def put_item(self, item):
+ self.reader.fifo_item.insert(0, item)
+ return
+
+ def parse(self):
+ if self.block is not None:
+ return
+ try:
+ block = self.block = BeginSource(self)
+ except KeyboardInterrupt:
+ raise
+ except:
+ reader = self.reader
+ while reader is not None:
+ message = reader.format_message('FATAL ERROR',
+ 'while processing line',
+ reader.linecount, reader.linecount)
+ reader.show_message(message, sys.stderr)
+ reader = reader.reader
+ traceback.print_exc(file=sys.stderr)
+ self.reader.show_message(red_text('STOPPED PARSING'), sys.stderr)
+ return
+ return
+
+ def analyze(self):
+ if self.is_analyzed:
+ return
+ if self.block is None:
+ self.reader.show_message('Nothing to analyze.')
+ return
+
+ try:
+ self.block.analyze()
+ except AnalyzeError:
+ pass
+ except Exception, msg:
+ if str(msg) != '123454321':
+ traceback.print_exc(file=sys.stderr)
+ self.reader.show_message(red_text('FATAL ERROR: STOPPED ANALYSING %r CONTENT' % (self.reader.source) ), sys.stderr)
+ sys.exit(123454321)
+ return
+ self.is_analyzed = True
+ return
+
+def test_pyf():
+ string = """
+python module foo
+ interface tere
+ subroutine bar
+ real r
+ end subroutine bar
+ end interface tere
+end python module foo
+"""
+ reader = FortranStringReader(string, True, True)
+ parser = FortranParser(reader)
+ block = parser.parse()
+ print block
+
+def test_free90():
+ string = """
+module foo
+
+ subroutine bar
+ real r
+ if ( pc_get_lun() .ne. 6) &
+ write ( pc_get_lun(), '( &
+ & /, a, /, " p=", i4, " stopping c_flag=", a, &
+ & /, " print unit=", i8)') &
+ trim(title), pcpsx_i_pel(), trim(c_flag), pc_get_lun()
+ if (.true.) then
+ call smth
+ end if
+ aaa : if (.false.) then
+ else if (a) then aaa
+ else aaa
+ end if aaa
+ hey = 1
+ end subroutine bar
+ abstract interface
+
+ end interface
+
+end module foo
+"""
+ reader = FortranStringReader(string, True, False)
+ parser = FortranParser(reader)
+ block = parser.parse()
+ print block
+
+def test_f77():
+ string = """\
+ program foo
+ a = 3
+ end
+ subroutine bar
+ end
+ pure function foo(a)
+ end
+ pure real*4 recursive function bar()
+ end
+"""
+ reader = FortranStringReader(string, False, True)
+ parser = FortranParser(reader)
+ block = parser.parse()
+ print block
+
+def simple_main():
+ import sys
+ if not sys.argv[1:]:
+ return parse_all_f()
+ for filename in sys.argv[1:]:
+ reader = FortranFileReader(filename)
+ print yellow_text('Processing '+filename+' (mode=%r)' % (reader.mode))
+ parser = FortranParser(reader)
+ parser.parse()
+ parser.analyze()
+ print parser.block.torepr(4)
+ #print parser.block
+
+def profile_main():
+ import hotshot, hotshot.stats
+ prof = hotshot.Profile("_parsefortran.prof")
+ prof.runcall(simple_main)
+ prof.close()
+ stats = hotshot.stats.load("_parsefortran.prof")
+ stats.strip_dirs()
+ stats.sort_stats('time', 'calls')
+ stats.print_stats(30)
+
+def parse_all_f():
+ for filename in open('opt_all_f.txt'):
+ filename = filename.strip()
+ reader = FortranFileReader(filename)
+ print yellow_text('Processing '+filename+' (mode=%r)' % (reader.mode))
+ parser = FortranParser(reader)
+ block = parser.parse()
+ print block
+
+if __name__ == "__main__":
+ #test_f77()
+ #test_free90()
+ #test_pyf()
+ simple_main()
+ #profile_main()
+ #parse_all_f()
diff --git a/numpy/f2py/lib/parser/pattern_tools.py b/numpy/f2py/lib/parser/pattern_tools.py
new file mode 100644
index 000000000..3c009a6a8
--- /dev/null
+++ b/numpy/f2py/lib/parser/pattern_tools.py
@@ -0,0 +1,401 @@
+"""
+Tools for constructing patterns.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: Oct 2006
+-----
+"""
+
+import re
+
+class Pattern:
+ """
+ p1 | p2 -> <p1> | <p2>
+ p1 + p2 -> <p1> <p2>
+ p1 & p2 -> <p1><p2>
+ ~p1 -> [ <p1> ]
+ ~~p1 -> [ <p1> ]...
+ ~~~p1 -> <p1> [ <p1> ]...
+ ~~~~p1 -> ~~~p1
+ abs(p1) -> whole string match of <p1>
+ p1.named(name) -> match of <p1> has name
+ p1.match(string) -> return string match with <p1>
+ p1.flags(<re.I,..>)
+ p1.rsplit(..) -> split a string from the rightmost p1 occurrence
+ p1.lsplit(..) -> split a string from the leftmost p1 occurrence
+ """
+ _special_symbol_map = {'.': '[.]',
+ '*': '[*]',
+ '+': '[+]',
+ '|': '[|]',
+ '(': r'\(',
+ ')': r'\)',
+ '[': r'\[',
+ ']': r'\]',
+ '^': '[^]',
+ '$': '[$]',
+ '?': '[?]',
+ '{': '\{',
+ '}': '\}',
+ '>': '[>]',
+ '<': '[<]',
+ '=': '[=]'
+ }
+
+ def __init__(self, label, pattern, optional=0, flags=0, value=None):
+ self.label = label
+ self.pattern = pattern
+ self.optional = optional
+ self._flags = flags
+ self.value = value
+ return
+
+ def flags(self, *flags):
+ f = self._flags
+ for f1 in flags:
+ f = f | f1
+ return Pattern(self.label, self.pattern, optional=self.optional, flags=f, value=self.value)
+
+ def get_compiled(self):
+ try:
+ return self._compiled_pattern
+ except AttributeError:
+ self._compiled_pattern = compiled = re.compile(self.pattern, self._flags)
+ return compiled
+
+ def match(self, string):
+ return self.get_compiled().match(string)
+
+ def search(self, string):
+ return self.get_compiled().search(string)
+
+ def rsplit(self, string):
+ """
+ Return (<lhs>, <pattern_match>, <rhs>) where
+ string = lhs + pattern_match + rhs
+ and rhs does not contain pattern_match.
+ If no pattern_match is found in string, return None.
+ """
+ compiled = self.get_compiled()
+ t = compiled.split(string)
+ if len(t) < 3: return
+ if '' in t[1:-1]: return
+ rhs = t[-1].strip()
+ pattern_match = t[-2].strip()
+ assert abs(self).match(pattern_match),`self,string,t,pattern_match`
+ lhs = (''.join(t[:-2])).strip()
+ return lhs, pattern_match, rhs
+
+ def lsplit(self, string):
+ """
+ Return (<lhs>, <pattern_match>, <rhs>) where
+ string = lhs + pattern_match + rhs
+ and rhs does not contain pattern_match.
+ If no pattern_match is found in string, return None.
+ """
+ compiled = self.get_compiled()
+ t = compiled.split(string) # can be optimized
+ if len(t) < 3: return
+ lhs = t[0].strip()
+ pattern_match = t[1].strip()
+ rhs = (''.join(t[2:])).strip()
+ assert abs(self).match(pattern_match),`pattern_match`
+ return lhs, pattern_match, rhs
+
+ def __abs__(self):
+ return Pattern(self.label, r'\A' + self.pattern+ r'\Z',flags=self._flags, value=self.value)
+
+ def __repr__(self):
+ return '%s(%r, %r)' % (self.__class__.__name__, self.label, self.pattern)
+
+ def __or__(self, other):
+ label = '( %s OR %s )' % (self.label, other.label)
+ if self.pattern==other.pattern:
+ pattern = self.pattern
+ flags = self._flags
+ else:
+ pattern = '(%s|%s)' % (self.pattern, other.pattern)
+ flags = self._flags | other._flags
+ return Pattern(label, pattern, flags=flags)
+
+ def __and__(self, other):
+ if isinstance(other, Pattern):
+ label = '%s%s' % (self.label, other.label)
+ pattern = self.pattern + other.pattern
+ flags = self._flags | other._flags
+ else:
+ assert isinstance(other,str),`other`
+ label = '%s%s' % (self.label, other)
+ pattern = self.pattern + other
+ flags = self._flags
+ return Pattern(label, pattern, flags=flags)
+
+ def __rand__(self, other):
+ assert isinstance(other,str),`other`
+ label = '%s%s' % (other, self.label)
+ pattern = other + self.pattern
+ return Pattern(label, pattern, flags=self._flags)
+
+ def __invert__(self):
+ if self.optional:
+ if self.optional==1:
+ return Pattern(self.label + '...', self.pattern[:-1] + '*', optional=2,flags=self._flags)
+ if self.optional==2:
+ return Pattern('%s %s' % (self.label[1:-4].strip(), self.label), self.pattern[:-1] + '+',
+ optional=3, flags=self._flags)
+ return self
+ label = '[ %s ]' % (self.label)
+ pattern = '(%s)?' % (self.pattern)
+ return Pattern(label, pattern, optional=1, flags=self._flags)
+
+ def __add__(self, other):
+ if isinstance(other, Pattern):
+ label = '%s %s' % (self.label, other.label)
+ pattern = self.pattern + r'\s*' + other.pattern
+ flags = self._flags | other._flags
+ else:
+ assert isinstance(other,str),`other`
+ label = '%s %s' % (self.label, other)
+ other = self._special_symbol_map.get(other, other)
+ pattern = self.pattern + r'\s*' + other
+ flags = self._flags
+ return Pattern(label, pattern, flags = flags)
+
+ def __radd__(self, other):
+ assert isinstance(other,str),`other`
+ label = '%s %s' % (other, self.label)
+ other = self._special_symbol_map.get(other, other)
+ pattern = other + r'\s*' + self.pattern
+ return Pattern(label, pattern, flags=self._flags)
+
+ def named(self, name = None):
+ if name is None:
+ label = self.label
+ assert label[0]+label[-1]=='<>' and ' ' not in label,`label`
+ else:
+ label = '<%s>' % (name)
+ pattern = '(?P%s%s)' % (label.replace('-','_'), self.pattern)
+ return Pattern(label, pattern, flags=self._flags, value= self.value)
+
+ def rename(self, label):
+ if label[0]+label[-1]!='<>':
+ label = '<%s>' % (label)
+ return Pattern(label, self.pattern, optional=self.optional, flags=self._flags, value=self.value)
+
+ def __call__(self, string):
+ m = self.match(string)
+ if m is None: return
+ if self.value is not None: return self.value
+ return m.group()
+
+# Predefined patterns
+
+letter = Pattern('<letter>','[A-Z]',flags=re.I)
+name = Pattern('<name>', r'[A-Z]\w*',flags=re.I)
+digit = Pattern('<digit>',r'\d')
+underscore = Pattern('<underscore>', '_')
+binary_digit = Pattern('<binary-digit>',r'[01]')
+octal_digit = Pattern('<octal-digit>',r'[0-7]')
+hex_digit = Pattern('<hex-digit>',r'[\dA-F]',flags=re.I)
+
+digit_string = Pattern('<digit-string>',r'\d+')
+binary_digit_string = Pattern('<binary-digit-string>',r'[01]+')
+octal_digit_string = Pattern('<octal-digit-string>',r'[0-7]+')
+hex_digit_string = Pattern('<hex-digit-string>',r'[\dA-F]+',flags=re.I)
+
+sign = Pattern('<sign>',r'[+-]')
+exponent_letter = Pattern('<exponent-letter>',r'[ED]',flags=re.I)
+
+alphanumeric_character = Pattern('<alphanumeric-character>',r'\w') # [A-Z0-9_]
+special_character = Pattern('<special-character>',r'[ =+-*/\()[\]{},.:;!"%&~<>?,\'`^|$#@]')
+character = alphanumeric_character | special_character
+
+kind_param = digit_string | name
+kind_param_named = kind_param.named('kind-param')
+signed_digit_string = ~sign + digit_string
+int_literal_constant = digit_string + ~('_' + kind_param)
+signed_int_literal_constant = ~sign + int_literal_constant
+int_literal_constant_named = digit_string.named('value') + ~ ('_' + kind_param_named)
+signed_int_literal_constant_named = (~sign + digit_string).named('value') + ~ ('_' + kind_param_named)
+
+binary_constant = ('B' + ("'" & binary_digit_string & "'" | '"' & binary_digit_string & '"')).flags(re.I)
+octal_constant = ('O' + ("'" & octal_digit_string & "'" | '"' & octal_digit_string & '"')).flags(re.I)
+hex_constant = ('Z' + ("'" & hex_digit_string & "'" | '"' & hex_digit_string & '"')).flags(re.I)
+boz_literal_constant = binary_constant | octal_constant | hex_constant
+
+exponent = signed_digit_string
+significand = digit_string + '.' + ~digit_string | '.' + digit_string
+real_literal_constant = significand + ~(exponent_letter + exponent) + ~ ('_' + kind_param) | \
+ digit_string + exponent_letter + exponent + ~ ('_' + kind_param)
+real_literal_constant_named = (significand + ~(exponent_letter + exponent) |\
+ digit_string + exponent_letter + exponent).named('value') + ~ ('_' + kind_param_named)
+signed_real_literal_constant_named = (~sign + (significand + ~(exponent_letter + exponent) |\
+ digit_string + exponent_letter + exponent)).named('value') + ~ ('_' + kind_param_named)
+signed_real_literal_constant = ~sign + real_literal_constant
+
+named_constant = name
+real_part = signed_int_literal_constant | signed_real_literal_constant | named_constant
+imag_part = real_part
+complex_literal_constant = '(' + real_part + ',' + imag_part + ')'
+
+a_n_rep_char = Pattern('<alpha-numeric-rep-char>',r'\w')
+rep_char = Pattern('<rep-char>',r'.')
+char_literal_constant = ~( kind_param + '_') + ("'" + ~~rep_char + "'" | '"' + ~~rep_char + '"' )
+a_n_char_literal_constant_named1 = ~( kind_param_named + '_') + (~~~("'" + ~~a_n_rep_char + "'" )).named('value')
+a_n_char_literal_constant_named2 = ~( kind_param_named + '_') + (~~~('"' + ~~a_n_rep_char + '"' )).named('value')
+
+logical_literal_constant = ('[.](TRUE|FALSE)[.]' + ~ ('_' + kind_param)).flags(re.I)
+logical_literal_constant_named = Pattern('<value>',r'[.](TRUE|FALSE)[.]',flags=re.I).named() + ~ ('_' + kind_param_named)
+literal_constant = int_literal_constant | real_literal_constant | complex_literal_constant | logical_literal_constant | char_literal_constant | boz_literal_constant
+constant = literal_constant | named_constant
+int_constant = int_literal_constant | boz_literal_constant | named_constant
+char_constant = char_literal_constant | named_constant
+
+# assume that replace_string_map is applied:
+part_ref = name + ~((r'[(]' + name + r'[)]'))
+data_ref = part_ref + ~~~(r'[%]' + part_ref)
+primary = constant | name | data_ref | (r'[(]' + name + r'[)]')
+
+power_op = Pattern('<power-op>',r'(?<![*])[*]{2}(?![*])')
+mult_op = Pattern('<mult-op>',r'(?<![*])[*](?![*])|(?<![/])[/](?![/])')
+add_op = Pattern('<add-op>',r'[+-]')
+concat_op = Pattern('<concat-op>',r'(?<![/])[/]{2}(?![/])')
+rel_op = Pattern('<rel-op>','[.]EQ[.]|[.]NE[.]|[.]LT[.]|[.]LE[.]|[.]GT[.]|[.]GE[.]|[=]{2}|/[=]|[<][=]|[<]|[>][=]|[>]',flags=re.I)
+not_op = Pattern('<not-op>','[.]NOT[.]',flags=re.I)
+and_op = Pattern('<and-op>','[.]AND[.]',flags=re.I)
+or_op = Pattern('<or-op>','[.]OR[.]',flags=re.I)
+equiv_op = Pattern('<equiv-op>','[.]EQV[.]|[.]NEQV[.]',flags=re.I)
+percent_op = Pattern('<percent-op>',r'%',flags=re.I)
+intrinsic_operator = power_op | mult_op | add_op | concat_op | rel_op | not_op | and_op | or_op | equiv_op
+extended_intrinsic_operator = intrinsic_operator
+
+defined_unary_op = Pattern('<defined-unary-op>','[.][A-Z]+[.]',flags=re.I)
+defined_binary_op = Pattern('<defined-binary-op>','[.][A-Z]+[.]',flags=re.I)
+defined_operator = defined_unary_op | defined_binary_op | extended_intrinsic_operator
+abs_defined_operator = abs(defined_operator)
+defined_op = Pattern('<defined-op>','[.][A-Z]+[.]',flags=re.I)
+abs_defined_op = abs(defined_op)
+
+non_defined_binary_op = intrinsic_operator | logical_literal_constant
+
+label = Pattern('<label>','\d{1,5}')
+abs_label = abs(label)
+
+keyword = name
+keyword_equal = keyword + '='
+
+
+
+
+abs_constant = abs(constant)
+abs_literal_constant = abs(literal_constant)
+abs_int_literal_constant = abs(int_literal_constant)
+abs_signed_int_literal_constant = abs(signed_int_literal_constant)
+abs_signed_int_literal_constant_named = abs(signed_int_literal_constant_named)
+abs_int_literal_constant_named = abs(int_literal_constant_named)
+abs_real_literal_constant = abs(real_literal_constant)
+abs_signed_real_literal_constant = abs(signed_real_literal_constant)
+abs_signed_real_literal_constant_named = abs(signed_real_literal_constant_named)
+abs_real_literal_constant_named = abs(real_literal_constant_named)
+abs_complex_literal_constant = abs(complex_literal_constant)
+abs_logical_literal_constant = abs(logical_literal_constant)
+abs_char_literal_constant = abs(char_literal_constant)
+abs_boz_literal_constant = abs(boz_literal_constant)
+abs_name = abs(name)
+abs_a_n_char_literal_constant_named1 = abs(a_n_char_literal_constant_named1)
+abs_a_n_char_literal_constant_named2 = abs(a_n_char_literal_constant_named2)
+abs_logical_literal_constant_named = abs(logical_literal_constant_named)
+abs_binary_constant = abs(binary_constant)
+abs_octal_constant = abs(octal_constant)
+abs_hex_constant = abs(hex_constant)
+
+intrinsic_type_name = Pattern('<intrinsic-type-name>',r'(INTEGER|REAL|COMPLEX|LOGICAL|CHARACTER|DOUBLE\s*COMPLEX|DOUBLE\s*PRECISION|BYTE)',flags=re.I)
+abs_intrinsic_type_name = abs(intrinsic_type_name)
+double_complex_name = Pattern('<double-complex-name>','DOUBLE\s*COMPLEX', flags=re.I, value='DOUBLE COMPLEX')
+double_precision_name = Pattern('<double-precision-name>','DOUBLE\s*PRECISION', flags=re.I, value='DOUBLE PRECISION')
+abs_double_complex_name = abs(double_complex_name)
+abs_double_precision_name = abs(double_precision_name)
+
+access_spec = Pattern('<access-spec>',r'PUBLIC|PRIVATE',flags=re.I)
+abs_access_spec = abs(access_spec)
+
+implicit_none = Pattern('<implicit-none>',r'IMPLICIT\s*NONE',flags=re.I, value='IMPLICIT NONE')
+abs_implicit_none = abs(implicit_none)
+
+attr_spec = Pattern('<attr-spec>',r'ALLOCATABLE|ASYNCHRONOUS|EXTERNAL|INTENT|INTRINSIC|OPTIONAL|PARAMETER|POINTER|PROTECTED|SAVE|TARGET|VALUE|VOLATILE',flags=re.I)
+abs_attr_spec = abs(attr_spec)
+
+dimension = Pattern('<dimension>',r'DIMENSION', flags=re.I)
+abs_dimension = abs(dimension)
+
+intent = Pattern('<intent>', r'INTENT', flags=re.I)
+abs_intent = abs(intent)
+
+intent_spec = Pattern('<intent-spec>', r'INOUT|IN|OUT', flags=re.I)
+abs_intent_spec = abs(intent_spec)
+
+subroutine = Pattern('<subroutine>', r'SUBROUTINE', flags=re.I)
+
+select_case = Pattern('<select-case>', r'SELECT\s*CASE', flags=re.I, value='SELECT CASE')
+abs_select_case = abs(select_case)
+
+def _test():
+ assert name.match('a1_a')
+ assert abs(name).match('a1_a')
+ assert not abs(name).match('a1_a[]')
+
+ m = abs(kind_param)
+ assert m.match('23')
+ assert m.match('SHORT')
+
+ m = abs(signed_digit_string)
+ assert m.match('23')
+ assert m.match('+ 23')
+ assert m.match('- 23')
+ assert m.match('-23')
+ assert not m.match('+n')
+
+ m = ~sign.named() + digit_string.named('number')
+ r = m.match('23')
+ assert r.groupdict()=={'number': '23', 'sign': None}
+ r = m.match('- 23')
+ assert r.groupdict()=={'number': '23', 'sign': '-'}
+
+ m = abs(char_literal_constant)
+ assert m.match('"adadfa"')
+ assert m.match('"adadfa""adad"')
+ assert m.match('HEY_"adadfa"')
+ assert m.match('HEY _ "ad\tadfa"')
+ assert not m.match('adadfa')
+
+ def assert_equal(result, expect):
+ try:
+ assert result==expect
+ except AssertionError, msg:
+ raise AssertionError,"Expected %r but got %r: %s" \
+ % (expect, result, msg)
+
+ m = mult_op.named()
+ assert m.rsplit('a * b')
+ assert_equal(m.lsplit('a * c* b'),('a','*','c* b'))
+ assert_equal(m.rsplit('a * c* b'),('a * c','*','b'))
+ assert_equal(m.lsplit('a * b ** c'),('a','*','b ** c'))
+ assert_equal(m.rsplit('a * b ** c'),('a','*','b ** c'))
+ assert_equal(m.lsplit('a * b ** c * d'),('a','*','b ** c * d'))
+ assert_equal(m.rsplit('a * b ** c * d'),('a * b ** c','*','d'))
+
+ m = power_op.named()
+ assert m.rsplit('a ** b')
+ assert_equal(m.lsplit('a * b ** c'),('a * b','**','c'))
+ assert_equal(m.rsplit('a * b ** c'),('a * b','**','c'))
+ assert_equal(m.lsplit('a ** b ** c'),('a','**','b ** c'))
+ assert_equal(m.rsplit('a ** b ** c'),('a ** b','**','c'))
+ print 'ok'
+
+if __name__ == '__main__':
+ _test()
diff --git a/numpy/f2py/lib/parser/readfortran.py b/numpy/f2py/lib/parser/readfortran.py
new file mode 100644
index 000000000..e3acffa36
--- /dev/null
+++ b/numpy/f2py/lib/parser/readfortran.py
@@ -0,0 +1,857 @@
+#!/usr/bin/env python
+"""
+Defines FortranReader classes for reading Fortran codes from
+files and strings. FortranReader handles comments and line continuations
+of both fix and free format Fortran codes.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: May 2006
+-----
+"""
+
+__all__ = ['FortranFileReader',
+ 'FortranStringReader',
+ 'FortranReaderError',
+ 'Line', 'SyntaxErrorLine',
+ 'Comment',
+ 'MultiLine','SyntaxErrorMultiLine',
+ ]
+
+import re
+import os
+import sys
+import tempfile
+import traceback
+from cStringIO import StringIO
+from numpy.distutils.misc_util import yellow_text, red_text, blue_text
+
+from sourceinfo import get_source_info
+from splitline import String, string_replace_map, splitquote
+
+_spacedigits=' 0123456789'
+_cf2py_re = re.compile(r'(?P<indent>\s*)!f2py(?P<rest>.*)',re.I)
+_is_fix_cont = lambda line: line and len(line)>5 and line[5]!=' ' and line[:5]==5*' '
+_is_f90_cont = lambda line: line and '&' in line and line.rstrip()[-1]=='&'
+_f90label_re = re.compile(r'\s*(?P<label>(\w+\s*:|\d+))\s*(\b|(?=&)|\Z)',re.I)
+_is_include_line = re.compile(r'\s*include\s*("[^"]+"|\'[^\']+\')\s*\Z',re.I).match
+_is_fix_comment = lambda line: line and line[0] in '*cC!'
+_hollerith_start_search = re.compile(r'(?P<pre>\A|,\s*)(?P<num>\d+)h',re.I).search
+_is_call_stmt = re.compile(r'call\b', re.I).match
+
+class FortranReaderError: # TODO: may be derive it from Exception
+ def __init__(self, message):
+ self.message = message
+ print >> sys.stderr,message
+ sys.stderr.flush()
+
+class Line:
+ """ Holds a Fortran source line.
+ """
+
+ f2py_strmap_findall = re.compile(r'(_F2PY_STRING_CONSTANT_\d+_|F2PY_EXPR_TUPLE_\d+)').findall
+
+ def __init__(self, line, linenospan, label, reader):
+ self.line = line.strip()
+ self.span = linenospan
+ self.label = label
+ self.reader = reader
+ self.strline = None
+ self.is_f2py_directive = linenospan[0] in reader.f2py_comment_lines
+
+ def has_map(self):
+ return not not (hasattr(self,'strlinemap') and self.strlinemap)
+
+ def apply_map(self, line):
+ if not hasattr(self,'strlinemap') or not self.strlinemap:
+ return line
+ findall = self.f2py_strmap_findall
+ str_map = self.strlinemap
+ keys = findall(line)
+ for k in keys:
+ line = line.replace(k, str_map[k])
+ return line
+
+ def copy(self, line = None, apply_map = False):
+ if line is None:
+ line = self.line
+ if apply_map:
+ line = self.apply_map(line)
+ return Line(line, self.span, self.label, self.reader)
+
+ def clone(self, line):
+ self.line = self.apply_map(line)
+ self.strline = None
+ return
+
+ def __repr__(self):
+ return self.__class__.__name__+'(%r,%s,%r)' \
+ % (self.line, self.span, self.label)
+
+ def isempty(self, ignore_comments=False):
+ return not (self.line.strip() or self.label)
+
+ def get_line(self):
+ if self.strline is not None:
+ return self.strline
+ line = self.line
+ if self.reader.isfix77:
+ # Handle Hollerith constants by replacing them
+ # with char-literal-constants.
+ # H constants may appear only in DATA statements and
+ # in the argument list of CALL statement.
+ # Holleriht constants were removed from the Fortran 77 standard.
+ # The following handling is not perfect but works for simple
+ # usage cases.
+ # todo: Handle hollerith constants in DATA statement
+ if _is_call_stmt(line):
+ l2 = self.line[4:].lstrip()
+ i = l2.find('(')
+ if i != -1 and l2[-1]==')':
+ substrings = ['call '+l2[:i+1]]
+ start_search = _hollerith_start_search
+ l2 = l2[i+1:-1].strip()
+ m = start_search(l2)
+ while m:
+ substrings.append(l2[:m.start()])
+ substrings.append(m.group('pre'))
+ num = int(m.group('num'))
+ substrings.append("'"+l2[m.end():m.end()+num]+"'")
+ l2 = l2[m.end()+num:]
+ m = start_search(l2)
+ substrings.append(l2)
+ substrings.append(')')
+ line = ''.join(substrings)
+
+ line, str_map = string_replace_map(line, lower=not self.reader.ispyf)
+ self.strline = line
+ self.strlinemap = str_map
+ return line
+
+class SyntaxErrorLine(Line, FortranReaderError):
+ def __init__(self, line, linenospan, label, reader, message):
+ Line.__init__(self, line, linenospan, label, reader)
+ FortranReaderError.__init__(self, message)
+
+class Comment:
+ """ Holds Fortran comment.
+ """
+ def __init__(self, comment, linenospan, reader):
+ self.comment = comment
+ self.span = linenospan
+ self.reader = reader
+ def __repr__(self):
+ return self.__class__.__name__+'(%r,%s)' \
+ % (self.comment, self.span)
+ def isempty(self, ignore_comments=False):
+ return ignore_comments or len(self.comment)<2
+
+class MultiLine:
+ """ Holds (prefix, line list, suffix) representing multiline
+ syntax in .pyf files:
+ prefix+'''+lines+'''+suffix.
+ """
+ def __init__(self, prefix, block, suffix, linenospan, reader):
+ self.prefix = prefix
+ self.block = block
+ self.suffix = suffix
+ self.span = linenospan
+ self.reader = reader
+ def __repr__(self):
+ return self.__class__.__name__+'(%r,%r,%r,%s)' \
+ % (self.prefix,self.block,self.suffix,
+ self.span)
+ def isempty(self, ignore_comments=False):
+ return not (self.prefix or self.block or self.suffix)
+
+class SyntaxErrorMultiLine(MultiLine, FortranReaderError):
+ def __init__(self, prefix, block, suffix, linenospan, reader, message):
+ MultiLine.__init__(self, prefix, block, suffix, linenospan, reader)
+ FortranReaderError.__init__(self, message)
+
+
+class FortranReaderBase:
+
+ def __init__(self, source, isfree, isstrict):
+ """
+ source - file-like object with .next() method
+ used to retrive a line.
+ source may contain
+ - Fortran 77 code
+ - fixed format Fortran 90 code
+ - free format Fortran 90 code
+ - .pyf signatures - extended free format Fortran 90 syntax
+ """
+
+ self.linecount = 0
+ self.source = source
+ self.isclosed = False
+
+ self.filo_line = []
+ self.fifo_item = []
+ self.source_lines = []
+
+ self.f2py_comment_lines = [] # line numbers that contain f2py directives
+
+ self.reader = None
+ self.include_dirs = ['.']
+
+ self.set_mode(isfree, isstrict)
+ return
+
+ def set_mode(self, isfree, isstrict):
+ self.isfree90 = isfree and not isstrict
+ self.isfix90 = not isfree and not isstrict
+ self.isfix77 = not isfree and isstrict
+ self.ispyf = isfree and isstrict
+ self.isfree = isfree
+ self.isfix = not isfree
+ self.isstrict = isstrict
+
+ if self.isfree90: mode = 'free90'
+ elif self.isfix90: mode = 'fix90'
+ elif self.isfix77: mode = 'fix77'
+ else: mode = 'pyf'
+ self.mode = mode
+ self.name = '%s mode=%s' % (self.source, mode)
+ return
+
+ def close_source(self):
+ # called when self.source.next() raises StopIteration.
+ pass
+
+ # For handling raw source lines:
+
+ def put_single_line(self, line):
+ self.filo_line.append(line)
+ self.linecount -= 1
+ return
+
+ def get_single_line(self):
+ try:
+ line = self.filo_line.pop()
+ self.linecount += 1
+ return line
+ except IndexError:
+ pass
+ if self.isclosed:
+ return None
+ try:
+ line = self.source.next()
+ except StopIteration:
+ self.isclosed = True
+ self.close_source()
+ return None
+ self.linecount += 1
+ # expand tabs, replace special symbols, get rid of nl characters
+ line = line.expandtabs().replace('\xa0',' ').rstrip()
+ self.source_lines.append(line)
+ if not line:
+ return self.get_single_line()
+ return line
+
+ def get_next_line(self):
+ line = self.get_single_line()
+ if line is None: return
+ self.put_single_line(line)
+ return line
+
+ # Parser methods:
+ def get_item(self):
+ try:
+ return self.next(ignore_comments = True)
+ except StopIteration:
+ pass
+ return
+
+ def put_item(self, item):
+ self.fifo_item.insert(0, item)
+ return
+ # Iterator methods:
+
+ def __iter__(self):
+ return self
+
+ def next(self, ignore_comments = False):
+
+ try:
+ if self.reader is not None:
+ try:
+ return self.reader.next()
+ except StopIteration:
+ self.reader = None
+ item = self._next(ignore_comments)
+ if isinstance(item, Line) and _is_include_line(item.line):
+ reader = item.reader
+ filename = item.line.strip()[7:].lstrip()[1:-1]
+ include_dirs = self.include_dirs[:]
+ path = filename
+ for incl_dir in include_dirs:
+ path = os.path.join(incl_dir, filename)
+ if os.path.exists(path):
+ break
+ if not os.path.isfile(path):
+ dirs = os.pathsep.join(include_dirs)
+ message = reader.format_message(\
+ 'WARNING',
+ 'include file %r not found in %r,'\
+ ' ignoring.' % (filename, dirs),
+ item.span[0], item.span[1])
+ reader.show_message(message, sys.stdout)
+ return self.next(ignore_comments = ignore_comments)
+ message = reader.format_message('INFORMATION',
+ 'found file %r' % (path),
+ item.span[0], item.span[1])
+ reader.show_message(message, sys.stdout)
+ self.reader = FortranFileReader(path, include_dirs = include_dirs)
+ return self.reader.next(ignore_comments = ignore_comments)
+ return item
+ except StopIteration:
+ raise
+ except:
+ message = self.format_message('FATAL ERROR',
+ 'while processing line',
+ self.linecount, self.linecount)
+ self.show_message(message, sys.stdout)
+ traceback.print_exc(file=sys.stdout)
+ self.show_message(red_text('STOPPED READING'), sys.stdout)
+ raise StopIteration
+
+ def _next(self, ignore_comments = False):
+ fifo_item_pop = self.fifo_item.pop
+ while 1:
+ try:
+ item = fifo_item_pop(0)
+ except IndexError:
+ item = self.get_source_item()
+ if item is None:
+ raise StopIteration
+ if not item.isempty(ignore_comments):
+ break
+ # else ignore empty lines and comments
+ if not isinstance(item, Comment):
+ if not self.ispyf and isinstance(item, Line) \
+ and not item.is_f2py_directive \
+ and ';' in item.get_line():
+ # ;-separator not recognized in pyf-mode
+ items = []
+ for line in item.get_line().split(';'):
+ line = line.strip()
+ items.append(item.copy(line, apply_map=True))
+ items.reverse()
+ for newitem in items:
+ self.fifo_item.insert(0, newitem)
+ return fifo_item_pop(0)
+ return item
+ # collect subsequent comments to one comment instance
+ comments = []
+ start = item.span[0]
+ while isinstance(item, Comment):
+ comments.append(item.comment)
+ end = item.span[1]
+ while 1:
+ try:
+ item = fifo_item_pop(0)
+ except IndexError:
+ item = self.get_source_item()
+ if item is None or not item.isempty(ignore_comments):
+ break
+ if item is None:
+ break # hold raising StopIteration for the next call.
+ if item is not None:
+ self.fifo_item.insert(0,item)
+ return self.comment_item('\n'.join(comments), start, end)
+
+ # Interface to returned items:
+
+ def line_item(self, line, startlineno, endlineno, label, errmessage=None):
+ if errmessage is None:
+ return Line(line, (startlineno, endlineno), label, self)
+ return SyntaxErrorLine(line, (startlineno, endlineno),
+ label, self, errmessage)
+
+ def multiline_item(self, prefix, lines, suffix,
+ startlineno, endlineno, errmessage=None):
+ if errmessage is None:
+ return MultiLine(prefix, lines, suffix, (startlineno, endlineno), self)
+ return SyntaxErrorMultiLine(prefix, lines, suffix,
+ (startlineno, endlineno), self, errmessage)
+
+ def comment_item(self, comment, startlineno, endlineno):
+ return Comment(comment, (startlineno, endlineno), self)
+
+ # For handling messages:
+
+ def show_message(self, message, stream = sys.stdout):
+ stream.write(message+'\n')
+ stream.flush()
+ return
+
+ def format_message(self, kind, message, startlineno, endlineno,
+ startcolno=0, endcolno=-1):
+ back_index = {'warning':2,'error':3,'info':0}.get(kind.lower(),3)
+ r = ['%s while processing %r (mode=%r)..' % (kind, self.id, self.mode)]
+ for i in range(max(1,startlineno-back_index),startlineno):
+ r.append('%5d:%s' % (i,self.source_lines[i-1]))
+ for i in range(startlineno,min(endlineno+back_index,len(self.source_lines))+1):
+ if i==0 and not self.source_lines:
+ break
+ linenostr = '%5d:' % (i)
+ if i==endlineno:
+ sourceline = self.source_lines[i-1]
+ l0 = linenostr+sourceline[:startcolno]
+ if endcolno==-1:
+ l1 = sourceline[startcolno:]
+ l2 = ''
+ else:
+ l1 = sourceline[startcolno:endcolno]
+ l2 = sourceline[endcolno:]
+ r.append('%s%s%s <== %s' % (l0,yellow_text(l1),l2,red_text(message)))
+ else:
+ r.append(linenostr+ self.source_lines[i-1])
+ return '\n'.join(r)
+
+ def format_error_message(self, message, startlineno, endlineno,
+ startcolno=0, endcolno=-1):
+ return self.format_message('ERROR',message, startlineno,
+ endlineno, startcolno, endcolno)
+
+ def format_warning_message(self, message, startlineno, endlineno,
+ startcolno=0, endcolno=-1):
+ return self.format_message('WARNING',message, startlineno,
+ endlineno, startcolno, endcolno)
+
+ def error(self, message, item=None):
+ if item is None:
+ m = self.format_error_message(message, len(self.source_lines)-2, len(self.source_lines))
+ else:
+ m = self.format_error_message(message, item.span[0], item.span[1])
+ self.show_message(m)
+ return
+
+ def warning(self, message, item=None):
+ if item is None:
+ m = self.format_warning_message(message, len(self.source_lines)-2, len(self.source_lines))
+ else:
+ m = self.format_warning_message(message, item.span[0], item.span[1])
+ self.show_message(m)
+ return
+
+ # Auxiliary methods for processing raw source lines:
+
+ def handle_cf2py_start(self, line):
+ """
+ f2py directives can be used only in Fortran codes.
+ They are ignored when used inside .pyf files.
+ """
+ if not line or self.ispyf: return line
+ if self.isfix:
+ if line[0] in '*cC!#':
+ if line[1:5].lower() == 'f2py':
+ line = 5*' ' + line[5:]
+ self.f2py_comment_lines.append(self.linecount)
+ if self.isfix77:
+ return line
+ m = _cf2py_re.match(line)
+ if m:
+ newline = m.group('indent')+5*' '+m.group('rest')
+ self.f2py_comment_lines.append(self.linecount)
+ assert len(newline)==len(line),`newlinel,line`
+ return newline
+ return line
+
+ def handle_inline_comment(self, line, lineno, quotechar=None):
+ if quotechar is None and '!' not in line and \
+ '"' not in line and "'" not in line:
+ return line, quotechar
+ i = line.find('!')
+ put_item = self.fifo_item.append
+ if quotechar is None and i!=-1:
+ # first try a quick method
+ newline = line[:i]
+ if '"' not in newline and '\'' not in newline:
+ if self.isfix77 or not line[i:].startswith('!f2py'):
+ put_item(self.comment_item(line[i:], lineno, lineno))
+ return newline, quotechar
+ # handle cases where comment char may be a part of a character content
+ #splitter = LineSplitter(line, quotechar)
+ #items = [item for item in splitter]
+ #newquotechar = splitter.quotechar
+ items, newquotechar = splitquote(line, quotechar)
+
+ noncomment_items = []
+ noncomment_items_append = noncomment_items.append
+ n = len(items)
+ commentline = None
+ for k in range(n):
+ item = items[k]
+ if isinstance(item, String) or '!' not in item:
+ noncomment_items_append(item)
+ continue
+ j = item.find('!')
+ noncomment_items_append(item[:j])
+ items[k] = item[j:]
+ commentline = ''.join(items[k:])
+ break
+ if commentline is not None:
+ if commentline.startswith('!f2py'):
+ # go to next iteration:
+ newline = ''.join(noncomment_items) + commentline[5:]
+ self.f2py_comment_lines.append(lineno)
+ return self.handle_inline_comment(newline, lineno, quotechar)
+ put_item(self.comment_item(commentline, lineno, lineno))
+ return ''.join(noncomment_items), newquotechar
+
+ def handle_multilines(self, line, startlineno, mlstr):
+ i = line.find(mlstr)
+ if i != -1:
+ prefix = line[:i]
+ # skip fake multiline starts
+ p,k = prefix,0
+ while p.endswith('\\'):
+ p,k = p[:-1],k+1
+ if k % 2: return
+ if i != -1 and '!' not in prefix:
+ # Note character constans like 'abc"""123',
+ # so multiline prefix should better not contain `'' or `"' not `!'.
+ for quote in '"\'':
+ if prefix.count(quote) % 2:
+ message = self.format_warning_message(\
+ 'multiline prefix contains odd number of %r characters' \
+ % (quote), startlineno, startlineno,
+ 0, len(prefix))
+ self.show_message(message, sys.stderr)
+
+ suffix = None
+ multilines = []
+ line = line[i+3:]
+ while line is not None:
+ j = line.find(mlstr)
+ if j != -1 and '!' not in line[:j]:
+ multilines.append(line[:j])
+ suffix = line[j+3:]
+ break
+ multilines.append(line)
+ line = self.get_single_line()
+ if line is None:
+ message = self.format_error_message(\
+ 'multiline block never ends', startlineno,
+ startlineno, i)
+ return self.multiline_item(\
+ prefix,multilines,suffix,\
+ startlineno, self.linecount, message)
+ suffix,qc = self.handle_inline_comment(suffix, self.linecount)
+ # no line continuation allowed in multiline suffix
+ if qc is not None:
+ message = self.format_message(\
+ 'ASSERTION FAILURE(pyf)',
+ 'following character continuation: %r, expected None.' % (qc),
+ startlineno, self.linecount)
+ self.show_message(message, sys.stderr)
+ # XXX: should we do line.replace('\\'+mlstr[0],mlstr[0])
+ # for line in multilines?
+ return self.multiline_item(prefix,multilines,suffix,
+ startlineno, self.linecount)
+
+ # The main method of interpreting raw source lines within
+ # the following contexts: f77, fixed f90, free f90, pyf.
+
+ def get_source_item(self):
+ """
+ a source item is ..
+ - a fortran line
+ - a list of continued fortran lines
+ - a multiline - lines inside triple-qoutes, only when in ispyf mode
+ """
+ get_single_line = self.get_single_line
+ line = get_single_line()
+ if line is None: return
+ startlineno = self.linecount
+ line = self.handle_cf2py_start(line)
+ is_f2py_directive = startlineno in self.f2py_comment_lines
+
+ label = None
+ if self.ispyf:
+ # handle multilines
+ for mlstr in ['"""',"'''"]:
+ r = self.handle_multilines(line, startlineno, mlstr)
+ if r: return r
+
+ if self.isfix:
+ label = line[:5].strip().lower()
+ if label.endswith(':'): label = label[:-1].strip()
+ if not line.strip():
+ # empty line
+ return self.line_item(line[6:],startlineno,self.linecount,label)
+ if _is_fix_comment(line):
+ return self.comment_item(line, startlineno, startlineno)
+ for i in range(5):
+ if line[i] not in _spacedigits:
+ message = 'non-space/digit char %r found in column %i'\
+ ' of fixed Fortran code' % (line[i],i+1)
+ if self.isfix90:
+ message = message + ', switching to free format mode'
+ message = self.format_warning_message(\
+ message,startlineno, self.linecount)
+ self.show_message(message, sys.stderr)
+ self.set_mode(True, False)
+ else:
+ return self.line_item(line[6:], startlineno, self.linecount,
+ label, self.format_error_message(\
+ message, startlineno, self.linecount))
+
+ if self.isfix77 and not is_f2py_directive:
+ lines = [line[6:72]]
+ while _is_fix_cont(self.get_next_line()):
+ # handle fix format line continuations for F77 code
+ line = get_single_line()
+ lines.append(line[6:72])
+ return self.line_item(''.join(lines),startlineno,self.linecount,label)
+
+ handle_inline_comment = self.handle_inline_comment
+
+ if self.isfix90 and not is_f2py_directive:
+ # handle inline comment
+ newline,qc = handle_inline_comment(line[6:], startlineno)
+ lines = [newline]
+ next_line = self.get_next_line()
+ while _is_fix_cont(next_line) or _is_fix_comment(next_line):
+ # handle fix format line continuations for F90 code.
+ # mixing fix format and f90 line continuations is not allowed
+ # nor detected, just eject warnings.
+ line2 = get_single_line()
+ if _is_fix_comment(line2):
+ # handle fix format comments inside line continuations
+ citem = self.comment_item(line2,self.linecount,self.linecount)
+ self.fifo_item.append(citem)
+ else:
+ newline, qc = self.handle_inline_comment(line2[6:],
+ self.linecount, qc)
+ lines.append(newline)
+ next_line = self.get_next_line()
+ # no character continuation should follows now
+ if qc is not None:
+ message = self.format_message(\
+ 'ASSERTION FAILURE(fix90)',
+ 'following character continuation: %r, expected None.'\
+ % (qc), startlineno, self.linecount)
+ self.show_message(message, sys.stderr)
+ if len(lines)>1:
+ for i in range(len(lines)):
+ l = lines[i]
+ if l.rstrip().endswith('&'):
+ message = self.format_warning_message(\
+ 'f90 line continuation character `&\' detected'\
+ ' in fix format code',
+ startlineno + i, startlineno + i, l.rfind('&')+5)
+ self.show_message(message, sys.stderr)
+ return self.line_item(''.join(lines),startlineno,
+ self.linecount,label)
+ start_index = 0
+ if self.isfix90:
+ start_index = 6
+
+ lines = []
+ lines_append = lines.append
+ put_item = self.fifo_item.append
+ qc = None
+ while line is not None:
+ if start_index: # fix format code
+ line,qc = handle_inline_comment(line[start_index:],
+ self.linecount,qc)
+ is_f2py_directive = self.linecount in self.f2py_comment_lines
+ else:
+ line_lstrip = line.lstrip()
+ if lines:
+ if line_lstrip.startswith('!'):
+ # check for comment line within line continuation
+ put_item(self.comment_item(line_lstrip,
+ self.linecount, self.linecount))
+ line = get_single_line()
+ continue
+ else:
+ # first line, check for a f90 label
+ m = _f90label_re.match(line)
+ if m:
+ assert not label,`label,m.group('label')`
+ label = m.group('label').strip()
+ if label.endswith(':'): label = label[:-1].strip()
+ if not self.ispyf: label = label.lower()
+ line = line[m.end():]
+ line,qc = handle_inline_comment(line, self.linecount, qc)
+ is_f2py_directive = self.linecount in self.f2py_comment_lines
+
+ i = line.rfind('&')
+ if i!=-1:
+ line_i1_rstrip = line[i+1:].rstrip()
+ if not lines:
+ # first line
+ if i == -1 or line_i1_rstrip:
+ lines_append(line)
+ break
+ lines_append(line[:i])
+ line = get_single_line()
+ continue
+ if i == -1 or line_i1_rstrip:
+ # no line continuation follows
+ i = len(line)
+ k = -1
+ if i != -1:
+ # handle the beggining of continued line
+ k = line[:i].find('&')
+ if k != 1 and line[:k].lstrip():
+ k = -1
+ lines_append(line[k+1:i])
+ if i==len(line):
+ break
+ line = get_single_line()
+
+ if qc is not None:
+ message = self.format_message('ASSERTION FAILURE(free)',
+ 'following character continuation: %r, expected None.' % (qc),
+ startlineno, self.linecount)
+ self.show_message(message, sys.stderr)
+ return self.line_item(''.join(lines),startlineno,self.linecount,label)
+
+ ## FortranReaderBase
+
+# Fortran file and string readers:
+
+class FortranFileReader(FortranReaderBase):
+
+ def __init__(self, filename,
+ include_dirs = None):
+ isfree, isstrict = get_source_info(filename)
+ self.id = filename
+ self.file = open(filename,'r')
+ FortranReaderBase.__init__(self, self.file, isfree, isstrict)
+ if include_dirs is None:
+ self.include_dirs.insert(0, os.path.dirname(filename))
+ else:
+ self.include_dirs = include_dirs[:]
+ return
+
+ def close_source(self):
+ self.file.close()
+
+class FortranStringReader(FortranReaderBase):
+
+ def __init__(self, string, isfree, isstrict, include_dirs = None):
+ self.id = 'string-'+str(id(string))
+ source = StringIO(string)
+ FortranReaderBase.__init__(self, source, isfree, isstrict)
+ if include_dirs is not None:
+ self.include_dirs = include_dirs[:]
+ return
+
+# Testing:
+
+def test_f77():
+ string_f77 = """
+c12346 comment
+ subroutine foo
+ call foo
+ 'bar
+a 'g
+ abc=2
+cf2py call me ! hey
+ call you ! hi
+ end
+ '"""
+ reader = FortranStringReader(string_f77,False,True)
+ for item in reader:
+ print item
+
+ filename = tempfile.mktemp()+'.f'
+ f = open(filename,'w')
+ f.write(string_f77)
+ f.close()
+
+ reader = FortranFileReader(filename)
+ for item in reader:
+ print item
+
+def test_pyf():
+ string_pyf = """\
+python module foo
+ interface
+ beginml '''1st line
+ 2nd line
+ end line'''endml='tere!fake comment'!should be a comment
+ a = 2
+ 'charc\"onstant' ''' single line mline '''a='hi!fake comment'!should be a comment
+ a=\\\\\\\\\\'''not a multiline'''
+ !blah='''never ending multiline
+ b=3! hey, fake line continuation:&
+ c=4& !line cont
+ &45
+ thisis_label_2 : c = 3
+ xxif_isotropic_2 : if ( string_upper_compare ( o%opt_aniso, 'ISOTROPIC' ) ) then
+ g=3
+ endif
+ end interface
+ if ( pc_get_lun() .ne. 6) &
+
+ write ( pc_get_lun(), '( &
+ & /, a, /, " p=", i4, " stopping c_flag=", a, &
+ & /, " print unit=", i8)') &
+ trim(title), pcpsx_i_pel(), trim(c_flag), pc_get_lun()
+end python module foo
+! end of file
+"""
+ reader = FortranStringReader(string_pyf,True, True)
+ for item in reader:
+ print item
+
+def test_fix90():
+ string_fix90 = """\
+ subroutine foo
+cComment
+ 1234 a = 3 !inline comment
+ b = 3
+!
+ !4!line cont. with comment symbol
+ &5
+ a = 3!f2py.14 ! pi!
+! KDMO
+ write (obj%print_lun, *) ' KDMO : '
+ write (obj%print_lun, *) ' COORD = ',coord, ' BIN_WID = ', &
+ obj%bin_wid,' VEL_DMO = ', obj%vel_dmo
+ end subroutine foo
+ subroutine
+
+ & foo
+ end
+"""
+ reader = FortranStringReader(string_fix90,False, False)
+ for item in reader:
+ print item
+
+def simple_main():
+ for filename in sys.argv[1:]:
+ print 'Processing',filename
+ reader = FortranFileReader(filename)
+ for item in reader:
+ print >> sys.stdout, item
+ sys.stdout.flush()
+ pass
+
+def profile_main():
+ import hotshot, hotshot.stats
+ prof = hotshot.Profile("readfortran.prof")
+ prof.runcall(simple_main)
+ prof.close()
+ stats = hotshot.stats.load("readfortran.prof")
+ stats.strip_dirs()
+ stats.sort_stats('time', 'calls')
+ stats.print_stats(30)
+
+if __name__ == "__main__":
+ #test_pyf()
+ #test_fix90()
+ #profile_main()
+ simple_main()
diff --git a/numpy/f2py/lib/parser/sourceinfo.py b/numpy/f2py/lib/parser/sourceinfo.py
new file mode 100644
index 000000000..7eb980251
--- /dev/null
+++ b/numpy/f2py/lib/parser/sourceinfo.py
@@ -0,0 +1,81 @@
+"""
+Provides get_source_info(<filename>) function to determine the format
+(free|fixed|strict|pyf) of a Fortran file.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: May 2006
+-----
+"""
+
+__all__ = ['get_source_info']
+
+import re
+import os
+import sys
+
+_has_f_extension = re.compile(r'.*[.](for|ftn|f77|f)\Z',re.I).match
+_has_f_header = re.compile(r'-[*]-\s*fortran\s*-[*]-',re.I).search
+_has_f90_header = re.compile(r'-[*]-\s*f90\s*-[*]-',re.I).search
+_has_fix_header = re.compile(r'-[*]-\s*fix\s*-[*]-',re.I).search
+_free_f90_start = re.compile(r'[^c*!]\s*[^\s\d\t]',re.I).match
+
+def get_source_info(filename):
+ """
+ Determine if fortran file is
+ - in fix format and contains Fortran 77 code -> return False, True
+ - in fix format and contains Fortran 90 code -> return False, False
+ - in free format and contains Fortran 90 code -> return True, False
+ - in free format and contains signatures (.pyf) -> return True, True
+ """
+ base,ext = os.path.splitext(filename)
+ if ext=='.pyf':
+ return True, True
+ isfree = False
+ isstrict = False
+ f = open(filename,'r')
+ firstline = f.readline()
+ f.close()
+ if _has_f_extension(filename) and \
+ not (_has_f90_header(firstline) or _has_fix_header(firstline)):
+ isstrict = True
+ elif is_free_format(filename) and not _has_fix_header(firstline):
+ isfree = True
+ return isfree,isstrict
+
+def is_free_format(file):
+ """Check if file is in free format Fortran."""
+ # f90 allows both fixed and free format, assuming fixed unless
+ # signs of free format are detected.
+ isfree = False
+ f = open(file,'r')
+ line = f.readline()
+ n = 10000 # the number of non-comment lines to scan for hints
+ if _has_f_header(line):
+ n = 0
+ elif _has_f90_header(line):
+ n = 0
+ isfree = True
+ contline = False
+ while n>0 and line:
+ line = line.rstrip()
+ if line and line[0]!='!':
+ n -= 1
+ if line[0]!='\t' and _free_f90_start(line[:5]) or line[-1:]=='&':
+ isfree = True
+ break
+ line = f.readline()
+ f.close()
+ return isfree
+
+def simple_main():
+ for filename in sys.argv[1:]:
+ isfree, isstrict = get_source_info(filename)
+ print '%s: isfree=%s, isstrict=%s' % (filename, isfree, isstrict)
+
+if __name__ == '__main__':
+ simple_main()
diff --git a/numpy/f2py/lib/parser/splitline.py b/numpy/f2py/lib/parser/splitline.py
new file mode 100644
index 000000000..9d4a40fc5
--- /dev/null
+++ b/numpy/f2py/lib/parser/splitline.py
@@ -0,0 +1,426 @@
+#!/usr/bin/env python
+"""
+Defines LineSplitter and helper functions.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: May 2006
+-----
+"""
+
+__all__ = ['String','string_replace_map','splitquote','splitparen']
+
+import re
+
+class String(str): pass
+class ParenString(str): pass
+
+def split2(line, lower=False):
+ """
+ Split line into non-string part and into a start of a string part.
+ Returns 2-tuple. The second item either is empty string or start
+ of a string part.
+ """
+ return LineSplitter(line,lower=lower).split2()
+
+_f2py_str_findall = re.compile(r"_F2PY_STRING_CONSTANT_\d+_").findall
+_is_name = re.compile(r'\w*\Z',re.I).match
+_is_simple_str = re.compile(r'\w*\Z',re.I).match
+_f2py_findall = re.compile(r'(_F2PY_STRING_CONSTANT_\d+_|F2PY_EXPR_TUPLE_\d+)').findall
+
+class string_replace_dict(dict):
+ """
+ Dictionary object that is callable for applying map returned
+ by string_replace_map() function.
+ """
+ def __call__(self, line):
+ for k in _f2py_findall(line):
+ line = line.replace(k, self[k])
+ return line
+
+def string_replace_map(line, lower=False,
+ _cache={'index':0,'pindex':0}):
+ """
+ 1) Replaces string constants with symbol `'_F2PY_STRING_CONSTANT_<index>_'`
+ 2) Replaces (expression) with symbol `(F2PY_EXPR_TUPLE_<index>)`
+ Returns a new line and the replacement map.
+ """
+ items = []
+ string_map = string_replace_dict()
+ rev_string_map = {}
+ for item in splitquote(line, lower=lower)[0]:
+ if isinstance(item, String) and not _is_simple_str(item[1:-1]):
+ key = rev_string_map.get(item)
+ if key is None:
+ _cache['index'] += 1
+ index = _cache['index']
+ key = "_F2PY_STRING_CONSTANT_%s_" % (index)
+ it = item[1:-1]
+ string_map[key] = it
+ rev_string_map[it] = key
+ items.append(item[0]+key+item[-1])
+ else:
+ items.append(item)
+ newline = ''.join(items)
+ items = []
+ expr_keys = []
+ for item in splitparen(newline):
+ if isinstance(item, ParenString) and not _is_name(item[1:-1]):
+ key = rev_string_map.get(item)
+ if key is None:
+ _cache['pindex'] += 1
+ index = _cache['pindex']
+ key = 'F2PY_EXPR_TUPLE_%s' % (index)
+ it = item[1:-1].strip()
+ string_map[key] = it
+ rev_string_map[it] = key
+ expr_keys.append(key)
+ items.append(item[0]+key+item[-1])
+ else:
+ items.append(item)
+ found_keys = set()
+ for k in expr_keys:
+ v = string_map[k]
+ l = _f2py_str_findall(v)
+ if l:
+ found_keys = found_keys.union(l)
+ for k1 in l:
+ v = v.replace(k1, string_map[k1])
+ string_map[k] = v
+ for k in found_keys:
+ del string_map[k]
+ return ''.join(items), string_map
+
+def splitquote(line, stopchar=None, lower=False, quotechars = '"\''):
+ """
+ Fast LineSplitter
+ """
+ items = []
+ i = 0
+ while 1:
+ try:
+ char = line[i]; i += 1
+ except IndexError:
+ break
+ l = []
+ l_append = l.append
+ nofslashes = 0
+ if stopchar is None:
+ # search for string start
+ while 1:
+ if char in quotechars and not nofslashes % 2:
+ stopchar = char
+ i -= 1
+ break
+ if char=='\\':
+ nofslashes += 1
+ else:
+ nofslashes = 0
+ l_append(char)
+ try:
+ char = line[i]; i += 1
+ except IndexError:
+ break
+ if not l: continue
+ item = ''.join(l)
+ if lower: item = item.lower()
+ items.append(item)
+ continue
+ if char==stopchar:
+ # string starts with quotechar
+ l_append(char)
+ try:
+ char = line[i]; i += 1
+ except IndexError:
+ if l:
+ item = String(''.join(l))
+ items.append(item)
+ break
+ # else continued string
+ while 1:
+ if char==stopchar and not nofslashes % 2:
+ l_append(char)
+ stopchar = None
+ break
+ if char=='\\':
+ nofslashes += 1
+ else:
+ nofslashes = 0
+ l_append(char)
+ try:
+ char = line[i]; i += 1
+ except IndexError:
+ break
+ if l:
+ item = String(''.join(l))
+ items.append(item)
+ return items, stopchar
+
+class LineSplitterBase:
+
+ def __iter__(self):
+ return self
+
+ def next(self):
+ item = ''
+ while not item:
+ item = self.get_item() # get_item raises StopIteration
+ return item
+
+class LineSplitter(LineSplitterBase):
+ """ Splits a line into non strings and strings. E.g.
+ abc=\"123\" -> ['abc=','\"123\"']
+ Handles splitting lines with incomplete string blocks.
+ """
+ def __init__(self, line,
+ quotechar = None,
+ lower=False,
+ ):
+ self.fifo_line = [c for c in line]
+ self.fifo_line.reverse()
+ self.quotechar = quotechar
+ self.lower = lower
+
+ def split2(self):
+ """
+ Split line until the first start of a string.
+ """
+ try:
+ item1 = self.get_item()
+ except StopIteration:
+ return '',''
+ i = len(item1)
+ l = self.fifo_line[:]
+ l.reverse()
+ item2 = ''.join(l)
+ return item1,item2
+
+ def get_item(self):
+ fifo_pop = self.fifo_line.pop
+ try:
+ char = fifo_pop()
+ except IndexError:
+ raise StopIteration
+ fifo_append = self.fifo_line.append
+ quotechar = self.quotechar
+ l = []
+ l_append = l.append
+
+ nofslashes = 0
+ if quotechar is None:
+ # search for string start
+ while 1:
+ if char in '"\'' and not nofslashes % 2:
+ self.quotechar = char
+ fifo_append(char)
+ break
+ if char=='\\':
+ nofslashes += 1
+ else:
+ nofslashes = 0
+ l_append(char)
+ try:
+ char = fifo_pop()
+ except IndexError:
+ break
+ item = ''.join(l)
+ if self.lower: item = item.lower()
+ return item
+
+ if char==quotechar:
+ # string starts with quotechar
+ l_append(char)
+ try:
+ char = fifo_pop()
+ except IndexError:
+ return String(''.join(l))
+ # else continued string
+ while 1:
+ if char==quotechar and not nofslashes % 2:
+ l_append(char)
+ self.quotechar = None
+ break
+ if char=='\\':
+ nofslashes += 1
+ else:
+ nofslashes = 0
+ l_append(char)
+ try:
+ char = fifo_pop()
+ except IndexError:
+ break
+ return String(''.join(l))
+
+def splitparen(line,paren='()'):
+ """
+ Fast LineSplitterParen.
+ """
+ stopchar = None
+ startchar, endchar = paren[0],paren[1]
+
+ items = []
+ i = 0
+ while 1:
+ try:
+ char = line[i]; i += 1
+ except IndexError:
+ break
+ nofslashes = 0
+ l = []
+ l_append = l.append
+ if stopchar is None:
+ # search for parenthesis start
+ while 1:
+ if char==startchar and not nofslashes % 2:
+ stopchar = endchar
+ i -= 1
+ break
+ if char=='\\':
+ nofslashes += 1
+ else:
+ nofslashes = 0
+ l_append(char)
+ try:
+ char = line[i]; i += 1
+ except IndexError:
+ break
+ item = ''.join(l)
+ else:
+ nofstarts = 0
+ while 1:
+ if char==stopchar and not nofslashes % 2 and nofstarts==1:
+ l_append(char)
+ stopchar = None
+ break
+ if char=='\\':
+ nofslashes += 1
+ else:
+ nofslashes = 0
+ if char==startchar:
+ nofstarts += 1
+ elif char==endchar:
+ nofstarts -= 1
+ l_append(char)
+ try:
+ char = line[i]; i += 1
+ except IndexError:
+ break
+ item = ParenString(''.join(l))
+ items.append(item)
+ return items
+
+class LineSplitterParen(LineSplitterBase):
+ """ Splits a line into strings and strings with parenthesis. E.g.
+ a(x) = b(c,d) -> ['a','(x)',' = b','(c,d)']
+ """
+ def __init__(self, line, paren = '()'):
+ self.fifo_line = [c for c in line]
+ self.fifo_line.reverse()
+ self.startchar = paren[0]
+ self.endchar = paren[1]
+ self.stopchar = None
+
+ def get_item(self):
+ fifo_pop = self.fifo_line.pop
+ try:
+ char = fifo_pop()
+ except IndexError:
+ raise StopIteration
+ fifo_append = self.fifo_line.append
+ startchar = self.startchar
+ endchar = self.endchar
+ stopchar = self.stopchar
+ l = []
+ l_append = l.append
+
+ nofslashes = 0
+ if stopchar is None:
+ # search for parenthesis start
+ while 1:
+ if char==startchar and not nofslashes % 2:
+ self.stopchar = endchar
+ fifo_append(char)
+ break
+ if char=='\\':
+ nofslashes += 1
+ else:
+ nofslashes = 0
+ l_append(char)
+ try:
+ char = fifo_pop()
+ except IndexError:
+ break
+ item = ''.join(l)
+ return item
+
+ nofstarts = 0
+ while 1:
+ if char==stopchar and not nofslashes % 2 and nofstarts==1:
+ l_append(char)
+ self.stopchar = None
+ break
+ if char=='\\':
+ nofslashes += 1
+ else:
+ nofslashes = 0
+ if char==startchar:
+ nofstarts += 1
+ elif char==endchar:
+ nofstarts -= 1
+ l_append(char)
+ try:
+ char = fifo_pop()
+ except IndexError:
+ break
+ return ParenString(''.join(l))
+
+def test():
+ splitter = LineSplitter('abc\\\' def"12\\"3""56"dfad\'a d\'')
+ l = [item for item in splitter]
+ assert l==['abc\\\' def','"12\\"3"','"56"','dfad','\'a d\''],`l`
+ assert splitter.quotechar is None
+ l,stopchar=splitquote('abc\\\' def"12\\"3""56"dfad\'a d\'')
+ assert l==['abc\\\' def','"12\\"3"','"56"','dfad','\'a d\''],`l`
+ assert stopchar is None
+
+ splitter = LineSplitter('"abc123&')
+ l = [item for item in splitter]
+ assert l==['"abc123&'],`l`
+ assert splitter.quotechar=='"'
+ l,stopchar = splitquote('"abc123&')
+ assert l==['"abc123&'],`l`
+ assert stopchar=='"'
+
+ splitter = LineSplitter(' &abc"123','"')
+ l = [item for item in splitter]
+ assert l==[' &abc"','123']
+ assert splitter.quotechar is None
+ l,stopchar = splitquote(' &abc"123','"')
+ assert l==[' &abc"','123']
+ assert stopchar is None
+
+ l = split2('')
+ assert l==('',''),`l`
+ l = split2('12')
+ assert l==('12',''),`l`
+ l = split2('1"a"//"b"')
+ assert l==('1','"a"//"b"'),`l`
+ l = split2('"ab"')
+ assert l==('','"ab"'),`l`
+
+ splitter = LineSplitterParen('a(b) = b(x,y(1)) b\((a)\)')
+ l = [item for item in splitter]
+ assert l==['a', '(b)', ' = b', '(x,y(1))', ' b\\(', '(a)', '\\)'],`l`
+ l = splitparen('a(b) = b(x,y(1)) b\((a)\)')
+ assert l==['a', '(b)', ' = b', '(x,y(1))', ' b\\(', '(a)', '\\)'],`l`
+
+ l = string_replace_map('a()')
+ print l
+ print 'ok'
+
+if __name__ == '__main__':
+ test()
diff --git a/numpy/f2py/lib/parser/statements.py b/numpy/f2py/lib/parser/statements.py
new file mode 100644
index 000000000..b37948faf
--- /dev/null
+++ b/numpy/f2py/lib/parser/statements.py
@@ -0,0 +1,1856 @@
+"""
+Fortran single line statements.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: May 2006
+-----
+"""
+
+__all__ = ['GeneralAssignment',
+ 'Assignment','PointerAssignment','Assign','Call','Goto','ComputedGoto','AssignedGoto',
+ 'Continue','Return','Stop','Print','Read','Read0','Read1','Write','Flush','Wait',
+ 'Contains','Allocate','Deallocate','ModuleProcedure','Access','Public','Private',
+ 'Close','Cycle','Backspace','Endfile','Rewind','Open','Format','Save',
+ 'Data','Nullify','Use','Exit','Parameter','Equivalence','Dimension','Target',
+ 'Pointer','Protected','Volatile','Value','ArithmeticIf','Intrinsic',
+ 'Inquire','Sequence','External','Namelist','Common','Optional','Intent',
+ 'Entry','Import','ForallStmt','SpecificBinding','GenericBinding',
+ 'FinalBinding','Allocatable','Asynchronous','Bind','Else','ElseIf',
+ 'Case','WhereStmt','ElseWhere','Enumerator','FortranName','Threadsafe',
+ 'Depend','Check','CallStatement','CallProtoArgument','Pause']
+
+import re
+import sys
+
+from base_classes import Statement, Variable
+
+# Auxiliary tools
+
+from utils import split_comma, specs_split_comma, AnalyzeError, ParseError,\
+ get_module_file, parse_bind, parse_result, is_name
+
+class StatementWithNamelist(Statement):
+ """
+ <statement> [ :: ] <name-list>
+ """
+ def process_item(self):
+ if self.item.has_map():
+ self.isvalid = False
+ return
+ if hasattr(self,'stmtname'):
+ clsname = self.stmtname
+ else:
+ clsname = self.__class__.__name__
+ line = self.item.get_line()[len(clsname):].lstrip()
+ if line.startswith('::'):
+ line = line[2:].lstrip()
+ self.items = items = []
+ for item in split_comma(line):
+ if not is_name(item):
+ self.isvalid = False
+ return
+ items.append(item)
+ return
+
+ def tofortran(self,isfix=None):
+ if hasattr(self,'stmtname'):
+ clsname = self.stmtname.upper()
+ else:
+ clsname = self.__class__.__name__.upper()
+ s = ', '.join(self.items)
+ if s:
+ s = ' ' + s
+ return self.get_indent_tab(isfix=isfix) + clsname + s
+
+# Execution statements
+
+class GeneralAssignment(Statement):
+ """
+ <variable> = <expr>
+ <pointer variable> => <expr>
+ """
+
+ match = re.compile(r'\w[^=]*\s*=\>?').match
+ item_re = re.compile(r'(?P<variable>\w[^=]*)\s*(?P<sign>=\>?)\s*(?P<expr>.*)\Z',re.I).match
+ _repr_attr_names = ['variable','sign','expr'] + Statement._repr_attr_names
+
+ def process_item(self):
+ m = self.item_re(self.item.get_line())
+ if not m:
+ self.isvalid = False
+ return
+ self.sign = sign = m.group('sign')
+ if isinstance(self, Assignment) and sign != '=':
+ self.isvalid = False
+ return
+ elif isinstance(self, PointerAssignment) and sign != '=>':
+ self.isvalid = False
+ return
+ else:
+ if sign=='=>':
+ self.__class__ = PointerAssignment
+ else:
+ self.__class__ = Assignment
+ apply_map = self.item.apply_map
+ self.variable = apply_map(m.group('variable').replace(' ',''))
+ self.expr = apply_map(m.group('expr'))
+ return
+
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + '%s %s %s' \
+ % (self.variable, self.sign, self.expr)
+
+ def analyze(self): return
+
+class Assignment(GeneralAssignment):
+ pass
+
+class PointerAssignment(GeneralAssignment):
+ pass
+
+class Assign(Statement):
+ """
+ ASSIGN <label> TO <int-variable-name>
+ """
+ modes = ['fix77']
+ match = re.compile(r'assign\s*\d+\s*to\s*\w+\s*\Z',re.I).match
+ def process_item(self):
+ line = self.item.get_line()[6:].lstrip()
+ i = line.lower().find('to')
+ assert not self.item.has_map()
+ self.items = [line[:i].rstrip(),line[i+2:].lstrip()]
+ return
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'ASSIGN %s TO %s' \
+ % (self.items[0], self.items[1])
+ def analyze(self): return
+
+class Call(Statement):
+ """Call statement class
+ CALL <procedure-designator> [ ( [ <actual-arg-spec-list> ] ) ]
+
+ <procedure-designator> = <procedure-name>
+ | <proc-component-ref>
+ | <data-ref> % <binding-name>
+
+ <actual-arg-spec> = [ <keyword> = ] <actual-arg>
+ <actual-arg> = <expr>
+ | <variable>
+ | <procedure-name>
+ | <proc-component-ref>
+ | <alt-return-spec>
+ <alt-return-spec> = * <label>
+
+ <proc-component-ref> = <variable> % <procedure-component-name>
+
+ <variable> = <designator>
+
+ Call instance has attributes:
+ designator
+ arg_list
+ """
+ match = re.compile(r'call\b', re.I).match
+
+ def process_item(self):
+ item = self.item
+ apply_map = item.apply_map
+ line = item.get_line()[4:].strip()
+ i = line.find('(')
+ items = []
+ if i==-1:
+ self.designator = apply_map(line).strip()
+ else:
+ j = line.find(')')
+ if j == -1 or len(line)-1 != j:
+ self.isvalid = False
+ return
+ self.designator = apply_map(line[:i]).strip()
+ items = split_comma(line[i+1:-1], item)
+ self.items = items
+ return
+
+ def tofortran(self, isfix=None):
+ s = self.get_indent_tab(isfix=isfix) + 'CALL '+str(self.designator)
+ if self.items:
+ s += '('+', '.join(map(str,self.items))+ ')'
+ return s
+
+ def analyze(self):
+ a = self.programblock.a
+ variables = a.variables
+ if hasattr(a, 'external'):
+ external = a.external
+ if self.designator in external:
+ print >> sys.stderr, 'Need to analyze:',self
+ return
+
+class Goto(Statement):
+ """
+ GO TO <label>
+ """
+ match = re.compile(r'go\s*to\s*\d+\s*\Z', re.I).match
+
+ def process_item(self):
+ assert not self.item.has_map()
+ self.label = self.item.get_line()[2:].lstrip()[2:].lstrip()
+ return
+
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'GO TO %s' % (self.label)
+ def analyze(self): return
+
+class ComputedGoto(Statement):
+ """
+ GO TO ( <label-list> ) [ , ] <scalar-int-expr>
+ """
+ match = re.compile(r'go\s*to\s*\(',re.I).match
+ def process_item(self):
+ apply_map = self.item.apply_map
+ line = self.item.get_line()[2:].lstrip()[2:].lstrip()
+ i = line.index(')')
+ self.items = split_comma(line[1:i], self.item)
+ line = line[i+1:].lstrip()
+ if line.startswith(','):
+ line = line[1:].lstrip()
+ self.expr = apply_map(line)
+ return
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'GO TO (%s) %s' \
+ % (', '.join(self.items), self.expr)
+ def analyze(self): return
+
+class AssignedGoto(Statement):
+ """
+ GO TO <int-variable-name> [ ( <label> [ , <label> ]... ) ]
+ """
+ modes = ['fix77']
+ match = re.compile(r'go\s*to\s*\w+\s*\(?',re.I).match
+ def process_item(self):
+ line = self.item.get_line()[2:].lstrip()[2:].lstrip()
+ i = line.find('(')
+ if i==-1:
+ self.varname = line
+ self.items = []
+ return
+ self.varname = line[:i].rstrip()
+ assert line[-1]==')',`line`
+ self
+ self.items = split_comma(line[i+1:-1], self.item)
+ return
+
+ def tofortran(self, isfix=None):
+ tab = self.get_indent_tab(isfix=isfix)
+ if self.items:
+ return tab + 'GO TO %s (%s)' \
+ % (self.varname, ', '.join(self.items))
+ return tab + 'GO TO %s' % (self.varname)
+ def analyze(self): return
+
+class Continue(Statement):
+ """
+ CONTINUE
+ """
+ match = re.compile(r'continue\Z',re.I).match
+
+ def process_item(self):
+ self.label = self.item.label
+ return
+
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(deindent=True) + 'CONTINUE'
+
+ def analyze(self): return
+
+class Return(Statement):
+ """
+ RETURN [ <scalar-int-expr> ]
+ """
+ match = re.compile(r'return\b',re.I).match
+
+ def process_item(self):
+ self.expr = self.item.apply_map(self.item.get_line()[6:].lstrip())
+ return
+
+ def tofortran(self, isfix=None):
+ tab = self.get_indent_tab(isfix=isfix)
+ if self.expr:
+ return tab + 'RETURN %s' % (self.expr)
+ return tab + 'RETURN'
+
+ def analyze(self): return
+
+class Stop(Statement):
+ """
+ STOP [ <stop-code> ]
+ <stop-code> = <scalar-char-constant> | <1-5-digit>
+ """
+ match = re.compile(r'stop\s*(\'\w*\'|"\w*"|\d+|)\Z',re.I).match
+
+ def process_item(self):
+ self.code = self.item.apply_map(self.item.get_line()[4:].lstrip())
+ return
+
+ def tofortran(self, isfix=None):
+ tab = self.get_indent_tab(isfix=isfix)
+ if self.code:
+ return tab + 'STOP %s' % (self.code)
+ return tab + 'STOP'
+
+ def analyze(self): return
+
+class Print(Statement):
+ """
+ PRINT <format> [, <output-item-list>]
+ <format> = <default-char-expr> | <label> | *
+
+ <output-item> = <expr> | <io-implied-do>
+ <io-implied-do> = ( <io-implied-do-object-list> , <implied-do-control> )
+ <io-implied-do-object> = <input-item> | <output-item>
+ <implied-do-control> = <do-variable> = <scalar-int-expr> , <scalar-int-expr> [ , <scalar-int-expr> ]
+ <input-item> = <variable> | <io-implied-do>
+ """
+ match = re.compile(r'print\s*(\'\w*\'|\"\w*\"|\d+|[*]|\b\w)', re.I).match
+
+ def process_item(self):
+ item = self.item
+ apply_map = item.apply_map
+ line = item.get_line()[5:].lstrip()
+ items = split_comma(line, item)
+ self.format = items[0]
+ self.items = items[1:]
+ return
+
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'PRINT %s' \
+ % (', '.join([self.format]+self.items))
+ def analyze(self): return
+
+class Read(Statement):
+ """
+Read0: READ ( <io-control-spec-list> ) [ <input-item-list> ]
+
+ <io-control-spec-list> = [ UNIT = ] <io-unit>
+ | [ FORMAT = ] <format>
+ | [ NML = ] <namelist-group-name>
+ | ADVANCE = <scalar-default-char-expr>
+ ...
+
+Read1: READ <format> [, <input-item-list>]
+ <format> == <default-char-expr> | <label> | *
+ """
+ match = re.compile(r'read\b\s*[\w(*\'"]', re.I).match
+
+ def process_item(self):
+ item = self.item
+ line = item.get_line()[4:].lstrip()
+ if line.startswith('('):
+ self.__class__ = Read0
+ else:
+ self.__class__ = Read1
+ self.process_item()
+ return
+ def analyze(self): return
+
+class Read0(Read):
+
+ def process_item(self):
+ item = self.item
+ line = item.get_line()[4:].lstrip()
+ i = line.find(')')
+ self.specs = specs_split_comma(line[1:i], item)
+ self.items = split_comma(line[i+1:], item)
+ return
+
+ def tofortran(self, isfix=None):
+ s = self.get_indent_tab(isfix=isfix) + 'READ (%s)' % (', '.join(self.specs))
+ if self.items:
+ return s + ' ' + ', '.join(self.items)
+ return s
+
+class Read1(Read):
+
+ def process_item(self):
+ item = self.item
+ line = item.get_line()[4:].lstrip()
+ items = split_comma(line, item)
+ self.format = items[0]
+ self.items = items[1:]
+ return
+
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'READ ' \
+ + ', '.join([self.format]+self.items)
+
+class Write(Statement):
+ """
+ WRITE ( io-control-spec-list ) [<output-item-list>]
+ """
+ match = re.compile(r'write\s*\(', re.I).match
+ def process_item(self):
+ item = self.item
+ line = item.get_line()[5:].lstrip()
+ i = line.find(')')
+ assert i != -1, `line`
+ self.specs = specs_split_comma(line[1:i], item)
+ self.items = split_comma(line[i+1:], item)
+ return
+
+ def tofortran(self, isfix=None):
+ s = self.get_indent_tab(isfix=isfix) + 'WRITE (%s)' % ', '.join(self.specs)
+ if self.items:
+ s += ' ' + ', '.join(self.items)
+ return s
+ def analyze(self): return
+
+
+class Flush(Statement):
+ """
+ FLUSH <file-unit-number>
+ FLUSH ( <flush-spec-list> )
+ <flush-spec> = [ UNIT = ] <file-unit-number>
+ | IOSTAT = <scalar-int-variable>
+ | IOMSG = <iomsg-variable>
+ | ERR = <label>
+ """
+ match = re.compile(r'flush\b',re.I).match
+
+ def process_item(self):
+ line = self.item.get_line()[5:].lstrip()
+ if not line:
+ self.isvalid = False
+ return
+ if line.startswith('('):
+ assert line[-1] == ')', `line`
+ self.specs = specs_split_comma(line[1:-1],self.item)
+ else:
+ self.specs = specs_split_comma(line,self.item)
+ return
+
+ def tofortran(self, isfix=None):
+ tab = self.get_indent_tab(isfix=isfix)
+ return tab + 'FLUSH (%s)' % (', '.join(self.specs))
+ def analyze(self): return
+
+class Wait(Statement):
+ """
+ WAIT ( <wait-spec-list> )
+ <wait-spec> = [ UNIT = ] <file-unit-number>
+ | END = <label>
+ | EOR = <label>
+ | ERR = <label>
+ | ID = <scalar-int-expr>
+ | IOMSG = <iomsg-variable>
+ | IOSTAT = <scalar-int-variable>
+
+ """
+ match = re.compile(r'wait\s*\(.*\)\Z',re.I).match
+ def process_item(self):
+ self.specs = specs_split_comma(\
+ self.item.get_line()[4:].lstrip()[1:-1], self.item)
+ return
+ def tofortran(self, isfix=None):
+ tab = self.get_indent_tab(isfix=isfix)
+ return tab + 'WAIT (%s)' % (', '.join(self.specs))
+ def analyze(self): return
+
+class Contains(Statement):
+ """
+ CONTAINS
+ """
+ match = re.compile(r'contains\Z',re.I).match
+ def process_item(self): return
+ def tofortran(self, isfix=None): return self.get_indent_tab(isfix=isfix) + 'CONTAINS'
+
+class Allocate(Statement):
+ """
+ ALLOCATE ( [ <type-spec> :: ] <allocation-list> [ , <alloc-opt-list> ] )
+ <alloc-opt> = STAT = <stat-variable>
+ | ERRMSG = <errmsg-variable>
+ | SOURCE = <source-expr>
+ <allocation> = <allocate-object> [ ( <allocate-shape-spec-list> ) ]
+ """
+ match = re.compile(r'allocate\s*\(.*\)\Z',re.I).match
+ def process_item(self):
+ line = self.item.get_line()[8:].lstrip()[1:-1].strip()
+ item2 = self.item.copy(line, True)
+ line2 = item2.get_line()
+ i = line2.find('::')
+ if i != -1:
+ spec = item2.apply_map(line2[:i].rstrip())
+ from block_statements import type_spec
+ stmt = None
+ for cls in type_spec:
+ if cls.match(spec):
+ stmt = cls(self, item2.copy(spec))
+ if stmt.isvalid:
+ break
+ if stmt is not None and stmt.isvalid:
+ spec = stmt
+ else:
+ self.warning('TODO: unparsed type-spec' + `spec`)
+ line2 = line2[i+2:].lstrip()
+ else:
+ spec = None
+ self.spec = spec
+ self.items = specs_split_comma(line2, item2)
+ return
+
+ def tofortran(self, isfix=None):
+ t = ''
+ if self.spec:
+ t = self.spec.tostr() + ' :: '
+ return self.get_indent_tab(isfix=isfix) \
+ + 'ALLOCATE (%s%s)' % (t,', '.join(self.items))
+ def analyze(self): return
+
+class Deallocate(Statement):
+ """
+ DEALLOCATE ( <allocate-object-list> [ , <dealloc-opt-list> ] )
+ <allocate-object> = <variable-name>
+ | <structure-component>
+ <structure-component> = <data-ref>
+ <dealloc-opt> = STAT = <stat-variable>
+ | ERRMSG = <errmsg-variable>
+ """
+ match = re.compile(r'deallocate\s*\(.*\)\Z',re.I).match
+ def process_item(self):
+ line = self.item.get_line()[10:].lstrip()[1:-1].strip()
+ self.items = specs_split_comma(line, self.item)
+ return
+ def tofortran(self, isfix=None): return self.get_indent_tab(isfix=isfix) \
+ + 'DEALLOCATE (%s)' % (', '.join(self.items))
+ def analyze(self): return
+
+class ModuleProcedure(Statement):
+ """
+ [ MODULE ] PROCEDURE <procedure-name-list>
+ """
+ match = re.compile(r'(module\s*|)procedure\b',re.I).match
+ def process_item(self):
+ line = self.item.get_line()
+ m = self.match(line)
+ assert m,`line`
+ items = split_comma(line[m.end():].strip(), self.item)
+ for n in items:
+ if not is_name(n):
+ self.isvalid = False
+ return
+ self.items = items
+ return
+
+ def tofortran(self, isfix=None):
+ tab = self.get_indent_tab(isfix=isfix)
+ return tab + 'MODULE PROCEDURE %s' % (', '.join(self.items))
+
+ def analyze(self):
+ module_procedures = self.parent.a.module_procedures
+ module_procedures.extend(self.items)
+ # XXX: add names to parent_provides
+ return
+
+class Access(Statement):
+ """
+ <access-spec> [ [::] <access-id-list>]
+ <access-spec> = PUBLIC | PRIVATE
+ <access-id> = <use-name> | <generic-spec>
+ """
+ match = re.compile(r'(public|private)\b',re.I).match
+ def process_item(self):
+ clsname = self.__class__.__name__.lower()
+ line = self.item.get_line()
+ if not line.lower().startswith(clsname):
+ self.isvalid = False
+ return
+ line = line[len(clsname):].lstrip()
+ if line.startswith('::'):
+ line = line[2:].lstrip()
+ self.items = split_comma(line, self.item)
+ return
+
+ def tofortran(self, isfix=None):
+ clsname = self.__class__.__name__.upper()
+ tab = self.get_indent_tab(isfix=isfix)
+ if self.items:
+ return tab + clsname + ' ' + ', '.join(self.items)
+ return tab + clsname
+
+ def analyze(self):
+ clsname = self.__class__.__name__
+ l = getattr(self.parent.a, clsname.lower() + '_id_list')
+ if self.items:
+ for name in self.items:
+ if name not in l: l.append(name)
+ else:
+ if '' not in l:
+ l.append('')
+ return
+
+class Public(Access):
+ is_public = True
+class Private(Access):
+ is_public = False
+
+class Close(Statement):
+ """
+ CLOSE ( <close-spec-list> )
+ <close-spec> = [ UNIT = ] <file-unit-number>
+ | IOSTAT = <scalar-int-variable>
+ | IOMSG = <iomsg-variable>
+ | ERR = <label>
+ | STATUS = <scalar-default-char-expr>
+ """
+ match = re.compile(r'close\s*\(.*\)\Z',re.I).match
+ def process_item(self):
+ line = self.item.get_line()[5:].lstrip()[1:-1].strip()
+ self.specs = specs_split_comma(line, self.item)
+ return
+ def tofortran(self, isfix=None):
+ tab = self.get_indent_tab(isfix=isfix)
+ return tab + 'CLOSE (%s)' % (', '.join(self.specs))
+ def analyze(self): return
+
+class Cycle(Statement):
+ """
+ CYCLE [ <do-construct-name> ]
+ """
+ match = re.compile(r'cycle\b\s*\w*\s*\Z',re.I).match
+ def process_item(self):
+ self.name = self.item.get_line()[5:].lstrip()
+ return
+ def tofortran(self, isfix=None):
+ if self.name:
+ return self.get_indent_tab(isfix=isfix) + 'CYCLE ' + self.name
+ return self.get_indent_tab(isfix=isfix) + 'CYCLE'
+ def analyze(self): return
+
+class FilePositioningStatement(Statement):
+ """
+ REWIND <file-unit-number>
+ REWIND ( <position-spec-list> )
+ <position-spec-list> = [ UNIT = ] <file-unit-number>
+ | IOMSG = <iomsg-variable>
+ | IOSTAT = <scalar-int-variable>
+ | ERR = <label>
+ The same for BACKSPACE, ENDFILE.
+ """
+ match = re.compile(r'(rewind|backspace|endfile)\b',re.I).match
+
+ def process_item(self):
+ clsname = self.__class__.__name__.lower()
+ line = self.item.get_line()
+ if not line.lower().startswith(clsname):
+ self.isvalid = False
+ return
+ line = line[len(clsname):].lstrip()
+ if line.startswith('('):
+ assert line[-1]==')',`line`
+ spec = line[1:-1].strip()
+ else:
+ spec = line
+ self.specs = specs_split_comma(spec, self.item)
+ return
+
+ def tofortran(self, isfix=None):
+ clsname = self.__class__.__name__.upper()
+ return self.get_indent_tab(isfix=isfix) + clsname + ' (%s)' % (', '.join(self.specs))
+ def analyze(self): return
+
+class Backspace(FilePositioningStatement): pass
+
+class Endfile(FilePositioningStatement): pass
+
+class Rewind(FilePositioningStatement): pass
+
+class Open(Statement):
+ """
+ OPEN ( <connect-spec-list> )
+ <connect-spec> = [ UNIT = ] <file-unit-number>
+ | ACCESS = <scalar-default-char-expr>
+ | ..
+ """
+ match = re.compile(r'open\s*\(.*\)\Z',re.I).match
+ def process_item(self):
+ line = self.item.get_line()[4:].lstrip()[1:-1].strip()
+ self.specs = specs_split_comma(line, self.item)
+ return
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'OPEN (%s)' % (', '.join(self.specs))
+ def analyze(self): return
+
+class Format(Statement):
+ """
+ FORMAT <format-specification>
+ <format-specification> = ( [ <format-item-list> ] )
+ <format-item> = [ <r> ] <data-edit-descr>
+ | <control-edit-descr>
+ | <char-string-edit-descr>
+ | [ <r> ] ( <format-item-list> )
+ <data-edit-descr> = I <w> [ . <m> ]
+ | B <w> [ . <m> ]
+ ...
+ <r|w|m|d|e> = <int-literal-constant>
+ <v> = <signed-int-literal-constant>
+ <control-edit-descr> = <position-edit-descr>
+ | [ <r> ] /
+ | :
+ ...
+ <position-edit-descr> = T <n>
+ | TL <n>
+ ...
+ <sign-edit-descr> = SS | SP | S
+ ...
+
+ """
+ match = re.compile(r'format\s*\(.*\)\Z', re.I).match
+ def process_item(self):
+ item = self.item
+ if not item.label:
+ # R1001:
+ self.warning('R1001: FORMAT statement must be labeled but got %r.' \
+ % (item.label))
+ line = item.get_line()[6:].lstrip()
+ assert line[0]+line[-1]=='()',`line`
+ self.specs = split_comma(line[1:-1], item)
+ return
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'FORMAT (%s)' % (', '.join(self.specs))
+ def analyze(self): return
+
+class Save(Statement):
+ """
+ SAVE [ [ :: ] <saved-entity-list> ]
+ <saved-entity> = <object-name>
+ | <proc-pointer-name>
+ | / <common-block-name> /
+ <proc-pointer-name> = <name>
+ <object-name> = <name>
+ """
+ match = re.compile(r'save\b',re.I).match
+ def process_item(self):
+ assert not self.item.has_map()
+ line = self.item.get_line()[4:].lstrip()
+ if line.startswith('::'):
+ line = line[2:].lstrip()
+ items = []
+ for s in line.split(','):
+ s = s.strip()
+ if not s: continue
+ if s.startswith('/'):
+ assert s.endswith('/'),`s`
+ n = s[1:-1].strip()
+ assert is_name(n),`n`
+ items.append('/%s/' % (n))
+ elif is_name(s):
+ items.append(s)
+ else:
+ self.isvalid = False
+ return
+ self.items = items
+ return
+ def tofortran(self, isfix=None):
+ tab = self.get_indent_tab(isfix=isfix)
+ if not self.items:
+ return tab + 'SAVE'
+ return tab + 'SAVE %s' % (', '.join(self.items))
+ def analyze(self): return
+
+class Data(Statement):
+ """
+ DATA <data-stmt-set> [ [ , ] <data-stmt-set> ]...
+ <data-stmt-set> = <data-stmt-object-list> / <data-stmt-value-list> /
+ <data-stmt-object> = <variable> | <data-implied-do>
+ <data-implied-do> = ( <data-i-do-object-list> , <data-i-do-variable> = <scalar-int-expr> , <scalar-int-expr> [ , <scalar-int-expr> ] )
+ <data-i-do-object> = <array-element> | <scalar-structure-component> | <data-implied-do>
+ <data-i-do-variable> = <scalar-int-variable>
+ <variable> = <designator>
+ <designator> = <object-name>
+ | <array-element>
+ | <array-section>
+ | <structure-component>
+ | <substring>
+ <array-element> = <data-ref>
+ <array-section> = <data-ref> [ ( <substring-range> ) ]
+
+ """
+ match = re.compile(r'data\b',re.I).match
+
+ def process_item(self):
+ line = self.item.get_line()[4:].lstrip()
+ stmts = []
+ self.isvalid = False
+ while line:
+ i = line.find('/')
+ if i==-1: return
+ j = line.find('/',i+1)
+ if j==-1: return
+ l1, l2 = line[:i].rstrip(),line[i+1:j].strip()
+ l1 = split_comma(l1, self.item)
+ l2 = split_comma(l2, self.item)
+ stmts.append((l1,l2))
+ line = line[j+1:].lstrip()
+ if line.startswith(','):
+ line = line[1:].lstrip()
+ self.stmts = stmts
+ self.isvalid = True
+ return
+
+ def tofortran(self, isfix=None):
+ tab = self.get_indent_tab(isfix=isfix)
+ l = []
+ for o,v in self.stmts:
+ l.append('%s / %s /' %(', '.join(o),', '.join(v)))
+ return tab + 'DATA ' + ' '.join(l)
+ def analyze(self): return
+
+class Nullify(Statement):
+ """
+ NULLIFY ( <pointer-object-list> )
+ <pointer-object> = <variable-name>
+ """
+ match = re.compile(r'nullify\s*\(.*\)\Z',re.I).match
+ def process_item(self):
+ line = self.item.get_line()[7:].lstrip()[1:-1].strip()
+ self.items = split_comma(line, self.item)
+ return
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'NULLIFY (%s)' % (', '.join(self.items))
+ def analyze(self): return
+
+class Use(Statement):
+ """
+ USE [ [ , <module-nature> ] :: ] <module-name> [ , <rename-list> ]
+ USE [ [ , <module-nature> ] :: ] <module-name> , ONLY : [ <only-list> ]
+ <module-nature> = INTRINSIC | NON_INTRINSIC
+ <rename> = <local-name> => <use-name>
+ | OPERATOR ( <local-defined-operator> ) => OPERATOR ( <use-defined-operator> )
+ <only> = <generic-spec> | <only-use-name> | <rename>
+ <only-use-name> = <use-name>
+ """
+ match = re.compile(r'use\b',re.I).match
+ def process_item(self):
+ line = self.item.get_line()[3:].lstrip()
+ nature = ''
+ if line.startswith(','):
+ i = line.find('::')
+ nature = line[1:i].strip().upper()
+ line = line[i+2:].lstrip()
+ if line.startswith('::'):
+ line = line[2:].lstrip()
+ if nature and not is_name(nature):
+ self.isvalid = False
+ return
+ self.nature = nature
+ i = line.find(',')
+ self.isonly = False
+ if i==-1:
+ self.name = line
+ self.items = []
+ else:
+ self.name = line[:i].rstrip()
+ line = line[i+1:].lstrip()
+ if line.lower().startswith('only') and line[4:].lstrip().startswith(':'):
+ self.isonly = True
+ line = line[4:].lstrip()[1:].lstrip()
+ self.items = split_comma(line, self.item)
+ return
+
+ def tofortran(self, isfix=None):
+ tab = self.get_indent_tab(isfix=isfix)
+ s = 'USE'
+ if self.nature:
+ s += ' ' + self.nature + ' ::'
+ s += ' ' + self.name
+ if self.isonly:
+ s += ', ONLY:'
+ elif self.items:
+ s += ','
+ if self.items:
+ s += ' ' + ', '.join(self.items)
+ return tab + s
+
+ def analyze(self):
+ use = self.parent.a.use
+ if use.has_key(self.name):
+ return
+
+ modules = self.top.a.module
+ if not modules.has_key(self.name):
+ fn = None
+ for d in self.reader.include_dirs:
+ fn = get_module_file(self.name, d)
+ if fn is not None:
+ break
+ if fn is not None:
+ from readfortran import FortranFileReader
+ from parsefortran import FortranParser
+ self.info('looking module information from %r' % (fn))
+ reader = FortranFileReader(fn)
+ parser = FortranParser(reader)
+ parser.parse()
+ parser.block.a.module.update(modules)
+ parser.analyze()
+ modules.update(parser.block.a.module)
+
+ if not modules.has_key(self.name):
+ self.warning('no information about the module %r in use statement' % (self.name))
+ return
+
+ module = modules[self.name]
+ use_provides = self.parent.a.use_provides
+ print use
+
+ return
+
+class Exit(Statement):
+ """
+ EXIT [ <do-construct-name> ]
+ """
+ match = re.compile(r'exit\b\s*\w*\s*\Z',re.I).match
+ def process_item(self):
+ self.name = self.item.get_line()[4:].lstrip()
+ return
+ def tofortran(self, isfix=None):
+ if self.name:
+ return self.get_indent_tab(isfix=isfix) + 'EXIT ' + self.name
+ return self.get_indent_tab(isfix=isfix) + 'EXIT'
+ def analyze(self): return
+
+class Parameter(Statement):
+ """
+ PARAMETER ( <named-constant-def-list> )
+ <named-constant-def> = <named-constant> = <initialization-expr>
+ """
+ match = re.compile(r'parameter\s*\(.*\)\Z', re.I).match
+ def process_item(self):
+ line = self.item.get_line()[9:].lstrip()[1:-1].strip()
+ self.items = split_comma(line, self.item)
+ return
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'PARAMETER (%s)' % (', '.join(self.items))
+ def analyze(self):
+ for item in self.items:
+ i = item.find('=')
+ assert i!=-1,`item`
+ name = item[:i].rstrip()
+ value = item[i+1:].lstrip()
+ var = self.get_variable(name)
+ var.update('parameter')
+ var.set_init(value)
+ return
+
+class Equivalence(Statement):
+ """
+ EQUIVALENCE <equivalence-set-list>
+ <equivalence-set> = ( <equivalence-object> , <equivalence-object-list> )
+ <equivalence-object> = <variable-name> | <array-element> | <substring>
+ """
+ match = re.compile(r'equivalence\s*\(.*\)\Z', re.I).match
+ def process_item(self):
+ items = []
+ for s in self.item.get_line()[11:].lstrip().split(','):
+ s = s.strip()
+ assert s[0]+s[-1]=='()',`s,self.item.get_line()`
+ s = ', '.join(split_comma(s[1:-1], self.item))
+ items.append('('+s+')')
+ self.items = items
+ return
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'EQUIVALENCE %s' % (', '.join(self.items))
+ def analyze(self): return
+
+class Dimension(Statement):
+ """
+ DIMENSION [ :: ] <array-name> ( <array-spec> ) [ , <array-name> ( <array-spec> ) ]...
+
+ """
+ match = re.compile(r'dimension\b', re.I).match
+ def process_item(self):
+ line = self.item.get_line()[9:].lstrip()
+ if line.startswith('::'):
+ line = line[2:].lstrip()
+ self.items = split_comma(line, self.item)
+ return
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'DIMENSION %s' % (', '.join(self.items))
+ def analyze(self):
+ for line in self.items:
+ i = line.find('(')
+ assert i!=-1 and line.endswith(')'),`line`
+ name = line[:i].rstrip()
+ array_spec = split_comma(line[i+1:-1].strip(), self.item)
+ var = self.get_variable(name)
+ var.set_bounds(array_spec)
+ return
+
+class Target(Statement):
+ """
+ TARGET [ :: ] <object-name> ( <array-spec> ) [ , <object-name> ( <array-spec> ) ]...
+
+ """
+ match = re.compile(r'target\b', re.I).match
+ def process_item(self):
+ line = self.item.get_line()[6:].lstrip()
+ if line.startswith('::'):
+ line = line[2:].lstrip()
+ self.items = split_comma(line, self.item)
+ return
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'TARGET %s' % (', '.join(self.items))
+ def analyze(self):
+ for line in self.items:
+ i = line.find('(')
+ assert i!=-1 and line.endswith(')'),`line`
+ name = line[:i].rstrip()
+ array_spec = split_comma(line[i+1:-1].strip(), self.item)
+ var = self.get_variable(name)
+ var.set_bounds(array_spec)
+ var.update('target')
+ return
+
+
+class Pointer(Statement):
+ """
+ POINTER [ :: ] <pointer-decl-list>
+ <pointer-decl> = <object-name> [ ( <deferred-shape-spec-list> ) ]
+ | <proc-entity-name>
+
+ """
+ match = re.compile(r'pointer\b',re.I).match
+ def process_item(self):
+ line = self.item.get_line()[7:].lstrip()
+ if line.startswith('::'):
+ line = line[2:].lstrip()
+ self.items = split_comma(line, self.item)
+ return
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'POINTER %s' % (', '.join(self.items))
+ def analyze(self):
+ for line in self.items:
+ i = line.find('(')
+ if i==-1:
+ name = line
+ array_spec = None
+ else:
+ assert line.endswith(')'),`line`
+ name = line[:i].rstrip()
+ array_spec = split_comma(line[i+1:-1].strip(), self.item)
+ var = self.get_variable(name)
+ var.set_bounds(array_spec)
+ var.update('pointer')
+ return
+
+class Protected(StatementWithNamelist):
+ """
+ PROTECTED [ :: ] <entity-name-list>
+ """
+ match = re.compile(r'protected\b',re.I).match
+ def analyze(self):
+ for name in self.items:
+ var = self.get_variable(name)
+ var.update('protected')
+ return
+
+class Volatile(StatementWithNamelist):
+ """
+ VOLATILE [ :: ] <object-name-list>
+ """
+ match = re.compile(r'volatile\b',re.I).match
+ def analyze(self):
+ for name in self.items:
+ var = self.get_variable(name)
+ var.update('volatile')
+ return
+
+class Value(StatementWithNamelist):
+ """
+ VALUE [ :: ] <dummy-arg-name-list>
+ """
+ match = re.compile(r'value\b',re.I).match
+ def analyze(self):
+ for name in self.items:
+ var = self.get_variable(name)
+ var.update('value')
+ return
+
+class ArithmeticIf(Statement):
+ """
+ IF ( <scalar-numeric-expr> ) <label> , <label> , <label>
+ """
+ match = re.compile(r'if\s*\(.*\)\s*\d+\s*,\s*\d+\s*,\s*\d+\s*\Z', re.I).match
+ def process_item(self):
+ line = self.item.get_line()[2:].lstrip()
+ line,l2,l3 = line.rsplit(',',2)
+ i = line.rindex(')')
+ l1 = line[i+1:]
+ self.expr = self.item.apply_map(line[1:i]).strip()
+ self.labels = [l1.strip(),l2.strip(),l3.strip()]
+ return
+
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'IF (%s) %s' \
+ % (self.expr,', '.join(self.labels))
+ def analyze(self): return
+
+class Intrinsic(StatementWithNamelist):
+ """
+ INTRINSIC [ :: ] <intrinsic-procedure-name-list>
+ """
+ match = re.compile(r'intrinsic\b',re.I).match
+ def analyze(self):
+ for name in self.items:
+ var = self.get_variable(name)
+ var.update('intrinsic')
+ return
+
+class Inquire(Statement):
+ """
+ INQUIRE ( <inquire-spec-list> )
+ INQUIRE ( IOLENGTH = <scalar-int-variable> ) <output-item-list>
+
+ <inquire-spec> = [ UNIT = ] <file-unit-number>
+ | FILE = <file-name-expr>
+ ...
+ <output-item> = <expr>
+ | <io-implied-do>
+ """
+ match = re.compile(r'inquire\s*\(',re.I).match
+ def process_item(self):
+ line = self.item.get_line()[7:].lstrip()
+ i = line.index(')')
+ self.specs = specs_split_comma(line[1:i].strip(), self.item)
+ self.items = split_comma(line[i+1:].lstrip(), self.item)
+ return
+ def tofortran(self, isfix=None):
+ if self.items:
+ return self.get_indent_tab(isfix=isfix) + 'INQUIRE (%s) %s' \
+ % (', '.join(self.specs), ', '.join(self.items))
+ return self.get_indent_tab(isfix=isfix) + 'INQUIRE (%s)' \
+ % (', '.join(self.specs))
+ def analyze(self): return
+
+class Sequence(Statement):
+ """
+ SEQUENCE
+ """
+ match = re.compile(r'sequence\Z',re.I).match
+ def process_item(self):
+ return
+ def tofortran(self, isfix=None): return self.get_indent_tab(isfix=isfix) + 'SEQUENCE'
+ def analyze(self):
+ self.parent.update_attributes('SEQUENCE')
+ return
+
+class External(StatementWithNamelist):
+ """
+ EXTERNAL [ :: ] <external-name-list>
+ """
+ match = re.compile(r'external\b', re.I).match
+ def analyze(self):
+ for name in self.items:
+ var = self.get_variable(name)
+ var.update('external')
+ return
+
+
+class Namelist(Statement):
+ """
+ NAMELIST / <namelist-group-name> / <namelist-group-object-list> [ [ , ] / <namelist-group-name> / <namelist-group-object-list> ]...
+ <namelist-group-object> = <variable-name>
+ """
+ match = re.compile(r'namelist\b',re.I).match
+ def process_item(self):
+ line = self.item.get_line()[8:].lstrip()
+ items = []
+ while line:
+ assert line.startswith('/'),`line`
+ i = line.find('/',1)
+ assert i!=-1,`line`
+ name = line[:i+1]
+ line = line[i+1:].lstrip()
+ i = line.find('/')
+ if i==-1:
+ items.append((name,line))
+ line = ''
+ continue
+ s = line[:i].rstrip()
+ if s.endswith(','):
+ s = s[:-1].rstrip()
+ items.append((name,s))
+ line = line[i+1:].lstrip()
+ self.items = items
+ return
+
+ def tofortran(self, isfix=None):
+ l = []
+ for name,s in self.items:
+ l.append('%s %s' % (name,s))
+ tab = self.get_indent_tab(isfix=isfix)
+ return tab + 'NAMELIST ' + ', '.join(l)
+
+class Common(Statement):
+ """
+ COMMON [ / [ <common-block-name> ] / ] <common-block-object-list> \
+ [ [ , ] / [ <common-block-name> ] / <common-block-object-list> ]...
+ <common-block-object> = <variable-name> [ ( <explicit-shape-spec-list> ) ]
+ | <proc-pointer-name>
+ """
+ match = re.compile(r'common\b',re.I).match
+ def process_item(self):
+ item = self.item
+ line = item.get_line()[6:].lstrip()
+ items = []
+ while line:
+ if not line.startswith('/'):
+ name = ''
+ assert not items,`line`
+ else:
+ i = line.find('/',1)
+ assert i!=-1,`line`
+ name = line[1:i].strip()
+ line = line[i+1:].lstrip()
+ i = line.find('/')
+ if i==-1:
+ items.append((name,split_comma(line, item)))
+ line = ''
+ continue
+ s = line[:i].rstrip()
+ if s.endswith(','):
+ s = s[:-1].rstrip()
+ items.append((name,split_comma(s,item)))
+ line = line[i:].lstrip()
+ self.items = items
+ return
+ def tofortran(self, isfix=None):
+ l = []
+ for name,s in self.items:
+ s = ', '.join(s)
+ if name:
+ l.append('/ %s / %s' % (name,s))
+ else:
+ l.append(s)
+ tab = self.get_indent_tab(isfix=isfix)
+ return tab + 'COMMON ' + ' '.join(l)
+ def analyze(self):
+ for cname, items in self.items:
+ for item in items:
+ i = item.find('(')
+ if i!=-1:
+ assert item.endswith(')'),`item`
+ name = item[:i].rstrip()
+ shape = split_comma(item[i+1:-1].strip(), self.item)
+ else:
+ name = item
+ shape = None
+ var = self.get_variable(name)
+ if shape is not None:
+ var.set_bounds(shape)
+ # XXX: add name,var to parent_provides
+ return
+
+class Optional(StatementWithNamelist):
+ """
+ OPTIONAL [ :: ] <dummy-arg-name-list>
+ <dummy-arg-name> = <name>
+ """
+ match = re.compile(r'optional\b',re.I).match
+ def analyze(self):
+ for name in self.items:
+ var = self.get_variable(name)
+ var.update('optional')
+ return
+
+class Intent(Statement):
+ """
+ INTENT ( <intent-spec> ) [ :: ] <dummy-arg-name-list>
+ <intent-spec> = IN | OUT | INOUT
+
+ generalization for pyf-files:
+ INTENT ( <intent-spec-list> ) [ :: ] <dummy-arg-name-list>
+ <intent-spec> = IN | OUT | INOUT | CACHE | HIDE | OUT = <name>
+ """
+ match = re.compile(r'intent\s*\(',re.I).match
+ def process_item(self):
+ line = self.item.get_line()[6:].lstrip()
+ i = line.find(')')
+ self.specs = specs_split_comma(line[1:i], self.item, upper=True)
+ line = line[i+1:].lstrip()
+ if line.startswith('::'):
+ line = line[2:].lstrip()
+ self.items = [s.strip() for s in line.split(',')]
+ for n in self.items:
+ if not is_name(n):
+ self.isvalid = False
+ return
+ return
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'INTENT (%s) %s' \
+ % (', '.join(self.specs), ', '.join(self.items))
+ def analyze(self):
+ for name in self.items:
+ var = self.get_variable(name)
+ var.set_intent(self.specs)
+ return
+
+
+class Entry(Statement):
+ """
+ ENTRY <entry-name> [ ( [ <dummy-arg-list> ] ) [ <suffix> ] ]
+ <suffix> = <proc-language-binding-spec> [ RESULT ( <result-name> ) ]
+ | RESULT ( <result-name> ) [ <proc-language-binding-spec> ]
+ <proc-language-binding-spec> = <language-binding-spec>
+ <language-binding-spec> = BIND ( C [ , NAME = <scalar-char-initialization-expr> ] )
+ <dummy-arg> = <dummy-arg-name> | *
+ """
+ match = re.compile(r'entry\b', re.I).match
+ def process_item(self):
+ line = self.item.get_line()[5:].lstrip()
+ m = re.match(r'\w+', line)
+ name = line[:m.end()]
+ line = line[m.end():].lstrip()
+ if line.startswith('('):
+ i = line.find(')')
+ assert i!=-1,`line`
+ items = split_comma(line[1:i], self.item)
+ line = line[i+1:].lstrip()
+ else:
+ items = []
+ self.bind, line = parse_bind(line, self.item)
+ self.result, line = parse_result(line, self.item)
+ if line:
+ assert self.bind is None,`self.bind`
+ self.bind, line = parse_bind(line, self.item)
+ assert not line,`line`
+ self.name = name
+ self.items = items
+ return
+ def tofortran(self, isfix=None):
+ tab = self.get_indent_tab(isfix=isfix)
+ s = tab + 'ENTRY '+self.name
+ if self.items:
+ s += ' (%s)' % (', '.join(self.items))
+ if self.result:
+ s += ' RESULT (%s)' % (self.result)
+ if self.bind:
+ s += ' BIND (%s)' % (', '.join(self.bind))
+ return s
+
+class Import(StatementWithNamelist):
+ """
+ IMPORT [ [ :: ] <import-name-list> ]
+ """
+ match = re.compile(r'import(\b|\Z)',re.I).match
+
+class Forall(Statement):
+ """
+ FORALL <forall-header> <forall-assignment-stmt>
+ <forall-header> = ( <forall-triplet-spec-list> [ , <scalar-mask-expr> ] )
+ <forall-triplet-spec> = <index-name> = <subscript> : <subscript> [ : <stride> ]
+ <subscript|stride> = <scalar-int-expr>
+ <forall-assignment-stmt> = <assignment-stmt> | <pointer-assignment-stmt>
+ """
+ match = re.compile(r'forall\s*\(.*\).*=', re.I).match
+ def process_item(self):
+ line = self.item.get_line()[6:].lstrip()
+ i = line.index(')')
+
+ line0 = line[1:i]
+ line = line[i+1:].lstrip()
+ stmt = GeneralAssignment(self, self.item.copy(line, True))
+ if stmt.isvalid:
+ self.content = [stmt]
+ else:
+ self.isvalid = False
+ return
+
+ specs = []
+ mask = ''
+ for l in split_comma(line0,self.item):
+ j = l.find('=')
+ if j==-1:
+ assert not mask,`mask,l`
+ mask = l
+ continue
+ assert j!=-1,`l`
+ index = l[:j].rstrip()
+ it = self.item.copy(l[j+1:].lstrip())
+ l = it.get_line()
+ k = l.split(':')
+ if len(k)==3:
+ s1, s2, s3 = map(it.apply_map,
+ [k[0].strip(),k[1].strip(),k[2].strip()])
+ else:
+ assert len(k)==2,`k`
+ s1, s2 = map(it.apply_map,
+ [k[0].strip(),k[1].strip()])
+ s3 = '1'
+ specs.append((index,s1,s2,s3))
+
+ self.specs = specs
+ self.mask = mask
+ return
+
+ def tofortran(self, isfix=None):
+ tab = self.get_indent_tab(isfix=isfix)
+ l = []
+ for index,s1,s2,s3 in self.specs:
+ s = '%s = %s : %s' % (index,s1,s2)
+ if s3!='1':
+ s += ' : %s' % (s3)
+ l.append(s)
+ s = ', '.join(l)
+ if self.mask:
+ s += ', ' + self.mask
+ return tab + 'FORALL (%s) %s' % \
+ (s, str(self.content[0]).lstrip())
+ def analyze(self): return
+
+ForallStmt = Forall
+
+class SpecificBinding(Statement):
+ """
+ PROCEDURE [ ( <interface-name> ) ] [ [ , <binding-attr-list> ] :: ] <binding-name> [ => <procedure-name> ]
+ <binding-attr> = PASS [ ( <arg-name> ) ]
+ | NOPASS
+ | NON_OVERRIDABLE
+ | DEFERRED
+ | <access-spec>
+ <access-spec> = PUBLIC | PRIVATE
+ """
+ match = re.compile(r'procedure\b',re.I).match
+ def process_item(self):
+ line = self.item.get_line()[9:].lstrip()
+ if line.startswith('('):
+ i = line.index(')')
+ name = line[1:i].strip()
+ line = line[i+1:].lstrip()
+ else:
+ name = ''
+ self.iname = name
+ if line.startswith(','):
+ line = line[1:].lstrip()
+ i = line.find('::')
+ if i != -1:
+ attrs = split_comma(line[:i], self.item)
+ line = line[i+2:].lstrip()
+ else:
+ attrs = []
+ attrs1 = []
+ for attr in attrs:
+ if is_name(attr):
+ attr = attr.upper()
+ else:
+ i = attr.find('(')
+ assert i!=-1 and attr.endswith(')'),`attr`
+ attr = '%s (%s)' % (attr[:i].rstrip().upper(), attr[i+1:-1].strip())
+ attrs1.append(attr)
+ self.attrs = attrs1
+ i = line.find('=')
+ if i==-1:
+ self.name = line
+ self.bname = ''
+ else:
+ self.name = line[:i].rstrip()
+ self.bname = line[i+1:].lstrip()[1:].lstrip()
+ return
+ def tofortran(self, isfix=None):
+ tab = self.get_indent_tab(isfix=isfix)
+ s = 'PROCEDURE '
+ if self.iname:
+ s += '(' + self.iname + ') '
+ if self.attrs:
+ s += ', ' + ', '.join(self.attrs) + ' :: '
+ if self.bname:
+ s += '%s => %s' % (self.name, self.bname)
+ else:
+ s += self.name
+ return tab + s
+
+class GenericBinding(Statement):
+ """
+ GENERIC [ , <access-spec> ] :: <generic-spec> => <binding-name-list>
+ """
+ match = re.compile(r'generic\b.*::.*=\>.*\Z', re.I).match
+ def process_item(self):
+ line = self.item.get_line()[7:].lstrip()
+ if line.startswith(','):
+ line = line[1:].lstrip()
+ i = line.index('::')
+ self.aspec = line[:i].rstrip().upper()
+ line = line[i+2:].lstrip()
+ i = line.index('=>')
+ self.spec = self.item.apply_map(line[:i].rstrip())
+ self.items = split_comma(line[i+2:].lstrip())
+ return
+
+ def tofortran(self, isfix=None):
+ tab = self.get_indent_tab(isfix=isfix)
+ s = 'GENERIC'
+ if self.aspec:
+ s += ', '+self.aspec
+ s += ' :: ' + self.spec + ' => ' + ', '.join(self.items)
+ return tab + s
+
+
+class FinalBinding(StatementWithNamelist):
+ """
+ FINAL [ :: ] <final-subroutine-name-list>
+ """
+ stmtname = 'final'
+ match = re.compile(r'final\b', re.I).match
+
+class Allocatable(Statement):
+ """
+ ALLOCATABLE [ :: ] <object-name> [ ( <deferred-shape-spec-list> ) ] [ , <object-name> [ ( <deferred-shape-spec-list> ) ] ]...
+ """
+ match = re.compile(r'allocatable\b',re.I).match
+ def process_item(self):
+ line = self.item.get_line()[11:].lstrip()
+ if line.startswith('::'):
+ line = line[2:].lstrip()
+ self.items = split_comma(line, self.item)
+ return
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'ALLOCATABLE ' + ', '.join(self.items)
+ def analyze(self):
+ for line in self.items:
+ i = line.find('(')
+ if i==-1:
+ name = line
+ array_spec = None
+ else:
+ assert line.endswith(')')
+ name = line[:i].rstrip()
+ array_spec = split_comma(line[i+1:-1], self.item)
+ var = self.get_variable(name)
+ var.update('allocatable')
+ if array_spec is not None:
+ var.set_bounds(array_spec)
+ return
+
+class Asynchronous(StatementWithNamelist):
+ """
+ ASYNCHRONOUS [ :: ] <object-name-list>
+ """
+ match = re.compile(r'asynchronous\b',re.I).match
+ def analyze(self):
+ for name in self.items:
+ var = self.get_variable(name)
+ var.update('asynchronous')
+ return
+
+
+class Bind(Statement):
+ """
+ <language-binding-spec> [ :: ] <bind-entity-list>
+ <language-binding-spec> = BIND ( C [ , NAME = <scalar-char-initialization-expr> ] )
+ <bind-entity> = <entity-name> | / <common-block-name> /
+ """
+ match = re.compile(r'bind\s*\(.*\)',re.I).match
+ def process_item(self):
+ line = self.item.line
+ self.specs, line = parse_bind(line, self.item)
+ if line.startswith('::'):
+ line = line[2:].lstrip()
+ items = []
+ for item in split_comma(line, self.item):
+ if item.startswith('/'):
+ assert item.endswith('/'),`item`
+ item = '/ ' + item[1:-1].strip() + ' /'
+ items.append(item)
+ self.items = items
+ return
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'BIND (%s) %s' %\
+ (', '.join(self.specs), ', '.join(self.items))
+
+# IF construct statements
+
+class Else(Statement):
+ """
+ ELSE [<if-construct-name>]
+ """
+ match = re.compile(r'else\b\s*\w*\s*\Z',re.I).match
+
+ def process_item(self):
+ item = self.item
+ self.name = item.get_line()[4:].strip()
+ parent_name = getattr(self.parent,'name','')
+ if self.name and self.name!=parent_name:
+ self.warning('expected if-construct-name %r but got %r, skipping.'\
+ % (parent_name, self.name))
+ self.isvalid = False
+ return
+
+ def tofortran(self, isfix=None):
+ if self.name:
+ return self.get_indent_tab(deindent=True) + 'ELSE ' + self.name
+ return self.get_indent_tab(deindent=True) + 'ELSE'
+
+ def analyze(self): return
+
+class ElseIf(Statement):
+ """
+ ELSE IF ( <scalar-logical-expr> ) THEN [ <if-construct-name> ]
+ """
+ match = re.compile(r'else\s*if\s*\(.*\)\s*then\s*\w*\s*\Z',re.I).match
+
+ def process_item(self):
+ item = self.item
+ line = item.get_line()[4:].lstrip()[2:].lstrip()
+ i = line.find(')')
+ assert line[0]=='('
+ self.expr = item.apply_map(line[1:i])
+ self.name = line[i+1:].lstrip()[4:].strip()
+ parent_name = getattr(self.parent,'name','')
+ if self.name and self.name!=parent_name:
+ self.warning('expected if-construct-name %r but got %r, skipping.'\
+ % (parent_name, self.name))
+ self.isvalid = False
+ return
+
+ def tofortran(self, isfix=None):
+ s = ''
+ if self.name:
+ s = ' ' + self.name
+ return self.get_indent_tab(deindent=True) + 'ELSE IF (%s) THEN%s' \
+ % (self.expr, s)
+
+ def analyze(self): return
+
+# SelectCase construct statements
+
+class Case(Statement):
+ """
+ CASE <case-selector> [ <case-constract-name> ]
+ <case-selector> = ( <case-value-range-list> ) | DEFAULT
+ <case-value-range> = <case-value>
+ | <case-value> :
+ | : <case-value>
+ | <case-value> : <case-value>
+ <case-value> = <scalar-(int|char|logical)-initialization-expr>
+ """
+ match = re.compile(r'case\b\s*(\(.*\)|DEFAULT)\s*\w*\Z',re.I).match
+ def process_item(self):
+ #assert self.parent.__class__.__name__=='Select',`self.parent.__class__`
+ line = self.item.get_line()[4:].lstrip()
+ if line.startswith('('):
+ i = line.find(')')
+ items = split_comma(line[1:i].strip(), self.item)
+ line = line[i+1:].lstrip()
+ else:
+ assert line.lower().startswith('default'),`line`
+ items = []
+ line = line[7:].lstrip()
+ for i in range(len(items)):
+ it = self.item.copy(items[i])
+ rl = []
+ for r in it.get_line().split(':'):
+ rl.append(it.apply_map(r.strip()))
+ items[i] = rl
+ self.items = items
+ self.name = line
+ parent_name = getattr(self.parent, 'name', '')
+ if self.name and self.name!=parent_name:
+ self.warning('expected case-construct-name %r but got %r, skipping.'\
+ % (parent_name, self.name))
+ self.isvalid = False
+ return
+
+ def tofortran(self, isfix=None):
+ tab = self.get_indent_tab(isfix=isfix)
+ s = 'CASE'
+ if self.items:
+ l = []
+ for item in self.items:
+ l.append((' : '.join(item)).strip())
+ s += ' ( %s )' % (', '.join(l))
+ else:
+ s += ' DEFAULT'
+ if self.name:
+ s += ' ' + self.name
+ return s
+ def analyze(self): return
+
+# Where construct statements
+
+class Where(Statement):
+ """
+ WHERE ( <mask-expr> ) <where-assignment-stmt>
+ """
+ match = re.compile(r'where\s*\(.*\)\s*\w.*\Z',re.I).match
+ def process_item(self):
+ line = self.item.get_line()[5:].lstrip()
+ i = line.index(')')
+ self.expr = self.item.apply_map(line[1:i].strip())
+ line = line[i+1:].lstrip()
+ newitem = self.item.copy(line)
+ cls = Assignment
+ if cls.match(line):
+ stmt = cls(self, newitem)
+ if stmt.isvalid:
+ self.content = [stmt]
+ return
+ self.isvalid = False
+ return
+
+ def tofortran(self, isfix=None):
+ tab = self.get_indent_tab(isfix=isfix)
+ return tab + 'WHERE ( %s ) %s' % (self.expr, str(self.content[0]).lstrip())
+ def analyze(self): return
+
+WhereStmt = Where
+
+class ElseWhere(Statement):
+ """
+ ELSE WHERE ( <mask-expr> ) [ <where-construct-name> ]
+ ELSE WHERE [ <where-construct-name> ]
+ """
+ match = re.compile(r'else\s*where\b',re.I).match
+ def process_item(self):
+ line = self.item.get_line()[4:].lstrip()[5:].lstrip()
+ self.expr = None
+ if line.startswith('('):
+ i = line.index(')')
+ assert i != -1,`line`
+ self.expr = self.item.apply_map(line[1:i].strip())
+ line = line[i+1:].lstrip()
+ self.name = line
+ parent_name = getattr(self.parent,'name','')
+ if self.name and not self.name==parent_name:
+ self.warning('expected where-construct-name %r but got %r, skipping.'\
+ % (parent_name, self.name))
+ self.isvalid = False
+ return
+
+ def tofortran(self, isfix=None):
+ tab = self.get_indent_tab(isfix=isfix)
+ s = 'ELSE WHERE'
+ if self.expr is not None:
+ s += ' ( %s )' % (self.expr)
+ if self.name:
+ s += ' ' + self.name
+ return tab + s
+ def analyze(self): return
+
+# Enum construct statements
+
+class Enumerator(Statement):
+ """
+ ENUMERATOR [ :: ] <enumerator-list>
+ <enumerator> = <named-constant> [ = <scalar-int-initialization-expr> ]
+ """
+ match = re.compile(r'enumerator\b',re.I).match
+ def process_item(self):
+ line = self.item.get_line()[10:].lstrip()
+ if line.startswith('::'):
+ line = line[2:].lstrip()
+ self.items = split_comma(line, self.item)
+ return
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'ENUMERATOR ' + ', '.join(self.items)
+
+# F2PY specific statements
+
+class FortranName(Statement):
+ """
+ FORTRANNAME <name>
+ """
+ match = re.compile(r'fortranname\s*\w+\Z',re.I).match
+ def process_item(self):
+ self.value = self.item.get_line()[11:].lstrip()
+ return
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'FORTRANNAME ' + self.value
+
+class Threadsafe(Statement):
+ """
+ THREADSAFE
+ """
+ match = re.compile(r'threadsafe\Z',re.I).match
+ def process_item(self):
+ return
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'THREADSAFE'
+
+class Depend(Statement):
+ """
+ DEPEND ( <name-list> ) [ :: ] <dummy-arg-name-list>
+
+ """
+ match = re.compile(r'depend\s*\(',re.I).match
+ def process_item(self):
+ line = self.item.get_line()[6:].lstrip()
+ i = line.find(')')
+ self.depends = split_comma(line[1:i].strip(), self.item)
+ line = line[i+1:].lstrip()
+ if line.startswith('::'):
+ line = line[2:].lstrip()
+ self.items = split_comma(line)
+ return
+
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'DEPEND ( %s ) %s' \
+ % (', '.join(self.depends), ', '.join(self.items))
+
+class Check(Statement):
+ """
+ CHECK ( <c-int-scalar-expr> ) [ :: ] <name>
+
+ """
+ match = re.compile(r'check\s*\(',re.I).match
+ def process_item(self):
+ line = self.item.get_line()[5:].lstrip()
+ i = line.find(')')
+ assert i!=-1,`line`
+ self.expr = self.item.apply_map(line[1:i].strip())
+ line = line[i+1:].lstrip()
+ if line.startswith('::'):
+ line = line[2:].lstrip()
+ self.value = line
+ return
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'CHECK ( %s ) %s' \
+ % (self.expr, self.value)
+
+class CallStatement(Statement):
+ """
+ CALLSTATEMENT <c-expr>
+ """
+ match = re.compile(r'callstatement\b', re.I).match
+ def process_item(self):
+ self.expr = self.item.apply_map(self.item.get_line()[13:].lstrip())
+ return
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'CALLSTATEMENT ' + self.expr
+
+class CallProtoArgument(Statement):
+ """
+ CALLPROTOARGUMENT <c-type-spec-list>
+ """
+ match = re.compile(r'callprotoargument\b', re.I).match
+ def process_item(self):
+ self.specs = self.item.apply_map(self.item.get_line()[17:].lstrip())
+ return
+ def tofortran(self, isfix=None):
+ return self.get_indent_tab(isfix=isfix) + 'CALLPROTOARGUMENT ' + self.specs
+
+# Non-standard statements
+
+class Pause(Statement):
+ """
+ PAUSE [ <char-literal-constant|int-literal-constant> ]
+ """
+ match = re.compile(r'pause\s*(\d+|\'\w*\'|"\w*"|)\Z', re.I).match
+ def process_item(self):
+ self.value = self.item.apply_map(self.item.get_line()[5:].lstrip())
+ return
+ def tofortran(self, isfix=None):
+ if self.value:
+ return self.get_indent_tab(isfix=isfix) + 'PAUSE ' + self.value
+ return self.get_indent_tab(isfix=isfix) + 'PAUSE'
+ def analyze(self): return
diff --git a/numpy/f2py/lib/parser/test_Fortran2003.py b/numpy/f2py/lib/parser/test_Fortran2003.py
new file mode 100644
index 000000000..a8aae6081
--- /dev/null
+++ b/numpy/f2py/lib/parser/test_Fortran2003.py
@@ -0,0 +1,2101 @@
+from numpy.testing import *
+
+from Fortran2003 import *
+from api import get_reader
+
+###############################################################################
+############################### SECTION 2 ####################################
+###############################################################################
+
+class test_Program(NumpyTestCase): # R201
+
+ def check_simple(self):
+ reader = get_reader('''\
+ subroutine foo
+ end subroutine foo
+ subroutine bar
+ end
+ ''')
+ cls = Program
+ a = cls(reader)
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a), 'SUBROUTINE foo\nEND SUBROUTINE foo\nSUBROUTINE bar\nEND SUBROUTINE bar')
+
+class test_Specification_Part(NumpyTestCase): # R204
+
+ def check_simple(self):
+ from api import get_reader
+ reader = get_reader('''\
+ integer a''')
+ cls = Specification_Part
+ a = cls(reader)
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'INTEGER :: a')
+ assert_equal(repr(a), "Specification_Part(Type_Declaration_Stmt(Intrinsic_Type_Spec('INTEGER', None), None, Entity_Decl(Name('a'), None, None, None)))")
+
+###############################################################################
+############################### SECTION 3 ####################################
+###############################################################################
+
+class test_Name(NumpyTestCase): # R304
+
+ def check_name(self):
+ a = Name('a')
+ assert isinstance(a,Name),`a`
+ a = Name('a2')
+ assert isinstance(a,Name),`a`
+ a = Designator('a')
+ assert isinstance(a,Name),`a`
+ a = Constant('a')
+ assert isinstance(a,Name),`a`
+ a = Expr('a')
+ assert isinstance(a,Name),`a`
+
+###############################################################################
+############################### SECTION 4 ####################################
+###############################################################################
+
+class test_Type_Param_Value(NumpyTestCase): # 402
+
+ def check_type_param_value(self):
+ cls = Type_Param_Value
+ a = cls('*')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'*')
+ assert_equal(repr(a),"Type_Param_Value('*')")
+
+ a = cls(':')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),':')
+
+ a = cls('1+2')
+ assert isinstance(a,Level_2_Expr),`a`
+ assert_equal(str(a),'1 + 2')
+
+class test_Intrinsic_Type_Spec(NumpyTestCase): # R403
+
+ def check_intrinsic_type_spec(self):
+ cls = Intrinsic_Type_Spec
+ a = cls('INTEGER')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'INTEGER')
+ assert_equal(repr(a), "Intrinsic_Type_Spec('INTEGER', None)")
+
+ a = cls('Integer*2')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'INTEGER*2')
+
+ a = cls('real*2')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'REAL*2')
+
+ a = cls('logical*2')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'LOGICAL*2')
+
+ a = cls('complex*2')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'COMPLEX*2')
+
+ a = cls('character*2')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'CHARACTER*2')
+
+ a = cls('double complex')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'DOUBLE COMPLEX')
+
+ a = cls('double precision')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'DOUBLE PRECISION')
+
+class test_Kind_Selector(NumpyTestCase): # R404
+
+ def check_kind_selector(self):
+ cls = Kind_Selector
+ a = cls('(1)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(KIND = 1)')
+ assert_equal(repr(a),"Kind_Selector('(', Int_Literal_Constant('1', None), ')')")
+
+ a = cls('(kind=1+2)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(KIND = 1 + 2)')
+
+ a = cls('* 1')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'*1')
+
+class test_Signed_Int_Literal_Constant(NumpyTestCase): # R405
+
+ def check_int_literal_constant(self):
+ cls = Signed_Int_Literal_Constant
+ a = cls('1')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'1')
+ assert_equal(repr(a),"%s('1', None)" % (cls.__name__))
+
+ a = cls('+ 21_2')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'+ 21_2')
+ assert_equal(repr(a),"%s('+ 21', '2')" % (cls.__name__))
+
+ a = cls('-21_SHORT')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'-21_SHORT')
+
+ a = cls('21_short')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'21_short')
+
+ a = cls('+1976354279568241_8')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'+1976354279568241_8')
+
+class test_Int_Literal_Constant(NumpyTestCase): # R406
+
+ def check_int_literal_constant(self):
+ cls = Int_Literal_Constant
+ a = cls('1')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'1')
+ assert_equal(repr(a),"%s('1', None)" % (cls.__name__))
+
+ a = cls('21_2')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'21_2')
+ assert_equal(repr(a),"%s('21', '2')" % (cls.__name__))
+
+ a = cls('21_SHORT')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'21_SHORT')
+
+ a = cls('21_short')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'21_short')
+
+ a = cls('1976354279568241_8')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'1976354279568241_8')
+
+class test_Binary_Constant(NumpyTestCase): # R412
+
+ def check_boz_literal_constant(self):
+ cls = Boz_Literal_Constant
+ bcls = Binary_Constant
+ a = cls('B"01"')
+ assert isinstance(a,bcls),`a`
+ assert_equal(str(a),'B"01"')
+ assert_equal(repr(a),"%s('B\"01\"')" % (bcls.__name__))
+
+class test_Octal_Constant(NumpyTestCase): # R413
+
+ def check_boz_literal_constant(self):
+ cls = Boz_Literal_Constant
+ ocls = Octal_Constant
+ a = cls('O"017"')
+ assert isinstance(a,ocls),`a`
+ assert_equal(str(a),'O"017"')
+ assert_equal(repr(a),"%s('O\"017\"')" % (ocls.__name__))
+
+class test_Hex_Constant(NumpyTestCase): # R414
+
+ def check_boz_literal_constant(self):
+ cls = Boz_Literal_Constant
+ zcls = Hex_Constant
+ a = cls('Z"01A"')
+ assert isinstance(a,zcls),`a`
+ assert_equal(str(a),'Z"01A"')
+ assert_equal(repr(a),"%s('Z\"01A\"')" % (zcls.__name__))
+
+class test_Signed_Real_Literal_Constant(NumpyTestCase): # R416
+
+ def check_signed_real_literal_constant(self):
+ cls = Signed_Real_Literal_Constant
+ a = cls('12.78')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'12.78')
+ assert_equal(repr(a),"%s('12.78', None)" % (cls.__name__))
+
+ a = cls('+12.78_8')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'+12.78_8')
+ assert_equal(repr(a),"%s('+12.78', '8')" % (cls.__name__))
+
+ a = cls('- 12.')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'- 12.')
+
+ a = cls('1.6E3')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'1.6E3')
+
+ a = cls('+1.6E3_8')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'+1.6E3_8')
+
+ a = cls('1.6D3')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'1.6D3')
+
+ a = cls('-1.6E-3')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'-1.6E-3')
+ a = cls('1.6E+3')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'1.6E+3')
+
+ a = cls('3E4')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'3E4')
+
+ a = cls('.123')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'.123')
+
+ a = cls('+1.6E-3')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'+1.6E-3')
+
+ a = cls('10.9E7_QUAD')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'10.9E7_QUAD')
+
+ a = cls('-10.9e-17_quad')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'-10.9E-17_quad')
+
+class test_Real_Literal_Constant(NumpyTestCase): # R417
+
+ def check_real_literal_constant(self):
+ cls = Real_Literal_Constant
+ a = cls('12.78')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'12.78')
+ assert_equal(repr(a),"%s('12.78', None)" % (cls.__name__))
+
+ a = cls('12.78_8')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'12.78_8')
+ assert_equal(repr(a),"%s('12.78', '8')" % (cls.__name__))
+
+ a = cls('12.')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'12.')
+
+ a = cls('1.6E3')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'1.6E3')
+
+ a = cls('1.6E3_8')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'1.6E3_8')
+
+ a = cls('1.6D3')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'1.6D3')
+
+ a = cls('1.6E-3')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'1.6E-3')
+ a = cls('1.6E+3')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'1.6E+3')
+
+ a = cls('3E4')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'3E4')
+
+ a = cls('.123')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'.123')
+
+ a = cls('1.6E-3')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'1.6E-3')
+
+ a = cls('10.9E7_QUAD')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'10.9E7_QUAD')
+
+ a = cls('10.9e-17_quad')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'10.9E-17_quad')
+
+ a = cls('0.0D+0')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'0.0D+0')
+
+class test_Char_Selector(NumpyTestCase): # R424
+
+ def check_char_selector(self):
+ cls = Char_Selector
+ a = cls('(len=2, kind=8)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(LEN = 2, KIND = 8)')
+ assert_equal(repr(a),"Char_Selector(Int_Literal_Constant('2', None), Int_Literal_Constant('8', None))")
+
+
+ a = cls('(2, kind=8)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(LEN = 2, KIND = 8)')
+
+ a = cls('(2, 8)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(LEN = 2, KIND = 8)')
+
+ a = cls('(kind=8)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(KIND = 8)')
+
+ a = cls('(kind=8,len=2)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(LEN = 2, KIND = 8)')
+
+class test_Complex_Literal_Constant(NumpyTestCase): # R421
+
+ def check_complex_literal_constant(self):
+ cls = Complex_Literal_Constant
+ a = cls('(1.0, -1.0)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(1.0, -1.0)')
+ assert_equal(repr(a),"Complex_Literal_Constant(Signed_Real_Literal_Constant('1.0', None), Signed_Real_Literal_Constant('-1.0', None))")
+
+ a = cls('(3,3.1E6)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(3, 3.1E6)')
+
+ a = cls('(4.0_4, 3.6E7_8)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(4.0_4, 3.6E7_8)')
+
+ a = cls('( 0., PI)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(0., PI)')
+
+
+class test_Type_Name(NumpyTestCase): # C424
+
+ def check_simple(self):
+ cls = Type_Name
+ a = cls('a')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a')
+ assert_equal(repr(a),"Type_Name('a')")
+
+ self.assertRaises(NoMatchError,cls,'integer')
+ self.assertRaises(NoMatchError,cls,'doubleprecision')
+
+class test_Length_Selector(NumpyTestCase): # R425
+
+ def check_length_selector(self):
+ cls = Length_Selector
+ a = cls('( len = *)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(LEN = *)')
+ assert_equal(repr(a),"Length_Selector('(', Type_Param_Value('*'), ')')")
+
+ a = cls('*2,')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'*2')
+
+class test_Char_Length(NumpyTestCase): # R426
+
+ def check_char_length(self):
+ cls = Char_Length
+ a = cls('(1)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(1)')
+ assert_equal(repr(a),"Char_Length('(', Int_Literal_Constant('1', None), ')')")
+
+ a = cls('1')
+ assert isinstance(a,Int_Literal_Constant),`a`
+ assert_equal(str(a),'1')
+
+ a = cls('(*)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(*)')
+
+ a = cls('(:)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(:)')
+
+class test_Char_Literal_Constant(NumpyTestCase): # R427
+
+ def check_char_literal_constant(self):
+ cls = Char_Literal_Constant
+ a = cls('NIH_"DO"')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'NIH_"DO"')
+ assert_equal(repr(a),'Char_Literal_Constant(\'"DO"\', \'NIH\')')
+
+ a = cls("'DO'")
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),"'DO'")
+ assert_equal(repr(a),'Char_Literal_Constant("\'DO\'", None)')
+
+ a = cls("'DON''T'")
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),"'DON''T'")
+
+ a = cls('"DON\'T"')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'"DON\'T"')
+
+ a = cls('""')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'""')
+
+ a = cls("''")
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),"''")
+
+ a = cls('"hey ha(ada)\t"')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'"hey ha(ada)\t"')
+
+class test_Logical_Literal_Constant(NumpyTestCase): # R428
+
+ def check_logical_literal_constant(self):
+ cls = Logical_Literal_Constant
+ a = cls('.TRUE.')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'.TRUE.')
+ assert_equal(repr(a),"%s('.TRUE.', None)" % (cls.__name__))
+
+ a = cls('.True.')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'.TRUE.')
+
+ a = cls('.FALSE.')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'.FALSE.')
+
+ a = cls('.TRUE._HA')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'.TRUE._HA')
+
+class test_Derived_Type_Stmt(NumpyTestCase): # R430
+
+ def check_simple(self):
+ cls = Derived_Type_Stmt
+ a = cls('type a')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'TYPE :: a')
+ assert_equal(repr(a),"Derived_Type_Stmt(None, Type_Name('a'), None)")
+
+ a = cls('type ::a(b,c)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'TYPE :: a(b, c)')
+
+ a = cls('type, private, abstract::a(b,c)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'TYPE, PRIVATE, ABSTRACT :: a(b, c)')
+
+class test_Type_Name(NumpyTestCase): # C423
+
+ def check_simple(self):
+ cls = Type_Name
+ a = cls('a')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a')
+ assert_equal(repr(a),"Type_Name('a')")
+
+class test_Type_Attr_Spec(NumpyTestCase): # R431
+
+ def check_simple(self):
+ cls = Type_Attr_Spec
+ a = cls('abstract')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'ABSTRACT')
+ assert_equal(repr(a),"Type_Attr_Spec('ABSTRACT')")
+
+ a = cls('bind (c )')
+ assert isinstance(a, Language_Binding_Spec),`a`
+ assert_equal(str(a),'BIND(C)')
+
+ a = cls('extends(a)')
+ assert isinstance(a, Type_EXTENDS_Parent_Type_Name),`a`
+ assert_equal(str(a),'EXTENDS(a)')
+
+ a = cls('private')
+ assert isinstance(a, Access_Spec),`a`
+ assert_equal(str(a),'PRIVATE')
+
+
+class test_End_Type_Stmt(NumpyTestCase): # R433
+
+ def check_simple(self):
+ cls = End_Type_Stmt
+ a = cls('end type')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'END TYPE')
+ assert_equal(repr(a),"End_Type_Stmt('TYPE', None)")
+
+ a = cls('end type a')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'END TYPE a')
+
+class test_Sequence_Stmt(NumpyTestCase): # R434
+
+ def check_simple(self):
+ cls = Sequence_Stmt
+ a = cls('sequence')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'SEQUENCE')
+ assert_equal(repr(a),"Sequence_Stmt('SEQUENCE')")
+
+class test_Type_Param_Def_Stmt(NumpyTestCase): # R435
+
+ def check_simple(self):
+ cls = Type_Param_Def_Stmt
+ a = cls('integer ,kind :: a')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'INTEGER, KIND :: a')
+ assert_equal(repr(a),"Type_Param_Def_Stmt(None, Type_Param_Attr_Spec('KIND'), Name('a'))")
+
+ a = cls('integer*2 ,len :: a=3, b=2+c')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'INTEGER*2, LEN :: a = 3, b = 2 + c')
+
+class test_Type_Param_Decl(NumpyTestCase): # R436
+
+ def check_simple(self):
+ cls = Type_Param_Decl
+ a = cls('a=2')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a = 2')
+ assert_equal(repr(a),"Type_Param_Decl(Name('a'), '=', Int_Literal_Constant('2', None))")
+
+ a = cls('a')
+ assert isinstance(a, Name),`a`
+ assert_equal(str(a),'a')
+
+class test_Type_Param_Attr_Spec(NumpyTestCase): # R437
+
+ def check_simple(self):
+ cls = Type_Param_Attr_Spec
+ a = cls('kind')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'KIND')
+ assert_equal(repr(a),"Type_Param_Attr_Spec('KIND')")
+
+ a = cls('len')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'LEN')
+
+class test_Component_Attr_Spec(NumpyTestCase): # R441
+
+ def check_simple(self):
+ cls = Component_Attr_Spec
+ a = cls('pointer')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'POINTER')
+ assert_equal(repr(a),"Component_Attr_Spec('POINTER')")
+
+ a = cls('allocatable')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'ALLOCATABLE')
+
+ a = cls('dimension(a)')
+ assert isinstance(a, Dimension_Component_Attr_Spec),`a`
+ assert_equal(str(a),'DIMENSION(a)')
+
+ a = cls('private')
+ assert isinstance(a, Access_Spec),`a`
+ assert_equal(str(a),'PRIVATE')
+
+class test_Component_Decl(NumpyTestCase): # R442
+
+ def check_simple(self):
+ cls = Component_Decl
+ a = cls('a(1)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a(1)')
+ assert_equal(repr(a),"Component_Decl(Name('a'), Explicit_Shape_Spec(None, Int_Literal_Constant('1', None)), None, None)")
+
+ a = cls('a(1)*(3)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a(1)*(3)')
+
+ a = cls('a(1)*(3) = 2')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a(1)*(3) = 2')
+
+ a = cls('a(1) => NULL')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a(1) => NULL')
+
+class test_Final_Binding(NumpyTestCase): # R454
+
+ def check_simple(self):
+ cls = Final_Binding
+ a = cls('final a, b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'FINAL :: a, b')
+ assert_equal(repr(a),"Final_Binding('FINAL', Final_Subroutine_Name_List(',', (Name('a'), Name('b'))))")
+
+ a = cls('final::a')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'FINAL :: a')
+
+class test_Derived_Type_Spec(NumpyTestCase): # R455
+
+ def check_simple(self):
+ cls = Derived_Type_Spec
+ a = cls('a(b)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a(b)')
+ assert_equal(repr(a),"Derived_Type_Spec(Type_Name('a'), Name('b'))")
+
+ a = cls('a(b,c,g=1)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a(b, c, g = 1)')
+
+ a = cls('a')
+ assert isinstance(a,Name),`a`
+ assert_equal(str(a),'a')
+
+ a = cls('a()')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a()')
+
+class test_Type_Param_Spec(NumpyTestCase): # R456
+
+ def check_type_param_spec(self):
+ cls = Type_Param_Spec
+ a = cls('a=1')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a = 1')
+ assert_equal(repr(a),"Type_Param_Spec(Name('a'), Int_Literal_Constant('1', None))")
+
+ a = cls('k=a')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'k = a')
+
+ a = cls('k=:')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'k = :')
+
+class test_Type_Param_Spec_List(NumpyTestCase): # R456-list
+
+ def check_type_param_spec_list(self):
+ cls = Type_Param_Spec_List
+
+ a = cls('a,b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a, b')
+ assert_equal(repr(a),"Type_Param_Spec_List(',', (Name('a'), Name('b')))")
+
+ a = cls('a')
+ assert isinstance(a,Name),`a`
+
+ a = cls('k=a,c,g=1')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'k = a, c, g = 1')
+
+class test_Structure_Constructor_2(NumpyTestCase): # R457.b
+
+ def check_simple(self):
+ cls = Structure_Constructor_2
+ a = cls('k=a')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'k = a')
+ assert_equal(repr(a),"Structure_Constructor_2(Name('k'), Name('a'))")
+
+ a = cls('a')
+ assert isinstance(a,Name),`a`
+ assert_equal(str(a),'a')
+
+class test_Structure_Constructor(NumpyTestCase): # R457
+
+ def check_structure_constructor(self):
+ cls = Structure_Constructor
+ a = cls('t()')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'t()')
+ assert_equal(repr(a),"Structure_Constructor(Type_Name('t'), None)")
+
+ a = cls('t(s=1, a)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'t(s = 1, a)')
+
+ a = cls('a=k')
+ assert isinstance(a,Structure_Constructor_2),`a`
+ assert_equal(str(a),'a = k')
+ assert_equal(repr(a),"Structure_Constructor_2(Name('a'), Name('k'))")
+
+ a = cls('a')
+ assert isinstance(a,Name),`a`
+ assert_equal(str(a),'a')
+
+class test_Component_Spec(NumpyTestCase): # R458
+
+ def check_simple(self):
+ cls = Component_Spec
+ a = cls('k=a')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'k = a')
+ assert_equal(repr(a),"Component_Spec(Name('k'), Name('a'))")
+
+ a = cls('a')
+ assert isinstance(a,Name),`a`
+ assert_equal(str(a),'a')
+
+ a = cls('a % b')
+ assert isinstance(a, Proc_Component_Ref),`a`
+ assert_equal(str(a),'a % b')
+
+ a = cls('s =a % b')
+ assert isinstance(a, Component_Spec),`a`
+ assert_equal(str(a),'s = a % b')
+
+class test_Component_Spec_List(NumpyTestCase): # R458-list
+
+ def check_simple(self):
+ cls = Component_Spec_List
+ a = cls('k=a, b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'k = a, b')
+ assert_equal(repr(a),"Component_Spec_List(',', (Component_Spec(Name('k'), Name('a')), Name('b')))")
+
+ a = cls('k=a, c')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'k = a, c')
+
+class test_Array_Constructor(NumpyTestCase): # R465
+
+ def check_simple(self):
+ cls = Array_Constructor
+ a = cls('(/a/)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(/a/)')
+ assert_equal(repr(a),"Array_Constructor('(/', Name('a'), '/)')")
+
+ a = cls('[a]')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'[a]')
+ assert_equal(repr(a),"Array_Constructor('[', Name('a'), ']')")
+
+ a = cls('[integer::a]')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'[INTEGER :: a]')
+
+ a = cls('[integer::a,b]')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'[INTEGER :: a, b]')
+
+class test_Ac_Spec(NumpyTestCase): # R466
+
+ def check_ac_spec(self):
+ cls = Ac_Spec
+ a = cls('integer ::')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'INTEGER ::')
+ assert_equal(repr(a),"Ac_Spec(Intrinsic_Type_Spec('INTEGER', None), None)")
+
+ a = cls('integer :: a,b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'INTEGER :: a, b')
+
+ a = cls('a,b')
+ assert isinstance(a,Ac_Value_List),`a`
+ assert_equal(str(a),'a, b')
+
+ a = cls('integer :: a, (a, b, n = 1, 5)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'INTEGER :: a, (a, b, n = 1, 5)')
+
+class test_Ac_Value_List(NumpyTestCase): # R469-list
+
+ def check_ac_value_list(self):
+ cls = Ac_Value_List
+ a = cls('a, b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a, b')
+ assert_equal(repr(a),"Ac_Value_List(',', (Name('a'), Name('b')))")
+
+ a = cls('a')
+ assert isinstance(a,Name),`a`
+ assert_equal(str(a),'a')
+
+class test_Ac_Implied_Do(NumpyTestCase): # R470
+
+ def check_ac_implied_do(self):
+ cls = Ac_Implied_Do
+ a = cls('( a, b, n = 1, 5 )')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(a, b, n = 1, 5)')
+ assert_equal(repr(a),"Ac_Implied_Do(Ac_Value_List(',', (Name('a'), Name('b'))), Ac_Implied_Do_Control(Name('n'), [Int_Literal_Constant('1', None), Int_Literal_Constant('5', None)]))")
+
+class test_Ac_Implied_Do_Control(NumpyTestCase): # R471
+
+ def check_ac_implied_do_control(self):
+ cls = Ac_Implied_Do_Control
+ a = cls('n = 3, 5')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'n = 3, 5')
+ assert_equal(repr(a),"Ac_Implied_Do_Control(Name('n'), [Int_Literal_Constant('3', None), Int_Literal_Constant('5', None)])")
+
+ a = cls('n = 3+1, 5, 1')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'n = 3 + 1, 5, 1')
+
+###############################################################################
+############################### SECTION 5 ####################################
+###############################################################################
+
+class test_Type_Declaration_Stmt(NumpyTestCase): # R501
+
+ def check_simple(self):
+ cls = Type_Declaration_Stmt
+ a = cls('integer a')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a), 'INTEGER :: a')
+ assert_equal(repr(a), "Type_Declaration_Stmt(Intrinsic_Type_Spec('INTEGER', None), None, Entity_Decl(Name('a'), None, None, None))")
+
+ a = cls('integer ,dimension(2):: a*3')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a), 'INTEGER, DIMENSION(2) :: a*3')
+
+ a = cls('real a')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a), 'REAL :: a')
+ assert_equal(repr(a), "Type_Declaration_Stmt(Intrinsic_Type_Spec('REAL', None), None, Entity_Decl(Name('a'), None, None, None))")
+
+ a = cls('REAL A( LDA, * ), B( LDB, * )')
+ assert isinstance(a, cls),`a`
+
+ a = cls('DOUBLE PRECISION ALPHA, BETA')
+ assert isinstance(a, cls),`a`
+
+class test_Declaration_Type_Spec(NumpyTestCase): # R502
+
+ def check_simple(self):
+ cls = Declaration_Type_Spec
+ a = cls('Integer*2')
+ assert isinstance(a, Intrinsic_Type_Spec),`a`
+ assert_equal(str(a), 'INTEGER*2')
+
+ a = cls('type(foo)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a), 'TYPE(foo)')
+ assert_equal(repr(a), "Declaration_Type_Spec('TYPE', Type_Name('foo'))")
+
+class test_Attr_Spec(NumpyTestCase): # R503
+
+ def check_simple(self):
+ cls = Attr_Spec
+ a = cls('allocatable')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a), 'ALLOCATABLE')
+
+ a = cls('dimension(a)')
+ assert isinstance(a, Dimension_Attr_Spec),`a`
+ assert_equal(str(a),'DIMENSION(a)')
+
+class test_Dimension_Attr_Spec(NumpyTestCase): # R503.d
+
+ def check_simple(self):
+ cls = Dimension_Attr_Spec
+ a = cls('dimension(a)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'DIMENSION(a)')
+ assert_equal(repr(a),"Dimension_Attr_Spec('DIMENSION', Explicit_Shape_Spec(None, Name('a')))")
+
+class test_Intent_Attr_Spec(NumpyTestCase): # R503.f
+
+ def check_simple(self):
+ cls = Intent_Attr_Spec
+ a = cls('intent(in)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'INTENT(IN)')
+ assert_equal(repr(a),"Intent_Attr_Spec('INTENT', Intent_Spec('IN'))")
+
+class test_Entity_Decl(NumpyTestCase): # 504
+
+ def check_simple(self):
+ cls = Entity_Decl
+ a = cls('a(1)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a(1)')
+ assert_equal(repr(a),"Entity_Decl(Name('a'), Explicit_Shape_Spec(None, Int_Literal_Constant('1', None)), None, None)")
+
+ a = cls('a(1)*(3)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a(1)*(3)')
+
+ a = cls('a(1)*(3) = 2')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a(1)*(3) = 2')
+
+class test_Access_Spec(NumpyTestCase): # R508
+
+ def check_simple(self):
+ cls = Access_Spec
+ a = cls('private')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'PRIVATE')
+ assert_equal(repr(a),"Access_Spec('PRIVATE')")
+
+ a = cls('public')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'PUBLIC')
+
+class test_Language_Binding_Spec(NumpyTestCase): # R509
+
+ def check_simple(self):
+ cls = Language_Binding_Spec
+ a = cls('bind(c)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'BIND(C)')
+ assert_equal(repr(a),'Language_Binding_Spec(None)')
+
+ a = cls('bind(c, name="hey")')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'BIND(C, NAME = "hey")')
+
+class test_Explicit_Shape_Spec(NumpyTestCase): # R511
+
+ def check_simple(self):
+ cls = Explicit_Shape_Spec
+ a = cls('a:b')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a : b')
+ assert_equal(repr(a),"Explicit_Shape_Spec(Name('a'), Name('b'))")
+
+ a = cls('a')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a')
+
+class test_Upper_Bound(NumpyTestCase): # R513
+
+ def check_simple(self):
+ cls = Upper_Bound
+ a = cls('a')
+ assert isinstance(a, Name),`a`
+ assert_equal(str(a),'a')
+
+ self.assertRaises(NoMatchError,cls,'*')
+
+class test_Assumed_Shape_Spec(NumpyTestCase): # R514
+
+ def check_simple(self):
+ cls = Assumed_Shape_Spec
+ a = cls(':')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),':')
+ assert_equal(repr(a),'Assumed_Shape_Spec(None, None)')
+
+ a = cls('a :')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a :')
+
+class test_Deferred_Shape_Spec(NumpyTestCase): # R515
+
+ def check_simple(self):
+ cls = Deferred_Shape_Spec
+ a = cls(':')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),':')
+ assert_equal(repr(a),'Deferred_Shape_Spec(None, None)')
+
+
+class test_Assumed_Size_Spec(NumpyTestCase): # R516
+
+ def check_simple(self):
+ cls = Assumed_Size_Spec
+ a = cls('*')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'*')
+ assert_equal(repr(a),'Assumed_Size_Spec(None, None)')
+
+ a = cls('1:*')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'1 : *')
+
+ a = cls('a,1:*')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a, 1 : *')
+
+ a = cls('a:b,1:*')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a : b, 1 : *')
+
+class test_Access_Stmt(NumpyTestCase): # R518
+
+ def check_simple(self):
+ cls = Access_Stmt
+ a = cls('private')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'PRIVATE')
+ assert_equal(repr(a),"Access_Stmt('PRIVATE', None)")
+
+ a = cls('public a,b')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'PUBLIC :: a, b')
+
+ a = cls('public ::a')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'PUBLIC :: a')
+
+class test_Parameter_Stmt(NumpyTestCase): # R538
+
+ def check_simple(self):
+ cls = Parameter_Stmt
+ a = cls('parameter(a=1)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'PARAMETER(a = 1)')
+ assert_equal(repr(a),"Parameter_Stmt('PARAMETER', Named_Constant_Def(Name('a'), Int_Literal_Constant('1', None)))")
+
+ a = cls('parameter(a=1, b=a+2)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'PARAMETER(a = 1, b = a + 2)')
+
+ a = cls('PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'PARAMETER(ONE = 1.0D+0, ZERO = 0.0D+0)')
+
+class test_Named_Constant_Def(NumpyTestCase): # R539
+
+ def check_simple(self):
+ cls = Named_Constant_Def
+ a = cls('a=1')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a = 1')
+ assert_equal(repr(a),"Named_Constant_Def(Name('a'), Int_Literal_Constant('1', None))")
+
+class test_Pointer_Decl(NumpyTestCase): # R541
+
+ def check_simple(self):
+ cls = Pointer_Decl
+ a = cls('a(:)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a(:)')
+ assert_equal(repr(a),"Pointer_Decl(Name('a'), Deferred_Shape_Spec(None, None))")
+
+ a = cls('a(:,:)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a(:, :)')
+
+class test_Implicit_Stmt(NumpyTestCase): # R549
+
+ def check_simple(self):
+ cls = Implicit_Stmt
+ a = cls('implicitnone')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'IMPLICIT NONE')
+ assert_equal(repr(a),"Implicit_Stmt('IMPLICIT NONE', None)")
+
+ a = cls('implicit real(a-d), double precision(r-t,x), type(a) (y-z)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'IMPLICIT REAL(A - D), DOUBLE PRECISION(R - T, X), TYPE(a)(Y - Z)')
+
+class test_Implicit_Spec(NumpyTestCase): # R550
+
+ def check_simple(self):
+ cls = Implicit_Spec
+ a = cls('integer (a-z)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'INTEGER(A - Z)')
+ assert_equal(repr(a),"Implicit_Spec(Intrinsic_Type_Spec('INTEGER', None), Letter_Spec('A', 'Z'))")
+
+ a = cls('double complex (r,d-g)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'DOUBLE COMPLEX(R, D - G)')
+
+class test_Letter_Spec(NumpyTestCase): # R551
+
+ def check_simple(self):
+ cls = Letter_Spec
+ a = cls('a-z')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'A - Z')
+ assert_equal(repr(a),"Letter_Spec('A', 'Z')")
+
+ a = cls('d')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'D')
+
+class test_Equivalence_Stmt(NumpyTestCase): # R554
+
+ def check_simple(self):
+ cls = Equivalence_Stmt
+ a = cls('equivalence (a, b ,z)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'EQUIVALENCE(a, b, z)')
+ assert_equal(repr(a),"Equivalence_Stmt('EQUIVALENCE', Equivalence_Set(Name('a'), Equivalence_Object_List(',', (Name('b'), Name('z')))))")
+
+ a = cls('equivalence (a, b ,z),(b,l)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'EQUIVALENCE(a, b, z), (b, l)')
+
+class test_Common_Stmt(NumpyTestCase): # R557
+
+ def check_simple(self):
+ cls = Common_Stmt
+ a = cls('common a')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'COMMON // a')
+ assert_equal(repr(a),"Common_Stmt([(None, Name('a'))])")
+
+ a = cls('common // a,b')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'COMMON // a, b')
+
+ a = cls('common /name/ a,b')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'COMMON /name/ a, b')
+
+ a = cls('common /name/ a,b(4,5) // c, /ljuks/ g(2)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'COMMON /name/ a, b(4, 5) // c /ljuks/ g(2)')
+
+class test_Common_Block_Object(NumpyTestCase): # R558
+
+ def check_simple(self):
+ cls = Common_Block_Object
+ a = cls('a(2)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a(2)')
+ assert_equal(repr(a),"Common_Block_Object(Name('a'), Explicit_Shape_Spec(None, Int_Literal_Constant('2', None)))")
+
+ a = cls('a')
+ assert isinstance(a, Name),`a`
+ assert_equal(str(a),'a')
+
+
+###############################################################################
+############################### SECTION 6 ####################################
+###############################################################################
+
+class test_Substring(NumpyTestCase): # R609
+
+ def check_simple(self):
+ cls = Substring
+ a = cls('a(:)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a(:)')
+ assert_equal(repr(a),"Substring(Name('a'), Substring_Range(None, None))")
+
+ a = cls('a(1:2)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a(1 : 2)')
+ assert_equal(repr(a),"Substring(Name('a'), Substring_Range(Int_Literal_Constant('1', None), Int_Literal_Constant('2', None)))")
+
+
+class test_Substring_Range(NumpyTestCase): # R611
+
+ def check_simple(self):
+ cls = Substring_Range
+ a = cls(':')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),':')
+ assert_equal(repr(a),"Substring_Range(None, None)")
+
+ a = cls('a+1:')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a + 1 :')
+
+ a = cls('a+1: c/foo(g)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a + 1 : c / foo(g)')
+
+ a = cls('a:b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a : b')
+ assert_equal(repr(a),"Substring_Range(Name('a'), Name('b'))")
+
+ a = cls('a:')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a :')
+
+ a = cls(':b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),': b')
+
+
+class test_Data_Ref(NumpyTestCase): # R612
+
+ def check_data_ref(self):
+ cls = Data_Ref
+ a = cls('a%b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a % b')
+ assert_equal(repr(a),"Data_Ref('%', (Name('a'), Name('b')))")
+
+ a = cls('a')
+ assert isinstance(a,Name),`a`
+ assert_equal(str(a),'a')
+
+class test_Part_Ref(NumpyTestCase): # R613
+
+ def check_part_ref(self):
+ cls = Part_Ref
+ a = cls('a')
+ assert isinstance(a, Name),`a`
+ assert_equal(str(a),'a')
+
+class test_Type_Param_Inquiry(NumpyTestCase): # R615
+
+ def check_simple(self):
+ cls = Type_Param_Inquiry
+ a = cls('a % b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a % b')
+ assert_equal(repr(a),"Type_Param_Inquiry(Name('a'), '%', Name('b'))")
+
+
+class test_Array_Section(NumpyTestCase): # R617
+
+ def check_array_section(self):
+ cls = Array_Section
+ a = cls('a(:)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a(:)')
+ assert_equal(repr(a),"Array_Section(Name('a'), Substring_Range(None, None))")
+
+ a = cls('a(2:)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a(2 :)')
+
+
+class test_Section_Subscript(NumpyTestCase): # R619
+
+ def check_simple(self):
+ cls = Section_Subscript
+
+ a = cls('1:2')
+ assert isinstance(a, Subscript_Triplet),`a`
+ assert_equal(str(a),'1 : 2')
+
+ a = cls('zzz')
+ assert isinstance(a, Name),`a`
+ assert_equal(str(a),'zzz')
+
+class test_Section_Subscript_List(NumpyTestCase): # R619-list
+
+ def check_simple(self):
+ cls = Section_Subscript_List
+ a = cls('a,2')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a, 2')
+ assert_equal(repr(a),"Section_Subscript_List(',', (Name('a'), Int_Literal_Constant('2', None)))")
+
+ a = cls('::1')
+ assert isinstance(a,Subscript_Triplet),`a`
+ assert_equal(str(a),': : 1')
+
+ a = cls('::1, 3')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),': : 1, 3')
+
+class test_Subscript_Triplet(NumpyTestCase): # R620
+
+ def check_simple(self):
+ cls = Subscript_Triplet
+ a = cls('a:b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a : b')
+ assert_equal(repr(a),"Subscript_Triplet(Name('a'), Name('b'), None)")
+
+ a = cls('a:b:1')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a : b : 1')
+
+ a = cls(':')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),':')
+
+ a = cls('::5')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),': : 5')
+
+ a = cls(':5')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),': 5')
+
+ a = cls('a+1 :')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a + 1 :')
+
+class test_Alloc_Opt(NumpyTestCase): # R624
+
+ def check_simple(self):
+ cls = Alloc_Opt
+ a = cls('stat=a')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'STAT = a')
+ assert_equal(repr(a),"Alloc_Opt('STAT', Name('a'))")
+
+class test_Nullify_Stmt(NumpyTestCase): # R633
+
+ def check_simple(self):
+ cls = Nullify_Stmt
+ a = cls('nullify (a)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'NULLIFY(a)')
+ assert_equal(repr(a),"Nullify_Stmt('NULLIFY', Name('a'))")
+
+ a = cls('nullify (a,c)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'NULLIFY(a, c)')
+
+###############################################################################
+############################### SECTION 7 ####################################
+###############################################################################
+
+class test_Primary(NumpyTestCase): # R701
+
+ def check_simple(self):
+ cls = Primary
+ a = cls('a')
+ assert isinstance(a,Name),`a`
+ assert_equal(str(a),'a')
+
+ a = cls('(a)')
+ assert isinstance(a,Parenthesis),`a`
+ assert_equal(str(a),'(a)')
+
+ a = cls('1')
+ assert isinstance(a,Int_Literal_Constant),`a`
+ assert_equal(str(a),'1')
+
+ a = cls('1.')
+ assert isinstance(a,Real_Literal_Constant),`a`
+ assert_equal(str(a),'1.')
+
+ a = cls('(1, n)')
+ assert isinstance(a,Complex_Literal_Constant),`a`
+ assert_equal(str(a),'(1, n)')
+
+ a = cls('.true.')
+ assert isinstance(a,Logical_Literal_Constant),`a`
+ assert_equal(str(a),'.TRUE.')
+
+ a = cls('"hey a()c"')
+ assert isinstance(a,Char_Literal_Constant),`a`
+ assert_equal(str(a),'"hey a()c"')
+
+ a = cls('b"0101"')
+ assert isinstance(a,Binary_Constant),`a`
+ assert_equal(str(a),'B"0101"')
+
+ a = cls('o"0107"')
+ assert isinstance(a,Octal_Constant),`a`
+ assert_equal(str(a),'O"0107"')
+
+ a = cls('z"a107"')
+ assert isinstance(a,Hex_Constant),`a`
+ assert_equal(str(a),'Z"A107"')
+
+ a = cls('a % b')
+ assert isinstance(a,Data_Ref),`a`
+ assert_equal(str(a),'a % b')
+
+ a = cls('a(:)')
+ assert isinstance(a,Array_Section),`a`
+ assert_equal(str(a),'a(:)')
+
+ a = cls('0.0E-1')
+ assert isinstance(a,Real_Literal_Constant),`a`
+ assert_equal(str(a),'0.0E-1')
+
+class test_Parenthesis(NumpyTestCase): # R701.h
+
+ def check_simple(self):
+ cls = Parenthesis
+ a = cls('(a)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(a)')
+ assert_equal(repr(a),"Parenthesis('(', Name('a'), ')')")
+
+ a = cls('(a+1)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(a + 1)')
+
+ a = cls('((a))')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'((a))')
+
+ a = cls('(a+(a+c))')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(a + (a + c))')
+
+class test_Level_1_Expr(NumpyTestCase): # R702
+
+ def check_simple(self):
+ cls = Level_1_Expr
+ a = cls('.hey. a')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'.HEY. a')
+ assert_equal(repr(a),"Level_1_Expr('.HEY.', Name('a'))")
+
+ self.assertRaises(NoMatchError,cls,'.not. a')
+
+class test_Mult_Operand(NumpyTestCase): # R704
+
+ def check_simple(self):
+ cls = Mult_Operand
+ a = cls('a**b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a ** b')
+ assert_equal(repr(a),"Mult_Operand(Name('a'), '**', Name('b'))")
+
+ a = cls('a**2')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a ** 2')
+
+ a = cls('(a+b)**2')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'(a + b) ** 2')
+
+ a = cls('0.0E-1')
+ assert isinstance(a,Real_Literal_Constant),`a`
+ assert_equal(str(a),'0.0E-1')
+
+class test_Add_Operand(NumpyTestCase): # R705
+
+ def check_simple(self):
+ cls = Add_Operand
+ a = cls('a*b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a * b')
+ assert_equal(repr(a),"Add_Operand(Name('a'), '*', Name('b'))")
+
+ a = cls('a/b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a / b')
+
+ a = cls('a**b')
+ assert isinstance(a,Mult_Operand),`a`
+ assert_equal(str(a),'a ** b')
+
+ a = cls('0.0E-1')
+ assert isinstance(a,Real_Literal_Constant),`a`
+ assert_equal(str(a),'0.0E-1')
+
+class test_Level_2_Expr(NumpyTestCase): # R706
+
+ def check_simple(self):
+ cls = Level_2_Expr
+ a = cls('a+b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a + b')
+ assert_equal(repr(a),"Level_2_Expr(Name('a'), '+', Name('b'))")
+
+ a = cls('a-b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a - b')
+
+ a = cls('a+b+c')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a + b + c')
+
+ a = cls('+a')
+ assert isinstance(a,Level_2_Unary_Expr),`a`
+ assert_equal(str(a),'+ a')
+
+ a = cls('+1')
+ assert isinstance(a,Level_2_Unary_Expr),`a`
+ assert_equal(str(a),'+ 1')
+
+ a = cls('+a+b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'+ a + b')
+
+ a = cls('0.0E-1')
+ assert isinstance(a,Real_Literal_Constant),`a`
+ assert_equal(str(a),'0.0E-1')
+
+
+class test_Level_2_Unary_Expr(NumpyTestCase):
+
+ def check_simple(self):
+ cls = Level_2_Unary_Expr
+ a = cls('+a')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'+ a')
+ assert_equal(repr(a),"Level_2_Unary_Expr('+', Name('a'))")
+
+ a = cls('-a')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'- a')
+
+ a = cls('+1')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'+ 1')
+
+ a = cls('0.0E-1')
+ assert isinstance(a,Real_Literal_Constant),`a`
+ assert_equal(str(a),'0.0E-1')
+
+
+class test_Level_3_Expr(NumpyTestCase): # R710
+
+ def check_simple(self):
+ cls = Level_3_Expr
+ a = cls('a//b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a // b')
+ assert_equal(repr(a),"Level_3_Expr(Name('a'), '//', Name('b'))")
+
+ a = cls('"a"//"b"')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'"a" // "b"')
+
+class test_Level_4_Expr(NumpyTestCase): # R712
+
+ def check_simple(self):
+ cls = Level_4_Expr
+ a = cls('a.eq.b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a .EQ. b')
+ assert_equal(repr(a),"Level_4_Expr(Name('a'), '.EQ.', Name('b'))")
+
+ a = cls('a.ne.b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a .NE. b')
+
+ a = cls('a.lt.b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a .LT. b')
+
+ a = cls('a.gt.b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a .GT. b')
+
+ a = cls('a.ge.b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a .GE. b')
+
+ a = cls('a==b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a == b')
+
+ a = cls('a/=b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a /= b')
+
+ a = cls('a<b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a < b')
+
+ a = cls('a<=b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a <= b')
+
+ a = cls('a>=b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a >= b')
+
+ a = cls('a>b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a > b')
+
+class test_And_Operand(NumpyTestCase): # R714
+
+ def check_simple(self):
+ cls = And_Operand
+ a = cls('.not.a')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'.NOT. a')
+ assert_equal(repr(a),"And_Operand('.NOT.', Name('a'))")
+
+class test_Or_Operand(NumpyTestCase): # R715
+
+ def check_simple(self):
+ cls = Or_Operand
+ a = cls('a.and.b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a .AND. b')
+ assert_equal(repr(a),"Or_Operand(Name('a'), '.AND.', Name('b'))")
+
+
+class test_Equiv_Operand(NumpyTestCase): # R716
+
+ def check_simple(self):
+ cls = Equiv_Operand
+ a = cls('a.or.b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a .OR. b')
+ assert_equal(repr(a),"Equiv_Operand(Name('a'), '.OR.', Name('b'))")
+
+
+class test_Level_5_Expr(NumpyTestCase): # R717
+
+ def check_simple(self):
+ cls = Level_5_Expr
+ a = cls('a.eqv.b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a .EQV. b')
+ assert_equal(repr(a),"Level_5_Expr(Name('a'), '.EQV.', Name('b'))")
+
+ a = cls('a.neqv.b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a .NEQV. b')
+
+ a = cls('a.eq.b')
+ assert isinstance(a,Level_4_Expr),`a`
+ assert_equal(str(a),'a .EQ. b')
+
+class test_Expr(NumpyTestCase): # R722
+
+ def check_simple(self):
+ cls = Expr
+ a = cls('a .op. b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a .OP. b')
+ assert_equal(repr(a),"Expr(Name('a'), '.OP.', Name('b'))")
+
+ a = cls('a')
+ assert isinstance(a,Name),`a`
+ assert_equal(str(a),'a')
+
+ a = cls('3.e2')
+ assert isinstance(a,Real_Literal_Constant),`a`
+
+ a = cls('0.0E-1')
+ assert isinstance(a,Real_Literal_Constant),`a`
+ assert_equal(str(a),'0.0E-1')
+
+ self.assertRaises(NoMatchError,Scalar_Int_Expr,'a,b')
+
+class test_Assignment_Stmt(NumpyTestCase): # R734
+
+ def check_simple(self):
+ cls = Assignment_Stmt
+ a = cls('a = b')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a = b')
+ assert_equal(repr(a),"Assignment_Stmt(Name('a'), '=', Name('b'))")
+
+ a = cls('a(3:4) = b+c')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a(3 : 4) = b + c')
+
+ a = cls('a%c = b+c')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'a % c = b + c')
+
+class test_Proc_Component_Ref(NumpyTestCase): # R741
+
+ def check_proc_component_ref(self):
+ cls = Proc_Component_Ref
+ a = cls('a % b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a % b')
+ assert_equal(repr(a),"Proc_Component_Ref(Name('a'), '%', Name('b'))")
+
+class test_Where_Stmt(NumpyTestCase): # R743
+
+ def check_simple(self):
+ cls = Where_Stmt
+ a = cls('where (a) c=2')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'WHERE (a) c = 2')
+ assert_equal(repr(a),"Where_Stmt(Name('a'), Assignment_Stmt(Name('c'), '=', Int_Literal_Constant('2', None)))")
+
+class test_Where_Construct_Stmt(NumpyTestCase): # R745
+
+ def check_simple(self):
+ cls = Where_Construct_Stmt
+ a = cls('where (a)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'WHERE (a)')
+ assert_equal(repr(a),"Where_Construct_Stmt(Name('a'))")
+
+
+###############################################################################
+############################### SECTION 8 ####################################
+###############################################################################
+
+class test_Continue_Stmt(NumpyTestCase): # R848
+
+ def check_simple(self):
+ cls = Continue_Stmt
+ a = cls('continue')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'CONTINUE')
+ assert_equal(repr(a),"Continue_Stmt('CONTINUE')")
+
+###############################################################################
+############################### SECTION 9 ####################################
+###############################################################################
+
+class test_Io_Unit(NumpyTestCase): # R901
+
+ def check_simple(self):
+ cls = Io_Unit
+ a = cls('*')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'*')
+
+ a = cls('a')
+ assert isinstance(a, Name),`a`
+ assert_equal(str(a),'a')
+
+class test_Write_Stmt(NumpyTestCase): # R911
+
+ def check_simple(self):
+ cls = Write_Stmt
+ a = cls('write (123)"hey"')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'WRITE(UNIT = 123) "hey"')
+ assert_equal(repr(a),'Write_Stmt(Io_Control_Spec_List(\',\', (Io_Control_Spec(\'UNIT\', Int_Literal_Constant(\'123\', None)),)), Char_Literal_Constant(\'"hey"\', None))')
+
+class test_Print_Stmt(NumpyTestCase): # R912
+
+ def check_simple(self):
+ cls = Print_Stmt
+ a = cls('print 123')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'PRINT 123')
+ assert_equal(repr(a),"Print_Stmt(Label('123'), None)")
+
+ a = cls('print *,"a=",a')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'PRINT *, "a=", a')
+
+class test_Io_Control_Spec(NumpyTestCase): # R913
+
+ def check_simple(self):
+ cls = Io_Control_Spec
+ a = cls('end=123')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'END = 123')
+ assert_equal(repr(a),"Io_Control_Spec('END', Label('123'))")
+
+class test_Io_Control_Spec_List(NumpyTestCase): # R913-list
+
+ def check_simple(self):
+ cls = Io_Control_Spec_List
+ a = cls('end=123')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'END = 123')
+ assert_equal(repr(a),"Io_Control_Spec_List(',', (Io_Control_Spec('END', Label('123')),))")
+
+ a = cls('123')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'UNIT = 123')
+
+ a = cls('123,*')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'UNIT = 123, FMT = *')
+
+ a = cls('123,fmt=a')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'UNIT = 123, FMT = a')
+
+ if 0:
+ # see todo note in Io_Control_Spec_List
+ a = cls('123,a')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'UNIT = 123, NML = a')
+
+class test_Format(NumpyTestCase): # R914
+
+ def check_simple(self):
+ cls = Format
+ a = cls('*')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'*')
+ assert_equal(repr(a),"Format('*')")
+
+ a = cls('a')
+ assert isinstance(a, Name),`a`
+ assert_equal(str(a),'a')
+
+ a = cls('123')
+ assert isinstance(a, Label),`a`
+ assert_equal(str(a),'123')
+
+class test_Wait_Stmt(NumpyTestCase): # R921
+
+ def check_simple(self):
+ cls = Wait_Stmt
+ a = cls('wait (123)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'WAIT(UNIT = 123)')
+
+class test_Wait_Spec(NumpyTestCase): # R922
+
+ def check_simple(self):
+ cls = Wait_Spec
+ a = cls('123')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'UNIT = 123')
+ assert_equal(repr(a),"Wait_Spec('UNIT', Int_Literal_Constant('123', None))")
+
+ a = cls('err=1')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'ERR = 1')
+
+###############################################################################
+############################### SECTION 10 ####################################
+###############################################################################
+
+
+###############################################################################
+############################### SECTION 11 ####################################
+###############################################################################
+
+class test_Use_Stmt(NumpyTestCase): # R1109
+
+ def check_simple(self):
+ cls = Use_Stmt
+ a = cls('use a')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'USE :: a')
+ assert_equal(repr(a),"Use_Stmt(None, Name('a'), '', None)")
+
+ a = cls('use :: a, c=>d')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'USE :: a, c => d')
+
+ a = cls('use :: a, operator(.hey.)=>operator(.hoo.)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'USE :: a, OPERATOR(.HEY.) => OPERATOR(.HOO.)')
+
+ a = cls('use, intrinsic :: a, operator(.hey.)=>operator(.hoo.), c=>g')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'USE, INTRINSIC :: a, OPERATOR(.HEY.) => OPERATOR(.HOO.), c => g')
+
+class test_Module_Nature(NumpyTestCase): # R1110
+
+ def check_simple(self):
+ cls = Module_Nature
+ a = cls('intrinsic')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'INTRINSIC')
+ assert_equal(repr(a),"Module_Nature('INTRINSIC')")
+
+ a = cls('non_intrinsic')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'NON_INTRINSIC')
+
+###############################################################################
+############################### SECTION 12 ####################################
+###############################################################################
+
+class test_Function_Reference(NumpyTestCase): # R1217
+
+ def check_simple(self):
+ cls = Function_Reference
+ a = cls('f()')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'f()')
+ assert_equal(repr(a),"Function_Reference(Name('f'), None)")
+
+ a = cls('f(2,k=1,a)')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'f(2, k = 1, a)')
+
+
+class test_Procedure_Designator(NumpyTestCase): # R1219
+
+ def check_procedure_designator(self):
+ cls = Procedure_Designator
+ a = cls('a%b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a % b')
+ assert_equal(repr(a),"Procedure_Designator(Name('a'), '%', Name('b'))")
+
+class test_Actual_Arg_Spec(NumpyTestCase): # R1220
+
+ def check_simple(self):
+ cls = Actual_Arg_Spec
+ a = cls('k=a')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'k = a')
+ assert_equal(repr(a),"Actual_Arg_Spec(Name('k'), Name('a'))")
+
+ a = cls('a')
+ assert isinstance(a,Name),`a`
+ assert_equal(str(a),'a')
+
+class test_Actual_Arg_Spec_List(NumpyTestCase):
+
+ def check_simple(self):
+ cls = Actual_Arg_Spec_List
+ a = cls('a,b')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'a, b')
+ assert_equal(repr(a),"Actual_Arg_Spec_List(',', (Name('a'), Name('b')))")
+
+ a = cls('a = k')
+ assert isinstance(a,Actual_Arg_Spec),`a`
+ assert_equal(str(a),'a = k')
+
+ a = cls('a = k,b')
+ assert isinstance(a,Actual_Arg_Spec_List),`a`
+ assert_equal(str(a),'a = k, b')
+
+ a = cls('a')
+ assert isinstance(a,Name),`a`
+ assert_equal(str(a),'a')
+
+class test_Alt_Return_Spec(NumpyTestCase): # R1222
+
+ def check_alt_return_spec(self):
+ cls = Alt_Return_Spec
+ a = cls('* 123')
+ assert isinstance(a,cls),`a`
+ assert_equal(str(a),'*123')
+ assert_equal(repr(a),"Alt_Return_Spec(Label('123'))")
+
+class test_Prefix(NumpyTestCase): # R1227
+
+ def check_simple(self):
+ cls = Prefix
+ a = cls('pure recursive')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'PURE RECURSIVE')
+ assert_equal(repr(a), "Prefix(' ', (Prefix_Spec('PURE'), Prefix_Spec('RECURSIVE')))")
+
+ a = cls('integer * 2 pure')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'INTEGER*2 PURE')
+
+class test_Prefix_Spec(NumpyTestCase): # R1228
+
+ def check_simple(self):
+ cls = Prefix_Spec
+ a = cls('pure')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'PURE')
+ assert_equal(repr(a),"Prefix_Spec('PURE')")
+
+ a = cls('elemental')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'ELEMENTAL')
+
+ a = cls('recursive')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'RECURSIVE')
+
+ a = cls('integer * 2')
+ assert isinstance(a, Intrinsic_Type_Spec),`a`
+ assert_equal(str(a),'INTEGER*2')
+
+class test_Subroutine_Subprogram(NumpyTestCase): # R1231
+
+ def check_simple(self):
+ from api import get_reader
+ reader = get_reader('''\
+ subroutine foo
+ end subroutine foo''')
+ cls = Subroutine_Subprogram
+ a = cls(reader)
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'SUBROUTINE foo\nEND SUBROUTINE foo')
+ assert_equal(repr(a),"Subroutine_Subprogram(Subroutine_Stmt(None, Name('foo'), None, None), End_Subroutine_Stmt('SUBROUTINE', Name('foo')))")
+
+ reader = get_reader('''\
+ subroutine foo
+ integer a
+ end subroutine foo''')
+ cls = Subroutine_Subprogram
+ a = cls(reader)
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'SUBROUTINE foo\n INTEGER :: a\nEND SUBROUTINE foo')
+
+class test_Subroutine_Stmt(NumpyTestCase): # R1232
+
+ def check_simple(self):
+ cls = Subroutine_Stmt
+ a = cls('subroutine foo')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'SUBROUTINE foo')
+ assert_equal(repr(a),"Subroutine_Stmt(None, Name('foo'), None, None)")
+
+ a = cls('pure subroutine foo')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'PURE SUBROUTINE foo')
+
+ a = cls('pure subroutine foo(a,b)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'PURE SUBROUTINE foo(a, b)')
+
+ a = cls('subroutine foo() bind(c)')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'SUBROUTINE foo BIND(C)')
+
+class test_End_Subroutine_Stmt(NumpyTestCase): # R1234
+
+ def check_simple(self):
+ cls = End_Subroutine_Stmt
+ a = cls('end subroutine foo')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'END SUBROUTINE foo')
+ assert_equal(repr(a),"End_Subroutine_Stmt('SUBROUTINE', Name('foo'))")
+
+ a = cls('end')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'END SUBROUTINE')
+
+ a = cls('endsubroutine')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'END SUBROUTINE')
+
+class test_Return_Stmt(NumpyTestCase): # R1236
+
+ def check_simple(self):
+ cls = Return_Stmt
+ a = cls('return')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a), 'RETURN')
+ assert_equal(repr(a), 'Return_Stmt(None)')
+
+class test_Contains(NumpyTestCase): # R1237
+
+ def check_simple(self):
+ cls = Contains_Stmt
+ a = cls('Contains')
+ assert isinstance(a, cls),`a`
+ assert_equal(str(a),'CONTAINS')
+ assert_equal(repr(a),"Contains_Stmt('CONTAINS')")
+
+if 1:
+ nof_needed_tests = 0
+ nof_needed_match = 0
+ total_needs = 0
+ total_classes = 0
+ for name in dir():
+ obj = eval(name)
+ if not isinstance(obj, ClassType): continue
+ if not issubclass(obj, Base): continue
+ clsname = obj.__name__
+ if clsname.endswith('Base'): continue
+ total_classes += 1
+ subclass_names = obj.__dict__.get('subclass_names',None)
+ use_names = obj.__dict__.get('use_names',None)
+ if not use_names: continue
+ match = obj.__dict__.get('match',None)
+ try:
+ test_cls = eval('test_%s' % (clsname))
+ except NameError:
+ test_cls = None
+ total_needs += 1
+ if match is None:
+ if test_cls is None:
+ #print 'Needs tests:', clsname
+ print 'Needs match implementation:', clsname
+ nof_needed_tests += 1
+ nof_needed_match += 1
+ else:
+ print 'Needs match implementation:', clsname
+ nof_needed_match += 1
+ else:
+ if test_cls is None:
+ #print 'Needs tests:', clsname
+ nof_needed_tests += 1
+ continue
+ print '-----'
+ print 'Nof match implementation needs:',nof_needed_match,'out of',total_needs
+ print 'Nof tests needs:',nof_needed_tests,'out of',total_needs
+ print 'Total number of classes:',total_classes
+ print '-----'
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/f2py/lib/parser/test_parser.py b/numpy/f2py/lib/parser/test_parser.py
new file mode 100644
index 000000000..9f1767a1a
--- /dev/null
+++ b/numpy/f2py/lib/parser/test_parser.py
@@ -0,0 +1,496 @@
+"""
+Test parsing single Fortran lines.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: May 2006
+-----
+"""
+
+from numpy.testing import *
+from block_statements import *
+from readfortran import Line, FortranStringReader
+
+
+def parse(cls, line, label='',
+ isfree=True, isstrict=False):
+ if label:
+ line = label + ' : ' + line
+ reader = FortranStringReader(line, isfree, isstrict)
+ item = reader.next()
+ if not cls.match(item.get_line()):
+ raise ValueError, '%r does not match %s pattern' % (line, cls.__name__)
+ stmt = cls(item, item)
+ if stmt.isvalid:
+ r = str(stmt)
+ if not isstrict:
+ r1 = parse(cls, r, isstrict=True)
+ if r != r1:
+ raise ValueError, 'Failed to parse %r with %s pattern in pyf mode, got %r' % (r, cls.__name__, r1)
+ return r
+ raise ValueError, 'parsing %r with %s pattern failed' % (line, cls.__name__)
+
+class test_Statements(NumpyTestCase):
+
+ def check_assignment(self):
+ assert_equal(parse(Assignment,'a=b'), 'a = b')
+ assert_equal(parse(PointerAssignment,'a=>b'), 'a => b')
+ assert_equal(parse(Assignment,'a (2)=b(n,m)'), 'a(2) = b(n,m)')
+ assert_equal(parse(Assignment,'a % 2(2,4)=b(a(i))'), 'a%2(2,4) = b(a(i))')
+
+ def check_assign(self):
+ assert_equal(parse(Assign,'assign 10 to a'),'ASSIGN 10 TO a')
+
+ def check_call(self):
+ assert_equal(parse(Call,'call a'),'CALL a')
+ assert_equal(parse(Call,'call a()'),'CALL a')
+ assert_equal(parse(Call,'call a(1)'),'CALL a(1)')
+ assert_equal(parse(Call,'call a(1,2)'),'CALL a(1, 2)')
+ assert_equal(parse(Call,'call a % 2 ( n , a+1 )'),'CALL a % 2(n, a+1)')
+
+ def check_goto(self):
+ assert_equal(parse(Goto,'go to 19'),'GO TO 19')
+ assert_equal(parse(Goto,'goto 19'),'GO TO 19')
+ assert_equal(parse(ComputedGoto,'goto (1, 2 ,3) a+b(2)'),
+ 'GO TO (1, 2, 3) a+b(2)')
+ assert_equal(parse(ComputedGoto,'goto (1, 2 ,3) , a+b(2)'),
+ 'GO TO (1, 2, 3) a+b(2)')
+ assert_equal(parse(AssignedGoto,'goto a'),'GO TO a')
+ assert_equal(parse(AssignedGoto,'goto a ( 1 )'),'GO TO a (1)')
+ assert_equal(parse(AssignedGoto,'goto a ( 1 ,2)'),'GO TO a (1, 2)')
+
+ def check_continue(self):
+ assert_equal(parse(Continue,'continue'),'CONTINUE')
+
+ def check_return(self):
+ assert_equal(parse(Return,'return'),'RETURN')
+ assert_equal(parse(Return,'return a'),'RETURN a')
+ assert_equal(parse(Return,'return a+1'),'RETURN a+1')
+ assert_equal(parse(Return,'return a(c, a)'),'RETURN a(c, a)')
+
+ def check_stop(self):
+ assert_equal(parse(Stop,'stop'),'STOP')
+ assert_equal(parse(Stop,'stop 1'),'STOP 1')
+ assert_equal(parse(Stop,'stop "a"'),'STOP "a"')
+ assert_equal(parse(Stop,'stop "a b"'),'STOP "a b"')
+
+ def check_print(self):
+ assert_equal(parse(Print, 'print*'),'PRINT *')
+ assert_equal(parse(Print, 'print "a b( c )"'),'PRINT "a b( c )"')
+ assert_equal(parse(Print, 'print 12, a'),'PRINT 12, a')
+ assert_equal(parse(Print, 'print 12, a , b'),'PRINT 12, a, b')
+ assert_equal(parse(Print, 'print 12, a(c,1) , b'),'PRINT 12, a(c,1), b')
+
+ def check_read(self):
+ assert_equal(parse(Read, 'read ( 10 )'),'READ (10)')
+ assert_equal(parse(Read, 'read ( 10 ) a '),'READ (10) a')
+ assert_equal(parse(Read, 'read ( 10 ) a , b'),'READ (10) a, b')
+ assert_equal(parse(Read, 'read *'),'READ *')
+ assert_equal(parse(Read, 'read 12'),'READ 12')
+ assert_equal(parse(Read, 'read "a b"'),'READ "a b"')
+ assert_equal(parse(Read, 'read "a b",a'),'READ "a b", a')
+ assert_equal(parse(Read, 'read * , a'),'READ *, a')
+ assert_equal(parse(Read, 'read "hey a" , a'),'READ "hey a", a')
+ assert_equal(parse(Read, 'read * , a , b'),'READ *, a, b')
+ assert_equal(parse(Read, 'read ( unit =10 )'),'READ (UNIT = 10)')
+
+ def check_write(self):
+ assert_equal(parse(Write, 'write ( 10 )'),'WRITE (10)')
+ assert_equal(parse(Write, 'write ( 10 , a )'),'WRITE (10, a)')
+ assert_equal(parse(Write, 'write ( 10 ) b'),'WRITE (10) b')
+ assert_equal(parse(Write, 'write ( 10 ) a(1) , b+2'),'WRITE (10) a(1), b+2')
+ assert_equal(parse(Write, 'write ( unit=10 )'),'WRITE (UNIT = 10)')
+
+ def check_flush(self):
+ assert_equal(parse(Flush, 'flush 10'),'FLUSH (10)')
+ assert_equal(parse(Flush, 'flush (10)'),'FLUSH (10)')
+ assert_equal(parse(Flush, 'flush (UNIT = 10)'),'FLUSH (UNIT = 10)')
+ assert_equal(parse(Flush, 'flush (10, err= 23)'),'FLUSH (10, ERR = 23)')
+
+ def check_wait(self):
+ assert_equal(parse(Wait, 'wait(10)'),'WAIT (10)')
+ assert_equal(parse(Wait, 'wait(10,err=129)'),'WAIT (10, ERR = 129)')
+
+ def check_contains(self):
+ assert_equal(parse(Contains, 'contains'),'CONTAINS')
+
+ def check_allocate(self):
+ assert_equal(parse(Allocate, 'allocate (a)'), 'ALLOCATE (a)')
+ assert_equal(parse(Allocate, \
+ 'allocate (a, stat=b)'), 'ALLOCATE (a, STAT = b)')
+ assert_equal(parse(Allocate, 'allocate (a,b(:1))'), 'ALLOCATE (a, b(:1))')
+ assert_equal(parse(Allocate, \
+ 'allocate (real(8)::a)'), 'ALLOCATE (REAL(KIND=8) :: a)')
+ def check_deallocate(self):
+ assert_equal(parse(Deallocate, 'deallocate (a)'), 'DEALLOCATE (a)')
+ assert_equal(parse(Deallocate, 'deallocate (a, stat=b)'), 'DEALLOCATE (a, STAT = b)')
+
+ def check_moduleprocedure(self):
+ assert_equal(parse(ModuleProcedure,\
+ 'ModuleProcedure a'), 'MODULE PROCEDURE a')
+ assert_equal(parse(ModuleProcedure,\
+ 'module procedure a , b'), 'MODULE PROCEDURE a, b')
+
+ def check_access(self):
+ assert_equal(parse(Public,'Public'),'PUBLIC')
+ assert_equal(parse(Public,'public a'),'PUBLIC a')
+ assert_equal(parse(Public,'public :: a'),'PUBLIC a')
+ assert_equal(parse(Public,'public a,b,c'),'PUBLIC a, b, c')
+ assert_equal(parse(Public,'public :: a(:,:)'),'PUBLIC a(:,:)')
+ assert_equal(parse(Private,'private'),'PRIVATE')
+ assert_equal(parse(Private,'private :: a'),'PRIVATE a')
+
+ def check_close(self):
+ assert_equal(parse(Close,'close (12)'),'CLOSE (12)')
+ assert_equal(parse(Close,'close (12, err=99)'),'CLOSE (12, ERR = 99)')
+ assert_equal(parse(Close,'close (12, status = a(1,2))'),'CLOSE (12, STATUS = a(1,2))')
+
+ def check_cycle(self):
+ assert_equal(parse(Cycle,'cycle'),'CYCLE')
+ assert_equal(parse(Cycle,'cycle ab'),'CYCLE ab')
+
+ def check_rewind(self):
+ assert_equal(parse(Rewind,'rewind 1'),'REWIND (1)')
+ assert_equal(parse(Rewind,'rewind (1)'),'REWIND (1)')
+ assert_equal(parse(Rewind,'rewind (1, err = 123)'),'REWIND (1, ERR = 123)')
+
+ def check_backspace(self):
+ assert_equal(parse(Backspace,'backspace 1'),'BACKSPACE (1)')
+ assert_equal(parse(Backspace,'backspace (1)'),'BACKSPACE (1)')
+ assert_equal(parse(Backspace,'backspace (1, err = 123)'),'BACKSPACE (1, ERR = 123)')
+
+ def check_endfile(self):
+ assert_equal(parse(Endfile,'endfile 1'),'ENDFILE (1)')
+ assert_equal(parse(Endfile,'endfile (1)'),'ENDFILE (1)')
+ assert_equal(parse(Endfile,'endfile (1, err = 123)'),'ENDFILE (1, ERR = 123)')
+
+ def check_open(self):
+ assert_equal(parse(Open,'open (1)'),'OPEN (1)')
+ assert_equal(parse(Open,'open (1, err = 123)'),'OPEN (1, ERR = 123)')
+
+ def check_format(self):
+ assert_equal(parse(Format,'1: format ()'),'1: FORMAT ()')
+ assert_equal(parse(Format,'199 format (1)'),'199: FORMAT (1)')
+ assert_equal(parse(Format,'2 format (1 , SS)'),'2: FORMAT (1, ss)')
+
+ def check_save(self):
+ assert_equal(parse(Save,'save'), 'SAVE')
+ assert_equal(parse(Save,'save :: a'), 'SAVE a')
+ assert_equal(parse(Save,'save a,b'), 'SAVE a, b')
+
+ def check_data(self):
+ assert_equal(parse(Data,'data a /b/'), 'DATA a / b /')
+ assert_equal(parse(Data,'data a , c /b/'), 'DATA a, c / b /')
+ assert_equal(parse(Data,'data a /b ,c/'), 'DATA a / b, c /')
+ assert_equal(parse(Data,'data a /b/ c,e /d/'), 'DATA a / b / c, e / d /')
+ assert_equal(parse(Data,'data a(1,2) /b/'), 'DATA a(1,2) / b /')
+ assert_equal(parse(Data,'data a /b, c(1)/'), 'DATA a / b, c(1) /')
+
+ def check_nullify(self):
+ assert_equal(parse(Nullify,'nullify(a)'),'NULLIFY (a)')
+ assert_equal(parse(Nullify,'nullify(a ,b)'),'NULLIFY (a, b)')
+
+ def check_use(self):
+ assert_equal(parse(Use, 'use a'), 'USE a')
+ assert_equal(parse(Use, 'use :: a'), 'USE a')
+ assert_equal(parse(Use, 'use, intrinsic:: a'), 'USE INTRINSIC :: a')
+ assert_equal(parse(Use, 'use :: a ,only: b'), 'USE a, ONLY: b')
+ assert_equal(parse(Use, 'use :: a , only: b=>c'), 'USE a, ONLY: b=>c')
+ assert_equal(parse(Use, 'use :: a , b=>c'), 'USE a, b=>c')
+ assert_equal(parse(Use,\
+ 'use :: a , only: operator(+) , b'),\
+ 'USE a, ONLY: operator(+), b')
+
+ def check_exit(self):
+ assert_equal(parse(Exit,'exit'),'EXIT')
+ assert_equal(parse(Exit,'exit ab'),'EXIT ab')
+
+ def check_parameter(self):
+ assert_equal(parse(Parameter,'parameter (a = b(1,2))'),
+ 'PARAMETER (a = b(1,2))')
+ assert_equal(parse(Parameter,'parameter (a = b(1,2) , b=1)'),
+ 'PARAMETER (a = b(1,2), b=1)')
+
+ def check_equivalence(self):
+ assert_equal(parse(Equivalence,'equivalence (a , b)'),'EQUIVALENCE (a, b)')
+ assert_equal(parse(Equivalence,'equivalence (a , b) , ( c, d(1) , g )'),
+ 'EQUIVALENCE (a, b), (c, d(1), g)')
+
+ def check_dimension(self):
+ assert_equal(parse(Dimension,'dimension a(b)'),'DIMENSION a(b)')
+ assert_equal(parse(Dimension,'dimension::a(b)'),'DIMENSION a(b)')
+ assert_equal(parse(Dimension,'dimension a(b) , c(d)'),'DIMENSION a(b), c(d)')
+ assert_equal(parse(Dimension,'dimension a(b,c)'),'DIMENSION a(b,c)')
+
+ def check_target(self):
+ assert_equal(parse(Target,'target a(b)'),'TARGET a(b)')
+ assert_equal(parse(Target,'target::a(b)'),'TARGET a(b)')
+ assert_equal(parse(Target,'target a(b) , c(d)'),'TARGET a(b), c(d)')
+ assert_equal(parse(Target,'target a(b,c)'),'TARGET a(b,c)')
+
+ def check_pointer(self):
+ assert_equal(parse(Pointer,'pointer a=b'),'POINTER a=b')
+ assert_equal(parse(Pointer,'pointer :: a=b'),'POINTER a=b')
+ assert_equal(parse(Pointer,'pointer a=b, c=d(1,2)'),'POINTER a=b, c=d(1,2)')
+
+ def check_protected(self):
+ assert_equal(parse(Protected,'protected a'),'PROTECTED a')
+ assert_equal(parse(Protected,'protected::a'),'PROTECTED a')
+ assert_equal(parse(Protected,'protected a , b'),'PROTECTED a, b')
+
+ def check_volatile(self):
+ assert_equal(parse(Volatile,'volatile a'),'VOLATILE a')
+ assert_equal(parse(Volatile,'volatile::a'),'VOLATILE a')
+ assert_equal(parse(Volatile,'volatile a , b'),'VOLATILE a, b')
+
+ def check_value(self):
+ assert_equal(parse(Value,'value a'),'VALUE a')
+ assert_equal(parse(Value,'value::a'),'VALUE a')
+ assert_equal(parse(Value,'value a , b'),'VALUE a, b')
+
+ def check_arithmeticif(self):
+ assert_equal(parse(ArithmeticIf,'if (a) 1,2,3'),'IF (a) 1, 2, 3')
+ assert_equal(parse(ArithmeticIf,'if (a(1)) 1,2,3'),'IF (a(1)) 1, 2, 3')
+ assert_equal(parse(ArithmeticIf,'if (a(1,2)) 1,2,3'),'IF (a(1,2)) 1, 2, 3')
+
+ def check_intrinsic(self):
+ assert_equal(parse(Intrinsic,'intrinsic a'),'INTRINSIC a')
+ assert_equal(parse(Intrinsic,'intrinsic::a'),'INTRINSIC a')
+ assert_equal(parse(Intrinsic,'intrinsic a , b'),'INTRINSIC a, b')
+
+ def check_inquire(self):
+ assert_equal(parse(Inquire, 'inquire (1)'),'INQUIRE (1)')
+ assert_equal(parse(Inquire, 'inquire (1, err=123)'),'INQUIRE (1, ERR = 123)')
+ assert_equal(parse(Inquire, 'inquire (iolength=a) b'),'INQUIRE (IOLENGTH = a) b')
+ assert_equal(parse(Inquire, 'inquire (iolength=a) b ,c(1,2)'),
+ 'INQUIRE (IOLENGTH = a) b, c(1,2)')
+
+ def check_sequence(self):
+ assert_equal(parse(Sequence, 'sequence'),'SEQUENCE')
+
+ def check_external(self):
+ assert_equal(parse(External,'external a'),'EXTERNAL a')
+ assert_equal(parse(External,'external::a'),'EXTERNAL a')
+ assert_equal(parse(External,'external a , b'),'EXTERNAL a, b')
+
+ def check_common(self):
+ assert_equal(parse(Common, 'common a'),'COMMON a')
+ assert_equal(parse(Common, 'common a , b'),'COMMON a, b')
+ assert_equal(parse(Common, 'common a , b(1,2)'),'COMMON a, b(1,2)')
+ assert_equal(parse(Common, 'common // a'),'COMMON a')
+ assert_equal(parse(Common, 'common / name/ a'),'COMMON / name / a')
+ assert_equal(parse(Common, 'common / name/ a , c'),'COMMON / name / a, c')
+ assert_equal(parse(Common, 'common / name/ a /foo/ c(1) ,d'),
+ 'COMMON / name / a / foo / c(1), d')
+ assert_equal(parse(Common, 'common / name/ a, /foo/ c(1) ,d'),
+ 'COMMON / name / a / foo / c(1), d')
+
+ def check_optional(self):
+ assert_equal(parse(Optional,'optional a'),'OPTIONAL a')
+ assert_equal(parse(Optional,'optional::a'),'OPTIONAL a')
+ assert_equal(parse(Optional,'optional a , b'),'OPTIONAL a, b')
+
+ def check_intent(self):
+ assert_equal(parse(Intent,'intent (in) a'),'INTENT (IN) a')
+ assert_equal(parse(Intent,'intent(in)::a'),'INTENT (IN) a')
+ assert_equal(parse(Intent,'intent(in) a , b'),'INTENT (IN) a, b')
+ assert_equal(parse(Intent,'intent (in, out) a'),'INTENT (IN, OUT) a')
+
+ def check_entry(self):
+ assert_equal(parse(Entry,'entry a'), 'ENTRY a')
+ assert_equal(parse(Entry,'entry a()'), 'ENTRY a')
+ assert_equal(parse(Entry,'entry a(b)'), 'ENTRY a (b)')
+ assert_equal(parse(Entry,'entry a(b,*)'), 'ENTRY a (b, *)')
+ assert_equal(parse(Entry,'entry a bind(c , name="a b")'),
+ 'ENTRY a BIND (C, NAME = "a b")')
+ assert_equal(parse(Entry,'entry a result (b)'), 'ENTRY a RESULT (b)')
+ assert_equal(parse(Entry,'entry a bind(d) result (b)'),
+ 'ENTRY a RESULT (b) BIND (D)')
+ assert_equal(parse(Entry,'entry a result (b) bind( c )'),
+ 'ENTRY a RESULT (b) BIND (C)')
+ assert_equal(parse(Entry,'entry a(b,*) result (g)'),
+ 'ENTRY a (b, *) RESULT (g)')
+
+ def check_import(self):
+ assert_equal(parse(Import,'import'),'IMPORT')
+ assert_equal(parse(Import,'import a'),'IMPORT a')
+ assert_equal(parse(Import,'import::a'),'IMPORT a')
+ assert_equal(parse(Import,'import a , b'),'IMPORT a, b')
+
+ def check_forall(self):
+ assert_equal(parse(ForallStmt,'forall (i = 1:n(k,:) : 2) a(i) = i*i*b(i)'),
+ 'FORALL (i = 1 : n(k,:) : 2) a(i) = i*i*b(i)')
+ assert_equal(parse(ForallStmt,'forall (i=1:n,j=2:3) a(i) = b(i,i)'),
+ 'FORALL (i = 1 : n, j = 2 : 3) a(i) = b(i,i)')
+ assert_equal(parse(ForallStmt,'forall (i=1:n,j=2:3, 1+a(1,2)) a(i) = b(i,i)'),
+ 'FORALL (i = 1 : n, j = 2 : 3, 1+a(1,2)) a(i) = b(i,i)')
+
+ def check_specificbinding(self):
+ assert_equal(parse(SpecificBinding,'procedure a'),'PROCEDURE a')
+ assert_equal(parse(SpecificBinding,'procedure :: a'),'PROCEDURE a')
+ assert_equal(parse(SpecificBinding,'procedure , NOPASS :: a'),'PROCEDURE , NOPASS :: a')
+ assert_equal(parse(SpecificBinding,'procedure , public, pass(x ) :: a'),'PROCEDURE , PUBLIC, PASS (x) :: a')
+ assert_equal(parse(SpecificBinding,'procedure(n) a'),'PROCEDURE (n) a')
+ assert_equal(parse(SpecificBinding,'procedure(n),pass :: a'),
+ 'PROCEDURE (n) , PASS :: a')
+ assert_equal(parse(SpecificBinding,'procedure(n) :: a'),
+ 'PROCEDURE (n) a')
+ assert_equal(parse(SpecificBinding,'procedure a= >b'),'PROCEDURE a => b')
+ assert_equal(parse(SpecificBinding,'procedure(n),pass :: a =>c'),
+ 'PROCEDURE (n) , PASS :: a => c')
+
+ def check_genericbinding(self):
+ assert_equal(parse(GenericBinding,'generic :: a=>b'),'GENERIC :: a => b')
+ assert_equal(parse(GenericBinding,'generic, public :: a=>b'),'GENERIC, PUBLIC :: a => b')
+ assert_equal(parse(GenericBinding,'generic, public :: a(1,2)=>b ,c'),
+ 'GENERIC, PUBLIC :: a(1,2) => b, c')
+
+ def check_finalbinding(self):
+ assert_equal(parse(FinalBinding,'final a'),'FINAL a')
+ assert_equal(parse(FinalBinding,'final::a'),'FINAL a')
+ assert_equal(parse(FinalBinding,'final a , b'),'FINAL a, b')
+
+ def check_allocatable(self):
+ assert_equal(parse(Allocatable,'allocatable a'),'ALLOCATABLE a')
+ assert_equal(parse(Allocatable,'allocatable :: a'),'ALLOCATABLE a')
+ assert_equal(parse(Allocatable,'allocatable a (1,2)'),'ALLOCATABLE a (1,2)')
+ assert_equal(parse(Allocatable,'allocatable a (1,2) ,b'),'ALLOCATABLE a (1,2), b')
+
+ def check_asynchronous(self):
+ assert_equal(parse(Asynchronous,'asynchronous a'),'ASYNCHRONOUS a')
+ assert_equal(parse(Asynchronous,'asynchronous::a'),'ASYNCHRONOUS a')
+ assert_equal(parse(Asynchronous,'asynchronous a , b'),'ASYNCHRONOUS a, b')
+
+ def check_bind(self):
+ assert_equal(parse(Bind,'bind(c) a'),'BIND (C) a')
+ assert_equal(parse(Bind,'bind(c) :: a'),'BIND (C) a')
+ assert_equal(parse(Bind,'bind(c) a ,b'),'BIND (C) a, b')
+ assert_equal(parse(Bind,'bind(c) /a/'),'BIND (C) / a /')
+ assert_equal(parse(Bind,'bind(c) /a/ ,b'),'BIND (C) / a /, b')
+ assert_equal(parse(Bind,'bind(c,name="hey") a'),'BIND (C, NAME = "hey") a')
+
+ def check_else(self):
+ assert_equal(parse(Else,'else'),'ELSE')
+ assert_equal(parse(ElseIf,'else if (a) then'),'ELSE IF (a) THEN')
+ assert_equal(parse(ElseIf,'else if (a.eq.b(1,2)) then'),
+ 'ELSE IF (a.eq.b(1,2)) THEN')
+
+ def check_case(self):
+ assert_equal(parse(Case,'case (1)'),'CASE ( 1 )')
+ assert_equal(parse(Case,'case (1:)'),'CASE ( 1 : )')
+ assert_equal(parse(Case,'case (:1)'),'CASE ( : 1 )')
+ assert_equal(parse(Case,'case (1:2)'),'CASE ( 1 : 2 )')
+ assert_equal(parse(Case,'case (a(1,2))'),'CASE ( a(1,2) )')
+ assert_equal(parse(Case,'case ("ab")'),'CASE ( "ab" )')
+ assert_equal(parse(Case,'case default'),'CASE DEFAULT')
+ assert_equal(parse(Case,'case (1:2 ,3:4)'),'CASE ( 1 : 2, 3 : 4 )')
+ assert_equal(parse(Case,'case (a(1,:):)'),'CASE ( a(1,:) : )')
+ assert_equal(parse(Case,'case default'),'CASE DEFAULT')
+
+ def check_where(self):
+ assert_equal(parse(WhereStmt,'where (1) a=1'),'WHERE ( 1 ) a = 1')
+ assert_equal(parse(WhereStmt,'where (a(1,2)) a=1'),'WHERE ( a(1,2) ) a = 1')
+
+ def check_elsewhere(self):
+ assert_equal(parse(ElseWhere,'else where'),'ELSE WHERE')
+ assert_equal(parse(ElseWhere,'elsewhere (1)'),'ELSE WHERE ( 1 )')
+ assert_equal(parse(ElseWhere,'elsewhere(a(1,2))'),'ELSE WHERE ( a(1,2) )')
+
+ def check_enumerator(self):
+ assert_equal(parse(Enumerator,'enumerator a'), 'ENUMERATOR a')
+ assert_equal(parse(Enumerator,'enumerator:: a'), 'ENUMERATOR a')
+ assert_equal(parse(Enumerator,'enumerator a,b'), 'ENUMERATOR a, b')
+ assert_equal(parse(Enumerator,'enumerator a=1'), 'ENUMERATOR a=1')
+ assert_equal(parse(Enumerator,'enumerator a=1 , b=c(1,2)'), 'ENUMERATOR a=1, b=c(1,2)')
+
+ def check_fortranname(self):
+ assert_equal(parse(FortranName,'fortranname a'),'FORTRANNAME a')
+
+ def check_threadsafe(self):
+ assert_equal(parse(Threadsafe,'threadsafe'),'THREADSAFE')
+
+ def check_depend(self):
+ assert_equal(parse(Depend,'depend( a) b'), 'DEPEND ( a ) b')
+ assert_equal(parse(Depend,'depend( a) ::b'), 'DEPEND ( a ) b')
+ assert_equal(parse(Depend,'depend( a,c) b,e'), 'DEPEND ( a, c ) b, e')
+
+ def check_check(self):
+ assert_equal(parse(Check,'check(1) a'), 'CHECK ( 1 ) a')
+ assert_equal(parse(Check,'check(1) :: a'), 'CHECK ( 1 ) a')
+ assert_equal(parse(Check,'check(b(1,2)) a'), 'CHECK ( b(1,2) ) a')
+ assert_equal(parse(Check,'check(a>1) :: a'), 'CHECK ( a>1 ) a')
+
+ def check_callstatement(self):
+ assert_equal(parse(CallStatement,'callstatement (*func)()',isstrict=1),
+ 'CALLSTATEMENT (*func)()')
+ assert_equal(parse(CallStatement,'callstatement i=1;(*func)()',isstrict=1),
+ 'CALLSTATEMENT i=1;(*func)()')
+
+ def check_callprotoargument(self):
+ assert_equal(parse(CallProtoArgument,'callprotoargument int(*), double'),
+ 'CALLPROTOARGUMENT int(*), double')
+
+ def check_pause(self):
+ assert_equal(parse(Pause,'pause'),'PAUSE')
+ assert_equal(parse(Pause,'pause 1'),'PAUSE 1')
+ assert_equal(parse(Pause,'pause "hey"'),'PAUSE "hey"')
+ assert_equal(parse(Pause,'pause "hey pa"'),'PAUSE "hey pa"')
+
+ def check_integer(self):
+ assert_equal(parse(Integer,'integer'),'INTEGER')
+ assert_equal(parse(Integer,'integer*4'),'INTEGER*4')
+ assert_equal(parse(Integer,'integer*4 a'),'INTEGER*4 a')
+ assert_equal(parse(Integer,'integer*4, a'),'INTEGER*4 a')
+ assert_equal(parse(Integer,'integer*4 a ,b'),'INTEGER*4 a, b')
+ assert_equal(parse(Integer,'integer*4 :: a ,b'),'INTEGER*4 a, b')
+ assert_equal(parse(Integer,'integer*4 a(1,2)'),'INTEGER*4 a(1,2)')
+ assert_equal(parse(Integer,'integer*4 :: a(1,2),b'),'INTEGER*4 a(1,2), b')
+ assert_equal(parse(Integer,'integer*4 external :: a'),
+ 'INTEGER*4, external :: a')
+ assert_equal(parse(Integer,'integer*4, external :: a'),
+ 'INTEGER*4, external :: a')
+ assert_equal(parse(Integer,'integer*4 external , intent(in) :: a'),
+ 'INTEGER*4, external, intent(in) :: a')
+ assert_equal(parse(Integer,'integer(kind=4)'),'INTEGER(KIND=4)')
+ assert_equal(parse(Integer,'integer ( kind = 4)'),'INTEGER(KIND=4)')
+ assert_equal(parse(Integer,'integer(kind=2+2)'),'INTEGER(KIND=2+2)')
+ assert_equal(parse(Integer,'integer(kind=f(4,5))'),'INTEGER(KIND=f(4,5))')
+
+ def check_character(self):
+ assert_equal(parse(Character,'character'),'CHARACTER')
+ assert_equal(parse(Character,'character*2'),'CHARACTER(LEN=2)')
+ assert_equal(parse(Character,'character**'),'CHARACTER(LEN=*)')
+ assert_equal(parse(Character,'character*(2)'),'CHARACTER(LEN=2)')
+ assert_equal(parse(Character,'character*(len =2)'),'CHARACTER(LEN=2)')
+ assert_equal(parse(Character,'character*(len =2),'),'CHARACTER(LEN=2)')
+ assert_equal(parse(Character,'character*(len =:)'),'CHARACTER(LEN=:)')
+ assert_equal(parse(Character,'character(len =2)'),'CHARACTER(LEN=2)')
+ assert_equal(parse(Character,'character(2)'),'CHARACTER(LEN=2)')
+ assert_equal(parse(Character,'character(kind=2)'),'CHARACTER(KIND=2)')
+ assert_equal(parse(Character,'character(kind=2,len=3)'),
+ 'CHARACTER(LEN=3, KIND=2)')
+ assert_equal(parse(Character,'character(lEN=3,kind=2)'),
+ 'CHARACTER(LEN=3, KIND=2)')
+ assert_equal(parse(Character,'character(len=3,kind=2)', isstrict=True),
+ 'CHARACTER(LEN=3, KIND=2)')
+ assert_equal(parse(Character,'chaRACTER(len=3,kind=fA(1,2))', isstrict=True),
+ 'CHARACTER(LEN=3, KIND=fA(1,2))')
+ assert_equal(parse(Character,'character(len=3,kind=fA(1,2))'),
+ 'CHARACTER(LEN=3, KIND=fa(1,2))')
+
+ def check_implicit(self):
+ assert_equal(parse(Implicit,'implicit none'),'IMPLICIT NONE')
+ assert_equal(parse(Implicit,'implicit'),'IMPLICIT NONE')
+ assert_equal(parse(Implicit,'implicit integer (i-m)'),
+ 'IMPLICIT INTEGER ( i-m )')
+ assert_equal(parse(Implicit,'implicit integer (i-m,p,q-r)'),
+ 'IMPLICIT INTEGER ( i-m, p, q-r )')
+ assert_equal(parse(Implicit,'implicit integer (i-m), real (z)'),
+ 'IMPLICIT INTEGER ( i-m ), REAL ( z )')
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/f2py/lib/parser/typedecl_statements.py b/numpy/f2py/lib/parser/typedecl_statements.py
new file mode 100644
index 000000000..7414a6d2d
--- /dev/null
+++ b/numpy/f2py/lib/parser/typedecl_statements.py
@@ -0,0 +1,563 @@
+"""
+Fortran type declaration statements.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: May 2006
+-----
+"""
+
+__all__ = ['Integer', 'Real', 'DoublePrecision', 'Complex', 'DoubleComplex',
+ 'Character', 'Logical', 'Byte', 'TypeStmt','Class',
+ 'intrinsic_type_spec', 'declaration_type_spec',
+ 'Implicit']
+
+import re
+import string
+from base_classes import Statement, BeginStatement, EndStatement,\
+ AttributeHolder, Variable
+from utils import split_comma, AnalyzeError, name_re, is_entity_decl, is_name, CHAR_BIT, parse_array_spec
+
+# Intrinsic type specification statements
+
+class TypeDeclarationStatement(Statement):
+ """
+ <declaration-type-spec> [ [, <attr-spec>] :: ] <entity-decl-list>
+ <declaration-type-spec> = <intrinsic-type-spec>
+ | TYPE ( <derived-type-spec> )
+ | CLASS ( <derived-type-spec> )
+ | CLASS ( * )
+
+ <derived-type-spec> = <type-name> [ ( <type-param-spec-list> ) ]
+ <type-param-spec> = [ <keyword> = ] <type-param-value>
+ <type-param-value> = <scalar-int-expr> | * | :
+
+ <intrinsic-type-spec> = INTEGER [<kind-selector>]
+ | REAL [<kind-selector>]
+ | DOUBLE PRECISION
+ | COMPLEX [<kind-selector>]
+ | CHARACTER [<char-selector>]
+ | LOGICAL [<kind-selector>]
+
+ <kind-selector> = ( [ KIND = ] <scalar-int-initialization-expr> )
+ EXTENSION:
+ <kind-selector> = ( [ KIND = ] <scalar-int-initialization-expr> )
+ | * <length>
+
+ <char-selector> = <length-selector>
+ | ( LEN = <type-param-value>, KIND = <scalar-int-initialization-expr> )
+ | ( <type-param-value>, [ KIND = ] <scalar-int-initialization-expr> )
+ | ( KIND = <scalar-int-initialization-expr> [, LEN = <type-param-value>] )
+ <length-selector> = ( [ LEN = ] <type-param-value> )
+ | * <char-length> [ , ]
+ <char-length> = ( <type-param-value> ) | <scalar-int-literal-constant>
+
+ <attr-spec> = <access-spec> | ALLOCATABLE | ASYNCHRONOUS
+ | DIMENSION ( <array-spec> ) | EXTERNAL
+ | INTENT ( <intent-spec> ) | INTRINSIC
+ | <language-binding-spec> | OPTIONAL
+ | PARAMETER | POINTER | PROTECTED | SAVE
+ | TARGET | VALUE | VOLATILE
+ <entity-decl> = <object-name> [ ( <array-spec> ) ] [ * <char-length> ] [ <initialization> ]
+ | <function-name> [ * <char-length> ]
+ <initialization> = = <initialization-expr>
+ | => NULL
+ <access-spec> = PUBLIC | PRIVATE
+ <language-binding-spec> = BIND ( C [ , NAME = <scalar-char-initialization-expr>] )
+ <array-spec> = <explicit-shape-spec-list>
+ | <assumed-shape-spec-list>
+ | <deferred-shape-spec-list>
+ | <assumed-size-spec>
+ <explicit-shape-spec> = [ <lower-bound> : ] <upper-bound>
+ <assumed-shape-spec> = [ <lower-bound> ] :
+ <deferred-shape-spec> = :
+ <assumed-size-spec> = [ <explicit-shape-spec-list> , ] [ <lower-bound> : ] *
+ <bound> = <specification-expr>
+
+ <int-literal-constant> = <digit-string> [ _ <kind-param> ]
+ <digit-string> = <digit> [ <digit> ]..
+ <kind-param> = <digit-string> | <scalar-int-constant-name>
+ """
+ _repr_attr_names = ['selector','attrspec','entity_decls'] + Statement._repr_attr_names
+
+ def process_item(self):
+ item = self.item
+ apply_map = item.apply_map
+ clsname = self.__class__.__name__.lower()
+ line = item.get_line()
+ from block_statements import Function
+
+ if not line.lower().startswith(clsname):
+ i = 0
+ j = 0
+ for c in line:
+ i += 1
+ if c==' ': continue
+ j += 1
+ if j==len(clsname):
+ break
+ line = line[:i].replace(' ','') + line[i:]
+
+ assert line.lower().startswith(clsname),`line,clsname`
+ line = line[len(clsname):].lstrip()
+
+ if line.startswith('('):
+ i = line.find(')')
+ selector = apply_map(line[:i+1].strip())
+ line = line[i+1:].lstrip()
+ elif line.startswith('*'):
+ selector = '*'
+ line = line[1:].lstrip()
+ if line.startswith('('):
+ i = line.find(')')
+ selector += apply_map(line[:i+1].rstrip())
+ line = line[i+1:].lstrip()
+ else:
+ m = re.match(r'\d+(_\w+|)|[*]',line)
+ if not m:
+ self.isvalid = False
+ return
+ i = m.end()
+ selector += line[:i].rstrip()
+ line = line[i:].lstrip()
+ else:
+ selector = ''
+
+ fm = Function.match(line)
+ if fm:
+ l2 = line[:fm.end()]
+ m2 = re.match(r'.*?\b(?P<name>\w+)\Z',l2)
+ if not m2:
+ self.isvalid = False
+ return
+ fname = m2.group('name')
+ fitem = item.copy(clsname+selector+' :: '+fname,
+ apply_map=True)
+ self.parent.put_item(fitem)
+ item.clone(line)
+ self.isvalid = False
+ return
+
+ if line.startswith(','):
+ line = line[1:].lstrip()
+
+ self.raw_selector = selector
+ if isinstance(self, Character):
+ self.selector = self._parse_char_selector(selector)
+ else:
+ self.selector = self._parse_kind_selector(selector)
+
+ i = line.find('::')
+ if i==-1:
+ self.attrspec = []
+ self.entity_decls = split_comma(line, self.item)
+ else:
+ self.attrspec = split_comma(line[:i].rstrip(), self.item)
+ self.entity_decls = split_comma(line[i+2:].lstrip(), self.item)
+ for entity in self.entity_decls:
+ if not is_entity_decl(entity):
+ self.isvalid = False
+ return
+
+ if isinstance(self.parent, Function) \
+ and self.parent.name in self.entity_decls:
+ assert self.parent.typedecl is None,`self.parent.typedecl`
+ self.parent.typedecl = self
+ self.ignore = True
+ if isinstance(self, Type):
+ self.name = self.selector[1].lower()
+ assert is_name(self.name),`self.name`
+ else:
+ self.name = clsname
+ return
+
+ def _parse_kind_selector(self, selector):
+ if not selector:
+ return '',''
+ length,kind = '',''
+ if selector.startswith('*'):
+ length = selector[1:].lstrip()
+ else:
+ assert selector[0]+selector[-1]=='()',`selector`
+ l = selector[1:-1].strip()
+ if l.lower().startswith('kind'):
+ l = l[4:].lstrip()
+ assert l.startswith('='),`l`
+ kind = l[1:].lstrip()
+ else:
+ kind = l
+ return length,kind
+
+ def _parse_char_selector(self, selector):
+ if not selector:
+ return '',''
+ if selector.startswith('*'):
+ l = selector[1:].lstrip()
+ if l.startswith('('):
+ if l.endswith(','): l = l[:-1].rstrip()
+ assert l.endswith(')'),`l`
+ l = l[1:-1].strip()
+ if l.lower().startswith('len'):
+ l = l[3:].lstrip()[1:].lstrip()
+ kind=''
+ else:
+ assert selector[0]+selector[-1]=='()',`selector`
+ l = split_comma(selector[1:-1].strip(), self.item)
+ if len(l)==1:
+ l = l[0]
+ if l.lower().startswith('len'):
+ l=l[3:].lstrip()
+ assert l.startswith('='),`l`
+ l=l[1:].lstrip()
+ kind = ''
+ elif l.lower().startswith('kind'):
+ kind = l[4:].lstrip()[1:].lstrip()
+ l = ''
+ else:
+ kind = ''
+ else:
+ assert len(l)==2
+ if l[0].lower().startswith('len'):
+ assert l[1].lower().startswith('kind'),`l`
+ kind = l[1][4:].lstrip()[1:].lstrip()
+ l = l[0][3:].lstrip()[1:].lstrip()
+ elif l[0].lower().startswith('kind'):
+ assert l[1].lower().startswith('len'),`l`
+ kind = l[0][4:].lstrip()[1:].lstrip()
+ l = l[1][3:].lstrip()[1:].lstrip()
+ else:
+ if l[1].lower().startswith('kind'):
+ kind = l[1][4:].lstrip()[1:].lstrip()
+ l = l[0]
+ else:
+ kind = l[1]
+ l = l[0]
+ return l,kind
+
+ def tostr(self):
+ clsname = self.__class__.__name__.upper()
+ s = ''
+ length, kind = self.selector
+ if isinstance(self, Character):
+ if length and kind:
+ s += '(LEN=%s, KIND=%s)' % (length,kind)
+ elif length:
+ s += '(LEN=%s)' % (length)
+ elif kind:
+ s += '(KIND=%s)' % (kind)
+ else:
+ if isinstance(self, Type):
+ s += '(%s)' % (kind)
+ else:
+ if length:
+ s += '*%s' % (length)
+ if kind:
+ s += '(KIND=%s)' % (kind)
+
+ return clsname + s
+
+ def tofortran(self,isfix=None):
+ tab = self.get_indent_tab(isfix=isfix)
+ s = self.tostr()
+ if self.attrspec:
+ s += ', ' + ', '.join(self.attrspec)
+ if self.entity_decls:
+ s += ' ::'
+ if self.entity_decls:
+ s += ' ' + ', '.join(self.entity_decls)
+ return tab + s
+
+ def __str__(self):
+ return self.tofortran()
+
+ def __eq__(self, other):
+ if self.__class__ is not other.__class__:
+ return False
+ return self.selector==other.selector
+
+ def astypedecl(self):
+ if self.entity_decls or self.attrspec:
+ return self.__class__(self.parent, self.item.copy(self.tostr()))
+ return self
+
+ def analyze(self):
+ if not self.entity_decls:
+ return
+ variables = self.parent.a.variables
+ typedecl = self.astypedecl()
+ attrspec = self.attrspec[:]
+ try:
+ access_spec = [a for a in attrspec if a.lower() in ['private','public']][0]
+ attrspec.remove(access_spec)
+ except IndexError:
+ access_spec = None
+ for item in self.entity_decls:
+ name, array_spec, char_length, value = self._parse_entity(item)
+ var = self.parent.get_variable(name)
+ var.add_parent(self)
+ if char_length:
+ var.set_length(char_length)
+ else:
+ var.set_type(typedecl)
+ var.update(self.attrspec)
+ if array_spec:
+ var.set_bounds(array_spec)
+ if value:
+ var.set_init(value)
+ if access_spec is not None:
+ l = getattr(self.parent.a,access_spec.lower() + '_id_list')
+ l.append(name)
+ var.analyze()
+ return
+
+ def _parse_entity(self, line):
+ m = name_re(line)
+ assert m,`line,self.item,self.__class__.__name__`
+ name = line[:m.end()]
+ line = line[m.end():].lstrip()
+ array_spec = None
+ item = self.item.copy(line)
+ line = item.get_line()
+ if line.startswith('('):
+ i = line.find(')')
+ assert i!=-1,`line`
+ array_spec = parse_array_spec(line[1:i].strip(), item)
+ line = line[i+1:].lstrip()
+ char_length = None
+ if line.startswith('*'):
+ i = line.find('=')
+ if i==-1:
+ char_length = item.apply_map(line[1:].lstrip())
+ line = ''
+ else:
+ char_length = item.apply_map(line[1:i].strip())
+ line = line[i:]
+ value = None
+ if line.startswith('='):
+ value = item.apply_map(line[1:].lstrip())
+ return name, array_spec, char_length, value
+
+ def get_zero_value(self):
+ raise NotImplementedError,`self.__class__.__name__`
+
+ def assign_expression(self, name, value):
+ return '%s = %s' % (name, value)
+
+ def get_kind(self):
+ return self.selector[1] or self.default_kind
+
+ def get_length(self):
+ return self.selector[0] or 1
+
+ def get_byte_size(self):
+ length, kind = self.selector
+ if length: return int(length)
+ if kind: return int(kind)
+ return self.default_kind
+
+ def get_bit_size(self):
+ return CHAR_BIT * int(self.get_byte_size())
+
+ def is_intrinsic(self): return not isinstance(self,(Type,Class))
+ def is_derived(self): return isinstance(self,Type)
+
+ def is_numeric(self): return isinstance(self,(Integer,Real, DoublePrecision,Complex,DoubleComplex,Byte))
+ def is_nonnumeric(self): return isinstance(self,(Character,Logical))
+
+
+class Integer(TypeDeclarationStatement):
+ match = re.compile(r'integer\b',re.I).match
+ default_kind = 4
+
+ def get_zero_value(self):
+ kind = self.get_kind()
+ if kind==self.default_kind: return '0'
+ return '0_%s' % (kind)
+
+class Real(TypeDeclarationStatement):
+ match = re.compile(r'real\b',re.I).match
+ default_kind = 4
+
+ def get_zero_value(self):
+ kind = self.get_kind()
+ if kind==self.default_kind: return '0.0'
+ return '0_%s' % (kind)
+
+class DoublePrecision(TypeDeclarationStatement):
+ match = re.compile(r'double\s*precision\b',re.I).match
+ default_kind = 8
+
+ def get_byte_size(self):
+ return self.default_kind
+
+ def get_zero_value(self):
+ return '0.0D0'
+
+class Complex(TypeDeclarationStatement):
+ match = re.compile(r'complex\b',re.I).match
+ default_kind = 4
+
+ def get_byte_size(self):
+ length, kind = self.selector
+ if length: return int(length)
+ if kind: return 2*int(kind)
+ return 2*self.default_kind
+
+ def get_zero_value(self):
+ kind = self.get_kind()
+ if kind==self.default_kind: return '(0.0, 0.0)'
+ return '(0.0_%s, 0.0_%s)' % (kind, kind)
+
+ def get_part_typedecl(self):
+ bz = self.get_byte_size()/2
+ return Real(self.parent, self.item.copy('REAL*%s' % (bz)))
+
+class DoubleComplex(TypeDeclarationStatement):
+ # not in standard
+ match = re.compile(r'double\s*complex\b',re.I).match
+ default_kind = 8
+
+ def get_byte_size(self):
+ return 2*self.default_kind
+
+ def get_zero_value(self):
+ return '(0.0D0,0.0D0)'
+
+class Logical(TypeDeclarationStatement):
+ match = re.compile(r'logical\b',re.I).match
+ default_kind = 4
+
+ def get_zero_value(self):
+ return ".FALSE."
+
+class Character(TypeDeclarationStatement):
+ match = re.compile(r'character\b',re.I).match
+ default_kind = 1
+
+ def get_bit_size(self):
+ length = self.get_length()
+ if length=='*':
+ return 0 # model for character*(*)
+ return CHAR_BIT * int(length) * int(self.get_kind())
+
+ def get_zero_value(self):
+ return "''"
+
+class Byte(TypeDeclarationStatement):
+ # not in standard
+ match = re.compile(r'byte\b',re.I).match
+ default_kind = 1
+
+ def get_zero_value(self):
+ return '0'
+
+class Type(TypeDeclarationStatement):
+ match = re.compile(r'type\s*\(', re.I).match
+
+ def get_zero_value(self):
+ type_decl = self.get_type_decl(self.name)
+ component_names = type_decl.a.component_names
+ components = type_decl.a.components
+ l = []
+ for name in component_names:
+ var = components[name]
+ l.append(var.typedecl.get_zero_value())
+ return '%s(%s)' % (type_decl.name, ', '.join(l))
+
+ def get_kind(self):
+ # See 4.5.2, page 48
+ raise NotImplementedError,`self.__class__.__name__`
+
+ def get_bit_size(self):
+ return self.get_type_decl(self.name).get_bit_size()
+
+TypeStmt = Type
+
+class Class(TypeDeclarationStatement):
+ match = re.compile(r'class\s*\(', re.I).match
+
+class Implicit(Statement):
+ """
+ IMPLICIT <implicit-spec-list>
+ IMPLICIT NONE
+ <implicit-spec> = <declaration-type-spec> ( <letter-spec-list> )
+ <letter-spec> = <letter> [ - <letter> ]
+ """
+ match = re.compile(r'implicit\b',re.I).match
+
+ letters = string.lowercase
+
+ def process_item(self):
+ line = self.item.get_line()[8:].lstrip()
+ if line.lower()=='none':
+ self.items = []
+ return
+ items = []
+ for item in split_comma(line, self.item):
+ i = item.find('(')
+ assert i!=-1 and item.endswith(')'),`item`
+ specs = []
+ for spec in split_comma(item[i+1:-1].strip(), self.item):
+ if '-' in spec:
+ s,e = spec.lower().split('-')
+ s = s.strip()
+ e = e.strip()
+ assert s in self.letters and e in self.letters,`s,e`
+ else:
+ e = s = spec.lower().strip()
+ assert s in self.letters,`s,e`
+ specs.append((s,e))
+ tspec = item[:i].rstrip()
+ stmt = None
+ for cls in declaration_type_spec:
+ if cls.match(tspec):
+ stmt = cls(self, self.item.copy(tspec))
+ if stmt.isvalid:
+ break
+ assert stmt is not None,`item,line`
+ items.append((stmt,specs))
+ self.items = items
+ return
+
+ def tofortran(self, isfix=None):
+ tab = self.get_indent_tab(isfix=isfix)
+ if not self.items:
+ return tab + 'IMPLICIT NONE'
+ l = []
+ for stmt,specs in self.items:
+ l1 = []
+ for s,e in specs:
+ if s==e:
+ l1.append(s)
+ else:
+ l1.append(s + '-' + e)
+ l.append('%s ( %s )' % (stmt.tostr(), ', '.join(l1)))
+ return tab + 'IMPLICIT ' + ', '.join(l)
+
+ def analyze(self):
+ implicit_rules = self.parent.a.implicit_rules
+ if not self.items:
+ if implicit_rules:
+ self.warning('overriding previously set implicit rule mapping'\
+ ' %r.' % (implicit_rules))
+ self.parent.a.implicit_rules = None
+ return
+ if implicit_rules is None:
+ self.warning('overriding previously set IMPLICIT NONE')
+ self.parent.a.implicit_rules = implicit_rules = {}
+ for stmt,specs in self.items:
+ for s,e in specs:
+ for l in string.lowercase[string.lowercase.index(s.lower()):\
+ string.lowercase.index(e.lower())+1]:
+ implicit_rules[l] = stmt
+ return
+
+intrinsic_type_spec = [ \
+ Integer , Real,
+ DoublePrecision, Complex, DoubleComplex, Character, Logical, Byte
+ ]
+declaration_type_spec = intrinsic_type_spec + [ TypeStmt, Class ]
diff --git a/numpy/f2py/lib/parser/utils.py b/numpy/f2py/lib/parser/utils.py
new file mode 100644
index 000000000..ac2cfce8e
--- /dev/null
+++ b/numpy/f2py/lib/parser/utils.py
@@ -0,0 +1,177 @@
+"""
+Various utility functions.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: May 2006
+-----
+"""
+
+__all__ = ['split_comma', 'specs_split_comma',
+ 'ParseError','AnalyzeError',
+ 'get_module_file','parse_bind','parse_result','is_name','parse_array_spec',
+ 'CHAR_BIT','str2stmt']
+
+import re
+import os, glob
+
+class ParseError(Exception):
+ pass
+
+class AnalyzeError(Exception):
+ pass
+
+is_name = re.compile(r'^[a-z_]\w*$',re.I).match
+name_re = re.compile(r'[a-z_]\w*',re.I).match
+is_entity_decl = re.compile(r'^[a-z_]\w*',re.I).match
+is_int_literal_constant = re.compile(r'^\d+(_\w+|)$').match
+
+def split_comma(line, item = None, comma=',', keep_empty=False):
+ items = []
+ if item is None:
+ for s in line.split(comma):
+ s = s.strip()
+ if not s and not keep_empty: continue
+ items.append(s)
+ return items
+ newitem = item.copy(line, True)
+ apply_map = newitem.apply_map
+ for s in newitem.get_line().split(comma):
+ s = apply_map(s).strip()
+ if not s and not keep_empty: continue
+ items.append(s)
+ return items
+
+def parse_array_spec(line, item = None):
+ items = []
+ for spec in split_comma(line, item):
+ items.append(tuple(split_comma(spec, item, comma=':', keep_empty=True)))
+ return items
+
+def specs_split_comma(line, item = None, upper=False):
+ specs0 = split_comma(line, item)
+ specs = []
+ for spec in specs0:
+ i = spec.find('=')
+ if i!=-1:
+ kw = spec[:i].strip().upper()
+ v = spec[i+1:].strip()
+ specs.append('%s = %s' % (kw, v))
+ else:
+ if upper:
+ spec = spec.upper()
+ specs.append(spec)
+ return specs
+
+def parse_bind(line, item = None):
+ if not line.lower().startswith('bind'):
+ return None, line
+ if item is not None:
+ newitem = item.copy(line, apply_map=True)
+ newline = newitem.get_line()
+ else:
+ newitem = None
+ newline = newline[4:].lstrip()
+ i = newline.find(')')
+ assert i!=-1,`newline`
+ args = []
+ for a in specs_split_comma(newline[1:i].strip(), newitem, upper=True):
+ args.append(a)
+ rest = newline[i+1:].lstrip()
+ if item is not None:
+ rest = newitem.apply_map(rest)
+ return args, rest
+
+def parse_result(line, item = None):
+ if not line.lower().startswith('result'):
+ return None, line
+ line = line[6:].lstrip()
+ i = line.find(')')
+ assert i != -1,`line`
+ name = line[1:i].strip()
+ assert is_name(name),`name`
+ return name, line[i+1:].lstrip()
+
+def filter_stmts(content, classes):
+ """ Pop and return classes instances from content.
+ """
+ stmts = []
+ indices = []
+ for i in range(len(content)):
+ stmt = content[i]
+ if isinstance(stmt, classes):
+ stmts.append(stmt)
+ indices.append(i)
+ indices.reverse()
+ for i in indices:
+ del content[i]
+ return stmts
+
+
+def get_module_files(directory, _cache={}):
+ if _cache.has_key(directory):
+ return _cache[directory]
+ module_line = re.compile(r'(\A|^)module\s+(?P<name>\w+)\s*(!.*|)$',re.I | re.M)
+ d = {}
+ for fn in glob.glob(os.path.join(directory,'*.f90')):
+ f = open(fn,'r')
+ for name in module_line.findall(f.read()):
+ name = name[1]
+ if d.has_key(name):
+ print d[name],'already defines',name
+ continue
+ d[name] = fn
+ _cache[directory] = d
+ return d
+
+def get_module_file(name, directory, _cache={}):
+ fn = _cache.get(name, None)
+ if fn is not None:
+ return fn
+ if name.endswith('_module'):
+ f1 = os.path.join(directory,name[:-7]+'.f90')
+ if os.path.isfile(f1):
+ _cache[name] = fn
+ return f1
+ pattern = re.compile(r'\s*module\s+(?P<name>[a-z]\w*)', re.I).match
+ for fn in glob.glob(os.path.join(directory,'*.f90')):
+ f = open(fn,'r')
+ for line in f:
+ m = pattern(line)
+ if m and m.group('name')==name:
+ _cache[name] = fn
+ f.close()
+ return fn
+ f.close()
+ return
+
+def str2stmt(string, isfree=True, isstrict=False):
+ """ Convert Fortran code to Statement tree.
+ """
+ from readfortran import Line, FortranStringReader
+ from parsefortran import FortranParser
+ reader = FortranStringReader(string, isfree, isstrict)
+ parser = FortranParser(reader)
+ parser.parse()
+ parser.analyze()
+ block = parser.block
+ while len(block.content)==1:
+ block = block.content[0]
+ return block
+
+def get_char_bit():
+ import numpy
+ one = numpy.ubyte(1)
+ two = numpy.ubyte(2)
+ n = numpy.ubyte(2)
+ i = 1
+ while n>=two:
+ n <<= one
+ i += 1
+ return i
+
+CHAR_BIT = get_char_bit()
diff --git a/numpy/f2py/lib/py_wrap.py b/numpy/f2py/lib/py_wrap.py
new file mode 100644
index 000000000..47c8437ad
--- /dev/null
+++ b/numpy/f2py/lib/py_wrap.py
@@ -0,0 +1,128 @@
+__all__ = ['PythonWrapperModule']
+
+import re
+import os
+import sys
+
+from parser.api import *
+from wrapper_base import *
+from py_wrap_type import *
+from py_wrap_subprogram import *
+
+class PythonWrapperModule(WrapperBase):
+
+ main_template = '''\
+#ifdef __cplusplus
+extern \"C\" {
+#endif
+#include "Python.h"
+
+#define PY_ARRAY_UNIQUE_SYMBOL PyArray_API
+#include "numpy/arrayobject.h"
+#include "numpy/arrayscalars.h"
+
+%(header_list)s
+
+%(typedef_list)s
+
+%(extern_list)s
+
+%(c_code_list)s
+
+%(capi_code_list)s
+
+%(objdecl_list)s
+
+static PyObject *f2py_module;
+
+static PyMethodDef f2py_module_methods[] = {
+ %(module_method_list)s
+ {NULL,NULL,0,NULL}
+};
+
+PyMODINIT_FUNC init%(modulename)s(void) {
+ f2py_module = Py_InitModule("%(modulename)s", f2py_module_methods);
+ import_array();
+ if (PyErr_Occurred()) {
+ PyErr_SetString(PyExc_ImportError, "failed to load array module.");
+ goto capi_err;
+ }
+ %(module_init_list)s
+ return;
+capi_err:
+ if (!PyErr_Occurred()) {
+ PyErr_SetString(PyExc_RuntimeError, "failed to initialize %(modulename)s module.");
+ }
+ return;
+}
+#ifdef __cplusplus
+}
+#endif
+'''
+
+ main_fortran_template = '''\
+%(fortran_code_list)s
+'''
+
+
+
+ def __init__(self, modulename):
+ WrapperBase.__init__(self)
+ self.modulename = modulename
+ self.cname = 'f2py_' + modulename
+
+ self.defined_cpp_code = []
+ self.defined_c_code = []
+ self.defined_types = []
+ self.defined_capi_codes = []
+
+
+ self.header_list = []
+ self.typedef_list = []
+ self.extern_list = []
+ self.objdecl_list = []
+ self.c_code_list = []
+ self.capi_code_list = []
+
+ self.module_method_list = []
+ self.module_init_list = []
+
+ self.fortran_code_list = []
+
+ self.list_names = ['header', 'typedef', 'extern', 'objdecl',
+ 'c_code','capi_code','module_method','module_init',
+ 'fortran_code']
+ self.isf90 = False
+ return
+
+ def add(self, block):
+ if isinstance(block, BeginSource):
+ for name, moduleblock in block.a.module.items():
+ self.add(moduleblock)
+ #for name, subblock in block.a.external_subprogram.items():
+ # self.add(subblock)
+ elif isinstance(block, Subroutine):
+ PythonCAPISubProgram(self, block)
+ elif isinstance(block, Function):
+ fcode = block.subroutine_wrapper_code()
+ self.fortran_code_list.append(fcode)
+ wrapper_block = block.subroutine_wrapper()
+ PythonCAPISubProgram(self, wrapper_block)
+ elif isinstance(block, Module):
+ self.isf90 = True
+ for name,declblock in block.a.type_decls.items():
+ self.add(declblock)
+ for name,subblock in block.a.module_subprogram.items():
+ self.add(subblock)
+ elif isinstance(block, tuple([TypeDecl]+declaration_type_spec)):
+ if isinstance(block, (TypeDecl, TypeStmt)):
+ self.isf90 = True
+ PythonCAPIType(self, block)
+ else:
+ raise NotImplementedError,`block.__class__.__name__`
+ return
+
+ def c_code(self):
+ return self.apply_attributes(self.main_template)
+ def fortran_code(self):
+ return self.apply_attributes(self.main_fortran_template)
diff --git a/numpy/f2py/lib/py_wrap_subprogram.py b/numpy/f2py/lib/py_wrap_subprogram.py
new file mode 100644
index 000000000..8dd0c3efb
--- /dev/null
+++ b/numpy/f2py/lib/py_wrap_subprogram.py
@@ -0,0 +1,210 @@
+__all__ = ['PythonCAPISubProgram']
+
+import sys
+
+from parser.api import TypeDecl, TypeStmt, Module
+from wrapper_base import *
+from py_wrap_type import *
+
+class PythonCAPISubProgram(WrapperBase):
+ """
+ Fortran subprogram hooks.
+ """
+
+ header_template_f77 = '''\
+#define %(name)s_f F_FUNC(%(name)s, %(NAME)s)
+'''
+ extern_template_f77 = '''\
+extern void %(name)s_f(%(ctype_args_f_clist)s);
+'''
+ objdecl_template_doc = '''\
+static char %(cname)s__doc[] = "";
+'''
+ module_method_template = '''\
+{"%(pyname)s", (PyCFunction)%(cname)s, METH_VARARGS | METH_KEYWORDS, %(cname)s__doc},'''
+
+ capi_code_template = '''\
+static PyObject* %(cname)s(PyObject *capi_self, PyObject *capi_args, PyObject *capi_keywds) {
+ PyObject * volatile capi_buildvalue = NULL;
+ volatile int f2py_success = 1;
+ %(decl_list)s
+ static char *capi_kwlist[] = {%(kw_clist+optkw_clist+extrakw_clist+["NULL"])s};
+ if (PyArg_ParseTupleAndKeywords(capi_args,capi_keywds,
+ "%(pyarg_format_elist)s",
+ %(["capi_kwlist"]+pyarg_obj_clist)s)) {
+ %(frompyobj_list)s
+ %(call_list)s
+ f2py_success = !PyErr_Occurred();
+ if (f2py_success) {
+ %(pyobjfrom_list)s
+ capi_buildvalue = Py_BuildValue("%(return_format_elist)s"
+ %(return_obj_clist)s);
+ %(clean_pyobjfrom_list)s
+ }
+ %(clean_call_list)s
+ %(clean_frompyobj_list)s
+ }
+ return capi_buildvalue;
+}
+'''
+
+ header_template_module = '''
+#define %(name)s_f (*%(name)s_func_ptr)
+#define %(init_func)s_f F_FUNC(%(init_func)s, %(INIT_FUNC)s)
+'''
+ typedef_template_module = '''
+typedef void (*%(name)s_functype)(%(ctype_args_f_clist)s);
+typedef void (*%(init_func)s_c_functype)(%(name)s_functype);
+'''
+ extern_template_module = '''\
+extern void %(init_func)s_f(%(init_func)s_c_functype);
+static %(name)s_functype %(name)s_func_ptr;
+'''
+ objdecl_template_module = '''
+'''
+ fortran_code_template_module = '''
+ subroutine %(init_func)s(init_func_c)
+ use %(mname)s
+ external init_func_c
+ call init_func_c(%(name)s)
+ end
+'''
+ c_code_template_module = '''
+static void %(init_func)s_c(%(name)s_functype func_ptr) {
+ %(name)s_func_ptr = func_ptr;
+}
+'''
+ module_init_template_module = '''
+%(init_func)s_f(%(init_func)s_c);
+'''
+
+ def __init__(self, parent, block):
+ WrapperBase.__init__(self)
+ self.name = name = pyname = block.name
+ self.cname = cname = '%s_%s' % (parent.cname,name)
+
+ defined = parent.defined_capi_codes
+ if cname in defined:
+ return
+ defined.append(cname)
+
+ self.info('Generating interface for %s %s: %s' % (parent.modulename, block.__class__.__name__, cname))
+ self.parent = parent
+
+ if pyname.startswith('f2pywrap_'):
+ pyname = pyname[9:]
+ self.pyname = pyname
+
+ self.header_template = ''
+ self.extern_template = ''
+ self.module_init_template = ''
+ self.typedef_template = ''
+ self.c_code_template = ''
+ self.objdecl_template = ''
+ self.fortran_code_template = ''
+
+ WrapperCPPMacro(parent, 'F_FUNC')
+
+ if isinstance(block.parent, Module):
+ self.mname = block.parent.name
+ self.init_func = '%s_init' % (name)
+ self.typedef_template += self.typedef_template_module
+ self.header_template += self.header_template_module
+ self.fortran_code_template += self.fortran_code_template_module
+ self.module_init_template += self.module_init_template_module
+ self.objdecl_template += self.objdecl_template_module
+ self.c_code_template += self.c_code_template_module
+ self.extern_template += self.extern_template_module
+ else:
+ self.extern_template += self.extern_template_f77
+ self.header_template += self.header_template_f77
+
+ self.objdecl_template += self.objdecl_template_doc
+
+ self.decl_list = []
+ self.kw_list = []
+ self.optkw_list = []
+ self.extrakw_list = []
+ self.pyarg_format_list = []
+ self.pyarg_obj_list = []
+ self.frompyobj_list = []
+ self.call_list = []
+ self.pyobjfrom_list = []
+ self.return_format_list = []
+ self.return_obj_list = []
+ self.buildvalue_list = []
+ self.clean_pyobjfrom_list = []
+ self.clean_call_list = []
+ self.clean_frompyobj_list = []
+
+ args_f = []
+ extra_args_f = []
+ ctype_args_f = []
+ extra_ctype_args_f = []
+ argindex = -1
+ for argname in block.args:
+ argindex += 1
+ var = block.a.variables[argname]
+ typedecl = var.get_typedecl()
+ PythonCAPIType(parent, typedecl)
+ ti = PyTypeInterface(typedecl)
+ if var.is_intent_in():
+ self.kw_list.append('"%s"' % (argname))
+
+ if var.is_scalar():
+ if isinstance(typedecl, TypeStmt):
+ if var.is_intent_in():
+ self.pyarg_format_list.append('O&')
+ self.pyarg_obj_list.append('\npyobj_to_%s_inplace, &%s' % (ti.ctype, argname))
+ else:
+ self.frompyobj_list.append('%s = (%s*)pyobj_from_%s(NULL);' % (argname,ti.otype,ti.ctype))
+ if not var.is_intent_out():
+ self.clean_frompyobj_list.append('Py_DECREF(%s);' % (argname))
+ self.decl_list.append('%s* %s = NULL;' % (ti.otype, argname))
+ args_f.append('%s->data' % (argname)) # is_scalar
+ ctype_args_f.append(ti.ctype)
+ else:
+ if var.is_intent_in():
+ self.pyarg_format_list.append('O&')
+ self.pyarg_obj_list.append('\npyobj_to_%s, &%s' % (ti.ctype, argname))
+ assert not isinstance(typedecl, TypeDecl)
+ if ti.ctype=='f2py_string0':
+ if not var.is_intent_in():
+ assert not var.is_intent_out(),'intent(out) not implemented for "%s"' % (var)
+ self.decl_list.append('%s %s = {NULL,0};' % (ti.ctype, argname))
+ args_f.append('%s.data' % argname) # is_scalar
+ ctype_args_f.append('char*')
+ extra_ctype_args_f.append('int')
+ extra_args_f.append('%s.len' % argname)
+ self.clean_frompyobj_list.append(\
+ 'if (%s.len) free(%s.data);' % (argname,argname))
+ else:
+ self.decl_list.append('%s %s;' % (ti.ctype, argname))
+ args_f.append('&'+argname) # is_scalar
+ ctype_args_f.append(ti.ctype+'*')
+ if var.is_intent_out(): # and is_scalar
+ if isinstance(typedecl, TypeStmt):
+ self.return_format_list.append('N')
+ self.return_obj_list.append('\n%s' % (argname))
+ else:
+ self.return_format_list.append('O&')
+ self.return_obj_list.append('\npyobj_from_%s, &%s' % (ti.ctype, argname))
+ else:
+ print `ti,var.dimension,var.bounds`
+ assert var.is_scalar(),'array support not implemented: "%s"' % (var)
+
+ self.call_list.append('%s_f(%s);' % (name,', '.join(args_f+extra_args_f)))
+
+ self.ctype_args_f_list = ctype_args_f + extra_ctype_args_f
+ if not self.ctype_args_f_list:
+ self.ctype_args_f_list.append('void')
+
+
+ self.clean_pyobjfrom_list.reverse()
+ self.clean_call_list.reverse()
+ self.clean_frompyobj_list.reverse()
+
+ if self.return_obj_list: self.return_obj_list.insert(0,'')
+
+ parent.apply_templates(self)
+ return
diff --git a/numpy/f2py/lib/py_wrap_type.py b/numpy/f2py/lib/py_wrap_type.py
new file mode 100644
index 000000000..7b90e7ed1
--- /dev/null
+++ b/numpy/f2py/lib/py_wrap_type.py
@@ -0,0 +1,753 @@
+__all__ = ['PythonCAPIType', 'PyTypeInterface']
+
+from wrapper_base import *
+from parser.api import CHAR_BIT, Module, declaration_type_spec, \
+ TypeDecl, TypeStmt, Subroutine, Function, Integer, Real,\
+ DoublePrecision, Complex, DoubleComplex, Logical, Character, \
+ Byte
+
+class PyTypeInterface:
+
+ def __init__(self, typedecl):
+ if isinstance(typedecl, TypeStmt):
+ typedecl = typedecl.get_type_decl(typedecl.name)
+ self._typedecl = typedecl
+ if isinstance(typedecl, TypeDecl):
+ self.name = name = typedecl.name
+ tname = 'f2py_type_%s_' % (name)
+ else:
+ if isinstance(typedecl,(Integer,Byte)):
+ tname = 'npy_int'
+ elif isinstance(typedecl,(Real, DoublePrecision)):
+ tname = 'npy_float'
+ elif isinstance(typedecl,(Complex, DoubleComplex)):
+ tname = 'npy_complex'
+ elif isinstance(typedecl,Logical):
+ tname = 'f2py_bool'
+ elif isinstance(typedecl,Character):
+ tname = 'f2py_string'
+ else:
+ raise NotImplementedError,`typedecl.__class__`
+ bitsize = typedecl.get_bit_size()
+ self.ctype = ctype = '%s%s' % (tname,bitsize)
+ self.bits = bitsize
+ self.bytes = bitsize / CHAR_BIT
+
+ if isinstance(typedecl, TypeDecl):
+ self.otype = '%sObject' % (ctype)
+ self.ftype = 'TYPE(%s)' % (name)
+ return
+ def __repr__(self): return '%s(%r)' % (self.__class__.__name__, self._typedecl)
+ def __str__(self):
+ s = []
+ for k,v in self.__dict__.items():
+ if k.startswith('_'): continue
+ s.append('%s=%s' % (k,v))
+ return 'PyTypeInterface(%s)' % (', '.join(s))
+
+class PythonCAPIType(WrapperBase):
+ """
+ Fortran type hooks.
+ """
+ def __init__(self, parent, typedecl):
+ WrapperBase.__init__(self)
+ if isinstance(typedecl, tuple(declaration_type_spec)):
+ if isinstance(typedecl, TypeStmt):
+ type_decl = typedecl.get_type_decl(typedecl.name)
+ assert type_decl is not None,"%s %s" % (typedecl,typedecl.name)
+ PythonCAPIDerivedType(parent, type_decl)
+ else:
+ PythonCAPIIntrinsicType(parent, typedecl)
+ elif isinstance(typedecl, TypeDecl):
+ PythonCAPIDerivedType(parent, typedecl)
+ else:
+ raise NotImplementedError,`self.__class__,typedecl.__class__`
+ return
+
+class PythonCAPIIntrinsicType(WrapperBase):
+ """
+ Fortran intrinsic type hooks.
+ """
+
+ capi_code_template_scalar = '''
+static PyObject* pyobj_from_%(ctype)s(%(ctype)s* value) {
+ PyObject* obj = PyArrayScalar_New(%(Cls)s);
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ fprintf(stderr,"pyobj_from_%(ctype)s(value=%%"%(CTYPE)s_FMT")\\n",*value);
+#endif
+ if (obj==NULL) /* TODO: set exception */ return NULL;
+ PyArrayScalar_ASSIGN(obj,%(Cls)s,*value);
+ return obj;
+}
+
+static int pyobj_to_%(ctype)s(PyObject *obj, %(ctype)s* value) {
+ int return_value = 0;
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ fprintf(stderr,"pyobj_to_%(ctype)s(type=%%s)\\n",PyString_AS_STRING(PyObject_Repr(PyObject_Type(obj))));
+#endif
+ if (obj==NULL) ;
+ else if (PyArray_IsScalar(obj,%(Cls)s)) {
+ *value = PyArrayScalar_VAL(obj,%(Cls)s);
+ return_value = 1;
+ }
+ else if (PySequence_Check(obj)) {
+ if (PySequence_Size(obj)==1)
+ return_value = pyobj_to_%(ctype)s(PySequence_GetItem(obj,0),value);
+ } else {
+ PyObject* sc = Py%(Cls)sArrType_Type.tp_new(
+ &Py%(Cls)sArrType_Type,Py_BuildValue("(O)",obj),NULL);
+ if (sc==NULL) ;
+ else if (PyArray_IsScalar(sc, Generic))
+ return_value = pyobj_to_%(ctype)s(sc,value);
+ else
+ return_value = pyobj_to_%(ctype)s(PyArray_ScalarFromObject(sc),value);
+ }
+ if (!return_value && !PyErr_Occurred()) {
+ PyObject* r = PyString_FromString("Failed to convert ");
+ PyString_ConcatAndDel(&r, PyObject_Repr(PyObject_Type(obj)));
+ PyString_ConcatAndDel(&r, PyString_FromString(" to C %(ctype)s"));
+ PyErr_SetObject(PyExc_TypeError,r);
+ }
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ if (PyErr_Occurred()) {
+ if (return_value)
+ fprintf(stderr,"pyobj_to_%(ctype)s:INCONSISTENCY with return_value=%%d and PyErr_Occurred()=%%p\\n",return_value, PyErr_Occurred());
+ else
+ fprintf(stderr,"pyobj_to_%(ctype)s: PyErr_Occurred()=%%p\\n", PyErr_Occurred());
+ } else {
+ if (return_value)
+ fprintf(stderr,"pyobj_to_%(ctype)s: value=%%"%(CTYPE)s_FMT"\\n", *value);
+ else
+ fprintf(stderr,"pyobj_to_%(ctype)s:INCONSISTENCY with return_value=%%d and PyErr_Occurred()=%%p\\n",return_value, PyErr_Occurred());
+ }
+#endif
+ return return_value;
+}
+'''
+
+ capi_code_template_complex_scalar = '''
+static PyObject* pyobj_from_%(ctype)s(%(ctype)s* value) {
+ PyObject* obj = PyArrayScalar_New(%(Cls)s);
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ fprintf(stderr,"pyobj_from_%(ctype)s(value=(%%"%(FCTYPE)s_FMT",%%"%(FCTYPE)s_FMT"))\\n",value->real, value->imag);
+#endif
+ if (obj==NULL) /* TODO: set exception */ return NULL;
+ PyArrayScalar_ASSIGN(obj,%(Cls)s,*value);
+ return obj;
+}
+
+static int pyobj_to_%(ctype)s(PyObject *obj, %(ctype)s* value) {
+ int return_value = 0;
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ fprintf(stderr,"pyobj_to_%(ctype)s(type=%%s)\\n",PyString_AS_STRING(PyObject_Repr(PyObject_Type(obj))));
+#endif
+ if (obj==NULL) ;
+ else if (PyArray_IsScalar(obj,%(Cls)s)) {
+ value->real = PyArrayScalar_VAL(obj,%(Cls)s).real;
+ value->imag = PyArrayScalar_VAL(obj,%(Cls)s).imag;
+ return_value = 1;
+ }
+ else if (PySequence_Check(obj)) {
+ if (PySequence_Size(obj)==1)
+ return_value = pyobj_to_%(ctype)s(PySequence_GetItem(obj,0),value);
+ else if (PySequence_Size(obj)==2) {
+ return_value = pyobj_to_%(fctype)s(PySequence_GetItem(obj,0),&(value->real))
+ && pyobj_to_%(fctype)s(PySequence_GetItem(obj,1),&(value->imag));
+ }
+ } else {
+ PyObject* sc = Py%(Cls)sArrType_Type.tp_new(
+ &Py%(Cls)sArrType_Type,Py_BuildValue("(O)",obj),NULL);
+ if (sc==NULL) ;
+ else if (PyArray_IsScalar(sc, Generic))
+ return_value = pyobj_to_%(ctype)s(sc,value);
+ else
+ return_value = pyobj_to_%(ctype)s(PyArray_ScalarFromObject(sc),value);
+ }
+ if (!return_value && !PyErr_Occurred()) {
+ PyObject* r = PyString_FromString("Failed to convert ");
+ PyString_ConcatAndDel(&r, PyObject_Repr(PyObject_Type(obj)));
+ PyString_ConcatAndDel(&r, PyString_FromString(" to C %(ctype)s"));
+ PyErr_SetObject(PyExc_TypeError,r);
+ }
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ if (PyErr_Occurred()) {
+ if (return_value)
+ fprintf(stderr,"pyobj_to_%(ctype)s:INCONSISTENCY with return_value=%%d and PyErr_Occurred()=%%p\\n",return_value, PyErr_Occurred());
+ else
+ fprintf(stderr,"pyobj_to_%(ctype)s: PyErr_Occurred()=%%p\\n", PyErr_Occurred());
+ } else {
+ if (return_value)
+ fprintf(stderr,"pyobj_to_%(ctype)s: value=(%%"%(FCTYPE)s_FMT",%%"%(FCTYPE)s_FMT")\\n",
+ value->real, value->imag);
+ else
+ fprintf(stderr,"pyobj_to_%(ctype)s:INCONSISTENCY with return_value=%%d and PyErr_Occurred()=%%p\\n",return_value, PyErr_Occurred());
+ }
+#endif
+ return return_value;
+}
+'''
+
+ capi_code_template_logical_scalar = '''
+static PyObject* pyobj_from_%(ctype)s(%(ctype)s* value) {
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ fprintf(stderr,"pyobj_from_%(ctype)s(value=%%"%(ICTYPE)s_FMT")\\n",*value);
+#endif
+ if (*value) {
+ PyArrayScalar_RETURN_TRUE;
+ } else {
+ PyArrayScalar_RETURN_FALSE;
+ }
+}
+static int pyobj_to_%(ctype)s(PyObject *obj, %(ctype)s* value) {
+ int return_value = 0;
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ fprintf(stderr,"pyobj_to_%(ctype)s(type=%%s)\\n",PyString_AS_STRING(PyObject_Repr(PyObject_Type(obj))));
+#endif
+ if (obj==NULL) ;
+ else if (PyArray_IsScalar(obj,Bool)) {
+ *value = PyArrayScalar_VAL(obj,Bool);
+ return_value = 1;
+ } else {
+ switch (PyObject_IsTrue(obj)) {
+ case 0: *value = 0; return_value = 1; break;
+ case -1: break;
+ default: *value = 1; return_value = 1;
+ }
+ }
+ if (!return_value && !PyErr_Occurred()) {
+ PyObject* r = PyString_FromString("Failed to convert ");
+ PyString_ConcatAndDel(&r, PyObject_Repr(PyObject_Type(obj)));
+ PyString_ConcatAndDel(&r, PyString_FromString(" to C %(ctype)s"));
+ PyErr_SetObject(PyExc_TypeError,r);
+ }
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ if (PyErr_Occurred()) {
+ if (return_value)
+ fprintf(stderr,"pyobj_to_%(ctype)s:INCONSISTENCY with return_value=%%d and PyErr_Occurred()=%%p\\n",return_value, PyErr_Occurred());
+ else
+ fprintf(stderr,"pyobj_to_%(ctype)s: PyErr_Occurred()=%%p\\n", PyErr_Occurred());
+ } else {
+ if (return_value)
+ fprintf(stderr,"pyobj_to_%(ctype)s: value=%%"%(ICTYPE)s_FMT"\\n", *value);
+ else
+ fprintf(stderr,"pyobj_to_%(ctype)s:INCONSISTENCY with return_value=%%d and PyErr_Occurred()=%%p\\n",return_value, PyErr_Occurred());
+ }
+#endif
+ return return_value;
+}
+'''
+ capi_code_template_string_scalar = '''
+static PyObject* pyobj_from_%(ctype)s(%(ctype)s* value) {
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ fprintf(stderr,"pyobj_from_%(ctype)s(value->data=\'%%s\')\\n",value->data);
+#endif
+ PyArray_Descr* descr = PyArray_DescrNewFromType(NPY_STRING);
+ descr->elsize = %(bytes)s;
+ PyObject* obj = PyArray_Scalar(value->data, descr, NULL);
+ if (obj==NULL) /* TODO: set exception */ return NULL;
+ return obj;
+}
+
+static int pyobj_to_%(ctype)s(PyObject *obj, %(ctype)s* value) {
+ int return_value = 0;
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ fprintf(stderr,"pyobj_to_%(ctype)s(type=%%s)\\n",PyString_AS_STRING(PyObject_Repr(PyObject_Type(obj))));
+#endif
+ if (PyString_Check(obj)) {
+ int s = PyString_GET_SIZE(obj);
+ memset(value->data, (int)\' \',%(bytes)s);
+ return_value = !! strncpy(value->data,PyString_AS_STRING(obj),%(bytes)s);
+ if (return_value && s<%(bytes)s) {
+ memset(value->data + s, (int)\' \',%(bytes)s-s);
+ }
+ } else {
+ return_value = pyobj_to_%(ctype)s(PyObject_Str(obj), value);
+ }
+ if (!return_value && !PyErr_Occurred()) {
+ PyObject* r = PyString_FromString("Failed to convert ");
+ PyString_ConcatAndDel(&r, PyObject_Repr(PyObject_Type(obj)));
+ PyString_ConcatAndDel(&r, PyString_FromString(" to C %(ctype)s"));
+ PyErr_SetObject(PyExc_TypeError,r);
+ }
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ if (PyErr_Occurred()) {
+ if (return_value)
+ fprintf(stderr,"pyobj_to_%(ctype)s:INCONSISTENCY with return_value=%%d and PyErr_Occurred()=%%p\\n",return_value, PyErr_Occurred());
+ else
+ fprintf(stderr,"pyobj_to_%(ctype)s: PyErr_Occurred()=%%p\\n", PyErr_Occurred());
+ } else {
+ if (return_value)
+ fprintf(stderr,"pyobj_to_%(ctype)s: value->data=\'%%s\'\\n", value->data);
+ else
+ fprintf(stderr,"pyobj_to_%(ctype)s:INCONSISTENCY with return_value=%%d and PyErr_Occurred()=%%p\\n",return_value, PyErr_Occurred());
+ }
+#endif
+ return return_value;
+}
+'''
+ capi_code_template_string0_scalar = '''
+static PyObject* pyobj_from_%(ctype)s(%(ctype)s* value) {
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ fprintf(stderr,"pyobj_from_%(ctype)s(value->len=%%d, value->data=\'%%s\')\\n",value->len, value->data);
+#endif
+ PyArray_Descr* descr = PyArray_DescrNewFromType(NPY_STRING);
+ descr->elsize = value->len;
+ PyObject* obj = PyArray_Scalar(value->data, descr, NULL);
+ if (obj==NULL) /* TODO: set exception */ return NULL;
+ return obj;
+}
+
+static int pyobj_to_%(ctype)s(PyObject *obj, %(ctype)s* value) {
+ int return_value = 0;
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ fprintf(stderr,"pyobj_to_%(ctype)s(type=%%s)\\n",PyString_AS_STRING(PyObject_Repr(PyObject_Type(obj))));
+#endif
+ if (PyString_Check(obj)) {
+ value->len = PyString_GET_SIZE(obj);
+ value->data = malloc(value->len*sizeof(char));
+ return_value = !! strncpy(value->data,PyString_AS_STRING(obj),value->len);
+ } else {
+ return_value = pyobj_to_%(ctype)s(PyObject_Str(obj), value);
+ }
+ if (!return_value && !PyErr_Occurred()) {
+ PyObject* r = PyString_FromString("Failed to convert ");
+ PyString_ConcatAndDel(&r, PyObject_Repr(PyObject_Type(obj)));
+ PyString_ConcatAndDel(&r, PyString_FromString(" to C %(ctype)s"));
+ PyErr_SetObject(PyExc_TypeError,r);
+ }
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ if (PyErr_Occurred()) {
+ if (return_value)
+ fprintf(stderr,"pyobj_to_%(ctype)s:INCONSISTENCY with return_value=%%d and PyErr_Occurred()=%%p\\n",return_value, PyErr_Occurred());
+ else
+ fprintf(stderr,"pyobj_to_%(ctype)s: PyErr_Occurred()=%%p\\n", PyErr_Occurred());
+ } else {
+ if (return_value)
+ fprintf(stderr,"pyobj_to_%(ctype)s: value->len=%%d, value->data=\'%%s\'\\n", value->len, value->data);
+ else
+ fprintf(stderr,"pyobj_to_%(ctype)s:INCONSISTENCY with return_value=%%d and PyErr_Occurred()=%%p\\n",return_value, PyErr_Occurred());
+ }
+#endif
+ return return_value;
+}
+'''
+ def __init__(self, parent, typedecl):
+ WrapperBase.__init__(self)
+ self.name = name = typedecl.name
+ ti = PyTypeInterface(typedecl)
+ self.ctype = ctype = ti.ctype
+
+ defined = parent.defined_types
+ if ctype in defined:
+ return
+ defined.append(ctype)
+
+ self.info('Generating interface for %s: %s' % (typedecl.__class__.__name__, ctype))
+ self.parent = parent
+ if isinstance(typedecl, (Integer,Byte,Real,DoublePrecision)):
+ self.Cls = ctype[4].upper() + ctype[5:]
+ self.capi_code_template = self.capi_code_template_scalar
+ elif isinstance(typedecl, (Complex,DoubleComplex)):
+ self.Cls = ctype[4].upper() + ctype[5:]
+ PythonCAPIIntrinsicType(parent, typedecl.get_part_typedecl())
+ ti1 = PyTypeInterface(typedecl.get_part_typedecl())
+ self.fctype = ti1.ctype
+ self.capi_code_template = self.capi_code_template_complex_scalar
+ elif isinstance(typedecl, Logical):
+ self.ictype = 'npy_int%s' % (typedecl.get_bit_size())
+ self.header_template = '#define %(ctype)s %(ictype)s'
+ self.capi_code_template = self.capi_code_template_logical_scalar
+ elif isinstance(typedecl, Character):
+ self.bits = bits = typedecl.get_bit_size()
+ if bits:
+ self.bytes = bits/CHAR_BIT
+ self.header_template = '''
+#include <string.h>
+typedef struct { char data[%(bytes)s]; } %(ctype)s;
+'''
+ self.capi_code_template = self.capi_code_template_string_scalar
+ else:
+ self.header_template = '''
+#include <string.h>
+typedef struct { char* data; size_t len; } %(ctype)s;
+'''
+ self.capi_code_template = self.capi_code_template_string0_scalar
+ else:
+ raise NotImplementedError,`name,ctype`
+ parent.apply_templates(self)
+ return
+
+class PythonCAPIDerivedType(WrapperBase):
+ """
+ Fortran 90 derived type hooks.
+ """
+
+ header_template_wrapper = '''\
+#define %(otype)s_Check(obj) \\
+ PyObject_TypeCheck((PyObject*)obj, &%(otype)sType)
+#define %(init_func)s_f \\
+ F_FUNC(%(init_func)s,%(INIT_FUNC)s)
+'''
+
+ typedef_template_wrapper = '''\
+typedef void * %(ctype)s;
+typedef struct {
+ PyObject_HEAD
+ %(ptrstruct_list)s
+ %(ctype)s data;
+} %(otype)s;
+typedef void (*%(init_func)s_c_functype)(%(init_func_c_ctype_arg_clist)s);
+'''
+
+ typedef_template_importer = '''\
+typedef void * %(ctype)s;
+typedef struct {
+ PyObject_HEAD
+ %(ptrstruct_list)s
+ %(ctype)s data;
+} %(otype)s;
+typedef int (*pyobj_to_%(ctype)s_inplace_functype)(PyObject*, %(otype)s** );
+typedef int (*pyobj_to_%(ctype)s_functype)(PyObject*, %(otype)s* );
+typedef PyObject* (*pyobj_from_%(ctype)s_functype)(%(ctype)s*);
+#define %(otype)sType (*(PyTypeObject *)PyArray_API[0])
+#define pyobj_from_%(ctype)s ((pyobj_from_%(ctype)s_functype)PyArray_API[1])
+#define pyobj_to_%(ctype)s_inplace ((pyobj_to_%(ctype)s_inplace_functype)PyArray_API[2])
+'''
+
+ extern_template_wrapper = '''\
+static PyTypeObject %(otype)sType;
+extern void %(init_func)s_f(%(init_func)s_c_functype, void*, %(ctype)s);
+'''
+
+ objdecl_template_wrapper = '''\
+static PyMethodDef %(otype)s_methods[] = {
+ %(type_method_list)s
+ {NULL} /* Sentinel */
+};
+
+static PyGetSetDef %(otype)s_getseters[] = {
+ %(type_getseters_list)s
+ {NULL} /* Sentinel */
+};
+
+static PyTypeObject %(otype)sType = {
+ PyObject_HEAD_INIT(NULL)
+ 0, /*ob_size*/
+ "%(modulename)s.%(name)s", /*tp_name*/
+ sizeof(%(otype)s), /*tp_basicsize*/
+ 0, /*tp_itemsize*/
+ (destructor)%(otype)s_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ %(otype)s_repr, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+ 0, /*tp_hash */
+ 0, /*tp_call*/
+ 0, /*tp_str*/
+ 0, /*tp_getattro*/
+ 0, /*tp_setattro*/
+ 0, /*tp_as_buffer*/
+ Py_TPFLAGS_DEFAULT | Py_TPFLAGS_BASETYPE, /*tp_flags*/
+ "Fortran derived type %(name)s objects", /* tp_doc */
+ 0, /* tp_traverse */
+ 0, /* tp_clear */
+ 0, /* tp_richcompare */
+ 0, /* tp_weaklistoffset */
+ 0, /* tp_iter */
+ 0, /* tp_iternext */
+ %(otype)s_methods, /* tp_methods */
+ 0 /*%(otype)s_members*/, /* tp_members */
+ %(otype)s_getseters, /* tp_getset */
+ 0, /* tp_base */
+ 0, /* tp_dict */
+ 0, /* tp_descr_get */
+ 0, /* tp_descr_set */
+ 0, /* tp_dictoffset */
+ (initproc)%(otype)s_init, /* tp_init */
+ 0, /* tp_alloc */
+ %(otype)s_new, /* tp_new */
+};
+
+void *F2PY_%(otype)s_API[] = {
+ (void *) &%(otype)sType,
+ (void *) pyobj_from_%(ctype)s,
+ (void *) pyobj_to_%(ctype)s_inplace
+};
+'''
+
+ objdecl_template_importer = '''\
+static void **F2PY_%(otype)s_API;
+'''
+ module_init_template_wrapper = '''\
+if (PyType_Ready(&%(otype)sType) < 0) goto capi_err;
+PyModule_AddObject(f2py_module, "%(name)s", (PyObject *)&%(otype)sType);
+{
+ PyObject* c_api = PyCObject_FromVoidPtr((void *)F2PY_%(otype)s_API, NULL);
+ PyModule_AddObject(f2py_module, "_%(NAME)s_API", c_api);
+ if (PyErr_Occurred()) goto capi_err;
+}
+'''
+ module_init_template_importer = '''\
+{
+ PyObject *c_api = NULL;
+ PyObject *wrappermodule = PyImport_ImportModule("%(wrappermodulename)s");
+ if (wrappermodule == NULL) goto capi_%(name)s_err;
+ c_api = PyObject_GetAttrString(wrappermodule, "_%(NAME)s_API");
+ if (c_api == NULL) {Py_DECREF(wrappermodule); goto capi_%(name)s_err;}
+ if (PyCObject_Check(c_api)) {
+ F2PY_%(otype)s_API = (void **)PyCObject_AsVoidPtr(c_api);
+ }
+ Py_DECREF(c_api);
+ Py_DECREF(wrappermodule);
+ if (F2PY_%(otype)s_API != NULL) goto capi_%(name)s_ok;
+capi_%(name)s_err:
+ PyErr_Print();
+ PyErr_SetString(PyExc_ImportError, "%(wrappermodulename)s failed to import");
+ return;
+capi_%(name)s_ok:
+ c_api = PyCObject_FromVoidPtr((void *)F2PY_%(otype)s_API, NULL);
+ PyModule_AddObject(f2py_module, "_%(NAME)s_API", c_api);
+ if (PyErr_Occurred()) goto capi_err;
+}
+'''
+
+ c_code_template_wrapper = '''\
+static void %(init_func)s_c(
+ %(init_func_c_arg_clist)s) {
+ %(init_func_c_body_list)s
+}
+'''
+
+ capi_code_template_wrapper = '''\
+static void %(otype)s_dealloc(%(otype)s* self) {
+ if (self->data)
+ PyMem_Free(self->data);
+ self->ob_type->tp_free((PyObject*)self);
+}
+
+static int pyobj_to_%(ctype)s_inplace(PyObject *obj,
+ %(otype)s** value_ptr) {
+ int return_value = 0;
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ fprintf(stderr,"pyobj_to_%(ctype)s(type=%%s)\\n",PyString_AS_STRING(PyObject_Repr(PyObject_Type(obj))));
+#endif
+ if (%(otype)s_Check(obj)) {
+ *value_ptr = (%(otype)s*)obj;
+ return_value = 1;
+ }
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ fprintf(stderr,"pyobj_to_%(ctype)s: return_value=%%d, PyErr_Occurred()=%%p\\n", return_value, PyErr_Occurred());
+#endif
+ return return_value;
+}
+
+static int pyobj_to_%(ctype)s(PyObject *obj,
+ %(ctype)s* value_ptr) {
+ int return_value = 0;
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ fprintf(stderr,"pyobj_to_%(ctype)s(type=%%s)\\n",PyString_AS_STRING(PyObject_Repr(PyObject_Type(obj))));
+#endif
+ if (%(otype)s_Check(obj)) {
+ if (!memcpy(value_ptr,((%(otype)s *)obj)->data, %(bytes)s)) {
+ PyErr_SetString(PyExc_MemoryError,
+ "failed to copy %(name)s instance memory to %(ctype)s object.");
+ } else {
+ return_value = 1;
+ }
+ }
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ fprintf(stderr,"pyobj_to_%(ctype)s: return_value=%%d, PyErr_Occurred()=%%p\\n", return_value, PyErr_Occurred());
+#endif
+ return return_value;
+}
+
+static PyObject* pyobj_from_%(ctype)s(%(ctype)s* value_ptr) {
+ %(otype)s* obj = (%(otype)s*)(%(otype)sType.tp_alloc(&%(otype)sType, 0));
+ if (obj == NULL)
+ return NULL;
+ obj->data = PyMem_Malloc(%(bytes)s);
+ if (obj->data == NULL) {
+ Py_DECREF(obj);
+ return PyErr_NoMemory();
+ }
+ if (value_ptr) {
+ if (!memcpy(obj->data, value_ptr, %(bytes)s)) {
+ PyErr_SetString(PyExc_MemoryError,
+ "failed to copy %(ctype)s object memory to %(name)s instance.");
+ }
+ }
+ %(init_func)s_f(%(init_func)s_c, obj, obj->data);
+ return (PyObject*)obj;
+}
+
+static PyObject * %(otype)s_new(PyTypeObject *type,
+ PyObject *args, PyObject *kwds)
+{
+ return pyobj_from_%(ctype)s(NULL);
+}
+
+static int %(otype)s_init(%(otype)s *self,
+ PyObject *capi_args, PyObject *capi_kwds)
+{
+ int return_value = 0;
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ fprintf(stderr,"%(otype)s_init()\\n");
+#endif
+ if (!PyArg_ParseTuple(capi_args,"%(attr_format_elist)s"
+ %(attr_init_clist)s))
+ return_value = -1;
+
+#if defined(F2PY_DEBUG_PYOBJ_TOFROM)
+ fprintf(stderr,"%(otype)s_init: return_value=%%d, PyErr_Occurred()=%%p\\n", return_value, PyErr_Occurred());
+#endif
+ return return_value;
+}
+
+static PyObject * %(otype)s_as_tuple(%(otype)s * self) {
+ return Py_BuildValue("%(as_tuple_format_elist)s"
+ %(as_tuple_arg_clist)s);
+}
+
+static PyObject * %(otype)s_repr(PyObject * self) {
+ PyObject* r = PyString_FromString("%(name)s(");
+ PyString_ConcatAndDel(&r, PyObject_Repr(%(otype)s_as_tuple((%(otype)s*)self)));
+ PyString_ConcatAndDel(&r, PyString_FromString(")"));
+ return r;
+}
+
+%(getset_func_list)s
+'''
+
+ fortran_code_template_wrapper = '''\
+ subroutine %(init_func)s(init_func_c, self, obj)
+ %(use_stmt_list)s
+ %(type_decl_list)s
+ external init_func_c
+! self is %(otype)s
+ external self
+ %(ftype)s obj
+ call init_func_c(%(init_func_f_arg_clist)s)
+ end
+'''
+
+ #module_method_template = ''''''
+
+ _defined = []
+ def __init__(self, parent, typedecl):
+ WrapperBase.__init__(self)
+ ti = PyTypeInterface(typedecl)
+ self.ctype = ctype = ti.ctype
+ defined = parent.defined_types
+ if ctype in defined:
+ return
+ defined.append(ctype)
+
+
+
+ implement_wrappers = True
+ if isinstance(typedecl.parent,Module) and typedecl.parent.name!=parent.modulename:
+ implement_wrappers = False
+ self.info('Using api for %s.%s: %s' % (parent.modulename, typedecl.name, ctype))
+ self.wrappermodulename = typedecl.parent.name
+ else:
+ self.info('Generating interface for %s.%s: %s' % (parent.modulename, typedecl.name, ctype))
+
+ parent.isf90 = True
+ self.parent = parent
+ self.name = name = typedecl.name
+ self.otype = otype = ti.otype
+ self.ctype = ctype = ti.ctype
+ self.ctype_ptrs = self.ctype + '_ptrs'
+ self.ftype = ti.ftype
+ self.bytes = bytes = ti.bytes
+
+ if not implement_wrappers:
+ self.typedef_template = self.typedef_template_importer
+ self.objdecl_template = self.objdecl_template_importer
+ self.module_init_template = self.module_init_template_importer
+ else:
+ self.header_template = self.header_template_wrapper
+ self.typedef_template = self.typedef_template_wrapper
+ self.extern_template = self.extern_template_wrapper
+ self.objdecl_template = self.objdecl_template_wrapper
+ self.module_init_template = self.module_init_template_wrapper
+ self.c_code_template = self.c_code_template_wrapper
+ self.capi_code_template = self.capi_code_template_wrapper
+ self.fortran_code_template = self.fortran_code_template_wrapper
+ WrapperCPPMacro(parent, 'F_FUNC')
+
+ self.init_func_f_arg_list = ['self']
+ self.init_func_c_arg_list = ['%s *self' % (otype)]
+ self.init_func_c_ctype_arg_list = ['%s *' % (otype)]
+ self.init_func_c_body_list = []
+ self.ptrstruct_list = []
+ self.attr_decl_list = []
+ self.attr_format_list = []
+ self.attr_init_list = []
+ self.as_tuple_format_list = []
+ self.as_tuple_arg_list = []
+ self.getset_func_list = []
+ self.type_getseters_list = []
+ for n in typedecl.a.component_names:
+ v = typedecl.a.components[n]
+ t = v.get_typedecl()
+ ti1 = PyTypeInterface(t)
+ PythonCAPIType(parent, t)
+ ct = ti1.ctype
+ parent.add(t)
+ self.ptrstruct_list.append('%s* %s_ptr;' % (ct, n))
+ self.init_func_f_arg_list.append('obj %% %s' % (n))
+ self.init_func_c_arg_list.append('\n%s * %s_ptr' % (ct, n))
+ self.init_func_c_ctype_arg_list.append('\n%s *' % (ct))
+ self.init_func_c_body_list.append('''\
+if (!((void*)%(n)s_ptr >= self->data
+ && (void*)%(n)s_ptr < self->data + %(bytes)s ))
+ fprintf(stderr,"INCONSISTENCY IN %(name)s WRAPPER: "
+ "self->data=%%p <= %(n)s_ptr=%%p < self->data+%(bytes)s=%%p\\n",
+ self->data, %(n)s_ptr, self->data + %(bytes)s);
+self->%(n)s_ptr = %(n)s_ptr;
+''' % (locals()))
+ self.attr_format_list.append('O&')
+ self.attr_init_list.append('\npyobj_to_%s, self->%s_ptr' % (ct,n))
+ self.as_tuple_format_list.append('O&')
+ self.as_tuple_arg_list.append('\npyobj_from_%s, self->%s_ptr' % (ct, n))
+ self.getset_func_list.append('''\
+static PyObject * %(otype)s_get_%(n)s(%(otype)s *self,
+ void *closure) {
+ return pyobj_from_%(ct)s(self->%(n)s_ptr);
+}
+static int %(otype)s_set_%(n)s(%(otype)s *self,
+ PyObject *value, void *closure)
+{
+ if (value == NULL) {
+ PyErr_SetString(PyExc_TypeError,
+ "Cannot delete %(name)s attribute %(n)s");
+ return -1;
+ }
+ if (pyobj_to_%(ct)s(value, self->%(n)s_ptr))
+ return 0;
+ return -1;
+}
+''' % (locals()))
+ self.type_getseters_list.append('{"%(n)s",(getter)%(otype)s_get_%(n)s, (setter)%(otype)s_set_%(n)s,\n "component %(n)s",NULL},' % (locals()))
+ if self.attr_init_list: self.attr_init_list.insert(0,'')
+ if self.as_tuple_arg_list: self.as_tuple_arg_list.insert(0,'')
+ self.init_func = self.ctype + '_init'
+
+ self.type_method_list = []
+ self.type_method_list.append('{"as_tuple",(PyCFunction)%(otype)s_as_tuple,METH_NOARGS,\n "Return %(name)s components as tuple."},' % (self.__dict__))
+
+ self.use_stmt_list = []
+ self.type_decl_list = []
+ if isinstance(typedecl.parent, Module):
+ self.use_stmt_list.append('use %s' % (typedecl.parent.name))
+ elif isinstance(typedecl.parent, (Subroutine, Function)):
+ self.type_decl_list.append(typedecl.asfix())
+ else:
+ raise NotImplementedError,'types declared in '+typedecl.parent.__class__.__name__
+ parent.apply_templates(self)
+ return
diff --git a/numpy/f2py/lib/setup.py b/numpy/f2py/lib/setup.py
new file mode 100644
index 000000000..cd63b07cd
--- /dev/null
+++ b/numpy/f2py/lib/setup.py
@@ -0,0 +1,12 @@
+#!/usr/bin/env python
+def configuration(parent_package='',top_path=None):
+ from numpy.distutils.misc_util import Configuration
+ config = Configuration('lib',parent_package,top_path)
+ config.add_subpackage('parser')
+ config.add_data_files('*.txt','parser/*.txt')
+ config.add_data_dir('src')
+ return config
+
+if __name__ == "__main__":
+ from numpy.distutils.core import setup
+ setup(configuration=configuration)
diff --git a/numpy/f2py/lib/src/F_FUNC.cpp b/numpy/f2py/lib/src/F_FUNC.cpp
new file mode 100644
index 000000000..edaa98064
--- /dev/null
+++ b/numpy/f2py/lib/src/F_FUNC.cpp
@@ -0,0 +1,34 @@
+#if defined(PREPEND_FORTRAN)
+#if defined(NO_APPEND_FORTRAN)
+#if defined(UPPERCASE_FORTRAN)
+#define F_FUNC(f,F) _##F
+#else
+#define F_FUNC(f,F) _##f
+#endif
+#else
+#if defined(UPPERCASE_FORTRAN)
+#define F_FUNC(f,F) _##F##_
+#else
+#define F_FUNC(f,F) _##f##_
+#endif
+#endif
+#else
+#if defined(NO_APPEND_FORTRAN)
+#if defined(UPPERCASE_FORTRAN)
+#define F_FUNC(f,F) F
+#else
+#define F_FUNC(f,F) f
+#endif
+#else
+#if defined(UPPERCASE_FORTRAN)
+#define F_FUNC(f,F) F##_
+#else
+#define F_FUNC(f,F) f##_
+#endif
+#endif
+#endif
+#if defined(UNDERSCORE_G77)
+#define F_FUNC_US(f,F) F_FUNC(f##_,F##_)
+#else
+#define F_FUNC_US(f,F) F_FUNC(f,F)
+#endif
diff --git a/numpy/f2py/lib/src/pyobj_to_string_len.c b/numpy/f2py/lib/src/pyobj_to_string_len.c
new file mode 100644
index 000000000..306c961a3
--- /dev/null
+++ b/numpy/f2py/lib/src/pyobj_to_string_len.c
@@ -0,0 +1,11 @@
+int pyobj_to_string_len(PyObject* obj, f2py_string* value, size_t length) {
+ if (PyString_Check(obj)) {
+ if (strncpy((char*)value,PyString_AS_STRING(obj), length))
+ return 1;
+ }
+ if (!PyErr_Occurred()) {
+ PyErr_SetString(PyExc_TypeError,
+ "Failed to convert python object to C f2py_string.");
+ }
+ return 0;
+}
diff --git a/numpy/f2py/lib/tests/test_derived_scalar.py b/numpy/f2py/lib/tests/test_derived_scalar.py
new file mode 100644
index 000000000..c57778020
--- /dev/null
+++ b/numpy/f2py/lib/tests/test_derived_scalar.py
@@ -0,0 +1,74 @@
+#!/usr/bin/env python
+"""
+Tests for intent(in,out) derived type arguments in Fortran subroutine's.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: Oct 2006
+-----
+"""
+
+import os
+import sys
+from numpy.testing import *
+set_package_path()
+from lib.main import build_extension, compile
+restore_path()
+
+fortran_code = '''
+subroutine foo(a)
+ type myt
+ integer flag
+ end type myt
+ type(myt) a
+!f2py intent(in,out) a
+ a % flag = a % flag + 1
+end
+function foo2(a)
+ type myt
+ integer flag
+ end type myt
+ type(myt) a
+ type(myt) foo2
+ foo2 % flag = a % flag + 2
+end
+'''
+
+m, = compile(fortran_code, 'test_derived_scalar_ext')
+
+from numpy import *
+
+class test_m(NumpyTestCase):
+
+ def check_foo_simple(self, level=1):
+ a = m.myt(2)
+ assert_equal(a.flag,2)
+ assert isinstance(a,m.myt),`a`
+ r = m.foo(a)
+ assert isinstance(r,m.myt),`r`
+ assert r is a
+ assert_equal(r.flag,3)
+ assert_equal(a.flag,3)
+
+ a.flag = 5
+ assert_equal(r.flag,5)
+
+ #s = m.foo((5,))
+
+ def check_foo2_simple(self, level=1):
+ a = m.myt(2)
+ assert_equal(a.flag,2)
+ assert isinstance(a,m.myt),`a`
+ r = m.foo2(a)
+ assert isinstance(r,m.myt),`r`
+ assert r is not a
+ assert_equal(a.flag,2)
+ assert_equal(r.flag,4)
+
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/f2py/lib/tests/test_module_module.py b/numpy/f2py/lib/tests/test_module_module.py
new file mode 100644
index 000000000..4d242ed54
--- /dev/null
+++ b/numpy/f2py/lib/tests/test_module_module.py
@@ -0,0 +1,61 @@
+#!/usr/bin/env python
+"""
+Tests for module with scalar derived types and subprograms.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: Oct 2006
+-----
+"""
+
+import os
+import sys
+from numpy.testing import *
+
+set_package_path()
+from lib.main import build_extension, compile
+restore_path()
+
+fortran_code = '''
+module test_module_module_ext2
+ type rat
+ integer n,d
+ end type rat
+ contains
+ subroutine foo2()
+ print*,"In foo2"
+ end subroutine foo2
+end module
+module test_module_module_ext
+ contains
+ subroutine foo
+ use test_module_module_ext2
+ print*,"In foo"
+ call foo2
+ end subroutine foo
+ subroutine bar(a)
+ use test_module_module_ext2
+ type(rat) a
+ print*,"In bar,a=",a
+ end subroutine bar
+end module test_module_module_ext
+'''
+
+m,m2 = compile(fortran_code, modulenames=['test_module_module_ext',
+ 'test_module_module_ext2',
+ ])
+
+from numpy import *
+
+class test_m(NumpyTestCase):
+
+ def check_foo_simple(self, level=1):
+ foo = m.foo
+ foo()
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/f2py/lib/tests/test_module_scalar.py b/numpy/f2py/lib/tests/test_module_scalar.py
new file mode 100644
index 000000000..e11a1e0ae
--- /dev/null
+++ b/numpy/f2py/lib/tests/test_module_scalar.py
@@ -0,0 +1,58 @@
+#!/usr/bin/env python
+"""
+Tests for module with scalar derived types and subprograms.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: Oct 2006
+-----
+"""
+
+import os
+import sys
+from numpy.testing import *
+set_package_path()
+from lib.main import build_extension, compile
+restore_path()
+
+fortran_code = '''
+module test_module_scalar_ext
+
+ contains
+ subroutine foo(a)
+ integer a
+!f2py intent(in,out) a
+ a = a + 1
+ end subroutine foo
+ function foo2(a)
+ integer a
+ integer foo2
+ foo2 = a + 2
+ end function foo2
+end module test_module_scalar_ext
+'''
+
+m, = compile(fortran_code, modulenames = ['test_module_scalar_ext'])
+
+from numpy import *
+
+class test_m(NumpyTestCase):
+
+ def check_foo_simple(self, level=1):
+ foo = m.foo
+ r = foo(2)
+ assert isinstance(r,int32),`type(r)`
+ assert_equal(r,3)
+
+ def check_foo2_simple(self, level=1):
+ foo2 = m.foo2
+ r = foo2(2)
+ assert isinstance(r,int32),`type(r)`
+ assert_equal(r,4)
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/f2py/lib/tests/test_scalar_function_in.py b/numpy/f2py/lib/tests/test_scalar_function_in.py
new file mode 100644
index 000000000..9c5cd8aba
--- /dev/null
+++ b/numpy/f2py/lib/tests/test_scalar_function_in.py
@@ -0,0 +1,532 @@
+#!/usr/bin/env python
+"""
+Tests for intent(in) arguments in subroutine-wrapped Fortran functions.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: Oct 2006
+-----
+"""
+
+import os
+import sys
+from numpy.testing import *
+
+set_package_path()
+from lib.main import build_extension, compile
+restore_path()
+
+fortran_code = '''\
+! -*- f77 -*-
+ function fooint1(a)
+ integer*1 a
+ integer*1 fooint1
+ fooint1 = a + 1
+ end
+ function fooint2(a)
+ integer*2 a
+ integer*2 fooint2
+ fooint2 = a + 1
+ end
+ function fooint4(a)
+ integer*4 a
+ integer*4 fooint4
+ fooint4 = a + 1
+ end
+ function fooint8(a)
+ integer*8 a
+ integer*8 fooint8
+ fooint8 = a + 1
+ end
+ function foofloat4(a)
+ real*4 a
+ real*4 foofloat4
+ foofloat4 = a + 1.0e0
+ end
+ function foofloat8(a)
+ real*8 a
+ real*8 foofloat8
+ foofloat8 = a + 1.0d0
+ end
+ function foocomplex8(a)
+ complex*8 a
+ complex*8 foocomplex8
+ foocomplex8 = a + 1.0e0
+ end
+ function foocomplex16(a)
+ complex*16 a
+ complex*16 foocomplex16
+ foocomplex16 = a + 1.0d0
+ end
+ function foobool1(a)
+ logical*1 a
+ logical*1 foobool1
+ foobool1 = .not. a
+ end
+ function foobool2(a)
+ logical*2 a
+ logical*2 foobool2
+ foobool2 = .not. a
+ end
+ function foobool4(a)
+ logical*4 a
+ logical*4 foobool4
+ foobool4 = .not. a
+ end
+ function foobool8(a)
+ logical*8 a
+ logical*8 foobool8
+ foobool8 = .not. a
+ end
+ function foostring1(a)
+ character*1 a
+ character*1 foostring1
+ foostring1 = "1"
+ end
+ function foostring5(a)
+ character*5 a
+ character*5 foostring5
+ foostring5 = a
+ foostring5(1:2) = "12"
+ end
+! function foostringstar(a)
+! character*(*) a
+! character*(*) foostringstar
+! if (len(a).gt.0) then
+! foostringstar = a
+! foostringstar(1:1) = "1"
+! endif
+! end
+'''
+
+m, = compile(fortran_code, 'test_scalar_function_in_ext')
+
+from numpy import *
+
+class test_m(NumpyTestCase):
+
+ def check_foo_integer1(self, level=1):
+ i = int8(2)
+ e = int8(3)
+ func = m.fooint1
+ assert isinstance(i,int8),`type(i)`
+ r = func(i)
+ assert isinstance(r,int8),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func(2)
+ assert isinstance(r,int8),`type(r)`
+ assert_equal(r,e)
+
+ for intx in [int64,int16,int32]:
+ r = func(intx(2))
+ assert isinstance(r,int8),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.0)
+ assert isinstance(r,int8),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.2)
+ assert isinstance(r,int8),`type(r)`
+ assert_equal(r,e)
+
+ r = func([2])
+ assert isinstance(r,int8),`type(r)`
+ assert_equal(r,e)
+
+ self.assertRaises(TypeError,lambda :func(2.2j))
+ self.assertRaises(TypeError,lambda :func([2,1]))
+ self.assertRaises(TypeError,lambda :func({}))
+
+ def check_foo_integer2(self, level=1):
+ i = int16(2)
+ e = int16(3)
+ func = m.fooint2
+ assert isinstance(i,int16),`type(i)`
+ r = func(i)
+ assert isinstance(r,int16),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func(2)
+ assert isinstance(r,int16),`type(r)`
+ assert_equal(r,e)
+
+ for intx in [int8,int64,int32]:
+ r = func(intx(2))
+ assert isinstance(r,int16),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.0)
+ assert isinstance(r,int16),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.2)
+ assert isinstance(r,int16),`type(r)`
+ assert_equal(r,e)
+
+ r = func([2])
+ assert isinstance(r,int16),`type(r)`
+ assert_equal(r,e)
+
+ self.assertRaises(TypeError,lambda :func(2.2j))
+ self.assertRaises(TypeError,lambda :func([2,1]))
+ self.assertRaises(TypeError,lambda :func({}))
+
+ def check_foo_integer4(self, level=1):
+ i = int32(2)
+ e = int32(3)
+ func = m.fooint4
+ assert isinstance(i,int32),`type(i)`
+ r = func(i)
+ assert isinstance(r,int32),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func(2)
+ assert isinstance(r,int32),`type(r)`
+ assert_equal(r,e)
+
+ for intx in [int8,int16,int64]:
+ r = func(intx(2))
+ assert isinstance(r,int32),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.0)
+ assert isinstance(r,int32),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.2)
+ assert isinstance(r,int32),`type(r)`
+ assert_equal(r,e)
+
+ r = func([2])
+ assert isinstance(r,int32),`type(r)`
+ assert_equal(r,e)
+
+ self.assertRaises(TypeError,lambda :func(2.2j))
+ self.assertRaises(TypeError,lambda :func([2,1]))
+ self.assertRaises(TypeError,lambda :func({}))
+
+ def check_foo_integer8(self, level=1):
+ i = int64(2)
+ e = int64(3)
+ func = m.fooint8
+ assert isinstance(i,int64),`type(i)`
+ r = func(i)
+ assert isinstance(r,int64),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func(2)
+ assert isinstance(r,int64),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.0)
+ assert isinstance(r,int64),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.2)
+ assert isinstance(r,int64),`type(r)`
+ assert_equal(r,e)
+
+ for intx in [int8,int16,int32]:
+ r = func(intx(2))
+ assert isinstance(r,int64),`type(r)`
+ assert_equal(r,e)
+
+ r = func([2])
+ assert isinstance(r,int64),`type(r)`
+ assert_equal(r,e)
+
+ self.assertRaises(TypeError,lambda :func(2.2j))
+ self.assertRaises(TypeError,lambda :func([2,1]))
+ self.assertRaises(TypeError,lambda :func({}))
+
+ def check_foo_real4(self, level=1):
+ i = float32(2)
+ e = float32(3)
+ func = m.foofloat4
+ assert isinstance(i,float32),`type(i)`
+ r = func(i)
+ assert isinstance(r,float32),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func(2)
+ assert isinstance(r,float32),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.0)
+ assert isinstance(r,float32),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.2)
+ assert isinstance(r,float32),`type(r)`
+ assert_equal(r,e+float32(0.2))
+
+ r = func(float64(2.0))
+ assert isinstance(r,float32),`type(r)`
+ assert_equal(r,e)
+
+ r = func([2])
+ assert isinstance(r,float32),`type(r)`
+ assert_equal(r,e)
+
+ self.assertRaises(TypeError,lambda :func(2.2j))
+ self.assertRaises(TypeError,lambda :func([2,1]))
+ self.assertRaises(TypeError,lambda :func({}))
+
+ def check_foo_real8(self, level=1):
+ i = float64(2)
+ e = float64(3)
+ func = m.foofloat8
+ assert isinstance(i,float64),`type(i)`
+ r = func(i)
+ assert isinstance(r,float64),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func(2)
+ assert isinstance(r,float64),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.0)
+ assert isinstance(r,float64),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.2)
+ assert isinstance(r,float64),`type(r)`
+ assert_equal(r,e+float64(0.2))
+
+ r = func(float32(2.0))
+ assert isinstance(r,float64),`type(r)`
+ assert_equal(r,e)
+
+ r = func([2])
+ assert isinstance(r,float64),`type(r)`
+ assert_equal(r,e)
+
+ self.assertRaises(TypeError,lambda :func(2.2j))
+ self.assertRaises(TypeError,lambda :func([2,1]))
+ self.assertRaises(TypeError,lambda :func({}))
+
+ def check_foo_complex8(self, level=1):
+ i = complex64(2)
+ e = complex64(3)
+ func = m.foocomplex8
+ assert isinstance(i,complex64),`type(i)`
+ r = func(i)
+ assert isinstance(r,complex64),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func(2)
+ assert isinstance(r,complex64),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.0)
+ assert isinstance(r,complex64),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.2)
+ assert isinstance(r,complex64),`type(r)`
+ assert_equal(r,e+complex64(0.2))
+
+ r = func(2+1j)
+ assert isinstance(r,complex64),`type(r)`
+ assert_equal(r,e+complex64(1j))
+
+ r = func(complex128(2.0))
+ assert isinstance(r,complex64),`type(r)`
+ assert_equal(r,e)
+
+ r = func([2])
+ assert isinstance(r,complex64),`type(r)`
+ assert_equal(r,e)
+
+ r = func([2,3])
+ assert isinstance(r,complex64),`type(r)`
+ assert_equal(r,e+complex64(3j))
+
+ self.assertRaises(TypeError,lambda :func([2,1,3]))
+ self.assertRaises(TypeError,lambda :func({}))
+
+ def check_foo_complex16(self, level=1):
+ i = complex128(2)
+ e = complex128(3)
+ func = m.foocomplex16
+ assert isinstance(i,complex128),`type(i)`
+ r = func(i)
+ assert isinstance(r,complex128),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func(2)
+ assert isinstance(r,complex128),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.0)
+ assert isinstance(r,complex128),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.2)
+ assert isinstance(r,complex128),`type(r)`
+ assert_equal(r,e+complex128(0.2))
+
+ r = func(2+1j)
+ assert isinstance(r,complex128),`type(r)`
+ assert_equal(r,e+complex128(1j))
+
+ r = func([2])
+ assert isinstance(r,complex128),`type(r)`
+ assert_equal(r,e)
+
+ r = func([2,3])
+ assert isinstance(r,complex128),`type(r)`
+ assert_equal(r,e+complex128(3j))
+
+ r = func(complex64(2.0))
+ assert isinstance(r,complex128),`type(r)`
+ assert_equal(r,e)
+
+ self.assertRaises(TypeError,lambda :func([2,1,3]))
+ self.assertRaises(TypeError,lambda :func({}))
+
+ def check_foo_bool1(self, level=1):
+ i = bool8(True)
+ e = bool8(False)
+ func = m.foobool1
+ assert isinstance(i,bool8),`type(i)`
+ r = func(i)
+ assert isinstance(r,bool8),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ for tv in [1,2,2.1,-1j,[0],True]:
+ r = func(tv)
+ assert isinstance(r,bool8),`type(r)`
+ assert_equal(r,e)
+
+ for fv in [0,0.0,0j,False,(),{},[]]:
+ r = func(fv)
+ assert isinstance(r,bool8),`type(r)`
+ assert_equal(r,not e)
+
+ def check_foo_bool2(self, level=1):
+ i = bool8(True)
+ e = bool8(False)
+ func = m.foobool2
+ assert isinstance(i,bool8),`type(i)`
+ r = func(i)
+ assert isinstance(r,bool8),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ for tv in [1,2,2.1,-1j,[0],True]:
+ r = func(tv)
+ assert isinstance(r,bool8),`type(r)`
+ assert_equal(r,e)
+
+ for fv in [0,0.0,0j,False,(),{},[]]:
+ r = func(fv)
+ assert isinstance(r,bool8),`type(r)`
+ assert_equal(r,not e)
+
+ def check_foo_bool4(self, level=1):
+ i = bool8(True)
+ e = bool8(False)
+ func = m.foobool4
+ assert isinstance(i,bool8),`type(i)`
+ r = func(i)
+ assert isinstance(r,bool8),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ for tv in [1,2,2.1,-1j,[0],True]:
+ r = func(tv)
+ assert isinstance(r,bool8),`type(r)`
+ assert_equal(r,e)
+
+ for fv in [0,0.0,0j,False,(),{},[]]:
+ r = func(fv)
+ assert isinstance(r,bool8),`type(r)`
+ assert_equal(r,not e)
+
+ def check_foo_bool8(self, level=1):
+ i = bool8(True)
+ e = bool8(False)
+ func = m.foobool8
+ assert isinstance(i,bool8),`type(i)`
+ r = func(i)
+ assert isinstance(r,bool8),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ for tv in [1,2,2.1,-1j,[0],True]:
+ r = func(tv)
+ assert isinstance(r,bool8),`type(r)`
+ assert_equal(r,e)
+
+ for fv in [0,0.0,0j,False,(),{},[]]:
+ r = func(fv)
+ assert isinstance(r,bool8),`type(r)`
+ assert_equal(r,not e)
+
+ def check_foo_string1(self, level=1):
+ i = string0('a')
+ e = string0('1')
+ func = m.foostring1
+ assert isinstance(i,string0),`type(i)`
+ r = func(i)
+ assert isinstance(r,string0),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func('ab')
+ assert isinstance(r,string0),`type(r)`
+ assert_equal(r,e)
+
+ r = func('')
+ assert isinstance(r,string0),`type(r)`
+ assert_equal(r,e)
+
+ def check_foo_string5(self, level=1):
+ i = string0('abcde')
+ e = string0('12cde')
+ func = m.foostring5
+ assert isinstance(i,string0),`type(i)`
+ r = func(i)
+ assert isinstance(r,string0),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func('abc')
+ assert isinstance(r,string0),`type(r)`
+ assert_equal(r,'12c ')
+
+ r = func('abcdefghi')
+ assert isinstance(r,string0),`type(r)`
+ assert_equal(r,'12cde')
+
+ r = func([1])
+ assert isinstance(r,string0),`type(r)`
+ assert_equal(r,'12] ')
+
+ def _check_foo_string0(self, level=1):
+ i = string0('abcde')
+ e = string0('12cde')
+ func = m.foostringstar
+ r = func('abcde')
+ assert_equal(r,'1bcde')
+ r = func('')
+ assert_equal(r,'')
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/f2py/lib/tests/test_scalar_in_out.py b/numpy/f2py/lib/tests/test_scalar_in_out.py
new file mode 100644
index 000000000..b73036848
--- /dev/null
+++ b/numpy/f2py/lib/tests/test_scalar_in_out.py
@@ -0,0 +1,529 @@
+#!/usr/bin/env python
+"""
+Tests for intent(in,out) arguments in Fortran subroutine's.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: Oct 2006
+-----
+"""
+
+import os
+import sys
+from numpy.testing import *
+
+set_package_path()
+from lib.main import build_extension, compile
+restore_path()
+
+fortran_code = '''
+ subroutine fooint1(a)
+ integer*1 a
+!f2py intent(in,out) a
+ a = a + 1
+ end
+ subroutine fooint2(a)
+ integer*2 a
+!f2py intent(in,out) a
+ a = a + 1
+ end
+ subroutine fooint4(a)
+ integer*4 a
+!f2py intent(in,out) a
+ a = a + 1
+ end
+ subroutine fooint8(a)
+ integer*8 a
+!f2py intent(in,out) a
+ a = a + 1
+ end
+ subroutine foofloat4(a)
+ real*4 a
+!f2py intent(in,out) a
+ a = a + 1.0e0
+ end
+ subroutine foofloat8(a)
+ real*8 a
+!f2py intent(in,out) a
+ a = a + 1.0d0
+ end
+ subroutine foocomplex8(a)
+ complex*8 a
+!f2py intent(in,out) a
+ a = a + 1.0e0
+ end
+ subroutine foocomplex16(a)
+ complex*16 a
+!f2py intent(in,out) a
+ a = a + 1.0d0
+ end
+ subroutine foobool1(a)
+ logical*1 a
+!f2py intent(in,out) a
+ a = .not. a
+ end
+ subroutine foobool2(a)
+ logical*2 a
+!f2py intent(in,out) a
+ a = .not. a
+ end
+ subroutine foobool4(a)
+ logical*4 a
+!f2py intent(in,out) a
+ a = .not. a
+ end
+ subroutine foobool8(a)
+ logical*8 a
+!f2py intent(in,out) a
+ a = .not. a
+ end
+ subroutine foostring1(a)
+ character*1 a
+!f2py intent(in,out) a
+ a = "1"
+ end
+ subroutine foostring5(a)
+ character*5 a
+!f2py intent(in,out) a
+ a(1:2) = "12"
+ end
+ subroutine foostringstar(a)
+ character*(*) a
+!f2py intent(in,out) a
+ if (len(a).gt.0) then
+ a(1:1) = "1"
+ endif
+ end
+'''
+
+m, = compile(fortran_code, 'test_scalar_in_out_ext', source_ext = '.f')
+
+from numpy import *
+
+class test_m(NumpyTestCase):
+
+ def check_foo_integer1(self, level=1):
+ i = int8(2)
+ e = int8(3)
+ func = m.fooint1
+ assert isinstance(i,int8),`type(i)`
+ r = func(i)
+ assert isinstance(r,int8),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func(2)
+ assert isinstance(r,int8),`type(r)`
+ assert_equal(r,e)
+
+ for intx in [int64,int16,int32]:
+ r = func(intx(2))
+ assert isinstance(r,int8),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.0)
+ assert isinstance(r,int8),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.2)
+ assert isinstance(r,int8),`type(r)`
+ assert_equal(r,e)
+
+ r = func([2])
+ assert isinstance(r,int8),`type(r)`
+ assert_equal(r,e)
+
+ self.assertRaises(TypeError,lambda :func(2.2j))
+ self.assertRaises(TypeError,lambda :func([2,1]))
+ self.assertRaises(TypeError,lambda :func({}))
+
+ def check_foo_integer2(self, level=1):
+ i = int16(2)
+ e = int16(3)
+ func = m.fooint2
+ assert isinstance(i,int16),`type(i)`
+ r = func(i)
+ assert isinstance(r,int16),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func(2)
+ assert isinstance(r,int16),`type(r)`
+ assert_equal(r,e)
+
+ for intx in [int8,int64,int32]:
+ r = func(intx(2))
+ assert isinstance(r,int16),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.0)
+ assert isinstance(r,int16),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.2)
+ assert isinstance(r,int16),`type(r)`
+ assert_equal(r,e)
+
+ r = func([2])
+ assert isinstance(r,int16),`type(r)`
+ assert_equal(r,e)
+
+ self.assertRaises(TypeError,lambda :func(2.2j))
+ self.assertRaises(TypeError,lambda :func([2,1]))
+ self.assertRaises(TypeError,lambda :func({}))
+
+ def check_foo_integer4(self, level=1):
+ i = int32(2)
+ e = int32(3)
+ func = m.fooint4
+ assert isinstance(i,int32),`type(i)`
+ r = func(i)
+ assert isinstance(r,int32),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func(2)
+ assert isinstance(r,int32),`type(r)`
+ assert_equal(r,e)
+
+ for intx in [int8,int16,int64]:
+ r = func(intx(2))
+ assert isinstance(r,int32),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.0)
+ assert isinstance(r,int32),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.2)
+ assert isinstance(r,int32),`type(r)`
+ assert_equal(r,e)
+
+ r = func([2])
+ assert isinstance(r,int32),`type(r)`
+ assert_equal(r,e)
+
+ self.assertRaises(TypeError,lambda :func(2.2j))
+ self.assertRaises(TypeError,lambda :func([2,1]))
+ self.assertRaises(TypeError,lambda :func({}))
+
+ def check_foo_integer8(self, level=1):
+ i = int64(2)
+ e = int64(3)
+ func = m.fooint8
+ assert isinstance(i,int64),`type(i)`
+ r = func(i)
+ assert isinstance(r,int64),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func(2)
+ assert isinstance(r,int64),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.0)
+ assert isinstance(r,int64),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.2)
+ assert isinstance(r,int64),`type(r)`
+ assert_equal(r,e)
+
+ for intx in [int8,int16,int32]:
+ r = func(intx(2))
+ assert isinstance(r,int64),`type(r)`
+ assert_equal(r,e)
+
+ r = func([2])
+ assert isinstance(r,int64),`type(r)`
+ assert_equal(r,e)
+
+ self.assertRaises(TypeError,lambda :func(2.2j))
+ self.assertRaises(TypeError,lambda :func([2,1]))
+ self.assertRaises(TypeError,lambda :func({}))
+
+ def check_foo_real4(self, level=1):
+ i = float32(2)
+ e = float32(3)
+ func = m.foofloat4
+ assert isinstance(i,float32),`type(i)`
+ r = func(i)
+ assert isinstance(r,float32),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func(2)
+ assert isinstance(r,float32),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.0)
+ assert isinstance(r,float32),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.2)
+ assert isinstance(r,float32),`type(r)`
+ assert_equal(r,e+float32(0.2))
+
+ r = func(float64(2.0))
+ assert isinstance(r,float32),`type(r)`
+ assert_equal(r,e)
+
+ r = func([2])
+ assert isinstance(r,float32),`type(r)`
+ assert_equal(r,e)
+
+ self.assertRaises(TypeError,lambda :func(2.2j))
+ self.assertRaises(TypeError,lambda :func([2,1]))
+ self.assertRaises(TypeError,lambda :func({}))
+
+ def check_foo_real8(self, level=1):
+ i = float64(2)
+ e = float64(3)
+ func = m.foofloat8
+ assert isinstance(i,float64),`type(i)`
+ r = func(i)
+ assert isinstance(r,float64),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func(2)
+ assert isinstance(r,float64),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.0)
+ assert isinstance(r,float64),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.2)
+ assert isinstance(r,float64),`type(r)`
+ assert_equal(r,e+float64(0.2))
+
+ r = func(float32(2.0))
+ assert isinstance(r,float64),`type(r)`
+ assert_equal(r,e)
+
+ r = func([2])
+ assert isinstance(r,float64),`type(r)`
+ assert_equal(r,e)
+
+ self.assertRaises(TypeError,lambda :func(2.2j))
+ self.assertRaises(TypeError,lambda :func([2,1]))
+ self.assertRaises(TypeError,lambda :func({}))
+
+ def check_foo_complex8(self, level=1):
+ i = complex64(2)
+ e = complex64(3)
+ func = m.foocomplex8
+ assert isinstance(i,complex64),`type(i)`
+ r = func(i)
+ assert isinstance(r,complex64),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func(2)
+ assert isinstance(r,complex64),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.0)
+ assert isinstance(r,complex64),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.2)
+ assert isinstance(r,complex64),`type(r)`
+ assert_equal(r,e+complex64(0.2))
+
+ r = func(2+1j)
+ assert isinstance(r,complex64),`type(r)`
+ assert_equal(r,e+complex64(1j))
+
+ r = func(complex128(2.0))
+ assert isinstance(r,complex64),`type(r)`
+ assert_equal(r,e)
+
+ r = func([2])
+ assert isinstance(r,complex64),`type(r)`
+ assert_equal(r,e)
+
+ r = func([2,3])
+ assert isinstance(r,complex64),`type(r)`
+ assert_equal(r,e+complex64(3j))
+
+ self.assertRaises(TypeError,lambda :func([2,1,3]))
+ self.assertRaises(TypeError,lambda :func({}))
+
+ def check_foo_complex16(self, level=1):
+ i = complex128(2)
+ e = complex128(3)
+ func = m.foocomplex16
+ assert isinstance(i,complex128),`type(i)`
+ r = func(i)
+ assert isinstance(r,complex128),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func(2)
+ assert isinstance(r,complex128),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.0)
+ assert isinstance(r,complex128),`type(r)`
+ assert_equal(r,e)
+
+ r = func(2.2)
+ assert isinstance(r,complex128),`type(r)`
+ assert_equal(r,e+complex128(0.2))
+
+ r = func(2+1j)
+ assert isinstance(r,complex128),`type(r)`
+ assert_equal(r,e+complex128(1j))
+
+ r = func([2])
+ assert isinstance(r,complex128),`type(r)`
+ assert_equal(r,e)
+
+ r = func([2,3])
+ assert isinstance(r,complex128),`type(r)`
+ assert_equal(r,e+complex128(3j))
+
+ r = func(complex64(2.0))
+ assert isinstance(r,complex128),`type(r)`
+ assert_equal(r,e)
+
+ self.assertRaises(TypeError,lambda :func([2,1,3]))
+ self.assertRaises(TypeError,lambda :func({}))
+
+ def check_foo_bool1(self, level=1):
+ i = bool8(True)
+ e = bool8(False)
+ func = m.foobool1
+ assert isinstance(i,bool8),`type(i)`
+ r = func(i)
+ assert isinstance(r,bool8),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ for tv in [1,2,2.1,-1j,[0],True]:
+ r = func(tv)
+ assert isinstance(r,bool8),`type(r)`
+ assert_equal(r,e)
+
+ for fv in [0,0.0,0j,False,(),{},[]]:
+ r = func(fv)
+ assert isinstance(r,bool8),`type(r)`
+ assert_equal(r,not e)
+
+ def check_foo_bool2(self, level=1):
+ i = bool8(True)
+ e = bool8(False)
+ func = m.foobool2
+ assert isinstance(i,bool8),`type(i)`
+ r = func(i)
+ assert isinstance(r,bool8),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ for tv in [1,2,2.1,-1j,[0],True]:
+ r = func(tv)
+ assert isinstance(r,bool8),`type(r)`
+ assert_equal(r,e)
+
+ for fv in [0,0.0,0j,False,(),{},[]]:
+ r = func(fv)
+ assert isinstance(r,bool8),`type(r)`
+ assert_equal(r,not e)
+
+ def check_foo_bool4(self, level=1):
+ i = bool8(True)
+ e = bool8(False)
+ func = m.foobool4
+ assert isinstance(i,bool8),`type(i)`
+ r = func(i)
+ assert isinstance(r,bool8),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ for tv in [1,2,2.1,-1j,[0],True]:
+ r = func(tv)
+ assert isinstance(r,bool8),`type(r)`
+ assert_equal(r,e)
+
+ for fv in [0,0.0,0j,False,(),{},[]]:
+ r = func(fv)
+ assert isinstance(r,bool8),`type(r)`
+ assert_equal(r,not e)
+
+ def check_foo_bool8(self, level=1):
+ i = bool8(True)
+ e = bool8(False)
+ func = m.foobool8
+ assert isinstance(i,bool8),`type(i)`
+ r = func(i)
+ assert isinstance(r,bool8),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ for tv in [1,2,2.1,-1j,[0],True]:
+ r = func(tv)
+ assert isinstance(r,bool8),`type(r)`
+ assert_equal(r,e)
+
+ for fv in [0,0.0,0j,False,(),{},[]]:
+ r = func(fv)
+ assert isinstance(r,bool8),`type(r)`
+ assert_equal(r,not e)
+
+ def check_foo_string1(self, level=1):
+ i = string0('a')
+ e = string0('1')
+ func = m.foostring1
+ assert isinstance(i,string0),`type(i)`
+ r = func(i)
+ assert isinstance(r,string0),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func('ab')
+ assert isinstance(r,string0),`type(r)`
+ assert_equal(r,e)
+
+ r = func('')
+ assert isinstance(r,string0),`type(r)`
+ assert_equal(r,e)
+
+ def check_foo_string5(self, level=1):
+ i = string0('abcde')
+ e = string0('12cde')
+ func = m.foostring5
+ assert isinstance(i,string0),`type(i)`
+ r = func(i)
+ assert isinstance(r,string0),`type(r)`
+ assert i is not r,`id(i),id(r)`
+ assert_equal(r,e)
+
+ r = func('abc')
+ assert isinstance(r,string0),`type(r)`
+ assert_equal(r,'12c ')
+
+ r = func('abcdefghi')
+ assert isinstance(r,string0),`type(r)`
+ assert_equal(r,'12cde')
+
+ r = func([1])
+ assert isinstance(r,string0),`type(r)`
+ assert_equal(r,'12] ')
+
+ def check_foo_string0(self, level=1):
+ i = string0('abcde')
+ e = string0('12cde')
+ func = m.foostringstar
+ r = func('abcde')
+ assert_equal(r,'1bcde')
+ r = func('')
+ assert_equal(r,'')
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/f2py/lib/wrapper_base.py b/numpy/f2py/lib/wrapper_base.py
new file mode 100644
index 000000000..3164e817f
--- /dev/null
+++ b/numpy/f2py/lib/wrapper_base.py
@@ -0,0 +1,178 @@
+import os
+import sys
+import re
+
+__all__ = ['WrapperBase','WrapperCPPMacro','WrapperCCode']
+
+class WrapperBase:
+
+ def __init__(self):
+ self.srcdir = os.path.join(os.path.dirname(__file__),'src')
+ return
+ def warning(self, message):
+ print >> sys.stderr, message
+ def info(self, message):
+ print >> sys.stderr, message
+
+ def get_resource_content(self, name, ext):
+ if name.startswith('pyobj_to_'):
+ try:
+ return self.generate_pyobj_to_ctype_c(name[9:])
+ except NotImplementedError:
+ pass
+ elif name.startswith('pyobj_from_'):
+ try:
+ return self.generate_pyobj_from_ctype_c(name[11:])
+ except NotImplementedError:
+ pass
+ generator_mth_name = 'generate_' + name + ext.replace('.','_')
+ generator_mth = getattr(self, generator_mth_name, lambda : None)
+ body = generator_mth()
+ if body is not None:
+ return body
+ fn = os.path.join(self.srcdir,name+ext)
+ if os.path.isfile(fn):
+ f = open(fn,'r')
+ body = f.read()
+ f.close()
+ return body
+ self.warning('No such file: %r' % (fn))
+ return
+
+ def get_dependencies(self, code):
+ l = []
+ for uses in re.findall(r'(?<=depends:)([,\w\s.]+)', code, re.I):
+ for use in uses.split(','):
+ use = use.strip()
+ if not use: continue
+ l.append(use)
+ return l
+
+ def resolve_dependencies(self, parent, body):
+ assert isinstance(body, str),type(body)
+ for d in self.get_dependencies(body):
+ if d.endswith('.cpp'):
+ WrapperCPPMacro(parent, d[:-4])
+ elif d.endswith('.c'):
+ WrapperCCode(parent, d[:-2])
+ else:
+ self.warning('Unknown dependence: %r.' % (d))
+ return
+
+ def apply_attributes(self, template):
+ """
+ Apply instance attributes to template string.
+
+ Replace rules for attributes:
+ _list - will be joined with newline
+ _clist - _list will be joined with comma
+ _elist - _list will be joined
+ ..+.. - attributes will be added
+ [..] - will be evaluated
+ """
+ replace_names = set(re.findall(r'[ ]*%\(.*?\)s', template))
+ d = {}
+ for name in replace_names:
+ tab = ' ' * (len(name)-len(name.lstrip()))
+ name = name.lstrip()[2:-2]
+ names = name.split('+')
+ joinsymbol = '\n'
+ attrs = None
+ for n in names:
+ realname = n.strip()
+ if n.endswith('_clist'):
+ joinsymbol = ', '
+ realname = realname[:-6] + '_list'
+ elif n.endswith('_elist'):
+ joinsymbol = ''
+ realname = realname[:-6] + '_list'
+ realname_lower = realname.lower()
+ parent = getattr(self,'parent',None)
+ if hasattr(self, realname):
+ attr = getattr(self, realname)
+ elif hasattr(self, realname_lower):
+ attr = getattr(self, realname_lower).upper()
+ elif hasattr(parent, realname):
+ attr = getattr(parent, realname)
+ elif hasattr(parent, realname_lower):
+ attr = getattr(parent, realname_lower).upper()
+ elif realname.startswith('['):
+ attr = eval(realname)
+ else:
+ self.warning('Undefined %r attribute: %r' % (self.__class__.__name__, realname))
+ continue
+ if attrs is None:
+ attrs = attr
+ else:
+ attrs += attr
+ if isinstance(attrs, list):
+ attrs = joinsymbol.join(attrs)
+ d[name] = str(attrs).replace('\n','\n'+tab)
+ return template % d
+
+ def apply_templates(self, child):
+ for n in self.list_names:
+ l = getattr(self,n + '_list')
+ c = child.apply_attributes(getattr(child, n+'_template',''))
+ if c:
+ l.append(c)
+ return
+
+class WrapperCPPMacro(WrapperBase):
+ """
+ CPP macros
+ """
+ def __init__(self, parent, name):
+ WrapperBase.__init__(self)
+ defined = parent.defined_cpp_code
+ if name in defined:
+ return
+ defined.append(name)
+
+ body = self.get_resource_content(name,'.cpp')
+ if body is None:
+ self.warning('Failed to get CPP macro %r content.' % (name))
+ return
+ self.resolve_dependencies(parent, body)
+ parent.header_list.append(body)
+ return
+
+class WrapperCCode(WrapperBase):
+ """
+ C code
+ """
+ def __init__(self, parent, name):
+ WrapperBase.__init__(self)
+ defined = parent.defined_c_code
+ if name in defined:
+ return
+ defined.append(name)
+
+ body = self.get_resource_content(name,'.c')
+ if body is None:
+ self.warning('Failed to get C code %r content.' % (name))
+ return
+ if isinstance(body, dict):
+ for k,v in body.items():
+ self.resolve_dependencies(parent, v)
+ for k,v in body.items():
+ l = getattr(parent,k+'_list')
+ l.append(v)
+ else:
+ self.resolve_dependencies(parent, body)
+ parent.c_code_list.append(body)
+ return
+
+ def generate_pyobj_to_ctype_c(self, ctype):
+ from generate_pyobj_tofrom_funcs import pyobj_to_npy_scalar, pyobj_to_f2py_string
+ if ctype.startswith('npy_'):
+ return pyobj_to_npy_scalar(ctype)
+ elif ctype.startswith('f2py_string'):
+ return pyobj_to_f2py_string(ctype)
+ raise NotImplementedError,`ctype`
+
+ def generate_pyobj_from_ctype_c(self, ctype):
+ from generate_pyobj_tofrom_funcs import pyobj_from_npy_scalar
+ if ctype.startswith('npy_'):
+ return pyobj_from_npy_scalar(ctype)
+ raise NotImplementedError,`ctype`
diff --git a/numpy/f2py/rules.py b/numpy/f2py/rules.py
new file mode 100644
index 000000000..d1eb4016e
--- /dev/null
+++ b/numpy/f2py/rules.py
@@ -0,0 +1,1344 @@
+#!/usr/bin/env python
+"""
+
+Rules for building C/API module with f2py2e.
+
+Here is a skeleton of a new wrapper function (13Dec2001):
+
+wrapper_function(args)
+ declarations
+ get_python_arguments, say, `a' and `b'
+
+ get_a_from_python
+ if (successful) {
+
+ get_b_from_python
+ if (successful) {
+
+ callfortran
+ if (succesful) {
+
+ put_a_to_python
+ if (succesful) {
+
+ put_b_to_python
+ if (succesful) {
+
+ buildvalue = ...
+
+ }
+
+ }
+
+ }
+
+ }
+ cleanup_b
+
+ }
+ cleanup_a
+
+ return buildvalue
+"""
+"""
+Copyright 1999,2000 Pearu Peterson all rights reserved,
+Pearu Peterson <pearu@ioc.ee>
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+$Date: 2005/08/30 08:58:42 $
+Pearu Peterson
+"""
+
+__version__ = "$Revision: 1.129 $"[10:-1]
+
+import __version__
+f2py_version = __version__.version
+
+import pprint
+import sys,string,time,types,copy
+errmess=sys.stderr.write
+outmess=sys.stdout.write
+show=pprint.pprint
+
+from auxfuncs import *
+import capi_maps
+from capi_maps import *
+import cfuncs
+import common_rules
+import use_rules
+import f90mod_rules
+import func2subr
+options={}
+
+sepdict={}
+#for k in ['need_cfuncs']: sepdict[k]=','
+for k in ['decl',
+ 'frompyobj',
+ 'cleanupfrompyobj',
+ 'topyarr','method',
+ 'pyobjfrom','closepyobjfrom',
+ 'freemem',
+ 'userincludes',
+ 'includes0','includes','typedefs','typedefs_generated',
+ 'cppmacros','cfuncs','callbacks',
+ 'latexdoc',
+ 'restdoc',
+ 'routine_defs','externroutines',
+ 'initf2pywraphooks',
+ 'commonhooks','initcommonhooks',
+ 'f90modhooks','initf90modhooks']:
+ sepdict[k]='\n'
+
+#################### Rules for C/API module #################
+
+module_rules={
+ 'modulebody':"""\
+/* File: #modulename#module.c
+ * This file is auto-generated with f2py (version:#f2py_version#).
+ * f2py is a Fortran to Python Interface Generator (FPIG), Second Edition,
+ * written by Pearu Peterson <pearu@cens.ioc.ee>.
+ * See http://cens.ioc.ee/projects/f2py2e/
+ * Generation date: """+time.asctime(time.localtime(time.time()))+"""
+ * $R"""+"""evision:$
+ * $D"""+"""ate:$
+ * Do not edit this file directly unless you know what you are doing!!!
+ */
+#ifdef __cplusplus
+extern \"C\" {
+#endif
+
+"""+gentitle("See f2py2e/cfuncs.py: includes")+"""
+#includes#
+#includes0#
+
+"""+gentitle("See f2py2e/rules.py: mod_rules['modulebody']")+"""
+static PyObject *#modulename#_error;
+static PyObject *#modulename#_module;
+
+"""+gentitle("See f2py2e/cfuncs.py: typedefs")+"""
+#typedefs#
+
+"""+gentitle("See f2py2e/cfuncs.py: typedefs_generated")+"""
+#typedefs_generated#
+
+"""+gentitle("See f2py2e/cfuncs.py: cppmacros")+"""
+#cppmacros#
+
+"""+gentitle("See f2py2e/cfuncs.py: cfuncs")+"""
+#cfuncs#
+
+"""+gentitle("See f2py2e/cfuncs.py: userincludes")+"""
+#userincludes#
+
+"""+gentitle("See f2py2e/capi_rules.py: usercode")+"""
+#usercode#
+
+/* See f2py2e/rules.py */
+#externroutines#
+
+"""+gentitle("See f2py2e/capi_rules.py: usercode1")+"""
+#usercode1#
+
+"""+gentitle("See f2py2e/cb_rules.py: buildcallback")+"""
+#callbacks#
+
+"""+gentitle("See f2py2e/rules.py: buildapi")+"""
+#body#
+
+"""+gentitle("See f2py2e/f90mod_rules.py: buildhooks")+"""
+#f90modhooks#
+
+"""+gentitle("See f2py2e/rules.py: module_rules['modulebody']")+"""
+
+"""+gentitle("See f2py2e/common_rules.py: buildhooks")+"""
+#commonhooks#
+
+"""+gentitle("See f2py2e/rules.py")+"""
+
+static FortranDataDef f2py_routine_defs[] = {
+#routine_defs#
+\t{NULL}
+};
+
+static PyMethodDef f2py_module_methods[] = {
+#pymethoddef#
+\t{NULL,NULL}
+};
+
+PyMODINIT_FUNC init#modulename#(void) {
+\tint i;
+\tPyObject *m,*d, *s;
+\tm = #modulename#_module = Py_InitModule(\"#modulename#\", f2py_module_methods);
+\tPyFortran_Type.ob_type = &PyType_Type;
+\timport_array();
+\tif (PyErr_Occurred())
+\t\t{PyErr_SetString(PyExc_ImportError, \"can't initialize module #modulename# (failed to import numpy)\"); return;}
+\td = PyModule_GetDict(m);
+\ts = PyString_FromString(\"$R"""+"""evision: $\");
+\tPyDict_SetItemString(d, \"__version__\", s);
+\ts = PyString_FromString(\"This module '#modulename#' is auto-generated with f2py (version:#f2py_version#).\\nFunctions:\\n\"\n#docs#\".\");
+\tPyDict_SetItemString(d, \"__doc__\", s);
+\t#modulename#_error = PyErr_NewException (\"#modulename#.error\", NULL, NULL);
+\tPy_DECREF(s);
+\tfor(i=0;f2py_routine_defs[i].name!=NULL;i++)
+\t\tPyDict_SetItemString(d, f2py_routine_defs[i].name,PyFortranObject_NewAsAttr(&f2py_routine_defs[i]));
+#initf2pywraphooks#
+#initf90modhooks#
+#initcommonhooks#
+#interface_usercode#
+
+#ifdef F2PY_REPORT_ATEXIT
+\tif (! PyErr_Occurred())
+\t\ton_exit(f2py_report_on_exit,(void*)\"#modulename#\");
+#endif
+
+}
+#ifdef __cplusplus
+}
+#endif
+""",
+ 'separatorsfor':{'latexdoc':'\n\n',
+ 'restdoc':'\n\n'},
+ 'latexdoc':['\\section{Module \\texttt{#texmodulename#}}\n',
+ '#modnote#\n',
+ '#latexdoc#'],
+ 'restdoc':['Module #modulename#\n'+'='*80,
+ '\n#restdoc#']
+ }
+
+defmod_rules=[
+ {'body':'/*eof body*/',
+ 'method':'/*eof method*/',
+ 'externroutines':'/*eof externroutines*/',
+ 'routine_defs':'/*eof routine_defs*/',
+ 'initf90modhooks':'/*eof initf90modhooks*/',
+ 'initf2pywraphooks':'/*eof initf2pywraphooks*/',
+ 'initcommonhooks':'/*eof initcommonhooks*/',
+ 'latexdoc':'',
+ 'restdoc':'',
+ 'modnote':{hasnote:'#note#',l_not(hasnote):''},
+ }
+ ]
+
+routine_rules={
+ 'separatorsfor':sepdict,
+ 'body':"""
+#begintitle#
+static char doc_#apiname#[] = \"\\\nFunction signature:\\n\\\n\t#docreturn##name#(#docsignatureshort#)\\n\\\n#docstrsigns#\";
+/* #declfortranroutine# */
+static PyObject *#apiname#(const PyObject *capi_self,
+ PyObject *capi_args,
+ PyObject *capi_keywds,
+ #functype# (*f2py_func)(#callprotoargument#)) {
+\tPyObject * volatile capi_buildvalue = NULL;
+\tvolatile int f2py_success = 1;
+#decl#
+\tstatic char *capi_kwlist[] = {#kwlist##kwlistopt##kwlistxa#NULL};
+#usercode#
+#routdebugenter#
+#ifdef F2PY_REPORT_ATEXIT
+f2py_start_clock();
+#endif
+\tif (!PyArg_ParseTupleAndKeywords(capi_args,capi_keywds,\\
+\t\t\"#argformat#|#keyformat##xaformat#:#pyname#\",\\
+\t\tcapi_kwlist#args_capi##keys_capi##keys_xa#))\n\t\treturn NULL;
+#frompyobj#
+/*end of frompyobj*/
+#ifdef F2PY_REPORT_ATEXIT
+f2py_start_call_clock();
+#endif
+#callfortranroutine#
+if (PyErr_Occurred())
+ f2py_success = 0;
+#ifdef F2PY_REPORT_ATEXIT
+f2py_stop_call_clock();
+#endif
+/*end of callfortranroutine*/
+\t\tif (f2py_success) {
+#pyobjfrom#
+/*end of pyobjfrom*/
+\t\tCFUNCSMESS(\"Building return value.\\n\");
+\t\tcapi_buildvalue = Py_BuildValue(\"#returnformat#\"#return#);
+/*closepyobjfrom*/
+#closepyobjfrom#
+\t\t} /*if (f2py_success) after callfortranroutine*/
+/*cleanupfrompyobj*/
+#cleanupfrompyobj#
+\tif (capi_buildvalue == NULL) {
+#routdebugfailure#
+\t} else {
+#routdebugleave#
+\t}
+\tCFUNCSMESS(\"Freeing memory.\\n\");
+#freemem#
+#ifdef F2PY_REPORT_ATEXIT
+f2py_stop_clock();
+#endif
+\treturn capi_buildvalue;
+}
+#endtitle#
+""",
+ 'routine_defs':'#routine_def#',
+ 'initf2pywraphooks':'#initf2pywraphook#',
+ 'externroutines':'#declfortranroutine#',
+ 'doc':'#docreturn##name#(#docsignature#)',
+ 'docshort':'#docreturn##name#(#docsignatureshort#)',
+ 'docs':'"\t#docreturn##name#(#docsignature#)\\n"\n',
+ 'need':['arrayobject.h','CFUNCSMESS','MINMAX'],
+ 'cppmacros':{debugcapi:'#define DEBUGCFUNCS'},
+ 'latexdoc':['\\subsection{Wrapper function \\texttt{#texname#}}\n',
+ """
+\\noindent{{}\\verb@#docreturn##name#@{}}\\texttt{(#latexdocsignatureshort#)}
+#routnote#
+
+#latexdocstrsigns#
+"""],
+ 'restdoc':['Wrapped function ``#name#``\n'+'-'*80,
+
+ ]
+ }
+
+################## Rules for C/API function ##############
+
+rout_rules=[
+ { # Init
+ 'separatorsfor': {'callfortranroutine':'\n','routdebugenter':'\n','decl':'\n',
+ 'routdebugleave':'\n','routdebugfailure':'\n',
+ 'setjmpbuf':' || ',
+ 'docstrreq':'\n','docstropt':'\n','docstrout':'\n',
+ 'docstrcbs':'\n','docstrsigns':'\\n"\n"',
+ 'latexdocstrsigns':'\n',
+ 'latexdocstrreq':'\n','latexdocstropt':'\n',
+ 'latexdocstrout':'\n','latexdocstrcbs':'\n',
+ },
+ 'kwlist':'','kwlistopt':'','callfortran':'','callfortranappend':'',
+ 'docsign':'','docsignopt':'','decl':'/*decl*/',
+ 'freemem':'/*freemem*/',
+ 'docsignshort':'','docsignoptshort':'',
+ 'docstrsigns':'','latexdocstrsigns':'',
+ 'docstrreq':'Required arguments:',
+ 'docstropt':'Optional arguments:',
+ 'docstrout':'Return objects:',
+ 'docstrcbs':'Call-back functions:',
+ 'latexdocstrreq':'\\noindent Required arguments:',
+ 'latexdocstropt':'\\noindent Optional arguments:',
+ 'latexdocstrout':'\\noindent Return objects:',
+ 'latexdocstrcbs':'\\noindent Call-back functions:',
+ 'args_capi':'','keys_capi':'','functype':'',
+ 'frompyobj':'/*frompyobj*/',
+ 'cleanupfrompyobj':['/*end of cleanupfrompyobj*/'], #this list will be reversed
+ 'pyobjfrom':'/*pyobjfrom*/',
+ 'closepyobjfrom':['/*end of closepyobjfrom*/'], #this list will be reversed
+ 'topyarr':'/*topyarr*/','routdebugleave':'/*routdebugleave*/',
+ 'routdebugenter':'/*routdebugenter*/',
+ 'routdebugfailure':'/*routdebugfailure*/',
+ 'callfortranroutine':'/*callfortranroutine*/',
+ 'argformat':'','keyformat':'','need_cfuncs':'',
+ 'docreturn':'','return':'','returnformat':'','rformat':'',
+ 'kwlistxa':'','keys_xa':'','xaformat':'','docsignxa':'','docsignxashort':'',
+ 'initf2pywraphook':'',
+ 'routnote':{hasnote:'--- #note#',l_not(hasnote):''},
+ },{
+ 'apiname':'f2py_rout_#modulename#_#name#',
+ 'pyname':'#modulename#.#name#',
+ 'decl':'',
+ '_check':l_not(ismoduleroutine)
+ },{
+ 'apiname':'f2py_rout_#modulename#_#f90modulename#_#name#',
+ 'pyname':'#modulename#.#f90modulename#.#name#',
+ 'decl':'',
+ '_check':ismoduleroutine
+ },{ # Subroutine
+ 'functype':'void',
+ 'declfortranroutine':{l_and(l_not(l_or(ismoduleroutine,isintent_c)),l_not(isdummyroutine)):'extern void #F_FUNC#(#fortranname#,#FORTRANNAME#)(#callprotoargument#);',
+ l_and(l_not(ismoduleroutine),isintent_c,l_not(isdummyroutine)):'extern void #fortranname#(#callprotoargument#);',
+ ismoduleroutine:'',
+ isdummyroutine:''
+ },
+ 'routine_def':{l_not(l_or(ismoduleroutine,isintent_c,isdummyroutine)):'\t{\"#name#\",-1,{{-1}},0,(char *)#F_FUNC#(#fortranname#,#FORTRANNAME#),(f2py_init_func)#apiname#,doc_#apiname#},',
+ l_and(l_not(ismoduleroutine),isintent_c,l_not(isdummyroutine)):'\t{\"#name#\",-1,{{-1}},0,(char *)#fortranname#,(f2py_init_func)#apiname#,doc_#apiname#},',
+ l_and(l_not(ismoduleroutine),isdummyroutine):'\t{\"#name#\",-1,{{-1}},0,NULL,(f2py_init_func)#apiname#,doc_#apiname#},',
+ },
+ 'need':{l_and(l_not(l_or(ismoduleroutine,isintent_c)),l_not(isdummyroutine)):'F_FUNC'},
+ 'callfortranroutine':[
+ {debugcapi:["""\tfprintf(stderr,\"debug-capi:Fortran subroutine `#fortranname#(#callfortran#)\'\\n\");"""]},
+ {hasexternals:"""\
+\t\tif (#setjmpbuf#) {
+\t\t\tf2py_success = 0;
+\t\t} else {"""},
+ {isthreadsafe:'\t\t\tPy_BEGIN_ALLOW_THREADS'},
+ {hascallstatement:'''\t\t\t\t#callstatement#;
+\t\t\t\t/*(*f2py_func)(#callfortran#);*/'''},
+ {l_not(l_or(hascallstatement,isdummyroutine)):'\t\t\t\t(*f2py_func)(#callfortran#);'},
+ {isthreadsafe:'\t\t\tPy_END_ALLOW_THREADS'},
+ {hasexternals:"""\t\t}"""}
+ ],
+ '_check':issubroutine,
+ },{ # Wrapped function
+ 'functype':'void',
+ 'declfortranroutine':{l_not(l_or(ismoduleroutine,isdummyroutine)):'extern void #F_WRAPPEDFUNC#(#name_lower#,#NAME#)(#callprotoargument#);',
+ isdummyroutine:'',
+ },
+
+ 'routine_def':{l_not(l_or(ismoduleroutine,isdummyroutine)):'\t{\"#name#\",-1,{{-1}},0,(char *)#F_WRAPPEDFUNC#(#name_lower#,#NAME#),(f2py_init_func)#apiname#,doc_#apiname#},',
+ isdummyroutine:'\t{\"#name#\",-1,{{-1}},0,NULL,(f2py_init_func)#apiname#,doc_#apiname#},',
+ },
+ 'initf2pywraphook':{l_not(l_or(ismoduleroutine,isdummyroutine)):'''
+ {
+ extern #ctype# #F_FUNC#(#name_lower#,#NAME#)(void);
+ PyObject* o = PyDict_GetItemString(d,"#name#");
+ PyObject_SetAttrString(o,"_cpointer", PyCObject_FromVoidPtr((void*)#F_FUNC#(#name_lower#,#NAME#),NULL));
+ }
+ '''},
+ 'need':{l_not(l_or(ismoduleroutine,isdummyroutine)):['F_WRAPPEDFUNC','F_FUNC']},
+ 'callfortranroutine':[
+ {debugcapi:["""\tfprintf(stderr,\"debug-capi:Fortran subroutine `f2pywrap#name_lower#(#callfortran#)\'\\n\");"""]},
+ {hasexternals:"""\
+\tif (#setjmpbuf#) {
+\t\tf2py_success = 0;
+\t} else {"""},
+ {isthreadsafe:'\tPy_BEGIN_ALLOW_THREADS'},
+ {l_not(l_or(hascallstatement,isdummyroutine)):'\t(*f2py_func)(#callfortran#);'},
+ {hascallstatement:'\t#callstatement#;\n\t/*(*f2py_func)(#callfortran#);*/'},
+ {isthreadsafe:'\tPy_END_ALLOW_THREADS'},
+ {hasexternals:'\t}'}
+ ],
+ '_check':isfunction_wrap,
+ },{ # Function
+ 'functype':'#ctype#',
+ 'docreturn':{l_not(isintent_hide):'#rname#,'},
+ 'docstrout':'\t#pydocsignout#',
+ 'latexdocstrout':['\\item[]{{}\\verb@#pydocsignout#@{}}',
+ {hasresultnote:'--- #resultnote#'}],
+ 'callfortranroutine':[{l_and(debugcapi,isstringfunction):"""\
+#ifdef USESCOMPAQFORTRAN
+\tfprintf(stderr,\"debug-capi:Fortran function #ctype# #fortranname#(#callcompaqfortran#)\\n\");
+#else
+\tfprintf(stderr,\"debug-capi:Fortran function #ctype# #fortranname#(#callfortran#)\\n\");
+#endif
+"""},
+ {l_and(debugcapi,l_not(isstringfunction)):"""\
+\tfprintf(stderr,\"debug-capi:Fortran function #ctype# #fortranname#(#callfortran#)\\n\");
+"""}
+ ],
+ '_check':l_and(isfunction,l_not(isfunction_wrap))
+ },{ # Scalar function
+ 'declfortranroutine':{l_and(l_not(l_or(ismoduleroutine,isintent_c)),l_not(isdummyroutine)):'extern #ctype# #F_FUNC#(#fortranname#,#FORTRANNAME#)(#callprotoargument#);',
+ l_and(l_not(ismoduleroutine),isintent_c,l_not(isdummyroutine)):'extern #ctype# #fortranname#(#callprotoargument#);',
+ isdummyroutine:''
+ },
+ 'routine_def':{l_and(l_not(l_or(ismoduleroutine,isintent_c)),l_not(isdummyroutine)):'\t{\"#name#\",-1,{{-1}},0,(char *)#F_FUNC#(#fortranname#,#FORTRANNAME#),(f2py_init_func)#apiname#,doc_#apiname#},',
+ l_and(l_not(ismoduleroutine),isintent_c,l_not(isdummyroutine)):'\t{\"#name#\",-1,{{-1}},0,(char *)#fortranname#,(f2py_init_func)#apiname#,doc_#apiname#},',
+ isdummyroutine:'\t{\"#name#\",-1,{{-1}},0,NULL,(f2py_init_func)#apiname#,doc_#apiname#},',
+ },
+ 'decl':[{iscomplexfunction_warn:'\t#ctype# #name#_return_value={0,0};',
+ l_not(iscomplexfunction):'\t#ctype# #name#_return_value=0;'},
+ {iscomplexfunction:'\tPyObject *#name#_return_value_capi = Py_None;'}
+ ],
+ 'callfortranroutine':[
+ {hasexternals:"""\
+\tif (#setjmpbuf#) {
+\t\tf2py_success = 0;
+\t} else {"""},
+ {isthreadsafe:'\tPy_BEGIN_ALLOW_THREADS'},
+ {hascallstatement:'''\t#callstatement#;
+/*\t#name#_return_value = (*f2py_func)(#callfortran#);*/
+'''},
+ {l_not(l_or(hascallstatement,isdummyroutine)):'\t#name#_return_value = (*f2py_func)(#callfortran#);'},
+ {isthreadsafe:'\tPy_END_ALLOW_THREADS'},
+ {hasexternals:'\t}'},
+ {l_and(debugcapi,iscomplexfunction):'\tfprintf(stderr,"#routdebugshowvalue#\\n",#name#_return_value.r,#name#_return_value.i);'},
+ {l_and(debugcapi,l_not(iscomplexfunction)):'\tfprintf(stderr,"#routdebugshowvalue#\\n",#name#_return_value);'}],
+ 'pyobjfrom':{iscomplexfunction:'\t#name#_return_value_capi = pyobj_from_#ctype#1(#name#_return_value);'},
+ 'need':[{l_not(isdummyroutine):'F_FUNC'},
+ {iscomplexfunction:'pyobj_from_#ctype#1'},
+ {islong_longfunction:'long_long'},
+ {islong_doublefunction:'long_double'}],
+ 'returnformat':{l_not(isintent_hide):'#rformat#'},
+ 'return':{iscomplexfunction:',#name#_return_value_capi',
+ l_not(l_or(iscomplexfunction,isintent_hide)):',#name#_return_value'},
+ '_check':l_and(isfunction,l_not(isstringfunction),l_not(isfunction_wrap))
+ },{ # String function # in use for --no-wrap
+ 'declfortranroutine':'extern void #F_FUNC#(#fortranname#,#FORTRANNAME#)(#callprotoargument#);',
+ 'routine_def':{l_not(l_or(ismoduleroutine,isintent_c)):
+# '\t{\"#name#\",-1,{{-1}},0,(char *)F_FUNC(#fortranname#,#FORTRANNAME#),(void *)#apiname#,doc_#apiname#},',
+ '\t{\"#name#\",-1,{{-1}},0,(char *)#F_FUNC#(#fortranname#,#FORTRANNAME#),(f2py_init_func)#apiname#,doc_#apiname#},',
+ l_and(l_not(ismoduleroutine),isintent_c):
+# '\t{\"#name#\",-1,{{-1}},0,(char *)#fortranname#,(void *)#apiname#,doc_#apiname#},'
+ '\t{\"#name#\",-1,{{-1}},0,(char *)#fortranname#,(f2py_init_func)#apiname#,doc_#apiname#},'
+ },
+ 'decl':['\t#ctype# #name#_return_value = NULL;',
+ '\tint #name#_return_value_len = 0;'],
+ 'callfortran':'#name#_return_value,#name#_return_value_len,',
+ 'callfortranroutine':['\t#name#_return_value_len = #rlength#;',
+ '\tif ((#name#_return_value = (string)malloc(sizeof(char)*(#name#_return_value_len+1))) == NULL) {',
+ '\t\tPyErr_SetString(PyExc_MemoryError, \"out of memory\");',
+ '\t\tf2py_success = 0;',
+ '\t} else {',
+ "\t\t(#name#_return_value)[#name#_return_value_len] = '\\0';",
+ '\t}',
+ '\tif (f2py_success) {',
+ {hasexternals:"""\
+\t\tif (#setjmpbuf#) {
+\t\t\tf2py_success = 0;
+\t\t} else {"""},
+ {isthreadsafe:'\t\tPy_BEGIN_ALLOW_THREADS'},
+ """\
+#ifdef USESCOMPAQFORTRAN
+\t\t(*f2py_func)(#callcompaqfortran#);
+#else
+\t\t(*f2py_func)(#callfortran#);
+#endif
+""",
+ {isthreadsafe:'\t\tPy_END_ALLOW_THREADS'},
+ {hasexternals:'\t\t}'},
+ {debugcapi:'\t\tfprintf(stderr,"#routdebugshowvalue#\\n",#name#_return_value_len,#name#_return_value);'},
+ '\t} /* if (f2py_success) after (string)malloc */',
+ ],
+ 'returnformat':'#rformat#',
+ 'return':',#name#_return_value',
+ 'freemem':'\tSTRINGFREE(#name#_return_value);',
+ 'need':['F_FUNC','#ctype#','STRINGFREE'],
+ '_check':l_and(isstringfunction,l_not(isfunction_wrap)) # ???obsolete
+ },
+ { # Debugging
+ 'routdebugenter':'\tfprintf(stderr,"debug-capi:Python C/API function #modulename#.#name#(#docsignature#)\\n");',
+ 'routdebugleave':'\tfprintf(stderr,"debug-capi:Python C/API function #modulename#.#name#: successful.\\n");',
+ 'routdebugfailure':'\tfprintf(stderr,"debug-capi:Python C/API function #modulename#.#name#: failure.\\n");',
+ '_check':debugcapi
+ }
+ ]
+
+################ Rules for arguments ##################
+
+typedef_need_dict = {islong_long:'long_long',
+ islong_double:'long_double',
+ islong_complex:'complex_long_double',
+ isunsigned_char:'unsigned_char',
+ isunsigned_short:'unsigned_short',
+ isunsigned:'unsigned',
+ isunsigned_long_long:'unsigned_long_long'}
+
+aux_rules=[
+ {
+ 'separatorsfor':sepdict
+ },
+ { # Common
+ 'frompyobj':['\t/* Processing auxiliary variable #varname# */',
+ {debugcapi:'\tfprintf(stderr,"#vardebuginfo#\\n");'},],
+ 'cleanupfrompyobj':'\t/* End of cleaning variable #varname# */',
+ 'need':typedef_need_dict,
+ },
+# Scalars (not complex)
+ { # Common
+ 'decl':'\t#ctype# #varname# = 0;',
+ 'need':{hasinitvalue:'math.h'},
+ 'frompyobj':{hasinitvalue:'\t#varname# = #init#;'},
+ '_check':l_and(isscalar,l_not(iscomplex)),
+ },
+ {
+ 'return':',#varname#',
+ 'docstrout':'\t#pydocsignout#',
+ 'docreturn':'#outvarname#,',
+ 'returnformat':'#varrformat#',
+ '_check':l_and(isscalar,l_not(iscomplex),isintent_out),
+ },
+# Complex scalars
+ { # Common
+ 'decl':'\t#ctype# #varname#;',
+ 'frompyobj': {hasinitvalue:'\t#varname#.r = #init.r#, #varname#.i = #init.i#;'},
+ '_check':iscomplex
+ },
+# String
+ { # Common
+ 'decl':['\t#ctype# #varname# = NULL;',
+ '\tint slen(#varname#);',
+ ],
+ 'need':['len..'],
+ '_check':isstring
+ },
+# Array
+ { # Common
+ 'decl':['\t#ctype# *#varname# = NULL;',
+ '\tnpy_intp #varname#_Dims[#rank#] = {#rank*[-1]#};',
+ '\tconst int #varname#_Rank = #rank#;',
+ ],
+ 'need':['len..',{hasinitvalue:'forcomb'},{hasinitvalue:'CFUNCSMESS'}],
+ '_check':isarray
+ },
+# Scalararray
+ { # Common
+ '_check':l_and(isarray,l_not(iscomplexarray))
+ },{ # Not hidden
+ '_check':l_and(isarray,l_not(iscomplexarray),isintent_nothide)
+ },
+# Integer*1 array
+ {'need':'#ctype#',
+ '_check':isint1array,
+ '_depend':''
+ },
+# Integer*-1 array
+ {'need':'#ctype#',
+ '_check':isunsigned_chararray,
+ '_depend':''
+ },
+# Integer*-2 array
+ {'need':'#ctype#',
+ '_check':isunsigned_shortarray,
+ '_depend':''
+ },
+# Integer*-8 array
+ {'need':'#ctype#',
+ '_check':isunsigned_long_longarray,
+ '_depend':''
+ },
+# Complexarray
+ {'need':'#ctype#',
+ '_check':iscomplexarray,
+ '_depend':''
+ },
+# Stringarray
+ {
+ 'callfortranappend':{isarrayofstrings:'flen(#varname#),'},
+ 'need':'string',
+ '_check':isstringarray
+ }
+ ]
+
+arg_rules=[
+ {
+ 'separatorsfor':sepdict
+ },
+ { # Common
+ 'frompyobj':['\t/* Processing variable #varname# */',
+ {debugcapi:'\tfprintf(stderr,"#vardebuginfo#\\n");'},],
+ 'cleanupfrompyobj':'\t/* End of cleaning variable #varname# */',
+ '_depend':'',
+ 'need':typedef_need_dict,
+ },
+# Doc signatures
+ {
+ 'docstropt':{l_and(isoptional,isintent_nothide):'\t#pydocsign#'},
+ 'docstrreq':{l_and(isrequired,isintent_nothide):'\t#pydocsign#'},
+ 'docstrout':{isintent_out:'\t#pydocsignout#'},
+ 'latexdocstropt':{l_and(isoptional,isintent_nothide):['\\item[]{{}\\verb@#pydocsign#@{}}',
+ {hasnote:'--- #note#'}]},
+ 'latexdocstrreq':{l_and(isrequired,isintent_nothide):['\\item[]{{}\\verb@#pydocsign#@{}}',
+ {hasnote:'--- #note#'}]},
+ 'latexdocstrout':{isintent_out:['\\item[]{{}\\verb@#pydocsignout#@{}}',
+ {l_and(hasnote,isintent_hide):'--- #note#',
+ l_and(hasnote,isintent_nothide):'--- See above.'}]},
+ 'depend':''
+ },
+# Required/Optional arguments
+ {
+ 'kwlist':'"#varname#",',
+ 'docsign':'#varname#,',
+ '_check':l_and(isintent_nothide,l_not(isoptional))
+ },
+ {
+ 'kwlistopt':'"#varname#",',
+ 'docsignopt':'#varname#=#showinit#,',
+ 'docsignoptshort':'#varname#,',
+ '_check':l_and(isintent_nothide,isoptional)
+ },
+# Docstring/BuildValue
+ {
+ 'docreturn':'#outvarname#,',
+ 'returnformat':'#varrformat#',
+ '_check':isintent_out
+ },
+# Externals (call-back functions)
+ { # Common
+ 'docsignxa':{isintent_nothide:'#varname#_extra_args=(),'},
+ 'docsignxashort':{isintent_nothide:'#varname#_extra_args,'},
+ 'docstropt':{isintent_nothide:'\t#varname#_extra_args := () input tuple'},
+ 'docstrcbs':'#cbdocstr#',
+ 'latexdocstrcbs':'\\item[] #cblatexdocstr#',
+ 'latexdocstropt':{isintent_nothide:'\\item[]{{}\\verb@#varname#_extra_args := () input tuple@{}} --- Extra arguments for call-back function {{}\\verb@#varname#@{}}.'},
+ 'decl':['\tPyObject *#varname#_capi = Py_None;',
+ '\tPyTupleObject *#varname#_xa_capi = NULL;',
+ '\tPyTupleObject *#varname#_args_capi = NULL;',
+ '\tint #varname#_nofargs_capi = 0;',
+ {l_not(isintent_callback):'\t#cbname#_typedef #varname#_cptr;'}
+ ],
+ 'kwlistxa':{isintent_nothide:'"#varname#_extra_args",'},
+ 'argformat':{isrequired:'O'},
+ 'keyformat':{isoptional:'O'},
+ 'xaformat':{isintent_nothide:'O!'},
+ 'args_capi':{isrequired:',&#varname#_capi'},
+ 'keys_capi':{isoptional:',&#varname#_capi'},
+ 'keys_xa':',&PyTuple_Type,&#varname#_xa_capi',
+ 'setjmpbuf':'(setjmp(#cbname#_jmpbuf))',
+ 'callfortran':{l_not(isintent_callback):'#varname#_cptr,'},
+ 'need':['#cbname#','setjmp.h'],
+ '_check':isexternal
+ },
+ {
+ 'frompyobj':[{l_not(isintent_callback):"""\
+if(PyCObject_Check(#varname#_capi)) {
+ #varname#_cptr = PyCObject_AsVoidPtr(#varname#_capi);
+} else {
+ #varname#_cptr = #cbname#;
+}
+"""},{isintent_callback:"""\
+if (#varname#_capi==Py_None) {
+ #varname#_capi = PyObject_GetAttrString(#modulename#_module,\"#varname#\");
+ if (#varname#_capi) {
+ if (#varname#_xa_capi==NULL) {
+ if (PyObject_HasAttrString(#modulename#_module,\"#varname#_extra_args\")) {
+ PyObject* capi_tmp = PyObject_GetAttrString(#modulename#_module,\"#varname#_extra_args\");
+ if (capi_tmp)
+ #varname#_xa_capi = (PyTupleObject *)PySequence_Tuple(capi_tmp);
+ else
+ #varname#_xa_capi = (PyTupleObject *)Py_BuildValue(\"()\");
+ if (#varname#_xa_capi==NULL) {
+ PyErr_SetString(#modulename#_error,\"Failed to convert #modulename#.#varname#_extra_args to tuple.\\n\");
+ return NULL;
+ }
+ }
+ }
+ }
+ if (#varname#_capi==NULL) {
+ PyErr_SetString(#modulename#_error,\"Callback #varname# not defined (as an argument or module #modulename# attribute).\\n\");
+ return NULL;
+ }
+}
+"""},
+## {l_not(isintent_callback):"""\
+## if (#varname#_capi==Py_None) {
+## printf(\"hoi\\n\");
+## }
+## """},
+"""\
+\t#varname#_nofargs_capi = #cbname#_nofargs;
+\tif (create_cb_arglist(#varname#_capi,#varname#_xa_capi,#maxnofargs#,#nofoptargs#,&#cbname#_nofargs,&#varname#_args_capi,\"failed in processing argument list for call-back #varname#.\")) {
+\t\tjmp_buf #varname#_jmpbuf;""",
+{debugcapi:["""\
+\t\tfprintf(stderr,\"debug-capi:Assuming %d arguments; at most #maxnofargs#(-#nofoptargs#) is expected.\\n\",#cbname#_nofargs);
+\t\tCFUNCSMESSPY(\"for #varname#=\",#cbname#_capi);""",
+{l_not(isintent_callback):"""\t\tfprintf(stderr,\"#vardebugshowvalue# (call-back in C).\\n\",#cbname#);"""}]},
+ """\
+\t\tCFUNCSMESS(\"Saving jmpbuf for `#varname#`.\\n\");
+\t\tSWAP(#varname#_capi,#cbname#_capi,PyObject);
+\t\tSWAP(#varname#_args_capi,#cbname#_args_capi,PyTupleObject);
+\t\tmemcpy(&#varname#_jmpbuf,&#cbname#_jmpbuf,sizeof(jmp_buf));""",
+ ],
+'cleanupfrompyobj':
+"""\
+\t\tCFUNCSMESS(\"Restoring jmpbuf for `#varname#`.\\n\");
+\t\t#cbname#_capi = #varname#_capi;
+\t\tPy_DECREF(#cbname#_args_capi);
+\t\t#cbname#_args_capi = #varname#_args_capi;
+\t\t#cbname#_nofargs = #varname#_nofargs_capi;
+\t\tmemcpy(&#cbname#_jmpbuf,&#varname#_jmpbuf,sizeof(jmp_buf));
+\t}""",
+ 'need':['SWAP','create_cb_arglist'],
+ '_check':isexternal,
+ '_depend':''
+ },
+# Scalars (not complex)
+ { # Common
+ 'decl':'\t#ctype# #varname# = 0;',
+ 'pyobjfrom':{debugcapi:'\tfprintf(stderr,"#vardebugshowvalue#\\n",#varname#);'},
+ 'callfortran':{isintent_c:'#varname#,',l_not(isintent_c):'&#varname#,'},
+ 'return':{isintent_out:',#varname#'},
+ '_check':l_and(isscalar,l_not(iscomplex))
+ },{
+ 'need':{hasinitvalue:'math.h'},
+ '_check':l_and(isscalar,l_not(iscomplex)),
+ #'_depend':''
+ },{ # Not hidden
+ 'decl':'\tPyObject *#varname#_capi = Py_None;',
+ 'argformat':{isrequired:'O'},
+ 'keyformat':{isoptional:'O'},
+ 'args_capi':{isrequired:',&#varname#_capi'},
+ 'keys_capi':{isoptional:',&#varname#_capi'},
+ 'pyobjfrom':{isintent_inout:"""\
+\tf2py_success = try_pyarr_from_#ctype#(#varname#_capi,&#varname#);
+\tif (f2py_success) {"""},
+ 'closepyobjfrom':{isintent_inout:"\t} /*if (f2py_success) of #varname# pyobjfrom*/"},
+ 'need':{isintent_inout:'try_pyarr_from_#ctype#'},
+ '_check':l_and(isscalar,l_not(iscomplex),isintent_nothide)
+ },{
+ 'frompyobj':[
+# hasinitvalue...
+# if pyobj is None:
+# varname = init
+# else
+# from_pyobj(varname)
+#
+# isoptional and noinitvalue...
+# if pyobj is not None:
+# from_pyobj(varname)
+# else:
+# varname is uninitialized
+#
+# ...
+# from_pyobj(varname)
+#
+ {hasinitvalue:'\tif (#varname#_capi == Py_None) #varname# = #init#; else',
+ '_depend':''},
+ {l_and(isoptional,l_not(hasinitvalue)):'\tif (#varname#_capi != Py_None)',
+ '_depend':''},
+ {l_not(islogical):'''\
+\t\tf2py_success = #ctype#_from_pyobj(&#varname#,#varname#_capi,"#pyname#() #nth# (#varname#) can\'t be converted to #ctype#");
+\tif (f2py_success) {'''},
+ {islogical:'''\
+\t\t#varname# = (#ctype#)PyObject_IsTrue(#varname#_capi);
+\t\tf2py_success = 1;
+\tif (f2py_success) {'''},
+ ],
+ 'cleanupfrompyobj':'\t} /*if (f2py_success) of #varname#*/',
+ 'need':{l_not(islogical):'#ctype#_from_pyobj'},
+ '_check':l_and(isscalar,l_not(iscomplex),isintent_nothide),
+ '_depend':''
+# },{ # Hidden
+# '_check':l_and(isscalar,l_not(iscomplex),isintent_hide)
+ },{ # Hidden
+ 'frompyobj':{hasinitvalue:'\t#varname# = #init#;'},
+ 'need':typedef_need_dict,
+ '_check':l_and(isscalar,l_not(iscomplex),isintent_hide),
+ '_depend':''
+ },{ # Common
+ 'frompyobj':{debugcapi:'\tfprintf(stderr,"#vardebugshowvalue#\\n",#varname#);'},
+ '_check':l_and(isscalar,l_not(iscomplex)),
+ '_depend':''
+ },
+# Complex scalars
+ { # Common
+ 'decl':'\t#ctype# #varname#;',
+ 'callfortran':{isintent_c:'#varname#,',l_not(isintent_c):'&#varname#,'},
+ 'pyobjfrom':{debugcapi:'\tfprintf(stderr,"#vardebugshowvalue#\\n",#varname#.r,#varname#.i);'},
+ 'return':{isintent_out:',#varname#_capi'},
+ '_check':iscomplex
+ },{ # Not hidden
+ 'decl':'\tPyObject *#varname#_capi = Py_None;',
+ 'argformat':{isrequired:'O'},
+ 'keyformat':{isoptional:'O'},
+ 'args_capi':{isrequired:',&#varname#_capi'},
+ 'keys_capi':{isoptional:',&#varname#_capi'},
+ 'need':{isintent_inout:'try_pyarr_from_#ctype#'},
+ 'pyobjfrom':{isintent_inout:"""\
+\t\tf2py_success = try_pyarr_from_#ctype#(#varname#_capi,&#varname#);
+\t\tif (f2py_success) {"""},
+ 'closepyobjfrom':{isintent_inout:"\t\t} /*if (f2py_success) of #varname# pyobjfrom*/"},
+ '_check':l_and(iscomplex,isintent_nothide)
+ },{
+ 'frompyobj':[{hasinitvalue:'\tif (#varname#_capi==Py_None) {#varname#.r = #init.r#, #varname#.i = #init.i#;} else'},
+ {l_and(isoptional,l_not(hasinitvalue)):'\tif (#varname#_capi != Py_None)'},
+# '\t\tf2py_success = #ctype#_from_pyobj(&#varname#,#varname#_capi,"#ctype#_from_pyobj failed in converting #nth# `#varname#\' of #pyname# to C #ctype#\\n");'
+ '\t\tf2py_success = #ctype#_from_pyobj(&#varname#,#varname#_capi,"#pyname#() #nth# (#varname#) can\'t be converted to #ctype#");'
+ '\n\tif (f2py_success) {'],
+ 'cleanupfrompyobj':'\t} /*if (f2py_success) of #varname# frompyobj*/',
+ 'need':['#ctype#_from_pyobj'],
+ '_check':l_and(iscomplex,isintent_nothide),
+ '_depend':''
+ },{ # Hidden
+ 'decl':{isintent_out:'\tPyObject *#varname#_capi = Py_None;'},
+ '_check':l_and(iscomplex,isintent_hide)
+ },{
+ 'frompyobj': {hasinitvalue:'\t#varname#.r = #init.r#, #varname#.i = #init.i#;'},
+ '_check':l_and(iscomplex,isintent_hide),
+ '_depend':''
+ },{ # Common
+ 'pyobjfrom':{isintent_out:'\t#varname#_capi = pyobj_from_#ctype#1(#varname#);'},
+ 'need':['pyobj_from_#ctype#1'],
+ '_check':iscomplex
+ },{
+ 'frompyobj':{debugcapi:'\tfprintf(stderr,"#vardebugshowvalue#\\n",#varname#.r,#varname#.i);'},
+ '_check':iscomplex,
+ '_depend':''
+ },
+# String
+ { # Common
+ 'decl':['\t#ctype# #varname# = NULL;',
+ '\tint slen(#varname#);',
+ '\tPyObject *#varname#_capi = Py_None;'],
+ 'callfortran':'#varname#,',
+ 'callfortranappend':'slen(#varname#),',
+ 'pyobjfrom':{debugcapi:'\tfprintf(stderr,"#vardebugshowvalue#\\n",slen(#varname#),#varname#);'},
+# 'freemem':'\tSTRINGFREE(#varname#);',
+ 'return':{isintent_out:',#varname#'},
+ 'need':['len..'],#'STRINGFREE'],
+ '_check':isstring
+ },{ # Common
+ 'frompyobj':"""\
+\tslen(#varname#) = #length#;
+\tf2py_success = #ctype#_from_pyobj(&#varname#,&slen(#varname#),#init#,#varname#_capi,\"#ctype#_from_pyobj failed in converting #nth# `#varname#\' of #pyname# to C #ctype#\");
+\tif (f2py_success) {""",
+ 'cleanupfrompyobj':"""\
+\t\tSTRINGFREE(#varname#);
+\t} /*if (f2py_success) of #varname#*/""",
+ 'need':['#ctype#_from_pyobj','len..','STRINGFREE'],
+ '_check':isstring,
+ '_depend':''
+ },{ # Not hidden
+ 'argformat':{isrequired:'O'},
+ 'keyformat':{isoptional:'O'},
+ 'args_capi':{isrequired:',&#varname#_capi'},
+ 'keys_capi':{isoptional:',&#varname#_capi'},
+ 'pyobjfrom':{isintent_inout:'''\
+\tf2py_success = try_pyarr_from_#ctype#(#varname#_capi,#varname#);
+\tif (f2py_success) {'''},
+ 'closepyobjfrom':{isintent_inout:'\t} /*if (f2py_success) of #varname# pyobjfrom*/'},
+ 'need':{isintent_inout:'try_pyarr_from_#ctype#'},
+ '_check':l_and(isstring,isintent_nothide)
+ },{ # Hidden
+ '_check':l_and(isstring,isintent_hide)
+ },{
+ 'frompyobj':{debugcapi:'\tfprintf(stderr,"#vardebugshowvalue#\\n",slen(#varname#),#varname#);'},
+ '_check':isstring,
+ '_depend':''
+ },
+# Array
+ { # Common
+ 'decl':['\t#ctype# *#varname# = NULL;',
+ '\tnpy_intp #varname#_Dims[#rank#] = {#rank*[-1]#};',
+ '\tconst int #varname#_Rank = #rank#;',
+ '\tPyArrayObject *capi_#varname#_tmp = NULL;',
+ '\tint capi_#varname#_intent = 0;',
+ ],
+ 'callfortran':'#varname#,',
+ 'return':{isintent_out:',capi_#varname#_tmp'},
+ 'need':'len..',
+ '_check':isarray
+ },{ # intent(overwrite) array
+ 'decl':'\tint capi_overwrite_#varname# = 1;',
+ 'kwlistxa':'"overwrite_#varname#",',
+ 'xaformat':'i',
+ 'keys_xa':',&capi_overwrite_#varname#',
+ 'docsignxa':'overwrite_#varname#=1,',
+ 'docsignxashort':'overwrite_#varname#,',
+ 'docstropt':'\toverwrite_#varname# := 1 input int',
+ '_check':l_and(isarray,isintent_overwrite),
+ },{
+ 'frompyobj':'\tcapi_#varname#_intent |= (capi_overwrite_#varname#?0:F2PY_INTENT_COPY);',
+ '_check':l_and(isarray,isintent_overwrite),
+ '_depend':'',
+ },
+ { # intent(copy) array
+ 'decl':'\tint capi_overwrite_#varname# = 0;',
+ 'kwlistxa':'"overwrite_#varname#",',
+ 'xaformat':'i',
+ 'keys_xa':',&capi_overwrite_#varname#',
+ 'docsignxa':'overwrite_#varname#=0,',
+ 'docsignxashort':'overwrite_#varname#,',
+ 'docstropt':'\toverwrite_#varname# := 0 input int',
+ '_check':l_and(isarray,isintent_copy),
+ },{
+ 'frompyobj':'\tcapi_#varname#_intent |= (capi_overwrite_#varname#?0:F2PY_INTENT_COPY);',
+ '_check':l_and(isarray,isintent_copy),
+ '_depend':'',
+ },{
+ 'need':[{hasinitvalue:'forcomb'},{hasinitvalue:'CFUNCSMESS'}],
+ '_check':isarray,
+ '_depend':''
+ },{ # Not hidden
+ 'decl':'\tPyObject *#varname#_capi = Py_None;',
+ 'argformat':{isrequired:'O'},
+ 'keyformat':{isoptional:'O'},
+ 'args_capi':{isrequired:',&#varname#_capi'},
+ 'keys_capi':{isoptional:',&#varname#_capi'},
+# 'pyobjfrom':{isintent_inout:"""\
+# /* Partly because of the following hack, intent(inout) is depreciated,
+# Use intent(in,out) instead.
+
+# \tif ((#varname#_capi != Py_None) && PyArray_Check(#varname#_capi) \\
+# \t\t&& (#varname#_capi != (PyObject *)capi_#varname#_tmp)) {
+# \t\tif (((PyArrayObject *)#varname#_capi)->nd != capi_#varname#_tmp->nd) {
+# \t\t\tif (#varname#_capi != capi_#varname#_tmp->base)
+# \t\t\t\tcopy_ND_array((PyArrayObject *)capi_#varname#_tmp->base,(PyArrayObject *)#varname#_capi);
+# \t\t} else
+# \t\t\tcopy_ND_array(capi_#varname#_tmp,(PyArrayObject *)#varname#_capi);
+# \t}
+# */
+# """},
+# 'need':{isintent_inout:'copy_ND_array'},
+ '_check':l_and(isarray,isintent_nothide)
+ },{
+ 'frompyobj':['\t#setdims#;',
+ '\tcapi_#varname#_intent |= #intent#;',
+ {isintent_hide:'\tcapi_#varname#_tmp = array_from_pyobj(#atype#,#varname#_Dims,#varname#_Rank,capi_#varname#_intent,Py_None);'},
+ {isintent_nothide:'\tcapi_#varname#_tmp = array_from_pyobj(#atype#,#varname#_Dims,#varname#_Rank,capi_#varname#_intent,#varname#_capi);'},
+ """\
+\tif (capi_#varname#_tmp == NULL) {
+\t\tif (!PyErr_Occurred())
+\t\t\tPyErr_SetString(#modulename#_error,\"failed in converting #nth# `#varname#\' of #pyname# to C/Fortran array\" );
+\t} else {
+\t\t#varname# = (#ctype# *)(capi_#varname#_tmp->data);
+""",
+{hasinitvalue:[
+ {isintent_nothide:'\tif (#varname#_capi == Py_None) {'},
+ {isintent_hide:'\t{'},
+ {iscomplexarray:'\t\t#ctype# capi_c;'},
+ """\
+\t\tint *_i,capi_i=0;
+\t\tCFUNCSMESS(\"#name#: Initializing #varname#=#init#\\n\");
+\t\tif (initforcomb(capi_#varname#_tmp->dimensions,capi_#varname#_tmp->nd,1)) {
+\t\t\twhile ((_i = nextforcomb()))
+\t\t\t\t#varname#[capi_i++] = #init#; /* fortran way */
+\t\t} else {
+\t\t\tif (!PyErr_Occurred())
+\t\t\t\tPyErr_SetString(#modulename#_error,\"Initialization of #nth# #varname# failed (initforcomb).\");
+\t\t\tf2py_success = 0;
+\t\t}
+\t}
+\tif (f2py_success) {"""]},
+ ],
+ 'cleanupfrompyobj':[ # note that this list will be reversed
+ '\t} /*if (capi_#varname#_tmp == NULL) ... else of #varname#*/',
+ {l_not(l_or(isintent_out,isintent_hide)):"""\
+\tif((PyObject *)capi_#varname#_tmp!=#varname#_capi) {
+\t\tPy_XDECREF(capi_#varname#_tmp); }"""},
+ {l_and(isintent_hide,l_not(isintent_out)):"""\t\tPy_XDECREF(capi_#varname#_tmp);"""},
+ {hasinitvalue:'\t} /*if (f2py_success) of #varname# init*/'},
+ ],
+ '_check':isarray,
+ '_depend':''
+ },
+# { # Hidden
+# 'freemem':{l_not(isintent_out):'\tPy_XDECREF(capi_#varname#_tmp);'},
+# '_check':l_and(isarray,isintent_hide)
+# },
+# Scalararray
+ { # Common
+ '_check':l_and(isarray,l_not(iscomplexarray))
+ },{ # Not hidden
+ '_check':l_and(isarray,l_not(iscomplexarray),isintent_nothide)
+ },
+# Integer*1 array
+ {'need':'#ctype#',
+ '_check':isint1array,
+ '_depend':''
+ },
+# Integer*-1 array
+ {'need':'#ctype#',
+ '_check':isunsigned_chararray,
+ '_depend':''
+ },
+# Integer*-2 array
+ {'need':'#ctype#',
+ '_check':isunsigned_shortarray,
+ '_depend':''
+ },
+# Integer*-8 array
+ {'need':'#ctype#',
+ '_check':isunsigned_long_longarray,
+ '_depend':''
+ },
+# Complexarray
+ {'need':'#ctype#',
+ '_check':iscomplexarray,
+ '_depend':''
+ },
+# Stringarray
+ {
+ 'callfortranappend':{isarrayofstrings:'flen(#varname#),'},
+ 'need':'string',
+ '_check':isstringarray
+ }
+ ]
+
+################# Rules for checking ###############
+
+check_rules=[
+ {
+ 'frompyobj':{debugcapi:'\tfprintf(stderr,\"debug-capi:Checking `#check#\'\\n\");'},
+ 'need':'len..'
+ },{
+ 'frompyobj':'\tCHECKSCALAR(#check#,\"#check#\",\"#nth# #varname#\",\"#varshowvalue#\",#varname#) {',
+ 'cleanupfrompyobj':'\t} /*CHECKSCALAR(#check#)*/',
+ 'need':'CHECKSCALAR',
+ '_check':l_and(isscalar,l_not(iscomplex)),
+ '_break':''
+ },{
+ 'frompyobj':'\tCHECKSTRING(#check#,\"#check#\",\"#nth# #varname#\",\"#varshowvalue#\",#varname#) {',
+ 'cleanupfrompyobj':'\t} /*CHECKSTRING(#check#)*/',
+ 'need':'CHECKSTRING',
+ '_check':isstring,
+ '_break':''
+ },{
+ 'need':'CHECKARRAY',
+ 'frompyobj':'\tCHECKARRAY(#check#,\"#check#\",\"#nth# #varname#\") {',
+ 'cleanupfrompyobj':'\t} /*CHECKARRAY(#check#)*/',
+ '_check':isarray,
+ '_break':''
+ },{
+ 'need':'CHECKGENERIC',
+ 'frompyobj':'\tCHECKGENERIC(#check#,\"#check#\",\"#nth# #varname#\") {',
+ 'cleanupfrompyobj':'\t} /*CHECKGENERIC(#check#)*/',
+ }
+]
+
+########## Applying the rules. No need to modify what follows #############
+
+#################### Build C/API module #######################
+
+def buildmodule(m,um):
+ """
+ Return
+ """
+ global f2py_version,options
+ outmess('\tBuilding module "%s"...\n'%(m['name']))
+ ret = {}
+ mod_rules=defmod_rules[:]
+ vrd=modsign2map(m)
+ rd=dictappend({'f2py_version':f2py_version},vrd)
+ funcwrappers = []
+ funcwrappers2 = [] # F90 codes
+ for n in m['interfaced']:
+ nb=None
+ for bi in m['body']:
+ if not bi['block']=='interface':
+ errmess('buildmodule: Expected interface block. Skipping.\n')
+ continue
+ for b in bi['body']:
+ if b['name']==n: nb=b;break
+
+ if not nb:
+ errmess('buildmodule: Could not found the body of interfaced routine "%s". Skipping.\n'%(n))
+ continue
+ nb_list = [nb]
+ if nb.has_key('entry'):
+ for k,a in nb['entry'].items():
+ nb1 = copy.deepcopy(nb)
+ del nb1['entry']
+ nb1['name'] = k
+ nb1['args'] = a
+ nb_list.append(nb1)
+ for nb in nb_list:
+ api,wrap=buildapi(nb)
+ if wrap:
+ if ismoduleroutine(nb):
+ funcwrappers2.append(wrap)
+ else:
+ funcwrappers.append(wrap)
+ ar=applyrules(api,vrd)
+ rd=dictappend(rd,ar)
+
+ # Construct COMMON block support
+ cr,wrap = common_rules.buildhooks(m)
+ if wrap:
+ funcwrappers.append(wrap)
+ ar=applyrules(cr,vrd)
+ rd=dictappend(rd,ar)
+
+ # Construct F90 module support
+ mr,wrap = f90mod_rules.buildhooks(m)
+ if wrap:
+ funcwrappers2.append(wrap)
+ ar=applyrules(mr,vrd)
+ rd=dictappend(rd,ar)
+
+ for u in um:
+ ar=use_rules.buildusevars(u,m['use'][u['name']])
+ rd=dictappend(rd,ar)
+
+ needs=cfuncs.get_needs()
+ code={}
+ for n in needs.keys():
+ code[n]=[]
+ for k in needs[n]:
+ c=''
+ if cfuncs.includes0.has_key(k): c=cfuncs.includes0[k]
+ elif cfuncs.includes.has_key(k): c=cfuncs.includes[k]
+ elif cfuncs.userincludes.has_key(k): c=cfuncs.userincludes[k]
+ elif cfuncs.typedefs.has_key(k): c=cfuncs.typedefs[k]
+ elif cfuncs.typedefs_generated.has_key(k):
+ c=cfuncs.typedefs_generated[k]
+ elif cfuncs.cppmacros.has_key(k): c=cfuncs.cppmacros[k]
+ elif cfuncs.cfuncs.has_key(k): c=cfuncs.cfuncs[k]
+ elif cfuncs.callbacks.has_key(k): c=cfuncs.callbacks[k]
+ elif cfuncs.f90modhooks.has_key(k): c=cfuncs.f90modhooks[k]
+ elif cfuncs.commonhooks.has_key(k): c=cfuncs.commonhooks[k]
+ else: errmess('buildmodule: unknown need %s.\n'%(`k`));continue
+ code[n].append(c)
+ mod_rules.append(code)
+ for r in mod_rules:
+ if (r.has_key('_check') and r['_check'](m)) or (not r.has_key('_check')):
+ ar=applyrules(r,vrd,m)
+ rd=dictappend(rd,ar)
+ ar=applyrules(module_rules,rd)
+
+ fn = os.path.join(options['buildpath'],vrd['modulename']+'module.c')
+ ret['csrc'] = fn
+ f=open(fn,'w')
+ f.write(string.replace(ar['modulebody'],'\t',2*' '))
+ f.close()
+ outmess('\tWrote C/API module "%s" to file "%s/%smodule.c"\n'%(m['name'],options['buildpath'],vrd['modulename']))
+
+ if options['dorestdoc']:
+ fn = os.path.join(options['buildpath'],vrd['modulename']+'module.rest')
+ f=open(fn,'w')
+ f.write('.. -*- rest -*-\n')
+ f.write(string.join(ar['restdoc'],'\n'))
+ f.close()
+ outmess('\tReST Documentation is saved to file "%s/%smodule.rest"\n'%(options['buildpath'],vrd['modulename']))
+ if options['dolatexdoc']:
+ fn = os.path.join(options['buildpath'],vrd['modulename']+'module.tex')
+ ret['ltx'] = fn
+ f=open(fn,'w')
+ f.write('%% This file is auto-generated with f2py (version:%s)\n'%(f2py_version))
+ if not options.has_key('shortlatex'):
+ f.write('\\documentclass{article}\n\\usepackage{a4wide}\n\\begin{document}\n\\tableofcontents\n\n')
+ f.write(string.join(ar['latexdoc'],'\n'))
+ if not options.has_key('shortlatex'):
+ f.write('\\end{document}')
+ f.close()
+ outmess('\tDocumentation is saved to file "%s/%smodule.tex"\n'%(options['buildpath'],vrd['modulename']))
+ if funcwrappers:
+ wn = os.path.join(options['buildpath'],'%s-f2pywrappers.f'%(vrd['modulename']))
+ ret['fsrc'] = wn
+ f=open(wn,'w')
+ f.write('C -*- fortran -*-\n')
+ f.write('C This file is autogenerated with f2py (version:%s)\n'%(f2py_version))
+ f.write('C It contains Fortran 77 wrappers to fortran functions.\n')
+ lines = []
+ for l in string.split(string.join(funcwrappers,'\n\n')+'\n','\n'):
+ if l and l[0]==' ':
+ while len(l)>=66:
+ lines.append(l[:66]+'\n &')
+ l = l[66:]
+ lines.append(l+'\n')
+ else: lines.append(l+'\n')
+ lines = string.join(lines,'').replace('\n &\n','\n')
+ f.write(lines)
+ f.close()
+ outmess('\tFortran 77 wrappers are saved to "%s"\n'%(wn))
+ if funcwrappers2:
+ wn = os.path.join(options['buildpath'],'%s-f2pywrappers2.f90'%(vrd['modulename']))
+ ret['fsrc'] = wn
+ f=open(wn,'w')
+ f.write('! -*- f90 -*-\n')
+ f.write('! This file is autogenerated with f2py (version:%s)\n'%(f2py_version))
+ f.write('! It contains Fortran 90 wrappers to fortran functions.\n')
+ lines = []
+ for l in string.split(string.join(funcwrappers2,'\n\n')+'\n','\n'):
+ if len(l)>72 and l[0]==' ':
+ lines.append(l[:72]+'&\n &')
+ l = l[72:]
+ while len(l)>66:
+ lines.append(l[:66]+'&\n &')
+ l = l[66:]
+ lines.append(l+'\n')
+ else: lines.append(l+'\n')
+ lines = string.join(lines,'').replace('\n &\n','\n')
+ f.write(lines)
+ f.close()
+ outmess('\tFortran 90 wrappers are saved to "%s"\n'%(wn))
+ return ret
+
+################## Build C/API function #############
+
+stnd={1:'st',2:'nd',3:'rd',4:'th',5:'th',6:'th',7:'th',8:'th',9:'th',0:'th'}
+def buildapi(rout):
+ rout,wrap = func2subr.assubr(rout)
+ args,depargs=getargs2(rout)
+ capi_maps.depargs=depargs
+ var=rout['vars']
+ auxvars = [a for a in var.keys() if isintent_aux(var[a])]
+
+ if ismoduleroutine(rout):
+ outmess('\t\t\tConstructing wrapper function "%s.%s"...\n'%(rout['modulename'],rout['name']))
+ else:
+ outmess('\t\tConstructing wrapper function "%s"...\n'%(rout['name']))
+ # Routine
+ vrd=routsign2map(rout)
+ rd=dictappend({},vrd)
+ for r in rout_rules:
+ if (r.has_key('_check') and r['_check'](rout)) or (not r.has_key('_check')):
+ ar=applyrules(r,vrd,rout)
+ rd=dictappend(rd,ar)
+
+ # Args
+ nth,nthk=0,0
+ savevrd={}
+ for a in args:
+ vrd=sign2map(a,var[a])
+ if isintent_aux(var[a]):
+ _rules = aux_rules
+ else:
+ _rules = arg_rules
+ if not isintent_hide(var[a]):
+ if not isoptional(var[a]):
+ nth=nth+1
+ vrd['nth']=`nth`+stnd[nth%10]+' argument'
+ else:
+ nthk=nthk+1
+ vrd['nth']=`nthk`+stnd[nthk%10]+' keyword'
+ else: vrd['nth']='hidden'
+ savevrd[a]=vrd
+ for r in _rules:
+ if r.has_key('_depend'): continue
+ if (r.has_key('_check') and r['_check'](var[a])) or (not r.has_key('_check')):
+ ar=applyrules(r,vrd,var[a])
+ rd=dictappend(rd,ar)
+ if r.has_key('_break'): break
+ for a in depargs:
+ if isintent_aux(var[a]):
+ _rules = aux_rules
+ else:
+ _rules = arg_rules
+ vrd=savevrd[a]
+ for r in _rules:
+ if not r.has_key('_depend'): continue
+ if (r.has_key('_check') and r['_check'](var[a])) or (not r.has_key('_check')):
+ ar=applyrules(r,vrd,var[a])
+ rd=dictappend(rd,ar)
+ if r.has_key('_break'): break
+ if var[a].has_key('check'):
+ for c in var[a]['check']:
+ vrd['check']=c
+ ar=applyrules(check_rules,vrd,var[a])
+ rd=dictappend(rd,ar)
+ if type(rd['cleanupfrompyobj']) is types.ListType:
+ rd['cleanupfrompyobj'].reverse()
+ if type(rd['closepyobjfrom']) is types.ListType:
+ rd['closepyobjfrom'].reverse()
+ rd['docsignature']=stripcomma(replace('#docsign##docsignopt##docsignxa#',
+ {'docsign':rd['docsign'],
+ 'docsignopt':rd['docsignopt'],
+ 'docsignxa':rd['docsignxa']}))
+ optargs=stripcomma(replace('#docsignopt##docsignxa#',
+ {'docsignxa':rd['docsignxashort'],
+ 'docsignopt':rd['docsignoptshort']}
+ ))
+ if optargs=='':
+ rd['docsignatureshort']=stripcomma(replace('#docsign#',{'docsign':rd['docsign']}))
+ else:
+ rd['docsignatureshort']=replace('#docsign#[#docsignopt#]',
+ {'docsign':rd['docsign'],
+ 'docsignopt':optargs,
+ })
+ rd['latexdocsignatureshort']=string.replace(rd['docsignatureshort'],'_','\\_')
+ rd['latexdocsignatureshort']=string.replace(rd['latexdocsignatureshort'],',',', ')
+ cfs=stripcomma(replace('#callfortran##callfortranappend#',{'callfortran':rd['callfortran'],'callfortranappend':rd['callfortranappend']}))
+ if len(rd['callfortranappend'])>1:
+ rd['callcompaqfortran']=stripcomma(replace('#callfortran# 0,#callfortranappend#',{'callfortran':rd['callfortran'],'callfortranappend':rd['callfortranappend']}))
+ else:
+ rd['callcompaqfortran']=cfs
+ rd['callfortran']=cfs
+ if type(rd['docreturn'])==types.ListType:
+ rd['docreturn']=stripcomma(replace('#docreturn#',{'docreturn':rd['docreturn']}))+' = '
+ rd['docstrsigns']=[]
+ rd['latexdocstrsigns']=[]
+ for k in ['docstrreq','docstropt','docstrout','docstrcbs']:
+ if rd.has_key(k) and type(rd[k])==types.ListType:
+ rd['docstrsigns']=rd['docstrsigns']+rd[k]
+ k='latex'+k
+ if rd.has_key(k) and type(rd[k])==types.ListType:
+ rd['latexdocstrsigns']=rd['latexdocstrsigns']+rd[k][0:1]+\
+ ['\\begin{description}']+rd[k][1:]+\
+ ['\\end{description}']
+ ar=applyrules(routine_rules,rd)
+ if ismoduleroutine(rout):
+ outmess('\t\t\t %s\n'%(ar['docshort']))
+ else:
+ outmess('\t\t %s\n'%(ar['docshort']))
+ return ar,wrap
+
+
+#################### EOF rules.py #######################
diff --git a/numpy/f2py/setup.cfg b/numpy/f2py/setup.cfg
new file mode 100644
index 000000000..14669544c
--- /dev/null
+++ b/numpy/f2py/setup.cfg
@@ -0,0 +1,3 @@
+[bdist_rpm]
+doc_files = docs/
+ tests/ \ No newline at end of file
diff --git a/numpy/f2py/setup.py b/numpy/f2py/setup.py
new file mode 100755
index 000000000..81d0fd20b
--- /dev/null
+++ b/numpy/f2py/setup.py
@@ -0,0 +1,129 @@
+#!/usr/bin/env python
+"""
+setup.py for installing F2PY
+
+Usage:
+ python setup.py install
+
+Copyright 2001-2005 Pearu Peterson all rights reserved,
+Pearu Peterson <pearu@cens.ioc.ee>
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+$Revision: 1.32 $
+$Date: 2005/01/30 17:22:14 $
+Pearu Peterson
+"""
+
+__version__ = "$Id: setup.py,v 1.32 2005/01/30 17:22:14 pearu Exp $"
+
+import os
+import sys
+from distutils.dep_util import newer
+from numpy.distutils.core import setup
+from numpy.distutils.misc_util import Configuration
+
+from __version__ import version
+
+def configuration(parent_package='',top_path=None):
+ config = Configuration('f2py', parent_package, top_path)
+
+ config.add_subpackage('lib')
+
+ config.add_data_dir('docs')
+
+ config.add_data_files('src/fortranobject.c',
+ 'src/fortranobject.h',
+ 'f2py.1'
+ )
+
+ config.make_svn_version_py()
+
+ def generate_f2py_py(build_dir):
+ f2py_exe = 'f2py'+os.path.basename(sys.executable)[6:]
+ if f2py_exe[-4:]=='.exe':
+ f2py_exe = f2py_exe[:-4] + '.py'
+ if 'bdist_wininst' in sys.argv and f2py_exe[-3:] != '.py':
+ f2py_exe = f2py_exe + '.py'
+ target = os.path.join(build_dir,f2py_exe)
+ if newer(__file__,target):
+ print 'Creating',target
+ f = open(target,'w')
+ f.write('''\
+#!/usr/bin/env %s
+# See http://cens.ioc.ee/projects/f2py2e/
+import os, sys
+for mode in ["g3-numpy", "2e-numeric", "2e-numarray", "2e-numpy"]:
+ try:
+ i=sys.argv.index("--"+mode)
+ del sys.argv[i]
+ break
+ except ValueError: pass
+os.environ["NO_SCIPY_IMPORT"]="f2py"
+if mode=="g3-numpy":
+ try:
+ from main import main
+ except ImportError:
+ from numpy.f2py.lib.api import main
+elif mode=="2e-numeric":
+ from f2py2e import main
+elif mode=="2e-numarray":
+ sys.argv.append("-DNUMARRAY")
+ from f2py2e import main
+elif mode=="2e-numpy":
+ from numpy.f2py import main
+else:
+ print >> sys.stderr, "Unknown mode:",`mode`
+ sys.exit(1)
+main()
+'''%(os.path.basename(sys.executable)))
+ f.close()
+ return target
+
+ config.add_scripts(generate_f2py_py)
+
+ print 'F2PY Version',config.get_version()
+
+ return config
+
+if __name__ == "__main__":
+
+ config = configuration(top_path='')
+ version = config.get_version()
+ print 'F2PY Version',version
+ config = config.todict()
+
+ if sys.version[:3]>='2.3':
+ config['download_url'] = "http://cens.ioc.ee/projects/f2py2e/2.x"\
+ "/F2PY-2-latest.tar.gz"
+ config['classifiers'] = [
+ 'Development Status :: 5 - Production/Stable',
+ 'Intended Audience :: Developers',
+ 'Intended Audience :: Science/Research',
+ 'License :: OSI Approved :: NumPy License',
+ 'Natural Language :: English',
+ 'Operating System :: OS Independent',
+ 'Programming Language :: C',
+ 'Programming Language :: Fortran',
+ 'Programming Language :: Python',
+ 'Topic :: Scientific/Engineering',
+ 'Topic :: Software Development :: Code Generators',
+ ]
+ setup(version=version,
+ description = "F2PY - Fortran to Python Interface Generaton",
+ author = "Pearu Peterson",
+ author_email = "pearu@cens.ioc.ee",
+ maintainer = "Pearu Peterson",
+ maintainer_email = "pearu@cens.ioc.ee",
+ license = "BSD",
+ platforms = "Unix, Windows (mingw|cygwin), Mac OSX",
+ long_description = """\
+The Fortran to Python Interface Generator, or F2PY for short, is a
+command line tool (f2py) for generating Python C/API modules for
+wrapping Fortran 77/90/95 subroutines, accessing common blocks from
+Python, and calling Python functions from Fortran (call-backs).
+Interfacing subroutines/data from Fortran 90/95 modules is supported.""",
+ url = "http://cens.ioc.ee/projects/f2py2e/",
+ keywords = ['Fortran','f2py'],
+ **config)
diff --git a/numpy/f2py/src/fortranobject.c b/numpy/f2py/src/fortranobject.c
new file mode 100644
index 000000000..27488d24d
--- /dev/null
+++ b/numpy/f2py/src/fortranobject.c
@@ -0,0 +1,815 @@
+#define FORTRANOBJECT_C
+#include "fortranobject.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+/*
+ 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);
+}
+
+/************************* 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))();
+ if ((fp = PyObject_New(PyFortranObject, &PyFortran_Type))==NULL) return NULL;
+ if ((fp->dict = PyDict_New())==NULL) 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) return NULL;
+ PyDict_SetItemString(fp->dict,fp->defs[i].name,v);
+ } else
+ if ((fp->defs[i].data)!=NULL) { /* Is Fortran variable or array (not allocatable) */
+ if (fp->defs[i].type == PyArray_STRING) {
+ int n = fp->defs[i].rank-1;
+ v = PyArray_New(&PyArray_Type, n, fp->defs[i].dims.d,
+ PyArray_STRING, NULL, fp->defs[i].data, fp->defs[i].dims.d[n],
+ NPY_FARRAY, NULL);
+ }
+ else {
+ v = PyArray_New(&PyArray_Type, fp->defs[i].rank, fp->defs[i].dims.d,
+ fp->defs[i].type, NULL, fp->defs[i].data, 0, NPY_FARRAY,
+ NULL);
+ }
+ if (v==NULL) return NULL;
+ PyDict_SetItemString(fp->dict,fp->defs[i].name,v);
+ }
+ Py_XDECREF(v);
+ return (PyObject *)fp;
+ fail:
+ Py_XDECREF(v);
+ 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) return NULL;
+ fp->len = 1;
+ fp->defs = defs;
+ return (PyObject *)fp;
+}
+
+/* Fortran methods */
+
+static void
+fortran_dealloc(PyFortranObject *fp) {
+ Py_XDECREF(fp->dict);
+ PyMem_Del(fp);
+}
+
+
+static PyMethodDef fortran_methods[] = {
+ {NULL, NULL} /* sentinel */
+};
+
+
+static PyObject *
+fortran_doc (FortranDataDef def) {
+ char *p;
+ PyObject *s = NULL;
+ int i;
+ unsigned size=100;
+ if (def.doc!=NULL)
+ size += strlen(def.doc);
+ p = (char*)malloc (size);
+ if (sprintf(p,"%s - ",def.name)==0) goto fail;
+ if (def.rank==-1) {
+ if (def.doc==NULL) {
+ if (sprintf(p,"%sno docs available",p)==0)
+ goto fail;
+ } else {
+ if (sprintf(p,"%s%s",p,def.doc)==0)
+ goto fail;
+ }
+ } else {
+ PyArray_Descr *d = PyArray_DescrFromType(def.type);
+ if (sprintf(p,"%s'%c'-",p,d->type)==0) {Py_DECREF(d); goto fail;}
+ Py_DECREF(d);
+ if (def.data==NULL) {
+ if (sprintf(p,"%sarray(%" NPY_INTP_FMT,p,def.dims.d[0])==0) goto fail;
+ for(i=1;i<def.rank;++i)
+ if (sprintf(p,"%s,%" NPY_INTP_FMT,p,def.dims.d[i])==0) goto fail;
+ if (sprintf(p,"%s), not allocated",p)==0) goto fail;
+ } else {
+ if (def.rank>0) {
+ if (sprintf(p,"%sarray(%"NPY_INTP_FMT,p,def.dims.d[0])==0) goto fail;
+ for(i=1;i<def.rank;i++)
+ if (sprintf(p,"%s,%" NPY_INTP_FMT,p,def.dims.d[i])==0) goto fail;
+ if (sprintf(p,"%s)",p)==0) goto fail;
+ } else {
+ if (sprintf(p,"%sscalar",p)==0) goto fail;
+ }
+ }
+ }
+ if (sprintf(p,"%s\n",p)==0) goto fail;
+ if (strlen(p)>size) {
+ fprintf(stderr,"fortranobject.c:fortran_doc:len(p)=%zd>%d(size): too long doc string required, increase size\n",strlen(p),size);
+ goto fail;
+ }
+ s = PyString_FromString(p);
+ fail:
+ free(p);
+ return s;
+}
+
+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_GetItemString(fp->dict, name);
+ 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_FARRAY,
+ NULL);
+ if (v==NULL) return NULL;
+ /* Py_INCREF(v); */
+ return v;
+ } else { /* array is not allocated */
+ Py_INCREF(Py_None);
+ return Py_None;
+ }
+ }
+ if (strcmp(name,"__dict__")==0) {
+ Py_INCREF(fp->dict);
+ return fp->dict;
+ }
+ if (strcmp(name,"__doc__")==0) {
+ PyObject *s = PyString_FromString("");
+ for (i=0;i<fp->len;i++)
+ PyString_ConcatAndDel(&s,fortran_doc(fp->defs[i]));
+ if (PyDict_SetItemString(fp->dict, name, s))
+ return NULL;
+ return s;
+ }
+ if ((strcmp(name,"_cpointer")==0) && (fp->len==1)) {
+ PyObject *cobj = PyCObject_FromVoidPtr((void *)(fp->defs[0].data),NULL);
+ if (PyDict_SetItemString(fp->dict, name, cobj))
+ return NULL;
+ return cobj;
+ }
+ return Py_FindMethod(fortran_methods, (PyObject *)fp, name);
+}
+
+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,arr->dimensions,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,arr->nd);
+ if (s==-1)
+ s = PyArray_MultiplyList(arr->dimensions,arr->nd);
+ if (s<0 ||
+ (memcpy(fp->defs[i].data,arr->data,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; /* succesful */
+ }
+ 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;
+}
+
+
+PyTypeObject PyFortran_Type = {
+ PyObject_HEAD_INIT(0)
+ 0, /*ob_size*/
+ "fortran", /*tp_name*/
+ sizeof(PyFortranObject), /*tp_basicsize*/
+ 0, /*tp_itemsize*/
+ /* methods */
+ (destructor)fortran_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ (getattrfunc)fortran_getattr, /*tp_getattr*/
+ (setattrfunc)fortran_setattr, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+ 0, /*tp_hash*/
+ (ternaryfunc)fortran_call, /*tp_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 (acctual) : %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 long arr_size = PyArray_Size((PyObject *)arr);
+ if (arr_size>F2PY_REPORT_ON_ARRAY_COPY) {
+ fprintf(stderr,"copied an array: size=%ld, elsize=%d\n",
+ arr_size, 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 contigious 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
+count_nonpos(const int rank,
+ const npy_intp *dims) {
+ int i=0,r=0;
+ while (i<rank) {
+ if (dims[i] <= 0) ++r;
+ ++i;
+ }
+ return r;
+}
+
+static int check_and_fix_dimensions(const PyArrayObject* arr,
+ const int rank,
+ npy_intp *dims);
+
+#ifdef DEBUG_COPY_ND_ARRAY
+void dump_dims(int rank, npy_intp* dims) {
+ int i;
+ printf("[");
+ for(i=0;i<rank;++i) {
+ printf("%3" NPY_INTP_FMT, dims[i]);
+ }
+ printf("]\n");
+}
+void dump_attrs(const PyArrayObject* arr) {
+ int rank = arr->nd;
+ 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* arr1, PyArrayObject* arr2) {
+ 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)) \
+)
+
+extern
+PyArrayObject* array_from_pyobj(const int type_num,
+ npy_intp *dims,
+ const int rank,
+ const int intent,
+ PyObject *obj) {
+ /* 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[200];
+ PyArrayObject *arr = NULL;
+ PyArray_Descr *descr;
+ char typechar;
+ int elsize;
+
+ if ((intent & F2PY_INTENT_HIDE)
+ || ((intent & F2PY_INTENT_CACHE) && (obj==Py_None))
+ || ((intent & F2PY_OPTIONAL) && (obj==Py_None))
+ ) {
+ /* intent(cache), optional, intent(hide) */
+ if (count_nonpos(rank,dims)) {
+ int i;
+ sprintf(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]);
+ sprintf(mess+strlen(mess),")");
+ PyErr_SetString(PyExc_ValueError,mess);
+ return NULL;
+ }
+ arr = (PyArrayObject *)
+ PyArray_New(&PyArray_Type, rank, dims, type_num,
+ NULL,NULL,0,
+ !(intent&F2PY_INTENT_C),
+ NULL);
+ if (arr==NULL) return NULL;
+ if (!(intent & F2PY_INTENT_CACHE))
+ PyArray_FILLWBYTE(arr, 0);
+ return arr;
+ }
+
+ descr = PyArray_DescrFromType(type_num);
+ elsize = descr->elsize;
+ typechar = descr->type;
+ Py_DECREF(descr);
+ if (PyArray_Check(obj)) {
+ arr = (PyArrayObject *)obj;
+
+ if (intent & F2PY_INTENT_CACHE) {
+ /* intent(cache) */
+ if (PyArray_ISONESEGMENT(obj)
+ && PyArray_ITEMSIZE((PyArrayObject *)obj)>=elsize) {
+ if (check_and_fix_dimensions((PyArrayObject *)obj,rank,dims)) {
+ return NULL; /*XXX: set exception */
+ }
+ if (intent & F2PY_INTENT_OUT)
+ Py_INCREF(obj);
+ return (PyArrayObject *)obj;
+ }
+ sprintf(mess,"failed to initialize intent(cache) array");
+ if (!PyArray_ISONESEGMENT(obj))
+ sprintf(mess+strlen(mess)," -- input must be in one segment");
+ if (PyArray_ITEMSIZE(arr)<elsize)
+ sprintf(mess+strlen(mess)," -- expected at least elsize=%d but got %d",
+ elsize,PyArray_ITEMSIZE(arr)
+ );
+ PyErr_SetString(PyExc_ValueError,mess);
+ return NULL;
+ }
+
+ /* here we have always intent(in) or intent(inout) or intent(inplace) */
+
+ if (check_and_fix_dimensions(arr,rank,dims)) {
+ return NULL; /*XXX: set exception */
+ }
+
+ if ((! (intent & F2PY_INTENT_COPY))
+ && PyArray_ITEMSIZE(arr)==elsize
+ && ARRAY_ISCOMPATIBLE(arr,type_num)
+ ) {
+ if ((intent & F2PY_INTENT_C)?PyArray_ISCARRAY(arr):PyArray_ISFARRAY(arr)) {
+ if ((intent & F2PY_INTENT_OUT)) {
+ Py_INCREF(arr);
+ }
+ /* Returning input array */
+ return arr;
+ }
+ }
+
+ if (intent & F2PY_INTENT_INOUT) {
+ sprintf(mess,"failed to initialize intent(inout) array");
+ if ((intent & F2PY_INTENT_C) && !PyArray_ISCARRAY(arr))
+ sprintf(mess+strlen(mess)," -- input not contiguous");
+ if (!(intent & F2PY_INTENT_C) && !PyArray_ISFARRAY(arr))
+ sprintf(mess+strlen(mess)," -- input not fortran contiguous");
+ if (PyArray_ITEMSIZE(arr)!=elsize)
+ sprintf(mess+strlen(mess)," -- expected elsize=%d but got %d",
+ elsize,
+ PyArray_ITEMSIZE(arr)
+ );
+ if (!(ARRAY_ISCOMPATIBLE(arr,type_num)))
+ sprintf(mess+strlen(mess)," -- input '%c' not compatible to '%c'",
+ arr->descr->type,typechar);
+ PyErr_SetString(PyExc_ValueError,mess);
+ return NULL;
+ }
+
+ /* here we have always intent(in) or intent(inplace) */
+
+ {
+ PyArrayObject *retarr = (PyArrayObject *) \
+ PyArray_New(&PyArray_Type, arr->nd, arr->dimensions, type_num,
+ NULL,NULL,0,
+ !(intent&F2PY_INTENT_C),
+ NULL);
+ if (retarr==NULL)
+ 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))
+ 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)) {
+ sprintf(mess,"failed to initialize intent(inout|inplace|cache) array"
+ " -- input must be array but got %s",
+ PyString_AsString(PyObject_Str(PyObject_Type(obj)))
+ );
+ PyErr_SetString(PyExc_TypeError,mess);
+ return NULL;
+ }
+
+ {
+ F2PY_REPORT_ON_ARRAY_COPY_FROMANY;
+ arr = (PyArrayObject *) \
+ PyArray_FromAny(obj,PyArray_DescrFromType(type_num), 0,0,
+ ((intent & F2PY_INTENT_C)?NPY_CARRAY:NPY_FARRAY) \
+ | NPY_FORCECAST, NULL);
+ if (arr==NULL)
+ return NULL;
+ if (check_and_fix_dimensions(arr,rank,dims))
+ return NULL; /*XXX: set exception */
+ return arr;
+ }
+
+}
+
+ /*****************************************/
+ /* Helper functions for array_from_pyobj */
+ /*****************************************/
+
+static
+int check_and_fix_dimensions(const PyArrayObject* arr,const int rank,npy_intp *dims) {
+ /*
+ 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.
+ */
+ const npy_intp arr_size = (arr->nd)?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 > arr->nd) { /* [1,2] -> [[1],[2]]; 1 -> [[1]] */
+ npy_intp new_size = 1;
+ int free_axe = -1;
+ int i;
+ /* Fill dims where -1 or 0; check dimensions; calc new_size; */
+ for(i=0;i<arr->nd;++i) {
+ if (dims[i] >= 0) {
+ if (dims[i]!=arr->dimensions[i]) {
+ fprintf(stderr,"%d-th dimension must be fixed to %" NPY_INTP_FMT
+ " but got %" NPY_INTP_FMT "\n",
+ i,dims[i], arr->dimensions[i]);
+ return 1;
+ }
+ if (!dims[i]) dims[i] = 1;
+ } else {
+ dims[i] = arr->dimensions[i] ? arr->dimensions[i] : 1;
+ }
+ new_size *= dims[i];
+ }
+ for(i=arr->nd;i<rank;++i)
+ if (dims[i]>1) {
+ fprintf(stderr,"%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) {
+ fprintf(stderr,"confused: new_size=%" NPY_INTP_FMT
+ ", arr_size=%" NPY_INTP_FMT " (maybe too many free"
+ " indices)\n", new_size,arr_size);
+ return 1;
+ }
+ } else if (rank==arr->nd) {
+ int i;
+ npy_intp d;
+ for (i=0; i<rank; ++i) {
+ d = arr->dimensions[i];
+ if (dims[i]>=0) {
+ if (d > 1 && d!=dims[i]) {
+ fprintf(stderr,"%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;
+ }
+ } else { /* [[1,2]] -> [[1],[2]] */
+ int i,j;
+ npy_intp d;
+ int effrank;
+ npy_intp size;
+ for (i=0,effrank=0;i<arr->nd;++i)
+ if (arr->dimensions[i]>1) ++effrank;
+ if (dims[rank-1]>=0)
+ if (effrank>rank) {
+ fprintf(stderr,"too many axes: %d (effrank=%d), expected rank=%d\n",
+ arr->nd,effrank,rank);
+ return 1;
+ }
+
+ for (i=0,j=0;i<rank;++i) {
+ while (j<arr->nd && arr->dimensions[j]<2) ++j;
+ if (j>=arr->nd) d = 1;
+ else d = arr->dimensions[j++];
+ if (dims[i]>=0) {
+ if (d>1 && d!=dims[i]) {
+ fprintf(stderr,"%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);
+ return 1;
+ }
+ if (!dims[i]) dims[i] = 1;
+ } else
+ dims[i] = d;
+ }
+
+ for (i=rank;i<arr->nd;++i) { /* [[1,2],[3,4]] -> [1,2,3,4] */
+ while (j<arr->nd && arr->dimensions[j]<2) ++j;
+ if (j>=arr->nd) d = 1;
+ else d = arr->dimensions[j++];
+ dims[rank-1] *= d;
+ }
+ for (i=0,size=1;i<rank;++i) size *= dims[i];
+ if (size != arr_size) {
+ fprintf(stderr,"confused: size=%" NPY_INTP_FMT ", arr_size=%" NPY_INTP_FMT
+ ", rank=%d, effrank=%d, arr.nd=%d, dims=[",
+ size,arr_size,rank,effrank,arr->nd);
+ for (i=0;i<rank;++i) fprintf(stderr," %" NPY_INTP_FMT,dims[i]);
+ fprintf(stderr," ], arr.dims=[");
+ for (i=0;i<arr->nd;++i) fprintf(stderr," %" NPY_INTP_FMT,arr->dimensions[i]);
+ fprintf(stderr," ]\n");
+ 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);
+}
+
+#ifdef __cplusplus
+}
+#endif
+/************************* EOF fortranobject.c *******************************/
diff --git a/numpy/f2py/src/fortranobject.h b/numpy/f2py/src/fortranobject.h
new file mode 100644
index 000000000..b28848b79
--- /dev/null
+++ b/numpy/f2py/src/fortranobject.h
@@ -0,0 +1,124 @@
+#ifndef Py_FORTRANOBJECT_H
+#define Py_FORTRANOBJECT_H
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#include "Python.h"
+
+#ifdef FORTRANOBJECT_C
+#define NO_IMPORT_ARRAY
+#endif
+#define PY_ARRAY_UNIQUE_SYMBOL PyArray_API
+#include "numpy/arrayobject.h"
+
+ /*
+#ifdef F2PY_REPORT_ATEXIT_DISABLE
+#undef F2PY_REPORT_ATEXIT
+#else
+
+#ifndef __FreeBSD__
+#ifndef __WIN32__
+#ifndef __APPLE__
+#define F2PY_REPORT_ATEXIT
+#endif
+#endif
+#endif
+
+#endif
+ */
+
+#ifdef F2PY_REPORT_ATEXIT
+#include <sys/timeb.h>
+ 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*);
+#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
+
+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 */
+ 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) ((op)->ob_type == &PyFortran_Type)
+#define PyFortran_Check1(op) (0==strcmp((op)->ob_type->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);
+
+#define ISCONTIGUOUS(m) ((m)->flags & NPY_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
+
+ 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
+
+#ifdef __cplusplus
+}
+#endif
+#endif /* !Py_FORTRANOBJECT_H */
diff --git a/numpy/f2py/src/test/Makefile b/numpy/f2py/src/test/Makefile
new file mode 100644
index 000000000..0f8869f72
--- /dev/null
+++ b/numpy/f2py/src/test/Makefile
@@ -0,0 +1,96 @@
+# -*- makefile -*-
+# File: Makefile-foo
+# Usage:
+# make -f Makefile-foo [MODE=opt|debug]
+# Notes:
+# 1) You must use GNU make; try `gmake ..' if `make' fails.
+# 2) This file is auto-generated with f2py (version 2.264).
+# f2py is a Fortran to Python Interface Generator (FPIG), Second Edition,
+# written by Pearu Peterson <pearu@ioc.ee>.
+# See http://cens.ioc.ee/projects/f2py2e/
+# Generation date: Wed Sep 13 16:22:55 2000
+# $Revision: 1.2 $
+# $Date: 2000/09/17 16:10:27 $
+
+# Recommendation notes produced by f2py2e/buildmakefile.py:
+# ***
+
+PYINC = -I/numeric/include/python1.5/Numeric -I/numeric/include/python1.5
+INCLUDES = -I..
+LIBS = -L$(shell gcc -v 2>&1 | grep specs | sed -e 's/Reading specs from //g' | sed -e 's/\/specs//g') -lg2c
+LIBS=-L$$ABSOFT/lib -lfio -lf77math -lf90math
+LIBS=-L/numeric/bin -lvast90 -L/usr/lib/gcc-lib/i586-mandrake-linux/2.95.2 -lg2c
+
+# Wrapper generator:
+F2PY = /home/pearu/bin/f2py-cvs
+
+# Fortran compiler: Absoft f95
+FC = f95
+FC = f90
+FOPT =
+FDEBUG =
+FFLAGS = -B108 -YCFRL=1 -YCOM_NAMES=LCS -YCOM_PFX -YCOM_SFX=_ -YEXT_PFX -YEXT_NAMES=LCS
+FFLAGS =
+# C compiler: cc ('gcc 2.x.x' 2.95.2)
+CC = cc
+COPT =
+CDEBUG =
+CFLAGS = -fpic
+
+# Linker: ld ('GNU ld' 2.9.5)
+LD = ld
+LDFLAGS = -shared -s
+SO = .so
+
+ifeq '$(MODE)' 'debug'
+FFLAGS += $(FDEBUG)
+CFLAGS += $(CDEBUG)
+endif
+ifeq '$(MODE)' 'opt'
+FFLAGS += $(FOPT)
+CFLAGS += $(COPT)
+endif
+FFLAGS += $(INCLUDES)
+CFLAGS += $(PYINC) $(INCLUDES)
+
+SRCC = ../fortranobject.c
+SRCF = mod.f90 bar.f foo90.f90 wrap.f
+SRCS = $(SRCC) $(SRCF)
+OBJC = $(filter %.o,$(SRCC:.c=.o) $(SRCC:.cc=.o) $(SRCC:.C=.o))
+OBJF = $(filter %.o,$(SRCF:.f90=.o) $(SRCF:.f=.o) $(SRCF:.F=.o) $(SRCF:.for=.o))
+OBJS = $(OBJC) $(OBJF)
+
+INSTALLNAME = f2py2e-apps
+INSTALLDIRECTORY = /numeric/lib/python1.5/site-packages/$(INSTALLNAME)
+INSTALLDIR = install -d -c
+INSTALLEXEC = install -m 755 -c
+
+all: foo
+
+foo: foomodule$(SO)
+foomodule$(SO) : foomodule.o $(OBJS)
+ $(LD) $(LDFLAGS) -o $@ $< $(OBJS) $(LIBS)
+
+foomodule.o: foomodule.c
+
+
+$(OBJS) : $(SRCS)
+%.o : %.f ; $(FC) -c $(FFLAGS) $<
+%.o : %.f90 ; $(FC) -c $(FFLAGS) $<
+
+test: foomodule$(SO)
+ python -c 'import foo;print foo.__doc__'
+install: foomodule$(SO)
+ $(INSTALLDIR) $(INSTALLDIRECTORY)
+ $(INSTALLEXEC) foomodule$(SO) $(INSTALLDIRECTORY)
+ cd $(INSTALLDIRECTORY) && echo "$(INSTALLNAME)" > ../$(INSTALLNAME).pth
+
+.PHONY: clean distclean debug test install foo
+debug:
+ echo "OBJS=$(OBJS)"
+ echo "SRCS=$(SRCS)"
+clean:
+ $(RM) *.o *.mod core foomodule.{dvi,log} $(OBJS)
+distclean: clean
+ $(RM) *.so *.sl foomodule.{tex,so}
+ $(RM) .f2py_get_compiler_*
diff --git a/numpy/f2py/src/test/bar.f b/numpy/f2py/src/test/bar.f
new file mode 100644
index 000000000..5354ceaf9
--- /dev/null
+++ b/numpy/f2py/src/test/bar.f
@@ -0,0 +1,11 @@
+ subroutine bar()
+ integer a
+ real*8 b,c(3)
+ common /foodata/ a,b,c
+ a = 4
+ b = 6.7
+ c(2) = 3.0
+ write(*,*) "bar:a=",a
+ write(*,*) "bar:b=",b
+ write(*,*) "bar:c=",c
+ end
diff --git a/numpy/f2py/src/test/foo.f b/numpy/f2py/src/test/foo.f
new file mode 100644
index 000000000..5354ceaf9
--- /dev/null
+++ b/numpy/f2py/src/test/foo.f
@@ -0,0 +1,11 @@
+ subroutine bar()
+ integer a
+ real*8 b,c(3)
+ common /foodata/ a,b,c
+ a = 4
+ b = 6.7
+ c(2) = 3.0
+ write(*,*) "bar:a=",a
+ write(*,*) "bar:b=",b
+ write(*,*) "bar:c=",c
+ end
diff --git a/numpy/f2py/src/test/foo90.f90 b/numpy/f2py/src/test/foo90.f90
new file mode 100644
index 000000000..dbca7e95b
--- /dev/null
+++ b/numpy/f2py/src/test/foo90.f90
@@ -0,0 +1,13 @@
+subroutine foo()
+ integer a
+ real*8 b,c(3)
+ common /foodata/ a,b,c
+ print*, " F: in foo"
+ a = 5
+ b = 6.3
+ c(2) = 9.1
+end subroutine foo
+
+
+
+
diff --git a/numpy/f2py/src/test/foomodule.c b/numpy/f2py/src/test/foomodule.c
new file mode 100644
index 000000000..0a954676e
--- /dev/null
+++ b/numpy/f2py/src/test/foomodule.c
@@ -0,0 +1,143 @@
+/* File: foomodule.c
+ * Example of FortranObject usage. See also wrap.f foo.f foo90.f90.
+ * Author: Pearu Peterson <pearu@ioc.ee>.
+ * http://cens.ioc.ee/projects/f2py2e/
+ * $Revision: 1.2 $
+ * $Date: 2000/09/17 16:10:27 $
+ */
+#ifdef __CPLUSPLUS__
+extern "C" {
+#endif
+
+#include "Python.h"
+#include "fortranobject.h"
+
+static PyObject *foo_error;
+
+#if defined(NO_APPEND_FORTRAN)
+#if defined(UPPERCASE_FORTRAN)
+#define F_FUNC(f,F) F
+#else
+#define F_FUNC(f,F) f
+#endif
+#else
+#if defined(UPPERCASE_FORTRAN)
+#define F_FUNC(f,F) F##_
+#else
+#define F_FUNC(f,F) f##_
+#endif
+#endif
+
+ /************* foo_bar *************/
+ static char doc_foo_bar[] = "\
+Function signature:\n\
+ bar()\n\
+";
+ static PyObject *foo_bar(PyObject *capi_self, PyObject *capi_args,
+ PyObject *capi_keywds, void (*f2py_func)()) {
+ PyObject *capi_buildvalue = NULL;
+ static char *capi_kwlist[] = {NULL};
+ if (!PyArg_ParseTupleAndKeywords(capi_args,capi_keywds,\
+ "|:foo.bar",\
+ capi_kwlist))
+ goto capi_fail;
+ (*f2py_func)();
+ capi_buildvalue = Py_BuildValue("");
+ capi_fail:
+ return capi_buildvalue;
+ }
+ /************ mod_init **************/
+ static PyObject *mod_init(PyObject *capi_self, PyObject *capi_args,
+ PyObject *capi_keywds, void (*f2py_func)()) {
+ PyObject *capi_buildvalue = NULL;
+ static char *capi_kwlist[] = {NULL};
+ if (!PyArg_ParseTupleAndKeywords(capi_args,capi_keywds,\
+ "|:mod.init",\
+ capi_kwlist))
+ goto capi_fail;
+ (*f2py_func)();
+ capi_buildvalue = Py_BuildValue("");
+ capi_fail:
+ return capi_buildvalue;
+ }
+
+ /* F90 module */
+ static FortranDataDef f2py_mod_def[] = {
+ {"a",0, {}, PyArray_INT},
+ {"b",0, {}, PyArray_DOUBLE},
+ {"c",1, {3}, PyArray_DOUBLE},
+ {"d",1, {-1}, PyArray_DOUBLE},
+ {"init",-1,{},0,NULL,(void *)mod_init},
+ {NULL}
+ };
+ static void f2py_setup_mod(char *a,char *b,char *c,void (*d)(),char *init) {
+ f2py_mod_def[0].data = a;
+ f2py_mod_def[1].data = b;
+ f2py_mod_def[2].data = c;
+ f2py_mod_def[3].func = d;
+ f2py_mod_def[4].data = init;
+ }
+ extern void F_FUNC(f2pyinitmod,F2PYINITMOD)();
+ static void f2py_init_mod() {
+ F_FUNC(f2pyinitmod,F2PYINITMOD)(f2py_setup_mod);
+ }
+
+ /* COMMON block */
+ static FortranDataDef f2py_foodata_def[] = {
+ {"a",0, {}, PyArray_INT},
+ {"b",0, {}, PyArray_DOUBLE},
+ {"c",1, {3}, PyArray_DOUBLE},
+ {NULL}
+ };
+ static void f2py_setup_foodata(char *a,char *b,char *c) {
+ f2py_foodata_def[0].data = a;
+ f2py_foodata_def[1].data = b;
+ f2py_foodata_def[2].data = c;
+ }
+ extern void F_FUNC(f2pyinitfoodata,F2PYINITFOODATA)();
+ static void f2py_init_foodata() {
+ F_FUNC(f2pyinitfoodata,F2PYINITFOODATA)(f2py_setup_foodata);
+ }
+
+ /* Fortran routines (needs no initialization/setup function) */
+ extern void F_FUNC(bar,BAR)();
+ extern void F_FUNC(foo,FOO)();
+ static FortranDataDef f2py_routines_def[] = {
+ {"bar",-1, {}, 0, (char *)F_FUNC(bar,BAR),(void *)foo_bar,doc_foo_bar},
+ {"foo",-1, {}, 0, (char *)F_FUNC(foo,FOO),(void *)foo_bar,doc_foo_bar},
+ {NULL}
+ };
+
+static PyMethodDef foo_module_methods[] = {
+/*eof method*/
+ {NULL,NULL}
+};
+
+void initfoo() {
+ int i;
+ PyObject *m, *d, *s;
+ PyTypeObject *t;
+ PyObject *f;
+ import_array();
+
+ m = Py_InitModule("foo", foo_module_methods);
+
+ d = PyModule_GetDict(m);
+ s = PyString_FromString("This module 'foo' demonstrates the usage of fortranobject.");
+ PyDict_SetItemString(d, "__doc__", s);
+
+ /* Fortran objects: */
+ PyDict_SetItemString(d, "mod", PyFortranObject_New(f2py_mod_def,f2py_init_mod));
+ PyDict_SetItemString(d, "foodata", PyFortranObject_New(f2py_foodata_def,f2py_init_foodata));
+ for(i=0;f2py_routines_def[i].name!=NULL;i++)
+ PyDict_SetItemString(d, f2py_routines_def[i].name,
+ PyFortranObject_NewAsAttr(&f2py_routines_def[i]));
+
+ Py_DECREF(s);
+
+ if (PyErr_Occurred())
+ Py_FatalError("can't initialize module foo");
+}
+#ifdef __CPLUSCPLUS__
+}
+#endif
diff --git a/numpy/f2py/src/test/wrap.f b/numpy/f2py/src/test/wrap.f
new file mode 100644
index 000000000..9414eb9f6
--- /dev/null
+++ b/numpy/f2py/src/test/wrap.f
@@ -0,0 +1,70 @@
+ subroutine f2py_mod_get_dims(f2py_r,f2py_s,f2py_set,f2py_n)
+ use mod
+ external f2py_set
+ logical f2py_ns
+ integer f2py_s(*),f2py_r,f2py_i,f2py_j
+ character*(*) f2py_n
+ if ("d".eq.f2py_n) then
+ f2py_ns = .FALSE.
+ if (allocated(d)) then
+ do f2py_i=1,f2py_r
+ if ((size(d,f2py_r-f2py_i+1).ne.f2py_s(f2py_i)).and.
+ c (f2py_s(f2py_i).ge.0)) then
+ f2py_ns = .TRUE.
+ end if
+ end do
+ if (f2py_ns) then
+ deallocate(d)
+ end if
+ end if
+ if (.not.allocated(d)) then
+ allocate(d(f2py_s(1)))
+ end if
+ if (allocated(d)) then
+ do f2py_i=1,f2py_r
+ f2py_s(f2py_i) = size(d,f2py_r-f2py_i+1)
+ end do
+ call f2py_set(d)
+ end if
+ end if
+ end subroutine f2py_mod_get_dims
+ subroutine f2py_mod_get_dims_d(r,s,set_data)
+ use mod, only: d => d
+ external set_data
+ logical ns
+ integer s(*),r,i,j
+ ns = .FALSE.
+ if (allocated(d)) then
+ do i=1,r
+ if ((size(d,r-i+1).ne.s(i)).and.(s(i).ge.0)) then
+ ns = .TRUE.
+ end if
+ end do
+ if (ns) then
+ deallocate(d)
+ end if
+ end if
+ if (.not.allocated(d).and.(s(1).ge.1)) then
+ allocate(d(s(1)))
+ end if
+ if (allocated(d)) then
+ do i=1,r
+ s(i) = size(d,r-i+1)
+ end do
+ end if
+ call set_data(d,allocated(d))
+ end subroutine f2py_mod_get_dims_d
+
+ subroutine f2pyinitmod(setupfunc)
+ use mod
+ external setupfunc,f2py_mod_get_dims_d,init
+ call setupfunc(a,b,c,f2py_mod_get_dims_d,init)
+ end subroutine f2pyinitmod
+
+ subroutine f2pyinitfoodata(setupfunc)
+ external setupfunc
+ integer a
+ real*8 b,c(3)
+ common /foodata/ a,b,c
+ call setupfunc(a,b,c)
+ end subroutine f2pyinitfoodata
diff --git a/numpy/f2py/tests/array_from_pyobj/__init__.py b/numpy/f2py/tests/array_from_pyobj/__init__.py
new file mode 100644
index 000000000..e69de29bb
--- /dev/null
+++ b/numpy/f2py/tests/array_from_pyobj/__init__.py
diff --git a/numpy/f2py/tests/array_from_pyobj/setup.py b/numpy/f2py/tests/array_from_pyobj/setup.py
new file mode 100644
index 000000000..520e3dd94
--- /dev/null
+++ b/numpy/f2py/tests/array_from_pyobj/setup.py
@@ -0,0 +1,25 @@
+import os
+def configuration(parent_name='',top_path=None):
+ from numpy.distutils.misc_util import Configuration
+
+ config = Configuration('array_from_pyobj',parent_name,top_path)
+ #import numpy.f2py as f2py
+ #f2pydir=os.path.dirname(os.path.abspath(f2py.__file__))
+ f2pydir=os.path.join(config.local_path,'..','..')
+ fobjhsrc = os.path.join(f2pydir,'src','fortranobject.h')
+ fobjcsrc = os.path.join(f2pydir,'src','fortranobject.c')
+ config.add_extension('wrap',
+ sources = ['wrapmodule.c',fobjcsrc],
+ include_dirs = [os.path.dirname(fobjhsrc)],
+ depends = [fobjhsrc,fobjcsrc],
+ define_macros = [('DEBUG_COPY_ND_ARRAY',1),
+ #('F2PY_REPORT_ON_ARRAY_COPY',1),
+ #('F2PY_REPORT_ATEXIT',1)
+ ]
+ )
+
+ return config
+
+if __name__ == "__main__":
+ from numpy.distutils.core import setup
+ setup(configuration=configuration)
diff --git a/numpy/f2py/tests/array_from_pyobj/tests/test_array_from_pyobj.py b/numpy/f2py/tests/array_from_pyobj/tests/test_array_from_pyobj.py
new file mode 100644
index 000000000..e1d4a47a6
--- /dev/null
+++ b/numpy/f2py/tests/array_from_pyobj/tests/test_array_from_pyobj.py
@@ -0,0 +1,515 @@
+import unittest
+import sys
+import copy
+
+from numpy.testing import *
+from numpy import array, alltrue, ndarray, asarray, can_cast,zeros, dtype
+from numpy.core.multiarray import typeinfo
+
+set_package_path()
+from array_from_pyobj import wrap
+del sys.path[0]
+
+def flags_info(arr):
+ flags = wrap.array_attrs(arr)[6]
+ return flags2names(flags)
+
+def flags2names(flags):
+ info = []
+ for flagname in ['CONTIGUOUS','FORTRAN','OWNDATA','ENSURECOPY',
+ 'ENSUREARRAY','ALIGNED','NOTSWAPPED','WRITEABLE',
+ 'UPDATEIFCOPY','BEHAVED','BEHAVED_RO',
+ 'CARRAY','FARRAY'
+ ]:
+ if abs(flags) & getattr(wrap,flagname):
+ info.append(flagname)
+ return info
+
+class Intent:
+ def __init__(self,intent_list=[]):
+ self.intent_list = intent_list[:]
+ flags = 0
+ for i in intent_list:
+ if i=='optional':
+ flags |= wrap.F2PY_OPTIONAL
+ else:
+ flags |= getattr(wrap,'F2PY_INTENT_'+i.upper())
+ self.flags = flags
+ def __getattr__(self,name):
+ name = name.lower()
+ if name=='in_': name='in'
+ return self.__class__(self.intent_list+[name])
+ def __str__(self):
+ return 'intent(%s)' % (','.join(self.intent_list))
+ def __repr__(self):
+ return 'Intent(%r)' % (self.intent_list)
+ def is_intent(self,*names):
+ for name in names:
+ if name not in self.intent_list:
+ return False
+ return True
+ def is_intent_exact(self,*names):
+ return len(self.intent_list)==len(names) and self.is_intent(*names)
+
+intent = Intent()
+
+class Type(object):
+
+ _type_names = ['BOOL','BYTE','UBYTE','SHORT','USHORT','INT','UINT',
+ 'LONG','ULONG','LONGLONG','ULONGLONG',
+ 'FLOAT','DOUBLE','LONGDOUBLE','CFLOAT','CDOUBLE',
+ 'CLONGDOUBLE']
+ _type_cache = {}
+
+ _cast_dict = {'BOOL':['BOOL']}
+ _cast_dict['BYTE'] = _cast_dict['BOOL'] + ['BYTE']
+ _cast_dict['UBYTE'] = _cast_dict['BOOL'] + ['UBYTE']
+ _cast_dict['BYTE'] = ['BYTE']
+ _cast_dict['UBYTE'] = ['UBYTE']
+ _cast_dict['SHORT'] = _cast_dict['BYTE'] + ['UBYTE','SHORT']
+ _cast_dict['USHORT'] = _cast_dict['UBYTE'] + ['BYTE','USHORT']
+ _cast_dict['INT'] = _cast_dict['SHORT'] + ['USHORT','INT']
+ _cast_dict['UINT'] = _cast_dict['USHORT'] + ['SHORT','UINT']
+
+ _cast_dict['LONG'] = _cast_dict['INT'] + ['LONG']
+ _cast_dict['ULONG'] = _cast_dict['UINT'] + ['ULONG']
+
+ _cast_dict['LONGLONG'] = _cast_dict['LONG'] + ['LONGLONG']
+ _cast_dict['ULONGLONG'] = _cast_dict['ULONG'] + ['ULONGLONG']
+
+ _cast_dict['FLOAT'] = _cast_dict['SHORT'] + ['USHORT','FLOAT']
+ _cast_dict['DOUBLE'] = _cast_dict['INT'] + ['UINT','FLOAT','DOUBLE']
+ _cast_dict['LONGDOUBLE'] = _cast_dict['LONG'] + ['ULONG','FLOAT','DOUBLE','LONGDOUBLE']
+
+ _cast_dict['CFLOAT'] = _cast_dict['FLOAT'] + ['CFLOAT']
+ _cast_dict['CDOUBLE'] = _cast_dict['DOUBLE'] + ['CFLOAT','CDOUBLE']
+ _cast_dict['CLONGDOUBLE'] = _cast_dict['LONGDOUBLE'] + ['CFLOAT','CDOUBLE','CLONGDOUBLE']
+
+
+ def __new__(cls,name):
+ if isinstance(name,dtype):
+ dtype0 = name
+ name = None
+ for n,i in typeinfo.items():
+ if isinstance(i,tuple) and dtype0.type is i[-1]:
+ name = n
+ break
+ obj = cls._type_cache.get(name.upper(),None)
+ if obj is not None:
+ return obj
+ obj = object.__new__(cls)
+ obj._init(name)
+ cls._type_cache[name.upper()] = obj
+ return obj
+
+ def _init(self,name):
+ self.NAME = name.upper()
+ self.type_num = getattr(wrap,'PyArray_'+self.NAME)
+ assert_equal(self.type_num,typeinfo[self.NAME][1])
+ self.dtype = typeinfo[self.NAME][-1]
+ self.elsize = typeinfo[self.NAME][2] / 8
+ self.dtypechar = typeinfo[self.NAME][0]
+
+ def cast_types(self):
+ return map(self.__class__,self._cast_dict[self.NAME])
+
+ def all_types(self):
+ return map(self.__class__,self._type_names)
+
+ def smaller_types(self):
+ bits = typeinfo[self.NAME][3]
+ types = []
+ for name in self._type_names:
+ if typeinfo[name][3]<bits:
+ types.append(Type(name))
+ return types
+
+ def equal_types(self):
+ bits = typeinfo[self.NAME][3]
+ types = []
+ for name in self._type_names:
+ if name==self.NAME: continue
+ if typeinfo[name][3]==bits:
+ types.append(Type(name))
+ return types
+
+ def larger_types(self):
+ bits = typeinfo[self.NAME][3]
+ types = []
+ for name in self._type_names:
+ if typeinfo[name][3]>bits:
+ types.append(Type(name))
+ return types
+
+class Array:
+ def __init__(self,typ,dims,intent,obj):
+ self.type = typ
+ self.dims = dims
+ self.intent = intent
+ self.obj_copy = copy.deepcopy(obj)
+ self.obj = obj
+
+ # arr.dtypechar may be different from typ.dtypechar
+ self.arr = wrap.call(typ.type_num,dims,intent.flags,obj)
+
+ self.arr_attr = wrap.array_attrs(self.arr)
+
+ if len(dims)>1:
+ if self.intent.is_intent('c'):
+ assert intent.flags & wrap.F2PY_INTENT_C
+ assert not self.arr.flags['FORTRAN'],`self.arr.flags,obj.flags`
+ assert self.arr.flags['CONTIGUOUS']
+ assert not self.arr_attr[6] & wrap.FORTRAN
+ else:
+ assert not intent.flags & wrap.F2PY_INTENT_C
+ assert self.arr.flags['FORTRAN']
+ assert not self.arr.flags['CONTIGUOUS']
+ assert self.arr_attr[6] & wrap.FORTRAN
+
+ if obj is None:
+ self.pyarr = None
+ self.pyarr_attr = None
+ return
+
+ if intent.is_intent('cache'):
+ assert isinstance(obj,ndarray),`type(obj)`
+ self.pyarr = array(obj).reshape(*dims)
+
+ else:
+ self.pyarr = array(array(obj,
+ dtype = typ.dtypechar).reshape(*dims),
+ fortran=not self.intent.is_intent('c'))
+ assert self.pyarr.dtype.char==typ.dtypechar,\
+ `self.pyarr.dtype.char,typ.dtypechar`
+ assert self.pyarr.flags['OWNDATA']
+ self.pyarr_attr = wrap.array_attrs(self.pyarr)
+
+ if len(dims)>1:
+ if self.intent.is_intent('c'):
+ assert not self.pyarr.flags['FORTRAN']
+ assert self.pyarr.flags['CONTIGUOUS']
+ assert not self.pyarr_attr[6] & wrap.FORTRAN
+ else:
+ assert self.pyarr.flags['FORTRAN']
+ assert not self.pyarr.flags['CONTIGUOUS']
+ assert self.pyarr_attr[6] & wrap.FORTRAN
+
+
+ assert self.arr_attr[1]==self.pyarr_attr[1] # nd
+ assert self.arr_attr[2]==self.pyarr_attr[2] # dimensions
+ if self.arr_attr[1]<=1:
+ assert self.arr_attr[3]==self.pyarr_attr[3],\
+ `self.arr_attr[3],self.pyarr_attr[3],self.arr.tostring(),self.pyarr.tostring()` # strides
+ assert self.arr_attr[5][-2:]==self.pyarr_attr[5][-2:],\
+ `self.arr_attr[5],self.pyarr_attr[5]` # descr
+ assert self.arr_attr[6]==self.pyarr_attr[6],\
+ `self.arr_attr[6],self.pyarr_attr[6],flags2names(0*self.arr_attr[6]-self.pyarr_attr[6]),flags2names(self.arr_attr[6]),intent` # flags
+
+ if intent.is_intent('cache'):
+ assert self.arr_attr[5][3]>=self.type.elsize,\
+ `self.arr_attr[5][3],self.type.elsize`
+ else:
+ assert self.arr_attr[5][3]==self.type.elsize,\
+ `self.arr_attr[5][3],self.type.elsize`
+ assert self.arr_equal(self.pyarr,self.arr)
+
+ if isinstance(self.obj,ndarray):
+ if typ.elsize==Type(obj.dtype).elsize:
+ if not intent.is_intent('copy') and self.arr_attr[1]<=1:
+ assert self.has_shared_memory()
+
+ def arr_equal(self,arr1,arr2):
+ if arr1.shape != arr2.shape:
+ return False
+ s = arr1==arr2
+ return alltrue(s.flatten())
+
+ def __str__(self):
+ return str(self.arr)
+
+ def has_shared_memory(self):
+ """Check that created array shares data with input array.
+ """
+ if self.obj is self.arr:
+ return True
+ if not isinstance(self.obj,ndarray):
+ return False
+ obj_attr = wrap.array_attrs(self.obj)
+ return obj_attr[0]==self.arr_attr[0]
+
+##################################################
+
+class test_intent(unittest.TestCase):
+ def check_in_out(self):
+ assert_equal(str(intent.in_.out),'intent(in,out)')
+ assert intent.in_.c.is_intent('c')
+ assert not intent.in_.c.is_intent_exact('c')
+ assert intent.in_.c.is_intent_exact('c','in')
+ assert intent.in_.c.is_intent_exact('in','c')
+ assert not intent.in_.is_intent('c')
+
+class _test_shared_memory:
+ num2seq = [1,2]
+ num23seq = [[1,2,3],[4,5,6]]
+ def check_in_from_2seq(self):
+ a = self.array([2],intent.in_,self.num2seq)
+ assert not a.has_shared_memory()
+
+ def check_in_from_2casttype(self):
+ for t in self.type.cast_types():
+ obj = array(self.num2seq,dtype=t.dtype)
+ a = self.array([len(self.num2seq)],intent.in_,obj)
+ if t.elsize==self.type.elsize:
+ assert a.has_shared_memory(),`self.type.dtype,t.dtype`
+ else:
+ assert not a.has_shared_memory(),`t.dtype`
+
+ def check_inout_2seq(self):
+ obj = array(self.num2seq,dtype=self.type.dtype)
+ a = self.array([len(self.num2seq)],intent.inout,obj)
+ assert a.has_shared_memory()
+
+ try:
+ a = self.array([2],intent.in_.inout,self.num2seq)
+ except TypeError,msg:
+ if not str(msg).startswith('failed to initialize intent(inout|inplace|cache) array'):
+ raise
+ else:
+ raise SystemError,'intent(inout) should have failed on sequence'
+
+ def check_f_inout_23seq(self):
+ obj = array(self.num23seq,dtype=self.type.dtype,fortran=1)
+ shape = (len(self.num23seq),len(self.num23seq[0]))
+ a = self.array(shape,intent.in_.inout,obj)
+ assert a.has_shared_memory()
+
+ obj = array(self.num23seq,dtype=self.type.dtype,fortran=0)
+ shape = (len(self.num23seq),len(self.num23seq[0]))
+ try:
+ a = self.array(shape,intent.in_.inout,obj)
+ except ValueError,msg:
+ if not str(msg).startswith('failed to initialize intent(inout) array'):
+ raise
+ else:
+ raise SystemError,'intent(inout) should have failed on improper array'
+
+ def check_c_inout_23seq(self):
+ obj = array(self.num23seq,dtype=self.type.dtype)
+ shape = (len(self.num23seq),len(self.num23seq[0]))
+ a = self.array(shape,intent.in_.c.inout,obj)
+ assert a.has_shared_memory()
+
+ def check_in_copy_from_2casttype(self):
+ for t in self.type.cast_types():
+ obj = array(self.num2seq,dtype=t.dtype)
+ a = self.array([len(self.num2seq)],intent.in_.copy,obj)
+ assert not a.has_shared_memory(),`t.dtype`
+
+ def check_c_in_from_23seq(self):
+ a = self.array([len(self.num23seq),len(self.num23seq[0])],
+ intent.in_,self.num23seq)
+ assert not a.has_shared_memory()
+
+ def check_in_from_23casttype(self):
+ for t in self.type.cast_types():
+ obj = array(self.num23seq,dtype=t.dtype)
+ a = self.array([len(self.num23seq),len(self.num23seq[0])],
+ intent.in_,obj)
+ assert not a.has_shared_memory(),`t.dtype`
+
+ def check_f_in_from_23casttype(self):
+ for t in self.type.cast_types():
+ obj = array(self.num23seq,dtype=t.dtype,fortran=1)
+ a = self.array([len(self.num23seq),len(self.num23seq[0])],
+ intent.in_,obj)
+ if t.elsize==self.type.elsize:
+ assert a.has_shared_memory(),`t.dtype`
+ else:
+ assert not a.has_shared_memory(),`t.dtype`
+
+ def check_c_in_from_23casttype(self):
+ for t in self.type.cast_types():
+ obj = array(self.num23seq,dtype=t.dtype)
+ a = self.array([len(self.num23seq),len(self.num23seq[0])],
+ intent.in_.c,obj)
+ if t.elsize==self.type.elsize:
+ assert a.has_shared_memory(),`t.dtype`
+ else:
+ assert not a.has_shared_memory(),`t.dtype`
+
+ def check_f_copy_in_from_23casttype(self):
+ for t in self.type.cast_types():
+ obj = array(self.num23seq,dtype=t.dtype,fortran=1)
+ a = self.array([len(self.num23seq),len(self.num23seq[0])],
+ intent.in_.copy,obj)
+ assert not a.has_shared_memory(),`t.dtype`
+
+ def check_c_copy_in_from_23casttype(self):
+ for t in self.type.cast_types():
+ obj = array(self.num23seq,dtype=t.dtype)
+ a = self.array([len(self.num23seq),len(self.num23seq[0])],
+ intent.in_.c.copy,obj)
+ assert not a.has_shared_memory(),`t.dtype`
+
+ def check_in_cache_from_2casttype(self):
+ for t in self.type.all_types():
+ if t.elsize != self.type.elsize:
+ continue
+ obj = array(self.num2seq,dtype=t.dtype)
+ shape = (len(self.num2seq),)
+ a = self.array(shape,intent.in_.c.cache,obj)
+ assert a.has_shared_memory(),`t.dtype`
+
+ a = self.array(shape,intent.in_.cache,obj)
+ assert a.has_shared_memory(),`t.dtype`
+
+ obj = array(self.num2seq,dtype=t.dtype,fortran=1)
+ a = self.array(shape,intent.in_.c.cache,obj)
+ assert a.has_shared_memory(),`t.dtype`
+
+ a = self.array(shape,intent.in_.cache,obj)
+ assert a.has_shared_memory(),`t.dtype`
+
+ try:
+ a = self.array(shape,intent.in_.cache,obj[::-1])
+ except ValueError,msg:
+ if not str(msg).startswith('failed to initialize intent(cache) array'):
+ raise
+ else:
+ raise SystemError,'intent(cache) should have failed on multisegmented array'
+ def check_in_cache_from_2casttype_failure(self):
+ for t in self.type.all_types():
+ if t.elsize >= self.type.elsize:
+ continue
+ obj = array(self.num2seq,dtype=t.dtype)
+ shape = (len(self.num2seq),)
+ try:
+ a = self.array(shape,intent.in_.cache,obj)
+ except ValueError,msg:
+ if not str(msg).startswith('failed to initialize intent(cache) array'):
+ raise
+ else:
+ raise SystemError,'intent(cache) should have failed on smaller array'
+
+ def check_cache_hidden(self):
+ shape = (2,)
+ a = self.array(shape,intent.cache.hide,None)
+ assert a.arr.shape==shape
+
+ shape = (2,3)
+ a = self.array(shape,intent.cache.hide,None)
+ assert a.arr.shape==shape
+
+ shape = (-1,3)
+ try:
+ a = self.array(shape,intent.cache.hide,None)
+ except ValueError,msg:
+ if not str(msg).startswith('failed to create intent(cache|hide)|optional array'):
+ raise
+ else:
+ raise SystemError,'intent(cache) should have failed on undefined dimensions'
+
+ def check_hidden(self):
+ shape = (2,)
+ a = self.array(shape,intent.hide,None)
+ assert a.arr.shape==shape
+ assert a.arr_equal(a.arr,zeros(shape,dtype=self.type.dtype))
+
+ shape = (2,3)
+ a = self.array(shape,intent.hide,None)
+ assert a.arr.shape==shape
+ assert a.arr_equal(a.arr,zeros(shape,dtype=self.type.dtype))
+ assert a.arr.flags['FORTRAN'] and not a.arr.flags['CONTIGUOUS']
+
+ shape = (2,3)
+ a = self.array(shape,intent.c.hide,None)
+ assert a.arr.shape==shape
+ assert a.arr_equal(a.arr,zeros(shape,dtype=self.type.dtype))
+ assert not a.arr.flags['FORTRAN'] and a.arr.flags['CONTIGUOUS']
+
+ shape = (-1,3)
+ try:
+ a = self.array(shape,intent.hide,None)
+ except ValueError,msg:
+ if not str(msg).startswith('failed to create intent(cache|hide)|optional array'):
+ raise
+ else:
+ raise SystemError,'intent(hide) should have failed on undefined dimensions'
+
+ def check_optional_none(self):
+ shape = (2,)
+ a = self.array(shape,intent.optional,None)
+ assert a.arr.shape==shape
+ assert a.arr_equal(a.arr,zeros(shape,dtype=self.type.dtype))
+
+ shape = (2,3)
+ a = self.array(shape,intent.optional,None)
+ assert a.arr.shape==shape
+ assert a.arr_equal(a.arr,zeros(shape,dtype=self.type.dtype))
+ assert a.arr.flags['FORTRAN'] and not a.arr.flags['CONTIGUOUS']
+
+ shape = (2,3)
+ a = self.array(shape,intent.c.optional,None)
+ assert a.arr.shape==shape
+ assert a.arr_equal(a.arr,zeros(shape,dtype=self.type.dtype))
+ assert not a.arr.flags['FORTRAN'] and a.arr.flags['CONTIGUOUS']
+
+ def check_optional_from_2seq(self):
+ obj = self.num2seq
+ shape = (len(obj),)
+ a = self.array(shape,intent.optional,obj)
+ assert a.arr.shape==shape
+ assert not a.has_shared_memory()
+
+ def check_optional_from_23seq(self):
+ obj = self.num23seq
+ shape = (len(obj),len(obj[0]))
+ a = self.array(shape,intent.optional,obj)
+ assert a.arr.shape==shape
+ assert not a.has_shared_memory()
+
+ a = self.array(shape,intent.optional.c,obj)
+ assert a.arr.shape==shape
+ assert not a.has_shared_memory()
+
+ def check_inplace(self):
+ obj = array(self.num23seq,dtype=self.type.dtype)
+ assert not obj.flags['FORTRAN'] and obj.flags['CONTIGUOUS']
+ shape = obj.shape
+ a = self.array(shape,intent.inplace,obj)
+ assert obj[1][2]==a.arr[1][2],`obj,a.arr`
+ a.arr[1][2]=54
+ assert obj[1][2]==a.arr[1][2]==array(54,dtype=self.type.dtype),`obj,a.arr`
+ assert a.arr is obj
+ assert obj.flags['FORTRAN'] # obj attributes are changed inplace!
+ assert not obj.flags['CONTIGUOUS']
+
+ def check_inplace_from_casttype(self):
+ for t in self.type.cast_types():
+ if t is self.type:
+ continue
+ obj = array(self.num23seq,dtype=t.dtype)
+ assert obj.dtype.type==t.dtype
+ assert obj.dtype.type is not self.type.dtype
+ assert not obj.flags['FORTRAN'] and obj.flags['CONTIGUOUS']
+ shape = obj.shape
+ a = self.array(shape,intent.inplace,obj)
+ assert obj[1][2]==a.arr[1][2],`obj,a.arr`
+ a.arr[1][2]=54
+ assert obj[1][2]==a.arr[1][2]==array(54,dtype=self.type.dtype),`obj,a.arr`
+ assert a.arr is obj
+ assert obj.flags['FORTRAN'] # obj attributes are changed inplace!
+ assert not obj.flags['CONTIGUOUS']
+ assert obj.dtype.type is self.type.dtype # obj type is changed inplace!
+
+for t in Type._type_names:
+ exec '''\
+class test_%s_gen(unittest.TestCase,
+ _test_shared_memory
+ ):
+ type = Type(%r)
+ array = lambda self,dims,intent,obj: Array(Type(%r),dims,intent,obj)
+''' % (t,t,t)
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/f2py/tests/array_from_pyobj/wrapmodule.c b/numpy/f2py/tests/array_from_pyobj/wrapmodule.c
new file mode 100644
index 000000000..38a794a7d
--- /dev/null
+++ b/numpy/f2py/tests/array_from_pyobj/wrapmodule.c
@@ -0,0 +1,196 @@
+/* File: wrapmodule.c
+ * This file is auto-generated with f2py (version:2_1330).
+ * Hand edited by Pearu.
+ * f2py is a Fortran to Python Interface Generator (FPIG), Second Edition,
+ * written by Pearu Peterson <pearu@cens.ioc.ee>.
+ * See http://cens.ioc.ee/projects/f2py2e/
+ * Generation date: Fri Oct 21 22:41:12 2005
+ * $Revision:$
+ * $Date:$
+ * Do not edit this file directly unless you know what you are doing!!!
+ */
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*********************** See f2py2e/cfuncs.py: includes ***********************/
+#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;
+ 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,"iOiO|:wrap.call",\
+ &type_num,&dims_capi,&intent,&arr_capi))
+ return NULL;
+ rank = PySequence_Length(dims_capi);
+ dims = malloc(rank*sizeof(intp));
+ for (i=0;i<rank;++i)
+ dims[i] = (intp)PyInt_AsLong(PySequence_GetItem(dims_capi,i));
+
+ capi_arr_tmp = array_from_pyobj(type_num,dims,rank,intent|F2PY_INTENT_OUT,arr_capi);
+ if (capi_arr_tmp == NULL)
+ return NULL;
+ capi_buildvalue = Py_BuildValue("N",capi_arr_tmp);
+ free(dims);
+ return capi_buildvalue;
+}
+
+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*sizeof(char));
+ if (!PyArg_ParseTuple(capi_args,"O!|:wrap.attrs",
+ &PyArray_Type,&arr_capi))
+ return NULL;
+ arr = (PyArrayObject *)arr_capi;
+ sprintf(s,"%p",arr->data);
+ dimensions = PyTuple_New(arr->nd);
+ strides = PyTuple_New(arr->nd);
+ for (i=0;i<arr->nd;++i) {
+ PyTuple_SetItem(dimensions,i,PyInt_FromLong(arr->dimensions[i]));
+ PyTuple_SetItem(strides,i,PyInt_FromLong(arr->strides[i]));
+ }
+ return Py_BuildValue("siOOO(cciii)ii",s,arr->nd,
+ dimensions,strides,
+ (arr->base==NULL?Py_None:arr->base),
+ arr->descr->kind,
+ arr->descr->type,
+ arr->descr->type_num,
+ arr->descr->elsize,
+ arr->descr->alignment,
+ arr->flags,
+ 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}
+};
+
+PyMODINIT_FUNC initwrap(void) {
+ PyObject *m,*d, *s;
+ m = wrap_module = Py_InitModule("wrap", f2py_module_methods);
+ PyFortran_Type.ob_type = &PyType_Type;
+ import_array();
+ if (PyErr_Occurred())
+ Py_FatalError("can't initialize module wrap (failed to import numpy)");
+ d = PyModule_GetDict(m);
+ s = PyString_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);
+ PyDict_SetItemString(d, "F2PY_INTENT_IN", PyInt_FromLong(F2PY_INTENT_IN));
+ PyDict_SetItemString(d, "F2PY_INTENT_INOUT", PyInt_FromLong(F2PY_INTENT_INOUT));
+ PyDict_SetItemString(d, "F2PY_INTENT_OUT", PyInt_FromLong(F2PY_INTENT_OUT));
+ PyDict_SetItemString(d, "F2PY_INTENT_HIDE", PyInt_FromLong(F2PY_INTENT_HIDE));
+ PyDict_SetItemString(d, "F2PY_INTENT_CACHE", PyInt_FromLong(F2PY_INTENT_CACHE));
+ PyDict_SetItemString(d, "F2PY_INTENT_COPY", PyInt_FromLong(F2PY_INTENT_COPY));
+ PyDict_SetItemString(d, "F2PY_INTENT_C", PyInt_FromLong(F2PY_INTENT_C));
+ PyDict_SetItemString(d, "F2PY_OPTIONAL", PyInt_FromLong(F2PY_OPTIONAL));
+ PyDict_SetItemString(d, "F2PY_INTENT_INPLACE", PyInt_FromLong(F2PY_INTENT_INPLACE));
+ PyDict_SetItemString(d, "PyArray_BOOL", PyInt_FromLong(PyArray_BOOL));
+ PyDict_SetItemString(d, "PyArray_BYTE", PyInt_FromLong(PyArray_BYTE));
+ PyDict_SetItemString(d, "PyArray_UBYTE", PyInt_FromLong(PyArray_UBYTE));
+ PyDict_SetItemString(d, "PyArray_SHORT", PyInt_FromLong(PyArray_SHORT));
+ PyDict_SetItemString(d, "PyArray_USHORT", PyInt_FromLong(PyArray_USHORT));
+ PyDict_SetItemString(d, "PyArray_INT", PyInt_FromLong(PyArray_INT));
+ PyDict_SetItemString(d, "PyArray_UINT", PyInt_FromLong(PyArray_UINT));
+ PyDict_SetItemString(d, "PyArray_INTP", PyInt_FromLong(PyArray_INTP));
+ PyDict_SetItemString(d, "PyArray_UINTP", PyInt_FromLong(PyArray_UINTP));
+ PyDict_SetItemString(d, "PyArray_LONG", PyInt_FromLong(PyArray_LONG));
+ PyDict_SetItemString(d, "PyArray_ULONG", PyInt_FromLong(PyArray_ULONG));
+ PyDict_SetItemString(d, "PyArray_LONGLONG", PyInt_FromLong(PyArray_LONGLONG));
+ PyDict_SetItemString(d, "PyArray_ULONGLONG", PyInt_FromLong(PyArray_ULONGLONG));
+ PyDict_SetItemString(d, "PyArray_FLOAT", PyInt_FromLong(PyArray_FLOAT));
+ PyDict_SetItemString(d, "PyArray_DOUBLE", PyInt_FromLong(PyArray_DOUBLE));
+ PyDict_SetItemString(d, "PyArray_LONGDOUBLE", PyInt_FromLong(PyArray_LONGDOUBLE));
+ PyDict_SetItemString(d, "PyArray_CFLOAT", PyInt_FromLong(PyArray_CFLOAT));
+ PyDict_SetItemString(d, "PyArray_CDOUBLE", PyInt_FromLong(PyArray_CDOUBLE));
+ PyDict_SetItemString(d, "PyArray_CLONGDOUBLE", PyInt_FromLong(PyArray_CLONGDOUBLE));
+ PyDict_SetItemString(d, "PyArray_OBJECT", PyInt_FromLong(PyArray_OBJECT));
+ PyDict_SetItemString(d, "PyArray_STRING", PyInt_FromLong(PyArray_STRING));
+ PyDict_SetItemString(d, "PyArray_UNICODE", PyInt_FromLong(PyArray_UNICODE));
+ PyDict_SetItemString(d, "PyArray_VOID", PyInt_FromLong(PyArray_VOID));
+ PyDict_SetItemString(d, "PyArray_NTYPES", PyInt_FromLong(PyArray_NTYPES));
+ PyDict_SetItemString(d, "PyArray_NOTYPE", PyInt_FromLong(PyArray_NOTYPE));
+ PyDict_SetItemString(d, "PyArray_UDERDEF", PyInt_FromLong(PyArray_USERDEF));
+
+ PyDict_SetItemString(d, "CONTIGUOUS", PyInt_FromLong(CONTIGUOUS));
+ PyDict_SetItemString(d, "FORTRAN", PyInt_FromLong(FORTRAN));
+ PyDict_SetItemString(d, "OWNDATA", PyInt_FromLong(OWNDATA));
+ PyDict_SetItemString(d, "FORCECAST", PyInt_FromLong(FORCECAST));
+ PyDict_SetItemString(d, "ENSURECOPY", PyInt_FromLong(ENSURECOPY));
+ PyDict_SetItemString(d, "ENSUREARRAY", PyInt_FromLong(ENSUREARRAY));
+ PyDict_SetItemString(d, "ALIGNED", PyInt_FromLong(ALIGNED));
+ PyDict_SetItemString(d, "WRITEABLE", PyInt_FromLong(WRITEABLE));
+ PyDict_SetItemString(d, "UPDATEIFCOPY", PyInt_FromLong(UPDATEIFCOPY));
+
+ PyDict_SetItemString(d, "BEHAVED", PyInt_FromLong(NPY_BEHAVED));
+ PyDict_SetItemString(d, "BEHAVED_NS", PyInt_FromLong(NPY_BEHAVED_NS));
+ PyDict_SetItemString(d, "CARRAY", PyInt_FromLong(NPY_CARRAY));
+ PyDict_SetItemString(d, "FARRAY", PyInt_FromLong(NPY_FARRAY));
+ PyDict_SetItemString(d, "CARRAY_RO", PyInt_FromLong(NPY_CARRAY_RO));
+ PyDict_SetItemString(d, "FARRAY_RO", PyInt_FromLong(NPY_FARRAY_RO));
+ PyDict_SetItemString(d, "DEFAULT", PyInt_FromLong(NPY_DEFAULT));
+ PyDict_SetItemString(d, "UPDATE_ALL", PyInt_FromLong(NPY_UPDATE_ALL));
+
+ 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
+
+}
+#ifdef __cplusplus
+}
+#endif
diff --git a/numpy/f2py/tests/c/return_real.py b/numpy/f2py/tests/c/return_real.py
new file mode 100644
index 000000000..62dbd2f74
--- /dev/null
+++ b/numpy/f2py/tests/c/return_real.py
@@ -0,0 +1,107 @@
+__usage__ = """
+Run:
+ python return_real.py [<f2py options>]
+Examples:
+ python return_real.py --fcompiler=Gnu --no-wrap-functions
+ python return_real.py --quiet
+"""
+
+import f2py2e
+from Numeric import array
+
+def build(f2py_opts):
+ try:
+ import c_ext_return_real
+ except ImportError:
+ assert not f2py2e.compile('''\
+python module c_ext_return_real
+usercode \'\'\'
+float t4(float value) { return value; }
+void s4(float *t4, float value) { *t4 = value; }
+double t8(double value) { return value; }
+void s8(double *t8, double value) { *t8 = value; }
+\'\'\'
+interface
+ function t4(value)
+ real*4 intent(c) :: t4,value
+ end
+ function t8(value)
+ real*8 intent(c) :: t8,value
+ end
+ subroutine s4(t4,value)
+ intent(c) s4
+ real*4 intent(out) :: t4
+ real*4 intent(c) :: value
+ end
+ subroutine s8(t8,value)
+ intent(c) s8
+ real*8 intent(out) :: t8
+ real*8 intent(c) :: value
+ end
+end interface
+end python module c_ext_return_real
+''','c_ext_return_real',f2py_opts,source_fn='c_ret_real.pyf')
+
+ from c_ext_return_real import t4,t8,s4,s8
+ test_functions = [t4,t8,s4,s8]
+ return test_functions
+
+def runtest(t):
+ import sys
+ if t.__doc__.split()[0] in ['t0','t4','s0','s4']:
+ err = 1e-5
+ else:
+ err = 0.0
+ assert abs(t(234)-234.0)<=err
+ assert abs(t(234.6)-234.6)<=err
+ assert abs(t(234l)-234.0)<=err
+ if sys.version[:3]<'2.3':
+ assert abs(t(234.6+3j)-234.6)<=err
+ assert abs(t('234')-234)<=err
+ assert abs(t('234.6')-234.6)<=err
+ assert abs(t(-234)+234)<=err
+ assert abs(t([234])-234)<=err
+ assert abs(t((234,))-234.)<=err
+ assert abs(t(array(234))-234.)<=err
+ assert abs(t(array([234]))-234.)<=err
+ assert abs(t(array([[234]]))-234.)<=err
+ assert abs(t(array([234],'1'))+22)<=err
+ assert abs(t(array([234],'s'))-234.)<=err
+ assert abs(t(array([234],'i'))-234.)<=err
+ assert abs(t(array([234],'l'))-234.)<=err
+ assert abs(t(array([234],'b'))-234.)<=err
+ assert abs(t(array([234],'f'))-234.)<=err
+ assert abs(t(array([234],'d'))-234.)<=err
+ if sys.version[:3]<'2.3':
+ assert abs(t(array([234+3j],'F'))-234.)<=err
+ assert abs(t(array([234],'D'))-234.)<=err
+ if t.__doc__.split()[0] in ['t0','t4','s0','s4']:
+ assert t(1e200)==t(1e300) # inf
+
+ try: raise RuntimeError,`t(array([234],'c'))`
+ except ValueError: pass
+ try: raise RuntimeError,`t('abc')`
+ except ValueError: pass
+
+ try: raise RuntimeError,`t([])`
+ except IndexError: pass
+ try: raise RuntimeError,`t(())`
+ except IndexError: pass
+
+ try: raise RuntimeError,`t(t)`
+ except TypeError: pass
+ try: raise RuntimeError,`t({})`
+ except TypeError: pass
+
+ try:
+ try: raise RuntimeError,`t(10l**400)`
+ except OverflowError: pass
+ except RuntimeError:
+ r = t(10l**400); assert `r` in ['inf','Infinity'],`r`
+
+if __name__=='__main__':
+ #import libwadpy
+ repeat,f2py_opts = f2py2e.f2py_testing.cmdline()
+ test_functions = build(f2py_opts)
+ f2py2e.f2py_testing.run(runtest,test_functions,repeat)
+ print 'ok'
diff --git a/numpy/f2py/tests/f77/callback.py b/numpy/f2py/tests/f77/callback.py
new file mode 100644
index 000000000..bfe4eb547
--- /dev/null
+++ b/numpy/f2py/tests/f77/callback.py
@@ -0,0 +1,98 @@
+__usage__ = """
+Run:
+ python callback.py [<f2py options>]
+Examples:
+ python callback.py --fcompiler=Gnu --no-wrap-functions
+ python callback.py --quiet
+"""
+
+import f2py2e
+import math
+import sys
+from Numeric import array
+
+def build(f2py_opts):
+ try:
+ import f77_ext_callback
+ except ImportError:
+ assert not f2py2e.compile('''\
+ 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
+
+''','f77_ext_callback',f2py_opts,source_fn='f77_callback.f')
+
+ from f77_ext_callback import t,t2
+ test_functions = [t,t2]
+ return test_functions
+
+def runtest(t):
+ r = t(lambda : 4)
+ assert r==4,`r`
+ r = t(lambda a:5,fun_extra_args=(6,))
+ assert r==5,`r`
+ r = t(lambda a:a,fun_extra_args=(6,))
+ assert r==6,`r`
+ r = t(lambda a:5+a,fun_extra_args=(7,))
+ assert r==12,`r`
+ if sys.version[:3]>='2.3':
+ r = t(lambda a:math.degrees(a),fun_extra_args=(math.pi,))
+ assert r==180,`r`
+ r = t(math.degrees,fun_extra_args=(math.pi,))
+ assert r==180,`r`
+ from f77_ext_callback import func,func0
+ r = t(func,fun_extra_args=(6,))
+ assert r==17,`r`
+ r = t(func0)
+ assert r==11,`r`
+ r = t(func0._cpointer)
+ assert r==11,`r`
+ class A:
+ def __call__(self):
+ return 7
+ def mth(self):
+ return 9
+ a = A()
+ r = t(a)
+ assert r==7,`r`
+ r = t(a.mth)
+ assert r==9,`r`
+
+if __name__=='__main__':
+ #import libwadpy
+ status = 1
+ try:
+ repeat,f2py_opts = f2py2e.f2py_testing.cmdline()
+ test_functions = build(f2py_opts)
+ f2py2e.f2py_testing.run(runtest,test_functions,repeat)
+ print 'ok'
+ status = 0
+ finally:
+ if status:
+ print '*'*20
+ print 'Running f2py2e.diagnose'
+ import f2py2e.diagnose
+ f2py2e.diagnose.run()
diff --git a/numpy/f2py/tests/f77/return_character.py b/numpy/f2py/tests/f77/return_character.py
new file mode 100644
index 000000000..b44b6ee70
--- /dev/null
+++ b/numpy/f2py/tests/f77/return_character.py
@@ -0,0 +1,99 @@
+__usage__ = """
+Run:
+ python return_character.py [<f2py options>]
+Examples:
+ python return_character.py --fcompiler=Gnu --no-wrap-functions
+ python return_character.py --quiet
+"""
+
+import sys
+import f2py2e
+from Numeric import array
+
+def build(f2py_opts):
+ try:
+ import f77_ext_return_character
+ except ImportError:
+ assert not f2py2e.compile('''\
+ 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
+''','f77_ext_return_character',f2py_opts,source_fn='f77_ret_char.f')
+
+ from f77_ext_return_character import t0,t1,t5,s0,s1,s5,ss
+ test_functions = [t0,t1,t5,s0,s1,s5,ss]
+ if sys.platform!='win32': # this is acctually compiler dependent case
+ from f77_ext_return_character import ts
+ test_functions.append(ts)
+
+ return test_functions
+
+def runtest(t):
+ tname = t.__doc__.split()[0]
+ if tname in ['t0','t1','s0','s1']:
+ assert t(23)=='2'
+ r = t('ab');assert r=='a',`r`
+ r = t(array('ab'));assert r=='a',`r`
+ r = t(array(77,'1'));assert r=='M',`r`
+ try: raise RuntimeError,`t(array([77,87]))`
+ except ValueError: pass
+ try: raise RuntimeError,`t(array(77))`
+ except ValueError: pass
+ elif tname in ['ts','ss']:
+ assert t(23)=='23 ',`t(23)`
+ assert t('123456789abcdef')=='123456789a'
+ elif tname in ['t5','s5']:
+ assert t(23)=='23 ',`t(23)`
+ assert t('ab')=='ab ',`t('ab')`
+ assert t('123456789abcdef')=='12345'
+ else:
+ raise NotImplementedError
+
+if __name__=='__main__':
+ #import libwadpy
+ repeat,f2py_opts = f2py2e.f2py_testing.cmdline()
+ test_functions = build(f2py_opts)
+ f2py2e.f2py_testing.run(runtest,test_functions,repeat)
+ print 'ok'
diff --git a/numpy/f2py/tests/f77/return_complex.py b/numpy/f2py/tests/f77/return_complex.py
new file mode 100644
index 000000000..e182902b3
--- /dev/null
+++ b/numpy/f2py/tests/f77/return_complex.py
@@ -0,0 +1,124 @@
+__usage__ = """
+Run:
+ python return_complex.py [<f2py options>]
+Examples:
+ python return_complex.py --fcompiler=Gnu --no-wrap-functions
+ python return_complex.py --quiet
+"""
+
+import f2py2e
+from Numeric import array
+
+def build(f2py_opts):
+ try:
+ import f77_ext_return_complex
+ except ImportError:
+ assert not f2py2e.compile('''\
+ 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
+''','f77_ext_return_complex',f2py_opts)
+
+ from f77_ext_return_complex import t0,t8,t16,td,s0,s8,s16,sd
+ test_functions = [t0,t8,t16,td,s0,s8,s16,sd]
+ return test_functions
+
+
+def runtest(t):
+ tname = t.__doc__.split()[0]
+ if tname in ['t0','t8','s0','s8']:
+ err = 1e-5
+ else:
+ err = 0.0
+ assert abs(t(234j)-234.0j)<=err
+ assert abs(t(234.6)-234.6)<=err
+ assert abs(t(234l)-234.0)<=err
+ assert abs(t(234.6+3j)-(234.6+3j))<=err
+ #assert abs(t('234')-234.)<=err
+ #assert abs(t('234.6')-234.6)<=err
+ assert abs(t(-234)+234.)<=err
+ assert abs(t([234])-234.)<=err
+ assert abs(t((234,))-234.)<=err
+ assert abs(t(array(234))-234.)<=err
+ assert abs(t(array(23+4j,'F'))-(23+4j))<=err
+ assert abs(t(array([234]))-234.)<=err
+ assert abs(t(array([[234]]))-234.)<=err
+ assert abs(t(array([234],'1'))+22.)<=err
+ assert abs(t(array([234],'s'))-234.)<=err
+ assert abs(t(array([234],'i'))-234.)<=err
+ assert abs(t(array([234],'l'))-234.)<=err
+ assert abs(t(array([234],'b'))-234.)<=err
+ assert abs(t(array([234],'f'))-234.)<=err
+ assert abs(t(array([234],'d'))-234.)<=err
+ assert abs(t(array([234+3j],'F'))-(234+3j))<=err
+ assert abs(t(array([234],'D'))-234.)<=err
+
+ try: raise RuntimeError,`t(array([234],'c'))`
+ except TypeError: pass
+ try: raise RuntimeError,`t('abc')`
+ except TypeError: pass
+
+ try: raise RuntimeError,`t([])`
+ except IndexError: pass
+ try: raise RuntimeError,`t(())`
+ except IndexError: pass
+
+ try: raise RuntimeError,`t(t)`
+ except TypeError: pass
+ try: raise RuntimeError,`t({})`
+ except TypeError: pass
+
+ try:
+ try: raise RuntimeError,`t(10l**400)`
+ except OverflowError: pass
+ except RuntimeError:
+ r = t(10l**400); assert `r` in ['(inf+0j)','(Infinity+0j)'],`r`
+
+if __name__=='__main__':
+ #import libwadpy
+ repeat,f2py_opts = f2py2e.f2py_testing.cmdline()
+ test_functions = build(f2py_opts)
+ f2py2e.f2py_testing.run(runtest,test_functions,repeat)
+ print 'ok'
diff --git a/numpy/f2py/tests/f77/return_integer.py b/numpy/f2py/tests/f77/return_integer.py
new file mode 100644
index 000000000..fe9e70fda
--- /dev/null
+++ b/numpy/f2py/tests/f77/return_integer.py
@@ -0,0 +1,147 @@
+__usage__ = """
+Run:
+ python return_integer.py [<f2py options>]
+Examples:
+ python return_integer.py --fcompiler=Gnu --no-wrap-functions
+ python return_integer.py --quiet
+"""
+
+import numpy.f2py as f2py2e
+from numpy import array
+
+def build(f2py_opts):
+ try:
+ import f77_ext_return_integer
+ except ImportError:
+ assert not f2py2e.compile('''\
+ 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
+
+''','f77_ext_return_integer',f2py_opts,source_fn='f77_ret_int.f')
+
+ from f77_ext_return_integer import t0,t1,t2,t4,t8,s0,s1,s2,s4,s8
+ test_functions = [t0,t1,t2,t4,t8,s0,s1,s2,s4,s8]
+ return test_functions
+
+def runtest(t):
+ import sys
+ assert t(123)==123,`t(123)`
+ assert t(123.6)==123
+ assert t(123l)==123
+ if sys.version[:3]<'2.3':
+ assert t(123.6+3j)==123
+ assert t('123')==123
+ assert t(-123)==-123
+ assert t([123])==123
+ assert t((123,))==123
+ assert t(array(123))==123
+ assert t(array([123]))==123
+ assert t(array([[123]]))==123
+ assert t(array([123],'b'))==123
+ assert t(array([123],'h'))==123
+ assert t(array([123],'i'))==123
+ assert t(array([123],'l'))==123
+ assert t(array([123],'B'))==123
+ assert t(array([123],'f'))==123
+ assert t(array([123],'d'))==123
+ if sys.version[:3]<'2.3':
+ assert t(array([123+3j],'F'))==123
+ assert t(array([123],'D'))==123
+
+
+ try: raise RuntimeError,`t(array([123],'c'))`
+ except ValueError: pass
+ try: raise RuntimeError,`t('abc')`
+ except ValueError: pass
+
+ try: raise RuntimeError,`t([])`
+ except IndexError: pass
+ try: raise RuntimeError,`t(())`
+ except IndexError: pass
+
+ try: raise RuntimeError,`t(t)`
+ except TypeError: pass
+ try: raise RuntimeError,`t({})`
+ except TypeError: pass
+
+ if t.__doc__.split()[0] in ['t8','s8']:
+ try: raise RuntimeError,`t(100000000000000000000000l)`
+ except OverflowError: pass
+ try: raise RuntimeError,`t(10000000011111111111111.23)`
+ except OverflowError: pass
+ else:
+ if sys.version[:3]<'2.3':
+ try: raise RuntimeError,`t(10000000000000l)`
+ except OverflowError: pass
+ try: raise RuntimeError,`t(10000000000.23)`
+ except OverflowError: pass
+
+if __name__=='__main__':
+ #import libwadpy
+ status = 1
+ try:
+ repeat,f2py_opts = f2py2e.f2py_testing.cmdline()
+ test_functions = build(f2py_opts)
+ f2py2e.f2py_testing.run(runtest,test_functions,repeat)
+ print 'ok'
+ status = 0
+ finally:
+ if status:
+ print '*'*20
+ print 'Running f2py2e.diagnose'
+ import numpy.f2py.diagnose as diagnose
+ #diagnose.run()
diff --git a/numpy/f2py/tests/f77/return_logical.py b/numpy/f2py/tests/f77/return_logical.py
new file mode 100644
index 000000000..cc5f9cb05
--- /dev/null
+++ b/numpy/f2py/tests/f77/return_logical.py
@@ -0,0 +1,133 @@
+__usage__ = """
+Run:
+ python return_logical.py [<f2py options>]
+Examples:
+ python return_logical.py --fcompiler=Gnu --no-wrap-functions
+ python return_logical.py --quiet
+"""
+
+import f2py2e
+from Numeric import array
+try: True
+except NameError:
+ True = 1
+ False = 0
+
+def build(f2py_opts):
+ try:
+ import f77_ext_return_logical
+ except ImportError:
+ assert not f2py2e.compile('''\
+ 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
+''','f77_ext_return_logical',f2py_opts)
+
+ #from f77_ext_return_logical import t0,t1,t2,t4,t8,s0,s1,s2,s4,s8
+ #test_functions = [t0,t1,t2,t4,t8,s0,s1,s2,s4,s8]
+ from f77_ext_return_logical import t0,t1,t2,t4,s0,s1,s2,s4
+ test_functions = [t0,t1,t2,t4,s0,s1,s2,s4]
+ return test_functions
+
+def runtest(t):
+ assert t(True)==1,`t(True)`
+ assert t(False)==0,`t(False)`
+ assert t(0)==0
+ assert t(None)==0
+ assert t(0.0)==0
+ assert t(0j)==0
+ assert t(1j)==1
+ assert t(234)==1
+ assert t(234.6)==1
+ assert t(234l)==1
+ assert t(234.6+3j)==1
+ assert t('234')==1
+ assert t('aaa')==1
+ assert t('')==0
+ assert t([])==0
+ assert t(())==0
+ assert t({})==0
+ assert t(t)==1
+ assert t(-234)==1
+ assert t(10l**100)==1
+ assert t([234])==1
+ assert t((234,))==1
+ assert t(array(234))==1
+ assert t(array([234]))==1
+ assert t(array([[234]]))==1
+ assert t(array([234],'1'))==1
+ assert t(array([234],'s'))==1
+ assert t(array([234],'i'))==1
+ assert t(array([234],'l'))==1
+ assert t(array([234],'b'))==1
+ assert t(array([234],'f'))==1
+ assert t(array([234],'d'))==1
+ assert t(array([234+3j],'F'))==1
+ assert t(array([234],'D'))==1
+ assert t(array(0))==0
+ assert t(array([0]))==0
+ assert t(array([[0]]))==0
+ assert t(array([0j]))==0
+ assert t(array([1]))==1
+ assert t(array([0,0]))==0
+ assert t(array([0,1]))==1 #XXX: is this expected?
+
+if __name__=='__main__':
+ #import libwadpy
+ repeat,f2py_opts = f2py2e.f2py_testing.cmdline()
+ test_functions = build(f2py_opts)
+ f2py2e.f2py_testing.run(runtest,test_functions,repeat)
+ print 'ok'
diff --git a/numpy/f2py/tests/f77/return_real.py b/numpy/f2py/tests/f77/return_real.py
new file mode 100644
index 000000000..a751743e9
--- /dev/null
+++ b/numpy/f2py/tests/f77/return_real.py
@@ -0,0 +1,126 @@
+__usage__ = """
+Run:
+ python return_real.py [<f2py options>]
+Examples:
+ python return_real.py --fcompiler=Gnu --no-wrap-functions
+ python return_real.py --quiet
+"""
+
+import numpy.f2py as f2py2e
+from numpy import array
+
+def build(f2py_opts):
+ try:
+ import f77_ext_return_real
+ except ImportError:
+ assert not f2py2e.compile('''\
+ 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
+''','f77_ext_return_real',f2py_opts,source_fn='f77_ret_real.f')
+
+ from f77_ext_return_real import t0,t4,t8,td,s0,s4,s8,sd
+ test_functions = [t0,t4,t8,td,s0,s4,s8,sd]
+ return test_functions
+
+def runtest(t):
+ import sys
+ if t.__doc__.split()[0] in ['t0','t4','s0','s4']:
+ err = 1e-5
+ else:
+ err = 0.0
+ assert abs(t(234)-234.0)<=err
+ assert abs(t(234.6)-234.6)<=err
+ assert abs(t(234l)-234.0)<=err
+ if sys.version[:3]<'2.3':
+ assert abs(t(234.6+3j)-234.6)<=err
+ assert abs(t('234')-234)<=err
+ assert abs(t('234.6')-234.6)<=err
+ assert abs(t(-234)+234)<=err
+ assert abs(t([234])-234)<=err
+ assert abs(t((234,))-234.)<=err
+ assert abs(t(array(234))-234.)<=err
+ assert abs(t(array([234]))-234.)<=err
+ assert abs(t(array([[234]]))-234.)<=err
+ assert abs(t(array([234],'b'))+22)<=err
+ assert abs(t(array([234],'h'))-234.)<=err
+ assert abs(t(array([234],'i'))-234.)<=err
+ assert abs(t(array([234],'l'))-234.)<=err
+ assert abs(t(array([234],'B'))-234.)<=err
+ assert abs(t(array([234],'f'))-234.)<=err
+ assert abs(t(array([234],'d'))-234.)<=err
+ if sys.version[:3]<'2.3':
+ assert abs(t(array([234+3j],'F'))-234.)<=err
+ assert abs(t(array([234],'D'))-234.)<=err
+ if t.__doc__.split()[0] in ['t0','t4','s0','s4']:
+ assert t(1e200)==t(1e300) # inf
+
+ try: raise RuntimeError,`t(array([234],'c'))`
+ except ValueError: pass
+ try: raise RuntimeError,`t('abc')`
+ except ValueError: pass
+
+ try: raise RuntimeError,`t([])`
+ except IndexError: pass
+ try: raise RuntimeError,`t(())`
+ except IndexError: pass
+
+ try: raise RuntimeError,`t(t)`
+ except TypeError: pass
+ try: raise RuntimeError,`t({})`
+ except TypeError: pass
+
+ try:
+ try: raise RuntimeError,`t(10l**400)`
+ except OverflowError: pass
+ except RuntimeError:
+ r = t(10l**400); assert `r` in ['inf','Infinity'],`r`
+
+if __name__=='__main__':
+ #import libwadpy
+ repeat,f2py_opts = f2py2e.f2py_testing.cmdline()
+ test_functions = build(f2py_opts)
+ f2py2e.f2py_testing.run(runtest,test_functions,repeat)
+ print 'ok'
diff --git a/numpy/f2py/tests/f90/return_character.py b/numpy/f2py/tests/f90/return_character.py
new file mode 100644
index 000000000..1b5515f4d
--- /dev/null
+++ b/numpy/f2py/tests/f90/return_character.py
@@ -0,0 +1,98 @@
+__usage__ = """
+Run:
+ python return_character.py [<f2py options>]
+Examples:
+ python return_character.py --fcompiler=Gnu --no-wrap-functions
+ python return_character.py --quiet
+"""
+
+import f2py2e
+from Numeric import array
+
+def build(f2py_opts):
+ try:
+ import f90_ext_return_character
+ except ImportError:
+ assert not f2py2e.compile('''\
+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
+''','f90_ext_return_character',f2py_opts,source_fn='f90_ret_char.f90')
+
+ from f90_ext_return_character import f90_return_char as m
+ test_functions = [m.t0,m.t1,m.t5,m.ts,m.s0,m.s1,m.s5,m.ss]
+ return test_functions
+
+
+def runtest(t):
+ tname = t.__doc__.split()[0]
+ if tname in ['t0','t1','s0','s1']:
+ assert t(23)=='2'
+ r = t('ab');assert r=='a',`r`
+ r = t(array('ab'));assert r=='a',`r`
+ r = t(array(77,'1'));assert r=='M',`r`
+ try: raise RuntimeError,`t(array([77,87]))`
+ except ValueError: pass
+ try: raise RuntimeError,`t(array(77))`
+ except ValueError: pass
+ elif tname in ['ts','ss']:
+ assert t(23)=='23 ',`t(23)`
+ assert t('123456789abcdef')=='123456789a',`t('123456789abcdef')`
+ elif tname in ['t5','s5']:
+ assert t(23)=='23 '
+ assert t('ab')=='ab '
+ assert t('123456789abcdef')=='12345'
+ else:
+ raise NotImplementedError
+
+if __name__=='__main__':
+ #import libwadpy
+ repeat,f2py_opts = f2py2e.f2py_testing.cmdline()
+ test_functions = build(f2py_opts)
+ f2py2e.f2py_testing.run(runtest,test_functions,repeat)
+ print 'ok'
diff --git a/numpy/f2py/tests/f90/return_complex.py b/numpy/f2py/tests/f90/return_complex.py
new file mode 100644
index 000000000..e615de218
--- /dev/null
+++ b/numpy/f2py/tests/f90/return_complex.py
@@ -0,0 +1,126 @@
+__usage__ = """
+Run:
+ python return_complex.py [<f2py options>]
+Examples:
+ python return_complex.py --quiet
+"""
+
+import f2py2e
+from Numeric import array
+
+def build(f2py_opts):
+ try:
+ import f90_ext_return_complex
+ except ImportError:
+ assert not f2py2e.compile('''\
+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
+''','f90_ext_return_complex',f2py_opts,source_fn='f90_ret_cmlx.f90')
+
+ from f90_ext_return_complex import f90_return_complex as m
+ test_functions = [m.t0,m.t8,m.t16,m.td,m.s0,m.s8,m.s16,m.sd]
+ return test_functions
+
+
+def runtest(t):
+ tname = t.__doc__.split()[0]
+ if tname in ['t0','t8','s0','s8']:
+ err = 1e-5
+ else:
+ err = 0.0
+ #assert abs(t(234j)-234.0j)<=err
+ assert abs(t(234.6)-234.6)<=err
+ assert abs(t(234l)-234.0)<=err
+ assert abs(t(234.6+3j)-(234.6+3j))<=err
+ #assert abs(t('234')-234.)<=err
+ #assert abs(t('234.6')-234.6)<=err
+ assert abs(t(-234)+234.)<=err
+ assert abs(t([234])-234.)<=err
+ assert abs(t((234,))-234.)<=err
+ assert abs(t(array(234))-234.)<=err
+ assert abs(t(array(23+4j,'F'))-(23+4j))<=err
+ assert abs(t(array([234]))-234.)<=err
+ assert abs(t(array([[234]]))-234.)<=err
+ assert abs(t(array([234],'1'))+22.)<=err
+ assert abs(t(array([234],'s'))-234.)<=err
+ assert abs(t(array([234],'i'))-234.)<=err
+ assert abs(t(array([234],'l'))-234.)<=err
+ assert abs(t(array([234],'b'))-234.)<=err
+ assert abs(t(array([234],'f'))-234.)<=err
+ assert abs(t(array([234],'d'))-234.)<=err
+ assert abs(t(array([234+3j],'F'))-(234+3j))<=err
+ assert abs(t(array([234],'D'))-234.)<=err
+
+ try: raise RuntimeError,`t(array([234],'c'))`
+ except TypeError: pass
+ try: raise RuntimeError,`t('abc')`
+ except TypeError: pass
+
+ try: raise RuntimeError,`t([])`
+ except IndexError: pass
+ try: raise RuntimeError,`t(())`
+ except IndexError: pass
+
+ try: raise RuntimeError,`t(t)`
+ except TypeError: pass
+ try: raise RuntimeError,`t({})`
+ except TypeError: pass
+
+ try:
+ try: raise RuntimeError,`t(10l**400)`
+ except OverflowError: pass
+ except RuntimeError:
+ r = t(10l**400); assert `r` in ['(inf+0j)','(Infinity+0j)'],`r`
+
+if __name__=='__main__':
+ #import libwadpy
+ repeat,f2py_opts = f2py2e.f2py_testing.cmdline()
+ test_functions = build(f2py_opts)
+ f2py2e.f2py_testing.run(runtest,test_functions,repeat)
+ print 'ok'
diff --git a/numpy/f2py/tests/f90/return_integer.py b/numpy/f2py/tests/f90/return_integer.py
new file mode 100644
index 000000000..c0241eeaf
--- /dev/null
+++ b/numpy/f2py/tests/f90/return_integer.py
@@ -0,0 +1,151 @@
+# XXX: investigate cases that are disabled under win32
+#
+
+__usage__ = """
+Run:
+ python return_integer.py [<f2py options>]
+Examples:
+ python return_integer.py --quiet
+"""
+
+import sys
+import f2py2e
+from Numeric import array
+
+def build(f2py_opts):
+ try:
+ import f90_ext_return_integer
+ except ImportError:
+ assert not f2py2e.compile('''\
+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
+''','f90_ext_return_integer',f2py_opts,source_fn='f90_ret_int.f90')
+
+ from f90_ext_return_integer import f90_return_integer as m
+ test_functions = [m.t0,m.t1,m.t2,m.t4,m.t8,m.s0,m.s1,m.s2,m.s4,m.s8]
+ return test_functions
+
+def runtest(t):
+ tname = t.__doc__.split()[0]
+ assert t(123)==123
+ assert t(123.6)==123
+ assert t(123l)==123
+ if sys.version[:3]<='2.2':
+ assert t(123.6+3j)==123
+ assert t('123')==123
+ assert t(-123)==-123
+ assert t([123])==123
+ assert t((123,))==123
+ assert t(array(123))==123
+ assert t(array([123]))==123
+ assert t(array([[123]]))==123
+ assert t(array([123],'1'))==123
+ assert t(array([123],'s'))==123
+ assert t(array([123],'i'))==123
+ assert t(array([123],'l'))==123
+ assert t(array([123],'b'))==123
+ assert t(array([123],'f'))==123
+ assert t(array([123],'d'))==123
+ if sys.version[:3]<='2.2':
+ assert t(array([123+3j],'F'))==123
+ assert t(array([123],'D'))==123
+
+ try: raise RuntimeError,`t(array([123],'c'))`
+ except ValueError: pass
+ try: raise RuntimeError,`t('abc')`
+ except ValueError: pass
+
+ try: raise RuntimeError,`t([])`
+ except IndexError: pass
+ try: raise RuntimeError,`t(())`
+ except IndexError: pass
+
+ try: raise RuntimeError,`t(t)`
+ except TypeError: pass
+ try: raise RuntimeError,`t({})`
+ except TypeError: pass
+
+ if tname in ['t8','s8']:
+ try: raise RuntimeError,`t(100000000000000000000000l)`
+ except OverflowError: pass
+ try: raise RuntimeError,`t(10000000011111111111111.23)`
+ except OverflowError: pass
+ else:
+ if sys.version[:3]<='2.2':
+ try: raise RuntimeError,`t(10000000000000l)`
+ except OverflowError: pass
+ try: raise RuntimeError,`t(10000000000.23)`
+ except OverflowError: pass
+
+if __name__=='__main__':
+ #import libwadpy
+ status = 1
+ try:
+ repeat,f2py_opts = f2py2e.f2py_testing.cmdline()
+ test_functions = build(f2py_opts)
+ f2py2e.f2py_testing.run(runtest,test_functions,repeat)
+ print 'ok'
+ status = 0
+ finally:
+ if status:
+ print '*'*20
+ print 'Running f2py2e.diagnose'
+ import f2py2e.diagnose
+ f2py2e.diagnose.run()
diff --git a/numpy/f2py/tests/f90/return_logical.py b/numpy/f2py/tests/f90/return_logical.py
new file mode 100644
index 000000000..71cfe162e
--- /dev/null
+++ b/numpy/f2py/tests/f90/return_logical.py
@@ -0,0 +1,137 @@
+__usage__ = """
+Run:
+ python return_logical.py [<f2py options>]
+Examples:
+ python return_logical.py --quiet
+"""
+
+import f2py2e
+from Numeric import array
+
+try: True
+except NameError:
+ True = 1
+ False = 0
+
+def build(f2py_opts):
+ try:
+ import f90_ext_return_logical
+ except ImportError:
+ assert not f2py2e.compile('''\
+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
+''','f90_ext_return_logical',f2py_opts,source_fn='f90_ret_log.f90')
+
+ from f90_ext_return_logical import f90_return_logical as m
+ test_functions = [m.t0,m.t1,m.t2,m.t4,m.t8,m.s0,m.s1,m.s2,m.s4,m.s8]
+ return test_functions
+
+
+
+
+def runtest(t):
+ assert t(True)==1,`t(True)`
+ assert t(False)==0,`t(False)`
+ assert t(0)==0
+ assert t(None)==0
+ assert t(0.0)==0
+ assert t(0j)==0
+ assert t(1j)==1
+ assert t(234)==1
+ assert t(234.6)==1
+ assert t(234l)==1
+ assert t(234.6+3j)==1
+ assert t('234')==1
+ assert t('aaa')==1
+ assert t('')==0
+ assert t([])==0
+ assert t(())==0
+ assert t({})==0
+ assert t(t)==1
+ assert t(-234)==1
+ assert t(10l**100)==1
+ assert t([234])==1
+ assert t((234,))==1
+ assert t(array(234))==1
+ assert t(array([234]))==1
+ assert t(array([[234]]))==1
+ assert t(array([234],'1'))==1
+ assert t(array([234],'s'))==1
+ assert t(array([234],'i'))==1
+ assert t(array([234],'l'))==1
+ assert t(array([234],'b'))==1
+ assert t(array([234],'f'))==1
+ assert t(array([234],'d'))==1
+ assert t(array([234+3j],'F'))==1
+ assert t(array([234],'D'))==1
+ assert t(array(0))==0
+ assert t(array([0]))==0
+ assert t(array([[0]]))==0
+ assert t(array([0j]))==0
+ assert t(array([1]))==1
+ assert t(array([0,0]))==0
+ assert t(array([0,1]))==1 #XXX: is this expected?
+
+if __name__=='__main__':
+ #import libwadpy
+ repeat,f2py_opts = f2py2e.f2py_testing.cmdline()
+ test_functions = build(f2py_opts)
+ f2py2e.f2py_testing.run(runtest,test_functions,repeat)
+ print 'ok'
diff --git a/numpy/f2py/tests/f90/return_real.py b/numpy/f2py/tests/f90/return_real.py
new file mode 100644
index 000000000..42d40cb95
--- /dev/null
+++ b/numpy/f2py/tests/f90/return_real.py
@@ -0,0 +1,129 @@
+__usage__ = """
+Run:
+ python return_real.py [<f2py options>]
+Examples:
+ python return_real.py --quiet
+"""
+
+import sys
+import f2py2e
+from Numeric import array
+
+def build(f2py_opts):
+ try:
+ import f90_ext_return_real
+ except ImportError:
+ assert not f2py2e.compile('''\
+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
+''','f90_ext_return_real',f2py_opts,source_fn='f90_ret_real.f90')
+
+ from f90_ext_return_real import f90_return_real as m
+ test_functions = [m.t0,m.t4,m.t8,m.td,m.s0,m.s4,m.s8,m.sd]
+ return test_functions
+
+def runtest(t):
+ tname = t.__doc__.split()[0]
+ if tname in ['t0','t4','s0','s4']:
+ err = 1e-5
+ else:
+ err = 0.0
+ assert abs(t(234)-234.0)<=err
+ assert abs(t(234.6)-234.6)<=err
+ assert abs(t(234l)-234.0)<=err
+ if sys.version[:3]<='2.2':
+ assert abs(t(234.6+3j)-234.6)<=err,`t(234.6+3j)`
+ assert abs(t('234')-234)<=err
+ assert abs(t('234.6')-234.6)<=err
+ assert abs(t(-234)+234)<=err
+ assert abs(t([234])-234)<=err
+ assert abs(t((234,))-234.)<=err
+ assert abs(t(array(234))-234.)<=err
+ assert abs(t(array([234]))-234.)<=err
+ assert abs(t(array([[234]]))-234.)<=err
+ assert abs(t(array([234],'1'))+22)<=err
+ assert abs(t(array([234],'s'))-234.)<=err
+ assert abs(t(array([234],'i'))-234.)<=err
+ assert abs(t(array([234],'l'))-234.)<=err
+ assert abs(t(array([234],'b'))-234.)<=err
+ assert abs(t(array([234],'f'))-234.)<=err
+ assert abs(t(array([234],'d'))-234.)<=err
+ if sys.version[:3]<='2.2':
+ assert abs(t(array([234+3j],'F'))-234.)<=err,`t(array([234+3j],'F'))`
+ assert abs(t(array([234],'D'))-234.)<=err,`t(array([234],'D'))`
+ if tname in ['t0','t4','s0','s4']:
+ assert t(1e200)==t(1e300) # inf
+
+ try: raise RuntimeError,`t(array([234],'c'))`
+ except ValueError: pass
+ try: raise RuntimeError,`t('abc')`
+ except ValueError: pass
+
+ try: raise RuntimeError,`t([])`
+ except IndexError: pass
+ try: raise RuntimeError,`t(())`
+ except IndexError: pass
+
+ try: raise RuntimeError,`t(t)`
+ except TypeError: pass
+ try: raise RuntimeError,`t({})`
+ except TypeError: pass
+
+ try:
+ try: raise RuntimeError,`t(10l**400)`
+ except OverflowError: pass
+ except RuntimeError:
+ r = t(10l**400); assert `r` in ['inf','Infinity'],`r`
+
+if __name__=='__main__':
+ #import libwadpy
+ repeat,f2py_opts = f2py2e.f2py_testing.cmdline()
+ test_functions = build(f2py_opts)
+ f2py2e.f2py_testing.run(runtest,test_functions,repeat)
+ print 'ok'
diff --git a/numpy/f2py/tests/mixed/foo.f b/numpy/f2py/tests/mixed/foo.f
new file mode 100644
index 000000000..c34742578
--- /dev/null
+++ b/numpy/f2py/tests/mixed/foo.f
@@ -0,0 +1,5 @@
+ subroutine bar11(a)
+cf2py intent(out) a
+ integer a
+ a = 11
+ end
diff --git a/numpy/f2py/tests/mixed/foo_fixed.f90 b/numpy/f2py/tests/mixed/foo_fixed.f90
new file mode 100644
index 000000000..7543a6acb
--- /dev/null
+++ b/numpy/f2py/tests/mixed/foo_fixed.f90
@@ -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
diff --git a/numpy/f2py/tests/mixed/foo_free.f90 b/numpy/f2py/tests/mixed/foo_free.f90
new file mode 100644
index 000000000..c1b641f13
--- /dev/null
+++ b/numpy/f2py/tests/mixed/foo_free.f90
@@ -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
diff --git a/numpy/f2py/tests/mixed/run.py b/numpy/f2py/tests/mixed/run.py
new file mode 100644
index 000000000..6f4b7d444
--- /dev/null
+++ b/numpy/f2py/tests/mixed/run.py
@@ -0,0 +1,50 @@
+#!/usr/bin/env python
+__usage__ = """
+Run:
+ python run.py [<f2py options>]
+Examples:
+ python run.py --quiet
+"""
+
+import os
+import sys
+import string
+import f2py2e
+from Numeric import array
+
+def build(f2py_opts):
+ try:
+ import mixed_f77_f90
+ except:
+ d,b=os.path.split(sys.argv[0])
+ files = ['foo.f','foo_fixed.f90','foo_free.f90']
+ files = [os.path.join(d,f) for f in files]
+ files = string.join(files)
+ args = ' -c -m mixed_f77_f90 %s %s'%(files,f2py_opts)
+ c = '%s -c "import f2py2e;f2py2e.main()" %s' %(sys.executable,args)
+ s = os.system(c)
+ assert not s
+ from mixed_f77_f90 import bar11
+ test_functions = [bar11]
+ from mixed_f77_f90 import foo_fixed as m
+ test_functions.append(m.bar12)
+ from mixed_f77_f90 import foo_free as m
+ test_functions.append(m.bar13)
+ return test_functions
+
+def runtest(t):
+ tname = t.__doc__.split()[0]
+ if tname=='bar11':
+ assert t()==11
+ elif tname=='bar12':
+ assert t()==12
+ elif tname=='bar13':
+ assert t()==13
+ else:
+ raise NotImplementedError
+
+if __name__=='__main__':
+ repeat,f2py_opts = f2py2e.f2py_testing.cmdline()
+ test_functions = build(f2py_opts)
+ f2py2e.f2py_testing.run(runtest,test_functions,repeat)
+ print 'ok'
diff --git a/numpy/f2py/tests/run_all.py b/numpy/f2py/tests/run_all.py
new file mode 100755
index 000000000..016e68c29
--- /dev/null
+++ b/numpy/f2py/tests/run_all.py
@@ -0,0 +1,55 @@
+#!/usr/bin/env python
+
+import os,sys
+
+opts = sys.argv[1:]
+if not opts:
+ opts = ['10','--quiet']
+
+NUMARRAY = "-DNUMARRAY" in sys.argv
+
+test_f77_files = [\
+ 'f77/return_integer.py',
+ 'f77/return_logical.py',
+ 'f77/return_real.py',
+ 'f77/return_complex.py',
+ 'f77/callback.py',
+ ]
+
+if not NUMARRAY: # no support for character yet in numarray
+ test_f77_files.append('f77/return_character.py')
+
+test_f90_files = [\
+ 'f90/return_integer.py',
+ 'f90/return_logical.py',
+ 'f90/return_real.py',
+ 'f90/return_complex.py',
+ 'f90/return_character.py',
+ 'mixed/run.py',
+ ]
+
+test_files = test_f77_files
+
+if NUMARRAY:
+ print >>sys.stderr,"NOTE: f2py for numarray does not support"\
+ " f90 or character arrays."
+else:
+ test_files += test_f90_files
+
+py_path = os.environ.get('PYTHONPATH')
+if py_path is None:
+ py_path = '.'
+else:
+ py_path = os.pathsep.join(['.',py_path])
+os.environ['PYTHONPATH'] = py_path
+
+for f in test_files:
+ print "**********************************************"
+ ff = os.path.join(sys.path[0],f)
+ args = [sys.executable,ff]+opts
+ print "Running",' '.join(args)
+ status = os.spawnve(os.P_WAIT,sys.executable,args,os.environ)
+ if status:
+ print 'TEST FAILURE (status=%s)' % (status)
+ if f=='f90/return_integer.py':
+ sys.exit()
diff --git a/numpy/f2py/use_rules.py b/numpy/f2py/use_rules.py
new file mode 100644
index 000000000..43c223a7d
--- /dev/null
+++ b/numpy/f2py/use_rules.py
@@ -0,0 +1,109 @@
+#!/usr/bin/env python
+"""
+
+Build 'use others module data' mechanism for f2py2e.
+
+Unfinished.
+
+Copyright 2000 Pearu Peterson all rights reserved,
+Pearu Peterson <pearu@ioc.ee>
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
+$Date: 2000/09/10 12:35:43 $
+Pearu Peterson
+"""
+
+__version__ = "$Revision: 1.3 $"[10:-1]
+
+f2py_version='See `f2py -v`'
+
+import pprint
+import sys,string,time,types,copy
+errmess=sys.stderr.write
+outmess=sys.stdout.write
+show=pprint.pprint
+
+from auxfuncs import *
+import capi_maps
+import cfuncs
+##############
+
+usemodule_rules={
+ 'body':"""
+#begintitle#
+static char doc_#apiname#[] = \"\\\nVariable wrapper signature:\\n\\
+\t #name# = get_#name#()\\n\\
+Arguments:\\n\\
+#docstr#\";
+extern F_MODFUNC(#usemodulename#,#USEMODULENAME#,#realname#,#REALNAME#);
+static PyObject *#apiname#(PyObject *capi_self, PyObject *capi_args) {
+/*#decl#*/
+\tif (!PyArg_ParseTuple(capi_args, \"\")) goto capi_fail;
+printf(\"c: %d\\n\",F_MODFUNC(#usemodulename#,#USEMODULENAME#,#realname#,#REALNAME#));
+\treturn Py_BuildValue(\"\");
+capi_fail:
+\treturn NULL;
+}
+""",
+ 'method':'\t{\"get_#name#\",#apiname#,METH_VARARGS|METH_KEYWORDS,doc_#apiname#},',
+ 'need':['F_MODFUNC']
+ }
+
+################
+
+def buildusevars(m,r):
+ ret={}
+ outmess('\t\tBuilding use variable hooks for module "%s" (feature only for F90/F95)...\n'%(m['name']))
+ varsmap={}
+ revmap={}
+ if r.has_key('map'):
+ for k in r['map'].keys():
+ if revmap.has_key(r['map'][k]):
+ outmess('\t\t\tVariable "%s<=%s" is already mapped by "%s". Skipping.\n'%(r['map'][k],k,revmap[r['map'][k]]))
+ else:
+ revmap[r['map'][k]]=k
+ if r.has_key('only') and r['only']:
+ for v in r['map'].keys():
+ if m['vars'].has_key(r['map'][v]):
+
+ if revmap[r['map'][v]]==v:
+ varsmap[v]=r['map'][v]
+ else:
+ outmess('\t\t\tIgnoring map "%s=>%s". See above.\n'%(v,r['map'][v]))
+ else:
+ outmess('\t\t\tNo definition for variable "%s=>%s". Skipping.\n'%(v,r['map'][v]))
+ else:
+ for v in m['vars'].keys():
+ if revmap.has_key(v):
+ varsmap[v]=revmap[v]
+ else:
+ varsmap[v]=v
+ for v in varsmap.keys():
+ ret=dictappend(ret,buildusevar(v,varsmap[v],m['vars'],m['name']))
+ return ret
+def buildusevar(name,realname,vars,usemodulename):
+ outmess('\t\t\tConstructing wrapper function for variable "%s=>%s"...\n'%(name,realname))
+ ret={}
+ vrd={'name':name,
+ 'realname':realname,
+ 'REALNAME':string.upper(realname),
+ 'usemodulename':usemodulename,
+ 'USEMODULENAME':string.upper(usemodulename),
+ 'texname':string.replace(name,'_','\\_'),
+ 'begintitle':gentitle('%s=>%s'%(name,realname)),
+ 'endtitle':gentitle('end of %s=>%s'%(name,realname)),
+ 'apiname':'#modulename#_use_%s_from_%s'%(realname,usemodulename)
+ }
+ nummap={0:'Ro',1:'Ri',2:'Rii',3:'Riii',4:'Riv',5:'Rv',6:'Rvi',7:'Rvii',8:'Rviii',9:'Rix'}
+ vrd['texnamename']=name
+ for i in nummap.keys():
+ vrd['texnamename']=string.replace(vrd['texnamename'],`i`,nummap[i])
+ if hasnote(vars[realname]): vrd['note']=vars[realname]['note']
+ rd=dictappend({},vrd)
+ var=vars[realname]
+
+ print name,realname,vars[realname]
+ ret=applyrules(usemodule_rules,rd)
+ return ret
diff --git a/numpy/fft/__init__.py b/numpy/fft/__init__.py
new file mode 100644
index 000000000..0c5a7f2ed
--- /dev/null
+++ b/numpy/fft/__init__.py
@@ -0,0 +1,9 @@
+# To get sub-modules
+from info import __doc__
+
+from fftpack import *
+from helper import *
+
+def test(level=1, verbosity=1):
+ from numpy.testing import NumpyTest
+ return NumpyTest().test(level, verbosity)
diff --git a/numpy/fft/fftpack.c b/numpy/fft/fftpack.c
new file mode 100644
index 000000000..9c8fd118a
--- /dev/null
+++ b/numpy/fft/fftpack.c
@@ -0,0 +1,1501 @@
+/*
+fftpack.c : A set of FFT routines in C.
+Algorithmically based on Fortran-77 FFTPACK by Paul N. Swarztrauber (Version 4, 1985).
+
+*/
+
+/* isign is +1 for backward and -1 for forward transforms */
+
+#include <math.h>
+#include <stdio.h>
+#define DOUBLE
+
+#ifdef DOUBLE
+#define Treal double
+#else
+#define Treal float
+#endif
+
+
+#define ref(u,a) u[a]
+
+#define MAXFAC 13 /* maximum number of factors in factorization of n */
+#define NSPECIAL 4 /* number of factors for which we have special-case routines */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+/* ----------------------------------------------------------------------
+ passf2, passf3, passf4, passf5, passf. Complex FFT passes fwd and bwd.
+---------------------------------------------------------------------- */
+
+static void passf2(int ido, int l1, const Treal cc[], Treal ch[], const Treal wa1[], int isign)
+ /* isign==+1 for backward transform */
+ {
+ int i, k, ah, ac;
+ Treal ti2, tr2;
+ if (ido <= 2) {
+ for (k=0; k<l1; k++) {
+ ah = k*ido;
+ ac = 2*k*ido;
+ ch[ah] = ref(cc,ac) + ref(cc,ac + ido);
+ ch[ah + ido*l1] = ref(cc,ac) - ref(cc,ac + ido);
+ ch[ah+1] = ref(cc,ac+1) + ref(cc,ac + ido + 1);
+ ch[ah + ido*l1 + 1] = ref(cc,ac+1) - ref(cc,ac + ido + 1);
+ }
+ } else {
+ for (k=0; k<l1; k++) {
+ for (i=0; i<ido-1; i+=2) {
+ ah = i + k*ido;
+ ac = i + 2*k*ido;
+ ch[ah] = ref(cc,ac) + ref(cc,ac + ido);
+ tr2 = ref(cc,ac) - ref(cc,ac + ido);
+ ch[ah+1] = ref(cc,ac+1) + ref(cc,ac + 1 + ido);
+ ti2 = ref(cc,ac+1) - ref(cc,ac + 1 + ido);
+ ch[ah+l1*ido+1] = wa1[i]*ti2 + isign*wa1[i+1]*tr2;
+ ch[ah+l1*ido] = wa1[i]*tr2 - isign*wa1[i+1]*ti2;
+ }
+ }
+ }
+ } /* passf2 */
+
+
+static void passf3(int ido, int l1, const Treal cc[], Treal ch[],
+ const Treal wa1[], const Treal wa2[], int isign)
+ /* isign==+1 for backward transform */
+ {
+ static const Treal taur = -0.5;
+ static const Treal taui = 0.866025403784439;
+ int i, k, ac, ah;
+ Treal ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
+ if (ido == 2) {
+ for (k=1; k<=l1; k++) {
+ ac = (3*k - 2)*ido;
+ tr2 = ref(cc,ac) + ref(cc,ac + ido);
+ cr2 = ref(cc,ac - ido) + taur*tr2;
+ ah = (k - 1)*ido;
+ ch[ah] = ref(cc,ac - ido) + tr2;
+
+ ti2 = ref(cc,ac + 1) + ref(cc,ac + ido + 1);
+ ci2 = ref(cc,ac - ido + 1) + taur*ti2;
+ ch[ah + 1] = ref(cc,ac - ido + 1) + ti2;
+
+ cr3 = isign*taui*(ref(cc,ac) - ref(cc,ac + ido));
+ ci3 = isign*taui*(ref(cc,ac + 1) - ref(cc,ac + ido + 1));
+ ch[ah + l1*ido] = cr2 - ci3;
+ ch[ah + 2*l1*ido] = cr2 + ci3;
+ ch[ah + l1*ido + 1] = ci2 + cr3;
+ ch[ah + 2*l1*ido + 1] = ci2 - cr3;
+ }
+ } else {
+ for (k=1; k<=l1; k++) {
+ for (i=0; i<ido-1; i+=2) {
+ ac = i + (3*k - 2)*ido;
+ tr2 = ref(cc,ac) + ref(cc,ac + ido);
+ cr2 = ref(cc,ac - ido) + taur*tr2;
+ ah = i + (k-1)*ido;
+ ch[ah] = ref(cc,ac - ido) + tr2;
+ ti2 = ref(cc,ac + 1) + ref(cc,ac + ido + 1);
+ ci2 = ref(cc,ac - ido + 1) + taur*ti2;
+ ch[ah + 1] = ref(cc,ac - ido + 1) + ti2;
+ cr3 = isign*taui*(ref(cc,ac) - ref(cc,ac + ido));
+ ci3 = isign*taui*(ref(cc,ac + 1) - ref(cc,ac + ido + 1));
+ dr2 = cr2 - ci3;
+ dr3 = cr2 + ci3;
+ di2 = ci2 + cr3;
+ di3 = ci2 - cr3;
+ ch[ah + l1*ido + 1] = wa1[i]*di2 + isign*wa1[i+1]*dr2;
+ ch[ah + l1*ido] = wa1[i]*dr2 - isign*wa1[i+1]*di2;
+ ch[ah + 2*l1*ido + 1] = wa2[i]*di3 + isign*wa2[i+1]*dr3;
+ ch[ah + 2*l1*ido] = wa2[i]*dr3 - isign*wa2[i+1]*di3;
+ }
+ }
+ }
+ } /* passf3 */
+
+
+static void passf4(int ido, int l1, const Treal cc[], Treal ch[],
+ const Treal wa1[], const Treal wa2[], const Treal wa3[], int isign)
+ /* isign == -1 for forward transform and +1 for backward transform */
+ {
+ int i, k, ac, ah;
+ Treal ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;
+ if (ido == 2) {
+ for (k=0; k<l1; k++) {
+ ac = 4*k*ido + 1;
+ ti1 = ref(cc,ac) - ref(cc,ac + 2*ido);
+ ti2 = ref(cc,ac) + ref(cc,ac + 2*ido);
+ tr4 = ref(cc,ac + 3*ido) - ref(cc,ac + ido);
+ ti3 = ref(cc,ac + ido) + ref(cc,ac + 3*ido);
+ tr1 = ref(cc,ac - 1) - ref(cc,ac + 2*ido - 1);
+ tr2 = ref(cc,ac - 1) + ref(cc,ac + 2*ido - 1);
+ ti4 = ref(cc,ac + ido - 1) - ref(cc,ac + 3*ido - 1);
+ tr3 = ref(cc,ac + ido - 1) + ref(cc,ac + 3*ido - 1);
+ ah = k*ido;
+ ch[ah] = tr2 + tr3;
+ ch[ah + 2*l1*ido] = tr2 - tr3;
+ ch[ah + 1] = ti2 + ti3;
+ ch[ah + 2*l1*ido + 1] = ti2 - ti3;
+ ch[ah + l1*ido] = tr1 + isign*tr4;
+ ch[ah + 3*l1*ido] = tr1 - isign*tr4;
+ ch[ah + l1*ido + 1] = ti1 + isign*ti4;
+ ch[ah + 3*l1*ido + 1] = ti1 - isign*ti4;
+ }
+ } else {
+ for (k=0; k<l1; k++) {
+ for (i=0; i<ido-1; i+=2) {
+ ac = i + 1 + 4*k*ido;
+ ti1 = ref(cc,ac) - ref(cc,ac + 2*ido);
+ ti2 = ref(cc,ac) + ref(cc,ac + 2*ido);
+ ti3 = ref(cc,ac + ido) + ref(cc,ac + 3*ido);
+ tr4 = ref(cc,ac + 3*ido) - ref(cc,ac + ido);
+ tr1 = ref(cc,ac - 1) - ref(cc,ac + 2*ido - 1);
+ tr2 = ref(cc,ac - 1) + ref(cc,ac + 2*ido - 1);
+ ti4 = ref(cc,ac + ido - 1) - ref(cc,ac + 3*ido - 1);
+ tr3 = ref(cc,ac + ido - 1) + ref(cc,ac + 3*ido - 1);
+ ah = i + k*ido;
+ ch[ah] = tr2 + tr3;
+ cr3 = tr2 - tr3;
+ ch[ah + 1] = ti2 + ti3;
+ ci3 = ti2 - ti3;
+ cr2 = tr1 + isign*tr4;
+ cr4 = tr1 - isign*tr4;
+ ci2 = ti1 + isign*ti4;
+ ci4 = ti1 - isign*ti4;
+ ch[ah + l1*ido] = wa1[i]*cr2 - isign*wa1[i + 1]*ci2;
+ ch[ah + l1*ido + 1] = wa1[i]*ci2 + isign*wa1[i + 1]*cr2;
+ ch[ah + 2*l1*ido] = wa2[i]*cr3 - isign*wa2[i + 1]*ci3;
+ ch[ah + 2*l1*ido + 1] = wa2[i]*ci3 + isign*wa2[i + 1]*cr3;
+ ch[ah + 3*l1*ido] = wa3[i]*cr4 -isign*wa3[i + 1]*ci4;
+ ch[ah + 3*l1*ido + 1] = wa3[i]*ci4 + isign*wa3[i + 1]*cr4;
+ }
+ }
+ }
+ } /* passf4 */
+
+
+static void passf5(int ido, int l1, const Treal cc[], Treal ch[],
+ const Treal wa1[], const Treal wa2[], const Treal wa3[], const Treal wa4[], int isign)
+ /* isign == -1 for forward transform and +1 for backward transform */
+ {
+ static const Treal tr11 = 0.309016994374947;
+ static const Treal ti11 = 0.951056516295154;
+ static const Treal tr12 = -0.809016994374947;
+ static const Treal ti12 = 0.587785252292473;
+ int i, k, ac, ah;
+ Treal ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, ti2, ti3,
+ ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
+ if (ido == 2) {
+ for (k = 1; k <= l1; ++k) {
+ ac = (5*k - 4)*ido + 1;
+ ti5 = ref(cc,ac) - ref(cc,ac + 3*ido);
+ ti2 = ref(cc,ac) + ref(cc,ac + 3*ido);
+ ti4 = ref(cc,ac + ido) - ref(cc,ac + 2*ido);
+ ti3 = ref(cc,ac + ido) + ref(cc,ac + 2*ido);
+ tr5 = ref(cc,ac - 1) - ref(cc,ac + 3*ido - 1);
+ tr2 = ref(cc,ac - 1) + ref(cc,ac + 3*ido - 1);
+ tr4 = ref(cc,ac + ido - 1) - ref(cc,ac + 2*ido - 1);
+ tr3 = ref(cc,ac + ido - 1) + ref(cc,ac + 2*ido - 1);
+ ah = (k - 1)*ido;
+ ch[ah] = ref(cc,ac - ido - 1) + tr2 + tr3;
+ ch[ah + 1] = ref(cc,ac - ido) + ti2 + ti3;
+ cr2 = ref(cc,ac - ido - 1) + tr11*tr2 + tr12*tr3;
+ ci2 = ref(cc,ac - ido) + tr11*ti2 + tr12*ti3;
+ cr3 = ref(cc,ac - ido - 1) + tr12*tr2 + tr11*tr3;
+ ci3 = ref(cc,ac - ido) + tr12*ti2 + tr11*ti3;
+ cr5 = isign*(ti11*tr5 + ti12*tr4);
+ ci5 = isign*(ti11*ti5 + ti12*ti4);
+ cr4 = isign*(ti12*tr5 - ti11*tr4);
+ ci4 = isign*(ti12*ti5 - ti11*ti4);
+ ch[ah + l1*ido] = cr2 - ci5;
+ ch[ah + 4*l1*ido] = cr2 + ci5;
+ ch[ah + l1*ido + 1] = ci2 + cr5;
+ ch[ah + 2*l1*ido + 1] = ci3 + cr4;
+ ch[ah + 2*l1*ido] = cr3 - ci4;
+ ch[ah + 3*l1*ido] = cr3 + ci4;
+ ch[ah + 3*l1*ido + 1] = ci3 - cr4;
+ ch[ah + 4*l1*ido + 1] = ci2 - cr5;
+ }
+ } else {
+ for (k=1; k<=l1; k++) {
+ for (i=0; i<ido-1; i+=2) {
+ ac = i + 1 + (k*5 - 4)*ido;
+ ti5 = ref(cc,ac) - ref(cc,ac + 3*ido);
+ ti2 = ref(cc,ac) + ref(cc,ac + 3*ido);
+ ti4 = ref(cc,ac + ido) - ref(cc,ac + 2*ido);
+ ti3 = ref(cc,ac + ido) + ref(cc,ac + 2*ido);
+ tr5 = ref(cc,ac - 1) - ref(cc,ac + 3*ido - 1);
+ tr2 = ref(cc,ac - 1) + ref(cc,ac + 3*ido - 1);
+ tr4 = ref(cc,ac + ido - 1) - ref(cc,ac + 2*ido - 1);
+ tr3 = ref(cc,ac + ido - 1) + ref(cc,ac + 2*ido - 1);
+ ah = i + (k - 1)*ido;
+ ch[ah] = ref(cc,ac - ido - 1) + tr2 + tr3;
+ ch[ah + 1] = ref(cc,ac - ido) + ti2 + ti3;
+ cr2 = ref(cc,ac - ido - 1) + tr11*tr2 + tr12*tr3;
+
+ ci2 = ref(cc,ac - ido) + tr11*ti2 + tr12*ti3;
+ cr3 = ref(cc,ac - ido - 1) + tr12*tr2 + tr11*tr3;
+
+ ci3 = ref(cc,ac - ido) + tr12*ti2 + tr11*ti3;
+ cr5 = isign*(ti11*tr5 + ti12*tr4);
+ ci5 = isign*(ti11*ti5 + ti12*ti4);
+ cr4 = isign*(ti12*tr5 - ti11*tr4);
+ ci4 = isign*(ti12*ti5 - ti11*ti4);
+ dr3 = cr3 - ci4;
+ dr4 = cr3 + ci4;
+ di3 = ci3 + cr4;
+ di4 = ci3 - cr4;
+ dr5 = cr2 + ci5;
+ dr2 = cr2 - ci5;
+ di5 = ci2 - cr5;
+ di2 = ci2 + cr5;
+ ch[ah + l1*ido] = wa1[i]*dr2 - isign*wa1[i+1]*di2;
+ ch[ah + l1*ido + 1] = wa1[i]*di2 + isign*wa1[i+1]*dr2;
+ ch[ah + 2*l1*ido] = wa2[i]*dr3 - isign*wa2[i+1]*di3;
+ ch[ah + 2*l1*ido + 1] = wa2[i]*di3 + isign*wa2[i+1]*dr3;
+ ch[ah + 3*l1*ido] = wa3[i]*dr4 - isign*wa3[i+1]*di4;
+ ch[ah + 3*l1*ido + 1] = wa3[i]*di4 + isign*wa3[i+1]*dr4;
+ ch[ah + 4*l1*ido] = wa4[i]*dr5 - isign*wa4[i+1]*di5;
+ ch[ah + 4*l1*ido + 1] = wa4[i]*di5 + isign*wa4[i+1]*dr5;
+ }
+ }
+ }
+ } /* passf5 */
+
+
+static void passf(int *nac, int ido, int ip, int l1, int idl1,
+ Treal cc[], Treal ch[],
+ const Treal wa[], int isign)
+ /* isign is -1 for forward transform and +1 for backward transform */
+ {
+ int idij, idlj, idot, ipph, i, j, k, l, jc, lc, ik, idj, idl, inc,idp;
+ Treal wai, war;
+
+ idot = ido / 2;
+ /* nt = ip*idl1;*/
+ ipph = (ip + 1) / 2;
+ idp = ip*ido;
+ if (ido >= l1) {
+ for (j=1; j<ipph; j++) {
+ jc = ip - j;
+ for (k=0; k<l1; k++) {
+ for (i=0; i<ido; i++) {
+ ch[i + (k + j*l1)*ido] =
+ ref(cc,i + (j + k*ip)*ido) + ref(cc,i + (jc + k*ip)*ido);
+ ch[i + (k + jc*l1)*ido] =
+ ref(cc,i + (j + k*ip)*ido) - ref(cc,i + (jc + k*ip)*ido);
+ }
+ }
+ }
+ for (k=0; k<l1; k++)
+ for (i=0; i<ido; i++)
+ ch[i + k*ido] = ref(cc,i + k*ip*ido);
+ } else {
+ for (j=1; j<ipph; j++) {
+ jc = ip - j;
+ for (i=0; i<ido; i++) {
+ for (k=0; k<l1; k++) {
+ ch[i + (k + j*l1)*ido] = ref(cc,i + (j + k*ip)*ido) + ref(cc,i + (jc + k*
+ ip)*ido);
+ ch[i + (k + jc*l1)*ido] = ref(cc,i + (j + k*ip)*ido) - ref(cc,i + (jc + k*
+ ip)*ido);
+ }
+ }
+ }
+ for (i=0; i<ido; i++)
+ for (k=0; k<l1; k++)
+ ch[i + k*ido] = ref(cc,i + k*ip*ido);
+ }
+
+ idl = 2 - ido;
+ inc = 0;
+ for (l=1; l<ipph; l++) {
+ lc = ip - l;
+ idl += ido;
+ for (ik=0; ik<idl1; ik++) {
+ cc[ik + l*idl1] = ch[ik] + wa[idl - 2]*ch[ik + idl1];
+ cc[ik + lc*idl1] = isign*wa[idl-1]*ch[ik + (ip-1)*idl1];
+ }
+ idlj = idl;
+ inc += ido;
+ for (j=2; j<ipph; j++) {
+ jc = ip - j;
+ idlj += inc;
+ if (idlj > idp) idlj -= idp;
+ war = wa[idlj - 2];
+ wai = wa[idlj-1];
+ for (ik=0; ik<idl1; ik++) {
+ cc[ik + l*idl1] += war*ch[ik + j*idl1];
+ cc[ik + lc*idl1] += isign*wai*ch[ik + jc*idl1];
+ }
+ }
+ }
+ for (j=1; j<ipph; j++)
+ for (ik=0; ik<idl1; ik++)
+ ch[ik] += ch[ik + j*idl1];
+ for (j=1; j<ipph; j++) {
+ jc = ip - j;
+ for (ik=1; ik<idl1; ik+=2) {
+ ch[ik - 1 + j*idl1] = cc[ik - 1 + j*idl1] - cc[ik + jc*idl1];
+ ch[ik - 1 + jc*idl1] = cc[ik - 1 + j*idl1] + cc[ik + jc*idl1];
+ ch[ik + j*idl1] = cc[ik + j*idl1] + cc[ik - 1 + jc*idl1];
+ ch[ik + jc*idl1] = cc[ik + j*idl1] - cc[ik - 1 + jc*idl1];
+ }
+ }
+ *nac = 1;
+ if (ido == 2) return;
+ *nac = 0;
+ for (ik=0; ik<idl1; ik++)
+ cc[ik] = ch[ik];
+ for (j=1; j<ip; j++) {
+ for (k=0; k<l1; k++) {
+ cc[(k + j*l1)*ido + 0] = ch[(k + j*l1)*ido + 0];
+ cc[(k + j*l1)*ido + 1] = ch[(k + j*l1)*ido + 1];
+ }
+ }
+ if (idot <= l1) {
+ idij = 0;
+ for (j=1; j<ip; j++) {
+ idij += 2;
+ for (i=3; i<ido; i+=2) {
+ idij += 2;
+ for (k=0; k<l1; k++) {
+ cc[i - 1 + (k + j*l1)*ido] =
+ wa[idij - 2]*ch[i - 1 + (k + j*l1)*ido] -
+ isign*wa[idij-1]*ch[i + (k + j*l1)*ido];
+ cc[i + (k + j*l1)*ido] =
+ wa[idij - 2]*ch[i + (k + j*l1)*ido] +
+ isign*wa[idij-1]*ch[i - 1 + (k + j*l1)*ido];
+ }
+ }
+ }
+ } else {
+ idj = 2 - ido;
+ for (j=1; j<ip; j++) {
+ idj += ido;
+ for (k = 0; k < l1; k++) {
+ idij = idj;
+ for (i=3; i<ido; i+=2) {
+ idij += 2;
+ cc[i - 1 + (k + j*l1)*ido] =
+ wa[idij - 2]*ch[i - 1 + (k + j*l1)*ido] -
+ isign*wa[idij-1]*ch[i + (k + j*l1)*ido];
+ cc[i + (k + j*l1)*ido] =
+ wa[idij - 2]*ch[i + (k + j*l1)*ido] +
+ isign*wa[idij-1]*ch[i - 1 + (k + j*l1)*ido];
+ }
+ }
+ }
+ }
+ } /* passf */
+
+
+ /* ----------------------------------------------------------------------
+radf2,radb2, radf3,radb3, radf4,radb4, radf5,radb5, radfg,radbg.
+Treal FFT passes fwd and bwd.
+---------------------------------------------------------------------- */
+
+static void radf2(int ido, int l1, const Treal cc[], Treal ch[], const Treal wa1[])
+ {
+ int i, k, ic;
+ Treal ti2, tr2;
+ for (k=0; k<l1; k++) {
+ ch[2*k*ido] =
+ ref(cc,k*ido) + ref(cc,(k + l1)*ido);
+ ch[(2*k+1)*ido + ido-1] =
+ ref(cc,k*ido) - ref(cc,(k + l1)*ido);
+ }
+ if (ido < 2) return;
+ if (ido != 2) {
+ for (k=0; k<l1; k++) {
+ for (i=2; i<ido; i+=2) {
+ ic = ido - i;
+ tr2 = wa1[i - 2]*ref(cc, i-1 + (k + l1)*ido) + wa1[i - 1]*ref(cc, i + (k + l1)*ido);
+ ti2 = wa1[i - 2]*ref(cc, i + (k + l1)*ido) - wa1[i - 1]*ref(cc, i-1 + (k + l1)*ido);
+ ch[i + 2*k*ido] = ref(cc,i + k*ido) + ti2;
+ ch[ic + (2*k+1)*ido] = ti2 - ref(cc,i + k*ido);
+ ch[i - 1 + 2*k*ido] = ref(cc,i - 1 + k*ido) + tr2;
+ ch[ic - 1 + (2*k+1)*ido] = ref(cc,i - 1 + k*ido) - tr2;
+ }
+ }
+ if (ido % 2 == 1) return;
+ }
+ for (k=0; k<l1; k++) {
+ ch[(2*k+1)*ido] = -ref(cc,ido-1 + (k + l1)*ido);
+ ch[ido-1 + 2*k*ido] = ref(cc,ido-1 + k*ido);
+ }
+ } /* radf2 */
+
+
+static void radb2(int ido, int l1, const Treal cc[], Treal ch[], const Treal wa1[])
+ {
+ int i, k, ic;
+ Treal ti2, tr2;
+ for (k=0; k<l1; k++) {
+ ch[k*ido] =
+ ref(cc,2*k*ido) + ref(cc,ido-1 + (2*k+1)*ido);
+ ch[(k + l1)*ido] =
+ ref(cc,2*k*ido) - ref(cc,ido-1 + (2*k+1)*ido);
+ }
+ if (ido < 2) return;
+ if (ido != 2) {
+ for (k = 0; k < l1; ++k) {
+ for (i = 2; i < ido; i += 2) {
+ ic = ido - i;
+ ch[i-1 + k*ido] =
+ ref(cc,i-1 + 2*k*ido) + ref(cc,ic-1 + (2*k+1)*ido);
+ tr2 = ref(cc,i-1 + 2*k*ido) - ref(cc,ic-1 + (2*k+1)*ido);
+ ch[i + k*ido] =
+ ref(cc,i + 2*k*ido) - ref(cc,ic + (2*k+1)*ido);
+ ti2 = ref(cc,i + (2*k)*ido) + ref(cc,ic + (2*k+1)*ido);
+ ch[i-1 + (k + l1)*ido] =
+ wa1[i - 2]*tr2 - wa1[i - 1]*ti2;
+ ch[i + (k + l1)*ido] =
+ wa1[i - 2]*ti2 + wa1[i - 1]*tr2;
+ }
+ }
+ if (ido % 2 == 1) return;
+ }
+ for (k = 0; k < l1; k++) {
+ ch[ido-1 + k*ido] = 2*ref(cc,ido-1 + 2*k*ido);
+ ch[ido-1 + (k + l1)*ido] = -2*ref(cc,(2*k+1)*ido);
+ }
+ } /* radb2 */
+
+
+static void radf3(int ido, int l1, const Treal cc[], Treal ch[],
+ const Treal wa1[], const Treal wa2[])
+ {
+ static const Treal taur = -0.5;
+ static const Treal taui = 0.866025403784439;
+ int i, k, ic;
+ Treal ci2, di2, di3, cr2, dr2, dr3, ti2, ti3, tr2, tr3;
+ for (k=0; k<l1; k++) {
+ cr2 = ref(cc,(k + l1)*ido) + ref(cc,(k + 2*l1)*ido);
+ ch[3*k*ido] = ref(cc,k*ido) + cr2;
+ ch[(3*k+2)*ido] = taui*(ref(cc,(k + l1*2)*ido) - ref(cc,(k + l1)*ido));
+ ch[ido-1 + (3*k + 1)*ido] = ref(cc,k*ido) + taur*cr2;
+ }
+ if (ido == 1) return;
+ for (k=0; k<l1; k++) {
+ for (i=2; i<ido; i+=2) {
+ ic = ido - i;
+ dr2 = wa1[i - 2]*ref(cc,i - 1 + (k + l1)*ido) +
+ wa1[i - 1]*ref(cc,i + (k + l1)*ido);
+ di2 = wa1[i - 2]*ref(cc,i + (k + l1)*ido) - wa1[i - 1]*ref(cc,i - 1 + (k + l1)*ido);
+ dr3 = wa2[i - 2]*ref(cc,i - 1 + (k + l1*2)*ido) + wa2[i - 1]*ref(cc,i + (k + l1*2)*ido);
+ di3 = wa2[i - 2]*ref(cc,i + (k + l1*2)*ido) - wa2[i - 1]*ref(cc,i - 1 + (k + l1*2)*ido);
+ cr2 = dr2 + dr3;
+ ci2 = di2 + di3;
+ ch[i - 1 + 3*k*ido] = ref(cc,i - 1 + k*ido) + cr2;
+ ch[i + 3*k*ido] = ref(cc,i + k*ido) + ci2;
+ tr2 = ref(cc,i - 1 + k*ido) + taur*cr2;
+ ti2 = ref(cc,i + k*ido) + taur*ci2;
+ tr3 = taui*(di2 - di3);
+ ti3 = taui*(dr3 - dr2);
+ ch[i - 1 + (3*k + 2)*ido] = tr2 + tr3;
+ ch[ic - 1 + (3*k + 1)*ido] = tr2 - tr3;
+ ch[i + (3*k + 2)*ido] = ti2 + ti3;
+ ch[ic + (3*k + 1)*ido] = ti3 - ti2;
+ }
+ }
+ } /* radf3 */
+
+
+static void radb3(int ido, int l1, const Treal cc[], Treal ch[],
+ const Treal wa1[], const Treal wa2[])
+ {
+ static const Treal taur = -0.5;
+ static const Treal taui = 0.866025403784439;
+ int i, k, ic;
+ Treal ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
+ for (k=0; k<l1; k++) {
+ tr2 = 2*ref(cc,ido-1 + (3*k + 1)*ido);
+ cr2 = ref(cc,3*k*ido) + taur*tr2;
+ ch[k*ido] = ref(cc,3*k*ido) + tr2;
+ ci3 = 2*taui*ref(cc,(3*k + 2)*ido);
+ ch[(k + l1)*ido] = cr2 - ci3;
+ ch[(k + 2*l1)*ido] = cr2 + ci3;
+ }
+ if (ido == 1) return;
+ for (k=0; k<l1; k++) {
+ for (i=2; i<ido; i+=2) {
+ ic = ido - i;
+ tr2 = ref(cc,i - 1 + (3*k + 2)*ido) + ref(cc,ic - 1 + (3*k + 1)*ido);
+ cr2 = ref(cc,i - 1 + 3*k*ido) + taur*tr2;
+ ch[i - 1 + k*ido] = ref(cc,i - 1 + 3*k*ido) + tr2;
+ ti2 = ref(cc,i + (3*k + 2)*ido) - ref(cc,ic + (3*k + 1)*ido);
+ ci2 = ref(cc,i + 3*k*ido) + taur*ti2;
+ ch[i + k*ido] = ref(cc,i + 3*k*ido) + ti2;
+ cr3 = taui*(ref(cc,i - 1 + (3*k + 2)*ido) - ref(cc,ic - 1 + (3*k + 1)*ido));
+ ci3 = taui*(ref(cc,i + (3*k + 2)*ido) + ref(cc,ic + (3*k + 1)*ido));
+ dr2 = cr2 - ci3;
+ dr3 = cr2 + ci3;
+ di2 = ci2 + cr3;
+ di3 = ci2 - cr3;
+ ch[i - 1 + (k + l1)*ido] = wa1[i - 2]*dr2 - wa1[i - 1]*di2;
+ ch[i + (k + l1)*ido] = wa1[i - 2]*di2 + wa1[i - 1]*dr2;
+ ch[i - 1 + (k + 2*l1)*ido] = wa2[i - 2]*dr3 - wa2[i - 1]*di3;
+ ch[i + (k + 2*l1)*ido] = wa2[i - 2]*di3 + wa2[i - 1]*dr3;
+ }
+ }
+ } /* radb3 */
+
+
+static void radf4(int ido, int l1, const Treal cc[], Treal ch[],
+ const Treal wa1[], const Treal wa2[], const Treal wa3[])
+ {
+ static const Treal hsqt2 = 0.7071067811865475;
+ int i, k, ic;
+ Treal ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;
+ for (k=0; k<l1; k++) {
+ tr1 = ref(cc,(k + l1)*ido) + ref(cc,(k + 3*l1)*ido);
+ tr2 = ref(cc,k*ido) + ref(cc,(k + 2*l1)*ido);
+ ch[4*k*ido] = tr1 + tr2;
+ ch[ido-1 + (4*k + 3)*ido] = tr2 - tr1;
+ ch[ido-1 + (4*k + 1)*ido] = ref(cc,k*ido) - ref(cc,(k + 2*l1)*ido);
+ ch[(4*k + 2)*ido] = ref(cc,(k + 3*l1)*ido) - ref(cc,(k + l1)*ido);
+ }
+ if (ido < 2) return;
+ if (ido != 2) {
+ for (k=0; k<l1; k++) {
+ for (i=2; i<ido; i += 2) {
+ ic = ido - i;
+ cr2 = wa1[i - 2]*ref(cc,i - 1 + (k + l1)*ido) + wa1[i - 1]*ref(cc,i + (k + l1)*ido);
+ ci2 = wa1[i - 2]*ref(cc,i + (k + l1)*ido) - wa1[i - 1]*ref(cc,i - 1 + (k + l1)*ido);
+ cr3 = wa2[i - 2]*ref(cc,i - 1 + (k + 2*l1)*ido) + wa2[i - 1]*ref(cc,i + (k + 2*l1)*
+ ido);
+ ci3 = wa2[i - 2]*ref(cc,i + (k + 2*l1)*ido) - wa2[i - 1]*ref(cc,i - 1 + (k + 2*l1)*
+ ido);
+ cr4 = wa3[i - 2]*ref(cc,i - 1 + (k + 3*l1)*ido) + wa3[i - 1]*ref(cc,i + (k + 3*l1)*
+ ido);
+ ci4 = wa3[i - 2]*ref(cc,i + (k + 3*l1)*ido) - wa3[i - 1]*ref(cc,i - 1 + (k + 3*l1)*
+ ido);
+ tr1 = cr2 + cr4;
+ tr4 = cr4 - cr2;
+ ti1 = ci2 + ci4;
+ ti4 = ci2 - ci4;
+ ti2 = ref(cc,i + k*ido) + ci3;
+ ti3 = ref(cc,i + k*ido) - ci3;
+ tr2 = ref(cc,i - 1 + k*ido) + cr3;
+ tr3 = ref(cc,i - 1 + k*ido) - cr3;
+ ch[i - 1 + 4*k*ido] = tr1 + tr2;
+ ch[ic - 1 + (4*k + 3)*ido] = tr2 - tr1;
+ ch[i + 4*k*ido] = ti1 + ti2;
+ ch[ic + (4*k + 3)*ido] = ti1 - ti2;
+ ch[i - 1 + (4*k + 2)*ido] = ti4 + tr3;
+ ch[ic - 1 + (4*k + 1)*ido] = tr3 - ti4;
+ ch[i + (4*k + 2)*ido] = tr4 + ti3;
+ ch[ic + (4*k + 1)*ido] = tr4 - ti3;
+ }
+ }
+ if (ido % 2 == 1) return;
+ }
+ for (k=0; k<l1; k++) {
+ ti1 = -hsqt2*(ref(cc,ido-1 + (k + l1)*ido) + ref(cc,ido-1 + (k + 3*l1)*ido));
+ tr1 = hsqt2*(ref(cc,ido-1 + (k + l1)*ido) - ref(cc,ido-1 + (k + 3*l1)*ido));
+ ch[ido-1 + 4*k*ido] = tr1 + ref(cc,ido-1 + k*ido);
+ ch[ido-1 + (4*k + 2)*ido] = ref(cc,ido-1 + k*ido) - tr1;
+ ch[(4*k + 1)*ido] = ti1 - ref(cc,ido-1 + (k + 2*l1)*ido);
+ ch[(4*k + 3)*ido] = ti1 + ref(cc,ido-1 + (k + 2*l1)*ido);
+ }
+ } /* radf4 */
+
+
+static void radb4(int ido, int l1, const Treal cc[], Treal ch[],
+ const Treal wa1[], const Treal wa2[], const Treal wa3[])
+ {
+ static const Treal sqrt2 = 1.414213562373095;
+ int i, k, ic;
+ Treal ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;
+ for (k = 0; k < l1; k++) {
+ tr1 = ref(cc,4*k*ido) - ref(cc,ido-1 + (4*k + 3)*ido);
+ tr2 = ref(cc,4*k*ido) + ref(cc,ido-1 + (4*k + 3)*ido);
+ tr3 = ref(cc,ido-1 + (4*k + 1)*ido) + ref(cc,ido-1 + (4*k + 1)*ido);
+ tr4 = ref(cc,(4*k + 2)*ido) + ref(cc,(4*k + 2)*ido);
+ ch[k*ido] = tr2 + tr3;
+ ch[(k + l1)*ido] = tr1 - tr4;
+ ch[(k + 2*l1)*ido] = tr2 - tr3;
+ ch[(k + 3*l1)*ido] = tr1 + tr4;
+ }
+ if (ido < 2) return;
+ if (ido != 2) {
+ for (k = 0; k < l1; ++k) {
+ for (i = 2; i < ido; i += 2) {
+ ic = ido - i;
+ ti1 = ref(cc,i + 4*k*ido) + ref(cc,ic + (4*k + 3)*ido);
+ ti2 = ref(cc,i + 4*k*ido) - ref(cc,ic + (4*k + 3)*ido);
+ ti3 = ref(cc,i + (4*k + 2)*ido) - ref(cc,ic + (4*k + 1)*ido);
+ tr4 = ref(cc,i + (4*k + 2)*ido) + ref(cc,ic + (4*k + 1)*ido);
+ tr1 = ref(cc,i - 1 + 4*k*ido) - ref(cc,ic - 1 + (4*k + 3)*ido);
+ tr2 = ref(cc,i - 1 + 4*k*ido) + ref(cc,ic - 1 + (4*k + 3)*ido);
+ ti4 = ref(cc,i - 1 + (4*k + 2)*ido) - ref(cc,ic - 1 + (4*k + 1)*ido);
+ tr3 = ref(cc,i - 1 + (4*k + 2)*ido) + ref(cc,ic - 1 + (4*k + 1)*ido);
+ ch[i - 1 + k*ido] = tr2 + tr3;
+ cr3 = tr2 - tr3;
+ ch[i + k*ido] = ti2 + ti3;
+ ci3 = ti2 - ti3;
+ cr2 = tr1 - tr4;
+ cr4 = tr1 + tr4;
+ ci2 = ti1 + ti4;
+ ci4 = ti1 - ti4;
+ ch[i - 1 + (k + l1)*ido] = wa1[i - 2]*cr2 - wa1[i - 1]*ci2;
+ ch[i + (k + l1)*ido] = wa1[i - 2]*ci2 + wa1[i - 1]*cr2;
+ ch[i - 1 + (k + 2*l1)*ido] = wa2[i - 2]*cr3 - wa2[i - 1]*ci3;
+ ch[i + (k + 2*l1)*ido] = wa2[i - 2]*ci3 + wa2[i - 1]*cr3;
+ ch[i - 1 + (k + 3*l1)*ido] = wa3[i - 2]*cr4 - wa3[i - 1]*ci4;
+ ch[i + (k + 3*l1)*ido] = wa3[i - 2]*ci4 + wa3[i - 1]*cr4;
+ }
+ }
+ if (ido % 2 == 1) return;
+ }
+ for (k = 0; k < l1; k++) {
+ ti1 = ref(cc,(4*k + 1)*ido) + ref(cc,(4*k + 3)*ido);
+ ti2 = ref(cc,(4*k + 3)*ido) - ref(cc,(4*k + 1)*ido);
+ tr1 = ref(cc,ido-1 + 4*k*ido) - ref(cc,ido-1 + (4*k + 2)*ido);
+ tr2 = ref(cc,ido-1 + 4*k*ido) + ref(cc,ido-1 + (4*k + 2)*ido);
+ ch[ido-1 + k*ido] = tr2 + tr2;
+ ch[ido-1 + (k + l1)*ido] = sqrt2*(tr1 - ti1);
+ ch[ido-1 + (k + 2*l1)*ido] = ti2 + ti2;
+ ch[ido-1 + (k + 3*l1)*ido] = -sqrt2*(tr1 + ti1);
+ }
+ } /* radb4 */
+
+
+static void radf5(int ido, int l1, const Treal cc[], Treal ch[],
+ const Treal wa1[], const Treal wa2[], const Treal wa3[], const Treal wa4[])
+ {
+ static const Treal tr11 = 0.309016994374947;
+ static const Treal ti11 = 0.951056516295154;
+ static const Treal tr12 = -0.809016994374947;
+ static const Treal ti12 = 0.587785252292473;
+ int i, k, ic;
+ Treal ci2, di2, ci4, ci5, di3, di4, di5, ci3, cr2, cr3, dr2, dr3, dr4, dr5,
+ cr5, cr4, ti2, ti3, ti5, ti4, tr2, tr3, tr4, tr5;
+ for (k = 0; k < l1; k++) {
+ cr2 = ref(cc,(k + 4*l1)*ido) + ref(cc,(k + l1)*ido);
+ ci5 = ref(cc,(k + 4*l1)*ido) - ref(cc,(k + l1)*ido);
+ cr3 = ref(cc,(k + 3*l1)*ido) + ref(cc,(k + 2*l1)*ido);
+ ci4 = ref(cc,(k + 3*l1)*ido) - ref(cc,(k + 2*l1)*ido);
+ ch[5*k*ido] = ref(cc,k*ido) + cr2 + cr3;
+ ch[ido-1 + (5*k + 1)*ido] = ref(cc,k*ido) + tr11*cr2 + tr12*cr3;
+ ch[(5*k + 2)*ido] = ti11*ci5 + ti12*ci4;
+ ch[ido-1 + (5*k + 3)*ido] = ref(cc,k*ido) + tr12*cr2 + tr11*cr3;
+ ch[(5*k + 4)*ido] = ti12*ci5 - ti11*ci4;
+ }
+ if (ido == 1) return;
+ for (k = 0; k < l1; ++k) {
+ for (i = 2; i < ido; i += 2) {
+ ic = ido - i;
+ dr2 = wa1[i - 2]*ref(cc,i - 1 + (k + l1)*ido) + wa1[i - 1]*ref(cc,i + (k + l1)*ido);
+ di2 = wa1[i - 2]*ref(cc,i + (k + l1)*ido) - wa1[i - 1]*ref(cc,i - 1 + (k + l1)*ido);
+ dr3 = wa2[i - 2]*ref(cc,i - 1 + (k + 2*l1)*ido) + wa2[i - 1]*ref(cc,i + (k + 2*l1)*ido);
+ di3 = wa2[i - 2]*ref(cc,i + (k + 2*l1)*ido) - wa2[i - 1]*ref(cc,i - 1 + (k + 2*l1)*ido);
+ dr4 = wa3[i - 2]*ref(cc,i - 1 + (k + 3*l1)*ido) + wa3[i - 1]*ref(cc,i + (k + 3*l1)*ido);
+ di4 = wa3[i - 2]*ref(cc,i + (k + 3*l1)*ido) - wa3[i - 1]*ref(cc,i - 1 + (k + 3*l1)*ido);
+ dr5 = wa4[i - 2]*ref(cc,i - 1 + (k + 4*l1)*ido) + wa4[i - 1]*ref(cc,i + (k + 4*l1)*ido);
+ di5 = wa4[i - 2]*ref(cc,i + (k + 4*l1)*ido) - wa4[i - 1]*ref(cc,i - 1 + (k + 4*l1)*ido);
+ cr2 = dr2 + dr5;
+ ci5 = dr5 - dr2;
+ cr5 = di2 - di5;
+ ci2 = di2 + di5;
+ cr3 = dr3 + dr4;
+ ci4 = dr4 - dr3;
+ cr4 = di3 - di4;
+ ci3 = di3 + di4;
+ ch[i - 1 + 5*k*ido] = ref(cc,i - 1 + k*ido) + cr2 + cr3;
+ ch[i + 5*k*ido] = ref(cc,i + k*ido) + ci2 + ci3;
+ tr2 = ref(cc,i - 1 + k*ido) + tr11*cr2 + tr12*cr3;
+ ti2 = ref(cc,i + k*ido) + tr11*ci2 + tr12*ci3;
+ tr3 = ref(cc,i - 1 + k*ido) + tr12*cr2 + tr11*cr3;
+ ti3 = ref(cc,i + k*ido) + tr12*ci2 + tr11*ci3;
+ tr5 = ti11*cr5 + ti12*cr4;
+ ti5 = ti11*ci5 + ti12*ci4;
+ tr4 = ti12*cr5 - ti11*cr4;
+ ti4 = ti12*ci5 - ti11*ci4;
+ ch[i - 1 + (5*k + 2)*ido] = tr2 + tr5;
+ ch[ic - 1 + (5*k + 1)*ido] = tr2 - tr5;
+ ch[i + (5*k + 2)*ido] = ti2 + ti5;
+ ch[ic + (5*k + 1)*ido] = ti5 - ti2;
+ ch[i - 1 + (5*k + 4)*ido] = tr3 + tr4;
+ ch[ic - 1 + (5*k + 3)*ido] = tr3 - tr4;
+ ch[i + (5*k + 4)*ido] = ti3 + ti4;
+ ch[ic + (5*k + 3)*ido] = ti4 - ti3;
+ }
+ }
+ } /* radf5 */
+
+
+static void radb5(int ido, int l1, const Treal cc[], Treal ch[],
+ const Treal wa1[], const Treal wa2[], const Treal wa3[], const Treal wa4[])
+ {
+ static const Treal tr11 = 0.309016994374947;
+ static const Treal ti11 = 0.951056516295154;
+ static const Treal tr12 = -0.809016994374947;
+ static const Treal ti12 = 0.587785252292473;
+ int i, k, ic;
+ Treal ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, ti2, ti3,
+ ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
+ for (k = 0; k < l1; k++) {
+ ti5 = 2*ref(cc,(5*k + 2)*ido);
+ ti4 = 2*ref(cc,(5*k + 4)*ido);
+ tr2 = 2*ref(cc,ido-1 + (5*k + 1)*ido);
+ tr3 = 2*ref(cc,ido-1 + (5*k + 3)*ido);
+ ch[k*ido] = ref(cc,5*k*ido) + tr2 + tr3;
+ cr2 = ref(cc,5*k*ido) + tr11*tr2 + tr12*tr3;
+ cr3 = ref(cc,5*k*ido) + tr12*tr2 + tr11*tr3;
+ ci5 = ti11*ti5 + ti12*ti4;
+ ci4 = ti12*ti5 - ti11*ti4;
+ ch[(k + l1)*ido] = cr2 - ci5;
+ ch[(k + 2*l1)*ido] = cr3 - ci4;
+ ch[(k + 3*l1)*ido] = cr3 + ci4;
+ ch[(k + 4*l1)*ido] = cr2 + ci5;
+ }
+ if (ido == 1) return;
+ for (k = 0; k < l1; ++k) {
+ for (i = 2; i < ido; i += 2) {
+ ic = ido - i;
+ ti5 = ref(cc,i + (5*k + 2)*ido) + ref(cc,ic + (5*k + 1)*ido);
+ ti2 = ref(cc,i + (5*k + 2)*ido) - ref(cc,ic + (5*k + 1)*ido);
+ ti4 = ref(cc,i + (5*k + 4)*ido) + ref(cc,ic + (5*k + 3)*ido);
+ ti3 = ref(cc,i + (5*k + 4)*ido) - ref(cc,ic + (5*k + 3)*ido);
+ tr5 = ref(cc,i - 1 + (5*k + 2)*ido) - ref(cc,ic - 1 + (5*k + 1)*ido);
+ tr2 = ref(cc,i - 1 + (5*k + 2)*ido) + ref(cc,ic - 1 + (5*k + 1)*ido);
+ tr4 = ref(cc,i - 1 + (5*k + 4)*ido) - ref(cc,ic - 1 + (5*k + 3)*ido);
+ tr3 = ref(cc,i - 1 + (5*k + 4)*ido) + ref(cc,ic - 1 + (5*k + 3)*ido);
+ ch[i - 1 + k*ido] = ref(cc,i - 1 + 5*k*ido) + tr2 + tr3;
+ ch[i + k*ido] = ref(cc,i + 5*k*ido) + ti2 + ti3;
+ cr2 = ref(cc,i - 1 + 5*k*ido) + tr11*tr2 + tr12*tr3;
+
+ ci2 = ref(cc,i + 5*k*ido) + tr11*ti2 + tr12*ti3;
+ cr3 = ref(cc,i - 1 + 5*k*ido) + tr12*tr2 + tr11*tr3;
+
+ ci3 = ref(cc,i + 5*k*ido) + tr12*ti2 + tr11*ti3;
+ cr5 = ti11*tr5 + ti12*tr4;
+ ci5 = ti11*ti5 + ti12*ti4;
+ cr4 = ti12*tr5 - ti11*tr4;
+ ci4 = ti12*ti5 - ti11*ti4;
+ dr3 = cr3 - ci4;
+ dr4 = cr3 + ci4;
+ di3 = ci3 + cr4;
+ di4 = ci3 - cr4;
+ dr5 = cr2 + ci5;
+ dr2 = cr2 - ci5;
+ di5 = ci2 - cr5;
+ di2 = ci2 + cr5;
+ ch[i - 1 + (k + l1)*ido] = wa1[i - 2]*dr2 - wa1[i - 1]*di2;
+ ch[i + (k + l1)*ido] = wa1[i - 2]*di2 + wa1[i - 1]*dr2;
+ ch[i - 1 + (k + 2*l1)*ido] = wa2[i - 2]*dr3 - wa2[i - 1]*di3;
+ ch[i + (k + 2*l1)*ido] = wa2[i - 2]*di3 + wa2[i - 1]*dr3;
+ ch[i - 1 + (k + 3*l1)*ido] = wa3[i - 2]*dr4 - wa3[i - 1]*di4;
+ ch[i + (k + 3*l1)*ido] = wa3[i - 2]*di4 + wa3[i - 1]*dr4;
+ ch[i - 1 + (k + 4*l1)*ido] = wa4[i - 2]*dr5 - wa4[i - 1]*di5;
+ ch[i + (k + 4*l1)*ido] = wa4[i - 2]*di5 + wa4[i - 1]*dr5;
+ }
+ }
+ } /* radb5 */
+
+
+static void radfg(int ido, int ip, int l1, int idl1,
+ Treal cc[], Treal ch[], const Treal wa[])
+ {
+ static const Treal twopi = 6.28318530717959;
+ int idij, ipph, i, j, k, l, j2, ic, jc, lc, ik, is, nbd;
+ Treal dc2, ai1, ai2, ar1, ar2, ds2, dcp, arg, dsp, ar1h, ar2h;
+ arg = twopi / ip;
+ dcp = cos(arg);
+ dsp = sin(arg);
+ ipph = (ip + 1) / 2;
+ nbd = (ido - 1) / 2;
+ if (ido != 1) {
+ for (ik=0; ik<idl1; ik++) ch[ik] = cc[ik];
+ for (j=1; j<ip; j++)
+ for (k=0; k<l1; k++)
+ ch[(k + j*l1)*ido] = cc[(k + j*l1)*ido];
+ if (nbd <= l1) {
+ is = -ido;
+ for (j=1; j<ip; j++) {
+ is += ido;
+ idij = is-1;
+ for (i=2; i<ido; i+=2) {
+ idij += 2;
+ for (k=0; k<l1; k++) {
+ ch[i - 1 + (k + j*l1)*ido] =
+ wa[idij - 1]*cc[i - 1 + (k + j*l1)*ido] + wa[idij]*cc[i + (k + j*l1)*ido];
+ ch[i + (k + j*l1)*ido] =
+ wa[idij - 1]*cc[i + (k + j*l1)*ido] - wa[idij]*cc[i - 1 + (k + j*l1)*ido];
+ }
+ }
+ }
+ } else {
+ is = -ido;
+ for (j=1; j<ip; j++) {
+ is += ido;
+ for (k=0; k<l1; k++) {
+ idij = is-1;
+ for (i=2; i<ido; i+=2) {
+ idij += 2;
+ ch[i - 1 + (k + j*l1)*ido] =
+ wa[idij - 1]*cc[i - 1 + (k + j*l1)*ido] + wa[idij]*cc[i + (k + j*l1)*ido];
+ ch[i + (k + j*l1)*ido] =
+ wa[idij - 1]*cc[i + (k + j*l1)*ido] - wa[idij]*cc[i - 1 + (k + j*l1)*ido];
+ }
+ }
+ }
+ }
+ if (nbd >= l1) {
+ for (j=1; j<ipph; j++) {
+ jc = ip - j;
+ for (k=0; k<l1; k++) {
+ for (i=2; i<ido; i+=2) {
+ cc[i - 1 + (k + j*l1)*ido] = ch[i - 1 + (k + j*l1)*ido] + ch[i - 1 + (k + jc*l1)*ido];
+ cc[i - 1 + (k + jc*l1)*ido] = ch[i + (k + j*l1)*ido] - ch[i + (k + jc*l1)*ido];
+ cc[i + (k + j*l1)*ido] = ch[i + (k + j*l1)*ido] + ch[i + (k + jc*l1)*ido];
+ cc[i + (k + jc*l1)*ido] = ch[i - 1 + (k + jc*l1)*ido] - ch[i - 1 + (k + j*l1)*ido];
+ }
+ }
+ }
+ } else {
+ for (j=1; j<ipph; j++) {
+ jc = ip - j;
+ for (i=2; i<ido; i+=2) {
+ for (k=0; k<l1; k++) {
+ cc[i - 1 + (k + j*l1)*ido] =
+ ch[i - 1 + (k + j*l1)*ido] + ch[i - 1 + (k + jc*l1)*ido];
+ cc[i - 1 + (k + jc*l1)*ido] = ch[i + (k + j*l1)*ido] - ch[i + (k + jc*l1)*ido];
+ cc[i + (k + j*l1)*ido] = ch[i + (k + j*l1)*ido] + ch[i + (k + jc*l1)*ido];
+ cc[i + (k + jc*l1)*ido] = ch[i - 1 + (k + jc*l1)*ido] - ch[i - 1 + (k + j*l1)*ido];
+ }
+ }
+ }
+ }
+ } else { /* now ido == 1 */
+ for (ik=0; ik<idl1; ik++) cc[ik] = ch[ik];
+ }
+ for (j=1; j<ipph; j++) {
+ jc = ip - j;
+ for (k=0; k<l1; k++) {
+ cc[(k + j*l1)*ido] = ch[(k + j*l1)*ido] + ch[(k + jc*l1)*ido];
+ cc[(k + jc*l1)*ido] = ch[(k + jc*l1)*ido] - ch[(k + j*l1)*ido];
+ }
+ }
+
+ ar1 = 1;
+ ai1 = 0;
+ for (l=1; l<ipph; l++) {
+ lc = ip - l;
+ ar1h = dcp*ar1 - dsp*ai1;
+ ai1 = dcp*ai1 + dsp*ar1;
+ ar1 = ar1h;
+ for (ik=0; ik<idl1; ik++) {
+ ch[ik + l*idl1] = cc[ik] + ar1*cc[ik + idl1];
+ ch[ik + lc*idl1] = ai1*cc[ik + (ip-1)*idl1];
+ }
+ dc2 = ar1;
+ ds2 = ai1;
+ ar2 = ar1;
+ ai2 = ai1;
+ for (j=2; j<ipph; j++) {
+ jc = ip - j;
+ ar2h = dc2*ar2 - ds2*ai2;
+ ai2 = dc2*ai2 + ds2*ar2;
+ ar2 = ar2h;
+ for (ik=0; ik<idl1; ik++) {
+ ch[ik + l*idl1] += ar2*cc[ik + j*idl1];
+ ch[ik + lc*idl1] += ai2*cc[ik + jc*idl1];
+ }
+ }
+ }
+ for (j=1; j<ipph; j++)
+ for (ik=0; ik<idl1; ik++)
+ ch[ik] += cc[ik + j*idl1];
+
+ if (ido >= l1) {
+ for (k=0; k<l1; k++) {
+ for (i=0; i<ido; i++) {
+ ref(cc,i + k*ip*ido) = ch[i + k*ido];
+ }
+ }
+ } else {
+ for (i=0; i<ido; i++) {
+ for (k=0; k<l1; k++) {
+ ref(cc,i + k*ip*ido) = ch[i + k*ido];
+ }
+ }
+ }
+ for (j=1; j<ipph; j++) {
+ jc = ip - j;
+ j2 = 2*j;
+ for (k=0; k<l1; k++) {
+ ref(cc,ido-1 + (j2 - 1 + k*ip)*ido) =
+ ch[(k + j*l1)*ido];
+ ref(cc,(j2 + k*ip)*ido) =
+ ch[(k + jc*l1)*ido];
+ }
+ }
+ if (ido == 1) return;
+ if (nbd >= l1) {
+ for (j=1; j<ipph; j++) {
+ jc = ip - j;
+ j2 = 2*j;
+ for (k=0; k<l1; k++) {
+ for (i=2; i<ido; i+=2) {
+ ic = ido - i;
+ ref(cc,i - 1 + (j2 + k*ip)*ido) = ch[i - 1 + (k + j*l1)*ido] + ch[i - 1 + (k + jc*l1)*ido];
+ ref(cc,ic - 1 + (j2 - 1 + k*ip)*ido) = ch[i - 1 + (k + j*l1)*ido] - ch[i - 1 + (k + jc*l1)*ido];
+ ref(cc,i + (j2 + k*ip)*ido) = ch[i + (k + j*l1)*ido] + ch[i + (k + jc*l1)*ido];
+ ref(cc,ic + (j2 - 1 + k*ip)*ido) = ch[i + (k + jc*l1)*ido] - ch[i + (k + j*l1)*ido];
+ }
+ }
+ }
+ } else {
+ for (j=1; j<ipph; j++) {
+ jc = ip - j;
+ j2 = 2*j;
+ for (i=2; i<ido; i+=2) {
+ ic = ido - i;
+ for (k=0; k<l1; k++) {
+ ref(cc,i - 1 + (j2 + k*ip)*ido) = ch[i - 1 + (k + j*l1)*ido] + ch[i - 1 + (k + jc*l1)*ido];
+ ref(cc,ic - 1 + (j2 - 1 + k*ip)*ido) = ch[i - 1 + (k + j*l1)*ido] - ch[i - 1 + (k + jc*l1)*ido];
+ ref(cc,i + (j2 + k*ip)*ido) = ch[i + (k + j*l1)*ido] + ch[i + (k + jc*l1)*ido];
+ ref(cc,ic + (j2 - 1 + k*ip)*ido) = ch[i + (k + jc*l1)*ido] - ch[i + (k + j*l1)*ido];
+ }
+ }
+ }
+ }
+ } /* radfg */
+
+
+static void radbg(int ido, int ip, int l1, int idl1,
+ Treal cc[], Treal ch[], const Treal wa[])
+ {
+ static const Treal twopi = 6.28318530717959;
+ int idij, ipph, i, j, k, l, j2, ic, jc, lc, ik, is;
+ Treal dc2, ai1, ai2, ar1, ar2, ds2;
+ int nbd;
+ Treal dcp, arg, dsp, ar1h, ar2h;
+ arg = twopi / ip;
+ dcp = cos(arg);
+ dsp = sin(arg);
+ nbd = (ido - 1) / 2;
+ ipph = (ip + 1) / 2;
+ if (ido >= l1) {
+ for (k=0; k<l1; k++) {
+ for (i=0; i<ido; i++) {
+ ch[i + k*ido] = ref(cc,i + k*ip*ido);
+ }
+ }
+ } else {
+ for (i=0; i<ido; i++) {
+ for (k=0; k<l1; k++) {
+ ch[i + k*ido] = ref(cc,i + k*ip*ido);
+ }
+ }
+ }
+ for (j=1; j<ipph; j++) {
+ jc = ip - j;
+ j2 = 2*j;
+ for (k=0; k<l1; k++) {
+ ch[(k + j*l1)*ido] = ref(cc,ido-1 + (j2 - 1 + k*ip)*ido) + ref(cc,ido-1 + (j2 - 1 + k*ip)*
+ ido);
+ ch[(k + jc*l1)*ido] = ref(cc,(j2 + k*ip)*ido) + ref(cc,(j2 + k*ip)*ido);
+ }
+ }
+
+ if (ido != 1) {
+ if (nbd >= l1) {
+ for (j=1; j<ipph; j++) {
+ jc = ip - j;
+ for (k=0; k<l1; k++) {
+ for (i=2; i<ido; i+=2) {
+ ic = ido - i;
+ ch[i - 1 + (k + j*l1)*ido] = ref(cc,i - 1 + (2*j + k*ip)*ido) + ref(cc,
+ ic - 1 + (2*j - 1 + k*ip)*ido);
+ ch[i - 1 + (k + jc*l1)*ido] = ref(cc,i - 1 + (2*j + k*ip)*ido) -
+ ref(cc,ic - 1 + (2*j - 1 + k*ip)*ido);
+ ch[i + (k + j*l1)*ido] = ref(cc,i + (2*j + k*ip)*ido) - ref(cc,ic
+ + (2*j - 1 + k*ip)*ido);
+ ch[i + (k + jc*l1)*ido] = ref(cc,i + (2*j + k*ip)*ido) + ref(cc,ic
+ + (2*j - 1 + k*ip)*ido);
+ }
+ }
+ }
+ } else {
+ for (j=1; j<ipph; j++) {
+ jc = ip - j;
+ for (i=2; i<ido; i+=2) {
+ ic = ido - i;
+ for (k=0; k<l1; k++) {
+ ch[i - 1 + (k + j*l1)*ido] = ref(cc,i - 1 + (2*j + k*ip)*ido) + ref(cc,
+ ic - 1 + (2*j - 1 + k*ip)*ido);
+ ch[i - 1 + (k + jc*l1)*ido] = ref(cc,i - 1 + (2*j + k*ip)*ido) -
+ ref(cc,ic - 1 + (2*j - 1 + k*ip)*ido);
+ ch[i + (k + j*l1)*ido] = ref(cc,i + (2*j + k*ip)*ido) - ref(cc,ic
+ + (2*j - 1 + k*ip)*ido);
+ ch[i + (k + jc*l1)*ido] = ref(cc,i + (2*j + k*ip)*ido) + ref(cc,ic
+ + (2*j - 1 + k*ip)*ido);
+ }
+ }
+ }
+ }
+ }
+
+ ar1 = 1;
+ ai1 = 0;
+ for (l=1; l<ipph; l++) {
+ lc = ip - l;
+ ar1h = dcp*ar1 - dsp*ai1;
+ ai1 = dcp*ai1 + dsp*ar1;
+ ar1 = ar1h;
+ for (ik=0; ik<idl1; ik++) {
+ cc[ik + l*idl1] = ch[ik] + ar1*ch[ik + idl1];
+ cc[ik + lc*idl1] = ai1*ch[ik + (ip-1)*idl1];
+ }
+ dc2 = ar1;
+ ds2 = ai1;
+ ar2 = ar1;
+ ai2 = ai1;
+ for (j=2; j<ipph; j++) {
+ jc = ip - j;
+ ar2h = dc2*ar2 - ds2*ai2;
+ ai2 = dc2*ai2 + ds2*ar2;
+ ar2 = ar2h;
+ for (ik=0; ik<idl1; ik++) {
+ cc[ik + l*idl1] += ar2*ch[ik + j*idl1];
+ cc[ik + lc*idl1] += ai2*ch[ik + jc*idl1];
+ }
+ }
+ }
+ for (j=1; j<ipph; j++) {
+ for (ik=0; ik<idl1; ik++) {
+ ch[ik] += ch[ik + j*idl1];
+ }
+ }
+ for (j=1; j<ipph; j++) {
+ jc = ip - j;
+ for (k=0; k<l1; k++) {
+ ch[(k + j*l1)*ido] = cc[(k + j*l1)*ido] - cc[(k + jc*l1)*ido];
+ ch[(k + jc*l1)*ido] = cc[(k + j*l1)*ido] + cc[(k + jc*l1)*ido];
+ }
+ }
+
+ if (ido == 1) return;
+ if (nbd >= l1) {
+ for (j=1; j<ipph; j++) {
+ jc = ip - j;
+ for (k=0; k<l1; k++) {
+ for (i=2; i<ido; i+=2) {
+ ch[i - 1 + (k + j*l1)*ido] = cc[i - 1 + (k + j*l1)*ido] - cc[i + (k + jc*l1)*ido];
+ ch[i - 1 + (k + jc*l1)*ido] = cc[i - 1 + (k + j*l1)*ido] + cc[i + (k + jc*l1)*ido];
+ ch[i + (k + j*l1)*ido] = cc[i + (k + j*l1)*ido] + cc[i - 1 + (k + jc*l1)*ido];
+ ch[i + (k + jc*l1)*ido] = cc[i + (k + j*l1)*ido] - cc[i - 1 + (k + jc*l1)*ido];
+ }
+ }
+ }
+ } else {
+ for (j=1; j<ipph; j++) {
+ jc = ip - j;
+ for (i=2; i<ido; i+=2) {
+ for (k=0; k<l1; k++) {
+ ch[i - 1 + (k + j*l1)*ido] = cc[i - 1 + (k + j*l1)*ido] - cc[i + (k + jc*l1)*ido];
+ ch[i - 1 + (k + jc*l1)*ido] = cc[i - 1 + (k + j *l1)*ido] + cc[i + (k + jc*l1)*ido];
+ ch[i + (k + j*l1)*ido] = cc[i + (k + j*l1)*ido] + cc[i - 1 + (k + jc*l1)*ido];
+ ch[i + (k + jc*l1)*ido] = cc[i + (k + j*l1)*ido] - cc[i - 1 + (k + jc*l1)*ido];
+ }
+ }
+ }
+ }
+ for (ik=0; ik<idl1; ik++) cc[ik] = ch[ik];
+ for (j=1; j<ip; j++)
+ for (k=0; k<l1; k++)
+ cc[(k + j*l1)*ido] = ch[(k + j*l1)*ido];
+ if (nbd <= l1) {
+ is = -ido;
+ for (j=1; j<ip; j++) {
+ is += ido;
+ idij = is-1;
+ for (i=2; i<ido; i+=2) {
+ idij += 2;
+ for (k=0; k<l1; k++) {
+ cc[i - 1 + (k + j*l1)*ido] = wa[idij - 1]*ch[i - 1 + (k + j*l1)*ido] - wa[idij]*
+ ch[i + (k + j*l1)*ido];
+ cc[i + (k + j*l1)*ido] = wa[idij - 1]*ch[i + (k + j*l1)*ido] + wa[idij]*ch[i - 1 + (k + j*l1)*ido];
+ }
+ }
+ }
+ } else {
+ is = -ido;
+ for (j=1; j<ip; j++) {
+ is += ido;
+ for (k=0; k<l1; k++) {
+ idij = is - 1;
+ for (i=2; i<ido; i+=2) {
+ idij += 2;
+ cc[i - 1 + (k + j*l1)*ido] = wa[idij-1]*ch[i - 1 + (k + j*l1)*ido] - wa[idij]*
+ ch[i + (k + j*l1)*ido];
+ cc[i + (k + j*l1)*ido] = wa[idij-1]*ch[i + (k + j*l1)*ido] + wa[idij]*ch[i - 1 + (k + j*l1)*ido];
+ }
+ }
+ }
+ }
+ } /* radbg */
+
+ /* ----------------------------------------------------------------------
+cfftf1, cfftf, cfftb, cffti1, cffti. Complex FFTs.
+---------------------------------------------------------------------- */
+
+static void cfftf1(int n, Treal c[], Treal ch[], const Treal wa[], const int ifac[MAXFAC+2], int isign)
+ {
+ int idot, i;
+ int k1, l1, l2;
+ int na, nf, ip, iw, ix2, ix3, ix4, nac, ido, idl1;
+ Treal *cinput, *coutput;
+ nf = ifac[1];
+ na = 0;
+ l1 = 1;
+ iw = 0;
+ for (k1=2; k1<=nf+1; k1++) {
+ ip = ifac[k1];
+ l2 = ip*l1;
+ ido = n / l2;
+ idot = ido + ido;
+ idl1 = idot*l1;
+ if (na) {
+ cinput = ch;
+ coutput = c;
+ } else {
+ cinput = c;
+ coutput = ch;
+ }
+ switch (ip) {
+ case 4:
+ ix2 = iw + idot;
+ ix3 = ix2 + idot;
+ passf4(idot, l1, cinput, coutput, &wa[iw], &wa[ix2], &wa[ix3], isign);
+ na = !na;
+ break;
+ case 2:
+ passf2(idot, l1, cinput, coutput, &wa[iw], isign);
+ na = !na;
+ break;
+ case 3:
+ ix2 = iw + idot;
+ passf3(idot, l1, cinput, coutput, &wa[iw], &wa[ix2], isign);
+ na = !na;
+ break;
+ case 5:
+ ix2 = iw + idot;
+ ix3 = ix2 + idot;
+ ix4 = ix3 + idot;
+ passf5(idot, l1, cinput, coutput, &wa[iw], &wa[ix2], &wa[ix3], &wa[ix4], isign);
+ na = !na;
+ break;
+ default:
+ passf(&nac, idot, ip, l1, idl1, cinput, coutput, &wa[iw], isign);
+ if (nac != 0) na = !na;
+ }
+ l1 = l2;
+ iw += (ip - 1)*idot;
+ }
+ if (na == 0) return;
+ for (i=0; i<2*n; i++) c[i] = ch[i];
+ } /* cfftf1 */
+
+
+void cfftf(int n, Treal c[], Treal wsave[])
+ {
+ int iw1, iw2;
+ if (n == 1) return;
+ iw1 = 2*n;
+ iw2 = iw1 + 2*n;
+ cfftf1(n, c, wsave, wsave+iw1, (int*)(wsave+iw2), -1);
+ } /* cfftf */
+
+
+void cfftb(int n, Treal c[], Treal wsave[])
+ {
+ int iw1, iw2;
+ if (n == 1) return;
+ iw1 = 2*n;
+ iw2 = iw1 + 2*n;
+ cfftf1(n, c, wsave, wsave+iw1, (int*)(wsave+iw2), +1);
+ } /* cfftb */
+
+
+static void factorize(int n, int ifac[MAXFAC+2], const int ntryh[NSPECIAL])
+ /* Factorize n in factors in ntryh and rest. On exit,
+ifac[0] contains n and ifac[1] contains number of factors,
+the factors start from ifac[2]. */
+ {
+ int ntry=3, i, j=0, ib, nf=0, nl=n, nq, nr;
+startloop:
+ if (j < NSPECIAL)
+ ntry = ntryh[j];
+ else
+ ntry+= 2;
+ j++;
+ do {
+ nq = nl / ntry;
+ nr = nl - ntry*nq;
+ if (nr != 0) goto startloop;
+ nf++;
+ ifac[nf + 1] = ntry;
+ nl = nq;
+ if (ntry == 2 && nf != 1) {
+ for (i=2; i<=nf; i++) {
+ ib = nf - i + 2;
+ ifac[ib + 1] = ifac[ib];
+ }
+ ifac[2] = 2;
+ }
+ } while (nl != 1);
+ ifac[0] = n;
+ ifac[1] = nf;
+ }
+
+
+static void cffti1(int n, Treal wa[], int ifac[MAXFAC+2])
+ {
+ static const Treal twopi = 6.28318530717959;
+ Treal arg, argh, argld, fi;
+ int idot, i, j;
+ int i1, k1, l1, l2;
+ int ld, ii, nf, ip;
+ int ido, ipm;
+
+ static const int ntryh[NSPECIAL] = {
+ 3,4,2,5 }; /* Do not change the order of these. */
+
+ factorize(n,ifac,ntryh);
+ nf = ifac[1];
+ argh = twopi/(Treal)n;
+ i = 1;
+ l1 = 1;
+ for (k1=1; k1<=nf; k1++) {
+ ip = ifac[k1+1];
+ ld = 0;
+ l2 = l1*ip;
+ ido = n / l2;
+ idot = ido + ido + 2;
+ ipm = ip - 1;
+ for (j=1; j<=ipm; j++) {
+ i1 = i;
+ wa[i-1] = 1;
+ wa[i] = 0;
+ ld += l1;
+ fi = 0;
+ argld = ld*argh;
+ for (ii=4; ii<=idot; ii+=2) {
+ i+= 2;
+ fi+= 1;
+ arg = fi*argld;
+ wa[i-1] = cos(arg);
+ wa[i] = sin(arg);
+ }
+ if (ip > 5) {
+ wa[i1-1] = wa[i-1];
+ wa[i1] = wa[i];
+ }
+ }
+ l1 = l2;
+ }
+ } /* cffti1 */
+
+
+void cffti(int n, Treal wsave[])
+ {
+ int iw1, iw2;
+ if (n == 1) return;
+ iw1 = 2*n;
+ iw2 = iw1 + 2*n;
+ cffti1(n, wsave+iw1, (int*)(wsave+iw2));
+ } /* cffti */
+
+ /* ----------------------------------------------------------------------
+rfftf1, rfftb1, rfftf, rfftb, rffti1, rffti. Treal FFTs.
+---------------------------------------------------------------------- */
+
+static void rfftf1(int n, Treal c[], Treal ch[], const Treal wa[], const int ifac[MAXFAC+2])
+ {
+ int i;
+ int k1, l1, l2, na, kh, nf, ip, iw, ix2, ix3, ix4, ido, idl1;
+ Treal *cinput, *coutput;
+ nf = ifac[1];
+ na = 1;
+ l2 = n;
+ iw = n-1;
+ for (k1 = 1; k1 <= nf; ++k1) {
+ kh = nf - k1;
+ ip = ifac[kh + 2];
+ l1 = l2 / ip;
+ ido = n / l2;
+ idl1 = ido*l1;
+ iw -= (ip - 1)*ido;
+ na = !na;
+ if (na) {
+ cinput = ch;
+ coutput = c;
+ } else {
+ cinput = c;
+ coutput = ch;
+ }
+ switch (ip) {
+ case 4:
+ ix2 = iw + ido;
+ ix3 = ix2 + ido;
+ radf4(ido, l1, cinput, coutput, &wa[iw], &wa[ix2], &wa[ix3]);
+ break;
+ case 2:
+ radf2(ido, l1, cinput, coutput, &wa[iw]);
+ break;
+ case 3:
+ ix2 = iw + ido;
+ radf3(ido, l1, cinput, coutput, &wa[iw], &wa[ix2]);
+ break;
+ case 5:
+ ix2 = iw + ido;
+ ix3 = ix2 + ido;
+ ix4 = ix3 + ido;
+ radf5(ido, l1, cinput, coutput, &wa[iw], &wa[ix2], &wa[ix3], &wa[ix4]);
+ break;
+ default:
+ if (ido == 1)
+ na = !na;
+ if (na == 0) {
+ radfg(ido, ip, l1, idl1, c, ch, &wa[iw]);
+ na = 1;
+ } else {
+ radfg(ido, ip, l1, idl1, ch, c, &wa[iw]);
+ na = 0;
+ }
+ }
+ l2 = l1;
+ }
+ if (na == 1) return;
+ for (i = 0; i < n; i++) c[i] = ch[i];
+ } /* rfftf1 */
+
+
+void rfftb1(int n, Treal c[], Treal ch[], const Treal wa[], const int ifac[MAXFAC+2])
+ {
+ int i;
+ int k1, l1, l2, na, nf, ip, iw, ix2, ix3, ix4, ido, idl1;
+ Treal *cinput, *coutput;
+ nf = ifac[1];
+ na = 0;
+ l1 = 1;
+ iw = 0;
+ for (k1=1; k1<=nf; k1++) {
+ ip = ifac[k1 + 1];
+ l2 = ip*l1;
+ ido = n / l2;
+ idl1 = ido*l1;
+ if (na) {
+ cinput = ch;
+ coutput = c;
+ } else {
+ cinput = c;
+ coutput = ch;
+ }
+ switch (ip) {
+ case 4:
+ ix2 = iw + ido;
+ ix3 = ix2 + ido;
+ radb4(ido, l1, cinput, coutput, &wa[iw], &wa[ix2], &wa[ix3]);
+ na = !na;
+ break;
+ case 2:
+ radb2(ido, l1, cinput, coutput, &wa[iw]);
+ na = !na;
+ break;
+ case 3:
+ ix2 = iw + ido;
+ radb3(ido, l1, cinput, coutput, &wa[iw], &wa[ix2]);
+ na = !na;
+ break;
+ case 5:
+ ix2 = iw + ido;
+ ix3 = ix2 + ido;
+ ix4 = ix3 + ido;
+ radb5(ido, l1, cinput, coutput, &wa[iw], &wa[ix2], &wa[ix3], &wa[ix4]);
+ na = !na;
+ break;
+ default:
+ radbg(ido, ip, l1, idl1, cinput, coutput, &wa[iw]);
+ if (ido == 1) na = !na;
+ }
+ l1 = l2;
+ iw += (ip - 1)*ido;
+ }
+ if (na == 0) return;
+ for (i=0; i<n; i++) c[i] = ch[i];
+ } /* rfftb1 */
+
+
+void rfftf(int n, Treal r[], Treal wsave[])
+ {
+ if (n == 1) return;
+ rfftf1(n, r, wsave, wsave+n, (int*)(wsave+2*n));
+ } /* rfftf */
+
+
+void rfftb(int n, Treal r[], Treal wsave[])
+ {
+ if (n == 1) return;
+ rfftb1(n, r, wsave, wsave+n, (int*)(wsave+2*n));
+ } /* rfftb */
+
+
+static void rffti1(int n, Treal wa[], int ifac[MAXFAC+2])
+ {
+ static const Treal twopi = 6.28318530717959;
+ Treal arg, argh, argld, fi;
+ int i, j;
+ int k1, l1, l2;
+ int ld, ii, nf, ip, is;
+ int ido, ipm, nfm1;
+ static const int ntryh[NSPECIAL] = {
+ 4,2,3,5 }; /* Do not change the order of these. */
+ factorize(n,ifac,ntryh);
+ nf = ifac[1];
+ argh = twopi / n;
+ is = 0;
+ nfm1 = nf - 1;
+ l1 = 1;
+ if (nfm1 == 0) return;
+ for (k1 = 1; k1 <= nfm1; k1++) {
+ ip = ifac[k1 + 1];
+ ld = 0;
+ l2 = l1*ip;
+ ido = n / l2;
+ ipm = ip - 1;
+ for (j = 1; j <= ipm; ++j) {
+ ld += l1;
+ i = is;
+ argld = (Treal) ld*argh;
+ fi = 0;
+ for (ii = 3; ii <= ido; ii += 2) {
+ i += 2;
+ fi += 1;
+ arg = fi*argld;
+ wa[i - 2] = cos(arg);
+ wa[i - 1] = sin(arg);
+ }
+ is += ido;
+ }
+ l1 = l2;
+ }
+ } /* rffti1 */
+
+
+void rffti(int n, Treal wsave[])
+ {
+ if (n == 1) return;
+ rffti1(n, wsave+n, (int*)(wsave+2*n));
+ } /* rffti */
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/numpy/fft/fftpack.h b/numpy/fft/fftpack.h
new file mode 100644
index 000000000..d134784a2
--- /dev/null
+++ b/numpy/fft/fftpack.h
@@ -0,0 +1,28 @@
+/*
+ * This file is part of tela the Tensor Language.
+ * Copyright (c) 1994-1995 Pekka Janhunen
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define DOUBLE
+
+#ifdef DOUBLE
+#define Treal double
+#else
+#define Treal float
+#endif
+
+extern void cfftf(int N, Treal data[], const Treal wrk[]);
+extern void cfftb(int N, Treal data[], const Treal wrk[]);
+extern void cffti(int N, Treal wrk[]);
+
+extern void rfftf(int N, Treal data[], const Treal wrk[]);
+extern void rfftb(int N, Treal data[], const Treal wrk[]);
+extern void rffti(int N, Treal wrk[]);
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/numpy/fft/fftpack.py b/numpy/fft/fftpack.py
new file mode 100644
index 000000000..7918ea3e5
--- /dev/null
+++ b/numpy/fft/fftpack.py
@@ -0,0 +1,326 @@
+"""
+Discrete Fourier Transforms - FFT.py
+
+The underlying code for these functions is an f2c translated and modified
+version of the FFTPACK routines.
+
+fft(a, n=None, axis=-1)
+ifft(a, n=None, axis=-1)
+rfft(a, n=None, axis=-1)
+irfft(a, n=None, axis=-1)
+hfft(a, n=None, axis=-1)
+ihfft(a, n=None, axis=-1)
+fftn(a, s=None, axes=None)
+ifftn(a, s=None, axes=None)
+rfftn(a, s=None, axes=None)
+irfftn(a, s=None, axes=None)
+fft2(a, s=None, axes=(-2,-1))
+ifft2(a, s=None, axes=(-2, -1))
+rfft2(a, s=None, axes=(-2,-1))
+irfft2(a, s=None, axes=(-2, -1))
+"""
+__all__ = ['fft','ifft', 'rfft', 'irfft', 'hfft', 'ihfft', 'rfftn',
+ 'irfftn', 'rfft2', 'irfft2', 'fft2', 'ifft2', 'fftn', 'ifftn',
+ 'refft', 'irefft','refftn','irefftn', 'refft2', 'irefft2']
+
+from numpy.core import asarray, zeros, swapaxes, shape, conjugate, \
+ take
+import fftpack_lite as fftpack
+from helper import *
+
+_fft_cache = {}
+_real_fft_cache = {}
+
+def _raw_fft(a, n=None, axis=-1, init_function=fftpack.cffti,
+ work_function=fftpack.cfftf, fft_cache = _fft_cache ):
+ a = asarray(a)
+
+ if n == None: n = a.shape[axis]
+
+ if n < 1: raise ValueError("Invalid number of FFT data points (%d) specified." % n)
+
+ try:
+ wsave = fft_cache[n]
+ except(KeyError):
+ wsave = init_function(n)
+ fft_cache[n] = wsave
+
+ if a.shape[axis] != n:
+ s = list(a.shape)
+ if s[axis] > n:
+ index = [slice(None)]*len(s)
+ index[axis] = slice(0,n)
+ a = a[index]
+ else:
+ index = [slice(None)]*len(s)
+ index[axis] = slice(0,s[axis])
+ s[axis] = n
+ z = zeros(s, a.dtype.char)
+ z[index] = a
+ a = z
+
+ if axis != -1:
+ a = swapaxes(a, axis, -1)
+ r = work_function(a, wsave)
+ if axis != -1:
+ r = swapaxes(r, axis, -1)
+ return r
+
+
+def fft(a, n=None, axis=-1):
+ """fft(a, n=None, axis=-1)
+
+ Return the n point discrete Fourier transform of a. n defaults to
+ the length of a. If n is larger than the length of a, then a will
+ be zero-padded to make up the difference. If n is smaller than
+ the length of a, only the first n items in a will be used.
+
+ The packing of the result is "standard": If A = fft(a, n), then A[0]
+ contains the zero-frequency term, A[1:n/2+1] contains the
+ positive-frequency terms, and A[n/2+1:] contains the negative-frequency
+ terms, in order of decreasingly negative frequency. So for an 8-point
+ transform, the frequencies of the result are [ 0, 1, 2, 3, 4, -3, -2, -1].
+
+ This is most efficient for n a power of two. This also stores a cache of
+ working memory for different sizes of fft's, so you could theoretically
+ run into memory problems if you call this too many times with too many
+ different n's."""
+
+ return _raw_fft(a, n, axis, fftpack.cffti, fftpack.cfftf, _fft_cache)
+
+
+def ifft(a, n=None, axis=-1):
+ """ifft(a, n=None, axis=-1)
+
+ Return the n point inverse discrete Fourier transform of a. n
+ defaults to the length of a. If n is larger than the length of a,
+ then a will be zero-padded to make up the difference. If n is
+ smaller than the length of a, then a will be truncated to reduce
+ its size.
+
+ The input array is expected to be packed the same way as the output of
+ fft, as discussed in it's documentation.
+
+ This is the inverse of fft: ifft(fft(a)) == a within numerical
+ accuracy.
+
+ This is most efficient for n a power of two. This also stores a cache of
+ working memory for different sizes of fft's, so you could theoretically
+ run into memory problems if you call this too many times with too many
+ different n's."""
+
+ a = asarray(a).astype(complex)
+ if n == None:
+ n = shape(a)[axis]
+ return _raw_fft(a, n, axis, fftpack.cffti, fftpack.cfftb, _fft_cache) / n
+
+
+def rfft(a, n=None, axis=-1):
+ """rfft(a, n=None, axis=-1)
+
+ Return the n point discrete Fourier transform of the real valued
+ array a. n defaults to the length of a. n is the length of the
+ input, not the output.
+
+ The returned array will be the nonnegative frequency terms of the
+ Hermite-symmetric, complex transform of the real array. So for an 8-point
+ transform, the frequencies in the result are [ 0, 1, 2, 3, 4]. The first
+ term will be real, as will the last if n is even. The negative frequency
+ terms are not needed because they are the complex conjugates of the
+ positive frequency terms. (This is what I mean when I say
+ Hermite-symmetric.)
+
+ This is most efficient for n a power of two."""
+
+ a = asarray(a).astype(float)
+ return _raw_fft(a, n, axis, fftpack.rffti, fftpack.rfftf, _real_fft_cache)
+
+
+def irfft(a, n=None, axis=-1):
+ """irfft(a, n=None, axis=-1)
+
+ Return the real valued n point inverse discrete Fourier transform
+ of a, where a contains the nonnegative frequency terms of a
+ Hermite-symmetric sequence. n is the length of the result, not the
+ input. If n is not supplied, the default is 2*(len(a)-1). If you
+ want the length of the result to be odd, you have to say so.
+
+ If you specify an n such that a must be zero-padded or truncated, the
+ extra/removed values will be added/removed at high frequencies. One can
+ thus resample a series to m points via Fourier interpolation by: a_resamp
+ = irfft(rfft(a), m).
+
+ This is the inverse of rfft:
+ irfft(rfft(a), len(a)) == a
+ within numerical accuracy."""
+
+ a = asarray(a).astype(complex)
+ if n == None:
+ n = (shape(a)[axis] - 1) * 2
+ return _raw_fft(a, n, axis, fftpack.rffti, fftpack.rfftb,
+ _real_fft_cache) / n
+
+
+def hfft(a, n=None, axis=-1):
+ """hfft(a, n=None, axis=-1)
+ ihfft(a, n=None, axis=-1)
+
+ These are a pair analogous to rfft/irfft, but for the
+ opposite case: here the signal is real in the frequency domain and has
+ Hermite symmetry in the time domain. So here it's hermite_fft for which
+ you must supply the length of the result if it is to be odd.
+
+ ihfft(hfft(a), len(a)) == a
+ within numerical accuracy."""
+
+ a = asarray(a).astype(complex)
+ if n == None:
+ n = (shape(a)[axis] - 1) * 2
+ return irfft(conjugate(a), n, axis) * n
+
+
+def ihfft(a, n=None, axis=-1):
+ """hfft(a, n=None, axis=-1)
+ ihfft(a, n=None, axis=-1)
+
+ These are a pair analogous to rfft/irfft, but for the
+ opposite case: here the signal is real in the frequency domain and has
+ Hermite symmetry in the time domain. So here it's hfft for which
+ you must supply the length of the result if it is to be odd.
+
+ ihfft(hfft(a), len(a)) == a
+ within numerical accuracy."""
+
+ a = asarray(a).astype(float)
+ if n == None:
+ n = shape(a)[axis]
+ return conjugate(rfft(a, n, axis))/n
+
+
+def _cook_nd_args(a, s=None, axes=None, invreal=0):
+ if s is None:
+ shapeless = 1
+ if axes == None:
+ s = list(a.shape)
+ else:
+ s = take(a.shape, axes)
+ else:
+ shapeless = 0
+ s = list(s)
+ if axes == None:
+ axes = range(-len(s), 0)
+ if len(s) != len(axes):
+ raise ValueError, "Shape and axes have different lengths."
+ if invreal and shapeless:
+ s[axes[-1]] = (s[axes[-1]] - 1) * 2
+ return s, axes
+
+
+def _raw_fftnd(a, s=None, axes=None, function=fft):
+ a = asarray(a)
+ s, axes = _cook_nd_args(a, s, axes)
+ itl = range(len(axes))
+ itl.reverse()
+ for ii in itl:
+ a = function(a, n=s[ii], axis=axes[ii])
+ return a
+
+
+def fftn(a, s=None, axes=None):
+ """fftn(a, s=None, axes=None)
+
+ The n-dimensional fft of a. s is a sequence giving the shape of the input
+ an result along the transformed axes, as n for fft. Results are packed
+ analogously to fft: the term for zero frequency in all axes is in the
+ low-order corner, while the term for the Nyquist frequency in all axes is
+ in the middle.
+
+ If neither s nor axes is specified, the transform is taken along all
+ axes. If s is specified and axes is not, the last len(s) axes are used.
+ If axes are specified and s is not, the input shape along the specified
+ axes is used. If s and axes are both specified and are not the same
+ length, an exception is raised."""
+
+ return _raw_fftnd(a,s,axes,fft)
+
+def ifftn(a, s=None, axes=None):
+ """ifftn(a, s=None, axes=None)
+
+ The inverse of fftn."""
+
+ return _raw_fftnd(a, s, axes, ifft)
+
+
+def fft2(a, s=None, axes=(-2,-1)):
+ """fft2(a, s=None, axes=(-2,-1))
+
+ The 2d fft of a. This is really just fftn with different default
+ behavior."""
+
+ return _raw_fftnd(a,s,axes,fft)
+
+
+def ifft2(a, s=None, axes=(-2,-1)):
+ """ifft2(a, s=None, axes=(-2, -1))
+
+ The inverse of fft2d. This is really just ifftn with different
+ default behavior."""
+
+ return _raw_fftnd(a, s, axes, ifft)
+
+
+def rfftn(a, s=None, axes=None):
+ """rfftn(a, s=None, axes=None)
+
+ The n-dimensional discrete Fourier transform of a real array a. A real
+ transform as rfft is performed along the axis specified by the last
+ element of axes, then complex transforms as fft are performed along the
+ other axes."""
+
+ a = asarray(a).astype(float)
+ s, axes = _cook_nd_args(a, s, axes)
+ a = rfft(a, s[-1], axes[-1])
+ for ii in range(len(axes)-1):
+ a = fft(a, s[ii], axes[ii])
+ return a
+
+def rfft2(a, s=None, axes=(-2,-1)):
+ """rfft2(a, s=None, axes=(-2,-1))
+
+ The 2d fft of the real valued array a. This is really just rfftn with
+ different default behavior."""
+
+ return rfftn(a, s, axes)
+
+def irfftn(a, s=None, axes=None):
+ """irfftn(a, s=None, axes=None)
+
+ The inverse of rfftn. The transform implemented in ifft is
+ applied along all axes but the last, then the transform implemented in
+ irfft is performed along the last axis. As with
+ irfft, the length of the result along that axis must be
+ specified if it is to be odd."""
+
+ a = asarray(a).astype(complex)
+ s, axes = _cook_nd_args(a, s, axes, invreal=1)
+ for ii in range(len(axes)-1):
+ a = ifft(a, s[ii], axes[ii])
+ a = irfft(a, s[-1], axes[-1])
+ return a
+
+def irfft2(a, s=None, axes=(-2,-1)):
+ """irfft2(a, s=None, axes=(-2, -1))
+
+ The inverse of rfft2. This is really just irfftn with
+ different default behavior."""
+
+ return irfftn(a, s, axes)
+
+# Deprecated names
+from numpy import deprecate
+refft = deprecate(rfft, 'refft', 'rfft')
+irefft = deprecate(irfft, 'irefft', 'irfft')
+refft2 = deprecate(rfft2, 'refft2', 'rfft2')
+irefft2 = deprecate(irfft2, 'irefft2', 'irfft2')
+refftn = deprecate(rfftn, 'refftn', 'rfftn')
+irefftn = deprecate(irfftn, 'irefftn', 'irfftn')
diff --git a/numpy/fft/fftpack_litemodule.c b/numpy/fft/fftpack_litemodule.c
new file mode 100644
index 000000000..4abfe84d3
--- /dev/null
+++ b/numpy/fft/fftpack_litemodule.c
@@ -0,0 +1,275 @@
+#include "fftpack.h"
+#include "Python.h"
+#include "numpy/arrayobject.h"
+
+static PyObject *ErrorObject;
+
+/* ----------------------------------------------------- */
+
+static char fftpack_cfftf__doc__[] ="";
+
+PyObject *
+fftpack_cfftf(PyObject *self, PyObject *args)
+{
+ PyObject *op1, *op2;
+ PyArrayObject *data;
+ double *wsave, *dptr;
+ int npts, nsave, nrepeats, i;
+
+ if(!PyArg_ParseTuple(args, "OO", &op1, &op2)) return NULL;
+ data = (PyArrayObject *)PyArray_CopyFromObject(op1, PyArray_CDOUBLE, 1, 0);
+ if (data == NULL) return NULL;
+ if (PyArray_As1D(&op2, (char **)&wsave, &nsave, PyArray_DOUBLE) == -1)
+ goto fail;
+ if (data == NULL) goto fail;
+
+ npts = data->dimensions[data->nd-1];
+ if (nsave != npts*4+15) {
+ PyErr_SetString(ErrorObject, "invalid work array for fft size");
+ goto fail;
+ }
+
+ nrepeats = PyArray_SIZE(data)/npts;
+ dptr = (double *)data->data;
+ NPY_SIGINT_ON
+ for (i=0; i<nrepeats; i++) {
+ cfftf(npts, dptr, wsave);
+ dptr += npts*2;
+ }
+ NPY_SIGINT_OFF
+ PyArray_Free(op2, (char *)wsave);
+ return (PyObject *)data;
+fail:
+ PyArray_Free(op2, (char *)wsave);
+ Py_DECREF(data);
+ return NULL;
+}
+
+static char fftpack_cfftb__doc__[] ="";
+
+PyObject *
+fftpack_cfftb(PyObject *self, PyObject *args)
+{
+ PyObject *op1, *op2;
+ PyArrayObject *data;
+ double *wsave, *dptr;
+ int npts, nsave, nrepeats, i;
+
+ if(!PyArg_ParseTuple(args, "OO", &op1, &op2)) return NULL;
+ data = (PyArrayObject *)PyArray_CopyFromObject(op1, PyArray_CDOUBLE, 1, 0);
+ if (data == NULL) return NULL;
+ if (PyArray_As1D(&op2, (char **)&wsave, &nsave, PyArray_DOUBLE) == -1)
+ goto fail;
+ if (data == NULL) goto fail;
+
+ npts = data->dimensions[data->nd-1];
+ if (nsave != npts*4+15) {
+ PyErr_SetString(ErrorObject, "invalid work array for fft size");
+ goto fail;
+ }
+
+ nrepeats = PyArray_SIZE(data)/npts;
+ dptr = (double *)data->data;
+ NPY_SIGINT_ON
+ for (i=0; i<nrepeats; i++) {
+ cfftb(npts, dptr, wsave);
+ dptr += npts*2;
+ }
+ NPY_SIGINT_OFF
+ PyArray_Free(op2, (char *)wsave);
+ return (PyObject *)data;
+fail:
+ PyArray_Free(op2, (char *)wsave);
+ Py_DECREF(data);
+ return NULL;
+}
+
+static char fftpack_cffti__doc__[] ="";
+
+static PyObject *
+fftpack_cffti(PyObject *self, PyObject *args)
+{
+ PyArrayObject *op;
+ int dim, n;
+
+ if (!PyArg_ParseTuple(args, "i", &n)) return NULL;
+
+ dim = 4*n+15; /*Magic size needed by cffti*/
+ /*Create a 1 dimensional array of dimensions of type double*/
+ op = (PyArrayObject *)PyArray_FromDims(1, &dim, PyArray_DOUBLE);
+ if (op == NULL) return NULL;
+
+ NPY_SIGINT_ON
+ cffti(n, (double *)((PyArrayObject*)op)->data);
+ NPY_SIGINT_OFF
+
+ return (PyObject *)op;
+}
+
+static char fftpack_rfftf__doc__[] ="";
+
+PyObject *
+fftpack_rfftf(PyObject *self, PyObject *args)
+{
+ PyObject *op1, *op2;
+ PyArrayObject *data, *ret;
+ double *wsave, *dptr, *rptr;
+ int npts, nsave, nrepeats, i, rstep;
+
+ if(!PyArg_ParseTuple(args, "OO", &op1, &op2)) return NULL;
+ data = (PyArrayObject *)PyArray_ContiguousFromObject(op1, PyArray_DOUBLE, 1, 0);
+ if (data == NULL) return NULL;
+ npts = data->dimensions[data->nd-1];
+ data->dimensions[data->nd-1] = npts/2+1;
+ ret = (PyArrayObject *)PyArray_Zeros(data->nd, data->dimensions,
+ PyArray_DescrFromType(PyArray_CDOUBLE), 0);
+ data->dimensions[data->nd-1] = npts;
+ rstep = (ret->dimensions[ret->nd-1])*2;
+
+ if (PyArray_As1D(&op2, (char **)&wsave, &nsave, PyArray_DOUBLE) == -1)
+ goto fail;
+ if (data == NULL || ret == NULL) goto fail;
+
+ if (nsave != npts*2+15) {
+ PyErr_SetString(ErrorObject, "invalid work array for fft size");
+ goto fail;
+ }
+
+ nrepeats = PyArray_SIZE(data)/npts;
+ rptr = (double *)ret->data;
+ dptr = (double *)data->data;
+
+
+ NPY_SIGINT_ON
+ for (i=0; i<nrepeats; i++) {
+ memcpy((char *)(rptr+1), dptr, npts*sizeof(double));
+ rfftf(npts, rptr+1, wsave);
+ rptr[0] = rptr[1];
+ rptr[1] = 0.0;
+ rptr += rstep;
+ dptr += npts;
+ }
+ NPY_SIGINT_OFF
+ PyArray_Free(op2, (char *)wsave);
+ Py_DECREF(data);
+ return (PyObject *)ret;
+fail:
+ PyArray_Free(op2, (char *)wsave);
+ Py_XDECREF(data);
+ Py_XDECREF(ret);
+ return NULL;
+}
+
+static char fftpack_rfftb__doc__[] ="";
+
+
+PyObject *
+fftpack_rfftb(PyObject *self, PyObject *args)
+{
+ PyObject *op1, *op2;
+ PyArrayObject *data, *ret;
+ double *wsave, *dptr, *rptr;
+ int npts, nsave, nrepeats, i;
+
+ if(!PyArg_ParseTuple(args, "OO", &op1, &op2)) return NULL;
+ data = (PyArrayObject *)PyArray_ContiguousFromObject(op1, PyArray_CDOUBLE, 1, 0);
+ if (data == NULL) return NULL;
+ npts = data->dimensions[data->nd-1];
+ ret = (PyArrayObject *)PyArray_Zeros(data->nd, data->dimensions,
+ PyArray_DescrFromType(PyArray_DOUBLE), 0);
+
+ if (PyArray_As1D(&op2, (char **)&wsave, &nsave, PyArray_DOUBLE) == -1)
+ goto fail;
+ if (data == NULL || ret == NULL) goto fail;
+
+ if (nsave != npts*2+15) {
+ PyErr_SetString(ErrorObject, "invalid work array for fft size");
+ goto fail;
+ }
+
+ nrepeats = PyArray_SIZE(ret)/npts;
+ rptr = (double *)ret->data;
+ dptr = (double *)data->data;
+
+ NPY_SIGINT_ON
+ for (i=0; i<nrepeats; i++) {
+ memcpy((char *)(rptr+1), (dptr+2), (npts-1)*sizeof(double));
+ rptr[0] = dptr[0];
+ rfftb(npts, rptr, wsave);
+ rptr += npts;
+ dptr += npts*2;
+ }
+ NPY_SIGINT_OFF
+ PyArray_Free(op2, (char *)wsave);
+ Py_DECREF(data);
+ return (PyObject *)ret;
+fail:
+ PyArray_Free(op2, (char *)wsave);
+ Py_XDECREF(data);
+ Py_XDECREF(ret);
+ return NULL;
+}
+
+
+static char fftpack_rffti__doc__[] ="";
+
+static PyObject *
+fftpack_rffti(PyObject *self, PyObject *args)
+{
+ PyArrayObject *op;
+ int dim, n;
+
+ if (!PyArg_ParseTuple(args, "i", &n)) return NULL;
+
+ dim = 2*n+15; /*Magic size needed by rffti*/
+ /*Create a 1 dimensional array of dimensions of type double*/
+ op = (PyArrayObject *)PyArray_FromDims(1, &dim, PyArray_DOUBLE);
+ if (op == NULL) return NULL;
+
+ NPY_SIGINT_ON
+ rffti(n, (double *)((PyArrayObject*)op)->data);
+ NPY_SIGINT_OFF
+
+ return (PyObject *)op;
+}
+
+
+/* List of methods defined in the module */
+
+static struct PyMethodDef fftpack_methods[] = {
+ {"cfftf", fftpack_cfftf, 1, fftpack_cfftf__doc__},
+ {"cfftb", fftpack_cfftb, 1, fftpack_cfftb__doc__},
+ {"cffti", fftpack_cffti, 1, fftpack_cffti__doc__},
+ {"rfftf", fftpack_rfftf, 1, fftpack_rfftf__doc__},
+ {"rfftb", fftpack_rfftb, 1, fftpack_rfftb__doc__},
+ {"rffti", fftpack_rffti, 1, fftpack_rffti__doc__},
+ {NULL, NULL} /* sentinel */
+};
+
+
+/* Initialization function for the module (*must* be called initfftpack) */
+
+static char fftpack_module_documentation[] =
+""
+;
+
+PyMODINIT_FUNC initfftpack_lite(void)
+{
+ PyObject *m, *d;
+
+ /* Create the module and add the functions */
+ m = Py_InitModule4("fftpack_lite", fftpack_methods,
+ fftpack_module_documentation,
+ (PyObject*)NULL,PYTHON_API_VERSION);
+
+ /* Import the array object */
+ import_array();
+
+ /* Add some symbolic constants to the module */
+ d = PyModule_GetDict(m);
+ ErrorObject = PyErr_NewException("fftpack.error", NULL, NULL);
+ PyDict_SetItemString(d, "error", ErrorObject);
+
+ /* XXXX Add constants here */
+
+}
diff --git a/numpy/fft/helper.py b/numpy/fft/helper.py
new file mode 100644
index 000000000..17a4a24dc
--- /dev/null
+++ b/numpy/fft/helper.py
@@ -0,0 +1,66 @@
+"""
+Discrete Fourier Transforms - helper.py
+"""
+# Created by Pearu Peterson, September 2002
+
+__all__ = ['fftshift','ifftshift','fftfreq']
+
+from numpy.core import asarray, concatenate, arange, take, \
+ integer
+from numpy import hstack
+import types
+
+def fftshift(x,axes=None):
+ """ fftshift(x, axes=None) -> y
+
+ Shift zero-frequency component to center of spectrum.
+
+ This function swaps half-spaces for all axes listed (defaults to all).
+
+ Notes:
+ If len(x) is even then the Nyquist component is y[0].
+ """
+ tmp = asarray(x)
+ ndim = len(tmp.shape)
+ if axes is None:
+ axes = range(ndim)
+ y = tmp
+ for k in axes:
+ n = tmp.shape[k]
+ p2 = (n+1)/2
+ mylist = concatenate((arange(p2,n),arange(p2)))
+ y = take(y,mylist,k)
+ return y
+
+
+def ifftshift(x,axes=None):
+ """ ifftshift(x,axes=None) - > y
+
+ Inverse of fftshift.
+ """
+ tmp = asarray(x)
+ ndim = len(tmp.shape)
+ if axes is None:
+ axes = range(ndim)
+ y = tmp
+ for k in axes:
+ n = tmp.shape[k]
+ p2 = n-(n+1)/2
+ mylist = concatenate((arange(p2,n),arange(p2)))
+ y = take(y,mylist,k)
+ return y
+
+def fftfreq(n,d=1.0):
+ """ fftfreq(n, d=1.0) -> f
+
+ DFT sample frequencies
+
+ The returned float array contains the frequency bins in
+ cycles/unit (with zero at the start) given a window length n and a
+ sample spacing d:
+
+ f = [0,1,...,n/2-1,-n/2,...,-1]/(d*n) if n is even
+ f = [0,1,...,(n-1)/2,-(n-1)/2,...,-1]/(d*n) if n is odd
+ """
+ assert isinstance(n,types.IntType) or isinstance(n, integer)
+ return hstack((arange(0,(n-1)/2 + 1), arange(-(n/2),0))) / (n*d)
diff --git a/numpy/fft/info.py b/numpy/fft/info.py
new file mode 100644
index 000000000..c9ab599a4
--- /dev/null
+++ b/numpy/fft/info.py
@@ -0,0 +1,29 @@
+"""\
+Core FFT routines
+==================
+
+ Standard FFTs
+
+ fft
+ ifft
+ fft2
+ ifft2
+ fftn
+ ifftn
+
+ Real FFTs
+
+ rfft
+ irfft
+ rfft2
+ irfft2
+ rfftn
+ irfftn
+
+ Hermite FFTs
+
+ hfft
+ ihfft
+"""
+
+depends = ['core']
diff --git a/numpy/fft/setup.py b/numpy/fft/setup.py
new file mode 100644
index 000000000..6acad7c9a
--- /dev/null
+++ b/numpy/fft/setup.py
@@ -0,0 +1,19 @@
+
+
+def configuration(parent_package='',top_path=None):
+ from numpy.distutils.misc_util import Configuration
+ config = Configuration('fft',parent_package,top_path)
+
+ config.add_data_dir('tests')
+
+ # Configure fftpack_lite
+ config.add_extension('fftpack_lite',
+ sources=['fftpack_litemodule.c', 'fftpack.c']
+ )
+
+
+ return config
+
+if __name__ == '__main__':
+ from numpy.distutils.core import setup
+ setup(configuration=configuration)
diff --git a/numpy/fft/tests/test_fftpack.py b/numpy/fft/tests/test_fftpack.py
new file mode 100644
index 000000000..0e38fb3ea
--- /dev/null
+++ b/numpy/fft/tests/test_fftpack.py
@@ -0,0 +1,12 @@
+import sys
+from numpy.testing import *
+set_package_path()
+from numpy.fft import *
+restore_path()
+
+class test_fftshift(NumpyTestCase):
+ def check_fft_n(self):
+ self.failUnlessRaises(ValueError,fft,[1,2,3],0)
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/fft/tests/test_helper.py b/numpy/fft/tests/test_helper.py
new file mode 100644
index 000000000..3d02c01df
--- /dev/null
+++ b/numpy/fft/tests/test_helper.py
@@ -0,0 +1,45 @@
+#!/usr/bin/env python
+# Copied from fftpack.helper by Pearu Peterson, October 2005
+""" Test functions for fftpack.helper module
+"""
+
+import sys
+from numpy.testing import *
+set_package_path()
+from numpy.fft import fftshift,ifftshift,fftfreq
+del sys.path[0]
+
+from numpy import pi
+
+def random(size):
+ return rand(*size)
+
+class test_fftshift(NumpyTestCase):
+
+ def check_definition(self):
+ x = [0,1,2,3,4,-4,-3,-2,-1]
+ y = [-4,-3,-2,-1,0,1,2,3,4]
+ assert_array_almost_equal(fftshift(x),y)
+ assert_array_almost_equal(ifftshift(y),x)
+ x = [0,1,2,3,4,-5,-4,-3,-2,-1]
+ y = [-5,-4,-3,-2,-1,0,1,2,3,4]
+ assert_array_almost_equal(fftshift(x),y)
+ assert_array_almost_equal(ifftshift(y),x)
+
+ def check_inverse(self):
+ for n in [1,4,9,100,211]:
+ x = random((n,))
+ assert_array_almost_equal(ifftshift(fftshift(x)),x)
+
+class test_fftfreq(NumpyTestCase):
+
+ def check_definition(self):
+ x = [0,1,2,3,4,-4,-3,-2,-1]
+ assert_array_almost_equal(9*fftfreq(9),x)
+ assert_array_almost_equal(9*pi*fftfreq(9,pi),x)
+ x = [0,1,2,3,4,-5,-4,-3,-2,-1]
+ assert_array_almost_equal(10*fftfreq(10),x)
+ assert_array_almost_equal(10*pi*fftfreq(10,pi),x)
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/lib/__init__.py b/numpy/lib/__init__.py
new file mode 100644
index 000000000..e17a0a726
--- /dev/null
+++ b/numpy/lib/__init__.py
@@ -0,0 +1,35 @@
+from info import __doc__
+from numpy.version import version as __version__
+
+from type_check import *
+from index_tricks import *
+from function_base import *
+from shape_base import *
+from twodim_base import *
+from ufunclike import *
+
+import scimath as emath
+from polynomial import *
+from machar import *
+from getlimits import *
+#import convertcode
+from utils import *
+from arraysetops import *
+import math
+
+__all__ = ['emath','math']
+__all__ += type_check.__all__
+__all__ += index_tricks.__all__
+__all__ += function_base.__all__
+__all__ += shape_base.__all__
+__all__ += twodim_base.__all__
+__all__ += ufunclike.__all__
+__all__ += polynomial.__all__
+__all__ += machar.__all__
+__all__ += getlimits.__all__
+__all__ += utils.__all__
+__all__ += arraysetops.__all__
+
+def test(level=1, verbosity=1):
+ from numpy.testing import NumpyTest
+ return NumpyTest().test(level, verbosity)
diff --git a/numpy/lib/arraysetops.py b/numpy/lib/arraysetops.py
new file mode 100644
index 000000000..fe08912e7
--- /dev/null
+++ b/numpy/lib/arraysetops.py
@@ -0,0 +1,327 @@
+"""
+Set operations for 1D numeric arrays based on sorting.
+
+Contains:
+ ediff1d,
+ unique1d,
+ intersect1d,
+ intersect1d_nu,
+ setxor1d,
+ setmember1d,
+ union1d,
+ setdiff1d
+
+All functions work best with integer numerical arrays on input (e.g. indices).
+For floating point arrays, innacurate results may appear due to usual round-off
+and floating point comparison issues.
+
+Except unique1d, union1d and intersect1d_nu, all functions expect inputs with
+unique elements. Speed could be gained in some operations by an implementaion of
+sort(), that can provide directly the permutation vectors, avoiding thus calls
+to argsort().
+
+Run _test_unique1d_speed() to compare performance of numpy.unique1d() and
+numpy.unique() - it should be the same.
+
+To do: Optionally return indices analogously to unique1d for all functions.
+
+Author: Robert Cimrman
+
+created: 01.11.2005
+last revision: 07.01.2007
+"""
+__all__ = ['ediff1d', 'unique1d', 'intersect1d', 'intersect1d_nu', 'setxor1d',
+ 'setmember1d', 'union1d', 'setdiff1d']
+
+import time
+import numpy as nm
+
+def ediff1d(ary, to_end = None, to_begin = None):
+ """The differences between consecutive elements of an array, possibly with
+ prefixed and/or appended values.
+
+ :Parameters:
+ - `ary` : array
+ This array will be flattened before the difference is taken.
+ - `to_end` : number, optional
+ If provided, this number will be tacked onto the end of the returned
+ differences.
+ - `to_begin` : number, optional
+ If provided, this number will be taked onto the beginning of the
+ returned differences.
+
+ :Returns:
+ - `ed` : array
+ The differences. Loosely, this will be (ary[1:] - ary[:-1]).
+ """
+ ary = nm.asarray(ary).flat
+ ed = ary[1:] - ary[:-1]
+ arrays = [ed]
+ if to_begin is not None:
+ arrays.insert(0, to_begin)
+ if to_end is not None:
+ arrays.append(to_end)
+
+ if len(arrays) != 1:
+ # We'll save ourselves a copy of a potentially large array in the common
+ # case where neither to_begin or to_end was given.
+ ed = nm.hstack(arrays)
+
+ return ed
+
+def unique1d(ar1, return_index=False):
+ """Find the unique elements of 1D array.
+
+ Most of the other array set operations operate on the unique arrays
+ generated by this function.
+
+ :Parameters:
+ - `ar1` : array
+ This array will be flattened if it is not already 1D.
+ - `return_index` : bool, optional
+ If True, also return the indices against ar1 that result in the unique
+ array.
+
+ :Returns:
+ - `unique` : array
+ The unique values.
+ - `unique_indices` : int array, optional
+ The indices of the unique values. Only provided if return_index is True.
+
+ :See also:
+ numpy.lib.arraysetops has a number of other functions for performing set
+ operations on arrays.
+ """
+ ar = nm.asarray(ar1).flatten()
+ if ar.size == 0:
+ if return_index: return nm.empty(0, nm.bool), ar
+ else: return ar
+
+ if return_index:
+ perm = ar.argsort()
+ aux = ar[perm]
+ flag = nm.concatenate( ([True], aux[1:] != aux[:-1]) )
+ return perm[flag], aux[flag]
+
+ else:
+ ar.sort()
+ flag = nm.concatenate( ([True], ar[1:] != ar[:-1]) )
+ return ar[flag]
+
+def intersect1d( ar1, ar2 ):
+ """Intersection of 1D arrays with unique elements.
+
+ Use unique1d() to generate arrays with only unique elements to use as inputs
+ to this function. Alternatively, use intersect1d_nu() which will find the
+ unique values for you.
+
+ :Parameters:
+ - `ar1` : array
+ - `ar2` : array
+
+ :Returns:
+ - `intersection` : array
+
+ :See also:
+ numpy.lib.arraysetops has a number of other functions for performing set
+ operations on arrays.
+ """
+ aux = nm.concatenate((ar1,ar2))
+ aux.sort()
+ return aux[aux[1:] == aux[:-1]]
+
+def intersect1d_nu( ar1, ar2 ):
+ """Intersection of 1D arrays with any elements.
+
+ The input arrays do not have unique elements like intersect1d() requires.
+
+ :Parameters:
+ - `ar1` : array
+ - `ar2` : array
+
+ :Returns:
+ - `intersection` : array
+
+ :See also:
+ numpy.lib.arraysetops has a number of other functions for performing set
+ operations on arrays.
+ """
+ # Might be faster than unique1d( intersect1d( ar1, ar2 ) )?
+ aux = nm.concatenate((unique1d(ar1), unique1d(ar2)))
+ aux.sort()
+ return aux[aux[1:] == aux[:-1]]
+
+def setxor1d( ar1, ar2 ):
+ """Set exclusive-or of 1D arrays with unique elements.
+
+ Use unique1d() to generate arrays with only unique elements to use as inputs
+ to this function.
+
+ :Parameters:
+ - `ar1` : array
+ - `ar2` : array
+
+ :Returns:
+ - `xor` : array
+ The values that are only in one, but not both, of the input arrays.
+
+ :See also:
+ numpy.lib.arraysetops has a number of other functions for performing set
+ operations on arrays.
+ """
+ aux = nm.concatenate((ar1, ar2))
+ if aux.size == 0:
+ return aux
+
+ aux.sort()
+# flag = ediff1d( aux, to_end = 1, to_begin = 1 ) == 0
+ flag = nm.concatenate( ([True], aux[1:] != aux[:-1], [True] ) )
+# flag2 = ediff1d( flag ) == 0
+ flag2 = flag[1:] == flag[:-1]
+ return aux[flag2]
+
+def setmember1d( ar1, ar2 ):
+ """Return a boolean array of shape of ar1 containing True where the elements
+ of ar1 are in ar2 and False otherwise.
+
+ Use unique1d() to generate arrays with only unique elements to use as inputs
+ to this function.
+
+ :Parameters:
+ - `ar1` : array
+ - `ar2` : array
+
+ :Returns:
+ - `mask` : bool array
+ The values ar1[mask] are in ar2.
+
+ :See also:
+ numpy.lib.arraysetops has a number of other functions for performing set
+ operations on arrays.
+ """
+ zlike = nm.zeros_like
+ ar = nm.concatenate( (ar1, ar2 ) )
+ tt = nm.concatenate( (zlike( ar1 ), zlike( ar2 ) + 1) )
+ # We need this to be a stable sort, so always use 'mergesort' here. The
+ # values from the first array should always come before the values from the
+ # second array.
+ perm = ar.argsort(kind='mergesort')
+ aux = ar[perm]
+ aux2 = tt[perm]
+# flag = ediff1d( aux, 1 ) == 0
+ flag = nm.concatenate( (aux[1:] == aux[:-1], [False] ) )
+
+ ii = nm.where( flag * aux2 )[0]
+ aux = perm[ii+1]
+ perm[ii+1] = perm[ii]
+ perm[ii] = aux
+
+ indx = perm.argsort(kind='mergesort')[:len( ar1 )]
+
+ return flag[indx]
+
+def union1d( ar1, ar2 ):
+ """Union of 1D arrays with unique elements.
+
+ Use unique1d() to generate arrays with only unique elements to use as inputs
+ to this function.
+
+ :Parameters:
+ - `ar1` : array
+ - `ar2` : array
+
+ :Returns:
+ - `union` : array
+
+ :See also:
+ numpy.lib.arraysetops has a number of other functions for performing set
+ operations on arrays.
+ """
+ return unique1d( nm.concatenate( (ar1, ar2) ) )
+
+def setdiff1d( ar1, ar2 ):
+ """Set difference of 1D arrays with unique elements.
+
+ Use unique1d() to generate arrays with only unique elements to use as inputs
+ to this function.
+
+ :Parameters:
+ - `ar1` : array
+ - `ar2` : array
+
+ :Returns:
+ - `difference` : array
+ The values in ar1 that are not in ar2.
+
+ :See also:
+ numpy.lib.arraysetops has a number of other functions for performing set
+ operations on arrays.
+ """
+ aux = setmember1d(ar1,ar2)
+ if aux.size == 0:
+ return aux
+ else:
+ return nm.asarray(ar1)[aux == 0]
+
+def _test_unique1d_speed( plot_results = False ):
+# exponents = nm.linspace( 2, 7, 9 )
+ exponents = nm.linspace( 2, 7, 9 )
+ ratios = []
+ nItems = []
+ dt1s = []
+ dt2s = []
+ for ii in exponents:
+
+ nItem = 10 ** ii
+ print 'using %d items:' % nItem
+ a = nm.fix( nItem / 10 * nm.random.random( nItem ) )
+
+ print 'unique:'
+ tt = time.clock()
+ b = nm.unique( a )
+ dt1 = time.clock() - tt
+ print dt1
+
+ print 'unique1d:'
+ tt = time.clock()
+ c = unique1d( a )
+ dt2 = time.clock() - tt
+ print dt2
+
+
+ if dt1 < 1e-8:
+ ratio = 'ND'
+ else:
+ ratio = dt2 / dt1
+ print 'ratio:', ratio
+ print 'nUnique: %d == %d\n' % (len( b ), len( c ))
+
+ nItems.append( nItem )
+ ratios.append( ratio )
+ dt1s.append( dt1 )
+ dt2s.append( dt2 )
+
+ assert nm.alltrue( b == c )
+
+ print nItems
+ print dt1s
+ print dt2s
+ print ratios
+
+ if plot_results:
+ import pylab
+
+ def plotMe( fig, fun, nItems, dt1s, dt2s ):
+ pylab.figure( fig )
+ fun( nItems, dt1s, 'g-o', linewidth = 2, markersize = 8 )
+ fun( nItems, dt2s, 'b-x', linewidth = 2, markersize = 8 )
+ pylab.legend( ('unique', 'unique1d' ) )
+ pylab.xlabel( 'nItem' )
+ pylab.ylabel( 'time [s]' )
+
+ plotMe( 1, pylab.loglog, nItems, dt1s, dt2s )
+ plotMe( 2, pylab.plot, nItems, dt1s, dt2s )
+ pylab.show()
+
+if (__name__ == '__main__'):
+ _test_unique1d_speed( plot_results = True )
diff --git a/numpy/lib/convdtype.py b/numpy/lib/convdtype.py
new file mode 100644
index 000000000..ebc1ba512
--- /dev/null
+++ b/numpy/lib/convdtype.py
@@ -0,0 +1,65 @@
+from tokenize import generate_tokens
+import token
+import sys
+def insert(s1, s2, posn):
+ """insert s1 into s2 at positions posn
+
+ >>> insert("XX", "abcdef", [2, 4])
+ 'abXXcdXXef'
+ """
+ pieces = []
+ start = 0
+ for end in posn + [len(s2)]:
+ pieces.append(s2[start:end])
+ start = end
+ return s1.join(pieces)
+
+def insert_dtype(readline, output=None):
+ """
+ >>> from StringIO import StringIO
+ >>> src = "zeros((2,3), dtype=float); zeros((2,3));"
+ >>> insert_dtype(StringIO(src).readline)
+ zeros((2,3), dtype=float); zeros((2,3), dtype=int);
+ """
+ if output is None:
+ output = sys.stdout
+ tokens = generate_tokens(readline)
+ flag = 0
+ parens = 0
+ argno = 0
+ posn = []
+ nodtype = True
+ prevtok = None
+ kwarg = 0
+ for (tok_type, tok, (srow, scol), (erow, ecol), line) in tokens:
+ if not flag and tok_type == token.NAME and tok in ('zeros', 'ones', 'empty'):
+ flag = 1
+ else:
+ if tok == '(':
+ parens += 1
+ elif tok == ')':
+ parens -= 1
+ if parens == 0:
+ if nodtype and argno < 1:
+ posn.append(scol)
+ argno = 0
+ flag = 0
+ nodtype = True
+ argno = 0
+ elif tok == '=':
+ kwarg = 1
+ if prevtok == 'dtype':
+ nodtype = False
+ elif tok == ',':
+ argno += (parens == 1)
+ if len(line) == ecol:
+ output.write(insert(', dtype=int', line, posn))
+ posn = []
+ prevtok = tok
+
+def _test():
+ import doctest
+ doctest.testmod()
+
+if __name__ == "__main__":
+ _test()
diff --git a/numpy/lib/function_base.py b/numpy/lib/function_base.py
new file mode 100644
index 000000000..e038a4803
--- /dev/null
+++ b/numpy/lib/function_base.py
@@ -0,0 +1,1454 @@
+__docformat__ = "restructuredtext en"
+__all__ = ['logspace', 'linspace',
+ 'select', 'piecewise', 'trim_zeros',
+ 'copy', 'iterable', #'base_repr', 'binary_repr',
+ 'diff', 'gradient', 'angle', 'unwrap', 'sort_complex', 'disp',
+ 'unique', 'extract', 'place', 'nansum', 'nanmax', 'nanargmax',
+ 'nanargmin', 'nanmin', 'vectorize', 'asarray_chkfinite', 'average',
+ 'histogram', 'histogramdd', 'bincount', 'digitize', 'cov',
+ 'corrcoef', 'msort', 'median', 'sinc', 'hamming', 'hanning',
+ 'bartlett', 'blackman', 'kaiser', 'trapz', 'i0', 'add_newdoc',
+ 'add_docstring', 'meshgrid', 'delete', 'insert', 'append',
+ 'interp'
+ ]
+
+import types
+import numpy.core.numeric as _nx
+from numpy.core.numeric import ones, zeros, arange, concatenate, array, \
+ asarray, asanyarray, empty, empty_like, asanyarray, ndarray, around
+from numpy.core.numeric import ScalarType, dot, where, newaxis, intp, \
+ integer, isscalar
+from numpy.core.umath import pi, multiply, add, arctan2, \
+ frompyfunc, isnan, cos, less_equal, sqrt, sin, mod, exp, log10
+from numpy.core.fromnumeric import ravel, nonzero, choose, sort
+from numpy.core.numerictypes import typecodes
+from numpy.lib.shape_base import atleast_1d, atleast_2d
+from numpy.lib.twodim_base import diag
+from _compiled_base import _insert, add_docstring
+from _compiled_base import digitize, bincount, interp
+from arraysetops import setdiff1d
+
+#end Fernando's utilities
+
+def linspace(start, stop, num=50, endpoint=True, retstep=False):
+ """Return evenly spaced numbers.
+
+ Return num evenly spaced samples from start to stop. If
+ endpoint is True, the last sample is stop. If retstep is
+ True then return the step value used.
+ """
+ num = int(num)
+ if num <= 0:
+ return array([], float)
+ if endpoint:
+ if num == 1:
+ return array([float(start)])
+ step = (stop-start)/float((num-1))
+ y = _nx.arange(0, num) * step + start
+ y[-1] = stop
+ else:
+ step = (stop-start)/float(num)
+ y = _nx.arange(0, num) * step + start
+ if retstep:
+ return y, step
+ else:
+ return y
+
+def logspace(start,stop,num=50,endpoint=True,base=10.0):
+ """Evenly spaced numbers on a logarithmic scale.
+
+ Computes int(num) evenly spaced exponents from base**start to
+ base**stop. If endpoint=True, then last number is base**stop
+ """
+ y = linspace(start,stop,num=num,endpoint=endpoint)
+ return _nx.power(base,y)
+
+def iterable(y):
+ try: iter(y)
+ except: return 0
+ return 1
+
+def histogram(a, bins=10, range=None, normed=False):
+ """Compute the histogram from a set of data.
+
+ Parameters:
+
+ a : array
+ The data to histogram. n-D arrays will be flattened.
+
+ bins : int or sequence of floats
+ If an int, then the number of equal-width bins in the given range.
+ Otherwise, a sequence of the lower bound of each bin.
+
+ range : (float, float)
+ The lower and upper range of the bins. If not provided, then
+ (a.min(), a.max()) is used. Values outside of this range are
+ allocated to the closest bin.
+
+ normed : bool
+ If False, the result array will contain the number of samples in
+ each bin. If True, the result array is the value of the
+ probability *density* function at the bin normalized such that the
+ *integral* over the range is 1. Note that the sum of all of the
+ histogram values will not usually be 1; it is not a probability
+ *mass* function.
+
+ Returns:
+
+ hist : array
+ The values of the histogram. See `normed` for a description of the
+ possible semantics.
+
+ lower_edges : float array
+ The lower edges of each bin.
+
+ SeeAlso:
+
+ histogramdd
+
+ """
+ a = asarray(a).ravel()
+ if not iterable(bins):
+ if range is None:
+ range = (a.min(), a.max())
+ mn, mx = [mi+0.0 for mi in range]
+ if mn == mx:
+ mn -= 0.5
+ mx += 0.5
+ bins = linspace(mn, mx, bins, endpoint=False)
+
+ # best block size probably depends on processor cache size
+ block = 65536
+ n = sort(a[:block]).searchsorted(bins)
+ for i in xrange(block, a.size, block):
+ n += sort(a[i:i+block]).searchsorted(bins)
+ n = concatenate([n, [len(a)]])
+ n = n[1:]-n[:-1]
+
+ if normed:
+ db = bins[1] - bins[0]
+ return 1.0/(a.size*db) * n, bins
+ else:
+ return n, bins
+
+def histogramdd(sample, bins=10, range=None, normed=False, weights=None):
+ """histogramdd(sample, bins=10, range=None, normed=False, weights=None)
+
+ Return the N-dimensional histogram of the sample.
+
+ Parameters:
+
+ sample : sequence or array
+ A sequence containing N arrays or an NxM array. Input data.
+
+ bins : sequence or scalar
+ A sequence of edge arrays, a sequence of bin counts, or a scalar
+ which is the bin count for all dimensions. Default is 10.
+
+ range : sequence
+ A sequence of lower and upper bin edges. Default is [min, max].
+
+ normed : boolean
+ If False, return the number of samples in each bin, if True,
+ returns the density.
+
+ weights : array
+ Array of weights. The weights are normed only if normed is True.
+ Should the sum of the weights not equal N, the total bin count will
+ not be equal to the number of samples.
+
+ Returns:
+
+ hist : array
+ Histogram array.
+
+ edges : list
+ List of arrays defining the lower bin edges.
+
+ SeeAlso:
+
+ histogram
+
+ Example
+
+ >>> x = random.randn(100,3)
+ >>> hist3d, edges = histogramdd(x, bins = (5, 6, 7))
+
+ """
+
+ try:
+ # Sample is an ND-array.
+ N, D = sample.shape
+ except (AttributeError, ValueError):
+ # Sample is a sequence of 1D arrays.
+ sample = atleast_2d(sample).T
+ N, D = sample.shape
+
+ nbin = empty(D, int)
+ edges = D*[None]
+ dedges = D*[None]
+ if weights is not None:
+ weights = asarray(weights)
+
+ try:
+ M = len(bins)
+ if M != D:
+ raise AttributeError, 'The dimension of bins must be a equal to the dimension of the sample x.'
+ except TypeError:
+ bins = D*[bins]
+
+ # Select range for each dimension
+ # Used only if number of bins is given.
+ if range is None:
+ smin = atleast_1d(array(sample.min(0), float))
+ smax = atleast_1d(array(sample.max(0), float))
+ else:
+ smin = zeros(D)
+ smax = zeros(D)
+ for i in arange(D):
+ smin[i], smax[i] = range[i]
+
+ # Make sure the bins have a finite width.
+ for i in arange(len(smin)):
+ if smin[i] == smax[i]:
+ smin[i] = smin[i] - .5
+ smax[i] = smax[i] + .5
+
+ # Create edge arrays
+ for i in arange(D):
+ if isscalar(bins[i]):
+ nbin[i] = bins[i] + 2 # +2 for outlier bins
+ edges[i] = linspace(smin[i], smax[i], nbin[i]-1)
+ else:
+ edges[i] = asarray(bins[i], float)
+ nbin[i] = len(edges[i])+1 # +1 for outlier bins
+ dedges[i] = diff(edges[i])
+
+ nbin = asarray(nbin)
+
+ # Compute the bin number each sample falls into.
+ Ncount = {}
+ for i in arange(D):
+ Ncount[i] = digitize(sample[:,i], edges[i])
+
+ # Using digitize, values that fall on an edge are put in the right bin.
+ # For the rightmost bin, we want values equal to the right
+ # edge to be counted in the last bin, and not as an outlier.
+ outliers = zeros(N, int)
+ for i in arange(D):
+ # Rounding precision
+ decimal = int(-log10(dedges[i].min())) +6
+ # Find which points are on the rightmost edge.
+ on_edge = where(around(sample[:,i], decimal) == around(edges[i][-1], decimal))[0]
+ # Shift these points one bin to the left.
+ Ncount[i][on_edge] -= 1
+
+ # Flattened histogram matrix (1D)
+ hist = zeros(nbin.prod(), float)
+
+ # Compute the sample indices in the flattened histogram matrix.
+ ni = nbin.argsort()
+ shape = []
+ xy = zeros(N, int)
+ for i in arange(0, D-1):
+ xy += Ncount[ni[i]] * nbin[ni[i+1:]].prod()
+ xy += Ncount[ni[-1]]
+
+ # Compute the number of repetitions in xy and assign it to the flattened histmat.
+ if len(xy) == 0:
+ return zeros(nbin-2, int), edges
+
+ flatcount = bincount(xy, weights)
+ a = arange(len(flatcount))
+ hist[a] = flatcount
+
+ # Shape into a proper matrix
+ hist = hist.reshape(sort(nbin))
+ for i in arange(nbin.size):
+ j = ni[i]
+ hist = hist.swapaxes(i,j)
+ ni[i],ni[j] = ni[j],ni[i]
+
+ # Remove outliers (indices 0 and -1 for each dimension).
+ core = D*[slice(1,-1)]
+ hist = hist[core]
+
+ # Normalize if normed is True
+ if normed:
+ s = hist.sum()
+ for i in arange(D):
+ shape = ones(D, int)
+ shape[i] = nbin[i]-2
+ hist = hist / dedges[i].reshape(shape)
+ hist /= s
+
+ return hist, edges
+
+
+def average(a, axis=None, weights=None, returned=False):
+ """average(a, axis=None weights=None, returned=False)
+
+ Average the array over the given axis. If the axis is None,
+ average over all dimensions of the array. Equivalent to
+ a.mean(axis) and to
+
+ a.sum(axis) / size(a, axis)
+
+ If weights are given, result is:
+ sum(a * weights,axis) / sum(weights,axis),
+ where the weights must have a's shape or be 1D with length the
+ size of a in the given axis. Integer weights are converted to
+ Float. Not specifying weights is equivalent to specifying
+ weights that are all 1.
+
+ If 'returned' is True, return a tuple: the result and the sum of
+ the weights or count of values. The shape of these two results
+ will be the same.
+
+ Raises ZeroDivisionError if appropriate. (The version in MA does
+ not -- it returns masked values).
+
+ """
+ if axis is None:
+ a = array(a).ravel()
+ if weights is None:
+ n = add.reduce(a)
+ d = len(a) * 1.0
+ else:
+ w = array(weights).ravel() * 1.0
+ n = add.reduce(multiply(a, w))
+ d = add.reduce(w)
+ else:
+ a = array(a)
+ ash = a.shape
+ if ash == ():
+ a.shape = (1,)
+ if weights is None:
+ n = add.reduce(a, axis)
+ d = ash[axis] * 1.0
+ if returned:
+ d = ones(n.shape) * d
+ else:
+ w = array(weights, copy=False) * 1.0
+ wsh = w.shape
+ if wsh == ():
+ wsh = (1,)
+ if wsh == ash:
+ n = add.reduce(a*w, axis)
+ d = add.reduce(w, axis)
+ elif wsh == (ash[axis],):
+ ni = ash[axis]
+ r = [newaxis]*ni
+ r[axis] = slice(None, None, 1)
+ w1 = eval("w["+repr(tuple(r))+"]*ones(ash, float)")
+ n = add.reduce(a*w1, axis)
+ d = add.reduce(w1, axis)
+ else:
+ raise ValueError, 'averaging weights have wrong shape'
+
+ if not isinstance(d, ndarray):
+ if d == 0.0:
+ raise ZeroDivisionError, 'zero denominator in average()'
+ if returned:
+ return n/d, d
+ else:
+ return n/d
+
+def asarray_chkfinite(a):
+ """Like asarray, but check that no NaNs or Infs are present.
+ """
+ a = asarray(a)
+ if (a.dtype.char in typecodes['AllFloat']) \
+ and (_nx.isnan(a).any() or _nx.isinf(a).any()):
+ raise ValueError, "array must not contain infs or NaNs"
+ return a
+
+def piecewise(x, condlist, funclist, *args, **kw):
+ """Return a piecewise-defined function.
+
+ x is the domain
+
+ condlist is a list of boolean arrays or a single boolean array
+ The length of the condition list must be n2 or n2-1 where n2
+ is the length of the function list. If len(condlist)==n2-1, then
+ an 'otherwise' condition is formed by |'ing all the conditions
+ and inverting.
+
+ funclist is a list of functions to call of length (n2).
+ Each function should return an array output for an array input
+ Each function can take (the same set) of extra arguments and
+ keyword arguments which are passed in after the function list.
+ A constant may be used in funclist for a function that returns a
+ constant (e.g. val and lambda x: val are equivalent in a funclist).
+
+ The output is the same shape and type as x and is found by
+ calling the functions on the appropriate portions of x.
+
+ Note: This is similar to choose or select, except
+ the the functions are only evaluated on elements of x
+ that satisfy the corresponding condition.
+
+ The result is
+ |--
+ | f1(x) for condition1
+ y = --| f2(x) for condition2
+ | ...
+ | fn(x) for conditionn
+ |--
+
+ """
+ x = asanyarray(x)
+ n2 = len(funclist)
+ if not isinstance(condlist, type([])):
+ condlist = [condlist]
+ n = len(condlist)
+ if n == n2-1: # compute the "otherwise" condition.
+ totlist = condlist[0]
+ for k in range(1, n):
+ totlist |= condlist[k]
+ condlist.append(~totlist)
+ n += 1
+ if (n != n2):
+ raise ValueError, "function list and condition list must be the same"
+ y = empty(x.shape, x.dtype)
+ for k in range(n):
+ item = funclist[k]
+ if not callable(item):
+ y[condlist[k]] = item
+ else:
+ y[condlist[k]] = item(x[condlist[k]], *args, **kw)
+ return y
+
+def select(condlist, choicelist, default=0):
+ """ Return an array composed of different elements of choicelist
+ depending on the list of conditions.
+
+ condlist is a list of condition arrays containing ones or zeros
+
+ choicelist is a list of choice arrays (of the "same" size as the
+ arrays in condlist). The result array has the "same" size as the
+ arrays in choicelist. If condlist is [c0, ..., cN-1] then choicelist
+ must be of length N. The elements of the choicelist can then be
+ represented as [v0, ..., vN-1]. The default choice if none of the
+ conditions are met is given as the default argument.
+
+ The conditions are tested in order and the first one statisfied is
+ used to select the choice. In other words, the elements of the
+ output array are found from the following tree (notice the order of
+ the conditions matters):
+
+ if c0: v0
+ elif c1: v1
+ elif c2: v2
+ ...
+ elif cN-1: vN-1
+ else: default
+
+ Note that one of the condition arrays must be large enough to handle
+ the largest array in the choice list.
+
+ """
+ n = len(condlist)
+ n2 = len(choicelist)
+ if n2 != n:
+ raise ValueError, "list of cases must be same length as list of conditions"
+ choicelist.insert(0, default)
+ S = 0
+ pfac = 1
+ for k in range(1, n+1):
+ S += k * pfac * asarray(condlist[k-1])
+ if k < n:
+ pfac *= (1-asarray(condlist[k-1]))
+ # handle special case of a 1-element condition but
+ # a multi-element choice
+ if type(S) in ScalarType or max(asarray(S).shape)==1:
+ pfac = asarray(1)
+ for k in range(n2+1):
+ pfac = pfac + asarray(choicelist[k])
+ if type(S) in ScalarType:
+ S = S*ones(asarray(pfac).shape, type(S))
+ else:
+ S = S*ones(asarray(pfac).shape, S.dtype)
+ return choose(S, tuple(choicelist))
+
+def _asarray1d(arr, copy=False):
+ """Ensure 1D array for one array.
+ """
+ if copy:
+ return asarray(arr).flatten()
+ else:
+ return asarray(arr).ravel()
+
+def copy(a):
+ """Return an array copy of the given object.
+ """
+ return array(a, copy=True)
+
+# Basic operations
+
+def gradient(f, *varargs):
+ """Calculate the gradient of an N-dimensional scalar function.
+
+ Uses central differences on the interior and first differences on boundaries
+ to give the same shape.
+
+ Inputs:
+
+ f -- An N-dimensional array giving samples of a scalar function
+
+ varargs -- 0, 1, or N scalars giving the sample distances in each direction
+
+ Outputs:
+
+ N arrays of the same shape as f giving the derivative of f with respect
+ to each dimension.
+
+ """
+ N = len(f.shape) # number of dimensions
+ n = len(varargs)
+ if n == 0:
+ dx = [1.0]*N
+ elif n == 1:
+ dx = [varargs[0]]*N
+ elif n == N:
+ dx = list(varargs)
+ else:
+ raise SyntaxError, "invalid number of arguments"
+
+ # use central differences on interior and first differences on endpoints
+
+ outvals = []
+
+ # create slice objects --- initially all are [:, :, ..., :]
+ slice1 = [slice(None)]*N
+ slice2 = [slice(None)]*N
+ slice3 = [slice(None)]*N
+
+ otype = f.dtype.char
+ if otype not in ['f', 'd', 'F', 'D']:
+ otype = 'd'
+
+ for axis in range(N):
+ # select out appropriate parts for this dimension
+ out = zeros(f.shape, f.dtype.char)
+ slice1[axis] = slice(1, -1)
+ slice2[axis] = slice(2, None)
+ slice3[axis] = slice(None, -2)
+ # 1D equivalent -- out[1:-1] = (f[2:] - f[:-2])/2.0
+ out[slice1] = (f[slice2] - f[slice3])/2.0
+ slice1[axis] = 0
+ slice2[axis] = 1
+ slice3[axis] = 0
+ # 1D equivalent -- out[0] = (f[1] - f[0])
+ out[slice1] = (f[slice2] - f[slice3])
+ slice1[axis] = -1
+ slice2[axis] = -1
+ slice3[axis] = -2
+ # 1D equivalent -- out[-1] = (f[-1] - f[-2])
+ out[slice1] = (f[slice2] - f[slice3])
+
+ # divide by step size
+ outvals.append(out / dx[axis])
+
+ # reset the slice object in this dimension to ":"
+ slice1[axis] = slice(None)
+ slice2[axis] = slice(None)
+ slice3[axis] = slice(None)
+
+ if N == 1:
+ return outvals[0]
+ else:
+ return outvals
+
+
+def diff(a, n=1, axis=-1):
+ """Calculate the nth order discrete difference along given axis.
+ """
+ if n == 0:
+ return a
+ if n < 0:
+ raise ValueError, 'order must be non-negative but got ' + repr(n)
+ a = asanyarray(a)
+ nd = len(a.shape)
+ slice1 = [slice(None)]*nd
+ slice2 = [slice(None)]*nd
+ slice1[axis] = slice(1, None)
+ slice2[axis] = slice(None, -1)
+ slice1 = tuple(slice1)
+ slice2 = tuple(slice2)
+ if n > 1:
+ return diff(a[slice1]-a[slice2], n-1, axis=axis)
+ else:
+ return a[slice1]-a[slice2]
+
+try:
+ add_docstring(digitize,
+r"""digitize(x,bins)
+
+Return the index of the bin to which each value of x belongs.
+
+Each index i returned is such that bins[i-1] <= x < bins[i] if
+bins is monotonically increasing, or bins [i-1] > x >= bins[i] if
+bins is monotonically decreasing.
+
+Beyond the bounds of the bins 0 or len(bins) is returned as appropriate.
+
+""")
+except RuntimeError:
+ pass
+
+try:
+ add_docstring(bincount,
+r"""bincount(x,weights=None)
+
+Return the number of occurrences of each value in x.
+
+x must be a list of non-negative integers. The output, b[i],
+represents the number of times that i is found in x. If weights
+is specified, every occurrence of i at a position p contributes
+weights[p] instead of 1.
+
+See also: histogram, digitize, unique.
+
+""")
+except RuntimeError:
+ pass
+
+try:
+ add_docstring(add_docstring,
+r"""docstring(obj, docstring)
+
+Add a docstring to a built-in obj if possible.
+If the obj already has a docstring raise a RuntimeError
+If this routine does not know how to add a docstring to the object
+raise a TypeError
+
+""")
+except RuntimeError:
+ pass
+
+try:
+ add_docstring(interp,
+r"""interp(x, xp, fp, left=None, right=None)
+
+Return the value of a piecewise-linear function at each value in x.
+
+The piecewise-linear function, f, is defined by the known data-points fp=f(xp).
+The xp points must be sorted in increasing order but this is not checked.
+
+For values of x < xp[0] return the value given by left. If left is None, then
+return fp[0].
+For values of x > xp[-1] return the value given by right. If right is None, then
+return fp[-1].
+"""
+ )
+except RuntimeError:
+ pass
+
+
+def angle(z, deg=0):
+ """Return the angle of the complex argument z.
+ """
+ if deg:
+ fact = 180/pi
+ else:
+ fact = 1.0
+ z = asarray(z)
+ if (issubclass(z.dtype.type, _nx.complexfloating)):
+ zimag = z.imag
+ zreal = z.real
+ else:
+ zimag = 0
+ zreal = z
+ return arctan2(zimag, zreal) * fact
+
+def unwrap(p, discont=pi, axis=-1):
+ """Unwrap radian phase p by changing absolute jumps greater than
+ 'discont' to their 2*pi complement along the given axis.
+ """
+ p = asarray(p)
+ nd = len(p.shape)
+ dd = diff(p, axis=axis)
+ slice1 = [slice(None, None)]*nd # full slices
+ slice1[axis] = slice(1, None)
+ ddmod = mod(dd+pi, 2*pi)-pi
+ _nx.putmask(ddmod, (ddmod==-pi) & (dd > 0), pi)
+ ph_correct = ddmod - dd;
+ _nx.putmask(ph_correct, abs(dd)<discont, 0)
+ up = array(p, copy=True, dtype='d')
+ up[slice1] = p[slice1] + ph_correct.cumsum(axis)
+ return up
+
+def sort_complex(a):
+ """ Sort 'a' as a complex array using the real part first and then
+ the imaginary part if the real part is equal (the default sort order
+ for complex arrays). This function is a wrapper ensuring a complex
+ return type.
+
+ """
+ b = array(a,copy=True)
+ b.sort()
+ if not issubclass(b.dtype.type, _nx.complexfloating):
+ if b.dtype.char in 'bhBH':
+ return b.astype('F')
+ elif b.dtype.char == 'g':
+ return b.astype('G')
+ else:
+ return b.astype('D')
+ else:
+ return b
+
+def trim_zeros(filt, trim='fb'):
+ """ Trim the leading and trailing zeros from a 1D array.
+
+ Example:
+ >>> import numpy
+ >>> a = array((0, 0, 0, 1, 2, 3, 2, 1, 0))
+ >>> numpy.trim_zeros(a)
+ array([1, 2, 3, 2, 1])
+
+ """
+ first = 0
+ trim = trim.upper()
+ if 'F' in trim:
+ for i in filt:
+ if i != 0.: break
+ else: first = first + 1
+ last = len(filt)
+ if 'B' in trim:
+ for i in filt[::-1]:
+ if i != 0.: break
+ else: last = last - 1
+ return filt[first:last]
+
+import sys
+if sys.hexversion < 0x2040000:
+ from sets import Set as set
+
+def unique(x):
+ """Return sorted unique items from an array or sequence.
+
+ Example:
+ >>> unique([5,2,4,0,4,4,2,2,1])
+ array([0, 1, 2, 4, 5])
+
+ """
+ try:
+ tmp = x.flatten()
+ if tmp.size == 0:
+ return tmp
+ tmp.sort()
+ idx = concatenate(([True],tmp[1:]!=tmp[:-1]))
+ return tmp[idx]
+ except AttributeError:
+ items = list(set(x))
+ items.sort()
+ return asarray(items)
+
+def extract(condition, arr):
+ """Return the elements of ravel(arr) where ravel(condition) is True
+ (in 1D).
+
+ Equivalent to compress(ravel(condition), ravel(arr)).
+ """
+ return _nx.take(ravel(arr), nonzero(ravel(condition))[0])
+
+def place(arr, mask, vals):
+ """Similar to putmask arr[mask] = vals but the 1D array vals has the
+ same number of elements as the non-zero values of mask. Inverse of
+ extract.
+
+ """
+ return _insert(arr, mask, vals)
+
+def nansum(a, axis=None):
+ """Sum the array over the given axis, treating NaNs as 0.
+ """
+ y = array(a,subok=True)
+ if not issubclass(y.dtype.type, _nx.integer):
+ y[isnan(a)] = 0
+ return y.sum(axis)
+
+def nanmin(a, axis=None):
+ """Find the minimium over the given axis, ignoring NaNs.
+ """
+ y = array(a,subok=True)
+ if not issubclass(y.dtype.type, _nx.integer):
+ y[isnan(a)] = _nx.inf
+ return y.min(axis)
+
+def nanargmin(a, axis=None):
+ """Find the indices of the minimium over the given axis ignoring NaNs.
+ """
+ y = array(a, subok=True)
+ if not issubclass(y.dtype.type, _nx.integer):
+ y[isnan(a)] = _nx.inf
+ return y.argmin(axis)
+
+def nanmax(a, axis=None):
+ """Find the maximum over the given axis ignoring NaNs.
+ """
+ y = array(a, subok=True)
+ if not issubclass(y.dtype.type, _nx.integer):
+ y[isnan(a)] = -_nx.inf
+ return y.max(axis)
+
+def nanargmax(a, axis=None):
+ """Find the maximum over the given axis ignoring NaNs.
+ """
+ y = array(a,subok=True)
+ if not issubclass(y.dtype.type, _nx.integer):
+ y[isnan(a)] = -_nx.inf
+ return y.argmax(axis)
+
+def disp(mesg, device=None, linefeed=True):
+ """Display a message to the given device (default is sys.stdout)
+ with or without a linefeed.
+ """
+ if device is None:
+ import sys
+ device = sys.stdout
+ if linefeed:
+ device.write('%s\n' % mesg)
+ else:
+ device.write('%s' % mesg)
+ device.flush()
+ return
+
+# return number of input arguments and
+# number of default arguments
+import re
+def _get_nargs(obj):
+ if not callable(obj):
+ raise TypeError, "Object is not callable."
+ if hasattr(obj,'func_code'):
+ fcode = obj.func_code
+ nargs = fcode.co_argcount
+ if obj.func_defaults is not None:
+ ndefaults = len(obj.func_defaults)
+ else:
+ ndefaults = 0
+ if isinstance(obj, types.MethodType):
+ nargs -= 1
+ return nargs, ndefaults
+ terr = re.compile(r'.*? takes exactly (?P<exargs>\d+) argument(s|) \((?P<gargs>\d+) given\)')
+ try:
+ obj()
+ return 0, 0
+ except TypeError, msg:
+ m = terr.match(str(msg))
+ if m:
+ nargs = int(m.group('exargs'))
+ ndefaults = int(m.group('gargs'))
+ if isinstance(obj, types.MethodType):
+ nargs -= 1
+ return nargs, ndefaults
+ raise ValueError, 'failed to determine the number of arguments for %s' % (obj)
+
+
+class vectorize(object):
+ """
+ vectorize(somefunction, otypes=None, doc=None)
+ Generalized Function class.
+
+ Description:
+
+ Define a vectorized function which takes nested sequence
+ of objects or numpy arrays as inputs and returns a
+ numpy array as output, evaluating the function over successive
+ tuples of the input arrays like the python map function except it uses
+ the broadcasting rules of numpy.
+
+ Data-type of output of vectorized is determined by calling the function
+ with the first element of the input. This can be avoided by specifying
+ the otypes argument as either a string of typecode characters or a list
+ of data-types specifiers. There should be one data-type specifier for
+ each output.
+
+ Input:
+
+ somefunction -- a Python function or method
+
+ Example:
+
+ >>> def myfunc(a, b):
+ ... if a > b:
+ ... return a-b
+ ... else:
+ ... return a+b
+
+ >>> vfunc = vectorize(myfunc)
+
+ >>> vfunc([1, 2, 3, 4], 2)
+ array([3, 4, 1, 2])
+
+ """
+ def __init__(self, pyfunc, otypes='', doc=None):
+ self.thefunc = pyfunc
+ self.ufunc = None
+ nin, ndefault = _get_nargs(pyfunc)
+ if nin == 0 and ndefault == 0:
+ self.nin = None
+ self.nin_wo_defaults = None
+ else:
+ self.nin = nin
+ self.nin_wo_defaults = nin - ndefault
+ self.nout = None
+ if doc is None:
+ self.__doc__ = pyfunc.__doc__
+ else:
+ self.__doc__ = doc
+ if isinstance(otypes, types.StringType):
+ self.otypes = otypes
+ for char in self.otypes:
+ if char not in typecodes['All']:
+ raise ValueError, "invalid otype specified"
+ elif iterable(otypes):
+ self.otypes = ''.join([_nx.dtype(x).char for x in otypes])
+ else:
+ raise ValueError, "output types must be a string of typecode characters or a list of data-types"
+ self.lastcallargs = 0
+
+ def __call__(self, *args):
+ # get number of outputs and output types by calling
+ # the function on the first entries of args
+ nargs = len(args)
+ if self.nin:
+ if (nargs > self.nin) or (nargs < self.nin_wo_defaults):
+ raise ValueError, "mismatch between python function inputs"\
+ " and received arguments"
+
+ if (self.lastcallargs != nargs):
+ self.lastcallargs = nargs
+ self.ufunc = None
+ self.nout = None
+
+ if self.nout is None or self.otypes == '':
+ newargs = []
+ for arg in args:
+ newargs.append(asarray(arg).flat[0])
+ theout = self.thefunc(*newargs)
+ if isinstance(theout, types.TupleType):
+ self.nout = len(theout)
+ else:
+ self.nout = 1
+ theout = (theout,)
+ if self.otypes == '':
+ otypes = []
+ for k in range(self.nout):
+ otypes.append(asarray(theout[k]).dtype.char)
+ self.otypes = ''.join(otypes)
+
+ if (self.ufunc is None):
+ self.ufunc = frompyfunc(self.thefunc, nargs, self.nout)
+
+ if self.nout == 1:
+ _res = array(self.ufunc(*args),copy=False).astype(self.otypes[0])
+ else:
+ _res = tuple([array(x,copy=False).astype(c) \
+ for x, c in zip(self.ufunc(*args), self.otypes)])
+ return _res
+
+def cov(m, y=None, rowvar=1, bias=0):
+ """Estimate the covariance matrix.
+
+ If m is a vector, return the variance. For matrices return the
+ covariance matrix.
+
+ If y is given it is treated as an additional (set of)
+ variable(s).
+
+ Normalization is by (N-1) where N is the number of observations
+ (unbiased estimate). If bias is 1 then normalization is by N.
+
+ If rowvar is non-zero (default), then each row is a variable with
+ observations in the columns, otherwise each column
+ is a variable and the observations are in the rows.
+ """
+
+ X = array(m, ndmin=2, dtype=float)
+ if X.shape[0] == 1:
+ rowvar = 1
+ if rowvar:
+ axis = 0
+ tup = (slice(None),newaxis)
+ else:
+ axis = 1
+ tup = (newaxis, slice(None))
+
+
+ if y is not None:
+ y = array(y, copy=False, ndmin=2, dtype=float)
+ X = concatenate((X,y),axis)
+
+ X -= X.mean(axis=1-axis)[tup]
+ if rowvar:
+ N = X.shape[1]
+ else:
+ N = X.shape[0]
+
+ if bias:
+ fact = N*1.0
+ else:
+ fact = N-1.0
+
+ if not rowvar:
+ return (dot(X.T, X.conj()) / fact).squeeze()
+ else:
+ return (dot(X, X.T.conj()) / fact).squeeze()
+
+def corrcoef(x, y=None, rowvar=1, bias=0):
+ """The correlation coefficients
+ """
+ c = cov(x, y, rowvar, bias)
+ try:
+ d = diag(c)
+ except ValueError: # scalar covariance
+ return 1
+ return c/sqrt(multiply.outer(d,d))
+
+def blackman(M):
+ """blackman(M) returns the M-point Blackman window.
+ """
+ if M < 1:
+ return array([])
+ if M == 1:
+ return ones(1, float)
+ n = arange(0,M)
+ return 0.42-0.5*cos(2.0*pi*n/(M-1)) + 0.08*cos(4.0*pi*n/(M-1))
+
+def bartlett(M):
+ """bartlett(M) returns the M-point Bartlett window.
+ """
+ if M < 1:
+ return array([])
+ if M == 1:
+ return ones(1, float)
+ n = arange(0,M)
+ return where(less_equal(n,(M-1)/2.0),2.0*n/(M-1),2.0-2.0*n/(M-1))
+
+def hanning(M):
+ """hanning(M) returns the M-point Hanning window.
+ """
+ if M < 1:
+ return array([])
+ if M == 1:
+ return ones(1, float)
+ n = arange(0,M)
+ return 0.5-0.5*cos(2.0*pi*n/(M-1))
+
+def hamming(M):
+ """hamming(M) returns the M-point Hamming window.
+ """
+ if M < 1:
+ return array([])
+ if M == 1:
+ return ones(1,float)
+ n = arange(0,M)
+ return 0.54-0.46*cos(2.0*pi*n/(M-1))
+
+## Code from cephes for i0
+
+_i0A = [
+-4.41534164647933937950E-18,
+ 3.33079451882223809783E-17,
+-2.43127984654795469359E-16,
+ 1.71539128555513303061E-15,
+-1.16853328779934516808E-14,
+ 7.67618549860493561688E-14,
+-4.85644678311192946090E-13,
+ 2.95505266312963983461E-12,
+-1.72682629144155570723E-11,
+ 9.67580903537323691224E-11,
+-5.18979560163526290666E-10,
+ 2.65982372468238665035E-9,
+-1.30002500998624804212E-8,
+ 6.04699502254191894932E-8,
+-2.67079385394061173391E-7,
+ 1.11738753912010371815E-6,
+-4.41673835845875056359E-6,
+ 1.64484480707288970893E-5,
+-5.75419501008210370398E-5,
+ 1.88502885095841655729E-4,
+-5.76375574538582365885E-4,
+ 1.63947561694133579842E-3,
+-4.32430999505057594430E-3,
+ 1.05464603945949983183E-2,
+-2.37374148058994688156E-2,
+ 4.93052842396707084878E-2,
+-9.49010970480476444210E-2,
+ 1.71620901522208775349E-1,
+-3.04682672343198398683E-1,
+ 6.76795274409476084995E-1]
+
+_i0B = [
+-7.23318048787475395456E-18,
+-4.83050448594418207126E-18,
+ 4.46562142029675999901E-17,
+ 3.46122286769746109310E-17,
+-2.82762398051658348494E-16,
+-3.42548561967721913462E-16,
+ 1.77256013305652638360E-15,
+ 3.81168066935262242075E-15,
+-9.55484669882830764870E-15,
+-4.15056934728722208663E-14,
+ 1.54008621752140982691E-14,
+ 3.85277838274214270114E-13,
+ 7.18012445138366623367E-13,
+-1.79417853150680611778E-12,
+-1.32158118404477131188E-11,
+-3.14991652796324136454E-11,
+ 1.18891471078464383424E-11,
+ 4.94060238822496958910E-10,
+ 3.39623202570838634515E-9,
+ 2.26666899049817806459E-8,
+ 2.04891858946906374183E-7,
+ 2.89137052083475648297E-6,
+ 6.88975834691682398426E-5,
+ 3.36911647825569408990E-3,
+ 8.04490411014108831608E-1]
+
+def _chbevl(x, vals):
+ b0 = vals[0]
+ b1 = 0.0
+
+ for i in xrange(1,len(vals)):
+ b2 = b1
+ b1 = b0
+ b0 = x*b1 - b2 + vals[i]
+
+ return 0.5*(b0 - b2)
+
+def _i0_1(x):
+ return exp(x) * _chbevl(x/2.0-2, _i0A)
+
+def _i0_2(x):
+ return exp(x) * _chbevl(32.0/x - 2.0, _i0B) / sqrt(x)
+
+def i0(x):
+ x = atleast_1d(x).copy()
+ y = empty_like(x)
+ ind = (x<0)
+ x[ind] = -x[ind]
+ ind = (x<=8.0)
+ y[ind] = _i0_1(x[ind])
+ ind2 = ~ind
+ y[ind2] = _i0_2(x[ind2])
+ return y.squeeze()
+
+## End of cephes code for i0
+
+def kaiser(M,beta):
+ """kaiser(M, beta) returns a Kaiser window of length M with shape parameter
+ beta.
+ """
+ from numpy.dual import i0
+ n = arange(0,M)
+ alpha = (M-1)/2.0
+ return i0(beta * sqrt(1-((n-alpha)/alpha)**2.0))/i0(beta)
+
+def sinc(x):
+ """sinc(x) returns sin(pi*x)/(pi*x) at all points of array x.
+ """
+ y = pi* where(x == 0, 1.0e-20, x)
+ return sin(y)/y
+
+def msort(a):
+ b = array(a,subok=True,copy=True)
+ b.sort(0)
+ return b
+
+def median(m):
+ """median(m) returns a median of m along the first dimension of m.
+ """
+ sorted = msort(m)
+ index = int(sorted.shape[0]/2)
+ if sorted.shape[0] % 2 == 1:
+ return sorted[index]
+ else:
+ return (sorted[index-1]+sorted[index])/2.0
+
+def trapz(y, x=None, dx=1.0, axis=-1):
+ """Integrate y(x) using samples along the given axis and the composite
+ trapezoidal rule. If x is None, spacing given by dx is assumed.
+ """
+ y = asarray(y)
+ if x is None:
+ d = dx
+ else:
+ d = diff(x,axis=axis)
+ nd = len(y.shape)
+ slice1 = [slice(None)]*nd
+ slice2 = [slice(None)]*nd
+ slice1[axis] = slice(1,None)
+ slice2[axis] = slice(None,-1)
+ return add.reduce(d * (y[slice1]+y[slice2])/2.0,axis)
+
+#always succeed
+def add_newdoc(place, obj, doc):
+ """Adds documentation to obj which is in module place.
+
+ If doc is a string add it to obj as a docstring
+
+ If doc is a tuple, then the first element is interpreted as
+ an attribute of obj and the second as the docstring
+ (method, docstring)
+
+ If doc is a list, then each element of the list should be a
+ sequence of length two --> [(method1, docstring1),
+ (method2, docstring2), ...]
+
+ This routine never raises an error.
+ """
+ try:
+ new = {}
+ exec 'from %s import %s' % (place, obj) in new
+ if isinstance(doc, str):
+ add_docstring(new[obj], doc.strip())
+ elif isinstance(doc, tuple):
+ add_docstring(getattr(new[obj], doc[0]), doc[1].strip())
+ elif isinstance(doc, list):
+ for val in doc:
+ add_docstring(getattr(new[obj], val[0]), val[1].strip())
+ except:
+ pass
+
+
+# From matplotlib
+def meshgrid(x,y):
+ """
+ For vectors x, y with lengths Nx=len(x) and Ny=len(y), return X, Y
+ where X and Y are (Ny, Nx) shaped arrays with the elements of x
+ and y repeated to fill the matrix
+
+ EG,
+
+ [X, Y] = meshgrid([1,2,3], [4,5,6,7])
+
+ X =
+ 1 2 3
+ 1 2 3
+ 1 2 3
+ 1 2 3
+
+
+ Y =
+ 4 4 4
+ 5 5 5
+ 6 6 6
+ 7 7 7
+ """
+ x = asarray(x)
+ y = asarray(y)
+ numRows, numCols = len(y), len(x) # yes, reversed
+ x = x.reshape(1,numCols)
+ X = x.repeat(numRows, axis=0)
+
+ y = y.reshape(numRows,1)
+ Y = y.repeat(numCols, axis=1)
+ return X, Y
+
+def delete(arr, obj, axis=None):
+ """Return a new array with sub-arrays along an axis deleted.
+
+ Return a new array with the sub-arrays (i.e. rows or columns)
+ deleted along the given axis as specified by obj
+
+ obj may be a slice_object (s_[3:5:2]) or an integer
+ or an array of integers indicated which sub-arrays to
+ remove.
+
+ If axis is None, then ravel the array first.
+
+ Example:
+ >>> arr = [[3,4,5],
+ ... [1,2,3],
+ ... [6,7,8]]
+
+ >>> delete(arr, 1, 1)
+ array([[3, 5],
+ [1, 3],
+ [6, 8]])
+ >>> delete(arr, 1, 0)
+ array([[3, 4, 5],
+ [6, 7, 8]])
+ """
+ wrap = None
+ if type(arr) is not ndarray:
+ try:
+ wrap = arr.__array_wrap__
+ except AttributeError:
+ pass
+
+
+ arr = asarray(arr)
+ ndim = arr.ndim
+ if axis is None:
+ if ndim != 1:
+ arr = arr.ravel()
+ ndim = arr.ndim;
+ axis = ndim-1;
+ if ndim == 0:
+ if wrap:
+ return wrap(arr)
+ else:
+ return arr.copy()
+ slobj = [slice(None)]*ndim
+ N = arr.shape[axis]
+ newshape = list(arr.shape)
+ if isinstance(obj, (int, long, integer)):
+ if (obj < 0): obj += N
+ if (obj < 0 or obj >=N):
+ raise ValueError, "invalid entry"
+ newshape[axis]-=1;
+ new = empty(newshape, arr.dtype, arr.flags.fnc)
+ slobj[axis] = slice(None, obj)
+ new[slobj] = arr[slobj]
+ slobj[axis] = slice(obj,None)
+ slobj2 = [slice(None)]*ndim
+ slobj2[axis] = slice(obj+1,None)
+ new[slobj] = arr[slobj2]
+ elif isinstance(obj, slice):
+ start, stop, step = obj.indices(N)
+ numtodel = len(xrange(start, stop, step))
+ if numtodel <= 0:
+ if wrap:
+ return wrap(new)
+ else:
+ return arr.copy()
+ newshape[axis] -= numtodel
+ new = empty(newshape, arr.dtype, arr.flags.fnc)
+ # copy initial chunk
+ if start == 0:
+ pass
+ else:
+ slobj[axis] = slice(None, start)
+ new[slobj] = arr[slobj]
+ # copy end chunck
+ if stop == N:
+ pass
+ else:
+ slobj[axis] = slice(stop-numtodel,None)
+ slobj2 = [slice(None)]*ndim
+ slobj2[axis] = slice(stop, None)
+ new[slobj] = arr[slobj2]
+ # copy middle pieces
+ if step == 1:
+ pass
+ else: # use array indexing.
+ obj = arange(start, stop, step, dtype=intp)
+ all = arange(start, stop, dtype=intp)
+ obj = setdiff1d(all, obj)
+ slobj[axis] = slice(start, stop-numtodel)
+ slobj2 = [slice(None)]*ndim
+ slobj2[axis] = obj
+ new[slobj] = arr[slobj2]
+ else: # default behavior
+ obj = array(obj, dtype=intp, copy=0, ndmin=1)
+ all = arange(N, dtype=intp)
+ obj = setdiff1d(all, obj)
+ slobj[axis] = obj
+ new = arr[slobj]
+ if wrap:
+ return wrap(new)
+ else:
+ return new
+
+def insert(arr, obj, values, axis=None):
+ """Return a new array with values inserted along the given axis
+ before the given indices
+
+ If axis is None, then ravel the array first.
+
+ The obj argument can be an integer, a slice, or a sequence of
+ integers.
+
+ Example:
+ >>> a = array([[1,2,3],
+ ... [4,5,6],
+ ... [7,8,9]])
+
+ >>> insert(a, [1,2], [[4],[5]], axis=0)
+ array([[1, 2, 3],
+ [4, 4, 4],
+ [4, 5, 6],
+ [5, 5, 5],
+ [7, 8, 9]])
+ """
+ wrap = None
+ if type(arr) is not ndarray:
+ try:
+ wrap = arr.__array_wrap__
+ except AttributeError:
+ pass
+
+ arr = asarray(arr)
+ ndim = arr.ndim
+ if axis is None:
+ if ndim != 1:
+ arr = arr.ravel()
+ ndim = arr.ndim
+ axis = ndim-1
+ if (ndim == 0):
+ arr = arr.copy()
+ arr[...] = values
+ if wrap:
+ return wrap(arr)
+ else:
+ return arr
+ slobj = [slice(None)]*ndim
+ N = arr.shape[axis]
+ newshape = list(arr.shape)
+ if isinstance(obj, (int, long, integer)):
+ if (obj < 0): obj += N
+ if obj < 0 or obj > N:
+ raise ValueError, "index (%d) out of range (0<=index<=%d) "\
+ "in dimension %d" % (obj, N, axis)
+ newshape[axis] += 1;
+ new = empty(newshape, arr.dtype, arr.flags.fnc)
+ slobj[axis] = slice(None, obj)
+ new[slobj] = arr[slobj]
+ slobj[axis] = obj
+ new[slobj] = values
+ slobj[axis] = slice(obj+1,None)
+ slobj2 = [slice(None)]*ndim
+ slobj2[axis] = slice(obj,None)
+ new[slobj] = arr[slobj2]
+ if wrap:
+ return wrap(new)
+ return new
+
+ elif isinstance(obj, slice):
+ # turn it into a range object
+ obj = arange(*obj.indices(N),**{'dtype':intp})
+
+ # get two sets of indices
+ # one is the indices which will hold the new stuff
+ # two is the indices where arr will be copied over
+
+ obj = asarray(obj, dtype=intp)
+ numnew = len(obj)
+ index1 = obj + arange(numnew)
+ index2 = setdiff1d(arange(numnew+N),index1)
+ newshape[axis] += numnew
+ new = empty(newshape, arr.dtype, arr.flags.fnc)
+ slobj2 = [slice(None)]*ndim
+ slobj[axis] = index1
+ slobj2[axis] = index2
+ new[slobj] = values
+ new[slobj2] = arr
+
+ if wrap:
+ return wrap(new)
+ return new
+
+def append(arr, values, axis=None):
+ """Append to the end of an array along axis (ravel first if None)
+ """
+ arr = asanyarray(arr)
+ if axis is None:
+ if arr.ndim != 1:
+ arr = arr.ravel()
+ values = ravel(values)
+ axis = arr.ndim-1
+ return concatenate((arr, values), axis=axis)
diff --git a/numpy/lib/getlimits.py b/numpy/lib/getlimits.py
new file mode 100644
index 000000000..00c3ea846
--- /dev/null
+++ b/numpy/lib/getlimits.py
@@ -0,0 +1,175 @@
+""" Machine limits for Float32 and Float64 and (long double) if available...
+"""
+
+__all__ = ['finfo','iinfo']
+
+from machar import MachAr
+import numpy.core.numeric as numeric
+import numpy.core.numerictypes as ntypes
+from numpy.core.numeric import array
+import numpy as N
+
+def _frz(a):
+ """fix rank-0 --> rank-1"""
+ if a.ndim == 0: a.shape = (1,)
+ return a
+
+_convert_to_float = {
+ ntypes.csingle: ntypes.single,
+ ntypes.complex_: ntypes.float_,
+ ntypes.clongfloat: ntypes.longfloat
+ }
+
+class finfo(object):
+ """Machine limits for floating point types.
+
+ :Parameters:
+ dtype : floating point type or instance
+
+ :SeeAlso:
+ - numpy.lib.machar.MachAr
+
+ """
+
+ _finfo_cache = {}
+
+ def __new__(cls, dtype):
+ obj = cls._finfo_cache.get(dtype,None)
+ if obj is not None:
+ return obj
+ dtypes = [dtype]
+ newdtype = numeric.obj2sctype(dtype)
+ if newdtype is not dtype:
+ dtypes.append(newdtype)
+ dtype = newdtype
+ if not issubclass(dtype, numeric.inexact):
+ raise ValueError, "data type %r not inexact" % (dtype)
+ obj = cls._finfo_cache.get(dtype,None)
+ if obj is not None:
+ return obj
+ if not issubclass(dtype, numeric.floating):
+ newdtype = _convert_to_float[dtype]
+ if newdtype is not dtype:
+ dtypes.append(newdtype)
+ dtype = newdtype
+ obj = cls._finfo_cache.get(dtype,None)
+ if obj is not None:
+ return obj
+ obj = object.__new__(cls)._init(dtype)
+ for dt in dtypes:
+ cls._finfo_cache[dt] = obj
+ return obj
+
+ def _init(self, dtype):
+ self.dtype = dtype
+ if dtype is ntypes.double:
+ itype = ntypes.int64
+ fmt = '%24.16e'
+ precname = 'double'
+ elif dtype is ntypes.single:
+ itype = ntypes.int32
+ fmt = '%15.7e'
+ precname = 'single'
+ elif dtype is ntypes.longdouble:
+ itype = ntypes.longlong
+ fmt = '%s'
+ precname = 'long double'
+ else:
+ raise ValueError, repr(dtype)
+
+ machar = MachAr(lambda v:array([v], dtype),
+ lambda v:_frz(v.astype(itype))[0],
+ lambda v:array(_frz(v)[0], dtype),
+ lambda v: fmt % array(_frz(v)[0], dtype),
+ 'numpy %s precision floating point number' % precname)
+
+ for word in ['precision', 'iexp',
+ 'maxexp','minexp','negep',
+ 'machep']:
+ setattr(self,word,getattr(machar, word))
+ for word in ['tiny','resolution','epsneg']:
+ setattr(self,word,getattr(machar, word).squeeze())
+ self.max = machar.huge.flat[0]
+ self.min = -self.max
+ self.eps = machar.eps.flat[0]
+ self.nexp = machar.iexp
+ self.nmant = machar.it
+ self.machar = machar
+ self._str_tiny = machar._str_xmin
+ self._str_max = machar._str_xmax
+ self._str_epsneg = machar._str_epsneg
+ self._str_eps = machar._str_eps
+ self._str_resolution = machar._str_resolution
+ return self
+
+ def __str__(self):
+ return '''\
+Machine parameters for %(dtype)s
+---------------------------------------------------------------------
+precision=%(precision)3s resolution=%(_str_resolution)s
+machep=%(machep)6s eps= %(_str_eps)s
+negep =%(negep)6s epsneg= %(_str_epsneg)s
+minexp=%(minexp)6s tiny= %(_str_tiny)s
+maxexp=%(maxexp)6s max= %(_str_max)s
+nexp =%(nexp)6s min= -max
+---------------------------------------------------------------------
+''' % self.__dict__
+
+
+class iinfo:
+ """Limits for integer types.
+
+ :Parameters:
+ type : integer type or instance
+
+ """
+
+ _min_vals = {}
+ _max_vals = {}
+
+ def __init__(self, type):
+ self.dtype = N.dtype(type)
+ self.kind = self.dtype.kind
+ self.bits = self.dtype.itemsize * 8
+ self.key = "%s%d" % (self.kind, self.bits)
+ if not self.kind in 'iu':
+ raise ValueError("Invalid integer data type.")
+
+ def min(self):
+ """Minimum value of given dtype."""
+ if self.kind == 'u':
+ return 0
+ else:
+ try:
+ val = iinfo._min_vals[self.key]
+ except KeyError:
+ val = int(-(1L << (self.bits-1)))
+ iinfo._min_vals[self.key] = val
+ return val
+
+ min = property(min)
+
+ def max(self):
+ """Maximum value of given dtype."""
+ try:
+ val = iinfo._max_vals[self.key]
+ except KeyError:
+ if self.kind == 'u':
+ val = int((1L << self.bits) - 1)
+ else:
+ val = int((1L << (self.bits-1)) - 1)
+ iinfo._max_vals[self.key] = val
+ return val
+
+ max = property(max)
+
+if __name__ == '__main__':
+ f = finfo(ntypes.single)
+ print 'single epsilon:',f.eps
+ print 'single tiny:',f.tiny
+ f = finfo(ntypes.float)
+ print 'float epsilon:',f.eps
+ print 'float tiny:',f.tiny
+ f = finfo(ntypes.longfloat)
+ print 'longfloat epsilon:',f.eps
+ print 'longfloat tiny:',f.tiny
diff --git a/numpy/lib/index_tricks.py b/numpy/lib/index_tricks.py
new file mode 100644
index 000000000..8e6f36e30
--- /dev/null
+++ b/numpy/lib/index_tricks.py
@@ -0,0 +1,457 @@
+## Automatically adapted for numpy Sep 19, 2005 by convertcode.py
+
+__all__ = ['unravel_index',
+ 'mgrid',
+ 'ogrid',
+ 'r_', 'c_', 's_',
+ 'index_exp', 'ix_',
+ 'ndenumerate','ndindex']
+
+import sys
+import numpy.core.numeric as _nx
+from numpy.core.numeric import asarray, ScalarType, array
+import math
+
+import function_base
+import numpy.core.defmatrix as matrix
+makemat = matrix.matrix
+
+# contributed by Stefan van der Walt
+def unravel_index(x,dims):
+ """Convert a flat index into an index tuple for an array of given shape.
+
+ e.g. for a 2x2 array, unravel_index(2,(2,2)) returns (1,0).
+
+ Example usage:
+ p = x.argmax()
+ idx = unravel_index(p,x.shape)
+ x[idx] == x.max()
+
+ Note: x.flat[p] == x.max()
+
+ Thus, it may be easier to use flattened indexing than to re-map
+ the index to a tuple.
+ """
+ if x > _nx.prod(dims)-1 or x < 0:
+ raise ValueError("Invalid index, must be 0 <= x <= number of elements.")
+
+ idx = _nx.empty_like(dims)
+
+ # Take dimensions
+ # [a,b,c,d]
+ # Reverse and drop first element
+ # [d,c,b]
+ # Prepend [1]
+ # [1,d,c,b]
+ # Calculate cumulative product
+ # [1,d,dc,dcb]
+ # Reverse
+ # [dcb,dc,d,1]
+ dim_prod = _nx.cumprod([1] + list(dims)[:0:-1])[::-1]
+ # Indeces become [x/dcb % a, x/dc % b, x/d % c, x/1 % d]
+ return tuple(x/dim_prod % dims)
+
+def ix_(*args):
+ """ Construct an open mesh from multiple sequences.
+
+ This function takes n 1-d sequences and returns n outputs with n
+ dimensions each such that the shape is 1 in all but one dimension and
+ the dimension with the non-unit shape value cycles through all n
+ dimensions.
+
+ Using ix_() one can quickly construct index arrays that will index
+ the cross product.
+
+ a[ix_([1,3,7],[2,5,8])] returns the array
+
+ a[1,2] a[1,5] a[1,8]
+ a[3,2] a[3,5] a[3,8]
+ a[7,2] a[7,5] a[7,8]
+ """
+ out = []
+ nd = len(args)
+ baseshape = [1]*nd
+ for k in range(nd):
+ new = _nx.asarray(args[k])
+ if (new.ndim != 1):
+ raise ValueError, "Cross index must be 1 dimensional"
+ if issubclass(new.dtype.type, _nx.bool_):
+ new = new.nonzero()[0]
+ baseshape[k] = len(new)
+ new = new.reshape(tuple(baseshape))
+ out.append(new)
+ baseshape[k] = 1
+ return tuple(out)
+
+class nd_grid(object):
+ """ Construct a "meshgrid" in N-dimensions.
+
+ grid = nd_grid() creates an instance which will return a mesh-grid
+ when indexed. The dimension and number of the output arrays are equal
+ to the number of indexing dimensions. If the step length is not a
+ complex number, then the stop is not inclusive.
+
+ However, if the step length is a COMPLEX NUMBER (e.g. 5j), then the
+ integer part of it's magnitude is interpreted as specifying the
+ number of points to create between the start and stop values, where
+ the stop value IS INCLUSIVE.
+
+ If instantiated with an argument of sparse=True, the mesh-grid is
+ open (or not fleshed out) so that only one-dimension of each returned
+ argument is greater than 1
+
+ Example:
+
+ >>> mgrid = nd_grid()
+ >>> mgrid[0:5,0:5]
+ array([[[0, 0, 0, 0, 0],
+ [1, 1, 1, 1, 1],
+ [2, 2, 2, 2, 2],
+ [3, 3, 3, 3, 3],
+ [4, 4, 4, 4, 4]],
+ <BLANKLINE>
+ [[0, 1, 2, 3, 4],
+ [0, 1, 2, 3, 4],
+ [0, 1, 2, 3, 4],
+ [0, 1, 2, 3, 4],
+ [0, 1, 2, 3, 4]]])
+ >>> mgrid[-1:1:5j]
+ array([-1. , -0.5, 0. , 0.5, 1. ])
+
+ >>> ogrid = nd_grid(sparse=True)
+ >>> ogrid[0:5,0:5]
+ [array([[0],
+ [1],
+ [2],
+ [3],
+ [4]]), array([[0, 1, 2, 3, 4]])]
+
+ """
+ def __init__(self, sparse=False):
+ self.sparse = sparse
+ def __getitem__(self,key):
+ try:
+ size = []
+ typ = int
+ for k in range(len(key)):
+ step = key[k].step
+ start = key[k].start
+ if start is None: start=0
+ if step is None: step=1
+ if isinstance(step, complex):
+ size.append(int(abs(step)))
+ typ = float
+ else:
+ size.append(math.ceil((key[k].stop - start)/(step*1.0)))
+ if isinstance(step, float) or \
+ isinstance(start, float) or \
+ isinstance(key[k].stop, float):
+ typ = float
+ if self.sparse:
+ nn = map(lambda x,t: _nx.arange(x, dtype=t), size, \
+ (typ,)*len(size))
+ else:
+ nn = _nx.indices(size, typ)
+ for k in range(len(size)):
+ step = key[k].step
+ start = key[k].start
+ if start is None: start=0
+ if step is None: step=1
+ if isinstance(step, complex):
+ step = int(abs(step))
+ if step != 1:
+ step = (key[k].stop - start)/float(step-1)
+ nn[k] = (nn[k]*step+start)
+ if self.sparse:
+ slobj = [_nx.newaxis]*len(size)
+ for k in range(len(size)):
+ slobj[k] = slice(None,None)
+ nn[k] = nn[k][slobj]
+ slobj[k] = _nx.newaxis
+ return nn
+ except (IndexError, TypeError):
+ step = key.step
+ stop = key.stop
+ start = key.start
+ if start is None: start = 0
+ if isinstance(step, complex):
+ step = abs(step)
+ length = int(step)
+ if step != 1:
+ step = (key.stop-start)/float(step-1)
+ stop = key.stop+step
+ return _nx.arange(0, length,1, float)*step + start
+ else:
+ return _nx.arange(start, stop, step)
+
+ def __getslice__(self,i,j):
+ return _nx.arange(i,j)
+
+ def __len__(self):
+ return 0
+
+mgrid = nd_grid(sparse=False)
+ogrid = nd_grid(sparse=True)
+
+class concatenator(object):
+ """Translates slice objects to concatenation along an axis.
+ """
+ def _retval(self, res):
+ if self.matrix:
+ oldndim = res.ndim
+ res = makemat(res)
+ if oldndim == 1 and self.col:
+ res = res.T
+ self.axis = self._axis
+ self.matrix = self._matrix
+ self.col = 0
+ return res
+
+ def __init__(self, axis=0, matrix=False, ndmin=1, trans1d=-1):
+ self._axis = axis
+ self._matrix = matrix
+ self.axis = axis
+ self.matrix = matrix
+ self.col = 0
+ self.trans1d = trans1d
+ self.ndmin = ndmin
+
+ def __getitem__(self,key):
+ trans1d = self.trans1d
+ ndmin = self.ndmin
+ if isinstance(key, str):
+ frame = sys._getframe().f_back
+ mymat = matrix.bmat(key,frame.f_globals,frame.f_locals)
+ return mymat
+ if type(key) is not tuple:
+ key = (key,)
+ objs = []
+ scalars = []
+ final_dtypedescr = None
+ for k in range(len(key)):
+ scalar = False
+ if type(key[k]) is slice:
+ step = key[k].step
+ start = key[k].start
+ stop = key[k].stop
+ if start is None: start = 0
+ if step is None:
+ step = 1
+ if isinstance(step, complex):
+ size = int(abs(step))
+ newobj = function_base.linspace(start, stop, num=size)
+ else:
+ newobj = _nx.arange(start, stop, step)
+ if ndmin > 1:
+ newobj = array(newobj,copy=False,ndmin=ndmin)
+ if trans1d != -1:
+ newobj = newobj.swapaxes(-1,trans1d)
+ elif isinstance(key[k],str):
+ if k != 0:
+ raise ValueError, "special directives must be the"\
+ "first entry."
+ key0 = key[0]
+ if key0 in 'rc':
+ self.matrix = True
+ self.col = (key0 == 'c')
+ continue
+ if ',' in key0:
+ vec = key0.split(',')
+ try:
+ self.axis, ndmin = \
+ [int(x) for x in vec[:2]]
+ if len(vec) == 3:
+ trans1d = int(vec[2])
+ continue
+ except:
+ raise ValueError, "unknown special directive"
+ try:
+ self.axis = int(key[k])
+ continue
+ except (ValueError, TypeError):
+ raise ValueError, "unknown special directive"
+ elif type(key[k]) in ScalarType:
+ newobj = array(key[k],ndmin=ndmin)
+ scalars.append(k)
+ scalar = True
+ else:
+ newobj = key[k]
+ if ndmin > 1:
+ tempobj = array(newobj, copy=False, subok=True)
+ newobj = array(newobj, copy=False, subok=True,
+ ndmin=ndmin)
+ if trans1d != -1 and tempobj.ndim < ndmin:
+ k2 = ndmin-tempobj.ndim
+ if (trans1d < 0):
+ trans1d += k2 + 1
+ defaxes = range(ndmin)
+ k1 = trans1d
+ axes = defaxes[:k1] + defaxes[k2:] + \
+ defaxes[k1:k2]
+ newobj = newobj.transpose(axes)
+ del tempobj
+ objs.append(newobj)
+ if isinstance(newobj, _nx.ndarray) and not scalar:
+ if final_dtypedescr is None:
+ final_dtypedescr = newobj.dtype
+ elif newobj.dtype > final_dtypedescr:
+ final_dtypedescr = newobj.dtype
+ if final_dtypedescr is not None:
+ for k in scalars:
+ objs[k] = objs[k].astype(final_dtypedescr)
+ res = _nx.concatenate(tuple(objs),axis=self.axis)
+ return self._retval(res)
+
+ def __getslice__(self,i,j):
+ res = _nx.arange(i,j)
+ return self._retval(res)
+
+ def __len__(self):
+ return 0
+
+# separate classes are used here instead of just making r_ = concatentor(0),
+# etc. because otherwise we couldn't get the doc string to come out right
+# in help(r_)
+
+class r_class(concatenator):
+ """Translates slice objects to concatenation along the first axis.
+
+ For example:
+ >>> r_[array([1,2,3]), 0, 0, array([4,5,6])]
+ array([1, 2, 3, 0, 0, 4, 5, 6])
+
+ """
+ def __init__(self):
+ concatenator.__init__(self, 0)
+
+r_ = r_class()
+
+class c_class(concatenator):
+ """Translates slice objects to concatenation along the second axis.
+ """
+ def __init__(self):
+ concatenator.__init__(self, -1, ndmin=2, trans1d=0)
+
+c_ = c_class()
+
+class ndenumerate(object):
+ """
+ A simple nd index iterator over an array.
+
+ Example:
+ >>> a = array([[1,2],[3,4]])
+ >>> for index, x in ndenumerate(a):
+ ... print index, x
+ (0, 0) 1
+ (0, 1) 2
+ (1, 0) 3
+ (1, 1) 4
+ """
+ def __init__(self, arr):
+ self.iter = asarray(arr).flat
+
+ def next(self):
+ return self.iter.coords, self.iter.next()
+
+ def __iter__(self):
+ return self
+
+
+class ndindex(object):
+ """Pass in a sequence of integers corresponding
+ to the number of dimensions in the counter. This iterator
+ will then return an N-dimensional counter.
+
+ Example:
+ >>> for index in ndindex(3,2,1):
+ ... print index
+ (0, 0, 0)
+ (0, 1, 0)
+ (1, 0, 0)
+ (1, 1, 0)
+ (2, 0, 0)
+ (2, 1, 0)
+
+ """
+
+ def __init__(self, *args):
+ if len(args) == 1 and isinstance(args[0], tuple):
+ args = args[0]
+ self.nd = len(args)
+ self.ind = [0]*self.nd
+ self.index = 0
+ self.maxvals = args
+ tot = 1
+ for k in range(self.nd):
+ tot *= args[k]
+ self.total = tot
+
+ def _incrementone(self, axis):
+ if (axis < 0): # base case
+ return
+ if (self.ind[axis] < self.maxvals[axis]-1):
+ self.ind[axis] += 1
+ else:
+ self.ind[axis] = 0
+ self._incrementone(axis-1)
+
+ def ndincr(self):
+ self._incrementone(self.nd-1)
+
+ def next(self):
+ if (self.index >= self.total):
+ raise StopIteration
+ val = tuple(self.ind)
+ self.index += 1
+ self.ndincr()
+ return val
+
+ def __iter__(self):
+ return self
+
+
+
+
+# You can do all this with slice() plus a few special objects,
+# but there's a lot to remember. This version is simpler because
+# it uses the standard array indexing syntax.
+#
+# Written by Konrad Hinsen <hinsen@cnrs-orleans.fr>
+# last revision: 1999-7-23
+#
+# Cosmetic changes by T. Oliphant 2001
+#
+#
+
+class _index_expression_class(object):
+ """
+ A nicer way to build up index tuples for arrays.
+
+ For any index combination, including slicing and axis insertion,
+ 'a[indices]' is the same as 'a[index_exp[indices]]' for any
+ array 'a'. However, 'index_exp[indices]' can be used anywhere
+ in Python code and returns a tuple of slice objects that can be
+ used in the construction of complex index expressions.
+ """
+ maxint = sys.maxint
+ def __init__(self, maketuple):
+ self.maketuple = maketuple
+
+ def __getitem__(self, item):
+ if self.maketuple and type(item) != type(()):
+ return (item,)
+ else:
+ return item
+
+ def __len__(self):
+ return self.maxint
+
+ def __getslice__(self, start, stop):
+ if stop == self.maxint:
+ stop = None
+ return self[start:stop:None]
+
+index_exp = _index_expression_class(1)
+s_ = _index_expression_class(0)
+
+# End contribution from Konrad.
diff --git a/numpy/lib/info.py b/numpy/lib/info.py
new file mode 100644
index 000000000..0944fa9b5
--- /dev/null
+++ b/numpy/lib/info.py
@@ -0,0 +1,136 @@
+__doc_title__ = """Basic functions used by several sub-packages and
+useful to have in the main name-space."""
+__doc__ = __doc_title__ + """
+
+Type handling
+==============
+iscomplexobj -- Test for complex object, scalar result
+isrealobj -- Test for real object, scalar result
+iscomplex -- Test for complex elements, array result
+isreal -- Test for real elements, array result
+imag -- Imaginary part
+real -- Real part
+real_if_close -- Turns complex number with tiny imaginary part to real
+isneginf -- Tests for negative infinity ---|
+isposinf -- Tests for positive infinity |
+isnan -- Tests for nans |---- array results
+isinf -- Tests for infinity |
+isfinite -- Tests for finite numbers ---|
+isscalar -- True if argument is a scalar
+nan_to_num -- Replaces NaN's with 0 and infinities with large numbers
+cast -- Dictionary of functions to force cast to each type
+common_type -- Determine the 'minimum common type code' for a group
+ of arrays
+mintypecode -- Return minimal allowed common typecode.
+
+Index tricks
+==================
+mgrid -- Method which allows easy construction of N-d 'mesh-grids'
+r_ -- Append and construct arrays: turns slice objects into
+ ranges and concatenates them, for 2d arrays appends
+ rows.
+index_exp -- Konrad Hinsen's index_expression class instance which
+ can be useful for building complicated slicing syntax.
+
+Useful functions
+==================
+select -- Extension of where to multiple conditions and choices
+extract -- Extract 1d array from flattened array according to mask
+insert -- Insert 1d array of values into Nd array according to mask
+linspace -- Evenly spaced samples in linear space
+logspace -- Evenly spaced samples in logarithmic space
+fix -- Round x to nearest integer towards zero
+mod -- Modulo mod(x,y) = x % y except keeps sign of y
+amax -- Array maximum along axis
+amin -- Array minimum along axis
+ptp -- Array max-min along axis
+cumsum -- Cumulative sum along axis
+prod -- Product of elements along axis
+cumprod -- Cumluative product along axis
+diff -- Discrete differences along axis
+angle -- Returns angle of complex argument
+unwrap -- Unwrap phase along given axis (1-d algorithm)
+sort_complex -- Sort a complex-array (based on real, then imaginary)
+trim_zeros -- trim the leading and trailing zeros from 1D array.
+
+vectorize -- a class that wraps a Python function taking scalar
+ arguments into a generalized function which
+ can handle arrays of arguments using the broadcast
+ rules of numerix Python.
+
+Shape manipulation
+===================
+squeeze -- Return a with length-one dimensions removed.
+atleast_1d -- Force arrays to be > 1D
+atleast_2d -- Force arrays to be > 2D
+atleast_3d -- Force arrays to be > 3D
+vstack -- Stack arrays vertically (row on row)
+hstack -- Stack arrays horizontally (column on column)
+column_stack -- Stack 1D arrays as columns into 2D array
+dstack -- Stack arrays depthwise (along third dimension)
+split -- Divide array into a list of sub-arrays
+hsplit -- Split into columns
+vsplit -- Split into rows
+dsplit -- Split along third dimension
+
+Matrix (2d array) manipluations
+===============================
+fliplr -- 2D array with columns flipped
+flipud -- 2D array with rows flipped
+rot90 -- Rotate a 2D array a multiple of 90 degrees
+eye -- Return a 2D array with ones down a given diagonal
+diag -- Construct a 2D array from a vector, or return a given
+ diagonal from a 2D array.
+mat -- Construct a Matrix
+bmat -- Build a Matrix from blocks
+
+Polynomials
+============
+poly1d -- A one-dimensional polynomial class
+
+poly -- Return polynomial coefficients from roots
+roots -- Find roots of polynomial given coefficients
+polyint -- Integrate polynomial
+polyder -- Differentiate polynomial
+polyadd -- Add polynomials
+polysub -- Substract polynomials
+polymul -- Multiply polynomials
+polydiv -- Divide polynomials
+polyval -- Evaluate polynomial at given argument
+
+Import tricks
+=============
+ppimport -- Postpone module import until trying to use it
+ppimport_attr -- Postpone module import until trying to use its
+ attribute
+ppresolve -- Import postponed module and return it.
+
+Machine arithmetics
+===================
+machar_single -- MachAr instance storing the parameters of system
+ single precision floating point arithmetics
+machar_double -- MachAr instance storing the parameters of system
+ double precision floating point arithmetics
+
+Threading tricks
+================
+ParallelExec -- Execute commands in parallel thread.
+
+1D array set operations
+=======================
+Set operations for 1D numeric arrays based on sort() function.
+
+ediff1d -- Array difference (auxiliary function).
+unique1d -- Unique elements of 1D array.
+intersect1d -- Intersection of 1D arrays with unique elements.
+intersect1d_nu -- Intersection of 1D arrays with any elements.
+setxor1d -- Set exclusive-or of 1D arrays with unique elements.
+setmember1d -- Return an array of shape of ar1 containing 1 where
+ the elements of ar1 are in ar2 and 0 otherwise.
+union1d -- Union of 1D arrays with unique elements.
+setdiff1d -- Set difference of 1D arrays with unique elements.
+
+"""
+
+depends = ['core','testing']
+global_symbols = ['*']
diff --git a/numpy/lib/machar.py b/numpy/lib/machar.py
new file mode 100644
index 000000000..9d0e08e45
--- /dev/null
+++ b/numpy/lib/machar.py
@@ -0,0 +1,285 @@
+"""
+Machine arithmetics - determine the parameters of the
+floating-point arithmetic system
+"""
+# Author: Pearu Peterson, September 2003
+
+
+__all__ = ['MachAr']
+
+from numpy.core.fromnumeric import any
+
+# Need to speed this up...especially for longfloat
+
+class MachAr(object):
+ """Diagnosing machine parameters.
+
+ The following attributes are available:
+
+ ibeta - radix in which numbers are represented
+ it - number of base-ibeta digits in the floating point mantissa M
+ machep - exponent of the smallest (most negative) power of ibeta that,
+ added to 1.0,
+ gives something different from 1.0
+ eps - floating-point number beta**machep (floating point precision)
+ negep - exponent of the smallest power of ibeta that, substracted
+ from 1.0, gives something different from 1.0
+ epsneg - floating-point number beta**negep
+ iexp - number of bits in the exponent (including its sign and bias)
+ minexp - smallest (most negative) power of ibeta consistent with there
+ being no leading zeros in the mantissa
+ xmin - floating point number beta**minexp (the smallest (in
+ magnitude) usable floating value)
+ maxexp - smallest (positive) power of ibeta that causes overflow
+ xmax - (1-epsneg)* beta**maxexp (the largest (in magnitude)
+ usable floating value)
+ irnd - in range(6), information on what kind of rounding is done
+ in addition, and on how underflow is handled
+ ngrd - number of 'guard digits' used when truncating the product
+ of two mantissas to fit the representation
+
+ epsilon - same as eps
+ tiny - same as xmin
+ huge - same as xmax
+ precision - int(-log10(eps))
+ resolution - 10**(-precision)
+
+ Reference:
+ Numerical Recipies.
+ """
+ def __init__(self, float_conv=float,int_conv=int,
+ float_to_float=float,
+ float_to_str = lambda v:'%24.16e' % v,
+ title = 'Python floating point number'):
+ """
+ float_conv - convert integer to float (array)
+ int_conv - convert float (array) to integer
+ float_to_float - convert float array to float
+ float_to_str - convert array float to str
+ title - description of used floating point numbers
+ """
+ max_iterN = 10000
+ msg = "Did not converge after %d tries with %s"
+ one = float_conv(1)
+ two = one + one
+ zero = one - one
+
+ # Do we really need to do this? Aren't they 2 and 2.0?
+ # Determine ibeta and beta
+ a = one
+ for _ in xrange(max_iterN):
+ a = a + a
+ temp = a + one
+ temp1 = temp - a
+ if any(temp1 - one != zero):
+ break
+ else:
+ raise RuntimeError, msg % (_, one.dtype)
+ b = one
+ for _ in xrange(max_iterN):
+ b = b + b
+ temp = a + b
+ itemp = int_conv(temp-a)
+ if any(itemp != 0):
+ break
+ else:
+ raise RuntimeError, msg % (_, one.dtype)
+ ibeta = itemp
+ beta = float_conv(ibeta)
+
+ # Determine it and irnd
+ it = -1
+ b = one
+ for _ in xrange(max_iterN):
+ it = it + 1
+ b = b * beta
+ temp = b + one
+ temp1 = temp - b
+ if any(temp1 - one != zero):
+ break
+ else:
+ raise RuntimeError, msg % (_, one.dtype)
+
+ betah = beta / two
+ a = one
+ for _ in xrange(max_iterN):
+ a = a + a
+ temp = a + one
+ temp1 = temp - a
+ if any(temp1 - one != zero):
+ break
+ else:
+ raise RuntimeError, msg % (_, one.dtype)
+ temp = a + betah
+ irnd = 0
+ if any(temp-a != zero):
+ irnd = 1
+ tempa = a + beta
+ temp = tempa + betah
+ if irnd==0 and any(temp-tempa != zero):
+ irnd = 2
+
+ # Determine negep and epsneg
+ negep = it + 3
+ betain = one / beta
+ a = one
+ for i in range(negep):
+ a = a * betain
+ b = a
+ for _ in xrange(max_iterN):
+ temp = one - a
+ if any(temp-one != zero):
+ break
+ a = a * beta
+ negep = negep - 1
+ # Prevent infinite loop on PPC with gcc 4.0:
+ if negep < 0:
+ raise RuntimeError, "could not determine machine tolerance " \
+ "for 'negep', locals() -> %s" % (locals())
+ else:
+ raise RuntimeError, msg % (_, one.dtype)
+ negep = -negep
+ epsneg = a
+
+ # Determine machep and eps
+ machep = - it - 3
+ a = b
+
+ for _ in xrange(max_iterN):
+ temp = one + a
+ if any(temp-one != zero):
+ break
+ a = a * beta
+ machep = machep + 1
+ else:
+ raise RuntimeError, msg % (_, one.dtype)
+ eps = a
+
+ # Determine ngrd
+ ngrd = 0
+ temp = one + eps
+ if irnd==0 and any(temp*one - one != zero):
+ ngrd = 1
+
+ # Determine iexp
+ i = 0
+ k = 1
+ z = betain
+ t = one + eps
+ nxres = 0
+ for _ in xrange(max_iterN):
+ y = z
+ z = y*y
+ a = z*one # Check here for underflow
+ temp = z*t
+ if any(a+a == zero) or any(abs(z)>=y):
+ break
+ temp1 = temp * betain
+ if any(temp1*beta == z):
+ break
+ i = i + 1
+ k = k + k
+ else:
+ raise RuntimeError, msg % (_, one.dtype)
+ if ibeta != 10:
+ iexp = i + 1
+ mx = k + k
+ else:
+ iexp = 2
+ iz = ibeta
+ while k >= iz:
+ iz = iz * ibeta
+ iexp = iexp + 1
+ mx = iz + iz - 1
+
+ # Determine minexp and xmin
+ for _ in xrange(max_iterN):
+ xmin = y
+ y = y * betain
+ a = y * one
+ temp = y * t
+ if any(a+a != zero) and any(abs(y) < xmin):
+ k = k + 1
+ temp1 = temp * betain
+ if any(temp1*beta == y) and any(temp != y):
+ nxres = 3
+ xmin = y
+ break
+ else:
+ break
+ else:
+ raise RuntimeError, msg % (_, one.dtype)
+ minexp = -k
+
+ # Determine maxexp, xmax
+ if mx <= k + k - 3 and ibeta != 10:
+ mx = mx + mx
+ iexp = iexp + 1
+ maxexp = mx + minexp
+ irnd = irnd + nxres
+ if irnd >= 2:
+ maxexp = maxexp - 2
+ i = maxexp + minexp
+ if ibeta == 2 and not i:
+ maxexp = maxexp - 1
+ if i > 20:
+ maxexp = maxexp - 1
+ if any(a != y):
+ maxexp = maxexp - 2
+ xmax = one - epsneg
+ if any(xmax*one != xmax):
+ xmax = one - beta*epsneg
+ xmax = xmax / (xmin*beta*beta*beta)
+ i = maxexp + minexp + 3
+ for j in range(i):
+ if ibeta==2:
+ xmax = xmax + xmax
+ else:
+ xmax = xmax * beta
+
+ self.ibeta = ibeta
+ self.it = it
+ self.negep = negep
+ self.epsneg = float_to_float(epsneg)
+ self._str_epsneg = float_to_str(epsneg)
+ self.machep = machep
+ self.eps = float_to_float(eps)
+ self._str_eps = float_to_str(eps)
+ self.ngrd = ngrd
+ self.iexp = iexp
+ self.minexp = minexp
+ self.xmin = float_to_float(xmin)
+ self._str_xmin = float_to_str(xmin)
+ self.maxexp = maxexp
+ self.xmax = float_to_float(xmax)
+ self._str_xmax = float_to_str(xmax)
+ self.irnd = irnd
+
+ self.title = title
+ # Commonly used parameters
+ self.epsilon = self.eps
+ self.tiny = self.xmin
+ self.huge = self.xmax
+
+ import math
+ self.precision = int(-math.log10(float_to_float(self.eps)))
+ ten = two + two + two + two + two
+ resolution = ten ** (-self.precision)
+ self.resolution = float_to_float(resolution)
+ self._str_resolution = float_to_str(resolution)
+
+ def __str__(self):
+ return '''\
+Machine parameters for %(title)s
+---------------------------------------------------------------------
+ibeta=%(ibeta)s it=%(it)s iexp=%(iexp)s ngrd=%(ngrd)s irnd=%(irnd)s
+machep=%(machep)s eps=%(_str_eps)s (beta**machep == epsilon)
+negep =%(negep)s epsneg=%(_str_epsneg)s (beta**epsneg)
+minexp=%(minexp)s xmin=%(_str_xmin)s (beta**minexp == tiny)
+maxexp=%(maxexp)s xmax=%(_str_xmax)s ((1-epsneg)*beta**maxexp == huge)
+---------------------------------------------------------------------
+''' % self.__dict__
+
+
+if __name__ == '__main__':
+ print MachAr()
diff --git a/numpy/lib/polynomial.py b/numpy/lib/polynomial.py
new file mode 100644
index 000000000..b35926900
--- /dev/null
+++ b/numpy/lib/polynomial.py
@@ -0,0 +1,657 @@
+"""
+Functions to operate on polynomials.
+"""
+
+__all__ = ['poly', 'roots', 'polyint', 'polyder', 'polyadd',
+ 'polysub', 'polymul', 'polydiv', 'polyval', 'poly1d',
+ 'polyfit', 'RankWarning']
+
+import re
+import warnings
+import numpy.core.numeric as NX
+
+from numpy.core import isscalar, abs
+from numpy.lib.getlimits import finfo
+from numpy.lib.twodim_base import diag, vander
+from numpy.lib.shape_base import hstack, atleast_1d
+from numpy.lib.function_base import trim_zeros, sort_complex
+eigvals = None
+lstsq = None
+_single_eps = finfo(NX.single).eps
+_double_eps = finfo(NX.double).eps
+
+class RankWarning(UserWarning):
+ """Issued by polyfit when Vandermonde matrix is rank deficient.
+ """
+ pass
+
+def get_linalg_funcs():
+ "Look for linear algebra functions in numpy"
+ global eigvals, lstsq
+ from numpy.dual import eigvals, lstsq
+ return
+
+def _eigvals(arg):
+ "Return the eigenvalues of the argument"
+ try:
+ return eigvals(arg)
+ except TypeError:
+ get_linalg_funcs()
+ return eigvals(arg)
+
+def _lstsq(X, y, rcond):
+ "Do least squares on the arguments"
+ try:
+ return lstsq(X, y, rcond)
+ except TypeError:
+ get_linalg_funcs()
+ return lstsq(X, y, rcond)
+
+def poly(seq_of_zeros):
+ """ Return a sequence representing a polynomial given a sequence of roots.
+
+ If the input is a matrix, return the characteristic polynomial.
+
+ Example:
+
+ >>> b = roots([1,3,1,5,6])
+ >>> poly(b)
+ array([ 1., 3., 1., 5., 6.])
+
+ """
+ seq_of_zeros = atleast_1d(seq_of_zeros)
+ sh = seq_of_zeros.shape
+ if len(sh) == 2 and sh[0] == sh[1]:
+ seq_of_zeros = _eigvals(seq_of_zeros)
+ elif len(sh) ==1:
+ pass
+ else:
+ raise ValueError, "input must be 1d or square 2d array."
+
+ if len(seq_of_zeros) == 0:
+ return 1.0
+
+ a = [1]
+ for k in range(len(seq_of_zeros)):
+ a = NX.convolve(a, [1, -seq_of_zeros[k]], mode='full')
+
+ if issubclass(a.dtype.type, NX.complexfloating):
+ # if complex roots are all complex conjugates, the roots are real.
+ roots = NX.asarray(seq_of_zeros, complex)
+ pos_roots = sort_complex(NX.compress(roots.imag > 0, roots))
+ neg_roots = NX.conjugate(sort_complex(
+ NX.compress(roots.imag < 0,roots)))
+ if (len(pos_roots) == len(neg_roots) and
+ NX.alltrue(neg_roots == pos_roots)):
+ a = a.real.copy()
+
+ return a
+
+def roots(p):
+ """ Return the roots of the polynomial coefficients in p.
+
+ The values in the rank-1 array p are coefficients of a polynomial.
+ If the length of p is n+1 then the polynomial is
+ p[0] * x**n + p[1] * x**(n-1) + ... + p[n-1]*x + p[n]
+ """
+ # If input is scalar, this makes it an array
+ p = atleast_1d(p)
+ if len(p.shape) != 1:
+ raise ValueError,"Input must be a rank-1 array."
+
+ # find non-zero array entries
+ non_zero = NX.nonzero(NX.ravel(p))[0]
+
+ # Return an empty array if polynomial is all zeros
+ if len(non_zero) == 0:
+ return NX.array([])
+
+ # find the number of trailing zeros -- this is the number of roots at 0.
+ trailing_zeros = len(p) - non_zero[-1] - 1
+
+ # strip leading and trailing zeros
+ p = p[int(non_zero[0]):int(non_zero[-1])+1]
+
+ # casting: if incoming array isn't floating point, make it floating point.
+ if not issubclass(p.dtype.type, (NX.floating, NX.complexfloating)):
+ p = p.astype(float)
+
+ N = len(p)
+ if N > 1:
+ # build companion matrix and find its eigenvalues (the roots)
+ A = diag(NX.ones((N-2,), p.dtype), -1)
+ A[0, :] = -p[1:] / p[0]
+ roots = _eigvals(A)
+ else:
+ roots = NX.array([])
+
+ # tack any zeros onto the back of the array
+ roots = hstack((roots, NX.zeros(trailing_zeros, roots.dtype)))
+ return roots
+
+def polyint(p, m=1, k=None):
+ """Return the mth analytical integral of the polynomial p.
+
+ If k is None, then zero-valued constants of integration are used.
+ otherwise, k should be a list of length m (or a scalar if m=1) to
+ represent the constants of integration to use for each integration
+ (starting with k[0])
+ """
+ m = int(m)
+ if m < 0:
+ raise ValueError, "Order of integral must be positive (see polyder)"
+ if k is None:
+ k = NX.zeros(m, float)
+ k = atleast_1d(k)
+ if len(k) == 1 and m > 1:
+ k = k[0]*NX.ones(m, float)
+ if len(k) < m:
+ raise ValueError, \
+ "k must be a scalar or a rank-1 array of length 1 or >m."
+ if m == 0:
+ return p
+ else:
+ truepoly = isinstance(p, poly1d)
+ p = NX.asarray(p)
+ y = NX.zeros(len(p)+1, float)
+ y[:-1] = p*1.0/NX.arange(len(p), 0, -1)
+ y[-1] = k[0]
+ val = polyint(y, m-1, k=k[1:])
+ if truepoly:
+ val = poly1d(val)
+ return val
+
+def polyder(p, m=1):
+ """Return the mth derivative of the polynomial p.
+ """
+ m = int(m)
+ truepoly = isinstance(p, poly1d)
+ p = NX.asarray(p)
+ n = len(p)-1
+ y = p[:-1] * NX.arange(n, 0, -1)
+ if m < 0:
+ raise ValueError, "Order of derivative must be positive (see polyint)"
+ if m == 0:
+ return p
+ else:
+ val = polyder(y, m-1)
+ if truepoly:
+ val = poly1d(val)
+ return val
+
+def polyfit(x, y, deg, rcond=None, full=False):
+ """Least squares polynomial fit.
+
+ Required arguments
+
+ x -- vector of sample points
+ y -- vector or 2D array of values to fit
+ deg -- degree of the fitting polynomial
+
+ Keyword arguments
+
+ rcond -- relative condition number of the fit (default len(x)*eps)
+ full -- return full diagnostic output (default False)
+
+ Returns
+
+ full == False -- coefficients
+ full == True -- coefficients, residuals, rank, singular values, rcond.
+
+ Warns
+
+ RankWarning -- if rank is reduced and not full output
+
+ Do a best fit polynomial of degree 'deg' of 'x' to 'y'. Return value is a
+ vector of polynomial coefficients [pk ... p1 p0]. Eg, for n=2
+
+ p2*x0^2 + p1*x0 + p0 = y1
+ p2*x1^2 + p1*x1 + p0 = y1
+ p2*x2^2 + p1*x2 + p0 = y2
+ .....
+ p2*xk^2 + p1*xk + p0 = yk
+
+
+ Method: if X is a the Vandermonde Matrix computed from x (see
+ http://mathworld.wolfram.com/VandermondeMatrix.html), then the
+ polynomial least squares solution is given by the 'p' in
+
+ X*p = y
+
+ where X is a len(x) x N+1 matrix, p is a N+1 length vector, and y
+ is a len(x) x 1 vector
+
+ This equation can be solved as
+
+ p = (XT*X)^-1 * XT * y
+
+ where XT is the transpose of X and -1 denotes the inverse. However, this
+ method is susceptible to rounding errors and generally the singular value
+ decomposition is preferred and that is the method used here. The singular
+ value method takes a paramenter, 'rcond', which sets a limit on the
+ relative size of the smallest singular value to be used in solving the
+ equation. This may result in lowering the rank of the Vandermonde matrix,
+ in which case a RankWarning is issued. If polyfit issues a RankWarning, try
+ a fit of lower degree or replace x by x - x.mean(), both of which will
+ generally improve the condition number. The routine already normalizes the
+ vector x by its maximum absolute value to help in this regard. The rcond
+ parameter may also be set to a value smaller than its default, but this may
+ result in bad fits. The current default value of rcond is len(x)*eps, where
+ eps is the relative precision of the floating type being used, generally
+ around 1e-7 and 2e-16 for IEEE single and double precision respectively.
+ This value of rcond is fairly conservative but works pretty well when x -
+ x.mean() is used in place of x.
+
+ The warnings can be turned off by:
+
+ >>> import numpy
+ >>> import warnings
+ >>> warnings.simplefilter('ignore',numpy.RankWarning)
+
+ DISCLAIMER: Power series fits are full of pitfalls for the unwary once the
+ degree of the fit becomes large or the interval of sample points is badly
+ centered. The basic problem is that the powers x**n are generally a poor
+ basis for the functions on the sample interval with the result that the
+ Vandermonde matrix is ill conditioned and computation of the polynomial
+ values is sensitive to coefficient error. The quality of the resulting fit
+ should be checked against the data whenever the condition number is large,
+ as the quality of polynomial fits *can not* be taken for granted. If all
+ you want to do is draw a smooth curve through the y values and polyfit is
+ not doing the job, try centering the sample range or look into
+ scipy.interpolate, which includes some nice spline fitting functions that
+ may be of use.
+
+ For more info, see
+ http://mathworld.wolfram.com/LeastSquaresFittingPolynomial.html,
+ but note that the k's and n's in the superscripts and subscripts
+ on that page. The linear algebra is correct, however.
+
+ See also polyval
+
+ """
+ order = int(deg) + 1
+ x = NX.asarray(x) + 0.0
+ y = NX.asarray(y) + 0.0
+
+ # check arguments.
+ if deg < 0 :
+ raise ValueError, "expected deg >= 0"
+ if x.ndim != 1 or x.size == 0:
+ raise TypeError, "expected non-empty vector for x"
+ if y.ndim < 1 or y.ndim > 2 :
+ raise TypeError, "expected 1D or 2D array for y"
+ if x.shape[0] != y.shape[0] :
+ raise TypeError, "expected x and y to have same length"
+
+ # set rcond
+ if rcond is None :
+ xtype = x.dtype
+ if xtype == NX.single or xtype == NX.csingle :
+ rcond = len(x)*_single_eps
+ else :
+ rcond = len(x)*_double_eps
+
+ # scale x to improve condition number
+ scale = abs(x).max()
+ if scale != 0 :
+ x /= scale
+
+ # solve least squares equation for powers of x
+ v = vander(x, order)
+ c, resids, rank, s = _lstsq(v, y, rcond)
+
+ # warn on rank reduction, which indicates an ill conditioned matrix
+ if rank != order and not full:
+ msg = "Polyfit may be poorly conditioned"
+ warnings.warn(msg, RankWarning)
+
+ # scale returned coefficients
+ if scale != 0 :
+ c /= vander([scale], order)[0]
+
+ if full :
+ return c, resids, rank, s, rcond
+ else :
+ return c
+
+
+
+def polyval(p, x):
+ """Evaluate the polynomial p at x. If x is a polynomial then composition.
+
+ Description:
+
+ If p is of length N, this function returns the value:
+ p[0]*(x**N-1) + p[1]*(x**N-2) + ... + p[N-2]*x + p[N-1]
+
+ x can be a sequence and p(x) will be returned for all elements of x.
+ or x can be another polynomial and the composite polynomial p(x) will be
+ returned.
+
+ Notice: This can produce inaccurate results for polynomials with
+ significant variability. Use carefully.
+ """
+ p = NX.asarray(p)
+ if isinstance(x, poly1d):
+ y = 0
+ else:
+ x = NX.asarray(x)
+ y = NX.zeros_like(x)
+ for i in range(len(p)):
+ y = x * y + p[i]
+ return y
+
+def polyadd(a1, a2):
+ """Adds two polynomials represented as sequences
+ """
+ truepoly = (isinstance(a1, poly1d) or isinstance(a2, poly1d))
+ a1 = atleast_1d(a1)
+ a2 = atleast_1d(a2)
+ diff = len(a2) - len(a1)
+ if diff == 0:
+ val = a1 + a2
+ elif diff > 0:
+ zr = NX.zeros(diff, a1.dtype)
+ val = NX.concatenate((zr, a1)) + a2
+ else:
+ zr = NX.zeros(abs(diff), a2.dtype)
+ val = a1 + NX.concatenate((zr, a2))
+ if truepoly:
+ val = poly1d(val)
+ return val
+
+def polysub(a1, a2):
+ """Subtracts two polynomials represented as sequences
+ """
+ truepoly = (isinstance(a1, poly1d) or isinstance(a2, poly1d))
+ a1 = atleast_1d(a1)
+ a2 = atleast_1d(a2)
+ diff = len(a2) - len(a1)
+ if diff == 0:
+ val = a1 - a2
+ elif diff > 0:
+ zr = NX.zeros(diff, a1.dtype)
+ val = NX.concatenate((zr, a1)) - a2
+ else:
+ zr = NX.zeros(abs(diff), a2.dtype)
+ val = a1 - NX.concatenate((zr, a2))
+ if truepoly:
+ val = poly1d(val)
+ return val
+
+
+def polymul(a1, a2):
+ """Multiplies two polynomials represented as sequences.
+ """
+ truepoly = (isinstance(a1, poly1d) or isinstance(a2, poly1d))
+ a1,a2 = poly1d(a1),poly1d(a2)
+ val = NX.convolve(a1, a2)
+ if truepoly:
+ val = poly1d(val)
+ return val
+
+def polydiv(u, v):
+ """Computes q and r polynomials so that u(s) = q(s)*v(s) + r(s)
+ and deg r < deg v.
+ """
+ truepoly = (isinstance(u, poly1d) or isinstance(u, poly1d))
+ u = atleast_1d(u)
+ v = atleast_1d(v)
+ m = len(u) - 1
+ n = len(v) - 1
+ scale = 1. / v[0]
+ q = NX.zeros((m-n+1,), float)
+ r = u.copy()
+ for k in range(0, m-n+1):
+ d = scale * r[k]
+ q[k] = d
+ r[k:k+n+1] -= d*v
+ while NX.allclose(r[0], 0, rtol=1e-14) and (r.shape[-1] > 1):
+ r = r[1:]
+ if truepoly:
+ q = poly1d(q)
+ r = poly1d(r)
+ return q, r
+
+_poly_mat = re.compile(r"[*][*]([0-9]*)")
+def _raise_power(astr, wrap=70):
+ n = 0
+ line1 = ''
+ line2 = ''
+ output = ' '
+ while 1:
+ mat = _poly_mat.search(astr, n)
+ if mat is None:
+ break
+ span = mat.span()
+ power = mat.groups()[0]
+ partstr = astr[n:span[0]]
+ n = span[1]
+ toadd2 = partstr + ' '*(len(power)-1)
+ toadd1 = ' '*(len(partstr)-1) + power
+ if ((len(line2)+len(toadd2) > wrap) or \
+ (len(line1)+len(toadd1) > wrap)):
+ output += line1 + "\n" + line2 + "\n "
+ line1 = toadd1
+ line2 = toadd2
+ else:
+ line2 += partstr + ' '*(len(power)-1)
+ line1 += ' '*(len(partstr)-1) + power
+ output += line1 + "\n" + line2
+ return output + astr[n:]
+
+
+class poly1d(object):
+ """A one-dimensional polynomial class.
+
+ p = poly1d([1,2,3]) constructs the polynomial x**2 + 2 x + 3
+
+ p(0.5) evaluates the polynomial at the location
+ p.r is a list of roots
+ p.c is the coefficient array [1,2,3]
+ p.order is the polynomial order (after leading zeros in p.c are removed)
+ p[k] is the coefficient on the kth power of x (backwards from
+ sequencing the coefficient array.
+
+ polynomials can be added, substracted, multplied and divided (returns
+ quotient and remainder).
+ asarray(p) will also give the coefficient array, so polynomials can
+ be used in all functions that accept arrays.
+
+ p = poly1d([1,2,3], variable='lambda') will use lambda in the
+ string representation of p.
+ """
+ coeffs = None
+ order = None
+ variable = None
+ def __init__(self, c_or_r, r=0, variable=None):
+ if isinstance(c_or_r, poly1d):
+ for key in c_or_r.__dict__.keys():
+ self.__dict__[key] = c_or_r.__dict__[key]
+ if variable is not None:
+ self.__dict__['variable'] = variable
+ return
+ if r:
+ c_or_r = poly(c_or_r)
+ c_or_r = atleast_1d(c_or_r)
+ if len(c_or_r.shape) > 1:
+ raise ValueError, "Polynomial must be 1d only."
+ c_or_r = trim_zeros(c_or_r, trim='f')
+ if len(c_or_r) == 0:
+ c_or_r = NX.array([0.])
+ self.__dict__['coeffs'] = c_or_r
+ self.__dict__['order'] = len(c_or_r) - 1
+ if variable is None:
+ variable = 'x'
+ self.__dict__['variable'] = variable
+
+ def __array__(self, t=None):
+ if t:
+ return NX.asarray(self.coeffs, t)
+ else:
+ return NX.asarray(self.coeffs)
+
+ def __repr__(self):
+ vals = repr(self.coeffs)
+ vals = vals[6:-1]
+ return "poly1d(%s)" % vals
+
+ def __len__(self):
+ return self.order
+
+ def __str__(self):
+ N = self.order
+ thestr = "0"
+ var = self.variable
+ for k in range(len(self.coeffs)):
+ coefstr ='%.4g' % abs(self.coeffs[k])
+ if coefstr[-4:] == '0000':
+ coefstr = coefstr[:-5]
+ power = (N-k)
+ if power == 0:
+ if coefstr != '0':
+ newstr = '%s' % (coefstr,)
+ else:
+ if k == 0:
+ newstr = '0'
+ else:
+ newstr = ''
+ elif power == 1:
+ if coefstr == '0':
+ newstr = ''
+ elif coefstr == 'b':
+ newstr = var
+ else:
+ newstr = '%s %s' % (coefstr, var)
+ else:
+ if coefstr == '0':
+ newstr = ''
+ elif coefstr == 'b':
+ newstr = '%s**%d' % (var, power,)
+ else:
+ newstr = '%s %s**%d' % (coefstr, var, power)
+
+ if k > 0:
+ if newstr != '':
+ if self.coeffs[k] < 0:
+ thestr = "%s - %s" % (thestr, newstr)
+ else:
+ thestr = "%s + %s" % (thestr, newstr)
+ elif (k == 0) and (newstr != '') and (self.coeffs[k] < 0):
+ thestr = "-%s" % (newstr,)
+ else:
+ thestr = newstr
+ return _raise_power(thestr)
+
+
+ def __call__(self, val):
+ return polyval(self.coeffs, val)
+
+ def __mul__(self, other):
+ if isscalar(other):
+ return poly1d(self.coeffs * other)
+ else:
+ other = poly1d(other)
+ return poly1d(polymul(self.coeffs, other.coeffs))
+
+ def __rmul__(self, other):
+ if isscalar(other):
+ return poly1d(other * self.coeffs)
+ else:
+ other = poly1d(other)
+ return poly1d(polymul(self.coeffs, other.coeffs))
+
+ def __add__(self, other):
+ other = poly1d(other)
+ return poly1d(polyadd(self.coeffs, other.coeffs))
+
+ def __radd__(self, other):
+ other = poly1d(other)
+ return poly1d(polyadd(self.coeffs, other.coeffs))
+
+ def __pow__(self, val):
+ if not isscalar(val) or int(val) != val or val < 0:
+ raise ValueError, "Power to non-negative integers only."
+ res = [1]
+ for _ in range(val):
+ res = polymul(self.coeffs, res)
+ return poly1d(res)
+
+ def __sub__(self, other):
+ other = poly1d(other)
+ return poly1d(polysub(self.coeffs, other.coeffs))
+
+ def __rsub__(self, other):
+ other = poly1d(other)
+ return poly1d(polysub(other.coeffs, self.coeffs))
+
+ def __div__(self, other):
+ if isscalar(other):
+ return poly1d(self.coeffs/other)
+ else:
+ other = poly1d(other)
+ return polydiv(self, other)
+
+ def __rdiv__(self, other):
+ if isscalar(other):
+ return poly1d(other/self.coeffs)
+ else:
+ other = poly1d(other)
+ return polydiv(other, self)
+
+ def __eq__(self, other):
+ return (self.coeffs == other.coeffs).all()
+
+ def __ne__(self, other):
+ return (self.coeffs != other.coeffs).any()
+
+ def __setattr__(self, key, val):
+ raise ValueError, "Attributes cannot be changed this way."
+
+ def __getattr__(self, key):
+ if key in ['r', 'roots']:
+ return roots(self.coeffs)
+ elif key in ['c','coef','coefficients']:
+ return self.coeffs
+ elif key in ['o']:
+ return self.order
+ else:
+ try:
+ return self.__dict__[key]
+ except KeyError:
+ raise AttributeError("'%s' has no attribute '%s'" % (self.__class__, key))
+
+ def __getitem__(self, val):
+ ind = self.order - val
+ if val > self.order:
+ return 0
+ if val < 0:
+ return 0
+ return self.coeffs[ind]
+
+ def __setitem__(self, key, val):
+ ind = self.order - key
+ if key < 0:
+ raise ValueError, "Does not support negative powers."
+ if key > self.order:
+ zr = NX.zeros(key-self.order, self.coeffs.dtype)
+ self.__dict__['coeffs'] = NX.concatenate((zr, self.coeffs))
+ self.__dict__['order'] = key
+ ind = 0
+ self.__dict__['coeffs'][ind] = val
+ return
+
+ def integ(self, m=1, k=0):
+ """Return the mth analytical integral of this polynomial.
+ See the documentation for polyint.
+ """
+ return poly1d(polyint(self.coeffs, m=m, k=k))
+
+ def deriv(self, m=1):
+ """Return the mth derivative of this polynomial.
+ """
+ return poly1d(polyder(self.coeffs, m=m))
+
+# Stuff to do on module import
+
+warnings.simplefilter('always',RankWarning)
diff --git a/numpy/lib/scimath.py b/numpy/lib/scimath.py
new file mode 100644
index 000000000..c15f254a3
--- /dev/null
+++ b/numpy/lib/scimath.py
@@ -0,0 +1,86 @@
+"""
+Wrapper functions to more user-friendly calling of certain math functions
+whose output data-type is different than the input data-type in certain
+domains of the input.
+"""
+
+__all__ = ['sqrt', 'log', 'log2', 'logn','log10', 'power', 'arccos',
+ 'arcsin', 'arctanh']
+
+import numpy.core.numeric as nx
+import numpy.core.numerictypes as nt
+from numpy.core.numeric import asarray, any
+from numpy.lib.type_check import isreal
+
+
+#__all__.extend([key for key in dir(nx.umath)
+# if key[0] != '_' and key not in __all__])
+
+_ln2 = nx.log(2.0)
+
+def _tocomplex(arr):
+ if isinstance(arr.dtype, (nt.single, nt.byte, nt.short, nt.ubyte,
+ nt.ushort)):
+ return arr.astype(nt.csingle)
+ else:
+ return arr.astype(nt.cdouble)
+
+def _fix_real_lt_zero(x):
+ x = asarray(x)
+ if any(isreal(x) & (x<0)):
+ x = _tocomplex(x)
+ return x
+
+def _fix_int_lt_zero(x):
+ x = asarray(x)
+ if any(isreal(x) & (x < 0)):
+ x = x * 1.0
+ return x
+
+def _fix_real_abs_gt_1(x):
+ x = asarray(x)
+ if any(isreal(x) & (abs(x)>1)):
+ x = _tocomplex(x)
+ return x
+
+def sqrt(x):
+ x = _fix_real_lt_zero(x)
+ return nx.sqrt(x)
+
+def log(x):
+ x = _fix_real_lt_zero(x)
+ return nx.log(x)
+
+def log10(x):
+ x = _fix_real_lt_zero(x)
+ return nx.log10(x)
+
+def logn(n, x):
+ """ Take log base n of x.
+ """
+ x = _fix_real_lt_zero(x)
+ n = _fix_real_lt_zero(n)
+ return nx.log(x)/nx.log(n)
+
+def log2(x):
+ """ Take log base 2 of x.
+ """
+ x = _fix_real_lt_zero(x)
+ return nx.log(x)/_ln2
+
+def power(x, p):
+ x = _fix_real_lt_zero(x)
+ p = _fix_int_lt_zero(p)
+ return nx.power(x, p)
+
+def arccos(x):
+ x = _fix_real_abs_gt_1(x)
+ return nx.arccos(x)
+
+def arcsin(x):
+ x = _fix_real_abs_gt_1(x)
+ return nx.arcsin(x)
+
+def arctanh(x):
+ x = _fix_real_abs_gt_1(x)
+ return nx.arctanh(x)
diff --git a/numpy/lib/setup.py b/numpy/lib/setup.py
new file mode 100644
index 000000000..f43843ddc
--- /dev/null
+++ b/numpy/lib/setup.py
@@ -0,0 +1,21 @@
+from os.path import join
+
+def configuration(parent_package='',top_path=None):
+ from numpy.distutils.misc_util import Configuration
+
+ config = Configuration('lib',parent_package,top_path)
+
+ config.add_include_dirs(join('..','core','include'))
+
+
+ config.add_extension('_compiled_base',
+ sources=[join('src','_compiled_base.c')]
+ )
+
+ config.add_data_dir('tests')
+
+ return config
+
+if __name__=='__main__':
+ from numpy.distutils.core import setup
+ setup(configuration=configuration)
diff --git a/numpy/lib/shape_base.py b/numpy/lib/shape_base.py
new file mode 100644
index 000000000..2f9ecfa26
--- /dev/null
+++ b/numpy/lib/shape_base.py
@@ -0,0 +1,633 @@
+__all__ = ['atleast_1d','atleast_2d','atleast_3d','vstack','hstack',
+ 'column_stack','row_stack', 'dstack','array_split','split','hsplit',
+ 'vsplit','dsplit','apply_over_axes','expand_dims',
+ 'apply_along_axis', 'kron', 'tile', 'get_array_wrap']
+
+import numpy.core.numeric as _nx
+from numpy.core.numeric import asarray, zeros, newaxis, outer, \
+ concatenate, isscalar, array, asanyarray
+from numpy.core.fromnumeric import product, reshape
+
+def apply_along_axis(func1d,axis,arr,*args):
+ """ Execute func1d(arr[i],*args) where func1d takes 1-D arrays
+ and arr is an N-d array. i varies so as to apply the function
+ along the given axis for each 1-d subarray in arr.
+ """
+ arr = asarray(arr)
+ nd = arr.ndim
+ if axis < 0:
+ axis += nd
+ if (axis >= nd):
+ raise ValueError("axis must be less than arr.ndim; axis=%d, rank=%d."
+ % (axis,nd))
+ ind = [0]*(nd-1)
+ i = zeros(nd,'O')
+ indlist = range(nd)
+ indlist.remove(axis)
+ i[axis] = slice(None,None)
+ outshape = asarray(arr.shape).take(indlist)
+ i.put(indlist, ind)
+ res = func1d(arr[tuple(i.tolist())],*args)
+ # if res is a number, then we have a smaller output array
+ if isscalar(res):
+ outarr = zeros(outshape,asarray(res).dtype)
+ outarr[tuple(ind)] = res
+ Ntot = product(outshape)
+ k = 1
+ while k < Ntot:
+ # increment the index
+ ind[-1] += 1
+ n = -1
+ while (ind[n] >= outshape[n]) and (n > (1-nd)):
+ ind[n-1] += 1
+ ind[n] = 0
+ n -= 1
+ i.put(indlist,ind)
+ res = func1d(arr[tuple(i.tolist())],*args)
+ outarr[tuple(ind)] = res
+ k += 1
+ return outarr
+ else:
+ Ntot = product(outshape)
+ holdshape = outshape
+ outshape = list(arr.shape)
+ outshape[axis] = len(res)
+ outarr = zeros(outshape,asarray(res).dtype)
+ outarr[tuple(i.tolist())] = res
+ k = 1
+ while k < Ntot:
+ # increment the index
+ ind[-1] += 1
+ n = -1
+ while (ind[n] >= holdshape[n]) and (n > (1-nd)):
+ ind[n-1] += 1
+ ind[n] = 0
+ n -= 1
+ i.put(indlist, ind)
+ res = func1d(arr[tuple(i.tolist())],*args)
+ outarr[tuple(i.tolist())] = res
+ k += 1
+ return outarr
+
+
+def apply_over_axes(func, a, axes):
+ """Apply a function repeatedly over multiple axes, keeping the same shape
+ for the resulting array.
+
+ func is called as res = func(a, axis). The result is assumed
+ to be either the same shape as a or have one less dimension.
+ This call is repeated for each axis in the axes sequence.
+ """
+ val = asarray(a)
+ N = a.ndim
+ if array(axes).ndim == 0:
+ axes = (axes,)
+ for axis in axes:
+ if axis < 0: axis = N + axis
+ args = (val, axis)
+ res = func(*args)
+ if res.ndim == val.ndim:
+ val = res
+ else:
+ res = expand_dims(res,axis)
+ if res.ndim == val.ndim:
+ val = res
+ else:
+ raise ValueError, "function is not returning"\
+ " an array of correct shape"
+ return val
+
+def expand_dims(a, axis):
+ """Expand the shape of a by including newaxis before given axis.
+ """
+ a = asarray(a)
+ shape = a.shape
+ if axis < 0:
+ axis = axis + len(shape) + 1
+ return a.reshape(shape[:axis] + (1,) + shape[axis:])
+
+
+def atleast_1d(*arys):
+ """ Force a sequence of arrays to each be at least 1D.
+
+ Description:
+ Force an array to be at least 1D. If an array is 0D, the
+ array is converted to a single row of values. Otherwise,
+ the array is unaltered.
+ Arguments:
+ *arys -- arrays to be converted to 1 or more dimensional array.
+ Returns:
+ input array converted to at least 1D array.
+ """
+ res = []
+ for ary in arys:
+ res.append(array(ary,copy=False,subok=True,ndmin=1))
+ if len(res) == 1:
+ return res[0]
+ else:
+ return res
+
+def atleast_2d(*arys):
+ """ Force a sequence of arrays to each be at least 2D.
+
+ Description:
+ Force an array to each be at least 2D. If the array
+ is 0D or 1D, the array is converted to a single
+ row of values. Otherwise, the array is unaltered.
+ Arguments:
+ arys -- arrays to be converted to 2 or more dimensional array.
+ Returns:
+ input array converted to at least 2D array.
+ """
+ res = []
+ for ary in arys:
+ res.append(array(ary,copy=False,subok=True,ndmin=2))
+ if len(res) == 1:
+ return res[0]
+ else:
+ return res
+
+def atleast_3d(*arys):
+ """ Force a sequence of arrays to each be at least 3D.
+
+ Description:
+ Force an array each be at least 3D. If the array is 0D or 1D,
+ the array is converted to a single 1xNx1 array of values where
+ N is the orginal length of the array. If the array is 2D, the
+ array is converted to a single MxNx1 array of values where MxN
+ is the orginal shape of the array. Otherwise, the array is
+ unaltered.
+ Arguments:
+ arys -- arrays to be converted to 3 or more dimensional array.
+ Returns:
+ input array converted to at least 3D array.
+ """
+ res = []
+ for ary in arys:
+ ary = asarray(ary)
+ if len(ary.shape) == 0:
+ result = ary.reshape(1,1,1)
+ elif len(ary.shape) == 1:
+ result = ary[newaxis,:,newaxis]
+ elif len(ary.shape) == 2:
+ result = ary[:,:,newaxis]
+ else:
+ result = ary
+ res.append(result)
+ if len(res) == 1:
+ return res[0]
+ else:
+ return res
+
+
+def vstack(tup):
+ """ Stack arrays in sequence vertically (row wise)
+
+ Description:
+ Take a sequence of arrays and stack them vertically
+ to make a single array. All arrays in the sequence
+ must have the same shape along all but the first axis.
+ vstack will rebuild arrays divided by vsplit.
+ Arguments:
+ tup -- sequence of arrays. All arrays must have the same
+ shape.
+ Examples:
+ >>> import numpy
+ >>> a = array((1,2,3))
+ >>> b = array((2,3,4))
+ >>> numpy.vstack((a,b))
+ array([[1, 2, 3],
+ [2, 3, 4]])
+ >>> a = array([[1],[2],[3]])
+ >>> b = array([[2],[3],[4]])
+ >>> numpy.vstack((a,b))
+ array([[1],
+ [2],
+ [3],
+ [2],
+ [3],
+ [4]])
+
+ """
+ return _nx.concatenate(map(atleast_2d,tup),0)
+
+def hstack(tup):
+ """ Stack arrays in sequence horizontally (column wise)
+
+ Description:
+ Take a sequence of arrays and stack them horizontally
+ to make a single array. All arrays in the sequence
+ must have the same shape along all but the second axis.
+ hstack will rebuild arrays divided by hsplit.
+ Arguments:
+ tup -- sequence of arrays. All arrays must have the same
+ shape.
+ Examples:
+ >>> import numpy
+ >>> a = array((1,2,3))
+ >>> b = array((2,3,4))
+ >>> numpy.hstack((a,b))
+ array([1, 2, 3, 2, 3, 4])
+ >>> a = array([[1],[2],[3]])
+ >>> b = array([[2],[3],[4]])
+ >>> numpy.hstack((a,b))
+ array([[1, 2],
+ [2, 3],
+ [3, 4]])
+
+ """
+ return _nx.concatenate(map(atleast_1d,tup),1)
+
+row_stack = vstack
+
+def column_stack(tup):
+ """ Stack 1D arrays as columns into a 2D array
+
+ Description:
+ Take a sequence of 1D arrays and stack them as columns
+ to make a single 2D array. All arrays in the sequence
+ must have the same first dimension. 2D arrays are
+ stacked as-is, just like with hstack. 1D arrays are turned
+ into 2D columns first.
+
+ Arguments:
+ tup -- sequence of 1D or 2D arrays. All arrays must have the same
+ first dimension.
+ Examples:
+ >>> import numpy
+ >>> a = array((1,2,3))
+ >>> b = array((2,3,4))
+ >>> numpy.column_stack((a,b))
+ array([[1, 2],
+ [2, 3],
+ [3, 4]])
+
+ """
+ arrays = []
+ for v in tup:
+ arr = array(v,copy=False,subok=True)
+ if arr.ndim < 2:
+ arr = array(arr,copy=False,subok=True,ndmin=2).T
+ arrays.append(arr)
+ return _nx.concatenate(arrays,1)
+
+def dstack(tup):
+ """ Stack arrays in sequence depth wise (along third dimension)
+
+ Description:
+ Take a sequence of arrays and stack them along the third axis.
+ All arrays in the sequence must have the same shape along all
+ but the third axis. This is a simple way to stack 2D arrays
+ (images) into a single 3D array for processing.
+ dstack will rebuild arrays divided by dsplit.
+ Arguments:
+ tup -- sequence of arrays. All arrays must have the same
+ shape.
+ Examples:
+ >>> import numpy
+ >>> a = array((1,2,3))
+ >>> b = array((2,3,4))
+ >>> numpy.dstack((a,b))
+ array([[[1, 2],
+ [2, 3],
+ [3, 4]]])
+ >>> a = array([[1],[2],[3]])
+ >>> b = array([[2],[3],[4]])
+ >>> numpy.dstack((a,b))
+ array([[[1, 2]],
+ <BLANKLINE>
+ [[2, 3]],
+ <BLANKLINE>
+ [[3, 4]]])
+
+ """
+ return _nx.concatenate(map(atleast_3d,tup),2)
+
+def _replace_zero_by_x_arrays(sub_arys):
+ for i in range(len(sub_arys)):
+ if len(_nx.shape(sub_arys[i])) == 0:
+ sub_arys[i] = _nx.array([])
+ elif _nx.sometrue(_nx.equal(_nx.shape(sub_arys[i]),0)):
+ sub_arys[i] = _nx.array([])
+ return sub_arys
+
+def array_split(ary,indices_or_sections,axis = 0):
+ """ Divide an array into a list of sub-arrays.
+
+ Description:
+ Divide ary into a list of sub-arrays along the
+ specified axis. If indices_or_sections is an integer,
+ ary is divided into that many equally sized arrays.
+ If it is impossible to make an equal split, each of the
+ leading arrays in the list have one additional member. If
+ indices_or_sections is a list of sorted integers, its
+ entries define the indexes where ary is split.
+
+ Arguments:
+ ary -- N-D array.
+ Array to be divided into sub-arrays.
+ indices_or_sections -- integer or 1D array.
+ If integer, defines the number of (close to) equal sized
+ sub-arrays. If it is a 1D array of sorted indices, it
+ defines the indexes at which ary is divided. Any empty
+ list results in a single sub-array equal to the original
+ array.
+ axis -- integer. default=0.
+ Specifies the axis along which to split ary.
+ Caveats:
+ Currently, the default for axis is 0. This
+ means a 2D array is divided into multiple groups
+ of rows. This seems like the appropriate default,
+ """
+ try:
+ Ntotal = ary.shape[axis]
+ except AttributeError:
+ Ntotal = len(ary)
+ try: # handle scalar case.
+ Nsections = len(indices_or_sections) + 1
+ div_points = [0] + list(indices_or_sections) + [Ntotal]
+ except TypeError: #indices_or_sections is a scalar, not an array.
+ Nsections = int(indices_or_sections)
+ if Nsections <= 0:
+ raise ValueError, 'number sections must be larger than 0.'
+ Neach_section,extras = divmod(Ntotal,Nsections)
+ section_sizes = [0] + \
+ extras * [Neach_section+1] + \
+ (Nsections-extras) * [Neach_section]
+ div_points = _nx.array(section_sizes).cumsum()
+
+ sub_arys = []
+ sary = _nx.swapaxes(ary,axis,0)
+ for i in range(Nsections):
+ st = div_points[i]; end = div_points[i+1]
+ sub_arys.append(_nx.swapaxes(sary[st:end],axis,0))
+
+ # there is a wierd issue with array slicing that allows
+ # 0x10 arrays and other such things. The following cluge is needed
+ # to get around this issue.
+ sub_arys = _replace_zero_by_x_arrays(sub_arys)
+ # end cluge.
+
+ return sub_arys
+
+def split(ary,indices_or_sections,axis=0):
+ """ Divide an array into a list of sub-arrays.
+
+ Description:
+ Divide ary into a list of sub-arrays along the
+ specified axis. If indices_or_sections is an integer,
+ ary is divided into that many equally sized arrays.
+ If it is impossible to make an equal split, an error is
+ raised. This is the only way this function differs from
+ the array_split() function. If indices_or_sections is a
+ list of sorted integers, its entries define the indexes
+ where ary is split.
+
+ Arguments:
+ ary -- N-D array.
+ Array to be divided into sub-arrays.
+ indices_or_sections -- integer or 1D array.
+ If integer, defines the number of (close to) equal sized
+ sub-arrays. If it is a 1D array of sorted indices, it
+ defines the indexes at which ary is divided. Any empty
+ list results in a single sub-array equal to the original
+ array.
+ axis -- integer. default=0.
+ Specifies the axis along which to split ary.
+ Caveats:
+ Currently, the default for axis is 0. This
+ means a 2D array is divided into multiple groups
+ of rows. This seems like the appropriate default
+ """
+ try: len(indices_or_sections)
+ except TypeError:
+ sections = indices_or_sections
+ N = ary.shape[axis]
+ if N % sections:
+ raise ValueError, 'array split does not result in an equal division'
+ res = array_split(ary,indices_or_sections,axis)
+ return res
+
+def hsplit(ary,indices_or_sections):
+ """ Split ary into multiple columns of sub-arrays
+
+ Description:
+ Split a single array into multiple sub arrays. The array is
+ divided into groups of columns. If indices_or_sections is
+ an integer, ary is divided into that many equally sized sub arrays.
+ If it is impossible to make the sub-arrays equally sized, the
+ operation throws a ValueError exception. See array_split and
+ split for other options on indices_or_sections.
+ Arguments:
+ ary -- N-D array.
+ Array to be divided into sub-arrays.
+ indices_or_sections -- integer or 1D array.
+ If integer, defines the number of (close to) equal sized
+ sub-arrays. If it is a 1D array of sorted indices, it
+ defines the indexes at which ary is divided. Any empty
+ list results in a single sub-array equal to the original
+ array.
+ Returns:
+ sequence of sub-arrays. The returned arrays have the same
+ number of dimensions as the input array.
+ Related:
+ hstack, split, array_split, vsplit, dsplit.
+ Examples:
+ >>> import numpy
+ >>> a= array((1,2,3,4))
+ >>> numpy.hsplit(a,2)
+ [array([1, 2]), array([3, 4])]
+ >>> a = array([[1,2,3,4],[1,2,3,4]])
+ >>> hsplit(a,2)
+ [array([[1, 2],
+ [1, 2]]), array([[3, 4],
+ [3, 4]])]
+
+ """
+ if len(_nx.shape(ary)) == 0:
+ raise ValueError, 'hsplit only works on arrays of 1 or more dimensions'
+ if len(ary.shape) > 1:
+ return split(ary,indices_or_sections,1)
+ else:
+ return split(ary,indices_or_sections,0)
+
+def vsplit(ary,indices_or_sections):
+ """ Split ary into multiple rows of sub-arrays
+
+ Description:
+ Split a single array into multiple sub arrays. The array is
+ divided into groups of rows. If indices_or_sections is
+ an integer, ary is divided into that many equally sized sub arrays.
+ If it is impossible to make the sub-arrays equally sized, the
+ operation throws a ValueError exception. See array_split and
+ split for other options on indices_or_sections.
+ Arguments:
+ ary -- N-D array.
+ Array to be divided into sub-arrays.
+ indices_or_sections -- integer or 1D array.
+ If integer, defines the number of (close to) equal sized
+ sub-arrays. If it is a 1D array of sorted indices, it
+ defines the indexes at which ary is divided. Any empty
+ list results in a single sub-array equal to the original
+ array.
+ Returns:
+ sequence of sub-arrays. The returned arrays have the same
+ number of dimensions as the input array.
+ Caveats:
+ How should we handle 1D arrays here? I am currently raising
+ an error when I encounter them. Any better approach?
+
+ Should we reduce the returned array to their minium dimensions
+ by getting rid of any dimensions that are 1?
+ Related:
+ vstack, split, array_split, hsplit, dsplit.
+ Examples:
+ import numpy
+ >>> a = array([[1,2,3,4],
+ ... [1,2,3,4]])
+ >>> numpy.vsplit(a,2)
+ [array([[1, 2, 3, 4]]), array([[1, 2, 3, 4]])]
+
+ """
+ if len(_nx.shape(ary)) < 2:
+ raise ValueError, 'vsplit only works on arrays of 2 or more dimensions'
+ return split(ary,indices_or_sections,0)
+
+def dsplit(ary,indices_or_sections):
+ """ Split ary into multiple sub-arrays along the 3rd axis (depth)
+
+ Description:
+ Split a single array into multiple sub arrays. The array is
+ divided into groups along the 3rd axis. If indices_or_sections is
+ an integer, ary is divided into that many equally sized sub arrays.
+ If it is impossible to make the sub-arrays equally sized, the
+ operation throws a ValueError exception. See array_split and
+ split for other options on indices_or_sections.
+ Arguments:
+ ary -- N-D array.
+ Array to be divided into sub-arrays.
+ indices_or_sections -- integer or 1D array.
+ If integer, defines the number of (close to) equal sized
+ sub-arrays. If it is a 1D array of sorted indices, it
+ defines the indexes at which ary is divided. Any empty
+ list results in a single sub-array equal to the original
+ array.
+ Returns:
+ sequence of sub-arrays. The returned arrays have the same
+ number of dimensions as the input array.
+ Caveats:
+ See vsplit caveats.
+ Related:
+ dstack, split, array_split, hsplit, vsplit.
+ Examples:
+ >>> a = array([[[1,2,3,4],[1,2,3,4]]])
+ >>> dsplit(a,2)
+ [array([[[1, 2],
+ [1, 2]]]), array([[[3, 4],
+ [3, 4]]])]
+
+ """
+ if len(_nx.shape(ary)) < 3:
+ raise ValueError, 'vsplit only works on arrays of 3 or more dimensions'
+ return split(ary,indices_or_sections,2)
+
+def get_array_wrap(*args):
+ """Find the wrapper for the array with the highest priority.
+
+ In case of ties, leftmost wins. If no wrapper is found, return None
+ """
+ wrappers = [(getattr(x, '__array_priority__', 0), -i,
+ x.__array_wrap__) for i, x in enumerate(args)
+ if hasattr(x, '__array_wrap__')]
+ wrappers.sort()
+ if wrappers:
+ return wrappers[-1][-1]
+ return None
+
+def kron(a,b):
+ """kronecker product of a and b
+
+ Kronecker product of two arrays is block array
+ [[ a[ 0 ,0]*b, a[ 0 ,1]*b, ... , a[ 0 ,n-1]*b ],
+ [ ... ... ],
+ [ a[m-1,0]*b, a[m-1,1]*b, ... , a[m-1,n-1]*b ]]
+ """
+ wrapper = get_array_wrap(a, b)
+ b = asanyarray(b)
+ a = array(a,copy=False,subok=True,ndmin=b.ndim)
+ ndb, nda = b.ndim, a.ndim
+ if (nda == 0 or ndb == 0):
+ return _nx.multiply(a,b)
+ as_ = a.shape
+ bs = b.shape
+ if not a.flags.contiguous:
+ a = reshape(a, as_)
+ if not b.flags.contiguous:
+ b = reshape(b, bs)
+ nd = ndb
+ if (ndb != nda):
+ if (ndb > nda):
+ as_ = (1,)*(ndb-nda) + as_
+ else:
+ bs = (1,)*(nda-ndb) + bs
+ nd = nda
+ result = outer(a,b).reshape(as_+bs)
+ axis = nd-1
+ for _ in xrange(nd):
+ result = concatenate(result, axis=axis)
+ if wrapper is not None:
+ result = wrapper(result)
+ return result
+
+
+def tile(A, reps):
+ """Repeat an array the number of times given in the integer tuple, reps.
+
+ If reps has length d, the result will have dimension of max(d, A.ndim).
+ If reps is scalar it is treated as a 1-tuple.
+
+ If A.ndim < d, A is promoted to be d-dimensional by prepending new axes.
+ So a shape (3,) array is promoted to (1,3) for 2-D replication,
+ or shape (1,1,3) for 3-D replication.
+ If this is not the desired behavior, promote A to d-dimensions manually
+ before calling this function.
+
+ If d < A.ndim, tup is promoted to A.ndim by pre-pending 1's to it. Thus
+ for an A.shape of (2,3,4,5), a tup of (2,2) is treated as (1,1,2,2)
+
+
+ Examples:
+ >>> a = array([0,1,2])
+ >>> tile(a,2)
+ array([0, 1, 2, 0, 1, 2])
+ >>> tile(a,(1,2))
+ array([[0, 1, 2, 0, 1, 2]])
+ >>> tile(a,(2,2))
+ array([[0, 1, 2, 0, 1, 2],
+ [0, 1, 2, 0, 1, 2]])
+ >>> tile(a,(2,1,2))
+ array([[[0, 1, 2, 0, 1, 2]],
+ <BLANKLINE>
+ [[0, 1, 2, 0, 1, 2]]])
+
+ See Also:
+ repeat
+ """
+ try:
+ tup = tuple(reps)
+ except TypeError:
+ tup = (reps,)
+ d = len(tup)
+ c = _nx.array(A,copy=False,subok=True,ndmin=d)
+ shape = list(c.shape)
+ n = c.size
+ if (d < c.ndim):
+ tup = (1,)*(c.ndim-d) + tup
+ for i, nrep in enumerate(tup):
+ if nrep!=1:
+ c = c.reshape(-1,n).repeat(nrep,0)
+ dim_in = shape[i]
+ dim_out = dim_in*nrep
+ shape[i] = dim_out
+ n /= dim_in
+ return c.reshape(shape)
diff --git a/numpy/lib/src/_compiled_base.c b/numpy/lib/src/_compiled_base.c
new file mode 100644
index 000000000..b9ca208ea
--- /dev/null
+++ b/numpy/lib/src/_compiled_base.c
@@ -0,0 +1,589 @@
+#include "Python.h"
+#include "structmember.h"
+#include "numpy/noprefix.h"
+
+static PyObject *ErrorObject;
+#define Py_Try(BOOLEAN) {if (!(BOOLEAN)) goto fail;}
+#define Py_Assert(BOOLEAN,MESS) {if (!(BOOLEAN)) { \
+ PyErr_SetString(ErrorObject, (MESS)); \
+ goto fail;} \
+ }
+
+static intp
+incr_slot_ (double x, double *bins, intp lbins)
+{
+ intp i ;
+ for ( i = 0 ; i < lbins ; i ++ )
+ if ( x < bins [i] )
+ return i ;
+ return lbins ;
+}
+
+static intp
+decr_slot_ (double x, double * bins, intp lbins)
+{
+ intp i ;
+ for ( i = lbins - 1 ; i >= 0; i -- )
+ if (x < bins [i])
+ return i + 1 ;
+ return 0 ;
+}
+
+static int
+monotonic_ (double * a, int lena)
+{
+ int i;
+ if (a [0] <= a [1]) /* possibly monotonic increasing */
+ {
+ for (i = 1 ; i < lena - 1; i ++)
+ if (a [i] > a [i + 1]) return 0 ;
+ return 1 ;
+ }
+ else /* possibly monotonic decreasing */
+ {
+ for (i = 1 ; i < lena - 1; i ++)
+ if (a [i] < a [i + 1]) return 0 ;
+ return -1 ;
+ }
+}
+
+
+
+static intp
+mxx (intp *i , intp len)
+{
+ /* find the index of the maximum element of an integer array */
+ intp mx = 0, max = i[0] ;
+ intp j ;
+ for ( j = 1 ; j < len; j ++ )
+ if ( i [j] > max )
+ {max = i [j] ;
+ mx = j ;}
+ return mx;
+}
+
+static intp
+mnx (intp *i , intp len)
+{
+ /* find the index of the minimum element of an integer array */
+ intp mn = 0, min = i [0] ;
+ intp j ;
+ for ( j = 1 ; j < len; j ++ )
+ if ( i [j] < min )
+ {min = i [j] ;
+ mn = j ;}
+ return mn;
+}
+
+
+static PyObject *
+arr_bincount(PyObject *self, PyObject *args, PyObject *kwds)
+{
+ /* histogram accepts one or two arguments. The first is an array
+ * of non-negative integers and the second, if present, is an
+ * array of weights, which must be promotable to double.
+ * Call these arguments list and weight. Both must be one-
+ * dimensional. len (weight) == len(list)
+ * If weight is not present:
+ * histogram (list) [i] is the number of occurrences of i in list.
+ * If weight is present:
+ * histogram (list, weight) [i] is the sum of all weight [j]
+ * where list [j] == i. */
+ /* self is not used */
+ PyArray_Descr *type;
+ PyObject *list = NULL, *weight=Py_None ;
+ PyObject *lst=NULL, *ans=NULL, *wts=NULL;
+ intp *numbers, *ians, len , mxi, mni, ans_size;
+ int i;
+ double *weights , *dans;
+ static char *kwlist[] = {"list", "weights", NULL};
+
+
+ Py_Try(PyArg_ParseTupleAndKeywords(args, kwds, "O|O", kwlist,
+ &list, &weight));
+ Py_Try(lst = PyArray_ContiguousFromAny(list, PyArray_INTP, 1, 1));
+ len = PyArray_SIZE(lst);
+ numbers = (intp *) PyArray_DATA(lst);
+ mxi = mxx (numbers, len) ;
+ mni = mnx (numbers, len) ;
+ Py_Assert(numbers[mni] >= 0,
+ "irst argument of bincount must be non-negative");
+ ans_size = numbers [mxi] + 1 ;
+ type = PyArray_DescrFromType(PyArray_INTP);
+ if (weight == Py_None) {
+ Py_Try(ans = PyArray_Zeros(1, &ans_size, type, 0));
+ ians = (intp *)(PyArray_DATA(ans));
+ for (i = 0 ; i < len ; i++)
+ ians [numbers [i]] += 1 ;
+ Py_DECREF(lst);
+ }
+ else {
+ Py_Try(wts = PyArray_ContiguousFromAny(weight,
+ PyArray_DOUBLE, 1, 1));
+ weights = (double *)PyArray_DATA (wts);
+ Py_Assert(PyArray_SIZE(wts) == len, "bincount: length of weights " \
+ "does not match that of list");
+ type = PyArray_DescrFromType(PyArray_DOUBLE);
+ Py_Try(ans = PyArray_Zeros(1, &ans_size, type, 0));
+ dans = (double *)PyArray_DATA (ans);
+ for (i = 0 ; i < len ; i++) {
+ dans[numbers[i]] += weights[i];
+ }
+ Py_DECREF(lst);
+ Py_DECREF(wts);
+ }
+ return ans;
+
+ fail:
+ Py_XDECREF(lst);
+ Py_XDECREF(wts);
+ Py_XDECREF(ans);
+ return NULL;
+}
+
+
+static PyObject *
+arr_digitize(PyObject *self, PyObject *args, PyObject *kwds)
+{
+ /* digitize (x, bins) returns an array of python integers the same
+ length of x. The values i returned are such that
+ bins [i - 1] <= x < bins [i] if bins is monotonically increasing,
+ or bins [i - 1] > x >= bins [i] if bins is monotonically decreasing.
+ Beyond the bounds of bins, returns either i = 0 or i = len (bins)
+ as appropriate. */
+ /* self is not used */
+ PyObject *ox, *obins ;
+ PyObject *ax=NULL, *abins=NULL, *aret=NULL;
+ double *dx, *dbins ;
+ intp lbins, lx ; /* lengths */
+ intp *iret;
+ int m, i ;
+ static char *kwlist[] = {"x", "bins", NULL};
+ PyArray_Descr *type;
+
+ Py_Try(PyArg_ParseTupleAndKeywords(args, kwds, "OO", kwlist,
+ &ox, &obins));
+
+ type = PyArray_DescrFromType(PyArray_DOUBLE);
+ Py_Try(ax=PyArray_FromAny(ox, type, 1, 1, CARRAY, NULL));
+ Py_INCREF(type);
+ Py_Try(abins = PyArray_FromAny(obins, type, 1, 1, CARRAY, NULL));
+
+ lx = PyArray_SIZE(ax);
+ dx = (double *)PyArray_DATA(ax);
+ lbins = PyArray_SIZE(abins);
+ dbins = (double *)PyArray_DATA(abins);
+ Py_Try(aret = PyArray_SimpleNew(1, &lx, PyArray_INTP));
+ iret = (intp *)PyArray_DATA(aret);
+
+ Py_Assert(lx > 0 && lbins > 0,
+ "x and bins both must have non-zero length");
+
+ if (lbins == 1) {
+ for (i=0 ; i<lx ; i++)
+ if (dx [i] >= dbins[0])
+ iret[i] = 1;
+ else
+ iret[i] = 0;
+ }
+ else {
+ m = monotonic_ (dbins, lbins) ;
+ if ( m == -1 ) {
+ for ( i = 0 ; i < lx ; i ++ )
+ iret [i] = decr_slot_ ((double)dx [i], dbins, lbins) ;
+ }
+ else if ( m == 1 ) {
+ for ( i = 0 ; i < lx ; i ++ )
+ iret [i] = incr_slot_ ((double)dx [i], dbins, lbins) ;
+ }
+ else Py_Assert(0, "bins must be montonically increasing or decreasing");
+ }
+
+ Py_DECREF(ax);
+ Py_DECREF(abins);
+ return aret;
+
+ fail:
+ Py_XDECREF(ax);
+ Py_XDECREF(abins);
+ Py_XDECREF(aret);
+ return NULL;
+}
+
+
+
+static char arr_insert__doc__[] = "Insert vals sequentially into equivalent 1-d positions indicated by mask.";
+
+static PyObject *
+arr_insert(PyObject *self, PyObject *args, PyObject *kwdict)
+{
+ /* Returns input array with values inserted sequentially into places
+ indicated by the mask
+ */
+ PyObject *mask=NULL, *vals=NULL;
+ PyArrayObject *ainput=NULL, *amask=NULL, *avals=NULL,
+ *tmp=NULL;
+ int numvals, totmask, sameshape;
+ char *input_data, *mptr, *vptr, *zero=NULL;
+ int melsize, delsize, copied, nd;
+ intp *instrides, *inshape;
+ int mindx, rem_indx, indx, i, k, objarray;
+
+ static char *kwlist[] = {"input","mask","vals",NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwdict, "O&OO", kwlist,
+ PyArray_Converter, &ainput,
+ &mask, &vals))
+ goto fail;
+
+ amask = (PyArrayObject *) PyArray_FROM_OF(mask, CARRAY);
+ if (amask == NULL) goto fail;
+ /* Cast an object array */
+ if (amask->descr->type_num == PyArray_OBJECT) {
+ tmp = (PyArrayObject *)PyArray_Cast(amask, PyArray_INTP);
+ if (tmp == NULL) goto fail;
+ Py_DECREF(amask);
+ amask = tmp;
+ }
+
+ sameshape = 1;
+ if (amask->nd == ainput->nd) {
+ for (k=0; k < amask->nd; k++)
+ if (amask->dimensions[k] != ainput->dimensions[k])
+ sameshape = 0;
+ }
+ else { /* Test to see if amask is 1d */
+ if (amask->nd != 1) sameshape = 0;
+ else if ((PyArray_SIZE(ainput)) != PyArray_SIZE(amask)) sameshape = 0;
+ }
+ if (!sameshape) {
+ PyErr_SetString(PyExc_TypeError,
+ "mask array must be 1-d or same shape as input array");
+ goto fail;
+ }
+
+ avals = (PyArrayObject *)PyArray_FromObject(vals, ainput->descr->type_num, 0, 1);
+ if (avals == NULL) goto fail;
+
+ numvals = PyArray_SIZE(avals);
+ nd = ainput->nd;
+ input_data = ainput->data;
+ mptr = amask->data;
+ melsize = amask->descr->elsize;
+ vptr = avals->data;
+ delsize = avals->descr->elsize;
+ zero = PyArray_Zero(amask);
+ if (zero == NULL)
+ goto fail;
+ objarray = (ainput->descr->type_num == PyArray_OBJECT);
+
+ /* Handle zero-dimensional case separately */
+ if (nd == 0) {
+ if (memcmp(mptr,zero,melsize) != 0) {
+ /* Copy value element over to input array */
+ memcpy(input_data,vptr,delsize);
+ if (objarray) Py_INCREF(*((PyObject **)vptr));
+ }
+ Py_DECREF(amask);
+ Py_DECREF(avals);
+ PyDataMem_FREE(zero);
+ Py_INCREF(Py_None);
+ return Py_None;
+ }
+
+ /* Walk through mask array, when non-zero is encountered
+ copy next value in the vals array to the input array.
+ If we get through the value array, repeat it as necessary.
+ */
+ totmask = (int) PyArray_SIZE(amask);
+ copied = 0;
+ instrides = ainput->strides;
+ inshape = ainput->dimensions;
+ for (mindx = 0; mindx < totmask; mindx++) {
+ if (memcmp(mptr,zero,melsize) != 0) {
+ /* compute indx into input array
+ */
+ rem_indx = mindx;
+ indx = 0;
+ for(i=nd-1; i > 0; --i) {
+ indx += (rem_indx % inshape[i]) * instrides[i];
+ rem_indx /= inshape[i];
+ }
+ indx += rem_indx * instrides[0];
+ /* fprintf(stderr, "mindx = %d, indx=%d\n", mindx, indx); */
+ /* Copy value element over to input array */
+ memcpy(input_data+indx,vptr,delsize);
+ if (objarray) Py_INCREF(*((PyObject **)vptr));
+ vptr += delsize;
+ copied += 1;
+ /* If we move past value data. Reset */
+ if (copied >= numvals) vptr = avals->data;
+ }
+ mptr += melsize;
+ }
+
+ Py_DECREF(amask);
+ Py_DECREF(avals);
+ PyDataMem_FREE(zero);
+ Py_DECREF(ainput);
+ Py_INCREF(Py_None);
+ return Py_None;
+
+ fail:
+ PyDataMem_FREE(zero);
+ Py_XDECREF(ainput);
+ Py_XDECREF(amask);
+ Py_XDECREF(avals);
+ return NULL;
+}
+
+static npy_intp
+binary_search(double dval, double dlist [], npy_intp len)
+{
+ /* binary_search accepts three arguments: a numeric value and
+ * a numeric array and its length. It assumes that the array is sorted in
+ * increasing order. It returns the index of the array's
+ * largest element which is <= the value. It will return -1 if
+ * the value is less than the least element of the array. */
+ /* self is not used */
+ npy_intp bottom , top , middle, result;
+
+ if (dval < dlist [0])
+ result = -1 ;
+ else {
+ bottom = 0;
+ top = len - 1;
+ while (bottom < top) {
+ middle = (top + bottom) / 2 ;
+ if (dlist [middle] < dval)
+ bottom = middle + 1 ;
+ else if (dlist [middle] > dval)
+ top = middle - 1 ;
+ else
+ return middle ;
+ }
+ if (dlist [bottom] > dval)
+ result = bottom - 1 ;
+ else
+ result = bottom ;
+ }
+
+ return result ;
+}
+
+static PyObject *
+arr_interp(PyObject *self, PyObject *args, PyObject *kwdict)
+{
+
+ PyObject *fp, *xp, *x;
+ PyObject *left=NULL, *right=NULL;
+ PyArrayObject *afp=NULL, *axp=NULL, *ax=NULL, *af=NULL;
+ npy_intp i, lenx, lenxp, indx;
+ double lval, rval;
+ double *dy, *dx, *dz, *dres, *slopes;
+
+ static char *kwlist[] = {"x", "xp", "fp", "left", "right", NULL};
+
+ if (!PyArg_ParseTupleAndKeywords(args, kwdict, "OOO|OO", kwlist,
+ &x, &xp, &fp, &left, &right))
+ return NULL;
+
+
+ afp = (NPY_AO*)PyArray_ContiguousFromAny(fp, NPY_DOUBLE, 1, 1);
+ if (afp == NULL) return NULL;
+ axp = (NPY_AO*)PyArray_ContiguousFromAny(xp, NPY_DOUBLE, 1, 1);
+ if (axp == NULL) goto fail;
+ ax = (NPY_AO*)PyArray_ContiguousFromAny(x, NPY_DOUBLE, 1, 0);
+ if (ax == NULL) goto fail;
+
+ lenxp = axp->dimensions[0];
+ if (afp->dimensions[0] != lenxp) {
+ PyErr_SetString(PyExc_ValueError, "interp: fp and xp are not the same length.");
+ goto fail;
+ }
+
+ af = (NPY_AO*)PyArray_SimpleNew(ax->nd, ax->dimensions, NPY_DOUBLE);
+ if (af == NULL) goto fail;
+
+ lenx = PyArray_SIZE(ax);
+
+ dy = (double *)PyArray_DATA(afp);
+ dx = (double *)PyArray_DATA(axp);
+ dz = (double *)PyArray_DATA(ax);
+ dres = (double *)PyArray_DATA(af);
+
+ /* Get left and right fill values. */
+ if ((left == NULL) || (left == Py_None)) {
+ lval = dy[0];
+ }
+ else {
+ lval = PyFloat_AsDouble(left);
+ if ((lval==-1) && PyErr_Occurred())
+ goto fail;
+ }
+ if ((right == NULL) || (right == Py_None)) {
+ rval = dy[lenxp-1];
+ }
+ else {
+ rval = PyFloat_AsDouble(right);
+ if ((rval==-1) && PyErr_Occurred())
+ goto fail;
+ }
+
+ slopes = (double *) PyDataMem_NEW((lenxp-1)*sizeof(double));
+ for (i=0; i < lenxp-1; i++) {
+ slopes[i] = (dy[i+1] - dy[i])/(dx[i+1]-dx[i]);
+ }
+ for (i=0; i<lenx; i++) {
+ indx = binary_search(dz[i], dx, lenxp);
+ if (indx < 0)
+ dres[i] = lval;
+ else if (indx >= lenxp - 1)
+ dres[i] = rval;
+ else
+ dres[i] = slopes[indx]*(dz[i]-dx[indx]) + dy[indx];
+ }
+
+ PyDataMem_FREE(slopes);
+ Py_DECREF(afp);
+ Py_DECREF(axp);
+ Py_DECREF(ax);
+ return (PyObject *)af;
+
+ fail:
+ Py_XDECREF(afp);
+ Py_XDECREF(axp);
+ Py_XDECREF(ax);
+ Py_XDECREF(af);
+ return NULL;
+}
+
+
+
+static PyTypeObject *PyMemberDescr_TypePtr=NULL;
+static PyTypeObject *PyGetSetDescr_TypePtr=NULL;
+static PyTypeObject *PyMethodDescr_TypePtr=NULL;
+
+/* Can only be called if doc is currently NULL
+*/
+static PyObject *
+arr_add_docstring(PyObject *dummy, PyObject *args)
+{
+ PyObject *obj;
+ PyObject *str;
+ char *docstr;
+ static char *msg = "already has a docstring";
+
+ /* Don't add docstrings */
+ if (Py_OptimizeFlag > 1) {
+ Py_INCREF(Py_None);
+ return Py_None;
+ }
+
+ if (!PyArg_ParseTuple(args, "OO!", &obj, &PyString_Type, &str))
+ return NULL;
+
+ docstr = PyString_AS_STRING(str);
+
+#define _TESTDOC1(typebase) (obj->ob_type == &Py##typebase##_Type)
+#define _TESTDOC2(typebase) (obj->ob_type == Py##typebase##_TypePtr)
+#define _ADDDOC(typebase, doc, name) { \
+ Py##typebase##Object *new = (Py##typebase##Object *)obj; \
+ if (!(doc)) { \
+ doc = docstr; \
+ } \
+ else { \
+ PyErr_Format(PyExc_RuntimeError, \
+ "%s method %s",name, msg); \
+ return NULL; \
+ } \
+ }
+
+ if _TESTDOC1(CFunction)
+ _ADDDOC(CFunction, new->m_ml->ml_doc, new->m_ml->ml_name)
+ else if _TESTDOC1(Type)
+ _ADDDOC(Type, new->tp_doc, new->tp_name)
+ else if _TESTDOC2(MemberDescr)
+ _ADDDOC(MemberDescr, new->d_member->doc, new->d_member->name)
+ else if _TESTDOC2(GetSetDescr)
+ _ADDDOC(GetSetDescr, new->d_getset->doc, new->d_getset->name)
+ else if _TESTDOC2(MethodDescr)
+ _ADDDOC(MethodDescr, new->d_method->ml_doc,
+ new->d_method->ml_name)
+ else {
+ PyErr_SetString(PyExc_TypeError,
+ "Cannot set a docstring for that object");
+ return NULL;
+ }
+
+#undef _TESTDOC1
+#undef _TESTDOC2
+#undef _ADDDOC
+
+ Py_INCREF(str);
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+static struct PyMethodDef methods[] = {
+ {"_insert", (PyCFunction)arr_insert, METH_VARARGS | METH_KEYWORDS,
+ arr_insert__doc__},
+ {"bincount", (PyCFunction)arr_bincount,
+ METH_VARARGS | METH_KEYWORDS, NULL},
+ {"digitize", (PyCFunction)arr_digitize, METH_VARARGS | METH_KEYWORDS,
+ NULL},
+ {"interp", (PyCFunction)arr_interp, METH_VARARGS | METH_KEYWORDS,
+ NULL},
+ {"add_docstring", (PyCFunction)arr_add_docstring, METH_VARARGS,
+ NULL},
+ {NULL, NULL} /* sentinel */
+};
+
+static void
+define_types(void)
+{
+ PyObject *tp_dict;
+ PyObject *myobj;
+
+ tp_dict = PyArrayDescr_Type.tp_dict;
+ /* Get "subdescr" */
+ myobj = PyDict_GetItemString(tp_dict, "fields");
+ if (myobj == NULL) return;
+ PyGetSetDescr_TypePtr = myobj->ob_type;
+ myobj = PyDict_GetItemString(tp_dict, "alignment");
+ if (myobj == NULL) return;
+ PyMemberDescr_TypePtr = myobj->ob_type;
+ myobj = PyDict_GetItemString(tp_dict, "newbyteorder");
+ if (myobj == NULL) return;
+ PyMethodDescr_TypePtr = myobj->ob_type;
+ return;
+}
+
+/* Initialization function for the module (*must* be called init<name>) */
+
+PyMODINIT_FUNC init_compiled_base(void) {
+ PyObject *m, *d, *s;
+
+ /* Create the module and add the functions */
+ m = Py_InitModule("_compiled_base", methods);
+
+ /* Import the array objects */
+ import_array();
+
+ /* Add some symbolic constants to the module */
+ d = PyModule_GetDict(m);
+
+ s = PyString_FromString("0.5");
+ PyDict_SetItemString(d, "__version__", s);
+ Py_DECREF(s);
+
+ ErrorObject = PyString_FromString("numpy.lib._compiled_base.error");
+ PyDict_SetItemString(d, "error", ErrorObject);
+ Py_DECREF(ErrorObject);
+
+
+ /* define PyGetSetDescr_Type and PyMemberDescr_Type */
+ define_types();
+
+ return;
+}
diff --git a/numpy/lib/tests/test_arraysetops.py b/numpy/lib/tests/test_arraysetops.py
new file mode 100644
index 000000000..ccdcc7556
--- /dev/null
+++ b/numpy/lib/tests/test_arraysetops.py
@@ -0,0 +1,171 @@
+""" Test functions for 1D array set operations.
+
+"""
+
+from numpy.testing import *
+set_package_path()
+import numpy
+from numpy.lib.arraysetops import *
+from numpy.lib.arraysetops import ediff1d
+restore_path()
+
+##################################################
+
+class test_aso(NumpyTestCase):
+ ##
+ # 03.11.2005, c
+ def check_unique1d( self ):
+
+ a = numpy.array( [5, 7, 1, 2, 1, 5, 7] )
+
+ ec = numpy.array( [1, 2, 5, 7] )
+ c = unique1d( a )
+ assert_array_equal( c, ec )
+
+ assert_array_equal([], unique1d([]))
+
+ ##
+ # 03.11.2005, c
+ def check_intersect1d( self ):
+
+ a = numpy.array( [5, 7, 1, 2] )
+ b = numpy.array( [2, 4, 3, 1, 5] )
+
+ ec = numpy.array( [1, 2, 5] )
+ c = intersect1d( a, b )
+ assert_array_equal( c, ec )
+
+ assert_array_equal([], intersect1d([],[]))
+
+ ##
+ # 03.11.2005, c
+ def check_intersect1d_nu( self ):
+
+ a = numpy.array( [5, 5, 7, 1, 2] )
+ b = numpy.array( [2, 1, 4, 3, 3, 1, 5] )
+
+ ec = numpy.array( [1, 2, 5] )
+ c = intersect1d_nu( a, b )
+ assert_array_equal( c, ec )
+
+ assert_array_equal([], intersect1d_nu([],[]))
+
+ ##
+ # 03.11.2005, c
+ def check_setxor1d( self ):
+
+ a = numpy.array( [5, 7, 1, 2] )
+ b = numpy.array( [2, 4, 3, 1, 5] )
+
+ ec = numpy.array( [3, 4, 7] )
+ c = setxor1d( a, b )
+ assert_array_equal( c, ec )
+
+ a = numpy.array( [1, 2, 3] )
+ b = numpy.array( [6, 5, 4] )
+
+ ec = numpy.array( [1, 2, 3, 4, 5, 6] )
+ c = setxor1d( a, b )
+ assert_array_equal( c, ec )
+
+ a = numpy.array( [1, 8, 2, 3] )
+ b = numpy.array( [6, 5, 4, 8] )
+
+ ec = numpy.array( [1, 2, 3, 4, 5, 6] )
+ c = setxor1d( a, b )
+ assert_array_equal( c, ec )
+
+ assert_array_equal([], setxor1d([],[]))
+
+ def check_ediff1d(self):
+ zero_elem = numpy.array([])
+ one_elem = numpy.array([1])
+ two_elem = numpy.array([1,2])
+
+ assert_array_equal([],ediff1d(zero_elem))
+ assert_array_equal([0],ediff1d(zero_elem,to_begin=0))
+ assert_array_equal([0],ediff1d(zero_elem,to_end=0))
+ assert_array_equal([-1,0],ediff1d(zero_elem,to_begin=-1,to_end=0))
+ assert_array_equal([],ediff1d(one_elem))
+ assert_array_equal([1],ediff1d(two_elem))
+
+ ##
+ # 03.11.2005, c
+ def check_setmember1d( self ):
+
+ a = numpy.array( [5, 7, 1, 2] )
+ b = numpy.array( [2, 4, 3, 1, 5] )
+
+ ec = numpy.array( [True, False, True, True] )
+ c = setmember1d( a, b )
+ assert_array_equal( c, ec )
+
+ a[0] = 8
+ ec = numpy.array( [False, False, True, True] )
+ c = setmember1d( a, b )
+ assert_array_equal( c, ec )
+
+ a[0], a[3] = 4, 8
+ ec = numpy.array( [True, False, True, False] )
+ c = setmember1d( a, b )
+ assert_array_equal( c, ec )
+
+ assert_array_equal([], setmember1d([],[]))
+
+ ##
+ # 03.11.2005, c
+ def check_union1d( self ):
+
+ a = numpy.array( [5, 4, 7, 1, 2] )
+ b = numpy.array( [2, 4, 3, 3, 2, 1, 5] )
+
+ ec = numpy.array( [1, 2, 3, 4, 5, 7] )
+ c = union1d( a, b )
+ assert_array_equal( c, ec )
+
+ assert_array_equal([], union1d([],[]))
+
+ ##
+ # 03.11.2005, c
+ # 09.01.2006
+ def check_setdiff1d( self ):
+
+ a = numpy.array( [6, 5, 4, 7, 1, 2] )
+ b = numpy.array( [2, 4, 3, 3, 2, 1, 5] )
+
+ ec = numpy.array( [6, 7] )
+ c = setdiff1d( a, b )
+ assert_array_equal( c, ec )
+
+ a = numpy.arange( 21 )
+ b = numpy.arange( 19 )
+ ec = numpy.array( [19, 20] )
+ c = setdiff1d( a, b )
+ assert_array_equal( c, ec )
+
+ assert_array_equal([], setdiff1d([],[]))
+
+
+ ##
+ # 03.11.2005, c
+ def check_manyways( self ):
+
+ nItem = 100
+ a = numpy.fix( nItem / 10 * numpy.random.random( nItem ) )
+ b = numpy.fix( nItem / 10 * numpy.random.random( nItem ) )
+
+ c1 = intersect1d_nu( a, b )
+ c2 = unique1d( intersect1d( a, b ) )
+ assert_array_equal( c1, c2 )
+
+ a = numpy.array( [5, 7, 1, 2, 8] )
+ b = numpy.array( [9, 8, 2, 4, 3, 1, 5] )
+
+ c1 = setxor1d( a, b )
+ aux1 = intersect1d( a, b )
+ aux2 = union1d( a, b )
+ c2 = setdiff1d( aux2, aux1 )
+ assert_array_equal( c1, c2 )
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/lib/tests/test_function_base.py b/numpy/lib/tests/test_function_base.py
new file mode 100644
index 000000000..f0930ae5b
--- /dev/null
+++ b/numpy/lib/tests/test_function_base.py
@@ -0,0 +1,434 @@
+import sys
+
+from numpy.testing import *
+set_package_path()
+import numpy.lib;reload(numpy.lib)
+from numpy.lib import *
+from numpy.core import *
+del sys.path[0]
+
+class test_any(NumpyTestCase):
+ def check_basic(self):
+ y1 = [0,0,1,0]
+ y2 = [0,0,0,0]
+ y3 = [1,0,1,0]
+ assert(any(y1))
+ assert(any(y3))
+ assert(not any(y2))
+
+ def check_nd(self):
+ y1 = [[0,0,0],[0,1,0],[1,1,0]]
+ assert(any(y1))
+ assert_array_equal(sometrue(y1,axis=0),[1,1,0])
+ assert_array_equal(sometrue(y1,axis=1),[0,1,1])
+
+class test_all(NumpyTestCase):
+ def check_basic(self):
+ y1 = [0,1,1,0]
+ y2 = [0,0,0,0]
+ y3 = [1,1,1,1]
+ assert(not all(y1))
+ assert(all(y3))
+ assert(not all(y2))
+ assert(all(~array(y2)))
+
+ def check_nd(self):
+ y1 = [[0,0,1],[0,1,1],[1,1,1]]
+ assert(not all(y1))
+ assert_array_equal(alltrue(y1,axis=0),[0,0,1])
+ assert_array_equal(alltrue(y1,axis=1),[0,0,1])
+
+class test_average(NumpyTestCase):
+ def check_basic(self):
+ y1 = array([1,2,3])
+ assert(average(y1,axis=0) == 2.)
+ y2 = array([1.,2.,3.])
+ assert(average(y2,axis=0) == 2.)
+ y3 = [0.,0.,0.]
+ assert(average(y3,axis=0) == 0.)
+
+ y4 = ones((4,4))
+ y4[0,1] = 0
+ y4[1,0] = 2
+ assert_array_equal(y4.mean(0), average(y4, 0))
+ assert_array_equal(y4.mean(1), average(y4, 1))
+
+ y5 = rand(5,5)
+ assert_array_equal(y5.mean(0), average(y5, 0))
+ assert_array_equal(y5.mean(1), average(y5, 1))
+
+ def check_weighted(self):
+ y1 = array([[1,2,3],
+ [4,5,6]])
+ actual = average(y1,weights=[1,2],axis=0)
+ desired = array([3.,4.,5.])
+ assert_array_equal(actual, desired)
+
+class test_logspace(NumpyTestCase):
+ def check_basic(self):
+ y = logspace(0,6)
+ assert(len(y)==50)
+ y = logspace(0,6,num=100)
+ assert(y[-1] == 10**6)
+ y = logspace(0,6,endpoint=0)
+ assert(y[-1] < 10**6)
+ y = logspace(0,6,num=7)
+ assert_array_equal(y,[1,10,100,1e3,1e4,1e5,1e6])
+
+class test_linspace(NumpyTestCase):
+ def check_basic(self):
+ y = linspace(0,10)
+ assert(len(y)==50)
+ y = linspace(2,10,num=100)
+ assert(y[-1] == 10)
+ y = linspace(2,10,endpoint=0)
+ assert(y[-1] < 10)
+ y,st = linspace(2,10,retstep=1)
+ assert_almost_equal(st,8/49.0)
+ assert_array_almost_equal(y,mgrid[2:10:50j],13)
+
+ def check_corner(self):
+ y = list(linspace(0,1,1))
+ assert y == [0.0], y
+ y = list(linspace(0,1,2.5))
+ assert y == [0.0, 1.0]
+
+ def check_type(self):
+ t1 = linspace(0,1,0).dtype
+ t2 = linspace(0,1,1).dtype
+ t3 = linspace(0,1,2).dtype
+ assert_equal(t1, t2)
+ assert_equal(t2, t3)
+
+class test_insert(NumpyTestCase):
+ def check_basic(self):
+ a = [1,2,3]
+ assert_equal(insert(a,0,1), [1,1,2,3])
+ assert_equal(insert(a,3,1), [1,2,3,1])
+ assert_equal(insert(a,[1,1,1],[1,2,3]), [1,1,2,3,2,3])
+
+class test_amax(NumpyTestCase):
+ def check_basic(self):
+ a = [3,4,5,10,-3,-5,6.0]
+ assert_equal(amax(a),10.0)
+ b = [[3,6.0, 9.0],
+ [4,10.0,5.0],
+ [8,3.0,2.0]]
+ assert_equal(amax(b,axis=0),[8.0,10.0,9.0])
+ assert_equal(amax(b,axis=1),[9.0,10.0,8.0])
+
+class test_amin(NumpyTestCase):
+ def check_basic(self):
+ a = [3,4,5,10,-3,-5,6.0]
+ assert_equal(amin(a),-5.0)
+ b = [[3,6.0, 9.0],
+ [4,10.0,5.0],
+ [8,3.0,2.0]]
+ assert_equal(amin(b,axis=0),[3.0,3.0,2.0])
+ assert_equal(amin(b,axis=1),[3.0,4.0,2.0])
+
+class test_ptp(NumpyTestCase):
+ def check_basic(self):
+ a = [3,4,5,10,-3,-5,6.0]
+ assert_equal(ptp(a,axis=0),15.0)
+ b = [[3,6.0, 9.0],
+ [4,10.0,5.0],
+ [8,3.0,2.0]]
+ assert_equal(ptp(b,axis=0),[5.0,7.0,7.0])
+ assert_equal(ptp(b,axis=-1),[6.0,6.0,6.0])
+
+class test_cumsum(NumpyTestCase):
+ def check_basic(self):
+ ba = [1,2,10,11,6,5,4]
+ ba2 = [[1,2,3,4],[5,6,7,9],[10,3,4,5]]
+ for ctype in [int8,uint8,int16,uint16,int32,uint32,
+ float32,float64,complex64,complex128]:
+ a = array(ba,ctype)
+ a2 = array(ba2,ctype)
+ assert_array_equal(cumsum(a,axis=0), array([1,3,13,24,30,35,39],ctype))
+ assert_array_equal(cumsum(a2,axis=0), array([[1,2,3,4],[6,8,10,13],
+ [16,11,14,18]],ctype))
+ assert_array_equal(cumsum(a2,axis=1),
+ array([[1,3,6,10],
+ [5,11,18,27],
+ [10,13,17,22]],ctype))
+
+class test_prod(NumpyTestCase):
+ def check_basic(self):
+ ba = [1,2,10,11,6,5,4]
+ ba2 = [[1,2,3,4],[5,6,7,9],[10,3,4,5]]
+ for ctype in [int16,uint16,int32,uint32,
+ float32,float64,complex64,complex128]:
+ a = array(ba,ctype)
+ a2 = array(ba2,ctype)
+ if ctype in ['1', 'b']:
+ self.failUnlessRaises(ArithmeticError, prod, a)
+ self.failUnlessRaises(ArithmeticError, prod, a2, 1)
+ self.failUnlessRaises(ArithmeticError, prod, a)
+ else:
+ assert_equal(prod(a,axis=0),26400)
+ assert_array_equal(prod(a2,axis=0),
+ array([50,36,84,180],ctype))
+ assert_array_equal(prod(a2,axis=-1),array([24, 1890, 600],ctype))
+
+class test_cumprod(NumpyTestCase):
+ def check_basic(self):
+ ba = [1,2,10,11,6,5,4]
+ ba2 = [[1,2,3,4],[5,6,7,9],[10,3,4,5]]
+ for ctype in [int16,uint16,int32,uint32,
+ float32,float64,complex64,complex128]:
+ a = array(ba,ctype)
+ a2 = array(ba2,ctype)
+ if ctype in ['1', 'b']:
+ self.failUnlessRaises(ArithmeticError, cumprod, a)
+ self.failUnlessRaises(ArithmeticError, cumprod, a2, 1)
+ self.failUnlessRaises(ArithmeticError, cumprod, a)
+ else:
+ assert_array_equal(cumprod(a,axis=-1),
+ array([1, 2, 20, 220,
+ 1320, 6600, 26400],ctype))
+ assert_array_equal(cumprod(a2,axis=0),
+ array([[ 1, 2, 3, 4],
+ [ 5, 12, 21, 36],
+ [50, 36, 84, 180]],ctype))
+ assert_array_equal(cumprod(a2,axis=-1),
+ array([[ 1, 2, 6, 24],
+ [ 5, 30, 210, 1890],
+ [10, 30, 120, 600]],ctype))
+
+class test_diff(NumpyTestCase):
+ def check_basic(self):
+ x = [1,4,6,7,12]
+ out = array([3,2,1,5])
+ out2 = array([-1,-1,4])
+ out3 = array([0,5])
+ assert_array_equal(diff(x),out)
+ assert_array_equal(diff(x,n=2),out2)
+ assert_array_equal(diff(x,n=3),out3)
+
+ def check_nd(self):
+ x = 20*rand(10,20,30)
+ out1 = x[:,:,1:] - x[:,:,:-1]
+ out2 = out1[:,:,1:] - out1[:,:,:-1]
+ out3 = x[1:,:,:] - x[:-1,:,:]
+ out4 = out3[1:,:,:] - out3[:-1,:,:]
+ assert_array_equal(diff(x),out1)
+ assert_array_equal(diff(x,n=2),out2)
+ assert_array_equal(diff(x,axis=0),out3)
+ assert_array_equal(diff(x,n=2,axis=0),out4)
+
+class test_angle(NumpyTestCase):
+ def check_basic(self):
+ x = [1+3j,sqrt(2)/2.0+1j*sqrt(2)/2,1,1j,-1,-1j,1-3j,-1+3j]
+ y = angle(x)
+ yo = [arctan(3.0/1.0),arctan(1.0),0,pi/2,pi,-pi/2.0,
+ -arctan(3.0/1.0),pi-arctan(3.0/1.0)]
+ z = angle(x,deg=1)
+ zo = array(yo)*180/pi
+ assert_array_almost_equal(y,yo,11)
+ assert_array_almost_equal(z,zo,11)
+
+class test_trim_zeros(NumpyTestCase):
+ """ only testing for integer splits.
+ """
+ def check_basic(self):
+ a= array([0,0,1,2,3,4,0])
+ res = trim_zeros(a)
+ assert_array_equal(res,array([1,2,3,4]))
+ def check_leading_skip(self):
+ a= array([0,0,1,0,2,3,4,0])
+ res = trim_zeros(a)
+ assert_array_equal(res,array([1,0,2,3,4]))
+ def check_trailing_skip(self):
+ a= array([0,0,1,0,2,3,0,4,0])
+ res = trim_zeros(a)
+ assert_array_equal(res,array([1,0,2,3,0,4]))
+
+
+class test_extins(NumpyTestCase):
+ def check_basic(self):
+ a = array([1,3,2,1,2,3,3])
+ b = extract(a>1,a)
+ assert_array_equal(b,[3,2,2,3,3])
+ def check_place(self):
+ a = array([1,4,3,2,5,8,7])
+ place(a,[0,1,0,1,0,1,0],[2,4,6])
+ assert_array_equal(a,[1,2,3,4,5,6,7])
+ def check_both(self):
+ a = rand(10)
+ mask = a > 0.5
+ ac = a.copy()
+ c = extract(mask, a)
+ place(a,mask,0)
+ place(a,mask,c)
+ assert_array_equal(a,ac)
+
+class test_vectorize(NumpyTestCase):
+ def check_simple(self):
+ def addsubtract(a,b):
+ if a > b:
+ return a - b
+ else:
+ return a + b
+ f = vectorize(addsubtract)
+ r = f([0,3,6,9],[1,3,5,7])
+ assert_array_equal(r,[1,6,1,2])
+ def check_scalar(self):
+ def addsubtract(a,b):
+ if a > b:
+ return a - b
+ else:
+ return a + b
+ f = vectorize(addsubtract)
+ r = f([0,3,6,9],5)
+ assert_array_equal(r,[5,8,1,4])
+ def check_large(self):
+ x = linspace(-3,2,10000)
+ f = vectorize(lambda x: x)
+ y = f(x)
+ assert_array_equal(y, x)
+
+class test_digitize(NumpyTestCase):
+ def check_forward(self):
+ x = arange(-6,5)
+ bins = arange(-5,5)
+ assert_array_equal(digitize(x,bins),arange(11))
+
+ def check_reverse(self):
+ x = arange(5,-6,-1)
+ bins = arange(5,-5,-1)
+ assert_array_equal(digitize(x,bins),arange(11))
+
+ def check_random(self):
+ x = rand(10)
+ bin = linspace(x.min(), x.max(), 10)
+ assert all(digitize(x,bin) != 0)
+
+class test_unwrap(NumpyTestCase):
+ def check_simple(self):
+ #check that unwrap removes jumps greather that 2*pi
+ assert_array_equal(unwrap([1,1+2*pi]),[1,1])
+ #check that unwrap maintans continuity
+ assert(all(diff(unwrap(rand(10)*100))<pi))
+
+
+class test_filterwindows(NumpyTestCase):
+ def check_hanning(self):
+ #check symmetry
+ w=hanning(10)
+ assert_array_almost_equal(w,flipud(w),7)
+ #check known value
+ assert_almost_equal(sum(w,axis=0),4.500,4)
+
+ def check_hamming(self):
+ #check symmetry
+ w=hamming(10)
+ assert_array_almost_equal(w,flipud(w),7)
+ #check known value
+ assert_almost_equal(sum(w,axis=0),4.9400,4)
+
+ def check_bartlett(self):
+ #check symmetry
+ w=bartlett(10)
+ assert_array_almost_equal(w,flipud(w),7)
+ #check known value
+ assert_almost_equal(sum(w,axis=0),4.4444,4)
+
+ def check_blackman(self):
+ #check symmetry
+ w=blackman(10)
+ assert_array_almost_equal(w,flipud(w),7)
+ #check known value
+ assert_almost_equal(sum(w,axis=0),3.7800,4)
+
+
+class test_trapz(NumpyTestCase):
+ def check_simple(self):
+ r=trapz(exp(-1.0/2*(arange(-10,10,.1))**2)/sqrt(2*pi),dx=0.1)
+ #check integral of normal equals 1
+ assert_almost_equal(sum(r,axis=0),1,7)
+
+class test_sinc(NumpyTestCase):
+ def check_simple(self):
+ assert(sinc(0)==1)
+ w=sinc(linspace(-1,1,100))
+ #check symmetry
+ assert_array_almost_equal(w,flipud(w),7)
+
+class test_histogram(NumpyTestCase):
+ def check_simple(self):
+ n=100
+ v=rand(n)
+ (a,b)=histogram(v)
+ #check if the sum of the bins equals the number of samples
+ assert(sum(a,axis=0)==n)
+ #check that the bin counts are evenly spaced when the data is from a linear function
+ (a,b)=histogram(linspace(0,10,100))
+ assert(all(a==10))
+
+class test_histogramdd(NumpyTestCase):
+ def check_simple(self):
+ x = array([[-.5, .5, 1.5], [-.5, 1.5, 2.5], [-.5, 2.5, .5], \
+ [.5, .5, 1.5], [.5, 1.5, 2.5], [.5, 2.5, 2.5]])
+ H, edges = histogramdd(x, (2,3,3), range = [[-1,1], [0,3], [0,3]])
+ answer = asarray([[[0,1,0], [0,0,1], [1,0,0]], [[0,1,0], [0,0,1], [0,0,1]]])
+ assert_array_equal(H,answer)
+ # Check normalization
+ ed = [[-2,0,2], [0,1,2,3], [0,1,2,3]]
+ H, edges = histogramdd(x, bins = ed, normed = True)
+ assert(all(H == answer/12.))
+ # Check that H has the correct shape.
+ H, edges = histogramdd(x, (2,3,4), range = [[-1,1], [0,3], [0,4]], normed=True)
+ answer = asarray([[[0,1,0,0], [0,0,1,0], [1,0,0,0]], [[0,1,0,0], [0,0,1,0], [0,0,1,0]]])
+ assert_array_almost_equal(H, answer/6., 4)
+ # Check that a sequence of arrays is accepted and H has the correct shape.
+ z = [squeeze(y) for y in split(x,3,axis=1)]
+ H, edges = histogramdd(z, bins=(4,3,2),range=[[-2,2], [0,3], [0,2]])
+ answer = asarray([[[0,0],[0,0],[0,0]],
+ [[0,1], [0,0], [1,0]],
+ [[0,1], [0,0],[0,0]],
+ [[0,0],[0,0],[0,0]]])
+ assert_array_equal(H, answer)
+
+ Z = zeros((5,5,5))
+ Z[range(5), range(5), range(5)] = 1.
+ H,edges = histogramdd([arange(5), arange(5), arange(5)], 5)
+ assert_array_equal(H, Z)
+
+ def check_shape(self):
+ x = rand(100,3)
+ hist3d, edges = histogramdd(x, bins = (5, 7, 6))
+ assert_array_equal(hist3d.shape, (5,7,6))
+
+ def check_weights(self):
+ v = rand(100,2)
+ hist, edges = histogramdd(v)
+ n_hist, edges = histogramdd(v, normed=True)
+ w_hist, edges = histogramdd(v, weights=ones(100))
+ assert_array_equal(w_hist, hist)
+ w_hist, edges = histogramdd(v, weights=ones(100)*2, normed=True)
+ assert_array_equal(w_hist, n_hist)
+ w_hist, edges = histogramdd(v, weights=ones(100, int)*2)
+ assert_array_equal(w_hist, 2*hist)
+
+ def check_identical_samples(self):
+ x = zeros((10,2),int)
+ hist, edges = histogramdd(x, bins=2)
+ assert_array_equal(edges[0],array([-0.5, 0. , 0.5]))
+
+class test_unique(NumpyTestCase):
+ def check_simple(self):
+ x = array([4,3,2,1,1,2,3,4, 0])
+ assert(all(unique(x) == [0,1,2,3,4]))
+ assert(unique(array([1,1,1,1,1])) == array([1]))
+ x = ['widget', 'ham', 'foo', 'bar', 'foo', 'ham']
+ assert(all(unique(x) == ['bar', 'foo', 'ham', 'widget']))
+ x = array([5+6j, 1+1j, 1+10j, 10, 5+6j])
+ assert(all(unique(x) == [1+1j, 1+10j, 5+6j, 10]))
+
+def compare_results(res,desired):
+ for i in range(len(desired)):
+ assert_array_equal(res[i],desired[i])
+
+if __name__ == "__main__":
+ NumpyTest('numpy.lib.function_base').run()
diff --git a/numpy/lib/tests/test_getlimits.py b/numpy/lib/tests/test_getlimits.py
new file mode 100644
index 000000000..7a4fea57a
--- /dev/null
+++ b/numpy/lib/tests/test_getlimits.py
@@ -0,0 +1,55 @@
+""" Test functions for limits module.
+"""
+
+from numpy.testing import *
+set_package_path()
+import numpy.lib;reload(numpy.lib)
+from numpy.lib.getlimits import finfo, iinfo
+from numpy import single,double,longdouble
+import numpy as N
+restore_path()
+
+##################################################
+
+class test_python_float(NumpyTestCase):
+ def check_singleton(self):
+ ftype = finfo(float)
+ ftype2 = finfo(float)
+ assert_equal(id(ftype),id(ftype2))
+
+class test_single(NumpyTestCase):
+ def check_singleton(self):
+ ftype = finfo(single)
+ ftype2 = finfo(single)
+ assert_equal(id(ftype),id(ftype2))
+
+class test_double(NumpyTestCase):
+ def check_singleton(self):
+ ftype = finfo(double)
+ ftype2 = finfo(double)
+ assert_equal(id(ftype),id(ftype2))
+
+class test_longdouble(NumpyTestCase):
+ def check_singleton(self,level=2):
+ ftype = finfo(longdouble)
+ ftype2 = finfo(longdouble)
+ assert_equal(id(ftype),id(ftype2))
+
+class test_iinfo(NumpyTestCase):
+ def check_basic(self):
+ dts = zip(['i1', 'i2', 'i4', 'i8',
+ 'u1', 'u2', 'u4', 'u8'],
+ [N.int8, N.int16, N.int32, N.int64,
+ N.uint8, N.uint16, N.uint32, N.uint64])
+ for dt1, dt2 in dts:
+ assert_equal(iinfo(dt1).min, iinfo(dt2).min)
+ assert_equal(iinfo(dt1).max, iinfo(dt2).max)
+ self.assertRaises(ValueError, iinfo, 'f4')
+
+ def check_unsigned_max(self):
+ types = N.sctypes['uint']
+ for T in types:
+ assert_equal(iinfo(T).max, T(-1))
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/lib/tests/test_index_tricks.py b/numpy/lib/tests/test_index_tricks.py
new file mode 100644
index 000000000..5d4f540b2
--- /dev/null
+++ b/numpy/lib/tests/test_index_tricks.py
@@ -0,0 +1,51 @@
+from numpy.testing import *
+set_package_path()
+from numpy import array, ones, r_, mgrid
+restore_path()
+
+class test_grid(NumpyTestCase):
+ def check_basic(self):
+ a = mgrid[-1:1:10j]
+ b = mgrid[-1:1:0.1]
+ assert(a.shape == (10,))
+ assert(b.shape == (20,))
+ assert(a[0] == -1)
+ assert_almost_equal(a[-1],1)
+ assert(b[0] == -1)
+ assert_almost_equal(b[1]-b[0],0.1,11)
+ assert_almost_equal(b[-1],b[0]+19*0.1,11)
+ assert_almost_equal(a[1]-a[0],2.0/9.0,11)
+
+ def check_nd(self):
+ c = mgrid[-1:1:10j,-2:2:10j]
+ d = mgrid[-1:1:0.1,-2:2:0.2]
+ assert(c.shape == (2,10,10))
+ assert(d.shape == (2,20,20))
+ assert_array_equal(c[0][0,:],-ones(10,'d'))
+ assert_array_equal(c[1][:,0],-2*ones(10,'d'))
+ assert_array_almost_equal(c[0][-1,:],ones(10,'d'),11)
+ assert_array_almost_equal(c[1][:,-1],2*ones(10,'d'),11)
+ assert_array_almost_equal(d[0,1,:]-d[0,0,:], 0.1*ones(20,'d'),11)
+ assert_array_almost_equal(d[1,:,1]-d[1,:,0], 0.2*ones(20,'d'),11)
+
+class test_concatenator(NumpyTestCase):
+ def check_1d(self):
+ assert_array_equal(r_[1,2,3,4,5,6],array([1,2,3,4,5,6]))
+ b = ones(5)
+ c = r_[b,0,0,b]
+ assert_array_equal(c,[1,1,1,1,1,0,0,1,1,1,1,1])
+
+ def check_2d(self):
+ b = rand(5,5)
+ c = rand(5,5)
+ d = r_['1',b,c] # append columns
+ assert(d.shape == (5,10))
+ assert_array_equal(d[:,:5],b)
+ assert_array_equal(d[:,5:],c)
+ d = r_[b,c]
+ assert(d.shape == (10,5))
+ assert_array_equal(d[:5,:],b)
+ assert_array_equal(d[5:,:],c)
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/lib/tests/test_polynomial.py b/numpy/lib/tests/test_polynomial.py
new file mode 100644
index 000000000..f3a8720d9
--- /dev/null
+++ b/numpy/lib/tests/test_polynomial.py
@@ -0,0 +1,86 @@
+"""
+>>> import numpy.core as nx
+>>> from numpy.lib.polynomial import poly1d, polydiv
+
+>>> p = poly1d([1.,2,3])
+>>> p
+poly1d([ 1., 2., 3.])
+>>> print p
+ 2
+1 x + 2 x + 3
+>>> q = poly1d([3.,2,1])
+>>> q
+poly1d([ 3., 2., 1.])
+>>> print q
+ 2
+3 x + 2 x + 1
+
+>>> p(0)
+3.0
+>>> p(5)
+38.0
+>>> q(0)
+1.0
+>>> q(5)
+86.0
+
+>>> p * q
+poly1d([ 3., 8., 14., 8., 3.])
+>>> p / q
+(poly1d([ 0.33333333]), poly1d([ 1.33333333, 2.66666667]))
+>>> p + q
+poly1d([ 4., 4., 4.])
+>>> p - q
+poly1d([-2., 0., 2.])
+>>> p ** 4
+poly1d([ 1., 8., 36., 104., 214., 312., 324., 216., 81.])
+
+>>> p(q)
+poly1d([ 9., 12., 16., 8., 6.])
+>>> q(p)
+poly1d([ 3., 12., 32., 40., 34.])
+
+>>> nx.asarray(p)
+array([ 1., 2., 3.])
+>>> len(p)
+2
+
+>>> p[0], p[1], p[2], p[3]
+(3.0, 2.0, 1.0, 0)
+
+>>> p.integ()
+poly1d([ 0.33333333, 1. , 3. , 0. ])
+>>> p.integ(1)
+poly1d([ 0.33333333, 1. , 3. , 0. ])
+>>> p.integ(5)
+poly1d([ 0.00039683, 0.00277778, 0.025 , 0. , 0. ,
+ 0. , 0. , 0. ])
+>>> p.deriv()
+poly1d([ 2., 2.])
+>>> p.deriv(2)
+poly1d([ 2.])
+
+>>> q = poly1d([1.,2,3], variable='y')
+>>> print q
+ 2
+1 y + 2 y + 3
+>>> q = poly1d([1.,2,3], variable='lambda')
+>>> print q
+ 2
+1 lambda + 2 lambda + 3
+
+>>> polydiv(poly1d([1,0,-1]), poly1d([1,1]))
+(poly1d([ 1., -1.]), poly1d([ 0.]))
+"""
+
+from numpy.testing import *
+import numpy as N
+
+class test_docs(NumpyTestCase):
+ def check_doctests(self): return self.rundocs()
+
+ def check_roots(self):
+ assert_array_equal(N.roots([1,0,0]), [0,0])
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/lib/tests/test_shape_base.py b/numpy/lib/tests/test_shape_base.py
new file mode 100644
index 000000000..6efd2cdf1
--- /dev/null
+++ b/numpy/lib/tests/test_shape_base.py
@@ -0,0 +1,408 @@
+from numpy.testing import *
+set_package_path()
+import numpy.lib;
+from numpy.lib import *
+from numpy.core import *
+restore_path()
+
+class test_apply_along_axis(NumpyTestCase):
+ def check_simple(self):
+ a = ones((20,10),'d')
+ assert_array_equal(apply_along_axis(len,0,a),len(a)*ones(shape(a)[1]))
+ def check_simple101(self,level=11):
+ a = ones((10,101),'d')
+ assert_array_equal(apply_along_axis(len,0,a),len(a)*ones(shape(a)[1]))
+
+ def check_3d(self):
+ a = arange(27).reshape((3,3,3))
+ assert_array_equal(apply_along_axis(sum,0,a), [[27,30,33],[36,39,42],[45,48,51]])
+
+class test_array_split(NumpyTestCase):
+ def check_integer_0_split(self):
+ a = arange(10)
+ try:
+ res = array_split(a,0)
+ assert(0) # it should have thrown a value error
+ except ValueError:
+ pass
+ def check_integer_split(self):
+ a = arange(10)
+ res = array_split(a,1)
+ desired = [arange(10)]
+ compare_results(res,desired)
+
+ res = array_split(a,2)
+ desired = [arange(5),arange(5,10)]
+ compare_results(res,desired)
+
+ res = array_split(a,3)
+ desired = [arange(4),arange(4,7),arange(7,10)]
+ compare_results(res,desired)
+
+ res = array_split(a,4)
+ desired = [arange(3),arange(3,6),arange(6,8),arange(8,10)]
+ compare_results(res,desired)
+
+ res = array_split(a,5)
+ desired = [arange(2),arange(2,4),arange(4,6),arange(6,8),arange(8,10)]
+ compare_results(res,desired)
+
+ res = array_split(a,6)
+ desired = [arange(2),arange(2,4),arange(4,6),arange(6,8),arange(8,9),
+ arange(9,10)]
+ compare_results(res,desired)
+
+ res = array_split(a,7)
+ desired = [arange(2),arange(2,4),arange(4,6),arange(6,7),arange(7,8),
+ arange(8,9), arange(9,10)]
+ compare_results(res,desired)
+
+ res = array_split(a,8)
+ desired = [arange(2),arange(2,4),arange(4,5),arange(5,6),arange(6,7),
+ arange(7,8), arange(8,9), arange(9,10)]
+ compare_results(res,desired)
+
+ res = array_split(a,9)
+ desired = [arange(2),arange(2,3),arange(3,4),arange(4,5),arange(5,6),
+ arange(6,7), arange(7,8), arange(8,9), arange(9,10)]
+ compare_results(res,desired)
+
+ res = array_split(a,10)
+ desired = [arange(1),arange(1,2),arange(2,3),arange(3,4),
+ arange(4,5),arange(5,6), arange(6,7), arange(7,8),
+ arange(8,9), arange(9,10)]
+ compare_results(res,desired)
+
+ res = array_split(a,11)
+ desired = [arange(1),arange(1,2),arange(2,3),arange(3,4),
+ arange(4,5),arange(5,6), arange(6,7), arange(7,8),
+ arange(8,9), arange(9,10),array([])]
+ compare_results(res,desired)
+ def check_integer_split_2D_rows(self):
+ a = array([arange(10),arange(10)])
+ res = array_split(a,3,axis=0)
+ desired = [array([arange(10)]),array([arange(10)]),array([])]
+ compare_results(res,desired)
+ def check_integer_split_2D_cols(self):
+ a = array([arange(10),arange(10)])
+ res = array_split(a,3,axis=-1)
+ desired = [array([arange(4),arange(4)]),
+ array([arange(4,7),arange(4,7)]),
+ array([arange(7,10),arange(7,10)])]
+ compare_results(res,desired)
+ def check_integer_split_2D_default(self):
+ """ This will fail if we change default axis
+ """
+ a = array([arange(10),arange(10)])
+ res = array_split(a,3)
+ desired = [array([arange(10)]),array([arange(10)]),array([])]
+ compare_results(res,desired)
+ #perhaps should check higher dimensions
+
+ def check_index_split_simple(self):
+ a = arange(10)
+ indices = [1,5,7]
+ res = array_split(a,indices,axis=-1)
+ desired = [arange(0,1),arange(1,5),arange(5,7),arange(7,10)]
+ compare_results(res,desired)
+
+ def check_index_split_low_bound(self):
+ a = arange(10)
+ indices = [0,5,7]
+ res = array_split(a,indices,axis=-1)
+ desired = [array([]),arange(0,5),arange(5,7),arange(7,10)]
+ compare_results(res,desired)
+ def check_index_split_high_bound(self):
+ a = arange(10)
+ indices = [0,5,7,10,12]
+ res = array_split(a,indices,axis=-1)
+ desired = [array([]),arange(0,5),arange(5,7),arange(7,10),
+ array([]),array([])]
+ compare_results(res,desired)
+
+class test_split(NumpyTestCase):
+ """* This function is essentially the same as array_split,
+ except that it test if splitting will result in an
+ equal split. Only test for this case.
+ *"""
+ def check_equal_split(self):
+ a = arange(10)
+ res = split(a,2)
+ desired = [arange(5),arange(5,10)]
+ compare_results(res,desired)
+
+ def check_unequal_split(self):
+ a = arange(10)
+ try:
+ res = split(a,3)
+ assert(0) # should raise an error
+ except ValueError:
+ pass
+
+class test_atleast_1d(NumpyTestCase):
+ def check_0D_array(self):
+ a = array(1); b = array(2);
+ res=map(atleast_1d,[a,b])
+ desired = [array([1]),array([2])]
+ assert_array_equal(res,desired)
+ def check_1D_array(self):
+ a = array([1,2]); b = array([2,3]);
+ res=map(atleast_1d,[a,b])
+ desired = [array([1,2]),array([2,3])]
+ assert_array_equal(res,desired)
+ def check_2D_array(self):
+ a = array([[1,2],[1,2]]); b = array([[2,3],[2,3]]);
+ res=map(atleast_1d,[a,b])
+ desired = [a,b]
+ assert_array_equal(res,desired)
+ def check_3D_array(self):
+ a = array([[1,2],[1,2]]); b = array([[2,3],[2,3]]);
+ a = array([a,a]);b = array([b,b]);
+ res=map(atleast_1d,[a,b])
+ desired = [a,b]
+ assert_array_equal(res,desired)
+ def check_r1array(self):
+ """ Test to make sure equivalent Travis O's r1array function
+ """
+ assert(atleast_1d(3).shape == (1,))
+ assert(atleast_1d(3j).shape == (1,))
+ assert(atleast_1d(3L).shape == (1,))
+ assert(atleast_1d(3.0).shape == (1,))
+ assert(atleast_1d([[2,3],[4,5]]).shape == (2,2))
+
+class test_atleast_2d(NumpyTestCase):
+ def check_0D_array(self):
+ a = array(1); b = array(2);
+ res=map(atleast_2d,[a,b])
+ desired = [array([[1]]),array([[2]])]
+ assert_array_equal(res,desired)
+ def check_1D_array(self):
+ a = array([1,2]); b = array([2,3]);
+ res=map(atleast_2d,[a,b])
+ desired = [array([[1,2]]),array([[2,3]])]
+ assert_array_equal(res,desired)
+ def check_2D_array(self):
+ a = array([[1,2],[1,2]]); b = array([[2,3],[2,3]]);
+ res=map(atleast_2d,[a,b])
+ desired = [a,b]
+ assert_array_equal(res,desired)
+ def check_3D_array(self):
+ a = array([[1,2],[1,2]]); b = array([[2,3],[2,3]]);
+ a = array([a,a]);b = array([b,b]);
+ res=map(atleast_2d,[a,b])
+ desired = [a,b]
+ assert_array_equal(res,desired)
+ def check_r2array(self):
+ """ Test to make sure equivalent Travis O's r2array function
+ """
+ assert(atleast_2d(3).shape == (1,1))
+ assert(atleast_2d([3j,1]).shape == (1,2))
+ assert(atleast_2d([[[3,1],[4,5]],[[3,5],[1,2]]]).shape == (2,2,2))
+
+class test_atleast_3d(NumpyTestCase):
+ def check_0D_array(self):
+ a = array(1); b = array(2);
+ res=map(atleast_3d,[a,b])
+ desired = [array([[[1]]]),array([[[2]]])]
+ assert_array_equal(res,desired)
+ def check_1D_array(self):
+ a = array([1,2]); b = array([2,3]);
+ res=map(atleast_3d,[a,b])
+ desired = [array([[[1],[2]]]),array([[[2],[3]]])]
+ assert_array_equal(res,desired)
+ def check_2D_array(self):
+ a = array([[1,2],[1,2]]); b = array([[2,3],[2,3]]);
+ res=map(atleast_3d,[a,b])
+ desired = [a[:,:,newaxis],b[:,:,newaxis]]
+ assert_array_equal(res,desired)
+ def check_3D_array(self):
+ a = array([[1,2],[1,2]]); b = array([[2,3],[2,3]]);
+ a = array([a,a]);b = array([b,b]);
+ res=map(atleast_3d,[a,b])
+ desired = [a,b]
+ assert_array_equal(res,desired)
+
+class test_hstack(NumpyTestCase):
+ def check_0D_array(self):
+ a = array(1); b = array(2);
+ res=hstack([a,b])
+ desired = array([1,2])
+ assert_array_equal(res,desired)
+ def check_1D_array(self):
+ a = array([1]); b = array([2]);
+ res=hstack([a,b])
+ desired = array([1,2])
+ assert_array_equal(res,desired)
+ def check_2D_array(self):
+ a = array([[1],[2]]); b = array([[1],[2]]);
+ res=hstack([a,b])
+ desired = array([[1,1],[2,2]])
+ assert_array_equal(res,desired)
+
+class test_vstack(NumpyTestCase):
+ def check_0D_array(self):
+ a = array(1); b = array(2);
+ res=vstack([a,b])
+ desired = array([[1],[2]])
+ assert_array_equal(res,desired)
+ def check_1D_array(self):
+ a = array([1]); b = array([2]);
+ res=vstack([a,b])
+ desired = array([[1],[2]])
+ assert_array_equal(res,desired)
+ def check_2D_array(self):
+ a = array([[1],[2]]); b = array([[1],[2]]);
+ res=vstack([a,b])
+ desired = array([[1],[2],[1],[2]])
+ assert_array_equal(res,desired)
+ def check_2D_array2(self):
+ a = array([1,2]); b = array([1,2]);
+ res=vstack([a,b])
+ desired = array([[1,2],[1,2]])
+ assert_array_equal(res,desired)
+
+class test_dstack(NumpyTestCase):
+ def check_0D_array(self):
+ a = array(1); b = array(2);
+ res=dstack([a,b])
+ desired = array([[[1,2]]])
+ assert_array_equal(res,desired)
+ def check_1D_array(self):
+ a = array([1]); b = array([2]);
+ res=dstack([a,b])
+ desired = array([[[1,2]]])
+ assert_array_equal(res,desired)
+ def check_2D_array(self):
+ a = array([[1],[2]]); b = array([[1],[2]]);
+ res=dstack([a,b])
+ desired = array([[[1,1]],[[2,2,]]])
+ assert_array_equal(res,desired)
+ def check_2D_array2(self):
+ a = array([1,2]); b = array([1,2]);
+ res=dstack([a,b])
+ desired = array([[[1,1],[2,2]]])
+ assert_array_equal(res,desired)
+
+""" array_split has more comprehensive test of splitting.
+ only do simple test on hsplit, vsplit, and dsplit
+"""
+class test_hsplit(NumpyTestCase):
+ """ only testing for integer splits.
+ """
+ def check_0D_array(self):
+ a= array(1)
+ try:
+ hsplit(a,2)
+ assert(0)
+ except ValueError:
+ pass
+ def check_1D_array(self):
+ a= array([1,2,3,4])
+ res = hsplit(a,2)
+ desired = [array([1,2]),array([3,4])]
+ compare_results(res,desired)
+ def check_2D_array(self):
+ a= array([[1,2,3,4],
+ [1,2,3,4]])
+ res = hsplit(a,2)
+ desired = [array([[1,2],[1,2]]),array([[3,4],[3,4]])]
+ compare_results(res,desired)
+
+class test_vsplit(NumpyTestCase):
+ """ only testing for integer splits.
+ """
+ def check_1D_array(self):
+ a= array([1,2,3,4])
+ try:
+ vsplit(a,2)
+ assert(0)
+ except ValueError:
+ pass
+ def check_2D_array(self):
+ a= array([[1,2,3,4],
+ [1,2,3,4]])
+ res = vsplit(a,2)
+ desired = [array([[1,2,3,4]]),array([[1,2,3,4]])]
+ compare_results(res,desired)
+
+class test_dsplit(NumpyTestCase):
+ """ only testing for integer splits.
+ """
+ def check_2D_array(self):
+ a= array([[1,2,3,4],
+ [1,2,3,4]])
+ try:
+ dsplit(a,2)
+ assert(0)
+ except ValueError:
+ pass
+ def check_3D_array(self):
+ a= array([[[1,2,3,4],
+ [1,2,3,4]],
+ [[1,2,3,4],
+ [1,2,3,4]]])
+ res = dsplit(a,2)
+ desired = [array([[[1,2],[1,2]],[[1,2],[1,2]]]),
+ array([[[3,4],[3,4]],[[3,4],[3,4]]])]
+ compare_results(res,desired)
+
+class test_squeeze(NumpyTestCase):
+ def check_basic(self):
+ a = rand(20,10,10,1,1)
+ b = rand(20,1,10,1,20)
+ c = rand(1,1,20,10)
+ assert_array_equal(squeeze(a),reshape(a,(20,10,10)))
+ assert_array_equal(squeeze(b),reshape(b,(20,10,20)))
+ assert_array_equal(squeeze(c),reshape(c,(20,10)))
+
+class test_kron(NumpyTestCase):
+ def check_return_type(self):
+ a = ones([2,2])
+ m = asmatrix(a)
+ assert_equal(type(kron(a,a)), ndarray)
+ assert_equal(type(kron(m,m)), matrix)
+ assert_equal(type(kron(a,m)), matrix)
+ assert_equal(type(kron(m,a)), matrix)
+ class myarray(ndarray):
+ __array_priority__ = 0.0
+ ma = myarray(a.shape, a.dtype, a.data)
+ assert_equal(type(kron(a,a)), ndarray)
+ assert_equal(type(kron(ma,ma)), myarray)
+ assert_equal(type(kron(a,ma)), ndarray)
+ assert_equal(type(kron(ma,a)), myarray)
+
+
+class test_tile(NumpyTestCase):
+ def check_basic(self):
+ a = array([0,1,2])
+ b = [[1,2],[3,4]]
+ assert_equal(tile(a,2), [0,1,2,0,1,2])
+ assert_equal(tile(a,(2,2)), [[0,1,2,0,1,2],[0,1,2,0,1,2]])
+ assert_equal(tile(a,(1,2)), [[0,1,2,0,1,2]])
+ assert_equal(tile(b, 2), [[1,2,1,2],[3,4,3,4]])
+ assert_equal(tile(b,(2,1)),[[1,2],[3,4],[1,2],[3,4]])
+ assert_equal(tile(b,(2,2)),[[1,2,1,2],[3,4,3,4],
+ [1,2,1,2],[3,4,3,4]])
+
+ def check_kroncompare(self):
+ import numpy.random as nr
+ reps=[(2,),(1,2),(2,1),(2,2),(2,3,2),(3,2)]
+ shape=[(3,),(2,3),(3,4,3),(3,2,3),(4,3,2,4),(2,2)]
+ for s in shape:
+ b = nr.randint(0,10,size=s)
+ for r in reps:
+ a = ones(r, b.dtype)
+ large = tile(b, r)
+ klarge = kron(a, b)
+ assert_equal(large, klarge)
+
+# Utility
+
+def compare_results(res,desired):
+ for i in range(len(desired)):
+ assert_array_equal(res[i],desired[i])
+
+
+if __name__ == "__main__":
+ NumpyTest().run()
+
diff --git a/numpy/lib/tests/test_twodim_base.py b/numpy/lib/tests/test_twodim_base.py
new file mode 100644
index 000000000..15ffb2777
--- /dev/null
+++ b/numpy/lib/tests/test_twodim_base.py
@@ -0,0 +1,187 @@
+""" Test functions for matrix module
+
+"""
+
+from numpy.testing import *
+set_package_path()
+from numpy import arange, rot90, add, fliplr, flipud, zeros, ones, eye, \
+ array, diag, histogram2d
+import numpy as np
+restore_path()
+
+##################################################
+
+
+def get_mat(n):
+ data = arange(n)
+ data = add.outer(data,data)
+ return data
+
+class test_eye(NumpyTestCase):
+ def check_basic(self):
+ assert_equal(eye(4),array([[1,0,0,0],
+ [0,1,0,0],
+ [0,0,1,0],
+ [0,0,0,1]]))
+ assert_equal(eye(4,dtype='f'),array([[1,0,0,0],
+ [0,1,0,0],
+ [0,0,1,0],
+ [0,0,0,1]],'f'))
+ def check_diag(self):
+ assert_equal(eye(4,k=1),array([[0,1,0,0],
+ [0,0,1,0],
+ [0,0,0,1],
+ [0,0,0,0]]))
+ assert_equal(eye(4,k=-1),array([[0,0,0,0],
+ [1,0,0,0],
+ [0,1,0,0],
+ [0,0,1,0]]))
+ def check_2d(self):
+ assert_equal(eye(4,3),array([[1,0,0],
+ [0,1,0],
+ [0,0,1],
+ [0,0,0]]))
+ assert_equal(eye(3,4),array([[1,0,0,0],
+ [0,1,0,0],
+ [0,0,1,0]]))
+ def check_diag2d(self):
+ assert_equal(eye(3,4,k=2),array([[0,0,1,0],
+ [0,0,0,1],
+ [0,0,0,0]]))
+ assert_equal(eye(4,3,k=-2),array([[0,0,0],
+ [0,0,0],
+ [1,0,0],
+ [0,1,0]]))
+
+class test_diag(NumpyTestCase):
+ def check_vector(self):
+ vals = (100*arange(5)).astype('l')
+ b = zeros((5,5))
+ for k in range(5):
+ b[k,k] = vals[k]
+ assert_equal(diag(vals),b)
+ b = zeros((7,7))
+ c = b.copy()
+ for k in range(5):
+ b[k,k+2] = vals[k]
+ c[k+2,k] = vals[k]
+ assert_equal(diag(vals,k=2), b)
+ assert_equal(diag(vals,k=-2), c)
+
+ def check_matrix(self):
+ vals = (100*get_mat(5)+1).astype('l')
+ b = zeros((5,))
+ for k in range(5):
+ b[k] = vals[k,k]
+ assert_equal(diag(vals),b)
+ b = b*0
+ for k in range(3):
+ b[k] = vals[k,k+2]
+ assert_equal(diag(vals,2),b[:3])
+ for k in range(3):
+ b[k] = vals[k+2,k]
+ assert_equal(diag(vals,-2),b[:3])
+
+class test_fliplr(NumpyTestCase):
+ def check_basic(self):
+ self.failUnlessRaises(ValueError, fliplr, ones(4))
+ a = get_mat(4)
+ b = a[:,::-1]
+ assert_equal(fliplr(a),b)
+ a = [[0,1,2],
+ [3,4,5]]
+ b = [[2,1,0],
+ [5,4,3]]
+ assert_equal(fliplr(a),b)
+
+class test_flipud(NumpyTestCase):
+ def check_basic(self):
+ a = get_mat(4)
+ b = a[::-1,:]
+ assert_equal(flipud(a),b)
+ a = [[0,1,2],
+ [3,4,5]]
+ b = [[3,4,5],
+ [0,1,2]]
+ assert_equal(flipud(a),b)
+
+class test_rot90(NumpyTestCase):
+ def check_basic(self):
+ self.failUnlessRaises(ValueError, rot90, ones(4))
+
+ a = [[0,1,2],
+ [3,4,5]]
+ b1 = [[2,5],
+ [1,4],
+ [0,3]]
+ b2 = [[5,4,3],
+ [2,1,0]]
+ b3 = [[3,0],
+ [4,1],
+ [5,2]]
+ b4 = [[0,1,2],
+ [3,4,5]]
+
+ for k in range(-3,13,4):
+ assert_equal(rot90(a,k=k),b1)
+ for k in range(-2,13,4):
+ assert_equal(rot90(a,k=k),b2)
+ for k in range(-1,13,4):
+ assert_equal(rot90(a,k=k),b3)
+ for k in range(0,13,4):
+ assert_equal(rot90(a,k=k),b4)
+
+
+class test_histogram2d(NumpyTestCase):
+ def check_simple(self):
+ x = array([ 0.41702200, 0.72032449, 0.00011437481, 0.302332573, 0.146755891])
+ y = array([ 0.09233859, 0.18626021, 0.34556073, 0.39676747, 0.53881673])
+ xedges = np.linspace(0,1,10)
+ yedges = np.linspace(0,1,10)
+ H = histogram2d(x, y, (xedges, yedges))[0]
+ answer = array([[0, 0, 0, 1, 0, 0, 0, 0, 0],
+ [0, 0, 0, 0, 0, 0, 1, 0, 0],
+ [0, 0, 0, 0, 0, 0, 0, 0, 0],
+ [1, 0, 1, 0, 0, 0, 0, 0, 0],
+ [0, 1, 0, 0, 0, 0, 0, 0, 0],
+ [0, 0, 0, 0, 0, 0, 0, 0, 0],
+ [0, 0, 0, 0, 0, 0, 0, 0, 0],
+ [0, 0, 0, 0, 0, 0, 0, 0, 0],
+ [0, 0, 0, 0, 0, 0, 0, 0, 0]])
+ assert_array_equal(H.T, answer)
+ H = histogram2d(x, y, xedges)[0]
+ assert_array_equal(H.T, answer)
+ H,xedges,yedges = histogram2d(range(10),range(10))
+ assert_array_equal(H, eye(10,10))
+ assert_array_equal(xedges, np.linspace(0,9,11))
+ assert_array_equal(yedges, np.linspace(0,9,11))
+
+ def check_asym(self):
+ x = array([1, 1, 2, 3, 4, 4, 4, 5])
+ y = array([1, 3, 2, 0, 1, 2, 3, 4])
+ H, xed, yed = histogram2d(x,y, (6, 5), range = [[0,6],[0,5]], normed=True)
+ answer = array([[0.,0,0,0,0],
+ [0,1,0,1,0],
+ [0,0,1,0,0],
+ [1,0,0,0,0],
+ [0,1,1,1,0],
+ [0,0,0,0,1]])
+ assert_array_almost_equal(H, answer/8., 3)
+ assert_array_equal(xed, np.linspace(0,6,7))
+ assert_array_equal(yed, np.linspace(0,5,6))
+ def check_norm(self):
+ x = array([1,2,3,1,2,3,1,2,3])
+ y = array([1,1,1,2,2,2,3,3,3])
+ H, xed, yed = histogram2d(x,y,[[1,2,3,5], [1,2,3,5]], normed=True)
+ answer=array([[1,1,.5],
+ [1,1,.5],
+ [.5,.5,.25]])/9.
+ assert_array_almost_equal(H, answer, 3)
+
+ def check_all_outliers(self):
+ r = rand(100)+1.
+ H, xed, yed = histogram2d(r, r, (4, 5), range=([0,1], [0,1]))
+ assert_array_equal(H, 0)
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/lib/tests/test_type_check.py b/numpy/lib/tests/test_type_check.py
new file mode 100644
index 000000000..8b990c57e
--- /dev/null
+++ b/numpy/lib/tests/test_type_check.py
@@ -0,0 +1,274 @@
+import sys
+
+from numpy.testing import *
+set_package_path()
+import numpy.lib;reload(numpy.lib);reload(numpy.lib.type_check)
+from numpy.lib import *
+from numpy.core import *
+restore_path()
+
+def assert_all(x):
+ assert(all(x)), x
+
+class test_mintypecode(NumpyTestCase):
+
+ def check_default_1(self):
+ for itype in '1bcsuwil':
+ assert_equal(mintypecode(itype),'d')
+ assert_equal(mintypecode('f'),'f')
+ assert_equal(mintypecode('d'),'d')
+ assert_equal(mintypecode('F'),'F')
+ assert_equal(mintypecode('D'),'D')
+
+ def check_default_2(self):
+ for itype in '1bcsuwil':
+ assert_equal(mintypecode(itype+'f'),'f')
+ assert_equal(mintypecode(itype+'d'),'d')
+ assert_equal(mintypecode(itype+'F'),'F')
+ assert_equal(mintypecode(itype+'D'),'D')
+ assert_equal(mintypecode('ff'),'f')
+ assert_equal(mintypecode('fd'),'d')
+ assert_equal(mintypecode('fF'),'F')
+ assert_equal(mintypecode('fD'),'D')
+ assert_equal(mintypecode('df'),'d')
+ assert_equal(mintypecode('dd'),'d')
+ #assert_equal(mintypecode('dF',savespace=1),'F')
+ assert_equal(mintypecode('dF'),'D')
+ assert_equal(mintypecode('dD'),'D')
+ assert_equal(mintypecode('Ff'),'F')
+ #assert_equal(mintypecode('Fd',savespace=1),'F')
+ assert_equal(mintypecode('Fd'),'D')
+ assert_equal(mintypecode('FF'),'F')
+ assert_equal(mintypecode('FD'),'D')
+ assert_equal(mintypecode('Df'),'D')
+ assert_equal(mintypecode('Dd'),'D')
+ assert_equal(mintypecode('DF'),'D')
+ assert_equal(mintypecode('DD'),'D')
+
+ def check_default_3(self):
+ assert_equal(mintypecode('fdF'),'D')
+ #assert_equal(mintypecode('fdF',savespace=1),'F')
+ assert_equal(mintypecode('fdD'),'D')
+ assert_equal(mintypecode('fFD'),'D')
+ assert_equal(mintypecode('dFD'),'D')
+
+ assert_equal(mintypecode('ifd'),'d')
+ assert_equal(mintypecode('ifF'),'F')
+ assert_equal(mintypecode('ifD'),'D')
+ assert_equal(mintypecode('idF'),'D')
+ #assert_equal(mintypecode('idF',savespace=1),'F')
+ assert_equal(mintypecode('idD'),'D')
+
+class test_isscalar(NumpyTestCase):
+ def check_basic(self):
+ assert(isscalar(3))
+ assert(not isscalar([3]))
+ assert(not isscalar((3,)))
+ assert(isscalar(3j))
+ assert(isscalar(10L))
+ assert(isscalar(4.0))
+
+class test_real(NumpyTestCase):
+ def check_real(self):
+ y = rand(10,)
+ assert_array_equal(y,real(y))
+
+ def check_cmplx(self):
+ y = rand(10,)+1j*rand(10,)
+ assert_array_equal(y.real,real(y))
+
+class test_imag(NumpyTestCase):
+ def check_real(self):
+ y = rand(10,)
+ assert_array_equal(0,imag(y))
+
+ def check_cmplx(self):
+ y = rand(10,)+1j*rand(10,)
+ assert_array_equal(y.imag,imag(y))
+
+class test_iscomplex(NumpyTestCase):
+ def check_fail(self):
+ z = array([-1,0,1])
+ res = iscomplex(z)
+ assert(not sometrue(res,axis=0))
+ def check_pass(self):
+ z = array([-1j,1,0])
+ res = iscomplex(z)
+ assert_array_equal(res,[1,0,0])
+
+class test_isreal(NumpyTestCase):
+ def check_pass(self):
+ z = array([-1,0,1j])
+ res = isreal(z)
+ assert_array_equal(res,[1,1,0])
+ def check_fail(self):
+ z = array([-1j,1,0])
+ res = isreal(z)
+ assert_array_equal(res,[0,1,1])
+
+class test_iscomplexobj(NumpyTestCase):
+ def check_basic(self):
+ z = array([-1,0,1])
+ assert(not iscomplexobj(z))
+ z = array([-1j,0,-1])
+ assert(iscomplexobj(z))
+
+class test_isrealobj(NumpyTestCase):
+ def check_basic(self):
+ z = array([-1,0,1])
+ assert(isrealobj(z))
+ z = array([-1j,0,-1])
+ assert(not isrealobj(z))
+
+class test_isnan(NumpyTestCase):
+ def check_goodvalues(self):
+ z = array((-1.,0.,1.))
+ res = isnan(z) == 0
+ assert_all(alltrue(res,axis=0))
+ def check_posinf(self):
+ olderr = seterr(divide='ignore')
+ assert_all(isnan(array((1.,))/0.) == 0)
+ seterr(**olderr)
+ def check_neginf(self):
+ olderr = seterr(divide='ignore')
+ assert_all(isnan(array((-1.,))/0.) == 0)
+ seterr(**olderr)
+ def check_ind(self):
+ olderr = seterr(divide='ignore', invalid='ignore')
+ assert_all(isnan(array((0.,))/0.) == 1)
+ seterr(**olderr)
+ #def check_qnan(self): log(-1) return pi*j now
+ # assert_all(isnan(log(-1.)) == 1)
+ def check_integer(self):
+ assert_all(isnan(1) == 0)
+ def check_complex(self):
+ assert_all(isnan(1+1j) == 0)
+ def check_complex1(self):
+ olderr = seterr(divide='ignore', invalid='ignore')
+ assert_all(isnan(array(0+0j)/0.) == 1)
+ seterr(**olderr)
+
+class test_isfinite(NumpyTestCase):
+ def check_goodvalues(self):
+ z = array((-1.,0.,1.))
+ res = isfinite(z) == 1
+ assert_all(alltrue(res,axis=0))
+ def check_posinf(self):
+ olderr = seterr(divide='ignore')
+ assert_all(isfinite(array((1.,))/0.) == 0)
+ seterr(**olderr)
+ def check_neginf(self):
+ olderr = seterr(divide='ignore')
+ assert_all(isfinite(array((-1.,))/0.) == 0)
+ seterr(**olderr)
+ def check_ind(self):
+ olderr = seterr(divide='ignore', invalid='ignore')
+ assert_all(isfinite(array((0.,))/0.) == 0)
+ seterr(**olderr)
+ #def check_qnan(self):
+ # assert_all(isfinite(log(-1.)) == 0)
+ def check_integer(self):
+ assert_all(isfinite(1) == 1)
+ def check_complex(self):
+ assert_all(isfinite(1+1j) == 1)
+ def check_complex1(self):
+ olderr = seterr(divide='ignore', invalid='ignore')
+ assert_all(isfinite(array(1+1j)/0.) == 0)
+ seterr(**olderr)
+
+class test_isinf(NumpyTestCase):
+ def check_goodvalues(self):
+ z = array((-1.,0.,1.))
+ res = isinf(z) == 0
+ assert_all(alltrue(res,axis=0))
+ def check_posinf(self):
+ olderr = seterr(divide='ignore')
+ assert_all(isinf(array((1.,))/0.) == 1)
+ seterr(**olderr)
+ def check_posinf_scalar(self):
+ olderr = seterr(divide='ignore')
+ assert_all(isinf(array(1.,)/0.) == 1)
+ seterr(**olderr)
+ def check_neginf(self):
+ olderr = seterr(divide='ignore')
+ assert_all(isinf(array((-1.,))/0.) == 1)
+ seterr(**olderr)
+ def check_neginf_scalar(self):
+ olderr = seterr(divide='ignore')
+ assert_all(isinf(array(-1.)/0.) == 1)
+ seterr(**olderr)
+ def check_ind(self):
+ olderr = seterr(divide='ignore', invalid='ignore')
+ assert_all(isinf(array((0.,))/0.) == 0)
+ seterr(**olderr)
+ #def check_qnan(self):
+ # assert_all(isinf(log(-1.)) == 0)
+ # assert_all(isnan(log(-1.)) == 1)
+
+class test_isposinf(NumpyTestCase):
+ def check_generic(self):
+ olderr = seterr(divide='ignore', invalid='ignore')
+ vals = isposinf(array((-1.,0,1))/0.)
+ seterr(**olderr)
+ assert(vals[0] == 0)
+ assert(vals[1] == 0)
+ assert(vals[2] == 1)
+
+class test_isneginf(NumpyTestCase):
+ def check_generic(self):
+ olderr = seterr(divide='ignore', invalid='ignore')
+ vals = isneginf(array((-1.,0,1))/0.)
+ seterr(**olderr)
+ assert(vals[0] == 1)
+ assert(vals[1] == 0)
+ assert(vals[2] == 0)
+
+class test_nan_to_num(NumpyTestCase):
+ def check_generic(self):
+ olderr = seterr(divide='ignore', invalid='ignore')
+ vals = nan_to_num(array((-1.,0,1))/0.)
+ seterr(**olderr)
+ assert_all(vals[0] < -1e10) and assert_all(isfinite(vals[0]))
+ assert(vals[1] == 0)
+ assert_all(vals[2] > 1e10) and assert_all(isfinite(vals[2]))
+ def check_integer(self):
+ vals = nan_to_num(1)
+ assert_all(vals == 1)
+ def check_complex_good(self):
+ vals = nan_to_num(1+1j)
+ assert_all(vals == 1+1j)
+ def check_complex_bad(self):
+ v = 1+1j
+ olderr = seterr(divide='ignore', invalid='ignore')
+ v += array(0+1.j)/0.
+ seterr(**olderr)
+ vals = nan_to_num(v)
+ # !! This is actually (unexpectedly) zero
+ assert_all(isfinite(vals))
+ def check_complex_bad2(self):
+ v = 1+1j
+ olderr = seterr(divide='ignore', invalid='ignore')
+ v += array(-1+1.j)/0.
+ seterr(**olderr)
+ vals = nan_to_num(v)
+ assert_all(isfinite(vals))
+ #assert_all(vals.imag > 1e10) and assert_all(isfinite(vals))
+ # !! This is actually (unexpectedly) positive
+ # !! inf. Comment out for now, and see if it
+ # !! changes
+ #assert_all(vals.real < -1e10) and assert_all(isfinite(vals))
+
+
+class test_real_if_close(NumpyTestCase):
+ def check_basic(self):
+ a = rand(10)
+ b = real_if_close(a+1e-15j)
+ assert_all(isrealobj(b))
+ assert_array_equal(a,b)
+ b = real_if_close(a+1e-7j)
+ assert_all(iscomplexobj(b))
+ b = real_if_close(a+1e-7j,tol=1e-6)
+ assert_all(isrealobj(b))
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/lib/tests/test_ufunclike.py b/numpy/lib/tests/test_ufunclike.py
new file mode 100644
index 000000000..8f9ac2833
--- /dev/null
+++ b/numpy/lib/tests/test_ufunclike.py
@@ -0,0 +1,66 @@
+"""
+>>> import numpy.core as nx
+>>> import numpy.lib.ufunclike as U
+
+Test fix:
+>>> a = nx.array([[1.0, 1.1, 1.5, 1.8], [-1.0, -1.1, -1.5, -1.8]])
+>>> U.fix(a)
+array([[ 1., 1., 1., 1.],
+ [ 0., -1., -1., -1.]])
+>>> y = nx.zeros(a.shape, float)
+>>> U.fix(a, y)
+array([[ 1., 1., 1., 1.],
+ [ 0., -1., -1., -1.]])
+>>> y
+array([[ 1., 1., 1., 1.],
+ [ 0., -1., -1., -1.]])
+
+Test isposinf, isneginf, sign
+>>> a = nx.array([nx.Inf, -nx.Inf, nx.NaN, 0.0, 3.0, -3.0])
+>>> U.isposinf(a)
+array([ True, False, False, False, False, False], dtype=bool)
+>>> U.isneginf(a)
+array([False, True, False, False, False, False], dtype=bool)
+>>> olderr = nx.seterr(invalid='ignore')
+>>> nx.sign(a)
+array([ 1., -1., 0., 0., 1., -1.])
+>>> olderr = nx.seterr(**olderr)
+
+Same thing with an output array:
+>>> y = nx.zeros(a.shape, bool)
+>>> U.isposinf(a, y)
+array([ True, False, False, False, False, False], dtype=bool)
+>>> y
+array([ True, False, False, False, False, False], dtype=bool)
+>>> U.isneginf(a, y)
+array([False, True, False, False, False, False], dtype=bool)
+>>> y
+array([False, True, False, False, False, False], dtype=bool)
+>>> olderr = nx.seterr(invalid='ignore')
+>>> nx.sign(a, y)
+array([ True, True, False, False, True, True], dtype=bool)
+>>> olderr = nx.seterr(**olderr)
+>>> y
+array([ True, True, False, False, True, True], dtype=bool)
+
+Now log2:
+>>> a = nx.array([4.5, 2.3, 6.5])
+>>> U.log2(a)
+array([ 2.169925 , 1.20163386, 2.70043972])
+>>> 2**_
+array([ 4.5, 2.3, 6.5])
+>>> y = nx.zeros(a.shape, float)
+>>> U.log2(a, y)
+array([ 2.169925 , 1.20163386, 2.70043972])
+>>> y
+array([ 2.169925 , 1.20163386, 2.70043972])
+
+"""
+
+from numpy.testing import *
+
+class test_docs(NumpyTestCase):
+ def check_doctests(self): return self.rundocs()
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/lib/twodim_base.py b/numpy/lib/twodim_base.py
new file mode 100644
index 000000000..bed2dcef0
--- /dev/null
+++ b/numpy/lib/twodim_base.py
@@ -0,0 +1,184 @@
+""" Basic functions for manipulating 2d arrays
+
+"""
+
+__all__ = ['diag','diagflat','eye','fliplr','flipud','rot90','tri','triu',
+ 'tril','vander','histogram2d']
+
+from numpy.core.numeric import asanyarray, equal, subtract, arange, \
+ zeros, arange, greater_equal, multiply, ones, asarray
+
+def fliplr(m):
+ """ returns an array m with the rows preserved and columns flipped
+ in the left/right direction. Works on the first two dimensions of m.
+ """
+ m = asanyarray(m)
+ if m.ndim < 2:
+ raise ValueError, "Input must be >= 2-d."
+ return m[:, ::-1]
+
+def flipud(m):
+ """ returns an array with the columns preserved and rows flipped in
+ the up/down direction. Works on the first dimension of m.
+ """
+ m = asanyarray(m)
+ if m.ndim < 1:
+ raise ValueError, "Input must be >= 1-d."
+ return m[::-1,...]
+
+def rot90(m, k=1):
+ """ returns the array found by rotating m by k*90
+ degrees in the counterclockwise direction. Works on the first two
+ dimensions of m.
+ """
+ m = asanyarray(m)
+ if m.ndim < 2:
+ raise ValueError, "Input must >= 2-d."
+ k = k % 4
+ if k == 0: return m
+ elif k == 1: return fliplr(m).transpose()
+ elif k == 2: return fliplr(flipud(m))
+ else: return fliplr(m.transpose()) # k==3
+
+def eye(N, M=None, k=0, dtype=float):
+ """ eye returns a N-by-M 2-d array where the k-th diagonal is all ones,
+ and everything else is zeros.
+ """
+ if M is None: M = N
+ m = equal(subtract.outer(arange(N), arange(M)),-k)
+ if m.dtype != dtype:
+ return m.astype(dtype)
+
+def diag(v, k=0):
+ """ returns a copy of the the k-th diagonal if v is a 2-d array
+ or returns a 2-d array with v as the k-th diagonal if v is a
+ 1-d array.
+ """
+ v = asarray(v)
+ s = v.shape
+ if len(s)==1:
+ n = s[0]+abs(k)
+ res = zeros((n,n), v.dtype)
+ if (k>=0):
+ i = arange(0,n-k)
+ fi = i+k+i*n
+ else:
+ i = arange(0,n+k)
+ fi = i+(i-k)*n
+ res.flat[fi] = v
+ return res
+ elif len(s)==2:
+ N1,N2 = s
+ if k >= 0:
+ M = min(N1,N2-k)
+ i = arange(0,M)
+ fi = i+k+i*N2
+ else:
+ M = min(N1+k,N2)
+ i = arange(0,M)
+ fi = i + (i-k)*N2
+ return v.flat[fi]
+ else:
+ raise ValueError, "Input must be 1- or 2-d."
+
+def diagflat(v,k=0):
+ try:
+ wrap = v.__array_wrap__
+ except AttributeError:
+ wrap = None
+ v = asarray(v).ravel()
+ s = len(v)
+ n = s + abs(k)
+ res = zeros((n,n), v.dtype)
+ if (k>=0):
+ i = arange(0,n-k)
+ fi = i+k+i*n
+ else:
+ i = arange(0,n+k)
+ fi = i+(i-k)*n
+ res.flat[fi] = v
+ if not wrap:
+ return res
+ return wrap(res)
+
+def tri(N, M=None, k=0, dtype=float):
+ """ returns a N-by-M array where all the diagonals starting from
+ lower left corner up to the k-th are all ones.
+ """
+ if M is None: M = N
+ m = greater_equal(subtract.outer(arange(N), arange(M)),-k)
+ if m.dtype != dtype:
+ return m.astype(dtype)
+
+def tril(m, k=0):
+ """ returns the elements on and below the k-th diagonal of m. k=0 is the
+ main diagonal, k > 0 is above and k < 0 is below the main diagonal.
+ """
+ m = asanyarray(m)
+ out = multiply(tri(m.shape[0], m.shape[1], k=k, dtype=int),m)
+ return out
+
+def triu(m, k=0):
+ """ returns the elements on and above the k-th diagonal of m. k=0 is the
+ main diagonal, k > 0 is above and k < 0 is below the main diagonal.
+ """
+ m = asanyarray(m)
+ out = multiply((1-tri(m.shape[0], m.shape[1], k-1, int)),m)
+ return out
+
+# borrowed from John Hunter and matplotlib
+def vander(x, N=None):
+ """
+ X = vander(x,N=None)
+
+ The Vandermonde matrix of vector x. The i-th column of X is the
+ the i-th power of x. N is the maximum power to compute; if N is
+ None it defaults to len(x).
+
+ """
+ x = asarray(x)
+ if N is None: N=len(x)
+ X = ones( (len(x),N), x.dtype)
+ for i in range(N-1):
+ X[:,i] = x**(N-i-1)
+ return X
+
+
+def histogram2d(x,y, bins=10, range=None, normed=False, weights=None):
+ """histogram2d(x,y, bins=10, range=None, normed=False) -> H, xedges, yedges
+
+ Compute the 2D histogram from samples x,y.
+
+ :Parameters:
+ - `x,y` : Sample arrays (1D).
+ - `bins` : Number of bins -or- [nbin x, nbin y] -or-
+ [bin edges] -or- [x bin edges, y bin edges].
+ - `range` : A sequence of lower and upper bin edges (default: [min, max]).
+ - `normed` : Boolean, if False, return the number of samples in each bin,
+ if True, returns the density.
+ - `weights` : An array of weights. The weights are normed only if normed
+ is True. Should weights.sum() not equal N, the total bin count \
+ will not be equal to the number of samples.
+
+ :Return:
+ - `hist` : Histogram array.
+ - `xedges, yedges` : Arrays defining the bin edges.
+
+ Example:
+ >>> x = random.randn(100,2)
+ >>> hist2d, xedges, yedges = histogram2d(x, bins = (6, 7))
+
+ :SeeAlso: histogramdd
+ """
+ from numpy import histogramdd
+
+ try:
+ N = len(bins)
+ except TypeError:
+ N = 1
+
+ if N != 1 and N != 2:
+ xedges = yedges = asarray(bins, float)
+ bins = [xedges, yedges]
+ hist, edges = histogramdd([x,y], bins, range, normed, weights)
+ return hist, edges[0], edges[1]
diff --git a/numpy/lib/type_check.py b/numpy/lib/type_check.py
new file mode 100644
index 000000000..8e10ac2b5
--- /dev/null
+++ b/numpy/lib/type_check.py
@@ -0,0 +1,233 @@
+## Automatically adapted for numpy Sep 19, 2005 by convertcode.py
+
+__all__ = ['iscomplexobj','isrealobj','imag','iscomplex',
+ 'isreal','nan_to_num','real','real_if_close',
+ 'typename','asfarray','mintypecode','asscalar',
+ 'common_type']
+
+import numpy.core.numeric as _nx
+from numpy.core.numeric import asarray, asanyarray, array, isnan, \
+ obj2sctype, zeros
+from ufunclike import isneginf, isposinf
+
+_typecodes_by_elsize = 'GDFgdfQqLlIiHhBb?'
+
+def mintypecode(typechars,typeset='GDFgdf',default='d'):
+ """ Return a minimum data type character from typeset that
+ handles all typechars given
+
+ The returned type character must be the smallest size such that
+ an array of the returned type can handle the data from an array of
+ type t for each t in typechars (or if typechars is an array,
+ then its dtype.char).
+
+ If the typechars does not intersect with the typeset, then default
+ is returned.
+
+ If t in typechars is not a string then t=asarray(t).dtype.char is
+ applied.
+ """
+ typecodes = [(type(t) is type('') and t) or asarray(t).dtype.char\
+ for t in typechars]
+ intersection = [t for t in typecodes if t in typeset]
+ if not intersection:
+ return default
+ if 'F' in intersection and 'd' in intersection:
+ return 'D'
+ l = []
+ for t in intersection:
+ i = _typecodes_by_elsize.index(t)
+ l.append((i,t))
+ l.sort()
+ return l[0][1]
+
+def asfarray(a, dtype=_nx.float_):
+ """asfarray(a,dtype=None) returns a as a float array."""
+ dtype = _nx.obj2sctype(dtype)
+ if not issubclass(dtype, _nx.inexact):
+ dtype = _nx.float_
+ return asanyarray(a,dtype=dtype)
+
+def real(val):
+ """Return the real part of val.
+
+ Useful if val maybe a scalar or an array.
+ """
+ return asanyarray(val).real
+
+def imag(val):
+ """Return the imaginary part of val.
+
+ Useful if val maybe a scalar or an array.
+ """
+ return asanyarray(val).imag
+
+def iscomplex(x):
+ """Return a boolean array where elements are True if that element
+ is complex (has non-zero imaginary part).
+
+ For scalars, return a boolean.
+ """
+ ax = asanyarray(x)
+ if issubclass(ax.dtype.type, _nx.complexfloating):
+ return ax.imag != 0
+ res = zeros(ax.shape, bool)
+ return +res # convet to array-scalar if needed
+
+def isreal(x):
+ """Return a boolean array where elements are True if that element
+ is real (has zero imaginary part)
+
+ For scalars, return a boolean.
+ """
+ return imag(x) == 0
+
+def iscomplexobj(x):
+ """Return True if x is a complex type or an array of complex numbers.
+
+ Unlike iscomplex(x), complex(3.0) is considered a complex object.
+ """
+ return issubclass( asarray(x).dtype.type, _nx.complexfloating)
+
+def isrealobj(x):
+ """Return True if x is not a complex type.
+
+ Unlike isreal(x), complex(3.0) is considered a complex object.
+ """
+ return not issubclass( asarray(x).dtype.type, _nx.complexfloating)
+
+#-----------------------------------------------------------------------------
+
+def _getmaxmin(t):
+ import getlimits
+ f = getlimits.finfo(t)
+ return f.max, f.min
+
+def nan_to_num(x):
+ """
+ Returns a copy of replacing NaN's with 0 and Infs with large numbers
+
+ The following mappings are applied:
+ NaN -> 0
+ Inf -> limits.double_max
+ -Inf -> limits.double_min
+ """
+ try:
+ t = x.dtype.type
+ except AttributeError:
+ t = obj2sctype(type(x))
+ if issubclass(t, _nx.complexfloating):
+ return nan_to_num(x.real) + 1j * nan_to_num(x.imag)
+ else:
+ try:
+ y = x.copy()
+ except AttributeError:
+ y = array(x)
+ if not issubclass(t, _nx.integer):
+ if not y.shape:
+ y = array([x])
+ scalar = True
+ else:
+ scalar = False
+ are_inf = isposinf(y)
+ are_neg_inf = isneginf(y)
+ are_nan = isnan(y)
+ maxf, minf = _getmaxmin(y.dtype.type)
+ y[are_nan] = 0
+ y[are_inf] = maxf
+ y[are_neg_inf] = minf
+ if scalar:
+ y = y[0]
+ return y
+
+#-----------------------------------------------------------------------------
+
+def real_if_close(a,tol=100):
+ """If a is a complex array, return it as a real array if the imaginary
+ part is close enough to zero.
+
+ "Close enough" is defined as tol*(machine epsilon of a's element type).
+ """
+ a = asanyarray(a)
+ if not issubclass(a.dtype.type, _nx.complexfloating):
+ return a
+ if tol > 1:
+ import getlimits
+ f = getlimits.finfo(a.dtype.type)
+ tol = f.eps * tol
+ if _nx.allclose(a.imag, 0, atol=tol):
+ a = a.real
+ return a
+
+
+def asscalar(a):
+ """Convert an array of size 1 to its scalar equivalent.
+ """
+ return a.item()
+
+#-----------------------------------------------------------------------------
+
+_namefromtype = {'S1' : 'character',
+ '?' : 'bool',
+ 'b' : 'signed char',
+ 'B' : 'unsigned char',
+ 'h' : 'short',
+ 'H' : 'unsigned short',
+ 'i' : 'integer',
+ 'I' : 'unsigned integer',
+ 'l' : 'long integer',
+ 'L' : 'unsigned long integer',
+ 'q' : 'long long integer',
+ 'Q' : 'unsigned long long integer',
+ 'f' : 'single precision',
+ 'd' : 'double precision',
+ 'g' : 'long precision',
+ 'F' : 'complex single precision',
+ 'D' : 'complex double precision',
+ 'G' : 'complex long double precision',
+ 'S' : 'string',
+ 'U' : 'unicode',
+ 'V' : 'void',
+ 'O' : 'object'
+ }
+
+def typename(char):
+ """Return an english description for the given data type character.
+ """
+ return _namefromtype[char]
+
+#-----------------------------------------------------------------------------
+
+#determine the "minimum common type" for a group of arrays.
+array_type = [[_nx.single, _nx.double, _nx.longdouble],
+ [_nx.csingle, _nx.cdouble, _nx.clongdouble]]
+array_precision = {_nx.single : 0,
+ _nx.double : 1,
+ _nx.longdouble : 2,
+ _nx.csingle : 0,
+ _nx.cdouble : 1,
+ _nx.clongdouble : 2}
+def common_type(*arrays):
+ """Given a sequence of arrays as arguments, return the best inexact
+ scalar type which is "most" common amongst them.
+
+ The return type will always be a inexact scalar type, even if all
+ the arrays are integer arrays.
+ """
+ is_complex = False
+ precision = 0
+ for a in arrays:
+ t = a.dtype.type
+ if iscomplexobj(a):
+ is_complex = True
+ if issubclass(t, _nx.integer):
+ p = 1
+ else:
+ p = array_precision.get(t, None)
+ if p is None:
+ raise TypeError("can't get common type for non-numeric array")
+ precision = max(precision, p)
+ if is_complex:
+ return array_type[1][precision]
+ else:
+ return array_type[0][precision]
diff --git a/numpy/lib/ufunclike.py b/numpy/lib/ufunclike.py
new file mode 100644
index 000000000..a8c2c1e25
--- /dev/null
+++ b/numpy/lib/ufunclike.py
@@ -0,0 +1,60 @@
+"""
+Module of functions that are like ufuncs in acting on arrays and optionally
+storing results in an output array.
+"""
+__all__ = ['fix', 'isneginf', 'isposinf', 'log2']
+
+import numpy.core.numeric as nx
+from numpy.core.numeric import asarray, empty, isinf, signbit, asanyarray
+import numpy.core.umath as umath
+
+def fix(x, y=None):
+ """ Round x to nearest integer towards zero.
+ """
+ x = asanyarray(x)
+ if y is None:
+ y = nx.floor(x)
+ else:
+ nx.floor(x, y)
+ if x.ndim == 0:
+ if (x<0):
+ y += 1
+ else:
+ y[x<0] = y[x<0]+1
+ return y
+
+def isposinf(x, y=None):
+ """Return a boolean array y with y[i] True for x[i] = +Inf.
+
+ If y is an array, the result replaces the contents of y.
+ """
+ if y is None:
+ x = asarray(x)
+ y = empty(x.shape, dtype=nx.bool_)
+ umath.logical_and(isinf(x), ~signbit(x), y)
+ return y
+
+def isneginf(x, y=None):
+ """Return a boolean array y with y[i] True for x[i] = -Inf.
+
+ If y is an array, the result replaces the contents of y.
+ """
+ if y is None:
+ x = asarray(x)
+ y = empty(x.shape, dtype=nx.bool_)
+ umath.logical_and(isinf(x), signbit(x), y)
+ return y
+
+_log2 = umath.log(2)
+def log2(x, y=None):
+ """Returns the base 2 logarithm of x
+
+ If y is an array, the result replaces the contents of y.
+ """
+ x = asanyarray(x)
+ if y is None:
+ y = umath.log(x)
+ else:
+ umath.log(x, y)
+ y /= _log2
+ return y
diff --git a/numpy/lib/user_array.py b/numpy/lib/user_array.py
new file mode 100644
index 000000000..43e9da3f2
--- /dev/null
+++ b/numpy/lib/user_array.py
@@ -0,0 +1,217 @@
+"""
+Standard container-class for easy multiple-inheritance.
+Try to inherit from the ndarray instead of using this class as this is not
+complete.
+"""
+
+from numpy.core import array, asarray, absolute, add, subtract, multiply, \
+ divide, remainder, power, left_shift, right_shift, bitwise_and, \
+ bitwise_or, bitwise_xor, invert, less, less_equal, not_equal, equal, \
+ greater, greater_equal, shape, reshape, arange, sin, sqrt, transpose
+
+class container(object):
+ def __init__(self, data, dtype=None, copy=True):
+ self.array = array(data, dtype, copy=copy)
+
+ def __repr__(self):
+ if len(self.shape) > 0:
+ return self.__class__.__name__+repr(self.array)[len("array"):]
+ else:
+ return self.__class__.__name__+"("+repr(self.array)+")"
+
+ def __array__(self,t=None):
+ if t: return self.array.astype(t)
+ return self.array
+
+ # Array as sequence
+ def __len__(self): return len(self.array)
+
+ def __getitem__(self, index):
+ return self._rc(self.array[index])
+
+ def __getslice__(self, i, j):
+ return self._rc(self.array[i:j])
+
+
+ def __setitem__(self, index, value):
+ self.array[index] = asarray(value,self.dtype)
+ def __setslice__(self, i, j, value):
+ self.array[i:j] = asarray(value,self.dtype)
+
+ def __abs__(self):
+ return self._rc(absolute(self.array))
+ def __neg__(self):
+ return self._rc(-self.array)
+
+ def __add__(self, other):
+ return self._rc(self.array+asarray(other))
+ __radd__ = __add__
+
+ def __iadd__(self, other):
+ add(self.array, other, self.array)
+ return self
+
+ def __sub__(self, other):
+ return self._rc(self.array-asarray(other))
+ def __rsub__(self, other):
+ return self._rc(asarray(other)-self.array)
+ def __isub__(self, other):
+ subtract(self.array, other, self.array)
+ return self
+
+ def __mul__(self, other):
+ return self._rc(multiply(self.array,asarray(other)))
+ __rmul__ = __mul__
+ def __imul__(self, other):
+ multiply(self.array, other, self.array)
+ return self
+
+ def __div__(self, other):
+ return self._rc(divide(self.array,asarray(other)))
+ def __rdiv__(self, other):
+ return self._rc(divide(asarray(other),self.array))
+ def __idiv__(self, other):
+ divide(self.array, other, self.array)
+ return self
+
+ def __mod__(self, other):
+ return self._rc(remainder(self.array, other))
+ def __rmod__(self, other):
+ return self._rc(remainder(other, self.array))
+ def __imod__(self, other):
+ remainder(self.array, other, self.array)
+ return self
+
+ def __divmod__(self, other):
+ return (self._rc(divide(self.array,other)),
+ self._rc(remainder(self.array, other)))
+ def __rdivmod__(self, other):
+ return (self._rc(divide(other, self.array)),
+ self._rc(remainder(other, self.array)))
+
+ def __pow__(self,other):
+ return self._rc(power(self.array,asarray(other)))
+ def __rpow__(self,other):
+ return self._rc(power(asarray(other),self.array))
+ def __ipow__(self,other):
+ power(self.array, other, self.array)
+ return self
+
+ def __lshift__(self,other):
+ return self._rc(left_shift(self.array, other))
+ def __rshift__(self,other):
+ return self._rc(right_shift(self.array, other))
+ def __rlshift__(self,other):
+ return self._rc(left_shift(other, self.array))
+ def __rrshift__(self,other):
+ return self._rc(right_shift(other, self.array))
+ def __ilshift__(self,other):
+ left_shift(self.array, other, self.array)
+ return self
+ def __irshift__(self,other):
+ right_shift(self.array, other, self.array)
+ return self
+
+ def __and__(self, other):
+ return self._rc(bitwise_and(self.array, other))
+ def __rand__(self, other):
+ return self._rc(bitwise_and(other, self.array))
+ def __iand__(self, other):
+ bitwise_and(self.array, other, self.array)
+ return self
+
+ def __xor__(self, other):
+ return self._rc(bitwise_xor(self.array, other))
+ def __rxor__(self, other):
+ return self._rc(bitwise_xor(other, self.array))
+ def __ixor__(self, other):
+ bitwise_xor(self.array, other, self.array)
+ return self
+
+ def __or__(self, other):
+ return self._rc(bitwise_or(self.array, other))
+ def __ror__(self, other):
+ return self._rc(bitwise_or(other, self.array))
+ def __ior__(self, other):
+ bitwise_or(self.array, other, self.array)
+ return self
+
+ def __neg__(self):
+ return self._rc(-self.array)
+ def __pos__(self):
+ return self._rc(self.array)
+ def __abs__(self):
+ return self._rc(abs(self.array))
+ def __invert__(self):
+ return self._rc(invert(self.array))
+
+ def _scalarfunc(self, func):
+ if len(self.shape) == 0:
+ return func(self[0])
+ else:
+ raise TypeError, "only rank-0 arrays can be converted to Python scalars."
+
+ def __complex__(self): return self._scalarfunc(complex)
+ def __float__(self): return self._scalarfunc(float)
+ def __int__(self): return self._scalarfunc(int)
+ def __long__(self): return self._scalarfunc(long)
+ def __hex__(self): return self._scalarfunc(hex)
+ def __oct__(self): return self._scalarfunc(oct)
+
+ def __lt__(self,other): return self._rc(less(self.array,other))
+ def __le__(self,other): return self._rc(less_equal(self.array,other))
+ def __eq__(self,other): return self._rc(equal(self.array,other))
+ def __ne__(self,other): return self._rc(not_equal(self.array,other))
+ def __gt__(self,other): return self._rc(greater(self.array,other))
+ def __ge__(self,other): return self._rc(greater_equal(self.array,other))
+
+ def copy(self): return self._rc(self.array.copy())
+
+ def tostring(self): return self.array.tostring()
+
+ def byteswap(self): return self._rc(self.array.byteswap())
+
+ def astype(self, typecode): return self._rc(self.array.astype(typecode))
+
+ def _rc(self, a):
+ if len(shape(a)) == 0: return a
+ else: return self.__class__(a)
+
+ def __array_wrap__(self, *args):
+ return self.__class__(args[0])
+
+ def __setattr__(self,attr,value):
+ if attr == 'array':
+ object.__setattr__(self, attr, value)
+ return
+ try:
+ self.array.__setattr__(attr, value)
+ except AttributeError:
+ object.__setattr__(self, attr, value)
+
+ # Only called after other approaches fail.
+ def __getattr__(self,attr):
+ if (attr == 'array'):
+ return object.__getattribute__(self, attr)
+ return self.array.__getattribute__(attr)
+
+#############################################################
+# Test of class container
+#############################################################
+if __name__ == '__main__':
+ temp=reshape(arange(10000),(100,100))
+
+ ua=container(temp)
+ # new object created begin test
+ print dir(ua)
+ print shape(ua),ua.shape # I have changed Numeric.py
+
+ ua_small=ua[:3,:5]
+ print ua_small
+ ua_small[0,0]=10 # this did not change ua[0,0], which is not normal behavior
+ print ua_small[0,0],ua[0,0]
+ print sin(ua_small)/3.*6.+sqrt(ua_small**2)
+ print less(ua_small,103),type(less(ua_small,103))
+ print type(ua_small*reshape(arange(15),shape(ua_small)))
+ print reshape(ua_small,(5,3))
+ print transpose(ua_small)
diff --git a/numpy/lib/utils.py b/numpy/lib/utils.py
new file mode 100644
index 000000000..fa69e6718
--- /dev/null
+++ b/numpy/lib/utils.py
@@ -0,0 +1,432 @@
+import os
+import sys
+import inspect
+import types
+from numpy.core.numerictypes import obj2sctype, generic
+from numpy.core.multiarray import dtype as _dtype
+from numpy.core import product, ndarray
+
+__all__ = ['issubclass_', 'get_numpy_include', 'issubsctype',
+ 'issubdtype', 'deprecate', 'get_numarray_include',
+ 'get_include', 'info', 'source', 'who',
+ 'byte_bounds', 'may_share_memory']
+
+def issubclass_(arg1, arg2):
+ try:
+ return issubclass(arg1, arg2)
+ except TypeError:
+ return False
+
+def issubsctype(arg1, arg2):
+ return issubclass(obj2sctype(arg1), obj2sctype(arg2))
+
+def issubdtype(arg1, arg2):
+ if issubclass_(arg2, generic):
+ return issubclass(_dtype(arg1).type, arg2)
+ mro = _dtype(arg2).type.mro()
+ if len(mro) > 1:
+ val = mro[1]
+ else:
+ val = mro[0]
+ return issubclass(_dtype(arg1).type, val)
+
+def get_include():
+ """Return the directory in the package that contains the numpy/*.h header
+ files.
+
+ Extension modules that need to compile against numpy should use this
+ function to locate the appropriate include directory. Using distutils:
+
+ import numpy
+ Extension('extension_name', ...
+ include_dirs=[numpy.get_include()])
+ """
+ import numpy
+ if numpy.show_config is None:
+ # running from numpy source directory
+ d = os.path.join(os.path.dirname(numpy.__file__), 'core', 'include')
+ else:
+ # using installed numpy core headers
+ import numpy.core as core
+ d = os.path.join(os.path.dirname(core.__file__), 'include')
+ return d
+
+def get_numarray_include(type=None):
+ """Return the directory in the package that contains the numpy/*.h header
+ files.
+
+ Extension modules that need to compile against numpy should use this
+ function to locate the appropriate include directory. Using distutils:
+
+ import numpy
+ Extension('extension_name', ...
+ include_dirs=[numpy.get_numarray_include()])
+ """
+ from numpy.numarray import get_numarray_include_dirs
+ include_dirs = get_numarray_include_dirs()
+ if type is None:
+ return include_dirs[0]
+ else:
+ return include_dirs + [get_include()]
+
+
+if sys.version_info < (2, 4):
+ # Can't set __name__ in 2.3
+ import new
+ def _set_function_name(func, name):
+ func = new.function(func.func_code, func.func_globals,
+ name, func.func_defaults, func.func_closure)
+ return func
+else:
+ def _set_function_name(func, name):
+ func.__name__ = name
+ return func
+
+def deprecate(func, oldname, newname):
+ import warnings
+ def newfunc(*args,**kwds):
+ warnings.warn("%s is deprecated, use %s" % (oldname, newname),
+ DeprecationWarning)
+ return func(*args, **kwds)
+ newfunc = _set_function_name(newfunc, oldname)
+ doc = func.__doc__
+ depdoc = '%s is DEPRECATED in numpy: use %s instead' % (oldname, newname,)
+ if doc is None:
+ doc = depdoc
+ else:
+ doc = '\n'.join([depdoc, doc])
+ newfunc.__doc__ = doc
+ try:
+ d = func.__dict__
+ except AttributeError:
+ pass
+ else:
+ newfunc.__dict__.update(d)
+ return newfunc
+
+get_numpy_include = deprecate(get_include, 'get_numpy_include', 'get_include')
+
+
+#--------------------------------------------
+# Determine if two arrays can share memory
+#--------------------------------------------
+
+def byte_bounds(a):
+ """(low, high) are pointers to the end-points of an array
+
+ low is the first byte
+ high is just *past* the last byte
+
+ If the array is not single-segment, then it may not actually
+ use every byte between these bounds.
+
+ The array provided must conform to the Python-side of the array interface
+ """
+ ai = a.__array_interface__
+ a_data = ai['data'][0]
+ astrides = ai['strides']
+ ashape = ai['shape']
+ nd_a = len(ashape)
+ bytes_a = int(ai['typestr'][2:])
+
+ a_low = a_high = a_data
+ if astrides is None: # contiguous case
+ a_high += product(ashape, dtype=int)*bytes_a
+ else:
+ for shape, stride in zip(ashape, astrides):
+ if stride < 0:
+ a_low += (shape-1)*stride
+ else:
+ a_high += (shape-1)*stride
+ a_high += bytes_a
+ return a_low, a_high
+
+
+def may_share_memory(a, b):
+ """Determine if two arrays can share memory
+
+ The memory-bounds of a and b are computed. If they overlap then
+ this function returns True. Otherwise, it returns False.
+
+ A return of True does not necessarily mean that the two arrays
+ share any element. It just means that they *might*.
+ """
+ a_low, a_high = byte_bounds(a)
+ b_low, b_high = byte_bounds(b)
+ if b_low >= a_high or a_low >= b_high:
+ return False
+ return True
+
+#-----------------------------------------------------------------------------
+# Function for output and information on the variables used.
+#-----------------------------------------------------------------------------
+
+
+def who(vardict=None):
+ """Print the Numpy arrays in the given dictionary (or globals() if None).
+ """
+ if vardict is None:
+ frame = sys._getframe().f_back
+ vardict = frame.f_globals
+ sta = []
+ cache = {}
+ for name in vardict.keys():
+ if isinstance(vardict[name],ndarray):
+ var = vardict[name]
+ idv = id(var)
+ if idv in cache.keys():
+ namestr = name + " (%s)" % cache[idv]
+ original=0
+ else:
+ cache[idv] = name
+ namestr = name
+ original=1
+ shapestr = " x ".join(map(str, var.shape))
+ bytestr = str(var.itemsize*product(var.shape))
+ sta.append([namestr, shapestr, bytestr, var.dtype.name,
+ original])
+
+ maxname = 0
+ maxshape = 0
+ maxbyte = 0
+ totalbytes = 0
+ for k in range(len(sta)):
+ val = sta[k]
+ if maxname < len(val[0]):
+ maxname = len(val[0])
+ if maxshape < len(val[1]):
+ maxshape = len(val[1])
+ if maxbyte < len(val[2]):
+ maxbyte = len(val[2])
+ if val[4]:
+ totalbytes += int(val[2])
+
+ if len(sta) > 0:
+ sp1 = max(10,maxname)
+ sp2 = max(10,maxshape)
+ sp3 = max(10,maxbyte)
+ prval = "Name %s Shape %s Bytes %s Type" % (sp1*' ', sp2*' ', sp3*' ')
+ print prval + "\n" + "="*(len(prval)+5) + "\n"
+
+ for k in range(len(sta)):
+ val = sta[k]
+ print "%s %s %s %s %s %s %s" % (val[0], ' '*(sp1-len(val[0])+4),
+ val[1], ' '*(sp2-len(val[1])+5),
+ val[2], ' '*(sp3-len(val[2])+5),
+ val[3])
+ print "\nUpper bound on total bytes = %d" % totalbytes
+ return
+
+#-----------------------------------------------------------------------------
+
+
+# NOTE: pydoc defines a help function which works simliarly to this
+# except it uses a pager to take over the screen.
+
+# combine name and arguments and split to multiple lines of
+# width characters. End lines on a comma and begin argument list
+# indented with the rest of the arguments.
+def _split_line(name, arguments, width):
+ firstwidth = len(name)
+ k = firstwidth
+ newstr = name
+ sepstr = ", "
+ arglist = arguments.split(sepstr)
+ for argument in arglist:
+ if k == firstwidth:
+ addstr = ""
+ else:
+ addstr = sepstr
+ k = k + len(argument) + len(addstr)
+ if k > width:
+ k = firstwidth + 1 + len(argument)
+ newstr = newstr + ",\n" + " "*(firstwidth+2) + argument
+ else:
+ newstr = newstr + addstr + argument
+ return newstr
+
+_namedict = None
+_dictlist = None
+
+# Traverse all module directories underneath globals
+# to see if something is defined
+def _makenamedict(module='numpy'):
+ module = __import__(module, globals(), locals(), [])
+ thedict = {module.__name__:module.__dict__}
+ dictlist = [module.__name__]
+ totraverse = [module.__dict__]
+ while 1:
+ if len(totraverse) == 0:
+ break
+ thisdict = totraverse.pop(0)
+ for x in thisdict.keys():
+ if isinstance(thisdict[x],types.ModuleType):
+ modname = thisdict[x].__name__
+ if modname not in dictlist:
+ moddict = thisdict[x].__dict__
+ dictlist.append(modname)
+ totraverse.append(moddict)
+ thedict[modname] = moddict
+ return thedict, dictlist
+
+def info(object=None,maxwidth=76,output=sys.stdout,toplevel='numpy'):
+ """Get help information for a function, class, or module.
+
+ Example:
+ >>> from numpy import *
+ >>> info(polyval) # doctest: +SKIP
+
+ polyval(p, x)
+
+ Evaluate the polymnomial p at x.
+
+ Description:
+ If p is of length N, this function returns the value:
+ p[0]*(x**N-1) + p[1]*(x**N-2) + ... + p[N-2]*x + p[N-1]
+ """
+ global _namedict, _dictlist
+ import pydoc
+
+ if hasattr(object,'_ppimport_importer') or \
+ hasattr(object, '_ppimport_module'):
+ object = object._ppimport_module
+ elif hasattr(object, '_ppimport_attr'):
+ object = object._ppimport_attr
+
+ if object is None:
+ info(info)
+ elif isinstance(object, ndarray):
+ import numpy.numarray as nn
+ nn.info(object, output=output, numpy=1)
+ elif isinstance(object, str):
+ if _namedict is None:
+ _namedict, _dictlist = _makenamedict(toplevel)
+ numfound = 0
+ objlist = []
+ for namestr in _dictlist:
+ try:
+ obj = _namedict[namestr][object]
+ if id(obj) in objlist:
+ print >> output, "\n *** Repeat reference found in %s *** " % namestr
+ else:
+ objlist.append(id(obj))
+ print >> output, " *** Found in %s ***" % namestr
+ info(obj)
+ print >> output, "-"*maxwidth
+ numfound += 1
+ except KeyError:
+ pass
+ if numfound == 0:
+ print >> output, "Help for %s not found." % object
+ else:
+ print >> output, "\n *** Total of %d references found. ***" % numfound
+
+ elif inspect.isfunction(object):
+ name = object.func_name
+ arguments = apply(inspect.formatargspec, inspect.getargspec(object))
+
+ if len(name+arguments) > maxwidth:
+ argstr = _split_line(name, arguments, maxwidth)
+ else:
+ argstr = name + arguments
+
+ print >> output, " " + argstr + "\n"
+ print >> output, inspect.getdoc(object)
+
+ elif inspect.isclass(object):
+ name = object.__name__
+ arguments = "()"
+ try:
+ if hasattr(object, '__init__'):
+ arguments = apply(inspect.formatargspec, inspect.getargspec(object.__init__.im_func))
+ arglist = arguments.split(', ')
+ if len(arglist) > 1:
+ arglist[1] = "("+arglist[1]
+ arguments = ", ".join(arglist[1:])
+ except:
+ pass
+
+ if len(name+arguments) > maxwidth:
+ argstr = _split_line(name, arguments, maxwidth)
+ else:
+ argstr = name + arguments
+
+ print >> output, " " + argstr + "\n"
+ doc1 = inspect.getdoc(object)
+ if doc1 is None:
+ if hasattr(object,'__init__'):
+ print >> output, inspect.getdoc(object.__init__)
+ else:
+ print >> output, inspect.getdoc(object)
+
+ methods = pydoc.allmethods(object)
+ if methods != []:
+ print >> output, "\n\nMethods:\n"
+ for meth in methods:
+ if meth[0] == '_':
+ continue
+ thisobj = getattr(object, meth, None)
+ if thisobj is not None:
+ methstr, other = pydoc.splitdoc(inspect.getdoc(thisobj) or "None")
+ print >> output, " %s -- %s" % (meth, methstr)
+
+ elif type(object) is types.InstanceType: ## check for __call__ method
+ print >> output, "Instance of class: ", object.__class__.__name__
+ print >> output
+ if hasattr(object, '__call__'):
+ arguments = apply(inspect.formatargspec, inspect.getargspec(object.__call__.im_func))
+ arglist = arguments.split(', ')
+ if len(arglist) > 1:
+ arglist[1] = "("+arglist[1]
+ arguments = ", ".join(arglist[1:])
+ else:
+ arguments = "()"
+
+ if hasattr(object,'name'):
+ name = "%s" % object.name
+ else:
+ name = "<name>"
+ if len(name+arguments) > maxwidth:
+ argstr = _split_line(name, arguments, maxwidth)
+ else:
+ argstr = name + arguments
+
+ print >> output, " " + argstr + "\n"
+ doc = inspect.getdoc(object.__call__)
+ if doc is not None:
+ print >> output, inspect.getdoc(object.__call__)
+ print >> output, inspect.getdoc(object)
+
+ else:
+ print >> output, inspect.getdoc(object)
+
+ elif inspect.ismethod(object):
+ name = object.__name__
+ arguments = apply(inspect.formatargspec, inspect.getargspec(object.im_func))
+ arglist = arguments.split(', ')
+ if len(arglist) > 1:
+ arglist[1] = "("+arglist[1]
+ arguments = ", ".join(arglist[1:])
+ else:
+ arguments = "()"
+
+ if len(name+arguments) > maxwidth:
+ argstr = _split_line(name, arguments, maxwidth)
+ else:
+ argstr = name + arguments
+
+ print >> output, " " + argstr + "\n"
+ print >> output, inspect.getdoc(object)
+
+ elif hasattr(object, '__doc__'):
+ print >> output, inspect.getdoc(object)
+
+
+def source(object, output=sys.stdout):
+ """Write source for this object to output.
+ """
+ try:
+ print >> output, "In file: %s\n" % inspect.getsourcefile(object)
+ print >> output, inspect.getsource(object)
+ except:
+ print >> output, "Not available for this object."
diff --git a/numpy/linalg/__init__.py b/numpy/linalg/__init__.py
new file mode 100644
index 000000000..85d81d0a8
--- /dev/null
+++ b/numpy/linalg/__init__.py
@@ -0,0 +1,8 @@
+# To get sub-modules
+from info import __doc__
+
+from linalg import *
+
+def test(level=1, verbosity=1):
+ from numpy.testing import NumpyTest
+ return NumpyTest().test(level, verbosity)
diff --git a/numpy/linalg/blas_lite.c b/numpy/linalg/blas_lite.c
new file mode 100644
index 000000000..38adc2aeb
--- /dev/null
+++ b/numpy/linalg/blas_lite.c
@@ -0,0 +1,10659 @@
+/*
+NOTE: This is generated code. Look in Misc/lapack_lite for information on
+ remaking this file.
+*/
+#include "f2c.h"
+
+#ifdef HAVE_CONFIG
+#include "config.h"
+#else
+extern doublereal dlamch_(char *);
+#define EPSILON dlamch_("Epsilon")
+#define SAFEMINIMUM dlamch_("Safe minimum")
+#define PRECISION dlamch_("Precision")
+#define BASE dlamch_("Base")
+#endif
+
+extern doublereal dlapy2_(doublereal *x, doublereal *y);
+
+
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static doublecomplex c_b359 = {1.,0.};
+
+/* Subroutine */ int daxpy_(integer *n, doublereal *da, doublereal *dx,
+ integer *incx, doublereal *dy, integer *incy)
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static integer i__, m, ix, iy, mp1;
+
+
+/*
+ constant times a vector plus a vector.
+ uses unrolled loops for increments equal to one.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+*/
+
+
+ /* Parameter adjustments */
+ --dy;
+ --dx;
+
+ /* Function Body */
+ if (*n <= 0) {
+ return 0;
+ }
+ if (*da == 0.) {
+ return 0;
+ }
+ if ((*incx == 1 && *incy == 1)) {
+ goto L20;
+ }
+
+/*
+ code for unequal increments or equal increments
+ not equal to 1
+*/
+
+ ix = 1;
+ iy = 1;
+ if (*incx < 0) {
+ ix = (-(*n) + 1) * *incx + 1;
+ }
+ if (*incy < 0) {
+ iy = (-(*n) + 1) * *incy + 1;
+ }
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dy[iy] += *da * dx[ix];
+ ix += *incx;
+ iy += *incy;
+/* L10: */
+ }
+ return 0;
+
+/*
+ code for both increments equal to 1
+
+
+ clean-up loop
+*/
+
+L20:
+ m = *n % 4;
+ if (m == 0) {
+ goto L40;
+ }
+ i__1 = m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dy[i__] += *da * dx[i__];
+/* L30: */
+ }
+ if (*n < 4) {
+ return 0;
+ }
+L40:
+ mp1 = m + 1;
+ i__1 = *n;
+ for (i__ = mp1; i__ <= i__1; i__ += 4) {
+ dy[i__] += *da * dx[i__];
+ dy[i__ + 1] += *da * dx[i__ + 1];
+ dy[i__ + 2] += *da * dx[i__ + 2];
+ dy[i__ + 3] += *da * dx[i__ + 3];
+/* L50: */
+ }
+ return 0;
+} /* daxpy_ */
+
+doublereal dcabs1_(doublecomplex *z__)
+{
+ /* System generated locals */
+ doublereal ret_val;
+ static doublecomplex equiv_0[1];
+
+ /* Local variables */
+#define t ((doublereal *)equiv_0)
+#define zz (equiv_0)
+
+ zz->r = z__->r, zz->i = z__->i;
+ ret_val = abs(t[0]) + abs(t[1]);
+ return ret_val;
+} /* dcabs1_ */
+
+#undef zz
+#undef t
+
+
+/* Subroutine */ int dcopy_(integer *n, doublereal *dx, integer *incx,
+ doublereal *dy, integer *incy)
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static integer i__, m, ix, iy, mp1;
+
+
+/*
+ copies a vector, x, to a vector, y.
+ uses unrolled loops for increments equal to one.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+*/
+
+
+ /* Parameter adjustments */
+ --dy;
+ --dx;
+
+ /* Function Body */
+ if (*n <= 0) {
+ return 0;
+ }
+ if ((*incx == 1 && *incy == 1)) {
+ goto L20;
+ }
+
+/*
+ code for unequal increments or equal increments
+ not equal to 1
+*/
+
+ ix = 1;
+ iy = 1;
+ if (*incx < 0) {
+ ix = (-(*n) + 1) * *incx + 1;
+ }
+ if (*incy < 0) {
+ iy = (-(*n) + 1) * *incy + 1;
+ }
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dy[iy] = dx[ix];
+ ix += *incx;
+ iy += *incy;
+/* L10: */
+ }
+ return 0;
+
+/*
+ code for both increments equal to 1
+
+
+ clean-up loop
+*/
+
+L20:
+ m = *n % 7;
+ if (m == 0) {
+ goto L40;
+ }
+ i__1 = m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dy[i__] = dx[i__];
+/* L30: */
+ }
+ if (*n < 7) {
+ return 0;
+ }
+L40:
+ mp1 = m + 1;
+ i__1 = *n;
+ for (i__ = mp1; i__ <= i__1; i__ += 7) {
+ dy[i__] = dx[i__];
+ dy[i__ + 1] = dx[i__ + 1];
+ dy[i__ + 2] = dx[i__ + 2];
+ dy[i__ + 3] = dx[i__ + 3];
+ dy[i__ + 4] = dx[i__ + 4];
+ dy[i__ + 5] = dx[i__ + 5];
+ dy[i__ + 6] = dx[i__ + 6];
+/* L50: */
+ }
+ return 0;
+} /* dcopy_ */
+
+doublereal ddot_(integer *n, doublereal *dx, integer *incx, doublereal *dy,
+ integer *incy)
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal ret_val;
+
+ /* Local variables */
+ static integer i__, m, ix, iy, mp1;
+ static doublereal dtemp;
+
+
+/*
+ forms the dot product of two vectors.
+ uses unrolled loops for increments equal to one.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+*/
+
+
+ /* Parameter adjustments */
+ --dy;
+ --dx;
+
+ /* Function Body */
+ ret_val = 0.;
+ dtemp = 0.;
+ if (*n <= 0) {
+ return ret_val;
+ }
+ if ((*incx == 1 && *incy == 1)) {
+ goto L20;
+ }
+
+/*
+ code for unequal increments or equal increments
+ not equal to 1
+*/
+
+ ix = 1;
+ iy = 1;
+ if (*incx < 0) {
+ ix = (-(*n) + 1) * *incx + 1;
+ }
+ if (*incy < 0) {
+ iy = (-(*n) + 1) * *incy + 1;
+ }
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dtemp += dx[ix] * dy[iy];
+ ix += *incx;
+ iy += *incy;
+/* L10: */
+ }
+ ret_val = dtemp;
+ return ret_val;
+
+/*
+ code for both increments equal to 1
+
+
+ clean-up loop
+*/
+
+L20:
+ m = *n % 5;
+ if (m == 0) {
+ goto L40;
+ }
+ i__1 = m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dtemp += dx[i__] * dy[i__];
+/* L30: */
+ }
+ if (*n < 5) {
+ goto L60;
+ }
+L40:
+ mp1 = m + 1;
+ i__1 = *n;
+ for (i__ = mp1; i__ <= i__1; i__ += 5) {
+ dtemp = dtemp + dx[i__] * dy[i__] + dx[i__ + 1] * dy[i__ + 1] + dx[
+ i__ + 2] * dy[i__ + 2] + dx[i__ + 3] * dy[i__ + 3] + dx[i__ +
+ 4] * dy[i__ + 4];
+/* L50: */
+ }
+L60:
+ ret_val = dtemp;
+ return ret_val;
+} /* ddot_ */
+
+/* Subroutine */ int dgemm_(char *transa, char *transb, integer *m, integer *
+ n, integer *k, doublereal *alpha, doublereal *a, integer *lda,
+ doublereal *b, integer *ldb, doublereal *beta, doublereal *c__,
+ integer *ldc)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
+ i__3;
+
+ /* Local variables */
+ static integer i__, j, l, info;
+ static logical nota, notb;
+ static doublereal temp;
+ static integer ncola;
+ extern logical lsame_(char *, char *);
+ static integer nrowa, nrowb;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/*
+ Purpose
+ =======
+
+ DGEMM performs one of the matrix-matrix operations
+
+ C := alpha*op( A )*op( B ) + beta*C,
+
+ where op( X ) is one of
+
+ op( X ) = X or op( X ) = X',
+
+ alpha and beta are scalars, and A, B and C are matrices, with op( A )
+ an m by k matrix, op( B ) a k by n matrix and C an m by n matrix.
+
+ Parameters
+ ==========
+
+ TRANSA - CHARACTER*1.
+ On entry, TRANSA specifies the form of op( A ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSA = 'N' or 'n', op( A ) = A.
+
+ TRANSA = 'T' or 't', op( A ) = A'.
+
+ TRANSA = 'C' or 'c', op( A ) = A'.
+
+ Unchanged on exit.
+
+ TRANSB - CHARACTER*1.
+ On entry, TRANSB specifies the form of op( B ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSB = 'N' or 'n', op( B ) = B.
+
+ TRANSB = 'T' or 't', op( B ) = B'.
+
+ TRANSB = 'C' or 'c', op( B ) = B'.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix
+ op( A ) and of the matrix C. M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix
+ op( B ) and the number of columns of the matrix C. N must be
+ at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry, K specifies the number of columns of the matrix
+ op( A ) and the number of rows of the matrix op( B ). K must
+ be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+ k when TRANSA = 'N' or 'n', and is m otherwise.
+ Before entry with TRANSA = 'N' or 'n', the leading m by k
+ part of the array A must contain the matrix A, otherwise
+ the leading k by m part of the array A must contain the
+ matrix A.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When TRANSA = 'N' or 'n' then
+ LDA must be at least max( 1, m ), otherwise LDA must be at
+ least max( 1, k ).
+ Unchanged on exit.
+
+ B - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
+ n when TRANSB = 'N' or 'n', and is k otherwise.
+ Before entry with TRANSB = 'N' or 'n', the leading k by n
+ part of the array B must contain the matrix B, otherwise
+ the leading n by k part of the array B must contain the
+ matrix B.
+ Unchanged on exit.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. When TRANSB = 'N' or 'n' then
+ LDB must be at least max( 1, k ), otherwise LDB must be at
+ least max( 1, n ).
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then C need not be set on input.
+ Unchanged on exit.
+
+ C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+ Before entry, the leading m by n part of the array C must
+ contain the matrix C, except when beta is zero, in which
+ case C need not be set on entry.
+ On exit, the array C is overwritten by the m by n matrix
+ ( alpha*op( A )*op( B ) + beta*C ).
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ Set NOTA and NOTB as true if A and B respectively are not
+ transposed and set NROWA, NCOLA and NROWB as the number of rows
+ and columns of A and the number of rows of B respectively.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+
+ /* Function Body */
+ nota = lsame_(transa, "N");
+ notb = lsame_(transb, "N");
+ if (nota) {
+ nrowa = *m;
+ ncola = *k;
+ } else {
+ nrowa = *k;
+ ncola = *m;
+ }
+ if (notb) {
+ nrowb = *k;
+ } else {
+ nrowb = *n;
+ }
+
+/* Test the input parameters. */
+
+ info = 0;
+ if (((! nota && ! lsame_(transa, "C")) && ! lsame_(
+ transa, "T"))) {
+ info = 1;
+ } else if (((! notb && ! lsame_(transb, "C")) && !
+ lsame_(transb, "T"))) {
+ info = 2;
+ } else if (*m < 0) {
+ info = 3;
+ } else if (*n < 0) {
+ info = 4;
+ } else if (*k < 0) {
+ info = 5;
+ } else if (*lda < max(1,nrowa)) {
+ info = 8;
+ } else if (*ldb < max(1,nrowb)) {
+ info = 10;
+ } else if (*ldc < max(1,*m)) {
+ info = 13;
+ }
+ if (info != 0) {
+ xerbla_("DGEMM ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0 || ((*alpha == 0. || *k == 0) && *beta == 1.)) {
+ return 0;
+ }
+
+/* And if alpha.eq.zero. */
+
+ if (*alpha == 0.) {
+ if (*beta == 0.) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
+/* L30: */
+ }
+/* L40: */
+ }
+ }
+ return 0;
+ }
+
+/* Start the operations. */
+
+ if (notb) {
+ if (nota) {
+
+/* Form C := alpha*A*B + beta*C. */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*beta == 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = 0.;
+/* L50: */
+ }
+ } else if (*beta != 1.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
+/* L60: */
+ }
+ }
+ i__2 = *k;
+ for (l = 1; l <= i__2; ++l) {
+ if (b[l + j * b_dim1] != 0.) {
+ temp = *alpha * b[l + j * b_dim1];
+ i__3 = *m;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ c__[i__ + j * c_dim1] += temp * a[i__ + l *
+ a_dim1];
+/* L70: */
+ }
+ }
+/* L80: */
+ }
+/* L90: */
+ }
+ } else {
+
+/* Form C := alpha*A'*B + beta*C */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ temp += a[l + i__ * a_dim1] * b[l + j * b_dim1];
+/* L100: */
+ }
+ if (*beta == 0.) {
+ c__[i__ + j * c_dim1] = *alpha * temp;
+ } else {
+ c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[
+ i__ + j * c_dim1];
+ }
+/* L110: */
+ }
+/* L120: */
+ }
+ }
+ } else {
+ if (nota) {
+
+/* Form C := alpha*A*B' + beta*C */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*beta == 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = 0.;
+/* L130: */
+ }
+ } else if (*beta != 1.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
+/* L140: */
+ }
+ }
+ i__2 = *k;
+ for (l = 1; l <= i__2; ++l) {
+ if (b[j + l * b_dim1] != 0.) {
+ temp = *alpha * b[j + l * b_dim1];
+ i__3 = *m;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ c__[i__ + j * c_dim1] += temp * a[i__ + l *
+ a_dim1];
+/* L150: */
+ }
+ }
+/* L160: */
+ }
+/* L170: */
+ }
+ } else {
+
+/* Form C := alpha*A'*B' + beta*C */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ temp += a[l + i__ * a_dim1] * b[j + l * b_dim1];
+/* L180: */
+ }
+ if (*beta == 0.) {
+ c__[i__ + j * c_dim1] = *alpha * temp;
+ } else {
+ c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[
+ i__ + j * c_dim1];
+ }
+/* L190: */
+ }
+/* L200: */
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DGEMM . */
+
+} /* dgemm_ */
+
+/* Subroutine */ int dgemv_(char *trans, integer *m, integer *n, doublereal *
+ alpha, doublereal *a, integer *lda, doublereal *x, integer *incx,
+ doublereal *beta, doublereal *y, integer *incy)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+
+ /* Local variables */
+ static integer i__, j, ix, iy, jx, jy, kx, ky, info;
+ static doublereal temp;
+ static integer lenx, leny;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/*
+ Purpose
+ =======
+
+ DGEMV performs one of the matrix-vector operations
+
+ y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y,
+
+ where alpha and beta are scalars, x and y are vectors and A is an
+ m by n matrix.
+
+ Parameters
+ ==========
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
+
+ TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
+
+ TRANS = 'C' or 'c' y := alpha*A'*x + beta*y.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry, the leading m by n part of the array A must
+ contain the matrix of coefficients.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+ Before entry, the incremented array X must contain the
+ vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of DIMENSION at least
+ ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+ Before entry with BETA non-zero, the incremented array Y
+ must contain the vector y. On exit, Y is overwritten by the
+ updated vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --x;
+ --y;
+
+ /* Function Body */
+ info = 0;
+ if (((! lsame_(trans, "N") && ! lsame_(trans, "T")) && ! lsame_(trans, "C"))) {
+ info = 1;
+ } else if (*m < 0) {
+ info = 2;
+ } else if (*n < 0) {
+ info = 3;
+ } else if (*lda < max(1,*m)) {
+ info = 6;
+ } else if (*incx == 0) {
+ info = 8;
+ } else if (*incy == 0) {
+ info = 11;
+ }
+ if (info != 0) {
+ xerbla_("DGEMV ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0 || (*alpha == 0. && *beta == 1.)) {
+ return 0;
+ }
+
+/*
+ Set LENX and LENY, the lengths of the vectors x and y, and set
+ up the start points in X and Y.
+*/
+
+ if (lsame_(trans, "N")) {
+ lenx = *n;
+ leny = *m;
+ } else {
+ lenx = *m;
+ leny = *n;
+ }
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (lenx - 1) * *incx;
+ }
+ if (*incy > 0) {
+ ky = 1;
+ } else {
+ ky = 1 - (leny - 1) * *incy;
+ }
+
+/*
+ Start the operations. In this version the elements of A are
+ accessed sequentially with one pass through A.
+
+ First form y := beta*y.
+*/
+
+ if (*beta != 1.) {
+ if (*incy == 1) {
+ if (*beta == 0.) {
+ i__1 = leny;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[i__] = 0.;
+/* L10: */
+ }
+ } else {
+ i__1 = leny;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[i__] = *beta * y[i__];
+/* L20: */
+ }
+ }
+ } else {
+ iy = ky;
+ if (*beta == 0.) {
+ i__1 = leny;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[iy] = 0.;
+ iy += *incy;
+/* L30: */
+ }
+ } else {
+ i__1 = leny;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[iy] = *beta * y[iy];
+ iy += *incy;
+/* L40: */
+ }
+ }
+ }
+ }
+ if (*alpha == 0.) {
+ return 0;
+ }
+ if (lsame_(trans, "N")) {
+
+/* Form y := alpha*A*x + y. */
+
+ jx = kx;
+ if (*incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[jx] != 0.) {
+ temp = *alpha * x[jx];
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ y[i__] += temp * a[i__ + j * a_dim1];
+/* L50: */
+ }
+ }
+ jx += *incx;
+/* L60: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[jx] != 0.) {
+ temp = *alpha * x[jx];
+ iy = ky;
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ y[iy] += temp * a[i__ + j * a_dim1];
+ iy += *incy;
+/* L70: */
+ }
+ }
+ jx += *incx;
+/* L80: */
+ }
+ }
+ } else {
+
+/* Form y := alpha*A'*x + y. */
+
+ jy = ky;
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp = 0.;
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp += a[i__ + j * a_dim1] * x[i__];
+/* L90: */
+ }
+ y[jy] += *alpha * temp;
+ jy += *incy;
+/* L100: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp = 0.;
+ ix = kx;
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp += a[i__ + j * a_dim1] * x[ix];
+ ix += *incx;
+/* L110: */
+ }
+ y[jy] += *alpha * temp;
+ jy += *incy;
+/* L120: */
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DGEMV . */
+
+} /* dgemv_ */
+
+/* Subroutine */ int dger_(integer *m, integer *n, doublereal *alpha,
+ doublereal *x, integer *incx, doublereal *y, integer *incy,
+ doublereal *a, integer *lda)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+
+ /* Local variables */
+ static integer i__, j, ix, jy, kx, info;
+ static doublereal temp;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/*
+ Purpose
+ =======
+
+ DGER performs the rank 1 operation
+
+ A := alpha*x*y' + A,
+
+ where alpha is a scalar, x is an m element vector, y is an n element
+ vector and A is an m by n matrix.
+
+ Parameters
+ ==========
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( m - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the m
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y.
+ Unchanged on exit.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry, the leading m by n part of the array A must
+ contain the matrix of coefficients. On exit, A is
+ overwritten by the updated matrix.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --x;
+ --y;
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+
+ /* Function Body */
+ info = 0;
+ if (*m < 0) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*incx == 0) {
+ info = 5;
+ } else if (*incy == 0) {
+ info = 7;
+ } else if (*lda < max(1,*m)) {
+ info = 9;
+ }
+ if (info != 0) {
+ xerbla_("DGER ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0 || *alpha == 0.) {
+ return 0;
+ }
+
+/*
+ Start the operations. In this version the elements of A are
+ accessed sequentially with one pass through A.
+*/
+
+ if (*incy > 0) {
+ jy = 1;
+ } else {
+ jy = 1 - (*n - 1) * *incy;
+ }
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (y[jy] != 0.) {
+ temp = *alpha * y[jy];
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] += x[i__] * temp;
+/* L10: */
+ }
+ }
+ jy += *incy;
+/* L20: */
+ }
+ } else {
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (*m - 1) * *incx;
+ }
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (y[jy] != 0.) {
+ temp = *alpha * y[jy];
+ ix = kx;
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] += x[ix] * temp;
+ ix += *incx;
+/* L30: */
+ }
+ }
+ jy += *incy;
+/* L40: */
+ }
+ }
+
+ return 0;
+
+/* End of DGER . */
+
+} /* dger_ */
+
+doublereal dnrm2_(integer *n, doublereal *x, integer *incx)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ doublereal ret_val, d__1;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static integer ix;
+ static doublereal ssq, norm, scale, absxi;
+
+
+/*
+ DNRM2 returns the euclidean norm of a vector via the function
+ name, so that
+
+ DNRM2 := sqrt( x'*x )
+
+
+ -- This version written on 25-October-1982.
+ Modified on 14-October-1993 to inline the call to DLASSQ.
+ Sven Hammarling, Nag Ltd.
+*/
+
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ if (*n < 1 || *incx < 1) {
+ norm = 0.;
+ } else if (*n == 1) {
+ norm = abs(x[1]);
+ } else {
+ scale = 0.;
+ ssq = 1.;
+/*
+ The following loop is equivalent to this call to the LAPACK
+ auxiliary routine:
+ CALL DLASSQ( N, X, INCX, SCALE, SSQ )
+*/
+
+ i__1 = (*n - 1) * *incx + 1;
+ i__2 = *incx;
+ for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {
+ if (x[ix] != 0.) {
+ absxi = (d__1 = x[ix], abs(d__1));
+ if (scale < absxi) {
+/* Computing 2nd power */
+ d__1 = scale / absxi;
+ ssq = ssq * (d__1 * d__1) + 1.;
+ scale = absxi;
+ } else {
+/* Computing 2nd power */
+ d__1 = absxi / scale;
+ ssq += d__1 * d__1;
+ }
+ }
+/* L10: */
+ }
+ norm = scale * sqrt(ssq);
+ }
+
+ ret_val = norm;
+ return ret_val;
+
+/* End of DNRM2. */
+
+} /* dnrm2_ */
+
+/* Subroutine */ int drot_(integer *n, doublereal *dx, integer *incx,
+ doublereal *dy, integer *incy, doublereal *c__, doublereal *s)
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static integer i__, ix, iy;
+ static doublereal dtemp;
+
+
+/*
+ applies a plane rotation.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+*/
+
+
+ /* Parameter adjustments */
+ --dy;
+ --dx;
+
+ /* Function Body */
+ if (*n <= 0) {
+ return 0;
+ }
+ if ((*incx == 1 && *incy == 1)) {
+ goto L20;
+ }
+
+/*
+ code for unequal increments or equal increments not equal
+ to 1
+*/
+
+ ix = 1;
+ iy = 1;
+ if (*incx < 0) {
+ ix = (-(*n) + 1) * *incx + 1;
+ }
+ if (*incy < 0) {
+ iy = (-(*n) + 1) * *incy + 1;
+ }
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dtemp = *c__ * dx[ix] + *s * dy[iy];
+ dy[iy] = *c__ * dy[iy] - *s * dx[ix];
+ dx[ix] = dtemp;
+ ix += *incx;
+ iy += *incy;
+/* L10: */
+ }
+ return 0;
+
+/* code for both increments equal to 1 */
+
+L20:
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dtemp = *c__ * dx[i__] + *s * dy[i__];
+ dy[i__] = *c__ * dy[i__] - *s * dx[i__];
+ dx[i__] = dtemp;
+/* L30: */
+ }
+ return 0;
+} /* drot_ */
+
+/* Subroutine */ int dscal_(integer *n, doublereal *da, doublereal *dx,
+ integer *incx)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+
+ /* Local variables */
+ static integer i__, m, mp1, nincx;
+
+
+/*
+ scales a vector by a constant.
+ uses unrolled loops for increment equal to one.
+ jack dongarra, linpack, 3/11/78.
+ modified 3/93 to return if incx .le. 0.
+ modified 12/3/93, array(1) declarations changed to array(*)
+*/
+
+
+ /* Parameter adjustments */
+ --dx;
+
+ /* Function Body */
+ if (*n <= 0 || *incx <= 0) {
+ return 0;
+ }
+ if (*incx == 1) {
+ goto L20;
+ }
+
+/* code for increment not equal to 1 */
+
+ nincx = *n * *incx;
+ i__1 = nincx;
+ i__2 = *incx;
+ for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+ dx[i__] = *da * dx[i__];
+/* L10: */
+ }
+ return 0;
+
+/*
+ code for increment equal to 1
+
+
+ clean-up loop
+*/
+
+L20:
+ m = *n % 5;
+ if (m == 0) {
+ goto L40;
+ }
+ i__2 = m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ dx[i__] = *da * dx[i__];
+/* L30: */
+ }
+ if (*n < 5) {
+ return 0;
+ }
+L40:
+ mp1 = m + 1;
+ i__2 = *n;
+ for (i__ = mp1; i__ <= i__2; i__ += 5) {
+ dx[i__] = *da * dx[i__];
+ dx[i__ + 1] = *da * dx[i__ + 1];
+ dx[i__ + 2] = *da * dx[i__ + 2];
+ dx[i__ + 3] = *da * dx[i__ + 3];
+ dx[i__ + 4] = *da * dx[i__ + 4];
+/* L50: */
+ }
+ return 0;
+} /* dscal_ */
+
+/* Subroutine */ int dswap_(integer *n, doublereal *dx, integer *incx,
+ doublereal *dy, integer *incy)
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static integer i__, m, ix, iy, mp1;
+ static doublereal dtemp;
+
+
+/*
+ interchanges two vectors.
+ uses unrolled loops for increments equal one.
+ jack dongarra, linpack, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+*/
+
+
+ /* Parameter adjustments */
+ --dy;
+ --dx;
+
+ /* Function Body */
+ if (*n <= 0) {
+ return 0;
+ }
+ if ((*incx == 1 && *incy == 1)) {
+ goto L20;
+ }
+
+/*
+ code for unequal increments or equal increments not equal
+ to 1
+*/
+
+ ix = 1;
+ iy = 1;
+ if (*incx < 0) {
+ ix = (-(*n) + 1) * *incx + 1;
+ }
+ if (*incy < 0) {
+ iy = (-(*n) + 1) * *incy + 1;
+ }
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dtemp = dx[ix];
+ dx[ix] = dy[iy];
+ dy[iy] = dtemp;
+ ix += *incx;
+ iy += *incy;
+/* L10: */
+ }
+ return 0;
+
+/*
+ code for both increments equal to 1
+
+
+ clean-up loop
+*/
+
+L20:
+ m = *n % 3;
+ if (m == 0) {
+ goto L40;
+ }
+ i__1 = m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dtemp = dx[i__];
+ dx[i__] = dy[i__];
+ dy[i__] = dtemp;
+/* L30: */
+ }
+ if (*n < 3) {
+ return 0;
+ }
+L40:
+ mp1 = m + 1;
+ i__1 = *n;
+ for (i__ = mp1; i__ <= i__1; i__ += 3) {
+ dtemp = dx[i__];
+ dx[i__] = dy[i__];
+ dy[i__] = dtemp;
+ dtemp = dx[i__ + 1];
+ dx[i__ + 1] = dy[i__ + 1];
+ dy[i__ + 1] = dtemp;
+ dtemp = dx[i__ + 2];
+ dx[i__ + 2] = dy[i__ + 2];
+ dy[i__ + 2] = dtemp;
+/* L50: */
+ }
+ return 0;
+} /* dswap_ */
+
+/* Subroutine */ int dsymv_(char *uplo, integer *n, doublereal *alpha,
+ doublereal *a, integer *lda, doublereal *x, integer *incx, doublereal
+ *beta, doublereal *y, integer *incy)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+
+ /* Local variables */
+ static integer i__, j, ix, iy, jx, jy, kx, ky, info;
+ static doublereal temp1, temp2;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/*
+ Purpose
+ =======
+
+ DSYMV performs the matrix-vector operation
+
+ y := alpha*A*x + beta*y,
+
+ where alpha and beta are scalars, x and y are n element vectors and
+ A is an n by n symmetric matrix.
+
+ Parameters
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array A is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of A
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of A
+ is to be referenced.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+ triangular part of the symmetric matrix and the strictly
+ lower triangular part of A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+ triangular part of the symmetric matrix and the strictly
+ upper triangular part of A is not referenced.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y. On exit, Y is overwritten by the updated
+ vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --x;
+ --y;
+
+ /* Function Body */
+ info = 0;
+ if ((! lsame_(uplo, "U") && ! lsame_(uplo, "L"))) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*lda < max(1,*n)) {
+ info = 5;
+ } else if (*incx == 0) {
+ info = 7;
+ } else if (*incy == 0) {
+ info = 10;
+ }
+ if (info != 0) {
+ xerbla_("DSYMV ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0 || (*alpha == 0. && *beta == 1.)) {
+ return 0;
+ }
+
+/* Set up the start points in X and Y. */
+
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (*n - 1) * *incx;
+ }
+ if (*incy > 0) {
+ ky = 1;
+ } else {
+ ky = 1 - (*n - 1) * *incy;
+ }
+
+/*
+ Start the operations. In this version the elements of A are
+ accessed sequentially with one pass through the triangular part
+ of A.
+
+ First form y := beta*y.
+*/
+
+ if (*beta != 1.) {
+ if (*incy == 1) {
+ if (*beta == 0.) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[i__] = 0.;
+/* L10: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[i__] = *beta * y[i__];
+/* L20: */
+ }
+ }
+ } else {
+ iy = ky;
+ if (*beta == 0.) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[iy] = 0.;
+ iy += *incy;
+/* L30: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[iy] = *beta * y[iy];
+ iy += *incy;
+/* L40: */
+ }
+ }
+ }
+ }
+ if (*alpha == 0.) {
+ return 0;
+ }
+ if (lsame_(uplo, "U")) {
+
+/* Form y when A is stored in upper triangle. */
+
+ if ((*incx == 1 && *incy == 1)) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[j];
+ temp2 = 0.;
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ y[i__] += temp1 * a[i__ + j * a_dim1];
+ temp2 += a[i__ + j * a_dim1] * x[i__];
+/* L50: */
+ }
+ y[j] = y[j] + temp1 * a[j + j * a_dim1] + *alpha * temp2;
+/* L60: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[jx];
+ temp2 = 0.;
+ ix = kx;
+ iy = ky;
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ y[iy] += temp1 * a[i__ + j * a_dim1];
+ temp2 += a[i__ + j * a_dim1] * x[ix];
+ ix += *incx;
+ iy += *incy;
+/* L70: */
+ }
+ y[jy] = y[jy] + temp1 * a[j + j * a_dim1] + *alpha * temp2;
+ jx += *incx;
+ jy += *incy;
+/* L80: */
+ }
+ }
+ } else {
+
+/* Form y when A is stored in lower triangle. */
+
+ if ((*incx == 1 && *incy == 1)) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[j];
+ temp2 = 0.;
+ y[j] += temp1 * a[j + j * a_dim1];
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ y[i__] += temp1 * a[i__ + j * a_dim1];
+ temp2 += a[i__ + j * a_dim1] * x[i__];
+/* L90: */
+ }
+ y[j] += *alpha * temp2;
+/* L100: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[jx];
+ temp2 = 0.;
+ y[jy] += temp1 * a[j + j * a_dim1];
+ ix = jx;
+ iy = jy;
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ ix += *incx;
+ iy += *incy;
+ y[iy] += temp1 * a[i__ + j * a_dim1];
+ temp2 += a[i__ + j * a_dim1] * x[ix];
+/* L110: */
+ }
+ y[jy] += *alpha * temp2;
+ jx += *incx;
+ jy += *incy;
+/* L120: */
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DSYMV . */
+
+} /* dsymv_ */
+
+/* Subroutine */ int dsyr2_(char *uplo, integer *n, doublereal *alpha,
+ doublereal *x, integer *incx, doublereal *y, integer *incy,
+ doublereal *a, integer *lda)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+
+ /* Local variables */
+ static integer i__, j, ix, iy, jx, jy, kx, ky, info;
+ static doublereal temp1, temp2;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/*
+ Purpose
+ =======
+
+ DSYR2 performs the symmetric rank 2 operation
+
+ A := alpha*x*y' + alpha*y*x' + A,
+
+ where alpha is a scalar, x and y are n element vectors and A is an n
+ by n symmetric matrix.
+
+ Parameters
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array A is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of A
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of A
+ is to be referenced.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ Y - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y.
+ Unchanged on exit.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+ triangular part of the symmetric matrix and the strictly
+ lower triangular part of A is not referenced. On exit, the
+ upper triangular part of the array A is overwritten by the
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+ triangular part of the symmetric matrix and the strictly
+ upper triangular part of A is not referenced. On exit, the
+ lower triangular part of the array A is overwritten by the
+ lower triangular part of the updated matrix.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --x;
+ --y;
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+
+ /* Function Body */
+ info = 0;
+ if ((! lsame_(uplo, "U") && ! lsame_(uplo, "L"))) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*incx == 0) {
+ info = 5;
+ } else if (*incy == 0) {
+ info = 7;
+ } else if (*lda < max(1,*n)) {
+ info = 9;
+ }
+ if (info != 0) {
+ xerbla_("DSYR2 ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0 || *alpha == 0.) {
+ return 0;
+ }
+
+/*
+ Set up the start points in X and Y if the increments are not both
+ unity.
+*/
+
+ if (*incx != 1 || *incy != 1) {
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (*n - 1) * *incx;
+ }
+ if (*incy > 0) {
+ ky = 1;
+ } else {
+ ky = 1 - (*n - 1) * *incy;
+ }
+ jx = kx;
+ jy = ky;
+ }
+
+/*
+ Start the operations. In this version the elements of A are
+ accessed sequentially with one pass through the triangular part
+ of A.
+*/
+
+ if (lsame_(uplo, "U")) {
+
+/* Form A when A is stored in the upper triangle. */
+
+ if ((*incx == 1 && *incy == 1)) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[j] != 0. || y[j] != 0.) {
+ temp1 = *alpha * y[j];
+ temp2 = *alpha * x[j];
+ i__2 = j;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[i__] *
+ temp1 + y[i__] * temp2;
+/* L10: */
+ }
+ }
+/* L20: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[jx] != 0. || y[jy] != 0.) {
+ temp1 = *alpha * y[jy];
+ temp2 = *alpha * x[jx];
+ ix = kx;
+ iy = ky;
+ i__2 = j;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[ix] *
+ temp1 + y[iy] * temp2;
+ ix += *incx;
+ iy += *incy;
+/* L30: */
+ }
+ }
+ jx += *incx;
+ jy += *incy;
+/* L40: */
+ }
+ }
+ } else {
+
+/* Form A when A is stored in the lower triangle. */
+
+ if ((*incx == 1 && *incy == 1)) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[j] != 0. || y[j] != 0.) {
+ temp1 = *alpha * y[j];
+ temp2 = *alpha * x[j];
+ i__2 = *n;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[i__] *
+ temp1 + y[i__] * temp2;
+/* L50: */
+ }
+ }
+/* L60: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[jx] != 0. || y[jy] != 0.) {
+ temp1 = *alpha * y[jy];
+ temp2 = *alpha * x[jx];
+ ix = jx;
+ iy = jy;
+ i__2 = *n;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] = a[i__ + j * a_dim1] + x[ix] *
+ temp1 + y[iy] * temp2;
+ ix += *incx;
+ iy += *incy;
+/* L70: */
+ }
+ }
+ jx += *incx;
+ jy += *incy;
+/* L80: */
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DSYR2 . */
+
+} /* dsyr2_ */
+
+/* Subroutine */ int dsyr2k_(char *uplo, char *trans, integer *n, integer *k,
+ doublereal *alpha, doublereal *a, integer *lda, doublereal *b,
+ integer *ldb, doublereal *beta, doublereal *c__, integer *ldc)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
+ i__3;
+
+ /* Local variables */
+ static integer i__, j, l, info;
+ static doublereal temp1, temp2;
+ extern logical lsame_(char *, char *);
+ static integer nrowa;
+ static logical upper;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/*
+ Purpose
+ =======
+
+ DSYR2K performs one of the symmetric rank 2k operations
+
+ C := alpha*A*B' + alpha*B*A' + beta*C,
+
+ or
+
+ C := alpha*A'*B + alpha*B'*A + beta*C,
+
+ where alpha and beta are scalars, C is an n by n symmetric matrix
+ and A and B are n by k matrices in the first case and k by n
+ matrices in the second case.
+
+ Parameters
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array C is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of C
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of C
+ is to be referenced.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' C := alpha*A*B' + alpha*B*A' +
+ beta*C.
+
+ TRANS = 'T' or 't' C := alpha*A'*B + alpha*B'*A +
+ beta*C.
+
+ TRANS = 'C' or 'c' C := alpha*A'*B + alpha*B'*A +
+ beta*C.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix C. N must be
+ at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with TRANS = 'N' or 'n', K specifies the number
+ of columns of the matrices A and B, and on entry with
+ TRANS = 'T' or 't' or 'C' or 'c', K specifies the number
+ of rows of the matrices A and B. K must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+ k when TRANS = 'N' or 'n', and is n otherwise.
+ Before entry with TRANS = 'N' or 'n', the leading n by k
+ part of the array A must contain the matrix A, otherwise
+ the leading k by n part of the array A must contain the
+ matrix A.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When TRANS = 'N' or 'n'
+ then LDA must be at least max( 1, n ), otherwise LDA must
+ be at least max( 1, k ).
+ Unchanged on exit.
+
+ B - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is
+ k when TRANS = 'N' or 'n', and is n otherwise.
+ Before entry with TRANS = 'N' or 'n', the leading n by k
+ part of the array B must contain the matrix B, otherwise
+ the leading k by n part of the array B must contain the
+ matrix B.
+ Unchanged on exit.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. When TRANS = 'N' or 'n'
+ then LDB must be at least max( 1, n ), otherwise LDB must
+ be at least max( 1, k ).
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta.
+ Unchanged on exit.
+
+ C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array C must contain the upper
+ triangular part of the symmetric matrix and the strictly
+ lower triangular part of C is not referenced. On exit, the
+ upper triangular part of the array C is overwritten by the
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array C must contain the lower
+ triangular part of the symmetric matrix and the strictly
+ upper triangular part of C is not referenced. On exit, the
+ lower triangular part of the array C is overwritten by the
+ lower triangular part of the updated matrix.
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+
+ /* Function Body */
+ if (lsame_(trans, "N")) {
+ nrowa = *n;
+ } else {
+ nrowa = *k;
+ }
+ upper = lsame_(uplo, "U");
+
+ info = 0;
+ if ((! upper && ! lsame_(uplo, "L"))) {
+ info = 1;
+ } else if (((! lsame_(trans, "N") && ! lsame_(trans,
+ "T")) && ! lsame_(trans, "C"))) {
+ info = 2;
+ } else if (*n < 0) {
+ info = 3;
+ } else if (*k < 0) {
+ info = 4;
+ } else if (*lda < max(1,nrowa)) {
+ info = 7;
+ } else if (*ldb < max(1,nrowa)) {
+ info = 9;
+ } else if (*ldc < max(1,*n)) {
+ info = 12;
+ }
+ if (info != 0) {
+ xerbla_("DSYR2K", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0 || ((*alpha == 0. || *k == 0) && *beta == 1.)) {
+ return 0;
+ }
+
+/* And when alpha.eq.zero. */
+
+ if (*alpha == 0.) {
+ if (upper) {
+ if (*beta == 0.) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
+/* L30: */
+ }
+/* L40: */
+ }
+ }
+ } else {
+ if (*beta == 0.) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = 0.;
+/* L50: */
+ }
+/* L60: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
+/* L70: */
+ }
+/* L80: */
+ }
+ }
+ }
+ return 0;
+ }
+
+/* Start the operations. */
+
+ if (lsame_(trans, "N")) {
+
+/* Form C := alpha*A*B' + alpha*B*A' + C. */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*beta == 0.) {
+ i__2 = j;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = 0.;
+/* L90: */
+ }
+ } else if (*beta != 1.) {
+ i__2 = j;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
+/* L100: */
+ }
+ }
+ i__2 = *k;
+ for (l = 1; l <= i__2; ++l) {
+ if (a[j + l * a_dim1] != 0. || b[j + l * b_dim1] != 0.) {
+ temp1 = *alpha * b[j + l * b_dim1];
+ temp2 = *alpha * a[j + l * a_dim1];
+ i__3 = j;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ c__[i__ + j * c_dim1] = c__[i__ + j * c_dim1] + a[
+ i__ + l * a_dim1] * temp1 + b[i__ + l *
+ b_dim1] * temp2;
+/* L110: */
+ }
+ }
+/* L120: */
+ }
+/* L130: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*beta == 0.) {
+ i__2 = *n;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = 0.;
+/* L140: */
+ }
+ } else if (*beta != 1.) {
+ i__2 = *n;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
+/* L150: */
+ }
+ }
+ i__2 = *k;
+ for (l = 1; l <= i__2; ++l) {
+ if (a[j + l * a_dim1] != 0. || b[j + l * b_dim1] != 0.) {
+ temp1 = *alpha * b[j + l * b_dim1];
+ temp2 = *alpha * a[j + l * a_dim1];
+ i__3 = *n;
+ for (i__ = j; i__ <= i__3; ++i__) {
+ c__[i__ + j * c_dim1] = c__[i__ + j * c_dim1] + a[
+ i__ + l * a_dim1] * temp1 + b[i__ + l *
+ b_dim1] * temp2;
+/* L160: */
+ }
+ }
+/* L170: */
+ }
+/* L180: */
+ }
+ }
+ } else {
+
+/* Form C := alpha*A'*B + alpha*B'*A + C. */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp1 = 0.;
+ temp2 = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ temp1 += a[l + i__ * a_dim1] * b[l + j * b_dim1];
+ temp2 += b[l + i__ * b_dim1] * a[l + j * a_dim1];
+/* L190: */
+ }
+ if (*beta == 0.) {
+ c__[i__ + j * c_dim1] = *alpha * temp1 + *alpha *
+ temp2;
+ } else {
+ c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]
+ + *alpha * temp1 + *alpha * temp2;
+ }
+/* L200: */
+ }
+/* L210: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ temp1 = 0.;
+ temp2 = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ temp1 += a[l + i__ * a_dim1] * b[l + j * b_dim1];
+ temp2 += b[l + i__ * b_dim1] * a[l + j * a_dim1];
+/* L220: */
+ }
+ if (*beta == 0.) {
+ c__[i__ + j * c_dim1] = *alpha * temp1 + *alpha *
+ temp2;
+ } else {
+ c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1]
+ + *alpha * temp1 + *alpha * temp2;
+ }
+/* L230: */
+ }
+/* L240: */
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DSYR2K. */
+
+} /* dsyr2k_ */
+
+/* Subroutine */ int dsyrk_(char *uplo, char *trans, integer *n, integer *k,
+ doublereal *alpha, doublereal *a, integer *lda, doublereal *beta,
+ doublereal *c__, integer *ldc)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i__, j, l, info;
+ static doublereal temp;
+ extern logical lsame_(char *, char *);
+ static integer nrowa;
+ static logical upper;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/*
+ Purpose
+ =======
+
+ DSYRK performs one of the symmetric rank k operations
+
+ C := alpha*A*A' + beta*C,
+
+ or
+
+ C := alpha*A'*A + beta*C,
+
+ where alpha and beta are scalars, C is an n by n symmetric matrix
+ and A is an n by k matrix in the first case and a k by n matrix
+ in the second case.
+
+ Parameters
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array C is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of C
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of C
+ is to be referenced.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' C := alpha*A*A' + beta*C.
+
+ TRANS = 'T' or 't' C := alpha*A'*A + beta*C.
+
+ TRANS = 'C' or 'c' C := alpha*A'*A + beta*C.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix C. N must be
+ at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with TRANS = 'N' or 'n', K specifies the number
+ of columns of the matrix A, and on entry with
+ TRANS = 'T' or 't' or 'C' or 'c', K specifies the number
+ of rows of the matrix A. K must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is
+ k when TRANS = 'N' or 'n', and is n otherwise.
+ Before entry with TRANS = 'N' or 'n', the leading n by k
+ part of the array A must contain the matrix A, otherwise
+ the leading k by n part of the array A must contain the
+ matrix A.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When TRANS = 'N' or 'n'
+ then LDA must be at least max( 1, n ), otherwise LDA must
+ be at least max( 1, k ).
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta.
+ Unchanged on exit.
+
+ C - DOUBLE PRECISION array of DIMENSION ( LDC, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array C must contain the upper
+ triangular part of the symmetric matrix and the strictly
+ lower triangular part of C is not referenced. On exit, the
+ upper triangular part of the array C is overwritten by the
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array C must contain the lower
+ triangular part of the symmetric matrix and the strictly
+ upper triangular part of C is not referenced. On exit, the
+ lower triangular part of the array C is overwritten by the
+ lower triangular part of the updated matrix.
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+
+ /* Function Body */
+ if (lsame_(trans, "N")) {
+ nrowa = *n;
+ } else {
+ nrowa = *k;
+ }
+ upper = lsame_(uplo, "U");
+
+ info = 0;
+ if ((! upper && ! lsame_(uplo, "L"))) {
+ info = 1;
+ } else if (((! lsame_(trans, "N") && ! lsame_(trans,
+ "T")) && ! lsame_(trans, "C"))) {
+ info = 2;
+ } else if (*n < 0) {
+ info = 3;
+ } else if (*k < 0) {
+ info = 4;
+ } else if (*lda < max(1,nrowa)) {
+ info = 7;
+ } else if (*ldc < max(1,*n)) {
+ info = 10;
+ }
+ if (info != 0) {
+ xerbla_("DSYRK ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0 || ((*alpha == 0. || *k == 0) && *beta == 1.)) {
+ return 0;
+ }
+
+/* And when alpha.eq.zero. */
+
+ if (*alpha == 0.) {
+ if (upper) {
+ if (*beta == 0.) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
+/* L30: */
+ }
+/* L40: */
+ }
+ }
+ } else {
+ if (*beta == 0.) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = 0.;
+/* L50: */
+ }
+/* L60: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
+/* L70: */
+ }
+/* L80: */
+ }
+ }
+ }
+ return 0;
+ }
+
+/* Start the operations. */
+
+ if (lsame_(trans, "N")) {
+
+/* Form C := alpha*A*A' + beta*C. */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*beta == 0.) {
+ i__2 = j;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = 0.;
+/* L90: */
+ }
+ } else if (*beta != 1.) {
+ i__2 = j;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
+/* L100: */
+ }
+ }
+ i__2 = *k;
+ for (l = 1; l <= i__2; ++l) {
+ if (a[j + l * a_dim1] != 0.) {
+ temp = *alpha * a[j + l * a_dim1];
+ i__3 = j;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ c__[i__ + j * c_dim1] += temp * a[i__ + l *
+ a_dim1];
+/* L110: */
+ }
+ }
+/* L120: */
+ }
+/* L130: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*beta == 0.) {
+ i__2 = *n;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = 0.;
+/* L140: */
+ }
+ } else if (*beta != 1.) {
+ i__2 = *n;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
+/* L150: */
+ }
+ }
+ i__2 = *k;
+ for (l = 1; l <= i__2; ++l) {
+ if (a[j + l * a_dim1] != 0.) {
+ temp = *alpha * a[j + l * a_dim1];
+ i__3 = *n;
+ for (i__ = j; i__ <= i__3; ++i__) {
+ c__[i__ + j * c_dim1] += temp * a[i__ + l *
+ a_dim1];
+/* L160: */
+ }
+ }
+/* L170: */
+ }
+/* L180: */
+ }
+ }
+ } else {
+
+/* Form C := alpha*A'*A + beta*C. */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ temp += a[l + i__ * a_dim1] * a[l + j * a_dim1];
+/* L190: */
+ }
+ if (*beta == 0.) {
+ c__[i__ + j * c_dim1] = *alpha * temp;
+ } else {
+ c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[
+ i__ + j * c_dim1];
+ }
+/* L200: */
+ }
+/* L210: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ temp = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ temp += a[l + i__ * a_dim1] * a[l + j * a_dim1];
+/* L220: */
+ }
+ if (*beta == 0.) {
+ c__[i__ + j * c_dim1] = *alpha * temp;
+ } else {
+ c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[
+ i__ + j * c_dim1];
+ }
+/* L230: */
+ }
+/* L240: */
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DSYRK . */
+
+} /* dsyrk_ */
+
+/* Subroutine */ int dtrmm_(char *side, char *uplo, char *transa, char *diag,
+ integer *m, integer *n, doublereal *alpha, doublereal *a, integer *
+ lda, doublereal *b, integer *ldb)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i__, j, k, info;
+ static doublereal temp;
+ static logical lside;
+ extern logical lsame_(char *, char *);
+ static integer nrowa;
+ static logical upper;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static logical nounit;
+
+
+/*
+ Purpose
+ =======
+
+ DTRMM performs one of the matrix-matrix operations
+
+ B := alpha*op( A )*B, or B := alpha*B*op( A ),
+
+ where alpha is a scalar, B is an m by n matrix, A is a unit, or
+ non-unit, upper or lower triangular matrix and op( A ) is one of
+
+ op( A ) = A or op( A ) = A'.
+
+ Parameters
+ ==========
+
+ SIDE - CHARACTER*1.
+ On entry, SIDE specifies whether op( A ) multiplies B from
+ the left or right as follows:
+
+ SIDE = 'L' or 'l' B := alpha*op( A )*B.
+
+ SIDE = 'R' or 'r' B := alpha*B*op( A ).
+
+ Unchanged on exit.
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix A is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANSA - CHARACTER*1.
+ On entry, TRANSA specifies the form of op( A ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSA = 'N' or 'n' op( A ) = A.
+
+ TRANSA = 'T' or 't' op( A ) = A'.
+
+ TRANSA = 'C' or 'c' op( A ) = A'.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit triangular
+ as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of B. M must be at
+ least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of B. N must be
+ at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha. When alpha is
+ zero then A is not referenced and B need not be set before
+ entry.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m
+ when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
+ Before entry with UPLO = 'U' or 'u', the leading k by k
+ upper triangular part of the array A must contain the upper
+ triangular matrix and the strictly lower triangular part of
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading k by k
+ lower triangular part of the array A must contain the lower
+ triangular matrix and the strictly upper triangular part of
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When SIDE = 'L' or 'l' then
+ LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
+ then LDA must be at least max( 1, n ).
+ Unchanged on exit.
+
+ B - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
+ Before entry, the leading m by n part of the array B must
+ contain the matrix B, and on exit is overwritten by the
+ transformed matrix.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. LDB must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+
+ /* Function Body */
+ lside = lsame_(side, "L");
+ if (lside) {
+ nrowa = *m;
+ } else {
+ nrowa = *n;
+ }
+ nounit = lsame_(diag, "N");
+ upper = lsame_(uplo, "U");
+
+ info = 0;
+ if ((! lside && ! lsame_(side, "R"))) {
+ info = 1;
+ } else if ((! upper && ! lsame_(uplo, "L"))) {
+ info = 2;
+ } else if (((! lsame_(transa, "N") && ! lsame_(
+ transa, "T")) && ! lsame_(transa, "C"))) {
+ info = 3;
+ } else if ((! lsame_(diag, "U") && ! lsame_(diag,
+ "N"))) {
+ info = 4;
+ } else if (*m < 0) {
+ info = 5;
+ } else if (*n < 0) {
+ info = 6;
+ } else if (*lda < max(1,nrowa)) {
+ info = 9;
+ } else if (*ldb < max(1,*m)) {
+ info = 11;
+ }
+ if (info != 0) {
+ xerbla_("DTRMM ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+/* And when alpha.eq.zero. */
+
+ if (*alpha == 0.) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+ return 0;
+ }
+
+/* Start the operations. */
+
+ if (lside) {
+ if (lsame_(transa, "N")) {
+
+/* Form B := alpha*A*B. */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (k = 1; k <= i__2; ++k) {
+ if (b[k + j * b_dim1] != 0.) {
+ temp = *alpha * b[k + j * b_dim1];
+ i__3 = k - 1;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ b[i__ + j * b_dim1] += temp * a[i__ + k *
+ a_dim1];
+/* L30: */
+ }
+ if (nounit) {
+ temp *= a[k + k * a_dim1];
+ }
+ b[k + j * b_dim1] = temp;
+ }
+/* L40: */
+ }
+/* L50: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ for (k = *m; k >= 1; --k) {
+ if (b[k + j * b_dim1] != 0.) {
+ temp = *alpha * b[k + j * b_dim1];
+ b[k + j * b_dim1] = temp;
+ if (nounit) {
+ b[k + j * b_dim1] *= a[k + k * a_dim1];
+ }
+ i__2 = *m;
+ for (i__ = k + 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] += temp * a[i__ + k *
+ a_dim1];
+/* L60: */
+ }
+ }
+/* L70: */
+ }
+/* L80: */
+ }
+ }
+ } else {
+
+/* Form B := alpha*A'*B. */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ for (i__ = *m; i__ >= 1; --i__) {
+ temp = b[i__ + j * b_dim1];
+ if (nounit) {
+ temp *= a[i__ + i__ * a_dim1];
+ }
+ i__2 = i__ - 1;
+ for (k = 1; k <= i__2; ++k) {
+ temp += a[k + i__ * a_dim1] * b[k + j * b_dim1];
+/* L90: */
+ }
+ b[i__ + j * b_dim1] = *alpha * temp;
+/* L100: */
+ }
+/* L110: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp = b[i__ + j * b_dim1];
+ if (nounit) {
+ temp *= a[i__ + i__ * a_dim1];
+ }
+ i__3 = *m;
+ for (k = i__ + 1; k <= i__3; ++k) {
+ temp += a[k + i__ * a_dim1] * b[k + j * b_dim1];
+/* L120: */
+ }
+ b[i__ + j * b_dim1] = *alpha * temp;
+/* L130: */
+ }
+/* L140: */
+ }
+ }
+ }
+ } else {
+ if (lsame_(transa, "N")) {
+
+/* Form B := alpha*B*A. */
+
+ if (upper) {
+ for (j = *n; j >= 1; --j) {
+ temp = *alpha;
+ if (nounit) {
+ temp *= a[j + j * a_dim1];
+ }
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
+/* L150: */
+ }
+ i__1 = j - 1;
+ for (k = 1; k <= i__1; ++k) {
+ if (a[k + j * a_dim1] != 0.) {
+ temp = *alpha * a[k + j * a_dim1];
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] += temp * b[i__ + k *
+ b_dim1];
+/* L160: */
+ }
+ }
+/* L170: */
+ }
+/* L180: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp = *alpha;
+ if (nounit) {
+ temp *= a[j + j * a_dim1];
+ }
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
+/* L190: */
+ }
+ i__2 = *n;
+ for (k = j + 1; k <= i__2; ++k) {
+ if (a[k + j * a_dim1] != 0.) {
+ temp = *alpha * a[k + j * a_dim1];
+ i__3 = *m;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ b[i__ + j * b_dim1] += temp * b[i__ + k *
+ b_dim1];
+/* L200: */
+ }
+ }
+/* L210: */
+ }
+/* L220: */
+ }
+ }
+ } else {
+
+/* Form B := alpha*B*A'. */
+
+ if (upper) {
+ i__1 = *n;
+ for (k = 1; k <= i__1; ++k) {
+ i__2 = k - 1;
+ for (j = 1; j <= i__2; ++j) {
+ if (a[j + k * a_dim1] != 0.) {
+ temp = *alpha * a[j + k * a_dim1];
+ i__3 = *m;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ b[i__ + j * b_dim1] += temp * b[i__ + k *
+ b_dim1];
+/* L230: */
+ }
+ }
+/* L240: */
+ }
+ temp = *alpha;
+ if (nounit) {
+ temp *= a[k + k * a_dim1];
+ }
+ if (temp != 1.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
+/* L250: */
+ }
+ }
+/* L260: */
+ }
+ } else {
+ for (k = *n; k >= 1; --k) {
+ i__1 = *n;
+ for (j = k + 1; j <= i__1; ++j) {
+ if (a[j + k * a_dim1] != 0.) {
+ temp = *alpha * a[j + k * a_dim1];
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] += temp * b[i__ + k *
+ b_dim1];
+/* L270: */
+ }
+ }
+/* L280: */
+ }
+ temp = *alpha;
+ if (nounit) {
+ temp *= a[k + k * a_dim1];
+ }
+ if (temp != 1.) {
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
+/* L290: */
+ }
+ }
+/* L300: */
+ }
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DTRMM . */
+
+} /* dtrmm_ */
+
+/* Subroutine */ int dtrmv_(char *uplo, char *trans, char *diag, integer *n,
+ doublereal *a, integer *lda, doublereal *x, integer *incx)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+
+ /* Local variables */
+ static integer i__, j, ix, jx, kx, info;
+ static doublereal temp;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static logical nounit;
+
+
+/*
+ Purpose
+ =======
+
+ DTRMV performs one of the matrix-vector operations
+
+ x := A*x, or x := A'*x,
+
+ where x is an n element vector and A is an n by n unit, or non-unit,
+ upper or lower triangular matrix.
+
+ Parameters
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' x := A*x.
+
+ TRANS = 'T' or 't' x := A'*x.
+
+ TRANS = 'C' or 'c' x := A'*x.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+ triangular matrix and the strictly lower triangular part of
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+ triangular matrix and the strictly upper triangular part of
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+ X - DOUBLE PRECISION array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x. On exit, X is overwritten with the
+ tranformed vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --x;
+
+ /* Function Body */
+ info = 0;
+ if ((! lsame_(uplo, "U") && ! lsame_(uplo, "L"))) {
+ info = 1;
+ } else if (((! lsame_(trans, "N") && ! lsame_(trans,
+ "T")) && ! lsame_(trans, "C"))) {
+ info = 2;
+ } else if ((! lsame_(diag, "U") && ! lsame_(diag,
+ "N"))) {
+ info = 3;
+ } else if (*n < 0) {
+ info = 4;
+ } else if (*lda < max(1,*n)) {
+ info = 6;
+ } else if (*incx == 0) {
+ info = 8;
+ }
+ if (info != 0) {
+ xerbla_("DTRMV ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+ nounit = lsame_(diag, "N");
+
+/*
+ Set up the start point in X if the increment is not unity. This
+ will be ( N - 1 )*INCX too small for descending loops.
+*/
+
+ if (*incx <= 0) {
+ kx = 1 - (*n - 1) * *incx;
+ } else if (*incx != 1) {
+ kx = 1;
+ }
+
+/*
+ Start the operations. In this version the elements of A are
+ accessed sequentially with one pass through A.
+*/
+
+ if (lsame_(trans, "N")) {
+
+/* Form x := A*x. */
+
+ if (lsame_(uplo, "U")) {
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[j] != 0.) {
+ temp = x[j];
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ x[i__] += temp * a[i__ + j * a_dim1];
+/* L10: */
+ }
+ if (nounit) {
+ x[j] *= a[j + j * a_dim1];
+ }
+ }
+/* L20: */
+ }
+ } else {
+ jx = kx;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[jx] != 0.) {
+ temp = x[jx];
+ ix = kx;
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ x[ix] += temp * a[i__ + j * a_dim1];
+ ix += *incx;
+/* L30: */
+ }
+ if (nounit) {
+ x[jx] *= a[j + j * a_dim1];
+ }
+ }
+ jx += *incx;
+/* L40: */
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ if (x[j] != 0.) {
+ temp = x[j];
+ i__1 = j + 1;
+ for (i__ = *n; i__ >= i__1; --i__) {
+ x[i__] += temp * a[i__ + j * a_dim1];
+/* L50: */
+ }
+ if (nounit) {
+ x[j] *= a[j + j * a_dim1];
+ }
+ }
+/* L60: */
+ }
+ } else {
+ kx += (*n - 1) * *incx;
+ jx = kx;
+ for (j = *n; j >= 1; --j) {
+ if (x[jx] != 0.) {
+ temp = x[jx];
+ ix = kx;
+ i__1 = j + 1;
+ for (i__ = *n; i__ >= i__1; --i__) {
+ x[ix] += temp * a[i__ + j * a_dim1];
+ ix -= *incx;
+/* L70: */
+ }
+ if (nounit) {
+ x[jx] *= a[j + j * a_dim1];
+ }
+ }
+ jx -= *incx;
+/* L80: */
+ }
+ }
+ }
+ } else {
+
+/* Form x := A'*x. */
+
+ if (lsame_(uplo, "U")) {
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ temp = x[j];
+ if (nounit) {
+ temp *= a[j + j * a_dim1];
+ }
+ for (i__ = j - 1; i__ >= 1; --i__) {
+ temp += a[i__ + j * a_dim1] * x[i__];
+/* L90: */
+ }
+ x[j] = temp;
+/* L100: */
+ }
+ } else {
+ jx = kx + (*n - 1) * *incx;
+ for (j = *n; j >= 1; --j) {
+ temp = x[jx];
+ ix = jx;
+ if (nounit) {
+ temp *= a[j + j * a_dim1];
+ }
+ for (i__ = j - 1; i__ >= 1; --i__) {
+ ix -= *incx;
+ temp += a[i__ + j * a_dim1] * x[ix];
+/* L110: */
+ }
+ x[jx] = temp;
+ jx -= *incx;
+/* L120: */
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp = x[j];
+ if (nounit) {
+ temp *= a[j + j * a_dim1];
+ }
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ temp += a[i__ + j * a_dim1] * x[i__];
+/* L130: */
+ }
+ x[j] = temp;
+/* L140: */
+ }
+ } else {
+ jx = kx;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp = x[jx];
+ ix = jx;
+ if (nounit) {
+ temp *= a[j + j * a_dim1];
+ }
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ ix += *incx;
+ temp += a[i__ + j * a_dim1] * x[ix];
+/* L150: */
+ }
+ x[jx] = temp;
+ jx += *incx;
+/* L160: */
+ }
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DTRMV . */
+
+} /* dtrmv_ */
+
+/* Subroutine */ int dtrsm_(char *side, char *uplo, char *transa, char *diag,
+ integer *m, integer *n, doublereal *alpha, doublereal *a, integer *
+ lda, doublereal *b, integer *ldb)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i__, j, k, info;
+ static doublereal temp;
+ static logical lside;
+ extern logical lsame_(char *, char *);
+ static integer nrowa;
+ static logical upper;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static logical nounit;
+
+
+/*
+ Purpose
+ =======
+
+ DTRSM solves one of the matrix equations
+
+ op( A )*X = alpha*B, or X*op( A ) = alpha*B,
+
+ where alpha is a scalar, X and B are m by n matrices, A is a unit, or
+ non-unit, upper or lower triangular matrix and op( A ) is one of
+
+ op( A ) = A or op( A ) = A'.
+
+ The matrix X is overwritten on B.
+
+ Parameters
+ ==========
+
+ SIDE - CHARACTER*1.
+ On entry, SIDE specifies whether op( A ) appears on the left
+ or right of X as follows:
+
+ SIDE = 'L' or 'l' op( A )*X = alpha*B.
+
+ SIDE = 'R' or 'r' X*op( A ) = alpha*B.
+
+ Unchanged on exit.
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix A is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANSA - CHARACTER*1.
+ On entry, TRANSA specifies the form of op( A ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSA = 'N' or 'n' op( A ) = A.
+
+ TRANSA = 'T' or 't' op( A ) = A'.
+
+ TRANSA = 'C' or 'c' op( A ) = A'.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit triangular
+ as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of B. M must be at
+ least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of B. N must be
+ at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION.
+ On entry, ALPHA specifies the scalar alpha. When alpha is
+ zero then A is not referenced and B need not be set before
+ entry.
+ Unchanged on exit.
+
+ A - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m
+ when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
+ Before entry with UPLO = 'U' or 'u', the leading k by k
+ upper triangular part of the array A must contain the upper
+ triangular matrix and the strictly lower triangular part of
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading k by k
+ lower triangular part of the array A must contain the lower
+ triangular matrix and the strictly upper triangular part of
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When SIDE = 'L' or 'l' then
+ LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
+ then LDA must be at least max( 1, n ).
+ Unchanged on exit.
+
+ B - DOUBLE PRECISION array of DIMENSION ( LDB, n ).
+ Before entry, the leading m by n part of the array B must
+ contain the right-hand side matrix B, and on exit is
+ overwritten by the solution matrix X.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. LDB must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+
+ /* Function Body */
+ lside = lsame_(side, "L");
+ if (lside) {
+ nrowa = *m;
+ } else {
+ nrowa = *n;
+ }
+ nounit = lsame_(diag, "N");
+ upper = lsame_(uplo, "U");
+
+ info = 0;
+ if ((! lside && ! lsame_(side, "R"))) {
+ info = 1;
+ } else if ((! upper && ! lsame_(uplo, "L"))) {
+ info = 2;
+ } else if (((! lsame_(transa, "N") && ! lsame_(
+ transa, "T")) && ! lsame_(transa, "C"))) {
+ info = 3;
+ } else if ((! lsame_(diag, "U") && ! lsame_(diag,
+ "N"))) {
+ info = 4;
+ } else if (*m < 0) {
+ info = 5;
+ } else if (*n < 0) {
+ info = 6;
+ } else if (*lda < max(1,nrowa)) {
+ info = 9;
+ } else if (*ldb < max(1,*m)) {
+ info = 11;
+ }
+ if (info != 0) {
+ xerbla_("DTRSM ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+/* And when alpha.eq.zero. */
+
+ if (*alpha == 0.) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+ return 0;
+ }
+
+/* Start the operations. */
+
+ if (lside) {
+ if (lsame_(transa, "N")) {
+
+/* Form B := alpha*inv( A )*B. */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*alpha != 1.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
+ ;
+/* L30: */
+ }
+ }
+ for (k = *m; k >= 1; --k) {
+ if (b[k + j * b_dim1] != 0.) {
+ if (nounit) {
+ b[k + j * b_dim1] /= a[k + k * a_dim1];
+ }
+ i__2 = k - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] -= b[k + j * b_dim1] * a[
+ i__ + k * a_dim1];
+/* L40: */
+ }
+ }
+/* L50: */
+ }
+/* L60: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*alpha != 1.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
+ ;
+/* L70: */
+ }
+ }
+ i__2 = *m;
+ for (k = 1; k <= i__2; ++k) {
+ if (b[k + j * b_dim1] != 0.) {
+ if (nounit) {
+ b[k + j * b_dim1] /= a[k + k * a_dim1];
+ }
+ i__3 = *m;
+ for (i__ = k + 1; i__ <= i__3; ++i__) {
+ b[i__ + j * b_dim1] -= b[k + j * b_dim1] * a[
+ i__ + k * a_dim1];
+/* L80: */
+ }
+ }
+/* L90: */
+ }
+/* L100: */
+ }
+ }
+ } else {
+
+/* Form B := alpha*inv( A' )*B. */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp = *alpha * b[i__ + j * b_dim1];
+ i__3 = i__ - 1;
+ for (k = 1; k <= i__3; ++k) {
+ temp -= a[k + i__ * a_dim1] * b[k + j * b_dim1];
+/* L110: */
+ }
+ if (nounit) {
+ temp /= a[i__ + i__ * a_dim1];
+ }
+ b[i__ + j * b_dim1] = temp;
+/* L120: */
+ }
+/* L130: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ for (i__ = *m; i__ >= 1; --i__) {
+ temp = *alpha * b[i__ + j * b_dim1];
+ i__2 = *m;
+ for (k = i__ + 1; k <= i__2; ++k) {
+ temp -= a[k + i__ * a_dim1] * b[k + j * b_dim1];
+/* L140: */
+ }
+ if (nounit) {
+ temp /= a[i__ + i__ * a_dim1];
+ }
+ b[i__ + j * b_dim1] = temp;
+/* L150: */
+ }
+/* L160: */
+ }
+ }
+ }
+ } else {
+ if (lsame_(transa, "N")) {
+
+/* Form B := alpha*B*inv( A ). */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*alpha != 1.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
+ ;
+/* L170: */
+ }
+ }
+ i__2 = j - 1;
+ for (k = 1; k <= i__2; ++k) {
+ if (a[k + j * a_dim1] != 0.) {
+ i__3 = *m;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ b[i__ + j * b_dim1] -= a[k + j * a_dim1] * b[
+ i__ + k * b_dim1];
+/* L180: */
+ }
+ }
+/* L190: */
+ }
+ if (nounit) {
+ temp = 1. / a[j + j * a_dim1];
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
+/* L200: */
+ }
+ }
+/* L210: */
+ }
+ } else {
+ for (j = *n; j >= 1; --j) {
+ if (*alpha != 1.) {
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
+ ;
+/* L220: */
+ }
+ }
+ i__1 = *n;
+ for (k = j + 1; k <= i__1; ++k) {
+ if (a[k + j * a_dim1] != 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] -= a[k + j * a_dim1] * b[
+ i__ + k * b_dim1];
+/* L230: */
+ }
+ }
+/* L240: */
+ }
+ if (nounit) {
+ temp = 1. / a[j + j * a_dim1];
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
+/* L250: */
+ }
+ }
+/* L260: */
+ }
+ }
+ } else {
+
+/* Form B := alpha*B*inv( A' ). */
+
+ if (upper) {
+ for (k = *n; k >= 1; --k) {
+ if (nounit) {
+ temp = 1. / a[k + k * a_dim1];
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
+/* L270: */
+ }
+ }
+ i__1 = k - 1;
+ for (j = 1; j <= i__1; ++j) {
+ if (a[j + k * a_dim1] != 0.) {
+ temp = a[j + k * a_dim1];
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] -= temp * b[i__ + k *
+ b_dim1];
+/* L280: */
+ }
+ }
+/* L290: */
+ }
+ if (*alpha != 1.) {
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ b[i__ + k * b_dim1] = *alpha * b[i__ + k * b_dim1]
+ ;
+/* L300: */
+ }
+ }
+/* L310: */
+ }
+ } else {
+ i__1 = *n;
+ for (k = 1; k <= i__1; ++k) {
+ if (nounit) {
+ temp = 1. / a[k + k * a_dim1];
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
+/* L320: */
+ }
+ }
+ i__2 = *n;
+ for (j = k + 1; j <= i__2; ++j) {
+ if (a[j + k * a_dim1] != 0.) {
+ temp = a[j + k * a_dim1];
+ i__3 = *m;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ b[i__ + j * b_dim1] -= temp * b[i__ + k *
+ b_dim1];
+/* L330: */
+ }
+ }
+/* L340: */
+ }
+ if (*alpha != 1.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + k * b_dim1] = *alpha * b[i__ + k * b_dim1]
+ ;
+/* L350: */
+ }
+ }
+/* L360: */
+ }
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DTRSM . */
+
+} /* dtrsm_ */
+
+doublereal dzasum_(integer *n, doublecomplex *zx, integer *incx)
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal ret_val;
+
+ /* Local variables */
+ static integer i__, ix;
+ static doublereal stemp;
+ extern doublereal dcabs1_(doublecomplex *);
+
+
+/*
+ takes the sum of the absolute values.
+ jack dongarra, 3/11/78.
+ modified 3/93 to return if incx .le. 0.
+ modified 12/3/93, array(1) declarations changed to array(*)
+*/
+
+
+ /* Parameter adjustments */
+ --zx;
+
+ /* Function Body */
+ ret_val = 0.;
+ stemp = 0.;
+ if (*n <= 0 || *incx <= 0) {
+ return ret_val;
+ }
+ if (*incx == 1) {
+ goto L20;
+ }
+
+/* code for increment not equal to 1 */
+
+ ix = 1;
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ stemp += dcabs1_(&zx[ix]);
+ ix += *incx;
+/* L10: */
+ }
+ ret_val = stemp;
+ return ret_val;
+
+/* code for increment equal to 1 */
+
+L20:
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ stemp += dcabs1_(&zx[i__]);
+/* L30: */
+ }
+ ret_val = stemp;
+ return ret_val;
+} /* dzasum_ */
+
+doublereal dznrm2_(integer *n, doublecomplex *x, integer *incx)
+{
+ /* System generated locals */
+ integer i__1, i__2, i__3;
+ doublereal ret_val, d__1;
+
+ /* Builtin functions */
+ double d_imag(doublecomplex *), sqrt(doublereal);
+
+ /* Local variables */
+ static integer ix;
+ static doublereal ssq, temp, norm, scale;
+
+
+/*
+ DZNRM2 returns the euclidean norm of a vector via the function
+ name, so that
+
+ DZNRM2 := sqrt( conjg( x' )*x )
+
+
+ -- This version written on 25-October-1982.
+ Modified on 14-October-1993 to inline the call to ZLASSQ.
+ Sven Hammarling, Nag Ltd.
+*/
+
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ if (*n < 1 || *incx < 1) {
+ norm = 0.;
+ } else {
+ scale = 0.;
+ ssq = 1.;
+/*
+ The following loop is equivalent to this call to the LAPACK
+ auxiliary routine:
+ CALL ZLASSQ( N, X, INCX, SCALE, SSQ )
+*/
+
+ i__1 = (*n - 1) * *incx + 1;
+ i__2 = *incx;
+ for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {
+ i__3 = ix;
+ if (x[i__3].r != 0.) {
+ i__3 = ix;
+ temp = (d__1 = x[i__3].r, abs(d__1));
+ if (scale < temp) {
+/* Computing 2nd power */
+ d__1 = scale / temp;
+ ssq = ssq * (d__1 * d__1) + 1.;
+ scale = temp;
+ } else {
+/* Computing 2nd power */
+ d__1 = temp / scale;
+ ssq += d__1 * d__1;
+ }
+ }
+ if (d_imag(&x[ix]) != 0.) {
+ temp = (d__1 = d_imag(&x[ix]), abs(d__1));
+ if (scale < temp) {
+/* Computing 2nd power */
+ d__1 = scale / temp;
+ ssq = ssq * (d__1 * d__1) + 1.;
+ scale = temp;
+ } else {
+/* Computing 2nd power */
+ d__1 = temp / scale;
+ ssq += d__1 * d__1;
+ }
+ }
+/* L10: */
+ }
+ norm = scale * sqrt(ssq);
+ }
+
+ ret_val = norm;
+ return ret_val;
+
+/* End of DZNRM2. */
+
+} /* dznrm2_ */
+
+integer idamax_(integer *n, doublereal *dx, integer *incx)
+{
+ /* System generated locals */
+ integer ret_val, i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer i__, ix;
+ static doublereal dmax__;
+
+
+/*
+ finds the index of element having max. absolute value.
+ jack dongarra, linpack, 3/11/78.
+ modified 3/93 to return if incx .le. 0.
+ modified 12/3/93, array(1) declarations changed to array(*)
+*/
+
+
+ /* Parameter adjustments */
+ --dx;
+
+ /* Function Body */
+ ret_val = 0;
+ if (*n < 1 || *incx <= 0) {
+ return ret_val;
+ }
+ ret_val = 1;
+ if (*n == 1) {
+ return ret_val;
+ }
+ if (*incx == 1) {
+ goto L20;
+ }
+
+/* code for increment not equal to 1 */
+
+ ix = 1;
+ dmax__ = abs(dx[1]);
+ ix += *incx;
+ i__1 = *n;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ if ((d__1 = dx[ix], abs(d__1)) <= dmax__) {
+ goto L5;
+ }
+ ret_val = i__;
+ dmax__ = (d__1 = dx[ix], abs(d__1));
+L5:
+ ix += *incx;
+/* L10: */
+ }
+ return ret_val;
+
+/* code for increment equal to 1 */
+
+L20:
+ dmax__ = abs(dx[1]);
+ i__1 = *n;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ if ((d__1 = dx[i__], abs(d__1)) <= dmax__) {
+ goto L30;
+ }
+ ret_val = i__;
+ dmax__ = (d__1 = dx[i__], abs(d__1));
+L30:
+ ;
+ }
+ return ret_val;
+} /* idamax_ */
+
+integer izamax_(integer *n, doublecomplex *zx, integer *incx)
+{
+ /* System generated locals */
+ integer ret_val, i__1;
+
+ /* Local variables */
+ static integer i__, ix;
+ static doublereal smax;
+ extern doublereal dcabs1_(doublecomplex *);
+
+
+/*
+ finds the index of element having max. absolute value.
+ jack dongarra, 1/15/85.
+ modified 3/93 to return if incx .le. 0.
+ modified 12/3/93, array(1) declarations changed to array(*)
+*/
+
+
+ /* Parameter adjustments */
+ --zx;
+
+ /* Function Body */
+ ret_val = 0;
+ if (*n < 1 || *incx <= 0) {
+ return ret_val;
+ }
+ ret_val = 1;
+ if (*n == 1) {
+ return ret_val;
+ }
+ if (*incx == 1) {
+ goto L20;
+ }
+
+/* code for increment not equal to 1 */
+
+ ix = 1;
+ smax = dcabs1_(&zx[1]);
+ ix += *incx;
+ i__1 = *n;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ if (dcabs1_(&zx[ix]) <= smax) {
+ goto L5;
+ }
+ ret_val = i__;
+ smax = dcabs1_(&zx[ix]);
+L5:
+ ix += *incx;
+/* L10: */
+ }
+ return ret_val;
+
+/* code for increment equal to 1 */
+
+L20:
+ smax = dcabs1_(&zx[1]);
+ i__1 = *n;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ if (dcabs1_(&zx[i__]) <= smax) {
+ goto L30;
+ }
+ ret_val = i__;
+ smax = dcabs1_(&zx[i__]);
+L30:
+ ;
+ }
+ return ret_val;
+} /* izamax_ */
+
+logical lsame_(char *ca, char *cb)
+{
+ /* System generated locals */
+ logical ret_val;
+
+ /* Local variables */
+ static integer inta, intb, zcode;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ LSAME returns .TRUE. if CA is the same letter as CB regardless of
+ case.
+
+ Arguments
+ =========
+
+ CA (input) CHARACTER*1
+ CB (input) CHARACTER*1
+ CA and CB specify the single characters to be compared.
+
+ =====================================================================
+
+
+ Test if the characters are equal
+*/
+
+ ret_val = *(unsigned char *)ca == *(unsigned char *)cb;
+ if (ret_val) {
+ return ret_val;
+ }
+
+/* Now test for equivalence if both characters are alphabetic. */
+
+ zcode = 'Z';
+
+/*
+ Use 'Z' rather than 'A' so that ASCII can be detected on Prime
+ machines, on which ICHAR returns a value with bit 8 set.
+ ICHAR('A') on Prime machines returns 193 which is the same as
+ ICHAR('A') on an EBCDIC machine.
+*/
+
+ inta = *(unsigned char *)ca;
+ intb = *(unsigned char *)cb;
+
+ if (zcode == 90 || zcode == 122) {
+
+/*
+ ASCII is assumed - ZCODE is the ASCII code of either lower or
+ upper case 'Z'.
+*/
+
+ if ((inta >= 97 && inta <= 122)) {
+ inta += -32;
+ }
+ if ((intb >= 97 && intb <= 122)) {
+ intb += -32;
+ }
+
+ } else if (zcode == 233 || zcode == 169) {
+
+/*
+ EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or
+ upper case 'Z'.
+*/
+
+ if ((inta >= 129 && inta <= 137) || (inta >= 145 && inta <= 153) || (
+ inta >= 162 && inta <= 169)) {
+ inta += 64;
+ }
+ if ((intb >= 129 && intb <= 137) || (intb >= 145 && intb <= 153) || (
+ intb >= 162 && intb <= 169)) {
+ intb += 64;
+ }
+
+ } else if (zcode == 218 || zcode == 250) {
+
+/*
+ ASCII is assumed, on Prime machines - ZCODE is the ASCII code
+ plus 128 of either lower or upper case 'Z'.
+*/
+
+ if ((inta >= 225 && inta <= 250)) {
+ inta += -32;
+ }
+ if ((intb >= 225 && intb <= 250)) {
+ intb += -32;
+ }
+ }
+ ret_val = inta == intb;
+
+/*
+ RETURN
+
+ End of LSAME
+*/
+
+ return ret_val;
+} /* lsame_ */
+
+/* Subroutine */ int xerbla_(char *srname, integer *info)
+{
+ /* Format strings */
+ static char fmt_9999[] = "(\002 ** On entry to \002,a6,\002 parameter nu"
+ "mber \002,i2,\002 had \002,\002an illegal value\002)";
+
+ /* Builtin functions */
+ integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
+ /* Subroutine */ int s_stop(char *, ftnlen);
+
+ /* Fortran I/O blocks */
+ static cilist io___147 = { 0, 6, 0, fmt_9999, 0 };
+
+
+/*
+ -- LAPACK auxiliary routine (preliminary version) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ February 29, 1992
+
+
+ Purpose
+ =======
+
+ XERBLA is an error handler for the LAPACK routines.
+ It is called by an LAPACK routine if an input parameter has an
+ invalid value. A message is printed and execution stops.
+
+ Installers may consider modifying the STOP statement in order to
+ call system-specific exception-handling facilities.
+
+ Arguments
+ =========
+
+ SRNAME (input) CHARACTER*6
+ The name of the routine which called XERBLA.
+
+ INFO (input) INTEGER
+ The position of the invalid parameter in the parameter list
+ of the calling routine.
+*/
+
+
+ s_wsfe(&io___147);
+ do_fio(&c__1, srname, (ftnlen)6);
+ do_fio(&c__1, (char *)&(*info), (ftnlen)sizeof(integer));
+ e_wsfe();
+
+ s_stop("", (ftnlen)0);
+
+
+/* End of XERBLA */
+
+ return 0;
+} /* xerbla_ */
+
+/* Subroutine */ int zaxpy_(integer *n, doublecomplex *za, doublecomplex *zx,
+ integer *incx, doublecomplex *zy, integer *incy)
+{
+ /* System generated locals */
+ integer i__1, i__2, i__3, i__4;
+ doublecomplex z__1, z__2;
+
+ /* Local variables */
+ static integer i__, ix, iy;
+ extern doublereal dcabs1_(doublecomplex *);
+
+
+/*
+ constant times a vector plus a vector.
+ jack dongarra, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+*/
+
+ /* Parameter adjustments */
+ --zy;
+ --zx;
+
+ /* Function Body */
+ if (*n <= 0) {
+ return 0;
+ }
+ if (dcabs1_(za) == 0.) {
+ return 0;
+ }
+ if ((*incx == 1 && *incy == 1)) {
+ goto L20;
+ }
+
+/*
+ code for unequal increments or equal increments
+ not equal to 1
+*/
+
+ ix = 1;
+ iy = 1;
+ if (*incx < 0) {
+ ix = (-(*n) + 1) * *incx + 1;
+ }
+ if (*incy < 0) {
+ iy = (-(*n) + 1) * *incy + 1;
+ }
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = iy;
+ i__3 = iy;
+ i__4 = ix;
+ z__2.r = za->r * zx[i__4].r - za->i * zx[i__4].i, z__2.i = za->r * zx[
+ i__4].i + za->i * zx[i__4].r;
+ z__1.r = zy[i__3].r + z__2.r, z__1.i = zy[i__3].i + z__2.i;
+ zy[i__2].r = z__1.r, zy[i__2].i = z__1.i;
+ ix += *incx;
+ iy += *incy;
+/* L10: */
+ }
+ return 0;
+
+/* code for both increments equal to 1 */
+
+L20:
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ i__3 = i__;
+ i__4 = i__;
+ z__2.r = za->r * zx[i__4].r - za->i * zx[i__4].i, z__2.i = za->r * zx[
+ i__4].i + za->i * zx[i__4].r;
+ z__1.r = zy[i__3].r + z__2.r, z__1.i = zy[i__3].i + z__2.i;
+ zy[i__2].r = z__1.r, zy[i__2].i = z__1.i;
+/* L30: */
+ }
+ return 0;
+} /* zaxpy_ */
+
+/* Subroutine */ int zcopy_(integer *n, doublecomplex *zx, integer *incx,
+ doublecomplex *zy, integer *incy)
+{
+ /* System generated locals */
+ integer i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i__, ix, iy;
+
+
+/*
+ copies a vector, x, to a vector, y.
+ jack dongarra, linpack, 4/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+*/
+
+
+ /* Parameter adjustments */
+ --zy;
+ --zx;
+
+ /* Function Body */
+ if (*n <= 0) {
+ return 0;
+ }
+ if ((*incx == 1 && *incy == 1)) {
+ goto L20;
+ }
+
+/*
+ code for unequal increments or equal increments
+ not equal to 1
+*/
+
+ ix = 1;
+ iy = 1;
+ if (*incx < 0) {
+ ix = (-(*n) + 1) * *incx + 1;
+ }
+ if (*incy < 0) {
+ iy = (-(*n) + 1) * *incy + 1;
+ }
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = iy;
+ i__3 = ix;
+ zy[i__2].r = zx[i__3].r, zy[i__2].i = zx[i__3].i;
+ ix += *incx;
+ iy += *incy;
+/* L10: */
+ }
+ return 0;
+
+/* code for both increments equal to 1 */
+
+L20:
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ i__3 = i__;
+ zy[i__2].r = zx[i__3].r, zy[i__2].i = zx[i__3].i;
+/* L30: */
+ }
+ return 0;
+} /* zcopy_ */
+
+/* Double Complex */ VOID zdotc_(doublecomplex * ret_val, integer *n,
+ doublecomplex *zx, integer *incx, doublecomplex *zy, integer *incy)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ doublecomplex z__1, z__2, z__3;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, ix, iy;
+ static doublecomplex ztemp;
+
+
+/*
+ forms the dot product of a vector.
+ jack dongarra, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+*/
+
+ /* Parameter adjustments */
+ --zy;
+ --zx;
+
+ /* Function Body */
+ ztemp.r = 0., ztemp.i = 0.;
+ ret_val->r = 0., ret_val->i = 0.;
+ if (*n <= 0) {
+ return ;
+ }
+ if ((*incx == 1 && *incy == 1)) {
+ goto L20;
+ }
+
+/*
+ code for unequal increments or equal increments
+ not equal to 1
+*/
+
+ ix = 1;
+ iy = 1;
+ if (*incx < 0) {
+ ix = (-(*n) + 1) * *incx + 1;
+ }
+ if (*incy < 0) {
+ iy = (-(*n) + 1) * *incy + 1;
+ }
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ d_cnjg(&z__3, &zx[ix]);
+ i__2 = iy;
+ z__2.r = z__3.r * zy[i__2].r - z__3.i * zy[i__2].i, z__2.i = z__3.r *
+ zy[i__2].i + z__3.i * zy[i__2].r;
+ z__1.r = ztemp.r + z__2.r, z__1.i = ztemp.i + z__2.i;
+ ztemp.r = z__1.r, ztemp.i = z__1.i;
+ ix += *incx;
+ iy += *incy;
+/* L10: */
+ }
+ ret_val->r = ztemp.r, ret_val->i = ztemp.i;
+ return ;
+
+/* code for both increments equal to 1 */
+
+L20:
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ d_cnjg(&z__3, &zx[i__]);
+ i__2 = i__;
+ z__2.r = z__3.r * zy[i__2].r - z__3.i * zy[i__2].i, z__2.i = z__3.r *
+ zy[i__2].i + z__3.i * zy[i__2].r;
+ z__1.r = ztemp.r + z__2.r, z__1.i = ztemp.i + z__2.i;
+ ztemp.r = z__1.r, ztemp.i = z__1.i;
+/* L30: */
+ }
+ ret_val->r = ztemp.r, ret_val->i = ztemp.i;
+ return ;
+} /* zdotc_ */
+
+/* Double Complex */ VOID zdotu_(doublecomplex * ret_val, integer *n,
+ doublecomplex *zx, integer *incx, doublecomplex *zy, integer *incy)
+{
+ /* System generated locals */
+ integer i__1, i__2, i__3;
+ doublecomplex z__1, z__2;
+
+ /* Local variables */
+ static integer i__, ix, iy;
+ static doublecomplex ztemp;
+
+
+/*
+ forms the dot product of two vectors.
+ jack dongarra, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+*/
+
+ /* Parameter adjustments */
+ --zy;
+ --zx;
+
+ /* Function Body */
+ ztemp.r = 0., ztemp.i = 0.;
+ ret_val->r = 0., ret_val->i = 0.;
+ if (*n <= 0) {
+ return ;
+ }
+ if ((*incx == 1 && *incy == 1)) {
+ goto L20;
+ }
+
+/*
+ code for unequal increments or equal increments
+ not equal to 1
+*/
+
+ ix = 1;
+ iy = 1;
+ if (*incx < 0) {
+ ix = (-(*n) + 1) * *incx + 1;
+ }
+ if (*incy < 0) {
+ iy = (-(*n) + 1) * *incy + 1;
+ }
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = ix;
+ i__3 = iy;
+ z__2.r = zx[i__2].r * zy[i__3].r - zx[i__2].i * zy[i__3].i, z__2.i =
+ zx[i__2].r * zy[i__3].i + zx[i__2].i * zy[i__3].r;
+ z__1.r = ztemp.r + z__2.r, z__1.i = ztemp.i + z__2.i;
+ ztemp.r = z__1.r, ztemp.i = z__1.i;
+ ix += *incx;
+ iy += *incy;
+/* L10: */
+ }
+ ret_val->r = ztemp.r, ret_val->i = ztemp.i;
+ return ;
+
+/* code for both increments equal to 1 */
+
+L20:
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ i__3 = i__;
+ z__2.r = zx[i__2].r * zy[i__3].r - zx[i__2].i * zy[i__3].i, z__2.i =
+ zx[i__2].r * zy[i__3].i + zx[i__2].i * zy[i__3].r;
+ z__1.r = ztemp.r + z__2.r, z__1.i = ztemp.i + z__2.i;
+ ztemp.r = z__1.r, ztemp.i = z__1.i;
+/* L30: */
+ }
+ ret_val->r = ztemp.r, ret_val->i = ztemp.i;
+ return ;
+} /* zdotu_ */
+
+/* Subroutine */ int zdscal_(integer *n, doublereal *da, doublecomplex *zx,
+ integer *incx)
+{
+ /* System generated locals */
+ integer i__1, i__2, i__3;
+ doublecomplex z__1, z__2;
+
+ /* Local variables */
+ static integer i__, ix;
+
+
+/*
+ scales a vector by a constant.
+ jack dongarra, 3/11/78.
+ modified 3/93 to return if incx .le. 0.
+ modified 12/3/93, array(1) declarations changed to array(*)
+*/
+
+
+ /* Parameter adjustments */
+ --zx;
+
+ /* Function Body */
+ if (*n <= 0 || *incx <= 0) {
+ return 0;
+ }
+ if (*incx == 1) {
+ goto L20;
+ }
+
+/* code for increment not equal to 1 */
+
+ ix = 1;
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = ix;
+ z__2.r = *da, z__2.i = 0.;
+ i__3 = ix;
+ z__1.r = z__2.r * zx[i__3].r - z__2.i * zx[i__3].i, z__1.i = z__2.r *
+ zx[i__3].i + z__2.i * zx[i__3].r;
+ zx[i__2].r = z__1.r, zx[i__2].i = z__1.i;
+ ix += *incx;
+/* L10: */
+ }
+ return 0;
+
+/* code for increment equal to 1 */
+
+L20:
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ z__2.r = *da, z__2.i = 0.;
+ i__3 = i__;
+ z__1.r = z__2.r * zx[i__3].r - z__2.i * zx[i__3].i, z__1.i = z__2.r *
+ zx[i__3].i + z__2.i * zx[i__3].r;
+ zx[i__2].r = z__1.r, zx[i__2].i = z__1.i;
+/* L30: */
+ }
+ return 0;
+} /* zdscal_ */
+
+/* Subroutine */ int zgemm_(char *transa, char *transb, integer *m, integer *
+ n, integer *k, doublecomplex *alpha, doublecomplex *a, integer *lda,
+ doublecomplex *b, integer *ldb, doublecomplex *beta, doublecomplex *
+ c__, integer *ldc)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
+ i__3, i__4, i__5, i__6;
+ doublecomplex z__1, z__2, z__3, z__4;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, j, l, info;
+ static logical nota, notb;
+ static doublecomplex temp;
+ static logical conja, conjb;
+ static integer ncola;
+ extern logical lsame_(char *, char *);
+ static integer nrowa, nrowb;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/*
+ Purpose
+ =======
+
+ ZGEMM performs one of the matrix-matrix operations
+
+ C := alpha*op( A )*op( B ) + beta*C,
+
+ where op( X ) is one of
+
+ op( X ) = X or op( X ) = X' or op( X ) = conjg( X' ),
+
+ alpha and beta are scalars, and A, B and C are matrices, with op( A )
+ an m by k matrix, op( B ) a k by n matrix and C an m by n matrix.
+
+ Parameters
+ ==========
+
+ TRANSA - CHARACTER*1.
+ On entry, TRANSA specifies the form of op( A ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSA = 'N' or 'n', op( A ) = A.
+
+ TRANSA = 'T' or 't', op( A ) = A'.
+
+ TRANSA = 'C' or 'c', op( A ) = conjg( A' ).
+
+ Unchanged on exit.
+
+ TRANSB - CHARACTER*1.
+ On entry, TRANSB specifies the form of op( B ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSB = 'N' or 'n', op( B ) = B.
+
+ TRANSB = 'T' or 't', op( B ) = B'.
+
+ TRANSB = 'C' or 'c', op( B ) = conjg( B' ).
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix
+ op( A ) and of the matrix C. M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix
+ op( B ) and the number of columns of the matrix C. N must be
+ at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry, K specifies the number of columns of the matrix
+ op( A ) and the number of rows of the matrix op( B ). K must
+ be at least zero.
+ Unchanged on exit.
+
+ ALPHA - COMPLEX*16 .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is
+ k when TRANSA = 'N' or 'n', and is m otherwise.
+ Before entry with TRANSA = 'N' or 'n', the leading m by k
+ part of the array A must contain the matrix A, otherwise
+ the leading k by m part of the array A must contain the
+ matrix A.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When TRANSA = 'N' or 'n' then
+ LDA must be at least max( 1, m ), otherwise LDA must be at
+ least max( 1, k ).
+ Unchanged on exit.
+
+ B - COMPLEX*16 array of DIMENSION ( LDB, kb ), where kb is
+ n when TRANSB = 'N' or 'n', and is k otherwise.
+ Before entry with TRANSB = 'N' or 'n', the leading k by n
+ part of the array B must contain the matrix B, otherwise
+ the leading n by k part of the array B must contain the
+ matrix B.
+ Unchanged on exit.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. When TRANSB = 'N' or 'n' then
+ LDB must be at least max( 1, k ), otherwise LDB must be at
+ least max( 1, n ).
+ Unchanged on exit.
+
+ BETA - COMPLEX*16 .
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then C need not be set on input.
+ Unchanged on exit.
+
+ C - COMPLEX*16 array of DIMENSION ( LDC, n ).
+ Before entry, the leading m by n part of the array C must
+ contain the matrix C, except when beta is zero, in which
+ case C need not be set on entry.
+ On exit, the array C is overwritten by the m by n matrix
+ ( alpha*op( A )*op( B ) + beta*C ).
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ Set NOTA and NOTB as true if A and B respectively are not
+ conjugated or transposed, set CONJA and CONJB as true if A and
+ B respectively are to be transposed but not conjugated and set
+ NROWA, NCOLA and NROWB as the number of rows and columns of A
+ and the number of rows of B respectively.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+
+ /* Function Body */
+ nota = lsame_(transa, "N");
+ notb = lsame_(transb, "N");
+ conja = lsame_(transa, "C");
+ conjb = lsame_(transb, "C");
+ if (nota) {
+ nrowa = *m;
+ ncola = *k;
+ } else {
+ nrowa = *k;
+ ncola = *m;
+ }
+ if (notb) {
+ nrowb = *k;
+ } else {
+ nrowb = *n;
+ }
+
+/* Test the input parameters. */
+
+ info = 0;
+ if (((! nota && ! conja) && ! lsame_(transa, "T")))
+ {
+ info = 1;
+ } else if (((! notb && ! conjb) && ! lsame_(transb, "T"))) {
+ info = 2;
+ } else if (*m < 0) {
+ info = 3;
+ } else if (*n < 0) {
+ info = 4;
+ } else if (*k < 0) {
+ info = 5;
+ } else if (*lda < max(1,nrowa)) {
+ info = 8;
+ } else if (*ldb < max(1,nrowb)) {
+ info = 10;
+ } else if (*ldc < max(1,*m)) {
+ info = 13;
+ }
+ if (info != 0) {
+ xerbla_("ZGEMM ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0 || (((alpha->r == 0. && alpha->i == 0.) || *k == 0)
+ && ((beta->r == 1. && beta->i == 0.)))) {
+ return 0;
+ }
+
+/* And when alpha.eq.zero. */
+
+ if ((alpha->r == 0. && alpha->i == 0.)) {
+ if ((beta->r == 0. && beta->i == 0.)) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ c__[i__3].r = 0., c__[i__3].i = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ i__4 = i__ + j * c_dim1;
+ z__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4].i,
+ z__1.i = beta->r * c__[i__4].i + beta->i * c__[
+ i__4].r;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L30: */
+ }
+/* L40: */
+ }
+ }
+ return 0;
+ }
+
+/* Start the operations. */
+
+ if (notb) {
+ if (nota) {
+
+/* Form C := alpha*A*B + beta*C. */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if ((beta->r == 0. && beta->i == 0.)) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ c__[i__3].r = 0., c__[i__3].i = 0.;
+/* L50: */
+ }
+ } else if (beta->r != 1. || beta->i != 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ i__4 = i__ + j * c_dim1;
+ z__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
+ .i, z__1.i = beta->r * c__[i__4].i + beta->i *
+ c__[i__4].r;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L60: */
+ }
+ }
+ i__2 = *k;
+ for (l = 1; l <= i__2; ++l) {
+ i__3 = l + j * b_dim1;
+ if (b[i__3].r != 0. || b[i__3].i != 0.) {
+ i__3 = l + j * b_dim1;
+ z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3].i,
+ z__1.i = alpha->r * b[i__3].i + alpha->i * b[
+ i__3].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ i__3 = *m;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ i__4 = i__ + j * c_dim1;
+ i__5 = i__ + j * c_dim1;
+ i__6 = i__ + l * a_dim1;
+ z__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,
+ z__2.i = temp.r * a[i__6].i + temp.i * a[
+ i__6].r;
+ z__1.r = c__[i__5].r + z__2.r, z__1.i = c__[i__5]
+ .i + z__2.i;
+ c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
+/* L70: */
+ }
+ }
+/* L80: */
+ }
+/* L90: */
+ }
+ } else if (conja) {
+
+/* Form C := alpha*conjg( A' )*B + beta*C. */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp.r = 0., temp.i = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ d_cnjg(&z__3, &a[l + i__ * a_dim1]);
+ i__4 = l + j * b_dim1;
+ z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i,
+ z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]
+ .r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L100: */
+ }
+ if ((beta->r == 0. && beta->i == 0.)) {
+ i__3 = i__ + j * c_dim1;
+ z__1.r = alpha->r * temp.r - alpha->i * temp.i,
+ z__1.i = alpha->r * temp.i + alpha->i *
+ temp.r;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ } else {
+ i__3 = i__ + j * c_dim1;
+ z__2.r = alpha->r * temp.r - alpha->i * temp.i,
+ z__2.i = alpha->r * temp.i + alpha->i *
+ temp.r;
+ i__4 = i__ + j * c_dim1;
+ z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
+ .i, z__3.i = beta->r * c__[i__4].i + beta->i *
+ c__[i__4].r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ }
+/* L110: */
+ }
+/* L120: */
+ }
+ } else {
+
+/* Form C := alpha*A'*B + beta*C */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp.r = 0., temp.i = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ i__4 = l + i__ * a_dim1;
+ i__5 = l + j * b_dim1;
+ z__2.r = a[i__4].r * b[i__5].r - a[i__4].i * b[i__5]
+ .i, z__2.i = a[i__4].r * b[i__5].i + a[i__4]
+ .i * b[i__5].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L130: */
+ }
+ if ((beta->r == 0. && beta->i == 0.)) {
+ i__3 = i__ + j * c_dim1;
+ z__1.r = alpha->r * temp.r - alpha->i * temp.i,
+ z__1.i = alpha->r * temp.i + alpha->i *
+ temp.r;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ } else {
+ i__3 = i__ + j * c_dim1;
+ z__2.r = alpha->r * temp.r - alpha->i * temp.i,
+ z__2.i = alpha->r * temp.i + alpha->i *
+ temp.r;
+ i__4 = i__ + j * c_dim1;
+ z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
+ .i, z__3.i = beta->r * c__[i__4].i + beta->i *
+ c__[i__4].r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ }
+/* L140: */
+ }
+/* L150: */
+ }
+ }
+ } else if (nota) {
+ if (conjb) {
+
+/* Form C := alpha*A*conjg( B' ) + beta*C. */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if ((beta->r == 0. && beta->i == 0.)) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ c__[i__3].r = 0., c__[i__3].i = 0.;
+/* L160: */
+ }
+ } else if (beta->r != 1. || beta->i != 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ i__4 = i__ + j * c_dim1;
+ z__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
+ .i, z__1.i = beta->r * c__[i__4].i + beta->i *
+ c__[i__4].r;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L170: */
+ }
+ }
+ i__2 = *k;
+ for (l = 1; l <= i__2; ++l) {
+ i__3 = j + l * b_dim1;
+ if (b[i__3].r != 0. || b[i__3].i != 0.) {
+ d_cnjg(&z__2, &b[j + l * b_dim1]);
+ z__1.r = alpha->r * z__2.r - alpha->i * z__2.i,
+ z__1.i = alpha->r * z__2.i + alpha->i *
+ z__2.r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ i__3 = *m;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ i__4 = i__ + j * c_dim1;
+ i__5 = i__ + j * c_dim1;
+ i__6 = i__ + l * a_dim1;
+ z__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,
+ z__2.i = temp.r * a[i__6].i + temp.i * a[
+ i__6].r;
+ z__1.r = c__[i__5].r + z__2.r, z__1.i = c__[i__5]
+ .i + z__2.i;
+ c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
+/* L180: */
+ }
+ }
+/* L190: */
+ }
+/* L200: */
+ }
+ } else {
+
+/* Form C := alpha*A*B' + beta*C */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if ((beta->r == 0. && beta->i == 0.)) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ c__[i__3].r = 0., c__[i__3].i = 0.;
+/* L210: */
+ }
+ } else if (beta->r != 1. || beta->i != 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ i__4 = i__ + j * c_dim1;
+ z__1.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
+ .i, z__1.i = beta->r * c__[i__4].i + beta->i *
+ c__[i__4].r;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L220: */
+ }
+ }
+ i__2 = *k;
+ for (l = 1; l <= i__2; ++l) {
+ i__3 = j + l * b_dim1;
+ if (b[i__3].r != 0. || b[i__3].i != 0.) {
+ i__3 = j + l * b_dim1;
+ z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3].i,
+ z__1.i = alpha->r * b[i__3].i + alpha->i * b[
+ i__3].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ i__3 = *m;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ i__4 = i__ + j * c_dim1;
+ i__5 = i__ + j * c_dim1;
+ i__6 = i__ + l * a_dim1;
+ z__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,
+ z__2.i = temp.r * a[i__6].i + temp.i * a[
+ i__6].r;
+ z__1.r = c__[i__5].r + z__2.r, z__1.i = c__[i__5]
+ .i + z__2.i;
+ c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
+/* L230: */
+ }
+ }
+/* L240: */
+ }
+/* L250: */
+ }
+ }
+ } else if (conja) {
+ if (conjb) {
+
+/* Form C := alpha*conjg( A' )*conjg( B' ) + beta*C. */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp.r = 0., temp.i = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ d_cnjg(&z__3, &a[l + i__ * a_dim1]);
+ d_cnjg(&z__4, &b[j + l * b_dim1]);
+ z__2.r = z__3.r * z__4.r - z__3.i * z__4.i, z__2.i =
+ z__3.r * z__4.i + z__3.i * z__4.r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L260: */
+ }
+ if ((beta->r == 0. && beta->i == 0.)) {
+ i__3 = i__ + j * c_dim1;
+ z__1.r = alpha->r * temp.r - alpha->i * temp.i,
+ z__1.i = alpha->r * temp.i + alpha->i *
+ temp.r;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ } else {
+ i__3 = i__ + j * c_dim1;
+ z__2.r = alpha->r * temp.r - alpha->i * temp.i,
+ z__2.i = alpha->r * temp.i + alpha->i *
+ temp.r;
+ i__4 = i__ + j * c_dim1;
+ z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
+ .i, z__3.i = beta->r * c__[i__4].i + beta->i *
+ c__[i__4].r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ }
+/* L270: */
+ }
+/* L280: */
+ }
+ } else {
+
+/* Form C := alpha*conjg( A' )*B' + beta*C */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp.r = 0., temp.i = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ d_cnjg(&z__3, &a[l + i__ * a_dim1]);
+ i__4 = j + l * b_dim1;
+ z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i,
+ z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]
+ .r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L290: */
+ }
+ if ((beta->r == 0. && beta->i == 0.)) {
+ i__3 = i__ + j * c_dim1;
+ z__1.r = alpha->r * temp.r - alpha->i * temp.i,
+ z__1.i = alpha->r * temp.i + alpha->i *
+ temp.r;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ } else {
+ i__3 = i__ + j * c_dim1;
+ z__2.r = alpha->r * temp.r - alpha->i * temp.i,
+ z__2.i = alpha->r * temp.i + alpha->i *
+ temp.r;
+ i__4 = i__ + j * c_dim1;
+ z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
+ .i, z__3.i = beta->r * c__[i__4].i + beta->i *
+ c__[i__4].r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ }
+/* L300: */
+ }
+/* L310: */
+ }
+ }
+ } else {
+ if (conjb) {
+
+/* Form C := alpha*A'*conjg( B' ) + beta*C */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp.r = 0., temp.i = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ i__4 = l + i__ * a_dim1;
+ d_cnjg(&z__3, &b[j + l * b_dim1]);
+ z__2.r = a[i__4].r * z__3.r - a[i__4].i * z__3.i,
+ z__2.i = a[i__4].r * z__3.i + a[i__4].i *
+ z__3.r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L320: */
+ }
+ if ((beta->r == 0. && beta->i == 0.)) {
+ i__3 = i__ + j * c_dim1;
+ z__1.r = alpha->r * temp.r - alpha->i * temp.i,
+ z__1.i = alpha->r * temp.i + alpha->i *
+ temp.r;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ } else {
+ i__3 = i__ + j * c_dim1;
+ z__2.r = alpha->r * temp.r - alpha->i * temp.i,
+ z__2.i = alpha->r * temp.i + alpha->i *
+ temp.r;
+ i__4 = i__ + j * c_dim1;
+ z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
+ .i, z__3.i = beta->r * c__[i__4].i + beta->i *
+ c__[i__4].r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ }
+/* L330: */
+ }
+/* L340: */
+ }
+ } else {
+
+/* Form C := alpha*A'*B' + beta*C */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp.r = 0., temp.i = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ i__4 = l + i__ * a_dim1;
+ i__5 = j + l * b_dim1;
+ z__2.r = a[i__4].r * b[i__5].r - a[i__4].i * b[i__5]
+ .i, z__2.i = a[i__4].r * b[i__5].i + a[i__4]
+ .i * b[i__5].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L350: */
+ }
+ if ((beta->r == 0. && beta->i == 0.)) {
+ i__3 = i__ + j * c_dim1;
+ z__1.r = alpha->r * temp.r - alpha->i * temp.i,
+ z__1.i = alpha->r * temp.i + alpha->i *
+ temp.r;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ } else {
+ i__3 = i__ + j * c_dim1;
+ z__2.r = alpha->r * temp.r - alpha->i * temp.i,
+ z__2.i = alpha->r * temp.i + alpha->i *
+ temp.r;
+ i__4 = i__ + j * c_dim1;
+ z__3.r = beta->r * c__[i__4].r - beta->i * c__[i__4]
+ .i, z__3.i = beta->r * c__[i__4].i + beta->i *
+ c__[i__4].r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ }
+/* L360: */
+ }
+/* L370: */
+ }
+ }
+ }
+
+ return 0;
+
+/* End of ZGEMM . */
+
+} /* zgemm_ */
+
+/* Subroutine */ int zgemv_(char *trans, integer *m, integer *n,
+ doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *
+ x, integer *incx, doublecomplex *beta, doublecomplex *y, integer *
+ incy)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
+ doublecomplex z__1, z__2, z__3;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, j, ix, iy, jx, jy, kx, ky, info;
+ static doublecomplex temp;
+ static integer lenx, leny;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static logical noconj;
+
+
+/*
+ Purpose
+ =======
+
+ ZGEMV performs one of the matrix-vector operations
+
+ y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, or
+
+ y := alpha*conjg( A' )*x + beta*y,
+
+ where alpha and beta are scalars, x and y are vectors and A is an
+ m by n matrix.
+
+ Parameters
+ ==========
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' y := alpha*A*x + beta*y.
+
+ TRANS = 'T' or 't' y := alpha*A'*x + beta*y.
+
+ TRANS = 'C' or 'c' y := alpha*conjg( A' )*x + beta*y.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - COMPLEX*16 .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - COMPLEX*16 array of DIMENSION ( LDA, n ).
+ Before entry, the leading m by n part of the array A must
+ contain the matrix of coefficients.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+ X - COMPLEX*16 array of DIMENSION at least
+ ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
+ Before entry, the incremented array X must contain the
+ vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - COMPLEX*16 .
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - COMPLEX*16 array of DIMENSION at least
+ ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
+ and at least
+ ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
+ Before entry with BETA non-zero, the incremented array Y
+ must contain the vector y. On exit, Y is overwritten by the
+ updated vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --x;
+ --y;
+
+ /* Function Body */
+ info = 0;
+ if (((! lsame_(trans, "N") && ! lsame_(trans, "T")) && ! lsame_(trans, "C"))) {
+ info = 1;
+ } else if (*m < 0) {
+ info = 2;
+ } else if (*n < 0) {
+ info = 3;
+ } else if (*lda < max(1,*m)) {
+ info = 6;
+ } else if (*incx == 0) {
+ info = 8;
+ } else if (*incy == 0) {
+ info = 11;
+ }
+ if (info != 0) {
+ xerbla_("ZGEMV ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0 || ((alpha->r == 0. && alpha->i == 0.) && ((
+ beta->r == 1. && beta->i == 0.)))) {
+ return 0;
+ }
+
+ noconj = lsame_(trans, "T");
+
+/*
+ Set LENX and LENY, the lengths of the vectors x and y, and set
+ up the start points in X and Y.
+*/
+
+ if (lsame_(trans, "N")) {
+ lenx = *n;
+ leny = *m;
+ } else {
+ lenx = *m;
+ leny = *n;
+ }
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (lenx - 1) * *incx;
+ }
+ if (*incy > 0) {
+ ky = 1;
+ } else {
+ ky = 1 - (leny - 1) * *incy;
+ }
+
+/*
+ Start the operations. In this version the elements of A are
+ accessed sequentially with one pass through A.
+
+ First form y := beta*y.
+*/
+
+ if (beta->r != 1. || beta->i != 0.) {
+ if (*incy == 1) {
+ if ((beta->r == 0. && beta->i == 0.)) {
+ i__1 = leny;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ y[i__2].r = 0., y[i__2].i = 0.;
+/* L10: */
+ }
+ } else {
+ i__1 = leny;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ i__3 = i__;
+ z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,
+ z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
+ .r;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+/* L20: */
+ }
+ }
+ } else {
+ iy = ky;
+ if ((beta->r == 0. && beta->i == 0.)) {
+ i__1 = leny;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = iy;
+ y[i__2].r = 0., y[i__2].i = 0.;
+ iy += *incy;
+/* L30: */
+ }
+ } else {
+ i__1 = leny;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = iy;
+ i__3 = iy;
+ z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,
+ z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
+ .r;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+ iy += *incy;
+/* L40: */
+ }
+ }
+ }
+ }
+ if ((alpha->r == 0. && alpha->i == 0.)) {
+ return 0;
+ }
+ if (lsame_(trans, "N")) {
+
+/* Form y := alpha*A*x + y. */
+
+ jx = kx;
+ if (*incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = jx;
+ if (x[i__2].r != 0. || x[i__2].i != 0.) {
+ i__2 = jx;
+ z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,
+ z__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
+ .r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__;
+ i__4 = i__;
+ i__5 = i__ + j * a_dim1;
+ z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
+ z__2.i = temp.r * a[i__5].i + temp.i * a[i__5]
+ .r;
+ z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i +
+ z__2.i;
+ y[i__3].r = z__1.r, y[i__3].i = z__1.i;
+/* L50: */
+ }
+ }
+ jx += *incx;
+/* L60: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = jx;
+ if (x[i__2].r != 0. || x[i__2].i != 0.) {
+ i__2 = jx;
+ z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,
+ z__1.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
+ .r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ iy = ky;
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = iy;
+ i__4 = iy;
+ i__5 = i__ + j * a_dim1;
+ z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
+ z__2.i = temp.r * a[i__5].i + temp.i * a[i__5]
+ .r;
+ z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i +
+ z__2.i;
+ y[i__3].r = z__1.r, y[i__3].i = z__1.i;
+ iy += *incy;
+/* L70: */
+ }
+ }
+ jx += *incx;
+/* L80: */
+ }
+ }
+ } else {
+
+/* Form y := alpha*A'*x + y or y := alpha*conjg( A' )*x + y. */
+
+ jy = ky;
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp.r = 0., temp.i = 0.;
+ if (noconj) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ i__4 = i__;
+ z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[i__4]
+ .i, z__2.i = a[i__3].r * x[i__4].i + a[i__3]
+ .i * x[i__4].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L90: */
+ }
+ } else {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ d_cnjg(&z__3, &a[i__ + j * a_dim1]);
+ i__3 = i__;
+ z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
+ z__2.i = z__3.r * x[i__3].i + z__3.i * x[i__3]
+ .r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L100: */
+ }
+ }
+ i__2 = jy;
+ i__3 = jy;
+ z__2.r = alpha->r * temp.r - alpha->i * temp.i, z__2.i =
+ alpha->r * temp.i + alpha->i * temp.r;
+ z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+ jy += *incy;
+/* L110: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp.r = 0., temp.i = 0.;
+ ix = kx;
+ if (noconj) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ i__4 = ix;
+ z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[i__4]
+ .i, z__2.i = a[i__3].r * x[i__4].i + a[i__3]
+ .i * x[i__4].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ ix += *incx;
+/* L120: */
+ }
+ } else {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ d_cnjg(&z__3, &a[i__ + j * a_dim1]);
+ i__3 = ix;
+ z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
+ z__2.i = z__3.r * x[i__3].i + z__3.i * x[i__3]
+ .r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ ix += *incx;
+/* L130: */
+ }
+ }
+ i__2 = jy;
+ i__3 = jy;
+ z__2.r = alpha->r * temp.r - alpha->i * temp.i, z__2.i =
+ alpha->r * temp.i + alpha->i * temp.r;
+ z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+ jy += *incy;
+/* L140: */
+ }
+ }
+ }
+
+ return 0;
+
+/* End of ZGEMV . */
+
+} /* zgemv_ */
+
+/* Subroutine */ int zgerc_(integer *m, integer *n, doublecomplex *alpha,
+ doublecomplex *x, integer *incx, doublecomplex *y, integer *incy,
+ doublecomplex *a, integer *lda)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
+ doublecomplex z__1, z__2;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, j, ix, jy, kx, info;
+ static doublecomplex temp;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/*
+ Purpose
+ =======
+
+ ZGERC performs the rank 1 operation
+
+ A := alpha*x*conjg( y' ) + A,
+
+ where alpha is a scalar, x is an m element vector, y is an n element
+ vector and A is an m by n matrix.
+
+ Parameters
+ ==========
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - COMPLEX*16 .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - COMPLEX*16 array of dimension at least
+ ( 1 + ( m - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the m
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ Y - COMPLEX*16 array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y.
+ Unchanged on exit.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+ A - COMPLEX*16 array of DIMENSION ( LDA, n ).
+ Before entry, the leading m by n part of the array A must
+ contain the matrix of coefficients. On exit, A is
+ overwritten by the updated matrix.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --x;
+ --y;
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+
+ /* Function Body */
+ info = 0;
+ if (*m < 0) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*incx == 0) {
+ info = 5;
+ } else if (*incy == 0) {
+ info = 7;
+ } else if (*lda < max(1,*m)) {
+ info = 9;
+ }
+ if (info != 0) {
+ xerbla_("ZGERC ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0 || (alpha->r == 0. && alpha->i == 0.)) {
+ return 0;
+ }
+
+/*
+ Start the operations. In this version the elements of A are
+ accessed sequentially with one pass through A.
+*/
+
+ if (*incy > 0) {
+ jy = 1;
+ } else {
+ jy = 1 - (*n - 1) * *incy;
+ }
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = jy;
+ if (y[i__2].r != 0. || y[i__2].i != 0.) {
+ d_cnjg(&z__2, &y[jy]);
+ z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
+ alpha->r * z__2.i + alpha->i * z__2.r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ i__4 = i__ + j * a_dim1;
+ i__5 = i__;
+ z__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, z__2.i =
+ x[i__5].r * temp.i + x[i__5].i * temp.r;
+ z__1.r = a[i__4].r + z__2.r, z__1.i = a[i__4].i + z__2.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+/* L10: */
+ }
+ }
+ jy += *incy;
+/* L20: */
+ }
+ } else {
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (*m - 1) * *incx;
+ }
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = jy;
+ if (y[i__2].r != 0. || y[i__2].i != 0.) {
+ d_cnjg(&z__2, &y[jy]);
+ z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
+ alpha->r * z__2.i + alpha->i * z__2.r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ ix = kx;
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ i__4 = i__ + j * a_dim1;
+ i__5 = ix;
+ z__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, z__2.i =
+ x[i__5].r * temp.i + x[i__5].i * temp.r;
+ z__1.r = a[i__4].r + z__2.r, z__1.i = a[i__4].i + z__2.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+ ix += *incx;
+/* L30: */
+ }
+ }
+ jy += *incy;
+/* L40: */
+ }
+ }
+
+ return 0;
+
+/* End of ZGERC . */
+
+} /* zgerc_ */
+
+/* Subroutine */ int zgeru_(integer *m, integer *n, doublecomplex *alpha,
+ doublecomplex *x, integer *incx, doublecomplex *y, integer *incy,
+ doublecomplex *a, integer *lda)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
+ doublecomplex z__1, z__2;
+
+ /* Local variables */
+ static integer i__, j, ix, jy, kx, info;
+ static doublecomplex temp;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/*
+ Purpose
+ =======
+
+ ZGERU performs the rank 1 operation
+
+ A := alpha*x*y' + A,
+
+ where alpha is a scalar, x is an m element vector, y is an n element
+ vector and A is an m by n matrix.
+
+ Parameters
+ ==========
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of the matrix A.
+ M must be at least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - COMPLEX*16 .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - COMPLEX*16 array of dimension at least
+ ( 1 + ( m - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the m
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ Y - COMPLEX*16 array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y.
+ Unchanged on exit.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+ A - COMPLEX*16 array of DIMENSION ( LDA, n ).
+ Before entry, the leading m by n part of the array A must
+ contain the matrix of coefficients. On exit, A is
+ overwritten by the updated matrix.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --x;
+ --y;
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+
+ /* Function Body */
+ info = 0;
+ if (*m < 0) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*incx == 0) {
+ info = 5;
+ } else if (*incy == 0) {
+ info = 7;
+ } else if (*lda < max(1,*m)) {
+ info = 9;
+ }
+ if (info != 0) {
+ xerbla_("ZGERU ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0 || (alpha->r == 0. && alpha->i == 0.)) {
+ return 0;
+ }
+
+/*
+ Start the operations. In this version the elements of A are
+ accessed sequentially with one pass through A.
+*/
+
+ if (*incy > 0) {
+ jy = 1;
+ } else {
+ jy = 1 - (*n - 1) * *incy;
+ }
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = jy;
+ if (y[i__2].r != 0. || y[i__2].i != 0.) {
+ i__2 = jy;
+ z__1.r = alpha->r * y[i__2].r - alpha->i * y[i__2].i, z__1.i =
+ alpha->r * y[i__2].i + alpha->i * y[i__2].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ i__4 = i__ + j * a_dim1;
+ i__5 = i__;
+ z__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, z__2.i =
+ x[i__5].r * temp.i + x[i__5].i * temp.r;
+ z__1.r = a[i__4].r + z__2.r, z__1.i = a[i__4].i + z__2.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+/* L10: */
+ }
+ }
+ jy += *incy;
+/* L20: */
+ }
+ } else {
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (*m - 1) * *incx;
+ }
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = jy;
+ if (y[i__2].r != 0. || y[i__2].i != 0.) {
+ i__2 = jy;
+ z__1.r = alpha->r * y[i__2].r - alpha->i * y[i__2].i, z__1.i =
+ alpha->r * y[i__2].i + alpha->i * y[i__2].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ ix = kx;
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ i__4 = i__ + j * a_dim1;
+ i__5 = ix;
+ z__2.r = x[i__5].r * temp.r - x[i__5].i * temp.i, z__2.i =
+ x[i__5].r * temp.i + x[i__5].i * temp.r;
+ z__1.r = a[i__4].r + z__2.r, z__1.i = a[i__4].i + z__2.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+ ix += *incx;
+/* L30: */
+ }
+ }
+ jy += *incy;
+/* L40: */
+ }
+ }
+
+ return 0;
+
+/* End of ZGERU . */
+
+} /* zgeru_ */
+
+/* Subroutine */ int zhemv_(char *uplo, integer *n, doublecomplex *alpha,
+ doublecomplex *a, integer *lda, doublecomplex *x, integer *incx,
+ doublecomplex *beta, doublecomplex *y, integer *incy)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
+ doublereal d__1;
+ doublecomplex z__1, z__2, z__3, z__4;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, j, ix, iy, jx, jy, kx, ky, info;
+ static doublecomplex temp1, temp2;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/*
+ Purpose
+ =======
+
+ ZHEMV performs the matrix-vector operation
+
+ y := alpha*A*x + beta*y,
+
+ where alpha and beta are scalars, x and y are n element vectors and
+ A is an n by n hermitian matrix.
+
+ Parameters
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array A is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of A
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of A
+ is to be referenced.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - COMPLEX*16 .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - COMPLEX*16 array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+ triangular part of the hermitian matrix and the strictly
+ lower triangular part of A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+ triangular part of the hermitian matrix and the strictly
+ upper triangular part of A is not referenced.
+ Note that the imaginary parts of the diagonal elements need
+ not be set and are assumed to be zero.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+ X - COMPLEX*16 array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ BETA - COMPLEX*16 .
+ On entry, BETA specifies the scalar beta. When BETA is
+ supplied as zero then Y need not be set on input.
+ Unchanged on exit.
+
+ Y - COMPLEX*16 array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y. On exit, Y is overwritten by the updated
+ vector y.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --x;
+ --y;
+
+ /* Function Body */
+ info = 0;
+ if ((! lsame_(uplo, "U") && ! lsame_(uplo, "L"))) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*lda < max(1,*n)) {
+ info = 5;
+ } else if (*incx == 0) {
+ info = 7;
+ } else if (*incy == 0) {
+ info = 10;
+ }
+ if (info != 0) {
+ xerbla_("ZHEMV ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0 || ((alpha->r == 0. && alpha->i == 0.) && ((beta->r == 1. &&
+ beta->i == 0.)))) {
+ return 0;
+ }
+
+/* Set up the start points in X and Y. */
+
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (*n - 1) * *incx;
+ }
+ if (*incy > 0) {
+ ky = 1;
+ } else {
+ ky = 1 - (*n - 1) * *incy;
+ }
+
+/*
+ Start the operations. In this version the elements of A are
+ accessed sequentially with one pass through the triangular part
+ of A.
+
+ First form y := beta*y.
+*/
+
+ if (beta->r != 1. || beta->i != 0.) {
+ if (*incy == 1) {
+ if ((beta->r == 0. && beta->i == 0.)) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ y[i__2].r = 0., y[i__2].i = 0.;
+/* L10: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ i__3 = i__;
+ z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,
+ z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
+ .r;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+/* L20: */
+ }
+ }
+ } else {
+ iy = ky;
+ if ((beta->r == 0. && beta->i == 0.)) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = iy;
+ y[i__2].r = 0., y[i__2].i = 0.;
+ iy += *incy;
+/* L30: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = iy;
+ i__3 = iy;
+ z__1.r = beta->r * y[i__3].r - beta->i * y[i__3].i,
+ z__1.i = beta->r * y[i__3].i + beta->i * y[i__3]
+ .r;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+ iy += *incy;
+/* L40: */
+ }
+ }
+ }
+ }
+ if ((alpha->r == 0. && alpha->i == 0.)) {
+ return 0;
+ }
+ if (lsame_(uplo, "U")) {
+
+/* Form y when A is stored in upper triangle. */
+
+ if ((*incx == 1 && *incy == 1)) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =
+ alpha->r * x[i__2].i + alpha->i * x[i__2].r;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ temp2.r = 0., temp2.i = 0.;
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__;
+ i__4 = i__;
+ i__5 = i__ + j * a_dim1;
+ z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,
+ z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
+ .r;
+ z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
+ y[i__3].r = z__1.r, y[i__3].i = z__1.i;
+ d_cnjg(&z__3, &a[i__ + j * a_dim1]);
+ i__3 = i__;
+ z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
+ z__3.r * x[i__3].i + z__3.i * x[i__3].r;
+ z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
+ temp2.r = z__1.r, temp2.i = z__1.i;
+/* L50: */
+ }
+ i__2 = j;
+ i__3 = j;
+ i__4 = j + j * a_dim1;
+ d__1 = a[i__4].r;
+ z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i;
+ z__2.r = y[i__3].r + z__3.r, z__2.i = y[i__3].i + z__3.i;
+ z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i =
+ alpha->r * temp2.i + alpha->i * temp2.r;
+ z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+/* L60: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = jx;
+ z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =
+ alpha->r * x[i__2].i + alpha->i * x[i__2].r;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ temp2.r = 0., temp2.i = 0.;
+ ix = kx;
+ iy = ky;
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = iy;
+ i__4 = iy;
+ i__5 = i__ + j * a_dim1;
+ z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,
+ z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
+ .r;
+ z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
+ y[i__3].r = z__1.r, y[i__3].i = z__1.i;
+ d_cnjg(&z__3, &a[i__ + j * a_dim1]);
+ i__3 = ix;
+ z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
+ z__3.r * x[i__3].i + z__3.i * x[i__3].r;
+ z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
+ temp2.r = z__1.r, temp2.i = z__1.i;
+ ix += *incx;
+ iy += *incy;
+/* L70: */
+ }
+ i__2 = jy;
+ i__3 = jy;
+ i__4 = j + j * a_dim1;
+ d__1 = a[i__4].r;
+ z__3.r = d__1 * temp1.r, z__3.i = d__1 * temp1.i;
+ z__2.r = y[i__3].r + z__3.r, z__2.i = y[i__3].i + z__3.i;
+ z__4.r = alpha->r * temp2.r - alpha->i * temp2.i, z__4.i =
+ alpha->r * temp2.i + alpha->i * temp2.r;
+ z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+ jx += *incx;
+ jy += *incy;
+/* L80: */
+ }
+ }
+ } else {
+
+/* Form y when A is stored in lower triangle. */
+
+ if ((*incx == 1 && *incy == 1)) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =
+ alpha->r * x[i__2].i + alpha->i * x[i__2].r;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ temp2.r = 0., temp2.i = 0.;
+ i__2 = j;
+ i__3 = j;
+ i__4 = j + j * a_dim1;
+ d__1 = a[i__4].r;
+ z__2.r = d__1 * temp1.r, z__2.i = d__1 * temp1.i;
+ z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ i__3 = i__;
+ i__4 = i__;
+ i__5 = i__ + j * a_dim1;
+ z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,
+ z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
+ .r;
+ z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
+ y[i__3].r = z__1.r, y[i__3].i = z__1.i;
+ d_cnjg(&z__3, &a[i__ + j * a_dim1]);
+ i__3 = i__;
+ z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
+ z__3.r * x[i__3].i + z__3.i * x[i__3].r;
+ z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
+ temp2.r = z__1.r, temp2.i = z__1.i;
+/* L90: */
+ }
+ i__2 = j;
+ i__3 = j;
+ z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i =
+ alpha->r * temp2.i + alpha->i * temp2.r;
+ z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+/* L100: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = jx;
+ z__1.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i, z__1.i =
+ alpha->r * x[i__2].i + alpha->i * x[i__2].r;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ temp2.r = 0., temp2.i = 0.;
+ i__2 = jy;
+ i__3 = jy;
+ i__4 = j + j * a_dim1;
+ d__1 = a[i__4].r;
+ z__2.r = d__1 * temp1.r, z__2.i = d__1 * temp1.i;
+ z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+ ix = jx;
+ iy = jy;
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ ix += *incx;
+ iy += *incy;
+ i__3 = iy;
+ i__4 = iy;
+ i__5 = i__ + j * a_dim1;
+ z__2.r = temp1.r * a[i__5].r - temp1.i * a[i__5].i,
+ z__2.i = temp1.r * a[i__5].i + temp1.i * a[i__5]
+ .r;
+ z__1.r = y[i__4].r + z__2.r, z__1.i = y[i__4].i + z__2.i;
+ y[i__3].r = z__1.r, y[i__3].i = z__1.i;
+ d_cnjg(&z__3, &a[i__ + j * a_dim1]);
+ i__3 = ix;
+ z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i, z__2.i =
+ z__3.r * x[i__3].i + z__3.i * x[i__3].r;
+ z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
+ temp2.r = z__1.r, temp2.i = z__1.i;
+/* L110: */
+ }
+ i__2 = jy;
+ i__3 = jy;
+ z__2.r = alpha->r * temp2.r - alpha->i * temp2.i, z__2.i =
+ alpha->r * temp2.i + alpha->i * temp2.r;
+ z__1.r = y[i__3].r + z__2.r, z__1.i = y[i__3].i + z__2.i;
+ y[i__2].r = z__1.r, y[i__2].i = z__1.i;
+ jx += *incx;
+ jy += *incy;
+/* L120: */
+ }
+ }
+ }
+
+ return 0;
+
+/* End of ZHEMV . */
+
+} /* zhemv_ */
+
+/* Subroutine */ int zher2_(char *uplo, integer *n, doublecomplex *alpha,
+ doublecomplex *x, integer *incx, doublecomplex *y, integer *incy,
+ doublecomplex *a, integer *lda)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6;
+ doublereal d__1;
+ doublecomplex z__1, z__2, z__3, z__4;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, j, ix, iy, jx, jy, kx, ky, info;
+ static doublecomplex temp1, temp2;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/*
+ Purpose
+ =======
+
+ ZHER2 performs the hermitian rank 2 operation
+
+ A := alpha*x*conjg( y' ) + conjg( alpha )*y*conjg( x' ) + A,
+
+ where alpha is a scalar, x and y are n element vectors and A is an n
+ by n hermitian matrix.
+
+ Parameters
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array A is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of A
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of A
+ is to be referenced.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - COMPLEX*16 .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ X - COMPLEX*16 array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x.
+ Unchanged on exit.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+ Y - COMPLEX*16 array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCY ) ).
+ Before entry, the incremented array Y must contain the n
+ element vector y.
+ Unchanged on exit.
+
+ INCY - INTEGER.
+ On entry, INCY specifies the increment for the elements of
+ Y. INCY must not be zero.
+ Unchanged on exit.
+
+ A - COMPLEX*16 array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+ triangular part of the hermitian matrix and the strictly
+ lower triangular part of A is not referenced. On exit, the
+ upper triangular part of the array A is overwritten by the
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+ triangular part of the hermitian matrix and the strictly
+ upper triangular part of A is not referenced. On exit, the
+ lower triangular part of the array A is overwritten by the
+ lower triangular part of the updated matrix.
+ Note that the imaginary parts of the diagonal elements need
+ not be set, they are assumed to be zero, and on exit they
+ are set to zero.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --x;
+ --y;
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+
+ /* Function Body */
+ info = 0;
+ if ((! lsame_(uplo, "U") && ! lsame_(uplo, "L"))) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*incx == 0) {
+ info = 5;
+ } else if (*incy == 0) {
+ info = 7;
+ } else if (*lda < max(1,*n)) {
+ info = 9;
+ }
+ if (info != 0) {
+ xerbla_("ZHER2 ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0 || (alpha->r == 0. && alpha->i == 0.)) {
+ return 0;
+ }
+
+/*
+ Set up the start points in X and Y if the increments are not both
+ unity.
+*/
+
+ if (*incx != 1 || *incy != 1) {
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (*n - 1) * *incx;
+ }
+ if (*incy > 0) {
+ ky = 1;
+ } else {
+ ky = 1 - (*n - 1) * *incy;
+ }
+ jx = kx;
+ jy = ky;
+ }
+
+/*
+ Start the operations. In this version the elements of A are
+ accessed sequentially with one pass through the triangular part
+ of A.
+*/
+
+ if (lsame_(uplo, "U")) {
+
+/* Form A when A is stored in the upper triangle. */
+
+ if ((*incx == 1 && *incy == 1)) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ i__3 = j;
+ if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. ||
+ y[i__3].i != 0.)) {
+ d_cnjg(&z__2, &y[j]);
+ z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
+ alpha->r * z__2.i + alpha->i * z__2.r;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ i__2 = j;
+ z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,
+ z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
+ .r;
+ d_cnjg(&z__1, &z__2);
+ temp2.r = z__1.r, temp2.i = z__1.i;
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ i__4 = i__ + j * a_dim1;
+ i__5 = i__;
+ z__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i,
+ z__3.i = x[i__5].r * temp1.i + x[i__5].i *
+ temp1.r;
+ z__2.r = a[i__4].r + z__3.r, z__2.i = a[i__4].i +
+ z__3.i;
+ i__6 = i__;
+ z__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i,
+ z__4.i = y[i__6].r * temp2.i + y[i__6].i *
+ temp2.r;
+ z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+/* L10: */
+ }
+ i__2 = j + j * a_dim1;
+ i__3 = j + j * a_dim1;
+ i__4 = j;
+ z__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i,
+ z__2.i = x[i__4].r * temp1.i + x[i__4].i *
+ temp1.r;
+ i__5 = j;
+ z__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i,
+ z__3.i = y[i__5].r * temp2.i + y[i__5].i *
+ temp2.r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ d__1 = a[i__3].r + z__1.r;
+ a[i__2].r = d__1, a[i__2].i = 0.;
+ } else {
+ i__2 = j + j * a_dim1;
+ i__3 = j + j * a_dim1;
+ d__1 = a[i__3].r;
+ a[i__2].r = d__1, a[i__2].i = 0.;
+ }
+/* L20: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = jx;
+ i__3 = jy;
+ if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. ||
+ y[i__3].i != 0.)) {
+ d_cnjg(&z__2, &y[jy]);
+ z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
+ alpha->r * z__2.i + alpha->i * z__2.r;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ i__2 = jx;
+ z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,
+ z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
+ .r;
+ d_cnjg(&z__1, &z__2);
+ temp2.r = z__1.r, temp2.i = z__1.i;
+ ix = kx;
+ iy = ky;
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ i__4 = i__ + j * a_dim1;
+ i__5 = ix;
+ z__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i,
+ z__3.i = x[i__5].r * temp1.i + x[i__5].i *
+ temp1.r;
+ z__2.r = a[i__4].r + z__3.r, z__2.i = a[i__4].i +
+ z__3.i;
+ i__6 = iy;
+ z__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i,
+ z__4.i = y[i__6].r * temp2.i + y[i__6].i *
+ temp2.r;
+ z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+ ix += *incx;
+ iy += *incy;
+/* L30: */
+ }
+ i__2 = j + j * a_dim1;
+ i__3 = j + j * a_dim1;
+ i__4 = jx;
+ z__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i,
+ z__2.i = x[i__4].r * temp1.i + x[i__4].i *
+ temp1.r;
+ i__5 = jy;
+ z__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i,
+ z__3.i = y[i__5].r * temp2.i + y[i__5].i *
+ temp2.r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ d__1 = a[i__3].r + z__1.r;
+ a[i__2].r = d__1, a[i__2].i = 0.;
+ } else {
+ i__2 = j + j * a_dim1;
+ i__3 = j + j * a_dim1;
+ d__1 = a[i__3].r;
+ a[i__2].r = d__1, a[i__2].i = 0.;
+ }
+ jx += *incx;
+ jy += *incy;
+/* L40: */
+ }
+ }
+ } else {
+
+/* Form A when A is stored in the lower triangle. */
+
+ if ((*incx == 1 && *incy == 1)) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ i__3 = j;
+ if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. ||
+ y[i__3].i != 0.)) {
+ d_cnjg(&z__2, &y[j]);
+ z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
+ alpha->r * z__2.i + alpha->i * z__2.r;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ i__2 = j;
+ z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,
+ z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
+ .r;
+ d_cnjg(&z__1, &z__2);
+ temp2.r = z__1.r, temp2.i = z__1.i;
+ i__2 = j + j * a_dim1;
+ i__3 = j + j * a_dim1;
+ i__4 = j;
+ z__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i,
+ z__2.i = x[i__4].r * temp1.i + x[i__4].i *
+ temp1.r;
+ i__5 = j;
+ z__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i,
+ z__3.i = y[i__5].r * temp2.i + y[i__5].i *
+ temp2.r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ d__1 = a[i__3].r + z__1.r;
+ a[i__2].r = d__1, a[i__2].i = 0.;
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ i__4 = i__ + j * a_dim1;
+ i__5 = i__;
+ z__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i,
+ z__3.i = x[i__5].r * temp1.i + x[i__5].i *
+ temp1.r;
+ z__2.r = a[i__4].r + z__3.r, z__2.i = a[i__4].i +
+ z__3.i;
+ i__6 = i__;
+ z__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i,
+ z__4.i = y[i__6].r * temp2.i + y[i__6].i *
+ temp2.r;
+ z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+/* L50: */
+ }
+ } else {
+ i__2 = j + j * a_dim1;
+ i__3 = j + j * a_dim1;
+ d__1 = a[i__3].r;
+ a[i__2].r = d__1, a[i__2].i = 0.;
+ }
+/* L60: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = jx;
+ i__3 = jy;
+ if (x[i__2].r != 0. || x[i__2].i != 0. || (y[i__3].r != 0. ||
+ y[i__3].i != 0.)) {
+ d_cnjg(&z__2, &y[jy]);
+ z__1.r = alpha->r * z__2.r - alpha->i * z__2.i, z__1.i =
+ alpha->r * z__2.i + alpha->i * z__2.r;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ i__2 = jx;
+ z__2.r = alpha->r * x[i__2].r - alpha->i * x[i__2].i,
+ z__2.i = alpha->r * x[i__2].i + alpha->i * x[i__2]
+ .r;
+ d_cnjg(&z__1, &z__2);
+ temp2.r = z__1.r, temp2.i = z__1.i;
+ i__2 = j + j * a_dim1;
+ i__3 = j + j * a_dim1;
+ i__4 = jx;
+ z__2.r = x[i__4].r * temp1.r - x[i__4].i * temp1.i,
+ z__2.i = x[i__4].r * temp1.i + x[i__4].i *
+ temp1.r;
+ i__5 = jy;
+ z__3.r = y[i__5].r * temp2.r - y[i__5].i * temp2.i,
+ z__3.i = y[i__5].r * temp2.i + y[i__5].i *
+ temp2.r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ d__1 = a[i__3].r + z__1.r;
+ a[i__2].r = d__1, a[i__2].i = 0.;
+ ix = jx;
+ iy = jy;
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ ix += *incx;
+ iy += *incy;
+ i__3 = i__ + j * a_dim1;
+ i__4 = i__ + j * a_dim1;
+ i__5 = ix;
+ z__3.r = x[i__5].r * temp1.r - x[i__5].i * temp1.i,
+ z__3.i = x[i__5].r * temp1.i + x[i__5].i *
+ temp1.r;
+ z__2.r = a[i__4].r + z__3.r, z__2.i = a[i__4].i +
+ z__3.i;
+ i__6 = iy;
+ z__4.r = y[i__6].r * temp2.r - y[i__6].i * temp2.i,
+ z__4.i = y[i__6].r * temp2.i + y[i__6].i *
+ temp2.r;
+ z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+/* L70: */
+ }
+ } else {
+ i__2 = j + j * a_dim1;
+ i__3 = j + j * a_dim1;
+ d__1 = a[i__3].r;
+ a[i__2].r = d__1, a[i__2].i = 0.;
+ }
+ jx += *incx;
+ jy += *incy;
+/* L80: */
+ }
+ }
+ }
+
+ return 0;
+
+/* End of ZHER2 . */
+
+} /* zher2_ */
+
+/* Subroutine */ int zher2k_(char *uplo, char *trans, integer *n, integer *k,
+ doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *
+ b, integer *ldb, doublereal *beta, doublecomplex *c__, integer *ldc)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
+ i__3, i__4, i__5, i__6, i__7;
+ doublereal d__1;
+ doublecomplex z__1, z__2, z__3, z__4, z__5, z__6;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, j, l, info;
+ static doublecomplex temp1, temp2;
+ extern logical lsame_(char *, char *);
+ static integer nrowa;
+ static logical upper;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/*
+ Purpose
+ =======
+
+ ZHER2K performs one of the hermitian rank 2k operations
+
+ C := alpha*A*conjg( B' ) + conjg( alpha )*B*conjg( A' ) + beta*C,
+
+ or
+
+ C := alpha*conjg( A' )*B + conjg( alpha )*conjg( B' )*A + beta*C,
+
+ where alpha and beta are scalars with beta real, C is an n by n
+ hermitian matrix and A and B are n by k matrices in the first case
+ and k by n matrices in the second case.
+
+ Parameters
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array C is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of C
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of C
+ is to be referenced.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' C := alpha*A*conjg( B' ) +
+ conjg( alpha )*B*conjg( A' ) +
+ beta*C.
+
+ TRANS = 'C' or 'c' C := alpha*conjg( A' )*B +
+ conjg( alpha )*conjg( B' )*A +
+ beta*C.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix C. N must be
+ at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with TRANS = 'N' or 'n', K specifies the number
+ of columns of the matrices A and B, and on entry with
+ TRANS = 'C' or 'c', K specifies the number of rows of the
+ matrices A and B. K must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - COMPLEX*16 .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is
+ k when TRANS = 'N' or 'n', and is n otherwise.
+ Before entry with TRANS = 'N' or 'n', the leading n by k
+ part of the array A must contain the matrix A, otherwise
+ the leading k by n part of the array A must contain the
+ matrix A.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When TRANS = 'N' or 'n'
+ then LDA must be at least max( 1, n ), otherwise LDA must
+ be at least max( 1, k ).
+ Unchanged on exit.
+
+ B - COMPLEX*16 array of DIMENSION ( LDB, kb ), where kb is
+ k when TRANS = 'N' or 'n', and is n otherwise.
+ Before entry with TRANS = 'N' or 'n', the leading n by k
+ part of the array B must contain the matrix B, otherwise
+ the leading k by n part of the array B must contain the
+ matrix B.
+ Unchanged on exit.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. When TRANS = 'N' or 'n'
+ then LDB must be at least max( 1, n ), otherwise LDB must
+ be at least max( 1, k ).
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION .
+ On entry, BETA specifies the scalar beta.
+ Unchanged on exit.
+
+ C - COMPLEX*16 array of DIMENSION ( LDC, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array C must contain the upper
+ triangular part of the hermitian matrix and the strictly
+ lower triangular part of C is not referenced. On exit, the
+ upper triangular part of the array C is overwritten by the
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array C must contain the lower
+ triangular part of the hermitian matrix and the strictly
+ upper triangular part of C is not referenced. On exit, the
+ lower triangular part of the array C is overwritten by the
+ lower triangular part of the updated matrix.
+ Note that the imaginary parts of the diagonal elements need
+ not be set, they are assumed to be zero, and on exit they
+ are set to zero.
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+ -- Modified 8-Nov-93 to set C(J,J) to DBLE( C(J,J) ) when BETA = 1.
+ Ed Anderson, Cray Research Inc.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+
+ /* Function Body */
+ if (lsame_(trans, "N")) {
+ nrowa = *n;
+ } else {
+ nrowa = *k;
+ }
+ upper = lsame_(uplo, "U");
+
+ info = 0;
+ if ((! upper && ! lsame_(uplo, "L"))) {
+ info = 1;
+ } else if ((! lsame_(trans, "N") && ! lsame_(trans,
+ "C"))) {
+ info = 2;
+ } else if (*n < 0) {
+ info = 3;
+ } else if (*k < 0) {
+ info = 4;
+ } else if (*lda < max(1,nrowa)) {
+ info = 7;
+ } else if (*ldb < max(1,nrowa)) {
+ info = 9;
+ } else if (*ldc < max(1,*n)) {
+ info = 12;
+ }
+ if (info != 0) {
+ xerbla_("ZHER2K", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0 || (((alpha->r == 0. && alpha->i == 0.) || *k == 0) && *beta
+ == 1.)) {
+ return 0;
+ }
+
+/* And when alpha.eq.zero. */
+
+ if ((alpha->r == 0. && alpha->i == 0.)) {
+ if (upper) {
+ if (*beta == 0.) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ c__[i__3].r = 0., c__[i__3].i = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ i__4 = i__ + j * c_dim1;
+ z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
+ i__4].i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L30: */
+ }
+ i__2 = j + j * c_dim1;
+ i__3 = j + j * c_dim1;
+ d__1 = *beta * c__[i__3].r;
+ c__[i__2].r = d__1, c__[i__2].i = 0.;
+/* L40: */
+ }
+ }
+ } else {
+ if (*beta == 0.) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ c__[i__3].r = 0., c__[i__3].i = 0.;
+/* L50: */
+ }
+/* L60: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j + j * c_dim1;
+ i__3 = j + j * c_dim1;
+ d__1 = *beta * c__[i__3].r;
+ c__[i__2].r = d__1, c__[i__2].i = 0.;
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ i__4 = i__ + j * c_dim1;
+ z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
+ i__4].i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L70: */
+ }
+/* L80: */
+ }
+ }
+ }
+ return 0;
+ }
+
+/* Start the operations. */
+
+ if (lsame_(trans, "N")) {
+
+/*
+ Form C := alpha*A*conjg( B' ) + conjg( alpha )*B*conjg( A' ) +
+ C.
+*/
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*beta == 0.) {
+ i__2 = j;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ c__[i__3].r = 0., c__[i__3].i = 0.;
+/* L90: */
+ }
+ } else if (*beta != 1.) {
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ i__4 = i__ + j * c_dim1;
+ z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
+ i__4].i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L100: */
+ }
+ i__2 = j + j * c_dim1;
+ i__3 = j + j * c_dim1;
+ d__1 = *beta * c__[i__3].r;
+ c__[i__2].r = d__1, c__[i__2].i = 0.;
+ } else {
+ i__2 = j + j * c_dim1;
+ i__3 = j + j * c_dim1;
+ d__1 = c__[i__3].r;
+ c__[i__2].r = d__1, c__[i__2].i = 0.;
+ }
+ i__2 = *k;
+ for (l = 1; l <= i__2; ++l) {
+ i__3 = j + l * a_dim1;
+ i__4 = j + l * b_dim1;
+ if (a[i__3].r != 0. || a[i__3].i != 0. || (b[i__4].r !=
+ 0. || b[i__4].i != 0.)) {
+ d_cnjg(&z__2, &b[j + l * b_dim1]);
+ z__1.r = alpha->r * z__2.r - alpha->i * z__2.i,
+ z__1.i = alpha->r * z__2.i + alpha->i *
+ z__2.r;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ i__3 = j + l * a_dim1;
+ z__2.r = alpha->r * a[i__3].r - alpha->i * a[i__3].i,
+ z__2.i = alpha->r * a[i__3].i + alpha->i * a[
+ i__3].r;
+ d_cnjg(&z__1, &z__2);
+ temp2.r = z__1.r, temp2.i = z__1.i;
+ i__3 = j - 1;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ i__4 = i__ + j * c_dim1;
+ i__5 = i__ + j * c_dim1;
+ i__6 = i__ + l * a_dim1;
+ z__3.r = a[i__6].r * temp1.r - a[i__6].i *
+ temp1.i, z__3.i = a[i__6].r * temp1.i + a[
+ i__6].i * temp1.r;
+ z__2.r = c__[i__5].r + z__3.r, z__2.i = c__[i__5]
+ .i + z__3.i;
+ i__7 = i__ + l * b_dim1;
+ z__4.r = b[i__7].r * temp2.r - b[i__7].i *
+ temp2.i, z__4.i = b[i__7].r * temp2.i + b[
+ i__7].i * temp2.r;
+ z__1.r = z__2.r + z__4.r, z__1.i = z__2.i +
+ z__4.i;
+ c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
+/* L110: */
+ }
+ i__3 = j + j * c_dim1;
+ i__4 = j + j * c_dim1;
+ i__5 = j + l * a_dim1;
+ z__2.r = a[i__5].r * temp1.r - a[i__5].i * temp1.i,
+ z__2.i = a[i__5].r * temp1.i + a[i__5].i *
+ temp1.r;
+ i__6 = j + l * b_dim1;
+ z__3.r = b[i__6].r * temp2.r - b[i__6].i * temp2.i,
+ z__3.i = b[i__6].r * temp2.i + b[i__6].i *
+ temp2.r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ d__1 = c__[i__4].r + z__1.r;
+ c__[i__3].r = d__1, c__[i__3].i = 0.;
+ }
+/* L120: */
+ }
+/* L130: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*beta == 0.) {
+ i__2 = *n;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ c__[i__3].r = 0., c__[i__3].i = 0.;
+/* L140: */
+ }
+ } else if (*beta != 1.) {
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ i__4 = i__ + j * c_dim1;
+ z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
+ i__4].i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L150: */
+ }
+ i__2 = j + j * c_dim1;
+ i__3 = j + j * c_dim1;
+ d__1 = *beta * c__[i__3].r;
+ c__[i__2].r = d__1, c__[i__2].i = 0.;
+ } else {
+ i__2 = j + j * c_dim1;
+ i__3 = j + j * c_dim1;
+ d__1 = c__[i__3].r;
+ c__[i__2].r = d__1, c__[i__2].i = 0.;
+ }
+ i__2 = *k;
+ for (l = 1; l <= i__2; ++l) {
+ i__3 = j + l * a_dim1;
+ i__4 = j + l * b_dim1;
+ if (a[i__3].r != 0. || a[i__3].i != 0. || (b[i__4].r !=
+ 0. || b[i__4].i != 0.)) {
+ d_cnjg(&z__2, &b[j + l * b_dim1]);
+ z__1.r = alpha->r * z__2.r - alpha->i * z__2.i,
+ z__1.i = alpha->r * z__2.i + alpha->i *
+ z__2.r;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ i__3 = j + l * a_dim1;
+ z__2.r = alpha->r * a[i__3].r - alpha->i * a[i__3].i,
+ z__2.i = alpha->r * a[i__3].i + alpha->i * a[
+ i__3].r;
+ d_cnjg(&z__1, &z__2);
+ temp2.r = z__1.r, temp2.i = z__1.i;
+ i__3 = *n;
+ for (i__ = j + 1; i__ <= i__3; ++i__) {
+ i__4 = i__ + j * c_dim1;
+ i__5 = i__ + j * c_dim1;
+ i__6 = i__ + l * a_dim1;
+ z__3.r = a[i__6].r * temp1.r - a[i__6].i *
+ temp1.i, z__3.i = a[i__6].r * temp1.i + a[
+ i__6].i * temp1.r;
+ z__2.r = c__[i__5].r + z__3.r, z__2.i = c__[i__5]
+ .i + z__3.i;
+ i__7 = i__ + l * b_dim1;
+ z__4.r = b[i__7].r * temp2.r - b[i__7].i *
+ temp2.i, z__4.i = b[i__7].r * temp2.i + b[
+ i__7].i * temp2.r;
+ z__1.r = z__2.r + z__4.r, z__1.i = z__2.i +
+ z__4.i;
+ c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
+/* L160: */
+ }
+ i__3 = j + j * c_dim1;
+ i__4 = j + j * c_dim1;
+ i__5 = j + l * a_dim1;
+ z__2.r = a[i__5].r * temp1.r - a[i__5].i * temp1.i,
+ z__2.i = a[i__5].r * temp1.i + a[i__5].i *
+ temp1.r;
+ i__6 = j + l * b_dim1;
+ z__3.r = b[i__6].r * temp2.r - b[i__6].i * temp2.i,
+ z__3.i = b[i__6].r * temp2.i + b[i__6].i *
+ temp2.r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ d__1 = c__[i__4].r + z__1.r;
+ c__[i__3].r = d__1, c__[i__3].i = 0.;
+ }
+/* L170: */
+ }
+/* L180: */
+ }
+ }
+ } else {
+
+/*
+ Form C := alpha*conjg( A' )*B + conjg( alpha )*conjg( B' )*A +
+ C.
+*/
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp1.r = 0., temp1.i = 0.;
+ temp2.r = 0., temp2.i = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ d_cnjg(&z__3, &a[l + i__ * a_dim1]);
+ i__4 = l + j * b_dim1;
+ z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i,
+ z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]
+ .r;
+ z__1.r = temp1.r + z__2.r, z__1.i = temp1.i + z__2.i;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ d_cnjg(&z__3, &b[l + i__ * b_dim1]);
+ i__4 = l + j * a_dim1;
+ z__2.r = z__3.r * a[i__4].r - z__3.i * a[i__4].i,
+ z__2.i = z__3.r * a[i__4].i + z__3.i * a[i__4]
+ .r;
+ z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
+ temp2.r = z__1.r, temp2.i = z__1.i;
+/* L190: */
+ }
+ if (i__ == j) {
+ if (*beta == 0.) {
+ i__3 = j + j * c_dim1;
+ z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,
+ z__2.i = alpha->r * temp1.i + alpha->i *
+ temp1.r;
+ d_cnjg(&z__4, alpha);
+ z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,
+ z__3.i = z__4.r * temp2.i + z__4.i *
+ temp2.r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
+ z__3.i;
+ d__1 = z__1.r;
+ c__[i__3].r = d__1, c__[i__3].i = 0.;
+ } else {
+ i__3 = j + j * c_dim1;
+ i__4 = j + j * c_dim1;
+ z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,
+ z__2.i = alpha->r * temp1.i + alpha->i *
+ temp1.r;
+ d_cnjg(&z__4, alpha);
+ z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,
+ z__3.i = z__4.r * temp2.i + z__4.i *
+ temp2.r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
+ z__3.i;
+ d__1 = *beta * c__[i__4].r + z__1.r;
+ c__[i__3].r = d__1, c__[i__3].i = 0.;
+ }
+ } else {
+ if (*beta == 0.) {
+ i__3 = i__ + j * c_dim1;
+ z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,
+ z__2.i = alpha->r * temp1.i + alpha->i *
+ temp1.r;
+ d_cnjg(&z__4, alpha);
+ z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,
+ z__3.i = z__4.r * temp2.i + z__4.i *
+ temp2.r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
+ z__3.i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ } else {
+ i__3 = i__ + j * c_dim1;
+ i__4 = i__ + j * c_dim1;
+ z__3.r = *beta * c__[i__4].r, z__3.i = *beta *
+ c__[i__4].i;
+ z__4.r = alpha->r * temp1.r - alpha->i * temp1.i,
+ z__4.i = alpha->r * temp1.i + alpha->i *
+ temp1.r;
+ z__2.r = z__3.r + z__4.r, z__2.i = z__3.i +
+ z__4.i;
+ d_cnjg(&z__6, alpha);
+ z__5.r = z__6.r * temp2.r - z__6.i * temp2.i,
+ z__5.i = z__6.r * temp2.i + z__6.i *
+ temp2.r;
+ z__1.r = z__2.r + z__5.r, z__1.i = z__2.i +
+ z__5.i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ }
+ }
+/* L200: */
+ }
+/* L210: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ temp1.r = 0., temp1.i = 0.;
+ temp2.r = 0., temp2.i = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ d_cnjg(&z__3, &a[l + i__ * a_dim1]);
+ i__4 = l + j * b_dim1;
+ z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4].i,
+ z__2.i = z__3.r * b[i__4].i + z__3.i * b[i__4]
+ .r;
+ z__1.r = temp1.r + z__2.r, z__1.i = temp1.i + z__2.i;
+ temp1.r = z__1.r, temp1.i = z__1.i;
+ d_cnjg(&z__3, &b[l + i__ * b_dim1]);
+ i__4 = l + j * a_dim1;
+ z__2.r = z__3.r * a[i__4].r - z__3.i * a[i__4].i,
+ z__2.i = z__3.r * a[i__4].i + z__3.i * a[i__4]
+ .r;
+ z__1.r = temp2.r + z__2.r, z__1.i = temp2.i + z__2.i;
+ temp2.r = z__1.r, temp2.i = z__1.i;
+/* L220: */
+ }
+ if (i__ == j) {
+ if (*beta == 0.) {
+ i__3 = j + j * c_dim1;
+ z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,
+ z__2.i = alpha->r * temp1.i + alpha->i *
+ temp1.r;
+ d_cnjg(&z__4, alpha);
+ z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,
+ z__3.i = z__4.r * temp2.i + z__4.i *
+ temp2.r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
+ z__3.i;
+ d__1 = z__1.r;
+ c__[i__3].r = d__1, c__[i__3].i = 0.;
+ } else {
+ i__3 = j + j * c_dim1;
+ i__4 = j + j * c_dim1;
+ z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,
+ z__2.i = alpha->r * temp1.i + alpha->i *
+ temp1.r;
+ d_cnjg(&z__4, alpha);
+ z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,
+ z__3.i = z__4.r * temp2.i + z__4.i *
+ temp2.r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
+ z__3.i;
+ d__1 = *beta * c__[i__4].r + z__1.r;
+ c__[i__3].r = d__1, c__[i__3].i = 0.;
+ }
+ } else {
+ if (*beta == 0.) {
+ i__3 = i__ + j * c_dim1;
+ z__2.r = alpha->r * temp1.r - alpha->i * temp1.i,
+ z__2.i = alpha->r * temp1.i + alpha->i *
+ temp1.r;
+ d_cnjg(&z__4, alpha);
+ z__3.r = z__4.r * temp2.r - z__4.i * temp2.i,
+ z__3.i = z__4.r * temp2.i + z__4.i *
+ temp2.r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
+ z__3.i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ } else {
+ i__3 = i__ + j * c_dim1;
+ i__4 = i__ + j * c_dim1;
+ z__3.r = *beta * c__[i__4].r, z__3.i = *beta *
+ c__[i__4].i;
+ z__4.r = alpha->r * temp1.r - alpha->i * temp1.i,
+ z__4.i = alpha->r * temp1.i + alpha->i *
+ temp1.r;
+ z__2.r = z__3.r + z__4.r, z__2.i = z__3.i +
+ z__4.i;
+ d_cnjg(&z__6, alpha);
+ z__5.r = z__6.r * temp2.r - z__6.i * temp2.i,
+ z__5.i = z__6.r * temp2.i + z__6.i *
+ temp2.r;
+ z__1.r = z__2.r + z__5.r, z__1.i = z__2.i +
+ z__5.i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ }
+ }
+/* L230: */
+ }
+/* L240: */
+ }
+ }
+ }
+
+ return 0;
+
+/* End of ZHER2K. */
+
+} /* zher2k_ */
+
+/* Subroutine */ int zherk_(char *uplo, char *trans, integer *n, integer *k,
+ doublereal *alpha, doublecomplex *a, integer *lda, doublereal *beta,
+ doublecomplex *c__, integer *ldc)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5,
+ i__6;
+ doublereal d__1;
+ doublecomplex z__1, z__2, z__3;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, j, l, info;
+ static doublecomplex temp;
+ extern logical lsame_(char *, char *);
+ static integer nrowa;
+ static doublereal rtemp;
+ static logical upper;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/*
+ Purpose
+ =======
+
+ ZHERK performs one of the hermitian rank k operations
+
+ C := alpha*A*conjg( A' ) + beta*C,
+
+ or
+
+ C := alpha*conjg( A' )*A + beta*C,
+
+ where alpha and beta are real scalars, C is an n by n hermitian
+ matrix and A is an n by k matrix in the first case and a k by n
+ matrix in the second case.
+
+ Parameters
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the upper or lower
+ triangular part of the array C is to be referenced as
+ follows:
+
+ UPLO = 'U' or 'u' Only the upper triangular part of C
+ is to be referenced.
+
+ UPLO = 'L' or 'l' Only the lower triangular part of C
+ is to be referenced.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' C := alpha*A*conjg( A' ) + beta*C.
+
+ TRANS = 'C' or 'c' C := alpha*conjg( A' )*A + beta*C.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix C. N must be
+ at least zero.
+ Unchanged on exit.
+
+ K - INTEGER.
+ On entry with TRANS = 'N' or 'n', K specifies the number
+ of columns of the matrix A, and on entry with
+ TRANS = 'C' or 'c', K specifies the number of rows of the
+ matrix A. K must be at least zero.
+ Unchanged on exit.
+
+ ALPHA - DOUBLE PRECISION .
+ On entry, ALPHA specifies the scalar alpha.
+ Unchanged on exit.
+
+ A - COMPLEX*16 array of DIMENSION ( LDA, ka ), where ka is
+ k when TRANS = 'N' or 'n', and is n otherwise.
+ Before entry with TRANS = 'N' or 'n', the leading n by k
+ part of the array A must contain the matrix A, otherwise
+ the leading k by n part of the array A must contain the
+ matrix A.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When TRANS = 'N' or 'n'
+ then LDA must be at least max( 1, n ), otherwise LDA must
+ be at least max( 1, k ).
+ Unchanged on exit.
+
+ BETA - DOUBLE PRECISION.
+ On entry, BETA specifies the scalar beta.
+ Unchanged on exit.
+
+ C - COMPLEX*16 array of DIMENSION ( LDC, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array C must contain the upper
+ triangular part of the hermitian matrix and the strictly
+ lower triangular part of C is not referenced. On exit, the
+ upper triangular part of the array C is overwritten by the
+ upper triangular part of the updated matrix.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array C must contain the lower
+ triangular part of the hermitian matrix and the strictly
+ upper triangular part of C is not referenced. On exit, the
+ lower triangular part of the array C is overwritten by the
+ lower triangular part of the updated matrix.
+ Note that the imaginary parts of the diagonal elements need
+ not be set, they are assumed to be zero, and on exit they
+ are set to zero.
+
+ LDC - INTEGER.
+ On entry, LDC specifies the first dimension of C as declared
+ in the calling (sub) program. LDC must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+ -- Modified 8-Nov-93 to set C(J,J) to DBLE( C(J,J) ) when BETA = 1.
+ Ed Anderson, Cray Research Inc.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+
+ /* Function Body */
+ if (lsame_(trans, "N")) {
+ nrowa = *n;
+ } else {
+ nrowa = *k;
+ }
+ upper = lsame_(uplo, "U");
+
+ info = 0;
+ if ((! upper && ! lsame_(uplo, "L"))) {
+ info = 1;
+ } else if ((! lsame_(trans, "N") && ! lsame_(trans,
+ "C"))) {
+ info = 2;
+ } else if (*n < 0) {
+ info = 3;
+ } else if (*k < 0) {
+ info = 4;
+ } else if (*lda < max(1,nrowa)) {
+ info = 7;
+ } else if (*ldc < max(1,*n)) {
+ info = 10;
+ }
+ if (info != 0) {
+ xerbla_("ZHERK ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0 || ((*alpha == 0. || *k == 0) && *beta == 1.)) {
+ return 0;
+ }
+
+/* And when alpha.eq.zero. */
+
+ if (*alpha == 0.) {
+ if (upper) {
+ if (*beta == 0.) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ c__[i__3].r = 0., c__[i__3].i = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ i__4 = i__ + j * c_dim1;
+ z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
+ i__4].i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L30: */
+ }
+ i__2 = j + j * c_dim1;
+ i__3 = j + j * c_dim1;
+ d__1 = *beta * c__[i__3].r;
+ c__[i__2].r = d__1, c__[i__2].i = 0.;
+/* L40: */
+ }
+ }
+ } else {
+ if (*beta == 0.) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ c__[i__3].r = 0., c__[i__3].i = 0.;
+/* L50: */
+ }
+/* L60: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j + j * c_dim1;
+ i__3 = j + j * c_dim1;
+ d__1 = *beta * c__[i__3].r;
+ c__[i__2].r = d__1, c__[i__2].i = 0.;
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ i__4 = i__ + j * c_dim1;
+ z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
+ i__4].i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L70: */
+ }
+/* L80: */
+ }
+ }
+ }
+ return 0;
+ }
+
+/* Start the operations. */
+
+ if (lsame_(trans, "N")) {
+
+/* Form C := alpha*A*conjg( A' ) + beta*C. */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*beta == 0.) {
+ i__2 = j;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ c__[i__3].r = 0., c__[i__3].i = 0.;
+/* L90: */
+ }
+ } else if (*beta != 1.) {
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ i__4 = i__ + j * c_dim1;
+ z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
+ i__4].i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L100: */
+ }
+ i__2 = j + j * c_dim1;
+ i__3 = j + j * c_dim1;
+ d__1 = *beta * c__[i__3].r;
+ c__[i__2].r = d__1, c__[i__2].i = 0.;
+ } else {
+ i__2 = j + j * c_dim1;
+ i__3 = j + j * c_dim1;
+ d__1 = c__[i__3].r;
+ c__[i__2].r = d__1, c__[i__2].i = 0.;
+ }
+ i__2 = *k;
+ for (l = 1; l <= i__2; ++l) {
+ i__3 = j + l * a_dim1;
+ if (a[i__3].r != 0. || a[i__3].i != 0.) {
+ d_cnjg(&z__2, &a[j + l * a_dim1]);
+ z__1.r = *alpha * z__2.r, z__1.i = *alpha * z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ i__3 = j - 1;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ i__4 = i__ + j * c_dim1;
+ i__5 = i__ + j * c_dim1;
+ i__6 = i__ + l * a_dim1;
+ z__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,
+ z__2.i = temp.r * a[i__6].i + temp.i * a[
+ i__6].r;
+ z__1.r = c__[i__5].r + z__2.r, z__1.i = c__[i__5]
+ .i + z__2.i;
+ c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
+/* L110: */
+ }
+ i__3 = j + j * c_dim1;
+ i__4 = j + j * c_dim1;
+ i__5 = i__ + l * a_dim1;
+ z__1.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
+ z__1.i = temp.r * a[i__5].i + temp.i * a[i__5]
+ .r;
+ d__1 = c__[i__4].r + z__1.r;
+ c__[i__3].r = d__1, c__[i__3].i = 0.;
+ }
+/* L120: */
+ }
+/* L130: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*beta == 0.) {
+ i__2 = *n;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ c__[i__3].r = 0., c__[i__3].i = 0.;
+/* L140: */
+ }
+ } else if (*beta != 1.) {
+ i__2 = j + j * c_dim1;
+ i__3 = j + j * c_dim1;
+ d__1 = *beta * c__[i__3].r;
+ c__[i__2].r = d__1, c__[i__2].i = 0.;
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ i__4 = i__ + j * c_dim1;
+ z__1.r = *beta * c__[i__4].r, z__1.i = *beta * c__[
+ i__4].i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L150: */
+ }
+ } else {
+ i__2 = j + j * c_dim1;
+ i__3 = j + j * c_dim1;
+ d__1 = c__[i__3].r;
+ c__[i__2].r = d__1, c__[i__2].i = 0.;
+ }
+ i__2 = *k;
+ for (l = 1; l <= i__2; ++l) {
+ i__3 = j + l * a_dim1;
+ if (a[i__3].r != 0. || a[i__3].i != 0.) {
+ d_cnjg(&z__2, &a[j + l * a_dim1]);
+ z__1.r = *alpha * z__2.r, z__1.i = *alpha * z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ i__3 = j + j * c_dim1;
+ i__4 = j + j * c_dim1;
+ i__5 = j + l * a_dim1;
+ z__1.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
+ z__1.i = temp.r * a[i__5].i + temp.i * a[i__5]
+ .r;
+ d__1 = c__[i__4].r + z__1.r;
+ c__[i__3].r = d__1, c__[i__3].i = 0.;
+ i__3 = *n;
+ for (i__ = j + 1; i__ <= i__3; ++i__) {
+ i__4 = i__ + j * c_dim1;
+ i__5 = i__ + j * c_dim1;
+ i__6 = i__ + l * a_dim1;
+ z__2.r = temp.r * a[i__6].r - temp.i * a[i__6].i,
+ z__2.i = temp.r * a[i__6].i + temp.i * a[
+ i__6].r;
+ z__1.r = c__[i__5].r + z__2.r, z__1.i = c__[i__5]
+ .i + z__2.i;
+ c__[i__4].r = z__1.r, c__[i__4].i = z__1.i;
+/* L160: */
+ }
+ }
+/* L170: */
+ }
+/* L180: */
+ }
+ }
+ } else {
+
+/* Form C := alpha*conjg( A' )*A + beta*C. */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp.r = 0., temp.i = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ d_cnjg(&z__3, &a[l + i__ * a_dim1]);
+ i__4 = l + j * a_dim1;
+ z__2.r = z__3.r * a[i__4].r - z__3.i * a[i__4].i,
+ z__2.i = z__3.r * a[i__4].i + z__3.i * a[i__4]
+ .r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L190: */
+ }
+ if (*beta == 0.) {
+ i__3 = i__ + j * c_dim1;
+ z__1.r = *alpha * temp.r, z__1.i = *alpha * temp.i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ } else {
+ i__3 = i__ + j * c_dim1;
+ z__2.r = *alpha * temp.r, z__2.i = *alpha * temp.i;
+ i__4 = i__ + j * c_dim1;
+ z__3.r = *beta * c__[i__4].r, z__3.i = *beta * c__[
+ i__4].i;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ }
+/* L200: */
+ }
+ rtemp = 0.;
+ i__2 = *k;
+ for (l = 1; l <= i__2; ++l) {
+ d_cnjg(&z__3, &a[l + j * a_dim1]);
+ i__3 = l + j * a_dim1;
+ z__2.r = z__3.r * a[i__3].r - z__3.i * a[i__3].i, z__2.i =
+ z__3.r * a[i__3].i + z__3.i * a[i__3].r;
+ z__1.r = rtemp + z__2.r, z__1.i = z__2.i;
+ rtemp = z__1.r;
+/* L210: */
+ }
+ if (*beta == 0.) {
+ i__2 = j + j * c_dim1;
+ d__1 = *alpha * rtemp;
+ c__[i__2].r = d__1, c__[i__2].i = 0.;
+ } else {
+ i__2 = j + j * c_dim1;
+ i__3 = j + j * c_dim1;
+ d__1 = *alpha * rtemp + *beta * c__[i__3].r;
+ c__[i__2].r = d__1, c__[i__2].i = 0.;
+ }
+/* L220: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ rtemp = 0.;
+ i__2 = *k;
+ for (l = 1; l <= i__2; ++l) {
+ d_cnjg(&z__3, &a[l + j * a_dim1]);
+ i__3 = l + j * a_dim1;
+ z__2.r = z__3.r * a[i__3].r - z__3.i * a[i__3].i, z__2.i =
+ z__3.r * a[i__3].i + z__3.i * a[i__3].r;
+ z__1.r = rtemp + z__2.r, z__1.i = z__2.i;
+ rtemp = z__1.r;
+/* L230: */
+ }
+ if (*beta == 0.) {
+ i__2 = j + j * c_dim1;
+ d__1 = *alpha * rtemp;
+ c__[i__2].r = d__1, c__[i__2].i = 0.;
+ } else {
+ i__2 = j + j * c_dim1;
+ i__3 = j + j * c_dim1;
+ d__1 = *alpha * rtemp + *beta * c__[i__3].r;
+ c__[i__2].r = d__1, c__[i__2].i = 0.;
+ }
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ temp.r = 0., temp.i = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ d_cnjg(&z__3, &a[l + i__ * a_dim1]);
+ i__4 = l + j * a_dim1;
+ z__2.r = z__3.r * a[i__4].r - z__3.i * a[i__4].i,
+ z__2.i = z__3.r * a[i__4].i + z__3.i * a[i__4]
+ .r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i + z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L240: */
+ }
+ if (*beta == 0.) {
+ i__3 = i__ + j * c_dim1;
+ z__1.r = *alpha * temp.r, z__1.i = *alpha * temp.i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ } else {
+ i__3 = i__ + j * c_dim1;
+ z__2.r = *alpha * temp.r, z__2.i = *alpha * temp.i;
+ i__4 = i__ + j * c_dim1;
+ z__3.r = *beta * c__[i__4].r, z__3.i = *beta * c__[
+ i__4].i;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+ }
+/* L250: */
+ }
+/* L260: */
+ }
+ }
+ }
+
+ return 0;
+
+/* End of ZHERK . */
+
+} /* zherk_ */
+
+/* Subroutine */ int zscal_(integer *n, doublecomplex *za, doublecomplex *zx,
+ integer *incx)
+{
+ /* System generated locals */
+ integer i__1, i__2, i__3;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer i__, ix;
+
+
+/*
+ scales a vector by a constant.
+ jack dongarra, 3/11/78.
+ modified 3/93 to return if incx .le. 0.
+ modified 12/3/93, array(1) declarations changed to array(*)
+*/
+
+
+ /* Parameter adjustments */
+ --zx;
+
+ /* Function Body */
+ if (*n <= 0 || *incx <= 0) {
+ return 0;
+ }
+ if (*incx == 1) {
+ goto L20;
+ }
+
+/* code for increment not equal to 1 */
+
+ ix = 1;
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = ix;
+ i__3 = ix;
+ z__1.r = za->r * zx[i__3].r - za->i * zx[i__3].i, z__1.i = za->r * zx[
+ i__3].i + za->i * zx[i__3].r;
+ zx[i__2].r = z__1.r, zx[i__2].i = z__1.i;
+ ix += *incx;
+/* L10: */
+ }
+ return 0;
+
+/* code for increment equal to 1 */
+
+L20:
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ i__3 = i__;
+ z__1.r = za->r * zx[i__3].r - za->i * zx[i__3].i, z__1.i = za->r * zx[
+ i__3].i + za->i * zx[i__3].r;
+ zx[i__2].r = z__1.r, zx[i__2].i = z__1.i;
+/* L30: */
+ }
+ return 0;
+} /* zscal_ */
+
+/* Subroutine */ int zswap_(integer *n, doublecomplex *zx, integer *incx,
+ doublecomplex *zy, integer *incy)
+{
+ /* System generated locals */
+ integer i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i__, ix, iy;
+ static doublecomplex ztemp;
+
+
+/*
+ interchanges two vectors.
+ jack dongarra, 3/11/78.
+ modified 12/3/93, array(1) declarations changed to array(*)
+*/
+
+
+ /* Parameter adjustments */
+ --zy;
+ --zx;
+
+ /* Function Body */
+ if (*n <= 0) {
+ return 0;
+ }
+ if ((*incx == 1 && *incy == 1)) {
+ goto L20;
+ }
+
+/*
+ code for unequal increments or equal increments not equal
+ to 1
+*/
+
+ ix = 1;
+ iy = 1;
+ if (*incx < 0) {
+ ix = (-(*n) + 1) * *incx + 1;
+ }
+ if (*incy < 0) {
+ iy = (-(*n) + 1) * *incy + 1;
+ }
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = ix;
+ ztemp.r = zx[i__2].r, ztemp.i = zx[i__2].i;
+ i__2 = ix;
+ i__3 = iy;
+ zx[i__2].r = zy[i__3].r, zx[i__2].i = zy[i__3].i;
+ i__2 = iy;
+ zy[i__2].r = ztemp.r, zy[i__2].i = ztemp.i;
+ ix += *incx;
+ iy += *incy;
+/* L10: */
+ }
+ return 0;
+
+/* code for both increments equal to 1 */
+L20:
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ ztemp.r = zx[i__2].r, ztemp.i = zx[i__2].i;
+ i__2 = i__;
+ i__3 = i__;
+ zx[i__2].r = zy[i__3].r, zx[i__2].i = zy[i__3].i;
+ i__2 = i__;
+ zy[i__2].r = ztemp.r, zy[i__2].i = ztemp.i;
+/* L30: */
+ }
+ return 0;
+} /* zswap_ */
+
+/* Subroutine */ int ztrmm_(char *side, char *uplo, char *transa, char *diag,
+ integer *m, integer *n, doublecomplex *alpha, doublecomplex *a,
+ integer *lda, doublecomplex *b, integer *ldb)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4, i__5,
+ i__6;
+ doublecomplex z__1, z__2, z__3;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, j, k, info;
+ static doublecomplex temp;
+ static logical lside;
+ extern logical lsame_(char *, char *);
+ static integer nrowa;
+ static logical upper;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static logical noconj, nounit;
+
+
+/*
+ Purpose
+ =======
+
+ ZTRMM performs one of the matrix-matrix operations
+
+ B := alpha*op( A )*B, or B := alpha*B*op( A )
+
+ where alpha is a scalar, B is an m by n matrix, A is a unit, or
+ non-unit, upper or lower triangular matrix and op( A ) is one of
+
+ op( A ) = A or op( A ) = A' or op( A ) = conjg( A' ).
+
+ Parameters
+ ==========
+
+ SIDE - CHARACTER*1.
+ On entry, SIDE specifies whether op( A ) multiplies B from
+ the left or right as follows:
+
+ SIDE = 'L' or 'l' B := alpha*op( A )*B.
+
+ SIDE = 'R' or 'r' B := alpha*B*op( A ).
+
+ Unchanged on exit.
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix A is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANSA - CHARACTER*1.
+ On entry, TRANSA specifies the form of op( A ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSA = 'N' or 'n' op( A ) = A.
+
+ TRANSA = 'T' or 't' op( A ) = A'.
+
+ TRANSA = 'C' or 'c' op( A ) = conjg( A' ).
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit triangular
+ as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of B. M must be at
+ least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of B. N must be
+ at least zero.
+ Unchanged on exit.
+
+ ALPHA - COMPLEX*16 .
+ On entry, ALPHA specifies the scalar alpha. When alpha is
+ zero then A is not referenced and B need not be set before
+ entry.
+ Unchanged on exit.
+
+ A - COMPLEX*16 array of DIMENSION ( LDA, k ), where k is m
+ when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
+ Before entry with UPLO = 'U' or 'u', the leading k by k
+ upper triangular part of the array A must contain the upper
+ triangular matrix and the strictly lower triangular part of
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading k by k
+ lower triangular part of the array A must contain the lower
+ triangular matrix and the strictly upper triangular part of
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When SIDE = 'L' or 'l' then
+ LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
+ then LDA must be at least max( 1, n ).
+ Unchanged on exit.
+
+ B - COMPLEX*16 array of DIMENSION ( LDB, n ).
+ Before entry, the leading m by n part of the array B must
+ contain the matrix B, and on exit is overwritten by the
+ transformed matrix.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. LDB must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+
+ /* Function Body */
+ lside = lsame_(side, "L");
+ if (lside) {
+ nrowa = *m;
+ } else {
+ nrowa = *n;
+ }
+ noconj = lsame_(transa, "T");
+ nounit = lsame_(diag, "N");
+ upper = lsame_(uplo, "U");
+
+ info = 0;
+ if ((! lside && ! lsame_(side, "R"))) {
+ info = 1;
+ } else if ((! upper && ! lsame_(uplo, "L"))) {
+ info = 2;
+ } else if (((! lsame_(transa, "N") && ! lsame_(
+ transa, "T")) && ! lsame_(transa, "C"))) {
+ info = 3;
+ } else if ((! lsame_(diag, "U") && ! lsame_(diag,
+ "N"))) {
+ info = 4;
+ } else if (*m < 0) {
+ info = 5;
+ } else if (*n < 0) {
+ info = 6;
+ } else if (*lda < max(1,nrowa)) {
+ info = 9;
+ } else if (*ldb < max(1,*m)) {
+ info = 11;
+ }
+ if (info != 0) {
+ xerbla_("ZTRMM ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+/* And when alpha.eq.zero. */
+
+ if ((alpha->r == 0. && alpha->i == 0.)) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ b[i__3].r = 0., b[i__3].i = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+ return 0;
+ }
+
+/* Start the operations. */
+
+ if (lside) {
+ if (lsame_(transa, "N")) {
+
+/* Form B := alpha*A*B. */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (k = 1; k <= i__2; ++k) {
+ i__3 = k + j * b_dim1;
+ if (b[i__3].r != 0. || b[i__3].i != 0.) {
+ i__3 = k + j * b_dim1;
+ z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3]
+ .i, z__1.i = alpha->r * b[i__3].i +
+ alpha->i * b[i__3].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ i__3 = k - 1;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ i__4 = i__ + j * b_dim1;
+ i__5 = i__ + j * b_dim1;
+ i__6 = i__ + k * a_dim1;
+ z__2.r = temp.r * a[i__6].r - temp.i * a[i__6]
+ .i, z__2.i = temp.r * a[i__6].i +
+ temp.i * a[i__6].r;
+ z__1.r = b[i__5].r + z__2.r, z__1.i = b[i__5]
+ .i + z__2.i;
+ b[i__4].r = z__1.r, b[i__4].i = z__1.i;
+/* L30: */
+ }
+ if (nounit) {
+ i__3 = k + k * a_dim1;
+ z__1.r = temp.r * a[i__3].r - temp.i * a[i__3]
+ .i, z__1.i = temp.r * a[i__3].i +
+ temp.i * a[i__3].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ i__3 = k + j * b_dim1;
+ b[i__3].r = temp.r, b[i__3].i = temp.i;
+ }
+/* L40: */
+ }
+/* L50: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ for (k = *m; k >= 1; --k) {
+ i__2 = k + j * b_dim1;
+ if (b[i__2].r != 0. || b[i__2].i != 0.) {
+ i__2 = k + j * b_dim1;
+ z__1.r = alpha->r * b[i__2].r - alpha->i * b[i__2]
+ .i, z__1.i = alpha->r * b[i__2].i +
+ alpha->i * b[i__2].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ i__2 = k + j * b_dim1;
+ b[i__2].r = temp.r, b[i__2].i = temp.i;
+ if (nounit) {
+ i__2 = k + j * b_dim1;
+ i__3 = k + j * b_dim1;
+ i__4 = k + k * a_dim1;
+ z__1.r = b[i__3].r * a[i__4].r - b[i__3].i *
+ a[i__4].i, z__1.i = b[i__3].r * a[
+ i__4].i + b[i__3].i * a[i__4].r;
+ b[i__2].r = z__1.r, b[i__2].i = z__1.i;
+ }
+ i__2 = *m;
+ for (i__ = k + 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ i__4 = i__ + j * b_dim1;
+ i__5 = i__ + k * a_dim1;
+ z__2.r = temp.r * a[i__5].r - temp.i * a[i__5]
+ .i, z__2.i = temp.r * a[i__5].i +
+ temp.i * a[i__5].r;
+ z__1.r = b[i__4].r + z__2.r, z__1.i = b[i__4]
+ .i + z__2.i;
+ b[i__3].r = z__1.r, b[i__3].i = z__1.i;
+/* L60: */
+ }
+ }
+/* L70: */
+ }
+/* L80: */
+ }
+ }
+ } else {
+
+/* Form B := alpha*A'*B or B := alpha*conjg( A' )*B. */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ for (i__ = *m; i__ >= 1; --i__) {
+ i__2 = i__ + j * b_dim1;
+ temp.r = b[i__2].r, temp.i = b[i__2].i;
+ if (noconj) {
+ if (nounit) {
+ i__2 = i__ + i__ * a_dim1;
+ z__1.r = temp.r * a[i__2].r - temp.i * a[i__2]
+ .i, z__1.i = temp.r * a[i__2].i +
+ temp.i * a[i__2].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ i__2 = i__ - 1;
+ for (k = 1; k <= i__2; ++k) {
+ i__3 = k + i__ * a_dim1;
+ i__4 = k + j * b_dim1;
+ z__2.r = a[i__3].r * b[i__4].r - a[i__3].i *
+ b[i__4].i, z__2.i = a[i__3].r * b[
+ i__4].i + a[i__3].i * b[i__4].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i +
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L90: */
+ }
+ } else {
+ if (nounit) {
+ d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
+ z__1.r = temp.r * z__2.r - temp.i * z__2.i,
+ z__1.i = temp.r * z__2.i + temp.i *
+ z__2.r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ i__2 = i__ - 1;
+ for (k = 1; k <= i__2; ++k) {
+ d_cnjg(&z__3, &a[k + i__ * a_dim1]);
+ i__3 = k + j * b_dim1;
+ z__2.r = z__3.r * b[i__3].r - z__3.i * b[i__3]
+ .i, z__2.i = z__3.r * b[i__3].i +
+ z__3.i * b[i__3].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i +
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L100: */
+ }
+ }
+ i__2 = i__ + j * b_dim1;
+ z__1.r = alpha->r * temp.r - alpha->i * temp.i,
+ z__1.i = alpha->r * temp.i + alpha->i *
+ temp.r;
+ b[i__2].r = z__1.r, b[i__2].i = z__1.i;
+/* L110: */
+ }
+/* L120: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ temp.r = b[i__3].r, temp.i = b[i__3].i;
+ if (noconj) {
+ if (nounit) {
+ i__3 = i__ + i__ * a_dim1;
+ z__1.r = temp.r * a[i__3].r - temp.i * a[i__3]
+ .i, z__1.i = temp.r * a[i__3].i +
+ temp.i * a[i__3].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ i__3 = *m;
+ for (k = i__ + 1; k <= i__3; ++k) {
+ i__4 = k + i__ * a_dim1;
+ i__5 = k + j * b_dim1;
+ z__2.r = a[i__4].r * b[i__5].r - a[i__4].i *
+ b[i__5].i, z__2.i = a[i__4].r * b[
+ i__5].i + a[i__4].i * b[i__5].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i +
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L130: */
+ }
+ } else {
+ if (nounit) {
+ d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
+ z__1.r = temp.r * z__2.r - temp.i * z__2.i,
+ z__1.i = temp.r * z__2.i + temp.i *
+ z__2.r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ i__3 = *m;
+ for (k = i__ + 1; k <= i__3; ++k) {
+ d_cnjg(&z__3, &a[k + i__ * a_dim1]);
+ i__4 = k + j * b_dim1;
+ z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4]
+ .i, z__2.i = z__3.r * b[i__4].i +
+ z__3.i * b[i__4].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i +
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L140: */
+ }
+ }
+ i__3 = i__ + j * b_dim1;
+ z__1.r = alpha->r * temp.r - alpha->i * temp.i,
+ z__1.i = alpha->r * temp.i + alpha->i *
+ temp.r;
+ b[i__3].r = z__1.r, b[i__3].i = z__1.i;
+/* L150: */
+ }
+/* L160: */
+ }
+ }
+ }
+ } else {
+ if (lsame_(transa, "N")) {
+
+/* Form B := alpha*B*A. */
+
+ if (upper) {
+ for (j = *n; j >= 1; --j) {
+ temp.r = alpha->r, temp.i = alpha->i;
+ if (nounit) {
+ i__1 = j + j * a_dim1;
+ z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
+ z__1.i = temp.r * a[i__1].i + temp.i * a[i__1]
+ .r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__ + j * b_dim1;
+ i__3 = i__ + j * b_dim1;
+ z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,
+ z__1.i = temp.r * b[i__3].i + temp.i * b[i__3]
+ .r;
+ b[i__2].r = z__1.r, b[i__2].i = z__1.i;
+/* L170: */
+ }
+ i__1 = j - 1;
+ for (k = 1; k <= i__1; ++k) {
+ i__2 = k + j * a_dim1;
+ if (a[i__2].r != 0. || a[i__2].i != 0.) {
+ i__2 = k + j * a_dim1;
+ z__1.r = alpha->r * a[i__2].r - alpha->i * a[i__2]
+ .i, z__1.i = alpha->r * a[i__2].i +
+ alpha->i * a[i__2].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ i__4 = i__ + j * b_dim1;
+ i__5 = i__ + k * b_dim1;
+ z__2.r = temp.r * b[i__5].r - temp.i * b[i__5]
+ .i, z__2.i = temp.r * b[i__5].i +
+ temp.i * b[i__5].r;
+ z__1.r = b[i__4].r + z__2.r, z__1.i = b[i__4]
+ .i + z__2.i;
+ b[i__3].r = z__1.r, b[i__3].i = z__1.i;
+/* L180: */
+ }
+ }
+/* L190: */
+ }
+/* L200: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp.r = alpha->r, temp.i = alpha->i;
+ if (nounit) {
+ i__2 = j + j * a_dim1;
+ z__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i,
+ z__1.i = temp.r * a[i__2].i + temp.i * a[i__2]
+ .r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ i__4 = i__ + j * b_dim1;
+ z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,
+ z__1.i = temp.r * b[i__4].i + temp.i * b[i__4]
+ .r;
+ b[i__3].r = z__1.r, b[i__3].i = z__1.i;
+/* L210: */
+ }
+ i__2 = *n;
+ for (k = j + 1; k <= i__2; ++k) {
+ i__3 = k + j * a_dim1;
+ if (a[i__3].r != 0. || a[i__3].i != 0.) {
+ i__3 = k + j * a_dim1;
+ z__1.r = alpha->r * a[i__3].r - alpha->i * a[i__3]
+ .i, z__1.i = alpha->r * a[i__3].i +
+ alpha->i * a[i__3].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ i__3 = *m;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ i__4 = i__ + j * b_dim1;
+ i__5 = i__ + j * b_dim1;
+ i__6 = i__ + k * b_dim1;
+ z__2.r = temp.r * b[i__6].r - temp.i * b[i__6]
+ .i, z__2.i = temp.r * b[i__6].i +
+ temp.i * b[i__6].r;
+ z__1.r = b[i__5].r + z__2.r, z__1.i = b[i__5]
+ .i + z__2.i;
+ b[i__4].r = z__1.r, b[i__4].i = z__1.i;
+/* L220: */
+ }
+ }
+/* L230: */
+ }
+/* L240: */
+ }
+ }
+ } else {
+
+/* Form B := alpha*B*A' or B := alpha*B*conjg( A' ). */
+
+ if (upper) {
+ i__1 = *n;
+ for (k = 1; k <= i__1; ++k) {
+ i__2 = k - 1;
+ for (j = 1; j <= i__2; ++j) {
+ i__3 = j + k * a_dim1;
+ if (a[i__3].r != 0. || a[i__3].i != 0.) {
+ if (noconj) {
+ i__3 = j + k * a_dim1;
+ z__1.r = alpha->r * a[i__3].r - alpha->i * a[
+ i__3].i, z__1.i = alpha->r * a[i__3]
+ .i + alpha->i * a[i__3].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ } else {
+ d_cnjg(&z__2, &a[j + k * a_dim1]);
+ z__1.r = alpha->r * z__2.r - alpha->i *
+ z__2.i, z__1.i = alpha->r * z__2.i +
+ alpha->i * z__2.r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ i__3 = *m;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ i__4 = i__ + j * b_dim1;
+ i__5 = i__ + j * b_dim1;
+ i__6 = i__ + k * b_dim1;
+ z__2.r = temp.r * b[i__6].r - temp.i * b[i__6]
+ .i, z__2.i = temp.r * b[i__6].i +
+ temp.i * b[i__6].r;
+ z__1.r = b[i__5].r + z__2.r, z__1.i = b[i__5]
+ .i + z__2.i;
+ b[i__4].r = z__1.r, b[i__4].i = z__1.i;
+/* L250: */
+ }
+ }
+/* L260: */
+ }
+ temp.r = alpha->r, temp.i = alpha->i;
+ if (nounit) {
+ if (noconj) {
+ i__2 = k + k * a_dim1;
+ z__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i,
+ z__1.i = temp.r * a[i__2].i + temp.i * a[
+ i__2].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ } else {
+ d_cnjg(&z__2, &a[k + k * a_dim1]);
+ z__1.r = temp.r * z__2.r - temp.i * z__2.i,
+ z__1.i = temp.r * z__2.i + temp.i *
+ z__2.r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ }
+ if (temp.r != 1. || temp.i != 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + k * b_dim1;
+ i__4 = i__ + k * b_dim1;
+ z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,
+ z__1.i = temp.r * b[i__4].i + temp.i * b[
+ i__4].r;
+ b[i__3].r = z__1.r, b[i__3].i = z__1.i;
+/* L270: */
+ }
+ }
+/* L280: */
+ }
+ } else {
+ for (k = *n; k >= 1; --k) {
+ i__1 = *n;
+ for (j = k + 1; j <= i__1; ++j) {
+ i__2 = j + k * a_dim1;
+ if (a[i__2].r != 0. || a[i__2].i != 0.) {
+ if (noconj) {
+ i__2 = j + k * a_dim1;
+ z__1.r = alpha->r * a[i__2].r - alpha->i * a[
+ i__2].i, z__1.i = alpha->r * a[i__2]
+ .i + alpha->i * a[i__2].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ } else {
+ d_cnjg(&z__2, &a[j + k * a_dim1]);
+ z__1.r = alpha->r * z__2.r - alpha->i *
+ z__2.i, z__1.i = alpha->r * z__2.i +
+ alpha->i * z__2.r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ i__4 = i__ + j * b_dim1;
+ i__5 = i__ + k * b_dim1;
+ z__2.r = temp.r * b[i__5].r - temp.i * b[i__5]
+ .i, z__2.i = temp.r * b[i__5].i +
+ temp.i * b[i__5].r;
+ z__1.r = b[i__4].r + z__2.r, z__1.i = b[i__4]
+ .i + z__2.i;
+ b[i__3].r = z__1.r, b[i__3].i = z__1.i;
+/* L290: */
+ }
+ }
+/* L300: */
+ }
+ temp.r = alpha->r, temp.i = alpha->i;
+ if (nounit) {
+ if (noconj) {
+ i__1 = k + k * a_dim1;
+ z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
+ z__1.i = temp.r * a[i__1].i + temp.i * a[
+ i__1].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ } else {
+ d_cnjg(&z__2, &a[k + k * a_dim1]);
+ z__1.r = temp.r * z__2.r - temp.i * z__2.i,
+ z__1.i = temp.r * z__2.i + temp.i *
+ z__2.r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ }
+ if (temp.r != 1. || temp.i != 0.) {
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__ + k * b_dim1;
+ i__3 = i__ + k * b_dim1;
+ z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,
+ z__1.i = temp.r * b[i__3].i + temp.i * b[
+ i__3].r;
+ b[i__2].r = z__1.r, b[i__2].i = z__1.i;
+/* L310: */
+ }
+ }
+/* L320: */
+ }
+ }
+ }
+ }
+
+ return 0;
+
+/* End of ZTRMM . */
+
+} /* ztrmm_ */
+
+/* Subroutine */ int ztrmv_(char *uplo, char *trans, char *diag, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *x, integer *incx)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
+ doublecomplex z__1, z__2, z__3;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, j, ix, jx, kx, info;
+ static doublecomplex temp;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static logical noconj, nounit;
+
+
+/*
+ Purpose
+ =======
+
+ ZTRMV performs one of the matrix-vector operations
+
+ x := A*x, or x := A'*x, or x := conjg( A' )*x,
+
+ where x is an n element vector and A is an n by n unit, or non-unit,
+ upper or lower triangular matrix.
+
+ Parameters
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the operation to be performed as
+ follows:
+
+ TRANS = 'N' or 'n' x := A*x.
+
+ TRANS = 'T' or 't' x := A'*x.
+
+ TRANS = 'C' or 'c' x := conjg( A' )*x.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ A - COMPLEX*16 array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+ triangular matrix and the strictly lower triangular part of
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+ triangular matrix and the strictly upper triangular part of
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+ X - COMPLEX*16 array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element vector x. On exit, X is overwritten with the
+ tranformed vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --x;
+
+ /* Function Body */
+ info = 0;
+ if ((! lsame_(uplo, "U") && ! lsame_(uplo, "L"))) {
+ info = 1;
+ } else if (((! lsame_(trans, "N") && ! lsame_(trans,
+ "T")) && ! lsame_(trans, "C"))) {
+ info = 2;
+ } else if ((! lsame_(diag, "U") && ! lsame_(diag,
+ "N"))) {
+ info = 3;
+ } else if (*n < 0) {
+ info = 4;
+ } else if (*lda < max(1,*n)) {
+ info = 6;
+ } else if (*incx == 0) {
+ info = 8;
+ }
+ if (info != 0) {
+ xerbla_("ZTRMV ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+ noconj = lsame_(trans, "T");
+ nounit = lsame_(diag, "N");
+
+/*
+ Set up the start point in X if the increment is not unity. This
+ will be ( N - 1 )*INCX too small for descending loops.
+*/
+
+ if (*incx <= 0) {
+ kx = 1 - (*n - 1) * *incx;
+ } else if (*incx != 1) {
+ kx = 1;
+ }
+
+/*
+ Start the operations. In this version the elements of A are
+ accessed sequentially with one pass through A.
+*/
+
+ if (lsame_(trans, "N")) {
+
+/* Form x := A*x. */
+
+ if (lsame_(uplo, "U")) {
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ if (x[i__2].r != 0. || x[i__2].i != 0.) {
+ i__2 = j;
+ temp.r = x[i__2].r, temp.i = x[i__2].i;
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__;
+ i__4 = i__;
+ i__5 = i__ + j * a_dim1;
+ z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
+ z__2.i = temp.r * a[i__5].i + temp.i * a[
+ i__5].r;
+ z__1.r = x[i__4].r + z__2.r, z__1.i = x[i__4].i +
+ z__2.i;
+ x[i__3].r = z__1.r, x[i__3].i = z__1.i;
+/* L10: */
+ }
+ if (nounit) {
+ i__2 = j;
+ i__3 = j;
+ i__4 = j + j * a_dim1;
+ z__1.r = x[i__3].r * a[i__4].r - x[i__3].i * a[
+ i__4].i, z__1.i = x[i__3].r * a[i__4].i +
+ x[i__3].i * a[i__4].r;
+ x[i__2].r = z__1.r, x[i__2].i = z__1.i;
+ }
+ }
+/* L20: */
+ }
+ } else {
+ jx = kx;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = jx;
+ if (x[i__2].r != 0. || x[i__2].i != 0.) {
+ i__2 = jx;
+ temp.r = x[i__2].r, temp.i = x[i__2].i;
+ ix = kx;
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = ix;
+ i__4 = ix;
+ i__5 = i__ + j * a_dim1;
+ z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
+ z__2.i = temp.r * a[i__5].i + temp.i * a[
+ i__5].r;
+ z__1.r = x[i__4].r + z__2.r, z__1.i = x[i__4].i +
+ z__2.i;
+ x[i__3].r = z__1.r, x[i__3].i = z__1.i;
+ ix += *incx;
+/* L30: */
+ }
+ if (nounit) {
+ i__2 = jx;
+ i__3 = jx;
+ i__4 = j + j * a_dim1;
+ z__1.r = x[i__3].r * a[i__4].r - x[i__3].i * a[
+ i__4].i, z__1.i = x[i__3].r * a[i__4].i +
+ x[i__3].i * a[i__4].r;
+ x[i__2].r = z__1.r, x[i__2].i = z__1.i;
+ }
+ }
+ jx += *incx;
+/* L40: */
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ i__1 = j;
+ if (x[i__1].r != 0. || x[i__1].i != 0.) {
+ i__1 = j;
+ temp.r = x[i__1].r, temp.i = x[i__1].i;
+ i__1 = j + 1;
+ for (i__ = *n; i__ >= i__1; --i__) {
+ i__2 = i__;
+ i__3 = i__;
+ i__4 = i__ + j * a_dim1;
+ z__2.r = temp.r * a[i__4].r - temp.i * a[i__4].i,
+ z__2.i = temp.r * a[i__4].i + temp.i * a[
+ i__4].r;
+ z__1.r = x[i__3].r + z__2.r, z__1.i = x[i__3].i +
+ z__2.i;
+ x[i__2].r = z__1.r, x[i__2].i = z__1.i;
+/* L50: */
+ }
+ if (nounit) {
+ i__1 = j;
+ i__2 = j;
+ i__3 = j + j * a_dim1;
+ z__1.r = x[i__2].r * a[i__3].r - x[i__2].i * a[
+ i__3].i, z__1.i = x[i__2].r * a[i__3].i +
+ x[i__2].i * a[i__3].r;
+ x[i__1].r = z__1.r, x[i__1].i = z__1.i;
+ }
+ }
+/* L60: */
+ }
+ } else {
+ kx += (*n - 1) * *incx;
+ jx = kx;
+ for (j = *n; j >= 1; --j) {
+ i__1 = jx;
+ if (x[i__1].r != 0. || x[i__1].i != 0.) {
+ i__1 = jx;
+ temp.r = x[i__1].r, temp.i = x[i__1].i;
+ ix = kx;
+ i__1 = j + 1;
+ for (i__ = *n; i__ >= i__1; --i__) {
+ i__2 = ix;
+ i__3 = ix;
+ i__4 = i__ + j * a_dim1;
+ z__2.r = temp.r * a[i__4].r - temp.i * a[i__4].i,
+ z__2.i = temp.r * a[i__4].i + temp.i * a[
+ i__4].r;
+ z__1.r = x[i__3].r + z__2.r, z__1.i = x[i__3].i +
+ z__2.i;
+ x[i__2].r = z__1.r, x[i__2].i = z__1.i;
+ ix -= *incx;
+/* L70: */
+ }
+ if (nounit) {
+ i__1 = jx;
+ i__2 = jx;
+ i__3 = j + j * a_dim1;
+ z__1.r = x[i__2].r * a[i__3].r - x[i__2].i * a[
+ i__3].i, z__1.i = x[i__2].r * a[i__3].i +
+ x[i__2].i * a[i__3].r;
+ x[i__1].r = z__1.r, x[i__1].i = z__1.i;
+ }
+ }
+ jx -= *incx;
+/* L80: */
+ }
+ }
+ }
+ } else {
+
+/* Form x := A'*x or x := conjg( A' )*x. */
+
+ if (lsame_(uplo, "U")) {
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ i__1 = j;
+ temp.r = x[i__1].r, temp.i = x[i__1].i;
+ if (noconj) {
+ if (nounit) {
+ i__1 = j + j * a_dim1;
+ z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
+ z__1.i = temp.r * a[i__1].i + temp.i * a[
+ i__1].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ for (i__ = j - 1; i__ >= 1; --i__) {
+ i__1 = i__ + j * a_dim1;
+ i__2 = i__;
+ z__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[
+ i__2].i, z__2.i = a[i__1].r * x[i__2].i +
+ a[i__1].i * x[i__2].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i +
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L90: */
+ }
+ } else {
+ if (nounit) {
+ d_cnjg(&z__2, &a[j + j * a_dim1]);
+ z__1.r = temp.r * z__2.r - temp.i * z__2.i,
+ z__1.i = temp.r * z__2.i + temp.i *
+ z__2.r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ for (i__ = j - 1; i__ >= 1; --i__) {
+ d_cnjg(&z__3, &a[i__ + j * a_dim1]);
+ i__1 = i__;
+ z__2.r = z__3.r * x[i__1].r - z__3.i * x[i__1].i,
+ z__2.i = z__3.r * x[i__1].i + z__3.i * x[
+ i__1].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i +
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L100: */
+ }
+ }
+ i__1 = j;
+ x[i__1].r = temp.r, x[i__1].i = temp.i;
+/* L110: */
+ }
+ } else {
+ jx = kx + (*n - 1) * *incx;
+ for (j = *n; j >= 1; --j) {
+ i__1 = jx;
+ temp.r = x[i__1].r, temp.i = x[i__1].i;
+ ix = jx;
+ if (noconj) {
+ if (nounit) {
+ i__1 = j + j * a_dim1;
+ z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
+ z__1.i = temp.r * a[i__1].i + temp.i * a[
+ i__1].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ for (i__ = j - 1; i__ >= 1; --i__) {
+ ix -= *incx;
+ i__1 = i__ + j * a_dim1;
+ i__2 = ix;
+ z__2.r = a[i__1].r * x[i__2].r - a[i__1].i * x[
+ i__2].i, z__2.i = a[i__1].r * x[i__2].i +
+ a[i__1].i * x[i__2].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i +
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L120: */
+ }
+ } else {
+ if (nounit) {
+ d_cnjg(&z__2, &a[j + j * a_dim1]);
+ z__1.r = temp.r * z__2.r - temp.i * z__2.i,
+ z__1.i = temp.r * z__2.i + temp.i *
+ z__2.r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ for (i__ = j - 1; i__ >= 1; --i__) {
+ ix -= *incx;
+ d_cnjg(&z__3, &a[i__ + j * a_dim1]);
+ i__1 = ix;
+ z__2.r = z__3.r * x[i__1].r - z__3.i * x[i__1].i,
+ z__2.i = z__3.r * x[i__1].i + z__3.i * x[
+ i__1].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i +
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L130: */
+ }
+ }
+ i__1 = jx;
+ x[i__1].r = temp.r, x[i__1].i = temp.i;
+ jx -= *incx;
+/* L140: */
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ temp.r = x[i__2].r, temp.i = x[i__2].i;
+ if (noconj) {
+ if (nounit) {
+ i__2 = j + j * a_dim1;
+ z__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i,
+ z__1.i = temp.r * a[i__2].i + temp.i * a[
+ i__2].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ i__4 = i__;
+ z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[
+ i__4].i, z__2.i = a[i__3].r * x[i__4].i +
+ a[i__3].i * x[i__4].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i +
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L150: */
+ }
+ } else {
+ if (nounit) {
+ d_cnjg(&z__2, &a[j + j * a_dim1]);
+ z__1.r = temp.r * z__2.r - temp.i * z__2.i,
+ z__1.i = temp.r * z__2.i + temp.i *
+ z__2.r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ d_cnjg(&z__3, &a[i__ + j * a_dim1]);
+ i__3 = i__;
+ z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
+ z__2.i = z__3.r * x[i__3].i + z__3.i * x[
+ i__3].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i +
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L160: */
+ }
+ }
+ i__2 = j;
+ x[i__2].r = temp.r, x[i__2].i = temp.i;
+/* L170: */
+ }
+ } else {
+ jx = kx;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = jx;
+ temp.r = x[i__2].r, temp.i = x[i__2].i;
+ ix = jx;
+ if (noconj) {
+ if (nounit) {
+ i__2 = j + j * a_dim1;
+ z__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i,
+ z__1.i = temp.r * a[i__2].i + temp.i * a[
+ i__2].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ ix += *incx;
+ i__3 = i__ + j * a_dim1;
+ i__4 = ix;
+ z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[
+ i__4].i, z__2.i = a[i__3].r * x[i__4].i +
+ a[i__3].i * x[i__4].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i +
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L180: */
+ }
+ } else {
+ if (nounit) {
+ d_cnjg(&z__2, &a[j + j * a_dim1]);
+ z__1.r = temp.r * z__2.r - temp.i * z__2.i,
+ z__1.i = temp.r * z__2.i + temp.i *
+ z__2.r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ ix += *incx;
+ d_cnjg(&z__3, &a[i__ + j * a_dim1]);
+ i__3 = ix;
+ z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
+ z__2.i = z__3.r * x[i__3].i + z__3.i * x[
+ i__3].r;
+ z__1.r = temp.r + z__2.r, z__1.i = temp.i +
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L190: */
+ }
+ }
+ i__2 = jx;
+ x[i__2].r = temp.r, x[i__2].i = temp.i;
+ jx += *incx;
+/* L200: */
+ }
+ }
+ }
+ }
+
+ return 0;
+
+/* End of ZTRMV . */
+
+} /* ztrmv_ */
+
+/* Subroutine */ int ztrsm_(char *side, char *uplo, char *transa, char *diag,
+ integer *m, integer *n, doublecomplex *alpha, doublecomplex *a,
+ integer *lda, doublecomplex *b, integer *ldb)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4, i__5,
+ i__6, i__7;
+ doublecomplex z__1, z__2, z__3;
+
+ /* Builtin functions */
+ void z_div(doublecomplex *, doublecomplex *, doublecomplex *), d_cnjg(
+ doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, j, k, info;
+ static doublecomplex temp;
+ static logical lside;
+ extern logical lsame_(char *, char *);
+ static integer nrowa;
+ static logical upper;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static logical noconj, nounit;
+
+
+/*
+ Purpose
+ =======
+
+ ZTRSM solves one of the matrix equations
+
+ op( A )*X = alpha*B, or X*op( A ) = alpha*B,
+
+ where alpha is a scalar, X and B are m by n matrices, A is a unit, or
+ non-unit, upper or lower triangular matrix and op( A ) is one of
+
+ op( A ) = A or op( A ) = A' or op( A ) = conjg( A' ).
+
+ The matrix X is overwritten on B.
+
+ Parameters
+ ==========
+
+ SIDE - CHARACTER*1.
+ On entry, SIDE specifies whether op( A ) appears on the left
+ or right of X as follows:
+
+ SIDE = 'L' or 'l' op( A )*X = alpha*B.
+
+ SIDE = 'R' or 'r' X*op( A ) = alpha*B.
+
+ Unchanged on exit.
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix A is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANSA - CHARACTER*1.
+ On entry, TRANSA specifies the form of op( A ) to be used in
+ the matrix multiplication as follows:
+
+ TRANSA = 'N' or 'n' op( A ) = A.
+
+ TRANSA = 'T' or 't' op( A ) = A'.
+
+ TRANSA = 'C' or 'c' op( A ) = conjg( A' ).
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit triangular
+ as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ M - INTEGER.
+ On entry, M specifies the number of rows of B. M must be at
+ least zero.
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the number of columns of B. N must be
+ at least zero.
+ Unchanged on exit.
+
+ ALPHA - COMPLEX*16 .
+ On entry, ALPHA specifies the scalar alpha. When alpha is
+ zero then A is not referenced and B need not be set before
+ entry.
+ Unchanged on exit.
+
+ A - COMPLEX*16 array of DIMENSION ( LDA, k ), where k is m
+ when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'.
+ Before entry with UPLO = 'U' or 'u', the leading k by k
+ upper triangular part of the array A must contain the upper
+ triangular matrix and the strictly lower triangular part of
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading k by k
+ lower triangular part of the array A must contain the lower
+ triangular matrix and the strictly upper triangular part of
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. When SIDE = 'L' or 'l' then
+ LDA must be at least max( 1, m ), when SIDE = 'R' or 'r'
+ then LDA must be at least max( 1, n ).
+ Unchanged on exit.
+
+ B - COMPLEX*16 array of DIMENSION ( LDB, n ).
+ Before entry, the leading m by n part of the array B must
+ contain the right-hand side matrix B, and on exit is
+ overwritten by the solution matrix X.
+
+ LDB - INTEGER.
+ On entry, LDB specifies the first dimension of B as declared
+ in the calling (sub) program. LDB must be at least
+ max( 1, m ).
+ Unchanged on exit.
+
+
+ Level 3 Blas routine.
+
+ -- Written on 8-February-1989.
+ Jack Dongarra, Argonne National Laboratory.
+ Iain Duff, AERE Harwell.
+ Jeremy Du Croz, Numerical Algorithms Group Ltd.
+ Sven Hammarling, Numerical Algorithms Group Ltd.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+
+ /* Function Body */
+ lside = lsame_(side, "L");
+ if (lside) {
+ nrowa = *m;
+ } else {
+ nrowa = *n;
+ }
+ noconj = lsame_(transa, "T");
+ nounit = lsame_(diag, "N");
+ upper = lsame_(uplo, "U");
+
+ info = 0;
+ if ((! lside && ! lsame_(side, "R"))) {
+ info = 1;
+ } else if ((! upper && ! lsame_(uplo, "L"))) {
+ info = 2;
+ } else if (((! lsame_(transa, "N") && ! lsame_(
+ transa, "T")) && ! lsame_(transa, "C"))) {
+ info = 3;
+ } else if ((! lsame_(diag, "U") && ! lsame_(diag,
+ "N"))) {
+ info = 4;
+ } else if (*m < 0) {
+ info = 5;
+ } else if (*n < 0) {
+ info = 6;
+ } else if (*lda < max(1,nrowa)) {
+ info = 9;
+ } else if (*ldb < max(1,*m)) {
+ info = 11;
+ }
+ if (info != 0) {
+ xerbla_("ZTRSM ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+/* And when alpha.eq.zero. */
+
+ if ((alpha->r == 0. && alpha->i == 0.)) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ b[i__3].r = 0., b[i__3].i = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+ return 0;
+ }
+
+/* Start the operations. */
+
+ if (lside) {
+ if (lsame_(transa, "N")) {
+
+/* Form B := alpha*inv( A )*B. */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (alpha->r != 1. || alpha->i != 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ i__4 = i__ + j * b_dim1;
+ z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]
+ .i, z__1.i = alpha->r * b[i__4].i +
+ alpha->i * b[i__4].r;
+ b[i__3].r = z__1.r, b[i__3].i = z__1.i;
+/* L30: */
+ }
+ }
+ for (k = *m; k >= 1; --k) {
+ i__2 = k + j * b_dim1;
+ if (b[i__2].r != 0. || b[i__2].i != 0.) {
+ if (nounit) {
+ i__2 = k + j * b_dim1;
+ z_div(&z__1, &b[k + j * b_dim1], &a[k + k *
+ a_dim1]);
+ b[i__2].r = z__1.r, b[i__2].i = z__1.i;
+ }
+ i__2 = k - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ i__4 = i__ + j * b_dim1;
+ i__5 = k + j * b_dim1;
+ i__6 = i__ + k * a_dim1;
+ z__2.r = b[i__5].r * a[i__6].r - b[i__5].i *
+ a[i__6].i, z__2.i = b[i__5].r * a[
+ i__6].i + b[i__5].i * a[i__6].r;
+ z__1.r = b[i__4].r - z__2.r, z__1.i = b[i__4]
+ .i - z__2.i;
+ b[i__3].r = z__1.r, b[i__3].i = z__1.i;
+/* L40: */
+ }
+ }
+/* L50: */
+ }
+/* L60: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (alpha->r != 1. || alpha->i != 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ i__4 = i__ + j * b_dim1;
+ z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]
+ .i, z__1.i = alpha->r * b[i__4].i +
+ alpha->i * b[i__4].r;
+ b[i__3].r = z__1.r, b[i__3].i = z__1.i;
+/* L70: */
+ }
+ }
+ i__2 = *m;
+ for (k = 1; k <= i__2; ++k) {
+ i__3 = k + j * b_dim1;
+ if (b[i__3].r != 0. || b[i__3].i != 0.) {
+ if (nounit) {
+ i__3 = k + j * b_dim1;
+ z_div(&z__1, &b[k + j * b_dim1], &a[k + k *
+ a_dim1]);
+ b[i__3].r = z__1.r, b[i__3].i = z__1.i;
+ }
+ i__3 = *m;
+ for (i__ = k + 1; i__ <= i__3; ++i__) {
+ i__4 = i__ + j * b_dim1;
+ i__5 = i__ + j * b_dim1;
+ i__6 = k + j * b_dim1;
+ i__7 = i__ + k * a_dim1;
+ z__2.r = b[i__6].r * a[i__7].r - b[i__6].i *
+ a[i__7].i, z__2.i = b[i__6].r * a[
+ i__7].i + b[i__6].i * a[i__7].r;
+ z__1.r = b[i__5].r - z__2.r, z__1.i = b[i__5]
+ .i - z__2.i;
+ b[i__4].r = z__1.r, b[i__4].i = z__1.i;
+/* L80: */
+ }
+ }
+/* L90: */
+ }
+/* L100: */
+ }
+ }
+ } else {
+
+/*
+ Form B := alpha*inv( A' )*B
+ or B := alpha*inv( conjg( A' ) )*B.
+*/
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3].i,
+ z__1.i = alpha->r * b[i__3].i + alpha->i * b[
+ i__3].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ if (noconj) {
+ i__3 = i__ - 1;
+ for (k = 1; k <= i__3; ++k) {
+ i__4 = k + i__ * a_dim1;
+ i__5 = k + j * b_dim1;
+ z__2.r = a[i__4].r * b[i__5].r - a[i__4].i *
+ b[i__5].i, z__2.i = a[i__4].r * b[
+ i__5].i + a[i__4].i * b[i__5].r;
+ z__1.r = temp.r - z__2.r, z__1.i = temp.i -
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L110: */
+ }
+ if (nounit) {
+ z_div(&z__1, &temp, &a[i__ + i__ * a_dim1]);
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ } else {
+ i__3 = i__ - 1;
+ for (k = 1; k <= i__3; ++k) {
+ d_cnjg(&z__3, &a[k + i__ * a_dim1]);
+ i__4 = k + j * b_dim1;
+ z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4]
+ .i, z__2.i = z__3.r * b[i__4].i +
+ z__3.i * b[i__4].r;
+ z__1.r = temp.r - z__2.r, z__1.i = temp.i -
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L120: */
+ }
+ if (nounit) {
+ d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
+ z_div(&z__1, &temp, &z__2);
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ }
+ i__3 = i__ + j * b_dim1;
+ b[i__3].r = temp.r, b[i__3].i = temp.i;
+/* L130: */
+ }
+/* L140: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ for (i__ = *m; i__ >= 1; --i__) {
+ i__2 = i__ + j * b_dim1;
+ z__1.r = alpha->r * b[i__2].r - alpha->i * b[i__2].i,
+ z__1.i = alpha->r * b[i__2].i + alpha->i * b[
+ i__2].r;
+ temp.r = z__1.r, temp.i = z__1.i;
+ if (noconj) {
+ i__2 = *m;
+ for (k = i__ + 1; k <= i__2; ++k) {
+ i__3 = k + i__ * a_dim1;
+ i__4 = k + j * b_dim1;
+ z__2.r = a[i__3].r * b[i__4].r - a[i__3].i *
+ b[i__4].i, z__2.i = a[i__3].r * b[
+ i__4].i + a[i__3].i * b[i__4].r;
+ z__1.r = temp.r - z__2.r, z__1.i = temp.i -
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L150: */
+ }
+ if (nounit) {
+ z_div(&z__1, &temp, &a[i__ + i__ * a_dim1]);
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ } else {
+ i__2 = *m;
+ for (k = i__ + 1; k <= i__2; ++k) {
+ d_cnjg(&z__3, &a[k + i__ * a_dim1]);
+ i__3 = k + j * b_dim1;
+ z__2.r = z__3.r * b[i__3].r - z__3.i * b[i__3]
+ .i, z__2.i = z__3.r * b[i__3].i +
+ z__3.i * b[i__3].r;
+ z__1.r = temp.r - z__2.r, z__1.i = temp.i -
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L160: */
+ }
+ if (nounit) {
+ d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
+ z_div(&z__1, &temp, &z__2);
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ }
+ i__2 = i__ + j * b_dim1;
+ b[i__2].r = temp.r, b[i__2].i = temp.i;
+/* L170: */
+ }
+/* L180: */
+ }
+ }
+ }
+ } else {
+ if (lsame_(transa, "N")) {
+
+/* Form B := alpha*B*inv( A ). */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (alpha->r != 1. || alpha->i != 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ i__4 = i__ + j * b_dim1;
+ z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]
+ .i, z__1.i = alpha->r * b[i__4].i +
+ alpha->i * b[i__4].r;
+ b[i__3].r = z__1.r, b[i__3].i = z__1.i;
+/* L190: */
+ }
+ }
+ i__2 = j - 1;
+ for (k = 1; k <= i__2; ++k) {
+ i__3 = k + j * a_dim1;
+ if (a[i__3].r != 0. || a[i__3].i != 0.) {
+ i__3 = *m;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ i__4 = i__ + j * b_dim1;
+ i__5 = i__ + j * b_dim1;
+ i__6 = k + j * a_dim1;
+ i__7 = i__ + k * b_dim1;
+ z__2.r = a[i__6].r * b[i__7].r - a[i__6].i *
+ b[i__7].i, z__2.i = a[i__6].r * b[
+ i__7].i + a[i__6].i * b[i__7].r;
+ z__1.r = b[i__5].r - z__2.r, z__1.i = b[i__5]
+ .i - z__2.i;
+ b[i__4].r = z__1.r, b[i__4].i = z__1.i;
+/* L200: */
+ }
+ }
+/* L210: */
+ }
+ if (nounit) {
+ z_div(&z__1, &c_b359, &a[j + j * a_dim1]);
+ temp.r = z__1.r, temp.i = z__1.i;
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ i__4 = i__ + j * b_dim1;
+ z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,
+ z__1.i = temp.r * b[i__4].i + temp.i * b[
+ i__4].r;
+ b[i__3].r = z__1.r, b[i__3].i = z__1.i;
+/* L220: */
+ }
+ }
+/* L230: */
+ }
+ } else {
+ for (j = *n; j >= 1; --j) {
+ if (alpha->r != 1. || alpha->i != 0.) {
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__ + j * b_dim1;
+ i__3 = i__ + j * b_dim1;
+ z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3]
+ .i, z__1.i = alpha->r * b[i__3].i +
+ alpha->i * b[i__3].r;
+ b[i__2].r = z__1.r, b[i__2].i = z__1.i;
+/* L240: */
+ }
+ }
+ i__1 = *n;
+ for (k = j + 1; k <= i__1; ++k) {
+ i__2 = k + j * a_dim1;
+ if (a[i__2].r != 0. || a[i__2].i != 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ i__4 = i__ + j * b_dim1;
+ i__5 = k + j * a_dim1;
+ i__6 = i__ + k * b_dim1;
+ z__2.r = a[i__5].r * b[i__6].r - a[i__5].i *
+ b[i__6].i, z__2.i = a[i__5].r * b[
+ i__6].i + a[i__5].i * b[i__6].r;
+ z__1.r = b[i__4].r - z__2.r, z__1.i = b[i__4]
+ .i - z__2.i;
+ b[i__3].r = z__1.r, b[i__3].i = z__1.i;
+/* L250: */
+ }
+ }
+/* L260: */
+ }
+ if (nounit) {
+ z_div(&z__1, &c_b359, &a[j + j * a_dim1]);
+ temp.r = z__1.r, temp.i = z__1.i;
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__ + j * b_dim1;
+ i__3 = i__ + j * b_dim1;
+ z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,
+ z__1.i = temp.r * b[i__3].i + temp.i * b[
+ i__3].r;
+ b[i__2].r = z__1.r, b[i__2].i = z__1.i;
+/* L270: */
+ }
+ }
+/* L280: */
+ }
+ }
+ } else {
+
+/*
+ Form B := alpha*B*inv( A' )
+ or B := alpha*B*inv( conjg( A' ) ).
+*/
+
+ if (upper) {
+ for (k = *n; k >= 1; --k) {
+ if (nounit) {
+ if (noconj) {
+ z_div(&z__1, &c_b359, &a[k + k * a_dim1]);
+ temp.r = z__1.r, temp.i = z__1.i;
+ } else {
+ d_cnjg(&z__2, &a[k + k * a_dim1]);
+ z_div(&z__1, &c_b359, &z__2);
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__ + k * b_dim1;
+ i__3 = i__ + k * b_dim1;
+ z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,
+ z__1.i = temp.r * b[i__3].i + temp.i * b[
+ i__3].r;
+ b[i__2].r = z__1.r, b[i__2].i = z__1.i;
+/* L290: */
+ }
+ }
+ i__1 = k - 1;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j + k * a_dim1;
+ if (a[i__2].r != 0. || a[i__2].i != 0.) {
+ if (noconj) {
+ i__2 = j + k * a_dim1;
+ temp.r = a[i__2].r, temp.i = a[i__2].i;
+ } else {
+ d_cnjg(&z__1, &a[j + k * a_dim1]);
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ i__4 = i__ + j * b_dim1;
+ i__5 = i__ + k * b_dim1;
+ z__2.r = temp.r * b[i__5].r - temp.i * b[i__5]
+ .i, z__2.i = temp.r * b[i__5].i +
+ temp.i * b[i__5].r;
+ z__1.r = b[i__4].r - z__2.r, z__1.i = b[i__4]
+ .i - z__2.i;
+ b[i__3].r = z__1.r, b[i__3].i = z__1.i;
+/* L300: */
+ }
+ }
+/* L310: */
+ }
+ if (alpha->r != 1. || alpha->i != 0.) {
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__ + k * b_dim1;
+ i__3 = i__ + k * b_dim1;
+ z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3]
+ .i, z__1.i = alpha->r * b[i__3].i +
+ alpha->i * b[i__3].r;
+ b[i__2].r = z__1.r, b[i__2].i = z__1.i;
+/* L320: */
+ }
+ }
+/* L330: */
+ }
+ } else {
+ i__1 = *n;
+ for (k = 1; k <= i__1; ++k) {
+ if (nounit) {
+ if (noconj) {
+ z_div(&z__1, &c_b359, &a[k + k * a_dim1]);
+ temp.r = z__1.r, temp.i = z__1.i;
+ } else {
+ d_cnjg(&z__2, &a[k + k * a_dim1]);
+ z_div(&z__1, &c_b359, &z__2);
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + k * b_dim1;
+ i__4 = i__ + k * b_dim1;
+ z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,
+ z__1.i = temp.r * b[i__4].i + temp.i * b[
+ i__4].r;
+ b[i__3].r = z__1.r, b[i__3].i = z__1.i;
+/* L340: */
+ }
+ }
+ i__2 = *n;
+ for (j = k + 1; j <= i__2; ++j) {
+ i__3 = j + k * a_dim1;
+ if (a[i__3].r != 0. || a[i__3].i != 0.) {
+ if (noconj) {
+ i__3 = j + k * a_dim1;
+ temp.r = a[i__3].r, temp.i = a[i__3].i;
+ } else {
+ d_cnjg(&z__1, &a[j + k * a_dim1]);
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ i__3 = *m;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ i__4 = i__ + j * b_dim1;
+ i__5 = i__ + j * b_dim1;
+ i__6 = i__ + k * b_dim1;
+ z__2.r = temp.r * b[i__6].r - temp.i * b[i__6]
+ .i, z__2.i = temp.r * b[i__6].i +
+ temp.i * b[i__6].r;
+ z__1.r = b[i__5].r - z__2.r, z__1.i = b[i__5]
+ .i - z__2.i;
+ b[i__4].r = z__1.r, b[i__4].i = z__1.i;
+/* L350: */
+ }
+ }
+/* L360: */
+ }
+ if (alpha->r != 1. || alpha->i != 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + k * b_dim1;
+ i__4 = i__ + k * b_dim1;
+ z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]
+ .i, z__1.i = alpha->r * b[i__4].i +
+ alpha->i * b[i__4].r;
+ b[i__3].r = z__1.r, b[i__3].i = z__1.i;
+/* L370: */
+ }
+ }
+/* L380: */
+ }
+ }
+ }
+ }
+
+ return 0;
+
+/* End of ZTRSM . */
+
+} /* ztrsm_ */
+
+/* Subroutine */ int ztrsv_(char *uplo, char *trans, char *diag, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *x, integer *incx)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
+ doublecomplex z__1, z__2, z__3;
+
+ /* Builtin functions */
+ void z_div(doublecomplex *, doublecomplex *, doublecomplex *), d_cnjg(
+ doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, j, ix, jx, kx, info;
+ static doublecomplex temp;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static logical noconj, nounit;
+
+
+/*
+ Purpose
+ =======
+
+ ZTRSV solves one of the systems of equations
+
+ A*x = b, or A'*x = b, or conjg( A' )*x = b,
+
+ where b and x are n element vectors and A is an n by n unit, or
+ non-unit, upper or lower triangular matrix.
+
+ No test for singularity or near-singularity is included in this
+ routine. Such tests must be performed before calling this routine.
+
+ Parameters
+ ==========
+
+ UPLO - CHARACTER*1.
+ On entry, UPLO specifies whether the matrix is an upper or
+ lower triangular matrix as follows:
+
+ UPLO = 'U' or 'u' A is an upper triangular matrix.
+
+ UPLO = 'L' or 'l' A is a lower triangular matrix.
+
+ Unchanged on exit.
+
+ TRANS - CHARACTER*1.
+ On entry, TRANS specifies the equations to be solved as
+ follows:
+
+ TRANS = 'N' or 'n' A*x = b.
+
+ TRANS = 'T' or 't' A'*x = b.
+
+ TRANS = 'C' or 'c' conjg( A' )*x = b.
+
+ Unchanged on exit.
+
+ DIAG - CHARACTER*1.
+ On entry, DIAG specifies whether or not A is unit
+ triangular as follows:
+
+ DIAG = 'U' or 'u' A is assumed to be unit triangular.
+
+ DIAG = 'N' or 'n' A is not assumed to be unit
+ triangular.
+
+ Unchanged on exit.
+
+ N - INTEGER.
+ On entry, N specifies the order of the matrix A.
+ N must be at least zero.
+ Unchanged on exit.
+
+ A - COMPLEX*16 array of DIMENSION ( LDA, n ).
+ Before entry with UPLO = 'U' or 'u', the leading n by n
+ upper triangular part of the array A must contain the upper
+ triangular matrix and the strictly lower triangular part of
+ A is not referenced.
+ Before entry with UPLO = 'L' or 'l', the leading n by n
+ lower triangular part of the array A must contain the lower
+ triangular matrix and the strictly upper triangular part of
+ A is not referenced.
+ Note that when DIAG = 'U' or 'u', the diagonal elements of
+ A are not referenced either, but are assumed to be unity.
+ Unchanged on exit.
+
+ LDA - INTEGER.
+ On entry, LDA specifies the first dimension of A as declared
+ in the calling (sub) program. LDA must be at least
+ max( 1, n ).
+ Unchanged on exit.
+
+ X - COMPLEX*16 array of dimension at least
+ ( 1 + ( n - 1 )*abs( INCX ) ).
+ Before entry, the incremented array X must contain the n
+ element right-hand side vector b. On exit, X is overwritten
+ with the solution vector x.
+
+ INCX - INTEGER.
+ On entry, INCX specifies the increment for the elements of
+ X. INCX must not be zero.
+ Unchanged on exit.
+
+
+ Level 2 Blas routine.
+
+ -- Written on 22-October-1986.
+ Jack Dongarra, Argonne National Lab.
+ Jeremy Du Croz, Nag Central Office.
+ Sven Hammarling, Nag Central Office.
+ Richard Hanson, Sandia National Labs.
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --x;
+
+ /* Function Body */
+ info = 0;
+ if ((! lsame_(uplo, "U") && ! lsame_(uplo, "L"))) {
+ info = 1;
+ } else if (((! lsame_(trans, "N") && ! lsame_(trans,
+ "T")) && ! lsame_(trans, "C"))) {
+ info = 2;
+ } else if ((! lsame_(diag, "U") && ! lsame_(diag,
+ "N"))) {
+ info = 3;
+ } else if (*n < 0) {
+ info = 4;
+ } else if (*lda < max(1,*n)) {
+ info = 6;
+ } else if (*incx == 0) {
+ info = 8;
+ }
+ if (info != 0) {
+ xerbla_("ZTRSV ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+ noconj = lsame_(trans, "T");
+ nounit = lsame_(diag, "N");
+
+/*
+ Set up the start point in X if the increment is not unity. This
+ will be ( N - 1 )*INCX too small for descending loops.
+*/
+
+ if (*incx <= 0) {
+ kx = 1 - (*n - 1) * *incx;
+ } else if (*incx != 1) {
+ kx = 1;
+ }
+
+/*
+ Start the operations. In this version the elements of A are
+ accessed sequentially with one pass through A.
+*/
+
+ if (lsame_(trans, "N")) {
+
+/* Form x := inv( A )*x. */
+
+ if (lsame_(uplo, "U")) {
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ i__1 = j;
+ if (x[i__1].r != 0. || x[i__1].i != 0.) {
+ if (nounit) {
+ i__1 = j;
+ z_div(&z__1, &x[j], &a[j + j * a_dim1]);
+ x[i__1].r = z__1.r, x[i__1].i = z__1.i;
+ }
+ i__1 = j;
+ temp.r = x[i__1].r, temp.i = x[i__1].i;
+ for (i__ = j - 1; i__ >= 1; --i__) {
+ i__1 = i__;
+ i__2 = i__;
+ i__3 = i__ + j * a_dim1;
+ z__2.r = temp.r * a[i__3].r - temp.i * a[i__3].i,
+ z__2.i = temp.r * a[i__3].i + temp.i * a[
+ i__3].r;
+ z__1.r = x[i__2].r - z__2.r, z__1.i = x[i__2].i -
+ z__2.i;
+ x[i__1].r = z__1.r, x[i__1].i = z__1.i;
+/* L10: */
+ }
+ }
+/* L20: */
+ }
+ } else {
+ jx = kx + (*n - 1) * *incx;
+ for (j = *n; j >= 1; --j) {
+ i__1 = jx;
+ if (x[i__1].r != 0. || x[i__1].i != 0.) {
+ if (nounit) {
+ i__1 = jx;
+ z_div(&z__1, &x[jx], &a[j + j * a_dim1]);
+ x[i__1].r = z__1.r, x[i__1].i = z__1.i;
+ }
+ i__1 = jx;
+ temp.r = x[i__1].r, temp.i = x[i__1].i;
+ ix = jx;
+ for (i__ = j - 1; i__ >= 1; --i__) {
+ ix -= *incx;
+ i__1 = ix;
+ i__2 = ix;
+ i__3 = i__ + j * a_dim1;
+ z__2.r = temp.r * a[i__3].r - temp.i * a[i__3].i,
+ z__2.i = temp.r * a[i__3].i + temp.i * a[
+ i__3].r;
+ z__1.r = x[i__2].r - z__2.r, z__1.i = x[i__2].i -
+ z__2.i;
+ x[i__1].r = z__1.r, x[i__1].i = z__1.i;
+/* L30: */
+ }
+ }
+ jx -= *incx;
+/* L40: */
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ if (x[i__2].r != 0. || x[i__2].i != 0.) {
+ if (nounit) {
+ i__2 = j;
+ z_div(&z__1, &x[j], &a[j + j * a_dim1]);
+ x[i__2].r = z__1.r, x[i__2].i = z__1.i;
+ }
+ i__2 = j;
+ temp.r = x[i__2].r, temp.i = x[i__2].i;
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ i__3 = i__;
+ i__4 = i__;
+ i__5 = i__ + j * a_dim1;
+ z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
+ z__2.i = temp.r * a[i__5].i + temp.i * a[
+ i__5].r;
+ z__1.r = x[i__4].r - z__2.r, z__1.i = x[i__4].i -
+ z__2.i;
+ x[i__3].r = z__1.r, x[i__3].i = z__1.i;
+/* L50: */
+ }
+ }
+/* L60: */
+ }
+ } else {
+ jx = kx;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = jx;
+ if (x[i__2].r != 0. || x[i__2].i != 0.) {
+ if (nounit) {
+ i__2 = jx;
+ z_div(&z__1, &x[jx], &a[j + j * a_dim1]);
+ x[i__2].r = z__1.r, x[i__2].i = z__1.i;
+ }
+ i__2 = jx;
+ temp.r = x[i__2].r, temp.i = x[i__2].i;
+ ix = jx;
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ ix += *incx;
+ i__3 = ix;
+ i__4 = ix;
+ i__5 = i__ + j * a_dim1;
+ z__2.r = temp.r * a[i__5].r - temp.i * a[i__5].i,
+ z__2.i = temp.r * a[i__5].i + temp.i * a[
+ i__5].r;
+ z__1.r = x[i__4].r - z__2.r, z__1.i = x[i__4].i -
+ z__2.i;
+ x[i__3].r = z__1.r, x[i__3].i = z__1.i;
+/* L70: */
+ }
+ }
+ jx += *incx;
+/* L80: */
+ }
+ }
+ }
+ } else {
+
+/* Form x := inv( A' )*x or x := inv( conjg( A' ) )*x. */
+
+ if (lsame_(uplo, "U")) {
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ temp.r = x[i__2].r, temp.i = x[i__2].i;
+ if (noconj) {
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ i__4 = i__;
+ z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[
+ i__4].i, z__2.i = a[i__3].r * x[i__4].i +
+ a[i__3].i * x[i__4].r;
+ z__1.r = temp.r - z__2.r, z__1.i = temp.i -
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L90: */
+ }
+ if (nounit) {
+ z_div(&z__1, &temp, &a[j + j * a_dim1]);
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ } else {
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ d_cnjg(&z__3, &a[i__ + j * a_dim1]);
+ i__3 = i__;
+ z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
+ z__2.i = z__3.r * x[i__3].i + z__3.i * x[
+ i__3].r;
+ z__1.r = temp.r - z__2.r, z__1.i = temp.i -
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L100: */
+ }
+ if (nounit) {
+ d_cnjg(&z__2, &a[j + j * a_dim1]);
+ z_div(&z__1, &temp, &z__2);
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ }
+ i__2 = j;
+ x[i__2].r = temp.r, x[i__2].i = temp.i;
+/* L110: */
+ }
+ } else {
+ jx = kx;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ ix = kx;
+ i__2 = jx;
+ temp.r = x[i__2].r, temp.i = x[i__2].i;
+ if (noconj) {
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ i__4 = ix;
+ z__2.r = a[i__3].r * x[i__4].r - a[i__3].i * x[
+ i__4].i, z__2.i = a[i__3].r * x[i__4].i +
+ a[i__3].i * x[i__4].r;
+ z__1.r = temp.r - z__2.r, z__1.i = temp.i -
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ ix += *incx;
+/* L120: */
+ }
+ if (nounit) {
+ z_div(&z__1, &temp, &a[j + j * a_dim1]);
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ } else {
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ d_cnjg(&z__3, &a[i__ + j * a_dim1]);
+ i__3 = ix;
+ z__2.r = z__3.r * x[i__3].r - z__3.i * x[i__3].i,
+ z__2.i = z__3.r * x[i__3].i + z__3.i * x[
+ i__3].r;
+ z__1.r = temp.r - z__2.r, z__1.i = temp.i -
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ ix += *incx;
+/* L130: */
+ }
+ if (nounit) {
+ d_cnjg(&z__2, &a[j + j * a_dim1]);
+ z_div(&z__1, &temp, &z__2);
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ }
+ i__2 = jx;
+ x[i__2].r = temp.r, x[i__2].i = temp.i;
+ jx += *incx;
+/* L140: */
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ i__1 = j;
+ temp.r = x[i__1].r, temp.i = x[i__1].i;
+ if (noconj) {
+ i__1 = j + 1;
+ for (i__ = *n; i__ >= i__1; --i__) {
+ i__2 = i__ + j * a_dim1;
+ i__3 = i__;
+ z__2.r = a[i__2].r * x[i__3].r - a[i__2].i * x[
+ i__3].i, z__2.i = a[i__2].r * x[i__3].i +
+ a[i__2].i * x[i__3].r;
+ z__1.r = temp.r - z__2.r, z__1.i = temp.i -
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L150: */
+ }
+ if (nounit) {
+ z_div(&z__1, &temp, &a[j + j * a_dim1]);
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ } else {
+ i__1 = j + 1;
+ for (i__ = *n; i__ >= i__1; --i__) {
+ d_cnjg(&z__3, &a[i__ + j * a_dim1]);
+ i__2 = i__;
+ z__2.r = z__3.r * x[i__2].r - z__3.i * x[i__2].i,
+ z__2.i = z__3.r * x[i__2].i + z__3.i * x[
+ i__2].r;
+ z__1.r = temp.r - z__2.r, z__1.i = temp.i -
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+/* L160: */
+ }
+ if (nounit) {
+ d_cnjg(&z__2, &a[j + j * a_dim1]);
+ z_div(&z__1, &temp, &z__2);
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ }
+ i__1 = j;
+ x[i__1].r = temp.r, x[i__1].i = temp.i;
+/* L170: */
+ }
+ } else {
+ kx += (*n - 1) * *incx;
+ jx = kx;
+ for (j = *n; j >= 1; --j) {
+ ix = kx;
+ i__1 = jx;
+ temp.r = x[i__1].r, temp.i = x[i__1].i;
+ if (noconj) {
+ i__1 = j + 1;
+ for (i__ = *n; i__ >= i__1; --i__) {
+ i__2 = i__ + j * a_dim1;
+ i__3 = ix;
+ z__2.r = a[i__2].r * x[i__3].r - a[i__2].i * x[
+ i__3].i, z__2.i = a[i__2].r * x[i__3].i +
+ a[i__2].i * x[i__3].r;
+ z__1.r = temp.r - z__2.r, z__1.i = temp.i -
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ ix -= *incx;
+/* L180: */
+ }
+ if (nounit) {
+ z_div(&z__1, &temp, &a[j + j * a_dim1]);
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ } else {
+ i__1 = j + 1;
+ for (i__ = *n; i__ >= i__1; --i__) {
+ d_cnjg(&z__3, &a[i__ + j * a_dim1]);
+ i__2 = ix;
+ z__2.r = z__3.r * x[i__2].r - z__3.i * x[i__2].i,
+ z__2.i = z__3.r * x[i__2].i + z__3.i * x[
+ i__2].r;
+ z__1.r = temp.r - z__2.r, z__1.i = temp.i -
+ z__2.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ ix -= *incx;
+/* L190: */
+ }
+ if (nounit) {
+ d_cnjg(&z__2, &a[j + j * a_dim1]);
+ z_div(&z__1, &temp, &z__2);
+ temp.r = z__1.r, temp.i = z__1.i;
+ }
+ }
+ i__1 = jx;
+ x[i__1].r = temp.r, x[i__1].i = temp.i;
+ jx -= *incx;
+/* L200: */
+ }
+ }
+ }
+ }
+
+ return 0;
+
+/* End of ZTRSV . */
+
+} /* ztrsv_ */
+
diff --git a/numpy/linalg/dlamch.c b/numpy/linalg/dlamch.c
new file mode 100644
index 000000000..bf1dfdb05
--- /dev/null
+++ b/numpy/linalg/dlamch.c
@@ -0,0 +1,951 @@
+#include <stdio.h>
+#include "f2c.h"
+
+/* If config.h is available, we only need dlamc3 */
+#ifndef HAVE_CONFIG
+doublereal dlamch_(char *cmach)
+{
+/* -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLAMCH determines double precision machine parameters.
+
+ Arguments
+ =========
+
+ CMACH (input) CHARACTER*1
+ Specifies the value to be returned by DLAMCH:
+ = 'E' or 'e', DLAMCH := eps
+ = 'S' or 's , DLAMCH := sfmin
+ = 'B' or 'b', DLAMCH := base
+ = 'P' or 'p', DLAMCH := eps*base
+ = 'N' or 'n', DLAMCH := t
+ = 'R' or 'r', DLAMCH := rnd
+ = 'M' or 'm', DLAMCH := emin
+ = 'U' or 'u', DLAMCH := rmin
+ = 'L' or 'l', DLAMCH := emax
+ = 'O' or 'o', DLAMCH := rmax
+
+ where
+
+ eps = relative machine precision
+ sfmin = safe minimum, such that 1/sfmin does not overflow
+ base = base of the machine
+ prec = eps*base
+ t = number of (base) digits in the mantissa
+ rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
+ emin = minimum exponent before (gradual) underflow
+ rmin = underflow threshold - base**(emin-1)
+ emax = largest exponent before overflow
+ rmax = overflow threshold - (base**emax)*(1-eps)
+
+ =====================================================================
+*/
+/* >>Start of File<<
+ Initialized data */
+ static logical first = TRUE_;
+ /* System generated locals */
+ integer i__1;
+ doublereal ret_val;
+ /* Builtin functions */
+ double pow_di(doublereal *, integer *);
+ /* Local variables */
+ static doublereal base;
+ static integer beta;
+ static doublereal emin, prec, emax;
+ static integer imin, imax;
+ static logical lrnd;
+ static doublereal rmin, rmax, t, rmach;
+ extern logical lsame_(char *, char *);
+ static doublereal small, sfmin;
+ extern /* Subroutine */ int dlamc2_(integer *, integer *, logical *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *);
+ static integer it;
+ static doublereal rnd, eps;
+
+
+
+ if (first) {
+ first = FALSE_;
+ dlamc2_(&beta, &it, &lrnd, &eps, &imin, &rmin, &imax, &rmax);
+ base = (doublereal) beta;
+ t = (doublereal) it;
+ if (lrnd) {
+ rnd = 1.;
+ i__1 = 1 - it;
+ eps = pow_di(&base, &i__1) / 2;
+ } else {
+ rnd = 0.;
+ i__1 = 1 - it;
+ eps = pow_di(&base, &i__1);
+ }
+ prec = eps * base;
+ emin = (doublereal) imin;
+ emax = (doublereal) imax;
+ sfmin = rmin;
+ small = 1. / rmax;
+ if (small >= sfmin) {
+
+/* Use SMALL plus a bit, to avoid the possibility of rou
+nding
+ causing overflow when computing 1/sfmin. */
+
+ sfmin = small * (eps + 1.);
+ }
+ }
+
+ if (lsame_(cmach, "E")) {
+ rmach = eps;
+ } else if (lsame_(cmach, "S")) {
+ rmach = sfmin;
+ } else if (lsame_(cmach, "B")) {
+ rmach = base;
+ } else if (lsame_(cmach, "P")) {
+ rmach = prec;
+ } else if (lsame_(cmach, "N")) {
+ rmach = t;
+ } else if (lsame_(cmach, "R")) {
+ rmach = rnd;
+ } else if (lsame_(cmach, "M")) {
+ rmach = emin;
+ } else if (lsame_(cmach, "U")) {
+ rmach = rmin;
+ } else if (lsame_(cmach, "L")) {
+ rmach = emax;
+ } else if (lsame_(cmach, "O")) {
+ rmach = rmax;
+ }
+
+ ret_val = rmach;
+ return ret_val;
+
+/* End of DLAMCH */
+
+} /* dlamch_ */
+
+
+/* Subroutine */ int dlamc1_(integer *beta, integer *t, logical *rnd, logical
+ *ieee1)
+{
+/* -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLAMC1 determines the machine parameters given by BETA, T, RND, and
+ IEEE1.
+
+ Arguments
+ =========
+
+ BETA (output) INTEGER
+ The base of the machine.
+
+ T (output) INTEGER
+ The number of ( BETA ) digits in the mantissa.
+
+ RND (output) LOGICAL
+ Specifies whether proper rounding ( RND = .TRUE. ) or
+ chopping ( RND = .FALSE. ) occurs in addition. This may not
+
+ be a reliable guide to the way in which the machine performs
+
+ its arithmetic.
+
+ IEEE1 (output) LOGICAL
+ Specifies whether rounding appears to be done in the IEEE
+ 'round to nearest' style.
+
+ Further Details
+ ===============
+
+ The routine is based on the routine ENVRON by Malcolm and
+ incorporates suggestions by Gentleman and Marovich. See
+
+ Malcolm M. A. (1972) Algorithms to reveal properties of
+ floating-point arithmetic. Comms. of the ACM, 15, 949-951.
+
+ Gentleman W. M. and Marovich S. B. (1974) More on algorithms
+ that reveal properties of floating point arithmetic units.
+ Comms. of the ACM, 17, 276-277.
+
+ =====================================================================
+*/
+ /* Initialized data */
+ static logical first = TRUE_;
+ /* System generated locals */
+ doublereal d__1, d__2;
+ /* Local variables */
+ static logical lrnd;
+ static doublereal a, b, c, f;
+ static integer lbeta;
+ static doublereal savec;
+ extern doublereal dlamc3_(doublereal *, doublereal *);
+ static logical lieee1;
+ static doublereal t1, t2;
+ static integer lt;
+ static doublereal one, qtr;
+
+
+
+ if (first) {
+ first = FALSE_;
+ one = 1.;
+
+/* LBETA, LIEEE1, LT and LRND are the local values of BE
+TA,
+ IEEE1, T and RND.
+
+ Throughout this routine we use the function DLAMC3 to ens
+ure
+ that relevant values are stored and not held in registers,
+ or
+ are not affected by optimizers.
+
+ Compute a = 2.0**m with the smallest positive integer m s
+uch
+ that
+
+ fl( a + 1.0 ) = a. */
+
+ a = 1.;
+ c = 1.;
+
+/* + WHILE( C.EQ.ONE )LOOP */
+L10:
+ if (c == one) {
+ a *= 2;
+ c = dlamc3_(&a, &one);
+ d__1 = -a;
+ c = dlamc3_(&c, &d__1);
+ goto L10;
+ }
+/* + END WHILE
+
+ Now compute b = 2.0**m with the smallest positive integer
+m
+ such that
+
+ fl( a + b ) .gt. a. */
+
+ b = 1.;
+ c = dlamc3_(&a, &b);
+
+/* + WHILE( C.EQ.A )LOOP */
+L20:
+ if (c == a) {
+ b *= 2;
+ c = dlamc3_(&a, &b);
+ goto L20;
+ }
+/* + END WHILE
+
+ Now compute the base. a and c are neighbouring floating po
+int
+ numbers in the interval ( beta**t, beta**( t + 1 ) ) and
+ so
+ their difference is beta. Adding 0.25 to c is to ensure that
+ it
+ is truncated to beta and not ( beta - 1 ). */
+
+ qtr = one / 4;
+ savec = c;
+ d__1 = -a;
+ c = dlamc3_(&c, &d__1);
+ lbeta = (integer) (c + qtr);
+
+/* Now determine whether rounding or chopping occurs, by addin
+g a
+ bit less than beta/2 and a bit more than beta/2 to
+ a. */
+
+ b = (doublereal) lbeta;
+ d__1 = b / 2;
+ d__2 = -b / 100;
+ f = dlamc3_(&d__1, &d__2);
+ c = dlamc3_(&f, &a);
+ if (c == a) {
+ lrnd = TRUE_;
+ } else {
+ lrnd = FALSE_;
+ }
+ d__1 = b / 2;
+ d__2 = b / 100;
+ f = dlamc3_(&d__1, &d__2);
+ c = dlamc3_(&f, &a);
+ if (lrnd && c == a) {
+ lrnd = FALSE_;
+ }
+
+/* Try and decide whether rounding is done in the IEEE 'round
+ to
+ nearest' style. B/2 is half a unit in the last place of the
+two
+ numbers A and SAVEC. Furthermore, A is even, i.e. has last
+bit
+ zero, and SAVEC is odd. Thus adding B/2 to A should not cha
+nge
+ A, but adding B/2 to SAVEC should change SAVEC. */
+
+ d__1 = b / 2;
+ t1 = dlamc3_(&d__1, &a);
+ d__1 = b / 2;
+ t2 = dlamc3_(&d__1, &savec);
+ lieee1 = t1 == a && t2 > savec && lrnd;
+
+/* Now find the mantissa, t. It should be the integer part
+ of
+ log to the base beta of a, however it is safer to determine
+ t
+ by powering. So we find t as the smallest positive integer
+for
+ which
+
+ fl( beta**t + 1.0 ) = 1.0. */
+
+ lt = 0;
+ a = 1.;
+ c = 1.;
+
+/* + WHILE( C.EQ.ONE )LOOP */
+L30:
+ if (c == one) {
+ ++lt;
+ a *= lbeta;
+ c = dlamc3_(&a, &one);
+ d__1 = -a;
+ c = dlamc3_(&c, &d__1);
+ goto L30;
+ }
+/* + END WHILE */
+
+ }
+
+ *beta = lbeta;
+ *t = lt;
+ *rnd = lrnd;
+ *ieee1 = lieee1;
+ return 0;
+
+/* End of DLAMC1 */
+
+} /* dlamc1_ */
+
+
+/* Subroutine */ int dlamc2_(integer *beta, integer *t, logical *rnd,
+ doublereal *eps, integer *emin, doublereal *rmin, integer *emax,
+ doublereal *rmax)
+{
+/* -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLAMC2 determines the machine parameters specified in its argument
+ list.
+
+ Arguments
+ =========
+
+ BETA (output) INTEGER
+ The base of the machine.
+
+ T (output) INTEGER
+ The number of ( BETA ) digits in the mantissa.
+
+ RND (output) LOGICAL
+ Specifies whether proper rounding ( RND = .TRUE. ) or
+ chopping ( RND = .FALSE. ) occurs in addition. This may not
+
+ be a reliable guide to the way in which the machine performs
+
+ its arithmetic.
+
+ EPS (output) DOUBLE PRECISION
+ The smallest positive number such that
+
+ fl( 1.0 - EPS ) .LT. 1.0,
+
+ where fl denotes the computed value.
+
+ EMIN (output) INTEGER
+ The minimum exponent before (gradual) underflow occurs.
+
+ RMIN (output) DOUBLE PRECISION
+ The smallest normalized number for the machine, given by
+ BASE**( EMIN - 1 ), where BASE is the floating point value
+
+ of BETA.
+
+ EMAX (output) INTEGER
+ The maximum exponent before overflow occurs.
+
+ RMAX (output) DOUBLE PRECISION
+ The largest positive number for the machine, given by
+ BASE**EMAX * ( 1 - EPS ), where BASE is the floating point
+
+ value of BETA.
+
+ Further Details
+ ===============
+
+ The computation of EPS is based on a routine PARANOIA by
+ W. Kahan of the University of California at Berkeley.
+
+ =====================================================================
+*/
+
+ /* Initialized data */
+ static logical first = TRUE_;
+ static logical iwarn = FALSE_;
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1, d__2, d__3, d__4, d__5;
+ /* Builtin functions */
+ double pow_di(doublereal *, integer *);
+ /* Local variables */
+ static logical ieee;
+ static doublereal half;
+ static logical lrnd;
+ static doublereal leps, zero, a, b, c;
+ static integer i, lbeta;
+ static doublereal rbase;
+ static integer lemin, lemax, gnmin;
+ static doublereal small;
+ static integer gpmin;
+ static doublereal third, lrmin, lrmax, sixth;
+ extern /* Subroutine */ int dlamc1_(integer *, integer *, logical *,
+ logical *);
+ extern doublereal dlamc3_(doublereal *, doublereal *);
+ static logical lieee1;
+ extern /* Subroutine */ int dlamc4_(integer *, doublereal *, integer *),
+ dlamc5_(integer *, integer *, integer *, logical *, integer *,
+ doublereal *);
+ static integer lt, ngnmin, ngpmin;
+ static doublereal one, two;
+
+
+
+ if (first) {
+ first = FALSE_;
+ zero = 0.;
+ one = 1.;
+ two = 2.;
+
+/* LBETA, LT, LRND, LEPS, LEMIN and LRMIN are the local values
+ of
+ BETA, T, RND, EPS, EMIN and RMIN.
+
+ Throughout this routine we use the function DLAMC3 to ens
+ure
+ that relevant values are stored and not held in registers,
+ or
+ are not affected by optimizers.
+
+ DLAMC1 returns the parameters LBETA, LT, LRND and LIEEE1.
+*/
+
+ dlamc1_(&lbeta, &lt, &lrnd, &lieee1);
+
+/* Start to find EPS. */
+
+ b = (doublereal) lbeta;
+ i__1 = -lt;
+ a = pow_di(&b, &i__1);
+ leps = a;
+
+/* Try some tricks to see whether or not this is the correct E
+PS. */
+
+ b = two / 3;
+ half = one / 2;
+ d__1 = -half;
+ sixth = dlamc3_(&b, &d__1);
+ third = dlamc3_(&sixth, &sixth);
+ d__1 = -half;
+ b = dlamc3_(&third, &d__1);
+ b = dlamc3_(&b, &sixth);
+ b = abs(b);
+ if (b < leps) {
+ b = leps;
+ }
+
+ leps = 1.;
+
+/* + WHILE( ( LEPS.GT.B ).AND.( B.GT.ZERO ) )LOOP */
+L10:
+ if (leps > b && b > zero) {
+ leps = b;
+ d__1 = half * leps;
+/* Computing 5th power */
+ d__3 = two, d__4 = d__3, d__3 *= d__3;
+/* Computing 2nd power */
+ d__5 = leps;
+ d__2 = d__4 * (d__3 * d__3) * (d__5 * d__5);
+ c = dlamc3_(&d__1, &d__2);
+ d__1 = -c;
+ c = dlamc3_(&half, &d__1);
+ b = dlamc3_(&half, &c);
+ d__1 = -b;
+ c = dlamc3_(&half, &d__1);
+ b = dlamc3_(&half, &c);
+ goto L10;
+ }
+/* + END WHILE */
+
+ if (a < leps) {
+ leps = a;
+ }
+
+/* Computation of EPS complete.
+
+ Now find EMIN. Let A = + or - 1, and + or - (1 + BASE**(-3
+)).
+ Keep dividing A by BETA until (gradual) underflow occurs. T
+his
+ is detected when we cannot recover the previous A. */
+
+ rbase = one / lbeta;
+ small = one;
+ for (i = 1; i <= 3; ++i) {
+ d__1 = small * rbase;
+ small = dlamc3_(&d__1, &zero);
+/* L20: */
+ }
+ a = dlamc3_(&one, &small);
+ dlamc4_(&ngpmin, &one, &lbeta);
+ d__1 = -one;
+ dlamc4_(&ngnmin, &d__1, &lbeta);
+ dlamc4_(&gpmin, &a, &lbeta);
+ d__1 = -a;
+ dlamc4_(&gnmin, &d__1, &lbeta);
+ ieee = FALSE_;
+
+ if (ngpmin == ngnmin && gpmin == gnmin) {
+ if (ngpmin == gpmin) {
+ lemin = ngpmin;
+/* ( Non twos-complement machines, no gradual under
+flow;
+ e.g., VAX ) */
+ } else if (gpmin - ngpmin == 3) {
+ lemin = ngpmin - 1 + lt;
+ ieee = TRUE_;
+/* ( Non twos-complement machines, with gradual und
+erflow;
+ e.g., IEEE standard followers ) */
+ } else {
+ lemin = min(ngpmin,gpmin);
+/* ( A guess; no known machine ) */
+ iwarn = TRUE_;
+ }
+
+ } else if (ngpmin == gpmin && ngnmin == gnmin) {
+ if ((i__1 = ngpmin - ngnmin, abs(i__1)) == 1) {
+ lemin = max(ngpmin,ngnmin);
+/* ( Twos-complement machines, no gradual underflow
+;
+ e.g., CYBER 205 ) */
+ } else {
+ lemin = min(ngpmin,ngnmin);
+/* ( A guess; no known machine ) */
+ iwarn = TRUE_;
+ }
+
+ } else if ((i__1 = ngpmin - ngnmin, abs(i__1)) == 1 && gpmin == gnmin)
+ {
+ if (gpmin - min(ngpmin,ngnmin) == 3) {
+ lemin = max(ngpmin,ngnmin) - 1 + lt;
+/* ( Twos-complement machines with gradual underflo
+w;
+ no known machine ) */
+ } else {
+ lemin = min(ngpmin,ngnmin);
+/* ( A guess; no known machine ) */
+ iwarn = TRUE_;
+ }
+
+ } else {
+/* Computing MIN */
+ i__1 = min(ngpmin,ngnmin), i__1 = min(i__1,gpmin);
+ lemin = min(i__1,gnmin);
+/* ( A guess; no known machine ) */
+ iwarn = TRUE_;
+ }
+/* **
+ Comment out this if block if EMIN is ok */
+ if (iwarn) {
+ first = TRUE_;
+ printf("\n\n WARNING. The value EMIN may be incorrect:- ");
+ printf("EMIN = %8i\n",lemin);
+ printf("If, after inspection, the value EMIN looks acceptable");
+ printf("please comment out \n the IF block as marked within the");
+ printf("code of routine DLAMC2, \n otherwise supply EMIN");
+ printf("explicitly.\n");
+ }
+/* **
+
+ Assume IEEE arithmetic if we found denormalised numbers abo
+ve,
+ or if arithmetic seems to round in the IEEE style, determi
+ned
+ in routine DLAMC1. A true IEEE machine should have both thi
+ngs
+ true; however, faulty machines may have one or the other. */
+
+ ieee = ieee || lieee1;
+
+/* Compute RMIN by successive division by BETA. We could comp
+ute
+ RMIN as BASE**( EMIN - 1 ), but some machines underflow dur
+ing
+ this computation. */
+
+ lrmin = 1.;
+ i__1 = 1 - lemin;
+ for (i = 1; i <= 1-lemin; ++i) {
+ d__1 = lrmin * rbase;
+ lrmin = dlamc3_(&d__1, &zero);
+/* L30: */
+ }
+
+/* Finally, call DLAMC5 to compute EMAX and RMAX. */
+
+ dlamc5_(&lbeta, &lt, &lemin, &ieee, &lemax, &lrmax);
+ }
+
+ *beta = lbeta;
+ *t = lt;
+ *rnd = lrnd;
+ *eps = leps;
+ *emin = lemin;
+ *rmin = lrmin;
+ *emax = lemax;
+ *rmax = lrmax;
+
+ return 0;
+
+
+/* End of DLAMC2 */
+
+} /* dlamc2_ */
+#endif
+
+
+doublereal dlamc3_(doublereal *a, doublereal *b)
+{
+/* -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLAMC3 is intended to force A and B to be stored prior to doing
+
+ the addition of A and B , for use in situations where optimizers
+
+ might hold one of these in a register.
+
+ Arguments
+ =========
+
+ A, B (input) DOUBLE PRECISION
+ The values A and B.
+
+ =====================================================================
+*/
+/* >>Start of File<<
+ System generated locals */
+ volatile doublereal ret_val;
+
+
+
+ ret_val = *a + *b;
+
+ return ret_val;
+
+/* End of DLAMC3 */
+
+} /* dlamc3_ */
+
+
+#ifndef HAVE_CONFIG
+/* Subroutine */ int dlamc4_(integer *emin, doublereal *start, integer *base)
+{
+/* -- LAPACK auxiliary routine (version 2.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLAMC4 is a service routine for DLAMC2.
+
+ Arguments
+ =========
+
+ EMIN (output) EMIN
+ The minimum exponent before (gradual) underflow, computed by
+
+ setting A = START and dividing by BASE until the previous A
+ can not be recovered.
+
+ START (input) DOUBLE PRECISION
+ The starting point for determining EMIN.
+
+ BASE (input) INTEGER
+ The base of the machine.
+
+ =====================================================================
+*/
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+ /* Local variables */
+ static doublereal zero, a;
+ static integer i;
+ static doublereal rbase, b1, b2, c1, c2, d1, d2;
+ extern doublereal dlamc3_(doublereal *, doublereal *);
+ static doublereal one;
+
+
+
+ a = *start;
+ one = 1.;
+ rbase = one / *base;
+ zero = 0.;
+ *emin = 1;
+ d__1 = a * rbase;
+ b1 = dlamc3_(&d__1, &zero);
+ c1 = a;
+ c2 = a;
+ d1 = a;
+ d2 = a;
+/* + WHILE( ( C1.EQ.A ).AND.( C2.EQ.A ).AND.
+ $ ( D1.EQ.A ).AND.( D2.EQ.A ) )LOOP */
+L10:
+ if (c1 == a && c2 == a && d1 == a && d2 == a) {
+ --(*emin);
+ a = b1;
+ d__1 = a / *base;
+ b1 = dlamc3_(&d__1, &zero);
+ d__1 = b1 * *base;
+ c1 = dlamc3_(&d__1, &zero);
+ d1 = zero;
+ i__1 = *base;
+ for (i = 1; i <= *base; ++i) {
+ d1 += b1;
+/* L20: */
+ }
+ d__1 = a * rbase;
+ b2 = dlamc3_(&d__1, &zero);
+ d__1 = b2 / rbase;
+ c2 = dlamc3_(&d__1, &zero);
+ d2 = zero;
+ i__1 = *base;
+ for (i = 1; i <= *base; ++i) {
+ d2 += b2;
+/* L30: */
+ }
+ goto L10;
+ }
+/* + END WHILE */
+
+ return 0;
+
+/* End of DLAMC4 */
+
+} /* dlamc4_ */
+
+
+/* Subroutine */ int dlamc5_(integer *beta, integer *p, integer *emin,
+ logical *ieee, integer *emax, doublereal *rmax)
+{
+/* -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLAMC5 attempts to compute RMAX, the largest machine floating-point
+ number, without overflow. It assumes that EMAX + abs(EMIN) sum
+ approximately to a power of 2. It will fail on machines where this
+ assumption does not hold, for example, the Cyber 205 (EMIN = -28625,
+
+ EMAX = 28718). It will also fail if the value supplied for EMIN is
+ too large (i.e. too close to zero), probably with overflow.
+
+ Arguments
+ =========
+
+ BETA (input) INTEGER
+ The base of floating-point arithmetic.
+
+ P (input) INTEGER
+ The number of base BETA digits in the mantissa of a
+ floating-point value.
+
+ EMIN (input) INTEGER
+ The minimum exponent before (gradual) underflow.
+
+ IEEE (input) LOGICAL
+ A logical flag specifying whether or not the arithmetic
+ system is thought to comply with the IEEE standard.
+
+ EMAX (output) INTEGER
+ The largest exponent before overflow
+
+ RMAX (output) DOUBLE PRECISION
+ The largest machine floating-point number.
+
+ =====================================================================
+
+
+
+ First compute LEXP and UEXP, two powers of 2 that bound
+ abs(EMIN). We then assume that EMAX + abs(EMIN) will sum
+ approximately to the bound that is closest to abs(EMIN).
+ (EMAX is the exponent of the required number RMAX). */
+ /* Table of constant values */
+ static doublereal c_b5 = 0.;
+
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+ /* Local variables */
+ static integer lexp;
+ static doublereal oldy;
+ static integer uexp, i;
+ static doublereal y, z;
+ static integer nbits;
+ extern doublereal dlamc3_(doublereal *, doublereal *);
+ static doublereal recbas;
+ static integer exbits, expsum, try__;
+
+
+
+ lexp = 1;
+ exbits = 1;
+L10:
+ try__ = lexp << 1;
+ if (try__ <= -(*emin)) {
+ lexp = try__;
+ ++exbits;
+ goto L10;
+ }
+ if (lexp == -(*emin)) {
+ uexp = lexp;
+ } else {
+ uexp = try__;
+ ++exbits;
+ }
+
+/* Now -LEXP is less than or equal to EMIN, and -UEXP is greater
+ than or equal to EMIN. EXBITS is the number of bits needed to
+ store the exponent. */
+
+ if (uexp + *emin > -lexp - *emin) {
+ expsum = lexp << 1;
+ } else {
+ expsum = uexp << 1;
+ }
+
+/* EXPSUM is the exponent range, approximately equal to
+ EMAX - EMIN + 1 . */
+
+ *emax = expsum + *emin - 1;
+ nbits = exbits + 1 + *p;
+
+/* NBITS is the total number of bits needed to store a
+ floating-point number. */
+
+ if (nbits % 2 == 1 && *beta == 2) {
+
+/* Either there are an odd number of bits used to store a
+ floating-point number, which is unlikely, or some bits are
+
+ not used in the representation of numbers, which is possible
+,
+ (e.g. Cray machines) or the mantissa has an implicit bit,
+ (e.g. IEEE machines, Dec Vax machines), which is perhaps the
+
+ most likely. We have to assume the last alternative.
+ If this is true, then we need to reduce EMAX by one because
+
+ there must be some way of representing zero in an implicit-b
+it
+ system. On machines like Cray, we are reducing EMAX by one
+
+ unnecessarily. */
+
+ --(*emax);
+ }
+
+ if (*ieee) {
+
+/* Assume we are on an IEEE machine which reserves one exponent
+
+ for infinity and NaN. */
+
+ --(*emax);
+ }
+
+/* Now create RMAX, the largest machine number, which should
+ be equal to (1.0 - BETA**(-P)) * BETA**EMAX .
+
+ First compute 1.0 - BETA**(-P), being careful that the
+ result is less than 1.0 . */
+
+ recbas = 1. / *beta;
+ z = *beta - 1.;
+ y = 0.;
+ i__1 = *p;
+ for (i = 1; i <= *p; ++i) {
+ z *= recbas;
+ if (y < 1.) {
+ oldy = y;
+ }
+ y = dlamc3_(&y, &z);
+/* L20: */
+ }
+ if (y >= 1.) {
+ y = oldy;
+ }
+
+/* Now multiply by BETA**EMAX to get RMAX. */
+
+ i__1 = *emax;
+ for (i = 1; i <= *emax; ++i) {
+ d__1 = y * *beta;
+ y = dlamc3_(&d__1, &c_b5);
+/* L30: */
+ }
+
+ *rmax = y;
+ return 0;
+
+/* End of DLAMC5 */
+
+} /* dlamc5_ */
+#endif
diff --git a/numpy/linalg/dlapack_lite.c b/numpy/linalg/dlapack_lite.c
new file mode 100644
index 000000000..e6634491f
--- /dev/null
+++ b/numpy/linalg/dlapack_lite.c
@@ -0,0 +1,36005 @@
+/*
+NOTE: This is generated code. Look in Misc/lapack_lite for information on
+ remaking this file.
+*/
+#include "f2c.h"
+
+#ifdef HAVE_CONFIG
+#include "config.h"
+#else
+extern doublereal dlamch_(char *);
+#define EPSILON dlamch_("Epsilon")
+#define SAFEMINIMUM dlamch_("Safe minimum")
+#define PRECISION dlamch_("Precision")
+#define BASE dlamch_("Base")
+#endif
+
+extern doublereal dlapy2_(doublereal *x, doublereal *y);
+
+
+
+/* Table of constant values */
+
+static integer c__9 = 9;
+static integer c__0 = 0;
+static doublereal c_b15 = 1.;
+static integer c__1 = 1;
+static doublereal c_b29 = 0.;
+static doublereal c_b94 = -.125;
+static doublereal c_b151 = -1.;
+static integer c_n1 = -1;
+static integer c__3 = 3;
+static integer c__2 = 2;
+static integer c__8 = 8;
+static integer c__4 = 4;
+static integer c__65 = 65;
+static integer c__6 = 6;
+static integer c__15 = 15;
+static logical c_false = FALSE_;
+static integer c__10 = 10;
+static integer c__11 = 11;
+static doublereal c_b2804 = 2.;
+static logical c_true = TRUE_;
+static real c_b3825 = 0.f;
+static real c_b3826 = 1.f;
+
+/* Subroutine */ int dbdsdc_(char *uplo, char *compq, integer *n, doublereal *
+ d__, doublereal *e, doublereal *u, integer *ldu, doublereal *vt,
+ integer *ldvt, doublereal *q, integer *iq, doublereal *work, integer *
+ iwork, integer *info)
+{
+ /* System generated locals */
+ integer u_dim1, u_offset, vt_dim1, vt_offset, i__1, i__2;
+ doublereal d__1;
+
+ /* Builtin functions */
+ double d_sign(doublereal *, doublereal *), log(doublereal);
+
+ /* Local variables */
+ static integer i__, j, k;
+ static doublereal p, r__;
+ static integer z__, ic, ii, kk;
+ static doublereal cs;
+ static integer is, iu;
+ static doublereal sn;
+ static integer nm1;
+ static doublereal eps;
+ static integer ivt, difl, difr, ierr, perm, mlvl, sqre;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dlasr_(char *, char *, char *, integer *,
+ integer *, doublereal *, doublereal *, doublereal *, integer *), dcopy_(integer *, doublereal *, integer *
+ , doublereal *, integer *), dswap_(integer *, doublereal *,
+ integer *, doublereal *, integer *);
+ static integer poles, iuplo, nsize, start;
+ extern /* Subroutine */ int dlasd0_(integer *, integer *, doublereal *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *,
+ integer *, integer *, doublereal *, integer *);
+
+ extern /* Subroutine */ int dlasda_(integer *, integer *, integer *,
+ integer *, doublereal *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, doublereal *,
+ doublereal *, integer *, integer *, integer *, integer *,
+ doublereal *, doublereal *, doublereal *, doublereal *, integer *,
+ integer *), dlascl_(char *, integer *, integer *, doublereal *,
+ doublereal *, integer *, integer *, doublereal *, integer *,
+ integer *), dlasdq_(char *, integer *, integer *, integer
+ *, integer *, integer *, doublereal *, doublereal *, doublereal *,
+ integer *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, integer *), dlaset_(char *, integer *,
+ integer *, doublereal *, doublereal *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *,
+ doublereal *, doublereal *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static integer givcol;
+ extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *);
+ static integer icompq;
+ static doublereal orgnrm;
+ static integer givnum, givptr, qstart, smlsiz, wstart, smlszp;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ December 1, 1999
+
+
+ Purpose
+ =======
+
+ DBDSDC computes the singular value decomposition (SVD) of a real
+ N-by-N (upper or lower) bidiagonal matrix B: B = U * S * VT,
+ using a divide and conquer method, where S is a diagonal matrix
+ with non-negative diagonal elements (the singular values of B), and
+ U and VT are orthogonal matrices of left and right singular vectors,
+ respectively. DBDSDC can be used to compute all singular values,
+ and optionally, singular vectors or singular vectors in compact form.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none. See DLASD3 for details.
+
+ The code currently call DLASDQ if singular values only are desired.
+ However, it can be slightly modified to compute singular values
+ using the divide and conquer method.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': B is upper bidiagonal.
+ = 'L': B is lower bidiagonal.
+
+ COMPQ (input) CHARACTER*1
+ Specifies whether singular vectors are to be computed
+ as follows:
+ = 'N': Compute singular values only;
+ = 'P': Compute singular values and compute singular
+ vectors in compact form;
+ = 'I': Compute singular values and singular vectors.
+
+ N (input) INTEGER
+ The order of the matrix B. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the bidiagonal matrix B.
+ On exit, if INFO=0, the singular values of B.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the elements of E contain the offdiagonal
+ elements of the bidiagonal matrix whose SVD is desired.
+ On exit, E has been destroyed.
+
+ U (output) DOUBLE PRECISION array, dimension (LDU,N)
+ If COMPQ = 'I', then:
+ On exit, if INFO = 0, U contains the left singular vectors
+ of the bidiagonal matrix.
+ For other values of COMPQ, U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= 1.
+ If singular vectors are desired, then LDU >= max( 1, N ).
+
+ VT (output) DOUBLE PRECISION array, dimension (LDVT,N)
+ If COMPQ = 'I', then:
+ On exit, if INFO = 0, VT' contains the right singular
+ vectors of the bidiagonal matrix.
+ For other values of COMPQ, VT is not referenced.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= 1.
+ If singular vectors are desired, then LDVT >= max( 1, N ).
+
+ Q (output) DOUBLE PRECISION array, dimension (LDQ)
+ If COMPQ = 'P', then:
+ On exit, if INFO = 0, Q and IQ contain the left
+ and right singular vectors in a compact form,
+ requiring O(N log N) space instead of 2*N**2.
+ In particular, Q contains all the DOUBLE PRECISION data in
+ LDQ >= N*(11 + 2*SMLSIZ + 8*INT(LOG_2(N/(SMLSIZ+1))))
+ words of memory, where SMLSIZ is returned by ILAENV and
+ is equal to the maximum size of the subproblems at the
+ bottom of the computation tree (usually about 25).
+ For other values of COMPQ, Q is not referenced.
+
+ IQ (output) INTEGER array, dimension (LDIQ)
+ If COMPQ = 'P', then:
+ On exit, if INFO = 0, Q and IQ contain the left
+ and right singular vectors in a compact form,
+ requiring O(N log N) space instead of 2*N**2.
+ In particular, IQ contains all INTEGER data in
+ LDIQ >= N*(3 + 3*INT(LOG_2(N/(SMLSIZ+1))))
+ words of memory, where SMLSIZ is returned by ILAENV and
+ is equal to the maximum size of the subproblems at the
+ bottom of the computation tree (usually about 25).
+ For other values of COMPQ, IQ is not referenced.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (LWORK)
+ If COMPQ = 'N' then LWORK >= (4 * N).
+ If COMPQ = 'P' then LWORK >= (6 * N).
+ If COMPQ = 'I' then LWORK >= (3 * N**2 + 4 * N).
+
+ IWORK (workspace) INTEGER array, dimension (8*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an singular value.
+ The update process of divide and conquer failed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ --e;
+ u_dim1 = *ldu;
+ u_offset = 1 + u_dim1 * 1;
+ u -= u_offset;
+ vt_dim1 = *ldvt;
+ vt_offset = 1 + vt_dim1 * 1;
+ vt -= vt_offset;
+ --q;
+ --iq;
+ --work;
+ --iwork;
+
+ /* Function Body */
+ *info = 0;
+
+ iuplo = 0;
+ if (lsame_(uplo, "U")) {
+ iuplo = 1;
+ }
+ if (lsame_(uplo, "L")) {
+ iuplo = 2;
+ }
+ if (lsame_(compq, "N")) {
+ icompq = 0;
+ } else if (lsame_(compq, "P")) {
+ icompq = 1;
+ } else if (lsame_(compq, "I")) {
+ icompq = 2;
+ } else {
+ icompq = -1;
+ }
+ if (iuplo == 0) {
+ *info = -1;
+ } else if (icompq < 0) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*ldu < 1 || (icompq == 2 && *ldu < *n)) {
+ *info = -7;
+ } else if (*ldvt < 1 || (icompq == 2 && *ldvt < *n)) {
+ *info = -9;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DBDSDC", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+ smlsiz = ilaenv_(&c__9, "DBDSDC", " ", &c__0, &c__0, &c__0, &c__0, (
+ ftnlen)6, (ftnlen)1);
+ if (*n == 1) {
+ if (icompq == 1) {
+ q[1] = d_sign(&c_b15, &d__[1]);
+ q[smlsiz * *n + 1] = 1.;
+ } else if (icompq == 2) {
+ u[u_dim1 + 1] = d_sign(&c_b15, &d__[1]);
+ vt[vt_dim1 + 1] = 1.;
+ }
+ d__[1] = abs(d__[1]);
+ return 0;
+ }
+ nm1 = *n - 1;
+
+/*
+ If matrix lower bidiagonal, rotate to be upper bidiagonal
+ by applying Givens rotations on the left
+*/
+
+ wstart = 1;
+ qstart = 3;
+ if (icompq == 1) {
+ dcopy_(n, &d__[1], &c__1, &q[1], &c__1);
+ i__1 = *n - 1;
+ dcopy_(&i__1, &e[1], &c__1, &q[*n + 1], &c__1);
+ }
+ if (iuplo == 2) {
+ qstart = 5;
+ wstart = ((*n) << (1)) - 1;
+ i__1 = *n - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dlartg_(&d__[i__], &e[i__], &cs, &sn, &r__);
+ d__[i__] = r__;
+ e[i__] = sn * d__[i__ + 1];
+ d__[i__ + 1] = cs * d__[i__ + 1];
+ if (icompq == 1) {
+ q[i__ + ((*n) << (1))] = cs;
+ q[i__ + *n * 3] = sn;
+ } else if (icompq == 2) {
+ work[i__] = cs;
+ work[nm1 + i__] = -sn;
+ }
+/* L10: */
+ }
+ }
+
+/* If ICOMPQ = 0, use DLASDQ to compute the singular values. */
+
+ if (icompq == 0) {
+ dlasdq_("U", &c__0, n, &c__0, &c__0, &c__0, &d__[1], &e[1], &vt[
+ vt_offset], ldvt, &u[u_offset], ldu, &u[u_offset], ldu, &work[
+ wstart], info);
+ goto L40;
+ }
+
+/*
+ If N is smaller than the minimum divide size SMLSIZ, then solve
+ the problem with another solver.
+*/
+
+ if (*n <= smlsiz) {
+ if (icompq == 2) {
+ dlaset_("A", n, n, &c_b29, &c_b15, &u[u_offset], ldu);
+ dlaset_("A", n, n, &c_b29, &c_b15, &vt[vt_offset], ldvt);
+ dlasdq_("U", &c__0, n, n, n, &c__0, &d__[1], &e[1], &vt[vt_offset]
+ , ldvt, &u[u_offset], ldu, &u[u_offset], ldu, &work[
+ wstart], info);
+ } else if (icompq == 1) {
+ iu = 1;
+ ivt = iu + *n;
+ dlaset_("A", n, n, &c_b29, &c_b15, &q[iu + (qstart - 1) * *n], n);
+ dlaset_("A", n, n, &c_b29, &c_b15, &q[ivt + (qstart - 1) * *n], n);
+ dlasdq_("U", &c__0, n, n, n, &c__0, &d__[1], &e[1], &q[ivt + (
+ qstart - 1) * *n], n, &q[iu + (qstart - 1) * *n], n, &q[
+ iu + (qstart - 1) * *n], n, &work[wstart], info);
+ }
+ goto L40;
+ }
+
+ if (icompq == 2) {
+ dlaset_("A", n, n, &c_b29, &c_b15, &u[u_offset], ldu);
+ dlaset_("A", n, n, &c_b29, &c_b15, &vt[vt_offset], ldvt);
+ }
+
+/* Scale. */
+
+ orgnrm = dlanst_("M", n, &d__[1], &e[1]);
+ if (orgnrm == 0.) {
+ return 0;
+ }
+ dlascl_("G", &c__0, &c__0, &orgnrm, &c_b15, n, &c__1, &d__[1], n, &ierr);
+ dlascl_("G", &c__0, &c__0, &orgnrm, &c_b15, &nm1, &c__1, &e[1], &nm1, &
+ ierr);
+
+ eps = EPSILON;
+
+ mlvl = (integer) (log((doublereal) (*n) / (doublereal) (smlsiz + 1)) /
+ log(2.)) + 1;
+ smlszp = smlsiz + 1;
+
+ if (icompq == 1) {
+ iu = 1;
+ ivt = smlsiz + 1;
+ difl = ivt + smlszp;
+ difr = difl + mlvl;
+ z__ = difr + ((mlvl) << (1));
+ ic = z__ + mlvl;
+ is = ic + 1;
+ poles = is + 1;
+ givnum = poles + ((mlvl) << (1));
+
+ k = 1;
+ givptr = 2;
+ perm = 3;
+ givcol = perm + mlvl;
+ }
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if ((d__1 = d__[i__], abs(d__1)) < eps) {
+ d__[i__] = d_sign(&eps, &d__[i__]);
+ }
+/* L20: */
+ }
+
+ start = 1;
+ sqre = 0;
+
+ i__1 = nm1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if ((d__1 = e[i__], abs(d__1)) < eps || i__ == nm1) {
+
+/*
+ Subproblem found. First determine its size and then
+ apply divide and conquer on it.
+*/
+
+ if (i__ < nm1) {
+
+/* A subproblem with E(I) small for I < NM1. */
+
+ nsize = i__ - start + 1;
+ } else if ((d__1 = e[i__], abs(d__1)) >= eps) {
+
+/* A subproblem with E(NM1) not too small but I = NM1. */
+
+ nsize = *n - start + 1;
+ } else {
+
+/*
+ A subproblem with E(NM1) small. This implies an
+ 1-by-1 subproblem at D(N). Solve this 1-by-1 problem
+ first.
+*/
+
+ nsize = i__ - start + 1;
+ if (icompq == 2) {
+ u[*n + *n * u_dim1] = d_sign(&c_b15, &d__[*n]);
+ vt[*n + *n * vt_dim1] = 1.;
+ } else if (icompq == 1) {
+ q[*n + (qstart - 1) * *n] = d_sign(&c_b15, &d__[*n]);
+ q[*n + (smlsiz + qstart - 1) * *n] = 1.;
+ }
+ d__[*n] = (d__1 = d__[*n], abs(d__1));
+ }
+ if (icompq == 2) {
+ dlasd0_(&nsize, &sqre, &d__[start], &e[start], &u[start +
+ start * u_dim1], ldu, &vt[start + start * vt_dim1],
+ ldvt, &smlsiz, &iwork[1], &work[wstart], info);
+ } else {
+ dlasda_(&icompq, &smlsiz, &nsize, &sqre, &d__[start], &e[
+ start], &q[start + (iu + qstart - 2) * *n], n, &q[
+ start + (ivt + qstart - 2) * *n], &iq[start + k * *n],
+ &q[start + (difl + qstart - 2) * *n], &q[start + (
+ difr + qstart - 2) * *n], &q[start + (z__ + qstart -
+ 2) * *n], &q[start + (poles + qstart - 2) * *n], &iq[
+ start + givptr * *n], &iq[start + givcol * *n], n, &
+ iq[start + perm * *n], &q[start + (givnum + qstart -
+ 2) * *n], &q[start + (ic + qstart - 2) * *n], &q[
+ start + (is + qstart - 2) * *n], &work[wstart], &
+ iwork[1], info);
+ if (*info != 0) {
+ return 0;
+ }
+ }
+ start = i__ + 1;
+ }
+/* L30: */
+ }
+
+/* Unscale */
+
+ dlascl_("G", &c__0, &c__0, &c_b15, &orgnrm, n, &c__1, &d__[1], n, &ierr);
+L40:
+
+/* Use Selection Sort to minimize swaps of singular vectors */
+
+ i__1 = *n;
+ for (ii = 2; ii <= i__1; ++ii) {
+ i__ = ii - 1;
+ kk = i__;
+ p = d__[i__];
+ i__2 = *n;
+ for (j = ii; j <= i__2; ++j) {
+ if (d__[j] > p) {
+ kk = j;
+ p = d__[j];
+ }
+/* L50: */
+ }
+ if (kk != i__) {
+ d__[kk] = d__[i__];
+ d__[i__] = p;
+ if (icompq == 1) {
+ iq[i__] = kk;
+ } else if (icompq == 2) {
+ dswap_(n, &u[i__ * u_dim1 + 1], &c__1, &u[kk * u_dim1 + 1], &
+ c__1);
+ dswap_(n, &vt[i__ + vt_dim1], ldvt, &vt[kk + vt_dim1], ldvt);
+ }
+ } else if (icompq == 1) {
+ iq[i__] = i__;
+ }
+/* L60: */
+ }
+
+/* If ICOMPQ = 1, use IQ(N,1) as the indicator for UPLO */
+
+ if (icompq == 1) {
+ if (iuplo == 1) {
+ iq[*n] = 1;
+ } else {
+ iq[*n] = 0;
+ }
+ }
+
+/*
+ If B is lower bidiagonal, update U by those Givens rotations
+ which rotated B to be upper bidiagonal
+*/
+
+ if ((iuplo == 2 && icompq == 2)) {
+ dlasr_("L", "V", "B", n, n, &work[1], &work[*n], &u[u_offset], ldu);
+ }
+
+ return 0;
+
+/* End of DBDSDC */
+
+} /* dbdsdc_ */
+
+/* Subroutine */ int dbdsqr_(char *uplo, integer *n, integer *ncvt, integer *
+ nru, integer *ncc, doublereal *d__, doublereal *e, doublereal *vt,
+ integer *ldvt, doublereal *u, integer *ldu, doublereal *c__, integer *
+ ldc, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer c_dim1, c_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1,
+ i__2;
+ doublereal d__1, d__2, d__3, d__4;
+
+ /* Builtin functions */
+ double pow_dd(doublereal *, doublereal *), sqrt(doublereal), d_sign(
+ doublereal *, doublereal *);
+
+ /* Local variables */
+ static doublereal f, g, h__;
+ static integer i__, j, m;
+ static doublereal r__, cs;
+ static integer ll;
+ static doublereal sn, mu;
+ static integer nm1, nm12, nm13, lll;
+ static doublereal eps, sll, tol, abse;
+ static integer idir;
+ static doublereal abss;
+ static integer oldm;
+ static doublereal cosl;
+ static integer isub, iter;
+ static doublereal unfl, sinl, cosr, smin, smax, sinr;
+ extern /* Subroutine */ int drot_(integer *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *), dlas2_(
+ doublereal *, doublereal *, doublereal *, doublereal *,
+ doublereal *), dscal_(integer *, doublereal *, doublereal *,
+ integer *);
+ extern logical lsame_(char *, char *);
+ static doublereal oldcs;
+ extern /* Subroutine */ int dlasr_(char *, char *, char *, integer *,
+ integer *, doublereal *, doublereal *, doublereal *, integer *);
+ static integer oldll;
+ static doublereal shift, sigmn, oldsn;
+ extern /* Subroutine */ int dswap_(integer *, doublereal *, integer *,
+ doublereal *, integer *);
+ static integer maxit;
+ static doublereal sminl, sigmx;
+ static logical lower;
+ extern /* Subroutine */ int dlasq1_(integer *, doublereal *, doublereal *,
+ doublereal *, integer *), dlasv2_(doublereal *, doublereal *,
+ doublereal *, doublereal *, doublereal *, doublereal *,
+ doublereal *, doublereal *, doublereal *);
+
+ extern /* Subroutine */ int dlartg_(doublereal *, doublereal *,
+ doublereal *, doublereal *, doublereal *), xerbla_(char *,
+ integer *);
+ static doublereal sminoa, thresh;
+ static logical rotate;
+ static doublereal sminlo, tolmul;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1999
+
+
+ Purpose
+ =======
+
+ DBDSQR computes the singular value decomposition (SVD) of a real
+ N-by-N (upper or lower) bidiagonal matrix B: B = Q * S * P' (P'
+ denotes the transpose of P), where S is a diagonal matrix with
+ non-negative diagonal elements (the singular values of B), and Q
+ and P are orthogonal matrices.
+
+ The routine computes S, and optionally computes U * Q, P' * VT,
+ or Q' * C, for given real input matrices U, VT, and C.
+
+ See "Computing Small Singular Values of Bidiagonal Matrices With
+ Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
+ LAPACK Working Note #3 (or SIAM J. Sci. Statist. Comput. vol. 11,
+ no. 5, pp. 873-912, Sept 1990) and
+ "Accurate singular values and differential qd algorithms," by
+ B. Parlett and V. Fernando, Technical Report CPAM-554, Mathematics
+ Department, University of California at Berkeley, July 1992
+ for a detailed description of the algorithm.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': B is upper bidiagonal;
+ = 'L': B is lower bidiagonal.
+
+ N (input) INTEGER
+ The order of the matrix B. N >= 0.
+
+ NCVT (input) INTEGER
+ The number of columns of the matrix VT. NCVT >= 0.
+
+ NRU (input) INTEGER
+ The number of rows of the matrix U. NRU >= 0.
+
+ NCC (input) INTEGER
+ The number of columns of the matrix C. NCC >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the bidiagonal matrix B.
+ On exit, if INFO=0, the singular values of B in decreasing
+ order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the elements of E contain the
+ offdiagonal elements of the bidiagonal matrix whose SVD
+ is desired. On normal exit (INFO = 0), E is destroyed.
+ If the algorithm does not converge (INFO > 0), D and E
+ will contain the diagonal and superdiagonal elements of a
+ bidiagonal matrix orthogonally equivalent to the one given
+ as input. E(N) is used for workspace.
+
+ VT (input/output) DOUBLE PRECISION array, dimension (LDVT, NCVT)
+ On entry, an N-by-NCVT matrix VT.
+ On exit, VT is overwritten by P' * VT.
+ VT is not referenced if NCVT = 0.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT.
+ LDVT >= max(1,N) if NCVT > 0; LDVT >= 1 if NCVT = 0.
+
+ U (input/output) DOUBLE PRECISION array, dimension (LDU, N)
+ On entry, an NRU-by-N matrix U.
+ On exit, U is overwritten by U * Q.
+ U is not referenced if NRU = 0.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max(1,NRU).
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC, NCC)
+ On entry, an N-by-NCC matrix C.
+ On exit, C is overwritten by Q' * C.
+ C is not referenced if NCC = 0.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C.
+ LDC >= max(1,N) if NCC > 0; LDC >=1 if NCC = 0.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: If INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm did not converge; D and E contain the
+ elements of a bidiagonal matrix which is orthogonally
+ similar to the input matrix B; if INFO = i, i
+ elements of E have not converged to zero.
+
+ Internal Parameters
+ ===================
+
+ TOLMUL DOUBLE PRECISION, default = max(10,min(100,EPS**(-1/8)))
+ TOLMUL controls the convergence criterion of the QR loop.
+ If it is positive, TOLMUL*EPS is the desired relative
+ precision in the computed singular values.
+ If it is negative, abs(TOLMUL*EPS*sigma_max) is the
+ desired absolute accuracy in the computed singular
+ values (corresponds to relative accuracy
+ abs(TOLMUL*EPS) in the largest singular value.
+ abs(TOLMUL) should be between 1 and 1/EPS, and preferably
+ between 10 (for fast convergence) and .1/EPS
+ (for there to be some accuracy in the results).
+ Default is to lose at either one eighth or 2 of the
+ available decimal digits in each computed singular value
+ (whichever is smaller).
+
+ MAXITR INTEGER, default = 6
+ MAXITR controls the maximum number of passes of the
+ algorithm through its inner loop. The algorithms stops
+ (and so fails to converge) if the number of passes
+ through the inner loop exceeds MAXITR*N**2.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ --e;
+ vt_dim1 = *ldvt;
+ vt_offset = 1 + vt_dim1 * 1;
+ vt -= vt_offset;
+ u_dim1 = *ldu;
+ u_offset = 1 + u_dim1 * 1;
+ u -= u_offset;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ lower = lsame_(uplo, "L");
+ if ((! lsame_(uplo, "U") && ! lower)) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*ncvt < 0) {
+ *info = -3;
+ } else if (*nru < 0) {
+ *info = -4;
+ } else if (*ncc < 0) {
+ *info = -5;
+ } else if ((*ncvt == 0 && *ldvt < 1) || (*ncvt > 0 && *ldvt < max(1,*n)))
+ {
+ *info = -9;
+ } else if (*ldu < max(1,*nru)) {
+ *info = -11;
+ } else if ((*ncc == 0 && *ldc < 1) || (*ncc > 0 && *ldc < max(1,*n))) {
+ *info = -13;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DBDSQR", &i__1);
+ return 0;
+ }
+ if (*n == 0) {
+ return 0;
+ }
+ if (*n == 1) {
+ goto L160;
+ }
+
+/* ROTATE is true if any singular vectors desired, false otherwise */
+
+ rotate = *ncvt > 0 || *nru > 0 || *ncc > 0;
+
+/* If no singular vectors desired, use qd algorithm */
+
+ if (! rotate) {
+ dlasq1_(n, &d__[1], &e[1], &work[1], info);
+ return 0;
+ }
+
+ nm1 = *n - 1;
+ nm12 = nm1 + nm1;
+ nm13 = nm12 + nm1;
+ idir = 0;
+
+/* Get machine constants */
+
+ eps = EPSILON;
+ unfl = SAFEMINIMUM;
+
+/*
+ If matrix lower bidiagonal, rotate to be upper bidiagonal
+ by applying Givens rotations on the left
+*/
+
+ if (lower) {
+ i__1 = *n - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dlartg_(&d__[i__], &e[i__], &cs, &sn, &r__);
+ d__[i__] = r__;
+ e[i__] = sn * d__[i__ + 1];
+ d__[i__ + 1] = cs * d__[i__ + 1];
+ work[i__] = cs;
+ work[nm1 + i__] = sn;
+/* L10: */
+ }
+
+/* Update singular vectors if desired */
+
+ if (*nru > 0) {
+ dlasr_("R", "V", "F", nru, n, &work[1], &work[*n], &u[u_offset],
+ ldu);
+ }
+ if (*ncc > 0) {
+ dlasr_("L", "V", "F", n, ncc, &work[1], &work[*n], &c__[c_offset],
+ ldc);
+ }
+ }
+
+/*
+ Compute singular values to relative accuracy TOL
+ (By setting TOL to be negative, algorithm will compute
+ singular values to absolute accuracy ABS(TOL)*norm(input matrix))
+
+ Computing MAX
+ Computing MIN
+*/
+ d__3 = 100., d__4 = pow_dd(&eps, &c_b94);
+ d__1 = 10., d__2 = min(d__3,d__4);
+ tolmul = max(d__1,d__2);
+ tol = tolmul * eps;
+
+/* Compute approximate maximum, minimum singular values */
+
+ smax = 0.;
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+/* Computing MAX */
+ d__2 = smax, d__3 = (d__1 = d__[i__], abs(d__1));
+ smax = max(d__2,d__3);
+/* L20: */
+ }
+ i__1 = *n - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+/* Computing MAX */
+ d__2 = smax, d__3 = (d__1 = e[i__], abs(d__1));
+ smax = max(d__2,d__3);
+/* L30: */
+ }
+ sminl = 0.;
+ if (tol >= 0.) {
+
+/* Relative accuracy desired */
+
+ sminoa = abs(d__[1]);
+ if (sminoa == 0.) {
+ goto L50;
+ }
+ mu = sminoa;
+ i__1 = *n;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ mu = (d__2 = d__[i__], abs(d__2)) * (mu / (mu + (d__1 = e[i__ - 1]
+ , abs(d__1))));
+ sminoa = min(sminoa,mu);
+ if (sminoa == 0.) {
+ goto L50;
+ }
+/* L40: */
+ }
+L50:
+ sminoa /= sqrt((doublereal) (*n));
+/* Computing MAX */
+ d__1 = tol * sminoa, d__2 = *n * 6 * *n * unfl;
+ thresh = max(d__1,d__2);
+ } else {
+
+/*
+ Absolute accuracy desired
+
+ Computing MAX
+*/
+ d__1 = abs(tol) * smax, d__2 = *n * 6 * *n * unfl;
+ thresh = max(d__1,d__2);
+ }
+
+/*
+ Prepare for main iteration loop for the singular values
+ (MAXIT is the maximum number of passes through the inner
+ loop permitted before nonconvergence signalled.)
+*/
+
+ maxit = *n * 6 * *n;
+ iter = 0;
+ oldll = -1;
+ oldm = -1;
+
+/* M points to last element of unconverged part of matrix */
+
+ m = *n;
+
+/* Begin main iteration loop */
+
+L60:
+
+/* Check for convergence or exceeding iteration count */
+
+ if (m <= 1) {
+ goto L160;
+ }
+ if (iter > maxit) {
+ goto L200;
+ }
+
+/* Find diagonal block of matrix to work on */
+
+ if ((tol < 0. && (d__1 = d__[m], abs(d__1)) <= thresh)) {
+ d__[m] = 0.;
+ }
+ smax = (d__1 = d__[m], abs(d__1));
+ smin = smax;
+ i__1 = m - 1;
+ for (lll = 1; lll <= i__1; ++lll) {
+ ll = m - lll;
+ abss = (d__1 = d__[ll], abs(d__1));
+ abse = (d__1 = e[ll], abs(d__1));
+ if ((tol < 0. && abss <= thresh)) {
+ d__[ll] = 0.;
+ }
+ if (abse <= thresh) {
+ goto L80;
+ }
+ smin = min(smin,abss);
+/* Computing MAX */
+ d__1 = max(smax,abss);
+ smax = max(d__1,abse);
+/* L70: */
+ }
+ ll = 0;
+ goto L90;
+L80:
+ e[ll] = 0.;
+
+/* Matrix splits since E(LL) = 0 */
+
+ if (ll == m - 1) {
+
+/* Convergence of bottom singular value, return to top of loop */
+
+ --m;
+ goto L60;
+ }
+L90:
+ ++ll;
+
+/* E(LL) through E(M-1) are nonzero, E(LL-1) is zero */
+
+ if (ll == m - 1) {
+
+/* 2 by 2 block, handle separately */
+
+ dlasv2_(&d__[m - 1], &e[m - 1], &d__[m], &sigmn, &sigmx, &sinr, &cosr,
+ &sinl, &cosl);
+ d__[m - 1] = sigmx;
+ e[m - 1] = 0.;
+ d__[m] = sigmn;
+
+/* Compute singular vectors, if desired */
+
+ if (*ncvt > 0) {
+ drot_(ncvt, &vt[m - 1 + vt_dim1], ldvt, &vt[m + vt_dim1], ldvt, &
+ cosr, &sinr);
+ }
+ if (*nru > 0) {
+ drot_(nru, &u[(m - 1) * u_dim1 + 1], &c__1, &u[m * u_dim1 + 1], &
+ c__1, &cosl, &sinl);
+ }
+ if (*ncc > 0) {
+ drot_(ncc, &c__[m - 1 + c_dim1], ldc, &c__[m + c_dim1], ldc, &
+ cosl, &sinl);
+ }
+ m += -2;
+ goto L60;
+ }
+
+/*
+ If working on new submatrix, choose shift direction
+ (from larger end diagonal element towards smaller)
+*/
+
+ if (ll > oldm || m < oldll) {
+ if ((d__1 = d__[ll], abs(d__1)) >= (d__2 = d__[m], abs(d__2))) {
+
+/* Chase bulge from top (big end) to bottom (small end) */
+
+ idir = 1;
+ } else {
+
+/* Chase bulge from bottom (big end) to top (small end) */
+
+ idir = 2;
+ }
+ }
+
+/* Apply convergence tests */
+
+ if (idir == 1) {
+
+/*
+ Run convergence test in forward direction
+ First apply standard test to bottom of matrix
+*/
+
+ if ((d__2 = e[m - 1], abs(d__2)) <= abs(tol) * (d__1 = d__[m], abs(
+ d__1)) || (tol < 0. && (d__3 = e[m - 1], abs(d__3)) <= thresh)
+ ) {
+ e[m - 1] = 0.;
+ goto L60;
+ }
+
+ if (tol >= 0.) {
+
+/*
+ If relative accuracy desired,
+ apply convergence criterion forward
+*/
+
+ mu = (d__1 = d__[ll], abs(d__1));
+ sminl = mu;
+ i__1 = m - 1;
+ for (lll = ll; lll <= i__1; ++lll) {
+ if ((d__1 = e[lll], abs(d__1)) <= tol * mu) {
+ e[lll] = 0.;
+ goto L60;
+ }
+ sminlo = sminl;
+ mu = (d__2 = d__[lll + 1], abs(d__2)) * (mu / (mu + (d__1 = e[
+ lll], abs(d__1))));
+ sminl = min(sminl,mu);
+/* L100: */
+ }
+ }
+
+ } else {
+
+/*
+ Run convergence test in backward direction
+ First apply standard test to top of matrix
+*/
+
+ if ((d__2 = e[ll], abs(d__2)) <= abs(tol) * (d__1 = d__[ll], abs(d__1)
+ ) || (tol < 0. && (d__3 = e[ll], abs(d__3)) <= thresh)) {
+ e[ll] = 0.;
+ goto L60;
+ }
+
+ if (tol >= 0.) {
+
+/*
+ If relative accuracy desired,
+ apply convergence criterion backward
+*/
+
+ mu = (d__1 = d__[m], abs(d__1));
+ sminl = mu;
+ i__1 = ll;
+ for (lll = m - 1; lll >= i__1; --lll) {
+ if ((d__1 = e[lll], abs(d__1)) <= tol * mu) {
+ e[lll] = 0.;
+ goto L60;
+ }
+ sminlo = sminl;
+ mu = (d__2 = d__[lll], abs(d__2)) * (mu / (mu + (d__1 = e[lll]
+ , abs(d__1))));
+ sminl = min(sminl,mu);
+/* L110: */
+ }
+ }
+ }
+ oldll = ll;
+ oldm = m;
+
+/*
+ Compute shift. First, test if shifting would ruin relative
+ accuracy, and if so set the shift to zero.
+
+ Computing MAX
+*/
+ d__1 = eps, d__2 = tol * .01;
+ if ((tol >= 0. && *n * tol * (sminl / smax) <= max(d__1,d__2))) {
+
+/* Use a zero shift to avoid loss of relative accuracy */
+
+ shift = 0.;
+ } else {
+
+/* Compute the shift from 2-by-2 block at end of matrix */
+
+ if (idir == 1) {
+ sll = (d__1 = d__[ll], abs(d__1));
+ dlas2_(&d__[m - 1], &e[m - 1], &d__[m], &shift, &r__);
+ } else {
+ sll = (d__1 = d__[m], abs(d__1));
+ dlas2_(&d__[ll], &e[ll], &d__[ll + 1], &shift, &r__);
+ }
+
+/* Test if shift negligible, and if so set to zero */
+
+ if (sll > 0.) {
+/* Computing 2nd power */
+ d__1 = shift / sll;
+ if (d__1 * d__1 < eps) {
+ shift = 0.;
+ }
+ }
+ }
+
+/* Increment iteration count */
+
+ iter = iter + m - ll;
+
+/* If SHIFT = 0, do simplified QR iteration */
+
+ if (shift == 0.) {
+ if (idir == 1) {
+
+/*
+ Chase bulge from top to bottom
+ Save cosines and sines for later singular vector updates
+*/
+
+ cs = 1.;
+ oldcs = 1.;
+ i__1 = m - 1;
+ for (i__ = ll; i__ <= i__1; ++i__) {
+ d__1 = d__[i__] * cs;
+ dlartg_(&d__1, &e[i__], &cs, &sn, &r__);
+ if (i__ > ll) {
+ e[i__ - 1] = oldsn * r__;
+ }
+ d__1 = oldcs * r__;
+ d__2 = d__[i__ + 1] * sn;
+ dlartg_(&d__1, &d__2, &oldcs, &oldsn, &d__[i__]);
+ work[i__ - ll + 1] = cs;
+ work[i__ - ll + 1 + nm1] = sn;
+ work[i__ - ll + 1 + nm12] = oldcs;
+ work[i__ - ll + 1 + nm13] = oldsn;
+/* L120: */
+ }
+ h__ = d__[m] * cs;
+ d__[m] = h__ * oldcs;
+ e[m - 1] = h__ * oldsn;
+
+/* Update singular vectors */
+
+ if (*ncvt > 0) {
+ i__1 = m - ll + 1;
+ dlasr_("L", "V", "F", &i__1, ncvt, &work[1], &work[*n], &vt[
+ ll + vt_dim1], ldvt);
+ }
+ if (*nru > 0) {
+ i__1 = m - ll + 1;
+ dlasr_("R", "V", "F", nru, &i__1, &work[nm12 + 1], &work[nm13
+ + 1], &u[ll * u_dim1 + 1], ldu);
+ }
+ if (*ncc > 0) {
+ i__1 = m - ll + 1;
+ dlasr_("L", "V", "F", &i__1, ncc, &work[nm12 + 1], &work[nm13
+ + 1], &c__[ll + c_dim1], ldc);
+ }
+
+/* Test convergence */
+
+ if ((d__1 = e[m - 1], abs(d__1)) <= thresh) {
+ e[m - 1] = 0.;
+ }
+
+ } else {
+
+/*
+ Chase bulge from bottom to top
+ Save cosines and sines for later singular vector updates
+*/
+
+ cs = 1.;
+ oldcs = 1.;
+ i__1 = ll + 1;
+ for (i__ = m; i__ >= i__1; --i__) {
+ d__1 = d__[i__] * cs;
+ dlartg_(&d__1, &e[i__ - 1], &cs, &sn, &r__);
+ if (i__ < m) {
+ e[i__] = oldsn * r__;
+ }
+ d__1 = oldcs * r__;
+ d__2 = d__[i__ - 1] * sn;
+ dlartg_(&d__1, &d__2, &oldcs, &oldsn, &d__[i__]);
+ work[i__ - ll] = cs;
+ work[i__ - ll + nm1] = -sn;
+ work[i__ - ll + nm12] = oldcs;
+ work[i__ - ll + nm13] = -oldsn;
+/* L130: */
+ }
+ h__ = d__[ll] * cs;
+ d__[ll] = h__ * oldcs;
+ e[ll] = h__ * oldsn;
+
+/* Update singular vectors */
+
+ if (*ncvt > 0) {
+ i__1 = m - ll + 1;
+ dlasr_("L", "V", "B", &i__1, ncvt, &work[nm12 + 1], &work[
+ nm13 + 1], &vt[ll + vt_dim1], ldvt);
+ }
+ if (*nru > 0) {
+ i__1 = m - ll + 1;
+ dlasr_("R", "V", "B", nru, &i__1, &work[1], &work[*n], &u[ll *
+ u_dim1 + 1], ldu);
+ }
+ if (*ncc > 0) {
+ i__1 = m - ll + 1;
+ dlasr_("L", "V", "B", &i__1, ncc, &work[1], &work[*n], &c__[
+ ll + c_dim1], ldc);
+ }
+
+/* Test convergence */
+
+ if ((d__1 = e[ll], abs(d__1)) <= thresh) {
+ e[ll] = 0.;
+ }
+ }
+ } else {
+
+/* Use nonzero shift */
+
+ if (idir == 1) {
+
+/*
+ Chase bulge from top to bottom
+ Save cosines and sines for later singular vector updates
+*/
+
+ f = ((d__1 = d__[ll], abs(d__1)) - shift) * (d_sign(&c_b15, &d__[
+ ll]) + shift / d__[ll]);
+ g = e[ll];
+ i__1 = m - 1;
+ for (i__ = ll; i__ <= i__1; ++i__) {
+ dlartg_(&f, &g, &cosr, &sinr, &r__);
+ if (i__ > ll) {
+ e[i__ - 1] = r__;
+ }
+ f = cosr * d__[i__] + sinr * e[i__];
+ e[i__] = cosr * e[i__] - sinr * d__[i__];
+ g = sinr * d__[i__ + 1];
+ d__[i__ + 1] = cosr * d__[i__ + 1];
+ dlartg_(&f, &g, &cosl, &sinl, &r__);
+ d__[i__] = r__;
+ f = cosl * e[i__] + sinl * d__[i__ + 1];
+ d__[i__ + 1] = cosl * d__[i__ + 1] - sinl * e[i__];
+ if (i__ < m - 1) {
+ g = sinl * e[i__ + 1];
+ e[i__ + 1] = cosl * e[i__ + 1];
+ }
+ work[i__ - ll + 1] = cosr;
+ work[i__ - ll + 1 + nm1] = sinr;
+ work[i__ - ll + 1 + nm12] = cosl;
+ work[i__ - ll + 1 + nm13] = sinl;
+/* L140: */
+ }
+ e[m - 1] = f;
+
+/* Update singular vectors */
+
+ if (*ncvt > 0) {
+ i__1 = m - ll + 1;
+ dlasr_("L", "V", "F", &i__1, ncvt, &work[1], &work[*n], &vt[
+ ll + vt_dim1], ldvt);
+ }
+ if (*nru > 0) {
+ i__1 = m - ll + 1;
+ dlasr_("R", "V", "F", nru, &i__1, &work[nm12 + 1], &work[nm13
+ + 1], &u[ll * u_dim1 + 1], ldu);
+ }
+ if (*ncc > 0) {
+ i__1 = m - ll + 1;
+ dlasr_("L", "V", "F", &i__1, ncc, &work[nm12 + 1], &work[nm13
+ + 1], &c__[ll + c_dim1], ldc);
+ }
+
+/* Test convergence */
+
+ if ((d__1 = e[m - 1], abs(d__1)) <= thresh) {
+ e[m - 1] = 0.;
+ }
+
+ } else {
+
+/*
+ Chase bulge from bottom to top
+ Save cosines and sines for later singular vector updates
+*/
+
+ f = ((d__1 = d__[m], abs(d__1)) - shift) * (d_sign(&c_b15, &d__[m]
+ ) + shift / d__[m]);
+ g = e[m - 1];
+ i__1 = ll + 1;
+ for (i__ = m; i__ >= i__1; --i__) {
+ dlartg_(&f, &g, &cosr, &sinr, &r__);
+ if (i__ < m) {
+ e[i__] = r__;
+ }
+ f = cosr * d__[i__] + sinr * e[i__ - 1];
+ e[i__ - 1] = cosr * e[i__ - 1] - sinr * d__[i__];
+ g = sinr * d__[i__ - 1];
+ d__[i__ - 1] = cosr * d__[i__ - 1];
+ dlartg_(&f, &g, &cosl, &sinl, &r__);
+ d__[i__] = r__;
+ f = cosl * e[i__ - 1] + sinl * d__[i__ - 1];
+ d__[i__ - 1] = cosl * d__[i__ - 1] - sinl * e[i__ - 1];
+ if (i__ > ll + 1) {
+ g = sinl * e[i__ - 2];
+ e[i__ - 2] = cosl * e[i__ - 2];
+ }
+ work[i__ - ll] = cosr;
+ work[i__ - ll + nm1] = -sinr;
+ work[i__ - ll + nm12] = cosl;
+ work[i__ - ll + nm13] = -sinl;
+/* L150: */
+ }
+ e[ll] = f;
+
+/* Test convergence */
+
+ if ((d__1 = e[ll], abs(d__1)) <= thresh) {
+ e[ll] = 0.;
+ }
+
+/* Update singular vectors if desired */
+
+ if (*ncvt > 0) {
+ i__1 = m - ll + 1;
+ dlasr_("L", "V", "B", &i__1, ncvt, &work[nm12 + 1], &work[
+ nm13 + 1], &vt[ll + vt_dim1], ldvt);
+ }
+ if (*nru > 0) {
+ i__1 = m - ll + 1;
+ dlasr_("R", "V", "B", nru, &i__1, &work[1], &work[*n], &u[ll *
+ u_dim1 + 1], ldu);
+ }
+ if (*ncc > 0) {
+ i__1 = m - ll + 1;
+ dlasr_("L", "V", "B", &i__1, ncc, &work[1], &work[*n], &c__[
+ ll + c_dim1], ldc);
+ }
+ }
+ }
+
+/* QR iteration finished, go back and check convergence */
+
+ goto L60;
+
+/* All singular values converged, so make them positive */
+
+L160:
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if (d__[i__] < 0.) {
+ d__[i__] = -d__[i__];
+
+/* Change sign of singular vectors, if desired */
+
+ if (*ncvt > 0) {
+ dscal_(ncvt, &c_b151, &vt[i__ + vt_dim1], ldvt);
+ }
+ }
+/* L170: */
+ }
+
+/*
+ Sort the singular values into decreasing order (insertion sort on
+ singular values, but only one transposition per singular vector)
+*/
+
+ i__1 = *n - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/* Scan for smallest D(I) */
+
+ isub = 1;
+ smin = d__[1];
+ i__2 = *n + 1 - i__;
+ for (j = 2; j <= i__2; ++j) {
+ if (d__[j] <= smin) {
+ isub = j;
+ smin = d__[j];
+ }
+/* L180: */
+ }
+ if (isub != *n + 1 - i__) {
+
+/* Swap singular values and vectors */
+
+ d__[isub] = d__[*n + 1 - i__];
+ d__[*n + 1 - i__] = smin;
+ if (*ncvt > 0) {
+ dswap_(ncvt, &vt[isub + vt_dim1], ldvt, &vt[*n + 1 - i__ +
+ vt_dim1], ldvt);
+ }
+ if (*nru > 0) {
+ dswap_(nru, &u[isub * u_dim1 + 1], &c__1, &u[(*n + 1 - i__) *
+ u_dim1 + 1], &c__1);
+ }
+ if (*ncc > 0) {
+ dswap_(ncc, &c__[isub + c_dim1], ldc, &c__[*n + 1 - i__ +
+ c_dim1], ldc);
+ }
+ }
+/* L190: */
+ }
+ goto L220;
+
+/* Maximum number of iterations exceeded, failure to converge */
+
+L200:
+ *info = 0;
+ i__1 = *n - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if (e[i__] != 0.) {
+ ++(*info);
+ }
+/* L210: */
+ }
+L220:
+ return 0;
+
+/* End of DBDSQR */
+
+} /* dbdsqr_ */
+
+/* Subroutine */ int dgebak_(char *job, char *side, integer *n, integer *ilo,
+ integer *ihi, doublereal *scale, integer *m, doublereal *v, integer *
+ ldv, integer *info)
+{
+ /* System generated locals */
+ integer v_dim1, v_offset, i__1;
+
+ /* Local variables */
+ static integer i__, k;
+ static doublereal s;
+ static integer ii;
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *);
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dswap_(integer *, doublereal *, integer *,
+ doublereal *, integer *);
+ static logical leftv;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static logical rightv;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ DGEBAK forms the right or left eigenvectors of a real general matrix
+ by backward transformation on the computed eigenvectors of the
+ balanced matrix output by DGEBAL.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the type of backward transformation required:
+ = 'N', do nothing, return immediately;
+ = 'P', do backward transformation for permutation only;
+ = 'S', do backward transformation for scaling only;
+ = 'B', do backward transformations for both permutation and
+ scaling.
+ JOB must be the same as the argument JOB supplied to DGEBAL.
+
+ SIDE (input) CHARACTER*1
+ = 'R': V contains right eigenvectors;
+ = 'L': V contains left eigenvectors.
+
+ N (input) INTEGER
+ The number of rows of the matrix V. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ The integers ILO and IHI determined by DGEBAL.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ SCALE (input) DOUBLE PRECISION array, dimension (N)
+ Details of the permutation and scaling factors, as returned
+ by DGEBAL.
+
+ M (input) INTEGER
+ The number of columns of the matrix V. M >= 0.
+
+ V (input/output) DOUBLE PRECISION array, dimension (LDV,M)
+ On entry, the matrix of right or left eigenvectors to be
+ transformed, as returned by DHSEIN or DTREVC.
+ On exit, V is overwritten by the transformed eigenvectors.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V. LDV >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+
+ Decode and Test the input parameters
+*/
+
+ /* Parameter adjustments */
+ --scale;
+ v_dim1 = *ldv;
+ v_offset = 1 + v_dim1 * 1;
+ v -= v_offset;
+
+ /* Function Body */
+ rightv = lsame_(side, "R");
+ leftv = lsame_(side, "L");
+
+ *info = 0;
+ if ((((! lsame_(job, "N") && ! lsame_(job, "P")) && ! lsame_(job, "S"))
+ && ! lsame_(job, "B"))) {
+ *info = -1;
+ } else if ((! rightv && ! leftv)) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*ilo < 1 || *ilo > max(1,*n)) {
+ *info = -4;
+ } else if (*ihi < min(*ilo,*n) || *ihi > *n) {
+ *info = -5;
+ } else if (*m < 0) {
+ *info = -7;
+ } else if (*ldv < max(1,*n)) {
+ *info = -9;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGEBAK", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+ if (*m == 0) {
+ return 0;
+ }
+ if (lsame_(job, "N")) {
+ return 0;
+ }
+
+ if (*ilo == *ihi) {
+ goto L30;
+ }
+
+/* Backward balance */
+
+ if (lsame_(job, "S") || lsame_(job, "B")) {
+
+ if (rightv) {
+ i__1 = *ihi;
+ for (i__ = *ilo; i__ <= i__1; ++i__) {
+ s = scale[i__];
+ dscal_(m, &s, &v[i__ + v_dim1], ldv);
+/* L10: */
+ }
+ }
+
+ if (leftv) {
+ i__1 = *ihi;
+ for (i__ = *ilo; i__ <= i__1; ++i__) {
+ s = 1. / scale[i__];
+ dscal_(m, &s, &v[i__ + v_dim1], ldv);
+/* L20: */
+ }
+ }
+
+ }
+
+/*
+ Backward permutation
+
+ For I = ILO-1 step -1 until 1,
+ IHI+1 step 1 until N do --
+*/
+
+L30:
+ if (lsame_(job, "P") || lsame_(job, "B")) {
+ if (rightv) {
+ i__1 = *n;
+ for (ii = 1; ii <= i__1; ++ii) {
+ i__ = ii;
+ if ((i__ >= *ilo && i__ <= *ihi)) {
+ goto L40;
+ }
+ if (i__ < *ilo) {
+ i__ = *ilo - ii;
+ }
+ k = (integer) scale[i__];
+ if (k == i__) {
+ goto L40;
+ }
+ dswap_(m, &v[i__ + v_dim1], ldv, &v[k + v_dim1], ldv);
+L40:
+ ;
+ }
+ }
+
+ if (leftv) {
+ i__1 = *n;
+ for (ii = 1; ii <= i__1; ++ii) {
+ i__ = ii;
+ if ((i__ >= *ilo && i__ <= *ihi)) {
+ goto L50;
+ }
+ if (i__ < *ilo) {
+ i__ = *ilo - ii;
+ }
+ k = (integer) scale[i__];
+ if (k == i__) {
+ goto L50;
+ }
+ dswap_(m, &v[i__ + v_dim1], ldv, &v[k + v_dim1], ldv);
+L50:
+ ;
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DGEBAK */
+
+} /* dgebak_ */
+
+/* Subroutine */ int dgebal_(char *job, integer *n, doublereal *a, integer *
+ lda, integer *ilo, integer *ihi, doublereal *scale, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+ doublereal d__1, d__2;
+
+ /* Local variables */
+ static doublereal c__, f, g;
+ static integer i__, j, k, l, m;
+ static doublereal r__, s, ca, ra;
+ static integer ica, ira, iexc;
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *);
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dswap_(integer *, doublereal *, integer *,
+ doublereal *, integer *);
+ static doublereal sfmin1, sfmin2, sfmax1, sfmax2;
+
+ extern integer idamax_(integer *, doublereal *, integer *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static logical noconv;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DGEBAL balances a general real matrix A. This involves, first,
+ permuting A by a similarity transformation to isolate eigenvalues
+ in the first 1 to ILO-1 and last IHI+1 to N elements on the
+ diagonal; and second, applying a diagonal similarity transformation
+ to rows and columns ILO to IHI to make the rows and columns as
+ close in norm as possible. Both steps are optional.
+
+ Balancing may reduce the 1-norm of the matrix, and improve the
+ accuracy of the computed eigenvalues and/or eigenvectors.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the operations to be performed on A:
+ = 'N': none: simply set ILO = 1, IHI = N, SCALE(I) = 1.0
+ for i = 1,...,N;
+ = 'P': permute only;
+ = 'S': scale only;
+ = 'B': both permute and scale.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the input matrix A.
+ On exit, A is overwritten by the balanced matrix.
+ If JOB = 'N', A is not referenced.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ ILO (output) INTEGER
+ IHI (output) INTEGER
+ ILO and IHI are set to integers such that on exit
+ A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N.
+ If JOB = 'N' or 'S', ILO = 1 and IHI = N.
+
+ SCALE (output) DOUBLE PRECISION array, dimension (N)
+ Details of the permutations and scaling factors applied to
+ A. If P(j) is the index of the row and column interchanged
+ with row and column j and D(j) is the scaling factor
+ applied to row and column j, then
+ SCALE(j) = P(j) for j = 1,...,ILO-1
+ = D(j) for j = ILO,...,IHI
+ = P(j) for j = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The permutations consist of row and column interchanges which put
+ the matrix in the form
+
+ ( T1 X Y )
+ P A P = ( 0 B Z )
+ ( 0 0 T2 )
+
+ where T1 and T2 are upper triangular matrices whose eigenvalues lie
+ along the diagonal. The column indices ILO and IHI mark the starting
+ and ending columns of the submatrix B. Balancing consists of applying
+ a diagonal similarity transformation inv(D) * B * D to make the
+ 1-norms of each row of B and its corresponding column nearly equal.
+ The output matrix is
+
+ ( T1 X*D Y )
+ ( 0 inv(D)*B*D inv(D)*Z ).
+ ( 0 0 T2 )
+
+ Information about the permutations P and the diagonal matrix D is
+ returned in the vector SCALE.
+
+ This subroutine is based on the EISPACK routine BALANC.
+
+ Modified by Tzu-Yi Chen, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input parameters
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --scale;
+
+ /* Function Body */
+ *info = 0;
+ if ((((! lsame_(job, "N") && ! lsame_(job, "P")) && ! lsame_(job, "S"))
+ && ! lsame_(job, "B"))) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*n)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGEBAL", &i__1);
+ return 0;
+ }
+
+ k = 1;
+ l = *n;
+
+ if (*n == 0) {
+ goto L210;
+ }
+
+ if (lsame_(job, "N")) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ scale[i__] = 1.;
+/* L10: */
+ }
+ goto L210;
+ }
+
+ if (lsame_(job, "S")) {
+ goto L120;
+ }
+
+/* Permutation to isolate eigenvalues if possible */
+
+ goto L50;
+
+/* Row and column exchange. */
+
+L20:
+ scale[m] = (doublereal) j;
+ if (j == m) {
+ goto L30;
+ }
+
+ dswap_(&l, &a[j * a_dim1 + 1], &c__1, &a[m * a_dim1 + 1], &c__1);
+ i__1 = *n - k + 1;
+ dswap_(&i__1, &a[j + k * a_dim1], lda, &a[m + k * a_dim1], lda);
+
+L30:
+ switch (iexc) {
+ case 1: goto L40;
+ case 2: goto L80;
+ }
+
+/* Search for rows isolating an eigenvalue and push them down. */
+
+L40:
+ if (l == 1) {
+ goto L210;
+ }
+ --l;
+
+L50:
+ for (j = l; j >= 1; --j) {
+
+ i__1 = l;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if (i__ == j) {
+ goto L60;
+ }
+ if (a[j + i__ * a_dim1] != 0.) {
+ goto L70;
+ }
+L60:
+ ;
+ }
+
+ m = l;
+ iexc = 1;
+ goto L20;
+L70:
+ ;
+ }
+
+ goto L90;
+
+/* Search for columns isolating an eigenvalue and push them left. */
+
+L80:
+ ++k;
+
+L90:
+ i__1 = l;
+ for (j = k; j <= i__1; ++j) {
+
+ i__2 = l;
+ for (i__ = k; i__ <= i__2; ++i__) {
+ if (i__ == j) {
+ goto L100;
+ }
+ if (a[i__ + j * a_dim1] != 0.) {
+ goto L110;
+ }
+L100:
+ ;
+ }
+
+ m = k;
+ iexc = 2;
+ goto L20;
+L110:
+ ;
+ }
+
+L120:
+ i__1 = l;
+ for (i__ = k; i__ <= i__1; ++i__) {
+ scale[i__] = 1.;
+/* L130: */
+ }
+
+ if (lsame_(job, "P")) {
+ goto L210;
+ }
+
+/*
+ Balance the submatrix in rows K to L.
+
+ Iterative loop for norm reduction
+*/
+
+ sfmin1 = SAFEMINIMUM / PRECISION;
+ sfmax1 = 1. / sfmin1;
+ sfmin2 = sfmin1 * 8.;
+ sfmax2 = 1. / sfmin2;
+L140:
+ noconv = FALSE_;
+
+ i__1 = l;
+ for (i__ = k; i__ <= i__1; ++i__) {
+ c__ = 0.;
+ r__ = 0.;
+
+ i__2 = l;
+ for (j = k; j <= i__2; ++j) {
+ if (j == i__) {
+ goto L150;
+ }
+ c__ += (d__1 = a[j + i__ * a_dim1], abs(d__1));
+ r__ += (d__1 = a[i__ + j * a_dim1], abs(d__1));
+L150:
+ ;
+ }
+ ica = idamax_(&l, &a[i__ * a_dim1 + 1], &c__1);
+ ca = (d__1 = a[ica + i__ * a_dim1], abs(d__1));
+ i__2 = *n - k + 1;
+ ira = idamax_(&i__2, &a[i__ + k * a_dim1], lda);
+ ra = (d__1 = a[i__ + (ira + k - 1) * a_dim1], abs(d__1));
+
+/* Guard against zero C or R due to underflow. */
+
+ if (c__ == 0. || r__ == 0.) {
+ goto L200;
+ }
+ g = r__ / 8.;
+ f = 1.;
+ s = c__ + r__;
+L160:
+/* Computing MAX */
+ d__1 = max(f,c__);
+/* Computing MIN */
+ d__2 = min(r__,g);
+ if (c__ >= g || max(d__1,ca) >= sfmax2 || min(d__2,ra) <= sfmin2) {
+ goto L170;
+ }
+ f *= 8.;
+ c__ *= 8.;
+ ca *= 8.;
+ r__ /= 8.;
+ g /= 8.;
+ ra /= 8.;
+ goto L160;
+
+L170:
+ g = c__ / 8.;
+L180:
+/* Computing MIN */
+ d__1 = min(f,c__), d__1 = min(d__1,g);
+ if (g < r__ || max(r__,ra) >= sfmax2 || min(d__1,ca) <= sfmin2) {
+ goto L190;
+ }
+ f /= 8.;
+ c__ /= 8.;
+ g /= 8.;
+ ca /= 8.;
+ r__ *= 8.;
+ ra *= 8.;
+ goto L180;
+
+/* Now balance. */
+
+L190:
+ if (c__ + r__ >= s * .95) {
+ goto L200;
+ }
+ if ((f < 1. && scale[i__] < 1.)) {
+ if (f * scale[i__] <= sfmin1) {
+ goto L200;
+ }
+ }
+ if ((f > 1. && scale[i__] > 1.)) {
+ if (scale[i__] >= sfmax1 / f) {
+ goto L200;
+ }
+ }
+ g = 1. / f;
+ scale[i__] *= f;
+ noconv = TRUE_;
+
+ i__2 = *n - k + 1;
+ dscal_(&i__2, &g, &a[i__ + k * a_dim1], lda);
+ dscal_(&l, &f, &a[i__ * a_dim1 + 1], &c__1);
+
+L200:
+ ;
+ }
+
+ if (noconv) {
+ goto L140;
+ }
+
+L210:
+ *ilo = k;
+ *ihi = l;
+
+ return 0;
+
+/* End of DGEBAL */
+
+} /* dgebal_ */
+
+/* Subroutine */ int dgebd2_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *d__, doublereal *e, doublereal *tauq, doublereal *
+ taup, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+
+ /* Local variables */
+ static integer i__;
+ extern /* Subroutine */ int dlarf_(char *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *), dlarfg_(integer *, doublereal *,
+ doublereal *, integer *, doublereal *), xerbla_(char *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ February 29, 1992
+
+
+ Purpose
+ =======
+
+ DGEBD2 reduces a real general m by n matrix A to upper or lower
+ bidiagonal form B by an orthogonal transformation: Q' * A * P = B.
+
+ If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows in the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns in the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the m by n general matrix to be reduced.
+ On exit,
+ if m >= n, the diagonal and the first superdiagonal are
+ overwritten with the upper bidiagonal matrix B; the
+ elements below the diagonal, with the array TAUQ, represent
+ the orthogonal matrix Q as a product of elementary
+ reflectors, and the elements above the first superdiagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors;
+ if m < n, the diagonal and the first subdiagonal are
+ overwritten with the lower bidiagonal matrix B; the
+ elements below the first subdiagonal, with the array TAUQ,
+ represent the orthogonal matrix Q as a product of
+ elementary reflectors, and the elements above the diagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ D (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The diagonal elements of the bidiagonal matrix B:
+ D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (min(M,N)-1)
+ The off-diagonal elements of the bidiagonal matrix B:
+ if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
+ if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
+
+ TAUQ (output) DOUBLE PRECISION array dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q. See Further Details.
+
+ TAUP (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix P. See Further Details.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (max(M,N))
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrices Q and P are represented as products of elementary
+ reflectors:
+
+ If m >= n,
+
+ Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
+ u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ If m < n,
+
+ Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
+ u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ The contents of A on exit are illustrated by the following examples:
+
+ m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
+
+ ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
+ ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
+ ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
+ ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
+ ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
+ ( v1 v2 v3 v4 v5 )
+
+ where d and e denote diagonal and off-diagonal elements of B, vi
+ denotes an element of the vector defining H(i), and ui an element of
+ the vector defining G(i).
+
+ =====================================================================
+
+
+ Test the input parameters
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --d__;
+ --e;
+ --tauq;
+ --taup;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ }
+ if (*info < 0) {
+ i__1 = -(*info);
+ xerbla_("DGEBD2", &i__1);
+ return 0;
+ }
+
+ if (*m >= *n) {
+
+/* Reduce to upper bidiagonal form */
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/* Generate elementary reflector H(i) to annihilate A(i+1:m,i) */
+
+ i__2 = *m - i__ + 1;
+/* Computing MIN */
+ i__3 = i__ + 1;
+ dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[min(i__3,*m) + i__ *
+ a_dim1], &c__1, &tauq[i__]);
+ d__[i__] = a[i__ + i__ * a_dim1];
+ a[i__ + i__ * a_dim1] = 1.;
+
+/* Apply H(i) to A(i:m,i+1:n) from the left */
+
+ i__2 = *m - i__ + 1;
+ i__3 = *n - i__;
+ dlarf_("Left", &i__2, &i__3, &a[i__ + i__ * a_dim1], &c__1, &tauq[
+ i__], &a[i__ + (i__ + 1) * a_dim1], lda, &work[1]);
+ a[i__ + i__ * a_dim1] = d__[i__];
+
+ if (i__ < *n) {
+
+/*
+ Generate elementary reflector G(i) to annihilate
+ A(i,i+2:n)
+*/
+
+ i__2 = *n - i__;
+/* Computing MIN */
+ i__3 = i__ + 2;
+ dlarfg_(&i__2, &a[i__ + (i__ + 1) * a_dim1], &a[i__ + min(
+ i__3,*n) * a_dim1], lda, &taup[i__]);
+ e[i__] = a[i__ + (i__ + 1) * a_dim1];
+ a[i__ + (i__ + 1) * a_dim1] = 1.;
+
+/* Apply G(i) to A(i+1:m,i+1:n) from the right */
+
+ i__2 = *m - i__;
+ i__3 = *n - i__;
+ dlarf_("Right", &i__2, &i__3, &a[i__ + (i__ + 1) * a_dim1],
+ lda, &taup[i__], &a[i__ + 1 + (i__ + 1) * a_dim1],
+ lda, &work[1]);
+ a[i__ + (i__ + 1) * a_dim1] = e[i__];
+ } else {
+ taup[i__] = 0.;
+ }
+/* L10: */
+ }
+ } else {
+
+/* Reduce to lower bidiagonal form */
+
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/* Generate elementary reflector G(i) to annihilate A(i,i+1:n) */
+
+ i__2 = *n - i__ + 1;
+/* Computing MIN */
+ i__3 = i__ + 1;
+ dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[i__ + min(i__3,*n) *
+ a_dim1], lda, &taup[i__]);
+ d__[i__] = a[i__ + i__ * a_dim1];
+ a[i__ + i__ * a_dim1] = 1.;
+
+/* Apply G(i) to A(i+1:m,i:n) from the right */
+
+ i__2 = *m - i__;
+ i__3 = *n - i__ + 1;
+/* Computing MIN */
+ i__4 = i__ + 1;
+ dlarf_("Right", &i__2, &i__3, &a[i__ + i__ * a_dim1], lda, &taup[
+ i__], &a[min(i__4,*m) + i__ * a_dim1], lda, &work[1]);
+ a[i__ + i__ * a_dim1] = d__[i__];
+
+ if (i__ < *m) {
+
+/*
+ Generate elementary reflector H(i) to annihilate
+ A(i+2:m,i)
+*/
+
+ i__2 = *m - i__;
+/* Computing MIN */
+ i__3 = i__ + 2;
+ dlarfg_(&i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3,*m) +
+ i__ * a_dim1], &c__1, &tauq[i__]);
+ e[i__] = a[i__ + 1 + i__ * a_dim1];
+ a[i__ + 1 + i__ * a_dim1] = 1.;
+
+/* Apply H(i) to A(i+1:m,i+1:n) from the left */
+
+ i__2 = *m - i__;
+ i__3 = *n - i__;
+ dlarf_("Left", &i__2, &i__3, &a[i__ + 1 + i__ * a_dim1], &
+ c__1, &tauq[i__], &a[i__ + 1 + (i__ + 1) * a_dim1],
+ lda, &work[1]);
+ a[i__ + 1 + i__ * a_dim1] = e[i__];
+ } else {
+ tauq[i__] = 0.;
+ }
+/* L20: */
+ }
+ }
+ return 0;
+
+/* End of DGEBD2 */
+
+} /* dgebd2_ */
+
+/* Subroutine */ int dgebrd_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *d__, doublereal *e, doublereal *tauq, doublereal *
+ taup, doublereal *work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+
+ /* Local variables */
+ static integer i__, j, nb, nx;
+ static doublereal ws;
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *);
+ static integer nbmin, iinfo, minmn;
+ extern /* Subroutine */ int dgebd2_(integer *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, doublereal *, doublereal *,
+ doublereal *, integer *), dlabrd_(integer *, integer *, integer *
+ , doublereal *, integer *, doublereal *, doublereal *, doublereal
+ *, doublereal *, doublereal *, integer *, doublereal *, integer *)
+ , xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static integer ldwrkx, ldwrky, lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DGEBRD reduces a general real M-by-N matrix A to upper or lower
+ bidiagonal form B by an orthogonal transformation: Q**T * A * P = B.
+
+ If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows in the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns in the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N general matrix to be reduced.
+ On exit,
+ if m >= n, the diagonal and the first superdiagonal are
+ overwritten with the upper bidiagonal matrix B; the
+ elements below the diagonal, with the array TAUQ, represent
+ the orthogonal matrix Q as a product of elementary
+ reflectors, and the elements above the first superdiagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors;
+ if m < n, the diagonal and the first subdiagonal are
+ overwritten with the lower bidiagonal matrix B; the
+ elements below the first subdiagonal, with the array TAUQ,
+ represent the orthogonal matrix Q as a product of
+ elementary reflectors, and the elements above the diagonal,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ D (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The diagonal elements of the bidiagonal matrix B:
+ D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (min(M,N)-1)
+ The off-diagonal elements of the bidiagonal matrix B:
+ if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
+ if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
+
+ TAUQ (output) DOUBLE PRECISION array dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q. See Further Details.
+
+ TAUP (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix P. See Further Details.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,M,N).
+ For optimum performance LWORK >= (M+N)*NB, where NB
+ is the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrices Q and P are represented as products of elementary
+ reflectors:
+
+ If m >= n,
+
+ Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
+ u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ If m < n,
+
+ Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors;
+ v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
+ u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ The contents of A on exit are illustrated by the following examples:
+
+ m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
+
+ ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
+ ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
+ ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
+ ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
+ ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
+ ( v1 v2 v3 v4 v5 )
+
+ where d and e denote diagonal and off-diagonal elements of B, vi
+ denotes an element of the vector defining H(i), and ui an element of
+ the vector defining G(i).
+
+ =====================================================================
+
+
+ Test the input parameters
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --d__;
+ --e;
+ --tauq;
+ --taup;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+/* Computing MAX */
+ i__1 = 1, i__2 = ilaenv_(&c__1, "DGEBRD", " ", m, n, &c_n1, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ nb = max(i__1,i__2);
+ lwkopt = (*m + *n) * nb;
+ work[1] = (doublereal) lwkopt;
+ lquery = *lwork == -1;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ } else /* if(complicated condition) */ {
+/* Computing MAX */
+ i__1 = max(1,*m);
+ if ((*lwork < max(i__1,*n) && ! lquery)) {
+ *info = -10;
+ }
+ }
+ if (*info < 0) {
+ i__1 = -(*info);
+ xerbla_("DGEBRD", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ minmn = min(*m,*n);
+ if (minmn == 0) {
+ work[1] = 1.;
+ return 0;
+ }
+
+ ws = (doublereal) max(*m,*n);
+ ldwrkx = *m;
+ ldwrky = *n;
+
+ if ((nb > 1 && nb < minmn)) {
+
+/*
+ Set the crossover point NX.
+
+ Computing MAX
+*/
+ i__1 = nb, i__2 = ilaenv_(&c__3, "DGEBRD", " ", m, n, &c_n1, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ nx = max(i__1,i__2);
+
+/* Determine when to switch from blocked to unblocked code. */
+
+ if (nx < minmn) {
+ ws = (doublereal) ((*m + *n) * nb);
+ if ((doublereal) (*lwork) < ws) {
+
+/*
+ Not enough work space for the optimal NB, consider using
+ a smaller block size.
+*/
+
+ nbmin = ilaenv_(&c__2, "DGEBRD", " ", m, n, &c_n1, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ if (*lwork >= (*m + *n) * nbmin) {
+ nb = *lwork / (*m + *n);
+ } else {
+ nb = 1;
+ nx = minmn;
+ }
+ }
+ }
+ } else {
+ nx = minmn;
+ }
+
+ i__1 = minmn - nx;
+ i__2 = nb;
+ for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+
+/*
+ Reduce rows and columns i:i+nb-1 to bidiagonal form and return
+ the matrices X and Y which are needed to update the unreduced
+ part of the matrix
+*/
+
+ i__3 = *m - i__ + 1;
+ i__4 = *n - i__ + 1;
+ dlabrd_(&i__3, &i__4, &nb, &a[i__ + i__ * a_dim1], lda, &d__[i__], &e[
+ i__], &tauq[i__], &taup[i__], &work[1], &ldwrkx, &work[ldwrkx
+ * nb + 1], &ldwrky);
+
+/*
+ Update the trailing submatrix A(i+nb:m,i+nb:n), using an update
+ of the form A := A - V*Y' - X*U'
+*/
+
+ i__3 = *m - i__ - nb + 1;
+ i__4 = *n - i__ - nb + 1;
+ dgemm_("No transpose", "Transpose", &i__3, &i__4, &nb, &c_b151, &a[
+ i__ + nb + i__ * a_dim1], lda, &work[ldwrkx * nb + nb + 1], &
+ ldwrky, &c_b15, &a[i__ + nb + (i__ + nb) * a_dim1], lda);
+ i__3 = *m - i__ - nb + 1;
+ i__4 = *n - i__ - nb + 1;
+ dgemm_("No transpose", "No transpose", &i__3, &i__4, &nb, &c_b151, &
+ work[nb + 1], &ldwrkx, &a[i__ + (i__ + nb) * a_dim1], lda, &
+ c_b15, &a[i__ + nb + (i__ + nb) * a_dim1], lda);
+
+/* Copy diagonal and off-diagonal elements of B back into A */
+
+ if (*m >= *n) {
+ i__3 = i__ + nb - 1;
+ for (j = i__; j <= i__3; ++j) {
+ a[j + j * a_dim1] = d__[j];
+ a[j + (j + 1) * a_dim1] = e[j];
+/* L10: */
+ }
+ } else {
+ i__3 = i__ + nb - 1;
+ for (j = i__; j <= i__3; ++j) {
+ a[j + j * a_dim1] = d__[j];
+ a[j + 1 + j * a_dim1] = e[j];
+/* L20: */
+ }
+ }
+/* L30: */
+ }
+
+/* Use unblocked code to reduce the remainder of the matrix */
+
+ i__2 = *m - i__ + 1;
+ i__1 = *n - i__ + 1;
+ dgebd2_(&i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &d__[i__], &e[i__], &
+ tauq[i__], &taup[i__], &work[1], &iinfo);
+ work[1] = ws;
+ return 0;
+
+/* End of DGEBRD */
+
+} /* dgebrd_ */
+
+/* Subroutine */ int dgeev_(char *jobvl, char *jobvr, integer *n, doublereal *
+ a, integer *lda, doublereal *wr, doublereal *wi, doublereal *vl,
+ integer *ldvl, doublereal *vr, integer *ldvr, doublereal *work,
+ integer *lwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1,
+ i__2, i__3, i__4;
+ doublereal d__1, d__2;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static integer i__, k;
+ static doublereal r__, cs, sn;
+ static integer ihi;
+ static doublereal scl;
+ static integer ilo;
+ static doublereal dum[1], eps;
+ static integer ibal;
+ static char side[1];
+ static integer maxb;
+ static doublereal anrm;
+ static integer ierr, itau;
+ extern /* Subroutine */ int drot_(integer *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *);
+ static integer iwrk, nout;
+ extern doublereal dnrm2_(integer *, doublereal *, integer *);
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *);
+ extern logical lsame_(char *, char *);
+ extern doublereal dlapy2_(doublereal *, doublereal *);
+ extern /* Subroutine */ int dlabad_(doublereal *, doublereal *), dgebak_(
+ char *, char *, integer *, integer *, integer *, doublereal *,
+ integer *, doublereal *, integer *, integer *),
+ dgebal_(char *, integer *, doublereal *, integer *, integer *,
+ integer *, doublereal *, integer *);
+ static logical scalea;
+
+ static doublereal cscale;
+ extern doublereal dlange_(char *, integer *, integer *, doublereal *,
+ integer *, doublereal *);
+ extern /* Subroutine */ int dgehrd_(integer *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ integer *), dlascl_(char *, integer *, integer *, doublereal *,
+ doublereal *, integer *, integer *, doublereal *, integer *,
+ integer *);
+ extern integer idamax_(integer *, doublereal *, integer *);
+ extern /* Subroutine */ int dlacpy_(char *, integer *, integer *,
+ doublereal *, integer *, doublereal *, integer *),
+ dlartg_(doublereal *, doublereal *, doublereal *, doublereal *,
+ doublereal *), xerbla_(char *, integer *);
+ static logical select[1];
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static doublereal bignum;
+ extern /* Subroutine */ int dorghr_(integer *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ integer *), dhseqr_(char *, char *, integer *, integer *, integer
+ *, doublereal *, integer *, doublereal *, doublereal *,
+ doublereal *, integer *, doublereal *, integer *, integer *), dtrevc_(char *, char *, logical *, integer *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ integer *, integer *, integer *, doublereal *, integer *);
+ static integer minwrk, maxwrk;
+ static logical wantvl;
+ static doublereal smlnum;
+ static integer hswork;
+ static logical lquery, wantvr;
+
+
+/*
+ -- LAPACK driver routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ December 8, 1999
+
+
+ Purpose
+ =======
+
+ DGEEV computes for an N-by-N real nonsymmetric matrix A, the
+ eigenvalues and, optionally, the left and/or right eigenvectors.
+
+ The right eigenvector v(j) of A satisfies
+ A * v(j) = lambda(j) * v(j)
+ where lambda(j) is its eigenvalue.
+ The left eigenvector u(j) of A satisfies
+ u(j)**H * A = lambda(j) * u(j)**H
+ where u(j)**H denotes the conjugate transpose of u(j).
+
+ The computed eigenvectors are normalized to have Euclidean norm
+ equal to 1 and largest component real.
+
+ Arguments
+ =========
+
+ JOBVL (input) CHARACTER*1
+ = 'N': left eigenvectors of A are not computed;
+ = 'V': left eigenvectors of A are computed.
+
+ JOBVR (input) CHARACTER*1
+ = 'N': right eigenvectors of A are not computed;
+ = 'V': right eigenvectors of A are computed.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the N-by-N matrix A.
+ On exit, A has been overwritten.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ WR (output) DOUBLE PRECISION array, dimension (N)
+ WI (output) DOUBLE PRECISION array, dimension (N)
+ WR and WI contain the real and imaginary parts,
+ respectively, of the computed eigenvalues. Complex
+ conjugate pairs of eigenvalues appear consecutively
+ with the eigenvalue having the positive imaginary part
+ first.
+
+ VL (output) DOUBLE PRECISION array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored one
+ after another in the columns of VL, in the same order
+ as their eigenvalues.
+ If JOBVL = 'N', VL is not referenced.
+ If the j-th eigenvalue is real, then u(j) = VL(:,j),
+ the j-th column of VL.
+ If the j-th and (j+1)-st eigenvalues form a complex
+ conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and
+ u(j+1) = VL(:,j) - i*VL(:,j+1).
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= 1; if
+ JOBVL = 'V', LDVL >= N.
+
+ VR (output) DOUBLE PRECISION array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors v(j) are stored one
+ after another in the columns of VR, in the same order
+ as their eigenvalues.
+ If JOBVR = 'N', VR is not referenced.
+ If the j-th eigenvalue is real, then v(j) = VR(:,j),
+ the j-th column of VR.
+ If the j-th and (j+1)-st eigenvalues form a complex
+ conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and
+ v(j+1) = VR(:,j) - i*VR(:,j+1).
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1; if
+ JOBVR = 'V', LDVR >= N.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,3*N), and
+ if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N. For good
+ performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the QR algorithm failed to compute all the
+ eigenvalues, and no eigenvectors have been computed;
+ elements i+1:N of WR and WI contain eigenvalues which
+ have converged.
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --wr;
+ --wi;
+ vl_dim1 = *ldvl;
+ vl_offset = 1 + vl_dim1 * 1;
+ vl -= vl_offset;
+ vr_dim1 = *ldvr;
+ vr_offset = 1 + vr_dim1 * 1;
+ vr -= vr_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ lquery = *lwork == -1;
+ wantvl = lsame_(jobvl, "V");
+ wantvr = lsame_(jobvr, "V");
+ if ((! wantvl && ! lsame_(jobvl, "N"))) {
+ *info = -1;
+ } else if ((! wantvr && ! lsame_(jobvr, "N"))) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*lda < max(1,*n)) {
+ *info = -5;
+ } else if (*ldvl < 1 || (wantvl && *ldvl < *n)) {
+ *info = -9;
+ } else if (*ldvr < 1 || (wantvr && *ldvr < *n)) {
+ *info = -11;
+ }
+
+/*
+ Compute workspace
+ (Note: Comments in the code beginning "Workspace:" describe the
+ minimal amount of workspace needed at that point in the code,
+ as well as the preferred amount for good performance.
+ NB refers to the optimal block size for the immediately
+ following subroutine, as returned by ILAENV.
+ HSWORK refers to the workspace preferred by DHSEQR, as
+ calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
+ the worst case.)
+*/
+
+ minwrk = 1;
+ if ((*info == 0 && (*lwork >= 1 || lquery))) {
+ maxwrk = ((*n) << (1)) + *n * ilaenv_(&c__1, "DGEHRD", " ", n, &c__1,
+ n, &c__0, (ftnlen)6, (ftnlen)1);
+ if ((! wantvl && ! wantvr)) {
+/* Computing MAX */
+ i__1 = 1, i__2 = *n * 3;
+ minwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = ilaenv_(&c__8, "DHSEQR", "EN", n, &c__1, n, &c_n1, (ftnlen)
+ 6, (ftnlen)2);
+ maxb = max(i__1,2);
+/*
+ Computing MIN
+ Computing MAX
+*/
+ i__3 = 2, i__4 = ilaenv_(&c__4, "DHSEQR", "EN", n, &c__1, n, &
+ c_n1, (ftnlen)6, (ftnlen)2);
+ i__1 = min(maxb,*n), i__2 = max(i__3,i__4);
+ k = min(i__1,i__2);
+/* Computing MAX */
+ i__1 = k * (k + 2), i__2 = (*n) << (1);
+ hswork = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *n + 1, i__1 = max(i__1,i__2), i__2 = *n +
+ hswork;
+ maxwrk = max(i__1,i__2);
+ } else {
+/* Computing MAX */
+ i__1 = 1, i__2 = (*n) << (2);
+ minwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*n) << (1)) + (*n - 1) * ilaenv_(&c__1,
+ "DORGHR", " ", n, &c__1, n, &c_n1, (ftnlen)6, (ftnlen)1);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = ilaenv_(&c__8, "DHSEQR", "SV", n, &c__1, n, &c_n1, (ftnlen)
+ 6, (ftnlen)2);
+ maxb = max(i__1,2);
+/*
+ Computing MIN
+ Computing MAX
+*/
+ i__3 = 2, i__4 = ilaenv_(&c__4, "DHSEQR", "SV", n, &c__1, n, &
+ c_n1, (ftnlen)6, (ftnlen)2);
+ i__1 = min(maxb,*n), i__2 = max(i__3,i__4);
+ k = min(i__1,i__2);
+/* Computing MAX */
+ i__1 = k * (k + 2), i__2 = (*n) << (1);
+ hswork = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *n + 1, i__1 = max(i__1,i__2), i__2 = *n +
+ hswork;
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = (*n) << (2);
+ maxwrk = max(i__1,i__2);
+ }
+ work[1] = (doublereal) maxwrk;
+ }
+ if ((*lwork < minwrk && ! lquery)) {
+ *info = -13;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGEEV ", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+/* Get machine constants */
+
+ eps = PRECISION;
+ smlnum = SAFEMINIMUM;
+ bignum = 1. / smlnum;
+ dlabad_(&smlnum, &bignum);
+ smlnum = sqrt(smlnum) / eps;
+ bignum = 1. / smlnum;
+
+/* Scale A if max element outside range [SMLNUM,BIGNUM] */
+
+ anrm = dlange_("M", n, n, &a[a_offset], lda, dum);
+ scalea = FALSE_;
+ if ((anrm > 0. && anrm < smlnum)) {
+ scalea = TRUE_;
+ cscale = smlnum;
+ } else if (anrm > bignum) {
+ scalea = TRUE_;
+ cscale = bignum;
+ }
+ if (scalea) {
+ dlascl_("G", &c__0, &c__0, &anrm, &cscale, n, n, &a[a_offset], lda, &
+ ierr);
+ }
+
+/*
+ Balance the matrix
+ (Workspace: need N)
+*/
+
+ ibal = 1;
+ dgebal_("B", n, &a[a_offset], lda, &ilo, &ihi, &work[ibal], &ierr);
+
+/*
+ Reduce to upper Hessenberg form
+ (Workspace: need 3*N, prefer 2*N+N*NB)
+*/
+
+ itau = ibal + *n;
+ iwrk = itau + *n;
+ i__1 = *lwork - iwrk + 1;
+ dgehrd_(n, &ilo, &ihi, &a[a_offset], lda, &work[itau], &work[iwrk], &i__1,
+ &ierr);
+
+ if (wantvl) {
+
+/*
+ Want left eigenvectors
+ Copy Householder vectors to VL
+*/
+
+ *(unsigned char *)side = 'L';
+ dlacpy_("L", n, n, &a[a_offset], lda, &vl[vl_offset], ldvl)
+ ;
+
+/*
+ Generate orthogonal matrix in VL
+ (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB)
+*/
+
+ i__1 = *lwork - iwrk + 1;
+ dorghr_(n, &ilo, &ihi, &vl[vl_offset], ldvl, &work[itau], &work[iwrk],
+ &i__1, &ierr);
+
+/*
+ Perform QR iteration, accumulating Schur vectors in VL
+ (Workspace: need N+1, prefer N+HSWORK (see comments) )
+*/
+
+ iwrk = itau;
+ i__1 = *lwork - iwrk + 1;
+ dhseqr_("S", "V", n, &ilo, &ihi, &a[a_offset], lda, &wr[1], &wi[1], &
+ vl[vl_offset], ldvl, &work[iwrk], &i__1, info);
+
+ if (wantvr) {
+
+/*
+ Want left and right eigenvectors
+ Copy Schur vectors to VR
+*/
+
+ *(unsigned char *)side = 'B';
+ dlacpy_("F", n, n, &vl[vl_offset], ldvl, &vr[vr_offset], ldvr);
+ }
+
+ } else if (wantvr) {
+
+/*
+ Want right eigenvectors
+ Copy Householder vectors to VR
+*/
+
+ *(unsigned char *)side = 'R';
+ dlacpy_("L", n, n, &a[a_offset], lda, &vr[vr_offset], ldvr)
+ ;
+
+/*
+ Generate orthogonal matrix in VR
+ (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB)
+*/
+
+ i__1 = *lwork - iwrk + 1;
+ dorghr_(n, &ilo, &ihi, &vr[vr_offset], ldvr, &work[itau], &work[iwrk],
+ &i__1, &ierr);
+
+/*
+ Perform QR iteration, accumulating Schur vectors in VR
+ (Workspace: need N+1, prefer N+HSWORK (see comments) )
+*/
+
+ iwrk = itau;
+ i__1 = *lwork - iwrk + 1;
+ dhseqr_("S", "V", n, &ilo, &ihi, &a[a_offset], lda, &wr[1], &wi[1], &
+ vr[vr_offset], ldvr, &work[iwrk], &i__1, info);
+
+ } else {
+
+/*
+ Compute eigenvalues only
+ (Workspace: need N+1, prefer N+HSWORK (see comments) )
+*/
+
+ iwrk = itau;
+ i__1 = *lwork - iwrk + 1;
+ dhseqr_("E", "N", n, &ilo, &ihi, &a[a_offset], lda, &wr[1], &wi[1], &
+ vr[vr_offset], ldvr, &work[iwrk], &i__1, info);
+ }
+
+/* If INFO > 0 from DHSEQR, then quit */
+
+ if (*info > 0) {
+ goto L50;
+ }
+
+ if (wantvl || wantvr) {
+
+/*
+ Compute left and/or right eigenvectors
+ (Workspace: need 4*N)
+*/
+
+ dtrevc_(side, "B", select, n, &a[a_offset], lda, &vl[vl_offset], ldvl,
+ &vr[vr_offset], ldvr, n, &nout, &work[iwrk], &ierr);
+ }
+
+ if (wantvl) {
+
+/*
+ Undo balancing of left eigenvectors
+ (Workspace: need N)
+*/
+
+ dgebak_("B", "L", n, &ilo, &ihi, &work[ibal], n, &vl[vl_offset], ldvl,
+ &ierr);
+
+/* Normalize left eigenvectors and make largest component real */
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if (wi[i__] == 0.) {
+ scl = 1. / dnrm2_(n, &vl[i__ * vl_dim1 + 1], &c__1);
+ dscal_(n, &scl, &vl[i__ * vl_dim1 + 1], &c__1);
+ } else if (wi[i__] > 0.) {
+ d__1 = dnrm2_(n, &vl[i__ * vl_dim1 + 1], &c__1);
+ d__2 = dnrm2_(n, &vl[(i__ + 1) * vl_dim1 + 1], &c__1);
+ scl = 1. / dlapy2_(&d__1, &d__2);
+ dscal_(n, &scl, &vl[i__ * vl_dim1 + 1], &c__1);
+ dscal_(n, &scl, &vl[(i__ + 1) * vl_dim1 + 1], &c__1);
+ i__2 = *n;
+ for (k = 1; k <= i__2; ++k) {
+/* Computing 2nd power */
+ d__1 = vl[k + i__ * vl_dim1];
+/* Computing 2nd power */
+ d__2 = vl[k + (i__ + 1) * vl_dim1];
+ work[iwrk + k - 1] = d__1 * d__1 + d__2 * d__2;
+/* L10: */
+ }
+ k = idamax_(n, &work[iwrk], &c__1);
+ dlartg_(&vl[k + i__ * vl_dim1], &vl[k + (i__ + 1) * vl_dim1],
+ &cs, &sn, &r__);
+ drot_(n, &vl[i__ * vl_dim1 + 1], &c__1, &vl[(i__ + 1) *
+ vl_dim1 + 1], &c__1, &cs, &sn);
+ vl[k + (i__ + 1) * vl_dim1] = 0.;
+ }
+/* L20: */
+ }
+ }
+
+ if (wantvr) {
+
+/*
+ Undo balancing of right eigenvectors
+ (Workspace: need N)
+*/
+
+ dgebak_("B", "R", n, &ilo, &ihi, &work[ibal], n, &vr[vr_offset], ldvr,
+ &ierr);
+
+/* Normalize right eigenvectors and make largest component real */
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if (wi[i__] == 0.) {
+ scl = 1. / dnrm2_(n, &vr[i__ * vr_dim1 + 1], &c__1);
+ dscal_(n, &scl, &vr[i__ * vr_dim1 + 1], &c__1);
+ } else if (wi[i__] > 0.) {
+ d__1 = dnrm2_(n, &vr[i__ * vr_dim1 + 1], &c__1);
+ d__2 = dnrm2_(n, &vr[(i__ + 1) * vr_dim1 + 1], &c__1);
+ scl = 1. / dlapy2_(&d__1, &d__2);
+ dscal_(n, &scl, &vr[i__ * vr_dim1 + 1], &c__1);
+ dscal_(n, &scl, &vr[(i__ + 1) * vr_dim1 + 1], &c__1);
+ i__2 = *n;
+ for (k = 1; k <= i__2; ++k) {
+/* Computing 2nd power */
+ d__1 = vr[k + i__ * vr_dim1];
+/* Computing 2nd power */
+ d__2 = vr[k + (i__ + 1) * vr_dim1];
+ work[iwrk + k - 1] = d__1 * d__1 + d__2 * d__2;
+/* L30: */
+ }
+ k = idamax_(n, &work[iwrk], &c__1);
+ dlartg_(&vr[k + i__ * vr_dim1], &vr[k + (i__ + 1) * vr_dim1],
+ &cs, &sn, &r__);
+ drot_(n, &vr[i__ * vr_dim1 + 1], &c__1, &vr[(i__ + 1) *
+ vr_dim1 + 1], &c__1, &cs, &sn);
+ vr[k + (i__ + 1) * vr_dim1] = 0.;
+ }
+/* L40: */
+ }
+ }
+
+/* Undo scaling if necessary */
+
+L50:
+ if (scalea) {
+ i__1 = *n - *info;
+/* Computing MAX */
+ i__3 = *n - *info;
+ i__2 = max(i__3,1);
+ dlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wr[*info +
+ 1], &i__2, &ierr);
+ i__1 = *n - *info;
+/* Computing MAX */
+ i__3 = *n - *info;
+ i__2 = max(i__3,1);
+ dlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wi[*info +
+ 1], &i__2, &ierr);
+ if (*info > 0) {
+ i__1 = ilo - 1;
+ dlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wr[1],
+ n, &ierr);
+ i__1 = ilo - 1;
+ dlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wi[1],
+ n, &ierr);
+ }
+ }
+
+ work[1] = (doublereal) maxwrk;
+ return 0;
+
+/* End of DGEEV */
+
+} /* dgeev_ */
+
+/* Subroutine */ int dgehd2_(integer *n, integer *ilo, integer *ihi,
+ doublereal *a, integer *lda, doublereal *tau, doublereal *work,
+ integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i__;
+ static doublereal aii;
+ extern /* Subroutine */ int dlarf_(char *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *), dlarfg_(integer *, doublereal *,
+ doublereal *, integer *, doublereal *), xerbla_(char *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DGEHD2 reduces a real general matrix A to upper Hessenberg form H by
+ an orthogonal similarity transformation: Q' * A * Q = H .
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that A is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+ set by a previous call to DGEBAL; otherwise they should be
+ set to 1 and N respectively. See Further Details.
+ 1 <= ILO <= IHI <= max(1,N).
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the n by n general matrix to be reduced.
+ On exit, the upper triangle and the first subdiagonal of A
+ are overwritten with the upper Hessenberg matrix H, and the
+ elements below the first subdiagonal, with the array TAU,
+ represent the orthogonal matrix Q as a product of elementary
+ reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) DOUBLE PRECISION array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+ Details).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of (ihi-ilo) elementary
+ reflectors
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
+ exit in A(i+2:ihi,i), and tau in TAU(i).
+
+ The contents of A are illustrated by the following example, with
+ n = 7, ilo = 2 and ihi = 6:
+
+ on entry, on exit,
+
+ ( a a a a a a a ) ( a a h h h h a )
+ ( a a a a a a ) ( a h h h h a )
+ ( a a a a a a ) ( h h h h h h )
+ ( a a a a a a ) ( v2 h h h h h )
+ ( a a a a a a ) ( v2 v3 h h h h )
+ ( a a a a a a ) ( v2 v3 v4 h h h )
+ ( a ) ( a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+ element of the vector defining H(i).
+
+ =====================================================================
+
+
+ Test the input parameters
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ if (*n < 0) {
+ *info = -1;
+ } else if (*ilo < 1 || *ilo > max(1,*n)) {
+ *info = -2;
+ } else if (*ihi < min(*ilo,*n) || *ihi > *n) {
+ *info = -3;
+ } else if (*lda < max(1,*n)) {
+ *info = -5;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGEHD2", &i__1);
+ return 0;
+ }
+
+ i__1 = *ihi - 1;
+ for (i__ = *ilo; i__ <= i__1; ++i__) {
+
+/* Compute elementary reflector H(i) to annihilate A(i+2:ihi,i) */
+
+ i__2 = *ihi - i__;
+/* Computing MIN */
+ i__3 = i__ + 2;
+ dlarfg_(&i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3,*n) + i__ *
+ a_dim1], &c__1, &tau[i__]);
+ aii = a[i__ + 1 + i__ * a_dim1];
+ a[i__ + 1 + i__ * a_dim1] = 1.;
+
+/* Apply H(i) to A(1:ihi,i+1:ihi) from the right */
+
+ i__2 = *ihi - i__;
+ dlarf_("Right", ihi, &i__2, &a[i__ + 1 + i__ * a_dim1], &c__1, &tau[
+ i__], &a[(i__ + 1) * a_dim1 + 1], lda, &work[1]);
+
+/* Apply H(i) to A(i+1:ihi,i+1:n) from the left */
+
+ i__2 = *ihi - i__;
+ i__3 = *n - i__;
+ dlarf_("Left", &i__2, &i__3, &a[i__ + 1 + i__ * a_dim1], &c__1, &tau[
+ i__], &a[i__ + 1 + (i__ + 1) * a_dim1], lda, &work[1]);
+
+ a[i__ + 1 + i__ * a_dim1] = aii;
+/* L10: */
+ }
+
+ return 0;
+
+/* End of DGEHD2 */
+
+} /* dgehd2_ */
+
+/* Subroutine */ int dgehrd_(integer *n, integer *ilo, integer *ihi,
+ doublereal *a, integer *lda, doublereal *tau, doublereal *work,
+ integer *lwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+
+ /* Local variables */
+ static integer i__;
+ static doublereal t[4160] /* was [65][64] */;
+ static integer ib;
+ static doublereal ei;
+ static integer nb, nh, nx, iws;
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *);
+ static integer nbmin, iinfo;
+ extern /* Subroutine */ int dgehd2_(integer *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *),
+ dlarfb_(char *, char *, char *, char *, integer *, integer *,
+ integer *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, integer *), dlahrd_(integer *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static integer ldwork, lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DGEHRD reduces a real general matrix A to upper Hessenberg form H by
+ an orthogonal similarity transformation: Q' * A * Q = H .
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that A is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+ set by a previous call to DGEBAL; otherwise they should be
+ set to 1 and N respectively. See Further Details.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the N-by-N general matrix to be reduced.
+ On exit, the upper triangle and the first subdiagonal of A
+ are overwritten with the upper Hessenberg matrix H, and the
+ elements below the first subdiagonal, with the array TAU,
+ represent the orthogonal matrix Q as a product of elementary
+ reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) DOUBLE PRECISION array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+ Details). Elements 1:ILO-1 and IHI:N-1 of TAU are set to
+ zero.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of (ihi-ilo) elementary
+ reflectors
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
+ exit in A(i+2:ihi,i), and tau in TAU(i).
+
+ The contents of A are illustrated by the following example, with
+ n = 7, ilo = 2 and ihi = 6:
+
+ on entry, on exit,
+
+ ( a a a a a a a ) ( a a h h h h a )
+ ( a a a a a a ) ( a h h h h a )
+ ( a a a a a a ) ( h h h h h h )
+ ( a a a a a a ) ( v2 h h h h h )
+ ( a a a a a a ) ( v2 v3 h h h h )
+ ( a a a a a a ) ( v2 v3 v4 h h h )
+ ( a ) ( a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+ element of the vector defining H(i).
+
+ =====================================================================
+
+
+ Test the input parameters
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+/* Computing MIN */
+ i__1 = 64, i__2 = ilaenv_(&c__1, "DGEHRD", " ", n, ilo, ihi, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ nb = min(i__1,i__2);
+ lwkopt = *n * nb;
+ work[1] = (doublereal) lwkopt;
+ lquery = *lwork == -1;
+ if (*n < 0) {
+ *info = -1;
+ } else if (*ilo < 1 || *ilo > max(1,*n)) {
+ *info = -2;
+ } else if (*ihi < min(*ilo,*n) || *ihi > *n) {
+ *info = -3;
+ } else if (*lda < max(1,*n)) {
+ *info = -5;
+ } else if ((*lwork < max(1,*n) && ! lquery)) {
+ *info = -8;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGEHRD", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Set elements 1:ILO-1 and IHI:N-1 of TAU to zero */
+
+ i__1 = *ilo - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ tau[i__] = 0.;
+/* L10: */
+ }
+ i__1 = *n - 1;
+ for (i__ = max(1,*ihi); i__ <= i__1; ++i__) {
+ tau[i__] = 0.;
+/* L20: */
+ }
+
+/* Quick return if possible */
+
+ nh = *ihi - *ilo + 1;
+ if (nh <= 1) {
+ work[1] = 1.;
+ return 0;
+ }
+
+/*
+ Determine the block size.
+
+ Computing MIN
+*/
+ i__1 = 64, i__2 = ilaenv_(&c__1, "DGEHRD", " ", n, ilo, ihi, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ nb = min(i__1,i__2);
+ nbmin = 2;
+ iws = 1;
+ if ((nb > 1 && nb < nh)) {
+
+/*
+ Determine when to cross over from blocked to unblocked code
+ (last block is always handled by unblocked code).
+
+ Computing MAX
+*/
+ i__1 = nb, i__2 = ilaenv_(&c__3, "DGEHRD", " ", n, ilo, ihi, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ nx = max(i__1,i__2);
+ if (nx < nh) {
+
+/* Determine if workspace is large enough for blocked code. */
+
+ iws = *n * nb;
+ if (*lwork < iws) {
+
+/*
+ Not enough workspace to use optimal NB: determine the
+ minimum value of NB, and reduce NB or force use of
+ unblocked code.
+
+ Computing MAX
+*/
+ i__1 = 2, i__2 = ilaenv_(&c__2, "DGEHRD", " ", n, ilo, ihi, &
+ c_n1, (ftnlen)6, (ftnlen)1);
+ nbmin = max(i__1,i__2);
+ if (*lwork >= *n * nbmin) {
+ nb = *lwork / *n;
+ } else {
+ nb = 1;
+ }
+ }
+ }
+ }
+ ldwork = *n;
+
+ if (nb < nbmin || nb >= nh) {
+
+/* Use unblocked code below */
+
+ i__ = *ilo;
+
+ } else {
+
+/* Use blocked code */
+
+ i__1 = *ihi - 1 - nx;
+ i__2 = nb;
+ for (i__ = *ilo; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+/* Computing MIN */
+ i__3 = nb, i__4 = *ihi - i__;
+ ib = min(i__3,i__4);
+
+/*
+ Reduce columns i:i+ib-1 to Hessenberg form, returning the
+ matrices V and T of the block reflector H = I - V*T*V'
+ which performs the reduction, and also the matrix Y = A*V*T
+*/
+
+ dlahrd_(ihi, &i__, &ib, &a[i__ * a_dim1 + 1], lda, &tau[i__], t, &
+ c__65, &work[1], &ldwork);
+
+/*
+ Apply the block reflector H to A(1:ihi,i+ib:ihi) from the
+ right, computing A := A - Y * V'. V(i+ib,ib-1) must be set
+ to 1.
+*/
+
+ ei = a[i__ + ib + (i__ + ib - 1) * a_dim1];
+ a[i__ + ib + (i__ + ib - 1) * a_dim1] = 1.;
+ i__3 = *ihi - i__ - ib + 1;
+ dgemm_("No transpose", "Transpose", ihi, &i__3, &ib, &c_b151, &
+ work[1], &ldwork, &a[i__ + ib + i__ * a_dim1], lda, &
+ c_b15, &a[(i__ + ib) * a_dim1 + 1], lda);
+ a[i__ + ib + (i__ + ib - 1) * a_dim1] = ei;
+
+/*
+ Apply the block reflector H to A(i+1:ihi,i+ib:n) from the
+ left
+*/
+
+ i__3 = *ihi - i__;
+ i__4 = *n - i__ - ib + 1;
+ dlarfb_("Left", "Transpose", "Forward", "Columnwise", &i__3, &
+ i__4, &ib, &a[i__ + 1 + i__ * a_dim1], lda, t, &c__65, &a[
+ i__ + 1 + (i__ + ib) * a_dim1], lda, &work[1], &ldwork);
+/* L30: */
+ }
+ }
+
+/* Use unblocked code to reduce the rest of the matrix */
+
+ dgehd2_(n, &i__, ihi, &a[a_offset], lda, &tau[1], &work[1], &iinfo);
+ work[1] = (doublereal) iws;
+
+ return 0;
+
+/* End of DGEHRD */
+
+} /* dgehrd_ */
+
+/* Subroutine */ int dgelq2_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i__, k;
+ static doublereal aii;
+ extern /* Subroutine */ int dlarf_(char *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *), dlarfg_(integer *, doublereal *,
+ doublereal *, integer *, doublereal *), xerbla_(char *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ February 29, 1992
+
+
+ Purpose
+ =======
+
+ DGELQ2 computes an LQ factorization of a real m by n matrix A:
+ A = L * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, the elements on and below the diagonal of the array
+ contain the m by min(m,n) lower trapezoidal matrix L (L is
+ lower triangular if m <= n); the elements above the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+ Details).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k) . . . H(2) H(1), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
+ and tau in TAU(i).
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGELQ2", &i__1);
+ return 0;
+ }
+
+ k = min(*m,*n);
+
+ i__1 = k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/* Generate elementary reflector H(i) to annihilate A(i,i+1:n) */
+
+ i__2 = *n - i__ + 1;
+/* Computing MIN */
+ i__3 = i__ + 1;
+ dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[i__ + min(i__3,*n) * a_dim1]
+ , lda, &tau[i__]);
+ if (i__ < *m) {
+
+/* Apply H(i) to A(i+1:m,i:n) from the right */
+
+ aii = a[i__ + i__ * a_dim1];
+ a[i__ + i__ * a_dim1] = 1.;
+ i__2 = *m - i__;
+ i__3 = *n - i__ + 1;
+ dlarf_("Right", &i__2, &i__3, &a[i__ + i__ * a_dim1], lda, &tau[
+ i__], &a[i__ + 1 + i__ * a_dim1], lda, &work[1]);
+ a[i__ + i__ * a_dim1] = aii;
+ }
+/* L10: */
+ }
+ return 0;
+
+/* End of DGELQ2 */
+
+} /* dgelq2_ */
+
+/* Subroutine */ int dgelqf_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+
+ /* Local variables */
+ static integer i__, k, ib, nb, nx, iws, nbmin, iinfo;
+ extern /* Subroutine */ int dgelq2_(integer *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *), dlarfb_(char *,
+ char *, char *, char *, integer *, integer *, integer *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal
+ *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static integer ldwork, lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DGELQF computes an LQ factorization of a real M-by-N matrix A:
+ A = L * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the elements on and below the diagonal of the array
+ contain the m-by-min(m,n) lower trapezoidal matrix L (L is
+ lower triangular if m <= n); the elements above the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+ Details).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k) . . . H(2) H(1), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
+ and tau in TAU(i).
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ nb = ilaenv_(&c__1, "DGELQF", " ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)
+ 1);
+ lwkopt = *m * nb;
+ work[1] = (doublereal) lwkopt;
+ lquery = *lwork == -1;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ } else if ((*lwork < max(1,*m) && ! lquery)) {
+ *info = -7;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGELQF", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ k = min(*m,*n);
+ if (k == 0) {
+ work[1] = 1.;
+ return 0;
+ }
+
+ nbmin = 2;
+ nx = 0;
+ iws = *m;
+ if ((nb > 1 && nb < k)) {
+
+/*
+ Determine when to cross over from blocked to unblocked code.
+
+ Computing MAX
+*/
+ i__1 = 0, i__2 = ilaenv_(&c__3, "DGELQF", " ", m, n, &c_n1, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ nx = max(i__1,i__2);
+ if (nx < k) {
+
+/* Determine if workspace is large enough for blocked code. */
+
+ ldwork = *m;
+ iws = ldwork * nb;
+ if (*lwork < iws) {
+
+/*
+ Not enough workspace to use optimal NB: reduce NB and
+ determine the minimum value of NB.
+*/
+
+ nb = *lwork / ldwork;
+/* Computing MAX */
+ i__1 = 2, i__2 = ilaenv_(&c__2, "DGELQF", " ", m, n, &c_n1, &
+ c_n1, (ftnlen)6, (ftnlen)1);
+ nbmin = max(i__1,i__2);
+ }
+ }
+ }
+
+ if (((nb >= nbmin && nb < k) && nx < k)) {
+
+/* Use blocked code initially */
+
+ i__1 = k - nx;
+ i__2 = nb;
+ for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+/* Computing MIN */
+ i__3 = k - i__ + 1;
+ ib = min(i__3,nb);
+
+/*
+ Compute the LQ factorization of the current block
+ A(i:i+ib-1,i:n)
+*/
+
+ i__3 = *n - i__ + 1;
+ dgelq2_(&ib, &i__3, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[
+ 1], &iinfo);
+ if (i__ + ib <= *m) {
+
+/*
+ Form the triangular factor of the block reflector
+ H = H(i) H(i+1) . . . H(i+ib-1)
+*/
+
+ i__3 = *n - i__ + 1;
+ dlarft_("Forward", "Rowwise", &i__3, &ib, &a[i__ + i__ *
+ a_dim1], lda, &tau[i__], &work[1], &ldwork);
+
+/* Apply H to A(i+ib:m,i:n) from the right */
+
+ i__3 = *m - i__ - ib + 1;
+ i__4 = *n - i__ + 1;
+ dlarfb_("Right", "No transpose", "Forward", "Rowwise", &i__3,
+ &i__4, &ib, &a[i__ + i__ * a_dim1], lda, &work[1], &
+ ldwork, &a[i__ + ib + i__ * a_dim1], lda, &work[ib +
+ 1], &ldwork);
+ }
+/* L10: */
+ }
+ } else {
+ i__ = 1;
+ }
+
+/* Use unblocked code to factor the last or only block. */
+
+ if (i__ <= k) {
+ i__2 = *m - i__ + 1;
+ i__1 = *n - i__ + 1;
+ dgelq2_(&i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1]
+ , &iinfo);
+ }
+
+ work[1] = (doublereal) iws;
+ return 0;
+
+/* End of DGELQF */
+
+} /* dgelqf_ */
+
+/* Subroutine */ int dgelsd_(integer *m, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal *
+ s, doublereal *rcond, integer *rank, doublereal *work, integer *lwork,
+ integer *iwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4;
+
+ /* Builtin functions */
+ double log(doublereal);
+
+ /* Local variables */
+ static integer ie, il, mm;
+ static doublereal eps, anrm, bnrm;
+ static integer itau, nlvl, iascl, ibscl;
+ static doublereal sfmin;
+ static integer minmn, maxmn, itaup, itauq, mnthr, nwork;
+ extern /* Subroutine */ int dlabad_(doublereal *, doublereal *), dgebrd_(
+ integer *, integer *, doublereal *, integer *, doublereal *,
+ doublereal *, doublereal *, doublereal *, doublereal *, integer *,
+ integer *);
+ extern doublereal dlamch_(char *), dlange_(char *, integer *,
+ integer *, doublereal *, integer *, doublereal *);
+ extern /* Subroutine */ int dgelqf_(integer *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *, integer *),
+ dlalsd_(char *, integer *, integer *, integer *, doublereal *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, integer *, integer *), dlascl_(char *,
+ integer *, integer *, doublereal *, doublereal *, integer *,
+ integer *, doublereal *, integer *, integer *), dgeqrf_(
+ integer *, integer *, doublereal *, integer *, doublereal *,
+ doublereal *, integer *, integer *), dlacpy_(char *, integer *,
+ integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *,
+ doublereal *, doublereal *, integer *), xerbla_(char *,
+ integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static doublereal bignum;
+ extern /* Subroutine */ int dormbr_(char *, char *, char *, integer *,
+ integer *, integer *, doublereal *, integer *, doublereal *,
+ doublereal *, integer *, doublereal *, integer *, integer *);
+ static integer wlalsd;
+ extern /* Subroutine */ int dormlq_(char *, char *, integer *, integer *,
+ integer *, doublereal *, integer *, doublereal *, doublereal *,
+ integer *, doublereal *, integer *, integer *);
+ static integer ldwork;
+ extern /* Subroutine */ int dormqr_(char *, char *, integer *, integer *,
+ integer *, doublereal *, integer *, doublereal *, doublereal *,
+ integer *, doublereal *, integer *, integer *);
+ static integer minwrk, maxwrk;
+ static doublereal smlnum;
+ static logical lquery;
+ static integer smlsiz;
+
+
+/*
+ -- LAPACK driver routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1999
+
+
+ Purpose
+ =======
+
+ DGELSD computes the minimum-norm solution to a real linear least
+ squares problem:
+ minimize 2-norm(| b - A*x |)
+ using the singular value decomposition (SVD) of A. A is an M-by-N
+ matrix which may be rank-deficient.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+ matrix X.
+
+ The problem is solved in three steps:
+ (1) Reduce the coefficient matrix A to bidiagonal form with
+ Householder transformations, reducing the original problem
+ into a "bidiagonal least squares problem" (BLS)
+ (2) Solve the BLS using a divide and conquer approach.
+ (3) Apply back all the Householder tranformations to solve
+ the original least squares problem.
+
+ The effective rank of A is determined by treating as zero those
+ singular values which are less than RCOND times the largest singular
+ value.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A has been destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the M-by-NRHS right hand side matrix B.
+ On exit, B is overwritten by the N-by-NRHS solution
+ matrix X. If m >= n and RANK = n, the residual
+ sum-of-squares for the solution in the i-th column is given
+ by the sum of squares of elements n+1:m in that column.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,max(M,N)).
+
+ S (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The singular values of A in decreasing order.
+ The condition number of A in the 2-norm = S(1)/S(min(m,n)).
+
+ RCOND (input) DOUBLE PRECISION
+ RCOND is used to determine the effective rank of A.
+ Singular values S(i) <= RCOND*S(1) are treated as zero.
+ If RCOND < 0, machine precision is used instead.
+
+ RANK (output) INTEGER
+ The effective rank of A, i.e., the number of singular values
+ which are greater than RCOND*S(1).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK must be at least 1.
+ The exact minimum amount of workspace needed depends on M,
+ N and NRHS. As long as LWORK is at least
+ 12*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS + (SMLSIZ+1)**2,
+ if M is greater than or equal to N or
+ 12*M + 2*M*SMLSIZ + 8*M*NLVL + M*NRHS + (SMLSIZ+1)**2,
+ if M is less than N, the code will execute correctly.
+ SMLSIZ is returned by ILAENV and is equal to the maximum
+ size of the subproblems at the bottom of the computation
+ tree (usually about 25), and
+ NLVL = MAX( 0, INT( LOG_2( MIN( M,N )/(SMLSIZ+1) ) ) + 1 )
+ For good performance, LWORK should generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace) INTEGER array, dimension (LIWORK)
+ LIWORK >= 3 * MINMN * NLVL + 11 * MINMN,
+ where MINMN = MIN( M,N ).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: the algorithm for computing the SVD failed to converge;
+ if INFO = i, i off-diagonal elements of an intermediate
+ bidiagonal form did not converge to zero.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+
+ Test the input arguments.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ --s;
+ --work;
+ --iwork;
+
+ /* Function Body */
+ *info = 0;
+ minmn = min(*m,*n);
+ maxmn = max(*m,*n);
+ mnthr = ilaenv_(&c__6, "DGELSD", " ", m, n, nrhs, &c_n1, (ftnlen)6, (
+ ftnlen)1);
+ lquery = *lwork == -1;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*nrhs < 0) {
+ *info = -3;
+ } else if (*lda < max(1,*m)) {
+ *info = -5;
+ } else if (*ldb < max(1,maxmn)) {
+ *info = -7;
+ }
+
+ smlsiz = ilaenv_(&c__9, "DGELSD", " ", &c__0, &c__0, &c__0, &c__0, (
+ ftnlen)6, (ftnlen)1);
+
+/*
+ Compute workspace.
+ (Note: Comments in the code beginning "Workspace:" describe the
+ minimal amount of workspace needed at that point in the code,
+ as well as the preferred amount for good performance.
+ NB refers to the optimal block size for the immediately
+ following subroutine, as returned by ILAENV.)
+*/
+
+ minwrk = 1;
+ minmn = max(1,minmn);
+/* Computing MAX */
+ i__1 = (integer) (log((doublereal) minmn / (doublereal) (smlsiz + 1)) /
+ log(2.)) + 1;
+ nlvl = max(i__1,0);
+
+ if (*info == 0) {
+ maxwrk = 0;
+ mm = *m;
+ if ((*m >= *n && *m >= mnthr)) {
+
+/* Path 1a - overdetermined, with many more rows than columns. */
+
+ mm = *n;
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *n + *n * ilaenv_(&c__1, "DGEQRF", " ", m,
+ n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *n + *nrhs * ilaenv_(&c__1, "DORMQR", "LT",
+ m, nrhs, n, &c_n1, (ftnlen)6, (ftnlen)2);
+ maxwrk = max(i__1,i__2);
+ }
+ if (*m >= *n) {
+
+/*
+ Path 1 - overdetermined or exactly determined.
+
+ Computing MAX
+*/
+ i__1 = maxwrk, i__2 = *n * 3 + (mm + *n) * ilaenv_(&c__1, "DGEBRD"
+ , " ", &mm, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *n * 3 + *nrhs * ilaenv_(&c__1, "DORMBR",
+ "QLT", &mm, nrhs, n, &c_n1, (ftnlen)6, (ftnlen)3);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *n * 3 + (*n - 1) * ilaenv_(&c__1, "DORMBR",
+ "PLN", n, nrhs, n, &c_n1, (ftnlen)6, (ftnlen)3);
+ maxwrk = max(i__1,i__2);
+/* Computing 2nd power */
+ i__1 = smlsiz + 1;
+ wlalsd = *n * 9 + ((*n) << (1)) * smlsiz + ((*n) << (3)) * nlvl +
+ *n * *nrhs + i__1 * i__1;
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *n * 3 + wlalsd;
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = *n * 3 + mm, i__2 = *n * 3 + *nrhs, i__1 = max(i__1,i__2),
+ i__2 = *n * 3 + wlalsd;
+ minwrk = max(i__1,i__2);
+ }
+ if (*n > *m) {
+/* Computing 2nd power */
+ i__1 = smlsiz + 1;
+ wlalsd = *m * 9 + ((*m) << (1)) * smlsiz + ((*m) << (3)) * nlvl +
+ *m * *nrhs + i__1 * i__1;
+ if (*n >= mnthr) {
+
+/*
+ Path 2a - underdetermined, with many more columns
+ than rows.
+*/
+
+ maxwrk = *m + *m * ilaenv_(&c__1, "DGELQF", " ", m, n, &c_n1,
+ &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *m * *m + ((*m) << (2)) + ((*m) << (1))
+ * ilaenv_(&c__1, "DGEBRD", " ", m, m, &c_n1, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *m * *m + ((*m) << (2)) + *nrhs *
+ ilaenv_(&c__1, "DORMBR", "QLT", m, nrhs, m, &c_n1, (
+ ftnlen)6, (ftnlen)3);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *m * *m + ((*m) << (2)) + (*m - 1) *
+ ilaenv_(&c__1, "DORMBR", "PLN", m, nrhs, m, &c_n1, (
+ ftnlen)6, (ftnlen)3);
+ maxwrk = max(i__1,i__2);
+ if (*nrhs > 1) {
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *m * *m + *m + *m * *nrhs;
+ maxwrk = max(i__1,i__2);
+ } else {
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *m * *m + ((*m) << (1));
+ maxwrk = max(i__1,i__2);
+ }
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *m + *nrhs * ilaenv_(&c__1, "DORMLQ",
+ "LT", n, nrhs, m, &c_n1, (ftnlen)6, (ftnlen)2);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *m * *m + ((*m) << (2)) + wlalsd;
+ maxwrk = max(i__1,i__2);
+ } else {
+
+/* Path 2 - remaining underdetermined cases. */
+
+ maxwrk = *m * 3 + (*n + *m) * ilaenv_(&c__1, "DGEBRD", " ", m,
+ n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *m * 3 + *nrhs * ilaenv_(&c__1, "DORMBR"
+ , "QLT", m, nrhs, n, &c_n1, (ftnlen)6, (ftnlen)3);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *m * 3 + *m * ilaenv_(&c__1, "DORMBR",
+ "PLN", n, nrhs, m, &c_n1, (ftnlen)6, (ftnlen)3);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *m * 3 + wlalsd;
+ maxwrk = max(i__1,i__2);
+ }
+/* Computing MAX */
+ i__1 = *m * 3 + *nrhs, i__2 = *m * 3 + *m, i__1 = max(i__1,i__2),
+ i__2 = *m * 3 + wlalsd;
+ minwrk = max(i__1,i__2);
+ }
+ minwrk = min(minwrk,maxwrk);
+ work[1] = (doublereal) maxwrk;
+ if ((*lwork < minwrk && ! lquery)) {
+ *info = -12;
+ }
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGELSD", &i__1);
+ return 0;
+ } else if (lquery) {
+ goto L10;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0) {
+ *rank = 0;
+ return 0;
+ }
+
+/* Get machine parameters. */
+
+ eps = PRECISION;
+ sfmin = SAFEMINIMUM;
+ smlnum = sfmin / eps;
+ bignum = 1. / smlnum;
+ dlabad_(&smlnum, &bignum);
+
+/* Scale A if max entry outside range [SMLNUM,BIGNUM]. */
+
+ anrm = dlange_("M", m, n, &a[a_offset], lda, &work[1]);
+ iascl = 0;
+ if ((anrm > 0. && anrm < smlnum)) {
+
+/* Scale matrix norm up to SMLNUM. */
+
+ dlascl_("G", &c__0, &c__0, &anrm, &smlnum, m, n, &a[a_offset], lda,
+ info);
+ iascl = 1;
+ } else if (anrm > bignum) {
+
+/* Scale matrix norm down to BIGNUM. */
+
+ dlascl_("G", &c__0, &c__0, &anrm, &bignum, m, n, &a[a_offset], lda,
+ info);
+ iascl = 2;
+ } else if (anrm == 0.) {
+
+/* Matrix all zero. Return zero solution. */
+
+ i__1 = max(*m,*n);
+ dlaset_("F", &i__1, nrhs, &c_b29, &c_b29, &b[b_offset], ldb);
+ dlaset_("F", &minmn, &c__1, &c_b29, &c_b29, &s[1], &c__1);
+ *rank = 0;
+ goto L10;
+ }
+
+/* Scale B if max entry outside range [SMLNUM,BIGNUM]. */
+
+ bnrm = dlange_("M", m, nrhs, &b[b_offset], ldb, &work[1]);
+ ibscl = 0;
+ if ((bnrm > 0. && bnrm < smlnum)) {
+
+/* Scale matrix norm up to SMLNUM. */
+
+ dlascl_("G", &c__0, &c__0, &bnrm, &smlnum, m, nrhs, &b[b_offset], ldb,
+ info);
+ ibscl = 1;
+ } else if (bnrm > bignum) {
+
+/* Scale matrix norm down to BIGNUM. */
+
+ dlascl_("G", &c__0, &c__0, &bnrm, &bignum, m, nrhs, &b[b_offset], ldb,
+ info);
+ ibscl = 2;
+ }
+
+/* If M < N make sure certain entries of B are zero. */
+
+ if (*m < *n) {
+ i__1 = *n - *m;
+ dlaset_("F", &i__1, nrhs, &c_b29, &c_b29, &b[*m + 1 + b_dim1], ldb);
+ }
+
+/* Overdetermined case. */
+
+ if (*m >= *n) {
+
+/* Path 1 - overdetermined or exactly determined. */
+
+ mm = *m;
+ if (*m >= mnthr) {
+
+/* Path 1a - overdetermined, with many more rows than columns. */
+
+ mm = *n;
+ itau = 1;
+ nwork = itau + *n;
+
+/*
+ Compute A=Q*R.
+ (Workspace: need 2*N, prefer N+N*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &i__1,
+ info);
+
+/*
+ Multiply B by transpose(Q).
+ (Workspace: need N+NRHS, prefer N+NRHS*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dormqr_("L", "T", m, nrhs, n, &a[a_offset], lda, &work[itau], &b[
+ b_offset], ldb, &work[nwork], &i__1, info);
+
+/* Zero out below R. */
+
+ if (*n > 1) {
+ i__1 = *n - 1;
+ i__2 = *n - 1;
+ dlaset_("L", &i__1, &i__2, &c_b29, &c_b29, &a[a_dim1 + 2],
+ lda);
+ }
+ }
+
+ ie = 1;
+ itauq = ie + *n;
+ itaup = itauq + *n;
+ nwork = itaup + *n;
+
+/*
+ Bidiagonalize R in A.
+ (Workspace: need 3*N+MM, prefer 3*N+(MM+N)*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dgebrd_(&mm, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &
+ work[itaup], &work[nwork], &i__1, info);
+
+/*
+ Multiply B by transpose of left bidiagonalizing vectors of R.
+ (Workspace: need 3*N+NRHS, prefer 3*N+NRHS*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dormbr_("Q", "L", "T", &mm, nrhs, n, &a[a_offset], lda, &work[itauq],
+ &b[b_offset], ldb, &work[nwork], &i__1, info);
+
+/* Solve the bidiagonal least squares problem. */
+
+ dlalsd_("U", &smlsiz, n, nrhs, &s[1], &work[ie], &b[b_offset], ldb,
+ rcond, rank, &work[nwork], &iwork[1], info);
+ if (*info != 0) {
+ goto L10;
+ }
+
+/* Multiply B by right bidiagonalizing vectors of R. */
+
+ i__1 = *lwork - nwork + 1;
+ dormbr_("P", "L", "N", n, nrhs, n, &a[a_offset], lda, &work[itaup], &
+ b[b_offset], ldb, &work[nwork], &i__1, info);
+
+ } else /* if(complicated condition) */ {
+/* Computing MAX */
+ i__1 = *m, i__2 = ((*m) << (1)) - 4, i__1 = max(i__1,i__2), i__1 =
+ max(i__1,*nrhs), i__2 = *n - *m * 3;
+ if ((*n >= mnthr && *lwork >= ((*m) << (2)) + *m * *m + max(i__1,i__2)
+ )) {
+
+/*
+ Path 2a - underdetermined, with many more columns than rows
+ and sufficient workspace for an efficient algorithm.
+*/
+
+ ldwork = *m;
+/*
+ Computing MAX
+ Computing MAX
+*/
+ i__3 = *m, i__4 = ((*m) << (1)) - 4, i__3 = max(i__3,i__4), i__3 =
+ max(i__3,*nrhs), i__4 = *n - *m * 3;
+ i__1 = ((*m) << (2)) + *m * *lda + max(i__3,i__4), i__2 = *m * *
+ lda + *m + *m * *nrhs;
+ if (*lwork >= max(i__1,i__2)) {
+ ldwork = *lda;
+ }
+ itau = 1;
+ nwork = *m + 1;
+
+/*
+ Compute A=L*Q.
+ (Workspace: need 2*M, prefer M+M*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &i__1,
+ info);
+ il = nwork;
+
+/* Copy L to WORK(IL), zeroing out above its diagonal. */
+
+ dlacpy_("L", m, m, &a[a_offset], lda, &work[il], &ldwork);
+ i__1 = *m - 1;
+ i__2 = *m - 1;
+ dlaset_("U", &i__1, &i__2, &c_b29, &c_b29, &work[il + ldwork], &
+ ldwork);
+ ie = il + ldwork * *m;
+ itauq = ie + *m;
+ itaup = itauq + *m;
+ nwork = itaup + *m;
+
+/*
+ Bidiagonalize L in WORK(IL).
+ (Workspace: need M*M+5*M, prefer M*M+4*M+2*M*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dgebrd_(m, m, &work[il], &ldwork, &s[1], &work[ie], &work[itauq],
+ &work[itaup], &work[nwork], &i__1, info);
+
+/*
+ Multiply B by transpose of left bidiagonalizing vectors of L.
+ (Workspace: need M*M+4*M+NRHS, prefer M*M+4*M+NRHS*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dormbr_("Q", "L", "T", m, nrhs, m, &work[il], &ldwork, &work[
+ itauq], &b[b_offset], ldb, &work[nwork], &i__1, info);
+
+/* Solve the bidiagonal least squares problem. */
+
+ dlalsd_("U", &smlsiz, m, nrhs, &s[1], &work[ie], &b[b_offset],
+ ldb, rcond, rank, &work[nwork], &iwork[1], info);
+ if (*info != 0) {
+ goto L10;
+ }
+
+/* Multiply B by right bidiagonalizing vectors of L. */
+
+ i__1 = *lwork - nwork + 1;
+ dormbr_("P", "L", "N", m, nrhs, m, &work[il], &ldwork, &work[
+ itaup], &b[b_offset], ldb, &work[nwork], &i__1, info);
+
+/* Zero out below first M rows of B. */
+
+ i__1 = *n - *m;
+ dlaset_("F", &i__1, nrhs, &c_b29, &c_b29, &b[*m + 1 + b_dim1],
+ ldb);
+ nwork = itau + *m;
+
+/*
+ Multiply transpose(Q) by B.
+ (Workspace: need M+NRHS, prefer M+NRHS*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dormlq_("L", "T", n, nrhs, m, &a[a_offset], lda, &work[itau], &b[
+ b_offset], ldb, &work[nwork], &i__1, info);
+
+ } else {
+
+/* Path 2 - remaining underdetermined cases. */
+
+ ie = 1;
+ itauq = ie + *m;
+ itaup = itauq + *m;
+ nwork = itaup + *m;
+
+/*
+ Bidiagonalize A.
+ (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dgebrd_(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &
+ work[itaup], &work[nwork], &i__1, info);
+
+/*
+ Multiply B by transpose of left bidiagonalizing vectors.
+ (Workspace: need 3*M+NRHS, prefer 3*M+NRHS*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dormbr_("Q", "L", "T", m, nrhs, n, &a[a_offset], lda, &work[itauq]
+ , &b[b_offset], ldb, &work[nwork], &i__1, info);
+
+/* Solve the bidiagonal least squares problem. */
+
+ dlalsd_("L", &smlsiz, m, nrhs, &s[1], &work[ie], &b[b_offset],
+ ldb, rcond, rank, &work[nwork], &iwork[1], info);
+ if (*info != 0) {
+ goto L10;
+ }
+
+/* Multiply B by right bidiagonalizing vectors of A. */
+
+ i__1 = *lwork - nwork + 1;
+ dormbr_("P", "L", "N", n, nrhs, m, &a[a_offset], lda, &work[itaup]
+ , &b[b_offset], ldb, &work[nwork], &i__1, info);
+
+ }
+ }
+
+/* Undo scaling. */
+
+ if (iascl == 1) {
+ dlascl_("G", &c__0, &c__0, &anrm, &smlnum, n, nrhs, &b[b_offset], ldb,
+ info);
+ dlascl_("G", &c__0, &c__0, &smlnum, &anrm, &minmn, &c__1, &s[1], &
+ minmn, info);
+ } else if (iascl == 2) {
+ dlascl_("G", &c__0, &c__0, &anrm, &bignum, n, nrhs, &b[b_offset], ldb,
+ info);
+ dlascl_("G", &c__0, &c__0, &bignum, &anrm, &minmn, &c__1, &s[1], &
+ minmn, info);
+ }
+ if (ibscl == 1) {
+ dlascl_("G", &c__0, &c__0, &smlnum, &bnrm, n, nrhs, &b[b_offset], ldb,
+ info);
+ } else if (ibscl == 2) {
+ dlascl_("G", &c__0, &c__0, &bignum, &bnrm, n, nrhs, &b[b_offset], ldb,
+ info);
+ }
+
+L10:
+ work[1] = (doublereal) maxwrk;
+ return 0;
+
+/* End of DGELSD */
+
+} /* dgelsd_ */
+
+/* Subroutine */ int dgeqr2_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i__, k;
+ static doublereal aii;
+ extern /* Subroutine */ int dlarf_(char *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *), dlarfg_(integer *, doublereal *,
+ doublereal *, integer *, doublereal *), xerbla_(char *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ February 29, 1992
+
+
+ Purpose
+ =======
+
+ DGEQR2 computes a QR factorization of a real m by n matrix A:
+ A = Q * R.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, the elements on and above the diagonal of the array
+ contain the min(m,n) by n upper trapezoidal matrix R (R is
+ upper triangular if m >= n); the elements below the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+ Details).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
+ and tau in TAU(i).
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGEQR2", &i__1);
+ return 0;
+ }
+
+ k = min(*m,*n);
+
+ i__1 = k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/* Generate elementary reflector H(i) to annihilate A(i+1:m,i) */
+
+ i__2 = *m - i__ + 1;
+/* Computing MIN */
+ i__3 = i__ + 1;
+ dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[min(i__3,*m) + i__ * a_dim1]
+ , &c__1, &tau[i__]);
+ if (i__ < *n) {
+
+/* Apply H(i) to A(i:m,i+1:n) from the left */
+
+ aii = a[i__ + i__ * a_dim1];
+ a[i__ + i__ * a_dim1] = 1.;
+ i__2 = *m - i__ + 1;
+ i__3 = *n - i__;
+ dlarf_("Left", &i__2, &i__3, &a[i__ + i__ * a_dim1], &c__1, &tau[
+ i__], &a[i__ + (i__ + 1) * a_dim1], lda, &work[1]);
+ a[i__ + i__ * a_dim1] = aii;
+ }
+/* L10: */
+ }
+ return 0;
+
+/* End of DGEQR2 */
+
+} /* dgeqr2_ */
+
+/* Subroutine */ int dgeqrf_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+
+ /* Local variables */
+ static integer i__, k, ib, nb, nx, iws, nbmin, iinfo;
+ extern /* Subroutine */ int dgeqr2_(integer *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *), dlarfb_(char *,
+ char *, char *, char *, integer *, integer *, integer *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal
+ *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static integer ldwork, lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DGEQRF computes a QR factorization of a real M-by-N matrix A:
+ A = Q * R.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the elements on and above the diagonal of the array
+ contain the min(M,N)-by-N upper trapezoidal matrix R (R is
+ upper triangular if m >= n); the elements below the diagonal,
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of min(m,n) elementary reflectors (see Further
+ Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+ Details).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
+ and tau in TAU(i).
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ nb = ilaenv_(&c__1, "DGEQRF", " ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)
+ 1);
+ lwkopt = *n * nb;
+ work[1] = (doublereal) lwkopt;
+ lquery = *lwork == -1;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ } else if ((*lwork < max(1,*n) && ! lquery)) {
+ *info = -7;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGEQRF", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ k = min(*m,*n);
+ if (k == 0) {
+ work[1] = 1.;
+ return 0;
+ }
+
+ nbmin = 2;
+ nx = 0;
+ iws = *n;
+ if ((nb > 1 && nb < k)) {
+
+/*
+ Determine when to cross over from blocked to unblocked code.
+
+ Computing MAX
+*/
+ i__1 = 0, i__2 = ilaenv_(&c__3, "DGEQRF", " ", m, n, &c_n1, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ nx = max(i__1,i__2);
+ if (nx < k) {
+
+/* Determine if workspace is large enough for blocked code. */
+
+ ldwork = *n;
+ iws = ldwork * nb;
+ if (*lwork < iws) {
+
+/*
+ Not enough workspace to use optimal NB: reduce NB and
+ determine the minimum value of NB.
+*/
+
+ nb = *lwork / ldwork;
+/* Computing MAX */
+ i__1 = 2, i__2 = ilaenv_(&c__2, "DGEQRF", " ", m, n, &c_n1, &
+ c_n1, (ftnlen)6, (ftnlen)1);
+ nbmin = max(i__1,i__2);
+ }
+ }
+ }
+
+ if (((nb >= nbmin && nb < k) && nx < k)) {
+
+/* Use blocked code initially */
+
+ i__1 = k - nx;
+ i__2 = nb;
+ for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+/* Computing MIN */
+ i__3 = k - i__ + 1;
+ ib = min(i__3,nb);
+
+/*
+ Compute the QR factorization of the current block
+ A(i:m,i:i+ib-1)
+*/
+
+ i__3 = *m - i__ + 1;
+ dgeqr2_(&i__3, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[
+ 1], &iinfo);
+ if (i__ + ib <= *n) {
+
+/*
+ Form the triangular factor of the block reflector
+ H = H(i) H(i+1) . . . H(i+ib-1)
+*/
+
+ i__3 = *m - i__ + 1;
+ dlarft_("Forward", "Columnwise", &i__3, &ib, &a[i__ + i__ *
+ a_dim1], lda, &tau[i__], &work[1], &ldwork);
+
+/* Apply H' to A(i:m,i+ib:n) from the left */
+
+ i__3 = *m - i__ + 1;
+ i__4 = *n - i__ - ib + 1;
+ dlarfb_("Left", "Transpose", "Forward", "Columnwise", &i__3, &
+ i__4, &ib, &a[i__ + i__ * a_dim1], lda, &work[1], &
+ ldwork, &a[i__ + (i__ + ib) * a_dim1], lda, &work[ib
+ + 1], &ldwork);
+ }
+/* L10: */
+ }
+ } else {
+ i__ = 1;
+ }
+
+/* Use unblocked code to factor the last or only block. */
+
+ if (i__ <= k) {
+ i__2 = *m - i__ + 1;
+ i__1 = *n - i__ + 1;
+ dgeqr2_(&i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1]
+ , &iinfo);
+ }
+
+ work[1] = (doublereal) iws;
+ return 0;
+
+/* End of DGEQRF */
+
+} /* dgeqrf_ */
+
+/* Subroutine */ int dgesdd_(char *jobz, integer *m, integer *n, doublereal *
+ a, integer *lda, doublereal *s, doublereal *u, integer *ldu,
+ doublereal *vt, integer *ldvt, doublereal *work, integer *lwork,
+ integer *iwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1,
+ i__2, i__3;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static integer i__, ie, il, ir, iu, blk;
+ static doublereal dum[1], eps;
+ static integer ivt, iscl;
+ static doublereal anrm;
+ static integer idum[1], ierr, itau;
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *);
+ extern logical lsame_(char *, char *);
+ static integer chunk, minmn, wrkbl, itaup, itauq, mnthr;
+ static logical wntqa;
+ static integer nwork;
+ static logical wntqn, wntqo, wntqs;
+ extern /* Subroutine */ int dbdsdc_(char *, char *, integer *, doublereal
+ *, doublereal *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, integer *, integer *), dgebrd_(integer *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, doublereal *, doublereal *,
+ doublereal *, integer *, integer *);
+ extern doublereal dlamch_(char *), dlange_(char *, integer *,
+ integer *, doublereal *, integer *, doublereal *);
+ static integer bdspac;
+ extern /* Subroutine */ int dgelqf_(integer *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *, integer *),
+ dlascl_(char *, integer *, integer *, doublereal *, doublereal *,
+ integer *, integer *, doublereal *, integer *, integer *),
+ dgeqrf_(integer *, integer *, doublereal *, integer *,
+ doublereal *, doublereal *, integer *, integer *), dlacpy_(char *,
+ integer *, integer *, doublereal *, integer *, doublereal *,
+ integer *), dlaset_(char *, integer *, integer *,
+ doublereal *, doublereal *, doublereal *, integer *),
+ xerbla_(char *, integer *), dorgbr_(char *, integer *,
+ integer *, integer *, doublereal *, integer *, doublereal *,
+ doublereal *, integer *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static doublereal bignum;
+ extern /* Subroutine */ int dormbr_(char *, char *, char *, integer *,
+ integer *, integer *, doublereal *, integer *, doublereal *,
+ doublereal *, integer *, doublereal *, integer *, integer *), dorglq_(integer *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ integer *), dorgqr_(integer *, integer *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *, integer *);
+ static integer ldwrkl, ldwrkr, minwrk, ldwrku, maxwrk, ldwkvt;
+ static doublereal smlnum;
+ static logical wntqas, lquery;
+
+
+/*
+ -- LAPACK driver routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1999
+
+
+ Purpose
+ =======
+
+ DGESDD computes the singular value decomposition (SVD) of a real
+ M-by-N matrix A, optionally computing the left and right singular
+ vectors. If singular vectors are desired, it uses a
+ divide-and-conquer algorithm.
+
+ The SVD is written
+
+ A = U * SIGMA * transpose(V)
+
+ where SIGMA is an M-by-N matrix which is zero except for its
+ min(m,n) diagonal elements, U is an M-by-M orthogonal matrix, and
+ V is an N-by-N orthogonal matrix. The diagonal elements of SIGMA
+ are the singular values of A; they are real and non-negative, and
+ are returned in descending order. The first min(m,n) columns of
+ U and V are the left and right singular vectors of A.
+
+ Note that the routine returns VT = V**T, not V.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ Specifies options for computing all or part of the matrix U:
+ = 'A': all M columns of U and all N rows of V**T are
+ returned in the arrays U and VT;
+ = 'S': the first min(M,N) columns of U and the first
+ min(M,N) rows of V**T are returned in the arrays U
+ and VT;
+ = 'O': If M >= N, the first N columns of U are overwritten
+ on the array A and all rows of V**T are returned in
+ the array VT;
+ otherwise, all columns of U are returned in the
+ array U and the first M rows of V**T are overwritten
+ in the array VT;
+ = 'N': no columns of U or rows of V**T are computed.
+
+ M (input) INTEGER
+ The number of rows of the input matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the input matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if JOBZ = 'O', A is overwritten with the first N columns
+ of U (the left singular vectors, stored
+ columnwise) if M >= N;
+ A is overwritten with the first M rows
+ of V**T (the right singular vectors, stored
+ rowwise) otherwise.
+ if JOBZ .ne. 'O', the contents of A are destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ S (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The singular values of A, sorted so that S(i) >= S(i+1).
+
+ U (output) DOUBLE PRECISION array, dimension (LDU,UCOL)
+ UCOL = M if JOBZ = 'A' or JOBZ = 'O' and M < N;
+ UCOL = min(M,N) if JOBZ = 'S'.
+ If JOBZ = 'A' or JOBZ = 'O' and M < N, U contains the M-by-M
+ orthogonal matrix U;
+ if JOBZ = 'S', U contains the first min(M,N) columns of U
+ (the left singular vectors, stored columnwise);
+ if JOBZ = 'O' and M >= N, or JOBZ = 'N', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= 1; if
+ JOBZ = 'S' or 'A' or JOBZ = 'O' and M < N, LDU >= M.
+
+ VT (output) DOUBLE PRECISION array, dimension (LDVT,N)
+ If JOBZ = 'A' or JOBZ = 'O' and M >= N, VT contains the
+ N-by-N orthogonal matrix V**T;
+ if JOBZ = 'S', VT contains the first min(M,N) rows of
+ V**T (the right singular vectors, stored rowwise);
+ if JOBZ = 'O' and M < N, or JOBZ = 'N', VT is not referenced.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= 1; if
+ JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N;
+ if JOBZ = 'S', LDVT >= min(M,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK;
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 1.
+ If JOBZ = 'N',
+ LWORK >= 3*min(M,N) + max(max(M,N),6*min(M,N)).
+ If JOBZ = 'O',
+ LWORK >= 3*min(M,N)*min(M,N) +
+ max(max(M,N),5*min(M,N)*min(M,N)+4*min(M,N)).
+ If JOBZ = 'S' or 'A'
+ LWORK >= 3*min(M,N)*min(M,N) +
+ max(max(M,N),4*min(M,N)*min(M,N)+4*min(M,N)).
+ For good performance, LWORK should generally be larger.
+ If LWORK < 0 but other input arguments are legal, WORK(1)
+ returns the optimal LWORK.
+
+ IWORK (workspace) INTEGER array, dimension (8*min(M,N))
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: DBDSDC did not converge, updating process failed.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --s;
+ u_dim1 = *ldu;
+ u_offset = 1 + u_dim1 * 1;
+ u -= u_offset;
+ vt_dim1 = *ldvt;
+ vt_offset = 1 + vt_dim1 * 1;
+ vt -= vt_offset;
+ --work;
+ --iwork;
+
+ /* Function Body */
+ *info = 0;
+ minmn = min(*m,*n);
+ mnthr = (integer) (minmn * 11. / 6.);
+ wntqa = lsame_(jobz, "A");
+ wntqs = lsame_(jobz, "S");
+ wntqas = wntqa || wntqs;
+ wntqo = lsame_(jobz, "O");
+ wntqn = lsame_(jobz, "N");
+ minwrk = 1;
+ maxwrk = 1;
+ lquery = *lwork == -1;
+
+ if (! (wntqa || wntqs || wntqo || wntqn)) {
+ *info = -1;
+ } else if (*m < 0) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*lda < max(1,*m)) {
+ *info = -5;
+ } else if (*ldu < 1 || (wntqas && *ldu < *m) || ((wntqo && *m < *n) && *
+ ldu < *m)) {
+ *info = -8;
+ } else if (*ldvt < 1 || (wntqa && *ldvt < *n) || (wntqs && *ldvt < minmn)
+ || ((wntqo && *m >= *n) && *ldvt < *n)) {
+ *info = -10;
+ }
+
+/*
+ Compute workspace
+ (Note: Comments in the code beginning "Workspace:" describe the
+ minimal amount of workspace needed at that point in the code,
+ as well as the preferred amount for good performance.
+ NB refers to the optimal block size for the immediately
+ following subroutine, as returned by ILAENV.)
+*/
+
+ if (((*info == 0 && *m > 0) && *n > 0)) {
+ if (*m >= *n) {
+
+/* Compute space needed for DBDSDC */
+
+ if (wntqn) {
+ bdspac = *n * 7;
+ } else {
+ bdspac = *n * 3 * *n + ((*n) << (2));
+ }
+ if (*m >= mnthr) {
+ if (wntqn) {
+
+/* Path 1 (M much larger than N, JOBZ='N') */
+
+ wrkbl = *n + *n * ilaenv_(&c__1, "DGEQRF", " ", m, n, &
+ c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n * 3 + ((*n) << (1)) * ilaenv_(&
+ c__1, "DGEBRD", " ", n, n, &c_n1, &c_n1, (ftnlen)
+ 6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = bdspac + *n;
+ maxwrk = max(i__1,i__2);
+ minwrk = bdspac + *n;
+ } else if (wntqo) {
+
+/* Path 2 (M much larger than N, JOBZ='O') */
+
+ wrkbl = *n + *n * ilaenv_(&c__1, "DGEQRF", " ", m, n, &
+ c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n + *n * ilaenv_(&c__1, "DORGQR",
+ " ", m, n, n, &c_n1, (ftnlen)6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n * 3 + ((*n) << (1)) * ilaenv_(&
+ c__1, "DGEBRD", " ", n, n, &c_n1, &c_n1, (ftnlen)
+ 6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&c__1, "DORMBR"
+ , "QLN", n, n, n, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&c__1, "DORMBR"
+ , "PRT", n, n, n, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = bdspac + *n * 3;
+ wrkbl = max(i__1,i__2);
+ maxwrk = wrkbl + ((*n) << (1)) * *n;
+ minwrk = bdspac + ((*n) << (1)) * *n + *n * 3;
+ } else if (wntqs) {
+
+/* Path 3 (M much larger than N, JOBZ='S') */
+
+ wrkbl = *n + *n * ilaenv_(&c__1, "DGEQRF", " ", m, n, &
+ c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n + *n * ilaenv_(&c__1, "DORGQR",
+ " ", m, n, n, &c_n1, (ftnlen)6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n * 3 + ((*n) << (1)) * ilaenv_(&
+ c__1, "DGEBRD", " ", n, n, &c_n1, &c_n1, (ftnlen)
+ 6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&c__1, "DORMBR"
+ , "QLN", n, n, n, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&c__1, "DORMBR"
+ , "PRT", n, n, n, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = bdspac + *n * 3;
+ wrkbl = max(i__1,i__2);
+ maxwrk = wrkbl + *n * *n;
+ minwrk = bdspac + *n * *n + *n * 3;
+ } else if (wntqa) {
+
+/* Path 4 (M much larger than N, JOBZ='A') */
+
+ wrkbl = *n + *n * ilaenv_(&c__1, "DGEQRF", " ", m, n, &
+ c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n + *m * ilaenv_(&c__1, "DORGQR",
+ " ", m, m, n, &c_n1, (ftnlen)6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n * 3 + ((*n) << (1)) * ilaenv_(&
+ c__1, "DGEBRD", " ", n, n, &c_n1, &c_n1, (ftnlen)
+ 6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&c__1, "DORMBR"
+ , "QLN", n, n, n, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&c__1, "DORMBR"
+ , "PRT", n, n, n, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = bdspac + *n * 3;
+ wrkbl = max(i__1,i__2);
+ maxwrk = wrkbl + *n * *n;
+ minwrk = bdspac + *n * *n + *n * 3;
+ }
+ } else {
+
+/* Path 5 (M at least N, but not much larger) */
+
+ wrkbl = *n * 3 + (*m + *n) * ilaenv_(&c__1, "DGEBRD", " ", m,
+ n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+ if (wntqn) {
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = bdspac + *n * 3;
+ maxwrk = max(i__1,i__2);
+ minwrk = *n * 3 + max(*m,bdspac);
+ } else if (wntqo) {
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&c__1, "DORMBR"
+ , "QLN", m, n, n, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&c__1, "DORMBR"
+ , "PRT", n, n, n, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = bdspac + *n * 3;
+ wrkbl = max(i__1,i__2);
+ maxwrk = wrkbl + *m * *n;
+/* Computing MAX */
+ i__1 = *m, i__2 = *n * *n + bdspac;
+ minwrk = *n * 3 + max(i__1,i__2);
+ } else if (wntqs) {
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&c__1, "DORMBR"
+ , "QLN", m, n, n, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&c__1, "DORMBR"
+ , "PRT", n, n, n, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = bdspac + *n * 3;
+ maxwrk = max(i__1,i__2);
+ minwrk = *n * 3 + max(*m,bdspac);
+ } else if (wntqa) {
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n * 3 + *m * ilaenv_(&c__1, "DORMBR"
+ , "QLN", m, m, n, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n * 3 + *n * ilaenv_(&c__1, "DORMBR"
+ , "PRT", n, n, n, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = bdspac + *n * 3;
+ maxwrk = max(i__1,i__2);
+ minwrk = *n * 3 + max(*m,bdspac);
+ }
+ }
+ } else {
+
+/* Compute space needed for DBDSDC */
+
+ if (wntqn) {
+ bdspac = *m * 7;
+ } else {
+ bdspac = *m * 3 * *m + ((*m) << (2));
+ }
+ if (*n >= mnthr) {
+ if (wntqn) {
+
+/* Path 1t (N much larger than M, JOBZ='N') */
+
+ wrkbl = *m + *m * ilaenv_(&c__1, "DGELQF", " ", m, n, &
+ c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m * 3 + ((*m) << (1)) * ilaenv_(&
+ c__1, "DGEBRD", " ", m, m, &c_n1, &c_n1, (ftnlen)
+ 6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = bdspac + *m;
+ maxwrk = max(i__1,i__2);
+ minwrk = bdspac + *m;
+ } else if (wntqo) {
+
+/* Path 2t (N much larger than M, JOBZ='O') */
+
+ wrkbl = *m + *m * ilaenv_(&c__1, "DGELQF", " ", m, n, &
+ c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m + *m * ilaenv_(&c__1, "DORGLQ",
+ " ", m, n, m, &c_n1, (ftnlen)6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m * 3 + ((*m) << (1)) * ilaenv_(&
+ c__1, "DGEBRD", " ", m, m, &c_n1, &c_n1, (ftnlen)
+ 6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&c__1, "DORMBR"
+ , "QLN", m, m, m, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&c__1, "DORMBR"
+ , "PRT", m, m, m, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = bdspac + *m * 3;
+ wrkbl = max(i__1,i__2);
+ maxwrk = wrkbl + ((*m) << (1)) * *m;
+ minwrk = bdspac + ((*m) << (1)) * *m + *m * 3;
+ } else if (wntqs) {
+
+/* Path 3t (N much larger than M, JOBZ='S') */
+
+ wrkbl = *m + *m * ilaenv_(&c__1, "DGELQF", " ", m, n, &
+ c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m + *m * ilaenv_(&c__1, "DORGLQ",
+ " ", m, n, m, &c_n1, (ftnlen)6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m * 3 + ((*m) << (1)) * ilaenv_(&
+ c__1, "DGEBRD", " ", m, m, &c_n1, &c_n1, (ftnlen)
+ 6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&c__1, "DORMBR"
+ , "QLN", m, m, m, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&c__1, "DORMBR"
+ , "PRT", m, m, m, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = bdspac + *m * 3;
+ wrkbl = max(i__1,i__2);
+ maxwrk = wrkbl + *m * *m;
+ minwrk = bdspac + *m * *m + *m * 3;
+ } else if (wntqa) {
+
+/* Path 4t (N much larger than M, JOBZ='A') */
+
+ wrkbl = *m + *m * ilaenv_(&c__1, "DGELQF", " ", m, n, &
+ c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m + *n * ilaenv_(&c__1, "DORGLQ",
+ " ", n, n, m, &c_n1, (ftnlen)6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m * 3 + ((*m) << (1)) * ilaenv_(&
+ c__1, "DGEBRD", " ", m, m, &c_n1, &c_n1, (ftnlen)
+ 6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&c__1, "DORMBR"
+ , "QLN", m, m, m, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&c__1, "DORMBR"
+ , "PRT", m, m, m, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = bdspac + *m * 3;
+ wrkbl = max(i__1,i__2);
+ maxwrk = wrkbl + *m * *m;
+ minwrk = bdspac + *m * *m + *m * 3;
+ }
+ } else {
+
+/* Path 5t (N greater than M, but not much larger) */
+
+ wrkbl = *m * 3 + (*m + *n) * ilaenv_(&c__1, "DGEBRD", " ", m,
+ n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+ if (wntqn) {
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = bdspac + *m * 3;
+ maxwrk = max(i__1,i__2);
+ minwrk = *m * 3 + max(*n,bdspac);
+ } else if (wntqo) {
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&c__1, "DORMBR"
+ , "QLN", m, m, n, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&c__1, "DORMBR"
+ , "PRT", m, n, m, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = bdspac + *m * 3;
+ wrkbl = max(i__1,i__2);
+ maxwrk = wrkbl + *m * *n;
+/* Computing MAX */
+ i__1 = *n, i__2 = *m * *m + bdspac;
+ minwrk = *m * 3 + max(i__1,i__2);
+ } else if (wntqs) {
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&c__1, "DORMBR"
+ , "QLN", m, m, n, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&c__1, "DORMBR"
+ , "PRT", m, n, m, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = bdspac + *m * 3;
+ maxwrk = max(i__1,i__2);
+ minwrk = *m * 3 + max(*n,bdspac);
+ } else if (wntqa) {
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&c__1, "DORMBR"
+ , "QLN", m, m, n, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m * 3 + *m * ilaenv_(&c__1, "DORMBR"
+ , "PRT", n, n, m, &c_n1, (ftnlen)6, (ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = bdspac + *m * 3;
+ maxwrk = max(i__1,i__2);
+ minwrk = *m * 3 + max(*n,bdspac);
+ }
+ }
+ }
+ work[1] = (doublereal) maxwrk;
+ }
+
+ if ((*lwork < minwrk && ! lquery)) {
+ *info = -12;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGESDD", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0) {
+ if (*lwork >= 1) {
+ work[1] = 1.;
+ }
+ return 0;
+ }
+
+/* Get machine constants */
+
+ eps = PRECISION;
+ smlnum = sqrt(SAFEMINIMUM) / eps;
+ bignum = 1. / smlnum;
+
+/* Scale A if max element outside range [SMLNUM,BIGNUM] */
+
+ anrm = dlange_("M", m, n, &a[a_offset], lda, dum);
+ iscl = 0;
+ if ((anrm > 0. && anrm < smlnum)) {
+ iscl = 1;
+ dlascl_("G", &c__0, &c__0, &anrm, &smlnum, m, n, &a[a_offset], lda, &
+ ierr);
+ } else if (anrm > bignum) {
+ iscl = 1;
+ dlascl_("G", &c__0, &c__0, &anrm, &bignum, m, n, &a[a_offset], lda, &
+ ierr);
+ }
+
+ if (*m >= *n) {
+
+/*
+ A has at least as many rows as columns. If A has sufficiently
+ more rows than columns, first reduce using the QR
+ decomposition (if sufficient workspace available)
+*/
+
+ if (*m >= mnthr) {
+
+ if (wntqn) {
+
+/*
+ Path 1 (M much larger than N, JOBZ='N')
+ No singular vectors to be computed
+*/
+
+ itau = 1;
+ nwork = itau + *n;
+
+/*
+ Compute A=Q*R
+ (Workspace: need 2*N, prefer N+N*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
+ i__1, &ierr);
+
+/* Zero out below R */
+
+ i__1 = *n - 1;
+ i__2 = *n - 1;
+ dlaset_("L", &i__1, &i__2, &c_b29, &c_b29, &a[a_dim1 + 2],
+ lda);
+ ie = 1;
+ itauq = ie + *n;
+ itaup = itauq + *n;
+ nwork = itaup + *n;
+
+/*
+ Bidiagonalize R in A
+ (Workspace: need 4*N, prefer 3*N+2*N*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dgebrd_(n, n, &a[a_offset], lda, &s[1], &work[ie], &work[
+ itauq], &work[itaup], &work[nwork], &i__1, &ierr);
+ nwork = ie + *n;
+
+/*
+ Perform bidiagonal SVD, computing singular values only
+ (Workspace: need N+BDSPAC)
+*/
+
+ dbdsdc_("U", "N", n, &s[1], &work[ie], dum, &c__1, dum, &c__1,
+ dum, idum, &work[nwork], &iwork[1], info);
+
+ } else if (wntqo) {
+
+/*
+ Path 2 (M much larger than N, JOBZ = 'O')
+ N left singular vectors to be overwritten on A and
+ N right singular vectors to be computed in VT
+*/
+
+ ir = 1;
+
+/* WORK(IR) is LDWRKR by N */
+
+ if (*lwork >= *lda * *n + *n * *n + *n * 3 + bdspac) {
+ ldwrkr = *lda;
+ } else {
+ ldwrkr = (*lwork - *n * *n - *n * 3 - bdspac) / *n;
+ }
+ itau = ir + ldwrkr * *n;
+ nwork = itau + *n;
+
+/*
+ Compute A=Q*R
+ (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
+ i__1, &ierr);
+
+/* Copy R to WORK(IR), zeroing out below it */
+
+ dlacpy_("U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr);
+ i__1 = *n - 1;
+ i__2 = *n - 1;
+ dlaset_("L", &i__1, &i__2, &c_b29, &c_b29, &work[ir + 1], &
+ ldwrkr);
+
+/*
+ Generate Q in A
+ (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dorgqr_(m, n, n, &a[a_offset], lda, &work[itau], &work[nwork],
+ &i__1, &ierr);
+ ie = itau;
+ itauq = ie + *n;
+ itaup = itauq + *n;
+ nwork = itaup + *n;
+
+/*
+ Bidiagonalize R in VT, copying result to WORK(IR)
+ (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dgebrd_(n, n, &work[ir], &ldwrkr, &s[1], &work[ie], &work[
+ itauq], &work[itaup], &work[nwork], &i__1, &ierr);
+
+/* WORK(IU) is N by N */
+
+ iu = nwork;
+ nwork = iu + *n * *n;
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in WORK(IU) and computing right
+ singular vectors of bidiagonal matrix in VT
+ (Workspace: need N+N*N+BDSPAC)
+*/
+
+ dbdsdc_("U", "I", n, &s[1], &work[ie], &work[iu], n, &vt[
+ vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1],
+ info);
+
+/*
+ Overwrite WORK(IU) by left singular vectors of R
+ and VT by right singular vectors of R
+ (Workspace: need 2*N*N+3*N, prefer 2*N*N+2*N+N*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dormbr_("Q", "L", "N", n, n, n, &work[ir], &ldwrkr, &work[
+ itauq], &work[iu], n, &work[nwork], &i__1, &ierr);
+ i__1 = *lwork - nwork + 1;
+ dormbr_("P", "R", "T", n, n, n, &work[ir], &ldwrkr, &work[
+ itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
+ ierr);
+
+/*
+ Multiply Q in A by left singular vectors of R in
+ WORK(IU), storing result in WORK(IR) and copying to A
+ (Workspace: need 2*N*N, prefer N*N+M*N)
+*/
+
+ i__1 = *m;
+ i__2 = ldwrkr;
+ for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ +=
+ i__2) {
+/* Computing MIN */
+ i__3 = *m - i__ + 1;
+ chunk = min(i__3,ldwrkr);
+ dgemm_("N", "N", &chunk, n, n, &c_b15, &a[i__ + a_dim1],
+ lda, &work[iu], n, &c_b29, &work[ir], &ldwrkr);
+ dlacpy_("F", &chunk, n, &work[ir], &ldwrkr, &a[i__ +
+ a_dim1], lda);
+/* L10: */
+ }
+
+ } else if (wntqs) {
+
+/*
+ Path 3 (M much larger than N, JOBZ='S')
+ N left singular vectors to be computed in U and
+ N right singular vectors to be computed in VT
+*/
+
+ ir = 1;
+
+/* WORK(IR) is N by N */
+
+ ldwrkr = *n;
+ itau = ir + ldwrkr * *n;
+ nwork = itau + *n;
+
+/*
+ Compute A=Q*R
+ (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
+ i__2, &ierr);
+
+/* Copy R to WORK(IR), zeroing out below it */
+
+ dlacpy_("U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr);
+ i__2 = *n - 1;
+ i__1 = *n - 1;
+ dlaset_("L", &i__2, &i__1, &c_b29, &c_b29, &work[ir + 1], &
+ ldwrkr);
+
+/*
+ Generate Q in A
+ (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dorgqr_(m, n, n, &a[a_offset], lda, &work[itau], &work[nwork],
+ &i__2, &ierr);
+ ie = itau;
+ itauq = ie + *n;
+ itaup = itauq + *n;
+ nwork = itaup + *n;
+
+/*
+ Bidiagonalize R in WORK(IR)
+ (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dgebrd_(n, n, &work[ir], &ldwrkr, &s[1], &work[ie], &work[
+ itauq], &work[itaup], &work[nwork], &i__2, &ierr);
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagoal matrix in U and computing right singular
+ vectors of bidiagonal matrix in VT
+ (Workspace: need N+BDSPAC)
+*/
+
+ dbdsdc_("U", "I", n, &s[1], &work[ie], &u[u_offset], ldu, &vt[
+ vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1],
+ info);
+
+/*
+ Overwrite U by left singular vectors of R and VT
+ by right singular vectors of R
+ (Workspace: need N*N+3*N, prefer N*N+2*N+N*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dormbr_("Q", "L", "N", n, n, n, &work[ir], &ldwrkr, &work[
+ itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr);
+
+ i__2 = *lwork - nwork + 1;
+ dormbr_("P", "R", "T", n, n, n, &work[ir], &ldwrkr, &work[
+ itaup], &vt[vt_offset], ldvt, &work[nwork], &i__2, &
+ ierr);
+
+/*
+ Multiply Q in A by left singular vectors of R in
+ WORK(IR), storing result in U
+ (Workspace: need N*N)
+*/
+
+ dlacpy_("F", n, n, &u[u_offset], ldu, &work[ir], &ldwrkr);
+ dgemm_("N", "N", m, n, n, &c_b15, &a[a_offset], lda, &work[ir]
+ , &ldwrkr, &c_b29, &u[u_offset], ldu);
+
+ } else if (wntqa) {
+
+/*
+ Path 4 (M much larger than N, JOBZ='A')
+ M left singular vectors to be computed in U and
+ N right singular vectors to be computed in VT
+*/
+
+ iu = 1;
+
+/* WORK(IU) is N by N */
+
+ ldwrku = *n;
+ itau = iu + ldwrku * *n;
+ nwork = itau + *n;
+
+/*
+ Compute A=Q*R, copying result to U
+ (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
+ i__2, &ierr);
+ dlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);
+
+/*
+ Generate Q in U
+ (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
+*/
+ i__2 = *lwork - nwork + 1;
+ dorgqr_(m, m, n, &u[u_offset], ldu, &work[itau], &work[nwork],
+ &i__2, &ierr);
+
+/* Produce R in A, zeroing out other entries */
+
+ i__2 = *n - 1;
+ i__1 = *n - 1;
+ dlaset_("L", &i__2, &i__1, &c_b29, &c_b29, &a[a_dim1 + 2],
+ lda);
+ ie = itau;
+ itauq = ie + *n;
+ itaup = itauq + *n;
+ nwork = itaup + *n;
+
+/*
+ Bidiagonalize R in A
+ (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dgebrd_(n, n, &a[a_offset], lda, &s[1], &work[ie], &work[
+ itauq], &work[itaup], &work[nwork], &i__2, &ierr);
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in WORK(IU) and computing right
+ singular vectors of bidiagonal matrix in VT
+ (Workspace: need N+N*N+BDSPAC)
+*/
+
+ dbdsdc_("U", "I", n, &s[1], &work[ie], &work[iu], n, &vt[
+ vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1],
+ info);
+
+/*
+ Overwrite WORK(IU) by left singular vectors of R and VT
+ by right singular vectors of R
+ (Workspace: need N*N+3*N, prefer N*N+2*N+N*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dormbr_("Q", "L", "N", n, n, n, &a[a_offset], lda, &work[
+ itauq], &work[iu], &ldwrku, &work[nwork], &i__2, &
+ ierr);
+ i__2 = *lwork - nwork + 1;
+ dormbr_("P", "R", "T", n, n, n, &a[a_offset], lda, &work[
+ itaup], &vt[vt_offset], ldvt, &work[nwork], &i__2, &
+ ierr);
+
+/*
+ Multiply Q in U by left singular vectors of R in
+ WORK(IU), storing result in A
+ (Workspace: need N*N)
+*/
+
+ dgemm_("N", "N", m, n, n, &c_b15, &u[u_offset], ldu, &work[iu]
+ , &ldwrku, &c_b29, &a[a_offset], lda);
+
+/* Copy left singular vectors of A from A to U */
+
+ dlacpy_("F", m, n, &a[a_offset], lda, &u[u_offset], ldu);
+
+ }
+
+ } else {
+
+/*
+ M .LT. MNTHR
+
+ Path 5 (M at least N, but not much larger)
+ Reduce to bidiagonal form without QR decomposition
+*/
+
+ ie = 1;
+ itauq = ie + *n;
+ itaup = itauq + *n;
+ nwork = itaup + *n;
+
+/*
+ Bidiagonalize A
+ (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dgebrd_(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &
+ work[itaup], &work[nwork], &i__2, &ierr);
+ if (wntqn) {
+
+/*
+ Perform bidiagonal SVD, only computing singular values
+ (Workspace: need N+BDSPAC)
+*/
+
+ dbdsdc_("U", "N", n, &s[1], &work[ie], dum, &c__1, dum, &c__1,
+ dum, idum, &work[nwork], &iwork[1], info);
+ } else if (wntqo) {
+ iu = nwork;
+ if (*lwork >= *m * *n + *n * 3 + bdspac) {
+
+/* WORK( IU ) is M by N */
+
+ ldwrku = *m;
+ nwork = iu + ldwrku * *n;
+ dlaset_("F", m, n, &c_b29, &c_b29, &work[iu], &ldwrku);
+ } else {
+
+/* WORK( IU ) is N by N */
+
+ ldwrku = *n;
+ nwork = iu + ldwrku * *n;
+
+/* WORK(IR) is LDWRKR by N */
+
+ ir = nwork;
+ ldwrkr = (*lwork - *n * *n - *n * 3) / *n;
+ }
+ nwork = iu + ldwrku * *n;
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in WORK(IU) and computing right
+ singular vectors of bidiagonal matrix in VT
+ (Workspace: need N+N*N+BDSPAC)
+*/
+
+ dbdsdc_("U", "I", n, &s[1], &work[ie], &work[iu], &ldwrku, &
+ vt[vt_offset], ldvt, dum, idum, &work[nwork], &iwork[
+ 1], info);
+
+/*
+ Overwrite VT by right singular vectors of A
+ (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dormbr_("P", "R", "T", n, n, n, &a[a_offset], lda, &work[
+ itaup], &vt[vt_offset], ldvt, &work[nwork], &i__2, &
+ ierr);
+
+ if (*lwork >= *m * *n + *n * 3 + bdspac) {
+
+/*
+ Overwrite WORK(IU) by left singular vectors of A
+ (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dormbr_("Q", "L", "N", m, n, n, &a[a_offset], lda, &work[
+ itauq], &work[iu], &ldwrku, &work[nwork], &i__2, &
+ ierr);
+
+/* Copy left singular vectors of A from WORK(IU) to A */
+
+ dlacpy_("F", m, n, &work[iu], &ldwrku, &a[a_offset], lda);
+ } else {
+
+/*
+ Generate Q in A
+ (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dorgbr_("Q", m, n, n, &a[a_offset], lda, &work[itauq], &
+ work[nwork], &i__2, &ierr);
+
+/*
+ Multiply Q in A by left singular vectors of
+ bidiagonal matrix in WORK(IU), storing result in
+ WORK(IR) and copying to A
+ (Workspace: need 2*N*N, prefer N*N+M*N)
+*/
+
+ i__2 = *m;
+ i__1 = ldwrkr;
+ for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ +=
+ i__1) {
+/* Computing MIN */
+ i__3 = *m - i__ + 1;
+ chunk = min(i__3,ldwrkr);
+ dgemm_("N", "N", &chunk, n, n, &c_b15, &a[i__ +
+ a_dim1], lda, &work[iu], &ldwrku, &c_b29, &
+ work[ir], &ldwrkr);
+ dlacpy_("F", &chunk, n, &work[ir], &ldwrkr, &a[i__ +
+ a_dim1], lda);
+/* L20: */
+ }
+ }
+
+ } else if (wntqs) {
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in U and computing right singular
+ vectors of bidiagonal matrix in VT
+ (Workspace: need N+BDSPAC)
+*/
+
+ dlaset_("F", m, n, &c_b29, &c_b29, &u[u_offset], ldu);
+ dbdsdc_("U", "I", n, &s[1], &work[ie], &u[u_offset], ldu, &vt[
+ vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1],
+ info);
+
+/*
+ Overwrite U by left singular vectors of A and VT
+ by right singular vectors of A
+ (Workspace: need 3*N, prefer 2*N+N*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dormbr_("Q", "L", "N", m, n, n, &a[a_offset], lda, &work[
+ itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr);
+ i__1 = *lwork - nwork + 1;
+ dormbr_("P", "R", "T", n, n, n, &a[a_offset], lda, &work[
+ itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
+ ierr);
+ } else if (wntqa) {
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in U and computing right singular
+ vectors of bidiagonal matrix in VT
+ (Workspace: need N+BDSPAC)
+*/
+
+ dlaset_("F", m, m, &c_b29, &c_b29, &u[u_offset], ldu);
+ dbdsdc_("U", "I", n, &s[1], &work[ie], &u[u_offset], ldu, &vt[
+ vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1],
+ info);
+
+/* Set the right corner of U to identity matrix */
+
+ i__1 = *m - *n;
+ i__2 = *m - *n;
+ dlaset_("F", &i__1, &i__2, &c_b29, &c_b15, &u[*n + 1 + (*n +
+ 1) * u_dim1], ldu);
+
+/*
+ Overwrite U by left singular vectors of A and VT
+ by right singular vectors of A
+ (Workspace: need N*N+2*N+M, prefer N*N+2*N+M*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dormbr_("Q", "L", "N", m, m, n, &a[a_offset], lda, &work[
+ itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr);
+ i__1 = *lwork - nwork + 1;
+ dormbr_("P", "R", "T", n, n, m, &a[a_offset], lda, &work[
+ itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
+ ierr);
+ }
+
+ }
+
+ } else {
+
+/*
+ A has more columns than rows. If A has sufficiently more
+ columns than rows, first reduce using the LQ decomposition (if
+ sufficient workspace available)
+*/
+
+ if (*n >= mnthr) {
+
+ if (wntqn) {
+
+/*
+ Path 1t (N much larger than M, JOBZ='N')
+ No singular vectors to be computed
+*/
+
+ itau = 1;
+ nwork = itau + *m;
+
+/*
+ Compute A=L*Q
+ (Workspace: need 2*M, prefer M+M*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
+ i__1, &ierr);
+
+/* Zero out above L */
+
+ i__1 = *m - 1;
+ i__2 = *m - 1;
+ dlaset_("U", &i__1, &i__2, &c_b29, &c_b29, &a[((a_dim1) << (1)
+ ) + 1], lda);
+ ie = 1;
+ itauq = ie + *m;
+ itaup = itauq + *m;
+ nwork = itaup + *m;
+
+/*
+ Bidiagonalize L in A
+ (Workspace: need 4*M, prefer 3*M+2*M*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dgebrd_(m, m, &a[a_offset], lda, &s[1], &work[ie], &work[
+ itauq], &work[itaup], &work[nwork], &i__1, &ierr);
+ nwork = ie + *m;
+
+/*
+ Perform bidiagonal SVD, computing singular values only
+ (Workspace: need M+BDSPAC)
+*/
+
+ dbdsdc_("U", "N", m, &s[1], &work[ie], dum, &c__1, dum, &c__1,
+ dum, idum, &work[nwork], &iwork[1], info);
+
+ } else if (wntqo) {
+
+/*
+ Path 2t (N much larger than M, JOBZ='O')
+ M right singular vectors to be overwritten on A and
+ M left singular vectors to be computed in U
+*/
+
+ ivt = 1;
+
+/* IVT is M by M */
+
+ il = ivt + *m * *m;
+ if (*lwork >= *m * *n + *m * *m + *m * 3 + bdspac) {
+
+/* WORK(IL) is M by N */
+
+ ldwrkl = *m;
+ chunk = *n;
+ } else {
+ ldwrkl = *m;
+ chunk = (*lwork - *m * *m) / *m;
+ }
+ itau = il + ldwrkl * *m;
+ nwork = itau + *m;
+
+/*
+ Compute A=L*Q
+ (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
+ i__1, &ierr);
+
+/* Copy L to WORK(IL), zeroing about above it */
+
+ dlacpy_("L", m, m, &a[a_offset], lda, &work[il], &ldwrkl);
+ i__1 = *m - 1;
+ i__2 = *m - 1;
+ dlaset_("U", &i__1, &i__2, &c_b29, &c_b29, &work[il + ldwrkl],
+ &ldwrkl);
+
+/*
+ Generate Q in A
+ (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dorglq_(m, n, m, &a[a_offset], lda, &work[itau], &work[nwork],
+ &i__1, &ierr);
+ ie = itau;
+ itauq = ie + *m;
+ itaup = itauq + *m;
+ nwork = itaup + *m;
+
+/*
+ Bidiagonalize L in WORK(IL)
+ (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dgebrd_(m, m, &work[il], &ldwrkl, &s[1], &work[ie], &work[
+ itauq], &work[itaup], &work[nwork], &i__1, &ierr);
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in U, and computing right singular
+ vectors of bidiagonal matrix in WORK(IVT)
+ (Workspace: need M+M*M+BDSPAC)
+*/
+
+ dbdsdc_("U", "I", m, &s[1], &work[ie], &u[u_offset], ldu, &
+ work[ivt], m, dum, idum, &work[nwork], &iwork[1],
+ info);
+
+/*
+ Overwrite U by left singular vectors of L and WORK(IVT)
+ by right singular vectors of L
+ (Workspace: need 2*M*M+3*M, prefer 2*M*M+2*M+M*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dormbr_("Q", "L", "N", m, m, m, &work[il], &ldwrkl, &work[
+ itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr);
+ i__1 = *lwork - nwork + 1;
+ dormbr_("P", "R", "T", m, m, m, &work[il], &ldwrkl, &work[
+ itaup], &work[ivt], m, &work[nwork], &i__1, &ierr);
+
+/*
+ Multiply right singular vectors of L in WORK(IVT) by Q
+ in A, storing result in WORK(IL) and copying to A
+ (Workspace: need 2*M*M, prefer M*M+M*N)
+*/
+
+ i__1 = *n;
+ i__2 = chunk;
+ for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ +=
+ i__2) {
+/* Computing MIN */
+ i__3 = *n - i__ + 1;
+ blk = min(i__3,chunk);
+ dgemm_("N", "N", m, &blk, m, &c_b15, &work[ivt], m, &a[
+ i__ * a_dim1 + 1], lda, &c_b29, &work[il], &
+ ldwrkl);
+ dlacpy_("F", m, &blk, &work[il], &ldwrkl, &a[i__ * a_dim1
+ + 1], lda);
+/* L30: */
+ }
+
+ } else if (wntqs) {
+
+/*
+ Path 3t (N much larger than M, JOBZ='S')
+ M right singular vectors to be computed in VT and
+ M left singular vectors to be computed in U
+*/
+
+ il = 1;
+
+/* WORK(IL) is M by M */
+
+ ldwrkl = *m;
+ itau = il + ldwrkl * *m;
+ nwork = itau + *m;
+
+/*
+ Compute A=L*Q
+ (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
+ i__2, &ierr);
+
+/* Copy L to WORK(IL), zeroing out above it */
+
+ dlacpy_("L", m, m, &a[a_offset], lda, &work[il], &ldwrkl);
+ i__2 = *m - 1;
+ i__1 = *m - 1;
+ dlaset_("U", &i__2, &i__1, &c_b29, &c_b29, &work[il + ldwrkl],
+ &ldwrkl);
+
+/*
+ Generate Q in A
+ (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dorglq_(m, n, m, &a[a_offset], lda, &work[itau], &work[nwork],
+ &i__2, &ierr);
+ ie = itau;
+ itauq = ie + *m;
+ itaup = itauq + *m;
+ nwork = itaup + *m;
+
+/*
+ Bidiagonalize L in WORK(IU), copying result to U
+ (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dgebrd_(m, m, &work[il], &ldwrkl, &s[1], &work[ie], &work[
+ itauq], &work[itaup], &work[nwork], &i__2, &ierr);
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in U and computing right singular
+ vectors of bidiagonal matrix in VT
+ (Workspace: need M+BDSPAC)
+*/
+
+ dbdsdc_("U", "I", m, &s[1], &work[ie], &u[u_offset], ldu, &vt[
+ vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1],
+ info);
+
+/*
+ Overwrite U by left singular vectors of L and VT
+ by right singular vectors of L
+ (Workspace: need M*M+3*M, prefer M*M+2*M+M*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dormbr_("Q", "L", "N", m, m, m, &work[il], &ldwrkl, &work[
+ itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr);
+ i__2 = *lwork - nwork + 1;
+ dormbr_("P", "R", "T", m, m, m, &work[il], &ldwrkl, &work[
+ itaup], &vt[vt_offset], ldvt, &work[nwork], &i__2, &
+ ierr);
+
+/*
+ Multiply right singular vectors of L in WORK(IL) by
+ Q in A, storing result in VT
+ (Workspace: need M*M)
+*/
+
+ dlacpy_("F", m, m, &vt[vt_offset], ldvt, &work[il], &ldwrkl);
+ dgemm_("N", "N", m, n, m, &c_b15, &work[il], &ldwrkl, &a[
+ a_offset], lda, &c_b29, &vt[vt_offset], ldvt);
+
+ } else if (wntqa) {
+
+/*
+ Path 4t (N much larger than M, JOBZ='A')
+ N right singular vectors to be computed in VT and
+ M left singular vectors to be computed in U
+*/
+
+ ivt = 1;
+
+/* WORK(IVT) is M by M */
+
+ ldwkvt = *m;
+ itau = ivt + ldwkvt * *m;
+ nwork = itau + *m;
+
+/*
+ Compute A=L*Q, copying result to VT
+ (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
+ i__2, &ierr);
+ dlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
+
+/*
+ Generate Q in VT
+ (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dorglq_(n, n, m, &vt[vt_offset], ldvt, &work[itau], &work[
+ nwork], &i__2, &ierr);
+
+/* Produce L in A, zeroing out other entries */
+
+ i__2 = *m - 1;
+ i__1 = *m - 1;
+ dlaset_("U", &i__2, &i__1, &c_b29, &c_b29, &a[((a_dim1) << (1)
+ ) + 1], lda);
+ ie = itau;
+ itauq = ie + *m;
+ itaup = itauq + *m;
+ nwork = itaup + *m;
+
+/*
+ Bidiagonalize L in A
+ (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dgebrd_(m, m, &a[a_offset], lda, &s[1], &work[ie], &work[
+ itauq], &work[itaup], &work[nwork], &i__2, &ierr);
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in U and computing right singular
+ vectors of bidiagonal matrix in WORK(IVT)
+ (Workspace: need M+M*M+BDSPAC)
+*/
+
+ dbdsdc_("U", "I", m, &s[1], &work[ie], &u[u_offset], ldu, &
+ work[ivt], &ldwkvt, dum, idum, &work[nwork], &iwork[1]
+ , info);
+
+/*
+ Overwrite U by left singular vectors of L and WORK(IVT)
+ by right singular vectors of L
+ (Workspace: need M*M+3*M, prefer M*M+2*M+M*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dormbr_("Q", "L", "N", m, m, m, &a[a_offset], lda, &work[
+ itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr);
+ i__2 = *lwork - nwork + 1;
+ dormbr_("P", "R", "T", m, m, m, &a[a_offset], lda, &work[
+ itaup], &work[ivt], &ldwkvt, &work[nwork], &i__2, &
+ ierr);
+
+/*
+ Multiply right singular vectors of L in WORK(IVT) by
+ Q in VT, storing result in A
+ (Workspace: need M*M)
+*/
+
+ dgemm_("N", "N", m, n, m, &c_b15, &work[ivt], &ldwkvt, &vt[
+ vt_offset], ldvt, &c_b29, &a[a_offset], lda);
+
+/* Copy right singular vectors of A from A to VT */
+
+ dlacpy_("F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
+
+ }
+
+ } else {
+
+/*
+ N .LT. MNTHR
+
+ Path 5t (N greater than M, but not much larger)
+ Reduce to bidiagonal form without LQ decomposition
+*/
+
+ ie = 1;
+ itauq = ie + *m;
+ itaup = itauq + *m;
+ nwork = itaup + *m;
+
+/*
+ Bidiagonalize A
+ (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dgebrd_(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &
+ work[itaup], &work[nwork], &i__2, &ierr);
+ if (wntqn) {
+
+/*
+ Perform bidiagonal SVD, only computing singular values
+ (Workspace: need M+BDSPAC)
+*/
+
+ dbdsdc_("L", "N", m, &s[1], &work[ie], dum, &c__1, dum, &c__1,
+ dum, idum, &work[nwork], &iwork[1], info);
+ } else if (wntqo) {
+ ldwkvt = *m;
+ ivt = nwork;
+ if (*lwork >= *m * *n + *m * 3 + bdspac) {
+
+/* WORK( IVT ) is M by N */
+
+ dlaset_("F", m, n, &c_b29, &c_b29, &work[ivt], &ldwkvt);
+ nwork = ivt + ldwkvt * *n;
+ } else {
+
+/* WORK( IVT ) is M by M */
+
+ nwork = ivt + ldwkvt * *m;
+ il = nwork;
+
+/* WORK(IL) is M by CHUNK */
+
+ chunk = (*lwork - *m * *m - *m * 3) / *m;
+ }
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in U and computing right singular
+ vectors of bidiagonal matrix in WORK(IVT)
+ (Workspace: need M*M+BDSPAC)
+*/
+
+ dbdsdc_("L", "I", m, &s[1], &work[ie], &u[u_offset], ldu, &
+ work[ivt], &ldwkvt, dum, idum, &work[nwork], &iwork[1]
+ , info);
+
+/*
+ Overwrite U by left singular vectors of A
+ (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dormbr_("Q", "L", "N", m, m, n, &a[a_offset], lda, &work[
+ itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr);
+
+ if (*lwork >= *m * *n + *m * 3 + bdspac) {
+
+/*
+ Overwrite WORK(IVT) by left singular vectors of A
+ (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dormbr_("P", "R", "T", m, n, m, &a[a_offset], lda, &work[
+ itaup], &work[ivt], &ldwkvt, &work[nwork], &i__2,
+ &ierr);
+
+/* Copy right singular vectors of A from WORK(IVT) to A */
+
+ dlacpy_("F", m, n, &work[ivt], &ldwkvt, &a[a_offset], lda);
+ } else {
+
+/*
+ Generate P**T in A
+ (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ dorgbr_("P", m, n, m, &a[a_offset], lda, &work[itaup], &
+ work[nwork], &i__2, &ierr);
+
+/*
+ Multiply Q in A by right singular vectors of
+ bidiagonal matrix in WORK(IVT), storing result in
+ WORK(IL) and copying to A
+ (Workspace: need 2*M*M, prefer M*M+M*N)
+*/
+
+ i__2 = *n;
+ i__1 = chunk;
+ for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ +=
+ i__1) {
+/* Computing MIN */
+ i__3 = *n - i__ + 1;
+ blk = min(i__3,chunk);
+ dgemm_("N", "N", m, &blk, m, &c_b15, &work[ivt], &
+ ldwkvt, &a[i__ * a_dim1 + 1], lda, &c_b29, &
+ work[il], m);
+ dlacpy_("F", m, &blk, &work[il], m, &a[i__ * a_dim1 +
+ 1], lda);
+/* L40: */
+ }
+ }
+ } else if (wntqs) {
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in U and computing right singular
+ vectors of bidiagonal matrix in VT
+ (Workspace: need M+BDSPAC)
+*/
+
+ dlaset_("F", m, n, &c_b29, &c_b29, &vt[vt_offset], ldvt);
+ dbdsdc_("L", "I", m, &s[1], &work[ie], &u[u_offset], ldu, &vt[
+ vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1],
+ info);
+
+/*
+ Overwrite U by left singular vectors of A and VT
+ by right singular vectors of A
+ (Workspace: need 3*M, prefer 2*M+M*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dormbr_("Q", "L", "N", m, m, n, &a[a_offset], lda, &work[
+ itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr);
+ i__1 = *lwork - nwork + 1;
+ dormbr_("P", "R", "T", m, n, m, &a[a_offset], lda, &work[
+ itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
+ ierr);
+ } else if (wntqa) {
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in U and computing right singular
+ vectors of bidiagonal matrix in VT
+ (Workspace: need M+BDSPAC)
+*/
+
+ dlaset_("F", n, n, &c_b29, &c_b29, &vt[vt_offset], ldvt);
+ dbdsdc_("L", "I", m, &s[1], &work[ie], &u[u_offset], ldu, &vt[
+ vt_offset], ldvt, dum, idum, &work[nwork], &iwork[1],
+ info);
+
+/* Set the right corner of VT to identity matrix */
+
+ i__1 = *n - *m;
+ i__2 = *n - *m;
+ dlaset_("F", &i__1, &i__2, &c_b29, &c_b15, &vt[*m + 1 + (*m +
+ 1) * vt_dim1], ldvt);
+
+/*
+ Overwrite U by left singular vectors of A and VT
+ by right singular vectors of A
+ (Workspace: need 2*M+N, prefer 2*M+N*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ dormbr_("Q", "L", "N", m, m, n, &a[a_offset], lda, &work[
+ itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr);
+ i__1 = *lwork - nwork + 1;
+ dormbr_("P", "R", "T", n, n, m, &a[a_offset], lda, &work[
+ itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
+ ierr);
+ }
+
+ }
+
+ }
+
+/* Undo scaling if necessary */
+
+ if (iscl == 1) {
+ if (anrm > bignum) {
+ dlascl_("G", &c__0, &c__0, &bignum, &anrm, &minmn, &c__1, &s[1], &
+ minmn, &ierr);
+ }
+ if (anrm < smlnum) {
+ dlascl_("G", &c__0, &c__0, &smlnum, &anrm, &minmn, &c__1, &s[1], &
+ minmn, &ierr);
+ }
+ }
+
+/* Return optimal workspace in WORK(1) */
+
+ work[1] = (doublereal) maxwrk;
+
+ return 0;
+
+/* End of DGESDD */
+
+} /* dgesdd_ */
+
+/* Subroutine */ int dgesv_(integer *n, integer *nrhs, doublereal *a, integer
+ *lda, integer *ipiv, doublereal *b, integer *ldb, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1;
+
+ /* Local variables */
+ extern /* Subroutine */ int dgetrf_(integer *, integer *, doublereal *,
+ integer *, integer *, integer *), xerbla_(char *, integer *), dgetrs_(char *, integer *, integer *, doublereal *,
+ integer *, integer *, doublereal *, integer *, integer *);
+
+
+/*
+ -- LAPACK driver routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ March 31, 1993
+
+
+ Purpose
+ =======
+
+ DGESV computes the solution to a real system of linear equations
+ A * X = B,
+ where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
+
+ The LU decomposition with partial pivoting and row interchanges is
+ used to factor A as
+ A = P * L * U,
+ where P is a permutation matrix, L is unit lower triangular, and U is
+ upper triangular. The factored form of A is then used to solve the
+ system of equations A * X = B.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the N-by-N coefficient matrix A.
+ On exit, the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ The pivot indices that define the permutation matrix P;
+ row i of the matrix was interchanged with row IPIV(i).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS matrix of right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+ singular, so the solution could not be computed.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --ipiv;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+
+ /* Function Body */
+ *info = 0;
+ if (*n < 0) {
+ *info = -1;
+ } else if (*nrhs < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*n)) {
+ *info = -4;
+ } else if (*ldb < max(1,*n)) {
+ *info = -7;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGESV ", &i__1);
+ return 0;
+ }
+
+/* Compute the LU factorization of A. */
+
+ dgetrf_(n, n, &a[a_offset], lda, &ipiv[1], info);
+ if (*info == 0) {
+
+/* Solve the system A*X = B, overwriting B with X. */
+
+ dgetrs_("No transpose", n, nrhs, &a[a_offset], lda, &ipiv[1], &b[
+ b_offset], ldb, info);
+ }
+ return 0;
+
+/* End of DGESV */
+
+} /* dgesv_ */
+
+/* Subroutine */ int dgetf2_(integer *m, integer *n, doublereal *a, integer *
+ lda, integer *ipiv, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer j, jp;
+ extern /* Subroutine */ int dger_(integer *, integer *, doublereal *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ integer *), dscal_(integer *, doublereal *, doublereal *, integer
+ *), dswap_(integer *, doublereal *, integer *, doublereal *,
+ integer *);
+ extern integer idamax_(integer *, doublereal *, integer *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1992
+
+
+ Purpose
+ =======
+
+ DGETF2 computes an LU factorization of a general m-by-n matrix A
+ using partial pivoting with row interchanges.
+
+ The factorization has the form
+ A = P * L * U
+ where P is a permutation matrix, L is lower triangular with unit
+ diagonal elements (lower trapezoidal if m > n), and U is upper
+ triangular (upper trapezoidal if m < n).
+
+ This is the right-looking Level 2 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the m by n matrix to be factored.
+ On exit, the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, U(k,k) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+ to solve a system of equations.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --ipiv;
+
+ /* Function Body */
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGETF2", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0) {
+ return 0;
+ }
+
+ i__1 = min(*m,*n);
+ for (j = 1; j <= i__1; ++j) {
+
+/* Find pivot and test for singularity. */
+
+ i__2 = *m - j + 1;
+ jp = j - 1 + idamax_(&i__2, &a[j + j * a_dim1], &c__1);
+ ipiv[j] = jp;
+ if (a[jp + j * a_dim1] != 0.) {
+
+/* Apply the interchange to columns 1:N. */
+
+ if (jp != j) {
+ dswap_(n, &a[j + a_dim1], lda, &a[jp + a_dim1], lda);
+ }
+
+/* Compute elements J+1:M of J-th column. */
+
+ if (j < *m) {
+ i__2 = *m - j;
+ d__1 = 1. / a[j + j * a_dim1];
+ dscal_(&i__2, &d__1, &a[j + 1 + j * a_dim1], &c__1);
+ }
+
+ } else if (*info == 0) {
+
+ *info = j;
+ }
+
+ if (j < min(*m,*n)) {
+
+/* Update trailing submatrix. */
+
+ i__2 = *m - j;
+ i__3 = *n - j;
+ dger_(&i__2, &i__3, &c_b151, &a[j + 1 + j * a_dim1], &c__1, &a[j
+ + (j + 1) * a_dim1], lda, &a[j + 1 + (j + 1) * a_dim1],
+ lda);
+ }
+/* L10: */
+ }
+ return 0;
+
+/* End of DGETF2 */
+
+} /* dgetf2_ */
+
+/* Subroutine */ int dgetrf_(integer *m, integer *n, doublereal *a, integer *
+ lda, integer *ipiv, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
+
+ /* Local variables */
+ static integer i__, j, jb, nb;
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *);
+ static integer iinfo;
+ extern /* Subroutine */ int dtrsm_(char *, char *, char *, char *,
+ integer *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *), dgetf2_(
+ integer *, integer *, doublereal *, integer *, integer *, integer
+ *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int dlaswp_(integer *, doublereal *, integer *,
+ integer *, integer *, integer *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ March 31, 1993
+
+
+ Purpose
+ =======
+
+ DGETRF computes an LU factorization of a general M-by-N matrix A
+ using partial pivoting with row interchanges.
+
+ The factorization has the form
+ A = P * L * U
+ where P is a permutation matrix, L is lower triangular with unit
+ diagonal elements (lower trapezoidal if m > n), and U is upper
+ triangular (upper trapezoidal if m < n).
+
+ This is the right-looking Level 3 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the M-by-N matrix to be factored.
+ On exit, the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+ to solve a system of equations.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --ipiv;
+
+ /* Function Body */
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGETRF", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0) {
+ return 0;
+ }
+
+/* Determine the block size for this environment. */
+
+ nb = ilaenv_(&c__1, "DGETRF", " ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)
+ 1);
+ if (nb <= 1 || nb >= min(*m,*n)) {
+
+/* Use unblocked code. */
+
+ dgetf2_(m, n, &a[a_offset], lda, &ipiv[1], info);
+ } else {
+
+/* Use blocked code. */
+
+ i__1 = min(*m,*n);
+ i__2 = nb;
+ for (j = 1; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
+/* Computing MIN */
+ i__3 = min(*m,*n) - j + 1;
+ jb = min(i__3,nb);
+
+/*
+ Factor diagonal and subdiagonal blocks and test for exact
+ singularity.
+*/
+
+ i__3 = *m - j + 1;
+ dgetf2_(&i__3, &jb, &a[j + j * a_dim1], lda, &ipiv[j], &iinfo);
+
+/* Adjust INFO and the pivot indices. */
+
+ if ((*info == 0 && iinfo > 0)) {
+ *info = iinfo + j - 1;
+ }
+/* Computing MIN */
+ i__4 = *m, i__5 = j + jb - 1;
+ i__3 = min(i__4,i__5);
+ for (i__ = j; i__ <= i__3; ++i__) {
+ ipiv[i__] = j - 1 + ipiv[i__];
+/* L10: */
+ }
+
+/* Apply interchanges to columns 1:J-1. */
+
+ i__3 = j - 1;
+ i__4 = j + jb - 1;
+ dlaswp_(&i__3, &a[a_offset], lda, &j, &i__4, &ipiv[1], &c__1);
+
+ if (j + jb <= *n) {
+
+/* Apply interchanges to columns J+JB:N. */
+
+ i__3 = *n - j - jb + 1;
+ i__4 = j + jb - 1;
+ dlaswp_(&i__3, &a[(j + jb) * a_dim1 + 1], lda, &j, &i__4, &
+ ipiv[1], &c__1);
+
+/* Compute block row of U. */
+
+ i__3 = *n - j - jb + 1;
+ dtrsm_("Left", "Lower", "No transpose", "Unit", &jb, &i__3, &
+ c_b15, &a[j + j * a_dim1], lda, &a[j + (j + jb) *
+ a_dim1], lda);
+ if (j + jb <= *m) {
+
+/* Update trailing submatrix. */
+
+ i__3 = *m - j - jb + 1;
+ i__4 = *n - j - jb + 1;
+ dgemm_("No transpose", "No transpose", &i__3, &i__4, &jb,
+ &c_b151, &a[j + jb + j * a_dim1], lda, &a[j + (j
+ + jb) * a_dim1], lda, &c_b15, &a[j + jb + (j + jb)
+ * a_dim1], lda);
+ }
+ }
+/* L20: */
+ }
+ }
+ return 0;
+
+/* End of DGETRF */
+
+} /* dgetrf_ */
+
+/* Subroutine */ int dgetrs_(char *trans, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, integer *ipiv, doublereal *b, integer *
+ ldb, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1;
+
+ /* Local variables */
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dtrsm_(char *, char *, char *, char *,
+ integer *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *), xerbla_(
+ char *, integer *), dlaswp_(integer *, doublereal *,
+ integer *, integer *, integer *, integer *, integer *);
+ static logical notran;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ March 31, 1993
+
+
+ Purpose
+ =======
+
+ DGETRS solves a system of linear equations
+ A * X = B or A' * X = B
+ with a general N-by-N matrix A using the LU factorization computed
+ by DGETRF.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A'* X = B (Transpose)
+ = 'C': A'* X = B (Conjugate transpose = Transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The factors L and U from the factorization A = P*L*U
+ as computed by DGETRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices from DGETRF; for 1<=i<=N, row i of the
+ matrix was interchanged with row IPIV(i).
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --ipiv;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+
+ /* Function Body */
+ *info = 0;
+ notran = lsame_(trans, "N");
+ if (((! notran && ! lsame_(trans, "T")) && ! lsame_(
+ trans, "C"))) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*nrhs < 0) {
+ *info = -3;
+ } else if (*lda < max(1,*n)) {
+ *info = -5;
+ } else if (*ldb < max(1,*n)) {
+ *info = -8;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGETRS", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0 || *nrhs == 0) {
+ return 0;
+ }
+
+ if (notran) {
+
+/*
+ Solve A * X = B.
+
+ Apply row interchanges to the right hand sides.
+*/
+
+ dlaswp_(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c__1);
+
+/* Solve L*X = B, overwriting B with X. */
+
+ dtrsm_("Left", "Lower", "No transpose", "Unit", n, nrhs, &c_b15, &a[
+ a_offset], lda, &b[b_offset], ldb);
+
+/* Solve U*X = B, overwriting B with X. */
+
+ dtrsm_("Left", "Upper", "No transpose", "Non-unit", n, nrhs, &c_b15, &
+ a[a_offset], lda, &b[b_offset], ldb);
+ } else {
+
+/*
+ Solve A' * X = B.
+
+ Solve U'*X = B, overwriting B with X.
+*/
+
+ dtrsm_("Left", "Upper", "Transpose", "Non-unit", n, nrhs, &c_b15, &a[
+ a_offset], lda, &b[b_offset], ldb);
+
+/* Solve L'*X = B, overwriting B with X. */
+
+ dtrsm_("Left", "Lower", "Transpose", "Unit", n, nrhs, &c_b15, &a[
+ a_offset], lda, &b[b_offset], ldb);
+
+/* Apply row interchanges to the solution vectors. */
+
+ dlaswp_(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c_n1);
+ }
+
+ return 0;
+
+/* End of DGETRS */
+
+} /* dgetrs_ */
+
+/* Subroutine */ int dhseqr_(char *job, char *compz, integer *n, integer *ilo,
+ integer *ihi, doublereal *h__, integer *ldh, doublereal *wr,
+ doublereal *wi, doublereal *z__, integer *ldz, doublereal *work,
+ integer *lwork, integer *info)
+{
+ /* System generated locals */
+ address a__1[2];
+ integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3[2], i__4,
+ i__5;
+ doublereal d__1, d__2;
+ char ch__1[2];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
+
+ /* Local variables */
+ static integer i__, j, k, l;
+ static doublereal s[225] /* was [15][15] */, v[16];
+ static integer i1, i2, ii, nh, nr, ns, nv;
+ static doublereal vv[16];
+ static integer itn;
+ static doublereal tau;
+ static integer its;
+ static doublereal ulp, tst1;
+ static integer maxb;
+ static doublereal absw;
+ static integer ierr;
+ static doublereal unfl, temp, ovfl;
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *);
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, doublereal *, integer *);
+ static integer itemp;
+ extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
+ doublereal *, integer *);
+ static logical initz, wantt, wantz;
+ extern doublereal dlapy2_(doublereal *, doublereal *);
+ extern /* Subroutine */ int dlabad_(doublereal *, doublereal *);
+
+ extern /* Subroutine */ int dlarfg_(integer *, doublereal *, doublereal *,
+ integer *, doublereal *);
+ extern integer idamax_(integer *, doublereal *, integer *);
+ extern doublereal dlanhs_(char *, integer *, doublereal *, integer *,
+ doublereal *);
+ extern /* Subroutine */ int dlahqr_(logical *, logical *, integer *,
+ integer *, integer *, doublereal *, integer *, doublereal *,
+ doublereal *, integer *, integer *, doublereal *, integer *,
+ integer *), dlacpy_(char *, integer *, integer *, doublereal *,
+ integer *, doublereal *, integer *), dlaset_(char *,
+ integer *, integer *, doublereal *, doublereal *, doublereal *,
+ integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int xerbla_(char *, integer *), dlarfx_(
+ char *, integer *, integer *, doublereal *, doublereal *,
+ doublereal *, integer *, doublereal *);
+ static doublereal smlnum;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DHSEQR computes the eigenvalues of a real upper Hessenberg matrix H
+ and, optionally, the matrices T and Z from the Schur decomposition
+ H = Z T Z**T, where T is an upper quasi-triangular matrix (the Schur
+ form), and Z is the orthogonal matrix of Schur vectors.
+
+ Optionally Z may be postmultiplied into an input orthogonal matrix Q,
+ so that this routine can give the Schur factorization of a matrix A
+ which has been reduced to the Hessenberg form H by the orthogonal
+ matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ = 'E': compute eigenvalues only;
+ = 'S': compute eigenvalues and the Schur form T.
+
+ COMPZ (input) CHARACTER*1
+ = 'N': no Schur vectors are computed;
+ = 'I': Z is initialized to the unit matrix and the matrix Z
+ of Schur vectors of H is returned;
+ = 'V': Z must contain an orthogonal matrix Q on entry, and
+ the product Q*Z is returned.
+
+ N (input) INTEGER
+ The order of the matrix H. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+ set by a previous call to DGEBAL, and then passed to SGEHRD
+ when the matrix output by DGEBAL is reduced to Hessenberg
+ form. Otherwise ILO and IHI should be set to 1 and N
+ respectively.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ H (input/output) DOUBLE PRECISION array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if JOB = 'S', H contains the upper quasi-triangular
+ matrix T from the Schur decomposition (the Schur form);
+ 2-by-2 diagonal blocks (corresponding to complex conjugate
+ pairs of eigenvalues) are returned in standard form, with
+ H(i,i) = H(i+1,i+1) and H(i+1,i)*H(i,i+1) < 0. If JOB = 'E',
+ the contents of H are unspecified on exit.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max(1,N).
+
+ WR (output) DOUBLE PRECISION array, dimension (N)
+ WI (output) DOUBLE PRECISION array, dimension (N)
+ The real and imaginary parts, respectively, of the computed
+ eigenvalues. If two eigenvalues are computed as a complex
+ conjugate pair, they are stored in consecutive elements of
+ WR and WI, say the i-th and (i+1)th, with WI(i) > 0 and
+ WI(i+1) < 0. If JOB = 'S', the eigenvalues are stored in the
+ same order as on the diagonal of the Schur form returned in
+ H, with WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2
+ diagonal block, WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and
+ WI(i+1) = -WI(i).
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+ If COMPZ = 'N': Z is not referenced.
+ If COMPZ = 'I': on entry, Z need not be set, and on exit, Z
+ contains the orthogonal matrix Z of the Schur vectors of H.
+ If COMPZ = 'V': on entry Z must contain an N-by-N matrix Q,
+ which is assumed to be equal to the unit matrix except for
+ the submatrix Z(ILO:IHI,ILO:IHI); on exit Z contains Q*Z.
+ Normally Q is the orthogonal matrix generated by DORGHR after
+ the call to DGEHRD which formed the Hessenberg matrix H.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z.
+ LDZ >= max(1,N) if COMPZ = 'I' or 'V'; LDZ >= 1 otherwise.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, DHSEQR failed to compute all of the
+ eigenvalues in a total of 30*(IHI-ILO+1) iterations;
+ elements 1:ilo-1 and i+1:n of WR and WI contain those
+ eigenvalues which have been successfully computed.
+
+ =====================================================================
+
+
+ Decode and test the input parameters
+*/
+
+ /* Parameter adjustments */
+ h_dim1 = *ldh;
+ h_offset = 1 + h_dim1 * 1;
+ h__ -= h_offset;
+ --wr;
+ --wi;
+ z_dim1 = *ldz;
+ z_offset = 1 + z_dim1 * 1;
+ z__ -= z_offset;
+ --work;
+
+ /* Function Body */
+ wantt = lsame_(job, "S");
+ initz = lsame_(compz, "I");
+ wantz = initz || lsame_(compz, "V");
+
+ *info = 0;
+ work[1] = (doublereal) max(1,*n);
+ lquery = *lwork == -1;
+ if ((! lsame_(job, "E") && ! wantt)) {
+ *info = -1;
+ } else if ((! lsame_(compz, "N") && ! wantz)) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*ilo < 1 || *ilo > max(1,*n)) {
+ *info = -4;
+ } else if (*ihi < min(*ilo,*n) || *ihi > *n) {
+ *info = -5;
+ } else if (*ldh < max(1,*n)) {
+ *info = -7;
+ } else if (*ldz < 1 || (wantz && *ldz < max(1,*n))) {
+ *info = -11;
+ } else if ((*lwork < max(1,*n) && ! lquery)) {
+ *info = -13;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DHSEQR", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Initialize Z, if necessary */
+
+ if (initz) {
+ dlaset_("Full", n, n, &c_b29, &c_b15, &z__[z_offset], ldz);
+ }
+
+/* Store the eigenvalues isolated by DGEBAL. */
+
+ i__1 = *ilo - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ wr[i__] = h__[i__ + i__ * h_dim1];
+ wi[i__] = 0.;
+/* L10: */
+ }
+ i__1 = *n;
+ for (i__ = *ihi + 1; i__ <= i__1; ++i__) {
+ wr[i__] = h__[i__ + i__ * h_dim1];
+ wi[i__] = 0.;
+/* L20: */
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return 0;
+ }
+ if (*ilo == *ihi) {
+ wr[*ilo] = h__[*ilo + *ilo * h_dim1];
+ wi[*ilo] = 0.;
+ return 0;
+ }
+
+/*
+ Set rows and columns ILO to IHI to zero below the first
+ subdiagonal.
+*/
+
+ i__1 = *ihi - 2;
+ for (j = *ilo; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = j + 2; i__ <= i__2; ++i__) {
+ h__[i__ + j * h_dim1] = 0.;
+/* L30: */
+ }
+/* L40: */
+ }
+ nh = *ihi - *ilo + 1;
+
+/*
+ Determine the order of the multi-shift QR algorithm to be used.
+
+ Writing concatenation
+*/
+ i__3[0] = 1, a__1[0] = job;
+ i__3[1] = 1, a__1[1] = compz;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ ns = ilaenv_(&c__4, "DHSEQR", ch__1, n, ilo, ihi, &c_n1, (ftnlen)6, (
+ ftnlen)2);
+/* Writing concatenation */
+ i__3[0] = 1, a__1[0] = job;
+ i__3[1] = 1, a__1[1] = compz;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ maxb = ilaenv_(&c__8, "DHSEQR", ch__1, n, ilo, ihi, &c_n1, (ftnlen)6, (
+ ftnlen)2);
+ if (ns <= 2 || ns > nh || maxb >= nh) {
+
+/* Use the standard double-shift algorithm */
+
+ dlahqr_(&wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[
+ 1], ilo, ihi, &z__[z_offset], ldz, info);
+ return 0;
+ }
+ maxb = max(3,maxb);
+/* Computing MIN */
+ i__1 = min(ns,maxb);
+ ns = min(i__1,15);
+
+/*
+ Now 2 < NS <= MAXB < NH.
+
+ Set machine-dependent constants for the stopping criterion.
+ If norm(H) <= sqrt(OVFL), overflow should not occur.
+*/
+
+ unfl = SAFEMINIMUM;
+ ovfl = 1. / unfl;
+ dlabad_(&unfl, &ovfl);
+ ulp = PRECISION;
+ smlnum = unfl * (nh / ulp);
+
+/*
+ I1 and I2 are the indices of the first row and last column of H
+ to which transformations must be applied. If eigenvalues only are
+ being computed, I1 and I2 are set inside the main loop.
+*/
+
+ if (wantt) {
+ i1 = 1;
+ i2 = *n;
+ }
+
+/* ITN is the total number of multiple-shift QR iterations allowed. */
+
+ itn = nh * 30;
+
+/*
+ The main loop begins here. I is the loop index and decreases from
+ IHI to ILO in steps of at most MAXB. Each iteration of the loop
+ works with the active submatrix in rows and columns L to I.
+ Eigenvalues I+1 to IHI have already converged. Either L = ILO or
+ H(L,L-1) is negligible so that the matrix splits.
+*/
+
+ i__ = *ihi;
+L50:
+ l = *ilo;
+ if (i__ < *ilo) {
+ goto L170;
+ }
+
+/*
+ Perform multiple-shift QR iterations on rows and columns ILO to I
+ until a submatrix of order at most MAXB splits off at the bottom
+ because a subdiagonal element has become negligible.
+*/
+
+ i__1 = itn;
+ for (its = 0; its <= i__1; ++its) {
+
+/* Look for a single small subdiagonal element. */
+
+ i__2 = l + 1;
+ for (k = i__; k >= i__2; --k) {
+ tst1 = (d__1 = h__[k - 1 + (k - 1) * h_dim1], abs(d__1)) + (d__2 =
+ h__[k + k * h_dim1], abs(d__2));
+ if (tst1 == 0.) {
+ i__4 = i__ - l + 1;
+ tst1 = dlanhs_("1", &i__4, &h__[l + l * h_dim1], ldh, &work[1]
+ );
+ }
+/* Computing MAX */
+ d__2 = ulp * tst1;
+ if ((d__1 = h__[k + (k - 1) * h_dim1], abs(d__1)) <= max(d__2,
+ smlnum)) {
+ goto L70;
+ }
+/* L60: */
+ }
+L70:
+ l = k;
+ if (l > *ilo) {
+
+/* H(L,L-1) is negligible. */
+
+ h__[l + (l - 1) * h_dim1] = 0.;
+ }
+
+/* Exit from loop if a submatrix of order <= MAXB has split off. */
+
+ if (l >= i__ - maxb + 1) {
+ goto L160;
+ }
+
+/*
+ Now the active submatrix is in rows and columns L to I. If
+ eigenvalues only are being computed, only the active submatrix
+ need be transformed.
+*/
+
+ if (! wantt) {
+ i1 = l;
+ i2 = i__;
+ }
+
+ if (its == 20 || its == 30) {
+
+/* Exceptional shifts. */
+
+ i__2 = i__;
+ for (ii = i__ - ns + 1; ii <= i__2; ++ii) {
+ wr[ii] = ((d__1 = h__[ii + (ii - 1) * h_dim1], abs(d__1)) + (
+ d__2 = h__[ii + ii * h_dim1], abs(d__2))) * 1.5;
+ wi[ii] = 0.;
+/* L80: */
+ }
+ } else {
+
+/* Use eigenvalues of trailing submatrix of order NS as shifts. */
+
+ dlacpy_("Full", &ns, &ns, &h__[i__ - ns + 1 + (i__ - ns + 1) *
+ h_dim1], ldh, s, &c__15);
+ dlahqr_(&c_false, &c_false, &ns, &c__1, &ns, s, &c__15, &wr[i__ -
+ ns + 1], &wi[i__ - ns + 1], &c__1, &ns, &z__[z_offset],
+ ldz, &ierr);
+ if (ierr > 0) {
+
+/*
+ If DLAHQR failed to compute all NS eigenvalues, use the
+ unconverged diagonal elements as the remaining shifts.
+*/
+
+ i__2 = ierr;
+ for (ii = 1; ii <= i__2; ++ii) {
+ wr[i__ - ns + ii] = s[ii + ii * 15 - 16];
+ wi[i__ - ns + ii] = 0.;
+/* L90: */
+ }
+ }
+ }
+
+/*
+ Form the first column of (G-w(1)) (G-w(2)) . . . (G-w(ns))
+ where G is the Hessenberg submatrix H(L:I,L:I) and w is
+ the vector of shifts (stored in WR and WI). The result is
+ stored in the local array V.
+*/
+
+ v[0] = 1.;
+ i__2 = ns + 1;
+ for (ii = 2; ii <= i__2; ++ii) {
+ v[ii - 1] = 0.;
+/* L100: */
+ }
+ nv = 1;
+ i__2 = i__;
+ for (j = i__ - ns + 1; j <= i__2; ++j) {
+ if (wi[j] >= 0.) {
+ if (wi[j] == 0.) {
+
+/* real shift */
+
+ i__4 = nv + 1;
+ dcopy_(&i__4, v, &c__1, vv, &c__1);
+ i__4 = nv + 1;
+ d__1 = -wr[j];
+ dgemv_("No transpose", &i__4, &nv, &c_b15, &h__[l + l *
+ h_dim1], ldh, vv, &c__1, &d__1, v, &c__1);
+ ++nv;
+ } else if (wi[j] > 0.) {
+
+/* complex conjugate pair of shifts */
+
+ i__4 = nv + 1;
+ dcopy_(&i__4, v, &c__1, vv, &c__1);
+ i__4 = nv + 1;
+ d__1 = wr[j] * -2.;
+ dgemv_("No transpose", &i__4, &nv, &c_b15, &h__[l + l *
+ h_dim1], ldh, v, &c__1, &d__1, vv, &c__1);
+ i__4 = nv + 1;
+ itemp = idamax_(&i__4, vv, &c__1);
+/* Computing MAX */
+ d__2 = (d__1 = vv[itemp - 1], abs(d__1));
+ temp = 1. / max(d__2,smlnum);
+ i__4 = nv + 1;
+ dscal_(&i__4, &temp, vv, &c__1);
+ absw = dlapy2_(&wr[j], &wi[j]);
+ temp = temp * absw * absw;
+ i__4 = nv + 2;
+ i__5 = nv + 1;
+ dgemv_("No transpose", &i__4, &i__5, &c_b15, &h__[l + l *
+ h_dim1], ldh, vv, &c__1, &temp, v, &c__1);
+ nv += 2;
+ }
+
+/*
+ Scale V(1:NV) so that max(abs(V(i))) = 1. If V is zero,
+ reset it to the unit vector.
+*/
+
+ itemp = idamax_(&nv, v, &c__1);
+ temp = (d__1 = v[itemp - 1], abs(d__1));
+ if (temp == 0.) {
+ v[0] = 1.;
+ i__4 = nv;
+ for (ii = 2; ii <= i__4; ++ii) {
+ v[ii - 1] = 0.;
+/* L110: */
+ }
+ } else {
+ temp = max(temp,smlnum);
+ d__1 = 1. / temp;
+ dscal_(&nv, &d__1, v, &c__1);
+ }
+ }
+/* L120: */
+ }
+
+/* Multiple-shift QR step */
+
+ i__2 = i__ - 1;
+ for (k = l; k <= i__2; ++k) {
+
+/*
+ The first iteration of this loop determines a reflection G
+ from the vector V and applies it from left and right to H,
+ thus creating a nonzero bulge below the subdiagonal.
+
+ Each subsequent iteration determines a reflection G to
+ restore the Hessenberg form in the (K-1)th column, and thus
+ chases the bulge one step toward the bottom of the active
+ submatrix. NR is the order of G.
+
+ Computing MIN
+*/
+ i__4 = ns + 1, i__5 = i__ - k + 1;
+ nr = min(i__4,i__5);
+ if (k > l) {
+ dcopy_(&nr, &h__[k + (k - 1) * h_dim1], &c__1, v, &c__1);
+ }
+ dlarfg_(&nr, v, &v[1], &c__1, &tau);
+ if (k > l) {
+ h__[k + (k - 1) * h_dim1] = v[0];
+ i__4 = i__;
+ for (ii = k + 1; ii <= i__4; ++ii) {
+ h__[ii + (k - 1) * h_dim1] = 0.;
+/* L130: */
+ }
+ }
+ v[0] = 1.;
+
+/*
+ Apply G from the left to transform the rows of the matrix in
+ columns K to I2.
+*/
+
+ i__4 = i2 - k + 1;
+ dlarfx_("Left", &nr, &i__4, v, &tau, &h__[k + k * h_dim1], ldh, &
+ work[1]);
+
+/*
+ Apply G from the right to transform the columns of the
+ matrix in rows I1 to min(K+NR,I).
+
+ Computing MIN
+*/
+ i__5 = k + nr;
+ i__4 = min(i__5,i__) - i1 + 1;
+ dlarfx_("Right", &i__4, &nr, v, &tau, &h__[i1 + k * h_dim1], ldh,
+ &work[1]);
+
+ if (wantz) {
+
+/* Accumulate transformations in the matrix Z */
+
+ dlarfx_("Right", &nh, &nr, v, &tau, &z__[*ilo + k * z_dim1],
+ ldz, &work[1]);
+ }
+/* L140: */
+ }
+
+/* L150: */
+ }
+
+/* Failure to converge in remaining number of iterations */
+
+ *info = i__;
+ return 0;
+
+L160:
+
+/*
+ A submatrix of order <= MAXB in rows and columns L to I has split
+ off. Use the double-shift QR algorithm to handle it.
+*/
+
+ dlahqr_(&wantt, &wantz, n, &l, &i__, &h__[h_offset], ldh, &wr[1], &wi[1],
+ ilo, ihi, &z__[z_offset], ldz, info);
+ if (*info > 0) {
+ return 0;
+ }
+
+/*
+ Decrement number of remaining iterations, and return to start of
+ the main loop with a new value of I.
+*/
+
+ itn -= its;
+ i__ = l - 1;
+ goto L50;
+
+L170:
+ work[1] = (doublereal) max(1,*n);
+ return 0;
+
+/* End of DHSEQR */
+
+} /* dhseqr_ */
+
+/* Subroutine */ int dlabad_(doublereal *small, doublereal *large)
+{
+ /* Builtin functions */
+ double d_lg10(doublereal *), sqrt(doublereal);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLABAD takes as input the values computed by DLAMCH for underflow and
+ overflow, and returns the square root of each of these values if the
+ log of LARGE is sufficiently large. This subroutine is intended to
+ identify machines with a large exponent range, such as the Crays, and
+ redefine the underflow and overflow limits to be the square roots of
+ the values computed by DLAMCH. This subroutine is needed because
+ DLAMCH does not compensate for poor arithmetic in the upper half of
+ the exponent range, as is found on a Cray.
+
+ Arguments
+ =========
+
+ SMALL (input/output) DOUBLE PRECISION
+ On entry, the underflow threshold as computed by DLAMCH.
+ On exit, if LOG10(LARGE) is sufficiently large, the square
+ root of SMALL, otherwise unchanged.
+
+ LARGE (input/output) DOUBLE PRECISION
+ On entry, the overflow threshold as computed by DLAMCH.
+ On exit, if LOG10(LARGE) is sufficiently large, the square
+ root of LARGE, otherwise unchanged.
+
+ =====================================================================
+
+
+ If it looks like we're on a Cray, take the square root of
+ SMALL and LARGE to avoid overflow and underflow problems.
+*/
+
+ if (d_lg10(large) > 2e3) {
+ *small = sqrt(*small);
+ *large = sqrt(*large);
+ }
+
+ return 0;
+
+/* End of DLABAD */
+
+} /* dlabad_ */
+
+/* Subroutine */ int dlabrd_(integer *m, integer *n, integer *nb, doublereal *
+ a, integer *lda, doublereal *d__, doublereal *e, doublereal *tauq,
+ doublereal *taup, doublereal *x, integer *ldx, doublereal *y, integer
+ *ldy)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, x_dim1, x_offset, y_dim1, y_offset, i__1, i__2,
+ i__3;
+
+ /* Local variables */
+ static integer i__;
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *), dgemv_(char *, integer *, integer *, doublereal *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ doublereal *, integer *), dlarfg_(integer *, doublereal *,
+ doublereal *, integer *, doublereal *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ February 29, 1992
+
+
+ Purpose
+ =======
+
+ DLABRD reduces the first NB rows and columns of a real general
+ m by n matrix A to upper or lower bidiagonal form by an orthogonal
+ transformation Q' * A * P, and returns the matrices X and Y which
+ are needed to apply the transformation to the unreduced part of A.
+
+ If m >= n, A is reduced to upper bidiagonal form; if m < n, to lower
+ bidiagonal form.
+
+ This is an auxiliary routine called by DGEBRD
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows in the matrix A.
+
+ N (input) INTEGER
+ The number of columns in the matrix A.
+
+ NB (input) INTEGER
+ The number of leading rows and columns of A to be reduced.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the m by n general matrix to be reduced.
+ On exit, the first NB rows and columns of the matrix are
+ overwritten; the rest of the array is unchanged.
+ If m >= n, elements on and below the diagonal in the first NB
+ columns, with the array TAUQ, represent the orthogonal
+ matrix Q as a product of elementary reflectors; and
+ elements above the diagonal in the first NB rows, with the
+ array TAUP, represent the orthogonal matrix P as a product
+ of elementary reflectors.
+ If m < n, elements below the diagonal in the first NB
+ columns, with the array TAUQ, represent the orthogonal
+ matrix Q as a product of elementary reflectors, and
+ elements on and above the diagonal in the first NB rows,
+ with the array TAUP, represent the orthogonal matrix P as
+ a product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ D (output) DOUBLE PRECISION array, dimension (NB)
+ The diagonal elements of the first NB rows and columns of
+ the reduced matrix. D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (NB)
+ The off-diagonal elements of the first NB rows and columns of
+ the reduced matrix.
+
+ TAUQ (output) DOUBLE PRECISION array dimension (NB)
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix Q. See Further Details.
+
+ TAUP (output) DOUBLE PRECISION array, dimension (NB)
+ The scalar factors of the elementary reflectors which
+ represent the orthogonal matrix P. See Further Details.
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NB)
+ The m-by-nb matrix X required to update the unreduced part
+ of A.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= M.
+
+ Y (output) DOUBLE PRECISION array, dimension (LDY,NB)
+ The n-by-nb matrix Y required to update the unreduced part
+ of A.
+
+ LDY (output) INTEGER
+ The leading dimension of the array Y. LDY >= N.
+
+ Further Details
+ ===============
+
+ The matrices Q and P are represented as products of elementary
+ reflectors:
+
+ Q = H(1) H(2) . . . H(nb) and P = G(1) G(2) . . . G(nb)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are real scalars, and v and u are real vectors.
+
+ If m >= n, v(1:i-1) = 0, v(i) = 1, and v(i:m) is stored on exit in
+ A(i:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+1:n) is stored on exit in
+ A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ If m < n, v(1:i) = 0, v(i+1) = 1, and v(i+1:m) is stored on exit in
+ A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i:n) is stored on exit in
+ A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ The elements of the vectors v and u together form the m-by-nb matrix
+ V and the nb-by-n matrix U' which are needed, with X and Y, to apply
+ the transformation to the unreduced part of the matrix, using a block
+ update of the form: A := A - V*Y' - X*U'.
+
+ The contents of A on exit are illustrated by the following examples
+ with nb = 2:
+
+ m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
+
+ ( 1 1 u1 u1 u1 ) ( 1 u1 u1 u1 u1 u1 )
+ ( v1 1 1 u2 u2 ) ( 1 1 u2 u2 u2 u2 )
+ ( v1 v2 a a a ) ( v1 1 a a a a )
+ ( v1 v2 a a a ) ( v1 v2 a a a a )
+ ( v1 v2 a a a ) ( v1 v2 a a a a )
+ ( v1 v2 a a a )
+
+ where a denotes an element of the original matrix which is unchanged,
+ vi denotes an element of the vector defining H(i), and ui an element
+ of the vector defining G(i).
+
+ =====================================================================
+
+
+ Quick return if possible
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --d__;
+ --e;
+ --tauq;
+ --taup;
+ x_dim1 = *ldx;
+ x_offset = 1 + x_dim1 * 1;
+ x -= x_offset;
+ y_dim1 = *ldy;
+ y_offset = 1 + y_dim1 * 1;
+ y -= y_offset;
+
+ /* Function Body */
+ if (*m <= 0 || *n <= 0) {
+ return 0;
+ }
+
+ if (*m >= *n) {
+
+/* Reduce to upper bidiagonal form */
+
+ i__1 = *nb;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/* Update A(i:m,i) */
+
+ i__2 = *m - i__ + 1;
+ i__3 = i__ - 1;
+ dgemv_("No transpose", &i__2, &i__3, &c_b151, &a[i__ + a_dim1],
+ lda, &y[i__ + y_dim1], ldy, &c_b15, &a[i__ + i__ * a_dim1]
+ , &c__1);
+ i__2 = *m - i__ + 1;
+ i__3 = i__ - 1;
+ dgemv_("No transpose", &i__2, &i__3, &c_b151, &x[i__ + x_dim1],
+ ldx, &a[i__ * a_dim1 + 1], &c__1, &c_b15, &a[i__ + i__ *
+ a_dim1], &c__1);
+
+/* Generate reflection Q(i) to annihilate A(i+1:m,i) */
+
+ i__2 = *m - i__ + 1;
+/* Computing MIN */
+ i__3 = i__ + 1;
+ dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[min(i__3,*m) + i__ *
+ a_dim1], &c__1, &tauq[i__]);
+ d__[i__] = a[i__ + i__ * a_dim1];
+ if (i__ < *n) {
+ a[i__ + i__ * a_dim1] = 1.;
+
+/* Compute Y(i+1:n,i) */
+
+ i__2 = *m - i__ + 1;
+ i__3 = *n - i__;
+ dgemv_("Transpose", &i__2, &i__3, &c_b15, &a[i__ + (i__ + 1) *
+ a_dim1], lda, &a[i__ + i__ * a_dim1], &c__1, &c_b29,
+ &y[i__ + 1 + i__ * y_dim1], &c__1);
+ i__2 = *m - i__ + 1;
+ i__3 = i__ - 1;
+ dgemv_("Transpose", &i__2, &i__3, &c_b15, &a[i__ + a_dim1],
+ lda, &a[i__ + i__ * a_dim1], &c__1, &c_b29, &y[i__ *
+ y_dim1 + 1], &c__1);
+ i__2 = *n - i__;
+ i__3 = i__ - 1;
+ dgemv_("No transpose", &i__2, &i__3, &c_b151, &y[i__ + 1 +
+ y_dim1], ldy, &y[i__ * y_dim1 + 1], &c__1, &c_b15, &y[
+ i__ + 1 + i__ * y_dim1], &c__1);
+ i__2 = *m - i__ + 1;
+ i__3 = i__ - 1;
+ dgemv_("Transpose", &i__2, &i__3, &c_b15, &x[i__ + x_dim1],
+ ldx, &a[i__ + i__ * a_dim1], &c__1, &c_b29, &y[i__ *
+ y_dim1 + 1], &c__1);
+ i__2 = i__ - 1;
+ i__3 = *n - i__;
+ dgemv_("Transpose", &i__2, &i__3, &c_b151, &a[(i__ + 1) *
+ a_dim1 + 1], lda, &y[i__ * y_dim1 + 1], &c__1, &c_b15,
+ &y[i__ + 1 + i__ * y_dim1], &c__1);
+ i__2 = *n - i__;
+ dscal_(&i__2, &tauq[i__], &y[i__ + 1 + i__ * y_dim1], &c__1);
+
+/* Update A(i,i+1:n) */
+
+ i__2 = *n - i__;
+ dgemv_("No transpose", &i__2, &i__, &c_b151, &y[i__ + 1 +
+ y_dim1], ldy, &a[i__ + a_dim1], lda, &c_b15, &a[i__ +
+ (i__ + 1) * a_dim1], lda);
+ i__2 = i__ - 1;
+ i__3 = *n - i__;
+ dgemv_("Transpose", &i__2, &i__3, &c_b151, &a[(i__ + 1) *
+ a_dim1 + 1], lda, &x[i__ + x_dim1], ldx, &c_b15, &a[
+ i__ + (i__ + 1) * a_dim1], lda);
+
+/* Generate reflection P(i) to annihilate A(i,i+2:n) */
+
+ i__2 = *n - i__;
+/* Computing MIN */
+ i__3 = i__ + 2;
+ dlarfg_(&i__2, &a[i__ + (i__ + 1) * a_dim1], &a[i__ + min(
+ i__3,*n) * a_dim1], lda, &taup[i__]);
+ e[i__] = a[i__ + (i__ + 1) * a_dim1];
+ a[i__ + (i__ + 1) * a_dim1] = 1.;
+
+/* Compute X(i+1:m,i) */
+
+ i__2 = *m - i__;
+ i__3 = *n - i__;
+ dgemv_("No transpose", &i__2, &i__3, &c_b15, &a[i__ + 1 + (
+ i__ + 1) * a_dim1], lda, &a[i__ + (i__ + 1) * a_dim1],
+ lda, &c_b29, &x[i__ + 1 + i__ * x_dim1], &c__1);
+ i__2 = *n - i__;
+ dgemv_("Transpose", &i__2, &i__, &c_b15, &y[i__ + 1 + y_dim1],
+ ldy, &a[i__ + (i__ + 1) * a_dim1], lda, &c_b29, &x[
+ i__ * x_dim1 + 1], &c__1);
+ i__2 = *m - i__;
+ dgemv_("No transpose", &i__2, &i__, &c_b151, &a[i__ + 1 +
+ a_dim1], lda, &x[i__ * x_dim1 + 1], &c__1, &c_b15, &x[
+ i__ + 1 + i__ * x_dim1], &c__1);
+ i__2 = i__ - 1;
+ i__3 = *n - i__;
+ dgemv_("No transpose", &i__2, &i__3, &c_b15, &a[(i__ + 1) *
+ a_dim1 + 1], lda, &a[i__ + (i__ + 1) * a_dim1], lda, &
+ c_b29, &x[i__ * x_dim1 + 1], &c__1);
+ i__2 = *m - i__;
+ i__3 = i__ - 1;
+ dgemv_("No transpose", &i__2, &i__3, &c_b151, &x[i__ + 1 +
+ x_dim1], ldx, &x[i__ * x_dim1 + 1], &c__1, &c_b15, &x[
+ i__ + 1 + i__ * x_dim1], &c__1);
+ i__2 = *m - i__;
+ dscal_(&i__2, &taup[i__], &x[i__ + 1 + i__ * x_dim1], &c__1);
+ }
+/* L10: */
+ }
+ } else {
+
+/* Reduce to lower bidiagonal form */
+
+ i__1 = *nb;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/* Update A(i,i:n) */
+
+ i__2 = *n - i__ + 1;
+ i__3 = i__ - 1;
+ dgemv_("No transpose", &i__2, &i__3, &c_b151, &y[i__ + y_dim1],
+ ldy, &a[i__ + a_dim1], lda, &c_b15, &a[i__ + i__ * a_dim1]
+ , lda);
+ i__2 = i__ - 1;
+ i__3 = *n - i__ + 1;
+ dgemv_("Transpose", &i__2, &i__3, &c_b151, &a[i__ * a_dim1 + 1],
+ lda, &x[i__ + x_dim1], ldx, &c_b15, &a[i__ + i__ * a_dim1]
+ , lda);
+
+/* Generate reflection P(i) to annihilate A(i,i+1:n) */
+
+ i__2 = *n - i__ + 1;
+/* Computing MIN */
+ i__3 = i__ + 1;
+ dlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[i__ + min(i__3,*n) *
+ a_dim1], lda, &taup[i__]);
+ d__[i__] = a[i__ + i__ * a_dim1];
+ if (i__ < *m) {
+ a[i__ + i__ * a_dim1] = 1.;
+
+/* Compute X(i+1:m,i) */
+
+ i__2 = *m - i__;
+ i__3 = *n - i__ + 1;
+ dgemv_("No transpose", &i__2, &i__3, &c_b15, &a[i__ + 1 + i__
+ * a_dim1], lda, &a[i__ + i__ * a_dim1], lda, &c_b29, &
+ x[i__ + 1 + i__ * x_dim1], &c__1);
+ i__2 = *n - i__ + 1;
+ i__3 = i__ - 1;
+ dgemv_("Transpose", &i__2, &i__3, &c_b15, &y[i__ + y_dim1],
+ ldy, &a[i__ + i__ * a_dim1], lda, &c_b29, &x[i__ *
+ x_dim1 + 1], &c__1);
+ i__2 = *m - i__;
+ i__3 = i__ - 1;
+ dgemv_("No transpose", &i__2, &i__3, &c_b151, &a[i__ + 1 +
+ a_dim1], lda, &x[i__ * x_dim1 + 1], &c__1, &c_b15, &x[
+ i__ + 1 + i__ * x_dim1], &c__1);
+ i__2 = i__ - 1;
+ i__3 = *n - i__ + 1;
+ dgemv_("No transpose", &i__2, &i__3, &c_b15, &a[i__ * a_dim1
+ + 1], lda, &a[i__ + i__ * a_dim1], lda, &c_b29, &x[
+ i__ * x_dim1 + 1], &c__1);
+ i__2 = *m - i__;
+ i__3 = i__ - 1;
+ dgemv_("No transpose", &i__2, &i__3, &c_b151, &x[i__ + 1 +
+ x_dim1], ldx, &x[i__ * x_dim1 + 1], &c__1, &c_b15, &x[
+ i__ + 1 + i__ * x_dim1], &c__1);
+ i__2 = *m - i__;
+ dscal_(&i__2, &taup[i__], &x[i__ + 1 + i__ * x_dim1], &c__1);
+
+/* Update A(i+1:m,i) */
+
+ i__2 = *m - i__;
+ i__3 = i__ - 1;
+ dgemv_("No transpose", &i__2, &i__3, &c_b151, &a[i__ + 1 +
+ a_dim1], lda, &y[i__ + y_dim1], ldy, &c_b15, &a[i__ +
+ 1 + i__ * a_dim1], &c__1);
+ i__2 = *m - i__;
+ dgemv_("No transpose", &i__2, &i__, &c_b151, &x[i__ + 1 +
+ x_dim1], ldx, &a[i__ * a_dim1 + 1], &c__1, &c_b15, &a[
+ i__ + 1 + i__ * a_dim1], &c__1);
+
+/* Generate reflection Q(i) to annihilate A(i+2:m,i) */
+
+ i__2 = *m - i__;
+/* Computing MIN */
+ i__3 = i__ + 2;
+ dlarfg_(&i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3,*m) +
+ i__ * a_dim1], &c__1, &tauq[i__]);
+ e[i__] = a[i__ + 1 + i__ * a_dim1];
+ a[i__ + 1 + i__ * a_dim1] = 1.;
+
+/* Compute Y(i+1:n,i) */
+
+ i__2 = *m - i__;
+ i__3 = *n - i__;
+ dgemv_("Transpose", &i__2, &i__3, &c_b15, &a[i__ + 1 + (i__ +
+ 1) * a_dim1], lda, &a[i__ + 1 + i__ * a_dim1], &c__1,
+ &c_b29, &y[i__ + 1 + i__ * y_dim1], &c__1);
+ i__2 = *m - i__;
+ i__3 = i__ - 1;
+ dgemv_("Transpose", &i__2, &i__3, &c_b15, &a[i__ + 1 + a_dim1]
+ , lda, &a[i__ + 1 + i__ * a_dim1], &c__1, &c_b29, &y[
+ i__ * y_dim1 + 1], &c__1);
+ i__2 = *n - i__;
+ i__3 = i__ - 1;
+ dgemv_("No transpose", &i__2, &i__3, &c_b151, &y[i__ + 1 +
+ y_dim1], ldy, &y[i__ * y_dim1 + 1], &c__1, &c_b15, &y[
+ i__ + 1 + i__ * y_dim1], &c__1);
+ i__2 = *m - i__;
+ dgemv_("Transpose", &i__2, &i__, &c_b15, &x[i__ + 1 + x_dim1],
+ ldx, &a[i__ + 1 + i__ * a_dim1], &c__1, &c_b29, &y[
+ i__ * y_dim1 + 1], &c__1);
+ i__2 = *n - i__;
+ dgemv_("Transpose", &i__, &i__2, &c_b151, &a[(i__ + 1) *
+ a_dim1 + 1], lda, &y[i__ * y_dim1 + 1], &c__1, &c_b15,
+ &y[i__ + 1 + i__ * y_dim1], &c__1);
+ i__2 = *n - i__;
+ dscal_(&i__2, &tauq[i__], &y[i__ + 1 + i__ * y_dim1], &c__1);
+ }
+/* L20: */
+ }
+ }
+ return 0;
+
+/* End of DLABRD */
+
+} /* dlabrd_ */
+
+/* Subroutine */ int dlacpy_(char *uplo, integer *m, integer *n, doublereal *
+ a, integer *lda, doublereal *b, integer *ldb)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2;
+
+ /* Local variables */
+ static integer i__, j;
+ extern logical lsame_(char *, char *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ February 29, 1992
+
+
+ Purpose
+ =======
+
+ DLACPY copies all or part of a two-dimensional matrix A to another
+ matrix B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies the part of the matrix A to be copied to B.
+ = 'U': Upper triangular part
+ = 'L': Lower triangular part
+ Otherwise: All of the matrix A
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The m by n matrix A. If UPLO = 'U', only the upper triangle
+ or trapezoid is accessed; if UPLO = 'L', only the lower
+ triangle or trapezoid is accessed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (output) DOUBLE PRECISION array, dimension (LDB,N)
+ On exit, B = A in the locations specified by UPLO.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,M).
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+
+ /* Function Body */
+ if (lsame_(uplo, "U")) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = min(j,*m);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] = a[i__ + j * a_dim1];
+/* L10: */
+ }
+/* L20: */
+ }
+ } else if (lsame_(uplo, "L")) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] = a[i__ + j * a_dim1];
+/* L30: */
+ }
+/* L40: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] = a[i__ + j * a_dim1];
+/* L50: */
+ }
+/* L60: */
+ }
+ }
+ return 0;
+
+/* End of DLACPY */
+
+} /* dlacpy_ */
+
+/* Subroutine */ int dladiv_(doublereal *a, doublereal *b, doublereal *c__,
+ doublereal *d__, doublereal *p, doublereal *q)
+{
+ static doublereal e, f;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLADIV performs complex division in real arithmetic
+
+ a + i*b
+ p + i*q = ---------
+ c + i*d
+
+ The algorithm is due to Robert L. Smith and can be found
+ in D. Knuth, The art of Computer Programming, Vol.2, p.195
+
+ Arguments
+ =========
+
+ A (input) DOUBLE PRECISION
+ B (input) DOUBLE PRECISION
+ C (input) DOUBLE PRECISION
+ D (input) DOUBLE PRECISION
+ The scalars a, b, c, and d in the above expression.
+
+ P (output) DOUBLE PRECISION
+ Q (output) DOUBLE PRECISION
+ The scalars p and q in the above expression.
+
+ =====================================================================
+*/
+
+
+ if (abs(*d__) < abs(*c__)) {
+ e = *d__ / *c__;
+ f = *c__ + *d__ * e;
+ *p = (*a + *b * e) / f;
+ *q = (*b - *a * e) / f;
+ } else {
+ e = *c__ / *d__;
+ f = *d__ + *c__ * e;
+ *p = (*b + *a * e) / f;
+ *q = (-(*a) + *b * e) / f;
+ }
+
+ return 0;
+
+/* End of DLADIV */
+
+} /* dladiv_ */
+
+/* Subroutine */ int dlae2_(doublereal *a, doublereal *b, doublereal *c__,
+ doublereal *rt1, doublereal *rt2)
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static doublereal ab, df, tb, sm, rt, adf, acmn, acmx;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix
+ [ A B ]
+ [ B C ].
+ On return, RT1 is the eigenvalue of larger absolute value, and RT2
+ is the eigenvalue of smaller absolute value.
+
+ Arguments
+ =========
+
+ A (input) DOUBLE PRECISION
+ The (1,1) element of the 2-by-2 matrix.
+
+ B (input) DOUBLE PRECISION
+ The (1,2) and (2,1) elements of the 2-by-2 matrix.
+
+ C (input) DOUBLE PRECISION
+ The (2,2) element of the 2-by-2 matrix.
+
+ RT1 (output) DOUBLE PRECISION
+ The eigenvalue of larger absolute value.
+
+ RT2 (output) DOUBLE PRECISION
+ The eigenvalue of smaller absolute value.
+
+ Further Details
+ ===============
+
+ RT1 is accurate to a few ulps barring over/underflow.
+
+ RT2 may be inaccurate if there is massive cancellation in the
+ determinant A*C-B*B; higher precision or correctly rounded or
+ correctly truncated arithmetic would be needed to compute RT2
+ accurately in all cases.
+
+ Overflow is possible only if RT1 is within a factor of 5 of overflow.
+ Underflow is harmless if the input data is 0 or exceeds
+ underflow_threshold / macheps.
+
+ =====================================================================
+
+
+ Compute the eigenvalues
+*/
+
+ sm = *a + *c__;
+ df = *a - *c__;
+ adf = abs(df);
+ tb = *b + *b;
+ ab = abs(tb);
+ if (abs(*a) > abs(*c__)) {
+ acmx = *a;
+ acmn = *c__;
+ } else {
+ acmx = *c__;
+ acmn = *a;
+ }
+ if (adf > ab) {
+/* Computing 2nd power */
+ d__1 = ab / adf;
+ rt = adf * sqrt(d__1 * d__1 + 1.);
+ } else if (adf < ab) {
+/* Computing 2nd power */
+ d__1 = adf / ab;
+ rt = ab * sqrt(d__1 * d__1 + 1.);
+ } else {
+
+/* Includes case AB=ADF=0 */
+
+ rt = ab * sqrt(2.);
+ }
+ if (sm < 0.) {
+ *rt1 = (sm - rt) * .5;
+
+/*
+ Order of execution important.
+ To get fully accurate smaller eigenvalue,
+ next line needs to be executed in higher precision.
+*/
+
+ *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
+ } else if (sm > 0.) {
+ *rt1 = (sm + rt) * .5;
+
+/*
+ Order of execution important.
+ To get fully accurate smaller eigenvalue,
+ next line needs to be executed in higher precision.
+*/
+
+ *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
+ } else {
+
+/* Includes case RT1 = RT2 = 0 */
+
+ *rt1 = rt * .5;
+ *rt2 = rt * -.5;
+ }
+ return 0;
+
+/* End of DLAE2 */
+
+} /* dlae2_ */
+
+/* Subroutine */ int dlaed0_(integer *icompq, integer *qsiz, integer *n,
+ doublereal *d__, doublereal *e, doublereal *q, integer *ldq,
+ doublereal *qstore, integer *ldqs, doublereal *work, integer *iwork,
+ integer *info)
+{
+ /* System generated locals */
+ integer q_dim1, q_offset, qstore_dim1, qstore_offset, i__1, i__2;
+ doublereal d__1;
+
+ /* Builtin functions */
+ double log(doublereal);
+ integer pow_ii(integer *, integer *);
+
+ /* Local variables */
+ static integer i__, j, k, iq, lgn, msd2, smm1, spm1, spm2;
+ static doublereal temp;
+ static integer curr;
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *);
+ static integer iperm;
+ extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
+ doublereal *, integer *);
+ static integer indxq, iwrem;
+ extern /* Subroutine */ int dlaed1_(integer *, doublereal *, doublereal *,
+ integer *, integer *, doublereal *, integer *, doublereal *,
+ integer *, integer *);
+ static integer iqptr;
+ extern /* Subroutine */ int dlaed7_(integer *, integer *, integer *,
+ integer *, integer *, integer *, doublereal *, doublereal *,
+ integer *, integer *, doublereal *, integer *, doublereal *,
+ integer *, integer *, integer *, integer *, integer *, doublereal
+ *, doublereal *, integer *, integer *);
+ static integer tlvls;
+ extern /* Subroutine */ int dlacpy_(char *, integer *, integer *,
+ doublereal *, integer *, doublereal *, integer *);
+ static integer igivcl;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static integer igivnm, submat, curprb, subpbs, igivpt;
+ extern /* Subroutine */ int dsteqr_(char *, integer *, doublereal *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *);
+ static integer curlvl, matsiz, iprmpt, smlsiz;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DLAED0 computes all eigenvalues and corresponding eigenvectors of a
+ symmetric tridiagonal matrix using the divide and conquer method.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ = 0: Compute eigenvalues only.
+ = 1: Compute eigenvectors of original dense symmetric matrix
+ also. On entry, Q contains the orthogonal matrix used
+ to reduce the original matrix to tridiagonal form.
+ = 2: Compute eigenvalues and eigenvectors of tridiagonal
+ matrix.
+
+ QSIZ (input) INTEGER
+ The dimension of the orthogonal matrix used to reduce
+ the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the main diagonal of the tridiagonal matrix.
+ On exit, its eigenvalues.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix.
+ On exit, E has been destroyed.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
+ On entry, Q must contain an N-by-N orthogonal matrix.
+ If ICOMPQ = 0 Q is not referenced.
+ If ICOMPQ = 1 On entry, Q is a subset of the columns of the
+ orthogonal matrix used to reduce the full
+ matrix to tridiagonal form corresponding to
+ the subset of the full matrix which is being
+ decomposed at this time.
+ If ICOMPQ = 2 On entry, Q will be the identity matrix.
+ On exit, Q contains the eigenvectors of the
+ tridiagonal matrix.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. If eigenvectors are
+ desired, then LDQ >= max(1,N). In any case, LDQ >= 1.
+
+ QSTORE (workspace) DOUBLE PRECISION array, dimension (LDQS, N)
+ Referenced only when ICOMPQ = 1. Used to store parts of
+ the eigenvector matrix when the updating matrix multiplies
+ take place.
+
+ LDQS (input) INTEGER
+ The leading dimension of the array QSTORE. If ICOMPQ = 1,
+ then LDQS >= max(1,N). In any case, LDQS >= 1.
+
+ WORK (workspace) DOUBLE PRECISION array,
+ If ICOMPQ = 0 or 1, the dimension of WORK must be at least
+ 1 + 3*N + 2*N*lg N + 2*N**2
+ ( lg( N ) = smallest integer k
+ such that 2^k >= N )
+ If ICOMPQ = 2, the dimension of WORK must be at least
+ 4*N + N**2.
+
+ IWORK (workspace) INTEGER array,
+ If ICOMPQ = 0 or 1, the dimension of IWORK must be at least
+ 6 + 6*N + 5*N*lg N.
+ ( lg( N ) = smallest integer k
+ such that 2^k >= N )
+ If ICOMPQ = 2, the dimension of IWORK must be at least
+ 3 + 5*N.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an eigenvalue while
+ working on the submatrix lying in rows and columns
+ INFO/(N+1) through mod(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ --e;
+ q_dim1 = *ldq;
+ q_offset = 1 + q_dim1 * 1;
+ q -= q_offset;
+ qstore_dim1 = *ldqs;
+ qstore_offset = 1 + qstore_dim1 * 1;
+ qstore -= qstore_offset;
+ --work;
+ --iwork;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*icompq < 0 || *icompq > 2) {
+ *info = -1;
+ } else if ((*icompq == 1 && *qsiz < max(0,*n))) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*ldq < max(1,*n)) {
+ *info = -7;
+ } else if (*ldqs < max(1,*n)) {
+ *info = -9;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLAED0", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+ smlsiz = ilaenv_(&c__9, "DLAED0", " ", &c__0, &c__0, &c__0, &c__0, (
+ ftnlen)6, (ftnlen)1);
+
+/*
+ Determine the size and placement of the submatrices, and save in
+ the leading elements of IWORK.
+*/
+
+ iwork[1] = *n;
+ subpbs = 1;
+ tlvls = 0;
+L10:
+ if (iwork[subpbs] > smlsiz) {
+ for (j = subpbs; j >= 1; --j) {
+ iwork[j * 2] = (iwork[j] + 1) / 2;
+ iwork[((j) << (1)) - 1] = iwork[j] / 2;
+/* L20: */
+ }
+ ++tlvls;
+ subpbs <<= 1;
+ goto L10;
+ }
+ i__1 = subpbs;
+ for (j = 2; j <= i__1; ++j) {
+ iwork[j] += iwork[j - 1];
+/* L30: */
+ }
+
+/*
+ Divide the matrix into SUBPBS submatrices of size at most SMLSIZ+1
+ using rank-1 modifications (cuts).
+*/
+
+ spm1 = subpbs - 1;
+ i__1 = spm1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ submat = iwork[i__] + 1;
+ smm1 = submat - 1;
+ d__[smm1] -= (d__1 = e[smm1], abs(d__1));
+ d__[submat] -= (d__1 = e[smm1], abs(d__1));
+/* L40: */
+ }
+
+ indxq = ((*n) << (2)) + 3;
+ if (*icompq != 2) {
+
+/*
+ Set up workspaces for eigenvalues only/accumulate new vectors
+ routine
+*/
+
+ temp = log((doublereal) (*n)) / log(2.);
+ lgn = (integer) temp;
+ if (pow_ii(&c__2, &lgn) < *n) {
+ ++lgn;
+ }
+ if (pow_ii(&c__2, &lgn) < *n) {
+ ++lgn;
+ }
+ iprmpt = indxq + *n + 1;
+ iperm = iprmpt + *n * lgn;
+ iqptr = iperm + *n * lgn;
+ igivpt = iqptr + *n + 2;
+ igivcl = igivpt + *n * lgn;
+
+ igivnm = 1;
+ iq = igivnm + ((*n) << (1)) * lgn;
+/* Computing 2nd power */
+ i__1 = *n;
+ iwrem = iq + i__1 * i__1 + 1;
+
+/* Initialize pointers */
+
+ i__1 = subpbs;
+ for (i__ = 0; i__ <= i__1; ++i__) {
+ iwork[iprmpt + i__] = 1;
+ iwork[igivpt + i__] = 1;
+/* L50: */
+ }
+ iwork[iqptr] = 1;
+ }
+
+/*
+ Solve each submatrix eigenproblem at the bottom of the divide and
+ conquer tree.
+*/
+
+ curr = 0;
+ i__1 = spm1;
+ for (i__ = 0; i__ <= i__1; ++i__) {
+ if (i__ == 0) {
+ submat = 1;
+ matsiz = iwork[1];
+ } else {
+ submat = iwork[i__] + 1;
+ matsiz = iwork[i__ + 1] - iwork[i__];
+ }
+ if (*icompq == 2) {
+ dsteqr_("I", &matsiz, &d__[submat], &e[submat], &q[submat +
+ submat * q_dim1], ldq, &work[1], info);
+ if (*info != 0) {
+ goto L130;
+ }
+ } else {
+ dsteqr_("I", &matsiz, &d__[submat], &e[submat], &work[iq - 1 +
+ iwork[iqptr + curr]], &matsiz, &work[1], info);
+ if (*info != 0) {
+ goto L130;
+ }
+ if (*icompq == 1) {
+ dgemm_("N", "N", qsiz, &matsiz, &matsiz, &c_b15, &q[submat *
+ q_dim1 + 1], ldq, &work[iq - 1 + iwork[iqptr + curr]],
+ &matsiz, &c_b29, &qstore[submat * qstore_dim1 + 1],
+ ldqs);
+ }
+/* Computing 2nd power */
+ i__2 = matsiz;
+ iwork[iqptr + curr + 1] = iwork[iqptr + curr] + i__2 * i__2;
+ ++curr;
+ }
+ k = 1;
+ i__2 = iwork[i__ + 1];
+ for (j = submat; j <= i__2; ++j) {
+ iwork[indxq + j] = k;
+ ++k;
+/* L60: */
+ }
+/* L70: */
+ }
+
+/*
+ Successively merge eigensystems of adjacent submatrices
+ into eigensystem for the corresponding larger matrix.
+
+ while ( SUBPBS > 1 )
+*/
+
+ curlvl = 1;
+L80:
+ if (subpbs > 1) {
+ spm2 = subpbs - 2;
+ i__1 = spm2;
+ for (i__ = 0; i__ <= i__1; i__ += 2) {
+ if (i__ == 0) {
+ submat = 1;
+ matsiz = iwork[2];
+ msd2 = iwork[1];
+ curprb = 0;
+ } else {
+ submat = iwork[i__] + 1;
+ matsiz = iwork[i__ + 2] - iwork[i__];
+ msd2 = matsiz / 2;
+ ++curprb;
+ }
+
+/*
+ Merge lower order eigensystems (of size MSD2 and MATSIZ - MSD2)
+ into an eigensystem of size MATSIZ.
+ DLAED1 is used only for the full eigensystem of a tridiagonal
+ matrix.
+ DLAED7 handles the cases in which eigenvalues only or eigenvalues
+ and eigenvectors of a full symmetric matrix (which was reduced to
+ tridiagonal form) are desired.
+*/
+
+ if (*icompq == 2) {
+ dlaed1_(&matsiz, &d__[submat], &q[submat + submat * q_dim1],
+ ldq, &iwork[indxq + submat], &e[submat + msd2 - 1], &
+ msd2, &work[1], &iwork[subpbs + 1], info);
+ } else {
+ dlaed7_(icompq, &matsiz, qsiz, &tlvls, &curlvl, &curprb, &d__[
+ submat], &qstore[submat * qstore_dim1 + 1], ldqs, &
+ iwork[indxq + submat], &e[submat + msd2 - 1], &msd2, &
+ work[iq], &iwork[iqptr], &iwork[iprmpt], &iwork[iperm]
+ , &iwork[igivpt], &iwork[igivcl], &work[igivnm], &
+ work[iwrem], &iwork[subpbs + 1], info);
+ }
+ if (*info != 0) {
+ goto L130;
+ }
+ iwork[i__ / 2 + 1] = iwork[i__ + 2];
+/* L90: */
+ }
+ subpbs /= 2;
+ ++curlvl;
+ goto L80;
+ }
+
+/*
+ end while
+
+ Re-merge the eigenvalues/vectors which were deflated at the final
+ merge step.
+*/
+
+ if (*icompq == 1) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ j = iwork[indxq + i__];
+ work[i__] = d__[j];
+ dcopy_(qsiz, &qstore[j * qstore_dim1 + 1], &c__1, &q[i__ * q_dim1
+ + 1], &c__1);
+/* L100: */
+ }
+ dcopy_(n, &work[1], &c__1, &d__[1], &c__1);
+ } else if (*icompq == 2) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ j = iwork[indxq + i__];
+ work[i__] = d__[j];
+ dcopy_(n, &q[j * q_dim1 + 1], &c__1, &work[*n * i__ + 1], &c__1);
+/* L110: */
+ }
+ dcopy_(n, &work[1], &c__1, &d__[1], &c__1);
+ dlacpy_("A", n, n, &work[*n + 1], n, &q[q_offset], ldq);
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ j = iwork[indxq + i__];
+ work[i__] = d__[j];
+/* L120: */
+ }
+ dcopy_(n, &work[1], &c__1, &d__[1], &c__1);
+ }
+ goto L140;
+
+L130:
+ *info = submat * (*n + 1) + submat + matsiz - 1;
+
+L140:
+ return 0;
+
+/* End of DLAED0 */
+
+} /* dlaed0_ */
+
+/* Subroutine */ int dlaed1_(integer *n, doublereal *d__, doublereal *q,
+ integer *ldq, integer *indxq, doublereal *rho, integer *cutpnt,
+ doublereal *work, integer *iwork, integer *info)
+{
+ /* System generated locals */
+ integer q_dim1, q_offset, i__1, i__2;
+
+ /* Local variables */
+ static integer i__, k, n1, n2, is, iw, iz, iq2, zpp1, indx, indxc;
+ extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
+ doublereal *, integer *);
+ static integer indxp;
+ extern /* Subroutine */ int dlaed2_(integer *, integer *, integer *,
+ doublereal *, doublereal *, integer *, integer *, doublereal *,
+ doublereal *, doublereal *, doublereal *, doublereal *, integer *,
+ integer *, integer *, integer *, integer *), dlaed3_(integer *,
+ integer *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *, doublereal *, doublereal *, integer *, integer *,
+ doublereal *, doublereal *, integer *);
+ static integer idlmda;
+ extern /* Subroutine */ int dlamrg_(integer *, integer *, doublereal *,
+ integer *, integer *, integer *), xerbla_(char *, integer *);
+ static integer coltyp;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DLAED1 computes the updated eigensystem of a diagonal
+ matrix after modification by a rank-one symmetric matrix. This
+ routine is used only for the eigenproblem which requires all
+ eigenvalues and eigenvectors of a tridiagonal matrix. DLAED7 handles
+ the case in which eigenvalues only or eigenvalues and eigenvectors
+ of a full symmetric matrix (which was reduced to tridiagonal form)
+ are desired.
+
+ T = Q(in) ( D(in) + RHO * Z*Z' ) Q'(in) = Q(out) * D(out) * Q'(out)
+
+ where Z = Q'u, u is a vector of length N with ones in the
+ CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.
+
+ The eigenvectors of the original matrix are stored in Q, and the
+ eigenvalues are in D. The algorithm consists of three stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple eigenvalues or if there is a zero in
+ the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine DLAED2.
+
+ The second stage consists of calculating the updated
+ eigenvalues. This is done by finding the roots of the secular
+ equation via the routine DLAED4 (as called by DLAED3).
+ This routine also calculates the eigenvectors of the current
+ problem.
+
+ The final stage consists of computing the updated eigenvectors
+ directly using the updated eigenvalues. The eigenvectors for
+ the current problem are multiplied with the eigenvectors from
+ the overall problem.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the eigenvalues of the rank-1-perturbed matrix.
+ On exit, the eigenvalues of the repaired matrix.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+ On entry, the eigenvectors of the rank-1-perturbed matrix.
+ On exit, the eigenvectors of the repaired tridiagonal matrix.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (input/output) INTEGER array, dimension (N)
+ On entry, the permutation which separately sorts the two
+ subproblems in D into ascending order.
+ On exit, the permutation which will reintegrate the
+ subproblems back into sorted order,
+ i.e. D( INDXQ( I = 1, N ) ) will be in ascending order.
+
+ RHO (input) DOUBLE PRECISION
+ The subdiagonal entry used to create the rank-1 modification.
+
+ CUTPNT (input) INTEGER
+ The location of the last eigenvalue in the leading sub-matrix.
+ min(1,N) <= CUTPNT <= N/2.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N + N**2)
+
+ IWORK (workspace) INTEGER array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ q_dim1 = *ldq;
+ q_offset = 1 + q_dim1 * 1;
+ q -= q_offset;
+ --indxq;
+ --work;
+ --iwork;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*n < 0) {
+ *info = -1;
+ } else if (*ldq < max(1,*n)) {
+ *info = -4;
+ } else /* if(complicated condition) */ {
+/* Computing MIN */
+ i__1 = 1, i__2 = *n / 2;
+ if (min(i__1,i__2) > *cutpnt || *n / 2 < *cutpnt) {
+ *info = -7;
+ }
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLAED1", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+/*
+ The following values are integer pointers which indicate
+ the portion of the workspace
+ used by a particular array in DLAED2 and DLAED3.
+*/
+
+ iz = 1;
+ idlmda = iz + *n;
+ iw = idlmda + *n;
+ iq2 = iw + *n;
+
+ indx = 1;
+ indxc = indx + *n;
+ coltyp = indxc + *n;
+ indxp = coltyp + *n;
+
+
+/*
+ Form the z-vector which consists of the last row of Q_1 and the
+ first row of Q_2.
+*/
+
+ dcopy_(cutpnt, &q[*cutpnt + q_dim1], ldq, &work[iz], &c__1);
+ zpp1 = *cutpnt + 1;
+ i__1 = *n - *cutpnt;
+ dcopy_(&i__1, &q[zpp1 + zpp1 * q_dim1], ldq, &work[iz + *cutpnt], &c__1);
+
+/* Deflate eigenvalues. */
+
+ dlaed2_(&k, n, cutpnt, &d__[1], &q[q_offset], ldq, &indxq[1], rho, &work[
+ iz], &work[idlmda], &work[iw], &work[iq2], &iwork[indx], &iwork[
+ indxc], &iwork[indxp], &iwork[coltyp], info);
+
+ if (*info != 0) {
+ goto L20;
+ }
+
+/* Solve Secular Equation. */
+
+ if (k != 0) {
+ is = (iwork[coltyp] + iwork[coltyp + 1]) * *cutpnt + (iwork[coltyp +
+ 1] + iwork[coltyp + 2]) * (*n - *cutpnt) + iq2;
+ dlaed3_(&k, n, cutpnt, &d__[1], &q[q_offset], ldq, rho, &work[idlmda],
+ &work[iq2], &iwork[indxc], &iwork[coltyp], &work[iw], &work[
+ is], info);
+ if (*info != 0) {
+ goto L20;
+ }
+
+/* Prepare the INDXQ sorting permutation. */
+
+ n1 = k;
+ n2 = *n - k;
+ dlamrg_(&n1, &n2, &d__[1], &c__1, &c_n1, &indxq[1]);
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ indxq[i__] = i__;
+/* L10: */
+ }
+ }
+
+L20:
+ return 0;
+
+/* End of DLAED1 */
+
+} /* dlaed1_ */
+
+/* Subroutine */ int dlaed2_(integer *k, integer *n, integer *n1, doublereal *
+ d__, doublereal *q, integer *ldq, integer *indxq, doublereal *rho,
+ doublereal *z__, doublereal *dlamda, doublereal *w, doublereal *q2,
+ integer *indx, integer *indxc, integer *indxp, integer *coltyp,
+ integer *info)
+{
+ /* System generated locals */
+ integer q_dim1, q_offset, i__1, i__2;
+ doublereal d__1, d__2, d__3, d__4;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static doublereal c__;
+ static integer i__, j;
+ static doublereal s, t;
+ static integer k2, n2, ct, nj, pj, js, iq1, iq2, n1p1;
+ static doublereal eps, tau, tol;
+ static integer psm[4], imax, jmax;
+ extern /* Subroutine */ int drot_(integer *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *);
+ static integer ctot[4];
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *), dcopy_(integer *, doublereal *, integer *, doublereal
+ *, integer *);
+
+ extern integer idamax_(integer *, doublereal *, integer *);
+ extern /* Subroutine */ int dlamrg_(integer *, integer *, doublereal *,
+ integer *, integer *, integer *), dlacpy_(char *, integer *,
+ integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1999
+
+
+ Purpose
+ =======
+
+ DLAED2 merges the two sets of eigenvalues together into a single
+ sorted set. Then it tries to deflate the size of the problem.
+ There are two ways in which deflation can occur: when two or more
+ eigenvalues are close together or if there is a tiny entry in the
+ Z vector. For each such occurrence the order of the related secular
+ equation problem is reduced by one.
+
+ Arguments
+ =========
+
+ K (output) INTEGER
+ The number of non-deflated eigenvalues, and the order of the
+ related secular equation. 0 <= K <=N.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ N1 (input) INTEGER
+ The location of the last eigenvalue in the leading sub-matrix.
+ min(1,N) <= N1 <= N/2.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, D contains the eigenvalues of the two submatrices to
+ be combined.
+ On exit, D contains the trailing (N-K) updated eigenvalues
+ (those which were deflated) sorted into increasing order.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
+ On entry, Q contains the eigenvectors of two submatrices in
+ the two square blocks with corners at (1,1), (N1,N1)
+ and (N1+1, N1+1), (N,N).
+ On exit, Q contains the trailing (N-K) updated eigenvectors
+ (those which were deflated) in its last N-K columns.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (input/output) INTEGER array, dimension (N)
+ The permutation which separately sorts the two sub-problems
+ in D into ascending order. Note that elements in the second
+ half of this permutation must first have N1 added to their
+ values. Destroyed on exit.
+
+ RHO (input/output) DOUBLE PRECISION
+ On entry, the off-diagonal element associated with the rank-1
+ cut which originally split the two submatrices which are now
+ being recombined.
+ On exit, RHO has been modified to the value required by
+ DLAED3.
+
+ Z (input) DOUBLE PRECISION array, dimension (N)
+ On entry, Z contains the updating vector (the last
+ row of the first sub-eigenvector matrix and the first row of
+ the second sub-eigenvector matrix).
+ On exit, the contents of Z have been destroyed by the updating
+ process.
+
+ DLAMDA (output) DOUBLE PRECISION array, dimension (N)
+ A copy of the first K eigenvalues which will be used by
+ DLAED3 to form the secular equation.
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first k values of the final deflation-altered z-vector
+ which will be passed to DLAED3.
+
+ Q2 (output) DOUBLE PRECISION array, dimension (N1**2+(N-N1)**2)
+ A copy of the first K eigenvectors which will be used by
+ DLAED3 in a matrix multiply (DGEMM) to solve for the new
+ eigenvectors.
+
+ INDX (workspace) INTEGER array, dimension (N)
+ The permutation used to sort the contents of DLAMDA into
+ ascending order.
+
+ INDXC (output) INTEGER array, dimension (N)
+ The permutation used to arrange the columns of the deflated
+ Q matrix into three groups: the first group contains non-zero
+ elements only at and above N1, the second contains
+ non-zero elements only below N1, and the third is dense.
+
+ INDXP (workspace) INTEGER array, dimension (N)
+ The permutation used to place deflated values of D at the end
+ of the array. INDXP(1:K) points to the nondeflated D-values
+ and INDXP(K+1:N) points to the deflated eigenvalues.
+
+ COLTYP (workspace/output) INTEGER array, dimension (N)
+ During execution, a label which will indicate which of the
+ following types a column in the Q2 matrix is:
+ 1 : non-zero in the upper half only;
+ 2 : dense;
+ 3 : non-zero in the lower half only;
+ 4 : deflated.
+ On exit, COLTYP(i) is the number of columns of type i,
+ for i=1 to 4 only.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ q_dim1 = *ldq;
+ q_offset = 1 + q_dim1 * 1;
+ q -= q_offset;
+ --indxq;
+ --z__;
+ --dlamda;
+ --w;
+ --q2;
+ --indx;
+ --indxc;
+ --indxp;
+ --coltyp;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*n < 0) {
+ *info = -2;
+ } else if (*ldq < max(1,*n)) {
+ *info = -6;
+ } else /* if(complicated condition) */ {
+/* Computing MIN */
+ i__1 = 1, i__2 = *n / 2;
+ if (min(i__1,i__2) > *n1 || *n / 2 < *n1) {
+ *info = -3;
+ }
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLAED2", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+ n2 = *n - *n1;
+ n1p1 = *n1 + 1;
+
+ if (*rho < 0.) {
+ dscal_(&n2, &c_b151, &z__[n1p1], &c__1);
+ }
+
+/*
+ Normalize z so that norm(z) = 1. Since z is the concatenation of
+ two normalized vectors, norm2(z) = sqrt(2).
+*/
+
+ t = 1. / sqrt(2.);
+ dscal_(n, &t, &z__[1], &c__1);
+
+/* RHO = ABS( norm(z)**2 * RHO ) */
+
+ *rho = (d__1 = *rho * 2., abs(d__1));
+
+/* Sort the eigenvalues into increasing order */
+
+ i__1 = *n;
+ for (i__ = n1p1; i__ <= i__1; ++i__) {
+ indxq[i__] += *n1;
+/* L10: */
+ }
+
+/* re-integrate the deflated parts from the last pass */
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dlamda[i__] = d__[indxq[i__]];
+/* L20: */
+ }
+ dlamrg_(n1, &n2, &dlamda[1], &c__1, &c__1, &indxc[1]);
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ indx[i__] = indxq[indxc[i__]];
+/* L30: */
+ }
+
+/* Calculate the allowable deflation tolerance */
+
+ imax = idamax_(n, &z__[1], &c__1);
+ jmax = idamax_(n, &d__[1], &c__1);
+ eps = EPSILON;
+/* Computing MAX */
+ d__3 = (d__1 = d__[jmax], abs(d__1)), d__4 = (d__2 = z__[imax], abs(d__2))
+ ;
+ tol = eps * 8. * max(d__3,d__4);
+
+/*
+ If the rank-1 modifier is small enough, no more needs to be done
+ except to reorganize Q so that its columns correspond with the
+ elements in D.
+*/
+
+ if (*rho * (d__1 = z__[imax], abs(d__1)) <= tol) {
+ *k = 0;
+ iq2 = 1;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__ = indx[j];
+ dcopy_(n, &q[i__ * q_dim1 + 1], &c__1, &q2[iq2], &c__1);
+ dlamda[j] = d__[i__];
+ iq2 += *n;
+/* L40: */
+ }
+ dlacpy_("A", n, n, &q2[1], n, &q[q_offset], ldq);
+ dcopy_(n, &dlamda[1], &c__1, &d__[1], &c__1);
+ goto L190;
+ }
+
+/*
+ If there are multiple eigenvalues then the problem deflates. Here
+ the number of equal eigenvalues are found. As each equal
+ eigenvalue is found, an elementary reflector is computed to rotate
+ the corresponding eigensubspace so that the corresponding
+ components of Z are zero in this new basis.
+*/
+
+ i__1 = *n1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ coltyp[i__] = 1;
+/* L50: */
+ }
+ i__1 = *n;
+ for (i__ = n1p1; i__ <= i__1; ++i__) {
+ coltyp[i__] = 3;
+/* L60: */
+ }
+
+
+ *k = 0;
+ k2 = *n + 1;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ nj = indx[j];
+ if (*rho * (d__1 = z__[nj], abs(d__1)) <= tol) {
+
+/* Deflate due to small z component. */
+
+ --k2;
+ coltyp[nj] = 4;
+ indxp[k2] = nj;
+ if (j == *n) {
+ goto L100;
+ }
+ } else {
+ pj = nj;
+ goto L80;
+ }
+/* L70: */
+ }
+L80:
+ ++j;
+ nj = indx[j];
+ if (j > *n) {
+ goto L100;
+ }
+ if (*rho * (d__1 = z__[nj], abs(d__1)) <= tol) {
+
+/* Deflate due to small z component. */
+
+ --k2;
+ coltyp[nj] = 4;
+ indxp[k2] = nj;
+ } else {
+
+/* Check if eigenvalues are close enough to allow deflation. */
+
+ s = z__[pj];
+ c__ = z__[nj];
+
+/*
+ Find sqrt(a**2+b**2) without overflow or
+ destructive underflow.
+*/
+
+ tau = dlapy2_(&c__, &s);
+ t = d__[nj] - d__[pj];
+ c__ /= tau;
+ s = -s / tau;
+ if ((d__1 = t * c__ * s, abs(d__1)) <= tol) {
+
+/* Deflation is possible. */
+
+ z__[nj] = tau;
+ z__[pj] = 0.;
+ if (coltyp[nj] != coltyp[pj]) {
+ coltyp[nj] = 2;
+ }
+ coltyp[pj] = 4;
+ drot_(n, &q[pj * q_dim1 + 1], &c__1, &q[nj * q_dim1 + 1], &c__1, &
+ c__, &s);
+/* Computing 2nd power */
+ d__1 = c__;
+/* Computing 2nd power */
+ d__2 = s;
+ t = d__[pj] * (d__1 * d__1) + d__[nj] * (d__2 * d__2);
+/* Computing 2nd power */
+ d__1 = s;
+/* Computing 2nd power */
+ d__2 = c__;
+ d__[nj] = d__[pj] * (d__1 * d__1) + d__[nj] * (d__2 * d__2);
+ d__[pj] = t;
+ --k2;
+ i__ = 1;
+L90:
+ if (k2 + i__ <= *n) {
+ if (d__[pj] < d__[indxp[k2 + i__]]) {
+ indxp[k2 + i__ - 1] = indxp[k2 + i__];
+ indxp[k2 + i__] = pj;
+ ++i__;
+ goto L90;
+ } else {
+ indxp[k2 + i__ - 1] = pj;
+ }
+ } else {
+ indxp[k2 + i__ - 1] = pj;
+ }
+ pj = nj;
+ } else {
+ ++(*k);
+ dlamda[*k] = d__[pj];
+ w[*k] = z__[pj];
+ indxp[*k] = pj;
+ pj = nj;
+ }
+ }
+ goto L80;
+L100:
+
+/* Record the last eigenvalue. */
+
+ ++(*k);
+ dlamda[*k] = d__[pj];
+ w[*k] = z__[pj];
+ indxp[*k] = pj;
+
+/*
+ Count up the total number of the various types of columns, then
+ form a permutation which positions the four column types into
+ four uniform groups (although one or more of these groups may be
+ empty).
+*/
+
+ for (j = 1; j <= 4; ++j) {
+ ctot[j - 1] = 0;
+/* L110: */
+ }
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ ct = coltyp[j];
+ ++ctot[ct - 1];
+/* L120: */
+ }
+
+/* PSM(*) = Position in SubMatrix (of types 1 through 4) */
+
+ psm[0] = 1;
+ psm[1] = ctot[0] + 1;
+ psm[2] = psm[1] + ctot[1];
+ psm[3] = psm[2] + ctot[2];
+ *k = *n - ctot[3];
+
+/*
+ Fill out the INDXC array so that the permutation which it induces
+ will place all type-1 columns first, all type-2 columns next,
+ then all type-3's, and finally all type-4's.
+*/
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ js = indxp[j];
+ ct = coltyp[js];
+ indx[psm[ct - 1]] = js;
+ indxc[psm[ct - 1]] = j;
+ ++psm[ct - 1];
+/* L130: */
+ }
+
+/*
+ Sort the eigenvalues and corresponding eigenvectors into DLAMDA
+ and Q2 respectively. The eigenvalues/vectors which were not
+ deflated go into the first K slots of DLAMDA and Q2 respectively,
+ while those which were deflated go into the last N - K slots.
+*/
+
+ i__ = 1;
+ iq1 = 1;
+ iq2 = (ctot[0] + ctot[1]) * *n1 + 1;
+ i__1 = ctot[0];
+ for (j = 1; j <= i__1; ++j) {
+ js = indx[i__];
+ dcopy_(n1, &q[js * q_dim1 + 1], &c__1, &q2[iq1], &c__1);
+ z__[i__] = d__[js];
+ ++i__;
+ iq1 += *n1;
+/* L140: */
+ }
+
+ i__1 = ctot[1];
+ for (j = 1; j <= i__1; ++j) {
+ js = indx[i__];
+ dcopy_(n1, &q[js * q_dim1 + 1], &c__1, &q2[iq1], &c__1);
+ dcopy_(&n2, &q[*n1 + 1 + js * q_dim1], &c__1, &q2[iq2], &c__1);
+ z__[i__] = d__[js];
+ ++i__;
+ iq1 += *n1;
+ iq2 += n2;
+/* L150: */
+ }
+
+ i__1 = ctot[2];
+ for (j = 1; j <= i__1; ++j) {
+ js = indx[i__];
+ dcopy_(&n2, &q[*n1 + 1 + js * q_dim1], &c__1, &q2[iq2], &c__1);
+ z__[i__] = d__[js];
+ ++i__;
+ iq2 += n2;
+/* L160: */
+ }
+
+ iq1 = iq2;
+ i__1 = ctot[3];
+ for (j = 1; j <= i__1; ++j) {
+ js = indx[i__];
+ dcopy_(n, &q[js * q_dim1 + 1], &c__1, &q2[iq2], &c__1);
+ iq2 += *n;
+ z__[i__] = d__[js];
+ ++i__;
+/* L170: */
+ }
+
+/*
+ The deflated eigenvalues and their corresponding vectors go back
+ into the last N - K slots of D and Q respectively.
+*/
+
+ dlacpy_("A", n, &ctot[3], &q2[iq1], n, &q[(*k + 1) * q_dim1 + 1], ldq);
+ i__1 = *n - *k;
+ dcopy_(&i__1, &z__[*k + 1], &c__1, &d__[*k + 1], &c__1);
+
+/* Copy CTOT into COLTYP for referencing in DLAED3. */
+
+ for (j = 1; j <= 4; ++j) {
+ coltyp[j] = ctot[j - 1];
+/* L180: */
+ }
+
+L190:
+ return 0;
+
+/* End of DLAED2 */
+
+} /* dlaed2_ */
+
+/* Subroutine */ int dlaed3_(integer *k, integer *n, integer *n1, doublereal *
+ d__, doublereal *q, integer *ldq, doublereal *rho, doublereal *dlamda,
+ doublereal *q2, integer *indx, integer *ctot, doublereal *w,
+ doublereal *s, integer *info)
+{
+ /* System generated locals */
+ integer q_dim1, q_offset, i__1, i__2;
+ doublereal d__1;
+
+ /* Builtin functions */
+ double sqrt(doublereal), d_sign(doublereal *, doublereal *);
+
+ /* Local variables */
+ static integer i__, j, n2, n12, ii, n23, iq2;
+ static doublereal temp;
+ extern doublereal dnrm2_(integer *, doublereal *, integer *);
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *),
+ dcopy_(integer *, doublereal *, integer *, doublereal *, integer
+ *), dlaed4_(integer *, integer *, doublereal *, doublereal *,
+ doublereal *, doublereal *, doublereal *, integer *);
+ extern doublereal dlamc3_(doublereal *, doublereal *);
+ extern /* Subroutine */ int dlacpy_(char *, integer *, integer *,
+ doublereal *, integer *, doublereal *, integer *),
+ dlaset_(char *, integer *, integer *, doublereal *, doublereal *,
+ doublereal *, integer *), xerbla_(char *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Oak Ridge National Lab, Argonne National Lab,
+ Courant Institute, NAG Ltd., and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DLAED3 finds the roots of the secular equation, as defined by the
+ values in D, W, and RHO, between 1 and K. It makes the
+ appropriate calls to DLAED4 and then updates the eigenvectors by
+ multiplying the matrix of eigenvectors of the pair of eigensystems
+ being combined by the matrix of eigenvectors of the K-by-K system
+ which is solved here.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ K (input) INTEGER
+ The number of terms in the rational function to be solved by
+ DLAED4. K >= 0.
+
+ N (input) INTEGER
+ The number of rows and columns in the Q matrix.
+ N >= K (deflation may result in N>K).
+
+ N1 (input) INTEGER
+ The location of the last eigenvalue in the leading submatrix.
+ min(1,N) <= N1 <= N/2.
+
+ D (output) DOUBLE PRECISION array, dimension (N)
+ D(I) contains the updated eigenvalues for
+ 1 <= I <= K.
+
+ Q (output) DOUBLE PRECISION array, dimension (LDQ,N)
+ Initially the first K columns are used as workspace.
+ On output the columns 1 to K contain
+ the updated eigenvectors.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ RHO (input) DOUBLE PRECISION
+ The value of the parameter in the rank one update equation.
+ RHO >= 0 required.
+
+ DLAMDA (input/output) DOUBLE PRECISION array, dimension (K)
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation. May be changed on output by
+ having lowest order bit set to zero on Cray X-MP, Cray Y-MP,
+ Cray-2, or Cray C-90, as described above.
+
+ Q2 (input) DOUBLE PRECISION array, dimension (LDQ2, N)
+ The first K columns of this matrix contain the non-deflated
+ eigenvectors for the split problem.
+
+ INDX (input) INTEGER array, dimension (N)
+ The permutation used to arrange the columns of the deflated
+ Q matrix into three groups (see DLAED2).
+ The rows of the eigenvectors found by DLAED4 must be likewise
+ permuted before the matrix multiply can take place.
+
+ CTOT (input) INTEGER array, dimension (4)
+ A count of the total number of the various types of columns
+ in Q, as described in INDX. The fourth column type is any
+ column which has been deflated.
+
+ W (input/output) DOUBLE PRECISION array, dimension (K)
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating vector. Destroyed on
+ output.
+
+ S (workspace) DOUBLE PRECISION array, dimension (N1 + 1)*K
+ Will contain the eigenvectors of the repaired matrix which
+ will be multiplied by the previously accumulated eigenvectors
+ to update the system.
+
+ LDS (input) INTEGER
+ The leading dimension of S. LDS >= max(1,K).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ q_dim1 = *ldq;
+ q_offset = 1 + q_dim1 * 1;
+ q -= q_offset;
+ --dlamda;
+ --q2;
+ --indx;
+ --ctot;
+ --w;
+ --s;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*k < 0) {
+ *info = -1;
+ } else if (*n < *k) {
+ *info = -2;
+ } else if (*ldq < max(1,*n)) {
+ *info = -6;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLAED3", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*k == 0) {
+ return 0;
+ }
+
+/*
+ Modify values DLAMDA(i) to make sure all DLAMDA(i)-DLAMDA(j) can
+ be computed with high relative accuracy (barring over/underflow).
+ This is a problem on machines without a guard digit in
+ add/subtract (Cray XMP, Cray YMP, Cray C 90 and Cray 2).
+ The following code replaces DLAMDA(I) by 2*DLAMDA(I)-DLAMDA(I),
+ which on any of these machines zeros out the bottommost
+ bit of DLAMDA(I) if it is 1; this makes the subsequent
+ subtractions DLAMDA(I)-DLAMDA(J) unproblematic when cancellation
+ occurs. On binary machines with a guard digit (almost all
+ machines) it does not change DLAMDA(I) at all. On hexadecimal
+ and decimal machines with a guard digit, it slightly
+ changes the bottommost bits of DLAMDA(I). It does not account
+ for hexadecimal or decimal machines without guard digits
+ (we know of none). We use a subroutine call to compute
+ 2*DLAMBDA(I) to prevent optimizing compilers from eliminating
+ this code.
+*/
+
+ i__1 = *k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dlamda[i__] = dlamc3_(&dlamda[i__], &dlamda[i__]) - dlamda[i__];
+/* L10: */
+ }
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dlaed4_(k, &j, &dlamda[1], &w[1], &q[j * q_dim1 + 1], rho, &d__[j],
+ info);
+
+/* If the zero finder fails, the computation is terminated. */
+
+ if (*info != 0) {
+ goto L120;
+ }
+/* L20: */
+ }
+
+ if (*k == 1) {
+ goto L110;
+ }
+ if (*k == 2) {
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ w[1] = q[j * q_dim1 + 1];
+ w[2] = q[j * q_dim1 + 2];
+ ii = indx[1];
+ q[j * q_dim1 + 1] = w[ii];
+ ii = indx[2];
+ q[j * q_dim1 + 2] = w[ii];
+/* L30: */
+ }
+ goto L110;
+ }
+
+/* Compute updated W. */
+
+ dcopy_(k, &w[1], &c__1, &s[1], &c__1);
+
+/* Initialize W(I) = Q(I,I) */
+
+ i__1 = *ldq + 1;
+ dcopy_(k, &q[q_offset], &i__1, &w[1], &c__1);
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ w[i__] *= q[i__ + j * q_dim1] / (dlamda[i__] - dlamda[j]);
+/* L40: */
+ }
+ i__2 = *k;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ w[i__] *= q[i__ + j * q_dim1] / (dlamda[i__] - dlamda[j]);
+/* L50: */
+ }
+/* L60: */
+ }
+ i__1 = *k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ d__1 = sqrt(-w[i__]);
+ w[i__] = d_sign(&d__1, &s[i__]);
+/* L70: */
+ }
+
+/* Compute eigenvectors of the modified rank-1 modification. */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *k;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ s[i__] = w[i__] / q[i__ + j * q_dim1];
+/* L80: */
+ }
+ temp = dnrm2_(k, &s[1], &c__1);
+ i__2 = *k;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ ii = indx[i__];
+ q[i__ + j * q_dim1] = s[ii] / temp;
+/* L90: */
+ }
+/* L100: */
+ }
+
+/* Compute the updated eigenvectors. */
+
+L110:
+
+ n2 = *n - *n1;
+ n12 = ctot[1] + ctot[2];
+ n23 = ctot[2] + ctot[3];
+
+ dlacpy_("A", &n23, k, &q[ctot[1] + 1 + q_dim1], ldq, &s[1], &n23);
+ iq2 = *n1 * n12 + 1;
+ if (n23 != 0) {
+ dgemm_("N", "N", &n2, k, &n23, &c_b15, &q2[iq2], &n2, &s[1], &n23, &
+ c_b29, &q[*n1 + 1 + q_dim1], ldq);
+ } else {
+ dlaset_("A", &n2, k, &c_b29, &c_b29, &q[*n1 + 1 + q_dim1], ldq);
+ }
+
+ dlacpy_("A", &n12, k, &q[q_offset], ldq, &s[1], &n12);
+ if (n12 != 0) {
+ dgemm_("N", "N", n1, k, &n12, &c_b15, &q2[1], n1, &s[1], &n12, &c_b29,
+ &q[q_offset], ldq);
+ } else {
+ dlaset_("A", n1, k, &c_b29, &c_b29, &q[q_dim1 + 1], ldq);
+ }
+
+
+L120:
+ return 0;
+
+/* End of DLAED3 */
+
+} /* dlaed3_ */
+
+/* Subroutine */ int dlaed4_(integer *n, integer *i__, doublereal *d__,
+ doublereal *z__, doublereal *delta, doublereal *rho, doublereal *dlam,
+ integer *info)
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static doublereal a, b, c__;
+ static integer j;
+ static doublereal w;
+ static integer ii;
+ static doublereal dw, zz[3];
+ static integer ip1;
+ static doublereal del, eta, phi, eps, tau, psi;
+ static integer iim1, iip1;
+ static doublereal dphi, dpsi;
+ static integer iter;
+ static doublereal temp, prew, temp1, dltlb, dltub, midpt;
+ static integer niter;
+ static logical swtch;
+ extern /* Subroutine */ int dlaed5_(integer *, doublereal *, doublereal *,
+ doublereal *, doublereal *, doublereal *), dlaed6_(integer *,
+ logical *, doublereal *, doublereal *, doublereal *, doublereal *,
+ doublereal *, integer *);
+ static logical swtch3;
+
+ static logical orgati;
+ static doublereal erretm, rhoinv;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Oak Ridge National Lab, Argonne National Lab,
+ Courant Institute, NAG Ltd., and Rice University
+ December 23, 1999
+
+
+ Purpose
+ =======
+
+ This subroutine computes the I-th updated eigenvalue of a symmetric
+ rank-one modification to a diagonal matrix whose elements are
+ given in the array d, and that
+
+ D(i) < D(j) for i < j
+
+ and that RHO > 0. This is arranged by the calling routine, and is
+ no loss in generality. The rank-one modified system is thus
+
+ diag( D ) + RHO * Z * Z_transpose.
+
+ where we assume the Euclidean norm of Z is 1.
+
+ The method consists of approximating the rational functions in the
+ secular equation by simpler interpolating rational functions.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The length of all arrays.
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. 1 <= I <= N.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The original eigenvalues. It is assumed that they are in
+ order, D(I) < D(J) for I < J.
+
+ Z (input) DOUBLE PRECISION array, dimension (N)
+ The components of the updating vector.
+
+ DELTA (output) DOUBLE PRECISION array, dimension (N)
+ If N .ne. 1, DELTA contains (D(j) - lambda_I) in its j-th
+ component. If N = 1, then DELTA(1) = 1. The vector DELTA
+ contains the information necessary to construct the
+ eigenvectors.
+
+ RHO (input) DOUBLE PRECISION
+ The scalar in the symmetric updating formula.
+
+ DLAM (output) DOUBLE PRECISION
+ The computed lambda_I, the I-th updated eigenvalue.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = 1, the updating process failed.
+
+ Internal Parameters
+ ===================
+
+ Logical variable ORGATI (origin-at-i?) is used for distinguishing
+ whether D(i) or D(i+1) is treated as the origin.
+
+ ORGATI = .true. origin at i
+ ORGATI = .false. origin at i+1
+
+ Logical variable SWTCH3 (switch-for-3-poles?) is for noting
+ if we are working with THREE poles!
+
+ MAXIT is the maximum number of iterations allowed for each
+ eigenvalue.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+
+ Since this routine is called in an inner loop, we do no argument
+ checking.
+
+ Quick return for N=1 and 2.
+*/
+
+ /* Parameter adjustments */
+ --delta;
+ --z__;
+ --d__;
+
+ /* Function Body */
+ *info = 0;
+ if (*n == 1) {
+
+/* Presumably, I=1 upon entry */
+
+ *dlam = d__[1] + *rho * z__[1] * z__[1];
+ delta[1] = 1.;
+ return 0;
+ }
+ if (*n == 2) {
+ dlaed5_(i__, &d__[1], &z__[1], &delta[1], rho, dlam);
+ return 0;
+ }
+
+/* Compute machine epsilon */
+
+ eps = EPSILON;
+ rhoinv = 1. / *rho;
+
+/* The case I = N */
+
+ if (*i__ == *n) {
+
+/* Initialize some basic variables */
+
+ ii = *n - 1;
+ niter = 1;
+
+/* Calculate initial guess */
+
+ midpt = *rho / 2.;
+
+/*
+ If ||Z||_2 is not one, then TEMP should be set to
+ RHO * ||Z||_2^2 / TWO
+*/
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ delta[j] = d__[j] - d__[*i__] - midpt;
+/* L10: */
+ }
+
+ psi = 0.;
+ i__1 = *n - 2;
+ for (j = 1; j <= i__1; ++j) {
+ psi += z__[j] * z__[j] / delta[j];
+/* L20: */
+ }
+
+ c__ = rhoinv + psi;
+ w = c__ + z__[ii] * z__[ii] / delta[ii] + z__[*n] * z__[*n] / delta[*
+ n];
+
+ if (w <= 0.) {
+ temp = z__[*n - 1] * z__[*n - 1] / (d__[*n] - d__[*n - 1] + *rho)
+ + z__[*n] * z__[*n] / *rho;
+ if (c__ <= temp) {
+ tau = *rho;
+ } else {
+ del = d__[*n] - d__[*n - 1];
+ a = -c__ * del + z__[*n - 1] * z__[*n - 1] + z__[*n] * z__[*n]
+ ;
+ b = z__[*n] * z__[*n] * del;
+ if (a < 0.) {
+ tau = b * 2. / (sqrt(a * a + b * 4. * c__) - a);
+ } else {
+ tau = (a + sqrt(a * a + b * 4. * c__)) / (c__ * 2.);
+ }
+ }
+
+/*
+ It can be proved that
+ D(N)+RHO/2 <= LAMBDA(N) < D(N)+TAU <= D(N)+RHO
+*/
+
+ dltlb = midpt;
+ dltub = *rho;
+ } else {
+ del = d__[*n] - d__[*n - 1];
+ a = -c__ * del + z__[*n - 1] * z__[*n - 1] + z__[*n] * z__[*n];
+ b = z__[*n] * z__[*n] * del;
+ if (a < 0.) {
+ tau = b * 2. / (sqrt(a * a + b * 4. * c__) - a);
+ } else {
+ tau = (a + sqrt(a * a + b * 4. * c__)) / (c__ * 2.);
+ }
+
+/*
+ It can be proved that
+ D(N) < D(N)+TAU < LAMBDA(N) < D(N)+RHO/2
+*/
+
+ dltlb = 0.;
+ dltub = midpt;
+ }
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ delta[j] = d__[j] - d__[*i__] - tau;
+/* L30: */
+ }
+
+/* Evaluate PSI and the derivative DPSI */
+
+ dpsi = 0.;
+ psi = 0.;
+ erretm = 0.;
+ i__1 = ii;
+ for (j = 1; j <= i__1; ++j) {
+ temp = z__[j] / delta[j];
+ psi += z__[j] * temp;
+ dpsi += temp * temp;
+ erretm += psi;
+/* L40: */
+ }
+ erretm = abs(erretm);
+
+/* Evaluate PHI and the derivative DPHI */
+
+ temp = z__[*n] / delta[*n];
+ phi = z__[*n] * temp;
+ dphi = temp * temp;
+ erretm = (-phi - psi) * 8. + erretm - phi + rhoinv + abs(tau) * (dpsi
+ + dphi);
+
+ w = rhoinv + phi + psi;
+
+/* Test for convergence */
+
+ if (abs(w) <= eps * erretm) {
+ *dlam = d__[*i__] + tau;
+ goto L250;
+ }
+
+ if (w <= 0.) {
+ dltlb = max(dltlb,tau);
+ } else {
+ dltub = min(dltub,tau);
+ }
+
+/* Calculate the new step */
+
+ ++niter;
+ c__ = w - delta[*n - 1] * dpsi - delta[*n] * dphi;
+ a = (delta[*n - 1] + delta[*n]) * w - delta[*n - 1] * delta[*n] * (
+ dpsi + dphi);
+ b = delta[*n - 1] * delta[*n] * w;
+ if (c__ < 0.) {
+ c__ = abs(c__);
+ }
+ if (c__ == 0.) {
+/*
+ ETA = B/A
+ ETA = RHO - TAU
+*/
+ eta = dltub - tau;
+ } else if (a >= 0.) {
+ eta = (a + sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))) / (c__
+ * 2.);
+ } else {
+ eta = b * 2. / (a - sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))
+ );
+ }
+
+/*
+ Note, eta should be positive if w is negative, and
+ eta should be negative otherwise. However,
+ if for some reason caused by roundoff, eta*w > 0,
+ we simply use one Newton step instead. This way
+ will guarantee eta*w < 0.
+*/
+
+ if (w * eta > 0.) {
+ eta = -w / (dpsi + dphi);
+ }
+ temp = tau + eta;
+ if (temp > dltub || temp < dltlb) {
+ if (w < 0.) {
+ eta = (dltub - tau) / 2.;
+ } else {
+ eta = (dltlb - tau) / 2.;
+ }
+ }
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ delta[j] -= eta;
+/* L50: */
+ }
+
+ tau += eta;
+
+/* Evaluate PSI and the derivative DPSI */
+
+ dpsi = 0.;
+ psi = 0.;
+ erretm = 0.;
+ i__1 = ii;
+ for (j = 1; j <= i__1; ++j) {
+ temp = z__[j] / delta[j];
+ psi += z__[j] * temp;
+ dpsi += temp * temp;
+ erretm += psi;
+/* L60: */
+ }
+ erretm = abs(erretm);
+
+/* Evaluate PHI and the derivative DPHI */
+
+ temp = z__[*n] / delta[*n];
+ phi = z__[*n] * temp;
+ dphi = temp * temp;
+ erretm = (-phi - psi) * 8. + erretm - phi + rhoinv + abs(tau) * (dpsi
+ + dphi);
+
+ w = rhoinv + phi + psi;
+
+/* Main loop to update the values of the array DELTA */
+
+ iter = niter + 1;
+
+ for (niter = iter; niter <= 30; ++niter) {
+
+/* Test for convergence */
+
+ if (abs(w) <= eps * erretm) {
+ *dlam = d__[*i__] + tau;
+ goto L250;
+ }
+
+ if (w <= 0.) {
+ dltlb = max(dltlb,tau);
+ } else {
+ dltub = min(dltub,tau);
+ }
+
+/* Calculate the new step */
+
+ c__ = w - delta[*n - 1] * dpsi - delta[*n] * dphi;
+ a = (delta[*n - 1] + delta[*n]) * w - delta[*n - 1] * delta[*n] *
+ (dpsi + dphi);
+ b = delta[*n - 1] * delta[*n] * w;
+ if (a >= 0.) {
+ eta = (a + sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))) / (
+ c__ * 2.);
+ } else {
+ eta = b * 2. / (a - sqrt((d__1 = a * a - b * 4. * c__, abs(
+ d__1))));
+ }
+
+/*
+ Note, eta should be positive if w is negative, and
+ eta should be negative otherwise. However,
+ if for some reason caused by roundoff, eta*w > 0,
+ we simply use one Newton step instead. This way
+ will guarantee eta*w < 0.
+*/
+
+ if (w * eta > 0.) {
+ eta = -w / (dpsi + dphi);
+ }
+ temp = tau + eta;
+ if (temp > dltub || temp < dltlb) {
+ if (w < 0.) {
+ eta = (dltub - tau) / 2.;
+ } else {
+ eta = (dltlb - tau) / 2.;
+ }
+ }
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ delta[j] -= eta;
+/* L70: */
+ }
+
+ tau += eta;
+
+/* Evaluate PSI and the derivative DPSI */
+
+ dpsi = 0.;
+ psi = 0.;
+ erretm = 0.;
+ i__1 = ii;
+ for (j = 1; j <= i__1; ++j) {
+ temp = z__[j] / delta[j];
+ psi += z__[j] * temp;
+ dpsi += temp * temp;
+ erretm += psi;
+/* L80: */
+ }
+ erretm = abs(erretm);
+
+/* Evaluate PHI and the derivative DPHI */
+
+ temp = z__[*n] / delta[*n];
+ phi = z__[*n] * temp;
+ dphi = temp * temp;
+ erretm = (-phi - psi) * 8. + erretm - phi + rhoinv + abs(tau) * (
+ dpsi + dphi);
+
+ w = rhoinv + phi + psi;
+/* L90: */
+ }
+
+/* Return with INFO = 1, NITER = MAXIT and not converged */
+
+ *info = 1;
+ *dlam = d__[*i__] + tau;
+ goto L250;
+
+/* End for the case I = N */
+
+ } else {
+
+/* The case for I < N */
+
+ niter = 1;
+ ip1 = *i__ + 1;
+
+/* Calculate initial guess */
+
+ del = d__[ip1] - d__[*i__];
+ midpt = del / 2.;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ delta[j] = d__[j] - d__[*i__] - midpt;
+/* L100: */
+ }
+
+ psi = 0.;
+ i__1 = *i__ - 1;
+ for (j = 1; j <= i__1; ++j) {
+ psi += z__[j] * z__[j] / delta[j];
+/* L110: */
+ }
+
+ phi = 0.;
+ i__1 = *i__ + 2;
+ for (j = *n; j >= i__1; --j) {
+ phi += z__[j] * z__[j] / delta[j];
+/* L120: */
+ }
+ c__ = rhoinv + psi + phi;
+ w = c__ + z__[*i__] * z__[*i__] / delta[*i__] + z__[ip1] * z__[ip1] /
+ delta[ip1];
+
+ if (w > 0.) {
+
+/*
+ d(i)< the ith eigenvalue < (d(i)+d(i+1))/2
+
+ We choose d(i) as origin.
+*/
+
+ orgati = TRUE_;
+ a = c__ * del + z__[*i__] * z__[*i__] + z__[ip1] * z__[ip1];
+ b = z__[*i__] * z__[*i__] * del;
+ if (a > 0.) {
+ tau = b * 2. / (a + sqrt((d__1 = a * a - b * 4. * c__, abs(
+ d__1))));
+ } else {
+ tau = (a - sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))) / (
+ c__ * 2.);
+ }
+ dltlb = 0.;
+ dltub = midpt;
+ } else {
+
+/*
+ (d(i)+d(i+1))/2 <= the ith eigenvalue < d(i+1)
+
+ We choose d(i+1) as origin.
+*/
+
+ orgati = FALSE_;
+ a = c__ * del - z__[*i__] * z__[*i__] - z__[ip1] * z__[ip1];
+ b = z__[ip1] * z__[ip1] * del;
+ if (a < 0.) {
+ tau = b * 2. / (a - sqrt((d__1 = a * a + b * 4. * c__, abs(
+ d__1))));
+ } else {
+ tau = -(a + sqrt((d__1 = a * a + b * 4. * c__, abs(d__1)))) /
+ (c__ * 2.);
+ }
+ dltlb = -midpt;
+ dltub = 0.;
+ }
+
+ if (orgati) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ delta[j] = d__[j] - d__[*i__] - tau;
+/* L130: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ delta[j] = d__[j] - d__[ip1] - tau;
+/* L140: */
+ }
+ }
+ if (orgati) {
+ ii = *i__;
+ } else {
+ ii = *i__ + 1;
+ }
+ iim1 = ii - 1;
+ iip1 = ii + 1;
+
+/* Evaluate PSI and the derivative DPSI */
+
+ dpsi = 0.;
+ psi = 0.;
+ erretm = 0.;
+ i__1 = iim1;
+ for (j = 1; j <= i__1; ++j) {
+ temp = z__[j] / delta[j];
+ psi += z__[j] * temp;
+ dpsi += temp * temp;
+ erretm += psi;
+/* L150: */
+ }
+ erretm = abs(erretm);
+
+/* Evaluate PHI and the derivative DPHI */
+
+ dphi = 0.;
+ phi = 0.;
+ i__1 = iip1;
+ for (j = *n; j >= i__1; --j) {
+ temp = z__[j] / delta[j];
+ phi += z__[j] * temp;
+ dphi += temp * temp;
+ erretm += phi;
+/* L160: */
+ }
+
+ w = rhoinv + phi + psi;
+
+/*
+ W is the value of the secular function with
+ its ii-th element removed.
+*/
+
+ swtch3 = FALSE_;
+ if (orgati) {
+ if (w < 0.) {
+ swtch3 = TRUE_;
+ }
+ } else {
+ if (w > 0.) {
+ swtch3 = TRUE_;
+ }
+ }
+ if (ii == 1 || ii == *n) {
+ swtch3 = FALSE_;
+ }
+
+ temp = z__[ii] / delta[ii];
+ dw = dpsi + dphi + temp * temp;
+ temp = z__[ii] * temp;
+ w += temp;
+ erretm = (phi - psi) * 8. + erretm + rhoinv * 2. + abs(temp) * 3. +
+ abs(tau) * dw;
+
+/* Test for convergence */
+
+ if (abs(w) <= eps * erretm) {
+ if (orgati) {
+ *dlam = d__[*i__] + tau;
+ } else {
+ *dlam = d__[ip1] + tau;
+ }
+ goto L250;
+ }
+
+ if (w <= 0.) {
+ dltlb = max(dltlb,tau);
+ } else {
+ dltub = min(dltub,tau);
+ }
+
+/* Calculate the new step */
+
+ ++niter;
+ if (! swtch3) {
+ if (orgati) {
+/* Computing 2nd power */
+ d__1 = z__[*i__] / delta[*i__];
+ c__ = w - delta[ip1] * dw - (d__[*i__] - d__[ip1]) * (d__1 *
+ d__1);
+ } else {
+/* Computing 2nd power */
+ d__1 = z__[ip1] / delta[ip1];
+ c__ = w - delta[*i__] * dw - (d__[ip1] - d__[*i__]) * (d__1 *
+ d__1);
+ }
+ a = (delta[*i__] + delta[ip1]) * w - delta[*i__] * delta[ip1] *
+ dw;
+ b = delta[*i__] * delta[ip1] * w;
+ if (c__ == 0.) {
+ if (a == 0.) {
+ if (orgati) {
+ a = z__[*i__] * z__[*i__] + delta[ip1] * delta[ip1] *
+ (dpsi + dphi);
+ } else {
+ a = z__[ip1] * z__[ip1] + delta[*i__] * delta[*i__] *
+ (dpsi + dphi);
+ }
+ }
+ eta = b / a;
+ } else if (a <= 0.) {
+ eta = (a - sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))) / (
+ c__ * 2.);
+ } else {
+ eta = b * 2. / (a + sqrt((d__1 = a * a - b * 4. * c__, abs(
+ d__1))));
+ }
+ } else {
+
+/* Interpolation using THREE most relevant poles */
+
+ temp = rhoinv + psi + phi;
+ if (orgati) {
+ temp1 = z__[iim1] / delta[iim1];
+ temp1 *= temp1;
+ c__ = temp - delta[iip1] * (dpsi + dphi) - (d__[iim1] - d__[
+ iip1]) * temp1;
+ zz[0] = z__[iim1] * z__[iim1];
+ zz[2] = delta[iip1] * delta[iip1] * (dpsi - temp1 + dphi);
+ } else {
+ temp1 = z__[iip1] / delta[iip1];
+ temp1 *= temp1;
+ c__ = temp - delta[iim1] * (dpsi + dphi) - (d__[iip1] - d__[
+ iim1]) * temp1;
+ zz[0] = delta[iim1] * delta[iim1] * (dpsi + (dphi - temp1));
+ zz[2] = z__[iip1] * z__[iip1];
+ }
+ zz[1] = z__[ii] * z__[ii];
+ dlaed6_(&niter, &orgati, &c__, &delta[iim1], zz, &w, &eta, info);
+ if (*info != 0) {
+ goto L250;
+ }
+ }
+
+/*
+ Note, eta should be positive if w is negative, and
+ eta should be negative otherwise. However,
+ if for some reason caused by roundoff, eta*w > 0,
+ we simply use one Newton step instead. This way
+ will guarantee eta*w < 0.
+*/
+
+ if (w * eta >= 0.) {
+ eta = -w / dw;
+ }
+ temp = tau + eta;
+ if (temp > dltub || temp < dltlb) {
+ if (w < 0.) {
+ eta = (dltub - tau) / 2.;
+ } else {
+ eta = (dltlb - tau) / 2.;
+ }
+ }
+
+ prew = w;
+
+/* L170: */
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ delta[j] -= eta;
+/* L180: */
+ }
+
+/* Evaluate PSI and the derivative DPSI */
+
+ dpsi = 0.;
+ psi = 0.;
+ erretm = 0.;
+ i__1 = iim1;
+ for (j = 1; j <= i__1; ++j) {
+ temp = z__[j] / delta[j];
+ psi += z__[j] * temp;
+ dpsi += temp * temp;
+ erretm += psi;
+/* L190: */
+ }
+ erretm = abs(erretm);
+
+/* Evaluate PHI and the derivative DPHI */
+
+ dphi = 0.;
+ phi = 0.;
+ i__1 = iip1;
+ for (j = *n; j >= i__1; --j) {
+ temp = z__[j] / delta[j];
+ phi += z__[j] * temp;
+ dphi += temp * temp;
+ erretm += phi;
+/* L200: */
+ }
+
+ temp = z__[ii] / delta[ii];
+ dw = dpsi + dphi + temp * temp;
+ temp = z__[ii] * temp;
+ w = rhoinv + phi + psi + temp;
+ erretm = (phi - psi) * 8. + erretm + rhoinv * 2. + abs(temp) * 3. + (
+ d__1 = tau + eta, abs(d__1)) * dw;
+
+ swtch = FALSE_;
+ if (orgati) {
+ if (-w > abs(prew) / 10.) {
+ swtch = TRUE_;
+ }
+ } else {
+ if (w > abs(prew) / 10.) {
+ swtch = TRUE_;
+ }
+ }
+
+ tau += eta;
+
+/* Main loop to update the values of the array DELTA */
+
+ iter = niter + 1;
+
+ for (niter = iter; niter <= 30; ++niter) {
+
+/* Test for convergence */
+
+ if (abs(w) <= eps * erretm) {
+ if (orgati) {
+ *dlam = d__[*i__] + tau;
+ } else {
+ *dlam = d__[ip1] + tau;
+ }
+ goto L250;
+ }
+
+ if (w <= 0.) {
+ dltlb = max(dltlb,tau);
+ } else {
+ dltub = min(dltub,tau);
+ }
+
+/* Calculate the new step */
+
+ if (! swtch3) {
+ if (! swtch) {
+ if (orgati) {
+/* Computing 2nd power */
+ d__1 = z__[*i__] / delta[*i__];
+ c__ = w - delta[ip1] * dw - (d__[*i__] - d__[ip1]) * (
+ d__1 * d__1);
+ } else {
+/* Computing 2nd power */
+ d__1 = z__[ip1] / delta[ip1];
+ c__ = w - delta[*i__] * dw - (d__[ip1] - d__[*i__]) *
+ (d__1 * d__1);
+ }
+ } else {
+ temp = z__[ii] / delta[ii];
+ if (orgati) {
+ dpsi += temp * temp;
+ } else {
+ dphi += temp * temp;
+ }
+ c__ = w - delta[*i__] * dpsi - delta[ip1] * dphi;
+ }
+ a = (delta[*i__] + delta[ip1]) * w - delta[*i__] * delta[ip1]
+ * dw;
+ b = delta[*i__] * delta[ip1] * w;
+ if (c__ == 0.) {
+ if (a == 0.) {
+ if (! swtch) {
+ if (orgati) {
+ a = z__[*i__] * z__[*i__] + delta[ip1] *
+ delta[ip1] * (dpsi + dphi);
+ } else {
+ a = z__[ip1] * z__[ip1] + delta[*i__] * delta[
+ *i__] * (dpsi + dphi);
+ }
+ } else {
+ a = delta[*i__] * delta[*i__] * dpsi + delta[ip1]
+ * delta[ip1] * dphi;
+ }
+ }
+ eta = b / a;
+ } else if (a <= 0.) {
+ eta = (a - sqrt((d__1 = a * a - b * 4. * c__, abs(d__1))))
+ / (c__ * 2.);
+ } else {
+ eta = b * 2. / (a + sqrt((d__1 = a * a - b * 4. * c__,
+ abs(d__1))));
+ }
+ } else {
+
+/* Interpolation using THREE most relevant poles */
+
+ temp = rhoinv + psi + phi;
+ if (swtch) {
+ c__ = temp - delta[iim1] * dpsi - delta[iip1] * dphi;
+ zz[0] = delta[iim1] * delta[iim1] * dpsi;
+ zz[2] = delta[iip1] * delta[iip1] * dphi;
+ } else {
+ if (orgati) {
+ temp1 = z__[iim1] / delta[iim1];
+ temp1 *= temp1;
+ c__ = temp - delta[iip1] * (dpsi + dphi) - (d__[iim1]
+ - d__[iip1]) * temp1;
+ zz[0] = z__[iim1] * z__[iim1];
+ zz[2] = delta[iip1] * delta[iip1] * (dpsi - temp1 +
+ dphi);
+ } else {
+ temp1 = z__[iip1] / delta[iip1];
+ temp1 *= temp1;
+ c__ = temp - delta[iim1] * (dpsi + dphi) - (d__[iip1]
+ - d__[iim1]) * temp1;
+ zz[0] = delta[iim1] * delta[iim1] * (dpsi + (dphi -
+ temp1));
+ zz[2] = z__[iip1] * z__[iip1];
+ }
+ }
+ dlaed6_(&niter, &orgati, &c__, &delta[iim1], zz, &w, &eta,
+ info);
+ if (*info != 0) {
+ goto L250;
+ }
+ }
+
+/*
+ Note, eta should be positive if w is negative, and
+ eta should be negative otherwise. However,
+ if for some reason caused by roundoff, eta*w > 0,
+ we simply use one Newton step instead. This way
+ will guarantee eta*w < 0.
+*/
+
+ if (w * eta >= 0.) {
+ eta = -w / dw;
+ }
+ temp = tau + eta;
+ if (temp > dltub || temp < dltlb) {
+ if (w < 0.) {
+ eta = (dltub - tau) / 2.;
+ } else {
+ eta = (dltlb - tau) / 2.;
+ }
+ }
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ delta[j] -= eta;
+/* L210: */
+ }
+
+ tau += eta;
+ prew = w;
+
+/* Evaluate PSI and the derivative DPSI */
+
+ dpsi = 0.;
+ psi = 0.;
+ erretm = 0.;
+ i__1 = iim1;
+ for (j = 1; j <= i__1; ++j) {
+ temp = z__[j] / delta[j];
+ psi += z__[j] * temp;
+ dpsi += temp * temp;
+ erretm += psi;
+/* L220: */
+ }
+ erretm = abs(erretm);
+
+/* Evaluate PHI and the derivative DPHI */
+
+ dphi = 0.;
+ phi = 0.;
+ i__1 = iip1;
+ for (j = *n; j >= i__1; --j) {
+ temp = z__[j] / delta[j];
+ phi += z__[j] * temp;
+ dphi += temp * temp;
+ erretm += phi;
+/* L230: */
+ }
+
+ temp = z__[ii] / delta[ii];
+ dw = dpsi + dphi + temp * temp;
+ temp = z__[ii] * temp;
+ w = rhoinv + phi + psi + temp;
+ erretm = (phi - psi) * 8. + erretm + rhoinv * 2. + abs(temp) * 3.
+ + abs(tau) * dw;
+ if ((w * prew > 0. && abs(w) > abs(prew) / 10.)) {
+ swtch = ! swtch;
+ }
+
+/* L240: */
+ }
+
+/* Return with INFO = 1, NITER = MAXIT and not converged */
+
+ *info = 1;
+ if (orgati) {
+ *dlam = d__[*i__] + tau;
+ } else {
+ *dlam = d__[ip1] + tau;
+ }
+
+ }
+
+L250:
+
+ return 0;
+
+/* End of DLAED4 */
+
+} /* dlaed4_ */
+
+/* Subroutine */ int dlaed5_(integer *i__, doublereal *d__, doublereal *z__,
+ doublereal *delta, doublereal *rho, doublereal *dlam)
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static doublereal b, c__, w, del, tau, temp;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Oak Ridge National Lab, Argonne National Lab,
+ Courant Institute, NAG Ltd., and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ This subroutine computes the I-th eigenvalue of a symmetric rank-one
+ modification of a 2-by-2 diagonal matrix
+
+ diag( D ) + RHO * Z * transpose(Z) .
+
+ The diagonal elements in the array D are assumed to satisfy
+
+ D(i) < D(j) for i < j .
+
+ We also assume RHO > 0 and that the Euclidean norm of the vector
+ Z is one.
+
+ Arguments
+ =========
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. I = 1 or I = 2.
+
+ D (input) DOUBLE PRECISION array, dimension (2)
+ The original eigenvalues. We assume D(1) < D(2).
+
+ Z (input) DOUBLE PRECISION array, dimension (2)
+ The components of the updating vector.
+
+ DELTA (output) DOUBLE PRECISION array, dimension (2)
+ The vector DELTA contains the information necessary
+ to construct the eigenvectors.
+
+ RHO (input) DOUBLE PRECISION
+ The scalar in the symmetric updating formula.
+
+ DLAM (output) DOUBLE PRECISION
+ The computed lambda_I, the I-th updated eigenvalue.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ --delta;
+ --z__;
+ --d__;
+
+ /* Function Body */
+ del = d__[2] - d__[1];
+ if (*i__ == 1) {
+ w = *rho * 2. * (z__[2] * z__[2] - z__[1] * z__[1]) / del + 1.;
+ if (w > 0.) {
+ b = del + *rho * (z__[1] * z__[1] + z__[2] * z__[2]);
+ c__ = *rho * z__[1] * z__[1] * del;
+
+/* B > ZERO, always */
+
+ tau = c__ * 2. / (b + sqrt((d__1 = b * b - c__ * 4., abs(d__1))));
+ *dlam = d__[1] + tau;
+ delta[1] = -z__[1] / tau;
+ delta[2] = z__[2] / (del - tau);
+ } else {
+ b = -del + *rho * (z__[1] * z__[1] + z__[2] * z__[2]);
+ c__ = *rho * z__[2] * z__[2] * del;
+ if (b > 0.) {
+ tau = c__ * -2. / (b + sqrt(b * b + c__ * 4.));
+ } else {
+ tau = (b - sqrt(b * b + c__ * 4.)) / 2.;
+ }
+ *dlam = d__[2] + tau;
+ delta[1] = -z__[1] / (del + tau);
+ delta[2] = -z__[2] / tau;
+ }
+ temp = sqrt(delta[1] * delta[1] + delta[2] * delta[2]);
+ delta[1] /= temp;
+ delta[2] /= temp;
+ } else {
+
+/* Now I=2 */
+
+ b = -del + *rho * (z__[1] * z__[1] + z__[2] * z__[2]);
+ c__ = *rho * z__[2] * z__[2] * del;
+ if (b > 0.) {
+ tau = (b + sqrt(b * b + c__ * 4.)) / 2.;
+ } else {
+ tau = c__ * 2. / (-b + sqrt(b * b + c__ * 4.));
+ }
+ *dlam = d__[2] + tau;
+ delta[1] = -z__[1] / (del + tau);
+ delta[2] = -z__[2] / tau;
+ temp = sqrt(delta[1] * delta[1] + delta[2] * delta[2]);
+ delta[1] /= temp;
+ delta[2] /= temp;
+ }
+ return 0;
+
+/* End OF DLAED5 */
+
+} /* dlaed5_ */
+
+/* Subroutine */ int dlaed6_(integer *kniter, logical *orgati, doublereal *
+ rho, doublereal *d__, doublereal *z__, doublereal *finit, doublereal *
+ tau, integer *info)
+{
+ /* Initialized data */
+
+ static logical first = TRUE_;
+
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1, d__2, d__3, d__4;
+
+ /* Builtin functions */
+ double sqrt(doublereal), log(doublereal), pow_di(doublereal *, integer *);
+
+ /* Local variables */
+ static doublereal a, b, c__, f;
+ static integer i__;
+ static doublereal fc, df, ddf, eta, eps, base;
+ static integer iter;
+ static doublereal temp, temp1, temp2, temp3, temp4;
+ static logical scale;
+ static integer niter;
+ static doublereal small1, small2, sminv1, sminv2;
+
+ static doublereal dscale[3], sclfac, zscale[3], erretm, sclinv;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Oak Ridge National Lab, Argonne National Lab,
+ Courant Institute, NAG Ltd., and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DLAED6 computes the positive or negative root (closest to the origin)
+ of
+ z(1) z(2) z(3)
+ f(x) = rho + --------- + ---------- + ---------
+ d(1)-x d(2)-x d(3)-x
+
+ It is assumed that
+
+ if ORGATI = .true. the root is between d(2) and d(3);
+ otherwise it is between d(1) and d(2)
+
+ This routine will be called by DLAED4 when necessary. In most cases,
+ the root sought is the smallest in magnitude, though it might not be
+ in some extremely rare situations.
+
+ Arguments
+ =========
+
+ KNITER (input) INTEGER
+ Refer to DLAED4 for its significance.
+
+ ORGATI (input) LOGICAL
+ If ORGATI is true, the needed root is between d(2) and
+ d(3); otherwise it is between d(1) and d(2). See
+ DLAED4 for further details.
+
+ RHO (input) DOUBLE PRECISION
+ Refer to the equation f(x) above.
+
+ D (input) DOUBLE PRECISION array, dimension (3)
+ D satisfies d(1) < d(2) < d(3).
+
+ Z (input) DOUBLE PRECISION array, dimension (3)
+ Each of the elements in z must be positive.
+
+ FINIT (input) DOUBLE PRECISION
+ The value of f at 0. It is more accurate than the one
+ evaluated inside this routine (if someone wants to do
+ so).
+
+ TAU (output) DOUBLE PRECISION
+ The root of the equation f(x).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = 1, failure to converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+*/
+
+ /* Parameter adjustments */
+ --z__;
+ --d__;
+
+ /* Function Body */
+
+ *info = 0;
+
+ niter = 1;
+ *tau = 0.;
+ if (*kniter == 2) {
+ if (*orgati) {
+ temp = (d__[3] - d__[2]) / 2.;
+ c__ = *rho + z__[1] / (d__[1] - d__[2] - temp);
+ a = c__ * (d__[2] + d__[3]) + z__[2] + z__[3];
+ b = c__ * d__[2] * d__[3] + z__[2] * d__[3] + z__[3] * d__[2];
+ } else {
+ temp = (d__[1] - d__[2]) / 2.;
+ c__ = *rho + z__[3] / (d__[3] - d__[2] - temp);
+ a = c__ * (d__[1] + d__[2]) + z__[1] + z__[2];
+ b = c__ * d__[1] * d__[2] + z__[1] * d__[2] + z__[2] * d__[1];
+ }
+/* Computing MAX */
+ d__1 = abs(a), d__2 = abs(b), d__1 = max(d__1,d__2), d__2 = abs(c__);
+ temp = max(d__1,d__2);
+ a /= temp;
+ b /= temp;
+ c__ /= temp;
+ if (c__ == 0.) {
+ *tau = b / a;
+ } else if (a <= 0.) {
+ *tau = (a - sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))) / (
+ c__ * 2.);
+ } else {
+ *tau = b * 2. / (a + sqrt((d__1 = a * a - b * 4. * c__, abs(d__1))
+ ));
+ }
+ temp = *rho + z__[1] / (d__[1] - *tau) + z__[2] / (d__[2] - *tau) +
+ z__[3] / (d__[3] - *tau);
+ if (abs(*finit) <= abs(temp)) {
+ *tau = 0.;
+ }
+ }
+
+/*
+ On first call to routine, get machine parameters for
+ possible scaling to avoid overflow
+*/
+
+ if (first) {
+ eps = EPSILON;
+ base = BASE;
+ i__1 = (integer) (log(SAFEMINIMUM) / log(base) / 3.);
+ small1 = pow_di(&base, &i__1);
+ sminv1 = 1. / small1;
+ small2 = small1 * small1;
+ sminv2 = sminv1 * sminv1;
+ first = FALSE_;
+ }
+
+/*
+ Determine if scaling of inputs necessary to avoid overflow
+ when computing 1/TEMP**3
+*/
+
+ if (*orgati) {
+/* Computing MIN */
+ d__3 = (d__1 = d__[2] - *tau, abs(d__1)), d__4 = (d__2 = d__[3] - *
+ tau, abs(d__2));
+ temp = min(d__3,d__4);
+ } else {
+/* Computing MIN */
+ d__3 = (d__1 = d__[1] - *tau, abs(d__1)), d__4 = (d__2 = d__[2] - *
+ tau, abs(d__2));
+ temp = min(d__3,d__4);
+ }
+ scale = FALSE_;
+ if (temp <= small1) {
+ scale = TRUE_;
+ if (temp <= small2) {
+
+/* Scale up by power of radix nearest 1/SAFMIN**(2/3) */
+
+ sclfac = sminv2;
+ sclinv = small2;
+ } else {
+
+/* Scale up by power of radix nearest 1/SAFMIN**(1/3) */
+
+ sclfac = sminv1;
+ sclinv = small1;
+ }
+
+/* Scaling up safe because D, Z, TAU scaled elsewhere to be O(1) */
+
+ for (i__ = 1; i__ <= 3; ++i__) {
+ dscale[i__ - 1] = d__[i__] * sclfac;
+ zscale[i__ - 1] = z__[i__] * sclfac;
+/* L10: */
+ }
+ *tau *= sclfac;
+ } else {
+
+/* Copy D and Z to DSCALE and ZSCALE */
+
+ for (i__ = 1; i__ <= 3; ++i__) {
+ dscale[i__ - 1] = d__[i__];
+ zscale[i__ - 1] = z__[i__];
+/* L20: */
+ }
+ }
+
+ fc = 0.;
+ df = 0.;
+ ddf = 0.;
+ for (i__ = 1; i__ <= 3; ++i__) {
+ temp = 1. / (dscale[i__ - 1] - *tau);
+ temp1 = zscale[i__ - 1] * temp;
+ temp2 = temp1 * temp;
+ temp3 = temp2 * temp;
+ fc += temp1 / dscale[i__ - 1];
+ df += temp2;
+ ddf += temp3;
+/* L30: */
+ }
+ f = *finit + *tau * fc;
+
+ if (abs(f) <= 0.) {
+ goto L60;
+ }
+
+/*
+ Iteration begins
+
+ It is not hard to see that
+
+ 1) Iterations will go up monotonically
+ if FINIT < 0;
+
+ 2) Iterations will go down monotonically
+ if FINIT > 0.
+*/
+
+ iter = niter + 1;
+
+ for (niter = iter; niter <= 20; ++niter) {
+
+ if (*orgati) {
+ temp1 = dscale[1] - *tau;
+ temp2 = dscale[2] - *tau;
+ } else {
+ temp1 = dscale[0] - *tau;
+ temp2 = dscale[1] - *tau;
+ }
+ a = (temp1 + temp2) * f - temp1 * temp2 * df;
+ b = temp1 * temp2 * f;
+ c__ = f - (temp1 + temp2) * df + temp1 * temp2 * ddf;
+/* Computing MAX */
+ d__1 = abs(a), d__2 = abs(b), d__1 = max(d__1,d__2), d__2 = abs(c__);
+ temp = max(d__1,d__2);
+ a /= temp;
+ b /= temp;
+ c__ /= temp;
+ if (c__ == 0.) {
+ eta = b / a;
+ } else if (a <= 0.) {
+ eta = (a - sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))) / (c__
+ * 2.);
+ } else {
+ eta = b * 2. / (a + sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))
+ );
+ }
+ if (f * eta >= 0.) {
+ eta = -f / df;
+ }
+
+ temp = eta + *tau;
+ if (*orgati) {
+ if ((eta > 0. && temp >= dscale[2])) {
+ eta = (dscale[2] - *tau) / 2.;
+ }
+ if ((eta < 0. && temp <= dscale[1])) {
+ eta = (dscale[1] - *tau) / 2.;
+ }
+ } else {
+ if ((eta > 0. && temp >= dscale[1])) {
+ eta = (dscale[1] - *tau) / 2.;
+ }
+ if ((eta < 0. && temp <= dscale[0])) {
+ eta = (dscale[0] - *tau) / 2.;
+ }
+ }
+ *tau += eta;
+
+ fc = 0.;
+ erretm = 0.;
+ df = 0.;
+ ddf = 0.;
+ for (i__ = 1; i__ <= 3; ++i__) {
+ temp = 1. / (dscale[i__ - 1] - *tau);
+ temp1 = zscale[i__ - 1] * temp;
+ temp2 = temp1 * temp;
+ temp3 = temp2 * temp;
+ temp4 = temp1 / dscale[i__ - 1];
+ fc += temp4;
+ erretm += abs(temp4);
+ df += temp2;
+ ddf += temp3;
+/* L40: */
+ }
+ f = *finit + *tau * fc;
+ erretm = (abs(*finit) + abs(*tau) * erretm) * 8. + abs(*tau) * df;
+ if (abs(f) <= eps * erretm) {
+ goto L60;
+ }
+/* L50: */
+ }
+ *info = 1;
+L60:
+
+/* Undo scaling */
+
+ if (scale) {
+ *tau *= sclinv;
+ }
+ return 0;
+
+/* End of DLAED6 */
+
+} /* dlaed6_ */
+
+/* Subroutine */ int dlaed7_(integer *icompq, integer *n, integer *qsiz,
+ integer *tlvls, integer *curlvl, integer *curpbm, doublereal *d__,
+ doublereal *q, integer *ldq, integer *indxq, doublereal *rho, integer
+ *cutpnt, doublereal *qstore, integer *qptr, integer *prmptr, integer *
+ perm, integer *givptr, integer *givcol, doublereal *givnum,
+ doublereal *work, integer *iwork, integer *info)
+{
+ /* System generated locals */
+ integer q_dim1, q_offset, i__1, i__2;
+
+ /* Builtin functions */
+ integer pow_ii(integer *, integer *);
+
+ /* Local variables */
+ static integer i__, k, n1, n2, is, iw, iz, iq2, ptr, ldq2, indx, curr;
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *);
+ static integer indxc, indxp;
+ extern /* Subroutine */ int dlaed8_(integer *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, doublereal *,
+ integer *, doublereal *, integer *, integer *, integer *,
+ doublereal *, integer *, integer *, integer *), dlaed9_(integer *,
+ integer *, integer *, integer *, doublereal *, doublereal *,
+ integer *, doublereal *, doublereal *, doublereal *, doublereal *,
+ integer *, integer *), dlaeda_(integer *, integer *, integer *,
+ integer *, integer *, integer *, integer *, integer *, doublereal
+ *, doublereal *, integer *, doublereal *, doublereal *, integer *)
+ ;
+ static integer idlmda;
+ extern /* Subroutine */ int dlamrg_(integer *, integer *, doublereal *,
+ integer *, integer *, integer *), xerbla_(char *, integer *);
+ static integer coltyp;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ DLAED7 computes the updated eigensystem of a diagonal
+ matrix after modification by a rank-one symmetric matrix. This
+ routine is used only for the eigenproblem which requires all
+ eigenvalues and optionally eigenvectors of a dense symmetric matrix
+ that has been reduced to tridiagonal form. DLAED1 handles
+ the case in which all eigenvalues and eigenvectors of a symmetric
+ tridiagonal matrix are desired.
+
+ T = Q(in) ( D(in) + RHO * Z*Z' ) Q'(in) = Q(out) * D(out) * Q'(out)
+
+ where Z = Q'u, u is a vector of length N with ones in the
+ CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.
+
+ The eigenvectors of the original matrix are stored in Q, and the
+ eigenvalues are in D. The algorithm consists of three stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple eigenvalues or if there is a zero in
+ the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine DLAED8.
+
+ The second stage consists of calculating the updated
+ eigenvalues. This is done by finding the roots of the secular
+ equation via the routine DLAED4 (as called by DLAED9).
+ This routine also calculates the eigenvectors of the current
+ problem.
+
+ The final stage consists of computing the updated eigenvectors
+ directly using the updated eigenvalues. The eigenvectors for
+ the current problem are multiplied with the eigenvectors from
+ the overall problem.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ = 0: Compute eigenvalues only.
+ = 1: Compute eigenvectors of original dense symmetric matrix
+ also. On entry, Q contains the orthogonal matrix used
+ to reduce the original matrix to tridiagonal form.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ QSIZ (input) INTEGER
+ The dimension of the orthogonal matrix used to reduce
+ the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
+
+ TLVLS (input) INTEGER
+ The total number of merging levels in the overall divide and
+ conquer tree.
+
+ CURLVL (input) INTEGER
+ The current level in the overall merge routine,
+ 0 <= CURLVL <= TLVLS.
+
+ CURPBM (input) INTEGER
+ The current problem in the current level in the overall
+ merge routine (counting from upper left to lower right).
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the eigenvalues of the rank-1-perturbed matrix.
+ On exit, the eigenvalues of the repaired matrix.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ, N)
+ On entry, the eigenvectors of the rank-1-perturbed matrix.
+ On exit, the eigenvectors of the repaired tridiagonal matrix.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (output) INTEGER array, dimension (N)
+ The permutation which will reintegrate the subproblem just
+ solved back into sorted order, i.e., D( INDXQ( I = 1, N ) )
+ will be in ascending order.
+
+ RHO (input) DOUBLE PRECISION
+ The subdiagonal element used to create the rank-1
+ modification.
+
+ CUTPNT (input) INTEGER
+ Contains the location of the last eigenvalue in the leading
+ sub-matrix. min(1,N) <= CUTPNT <= N.
+
+ QSTORE (input/output) DOUBLE PRECISION array, dimension (N**2+1)
+ Stores eigenvectors of submatrices encountered during
+ divide and conquer, packed together. QPTR points to
+ beginning of the submatrices.
+
+ QPTR (input/output) INTEGER array, dimension (N+2)
+ List of indices pointing to beginning of submatrices stored
+ in QSTORE. The submatrices are numbered starting at the
+ bottom left of the divide and conquer tree, from left to
+ right and bottom to top.
+
+ PRMPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in PERM a
+ level's permutation is stored. PRMPTR(i+1) - PRMPTR(i)
+ indicates the size of the permutation and also the size of
+ the full, non-deflated problem.
+
+ PERM (input) INTEGER array, dimension (N lg N)
+ Contains the permutations (from deflation and sorting) to be
+ applied to each eigenblock.
+
+ GIVPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in GIVCOL a
+ level's Givens rotations are stored. GIVPTR(i+1) - GIVPTR(i)
+ indicates the number of Givens rotations.
+
+ GIVCOL (input) INTEGER array, dimension (2, N lg N)
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation.
+
+ GIVNUM (input) DOUBLE PRECISION array, dimension (2, N lg N)
+ Each number indicates the S value to be used in the
+ corresponding Givens rotation.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N+QSIZ*N)
+
+ IWORK (workspace) INTEGER array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ q_dim1 = *ldq;
+ q_offset = 1 + q_dim1 * 1;
+ q -= q_offset;
+ --indxq;
+ --qstore;
+ --qptr;
+ --prmptr;
+ --perm;
+ --givptr;
+ givcol -= 3;
+ givnum -= 3;
+ --work;
+ --iwork;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*icompq < 0 || *icompq > 1) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if ((*icompq == 1 && *qsiz < *n)) {
+ *info = -4;
+ } else if (*ldq < max(1,*n)) {
+ *info = -9;
+ } else if (min(1,*n) > *cutpnt || *n < *cutpnt) {
+ *info = -12;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLAED7", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+/*
+ The following values are for bookkeeping purposes only. They are
+ integer pointers which indicate the portion of the workspace
+ used by a particular array in DLAED8 and DLAED9.
+*/
+
+ if (*icompq == 1) {
+ ldq2 = *qsiz;
+ } else {
+ ldq2 = *n;
+ }
+
+ iz = 1;
+ idlmda = iz + *n;
+ iw = idlmda + *n;
+ iq2 = iw + *n;
+ is = iq2 + *n * ldq2;
+
+ indx = 1;
+ indxc = indx + *n;
+ coltyp = indxc + *n;
+ indxp = coltyp + *n;
+
+/*
+ Form the z-vector which consists of the last row of Q_1 and the
+ first row of Q_2.
+*/
+
+ ptr = pow_ii(&c__2, tlvls) + 1;
+ i__1 = *curlvl - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = *tlvls - i__;
+ ptr += pow_ii(&c__2, &i__2);
+/* L10: */
+ }
+ curr = ptr + *curpbm;
+ dlaeda_(n, tlvls, curlvl, curpbm, &prmptr[1], &perm[1], &givptr[1], &
+ givcol[3], &givnum[3], &qstore[1], &qptr[1], &work[iz], &work[iz
+ + *n], info);
+
+/*
+ When solving the final problem, we no longer need the stored data,
+ so we will overwrite the data from this level onto the previously
+ used storage space.
+*/
+
+ if (*curlvl == *tlvls) {
+ qptr[curr] = 1;
+ prmptr[curr] = 1;
+ givptr[curr] = 1;
+ }
+
+/* Sort and Deflate eigenvalues. */
+
+ dlaed8_(icompq, &k, n, qsiz, &d__[1], &q[q_offset], ldq, &indxq[1], rho,
+ cutpnt, &work[iz], &work[idlmda], &work[iq2], &ldq2, &work[iw], &
+ perm[prmptr[curr]], &givptr[curr + 1], &givcol[((givptr[curr]) <<
+ (1)) + 1], &givnum[((givptr[curr]) << (1)) + 1], &iwork[indxp], &
+ iwork[indx], info);
+ prmptr[curr + 1] = prmptr[curr] + *n;
+ givptr[curr + 1] += givptr[curr];
+
+/* Solve Secular Equation. */
+
+ if (k != 0) {
+ dlaed9_(&k, &c__1, &k, n, &d__[1], &work[is], &k, rho, &work[idlmda],
+ &work[iw], &qstore[qptr[curr]], &k, info);
+ if (*info != 0) {
+ goto L30;
+ }
+ if (*icompq == 1) {
+ dgemm_("N", "N", qsiz, &k, &k, &c_b15, &work[iq2], &ldq2, &qstore[
+ qptr[curr]], &k, &c_b29, &q[q_offset], ldq);
+ }
+/* Computing 2nd power */
+ i__1 = k;
+ qptr[curr + 1] = qptr[curr] + i__1 * i__1;
+
+/* Prepare the INDXQ sorting permutation. */
+
+ n1 = k;
+ n2 = *n - k;
+ dlamrg_(&n1, &n2, &d__[1], &c__1, &c_n1, &indxq[1]);
+ } else {
+ qptr[curr + 1] = qptr[curr];
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ indxq[i__] = i__;
+/* L20: */
+ }
+ }
+
+L30:
+ return 0;
+
+/* End of DLAED7 */
+
+} /* dlaed7_ */
+
+/* Subroutine */ int dlaed8_(integer *icompq, integer *k, integer *n, integer
+ *qsiz, doublereal *d__, doublereal *q, integer *ldq, integer *indxq,
+ doublereal *rho, integer *cutpnt, doublereal *z__, doublereal *dlamda,
+ doublereal *q2, integer *ldq2, doublereal *w, integer *perm, integer
+ *givptr, integer *givcol, doublereal *givnum, integer *indxp, integer
+ *indx, integer *info)
+{
+ /* System generated locals */
+ integer q_dim1, q_offset, q2_dim1, q2_offset, i__1;
+ doublereal d__1;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static doublereal c__;
+ static integer i__, j;
+ static doublereal s, t;
+ static integer k2, n1, n2, jp, n1p1;
+ static doublereal eps, tau, tol;
+ static integer jlam, imax, jmax;
+ extern /* Subroutine */ int drot_(integer *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *), dscal_(
+ integer *, doublereal *, doublereal *, integer *), dcopy_(integer
+ *, doublereal *, integer *, doublereal *, integer *);
+
+ extern integer idamax_(integer *, doublereal *, integer *);
+ extern /* Subroutine */ int dlamrg_(integer *, integer *, doublereal *,
+ integer *, integer *, integer *), dlacpy_(char *, integer *,
+ integer *, doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Oak Ridge National Lab, Argonne National Lab,
+ Courant Institute, NAG Ltd., and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ DLAED8 merges the two sets of eigenvalues together into a single
+ sorted set. Then it tries to deflate the size of the problem.
+ There are two ways in which deflation can occur: when two or more
+ eigenvalues are close together or if there is a tiny element in the
+ Z vector. For each such occurrence the order of the related secular
+ equation problem is reduced by one.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ = 0: Compute eigenvalues only.
+ = 1: Compute eigenvectors of original dense symmetric matrix
+ also. On entry, Q contains the orthogonal matrix used
+ to reduce the original matrix to tridiagonal form.
+
+ K (output) INTEGER
+ The number of non-deflated eigenvalues, and the order of the
+ related secular equation.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ QSIZ (input) INTEGER
+ The dimension of the orthogonal matrix used to reduce
+ the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the eigenvalues of the two submatrices to be
+ combined. On exit, the trailing (N-K) updated eigenvalues
+ (those which were deflated) sorted into increasing order.
+
+ Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
+ If ICOMPQ = 0, Q is not referenced. Otherwise,
+ on entry, Q contains the eigenvectors of the partially solved
+ system which has been previously updated in matrix
+ multiplies with other partially solved eigensystems.
+ On exit, Q contains the trailing (N-K) updated eigenvectors
+ (those which were deflated) in its last N-K columns.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ INDXQ (input) INTEGER array, dimension (N)
+ The permutation which separately sorts the two sub-problems
+ in D into ascending order. Note that elements in the second
+ half of this permutation must first have CUTPNT added to
+ their values in order to be accurate.
+
+ RHO (input/output) DOUBLE PRECISION
+ On entry, the off-diagonal element associated with the rank-1
+ cut which originally split the two submatrices which are now
+ being recombined.
+ On exit, RHO has been modified to the value required by
+ DLAED3.
+
+ CUTPNT (input) INTEGER
+ The location of the last eigenvalue in the leading
+ sub-matrix. min(1,N) <= CUTPNT <= N.
+
+ Z (input) DOUBLE PRECISION array, dimension (N)
+ On entry, Z contains the updating vector (the last row of
+ the first sub-eigenvector matrix and the first row of the
+ second sub-eigenvector matrix).
+ On exit, the contents of Z are destroyed by the updating
+ process.
+
+ DLAMDA (output) DOUBLE PRECISION array, dimension (N)
+ A copy of the first K eigenvalues which will be used by
+ DLAED3 to form the secular equation.
+
+ Q2 (output) DOUBLE PRECISION array, dimension (LDQ2,N)
+ If ICOMPQ = 0, Q2 is not referenced. Otherwise,
+ a copy of the first K eigenvectors which will be used by
+ DLAED7 in a matrix multiply (DGEMM) to update the new
+ eigenvectors.
+
+ LDQ2 (input) INTEGER
+ The leading dimension of the array Q2. LDQ2 >= max(1,N).
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ The first k values of the final deflation-altered z-vector and
+ will be passed to DLAED3.
+
+ PERM (output) INTEGER array, dimension (N)
+ The permutations (from deflation and sorting) to be applied
+ to each eigenblock.
+
+ GIVPTR (output) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem.
+
+ GIVCOL (output) INTEGER array, dimension (2, N)
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation.
+
+ GIVNUM (output) DOUBLE PRECISION array, dimension (2, N)
+ Each number indicates the S value to be used in the
+ corresponding Givens rotation.
+
+ INDXP (workspace) INTEGER array, dimension (N)
+ The permutation used to place deflated values of D at the end
+ of the array. INDXP(1:K) points to the nondeflated D-values
+ and INDXP(K+1:N) points to the deflated eigenvalues.
+
+ INDX (workspace) INTEGER array, dimension (N)
+ The permutation used to sort the contents of D into ascending
+ order.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ q_dim1 = *ldq;
+ q_offset = 1 + q_dim1 * 1;
+ q -= q_offset;
+ --indxq;
+ --z__;
+ --dlamda;
+ q2_dim1 = *ldq2;
+ q2_offset = 1 + q2_dim1 * 1;
+ q2 -= q2_offset;
+ --w;
+ --perm;
+ givcol -= 3;
+ givnum -= 3;
+ --indxp;
+ --indx;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*icompq < 0 || *icompq > 1) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if ((*icompq == 1 && *qsiz < *n)) {
+ *info = -4;
+ } else if (*ldq < max(1,*n)) {
+ *info = -7;
+ } else if (*cutpnt < min(1,*n) || *cutpnt > *n) {
+ *info = -10;
+ } else if (*ldq2 < max(1,*n)) {
+ *info = -14;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLAED8", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+ n1 = *cutpnt;
+ n2 = *n - n1;
+ n1p1 = n1 + 1;
+
+ if (*rho < 0.) {
+ dscal_(&n2, &c_b151, &z__[n1p1], &c__1);
+ }
+
+/* Normalize z so that norm(z) = 1 */
+
+ t = 1. / sqrt(2.);
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ indx[j] = j;
+/* L10: */
+ }
+ dscal_(n, &t, &z__[1], &c__1);
+ *rho = (d__1 = *rho * 2., abs(d__1));
+
+/* Sort the eigenvalues into increasing order */
+
+ i__1 = *n;
+ for (i__ = *cutpnt + 1; i__ <= i__1; ++i__) {
+ indxq[i__] += *cutpnt;
+/* L20: */
+ }
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dlamda[i__] = d__[indxq[i__]];
+ w[i__] = z__[indxq[i__]];
+/* L30: */
+ }
+ i__ = 1;
+ j = *cutpnt + 1;
+ dlamrg_(&n1, &n2, &dlamda[1], &c__1, &c__1, &indx[1]);
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ d__[i__] = dlamda[indx[i__]];
+ z__[i__] = w[indx[i__]];
+/* L40: */
+ }
+
+/* Calculate the allowable deflation tolerence */
+
+ imax = idamax_(n, &z__[1], &c__1);
+ jmax = idamax_(n, &d__[1], &c__1);
+ eps = EPSILON;
+ tol = eps * 8. * (d__1 = d__[jmax], abs(d__1));
+
+/*
+ If the rank-1 modifier is small enough, no more needs to be done
+ except to reorganize Q so that its columns correspond with the
+ elements in D.
+*/
+
+ if (*rho * (d__1 = z__[imax], abs(d__1)) <= tol) {
+ *k = 0;
+ if (*icompq == 0) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ perm[j] = indxq[indx[j]];
+/* L50: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ perm[j] = indxq[indx[j]];
+ dcopy_(qsiz, &q[perm[j] * q_dim1 + 1], &c__1, &q2[j * q2_dim1
+ + 1], &c__1);
+/* L60: */
+ }
+ dlacpy_("A", qsiz, n, &q2[q2_dim1 + 1], ldq2, &q[q_dim1 + 1], ldq);
+ }
+ return 0;
+ }
+
+/*
+ If there are multiple eigenvalues then the problem deflates. Here
+ the number of equal eigenvalues are found. As each equal
+ eigenvalue is found, an elementary reflector is computed to rotate
+ the corresponding eigensubspace so that the corresponding
+ components of Z are zero in this new basis.
+*/
+
+ *k = 0;
+ *givptr = 0;
+ k2 = *n + 1;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*rho * (d__1 = z__[j], abs(d__1)) <= tol) {
+
+/* Deflate due to small z component. */
+
+ --k2;
+ indxp[k2] = j;
+ if (j == *n) {
+ goto L110;
+ }
+ } else {
+ jlam = j;
+ goto L80;
+ }
+/* L70: */
+ }
+L80:
+ ++j;
+ if (j > *n) {
+ goto L100;
+ }
+ if (*rho * (d__1 = z__[j], abs(d__1)) <= tol) {
+
+/* Deflate due to small z component. */
+
+ --k2;
+ indxp[k2] = j;
+ } else {
+
+/* Check if eigenvalues are close enough to allow deflation. */
+
+ s = z__[jlam];
+ c__ = z__[j];
+
+/*
+ Find sqrt(a**2+b**2) without overflow or
+ destructive underflow.
+*/
+
+ tau = dlapy2_(&c__, &s);
+ t = d__[j] - d__[jlam];
+ c__ /= tau;
+ s = -s / tau;
+ if ((d__1 = t * c__ * s, abs(d__1)) <= tol) {
+
+/* Deflation is possible. */
+
+ z__[j] = tau;
+ z__[jlam] = 0.;
+
+/* Record the appropriate Givens rotation */
+
+ ++(*givptr);
+ givcol[((*givptr) << (1)) + 1] = indxq[indx[jlam]];
+ givcol[((*givptr) << (1)) + 2] = indxq[indx[j]];
+ givnum[((*givptr) << (1)) + 1] = c__;
+ givnum[((*givptr) << (1)) + 2] = s;
+ if (*icompq == 1) {
+ drot_(qsiz, &q[indxq[indx[jlam]] * q_dim1 + 1], &c__1, &q[
+ indxq[indx[j]] * q_dim1 + 1], &c__1, &c__, &s);
+ }
+ t = d__[jlam] * c__ * c__ + d__[j] * s * s;
+ d__[j] = d__[jlam] * s * s + d__[j] * c__ * c__;
+ d__[jlam] = t;
+ --k2;
+ i__ = 1;
+L90:
+ if (k2 + i__ <= *n) {
+ if (d__[jlam] < d__[indxp[k2 + i__]]) {
+ indxp[k2 + i__ - 1] = indxp[k2 + i__];
+ indxp[k2 + i__] = jlam;
+ ++i__;
+ goto L90;
+ } else {
+ indxp[k2 + i__ - 1] = jlam;
+ }
+ } else {
+ indxp[k2 + i__ - 1] = jlam;
+ }
+ jlam = j;
+ } else {
+ ++(*k);
+ w[*k] = z__[jlam];
+ dlamda[*k] = d__[jlam];
+ indxp[*k] = jlam;
+ jlam = j;
+ }
+ }
+ goto L80;
+L100:
+
+/* Record the last eigenvalue. */
+
+ ++(*k);
+ w[*k] = z__[jlam];
+ dlamda[*k] = d__[jlam];
+ indxp[*k] = jlam;
+
+L110:
+
+/*
+ Sort the eigenvalues and corresponding eigenvectors into DLAMDA
+ and Q2 respectively. The eigenvalues/vectors which were not
+ deflated go into the first K slots of DLAMDA and Q2 respectively,
+ while those which were deflated go into the last N - K slots.
+*/
+
+ if (*icompq == 0) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ jp = indxp[j];
+ dlamda[j] = d__[jp];
+ perm[j] = indxq[indx[jp]];
+/* L120: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ jp = indxp[j];
+ dlamda[j] = d__[jp];
+ perm[j] = indxq[indx[jp]];
+ dcopy_(qsiz, &q[perm[j] * q_dim1 + 1], &c__1, &q2[j * q2_dim1 + 1]
+ , &c__1);
+/* L130: */
+ }
+ }
+
+/*
+ The deflated eigenvalues and their corresponding vectors go back
+ into the last N - K slots of D and Q respectively.
+*/
+
+ if (*k < *n) {
+ if (*icompq == 0) {
+ i__1 = *n - *k;
+ dcopy_(&i__1, &dlamda[*k + 1], &c__1, &d__[*k + 1], &c__1);
+ } else {
+ i__1 = *n - *k;
+ dcopy_(&i__1, &dlamda[*k + 1], &c__1, &d__[*k + 1], &c__1);
+ i__1 = *n - *k;
+ dlacpy_("A", qsiz, &i__1, &q2[(*k + 1) * q2_dim1 + 1], ldq2, &q[(*
+ k + 1) * q_dim1 + 1], ldq);
+ }
+ }
+
+ return 0;
+
+/* End of DLAED8 */
+
+} /* dlaed8_ */
+
+/* Subroutine */ int dlaed9_(integer *k, integer *kstart, integer *kstop,
+ integer *n, doublereal *d__, doublereal *q, integer *ldq, doublereal *
+ rho, doublereal *dlamda, doublereal *w, doublereal *s, integer *lds,
+ integer *info)
+{
+ /* System generated locals */
+ integer q_dim1, q_offset, s_dim1, s_offset, i__1, i__2;
+ doublereal d__1;
+
+ /* Builtin functions */
+ double sqrt(doublereal), d_sign(doublereal *, doublereal *);
+
+ /* Local variables */
+ static integer i__, j;
+ static doublereal temp;
+ extern doublereal dnrm2_(integer *, doublereal *, integer *);
+ extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
+ doublereal *, integer *), dlaed4_(integer *, integer *,
+ doublereal *, doublereal *, doublereal *, doublereal *,
+ doublereal *, integer *);
+ extern doublereal dlamc3_(doublereal *, doublereal *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Oak Ridge National Lab, Argonne National Lab,
+ Courant Institute, NAG Ltd., and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ DLAED9 finds the roots of the secular equation, as defined by the
+ values in D, Z, and RHO, between KSTART and KSTOP. It makes the
+ appropriate calls to DLAED4 and then stores the new matrix of
+ eigenvectors for use in calculating the next level of Z vectors.
+
+ Arguments
+ =========
+
+ K (input) INTEGER
+ The number of terms in the rational function to be solved by
+ DLAED4. K >= 0.
+
+ KSTART (input) INTEGER
+ KSTOP (input) INTEGER
+ The updated eigenvalues Lambda(I), KSTART <= I <= KSTOP
+ are to be computed. 1 <= KSTART <= KSTOP <= K.
+
+ N (input) INTEGER
+ The number of rows and columns in the Q matrix.
+ N >= K (delation may result in N > K).
+
+ D (output) DOUBLE PRECISION array, dimension (N)
+ D(I) contains the updated eigenvalues
+ for KSTART <= I <= KSTOP.
+
+ Q (workspace) DOUBLE PRECISION array, dimension (LDQ,N)
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max( 1, N ).
+
+ RHO (input) DOUBLE PRECISION
+ The value of the parameter in the rank one update equation.
+ RHO >= 0 required.
+
+ DLAMDA (input) DOUBLE PRECISION array, dimension (K)
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation.
+
+ W (input) DOUBLE PRECISION array, dimension (K)
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating vector.
+
+ S (output) DOUBLE PRECISION array, dimension (LDS, K)
+ Will contain the eigenvectors of the repaired matrix which
+ will be stored for subsequent Z vector calculation and
+ multiplied by the previously accumulated eigenvectors
+ to update the system.
+
+ LDS (input) INTEGER
+ The leading dimension of S. LDS >= max( 1, K ).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ q_dim1 = *ldq;
+ q_offset = 1 + q_dim1 * 1;
+ q -= q_offset;
+ --dlamda;
+ --w;
+ s_dim1 = *lds;
+ s_offset = 1 + s_dim1 * 1;
+ s -= s_offset;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*k < 0) {
+ *info = -1;
+ } else if (*kstart < 1 || *kstart > max(1,*k)) {
+ *info = -2;
+ } else if (max(1,*kstop) < *kstart || *kstop > max(1,*k)) {
+ *info = -3;
+ } else if (*n < *k) {
+ *info = -4;
+ } else if (*ldq < max(1,*k)) {
+ *info = -7;
+ } else if (*lds < max(1,*k)) {
+ *info = -12;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLAED9", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*k == 0) {
+ return 0;
+ }
+
+/*
+ Modify values DLAMDA(i) to make sure all DLAMDA(i)-DLAMDA(j) can
+ be computed with high relative accuracy (barring over/underflow).
+ This is a problem on machines without a guard digit in
+ add/subtract (Cray XMP, Cray YMP, Cray C 90 and Cray 2).
+ The following code replaces DLAMDA(I) by 2*DLAMDA(I)-DLAMDA(I),
+ which on any of these machines zeros out the bottommost
+ bit of DLAMDA(I) if it is 1; this makes the subsequent
+ subtractions DLAMDA(I)-DLAMDA(J) unproblematic when cancellation
+ occurs. On binary machines with a guard digit (almost all
+ machines) it does not change DLAMDA(I) at all. On hexadecimal
+ and decimal machines with a guard digit, it slightly
+ changes the bottommost bits of DLAMDA(I). It does not account
+ for hexadecimal or decimal machines without guard digits
+ (we know of none). We use a subroutine call to compute
+ 2*DLAMBDA(I) to prevent optimizing compilers from eliminating
+ this code.
+*/
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dlamda[i__] = dlamc3_(&dlamda[i__], &dlamda[i__]) - dlamda[i__];
+/* L10: */
+ }
+
+ i__1 = *kstop;
+ for (j = *kstart; j <= i__1; ++j) {
+ dlaed4_(k, &j, &dlamda[1], &w[1], &q[j * q_dim1 + 1], rho, &d__[j],
+ info);
+
+/* If the zero finder fails, the computation is terminated. */
+
+ if (*info != 0) {
+ goto L120;
+ }
+/* L20: */
+ }
+
+ if (*k == 1 || *k == 2) {
+ i__1 = *k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = *k;
+ for (j = 1; j <= i__2; ++j) {
+ s[j + i__ * s_dim1] = q[j + i__ * q_dim1];
+/* L30: */
+ }
+/* L40: */
+ }
+ goto L120;
+ }
+
+/* Compute updated W. */
+
+ dcopy_(k, &w[1], &c__1, &s[s_offset], &c__1);
+
+/* Initialize W(I) = Q(I,I) */
+
+ i__1 = *ldq + 1;
+ dcopy_(k, &q[q_offset], &i__1, &w[1], &c__1);
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ w[i__] *= q[i__ + j * q_dim1] / (dlamda[i__] - dlamda[j]);
+/* L50: */
+ }
+ i__2 = *k;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ w[i__] *= q[i__ + j * q_dim1] / (dlamda[i__] - dlamda[j]);
+/* L60: */
+ }
+/* L70: */
+ }
+ i__1 = *k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ d__1 = sqrt(-w[i__]);
+ w[i__] = d_sign(&d__1, &s[i__ + s_dim1]);
+/* L80: */
+ }
+
+/* Compute eigenvectors of the modified rank-1 modification. */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *k;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ q[i__ + j * q_dim1] = w[i__] / q[i__ + j * q_dim1];
+/* L90: */
+ }
+ temp = dnrm2_(k, &q[j * q_dim1 + 1], &c__1);
+ i__2 = *k;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ s[i__ + j * s_dim1] = q[i__ + j * q_dim1] / temp;
+/* L100: */
+ }
+/* L110: */
+ }
+
+L120:
+ return 0;
+
+/* End of DLAED9 */
+
+} /* dlaed9_ */
+
+/* Subroutine */ int dlaeda_(integer *n, integer *tlvls, integer *curlvl,
+ integer *curpbm, integer *prmptr, integer *perm, integer *givptr,
+ integer *givcol, doublereal *givnum, doublereal *q, integer *qptr,
+ doublereal *z__, doublereal *ztemp, integer *info)
+{
+ /* System generated locals */
+ integer i__1, i__2, i__3;
+
+ /* Builtin functions */
+ integer pow_ii(integer *, integer *);
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static integer i__, k, mid, ptr;
+ extern /* Subroutine */ int drot_(integer *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *);
+ static integer curr, bsiz1, bsiz2, psiz1, psiz2, zptr1;
+ extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, doublereal *, integer *), dcopy_(integer *,
+ doublereal *, integer *, doublereal *, integer *), xerbla_(char *,
+ integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ DLAEDA computes the Z vector corresponding to the merge step in the
+ CURLVLth step of the merge process with TLVLS steps for the CURPBMth
+ problem.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ TLVLS (input) INTEGER
+ The total number of merging levels in the overall divide and
+ conquer tree.
+
+ CURLVL (input) INTEGER
+ The current level in the overall merge routine,
+ 0 <= curlvl <= tlvls.
+
+ CURPBM (input) INTEGER
+ The current problem in the current level in the overall
+ merge routine (counting from upper left to lower right).
+
+ PRMPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in PERM a
+ level's permutation is stored. PRMPTR(i+1) - PRMPTR(i)
+ indicates the size of the permutation and incidentally the
+ size of the full, non-deflated problem.
+
+ PERM (input) INTEGER array, dimension (N lg N)
+ Contains the permutations (from deflation and sorting) to be
+ applied to each eigenblock.
+
+ GIVPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in GIVCOL a
+ level's Givens rotations are stored. GIVPTR(i+1) - GIVPTR(i)
+ indicates the number of Givens rotations.
+
+ GIVCOL (input) INTEGER array, dimension (2, N lg N)
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation.
+
+ GIVNUM (input) DOUBLE PRECISION array, dimension (2, N lg N)
+ Each number indicates the S value to be used in the
+ corresponding Givens rotation.
+
+ Q (input) DOUBLE PRECISION array, dimension (N**2)
+ Contains the square eigenblocks from previous levels, the
+ starting positions for blocks are given by QPTR.
+
+ QPTR (input) INTEGER array, dimension (N+2)
+ Contains a list of pointers which indicate where in Q an
+ eigenblock is stored. SQRT( QPTR(i+1) - QPTR(i) ) indicates
+ the size of the block.
+
+ Z (output) DOUBLE PRECISION array, dimension (N)
+ On output this vector contains the updating vector (the last
+ row of the first sub-eigenvector matrix and the first row of
+ the second sub-eigenvector matrix).
+
+ ZTEMP (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --ztemp;
+ --z__;
+ --qptr;
+ --q;
+ givnum -= 3;
+ givcol -= 3;
+ --givptr;
+ --perm;
+ --prmptr;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*n < 0) {
+ *info = -1;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLAEDA", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+/* Determine location of first number in second half. */
+
+ mid = *n / 2 + 1;
+
+/* Gather last/first rows of appropriate eigenblocks into center of Z */
+
+ ptr = 1;
+
+/*
+ Determine location of lowest level subproblem in the full storage
+ scheme
+*/
+
+ i__1 = *curlvl - 1;
+ curr = ptr + *curpbm * pow_ii(&c__2, curlvl) + pow_ii(&c__2, &i__1) - 1;
+
+/*
+ Determine size of these matrices. We add HALF to the value of
+ the SQRT in case the machine underestimates one of these square
+ roots.
+*/
+
+ bsiz1 = (integer) (sqrt((doublereal) (qptr[curr + 1] - qptr[curr])) + .5);
+ bsiz2 = (integer) (sqrt((doublereal) (qptr[curr + 2] - qptr[curr + 1])) +
+ .5);
+ i__1 = mid - bsiz1 - 1;
+ for (k = 1; k <= i__1; ++k) {
+ z__[k] = 0.;
+/* L10: */
+ }
+ dcopy_(&bsiz1, &q[qptr[curr] + bsiz1 - 1], &bsiz1, &z__[mid - bsiz1], &
+ c__1);
+ dcopy_(&bsiz2, &q[qptr[curr + 1]], &bsiz2, &z__[mid], &c__1);
+ i__1 = *n;
+ for (k = mid + bsiz2; k <= i__1; ++k) {
+ z__[k] = 0.;
+/* L20: */
+ }
+
+/*
+ Loop thru remaining levels 1 -> CURLVL applying the Givens
+ rotations and permutation and then multiplying the center matrices
+ against the current Z.
+*/
+
+ ptr = pow_ii(&c__2, tlvls) + 1;
+ i__1 = *curlvl - 1;
+ for (k = 1; k <= i__1; ++k) {
+ i__2 = *curlvl - k;
+ i__3 = *curlvl - k - 1;
+ curr = ptr + *curpbm * pow_ii(&c__2, &i__2) + pow_ii(&c__2, &i__3) -
+ 1;
+ psiz1 = prmptr[curr + 1] - prmptr[curr];
+ psiz2 = prmptr[curr + 2] - prmptr[curr + 1];
+ zptr1 = mid - psiz1;
+
+/* Apply Givens at CURR and CURR+1 */
+
+ i__2 = givptr[curr + 1] - 1;
+ for (i__ = givptr[curr]; i__ <= i__2; ++i__) {
+ drot_(&c__1, &z__[zptr1 + givcol[((i__) << (1)) + 1] - 1], &c__1,
+ &z__[zptr1 + givcol[((i__) << (1)) + 2] - 1], &c__1, &
+ givnum[((i__) << (1)) + 1], &givnum[((i__) << (1)) + 2]);
+/* L30: */
+ }
+ i__2 = givptr[curr + 2] - 1;
+ for (i__ = givptr[curr + 1]; i__ <= i__2; ++i__) {
+ drot_(&c__1, &z__[mid - 1 + givcol[((i__) << (1)) + 1]], &c__1, &
+ z__[mid - 1 + givcol[((i__) << (1)) + 2]], &c__1, &givnum[
+ ((i__) << (1)) + 1], &givnum[((i__) << (1)) + 2]);
+/* L40: */
+ }
+ psiz1 = prmptr[curr + 1] - prmptr[curr];
+ psiz2 = prmptr[curr + 2] - prmptr[curr + 1];
+ i__2 = psiz1 - 1;
+ for (i__ = 0; i__ <= i__2; ++i__) {
+ ztemp[i__ + 1] = z__[zptr1 + perm[prmptr[curr] + i__] - 1];
+/* L50: */
+ }
+ i__2 = psiz2 - 1;
+ for (i__ = 0; i__ <= i__2; ++i__) {
+ ztemp[psiz1 + i__ + 1] = z__[mid + perm[prmptr[curr + 1] + i__] -
+ 1];
+/* L60: */
+ }
+
+/*
+ Multiply Blocks at CURR and CURR+1
+
+ Determine size of these matrices. We add HALF to the value of
+ the SQRT in case the machine underestimates one of these
+ square roots.
+*/
+
+ bsiz1 = (integer) (sqrt((doublereal) (qptr[curr + 1] - qptr[curr])) +
+ .5);
+ bsiz2 = (integer) (sqrt((doublereal) (qptr[curr + 2] - qptr[curr + 1])
+ ) + .5);
+ if (bsiz1 > 0) {
+ dgemv_("T", &bsiz1, &bsiz1, &c_b15, &q[qptr[curr]], &bsiz1, &
+ ztemp[1], &c__1, &c_b29, &z__[zptr1], &c__1);
+ }
+ i__2 = psiz1 - bsiz1;
+ dcopy_(&i__2, &ztemp[bsiz1 + 1], &c__1, &z__[zptr1 + bsiz1], &c__1);
+ if (bsiz2 > 0) {
+ dgemv_("T", &bsiz2, &bsiz2, &c_b15, &q[qptr[curr + 1]], &bsiz2, &
+ ztemp[psiz1 + 1], &c__1, &c_b29, &z__[mid], &c__1);
+ }
+ i__2 = psiz2 - bsiz2;
+ dcopy_(&i__2, &ztemp[psiz1 + bsiz2 + 1], &c__1, &z__[mid + bsiz2], &
+ c__1);
+
+ i__2 = *tlvls - k;
+ ptr += pow_ii(&c__2, &i__2);
+/* L70: */
+ }
+
+ return 0;
+
+/* End of DLAEDA */
+
+} /* dlaeda_ */
+
+/* Subroutine */ int dlaev2_(doublereal *a, doublereal *b, doublereal *c__,
+ doublereal *rt1, doublereal *rt2, doublereal *cs1, doublereal *sn1)
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static doublereal ab, df, cs, ct, tb, sm, tn, rt, adf, acs;
+ static integer sgn1, sgn2;
+ static doublereal acmn, acmx;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLAEV2 computes the eigendecomposition of a 2-by-2 symmetric matrix
+ [ A B ]
+ [ B C ].
+ On return, RT1 is the eigenvalue of larger absolute value, RT2 is the
+ eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right
+ eigenvector for RT1, giving the decomposition
+
+ [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ]
+ [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ].
+
+ Arguments
+ =========
+
+ A (input) DOUBLE PRECISION
+ The (1,1) element of the 2-by-2 matrix.
+
+ B (input) DOUBLE PRECISION
+ The (1,2) element and the conjugate of the (2,1) element of
+ the 2-by-2 matrix.
+
+ C (input) DOUBLE PRECISION
+ The (2,2) element of the 2-by-2 matrix.
+
+ RT1 (output) DOUBLE PRECISION
+ The eigenvalue of larger absolute value.
+
+ RT2 (output) DOUBLE PRECISION
+ The eigenvalue of smaller absolute value.
+
+ CS1 (output) DOUBLE PRECISION
+ SN1 (output) DOUBLE PRECISION
+ The vector (CS1, SN1) is a unit right eigenvector for RT1.
+
+ Further Details
+ ===============
+
+ RT1 is accurate to a few ulps barring over/underflow.
+
+ RT2 may be inaccurate if there is massive cancellation in the
+ determinant A*C-B*B; higher precision or correctly rounded or
+ correctly truncated arithmetic would be needed to compute RT2
+ accurately in all cases.
+
+ CS1 and SN1 are accurate to a few ulps barring over/underflow.
+
+ Overflow is possible only if RT1 is within a factor of 5 of overflow.
+ Underflow is harmless if the input data is 0 or exceeds
+ underflow_threshold / macheps.
+
+ =====================================================================
+
+
+ Compute the eigenvalues
+*/
+
+ sm = *a + *c__;
+ df = *a - *c__;
+ adf = abs(df);
+ tb = *b + *b;
+ ab = abs(tb);
+ if (abs(*a) > abs(*c__)) {
+ acmx = *a;
+ acmn = *c__;
+ } else {
+ acmx = *c__;
+ acmn = *a;
+ }
+ if (adf > ab) {
+/* Computing 2nd power */
+ d__1 = ab / adf;
+ rt = adf * sqrt(d__1 * d__1 + 1.);
+ } else if (adf < ab) {
+/* Computing 2nd power */
+ d__1 = adf / ab;
+ rt = ab * sqrt(d__1 * d__1 + 1.);
+ } else {
+
+/* Includes case AB=ADF=0 */
+
+ rt = ab * sqrt(2.);
+ }
+ if (sm < 0.) {
+ *rt1 = (sm - rt) * .5;
+ sgn1 = -1;
+
+/*
+ Order of execution important.
+ To get fully accurate smaller eigenvalue,
+ next line needs to be executed in higher precision.
+*/
+
+ *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
+ } else if (sm > 0.) {
+ *rt1 = (sm + rt) * .5;
+ sgn1 = 1;
+
+/*
+ Order of execution important.
+ To get fully accurate smaller eigenvalue,
+ next line needs to be executed in higher precision.
+*/
+
+ *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
+ } else {
+
+/* Includes case RT1 = RT2 = 0 */
+
+ *rt1 = rt * .5;
+ *rt2 = rt * -.5;
+ sgn1 = 1;
+ }
+
+/* Compute the eigenvector */
+
+ if (df >= 0.) {
+ cs = df + rt;
+ sgn2 = 1;
+ } else {
+ cs = df - rt;
+ sgn2 = -1;
+ }
+ acs = abs(cs);
+ if (acs > ab) {
+ ct = -tb / cs;
+ *sn1 = 1. / sqrt(ct * ct + 1.);
+ *cs1 = ct * *sn1;
+ } else {
+ if (ab == 0.) {
+ *cs1 = 1.;
+ *sn1 = 0.;
+ } else {
+ tn = -cs / tb;
+ *cs1 = 1. / sqrt(tn * tn + 1.);
+ *sn1 = tn * *cs1;
+ }
+ }
+ if (sgn1 == sgn2) {
+ tn = *cs1;
+ *cs1 = -(*sn1);
+ *sn1 = tn;
+ }
+ return 0;
+
+/* End of DLAEV2 */
+
+} /* dlaev2_ */
+
+/* Subroutine */ int dlahqr_(logical *wantt, logical *wantz, integer *n,
+ integer *ilo, integer *ihi, doublereal *h__, integer *ldh, doublereal
+ *wr, doublereal *wi, integer *iloz, integer *ihiz, doublereal *z__,
+ integer *ldz, integer *info)
+{
+ /* System generated locals */
+ integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4;
+ doublereal d__1, d__2;
+
+ /* Builtin functions */
+ double sqrt(doublereal), d_sign(doublereal *, doublereal *);
+
+ /* Local variables */
+ static integer i__, j, k, l, m;
+ static doublereal s, v[3];
+ static integer i1, i2;
+ static doublereal t1, t2, t3, v1, v2, v3, h00, h10, h11, h12, h21, h22,
+ h33, h44;
+ static integer nh;
+ static doublereal cs;
+ static integer nr;
+ static doublereal sn;
+ static integer nz;
+ static doublereal ave, h33s, h44s;
+ static integer itn, its;
+ static doublereal ulp, sum, tst1, h43h34, disc, unfl, ovfl;
+ extern /* Subroutine */ int drot_(integer *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *);
+ static doublereal work[1];
+ extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
+ doublereal *, integer *), dlanv2_(doublereal *, doublereal *,
+ doublereal *, doublereal *, doublereal *, doublereal *,
+ doublereal *, doublereal *, doublereal *, doublereal *), dlabad_(
+ doublereal *, doublereal *);
+
+ extern /* Subroutine */ int dlarfg_(integer *, doublereal *, doublereal *,
+ integer *, doublereal *);
+ extern doublereal dlanhs_(char *, integer *, doublereal *, integer *,
+ doublereal *);
+ static doublereal smlnum;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DLAHQR is an auxiliary routine called by DHSEQR to update the
+ eigenvalues and Schur decomposition already computed by DHSEQR, by
+ dealing with the Hessenberg submatrix in rows and columns ILO to IHI.
+
+ Arguments
+ =========
+
+ WANTT (input) LOGICAL
+ = .TRUE. : the full Schur form T is required;
+ = .FALSE.: only eigenvalues are required.
+
+ WANTZ (input) LOGICAL
+ = .TRUE. : the matrix of Schur vectors Z is required;
+ = .FALSE.: Schur vectors are not required.
+
+ N (input) INTEGER
+ The order of the matrix H. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper quasi-triangular in
+ rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless
+ ILO = 1). DLAHQR works primarily with the Hessenberg
+ submatrix in rows and columns ILO to IHI, but applies
+ transformations to all of H if WANTT is .TRUE..
+ 1 <= ILO <= max(1,IHI); IHI <= N.
+
+ H (input/output) DOUBLE PRECISION array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if WANTT is .TRUE., H is upper quasi-triangular in
+ rows and columns ILO:IHI, with any 2-by-2 diagonal blocks in
+ standard form. If WANTT is .FALSE., the contents of H are
+ unspecified on exit.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max(1,N).
+
+ WR (output) DOUBLE PRECISION array, dimension (N)
+ WI (output) DOUBLE PRECISION array, dimension (N)
+ The real and imaginary parts, respectively, of the computed
+ eigenvalues ILO to IHI are stored in the corresponding
+ elements of WR and WI. If two eigenvalues are computed as a
+ complex conjugate pair, they are stored in consecutive
+ elements of WR and WI, say the i-th and (i+1)th, with
+ WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the
+ eigenvalues are stored in the same order as on the diagonal
+ of the Schur form returned in H, with WR(i) = H(i,i), and, if
+ H(i:i+1,i:i+1) is a 2-by-2 diagonal block,
+ WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i).
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE..
+ 1 <= ILOZ <= ILO; IHI <= IHIZ <= N.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+ If WANTZ is .TRUE., on entry Z must contain the current
+ matrix Z of transformations accumulated by DHSEQR, and on
+ exit Z has been updated; transformations are applied only to
+ the submatrix Z(ILOZ:IHIZ,ILO:IHI).
+ If WANTZ is .FALSE., Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: DLAHQR failed to compute all the eigenvalues ILO to IHI
+ in a total of 30*(IHI-ILO+1) iterations; if INFO = i,
+ elements i+1:ihi of WR and WI contain those eigenvalues
+ which have been successfully computed.
+
+ Further Details
+ ===============
+
+ 2-96 Based on modifications by
+ David Day, Sandia National Laboratory, USA
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ h_dim1 = *ldh;
+ h_offset = 1 + h_dim1 * 1;
+ h__ -= h_offset;
+ --wr;
+ --wi;
+ z_dim1 = *ldz;
+ z_offset = 1 + z_dim1 * 1;
+ z__ -= z_offset;
+
+ /* Function Body */
+ *info = 0;
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+ if (*ilo == *ihi) {
+ wr[*ilo] = h__[*ilo + *ilo * h_dim1];
+ wi[*ilo] = 0.;
+ return 0;
+ }
+
+ nh = *ihi - *ilo + 1;
+ nz = *ihiz - *iloz + 1;
+
+/*
+ Set machine-dependent constants for the stopping criterion.
+ If norm(H) <= sqrt(OVFL), overflow should not occur.
+*/
+
+ unfl = SAFEMINIMUM;
+ ovfl = 1. / unfl;
+ dlabad_(&unfl, &ovfl);
+ ulp = PRECISION;
+ smlnum = unfl * (nh / ulp);
+
+/*
+ I1 and I2 are the indices of the first row and last column of H
+ to which transformations must be applied. If eigenvalues only are
+ being computed, I1 and I2 are set inside the main loop.
+*/
+
+ if (*wantt) {
+ i1 = 1;
+ i2 = *n;
+ }
+
+/* ITN is the total number of QR iterations allowed. */
+
+ itn = nh * 30;
+
+/*
+ The main loop begins here. I is the loop index and decreases from
+ IHI to ILO in steps of 1 or 2. Each iteration of the loop works
+ with the active submatrix in rows and columns L to I.
+ Eigenvalues I+1 to IHI have already converged. Either L = ILO or
+ H(L,L-1) is negligible so that the matrix splits.
+*/
+
+ i__ = *ihi;
+L10:
+ l = *ilo;
+ if (i__ < *ilo) {
+ goto L150;
+ }
+
+/*
+ Perform QR iterations on rows and columns ILO to I until a
+ submatrix of order 1 or 2 splits off at the bottom because a
+ subdiagonal element has become negligible.
+*/
+
+ i__1 = itn;
+ for (its = 0; its <= i__1; ++its) {
+
+/* Look for a single small subdiagonal element. */
+
+ i__2 = l + 1;
+ for (k = i__; k >= i__2; --k) {
+ tst1 = (d__1 = h__[k - 1 + (k - 1) * h_dim1], abs(d__1)) + (d__2 =
+ h__[k + k * h_dim1], abs(d__2));
+ if (tst1 == 0.) {
+ i__3 = i__ - l + 1;
+ tst1 = dlanhs_("1", &i__3, &h__[l + l * h_dim1], ldh, work);
+ }
+/* Computing MAX */
+ d__2 = ulp * tst1;
+ if ((d__1 = h__[k + (k - 1) * h_dim1], abs(d__1)) <= max(d__2,
+ smlnum)) {
+ goto L30;
+ }
+/* L20: */
+ }
+L30:
+ l = k;
+ if (l > *ilo) {
+
+/* H(L,L-1) is negligible */
+
+ h__[l + (l - 1) * h_dim1] = 0.;
+ }
+
+/* Exit from loop if a submatrix of order 1 or 2 has split off. */
+
+ if (l >= i__ - 1) {
+ goto L140;
+ }
+
+/*
+ Now the active submatrix is in rows and columns L to I. If
+ eigenvalues only are being computed, only the active submatrix
+ need be transformed.
+*/
+
+ if (! (*wantt)) {
+ i1 = l;
+ i2 = i__;
+ }
+
+ if (its == 10 || its == 20) {
+
+/* Exceptional shift. */
+
+ s = (d__1 = h__[i__ + (i__ - 1) * h_dim1], abs(d__1)) + (d__2 =
+ h__[i__ - 1 + (i__ - 2) * h_dim1], abs(d__2));
+ h44 = s * .75 + h__[i__ + i__ * h_dim1];
+ h33 = h44;
+ h43h34 = s * -.4375 * s;
+ } else {
+
+/*
+ Prepare to use Francis' double shift
+ (i.e. 2nd degree generalized Rayleigh quotient)
+*/
+
+ h44 = h__[i__ + i__ * h_dim1];
+ h33 = h__[i__ - 1 + (i__ - 1) * h_dim1];
+ h43h34 = h__[i__ + (i__ - 1) * h_dim1] * h__[i__ - 1 + i__ *
+ h_dim1];
+ s = h__[i__ - 1 + (i__ - 2) * h_dim1] * h__[i__ - 1 + (i__ - 2) *
+ h_dim1];
+ disc = (h33 - h44) * .5;
+ disc = disc * disc + h43h34;
+ if (disc > 0.) {
+
+/* Real roots: use Wilkinson's shift twice */
+
+ disc = sqrt(disc);
+ ave = (h33 + h44) * .5;
+ if (abs(h33) - abs(h44) > 0.) {
+ h33 = h33 * h44 - h43h34;
+ h44 = h33 / (d_sign(&disc, &ave) + ave);
+ } else {
+ h44 = d_sign(&disc, &ave) + ave;
+ }
+ h33 = h44;
+ h43h34 = 0.;
+ }
+ }
+
+/* Look for two consecutive small subdiagonal elements. */
+
+ i__2 = l;
+ for (m = i__ - 2; m >= i__2; --m) {
+/*
+ Determine the effect of starting the double-shift QR
+ iteration at row M, and see if this would make H(M,M-1)
+ negligible.
+*/
+
+ h11 = h__[m + m * h_dim1];
+ h22 = h__[m + 1 + (m + 1) * h_dim1];
+ h21 = h__[m + 1 + m * h_dim1];
+ h12 = h__[m + (m + 1) * h_dim1];
+ h44s = h44 - h11;
+ h33s = h33 - h11;
+ v1 = (h33s * h44s - h43h34) / h21 + h12;
+ v2 = h22 - h11 - h33s - h44s;
+ v3 = h__[m + 2 + (m + 1) * h_dim1];
+ s = abs(v1) + abs(v2) + abs(v3);
+ v1 /= s;
+ v2 /= s;
+ v3 /= s;
+ v[0] = v1;
+ v[1] = v2;
+ v[2] = v3;
+ if (m == l) {
+ goto L50;
+ }
+ h00 = h__[m - 1 + (m - 1) * h_dim1];
+ h10 = h__[m + (m - 1) * h_dim1];
+ tst1 = abs(v1) * (abs(h00) + abs(h11) + abs(h22));
+ if (abs(h10) * (abs(v2) + abs(v3)) <= ulp * tst1) {
+ goto L50;
+ }
+/* L40: */
+ }
+L50:
+
+/* Double-shift QR step */
+
+ i__2 = i__ - 1;
+ for (k = m; k <= i__2; ++k) {
+
+/*
+ The first iteration of this loop determines a reflection G
+ from the vector V and applies it from left and right to H,
+ thus creating a nonzero bulge below the subdiagonal.
+
+ Each subsequent iteration determines a reflection G to
+ restore the Hessenberg form in the (K-1)th column, and thus
+ chases the bulge one step toward the bottom of the active
+ submatrix. NR is the order of G.
+
+ Computing MIN
+*/
+ i__3 = 3, i__4 = i__ - k + 1;
+ nr = min(i__3,i__4);
+ if (k > m) {
+ dcopy_(&nr, &h__[k + (k - 1) * h_dim1], &c__1, v, &c__1);
+ }
+ dlarfg_(&nr, v, &v[1], &c__1, &t1);
+ if (k > m) {
+ h__[k + (k - 1) * h_dim1] = v[0];
+ h__[k + 1 + (k - 1) * h_dim1] = 0.;
+ if (k < i__ - 1) {
+ h__[k + 2 + (k - 1) * h_dim1] = 0.;
+ }
+ } else if (m > l) {
+ h__[k + (k - 1) * h_dim1] = -h__[k + (k - 1) * h_dim1];
+ }
+ v2 = v[1];
+ t2 = t1 * v2;
+ if (nr == 3) {
+ v3 = v[2];
+ t3 = t1 * v3;
+
+/*
+ Apply G from the left to transform the rows of the matrix
+ in columns K to I2.
+*/
+
+ i__3 = i2;
+ for (j = k; j <= i__3; ++j) {
+ sum = h__[k + j * h_dim1] + v2 * h__[k + 1 + j * h_dim1]
+ + v3 * h__[k + 2 + j * h_dim1];
+ h__[k + j * h_dim1] -= sum * t1;
+ h__[k + 1 + j * h_dim1] -= sum * t2;
+ h__[k + 2 + j * h_dim1] -= sum * t3;
+/* L60: */
+ }
+
+/*
+ Apply G from the right to transform the columns of the
+ matrix in rows I1 to min(K+3,I).
+
+ Computing MIN
+*/
+ i__4 = k + 3;
+ i__3 = min(i__4,i__);
+ for (j = i1; j <= i__3; ++j) {
+ sum = h__[j + k * h_dim1] + v2 * h__[j + (k + 1) * h_dim1]
+ + v3 * h__[j + (k + 2) * h_dim1];
+ h__[j + k * h_dim1] -= sum * t1;
+ h__[j + (k + 1) * h_dim1] -= sum * t2;
+ h__[j + (k + 2) * h_dim1] -= sum * t3;
+/* L70: */
+ }
+
+ if (*wantz) {
+
+/* Accumulate transformations in the matrix Z */
+
+ i__3 = *ihiz;
+ for (j = *iloz; j <= i__3; ++j) {
+ sum = z__[j + k * z_dim1] + v2 * z__[j + (k + 1) *
+ z_dim1] + v3 * z__[j + (k + 2) * z_dim1];
+ z__[j + k * z_dim1] -= sum * t1;
+ z__[j + (k + 1) * z_dim1] -= sum * t2;
+ z__[j + (k + 2) * z_dim1] -= sum * t3;
+/* L80: */
+ }
+ }
+ } else if (nr == 2) {
+
+/*
+ Apply G from the left to transform the rows of the matrix
+ in columns K to I2.
+*/
+
+ i__3 = i2;
+ for (j = k; j <= i__3; ++j) {
+ sum = h__[k + j * h_dim1] + v2 * h__[k + 1 + j * h_dim1];
+ h__[k + j * h_dim1] -= sum * t1;
+ h__[k + 1 + j * h_dim1] -= sum * t2;
+/* L90: */
+ }
+
+/*
+ Apply G from the right to transform the columns of the
+ matrix in rows I1 to min(K+3,I).
+*/
+
+ i__3 = i__;
+ for (j = i1; j <= i__3; ++j) {
+ sum = h__[j + k * h_dim1] + v2 * h__[j + (k + 1) * h_dim1]
+ ;
+ h__[j + k * h_dim1] -= sum * t1;
+ h__[j + (k + 1) * h_dim1] -= sum * t2;
+/* L100: */
+ }
+
+ if (*wantz) {
+
+/* Accumulate transformations in the matrix Z */
+
+ i__3 = *ihiz;
+ for (j = *iloz; j <= i__3; ++j) {
+ sum = z__[j + k * z_dim1] + v2 * z__[j + (k + 1) *
+ z_dim1];
+ z__[j + k * z_dim1] -= sum * t1;
+ z__[j + (k + 1) * z_dim1] -= sum * t2;
+/* L110: */
+ }
+ }
+ }
+/* L120: */
+ }
+
+/* L130: */
+ }
+
+/* Failure to converge in remaining number of iterations */
+
+ *info = i__;
+ return 0;
+
+L140:
+
+ if (l == i__) {
+
+/* H(I,I-1) is negligible: one eigenvalue has converged. */
+
+ wr[i__] = h__[i__ + i__ * h_dim1];
+ wi[i__] = 0.;
+ } else if (l == i__ - 1) {
+
+/*
+ H(I-1,I-2) is negligible: a pair of eigenvalues have converged.
+
+ Transform the 2-by-2 submatrix to standard Schur form,
+ and compute and store the eigenvalues.
+*/
+
+ dlanv2_(&h__[i__ - 1 + (i__ - 1) * h_dim1], &h__[i__ - 1 + i__ *
+ h_dim1], &h__[i__ + (i__ - 1) * h_dim1], &h__[i__ + i__ *
+ h_dim1], &wr[i__ - 1], &wi[i__ - 1], &wr[i__], &wi[i__], &cs,
+ &sn);
+
+ if (*wantt) {
+
+/* Apply the transformation to the rest of H. */
+
+ if (i2 > i__) {
+ i__1 = i2 - i__;
+ drot_(&i__1, &h__[i__ - 1 + (i__ + 1) * h_dim1], ldh, &h__[
+ i__ + (i__ + 1) * h_dim1], ldh, &cs, &sn);
+ }
+ i__1 = i__ - i1 - 1;
+ drot_(&i__1, &h__[i1 + (i__ - 1) * h_dim1], &c__1, &h__[i1 + i__ *
+ h_dim1], &c__1, &cs, &sn);
+ }
+ if (*wantz) {
+
+/* Apply the transformation to Z. */
+
+ drot_(&nz, &z__[*iloz + (i__ - 1) * z_dim1], &c__1, &z__[*iloz +
+ i__ * z_dim1], &c__1, &cs, &sn);
+ }
+ }
+
+/*
+ Decrement number of remaining iterations, and return to start of
+ the main loop with new value of I.
+*/
+
+ itn -= its;
+ i__ = l - 1;
+ goto L10;
+
+L150:
+ return 0;
+
+/* End of DLAHQR */
+
+} /* dlahqr_ */
+
+/* Subroutine */ int dlahrd_(integer *n, integer *k, integer *nb, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *t, integer *ldt,
+ doublereal *y, integer *ldy)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, t_dim1, t_offset, y_dim1, y_offset, i__1, i__2,
+ i__3;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer i__;
+ static doublereal ei;
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *), dgemv_(char *, integer *, integer *, doublereal *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ doublereal *, integer *), dcopy_(integer *, doublereal *,
+ integer *, doublereal *, integer *), daxpy_(integer *, doublereal
+ *, doublereal *, integer *, doublereal *, integer *), dtrmv_(char
+ *, char *, char *, integer *, doublereal *, integer *, doublereal
+ *, integer *), dlarfg_(integer *,
+ doublereal *, doublereal *, integer *, doublereal *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DLAHRD reduces the first NB columns of a real general n-by-(n-k+1)
+ matrix A so that elements below the k-th subdiagonal are zero. The
+ reduction is performed by an orthogonal similarity transformation
+ Q' * A * Q. The routine returns the matrices V and T which determine
+ Q as a block reflector I - V*T*V', and also the matrix Y = A * V * T.
+
+ This is an auxiliary routine called by DGEHRD.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ K (input) INTEGER
+ The offset for the reduction. Elements below the k-th
+ subdiagonal in the first NB columns are reduced to zero.
+
+ NB (input) INTEGER
+ The number of columns to be reduced.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N-K+1)
+ On entry, the n-by-(n-k+1) general matrix A.
+ On exit, the elements on and above the k-th subdiagonal in
+ the first NB columns are overwritten with the corresponding
+ elements of the reduced matrix; the elements below the k-th
+ subdiagonal, with the array TAU, represent the matrix Q as a
+ product of elementary reflectors. The other columns of A are
+ unchanged. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) DOUBLE PRECISION array, dimension (NB)
+ The scalar factors of the elementary reflectors. See Further
+ Details.
+
+ T (output) DOUBLE PRECISION array, dimension (LDT,NB)
+ The upper triangular matrix T.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= NB.
+
+ Y (output) DOUBLE PRECISION array, dimension (LDY,NB)
+ The n-by-nb matrix Y.
+
+ LDY (input) INTEGER
+ The leading dimension of the array Y. LDY >= N.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of nb elementary reflectors
+
+ Q = H(1) H(2) . . . H(nb).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
+ A(i+k+1:n,i), and tau in TAU(i).
+
+ The elements of the vectors v together form the (n-k+1)-by-nb matrix
+ V which is needed, with T and Y, to apply the transformation to the
+ unreduced part of the matrix, using an update of the form:
+ A := (I - V*T*V') * (A - Y*V').
+
+ The contents of A on exit are illustrated by the following example
+ with n = 7, k = 3 and nb = 2:
+
+ ( a h a a a )
+ ( a h a a a )
+ ( a h a a a )
+ ( h h a a a )
+ ( v1 h a a a )
+ ( v1 v2 a a a )
+ ( v1 v2 a a a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+ element of the vector defining H(i).
+
+ =====================================================================
+
+
+ Quick return if possible
+*/
+
+ /* Parameter adjustments */
+ --tau;
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ t_dim1 = *ldt;
+ t_offset = 1 + t_dim1 * 1;
+ t -= t_offset;
+ y_dim1 = *ldy;
+ y_offset = 1 + y_dim1 * 1;
+ y -= y_offset;
+
+ /* Function Body */
+ if (*n <= 1) {
+ return 0;
+ }
+
+ i__1 = *nb;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if (i__ > 1) {
+
+/*
+ Update A(1:n,i)
+
+ Compute i-th column of A - Y * V'
+*/
+
+ i__2 = i__ - 1;
+ dgemv_("No transpose", n, &i__2, &c_b151, &y[y_offset], ldy, &a[*
+ k + i__ - 1 + a_dim1], lda, &c_b15, &a[i__ * a_dim1 + 1],
+ &c__1);
+
+/*
+ Apply I - V * T' * V' to this column (call it b) from the
+ left, using the last column of T as workspace
+
+ Let V = ( V1 ) and b = ( b1 ) (first I-1 rows)
+ ( V2 ) ( b2 )
+
+ where V1 is unit lower triangular
+
+ w := V1' * b1
+*/
+
+ i__2 = i__ - 1;
+ dcopy_(&i__2, &a[*k + 1 + i__ * a_dim1], &c__1, &t[*nb * t_dim1 +
+ 1], &c__1);
+ i__2 = i__ - 1;
+ dtrmv_("Lower", "Transpose", "Unit", &i__2, &a[*k + 1 + a_dim1],
+ lda, &t[*nb * t_dim1 + 1], &c__1);
+
+/* w := w + V2'*b2 */
+
+ i__2 = *n - *k - i__ + 1;
+ i__3 = i__ - 1;
+ dgemv_("Transpose", &i__2, &i__3, &c_b15, &a[*k + i__ + a_dim1],
+ lda, &a[*k + i__ + i__ * a_dim1], &c__1, &c_b15, &t[*nb *
+ t_dim1 + 1], &c__1);
+
+/* w := T'*w */
+
+ i__2 = i__ - 1;
+ dtrmv_("Upper", "Transpose", "Non-unit", &i__2, &t[t_offset], ldt,
+ &t[*nb * t_dim1 + 1], &c__1);
+
+/* b2 := b2 - V2*w */
+
+ i__2 = *n - *k - i__ + 1;
+ i__3 = i__ - 1;
+ dgemv_("No transpose", &i__2, &i__3, &c_b151, &a[*k + i__ +
+ a_dim1], lda, &t[*nb * t_dim1 + 1], &c__1, &c_b15, &a[*k
+ + i__ + i__ * a_dim1], &c__1);
+
+/* b1 := b1 - V1*w */
+
+ i__2 = i__ - 1;
+ dtrmv_("Lower", "No transpose", "Unit", &i__2, &a[*k + 1 + a_dim1]
+ , lda, &t[*nb * t_dim1 + 1], &c__1);
+ i__2 = i__ - 1;
+ daxpy_(&i__2, &c_b151, &t[*nb * t_dim1 + 1], &c__1, &a[*k + 1 +
+ i__ * a_dim1], &c__1);
+
+ a[*k + i__ - 1 + (i__ - 1) * a_dim1] = ei;
+ }
+
+/*
+ Generate the elementary reflector H(i) to annihilate
+ A(k+i+1:n,i)
+*/
+
+ i__2 = *n - *k - i__ + 1;
+/* Computing MIN */
+ i__3 = *k + i__ + 1;
+ dlarfg_(&i__2, &a[*k + i__ + i__ * a_dim1], &a[min(i__3,*n) + i__ *
+ a_dim1], &c__1, &tau[i__]);
+ ei = a[*k + i__ + i__ * a_dim1];
+ a[*k + i__ + i__ * a_dim1] = 1.;
+
+/* Compute Y(1:n,i) */
+
+ i__2 = *n - *k - i__ + 1;
+ dgemv_("No transpose", n, &i__2, &c_b15, &a[(i__ + 1) * a_dim1 + 1],
+ lda, &a[*k + i__ + i__ * a_dim1], &c__1, &c_b29, &y[i__ *
+ y_dim1 + 1], &c__1);
+ i__2 = *n - *k - i__ + 1;
+ i__3 = i__ - 1;
+ dgemv_("Transpose", &i__2, &i__3, &c_b15, &a[*k + i__ + a_dim1], lda,
+ &a[*k + i__ + i__ * a_dim1], &c__1, &c_b29, &t[i__ * t_dim1 +
+ 1], &c__1);
+ i__2 = i__ - 1;
+ dgemv_("No transpose", n, &i__2, &c_b151, &y[y_offset], ldy, &t[i__ *
+ t_dim1 + 1], &c__1, &c_b15, &y[i__ * y_dim1 + 1], &c__1);
+ dscal_(n, &tau[i__], &y[i__ * y_dim1 + 1], &c__1);
+
+/* Compute T(1:i,i) */
+
+ i__2 = i__ - 1;
+ d__1 = -tau[i__];
+ dscal_(&i__2, &d__1, &t[i__ * t_dim1 + 1], &c__1);
+ i__2 = i__ - 1;
+ dtrmv_("Upper", "No transpose", "Non-unit", &i__2, &t[t_offset], ldt,
+ &t[i__ * t_dim1 + 1], &c__1)
+ ;
+ t[i__ + i__ * t_dim1] = tau[i__];
+
+/* L10: */
+ }
+ a[*k + *nb + *nb * a_dim1] = ei;
+
+ return 0;
+
+/* End of DLAHRD */
+
+} /* dlahrd_ */
+
+/* Subroutine */ int dlaln2_(logical *ltrans, integer *na, integer *nw,
+ doublereal *smin, doublereal *ca, doublereal *a, integer *lda,
+ doublereal *d1, doublereal *d2, doublereal *b, integer *ldb,
+ doublereal *wr, doublereal *wi, doublereal *x, integer *ldx,
+ doublereal *scale, doublereal *xnorm, integer *info)
+{
+ /* Initialized data */
+
+ static logical zswap[4] = { FALSE_,FALSE_,TRUE_,TRUE_ };
+ static logical rswap[4] = { FALSE_,TRUE_,FALSE_,TRUE_ };
+ static integer ipivot[16] /* was [4][4] */ = { 1,2,3,4,2,1,4,3,3,4,1,2,
+ 4,3,2,1 };
+
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, x_dim1, x_offset;
+ doublereal d__1, d__2, d__3, d__4, d__5, d__6;
+ static doublereal equiv_0[4], equiv_1[4];
+
+ /* Local variables */
+ static integer j;
+#define ci (equiv_0)
+#define cr (equiv_1)
+ static doublereal bi1, bi2, br1, br2, xi1, xi2, xr1, xr2, ci21, ci22,
+ cr21, cr22, li21, csi, ui11, lr21, ui12, ui22;
+#define civ (equiv_0)
+ static doublereal csr, ur11, ur12, ur22;
+#define crv (equiv_1)
+ static doublereal bbnd, cmax, ui11r, ui12s, temp, ur11r, ur12s, u22abs;
+ static integer icmax;
+ static doublereal bnorm, cnorm, smini;
+
+ extern /* Subroutine */ int dladiv_(doublereal *, doublereal *,
+ doublereal *, doublereal *, doublereal *, doublereal *);
+ static doublereal bignum, smlnum;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLALN2 solves a system of the form (ca A - w D ) X = s B
+ or (ca A' - w D) X = s B with possible scaling ("s") and
+ perturbation of A. (A' means A-transpose.)
+
+ A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA
+ real diagonal matrix, w is a real or complex value, and X and B are
+ NA x 1 matrices -- real if w is real, complex if w is complex. NA
+ may be 1 or 2.
+
+ If w is complex, X and B are represented as NA x 2 matrices,
+ the first column of each being the real part and the second
+ being the imaginary part.
+
+ "s" is a scaling factor (.LE. 1), computed by DLALN2, which is
+ so chosen that X can be computed without overflow. X is further
+ scaled if necessary to assure that norm(ca A - w D)*norm(X) is less
+ than overflow.
+
+ If both singular values of (ca A - w D) are less than SMIN,
+ SMIN*identity will be used instead of (ca A - w D). If only one
+ singular value is less than SMIN, one element of (ca A - w D) will be
+ perturbed enough to make the smallest singular value roughly SMIN.
+ If both singular values are at least SMIN, (ca A - w D) will not be
+ perturbed. In any case, the perturbation will be at most some small
+ multiple of max( SMIN, ulp*norm(ca A - w D) ). The singular values
+ are computed by infinity-norm approximations, and thus will only be
+ correct to a factor of 2 or so.
+
+ Note: all input quantities are assumed to be smaller than overflow
+ by a reasonable factor. (See BIGNUM.)
+
+ Arguments
+ ==========
+
+ LTRANS (input) LOGICAL
+ =.TRUE.: A-transpose will be used.
+ =.FALSE.: A will be used (not transposed.)
+
+ NA (input) INTEGER
+ The size of the matrix A. It may (only) be 1 or 2.
+
+ NW (input) INTEGER
+ 1 if "w" is real, 2 if "w" is complex. It may only be 1
+ or 2.
+
+ SMIN (input) DOUBLE PRECISION
+ The desired lower bound on the singular values of A. This
+ should be a safe distance away from underflow or overflow,
+ say, between (underflow/machine precision) and (machine
+ precision * overflow ). (See BIGNUM and ULP.)
+
+ CA (input) DOUBLE PRECISION
+ The coefficient c, which A is multiplied by.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,NA)
+ The NA x NA matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of A. It must be at least NA.
+
+ D1 (input) DOUBLE PRECISION
+ The 1,1 element in the diagonal matrix D.
+
+ D2 (input) DOUBLE PRECISION
+ The 2,2 element in the diagonal matrix D. Not used if NW=1.
+
+ B (input) DOUBLE PRECISION array, dimension (LDB,NW)
+ The NA x NW matrix B (right-hand side). If NW=2 ("w" is
+ complex), column 1 contains the real part of B and column 2
+ contains the imaginary part.
+
+ LDB (input) INTEGER
+ The leading dimension of B. It must be at least NA.
+
+ WR (input) DOUBLE PRECISION
+ The real part of the scalar "w".
+
+ WI (input) DOUBLE PRECISION
+ The imaginary part of the scalar "w". Not used if NW=1.
+
+ X (output) DOUBLE PRECISION array, dimension (LDX,NW)
+ The NA x NW matrix X (unknowns), as computed by DLALN2.
+ If NW=2 ("w" is complex), on exit, column 1 will contain
+ the real part of X and column 2 will contain the imaginary
+ part.
+
+ LDX (input) INTEGER
+ The leading dimension of X. It must be at least NA.
+
+ SCALE (output) DOUBLE PRECISION
+ The scale factor that B must be multiplied by to insure
+ that overflow does not occur when computing X. Thus,
+ (ca A - w D) X will be SCALE*B, not B (ignoring
+ perturbations of A.) It will be at most 1.
+
+ XNORM (output) DOUBLE PRECISION
+ The infinity-norm of X, when X is regarded as an NA x NW
+ real matrix.
+
+ INFO (output) INTEGER
+ An error flag. It will be set to zero if no error occurs,
+ a negative number if an argument is in error, or a positive
+ number if ca A - w D had to be perturbed.
+ The possible values are:
+ = 0: No error occurred, and (ca A - w D) did not have to be
+ perturbed.
+ = 1: (ca A - w D) had to be perturbed to make its smallest
+ (or only) singular value greater than SMIN.
+ NOTE: In the interests of speed, this routine does not
+ check the inputs for errors.
+
+ =====================================================================
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ x_dim1 = *ldx;
+ x_offset = 1 + x_dim1 * 1;
+ x -= x_offset;
+
+ /* Function Body */
+
+/* Compute BIGNUM */
+
+ smlnum = 2. * SAFEMINIMUM;
+ bignum = 1. / smlnum;
+ smini = max(*smin,smlnum);
+
+/* Don't check for input errors */
+
+ *info = 0;
+
+/* Standard Initializations */
+
+ *scale = 1.;
+
+ if (*na == 1) {
+
+/* 1 x 1 (i.e., scalar) system C X = B */
+
+ if (*nw == 1) {
+
+/*
+ Real 1x1 system.
+
+ C = ca A - w D
+*/
+
+ csr = *ca * a[a_dim1 + 1] - *wr * *d1;
+ cnorm = abs(csr);
+
+/* If | C | < SMINI, use C = SMINI */
+
+ if (cnorm < smini) {
+ csr = smini;
+ cnorm = smini;
+ *info = 1;
+ }
+
+/* Check scaling for X = B / C */
+
+ bnorm = (d__1 = b[b_dim1 + 1], abs(d__1));
+ if ((cnorm < 1. && bnorm > 1.)) {
+ if (bnorm > bignum * cnorm) {
+ *scale = 1. / bnorm;
+ }
+ }
+
+/* Compute X */
+
+ x[x_dim1 + 1] = b[b_dim1 + 1] * *scale / csr;
+ *xnorm = (d__1 = x[x_dim1 + 1], abs(d__1));
+ } else {
+
+/*
+ Complex 1x1 system (w is complex)
+
+ C = ca A - w D
+*/
+
+ csr = *ca * a[a_dim1 + 1] - *wr * *d1;
+ csi = -(*wi) * *d1;
+ cnorm = abs(csr) + abs(csi);
+
+/* If | C | < SMINI, use C = SMINI */
+
+ if (cnorm < smini) {
+ csr = smini;
+ csi = 0.;
+ cnorm = smini;
+ *info = 1;
+ }
+
+/* Check scaling for X = B / C */
+
+ bnorm = (d__1 = b[b_dim1 + 1], abs(d__1)) + (d__2 = b[((b_dim1) <<
+ (1)) + 1], abs(d__2));
+ if ((cnorm < 1. && bnorm > 1.)) {
+ if (bnorm > bignum * cnorm) {
+ *scale = 1. / bnorm;
+ }
+ }
+
+/* Compute X */
+
+ d__1 = *scale * b[b_dim1 + 1];
+ d__2 = *scale * b[((b_dim1) << (1)) + 1];
+ dladiv_(&d__1, &d__2, &csr, &csi, &x[x_dim1 + 1], &x[((x_dim1) <<
+ (1)) + 1]);
+ *xnorm = (d__1 = x[x_dim1 + 1], abs(d__1)) + (d__2 = x[((x_dim1)
+ << (1)) + 1], abs(d__2));
+ }
+
+ } else {
+
+/*
+ 2x2 System
+
+ Compute the real part of C = ca A - w D (or ca A' - w D )
+*/
+
+ cr[0] = *ca * a[a_dim1 + 1] - *wr * *d1;
+ cr[3] = *ca * a[((a_dim1) << (1)) + 2] - *wr * *d2;
+ if (*ltrans) {
+ cr[2] = *ca * a[a_dim1 + 2];
+ cr[1] = *ca * a[((a_dim1) << (1)) + 1];
+ } else {
+ cr[1] = *ca * a[a_dim1 + 2];
+ cr[2] = *ca * a[((a_dim1) << (1)) + 1];
+ }
+
+ if (*nw == 1) {
+
+/*
+ Real 2x2 system (w is real)
+
+ Find the largest element in C
+*/
+
+ cmax = 0.;
+ icmax = 0;
+
+ for (j = 1; j <= 4; ++j) {
+ if ((d__1 = crv[j - 1], abs(d__1)) > cmax) {
+ cmax = (d__1 = crv[j - 1], abs(d__1));
+ icmax = j;
+ }
+/* L10: */
+ }
+
+/* If norm(C) < SMINI, use SMINI*identity. */
+
+ if (cmax < smini) {
+/* Computing MAX */
+ d__3 = (d__1 = b[b_dim1 + 1], abs(d__1)), d__4 = (d__2 = b[
+ b_dim1 + 2], abs(d__2));
+ bnorm = max(d__3,d__4);
+ if ((smini < 1. && bnorm > 1.)) {
+ if (bnorm > bignum * smini) {
+ *scale = 1. / bnorm;
+ }
+ }
+ temp = *scale / smini;
+ x[x_dim1 + 1] = temp * b[b_dim1 + 1];
+ x[x_dim1 + 2] = temp * b[b_dim1 + 2];
+ *xnorm = temp * bnorm;
+ *info = 1;
+ return 0;
+ }
+
+/* Gaussian elimination with complete pivoting. */
+
+ ur11 = crv[icmax - 1];
+ cr21 = crv[ipivot[((icmax) << (2)) - 3] - 1];
+ ur12 = crv[ipivot[((icmax) << (2)) - 2] - 1];
+ cr22 = crv[ipivot[((icmax) << (2)) - 1] - 1];
+ ur11r = 1. / ur11;
+ lr21 = ur11r * cr21;
+ ur22 = cr22 - ur12 * lr21;
+
+/* If smaller pivot < SMINI, use SMINI */
+
+ if (abs(ur22) < smini) {
+ ur22 = smini;
+ *info = 1;
+ }
+ if (rswap[icmax - 1]) {
+ br1 = b[b_dim1 + 2];
+ br2 = b[b_dim1 + 1];
+ } else {
+ br1 = b[b_dim1 + 1];
+ br2 = b[b_dim1 + 2];
+ }
+ br2 -= lr21 * br1;
+/* Computing MAX */
+ d__2 = (d__1 = br1 * (ur22 * ur11r), abs(d__1)), d__3 = abs(br2);
+ bbnd = max(d__2,d__3);
+ if ((bbnd > 1. && abs(ur22) < 1.)) {
+ if (bbnd >= bignum * abs(ur22)) {
+ *scale = 1. / bbnd;
+ }
+ }
+
+ xr2 = br2 * *scale / ur22;
+ xr1 = *scale * br1 * ur11r - xr2 * (ur11r * ur12);
+ if (zswap[icmax - 1]) {
+ x[x_dim1 + 1] = xr2;
+ x[x_dim1 + 2] = xr1;
+ } else {
+ x[x_dim1 + 1] = xr1;
+ x[x_dim1 + 2] = xr2;
+ }
+/* Computing MAX */
+ d__1 = abs(xr1), d__2 = abs(xr2);
+ *xnorm = max(d__1,d__2);
+
+/* Further scaling if norm(A) norm(X) > overflow */
+
+ if ((*xnorm > 1. && cmax > 1.)) {
+ if (*xnorm > bignum / cmax) {
+ temp = cmax / bignum;
+ x[x_dim1 + 1] = temp * x[x_dim1 + 1];
+ x[x_dim1 + 2] = temp * x[x_dim1 + 2];
+ *xnorm = temp * *xnorm;
+ *scale = temp * *scale;
+ }
+ }
+ } else {
+
+/*
+ Complex 2x2 system (w is complex)
+
+ Find the largest element in C
+*/
+
+ ci[0] = -(*wi) * *d1;
+ ci[1] = 0.;
+ ci[2] = 0.;
+ ci[3] = -(*wi) * *d2;
+ cmax = 0.;
+ icmax = 0;
+
+ for (j = 1; j <= 4; ++j) {
+ if ((d__1 = crv[j - 1], abs(d__1)) + (d__2 = civ[j - 1], abs(
+ d__2)) > cmax) {
+ cmax = (d__1 = crv[j - 1], abs(d__1)) + (d__2 = civ[j - 1]
+ , abs(d__2));
+ icmax = j;
+ }
+/* L20: */
+ }
+
+/* If norm(C) < SMINI, use SMINI*identity. */
+
+ if (cmax < smini) {
+/* Computing MAX */
+ d__5 = (d__1 = b[b_dim1 + 1], abs(d__1)) + (d__2 = b[((b_dim1)
+ << (1)) + 1], abs(d__2)), d__6 = (d__3 = b[b_dim1 +
+ 2], abs(d__3)) + (d__4 = b[((b_dim1) << (1)) + 2],
+ abs(d__4));
+ bnorm = max(d__5,d__6);
+ if ((smini < 1. && bnorm > 1.)) {
+ if (bnorm > bignum * smini) {
+ *scale = 1. / bnorm;
+ }
+ }
+ temp = *scale / smini;
+ x[x_dim1 + 1] = temp * b[b_dim1 + 1];
+ x[x_dim1 + 2] = temp * b[b_dim1 + 2];
+ x[((x_dim1) << (1)) + 1] = temp * b[((b_dim1) << (1)) + 1];
+ x[((x_dim1) << (1)) + 2] = temp * b[((b_dim1) << (1)) + 2];
+ *xnorm = temp * bnorm;
+ *info = 1;
+ return 0;
+ }
+
+/* Gaussian elimination with complete pivoting. */
+
+ ur11 = crv[icmax - 1];
+ ui11 = civ[icmax - 1];
+ cr21 = crv[ipivot[((icmax) << (2)) - 3] - 1];
+ ci21 = civ[ipivot[((icmax) << (2)) - 3] - 1];
+ ur12 = crv[ipivot[((icmax) << (2)) - 2] - 1];
+ ui12 = civ[ipivot[((icmax) << (2)) - 2] - 1];
+ cr22 = crv[ipivot[((icmax) << (2)) - 1] - 1];
+ ci22 = civ[ipivot[((icmax) << (2)) - 1] - 1];
+ if (icmax == 1 || icmax == 4) {
+
+/* Code when off-diagonals of pivoted C are real */
+
+ if (abs(ur11) > abs(ui11)) {
+ temp = ui11 / ur11;
+/* Computing 2nd power */
+ d__1 = temp;
+ ur11r = 1. / (ur11 * (d__1 * d__1 + 1.));
+ ui11r = -temp * ur11r;
+ } else {
+ temp = ur11 / ui11;
+/* Computing 2nd power */
+ d__1 = temp;
+ ui11r = -1. / (ui11 * (d__1 * d__1 + 1.));
+ ur11r = -temp * ui11r;
+ }
+ lr21 = cr21 * ur11r;
+ li21 = cr21 * ui11r;
+ ur12s = ur12 * ur11r;
+ ui12s = ur12 * ui11r;
+ ur22 = cr22 - ur12 * lr21;
+ ui22 = ci22 - ur12 * li21;
+ } else {
+
+/* Code when diagonals of pivoted C are real */
+
+ ur11r = 1. / ur11;
+ ui11r = 0.;
+ lr21 = cr21 * ur11r;
+ li21 = ci21 * ur11r;
+ ur12s = ur12 * ur11r;
+ ui12s = ui12 * ur11r;
+ ur22 = cr22 - ur12 * lr21 + ui12 * li21;
+ ui22 = -ur12 * li21 - ui12 * lr21;
+ }
+ u22abs = abs(ur22) + abs(ui22);
+
+/* If smaller pivot < SMINI, use SMINI */
+
+ if (u22abs < smini) {
+ ur22 = smini;
+ ui22 = 0.;
+ *info = 1;
+ }
+ if (rswap[icmax - 1]) {
+ br2 = b[b_dim1 + 1];
+ br1 = b[b_dim1 + 2];
+ bi2 = b[((b_dim1) << (1)) + 1];
+ bi1 = b[((b_dim1) << (1)) + 2];
+ } else {
+ br1 = b[b_dim1 + 1];
+ br2 = b[b_dim1 + 2];
+ bi1 = b[((b_dim1) << (1)) + 1];
+ bi2 = b[((b_dim1) << (1)) + 2];
+ }
+ br2 = br2 - lr21 * br1 + li21 * bi1;
+ bi2 = bi2 - li21 * br1 - lr21 * bi1;
+/* Computing MAX */
+ d__1 = (abs(br1) + abs(bi1)) * (u22abs * (abs(ur11r) + abs(ui11r))
+ ), d__2 = abs(br2) + abs(bi2);
+ bbnd = max(d__1,d__2);
+ if ((bbnd > 1. && u22abs < 1.)) {
+ if (bbnd >= bignum * u22abs) {
+ *scale = 1. / bbnd;
+ br1 = *scale * br1;
+ bi1 = *scale * bi1;
+ br2 = *scale * br2;
+ bi2 = *scale * bi2;
+ }
+ }
+
+ dladiv_(&br2, &bi2, &ur22, &ui22, &xr2, &xi2);
+ xr1 = ur11r * br1 - ui11r * bi1 - ur12s * xr2 + ui12s * xi2;
+ xi1 = ui11r * br1 + ur11r * bi1 - ui12s * xr2 - ur12s * xi2;
+ if (zswap[icmax - 1]) {
+ x[x_dim1 + 1] = xr2;
+ x[x_dim1 + 2] = xr1;
+ x[((x_dim1) << (1)) + 1] = xi2;
+ x[((x_dim1) << (1)) + 2] = xi1;
+ } else {
+ x[x_dim1 + 1] = xr1;
+ x[x_dim1 + 2] = xr2;
+ x[((x_dim1) << (1)) + 1] = xi1;
+ x[((x_dim1) << (1)) + 2] = xi2;
+ }
+/* Computing MAX */
+ d__1 = abs(xr1) + abs(xi1), d__2 = abs(xr2) + abs(xi2);
+ *xnorm = max(d__1,d__2);
+
+/* Further scaling if norm(A) norm(X) > overflow */
+
+ if ((*xnorm > 1. && cmax > 1.)) {
+ if (*xnorm > bignum / cmax) {
+ temp = cmax / bignum;
+ x[x_dim1 + 1] = temp * x[x_dim1 + 1];
+ x[x_dim1 + 2] = temp * x[x_dim1 + 2];
+ x[((x_dim1) << (1)) + 1] = temp * x[((x_dim1) << (1)) + 1]
+ ;
+ x[((x_dim1) << (1)) + 2] = temp * x[((x_dim1) << (1)) + 2]
+ ;
+ *xnorm = temp * *xnorm;
+ *scale = temp * *scale;
+ }
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DLALN2 */
+
+} /* dlaln2_ */
+
+#undef crv
+#undef civ
+#undef cr
+#undef ci
+
+
+/* Subroutine */ int dlals0_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, integer *nrhs, doublereal *b, integer *ldb, doublereal
+ *bx, integer *ldbx, integer *perm, integer *givptr, integer *givcol,
+ integer *ldgcol, doublereal *givnum, integer *ldgnum, doublereal *
+ poles, doublereal *difl, doublereal *difr, doublereal *z__, integer *
+ k, doublereal *c__, doublereal *s, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer givcol_dim1, givcol_offset, b_dim1, b_offset, bx_dim1, bx_offset,
+ difr_dim1, difr_offset, givnum_dim1, givnum_offset, poles_dim1,
+ poles_offset, i__1, i__2;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer i__, j, m, n;
+ static doublereal dj;
+ static integer nlp1;
+ static doublereal temp;
+ extern /* Subroutine */ int drot_(integer *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *);
+ extern doublereal dnrm2_(integer *, doublereal *, integer *);
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *);
+ static doublereal diflj, difrj, dsigj;
+ extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, doublereal *, integer *), dcopy_(integer *,
+ doublereal *, integer *, doublereal *, integer *);
+ extern doublereal dlamc3_(doublereal *, doublereal *);
+ extern /* Subroutine */ int dlascl_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, integer *, doublereal *,
+ integer *, integer *), dlacpy_(char *, integer *, integer
+ *, doublereal *, integer *, doublereal *, integer *),
+ xerbla_(char *, integer *);
+ static doublereal dsigjp;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ December 1, 1999
+
+
+ Purpose
+ =======
+
+ DLALS0 applies back the multiplying factors of either the left or the
+ right singular vector matrix of a diagonal matrix appended by a row
+ to the right hand side matrix B in solving the least squares problem
+ using the divide-and-conquer SVD approach.
+
+ For the left singular vector matrix, three types of orthogonal
+ matrices are involved:
+
+ (1L) Givens rotations: the number of such rotations is GIVPTR; the
+ pairs of columns/rows they were applied to are stored in GIVCOL;
+ and the C- and S-values of these rotations are stored in GIVNUM.
+
+ (2L) Permutation. The (NL+1)-st row of B is to be moved to the first
+ row, and for J=2:N, PERM(J)-th row of B is to be moved to the
+ J-th row.
+
+ (3L) The left singular vector matrix of the remaining matrix.
+
+ For the right singular vector matrix, four types of orthogonal
+ matrices are involved:
+
+ (1R) The right singular vector matrix of the remaining matrix.
+
+ (2R) If SQRE = 1, one extra Givens rotation to generate the right
+ null space.
+
+ (3R) The inverse transformation of (2L).
+
+ (4R) The inverse transformation of (1L).
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed in
+ factored form:
+ = 0: Left singular vector matrix.
+ = 1: Right singular vector matrix.
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has row dimension N = NL + NR + 1,
+ and column dimension M = N + SQRE.
+
+ NRHS (input) INTEGER
+ The number of columns of B and BX. NRHS must be at least 1.
+
+ B (input/output) DOUBLE PRECISION array, dimension ( LDB, NRHS )
+ On input, B contains the right hand sides of the least
+ squares problem in rows 1 through M. On output, B contains
+ the solution X in rows 1 through N.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB must be at least
+ max(1,MAX( M, N ) ).
+
+ BX (workspace) DOUBLE PRECISION array, dimension ( LDBX, NRHS )
+
+ LDBX (input) INTEGER
+ The leading dimension of BX.
+
+ PERM (input) INTEGER array, dimension ( N )
+ The permutations (from deflation and sorting) applied
+ to the two blocks.
+
+ GIVPTR (input) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem.
+
+ GIVCOL (input) INTEGER array, dimension ( LDGCOL, 2 )
+ Each pair of numbers indicates a pair of rows/columns
+ involved in a Givens rotation.
+
+ LDGCOL (input) INTEGER
+ The leading dimension of GIVCOL, must be at least N.
+
+ GIVNUM (input) DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
+ Each number indicates the C or S value used in the
+ corresponding Givens rotation.
+
+ LDGNUM (input) INTEGER
+ The leading dimension of arrays DIFR, POLES and
+ GIVNUM, must be at least K.
+
+ POLES (input) DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
+ On entry, POLES(1:K, 1) contains the new singular
+ values obtained from solving the secular equation, and
+ POLES(1:K, 2) is an array containing the poles in the secular
+ equation.
+
+ DIFL (input) DOUBLE PRECISION array, dimension ( K ).
+ On entry, DIFL(I) is the distance between I-th updated
+ (undeflated) singular value and the I-th (undeflated) old
+ singular value.
+
+ DIFR (input) DOUBLE PRECISION array, dimension ( LDGNUM, 2 ).
+ On entry, DIFR(I, 1) contains the distances between I-th
+ updated (undeflated) singular value and the I+1-th
+ (undeflated) old singular value. And DIFR(I, 2) is the
+ normalizing factor for the I-th right singular vector.
+
+ Z (input) DOUBLE PRECISION array, dimension ( K )
+ Contain the components of the deflation-adjusted updating row
+ vector.
+
+ K (input) INTEGER
+ Contains the dimension of the non-deflated matrix,
+ This is the order of the related secular equation. 1 <= K <=N.
+
+ C (input) DOUBLE PRECISION
+ C contains garbage if SQRE =0 and the C-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ S (input) DOUBLE PRECISION
+ S contains garbage if SQRE =0 and the S-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension ( K )
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ bx_dim1 = *ldbx;
+ bx_offset = 1 + bx_dim1 * 1;
+ bx -= bx_offset;
+ --perm;
+ givcol_dim1 = *ldgcol;
+ givcol_offset = 1 + givcol_dim1 * 1;
+ givcol -= givcol_offset;
+ difr_dim1 = *ldgnum;
+ difr_offset = 1 + difr_dim1 * 1;
+ difr -= difr_offset;
+ poles_dim1 = *ldgnum;
+ poles_offset = 1 + poles_dim1 * 1;
+ poles -= poles_offset;
+ givnum_dim1 = *ldgnum;
+ givnum_offset = 1 + givnum_dim1 * 1;
+ givnum -= givnum_offset;
+ --difl;
+ --z__;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*icompq < 0 || *icompq > 1) {
+ *info = -1;
+ } else if (*nl < 1) {
+ *info = -2;
+ } else if (*nr < 1) {
+ *info = -3;
+ } else if (*sqre < 0 || *sqre > 1) {
+ *info = -4;
+ }
+
+ n = *nl + *nr + 1;
+
+ if (*nrhs < 1) {
+ *info = -5;
+ } else if (*ldb < n) {
+ *info = -7;
+ } else if (*ldbx < n) {
+ *info = -9;
+ } else if (*givptr < 0) {
+ *info = -11;
+ } else if (*ldgcol < n) {
+ *info = -13;
+ } else if (*ldgnum < n) {
+ *info = -15;
+ } else if (*k < 1) {
+ *info = -20;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLALS0", &i__1);
+ return 0;
+ }
+
+ m = n + *sqre;
+ nlp1 = *nl + 1;
+
+ if (*icompq == 0) {
+
+/*
+ Apply back orthogonal transformations from the left.
+
+ Step (1L): apply back the Givens rotations performed.
+*/
+
+ i__1 = *givptr;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ drot_(nrhs, &b[givcol[i__ + ((givcol_dim1) << (1))] + b_dim1],
+ ldb, &b[givcol[i__ + givcol_dim1] + b_dim1], ldb, &givnum[
+ i__ + ((givnum_dim1) << (1))], &givnum[i__ + givnum_dim1])
+ ;
+/* L10: */
+ }
+
+/* Step (2L): permute rows of B. */
+
+ dcopy_(nrhs, &b[nlp1 + b_dim1], ldb, &bx[bx_dim1 + 1], ldbx);
+ i__1 = n;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ dcopy_(nrhs, &b[perm[i__] + b_dim1], ldb, &bx[i__ + bx_dim1],
+ ldbx);
+/* L20: */
+ }
+
+/*
+ Step (3L): apply the inverse of the left singular vector
+ matrix to BX.
+*/
+
+ if (*k == 1) {
+ dcopy_(nrhs, &bx[bx_offset], ldbx, &b[b_offset], ldb);
+ if (z__[1] < 0.) {
+ dscal_(nrhs, &c_b151, &b[b_offset], ldb);
+ }
+ } else {
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ diflj = difl[j];
+ dj = poles[j + poles_dim1];
+ dsigj = -poles[j + ((poles_dim1) << (1))];
+ if (j < *k) {
+ difrj = -difr[j + difr_dim1];
+ dsigjp = -poles[j + 1 + ((poles_dim1) << (1))];
+ }
+ if (z__[j] == 0. || poles[j + ((poles_dim1) << (1))] == 0.) {
+ work[j] = 0.;
+ } else {
+ work[j] = -poles[j + ((poles_dim1) << (1))] * z__[j] /
+ diflj / (poles[j + ((poles_dim1) << (1))] + dj);
+ }
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ if (z__[i__] == 0. || poles[i__ + ((poles_dim1) << (1))]
+ == 0.) {
+ work[i__] = 0.;
+ } else {
+ work[i__] = poles[i__ + ((poles_dim1) << (1))] * z__[
+ i__] / (dlamc3_(&poles[i__ + ((poles_dim1) <<
+ (1))], &dsigj) - diflj) / (poles[i__ + ((
+ poles_dim1) << (1))] + dj);
+ }
+/* L30: */
+ }
+ i__2 = *k;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ if (z__[i__] == 0. || poles[i__ + ((poles_dim1) << (1))]
+ == 0.) {
+ work[i__] = 0.;
+ } else {
+ work[i__] = poles[i__ + ((poles_dim1) << (1))] * z__[
+ i__] / (dlamc3_(&poles[i__ + ((poles_dim1) <<
+ (1))], &dsigjp) + difrj) / (poles[i__ + ((
+ poles_dim1) << (1))] + dj);
+ }
+/* L40: */
+ }
+ work[1] = -1.;
+ temp = dnrm2_(k, &work[1], &c__1);
+ dgemv_("T", k, nrhs, &c_b15, &bx[bx_offset], ldbx, &work[1], &
+ c__1, &c_b29, &b[j + b_dim1], ldb);
+ dlascl_("G", &c__0, &c__0, &temp, &c_b15, &c__1, nrhs, &b[j +
+ b_dim1], ldb, info);
+/* L50: */
+ }
+ }
+
+/* Move the deflated rows of BX to B also. */
+
+ if (*k < max(m,n)) {
+ i__1 = n - *k;
+ dlacpy_("A", &i__1, nrhs, &bx[*k + 1 + bx_dim1], ldbx, &b[*k + 1
+ + b_dim1], ldb);
+ }
+ } else {
+
+/*
+ Apply back the right orthogonal transformations.
+
+ Step (1R): apply back the new right singular vector matrix
+ to B.
+*/
+
+ if (*k == 1) {
+ dcopy_(nrhs, &b[b_offset], ldb, &bx[bx_offset], ldbx);
+ } else {
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dsigj = poles[j + ((poles_dim1) << (1))];
+ if (z__[j] == 0.) {
+ work[j] = 0.;
+ } else {
+ work[j] = -z__[j] / difl[j] / (dsigj + poles[j +
+ poles_dim1]) / difr[j + ((difr_dim1) << (1))];
+ }
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ if (z__[j] == 0.) {
+ work[i__] = 0.;
+ } else {
+ d__1 = -poles[i__ + 1 + ((poles_dim1) << (1))];
+ work[i__] = z__[j] / (dlamc3_(&dsigj, &d__1) - difr[
+ i__ + difr_dim1]) / (dsigj + poles[i__ +
+ poles_dim1]) / difr[i__ + ((difr_dim1) << (1))
+ ];
+ }
+/* L60: */
+ }
+ i__2 = *k;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ if (z__[j] == 0.) {
+ work[i__] = 0.;
+ } else {
+ d__1 = -poles[i__ + ((poles_dim1) << (1))];
+ work[i__] = z__[j] / (dlamc3_(&dsigj, &d__1) - difl[
+ i__]) / (dsigj + poles[i__ + poles_dim1]) /
+ difr[i__ + ((difr_dim1) << (1))];
+ }
+/* L70: */
+ }
+ dgemv_("T", k, nrhs, &c_b15, &b[b_offset], ldb, &work[1], &
+ c__1, &c_b29, &bx[j + bx_dim1], ldbx);
+/* L80: */
+ }
+ }
+
+/*
+ Step (2R): if SQRE = 1, apply back the rotation that is
+ related to the right null space of the subproblem.
+*/
+
+ if (*sqre == 1) {
+ dcopy_(nrhs, &b[m + b_dim1], ldb, &bx[m + bx_dim1], ldbx);
+ drot_(nrhs, &bx[bx_dim1 + 1], ldbx, &bx[m + bx_dim1], ldbx, c__,
+ s);
+ }
+ if (*k < max(m,n)) {
+ i__1 = n - *k;
+ dlacpy_("A", &i__1, nrhs, &b[*k + 1 + b_dim1], ldb, &bx[*k + 1 +
+ bx_dim1], ldbx);
+ }
+
+/* Step (3R): permute rows of B. */
+
+ dcopy_(nrhs, &bx[bx_dim1 + 1], ldbx, &b[nlp1 + b_dim1], ldb);
+ if (*sqre == 1) {
+ dcopy_(nrhs, &bx[m + bx_dim1], ldbx, &b[m + b_dim1], ldb);
+ }
+ i__1 = n;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ dcopy_(nrhs, &bx[i__ + bx_dim1], ldbx, &b[perm[i__] + b_dim1],
+ ldb);
+/* L90: */
+ }
+
+/* Step (4R): apply back the Givens rotations performed. */
+
+ for (i__ = *givptr; i__ >= 1; --i__) {
+ d__1 = -givnum[i__ + givnum_dim1];
+ drot_(nrhs, &b[givcol[i__ + ((givcol_dim1) << (1))] + b_dim1],
+ ldb, &b[givcol[i__ + givcol_dim1] + b_dim1], ldb, &givnum[
+ i__ + ((givnum_dim1) << (1))], &d__1);
+/* L100: */
+ }
+ }
+
+ return 0;
+
+/* End of DLALS0 */
+
+} /* dlals0_ */
+
+/* Subroutine */ int dlalsa_(integer *icompq, integer *smlsiz, integer *n,
+ integer *nrhs, doublereal *b, integer *ldb, doublereal *bx, integer *
+ ldbx, doublereal *u, integer *ldu, doublereal *vt, integer *k,
+ doublereal *difl, doublereal *difr, doublereal *z__, doublereal *
+ poles, integer *givptr, integer *givcol, integer *ldgcol, integer *
+ perm, doublereal *givnum, doublereal *c__, doublereal *s, doublereal *
+ work, integer *iwork, integer *info)
+{
+ /* System generated locals */
+ integer givcol_dim1, givcol_offset, perm_dim1, perm_offset, b_dim1,
+ b_offset, bx_dim1, bx_offset, difl_dim1, difl_offset, difr_dim1,
+ difr_offset, givnum_dim1, givnum_offset, poles_dim1, poles_offset,
+ u_dim1, u_offset, vt_dim1, vt_offset, z_dim1, z_offset, i__1,
+ i__2;
+
+ /* Builtin functions */
+ integer pow_ii(integer *, integer *);
+
+ /* Local variables */
+ static integer i__, j, i1, ic, lf, nd, ll, nl, nr, im1, nlf, nrf, lvl,
+ ndb1, nlp1, lvl2, nrp1, nlvl, sqre;
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *);
+ static integer inode, ndiml, ndimr;
+ extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
+ doublereal *, integer *), dlals0_(integer *, integer *, integer *,
+ integer *, integer *, doublereal *, integer *, doublereal *,
+ integer *, integer *, integer *, integer *, integer *, doublereal
+ *, integer *, doublereal *, doublereal *, doublereal *,
+ doublereal *, integer *, doublereal *, doublereal *, doublereal *,
+ integer *), dlasdt_(integer *, integer *, integer *, integer *,
+ integer *, integer *, integer *), xerbla_(char *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DLALSA is an itermediate step in solving the least squares problem
+ by computing the SVD of the coefficient matrix in compact form (The
+ singular vectors are computed as products of simple orthorgonal
+ matrices.).
+
+ If ICOMPQ = 0, DLALSA applies the inverse of the left singular vector
+ matrix of an upper bidiagonal matrix to the right hand side; and if
+ ICOMPQ = 1, DLALSA applies the right singular vector matrix to the
+ right hand side. The singular vector matrices were generated in
+ compact form by DLALSA.
+
+ Arguments
+ =========
+
+
+ ICOMPQ (input) INTEGER
+ Specifies whether the left or the right singular vector
+ matrix is involved.
+ = 0: Left singular vector matrix
+ = 1: Right singular vector matrix
+
+ SMLSIZ (input) INTEGER
+ The maximum size of the subproblems at the bottom of the
+ computation tree.
+
+ N (input) INTEGER
+ The row and column dimensions of the upper bidiagonal matrix.
+
+ NRHS (input) INTEGER
+ The number of columns of B and BX. NRHS must be at least 1.
+
+ B (input) DOUBLE PRECISION array, dimension ( LDB, NRHS )
+ On input, B contains the right hand sides of the least
+ squares problem in rows 1 through M. On output, B contains
+ the solution X in rows 1 through N.
+
+ LDB (input) INTEGER
+ The leading dimension of B in the calling subprogram.
+ LDB must be at least max(1,MAX( M, N ) ).
+
+ BX (output) DOUBLE PRECISION array, dimension ( LDBX, NRHS )
+ On exit, the result of applying the left or right singular
+ vector matrix to B.
+
+ LDBX (input) INTEGER
+ The leading dimension of BX.
+
+ U (input) DOUBLE PRECISION array, dimension ( LDU, SMLSIZ ).
+ On entry, U contains the left singular vector matrices of all
+ subproblems at the bottom level.
+
+ LDU (input) INTEGER, LDU = > N.
+ The leading dimension of arrays U, VT, DIFL, DIFR,
+ POLES, GIVNUM, and Z.
+
+ VT (input) DOUBLE PRECISION array, dimension ( LDU, SMLSIZ+1 ).
+ On entry, VT' contains the right singular vector matrices of
+ all subproblems at the bottom level.
+
+ K (input) INTEGER array, dimension ( N ).
+
+ DIFL (input) DOUBLE PRECISION array, dimension ( LDU, NLVL ).
+ where NLVL = INT(log_2 (N/(SMLSIZ+1))) + 1.
+
+ DIFR (input) DOUBLE PRECISION array, dimension ( LDU, 2 * NLVL ).
+ On entry, DIFL(*, I) and DIFR(*, 2 * I -1) record
+ distances between singular values on the I-th level and
+ singular values on the (I -1)-th level, and DIFR(*, 2 * I)
+ record the normalizing factors of the right singular vectors
+ matrices of subproblems on I-th level.
+
+ Z (input) DOUBLE PRECISION array, dimension ( LDU, NLVL ).
+ On entry, Z(1, I) contains the components of the deflation-
+ adjusted updating row vector for subproblems on the I-th
+ level.
+
+ POLES (input) DOUBLE PRECISION array, dimension ( LDU, 2 * NLVL ).
+ On entry, POLES(*, 2 * I -1: 2 * I) contains the new and old
+ singular values involved in the secular equations on the I-th
+ level.
+
+ GIVPTR (input) INTEGER array, dimension ( N ).
+ On entry, GIVPTR( I ) records the number of Givens
+ rotations performed on the I-th problem on the computation
+ tree.
+
+ GIVCOL (input) INTEGER array, dimension ( LDGCOL, 2 * NLVL ).
+ On entry, for each I, GIVCOL(*, 2 * I - 1: 2 * I) records the
+ locations of Givens rotations performed on the I-th level on
+ the computation tree.
+
+ LDGCOL (input) INTEGER, LDGCOL = > N.
+ The leading dimension of arrays GIVCOL and PERM.
+
+ PERM (input) INTEGER array, dimension ( LDGCOL, NLVL ).
+ On entry, PERM(*, I) records permutations done on the I-th
+ level of the computation tree.
+
+ GIVNUM (input) DOUBLE PRECISION array, dimension ( LDU, 2 * NLVL ).
+ On entry, GIVNUM(*, 2 *I -1 : 2 * I) records the C- and S-
+ values of Givens rotations performed on the I-th level on the
+ computation tree.
+
+ C (input) DOUBLE PRECISION array, dimension ( N ).
+ On entry, if the I-th subproblem is not square,
+ C( I ) contains the C-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ S (input) DOUBLE PRECISION array, dimension ( N ).
+ On entry, if the I-th subproblem is not square,
+ S( I ) contains the S-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ WORK (workspace) DOUBLE PRECISION array.
+ The dimension must be at least N.
+
+ IWORK (workspace) INTEGER array.
+ The dimension must be at least 3 * N
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ bx_dim1 = *ldbx;
+ bx_offset = 1 + bx_dim1 * 1;
+ bx -= bx_offset;
+ givnum_dim1 = *ldu;
+ givnum_offset = 1 + givnum_dim1 * 1;
+ givnum -= givnum_offset;
+ poles_dim1 = *ldu;
+ poles_offset = 1 + poles_dim1 * 1;
+ poles -= poles_offset;
+ z_dim1 = *ldu;
+ z_offset = 1 + z_dim1 * 1;
+ z__ -= z_offset;
+ difr_dim1 = *ldu;
+ difr_offset = 1 + difr_dim1 * 1;
+ difr -= difr_offset;
+ difl_dim1 = *ldu;
+ difl_offset = 1 + difl_dim1 * 1;
+ difl -= difl_offset;
+ vt_dim1 = *ldu;
+ vt_offset = 1 + vt_dim1 * 1;
+ vt -= vt_offset;
+ u_dim1 = *ldu;
+ u_offset = 1 + u_dim1 * 1;
+ u -= u_offset;
+ --k;
+ --givptr;
+ perm_dim1 = *ldgcol;
+ perm_offset = 1 + perm_dim1 * 1;
+ perm -= perm_offset;
+ givcol_dim1 = *ldgcol;
+ givcol_offset = 1 + givcol_dim1 * 1;
+ givcol -= givcol_offset;
+ --c__;
+ --s;
+ --work;
+ --iwork;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*icompq < 0 || *icompq > 1) {
+ *info = -1;
+ } else if (*smlsiz < 3) {
+ *info = -2;
+ } else if (*n < *smlsiz) {
+ *info = -3;
+ } else if (*nrhs < 1) {
+ *info = -4;
+ } else if (*ldb < *n) {
+ *info = -6;
+ } else if (*ldbx < *n) {
+ *info = -8;
+ } else if (*ldu < *n) {
+ *info = -10;
+ } else if (*ldgcol < *n) {
+ *info = -19;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLALSA", &i__1);
+ return 0;
+ }
+
+/* Book-keeping and setting up the computation tree. */
+
+ inode = 1;
+ ndiml = inode + *n;
+ ndimr = ndiml + *n;
+
+ dlasdt_(n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr],
+ smlsiz);
+
+/*
+ The following code applies back the left singular vector factors.
+ For applying back the right singular vector factors, go to 50.
+*/
+
+ if (*icompq == 1) {
+ goto L50;
+ }
+
+/*
+ The nodes on the bottom level of the tree were solved
+ by DLASDQ. The corresponding left and right singular vector
+ matrices are in explicit form. First apply back the left
+ singular vector matrices.
+*/
+
+ ndb1 = (nd + 1) / 2;
+ i__1 = nd;
+ for (i__ = ndb1; i__ <= i__1; ++i__) {
+
+/*
+ IC : center row of each node
+ NL : number of rows of left subproblem
+ NR : number of rows of right subproblem
+ NLF: starting row of the left subproblem
+ NRF: starting row of the right subproblem
+*/
+
+ i1 = i__ - 1;
+ ic = iwork[inode + i1];
+ nl = iwork[ndiml + i1];
+ nr = iwork[ndimr + i1];
+ nlf = ic - nl;
+ nrf = ic + 1;
+ dgemm_("T", "N", &nl, nrhs, &nl, &c_b15, &u[nlf + u_dim1], ldu, &b[
+ nlf + b_dim1], ldb, &c_b29, &bx[nlf + bx_dim1], ldbx);
+ dgemm_("T", "N", &nr, nrhs, &nr, &c_b15, &u[nrf + u_dim1], ldu, &b[
+ nrf + b_dim1], ldb, &c_b29, &bx[nrf + bx_dim1], ldbx);
+/* L10: */
+ }
+
+/*
+ Next copy the rows of B that correspond to unchanged rows
+ in the bidiagonal matrix to BX.
+*/
+
+ i__1 = nd;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ ic = iwork[inode + i__ - 1];
+ dcopy_(nrhs, &b[ic + b_dim1], ldb, &bx[ic + bx_dim1], ldbx);
+/* L20: */
+ }
+
+/*
+ Finally go through the left singular vector matrices of all
+ the other subproblems bottom-up on the tree.
+*/
+
+ j = pow_ii(&c__2, &nlvl);
+ sqre = 0;
+
+ for (lvl = nlvl; lvl >= 1; --lvl) {
+ lvl2 = ((lvl) << (1)) - 1;
+
+/*
+ find the first node LF and last node LL on
+ the current level LVL
+*/
+
+ if (lvl == 1) {
+ lf = 1;
+ ll = 1;
+ } else {
+ i__1 = lvl - 1;
+ lf = pow_ii(&c__2, &i__1);
+ ll = ((lf) << (1)) - 1;
+ }
+ i__1 = ll;
+ for (i__ = lf; i__ <= i__1; ++i__) {
+ im1 = i__ - 1;
+ ic = iwork[inode + im1];
+ nl = iwork[ndiml + im1];
+ nr = iwork[ndimr + im1];
+ nlf = ic - nl;
+ nrf = ic + 1;
+ --j;
+ dlals0_(icompq, &nl, &nr, &sqre, nrhs, &bx[nlf + bx_dim1], ldbx, &
+ b[nlf + b_dim1], ldb, &perm[nlf + lvl * perm_dim1], &
+ givptr[j], &givcol[nlf + lvl2 * givcol_dim1], ldgcol, &
+ givnum[nlf + lvl2 * givnum_dim1], ldu, &poles[nlf + lvl2 *
+ poles_dim1], &difl[nlf + lvl * difl_dim1], &difr[nlf +
+ lvl2 * difr_dim1], &z__[nlf + lvl * z_dim1], &k[j], &c__[
+ j], &s[j], &work[1], info);
+/* L30: */
+ }
+/* L40: */
+ }
+ goto L90;
+
+/* ICOMPQ = 1: applying back the right singular vector factors. */
+
+L50:
+
+/*
+ First now go through the right singular vector matrices of all
+ the tree nodes top-down.
+*/
+
+ j = 0;
+ i__1 = nlvl;
+ for (lvl = 1; lvl <= i__1; ++lvl) {
+ lvl2 = ((lvl) << (1)) - 1;
+
+/*
+ Find the first node LF and last node LL on
+ the current level LVL.
+*/
+
+ if (lvl == 1) {
+ lf = 1;
+ ll = 1;
+ } else {
+ i__2 = lvl - 1;
+ lf = pow_ii(&c__2, &i__2);
+ ll = ((lf) << (1)) - 1;
+ }
+ i__2 = lf;
+ for (i__ = ll; i__ >= i__2; --i__) {
+ im1 = i__ - 1;
+ ic = iwork[inode + im1];
+ nl = iwork[ndiml + im1];
+ nr = iwork[ndimr + im1];
+ nlf = ic - nl;
+ nrf = ic + 1;
+ if (i__ == ll) {
+ sqre = 0;
+ } else {
+ sqre = 1;
+ }
+ ++j;
+ dlals0_(icompq, &nl, &nr, &sqre, nrhs, &b[nlf + b_dim1], ldb, &bx[
+ nlf + bx_dim1], ldbx, &perm[nlf + lvl * perm_dim1], &
+ givptr[j], &givcol[nlf + lvl2 * givcol_dim1], ldgcol, &
+ givnum[nlf + lvl2 * givnum_dim1], ldu, &poles[nlf + lvl2 *
+ poles_dim1], &difl[nlf + lvl * difl_dim1], &difr[nlf +
+ lvl2 * difr_dim1], &z__[nlf + lvl * z_dim1], &k[j], &c__[
+ j], &s[j], &work[1], info);
+/* L60: */
+ }
+/* L70: */
+ }
+
+/*
+ The nodes on the bottom level of the tree were solved
+ by DLASDQ. The corresponding right singular vector
+ matrices are in explicit form. Apply them back.
+*/
+
+ ndb1 = (nd + 1) / 2;
+ i__1 = nd;
+ for (i__ = ndb1; i__ <= i__1; ++i__) {
+ i1 = i__ - 1;
+ ic = iwork[inode + i1];
+ nl = iwork[ndiml + i1];
+ nr = iwork[ndimr + i1];
+ nlp1 = nl + 1;
+ if (i__ == nd) {
+ nrp1 = nr;
+ } else {
+ nrp1 = nr + 1;
+ }
+ nlf = ic - nl;
+ nrf = ic + 1;
+ dgemm_("T", "N", &nlp1, nrhs, &nlp1, &c_b15, &vt[nlf + vt_dim1], ldu,
+ &b[nlf + b_dim1], ldb, &c_b29, &bx[nlf + bx_dim1], ldbx);
+ dgemm_("T", "N", &nrp1, nrhs, &nrp1, &c_b15, &vt[nrf + vt_dim1], ldu,
+ &b[nrf + b_dim1], ldb, &c_b29, &bx[nrf + bx_dim1], ldbx);
+/* L80: */
+ }
+
+L90:
+
+ return 0;
+
+/* End of DLALSA */
+
+} /* dlalsa_ */
+
+/* Subroutine */ int dlalsd_(char *uplo, integer *smlsiz, integer *n, integer
+ *nrhs, doublereal *d__, doublereal *e, doublereal *b, integer *ldb,
+ doublereal *rcond, integer *rank, doublereal *work, integer *iwork,
+ integer *info)
+{
+ /* System generated locals */
+ integer b_dim1, b_offset, i__1, i__2;
+ doublereal d__1;
+
+ /* Builtin functions */
+ double log(doublereal), d_sign(doublereal *, doublereal *);
+
+ /* Local variables */
+ static integer c__, i__, j, k;
+ static doublereal r__;
+ static integer s, u, z__;
+ static doublereal cs;
+ static integer bx;
+ static doublereal sn;
+ static integer st, vt, nm1, st1;
+ static doublereal eps;
+ static integer iwk;
+ static doublereal tol;
+ static integer difl, difr, perm, nsub;
+ extern /* Subroutine */ int drot_(integer *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *);
+ static integer nlvl, sqre, bxst;
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *),
+ dcopy_(integer *, doublereal *, integer *, doublereal *, integer
+ *);
+ static integer poles, sizei, nsize, nwork, icmpq1, icmpq2;
+
+ extern /* Subroutine */ int dlasda_(integer *, integer *, integer *,
+ integer *, doublereal *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, doublereal *,
+ doublereal *, integer *, integer *, integer *, integer *,
+ doublereal *, doublereal *, doublereal *, doublereal *, integer *,
+ integer *), dlalsa_(integer *, integer *, integer *, integer *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, integer *, doublereal *, doublereal *,
+ doublereal *, doublereal *, integer *, integer *, integer *,
+ integer *, doublereal *, doublereal *, doublereal *, doublereal *,
+ integer *, integer *), dlascl_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, integer *, doublereal *,
+ integer *, integer *);
+ extern integer idamax_(integer *, doublereal *, integer *);
+ extern /* Subroutine */ int dlasdq_(char *, integer *, integer *, integer
+ *, integer *, integer *, doublereal *, doublereal *, doublereal *,
+ integer *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, integer *), dlacpy_(char *, integer *,
+ integer *, doublereal *, integer *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *,
+ doublereal *, doublereal *), dlaset_(char *, integer *, integer *,
+ doublereal *, doublereal *, doublereal *, integer *),
+ xerbla_(char *, integer *);
+ static integer givcol;
+ extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *);
+ extern /* Subroutine */ int dlasrt_(char *, integer *, doublereal *,
+ integer *);
+ static doublereal orgnrm;
+ static integer givnum, givptr, smlszp;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1999
+
+
+ Purpose
+ =======
+
+ DLALSD uses the singular value decomposition of A to solve the least
+ squares problem of finding X to minimize the Euclidean norm of each
+ column of A*X-B, where A is N-by-N upper bidiagonal, and X and B
+ are N-by-NRHS. The solution X overwrites B.
+
+ The singular values of A smaller than RCOND times the largest
+ singular value are treated as zero in solving the least squares
+ problem; in this case a minimum norm solution is returned.
+ The actual singular values are returned in D in ascending order.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray XMP, Cray YMP, Cray C 90, or Cray 2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': D and E define an upper bidiagonal matrix.
+ = 'L': D and E define a lower bidiagonal matrix.
+
+ SMLSIZ (input) INTEGER
+ The maximum size of the subproblems at the bottom of the
+ computation tree.
+
+ N (input) INTEGER
+ The dimension of the bidiagonal matrix. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of columns of B. NRHS must be at least 1.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry D contains the main diagonal of the bidiagonal
+ matrix. On exit, if INFO = 0, D contains its singular values.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ Contains the super-diagonal entries of the bidiagonal matrix.
+ On exit, E has been destroyed.
+
+ B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
+ On input, B contains the right hand sides of the least
+ squares problem. On output, B contains the solution X.
+
+ LDB (input) INTEGER
+ The leading dimension of B in the calling subprogram.
+ LDB must be at least max(1,N).
+
+ RCOND (input) DOUBLE PRECISION
+ The singular values of A less than or equal to RCOND times
+ the largest singular value are treated as zero in solving
+ the least squares problem. If RCOND is negative,
+ machine precision is used instead.
+ For example, if diag(S)*X=B were the least squares problem,
+ where diag(S) is a diagonal matrix of singular values, the
+ solution would be X(i) = B(i) / S(i) if S(i) is greater than
+ RCOND*max(S), and X(i) = 0 if S(i) is less than or equal to
+ RCOND*max(S).
+
+ RANK (output) INTEGER
+ The number of singular values of A greater than RCOND times
+ the largest singular value.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension at least
+ (9*N + 2*N*SMLSIZ + 8*N*NLVL + N*NRHS + (SMLSIZ+1)**2),
+ where NLVL = max(0, INT(log_2 (N/(SMLSIZ+1))) + 1).
+
+ IWORK (workspace) INTEGER array, dimension at least
+ (3*N*NLVL + 11*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an singular value while
+ working on the submatrix lying in rows and columns
+ INFO/(N+1) through MOD(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ --e;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ --work;
+ --iwork;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*n < 0) {
+ *info = -3;
+ } else if (*nrhs < 1) {
+ *info = -4;
+ } else if (*ldb < 1 || *ldb < *n) {
+ *info = -8;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLALSD", &i__1);
+ return 0;
+ }
+
+ eps = EPSILON;
+
+/* Set up the tolerance. */
+
+ if (*rcond <= 0. || *rcond >= 1.) {
+ *rcond = eps;
+ }
+
+ *rank = 0;
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return 0;
+ } else if (*n == 1) {
+ if (d__[1] == 0.) {
+ dlaset_("A", &c__1, nrhs, &c_b29, &c_b29, &b[b_offset], ldb);
+ } else {
+ *rank = 1;
+ dlascl_("G", &c__0, &c__0, &d__[1], &c_b15, &c__1, nrhs, &b[
+ b_offset], ldb, info);
+ d__[1] = abs(d__[1]);
+ }
+ return 0;
+ }
+
+/* Rotate the matrix if it is lower bidiagonal. */
+
+ if (*(unsigned char *)uplo == 'L') {
+ i__1 = *n - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dlartg_(&d__[i__], &e[i__], &cs, &sn, &r__);
+ d__[i__] = r__;
+ e[i__] = sn * d__[i__ + 1];
+ d__[i__ + 1] = cs * d__[i__ + 1];
+ if (*nrhs == 1) {
+ drot_(&c__1, &b[i__ + b_dim1], &c__1, &b[i__ + 1 + b_dim1], &
+ c__1, &cs, &sn);
+ } else {
+ work[((i__) << (1)) - 1] = cs;
+ work[i__ * 2] = sn;
+ }
+/* L10: */
+ }
+ if (*nrhs > 1) {
+ i__1 = *nrhs;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = *n - 1;
+ for (j = 1; j <= i__2; ++j) {
+ cs = work[((j) << (1)) - 1];
+ sn = work[j * 2];
+ drot_(&c__1, &b[j + i__ * b_dim1], &c__1, &b[j + 1 + i__ *
+ b_dim1], &c__1, &cs, &sn);
+/* L20: */
+ }
+/* L30: */
+ }
+ }
+ }
+
+/* Scale. */
+
+ nm1 = *n - 1;
+ orgnrm = dlanst_("M", n, &d__[1], &e[1]);
+ if (orgnrm == 0.) {
+ dlaset_("A", n, nrhs, &c_b29, &c_b29, &b[b_offset], ldb);
+ return 0;
+ }
+
+ dlascl_("G", &c__0, &c__0, &orgnrm, &c_b15, n, &c__1, &d__[1], n, info);
+ dlascl_("G", &c__0, &c__0, &orgnrm, &c_b15, &nm1, &c__1, &e[1], &nm1,
+ info);
+
+/*
+ If N is smaller than the minimum divide size SMLSIZ, then solve
+ the problem with another solver.
+*/
+
+ if (*n <= *smlsiz) {
+ nwork = *n * *n + 1;
+ dlaset_("A", n, n, &c_b29, &c_b15, &work[1], n);
+ dlasdq_("U", &c__0, n, n, &c__0, nrhs, &d__[1], &e[1], &work[1], n, &
+ work[1], n, &b[b_offset], ldb, &work[nwork], info);
+ if (*info != 0) {
+ return 0;
+ }
+ tol = *rcond * (d__1 = d__[idamax_(n, &d__[1], &c__1)], abs(d__1));
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if (d__[i__] <= tol) {
+ dlaset_("A", &c__1, nrhs, &c_b29, &c_b29, &b[i__ + b_dim1],
+ ldb);
+ } else {
+ dlascl_("G", &c__0, &c__0, &d__[i__], &c_b15, &c__1, nrhs, &b[
+ i__ + b_dim1], ldb, info);
+ ++(*rank);
+ }
+/* L40: */
+ }
+ dgemm_("T", "N", n, nrhs, n, &c_b15, &work[1], n, &b[b_offset], ldb, &
+ c_b29, &work[nwork], n);
+ dlacpy_("A", n, nrhs, &work[nwork], n, &b[b_offset], ldb);
+
+/* Unscale. */
+
+ dlascl_("G", &c__0, &c__0, &c_b15, &orgnrm, n, &c__1, &d__[1], n,
+ info);
+ dlasrt_("D", n, &d__[1], info);
+ dlascl_("G", &c__0, &c__0, &orgnrm, &c_b15, n, nrhs, &b[b_offset],
+ ldb, info);
+
+ return 0;
+ }
+
+/* Book-keeping and setting up some constants. */
+
+ nlvl = (integer) (log((doublereal) (*n) / (doublereal) (*smlsiz + 1)) /
+ log(2.)) + 1;
+
+ smlszp = *smlsiz + 1;
+
+ u = 1;
+ vt = *smlsiz * *n + 1;
+ difl = vt + smlszp * *n;
+ difr = difl + nlvl * *n;
+ z__ = difr + ((nlvl * *n) << (1));
+ c__ = z__ + nlvl * *n;
+ s = c__ + *n;
+ poles = s + *n;
+ givnum = poles + ((nlvl) << (1)) * *n;
+ bx = givnum + ((nlvl) << (1)) * *n;
+ nwork = bx + *n * *nrhs;
+
+ sizei = *n + 1;
+ k = sizei + *n;
+ givptr = k + *n;
+ perm = givptr + *n;
+ givcol = perm + nlvl * *n;
+ iwk = givcol + ((nlvl * *n) << (1));
+
+ st = 1;
+ sqre = 0;
+ icmpq1 = 1;
+ icmpq2 = 0;
+ nsub = 0;
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if ((d__1 = d__[i__], abs(d__1)) < eps) {
+ d__[i__] = d_sign(&eps, &d__[i__]);
+ }
+/* L50: */
+ }
+
+ i__1 = nm1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if ((d__1 = e[i__], abs(d__1)) < eps || i__ == nm1) {
+ ++nsub;
+ iwork[nsub] = st;
+
+/*
+ Subproblem found. First determine its size and then
+ apply divide and conquer on it.
+*/
+
+ if (i__ < nm1) {
+
+/* A subproblem with E(I) small for I < NM1. */
+
+ nsize = i__ - st + 1;
+ iwork[sizei + nsub - 1] = nsize;
+ } else if ((d__1 = e[i__], abs(d__1)) >= eps) {
+
+/* A subproblem with E(NM1) not too small but I = NM1. */
+
+ nsize = *n - st + 1;
+ iwork[sizei + nsub - 1] = nsize;
+ } else {
+
+/*
+ A subproblem with E(NM1) small. This implies an
+ 1-by-1 subproblem at D(N), which is not solved
+ explicitly.
+*/
+
+ nsize = i__ - st + 1;
+ iwork[sizei + nsub - 1] = nsize;
+ ++nsub;
+ iwork[nsub] = *n;
+ iwork[sizei + nsub - 1] = 1;
+ dcopy_(nrhs, &b[*n + b_dim1], ldb, &work[bx + nm1], n);
+ }
+ st1 = st - 1;
+ if (nsize == 1) {
+
+/*
+ This is a 1-by-1 subproblem and is not solved
+ explicitly.
+*/
+
+ dcopy_(nrhs, &b[st + b_dim1], ldb, &work[bx + st1], n);
+ } else if (nsize <= *smlsiz) {
+
+/* This is a small subproblem and is solved by DLASDQ. */
+
+ dlaset_("A", &nsize, &nsize, &c_b29, &c_b15, &work[vt + st1],
+ n);
+ dlasdq_("U", &c__0, &nsize, &nsize, &c__0, nrhs, &d__[st], &e[
+ st], &work[vt + st1], n, &work[nwork], n, &b[st +
+ b_dim1], ldb, &work[nwork], info);
+ if (*info != 0) {
+ return 0;
+ }
+ dlacpy_("A", &nsize, nrhs, &b[st + b_dim1], ldb, &work[bx +
+ st1], n);
+ } else {
+
+/* A large problem. Solve it using divide and conquer. */
+
+ dlasda_(&icmpq1, smlsiz, &nsize, &sqre, &d__[st], &e[st], &
+ work[u + st1], n, &work[vt + st1], &iwork[k + st1], &
+ work[difl + st1], &work[difr + st1], &work[z__ + st1],
+ &work[poles + st1], &iwork[givptr + st1], &iwork[
+ givcol + st1], n, &iwork[perm + st1], &work[givnum +
+ st1], &work[c__ + st1], &work[s + st1], &work[nwork],
+ &iwork[iwk], info);
+ if (*info != 0) {
+ return 0;
+ }
+ bxst = bx + st1;
+ dlalsa_(&icmpq2, smlsiz, &nsize, nrhs, &b[st + b_dim1], ldb, &
+ work[bxst], n, &work[u + st1], n, &work[vt + st1], &
+ iwork[k + st1], &work[difl + st1], &work[difr + st1],
+ &work[z__ + st1], &work[poles + st1], &iwork[givptr +
+ st1], &iwork[givcol + st1], n, &iwork[perm + st1], &
+ work[givnum + st1], &work[c__ + st1], &work[s + st1],
+ &work[nwork], &iwork[iwk], info);
+ if (*info != 0) {
+ return 0;
+ }
+ }
+ st = i__ + 1;
+ }
+/* L60: */
+ }
+
+/* Apply the singular values and treat the tiny ones as zero. */
+
+ tol = *rcond * (d__1 = d__[idamax_(n, &d__[1], &c__1)], abs(d__1));
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/*
+ Some of the elements in D can be negative because 1-by-1
+ subproblems were not solved explicitly.
+*/
+
+ if ((d__1 = d__[i__], abs(d__1)) <= tol) {
+ dlaset_("A", &c__1, nrhs, &c_b29, &c_b29, &work[bx + i__ - 1], n);
+ } else {
+ ++(*rank);
+ dlascl_("G", &c__0, &c__0, &d__[i__], &c_b15, &c__1, nrhs, &work[
+ bx + i__ - 1], n, info);
+ }
+ d__[i__] = (d__1 = d__[i__], abs(d__1));
+/* L70: */
+ }
+
+/* Now apply back the right singular vectors. */
+
+ icmpq2 = 1;
+ i__1 = nsub;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ st = iwork[i__];
+ st1 = st - 1;
+ nsize = iwork[sizei + i__ - 1];
+ bxst = bx + st1;
+ if (nsize == 1) {
+ dcopy_(nrhs, &work[bxst], n, &b[st + b_dim1], ldb);
+ } else if (nsize <= *smlsiz) {
+ dgemm_("T", "N", &nsize, nrhs, &nsize, &c_b15, &work[vt + st1], n,
+ &work[bxst], n, &c_b29, &b[st + b_dim1], ldb);
+ } else {
+ dlalsa_(&icmpq2, smlsiz, &nsize, nrhs, &work[bxst], n, &b[st +
+ b_dim1], ldb, &work[u + st1], n, &work[vt + st1], &iwork[
+ k + st1], &work[difl + st1], &work[difr + st1], &work[z__
+ + st1], &work[poles + st1], &iwork[givptr + st1], &iwork[
+ givcol + st1], n, &iwork[perm + st1], &work[givnum + st1],
+ &work[c__ + st1], &work[s + st1], &work[nwork], &iwork[
+ iwk], info);
+ if (*info != 0) {
+ return 0;
+ }
+ }
+/* L80: */
+ }
+
+/* Unscale and sort the singular values. */
+
+ dlascl_("G", &c__0, &c__0, &c_b15, &orgnrm, n, &c__1, &d__[1], n, info);
+ dlasrt_("D", n, &d__[1], info);
+ dlascl_("G", &c__0, &c__0, &orgnrm, &c_b15, n, nrhs, &b[b_offset], ldb,
+ info);
+
+ return 0;
+
+/* End of DLALSD */
+
+} /* dlalsd_ */
+
+/* Subroutine */ int dlamrg_(integer *n1, integer *n2, doublereal *a, integer
+ *dtrd1, integer *dtrd2, integer *index)
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ static integer i__, ind1, ind2, n1sv, n2sv;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ DLAMRG will create a permutation list which will merge the elements
+ of A (which is composed of two independently sorted sets) into a
+ single set which is sorted in ascending order.
+
+ Arguments
+ =========
+
+ N1 (input) INTEGER
+ N2 (input) INTEGER
+ These arguements contain the respective lengths of the two
+ sorted lists to be merged.
+
+ A (input) DOUBLE PRECISION array, dimension (N1+N2)
+ The first N1 elements of A contain a list of numbers which
+ are sorted in either ascending or descending order. Likewise
+ for the final N2 elements.
+
+ DTRD1 (input) INTEGER
+ DTRD2 (input) INTEGER
+ These are the strides to be taken through the array A.
+ Allowable strides are 1 and -1. They indicate whether a
+ subset of A is sorted in ascending (DTRDx = 1) or descending
+ (DTRDx = -1) order.
+
+ INDEX (output) INTEGER array, dimension (N1+N2)
+ On exit this array will contain a permutation such that
+ if B( I ) = A( INDEX( I ) ) for I=1,N1+N2, then B will be
+ sorted in ascending order.
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ --index;
+ --a;
+
+ /* Function Body */
+ n1sv = *n1;
+ n2sv = *n2;
+ if (*dtrd1 > 0) {
+ ind1 = 1;
+ } else {
+ ind1 = *n1;
+ }
+ if (*dtrd2 > 0) {
+ ind2 = *n1 + 1;
+ } else {
+ ind2 = *n1 + *n2;
+ }
+ i__ = 1;
+/* while ( (N1SV > 0) & (N2SV > 0) ) */
+L10:
+ if ((n1sv > 0 && n2sv > 0)) {
+ if (a[ind1] <= a[ind2]) {
+ index[i__] = ind1;
+ ++i__;
+ ind1 += *dtrd1;
+ --n1sv;
+ } else {
+ index[i__] = ind2;
+ ++i__;
+ ind2 += *dtrd2;
+ --n2sv;
+ }
+ goto L10;
+ }
+/* end while */
+ if (n1sv == 0) {
+ i__1 = n2sv;
+ for (n1sv = 1; n1sv <= i__1; ++n1sv) {
+ index[i__] = ind2;
+ ++i__;
+ ind2 += *dtrd2;
+/* L20: */
+ }
+ } else {
+/* N2SV .EQ. 0 */
+ i__1 = n1sv;
+ for (n2sv = 1; n2sv <= i__1; ++n2sv) {
+ index[i__] = ind1;
+ ++i__;
+ ind1 += *dtrd1;
+/* L30: */
+ }
+ }
+
+ return 0;
+
+/* End of DLAMRG */
+
+} /* dlamrg_ */
+
+doublereal dlange_(char *norm, integer *m, integer *n, doublereal *a, integer
+ *lda, doublereal *work)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+ doublereal ret_val, d__1, d__2, d__3;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static integer i__, j;
+ static doublereal sum, scale;
+ extern logical lsame_(char *, char *);
+ static doublereal value;
+ extern /* Subroutine */ int dlassq_(integer *, doublereal *, integer *,
+ doublereal *, doublereal *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLANGE returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real matrix A.
+
+ Description
+ ===========
+
+ DLANGE returns the value
+
+ DLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a matrix norm.
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANGE as described
+ above.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0. When M = 0,
+ DLANGE is set to zero.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0. When N = 0,
+ DLANGE is set to zero.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The m by n matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(M,1).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (LWORK),
+ where LWORK >= M when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --work;
+
+ /* Function Body */
+ if (min(*m,*n) == 0) {
+ value = 0.;
+ } else if (lsame_(norm, "M")) {
+
+/* Find max(abs(A(i,j))). */
+
+ value = 0.;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+/* Computing MAX */
+ d__2 = value, d__3 = (d__1 = a[i__ + j * a_dim1], abs(d__1));
+ value = max(d__2,d__3);
+/* L10: */
+ }
+/* L20: */
+ }
+ } else if (lsame_(norm, "O") || *(unsigned char *)
+ norm == '1') {
+
+/* Find norm1(A). */
+
+ value = 0.;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ sum = 0.;
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ sum += (d__1 = a[i__ + j * a_dim1], abs(d__1));
+/* L30: */
+ }
+ value = max(value,sum);
+/* L40: */
+ }
+ } else if (lsame_(norm, "I")) {
+
+/* Find normI(A). */
+
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ work[i__] = 0.;
+/* L50: */
+ }
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ work[i__] += (d__1 = a[i__ + j * a_dim1], abs(d__1));
+/* L60: */
+ }
+/* L70: */
+ }
+ value = 0.;
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+/* Computing MAX */
+ d__1 = value, d__2 = work[i__];
+ value = max(d__1,d__2);
+/* L80: */
+ }
+ } else if (lsame_(norm, "F") || lsame_(norm, "E")) {
+
+/* Find normF(A). */
+
+ scale = 0.;
+ sum = 1.;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ dlassq_(m, &a[j * a_dim1 + 1], &c__1, &scale, &sum);
+/* L90: */
+ }
+ value = scale * sqrt(sum);
+ }
+
+ ret_val = value;
+ return ret_val;
+
+/* End of DLANGE */
+
+} /* dlange_ */
+
+doublereal dlanhs_(char *norm, integer *n, doublereal *a, integer *lda,
+ doublereal *work)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+ doublereal ret_val, d__1, d__2, d__3;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static integer i__, j;
+ static doublereal sum, scale;
+ extern logical lsame_(char *, char *);
+ static doublereal value;
+ extern /* Subroutine */ int dlassq_(integer *, doublereal *, integer *,
+ doublereal *, doublereal *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLANHS returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ Hessenberg matrix A.
+
+ Description
+ ===========
+
+ DLANHS returns the value
+
+ DLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a matrix norm.
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANHS as described
+ above.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANHS is
+ set to zero.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The n by n upper Hessenberg matrix A; the part of A below the
+ first sub-diagonal is not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(N,1).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (LWORK),
+ where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --work;
+
+ /* Function Body */
+ if (*n == 0) {
+ value = 0.;
+ } else if (lsame_(norm, "M")) {
+
+/* Find max(abs(A(i,j))). */
+
+ value = 0.;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MIN */
+ i__3 = *n, i__4 = j + 1;
+ i__2 = min(i__3,i__4);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+/* Computing MAX */
+ d__2 = value, d__3 = (d__1 = a[i__ + j * a_dim1], abs(d__1));
+ value = max(d__2,d__3);
+/* L10: */
+ }
+/* L20: */
+ }
+ } else if (lsame_(norm, "O") || *(unsigned char *)
+ norm == '1') {
+
+/* Find norm1(A). */
+
+ value = 0.;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ sum = 0.;
+/* Computing MIN */
+ i__3 = *n, i__4 = j + 1;
+ i__2 = min(i__3,i__4);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ sum += (d__1 = a[i__ + j * a_dim1], abs(d__1));
+/* L30: */
+ }
+ value = max(value,sum);
+/* L40: */
+ }
+ } else if (lsame_(norm, "I")) {
+
+/* Find normI(A). */
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ work[i__] = 0.;
+/* L50: */
+ }
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MIN */
+ i__3 = *n, i__4 = j + 1;
+ i__2 = min(i__3,i__4);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ work[i__] += (d__1 = a[i__ + j * a_dim1], abs(d__1));
+/* L60: */
+ }
+/* L70: */
+ }
+ value = 0.;
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+/* Computing MAX */
+ d__1 = value, d__2 = work[i__];
+ value = max(d__1,d__2);
+/* L80: */
+ }
+ } else if (lsame_(norm, "F") || lsame_(norm, "E")) {
+
+/* Find normF(A). */
+
+ scale = 0.;
+ sum = 1.;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MIN */
+ i__3 = *n, i__4 = j + 1;
+ i__2 = min(i__3,i__4);
+ dlassq_(&i__2, &a[j * a_dim1 + 1], &c__1, &scale, &sum);
+/* L90: */
+ }
+ value = scale * sqrt(sum);
+ }
+
+ ret_val = value;
+ return ret_val;
+
+/* End of DLANHS */
+
+} /* dlanhs_ */
+
+doublereal dlanst_(char *norm, integer *n, doublereal *d__, doublereal *e)
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal ret_val, d__1, d__2, d__3, d__4, d__5;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static integer i__;
+ static doublereal sum, scale;
+ extern logical lsame_(char *, char *);
+ static doublereal anorm;
+ extern /* Subroutine */ int dlassq_(integer *, doublereal *, integer *,
+ doublereal *, doublereal *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ February 29, 1992
+
+
+ Purpose
+ =======
+
+ DLANST returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real symmetric tridiagonal matrix A.
+
+ Description
+ ===========
+
+ DLANST returns the value
+
+ DLANST = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a matrix norm.
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANST as described
+ above.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANST is
+ set to zero.
+
+ D (input) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of A.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ The (n-1) sub-diagonal or super-diagonal elements of A.
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ --e;
+ --d__;
+
+ /* Function Body */
+ if (*n <= 0) {
+ anorm = 0.;
+ } else if (lsame_(norm, "M")) {
+
+/* Find max(abs(A(i,j))). */
+
+ anorm = (d__1 = d__[*n], abs(d__1));
+ i__1 = *n - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+/* Computing MAX */
+ d__2 = anorm, d__3 = (d__1 = d__[i__], abs(d__1));
+ anorm = max(d__2,d__3);
+/* Computing MAX */
+ d__2 = anorm, d__3 = (d__1 = e[i__], abs(d__1));
+ anorm = max(d__2,d__3);
+/* L10: */
+ }
+ } else if (lsame_(norm, "O") || *(unsigned char *)
+ norm == '1' || lsame_(norm, "I")) {
+
+/* Find norm1(A). */
+
+ if (*n == 1) {
+ anorm = abs(d__[1]);
+ } else {
+/* Computing MAX */
+ d__3 = abs(d__[1]) + abs(e[1]), d__4 = (d__1 = e[*n - 1], abs(
+ d__1)) + (d__2 = d__[*n], abs(d__2));
+ anorm = max(d__3,d__4);
+ i__1 = *n - 1;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+/* Computing MAX */
+ d__4 = anorm, d__5 = (d__1 = d__[i__], abs(d__1)) + (d__2 = e[
+ i__], abs(d__2)) + (d__3 = e[i__ - 1], abs(d__3));
+ anorm = max(d__4,d__5);
+/* L20: */
+ }
+ }
+ } else if (lsame_(norm, "F") || lsame_(norm, "E")) {
+
+/* Find normF(A). */
+
+ scale = 0.;
+ sum = 1.;
+ if (*n > 1) {
+ i__1 = *n - 1;
+ dlassq_(&i__1, &e[1], &c__1, &scale, &sum);
+ sum *= 2;
+ }
+ dlassq_(n, &d__[1], &c__1, &scale, &sum);
+ anorm = scale * sqrt(sum);
+ }
+
+ ret_val = anorm;
+ return ret_val;
+
+/* End of DLANST */
+
+} /* dlanst_ */
+
+doublereal dlansy_(char *norm, char *uplo, integer *n, doublereal *a, integer
+ *lda, doublereal *work)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+ doublereal ret_val, d__1, d__2, d__3;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static integer i__, j;
+ static doublereal sum, absa, scale;
+ extern logical lsame_(char *, char *);
+ static doublereal value;
+ extern /* Subroutine */ int dlassq_(integer *, doublereal *, integer *,
+ doublereal *, doublereal *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLANSY returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ real symmetric matrix A.
+
+ Description
+ ===========
+
+ DLANSY returns the value
+
+ DLANSY = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a matrix norm.
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in DLANSY as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is to be referenced.
+ = 'U': Upper triangular part of A is referenced
+ = 'L': Lower triangular part of A is referenced
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, DLANSY is
+ set to zero.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The symmetric matrix A. If UPLO = 'U', the leading n by n
+ upper triangular part of A contains the upper triangular part
+ of the matrix A, and the strictly lower triangular part of A
+ is not referenced. If UPLO = 'L', the leading n by n lower
+ triangular part of A contains the lower triangular part of
+ the matrix A, and the strictly upper triangular part of A is
+ not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(N,1).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (LWORK),
+ where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
+ WORK is not referenced.
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --work;
+
+ /* Function Body */
+ if (*n == 0) {
+ value = 0.;
+ } else if (lsame_(norm, "M")) {
+
+/* Find max(abs(A(i,j))). */
+
+ value = 0.;
+ if (lsame_(uplo, "U")) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+/* Computing MAX */
+ d__2 = value, d__3 = (d__1 = a[i__ + j * a_dim1], abs(
+ d__1));
+ value = max(d__2,d__3);
+/* L10: */
+ }
+/* L20: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = j; i__ <= i__2; ++i__) {
+/* Computing MAX */
+ d__2 = value, d__3 = (d__1 = a[i__ + j * a_dim1], abs(
+ d__1));
+ value = max(d__2,d__3);
+/* L30: */
+ }
+/* L40: */
+ }
+ }
+ } else if (lsame_(norm, "I") || lsame_(norm, "O") || *(unsigned char *)norm == '1') {
+
+/* Find normI(A) ( = norm1(A), since A is symmetric). */
+
+ value = 0.;
+ if (lsame_(uplo, "U")) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ sum = 0.;
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ absa = (d__1 = a[i__ + j * a_dim1], abs(d__1));
+ sum += absa;
+ work[i__] += absa;
+/* L50: */
+ }
+ work[j] = sum + (d__1 = a[j + j * a_dim1], abs(d__1));
+/* L60: */
+ }
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+/* Computing MAX */
+ d__1 = value, d__2 = work[i__];
+ value = max(d__1,d__2);
+/* L70: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ work[i__] = 0.;
+/* L80: */
+ }
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ sum = work[j] + (d__1 = a[j + j * a_dim1], abs(d__1));
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ absa = (d__1 = a[i__ + j * a_dim1], abs(d__1));
+ sum += absa;
+ work[i__] += absa;
+/* L90: */
+ }
+ value = max(value,sum);
+/* L100: */
+ }
+ }
+ } else if (lsame_(norm, "F") || lsame_(norm, "E")) {
+
+/* Find normF(A). */
+
+ scale = 0.;
+ sum = 1.;
+ if (lsame_(uplo, "U")) {
+ i__1 = *n;
+ for (j = 2; j <= i__1; ++j) {
+ i__2 = j - 1;
+ dlassq_(&i__2, &a[j * a_dim1 + 1], &c__1, &scale, &sum);
+/* L110: */
+ }
+ } else {
+ i__1 = *n - 1;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n - j;
+ dlassq_(&i__2, &a[j + 1 + j * a_dim1], &c__1, &scale, &sum);
+/* L120: */
+ }
+ }
+ sum *= 2;
+ i__1 = *lda + 1;
+ dlassq_(n, &a[a_offset], &i__1, &scale, &sum);
+ value = scale * sqrt(sum);
+ }
+
+ ret_val = value;
+ return ret_val;
+
+/* End of DLANSY */
+
+} /* dlansy_ */
+
+/* Subroutine */ int dlanv2_(doublereal *a, doublereal *b, doublereal *c__,
+ doublereal *d__, doublereal *rt1r, doublereal *rt1i, doublereal *rt2r,
+ doublereal *rt2i, doublereal *cs, doublereal *sn)
+{
+ /* System generated locals */
+ doublereal d__1, d__2;
+
+ /* Builtin functions */
+ double d_sign(doublereal *, doublereal *), sqrt(doublereal);
+
+ /* Local variables */
+ static doublereal p, z__, aa, bb, cc, dd, cs1, sn1, sab, sac, eps, tau,
+ temp, scale, bcmax, bcmis, sigma;
+
+
+
+/*
+ -- LAPACK driver routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric
+ matrix in standard form:
+
+ [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ]
+ [ C D ] [ SN CS ] [ CC DD ] [-SN CS ]
+
+ where either
+ 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or
+ 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex
+ conjugate eigenvalues.
+
+ Arguments
+ =========
+
+ A (input/output) DOUBLE PRECISION
+ B (input/output) DOUBLE PRECISION
+ C (input/output) DOUBLE PRECISION
+ D (input/output) DOUBLE PRECISION
+ On entry, the elements of the input matrix.
+ On exit, they are overwritten by the elements of the
+ standardised Schur form.
+
+ RT1R (output) DOUBLE PRECISION
+ RT1I (output) DOUBLE PRECISION
+ RT2R (output) DOUBLE PRECISION
+ RT2I (output) DOUBLE PRECISION
+ The real and imaginary parts of the eigenvalues. If the
+ eigenvalues are a complex conjugate pair, RT1I > 0.
+
+ CS (output) DOUBLE PRECISION
+ SN (output) DOUBLE PRECISION
+ Parameters of the rotation matrix.
+
+ Further Details
+ ===============
+
+ Modified by V. Sima, Research Institute for Informatics, Bucharest,
+ Romania, to reduce the risk of cancellation errors,
+ when computing real eigenvalues, and to ensure, if possible, that
+ abs(RT1R) >= abs(RT2R).
+
+ =====================================================================
+*/
+
+
+ eps = PRECISION;
+ if (*c__ == 0.) {
+ *cs = 1.;
+ *sn = 0.;
+ goto L10;
+
+ } else if (*b == 0.) {
+
+/* Swap rows and columns */
+
+ *cs = 0.;
+ *sn = 1.;
+ temp = *d__;
+ *d__ = *a;
+ *a = temp;
+ *b = -(*c__);
+ *c__ = 0.;
+ goto L10;
+ } else if ((*a - *d__ == 0. && d_sign(&c_b15, b) != d_sign(&c_b15, c__)))
+ {
+ *cs = 1.;
+ *sn = 0.;
+ goto L10;
+ } else {
+
+ temp = *a - *d__;
+ p = temp * .5;
+/* Computing MAX */
+ d__1 = abs(*b), d__2 = abs(*c__);
+ bcmax = max(d__1,d__2);
+/* Computing MIN */
+ d__1 = abs(*b), d__2 = abs(*c__);
+ bcmis = min(d__1,d__2) * d_sign(&c_b15, b) * d_sign(&c_b15, c__);
+/* Computing MAX */
+ d__1 = abs(p);
+ scale = max(d__1,bcmax);
+ z__ = p / scale * p + bcmax / scale * bcmis;
+
+/*
+ If Z is of the order of the machine accuracy, postpone the
+ decision on the nature of eigenvalues
+*/
+
+ if (z__ >= eps * 4.) {
+
+/* Real eigenvalues. Compute A and D. */
+
+ d__1 = sqrt(scale) * sqrt(z__);
+ z__ = p + d_sign(&d__1, &p);
+ *a = *d__ + z__;
+ *d__ -= bcmax / z__ * bcmis;
+
+/* Compute B and the rotation matrix */
+
+ tau = dlapy2_(c__, &z__);
+ *cs = z__ / tau;
+ *sn = *c__ / tau;
+ *b -= *c__;
+ *c__ = 0.;
+ } else {
+
+/*
+ Complex eigenvalues, or real (almost) equal eigenvalues.
+ Make diagonal elements equal.
+*/
+
+ sigma = *b + *c__;
+ tau = dlapy2_(&sigma, &temp);
+ *cs = sqrt((abs(sigma) / tau + 1.) * .5);
+ *sn = -(p / (tau * *cs)) * d_sign(&c_b15, &sigma);
+
+/*
+ Compute [ AA BB ] = [ A B ] [ CS -SN ]
+ [ CC DD ] [ C D ] [ SN CS ]
+*/
+
+ aa = *a * *cs + *b * *sn;
+ bb = -(*a) * *sn + *b * *cs;
+ cc = *c__ * *cs + *d__ * *sn;
+ dd = -(*c__) * *sn + *d__ * *cs;
+
+/*
+ Compute [ A B ] = [ CS SN ] [ AA BB ]
+ [ C D ] [-SN CS ] [ CC DD ]
+*/
+
+ *a = aa * *cs + cc * *sn;
+ *b = bb * *cs + dd * *sn;
+ *c__ = -aa * *sn + cc * *cs;
+ *d__ = -bb * *sn + dd * *cs;
+
+ temp = (*a + *d__) * .5;
+ *a = temp;
+ *d__ = temp;
+
+ if (*c__ != 0.) {
+ if (*b != 0.) {
+ if (d_sign(&c_b15, b) == d_sign(&c_b15, c__)) {
+
+/* Real eigenvalues: reduce to upper triangular form */
+
+ sab = sqrt((abs(*b)));
+ sac = sqrt((abs(*c__)));
+ d__1 = sab * sac;
+ p = d_sign(&d__1, c__);
+ tau = 1. / sqrt((d__1 = *b + *c__, abs(d__1)));
+ *a = temp + p;
+ *d__ = temp - p;
+ *b -= *c__;
+ *c__ = 0.;
+ cs1 = sab * tau;
+ sn1 = sac * tau;
+ temp = *cs * cs1 - *sn * sn1;
+ *sn = *cs * sn1 + *sn * cs1;
+ *cs = temp;
+ }
+ } else {
+ *b = -(*c__);
+ *c__ = 0.;
+ temp = *cs;
+ *cs = -(*sn);
+ *sn = temp;
+ }
+ }
+ }
+
+ }
+
+L10:
+
+/* Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I). */
+
+ *rt1r = *a;
+ *rt2r = *d__;
+ if (*c__ == 0.) {
+ *rt1i = 0.;
+ *rt2i = 0.;
+ } else {
+ *rt1i = sqrt((abs(*b))) * sqrt((abs(*c__)));
+ *rt2i = -(*rt1i);
+ }
+ return 0;
+
+/* End of DLANV2 */
+
+} /* dlanv2_ */
+
+doublereal dlapy2_(doublereal *x, doublereal *y)
+{
+ /* System generated locals */
+ doublereal ret_val, d__1;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static doublereal w, z__, xabs, yabs;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
+ overflow.
+
+ Arguments
+ =========
+
+ X (input) DOUBLE PRECISION
+ Y (input) DOUBLE PRECISION
+ X and Y specify the values x and y.
+
+ =====================================================================
+*/
+
+
+ xabs = abs(*x);
+ yabs = abs(*y);
+ w = max(xabs,yabs);
+ z__ = min(xabs,yabs);
+ if (z__ == 0.) {
+ ret_val = w;
+ } else {
+/* Computing 2nd power */
+ d__1 = z__ / w;
+ ret_val = w * sqrt(d__1 * d__1 + 1.);
+ }
+ return ret_val;
+
+/* End of DLAPY2 */
+
+} /* dlapy2_ */
+
+doublereal dlapy3_(doublereal *x, doublereal *y, doublereal *z__)
+{
+ /* System generated locals */
+ doublereal ret_val, d__1, d__2, d__3;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static doublereal w, xabs, yabs, zabs;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause
+ unnecessary overflow.
+
+ Arguments
+ =========
+
+ X (input) DOUBLE PRECISION
+ Y (input) DOUBLE PRECISION
+ Z (input) DOUBLE PRECISION
+ X, Y and Z specify the values x, y and z.
+
+ =====================================================================
+*/
+
+
+ xabs = abs(*x);
+ yabs = abs(*y);
+ zabs = abs(*z__);
+/* Computing MAX */
+ d__1 = max(xabs,yabs);
+ w = max(d__1,zabs);
+ if (w == 0.) {
+ ret_val = 0.;
+ } else {
+/* Computing 2nd power */
+ d__1 = xabs / w;
+/* Computing 2nd power */
+ d__2 = yabs / w;
+/* Computing 2nd power */
+ d__3 = zabs / w;
+ ret_val = w * sqrt(d__1 * d__1 + d__2 * d__2 + d__3 * d__3);
+ }
+ return ret_val;
+
+/* End of DLAPY3 */
+
+} /* dlapy3_ */
+
+/* Subroutine */ int dlarf_(char *side, integer *m, integer *n, doublereal *v,
+ integer *incv, doublereal *tau, doublereal *c__, integer *ldc,
+ doublereal *work)
+{
+ /* System generated locals */
+ integer c_dim1, c_offset;
+ doublereal d__1;
+
+ /* Local variables */
+ extern /* Subroutine */ int dger_(integer *, integer *, doublereal *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ integer *);
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, doublereal *, integer *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ February 29, 1992
+
+
+ Purpose
+ =======
+
+ DLARF applies a real elementary reflector H to a real m by n matrix
+ C, from either the left or the right. H is represented in the form
+
+ H = I - tau * v * v'
+
+ where tau is a real scalar and v is a real vector.
+
+ If tau = 0, then H is taken to be the unit matrix.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form H * C
+ = 'R': form C * H
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ V (input) DOUBLE PRECISION array, dimension
+ (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+ or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+ The vector v in the representation of H. V is not used if
+ TAU = 0.
+
+ INCV (input) INTEGER
+ The increment between elements of v. INCV <> 0.
+
+ TAU (input) DOUBLE PRECISION
+ The value tau in the representation of H.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+ or C * H if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L'
+ or (M) if SIDE = 'R'
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ --v;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ if (lsame_(side, "L")) {
+
+/* Form H * C */
+
+ if (*tau != 0.) {
+
+/* w := C' * v */
+
+ dgemv_("Transpose", m, n, &c_b15, &c__[c_offset], ldc, &v[1],
+ incv, &c_b29, &work[1], &c__1);
+
+/* C := C - v * w' */
+
+ d__1 = -(*tau);
+ dger_(m, n, &d__1, &v[1], incv, &work[1], &c__1, &c__[c_offset],
+ ldc);
+ }
+ } else {
+
+/* Form C * H */
+
+ if (*tau != 0.) {
+
+/* w := C * v */
+
+ dgemv_("No transpose", m, n, &c_b15, &c__[c_offset], ldc, &v[1],
+ incv, &c_b29, &work[1], &c__1);
+
+/* C := C - w * v' */
+
+ d__1 = -(*tau);
+ dger_(m, n, &d__1, &work[1], &c__1, &v[1], incv, &c__[c_offset],
+ ldc);
+ }
+ }
+ return 0;
+
+/* End of DLARF */
+
+} /* dlarf_ */
+
+/* Subroutine */ int dlarfb_(char *side, char *trans, char *direct, char *
+ storev, integer *m, integer *n, integer *k, doublereal *v, integer *
+ ldv, doublereal *t, integer *ldt, doublereal *c__, integer *ldc,
+ doublereal *work, integer *ldwork)
+{
+ /* System generated locals */
+ integer c_dim1, c_offset, t_dim1, t_offset, v_dim1, v_offset, work_dim1,
+ work_offset, i__1, i__2;
+
+ /* Local variables */
+ static integer i__, j;
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *);
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
+ doublereal *, integer *), dtrmm_(char *, char *, char *, char *,
+ integer *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *);
+ static char transt[1];
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ February 29, 1992
+
+
+ Purpose
+ =======
+
+ DLARFB applies a real block reflector H or its transpose H' to a
+ real m by n matrix C, from either the left or the right.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply H or H' from the Left
+ = 'R': apply H or H' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply H (No transpose)
+ = 'T': apply H' (Transpose)
+
+ DIRECT (input) CHARACTER*1
+ Indicates how H is formed from a product of elementary
+ reflectors
+ = 'F': H = H(1) H(2) . . . H(k) (Forward)
+ = 'B': H = H(k) . . . H(2) H(1) (Backward)
+
+ STOREV (input) CHARACTER*1
+ Indicates how the vectors which define the elementary
+ reflectors are stored:
+ = 'C': Columnwise
+ = 'R': Rowwise
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ K (input) INTEGER
+ The order of the matrix T (= the number of elementary
+ reflectors whose product defines the block reflector).
+
+ V (input) DOUBLE PRECISION array, dimension
+ (LDV,K) if STOREV = 'C'
+ (LDV,M) if STOREV = 'R' and SIDE = 'L'
+ (LDV,N) if STOREV = 'R' and SIDE = 'R'
+ The matrix V. See further details.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
+ if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
+ if STOREV = 'R', LDV >= K.
+
+ T (input) DOUBLE PRECISION array, dimension (LDT,K)
+ The triangular k by k matrix T in the representation of the
+ block reflector.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDA >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (LDWORK,K)
+
+ LDWORK (input) INTEGER
+ The leading dimension of the array WORK.
+ If SIDE = 'L', LDWORK >= max(1,N);
+ if SIDE = 'R', LDWORK >= max(1,M).
+
+ =====================================================================
+
+
+ Quick return if possible
+*/
+
+ /* Parameter adjustments */
+ v_dim1 = *ldv;
+ v_offset = 1 + v_dim1 * 1;
+ v -= v_offset;
+ t_dim1 = *ldt;
+ t_offset = 1 + t_dim1 * 1;
+ t -= t_offset;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ work_dim1 = *ldwork;
+ work_offset = 1 + work_dim1 * 1;
+ work -= work_offset;
+
+ /* Function Body */
+ if (*m <= 0 || *n <= 0) {
+ return 0;
+ }
+
+ if (lsame_(trans, "N")) {
+ *(unsigned char *)transt = 'T';
+ } else {
+ *(unsigned char *)transt = 'N';
+ }
+
+ if (lsame_(storev, "C")) {
+
+ if (lsame_(direct, "F")) {
+
+/*
+ Let V = ( V1 ) (first K rows)
+ ( V2 )
+ where V1 is unit lower triangular.
+*/
+
+ if (lsame_(side, "L")) {
+
+/*
+ Form H * C or H' * C where C = ( C1 )
+ ( C2 )
+
+ W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK)
+
+ W := C1'
+*/
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dcopy_(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1],
+ &c__1);
+/* L10: */
+ }
+
+/* W := W * V1 */
+
+ dtrmm_("Right", "Lower", "No transpose", "Unit", n, k, &c_b15,
+ &v[v_offset], ldv, &work[work_offset], ldwork);
+ if (*m > *k) {
+
+/* W := W + C2'*V2 */
+
+ i__1 = *m - *k;
+ dgemm_("Transpose", "No transpose", n, k, &i__1, &c_b15, &
+ c__[*k + 1 + c_dim1], ldc, &v[*k + 1 + v_dim1],
+ ldv, &c_b15, &work[work_offset], ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ dtrmm_("Right", "Upper", transt, "Non-unit", n, k, &c_b15, &t[
+ t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - V * W' */
+
+ if (*m > *k) {
+
+/* C2 := C2 - V2 * W' */
+
+ i__1 = *m - *k;
+ dgemm_("No transpose", "Transpose", &i__1, n, k, &c_b151,
+ &v[*k + 1 + v_dim1], ldv, &work[work_offset],
+ ldwork, &c_b15, &c__[*k + 1 + c_dim1], ldc);
+ }
+
+/* W := W * V1' */
+
+ dtrmm_("Right", "Lower", "Transpose", "Unit", n, k, &c_b15, &
+ v[v_offset], ldv, &work[work_offset], ldwork);
+
+/* C1 := C1 - W' */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[j + i__ * c_dim1] -= work[i__ + j * work_dim1];
+/* L20: */
+ }
+/* L30: */
+ }
+
+ } else if (lsame_(side, "R")) {
+
+/*
+ Form C * H or C * H' where C = ( C1 C2 )
+
+ W := C * V = (C1*V1 + C2*V2) (stored in WORK)
+
+ W := C1
+*/
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dcopy_(m, &c__[j * c_dim1 + 1], &c__1, &work[j *
+ work_dim1 + 1], &c__1);
+/* L40: */
+ }
+
+/* W := W * V1 */
+
+ dtrmm_("Right", "Lower", "No transpose", "Unit", m, k, &c_b15,
+ &v[v_offset], ldv, &work[work_offset], ldwork);
+ if (*n > *k) {
+
+/* W := W + C2 * V2 */
+
+ i__1 = *n - *k;
+ dgemm_("No transpose", "No transpose", m, k, &i__1, &
+ c_b15, &c__[(*k + 1) * c_dim1 + 1], ldc, &v[*k +
+ 1 + v_dim1], ldv, &c_b15, &work[work_offset],
+ ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ dtrmm_("Right", "Upper", trans, "Non-unit", m, k, &c_b15, &t[
+ t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - W * V' */
+
+ if (*n > *k) {
+
+/* C2 := C2 - W * V2' */
+
+ i__1 = *n - *k;
+ dgemm_("No transpose", "Transpose", m, &i__1, k, &c_b151,
+ &work[work_offset], ldwork, &v[*k + 1 + v_dim1],
+ ldv, &c_b15, &c__[(*k + 1) * c_dim1 + 1], ldc);
+ }
+
+/* W := W * V1' */
+
+ dtrmm_("Right", "Lower", "Transpose", "Unit", m, k, &c_b15, &
+ v[v_offset], ldv, &work[work_offset], ldwork);
+
+/* C1 := C1 - W */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] -= work[i__ + j * work_dim1];
+/* L50: */
+ }
+/* L60: */
+ }
+ }
+
+ } else {
+
+/*
+ Let V = ( V1 )
+ ( V2 ) (last K rows)
+ where V2 is unit upper triangular.
+*/
+
+ if (lsame_(side, "L")) {
+
+/*
+ Form H * C or H' * C where C = ( C1 )
+ ( C2 )
+
+ W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK)
+
+ W := C2'
+*/
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dcopy_(n, &c__[*m - *k + j + c_dim1], ldc, &work[j *
+ work_dim1 + 1], &c__1);
+/* L70: */
+ }
+
+/* W := W * V2 */
+
+ dtrmm_("Right", "Upper", "No transpose", "Unit", n, k, &c_b15,
+ &v[*m - *k + 1 + v_dim1], ldv, &work[work_offset],
+ ldwork);
+ if (*m > *k) {
+
+/* W := W + C1'*V1 */
+
+ i__1 = *m - *k;
+ dgemm_("Transpose", "No transpose", n, k, &i__1, &c_b15, &
+ c__[c_offset], ldc, &v[v_offset], ldv, &c_b15, &
+ work[work_offset], ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ dtrmm_("Right", "Lower", transt, "Non-unit", n, k, &c_b15, &t[
+ t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - V * W' */
+
+ if (*m > *k) {
+
+/* C1 := C1 - V1 * W' */
+
+ i__1 = *m - *k;
+ dgemm_("No transpose", "Transpose", &i__1, n, k, &c_b151,
+ &v[v_offset], ldv, &work[work_offset], ldwork, &
+ c_b15, &c__[c_offset], ldc)
+ ;
+ }
+
+/* W := W * V2' */
+
+ dtrmm_("Right", "Upper", "Transpose", "Unit", n, k, &c_b15, &
+ v[*m - *k + 1 + v_dim1], ldv, &work[work_offset],
+ ldwork);
+
+/* C2 := C2 - W' */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[*m - *k + j + i__ * c_dim1] -= work[i__ + j *
+ work_dim1];
+/* L80: */
+ }
+/* L90: */
+ }
+
+ } else if (lsame_(side, "R")) {
+
+/*
+ Form C * H or C * H' where C = ( C1 C2 )
+
+ W := C * V = (C1*V1 + C2*V2) (stored in WORK)
+
+ W := C2
+*/
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dcopy_(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[
+ j * work_dim1 + 1], &c__1);
+/* L100: */
+ }
+
+/* W := W * V2 */
+
+ dtrmm_("Right", "Upper", "No transpose", "Unit", m, k, &c_b15,
+ &v[*n - *k + 1 + v_dim1], ldv, &work[work_offset],
+ ldwork);
+ if (*n > *k) {
+
+/* W := W + C1 * V1 */
+
+ i__1 = *n - *k;
+ dgemm_("No transpose", "No transpose", m, k, &i__1, &
+ c_b15, &c__[c_offset], ldc, &v[v_offset], ldv, &
+ c_b15, &work[work_offset], ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ dtrmm_("Right", "Lower", trans, "Non-unit", m, k, &c_b15, &t[
+ t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - W * V' */
+
+ if (*n > *k) {
+
+/* C1 := C1 - W * V1' */
+
+ i__1 = *n - *k;
+ dgemm_("No transpose", "Transpose", m, &i__1, k, &c_b151,
+ &work[work_offset], ldwork, &v[v_offset], ldv, &
+ c_b15, &c__[c_offset], ldc)
+ ;
+ }
+
+/* W := W * V2' */
+
+ dtrmm_("Right", "Upper", "Transpose", "Unit", m, k, &c_b15, &
+ v[*n - *k + 1 + v_dim1], ldv, &work[work_offset],
+ ldwork);
+
+/* C2 := C2 - W */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + (*n - *k + j) * c_dim1] -= work[i__ + j *
+ work_dim1];
+/* L110: */
+ }
+/* L120: */
+ }
+ }
+ }
+
+ } else if (lsame_(storev, "R")) {
+
+ if (lsame_(direct, "F")) {
+
+/*
+ Let V = ( V1 V2 ) (V1: first K columns)
+ where V1 is unit upper triangular.
+*/
+
+ if (lsame_(side, "L")) {
+
+/*
+ Form H * C or H' * C where C = ( C1 )
+ ( C2 )
+
+ W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK)
+
+ W := C1'
+*/
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dcopy_(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1],
+ &c__1);
+/* L130: */
+ }
+
+/* W := W * V1' */
+
+ dtrmm_("Right", "Upper", "Transpose", "Unit", n, k, &c_b15, &
+ v[v_offset], ldv, &work[work_offset], ldwork);
+ if (*m > *k) {
+
+/* W := W + C2'*V2' */
+
+ i__1 = *m - *k;
+ dgemm_("Transpose", "Transpose", n, k, &i__1, &c_b15, &
+ c__[*k + 1 + c_dim1], ldc, &v[(*k + 1) * v_dim1 +
+ 1], ldv, &c_b15, &work[work_offset], ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ dtrmm_("Right", "Upper", transt, "Non-unit", n, k, &c_b15, &t[
+ t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - V' * W' */
+
+ if (*m > *k) {
+
+/* C2 := C2 - V2' * W' */
+
+ i__1 = *m - *k;
+ dgemm_("Transpose", "Transpose", &i__1, n, k, &c_b151, &v[
+ (*k + 1) * v_dim1 + 1], ldv, &work[work_offset],
+ ldwork, &c_b15, &c__[*k + 1 + c_dim1], ldc);
+ }
+
+/* W := W * V1 */
+
+ dtrmm_("Right", "Upper", "No transpose", "Unit", n, k, &c_b15,
+ &v[v_offset], ldv, &work[work_offset], ldwork);
+
+/* C1 := C1 - W' */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[j + i__ * c_dim1] -= work[i__ + j * work_dim1];
+/* L140: */
+ }
+/* L150: */
+ }
+
+ } else if (lsame_(side, "R")) {
+
+/*
+ Form C * H or C * H' where C = ( C1 C2 )
+
+ W := C * V' = (C1*V1' + C2*V2') (stored in WORK)
+
+ W := C1
+*/
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dcopy_(m, &c__[j * c_dim1 + 1], &c__1, &work[j *
+ work_dim1 + 1], &c__1);
+/* L160: */
+ }
+
+/* W := W * V1' */
+
+ dtrmm_("Right", "Upper", "Transpose", "Unit", m, k, &c_b15, &
+ v[v_offset], ldv, &work[work_offset], ldwork);
+ if (*n > *k) {
+
+/* W := W + C2 * V2' */
+
+ i__1 = *n - *k;
+ dgemm_("No transpose", "Transpose", m, k, &i__1, &c_b15, &
+ c__[(*k + 1) * c_dim1 + 1], ldc, &v[(*k + 1) *
+ v_dim1 + 1], ldv, &c_b15, &work[work_offset],
+ ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ dtrmm_("Right", "Upper", trans, "Non-unit", m, k, &c_b15, &t[
+ t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - W * V */
+
+ if (*n > *k) {
+
+/* C2 := C2 - W * V2 */
+
+ i__1 = *n - *k;
+ dgemm_("No transpose", "No transpose", m, &i__1, k, &
+ c_b151, &work[work_offset], ldwork, &v[(*k + 1) *
+ v_dim1 + 1], ldv, &c_b15, &c__[(*k + 1) * c_dim1
+ + 1], ldc);
+ }
+
+/* W := W * V1 */
+
+ dtrmm_("Right", "Upper", "No transpose", "Unit", m, k, &c_b15,
+ &v[v_offset], ldv, &work[work_offset], ldwork);
+
+/* C1 := C1 - W */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] -= work[i__ + j * work_dim1];
+/* L170: */
+ }
+/* L180: */
+ }
+
+ }
+
+ } else {
+
+/*
+ Let V = ( V1 V2 ) (V2: last K columns)
+ where V2 is unit lower triangular.
+*/
+
+ if (lsame_(side, "L")) {
+
+/*
+ Form H * C or H' * C where C = ( C1 )
+ ( C2 )
+
+ W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK)
+
+ W := C2'
+*/
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dcopy_(n, &c__[*m - *k + j + c_dim1], ldc, &work[j *
+ work_dim1 + 1], &c__1);
+/* L190: */
+ }
+
+/* W := W * V2' */
+
+ dtrmm_("Right", "Lower", "Transpose", "Unit", n, k, &c_b15, &
+ v[(*m - *k + 1) * v_dim1 + 1], ldv, &work[work_offset]
+ , ldwork);
+ if (*m > *k) {
+
+/* W := W + C1'*V1' */
+
+ i__1 = *m - *k;
+ dgemm_("Transpose", "Transpose", n, k, &i__1, &c_b15, &
+ c__[c_offset], ldc, &v[v_offset], ldv, &c_b15, &
+ work[work_offset], ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ dtrmm_("Right", "Lower", transt, "Non-unit", n, k, &c_b15, &t[
+ t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - V' * W' */
+
+ if (*m > *k) {
+
+/* C1 := C1 - V1' * W' */
+
+ i__1 = *m - *k;
+ dgemm_("Transpose", "Transpose", &i__1, n, k, &c_b151, &v[
+ v_offset], ldv, &work[work_offset], ldwork, &
+ c_b15, &c__[c_offset], ldc);
+ }
+
+/* W := W * V2 */
+
+ dtrmm_("Right", "Lower", "No transpose", "Unit", n, k, &c_b15,
+ &v[(*m - *k + 1) * v_dim1 + 1], ldv, &work[
+ work_offset], ldwork);
+
+/* C2 := C2 - W' */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[*m - *k + j + i__ * c_dim1] -= work[i__ + j *
+ work_dim1];
+/* L200: */
+ }
+/* L210: */
+ }
+
+ } else if (lsame_(side, "R")) {
+
+/*
+ Form C * H or C * H' where C = ( C1 C2 )
+
+ W := C * V' = (C1*V1' + C2*V2') (stored in WORK)
+
+ W := C2
+*/
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dcopy_(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[
+ j * work_dim1 + 1], &c__1);
+/* L220: */
+ }
+
+/* W := W * V2' */
+
+ dtrmm_("Right", "Lower", "Transpose", "Unit", m, k, &c_b15, &
+ v[(*n - *k + 1) * v_dim1 + 1], ldv, &work[work_offset]
+ , ldwork);
+ if (*n > *k) {
+
+/* W := W + C1 * V1' */
+
+ i__1 = *n - *k;
+ dgemm_("No transpose", "Transpose", m, k, &i__1, &c_b15, &
+ c__[c_offset], ldc, &v[v_offset], ldv, &c_b15, &
+ work[work_offset], ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ dtrmm_("Right", "Lower", trans, "Non-unit", m, k, &c_b15, &t[
+ t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - W * V */
+
+ if (*n > *k) {
+
+/* C1 := C1 - W * V1 */
+
+ i__1 = *n - *k;
+ dgemm_("No transpose", "No transpose", m, &i__1, k, &
+ c_b151, &work[work_offset], ldwork, &v[v_offset],
+ ldv, &c_b15, &c__[c_offset], ldc);
+ }
+
+/* W := W * V2 */
+
+ dtrmm_("Right", "Lower", "No transpose", "Unit", m, k, &c_b15,
+ &v[(*n - *k + 1) * v_dim1 + 1], ldv, &work[
+ work_offset], ldwork);
+
+/* C1 := C1 - W */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + (*n - *k + j) * c_dim1] -= work[i__ + j *
+ work_dim1];
+/* L230: */
+ }
+/* L240: */
+ }
+
+ }
+
+ }
+ }
+
+ return 0;
+
+/* End of DLARFB */
+
+} /* dlarfb_ */
+
+/* Subroutine */ int dlarfg_(integer *n, doublereal *alpha, doublereal *x,
+ integer *incx, doublereal *tau)
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Builtin functions */
+ double d_sign(doublereal *, doublereal *);
+
+ /* Local variables */
+ static integer j, knt;
+ static doublereal beta;
+ extern doublereal dnrm2_(integer *, doublereal *, integer *);
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *);
+ static doublereal xnorm;
+
+ static doublereal safmin, rsafmn;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ DLARFG generates a real elementary reflector H of order n, such
+ that
+
+ H * ( alpha ) = ( beta ), H' * H = I.
+ ( x ) ( 0 )
+
+ where alpha and beta are scalars, and x is an (n-1)-element real
+ vector. H is represented in the form
+
+ H = I - tau * ( 1 ) * ( 1 v' ) ,
+ ( v )
+
+ where tau is a real scalar and v is a real (n-1)-element
+ vector.
+
+ If the elements of x are all zero, then tau = 0 and H is taken to be
+ the unit matrix.
+
+ Otherwise 1 <= tau <= 2.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the elementary reflector.
+
+ ALPHA (input/output) DOUBLE PRECISION
+ On entry, the value alpha.
+ On exit, it is overwritten with the value beta.
+
+ X (input/output) DOUBLE PRECISION array, dimension
+ (1+(N-2)*abs(INCX))
+ On entry, the vector x.
+ On exit, it is overwritten with the vector v.
+
+ INCX (input) INTEGER
+ The increment between elements of X. INCX > 0.
+
+ TAU (output) DOUBLE PRECISION
+ The value tau.
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ if (*n <= 1) {
+ *tau = 0.;
+ return 0;
+ }
+
+ i__1 = *n - 1;
+ xnorm = dnrm2_(&i__1, &x[1], incx);
+
+ if (xnorm == 0.) {
+
+/* H = I */
+
+ *tau = 0.;
+ } else {
+
+/* general case */
+
+ d__1 = dlapy2_(alpha, &xnorm);
+ beta = -d_sign(&d__1, alpha);
+ safmin = SAFEMINIMUM / EPSILON;
+ if (abs(beta) < safmin) {
+
+/* XNORM, BETA may be inaccurate; scale X and recompute them */
+
+ rsafmn = 1. / safmin;
+ knt = 0;
+L10:
+ ++knt;
+ i__1 = *n - 1;
+ dscal_(&i__1, &rsafmn, &x[1], incx);
+ beta *= rsafmn;
+ *alpha *= rsafmn;
+ if (abs(beta) < safmin) {
+ goto L10;
+ }
+
+/* New BETA is at most 1, at least SAFMIN */
+
+ i__1 = *n - 1;
+ xnorm = dnrm2_(&i__1, &x[1], incx);
+ d__1 = dlapy2_(alpha, &xnorm);
+ beta = -d_sign(&d__1, alpha);
+ *tau = (beta - *alpha) / beta;
+ i__1 = *n - 1;
+ d__1 = 1. / (*alpha - beta);
+ dscal_(&i__1, &d__1, &x[1], incx);
+
+/* If ALPHA is subnormal, it may lose relative accuracy */
+
+ *alpha = beta;
+ i__1 = knt;
+ for (j = 1; j <= i__1; ++j) {
+ *alpha *= safmin;
+/* L20: */
+ }
+ } else {
+ *tau = (beta - *alpha) / beta;
+ i__1 = *n - 1;
+ d__1 = 1. / (*alpha - beta);
+ dscal_(&i__1, &d__1, &x[1], incx);
+ *alpha = beta;
+ }
+ }
+
+ return 0;
+
+/* End of DLARFG */
+
+} /* dlarfg_ */
+
+/* Subroutine */ int dlarft_(char *direct, char *storev, integer *n, integer *
+ k, doublereal *v, integer *ldv, doublereal *tau, doublereal *t,
+ integer *ldt)
+{
+ /* System generated locals */
+ integer t_dim1, t_offset, v_dim1, v_offset, i__1, i__2, i__3;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer i__, j;
+ static doublereal vii;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, doublereal *, integer *), dtrmv_(char *,
+ char *, char *, integer *, doublereal *, integer *, doublereal *,
+ integer *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ February 29, 1992
+
+
+ Purpose
+ =======
+
+ DLARFT forms the triangular factor T of a real block reflector H
+ of order n, which is defined as a product of k elementary reflectors.
+
+ If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
+
+ If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
+
+ If STOREV = 'C', the vector which defines the elementary reflector
+ H(i) is stored in the i-th column of the array V, and
+
+ H = I - V * T * V'
+
+ If STOREV = 'R', the vector which defines the elementary reflector
+ H(i) is stored in the i-th row of the array V, and
+
+ H = I - V' * T * V
+
+ Arguments
+ =========
+
+ DIRECT (input) CHARACTER*1
+ Specifies the order in which the elementary reflectors are
+ multiplied to form the block reflector:
+ = 'F': H = H(1) H(2) . . . H(k) (Forward)
+ = 'B': H = H(k) . . . H(2) H(1) (Backward)
+
+ STOREV (input) CHARACTER*1
+ Specifies how the vectors which define the elementary
+ reflectors are stored (see also Further Details):
+ = 'C': columnwise
+ = 'R': rowwise
+
+ N (input) INTEGER
+ The order of the block reflector H. N >= 0.
+
+ K (input) INTEGER
+ The order of the triangular factor T (= the number of
+ elementary reflectors). K >= 1.
+
+ V (input/output) DOUBLE PRECISION array, dimension
+ (LDV,K) if STOREV = 'C'
+ (LDV,N) if STOREV = 'R'
+ The matrix V. See further details.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i).
+
+ T (output) DOUBLE PRECISION array, dimension (LDT,K)
+ The k by k triangular factor T of the block reflector.
+ If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is
+ lower triangular. The rest of the array is not used.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ Further Details
+ ===============
+
+ The shape of the matrix V and the storage of the vectors which define
+ the H(i) is best illustrated by the following example with n = 5 and
+ k = 3. The elements equal to 1 are not stored; the corresponding
+ array elements are modified but restored on exit. The rest of the
+ array is not used.
+
+ DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
+
+ V = ( 1 ) V = ( 1 v1 v1 v1 v1 )
+ ( v1 1 ) ( 1 v2 v2 v2 )
+ ( v1 v2 1 ) ( 1 v3 v3 )
+ ( v1 v2 v3 )
+ ( v1 v2 v3 )
+
+ DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
+
+ V = ( v1 v2 v3 ) V = ( v1 v1 1 )
+ ( v1 v2 v3 ) ( v2 v2 v2 1 )
+ ( 1 v2 v3 ) ( v3 v3 v3 v3 1 )
+ ( 1 v3 )
+ ( 1 )
+
+ =====================================================================
+
+
+ Quick return if possible
+*/
+
+ /* Parameter adjustments */
+ v_dim1 = *ldv;
+ v_offset = 1 + v_dim1 * 1;
+ v -= v_offset;
+ --tau;
+ t_dim1 = *ldt;
+ t_offset = 1 + t_dim1 * 1;
+ t -= t_offset;
+
+ /* Function Body */
+ if (*n == 0) {
+ return 0;
+ }
+
+ if (lsame_(direct, "F")) {
+ i__1 = *k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if (tau[i__] == 0.) {
+
+/* H(i) = I */
+
+ i__2 = i__;
+ for (j = 1; j <= i__2; ++j) {
+ t[j + i__ * t_dim1] = 0.;
+/* L10: */
+ }
+ } else {
+
+/* general case */
+
+ vii = v[i__ + i__ * v_dim1];
+ v[i__ + i__ * v_dim1] = 1.;
+ if (lsame_(storev, "C")) {
+
+/* T(1:i-1,i) := - tau(i) * V(i:n,1:i-1)' * V(i:n,i) */
+
+ i__2 = *n - i__ + 1;
+ i__3 = i__ - 1;
+ d__1 = -tau[i__];
+ dgemv_("Transpose", &i__2, &i__3, &d__1, &v[i__ + v_dim1],
+ ldv, &v[i__ + i__ * v_dim1], &c__1, &c_b29, &t[
+ i__ * t_dim1 + 1], &c__1);
+ } else {
+
+/* T(1:i-1,i) := - tau(i) * V(1:i-1,i:n) * V(i,i:n)' */
+
+ i__2 = i__ - 1;
+ i__3 = *n - i__ + 1;
+ d__1 = -tau[i__];
+ dgemv_("No transpose", &i__2, &i__3, &d__1, &v[i__ *
+ v_dim1 + 1], ldv, &v[i__ + i__ * v_dim1], ldv, &
+ c_b29, &t[i__ * t_dim1 + 1], &c__1);
+ }
+ v[i__ + i__ * v_dim1] = vii;
+
+/* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) */
+
+ i__2 = i__ - 1;
+ dtrmv_("Upper", "No transpose", "Non-unit", &i__2, &t[
+ t_offset], ldt, &t[i__ * t_dim1 + 1], &c__1);
+ t[i__ + i__ * t_dim1] = tau[i__];
+ }
+/* L20: */
+ }
+ } else {
+ for (i__ = *k; i__ >= 1; --i__) {
+ if (tau[i__] == 0.) {
+
+/* H(i) = I */
+
+ i__1 = *k;
+ for (j = i__; j <= i__1; ++j) {
+ t[j + i__ * t_dim1] = 0.;
+/* L30: */
+ }
+ } else {
+
+/* general case */
+
+ if (i__ < *k) {
+ if (lsame_(storev, "C")) {
+ vii = v[*n - *k + i__ + i__ * v_dim1];
+ v[*n - *k + i__ + i__ * v_dim1] = 1.;
+
+/*
+ T(i+1:k,i) :=
+ - tau(i) * V(1:n-k+i,i+1:k)' * V(1:n-k+i,i)
+*/
+
+ i__1 = *n - *k + i__;
+ i__2 = *k - i__;
+ d__1 = -tau[i__];
+ dgemv_("Transpose", &i__1, &i__2, &d__1, &v[(i__ + 1)
+ * v_dim1 + 1], ldv, &v[i__ * v_dim1 + 1], &
+ c__1, &c_b29, &t[i__ + 1 + i__ * t_dim1], &
+ c__1);
+ v[*n - *k + i__ + i__ * v_dim1] = vii;
+ } else {
+ vii = v[i__ + (*n - *k + i__) * v_dim1];
+ v[i__ + (*n - *k + i__) * v_dim1] = 1.;
+
+/*
+ T(i+1:k,i) :=
+ - tau(i) * V(i+1:k,1:n-k+i) * V(i,1:n-k+i)'
+*/
+
+ i__1 = *k - i__;
+ i__2 = *n - *k + i__;
+ d__1 = -tau[i__];
+ dgemv_("No transpose", &i__1, &i__2, &d__1, &v[i__ +
+ 1 + v_dim1], ldv, &v[i__ + v_dim1], ldv, &
+ c_b29, &t[i__ + 1 + i__ * t_dim1], &c__1);
+ v[i__ + (*n - *k + i__) * v_dim1] = vii;
+ }
+
+/* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) */
+
+ i__1 = *k - i__;
+ dtrmv_("Lower", "No transpose", "Non-unit", &i__1, &t[i__
+ + 1 + (i__ + 1) * t_dim1], ldt, &t[i__ + 1 + i__ *
+ t_dim1], &c__1)
+ ;
+ }
+ t[i__ + i__ * t_dim1] = tau[i__];
+ }
+/* L40: */
+ }
+ }
+ return 0;
+
+/* End of DLARFT */
+
+} /* dlarft_ */
+
+/* Subroutine */ int dlarfx_(char *side, integer *m, integer *n, doublereal *
+ v, doublereal *tau, doublereal *c__, integer *ldc, doublereal *work)
+{
+ /* System generated locals */
+ integer c_dim1, c_offset, i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer j;
+ static doublereal t1, t2, t3, t4, t5, t6, t7, t8, t9, v1, v2, v3, v4, v5,
+ v6, v7, v8, v9, t10, v10, sum;
+ extern /* Subroutine */ int dger_(integer *, integer *, doublereal *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ integer *);
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, doublereal *, integer *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ February 29, 1992
+
+
+ Purpose
+ =======
+
+ DLARFX applies a real elementary reflector H to a real m by n
+ matrix C, from either the left or the right. H is represented in the
+ form
+
+ H = I - tau * v * v'
+
+ where tau is a real scalar and v is a real vector.
+
+ If tau = 0, then H is taken to be the unit matrix
+
+ This version uses inline code if H has order < 11.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form H * C
+ = 'R': form C * H
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ V (input) DOUBLE PRECISION array, dimension (M) if SIDE = 'L'
+ or (N) if SIDE = 'R'
+ The vector v in the representation of H.
+
+ TAU (input) DOUBLE PRECISION
+ The value tau in the representation of H.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+ or C * H if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDA >= (1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L'
+ or (M) if SIDE = 'R'
+ WORK is not referenced if H has order < 11.
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ --v;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ if (*tau == 0.) {
+ return 0;
+ }
+ if (lsame_(side, "L")) {
+
+/* Form H * C, where H has order m. */
+
+ switch (*m) {
+ case 1: goto L10;
+ case 2: goto L30;
+ case 3: goto L50;
+ case 4: goto L70;
+ case 5: goto L90;
+ case 6: goto L110;
+ case 7: goto L130;
+ case 8: goto L150;
+ case 9: goto L170;
+ case 10: goto L190;
+ }
+
+/*
+ Code for general M
+
+ w := C'*v
+*/
+
+ dgemv_("Transpose", m, n, &c_b15, &c__[c_offset], ldc, &v[1], &c__1, &
+ c_b29, &work[1], &c__1);
+
+/* C := C - tau * v * w' */
+
+ d__1 = -(*tau);
+ dger_(m, n, &d__1, &v[1], &c__1, &work[1], &c__1, &c__[c_offset], ldc)
+ ;
+ goto L410;
+L10:
+
+/* Special code for 1 x 1 Householder */
+
+ t1 = 1. - *tau * v[1] * v[1];
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ c__[j * c_dim1 + 1] = t1 * c__[j * c_dim1 + 1];
+/* L20: */
+ }
+ goto L410;
+L30:
+
+/* Special code for 2 x 2 Householder */
+
+ v1 = v[1];
+ t1 = *tau * v1;
+ v2 = v[2];
+ t2 = *tau * v2;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2];
+ c__[j * c_dim1 + 1] -= sum * t1;
+ c__[j * c_dim1 + 2] -= sum * t2;
+/* L40: */
+ }
+ goto L410;
+L50:
+
+/* Special code for 3 x 3 Householder */
+
+ v1 = v[1];
+ t1 = *tau * v1;
+ v2 = v[2];
+ t2 = *tau * v2;
+ v3 = v[3];
+ t3 = *tau * v3;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 *
+ c__[j * c_dim1 + 3];
+ c__[j * c_dim1 + 1] -= sum * t1;
+ c__[j * c_dim1 + 2] -= sum * t2;
+ c__[j * c_dim1 + 3] -= sum * t3;
+/* L60: */
+ }
+ goto L410;
+L70:
+
+/* Special code for 4 x 4 Householder */
+
+ v1 = v[1];
+ t1 = *tau * v1;
+ v2 = v[2];
+ t2 = *tau * v2;
+ v3 = v[3];
+ t3 = *tau * v3;
+ v4 = v[4];
+ t4 = *tau * v4;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 *
+ c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4];
+ c__[j * c_dim1 + 1] -= sum * t1;
+ c__[j * c_dim1 + 2] -= sum * t2;
+ c__[j * c_dim1 + 3] -= sum * t3;
+ c__[j * c_dim1 + 4] -= sum * t4;
+/* L80: */
+ }
+ goto L410;
+L90:
+
+/* Special code for 5 x 5 Householder */
+
+ v1 = v[1];
+ t1 = *tau * v1;
+ v2 = v[2];
+ t2 = *tau * v2;
+ v3 = v[3];
+ t3 = *tau * v3;
+ v4 = v[4];
+ t4 = *tau * v4;
+ v5 = v[5];
+ t5 = *tau * v5;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 *
+ c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4] + v5 * c__[
+ j * c_dim1 + 5];
+ c__[j * c_dim1 + 1] -= sum * t1;
+ c__[j * c_dim1 + 2] -= sum * t2;
+ c__[j * c_dim1 + 3] -= sum * t3;
+ c__[j * c_dim1 + 4] -= sum * t4;
+ c__[j * c_dim1 + 5] -= sum * t5;
+/* L100: */
+ }
+ goto L410;
+L110:
+
+/* Special code for 6 x 6 Householder */
+
+ v1 = v[1];
+ t1 = *tau * v1;
+ v2 = v[2];
+ t2 = *tau * v2;
+ v3 = v[3];
+ t3 = *tau * v3;
+ v4 = v[4];
+ t4 = *tau * v4;
+ v5 = v[5];
+ t5 = *tau * v5;
+ v6 = v[6];
+ t6 = *tau * v6;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 *
+ c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4] + v5 * c__[
+ j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6];
+ c__[j * c_dim1 + 1] -= sum * t1;
+ c__[j * c_dim1 + 2] -= sum * t2;
+ c__[j * c_dim1 + 3] -= sum * t3;
+ c__[j * c_dim1 + 4] -= sum * t4;
+ c__[j * c_dim1 + 5] -= sum * t5;
+ c__[j * c_dim1 + 6] -= sum * t6;
+/* L120: */
+ }
+ goto L410;
+L130:
+
+/* Special code for 7 x 7 Householder */
+
+ v1 = v[1];
+ t1 = *tau * v1;
+ v2 = v[2];
+ t2 = *tau * v2;
+ v3 = v[3];
+ t3 = *tau * v3;
+ v4 = v[4];
+ t4 = *tau * v4;
+ v5 = v[5];
+ t5 = *tau * v5;
+ v6 = v[6];
+ t6 = *tau * v6;
+ v7 = v[7];
+ t7 = *tau * v7;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 *
+ c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4] + v5 * c__[
+ j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6] + v7 * c__[j *
+ c_dim1 + 7];
+ c__[j * c_dim1 + 1] -= sum * t1;
+ c__[j * c_dim1 + 2] -= sum * t2;
+ c__[j * c_dim1 + 3] -= sum * t3;
+ c__[j * c_dim1 + 4] -= sum * t4;
+ c__[j * c_dim1 + 5] -= sum * t5;
+ c__[j * c_dim1 + 6] -= sum * t6;
+ c__[j * c_dim1 + 7] -= sum * t7;
+/* L140: */
+ }
+ goto L410;
+L150:
+
+/* Special code for 8 x 8 Householder */
+
+ v1 = v[1];
+ t1 = *tau * v1;
+ v2 = v[2];
+ t2 = *tau * v2;
+ v3 = v[3];
+ t3 = *tau * v3;
+ v4 = v[4];
+ t4 = *tau * v4;
+ v5 = v[5];
+ t5 = *tau * v5;
+ v6 = v[6];
+ t6 = *tau * v6;
+ v7 = v[7];
+ t7 = *tau * v7;
+ v8 = v[8];
+ t8 = *tau * v8;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 *
+ c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4] + v5 * c__[
+ j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6] + v7 * c__[j *
+ c_dim1 + 7] + v8 * c__[j * c_dim1 + 8];
+ c__[j * c_dim1 + 1] -= sum * t1;
+ c__[j * c_dim1 + 2] -= sum * t2;
+ c__[j * c_dim1 + 3] -= sum * t3;
+ c__[j * c_dim1 + 4] -= sum * t4;
+ c__[j * c_dim1 + 5] -= sum * t5;
+ c__[j * c_dim1 + 6] -= sum * t6;
+ c__[j * c_dim1 + 7] -= sum * t7;
+ c__[j * c_dim1 + 8] -= sum * t8;
+/* L160: */
+ }
+ goto L410;
+L170:
+
+/* Special code for 9 x 9 Householder */
+
+ v1 = v[1];
+ t1 = *tau * v1;
+ v2 = v[2];
+ t2 = *tau * v2;
+ v3 = v[3];
+ t3 = *tau * v3;
+ v4 = v[4];
+ t4 = *tau * v4;
+ v5 = v[5];
+ t5 = *tau * v5;
+ v6 = v[6];
+ t6 = *tau * v6;
+ v7 = v[7];
+ t7 = *tau * v7;
+ v8 = v[8];
+ t8 = *tau * v8;
+ v9 = v[9];
+ t9 = *tau * v9;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 *
+ c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4] + v5 * c__[
+ j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6] + v7 * c__[j *
+ c_dim1 + 7] + v8 * c__[j * c_dim1 + 8] + v9 * c__[j *
+ c_dim1 + 9];
+ c__[j * c_dim1 + 1] -= sum * t1;
+ c__[j * c_dim1 + 2] -= sum * t2;
+ c__[j * c_dim1 + 3] -= sum * t3;
+ c__[j * c_dim1 + 4] -= sum * t4;
+ c__[j * c_dim1 + 5] -= sum * t5;
+ c__[j * c_dim1 + 6] -= sum * t6;
+ c__[j * c_dim1 + 7] -= sum * t7;
+ c__[j * c_dim1 + 8] -= sum * t8;
+ c__[j * c_dim1 + 9] -= sum * t9;
+/* L180: */
+ }
+ goto L410;
+L190:
+
+/* Special code for 10 x 10 Householder */
+
+ v1 = v[1];
+ t1 = *tau * v1;
+ v2 = v[2];
+ t2 = *tau * v2;
+ v3 = v[3];
+ t3 = *tau * v3;
+ v4 = v[4];
+ t4 = *tau * v4;
+ v5 = v[5];
+ t5 = *tau * v5;
+ v6 = v[6];
+ t6 = *tau * v6;
+ v7 = v[7];
+ t7 = *tau * v7;
+ v8 = v[8];
+ t8 = *tau * v8;
+ v9 = v[9];
+ t9 = *tau * v9;
+ v10 = v[10];
+ t10 = *tau * v10;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 *
+ c__[j * c_dim1 + 3] + v4 * c__[j * c_dim1 + 4] + v5 * c__[
+ j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6] + v7 * c__[j *
+ c_dim1 + 7] + v8 * c__[j * c_dim1 + 8] + v9 * c__[j *
+ c_dim1 + 9] + v10 * c__[j * c_dim1 + 10];
+ c__[j * c_dim1 + 1] -= sum * t1;
+ c__[j * c_dim1 + 2] -= sum * t2;
+ c__[j * c_dim1 + 3] -= sum * t3;
+ c__[j * c_dim1 + 4] -= sum * t4;
+ c__[j * c_dim1 + 5] -= sum * t5;
+ c__[j * c_dim1 + 6] -= sum * t6;
+ c__[j * c_dim1 + 7] -= sum * t7;
+ c__[j * c_dim1 + 8] -= sum * t8;
+ c__[j * c_dim1 + 9] -= sum * t9;
+ c__[j * c_dim1 + 10] -= sum * t10;
+/* L200: */
+ }
+ goto L410;
+ } else {
+
+/* Form C * H, where H has order n. */
+
+ switch (*n) {
+ case 1: goto L210;
+ case 2: goto L230;
+ case 3: goto L250;
+ case 4: goto L270;
+ case 5: goto L290;
+ case 6: goto L310;
+ case 7: goto L330;
+ case 8: goto L350;
+ case 9: goto L370;
+ case 10: goto L390;
+ }
+
+/*
+ Code for general N
+
+ w := C * v
+*/
+
+ dgemv_("No transpose", m, n, &c_b15, &c__[c_offset], ldc, &v[1], &
+ c__1, &c_b29, &work[1], &c__1);
+
+/* C := C - tau * w * v' */
+
+ d__1 = -(*tau);
+ dger_(m, n, &d__1, &work[1], &c__1, &v[1], &c__1, &c__[c_offset], ldc)
+ ;
+ goto L410;
+L210:
+
+/* Special code for 1 x 1 Householder */
+
+ t1 = 1. - *tau * v[1] * v[1];
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ c__[j + c_dim1] = t1 * c__[j + c_dim1];
+/* L220: */
+ }
+ goto L410;
+L230:
+
+/* Special code for 2 x 2 Householder */
+
+ v1 = v[1];
+ t1 = *tau * v1;
+ v2 = v[2];
+ t2 = *tau * v2;
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ sum = v1 * c__[j + c_dim1] + v2 * c__[j + ((c_dim1) << (1))];
+ c__[j + c_dim1] -= sum * t1;
+ c__[j + ((c_dim1) << (1))] -= sum * t2;
+/* L240: */
+ }
+ goto L410;
+L250:
+
+/* Special code for 3 x 3 Householder */
+
+ v1 = v[1];
+ t1 = *tau * v1;
+ v2 = v[2];
+ t2 = *tau * v2;
+ v3 = v[3];
+ t3 = *tau * v3;
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ sum = v1 * c__[j + c_dim1] + v2 * c__[j + ((c_dim1) << (1))] + v3
+ * c__[j + c_dim1 * 3];
+ c__[j + c_dim1] -= sum * t1;
+ c__[j + ((c_dim1) << (1))] -= sum * t2;
+ c__[j + c_dim1 * 3] -= sum * t3;
+/* L260: */
+ }
+ goto L410;
+L270:
+
+/* Special code for 4 x 4 Householder */
+
+ v1 = v[1];
+ t1 = *tau * v1;
+ v2 = v[2];
+ t2 = *tau * v2;
+ v3 = v[3];
+ t3 = *tau * v3;
+ v4 = v[4];
+ t4 = *tau * v4;
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ sum = v1 * c__[j + c_dim1] + v2 * c__[j + ((c_dim1) << (1))] + v3
+ * c__[j + c_dim1 * 3] + v4 * c__[j + ((c_dim1) << (2))];
+ c__[j + c_dim1] -= sum * t1;
+ c__[j + ((c_dim1) << (1))] -= sum * t2;
+ c__[j + c_dim1 * 3] -= sum * t3;
+ c__[j + ((c_dim1) << (2))] -= sum * t4;
+/* L280: */
+ }
+ goto L410;
+L290:
+
+/* Special code for 5 x 5 Householder */
+
+ v1 = v[1];
+ t1 = *tau * v1;
+ v2 = v[2];
+ t2 = *tau * v2;
+ v3 = v[3];
+ t3 = *tau * v3;
+ v4 = v[4];
+ t4 = *tau * v4;
+ v5 = v[5];
+ t5 = *tau * v5;
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ sum = v1 * c__[j + c_dim1] + v2 * c__[j + ((c_dim1) << (1))] + v3
+ * c__[j + c_dim1 * 3] + v4 * c__[j + ((c_dim1) << (2))] +
+ v5 * c__[j + c_dim1 * 5];
+ c__[j + c_dim1] -= sum * t1;
+ c__[j + ((c_dim1) << (1))] -= sum * t2;
+ c__[j + c_dim1 * 3] -= sum * t3;
+ c__[j + ((c_dim1) << (2))] -= sum * t4;
+ c__[j + c_dim1 * 5] -= sum * t5;
+/* L300: */
+ }
+ goto L410;
+L310:
+
+/* Special code for 6 x 6 Householder */
+
+ v1 = v[1];
+ t1 = *tau * v1;
+ v2 = v[2];
+ t2 = *tau * v2;
+ v3 = v[3];
+ t3 = *tau * v3;
+ v4 = v[4];
+ t4 = *tau * v4;
+ v5 = v[5];
+ t5 = *tau * v5;
+ v6 = v[6];
+ t6 = *tau * v6;
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ sum = v1 * c__[j + c_dim1] + v2 * c__[j + ((c_dim1) << (1))] + v3
+ * c__[j + c_dim1 * 3] + v4 * c__[j + ((c_dim1) << (2))] +
+ v5 * c__[j + c_dim1 * 5] + v6 * c__[j + c_dim1 * 6];
+ c__[j + c_dim1] -= sum * t1;
+ c__[j + ((c_dim1) << (1))] -= sum * t2;
+ c__[j + c_dim1 * 3] -= sum * t3;
+ c__[j + ((c_dim1) << (2))] -= sum * t4;
+ c__[j + c_dim1 * 5] -= sum * t5;
+ c__[j + c_dim1 * 6] -= sum * t6;
+/* L320: */
+ }
+ goto L410;
+L330:
+
+/* Special code for 7 x 7 Householder */
+
+ v1 = v[1];
+ t1 = *tau * v1;
+ v2 = v[2];
+ t2 = *tau * v2;
+ v3 = v[3];
+ t3 = *tau * v3;
+ v4 = v[4];
+ t4 = *tau * v4;
+ v5 = v[5];
+ t5 = *tau * v5;
+ v6 = v[6];
+ t6 = *tau * v6;
+ v7 = v[7];
+ t7 = *tau * v7;
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ sum = v1 * c__[j + c_dim1] + v2 * c__[j + ((c_dim1) << (1))] + v3
+ * c__[j + c_dim1 * 3] + v4 * c__[j + ((c_dim1) << (2))] +
+ v5 * c__[j + c_dim1 * 5] + v6 * c__[j + c_dim1 * 6] + v7 *
+ c__[j + c_dim1 * 7];
+ c__[j + c_dim1] -= sum * t1;
+ c__[j + ((c_dim1) << (1))] -= sum * t2;
+ c__[j + c_dim1 * 3] -= sum * t3;
+ c__[j + ((c_dim1) << (2))] -= sum * t4;
+ c__[j + c_dim1 * 5] -= sum * t5;
+ c__[j + c_dim1 * 6] -= sum * t6;
+ c__[j + c_dim1 * 7] -= sum * t7;
+/* L340: */
+ }
+ goto L410;
+L350:
+
+/* Special code for 8 x 8 Householder */
+
+ v1 = v[1];
+ t1 = *tau * v1;
+ v2 = v[2];
+ t2 = *tau * v2;
+ v3 = v[3];
+ t3 = *tau * v3;
+ v4 = v[4];
+ t4 = *tau * v4;
+ v5 = v[5];
+ t5 = *tau * v5;
+ v6 = v[6];
+ t6 = *tau * v6;
+ v7 = v[7];
+ t7 = *tau * v7;
+ v8 = v[8];
+ t8 = *tau * v8;
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ sum = v1 * c__[j + c_dim1] + v2 * c__[j + ((c_dim1) << (1))] + v3
+ * c__[j + c_dim1 * 3] + v4 * c__[j + ((c_dim1) << (2))] +
+ v5 * c__[j + c_dim1 * 5] + v6 * c__[j + c_dim1 * 6] + v7 *
+ c__[j + c_dim1 * 7] + v8 * c__[j + ((c_dim1) << (3))];
+ c__[j + c_dim1] -= sum * t1;
+ c__[j + ((c_dim1) << (1))] -= sum * t2;
+ c__[j + c_dim1 * 3] -= sum * t3;
+ c__[j + ((c_dim1) << (2))] -= sum * t4;
+ c__[j + c_dim1 * 5] -= sum * t5;
+ c__[j + c_dim1 * 6] -= sum * t6;
+ c__[j + c_dim1 * 7] -= sum * t7;
+ c__[j + ((c_dim1) << (3))] -= sum * t8;
+/* L360: */
+ }
+ goto L410;
+L370:
+
+/* Special code for 9 x 9 Householder */
+
+ v1 = v[1];
+ t1 = *tau * v1;
+ v2 = v[2];
+ t2 = *tau * v2;
+ v3 = v[3];
+ t3 = *tau * v3;
+ v4 = v[4];
+ t4 = *tau * v4;
+ v5 = v[5];
+ t5 = *tau * v5;
+ v6 = v[6];
+ t6 = *tau * v6;
+ v7 = v[7];
+ t7 = *tau * v7;
+ v8 = v[8];
+ t8 = *tau * v8;
+ v9 = v[9];
+ t9 = *tau * v9;
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ sum = v1 * c__[j + c_dim1] + v2 * c__[j + ((c_dim1) << (1))] + v3
+ * c__[j + c_dim1 * 3] + v4 * c__[j + ((c_dim1) << (2))] +
+ v5 * c__[j + c_dim1 * 5] + v6 * c__[j + c_dim1 * 6] + v7 *
+ c__[j + c_dim1 * 7] + v8 * c__[j + ((c_dim1) << (3))] +
+ v9 * c__[j + c_dim1 * 9];
+ c__[j + c_dim1] -= sum * t1;
+ c__[j + ((c_dim1) << (1))] -= sum * t2;
+ c__[j + c_dim1 * 3] -= sum * t3;
+ c__[j + ((c_dim1) << (2))] -= sum * t4;
+ c__[j + c_dim1 * 5] -= sum * t5;
+ c__[j + c_dim1 * 6] -= sum * t6;
+ c__[j + c_dim1 * 7] -= sum * t7;
+ c__[j + ((c_dim1) << (3))] -= sum * t8;
+ c__[j + c_dim1 * 9] -= sum * t9;
+/* L380: */
+ }
+ goto L410;
+L390:
+
+/* Special code for 10 x 10 Householder */
+
+ v1 = v[1];
+ t1 = *tau * v1;
+ v2 = v[2];
+ t2 = *tau * v2;
+ v3 = v[3];
+ t3 = *tau * v3;
+ v4 = v[4];
+ t4 = *tau * v4;
+ v5 = v[5];
+ t5 = *tau * v5;
+ v6 = v[6];
+ t6 = *tau * v6;
+ v7 = v[7];
+ t7 = *tau * v7;
+ v8 = v[8];
+ t8 = *tau * v8;
+ v9 = v[9];
+ t9 = *tau * v9;
+ v10 = v[10];
+ t10 = *tau * v10;
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ sum = v1 * c__[j + c_dim1] + v2 * c__[j + ((c_dim1) << (1))] + v3
+ * c__[j + c_dim1 * 3] + v4 * c__[j + ((c_dim1) << (2))] +
+ v5 * c__[j + c_dim1 * 5] + v6 * c__[j + c_dim1 * 6] + v7 *
+ c__[j + c_dim1 * 7] + v8 * c__[j + ((c_dim1) << (3))] +
+ v9 * c__[j + c_dim1 * 9] + v10 * c__[j + c_dim1 * 10];
+ c__[j + c_dim1] -= sum * t1;
+ c__[j + ((c_dim1) << (1))] -= sum * t2;
+ c__[j + c_dim1 * 3] -= sum * t3;
+ c__[j + ((c_dim1) << (2))] -= sum * t4;
+ c__[j + c_dim1 * 5] -= sum * t5;
+ c__[j + c_dim1 * 6] -= sum * t6;
+ c__[j + c_dim1 * 7] -= sum * t7;
+ c__[j + ((c_dim1) << (3))] -= sum * t8;
+ c__[j + c_dim1 * 9] -= sum * t9;
+ c__[j + c_dim1 * 10] -= sum * t10;
+/* L400: */
+ }
+ goto L410;
+ }
+L410:
+ return 0;
+
+/* End of DLARFX */
+
+} /* dlarfx_ */
+
+/* Subroutine */ int dlartg_(doublereal *f, doublereal *g, doublereal *cs,
+ doublereal *sn, doublereal *r__)
+{
+ /* Initialized data */
+
+ static logical first = TRUE_;
+
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1, d__2;
+
+ /* Builtin functions */
+ double log(doublereal), pow_di(doublereal *, integer *), sqrt(doublereal);
+
+ /* Local variables */
+ static integer i__;
+ static doublereal f1, g1, eps, scale;
+ static integer count;
+ static doublereal safmn2, safmx2;
+
+ static doublereal safmin;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ DLARTG generate a plane rotation so that
+
+ [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1.
+ [ -SN CS ] [ G ] [ 0 ]
+
+ This is a slower, more accurate version of the BLAS1 routine DROTG,
+ with the following other differences:
+ F and G are unchanged on return.
+ If G=0, then CS=1 and SN=0.
+ If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any
+ floating point operations (saves work in DBDSQR when
+ there are zeros on the diagonal).
+
+ If F exceeds G in magnitude, CS will be positive.
+
+ Arguments
+ =========
+
+ F (input) DOUBLE PRECISION
+ The first component of vector to be rotated.
+
+ G (input) DOUBLE PRECISION
+ The second component of vector to be rotated.
+
+ CS (output) DOUBLE PRECISION
+ The cosine of the rotation.
+
+ SN (output) DOUBLE PRECISION
+ The sine of the rotation.
+
+ R (output) DOUBLE PRECISION
+ The nonzero component of the rotated vector.
+
+ =====================================================================
+*/
+
+
+ if (first) {
+ first = FALSE_;
+ safmin = SAFEMINIMUM;
+ eps = EPSILON;
+ d__1 = BASE;
+ i__1 = (integer) (log(safmin / eps) / log(BASE) /
+ 2.);
+ safmn2 = pow_di(&d__1, &i__1);
+ safmx2 = 1. / safmn2;
+ }
+ if (*g == 0.) {
+ *cs = 1.;
+ *sn = 0.;
+ *r__ = *f;
+ } else if (*f == 0.) {
+ *cs = 0.;
+ *sn = 1.;
+ *r__ = *g;
+ } else {
+ f1 = *f;
+ g1 = *g;
+/* Computing MAX */
+ d__1 = abs(f1), d__2 = abs(g1);
+ scale = max(d__1,d__2);
+ if (scale >= safmx2) {
+ count = 0;
+L10:
+ ++count;
+ f1 *= safmn2;
+ g1 *= safmn2;
+/* Computing MAX */
+ d__1 = abs(f1), d__2 = abs(g1);
+ scale = max(d__1,d__2);
+ if (scale >= safmx2) {
+ goto L10;
+ }
+/* Computing 2nd power */
+ d__1 = f1;
+/* Computing 2nd power */
+ d__2 = g1;
+ *r__ = sqrt(d__1 * d__1 + d__2 * d__2);
+ *cs = f1 / *r__;
+ *sn = g1 / *r__;
+ i__1 = count;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ *r__ *= safmx2;
+/* L20: */
+ }
+ } else if (scale <= safmn2) {
+ count = 0;
+L30:
+ ++count;
+ f1 *= safmx2;
+ g1 *= safmx2;
+/* Computing MAX */
+ d__1 = abs(f1), d__2 = abs(g1);
+ scale = max(d__1,d__2);
+ if (scale <= safmn2) {
+ goto L30;
+ }
+/* Computing 2nd power */
+ d__1 = f1;
+/* Computing 2nd power */
+ d__2 = g1;
+ *r__ = sqrt(d__1 * d__1 + d__2 * d__2);
+ *cs = f1 / *r__;
+ *sn = g1 / *r__;
+ i__1 = count;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ *r__ *= safmn2;
+/* L40: */
+ }
+ } else {
+/* Computing 2nd power */
+ d__1 = f1;
+/* Computing 2nd power */
+ d__2 = g1;
+ *r__ = sqrt(d__1 * d__1 + d__2 * d__2);
+ *cs = f1 / *r__;
+ *sn = g1 / *r__;
+ }
+ if ((abs(*f) > abs(*g) && *cs < 0.)) {
+ *cs = -(*cs);
+ *sn = -(*sn);
+ *r__ = -(*r__);
+ }
+ }
+ return 0;
+
+/* End of DLARTG */
+
+} /* dlartg_ */
+
+/* Subroutine */ int dlas2_(doublereal *f, doublereal *g, doublereal *h__,
+ doublereal *ssmin, doublereal *ssmax)
+{
+ /* System generated locals */
+ doublereal d__1, d__2;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static doublereal c__, fa, ga, ha, as, at, au, fhmn, fhmx;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ DLAS2 computes the singular values of the 2-by-2 matrix
+ [ F G ]
+ [ 0 H ].
+ On return, SSMIN is the smaller singular value and SSMAX is the
+ larger singular value.
+
+ Arguments
+ =========
+
+ F (input) DOUBLE PRECISION
+ The (1,1) element of the 2-by-2 matrix.
+
+ G (input) DOUBLE PRECISION
+ The (1,2) element of the 2-by-2 matrix.
+
+ H (input) DOUBLE PRECISION
+ The (2,2) element of the 2-by-2 matrix.
+
+ SSMIN (output) DOUBLE PRECISION
+ The smaller singular value.
+
+ SSMAX (output) DOUBLE PRECISION
+ The larger singular value.
+
+ Further Details
+ ===============
+
+ Barring over/underflow, all output quantities are correct to within
+ a few units in the last place (ulps), even in the absence of a guard
+ digit in addition/subtraction.
+
+ In IEEE arithmetic, the code works correctly if one matrix element is
+ infinite.
+
+ Overflow will not occur unless the largest singular value itself
+ overflows, or is within a few ulps of overflow. (On machines with
+ partial overflow, like the Cray, overflow may occur if the largest
+ singular value is within a factor of 2 of overflow.)
+
+ Underflow is harmless if underflow is gradual. Otherwise, results
+ may correspond to a matrix modified by perturbations of size near
+ the underflow threshold.
+
+ ====================================================================
+*/
+
+
+ fa = abs(*f);
+ ga = abs(*g);
+ ha = abs(*h__);
+ fhmn = min(fa,ha);
+ fhmx = max(fa,ha);
+ if (fhmn == 0.) {
+ *ssmin = 0.;
+ if (fhmx == 0.) {
+ *ssmax = ga;
+ } else {
+/* Computing 2nd power */
+ d__1 = min(fhmx,ga) / max(fhmx,ga);
+ *ssmax = max(fhmx,ga) * sqrt(d__1 * d__1 + 1.);
+ }
+ } else {
+ if (ga < fhmx) {
+ as = fhmn / fhmx + 1.;
+ at = (fhmx - fhmn) / fhmx;
+/* Computing 2nd power */
+ d__1 = ga / fhmx;
+ au = d__1 * d__1;
+ c__ = 2. / (sqrt(as * as + au) + sqrt(at * at + au));
+ *ssmin = fhmn * c__;
+ *ssmax = fhmx / c__;
+ } else {
+ au = fhmx / ga;
+ if (au == 0.) {
+
+/*
+ Avoid possible harmful underflow if exponent range
+ asymmetric (true SSMIN may not underflow even if
+ AU underflows)
+*/
+
+ *ssmin = fhmn * fhmx / ga;
+ *ssmax = ga;
+ } else {
+ as = fhmn / fhmx + 1.;
+ at = (fhmx - fhmn) / fhmx;
+/* Computing 2nd power */
+ d__1 = as * au;
+/* Computing 2nd power */
+ d__2 = at * au;
+ c__ = 1. / (sqrt(d__1 * d__1 + 1.) + sqrt(d__2 * d__2 + 1.));
+ *ssmin = fhmn * c__ * au;
+ *ssmin += *ssmin;
+ *ssmax = ga / (c__ + c__);
+ }
+ }
+ }
+ return 0;
+
+/* End of DLAS2 */
+
+} /* dlas2_ */
+
+/* Subroutine */ int dlascl_(char *type__, integer *kl, integer *ku,
+ doublereal *cfrom, doublereal *cto, integer *m, integer *n,
+ doublereal *a, integer *lda, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
+
+ /* Local variables */
+ static integer i__, j, k1, k2, k3, k4;
+ static doublereal mul, cto1;
+ static logical done;
+ static doublereal ctoc;
+ extern logical lsame_(char *, char *);
+ static integer itype;
+ static doublereal cfrom1;
+
+ static doublereal cfromc;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static doublereal bignum, smlnum;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ February 29, 1992
+
+
+ Purpose
+ =======
+
+ DLASCL multiplies the M by N real matrix A by the real scalar
+ CTO/CFROM. This is done without over/underflow as long as the final
+ result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that
+ A may be full, upper triangular, lower triangular, upper Hessenberg,
+ or banded.
+
+ Arguments
+ =========
+
+ TYPE (input) CHARACTER*1
+ TYPE indices the storage type of the input matrix.
+ = 'G': A is a full matrix.
+ = 'L': A is a lower triangular matrix.
+ = 'U': A is an upper triangular matrix.
+ = 'H': A is an upper Hessenberg matrix.
+ = 'B': A is a symmetric band matrix with lower bandwidth KL
+ and upper bandwidth KU and with the only the lower
+ half stored.
+ = 'Q': A is a symmetric band matrix with lower bandwidth KL
+ and upper bandwidth KU and with the only the upper
+ half stored.
+ = 'Z': A is a band matrix with lower bandwidth KL and upper
+ bandwidth KU.
+
+ KL (input) INTEGER
+ The lower bandwidth of A. Referenced only if TYPE = 'B',
+ 'Q' or 'Z'.
+
+ KU (input) INTEGER
+ The upper bandwidth of A. Referenced only if TYPE = 'B',
+ 'Q' or 'Z'.
+
+ CFROM (input) DOUBLE PRECISION
+ CTO (input) DOUBLE PRECISION
+ The matrix A is multiplied by CTO/CFROM. A(I,J) is computed
+ without over/underflow if the final result CTO*A(I,J)/CFROM
+ can be represented without over/underflow. CFROM must be
+ nonzero.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,M)
+ The matrix to be multiplied by CTO/CFROM. See TYPE for the
+ storage type.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ INFO (output) INTEGER
+ 0 - successful exit
+ <0 - if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+
+ /* Function Body */
+ *info = 0;
+
+ if (lsame_(type__, "G")) {
+ itype = 0;
+ } else if (lsame_(type__, "L")) {
+ itype = 1;
+ } else if (lsame_(type__, "U")) {
+ itype = 2;
+ } else if (lsame_(type__, "H")) {
+ itype = 3;
+ } else if (lsame_(type__, "B")) {
+ itype = 4;
+ } else if (lsame_(type__, "Q")) {
+ itype = 5;
+ } else if (lsame_(type__, "Z")) {
+ itype = 6;
+ } else {
+ itype = -1;
+ }
+
+ if (itype == -1) {
+ *info = -1;
+ } else if (*cfrom == 0.) {
+ *info = -4;
+ } else if (*m < 0) {
+ *info = -6;
+ } else if (*n < 0 || (itype == 4 && *n != *m) || (itype == 5 && *n != *m))
+ {
+ *info = -7;
+ } else if ((itype <= 3 && *lda < max(1,*m))) {
+ *info = -9;
+ } else if (itype >= 4) {
+/* Computing MAX */
+ i__1 = *m - 1;
+ if (*kl < 0 || *kl > max(i__1,0)) {
+ *info = -2;
+ } else /* if(complicated condition) */ {
+/* Computing MAX */
+ i__1 = *n - 1;
+ if (*ku < 0 || *ku > max(i__1,0) || ((itype == 4 || itype == 5) &&
+ *kl != *ku)) {
+ *info = -3;
+ } else if ((itype == 4 && *lda < *kl + 1) || (itype == 5 && *lda <
+ *ku + 1) || (itype == 6 && *lda < ((*kl) << (1)) + *ku +
+ 1)) {
+ *info = -9;
+ }
+ }
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLASCL", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0 || *m == 0) {
+ return 0;
+ }
+
+/* Get machine parameters */
+
+ smlnum = SAFEMINIMUM;
+ bignum = 1. / smlnum;
+
+ cfromc = *cfrom;
+ ctoc = *cto;
+
+L10:
+ cfrom1 = cfromc * smlnum;
+ cto1 = ctoc / bignum;
+ if ((abs(cfrom1) > abs(ctoc) && ctoc != 0.)) {
+ mul = smlnum;
+ done = FALSE_;
+ cfromc = cfrom1;
+ } else if (abs(cto1) > abs(cfromc)) {
+ mul = bignum;
+ done = FALSE_;
+ ctoc = cto1;
+ } else {
+ mul = ctoc / cfromc;
+ done = TRUE_;
+ }
+
+ if (itype == 0) {
+
+/* Full matrix */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] *= mul;
+/* L20: */
+ }
+/* L30: */
+ }
+
+ } else if (itype == 1) {
+
+/* Lower triangular matrix */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] *= mul;
+/* L40: */
+ }
+/* L50: */
+ }
+
+ } else if (itype == 2) {
+
+/* Upper triangular matrix */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = min(j,*m);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] *= mul;
+/* L60: */
+ }
+/* L70: */
+ }
+
+ } else if (itype == 3) {
+
+/* Upper Hessenberg matrix */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MIN */
+ i__3 = j + 1;
+ i__2 = min(i__3,*m);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] *= mul;
+/* L80: */
+ }
+/* L90: */
+ }
+
+ } else if (itype == 4) {
+
+/* Lower half of a symmetric band matrix */
+
+ k3 = *kl + 1;
+ k4 = *n + 1;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MIN */
+ i__3 = k3, i__4 = k4 - j;
+ i__2 = min(i__3,i__4);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] *= mul;
+/* L100: */
+ }
+/* L110: */
+ }
+
+ } else if (itype == 5) {
+
+/* Upper half of a symmetric band matrix */
+
+ k1 = *ku + 2;
+ k3 = *ku + 1;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MAX */
+ i__2 = k1 - j;
+ i__3 = k3;
+ for (i__ = max(i__2,1); i__ <= i__3; ++i__) {
+ a[i__ + j * a_dim1] *= mul;
+/* L120: */
+ }
+/* L130: */
+ }
+
+ } else if (itype == 6) {
+
+/* Band matrix */
+
+ k1 = *kl + *ku + 2;
+ k2 = *kl + 1;
+ k3 = ((*kl) << (1)) + *ku + 1;
+ k4 = *kl + *ku + 1 + *m;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MAX */
+ i__3 = k1 - j;
+/* Computing MIN */
+ i__4 = k3, i__5 = k4 - j;
+ i__2 = min(i__4,i__5);
+ for (i__ = max(i__3,k2); i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] *= mul;
+/* L140: */
+ }
+/* L150: */
+ }
+
+ }
+
+ if (! done) {
+ goto L10;
+ }
+
+ return 0;
+
+/* End of DLASCL */
+
+} /* dlascl_ */
+
+/* Subroutine */ int dlasd0_(integer *n, integer *sqre, doublereal *d__,
+ doublereal *e, doublereal *u, integer *ldu, doublereal *vt, integer *
+ ldvt, integer *smlsiz, integer *iwork, doublereal *work, integer *
+ info)
+{
+ /* System generated locals */
+ integer u_dim1, u_offset, vt_dim1, vt_offset, i__1, i__2;
+
+ /* Builtin functions */
+ integer pow_ii(integer *, integer *);
+
+ /* Local variables */
+ static integer i__, j, m, i1, ic, lf, nd, ll, nl, nr, im1, ncc, nlf, nrf,
+ iwk, lvl, ndb1, nlp1, nrp1;
+ static doublereal beta;
+ static integer idxq, nlvl;
+ static doublereal alpha;
+ static integer inode, ndiml, idxqc, ndimr, itemp, sqrei;
+ extern /* Subroutine */ int dlasd1_(integer *, integer *, integer *,
+ doublereal *, doublereal *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *, integer *, integer *, doublereal *,
+ integer *), dlasdq_(char *, integer *, integer *, integer *,
+ integer *, integer *, doublereal *, doublereal *, doublereal *,
+ integer *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, integer *), dlasdt_(integer *, integer *,
+ integer *, integer *, integer *, integer *, integer *), xerbla_(
+ char *, integer *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ Using a divide and conquer approach, DLASD0 computes the singular
+ value decomposition (SVD) of a real upper bidiagonal N-by-M
+ matrix B with diagonal D and offdiagonal E, where M = N + SQRE.
+ The algorithm computes orthogonal matrices U and VT such that
+ B = U * S * VT. The singular values S are overwritten on D.
+
+ A related subroutine, DLASDA, computes only the singular values,
+ and optionally, the singular vectors in compact form.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ On entry, the row dimension of the upper bidiagonal matrix.
+ This is also the dimension of the main diagonal array D.
+
+ SQRE (input) INTEGER
+ Specifies the column dimension of the bidiagonal matrix.
+ = 0: The bidiagonal matrix has column dimension M = N;
+ = 1: The bidiagonal matrix has column dimension M = N+1;
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry D contains the main diagonal of the bidiagonal
+ matrix.
+ On exit D, if INFO = 0, contains its singular values.
+
+ E (input) DOUBLE PRECISION array, dimension (M-1)
+ Contains the subdiagonal entries of the bidiagonal matrix.
+ On exit, E has been destroyed.
+
+ U (output) DOUBLE PRECISION array, dimension at least (LDQ, N)
+ On exit, U contains the left singular vectors.
+
+ LDU (input) INTEGER
+ On entry, leading dimension of U.
+
+ VT (output) DOUBLE PRECISION array, dimension at least (LDVT, M)
+ On exit, VT' contains the right singular vectors.
+
+ LDVT (input) INTEGER
+ On entry, leading dimension of VT.
+
+ SMLSIZ (input) INTEGER
+ On entry, maximum size of the subproblems at the
+ bottom of the computation tree.
+
+ IWORK INTEGER work array.
+ Dimension must be at least (8 * N)
+
+ WORK DOUBLE PRECISION work array.
+ Dimension must be at least (3 * M**2 + 2 * M)
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ --e;
+ u_dim1 = *ldu;
+ u_offset = 1 + u_dim1 * 1;
+ u -= u_offset;
+ vt_dim1 = *ldvt;
+ vt_offset = 1 + vt_dim1 * 1;
+ vt -= vt_offset;
+ --iwork;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*n < 0) {
+ *info = -1;
+ } else if (*sqre < 0 || *sqre > 1) {
+ *info = -2;
+ }
+
+ m = *n + *sqre;
+
+ if (*ldu < *n) {
+ *info = -6;
+ } else if (*ldvt < m) {
+ *info = -8;
+ } else if (*smlsiz < 3) {
+ *info = -9;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLASD0", &i__1);
+ return 0;
+ }
+
+/* If the input matrix is too small, call DLASDQ to find the SVD. */
+
+ if (*n <= *smlsiz) {
+ dlasdq_("U", sqre, n, &m, n, &c__0, &d__[1], &e[1], &vt[vt_offset],
+ ldvt, &u[u_offset], ldu, &u[u_offset], ldu, &work[1], info);
+ return 0;
+ }
+
+/* Set up the computation tree. */
+
+ inode = 1;
+ ndiml = inode + *n;
+ ndimr = ndiml + *n;
+ idxq = ndimr + *n;
+ iwk = idxq + *n;
+ dlasdt_(n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr],
+ smlsiz);
+
+/*
+ For the nodes on bottom level of the tree, solve
+ their subproblems by DLASDQ.
+*/
+
+ ndb1 = (nd + 1) / 2;
+ ncc = 0;
+ i__1 = nd;
+ for (i__ = ndb1; i__ <= i__1; ++i__) {
+
+/*
+ IC : center row of each node
+ NL : number of rows of left subproblem
+ NR : number of rows of right subproblem
+ NLF: starting row of the left subproblem
+ NRF: starting row of the right subproblem
+*/
+
+ i1 = i__ - 1;
+ ic = iwork[inode + i1];
+ nl = iwork[ndiml + i1];
+ nlp1 = nl + 1;
+ nr = iwork[ndimr + i1];
+ nrp1 = nr + 1;
+ nlf = ic - nl;
+ nrf = ic + 1;
+ sqrei = 1;
+ dlasdq_("U", &sqrei, &nl, &nlp1, &nl, &ncc, &d__[nlf], &e[nlf], &vt[
+ nlf + nlf * vt_dim1], ldvt, &u[nlf + nlf * u_dim1], ldu, &u[
+ nlf + nlf * u_dim1], ldu, &work[1], info);
+ if (*info != 0) {
+ return 0;
+ }
+ itemp = idxq + nlf - 2;
+ i__2 = nl;
+ for (j = 1; j <= i__2; ++j) {
+ iwork[itemp + j] = j;
+/* L10: */
+ }
+ if (i__ == nd) {
+ sqrei = *sqre;
+ } else {
+ sqrei = 1;
+ }
+ nrp1 = nr + sqrei;
+ dlasdq_("U", &sqrei, &nr, &nrp1, &nr, &ncc, &d__[nrf], &e[nrf], &vt[
+ nrf + nrf * vt_dim1], ldvt, &u[nrf + nrf * u_dim1], ldu, &u[
+ nrf + nrf * u_dim1], ldu, &work[1], info);
+ if (*info != 0) {
+ return 0;
+ }
+ itemp = idxq + ic;
+ i__2 = nr;
+ for (j = 1; j <= i__2; ++j) {
+ iwork[itemp + j - 1] = j;
+/* L20: */
+ }
+/* L30: */
+ }
+
+/* Now conquer each subproblem bottom-up. */
+
+ for (lvl = nlvl; lvl >= 1; --lvl) {
+
+/*
+ Find the first node LF and last node LL on the
+ current level LVL.
+*/
+
+ if (lvl == 1) {
+ lf = 1;
+ ll = 1;
+ } else {
+ i__1 = lvl - 1;
+ lf = pow_ii(&c__2, &i__1);
+ ll = ((lf) << (1)) - 1;
+ }
+ i__1 = ll;
+ for (i__ = lf; i__ <= i__1; ++i__) {
+ im1 = i__ - 1;
+ ic = iwork[inode + im1];
+ nl = iwork[ndiml + im1];
+ nr = iwork[ndimr + im1];
+ nlf = ic - nl;
+ if ((*sqre == 0 && i__ == ll)) {
+ sqrei = *sqre;
+ } else {
+ sqrei = 1;
+ }
+ idxqc = idxq + nlf - 1;
+ alpha = d__[ic];
+ beta = e[ic];
+ dlasd1_(&nl, &nr, &sqrei, &d__[nlf], &alpha, &beta, &u[nlf + nlf *
+ u_dim1], ldu, &vt[nlf + nlf * vt_dim1], ldvt, &iwork[
+ idxqc], &iwork[iwk], &work[1], info);
+ if (*info != 0) {
+ return 0;
+ }
+/* L40: */
+ }
+/* L50: */
+ }
+
+ return 0;
+
+/* End of DLASD0 */
+
+} /* dlasd0_ */
+
+/* Subroutine */ int dlasd1_(integer *nl, integer *nr, integer *sqre,
+ doublereal *d__, doublereal *alpha, doublereal *beta, doublereal *u,
+ integer *ldu, doublereal *vt, integer *ldvt, integer *idxq, integer *
+ iwork, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer u_dim1, u_offset, vt_dim1, vt_offset, i__1;
+ doublereal d__1, d__2;
+
+ /* Local variables */
+ static integer i__, k, m, n, n1, n2, iq, iz, iu2, ldq, idx, ldu2, ivt2,
+ idxc, idxp, ldvt2;
+ extern /* Subroutine */ int dlasd2_(integer *, integer *, integer *,
+ integer *, doublereal *, doublereal *, doublereal *, doublereal *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ doublereal *, integer *, doublereal *, integer *, integer *,
+ integer *, integer *, integer *, integer *, integer *), dlasd3_(
+ integer *, integer *, integer *, integer *, doublereal *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ integer *, integer *, integer *, doublereal *, integer *),
+ dlascl_(char *, integer *, integer *, doublereal *, doublereal *,
+ integer *, integer *, doublereal *, integer *, integer *),
+ dlamrg_(integer *, integer *, doublereal *, integer *, integer *,
+ integer *);
+ static integer isigma;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static doublereal orgnrm;
+ static integer coltyp;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DLASD1 computes the SVD of an upper bidiagonal N-by-M matrix B,
+ where N = NL + NR + 1 and M = N + SQRE. DLASD1 is called from DLASD0.
+
+ A related subroutine DLASD7 handles the case in which the singular
+ values (and the singular vectors in factored form) are desired.
+
+ DLASD1 computes the SVD as follows:
+
+ ( D1(in) 0 0 0 )
+ B = U(in) * ( Z1' a Z2' b ) * VT(in)
+ ( 0 0 D2(in) 0 )
+
+ = U(out) * ( D(out) 0) * VT(out)
+
+ where Z' = (Z1' a Z2' b) = u' VT', and u is a vector of dimension M
+ with ALPHA and BETA in the NL+1 and NL+2 th entries and zeros
+ elsewhere; and the entry b is empty if SQRE = 0.
+
+ The left singular vectors of the original matrix are stored in U, and
+ the transpose of the right singular vectors are stored in VT, and the
+ singular values are in D. The algorithm consists of three stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple singular values or when there are zeros in
+ the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine DLASD2.
+
+ The second stage consists of calculating the updated
+ singular values. This is done by finding the square roots of the
+ roots of the secular equation via the routine DLASD4 (as called
+ by DLASD3). This routine also calculates the singular vectors of
+ the current problem.
+
+ The final stage consists of computing the updated singular vectors
+ directly using the updated singular values. The singular vectors
+ for the current problem are multiplied with the singular vectors
+ from the overall problem.
+
+ Arguments
+ =========
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has row dimension N = NL + NR + 1,
+ and column dimension M = N + SQRE.
+
+ D (input/output) DOUBLE PRECISION array,
+ dimension (N = NL+NR+1).
+ On entry D(1:NL,1:NL) contains the singular values of the
+ upper block; and D(NL+2:N) contains the singular values of
+ the lower block. On exit D(1:N) contains the singular values
+ of the modified matrix.
+
+ ALPHA (input) DOUBLE PRECISION
+ Contains the diagonal element associated with the added row.
+
+ BETA (input) DOUBLE PRECISION
+ Contains the off-diagonal element associated with the added
+ row.
+
+ U (input/output) DOUBLE PRECISION array, dimension(LDU,N)
+ On entry U(1:NL, 1:NL) contains the left singular vectors of
+ the upper block; U(NL+2:N, NL+2:N) contains the left singular
+ vectors of the lower block. On exit U contains the left
+ singular vectors of the bidiagonal matrix.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= max( 1, N ).
+
+ VT (input/output) DOUBLE PRECISION array, dimension(LDVT,M)
+ where M = N + SQRE.
+ On entry VT(1:NL+1, 1:NL+1)' contains the right singular
+ vectors of the upper block; VT(NL+2:M, NL+2:M)' contains
+ the right singular vectors of the lower block. On exit
+ VT' contains the right singular vectors of the
+ bidiagonal matrix.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= max( 1, M ).
+
+ IDXQ (output) INTEGER array, dimension(N)
+ This contains the permutation which will reintegrate the
+ subproblem just solved back into sorted order, i.e.
+ D( IDXQ( I = 1, N ) ) will be in ascending order.
+
+ IWORK (workspace) INTEGER array, dimension( 4 * N )
+
+ WORK (workspace) DOUBLE PRECISION array, dimension( 3*M**2 + 2*M )
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ u_dim1 = *ldu;
+ u_offset = 1 + u_dim1 * 1;
+ u -= u_offset;
+ vt_dim1 = *ldvt;
+ vt_offset = 1 + vt_dim1 * 1;
+ vt -= vt_offset;
+ --idxq;
+ --iwork;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*nl < 1) {
+ *info = -1;
+ } else if (*nr < 1) {
+ *info = -2;
+ } else if (*sqre < 0 || *sqre > 1) {
+ *info = -3;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLASD1", &i__1);
+ return 0;
+ }
+
+ n = *nl + *nr + 1;
+ m = n + *sqre;
+
+/*
+ The following values are for bookkeeping purposes only. They are
+ integer pointers which indicate the portion of the workspace
+ used by a particular array in DLASD2 and DLASD3.
+*/
+
+ ldu2 = n;
+ ldvt2 = m;
+
+ iz = 1;
+ isigma = iz + m;
+ iu2 = isigma + n;
+ ivt2 = iu2 + ldu2 * n;
+ iq = ivt2 + ldvt2 * m;
+
+ idx = 1;
+ idxc = idx + n;
+ coltyp = idxc + n;
+ idxp = coltyp + n;
+
+/*
+ Scale.
+
+ Computing MAX
+*/
+ d__1 = abs(*alpha), d__2 = abs(*beta);
+ orgnrm = max(d__1,d__2);
+ d__[*nl + 1] = 0.;
+ i__1 = n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if ((d__1 = d__[i__], abs(d__1)) > orgnrm) {
+ orgnrm = (d__1 = d__[i__], abs(d__1));
+ }
+/* L10: */
+ }
+ dlascl_("G", &c__0, &c__0, &orgnrm, &c_b15, &n, &c__1, &d__[1], &n, info);
+ *alpha /= orgnrm;
+ *beta /= orgnrm;
+
+/* Deflate singular values. */
+
+ dlasd2_(nl, nr, sqre, &k, &d__[1], &work[iz], alpha, beta, &u[u_offset],
+ ldu, &vt[vt_offset], ldvt, &work[isigma], &work[iu2], &ldu2, &
+ work[ivt2], &ldvt2, &iwork[idxp], &iwork[idx], &iwork[idxc], &
+ idxq[1], &iwork[coltyp], info);
+
+/* Solve Secular Equation and update singular vectors. */
+
+ ldq = k;
+ dlasd3_(nl, nr, sqre, &k, &d__[1], &work[iq], &ldq, &work[isigma], &u[
+ u_offset], ldu, &work[iu2], &ldu2, &vt[vt_offset], ldvt, &work[
+ ivt2], &ldvt2, &iwork[idxc], &iwork[coltyp], &work[iz], info);
+ if (*info != 0) {
+ return 0;
+ }
+
+/* Unscale. */
+
+ dlascl_("G", &c__0, &c__0, &c_b15, &orgnrm, &n, &c__1, &d__[1], &n, info);
+
+/* Prepare the IDXQ sorting permutation. */
+
+ n1 = k;
+ n2 = n - k;
+ dlamrg_(&n1, &n2, &d__[1], &c__1, &c_n1, &idxq[1]);
+
+ return 0;
+
+/* End of DLASD1 */
+
+} /* dlasd1_ */
+
+/* Subroutine */ int dlasd2_(integer *nl, integer *nr, integer *sqre, integer
+ *k, doublereal *d__, doublereal *z__, doublereal *alpha, doublereal *
+ beta, doublereal *u, integer *ldu, doublereal *vt, integer *ldvt,
+ doublereal *dsigma, doublereal *u2, integer *ldu2, doublereal *vt2,
+ integer *ldvt2, integer *idxp, integer *idx, integer *idxc, integer *
+ idxq, integer *coltyp, integer *info)
+{
+ /* System generated locals */
+ integer u_dim1, u_offset, u2_dim1, u2_offset, vt_dim1, vt_offset,
+ vt2_dim1, vt2_offset, i__1;
+ doublereal d__1, d__2;
+
+ /* Local variables */
+ static doublereal c__;
+ static integer i__, j, m, n;
+ static doublereal s;
+ static integer k2;
+ static doublereal z1;
+ static integer ct, jp;
+ static doublereal eps, tau, tol;
+ static integer psm[4], nlp1, nlp2, idxi, idxj;
+ extern /* Subroutine */ int drot_(integer *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *);
+ static integer ctot[4], idxjp;
+ extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
+ doublereal *, integer *);
+ static integer jprev;
+
+ extern /* Subroutine */ int dlamrg_(integer *, integer *, doublereal *,
+ integer *, integer *, integer *), dlacpy_(char *, integer *,
+ integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *,
+ doublereal *, doublereal *, integer *), xerbla_(char *,
+ integer *);
+ static doublereal hlftol;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Oak Ridge National Lab, Argonne National Lab,
+ Courant Institute, NAG Ltd., and Rice University
+ October 31, 1999
+
+
+ Purpose
+ =======
+
+ DLASD2 merges the two sets of singular values together into a single
+ sorted set. Then it tries to deflate the size of the problem.
+ There are two ways in which deflation can occur: when two or more
+ singular values are close together or if there is a tiny entry in the
+ Z vector. For each such occurrence the order of the related secular
+ equation problem is reduced by one.
+
+ DLASD2 is called from DLASD1.
+
+ Arguments
+ =========
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ K (output) INTEGER
+ Contains the dimension of the non-deflated matrix,
+ This is the order of the related secular equation. 1 <= K <=N.
+
+ D (input/output) DOUBLE PRECISION array, dimension(N)
+ On entry D contains the singular values of the two submatrices
+ to be combined. On exit D contains the trailing (N-K) updated
+ singular values (those which were deflated) sorted into
+ increasing order.
+
+ ALPHA (input) DOUBLE PRECISION
+ Contains the diagonal element associated with the added row.
+
+ BETA (input) DOUBLE PRECISION
+ Contains the off-diagonal element associated with the added
+ row.
+
+ U (input/output) DOUBLE PRECISION array, dimension(LDU,N)
+ On entry U contains the left singular vectors of two
+ submatrices in the two square blocks with corners at (1,1),
+ (NL, NL), and (NL+2, NL+2), (N,N).
+ On exit U contains the trailing (N-K) updated left singular
+ vectors (those which were deflated) in its last N-K columns.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= N.
+
+ Z (output) DOUBLE PRECISION array, dimension(N)
+ On exit Z contains the updating row vector in the secular
+ equation.
+
+ DSIGMA (output) DOUBLE PRECISION array, dimension (N)
+ Contains a copy of the diagonal elements (K-1 singular values
+ and one zero) in the secular equation.
+
+ U2 (output) DOUBLE PRECISION array, dimension(LDU2,N)
+ Contains a copy of the first K-1 left singular vectors which
+ will be used by DLASD3 in a matrix multiply (DGEMM) to solve
+ for the new left singular vectors. U2 is arranged into four
+ blocks. The first block contains a column with 1 at NL+1 and
+ zero everywhere else; the second block contains non-zero
+ entries only at and above NL; the third contains non-zero
+ entries only below NL+1; and the fourth is dense.
+
+ LDU2 (input) INTEGER
+ The leading dimension of the array U2. LDU2 >= N.
+
+ VT (input/output) DOUBLE PRECISION array, dimension(LDVT,M)
+ On entry VT' contains the right singular vectors of two
+ submatrices in the two square blocks with corners at (1,1),
+ (NL+1, NL+1), and (NL+2, NL+2), (M,M).
+ On exit VT' contains the trailing (N-K) updated right singular
+ vectors (those which were deflated) in its last N-K columns.
+ In case SQRE =1, the last row of VT spans the right null
+ space.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= M.
+
+ VT2 (output) DOUBLE PRECISION array, dimension(LDVT2,N)
+ VT2' contains a copy of the first K right singular vectors
+ which will be used by DLASD3 in a matrix multiply (DGEMM) to
+ solve for the new right singular vectors. VT2 is arranged into
+ three blocks. The first block contains a row that corresponds
+ to the special 0 diagonal element in SIGMA; the second block
+ contains non-zeros only at and before NL +1; the third block
+ contains non-zeros only at and after NL +2.
+
+ LDVT2 (input) INTEGER
+ The leading dimension of the array VT2. LDVT2 >= M.
+
+ IDXP (workspace) INTEGER array, dimension(N)
+ This will contain the permutation used to place deflated
+ values of D at the end of the array. On output IDXP(2:K)
+ points to the nondeflated D-values and IDXP(K+1:N)
+ points to the deflated singular values.
+
+ IDX (workspace) INTEGER array, dimension(N)
+ This will contain the permutation used to sort the contents of
+ D into ascending order.
+
+ IDXC (output) INTEGER array, dimension(N)
+ This will contain the permutation used to arrange the columns
+ of the deflated U matrix into three groups: the first group
+ contains non-zero entries only at and above NL, the second
+ contains non-zero entries only below NL+2, and the third is
+ dense.
+
+ COLTYP (workspace/output) INTEGER array, dimension(N)
+ As workspace, this will contain a label which will indicate
+ which of the following types a column in the U2 matrix or a
+ row in the VT2 matrix is:
+ 1 : non-zero in the upper half only
+ 2 : non-zero in the lower half only
+ 3 : dense
+ 4 : deflated
+
+ On exit, it is an array of dimension 4, with COLTYP(I) being
+ the dimension of the I-th type columns.
+
+ IDXQ (input) INTEGER array, dimension(N)
+ This contains the permutation which separately sorts the two
+ sub-problems in D into ascending order. Note that entries in
+ the first hlaf of this permutation must first be moved one
+ position backward; and entries in the second half
+ must first have NL+1 added to their values.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ --z__;
+ u_dim1 = *ldu;
+ u_offset = 1 + u_dim1 * 1;
+ u -= u_offset;
+ vt_dim1 = *ldvt;
+ vt_offset = 1 + vt_dim1 * 1;
+ vt -= vt_offset;
+ --dsigma;
+ u2_dim1 = *ldu2;
+ u2_offset = 1 + u2_dim1 * 1;
+ u2 -= u2_offset;
+ vt2_dim1 = *ldvt2;
+ vt2_offset = 1 + vt2_dim1 * 1;
+ vt2 -= vt2_offset;
+ --idxp;
+ --idx;
+ --idxc;
+ --idxq;
+ --coltyp;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*nl < 1) {
+ *info = -1;
+ } else if (*nr < 1) {
+ *info = -2;
+ } else if ((*sqre != 1 && *sqre != 0)) {
+ *info = -3;
+ }
+
+ n = *nl + *nr + 1;
+ m = n + *sqre;
+
+ if (*ldu < n) {
+ *info = -10;
+ } else if (*ldvt < m) {
+ *info = -12;
+ } else if (*ldu2 < n) {
+ *info = -15;
+ } else if (*ldvt2 < m) {
+ *info = -17;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLASD2", &i__1);
+ return 0;
+ }
+
+ nlp1 = *nl + 1;
+ nlp2 = *nl + 2;
+
+/*
+ Generate the first part of the vector Z; and move the singular
+ values in the first part of D one position backward.
+*/
+
+ z1 = *alpha * vt[nlp1 + nlp1 * vt_dim1];
+ z__[1] = z1;
+ for (i__ = *nl; i__ >= 1; --i__) {
+ z__[i__ + 1] = *alpha * vt[i__ + nlp1 * vt_dim1];
+ d__[i__ + 1] = d__[i__];
+ idxq[i__ + 1] = idxq[i__] + 1;
+/* L10: */
+ }
+
+/* Generate the second part of the vector Z. */
+
+ i__1 = m;
+ for (i__ = nlp2; i__ <= i__1; ++i__) {
+ z__[i__] = *beta * vt[i__ + nlp2 * vt_dim1];
+/* L20: */
+ }
+
+/* Initialize some reference arrays. */
+
+ i__1 = nlp1;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ coltyp[i__] = 1;
+/* L30: */
+ }
+ i__1 = n;
+ for (i__ = nlp2; i__ <= i__1; ++i__) {
+ coltyp[i__] = 2;
+/* L40: */
+ }
+
+/* Sort the singular values into increasing order */
+
+ i__1 = n;
+ for (i__ = nlp2; i__ <= i__1; ++i__) {
+ idxq[i__] += nlp1;
+/* L50: */
+ }
+
+/*
+ DSIGMA, IDXC, IDXC, and the first column of U2
+ are used as storage space.
+*/
+
+ i__1 = n;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ dsigma[i__] = d__[idxq[i__]];
+ u2[i__ + u2_dim1] = z__[idxq[i__]];
+ idxc[i__] = coltyp[idxq[i__]];
+/* L60: */
+ }
+
+ dlamrg_(nl, nr, &dsigma[2], &c__1, &c__1, &idx[2]);
+
+ i__1 = n;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ idxi = idx[i__] + 1;
+ d__[i__] = dsigma[idxi];
+ z__[i__] = u2[idxi + u2_dim1];
+ coltyp[i__] = idxc[idxi];
+/* L70: */
+ }
+
+/* Calculate the allowable deflation tolerance */
+
+ eps = EPSILON;
+/* Computing MAX */
+ d__1 = abs(*alpha), d__2 = abs(*beta);
+ tol = max(d__1,d__2);
+/* Computing MAX */
+ d__2 = (d__1 = d__[n], abs(d__1));
+ tol = eps * 8. * max(d__2,tol);
+
+/*
+ There are 2 kinds of deflation -- first a value in the z-vector
+ is small, second two (or more) singular values are very close
+ together (their difference is small).
+
+ If the value in the z-vector is small, we simply permute the
+ array so that the corresponding singular value is moved to the
+ end.
+
+ If two values in the D-vector are close, we perform a two-sided
+ rotation designed to make one of the corresponding z-vector
+ entries zero, and then permute the array so that the deflated
+ singular value is moved to the end.
+
+ If there are multiple singular values then the problem deflates.
+ Here the number of equal singular values are found. As each equal
+ singular value is found, an elementary reflector is computed to
+ rotate the corresponding singular subspace so that the
+ corresponding components of Z are zero in this new basis.
+*/
+
+ *k = 1;
+ k2 = n + 1;
+ i__1 = n;
+ for (j = 2; j <= i__1; ++j) {
+ if ((d__1 = z__[j], abs(d__1)) <= tol) {
+
+/* Deflate due to small z component. */
+
+ --k2;
+ idxp[k2] = j;
+ coltyp[j] = 4;
+ if (j == n) {
+ goto L120;
+ }
+ } else {
+ jprev = j;
+ goto L90;
+ }
+/* L80: */
+ }
+L90:
+ j = jprev;
+L100:
+ ++j;
+ if (j > n) {
+ goto L110;
+ }
+ if ((d__1 = z__[j], abs(d__1)) <= tol) {
+
+/* Deflate due to small z component. */
+
+ --k2;
+ idxp[k2] = j;
+ coltyp[j] = 4;
+ } else {
+
+/* Check if singular values are close enough to allow deflation. */
+
+ if ((d__1 = d__[j] - d__[jprev], abs(d__1)) <= tol) {
+
+/* Deflation is possible. */
+
+ s = z__[jprev];
+ c__ = z__[j];
+
+/*
+ Find sqrt(a**2+b**2) without overflow or
+ destructive underflow.
+*/
+
+ tau = dlapy2_(&c__, &s);
+ c__ /= tau;
+ s = -s / tau;
+ z__[j] = tau;
+ z__[jprev] = 0.;
+
+/*
+ Apply back the Givens rotation to the left and right
+ singular vector matrices.
+*/
+
+ idxjp = idxq[idx[jprev] + 1];
+ idxj = idxq[idx[j] + 1];
+ if (idxjp <= nlp1) {
+ --idxjp;
+ }
+ if (idxj <= nlp1) {
+ --idxj;
+ }
+ drot_(&n, &u[idxjp * u_dim1 + 1], &c__1, &u[idxj * u_dim1 + 1], &
+ c__1, &c__, &s);
+ drot_(&m, &vt[idxjp + vt_dim1], ldvt, &vt[idxj + vt_dim1], ldvt, &
+ c__, &s);
+ if (coltyp[j] != coltyp[jprev]) {
+ coltyp[j] = 3;
+ }
+ coltyp[jprev] = 4;
+ --k2;
+ idxp[k2] = jprev;
+ jprev = j;
+ } else {
+ ++(*k);
+ u2[*k + u2_dim1] = z__[jprev];
+ dsigma[*k] = d__[jprev];
+ idxp[*k] = jprev;
+ jprev = j;
+ }
+ }
+ goto L100;
+L110:
+
+/* Record the last singular value. */
+
+ ++(*k);
+ u2[*k + u2_dim1] = z__[jprev];
+ dsigma[*k] = d__[jprev];
+ idxp[*k] = jprev;
+
+L120:
+
+/*
+ Count up the total number of the various types of columns, then
+ form a permutation which positions the four column types into
+ four groups of uniform structure (although one or more of these
+ groups may be empty).
+*/
+
+ for (j = 1; j <= 4; ++j) {
+ ctot[j - 1] = 0;
+/* L130: */
+ }
+ i__1 = n;
+ for (j = 2; j <= i__1; ++j) {
+ ct = coltyp[j];
+ ++ctot[ct - 1];
+/* L140: */
+ }
+
+/* PSM(*) = Position in SubMatrix (of types 1 through 4) */
+
+ psm[0] = 2;
+ psm[1] = ctot[0] + 2;
+ psm[2] = psm[1] + ctot[1];
+ psm[3] = psm[2] + ctot[2];
+
+/*
+ Fill out the IDXC array so that the permutation which it induces
+ will place all type-1 columns first, all type-2 columns next,
+ then all type-3's, and finally all type-4's, starting from the
+ second column. This applies similarly to the rows of VT.
+*/
+
+ i__1 = n;
+ for (j = 2; j <= i__1; ++j) {
+ jp = idxp[j];
+ ct = coltyp[jp];
+ idxc[psm[ct - 1]] = j;
+ ++psm[ct - 1];
+/* L150: */
+ }
+
+/*
+ Sort the singular values and corresponding singular vectors into
+ DSIGMA, U2, and VT2 respectively. The singular values/vectors
+ which were not deflated go into the first K slots of DSIGMA, U2,
+ and VT2 respectively, while those which were deflated go into the
+ last N - K slots, except that the first column/row will be treated
+ separately.
+*/
+
+ i__1 = n;
+ for (j = 2; j <= i__1; ++j) {
+ jp = idxp[j];
+ dsigma[j] = d__[jp];
+ idxj = idxq[idx[idxp[idxc[j]]] + 1];
+ if (idxj <= nlp1) {
+ --idxj;
+ }
+ dcopy_(&n, &u[idxj * u_dim1 + 1], &c__1, &u2[j * u2_dim1 + 1], &c__1);
+ dcopy_(&m, &vt[idxj + vt_dim1], ldvt, &vt2[j + vt2_dim1], ldvt2);
+/* L160: */
+ }
+
+/* Determine DSIGMA(1), DSIGMA(2) and Z(1) */
+
+ dsigma[1] = 0.;
+ hlftol = tol / 2.;
+ if (abs(dsigma[2]) <= hlftol) {
+ dsigma[2] = hlftol;
+ }
+ if (m > n) {
+ z__[1] = dlapy2_(&z1, &z__[m]);
+ if (z__[1] <= tol) {
+ c__ = 1.;
+ s = 0.;
+ z__[1] = tol;
+ } else {
+ c__ = z1 / z__[1];
+ s = z__[m] / z__[1];
+ }
+ } else {
+ if (abs(z1) <= tol) {
+ z__[1] = tol;
+ } else {
+ z__[1] = z1;
+ }
+ }
+
+/* Move the rest of the updating row to Z. */
+
+ i__1 = *k - 1;
+ dcopy_(&i__1, &u2[u2_dim1 + 2], &c__1, &z__[2], &c__1);
+
+/*
+ Determine the first column of U2, the first row of VT2 and the
+ last row of VT.
+*/
+
+ dlaset_("A", &n, &c__1, &c_b29, &c_b29, &u2[u2_offset], ldu2);
+ u2[nlp1 + u2_dim1] = 1.;
+ if (m > n) {
+ i__1 = nlp1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ vt[m + i__ * vt_dim1] = -s * vt[nlp1 + i__ * vt_dim1];
+ vt2[i__ * vt2_dim1 + 1] = c__ * vt[nlp1 + i__ * vt_dim1];
+/* L170: */
+ }
+ i__1 = m;
+ for (i__ = nlp2; i__ <= i__1; ++i__) {
+ vt2[i__ * vt2_dim1 + 1] = s * vt[m + i__ * vt_dim1];
+ vt[m + i__ * vt_dim1] = c__ * vt[m + i__ * vt_dim1];
+/* L180: */
+ }
+ } else {
+ dcopy_(&m, &vt[nlp1 + vt_dim1], ldvt, &vt2[vt2_dim1 + 1], ldvt2);
+ }
+ if (m > n) {
+ dcopy_(&m, &vt[m + vt_dim1], ldvt, &vt2[m + vt2_dim1], ldvt2);
+ }
+
+/*
+ The deflated singular values and their corresponding vectors go
+ into the back of D, U, and V respectively.
+*/
+
+ if (n > *k) {
+ i__1 = n - *k;
+ dcopy_(&i__1, &dsigma[*k + 1], &c__1, &d__[*k + 1], &c__1);
+ i__1 = n - *k;
+ dlacpy_("A", &n, &i__1, &u2[(*k + 1) * u2_dim1 + 1], ldu2, &u[(*k + 1)
+ * u_dim1 + 1], ldu);
+ i__1 = n - *k;
+ dlacpy_("A", &i__1, &m, &vt2[*k + 1 + vt2_dim1], ldvt2, &vt[*k + 1 +
+ vt_dim1], ldvt);
+ }
+
+/* Copy CTOT into COLTYP for referencing in DLASD3. */
+
+ for (j = 1; j <= 4; ++j) {
+ coltyp[j] = ctot[j - 1];
+/* L190: */
+ }
+
+ return 0;
+
+/* End of DLASD2 */
+
+} /* dlasd2_ */
+
+/* Subroutine */ int dlasd3_(integer *nl, integer *nr, integer *sqre, integer
+ *k, doublereal *d__, doublereal *q, integer *ldq, doublereal *dsigma,
+ doublereal *u, integer *ldu, doublereal *u2, integer *ldu2,
+ doublereal *vt, integer *ldvt, doublereal *vt2, integer *ldvt2,
+ integer *idxc, integer *ctot, doublereal *z__, integer *info)
+{
+ /* System generated locals */
+ integer q_dim1, q_offset, u_dim1, u_offset, u2_dim1, u2_offset, vt_dim1,
+ vt_offset, vt2_dim1, vt2_offset, i__1, i__2;
+ doublereal d__1, d__2;
+
+ /* Builtin functions */
+ double sqrt(doublereal), d_sign(doublereal *, doublereal *);
+
+ /* Local variables */
+ static integer i__, j, m, n, jc;
+ static doublereal rho;
+ static integer nlp1, nlp2, nrp1;
+ static doublereal temp;
+ extern doublereal dnrm2_(integer *, doublereal *, integer *);
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *);
+ static integer ctemp;
+ extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
+ doublereal *, integer *);
+ static integer ktemp;
+ extern doublereal dlamc3_(doublereal *, doublereal *);
+ extern /* Subroutine */ int dlasd4_(integer *, integer *, doublereal *,
+ doublereal *, doublereal *, doublereal *, doublereal *,
+ doublereal *, integer *), dlascl_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, integer *, doublereal *,
+ integer *, integer *), dlacpy_(char *, integer *, integer
+ *, doublereal *, integer *, doublereal *, integer *),
+ xerbla_(char *, integer *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Oak Ridge National Lab, Argonne National Lab,
+ Courant Institute, NAG Ltd., and Rice University
+ October 31, 1999
+
+
+ Purpose
+ =======
+
+ DLASD3 finds all the square roots of the roots of the secular
+ equation, as defined by the values in D and Z. It makes the
+ appropriate calls to DLASD4 and then updates the singular
+ vectors by matrix multiplication.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray XMP, Cray YMP, Cray C 90, or Cray 2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ DLASD3 is called from DLASD1.
+
+ Arguments
+ =========
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ K (input) INTEGER
+ The size of the secular equation, 1 =< K = < N.
+
+ D (output) DOUBLE PRECISION array, dimension(K)
+ On exit the square roots of the roots of the secular equation,
+ in ascending order.
+
+ Q (workspace) DOUBLE PRECISION array,
+ dimension at least (LDQ,K).
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= K.
+
+ DSIGMA (input) DOUBLE PRECISION array, dimension(K)
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation.
+
+ U (input) DOUBLE PRECISION array, dimension (LDU, N)
+ The last N - K columns of this matrix contain the deflated
+ left singular vectors.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= N.
+
+ U2 (input) DOUBLE PRECISION array, dimension (LDU2, N)
+ The first K columns of this matrix contain the non-deflated
+ left singular vectors for the split problem.
+
+ LDU2 (input) INTEGER
+ The leading dimension of the array U2. LDU2 >= N.
+
+ VT (input) DOUBLE PRECISION array, dimension (LDVT, M)
+ The last M - K columns of VT' contain the deflated
+ right singular vectors.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= N.
+
+ VT2 (input) DOUBLE PRECISION array, dimension (LDVT2, N)
+ The first K columns of VT2' contain the non-deflated
+ right singular vectors for the split problem.
+
+ LDVT2 (input) INTEGER
+ The leading dimension of the array VT2. LDVT2 >= N.
+
+ IDXC (input) INTEGER array, dimension ( N )
+ The permutation used to arrange the columns of U (and rows of
+ VT) into three groups: the first group contains non-zero
+ entries only at and above (or before) NL +1; the second
+ contains non-zero entries only at and below (or after) NL+2;
+ and the third is dense. The first column of U and the row of
+ VT are treated separately, however.
+
+ The rows of the singular vectors found by DLASD4
+ must be likewise permuted before the matrix multiplies can
+ take place.
+
+ CTOT (input) INTEGER array, dimension ( 4 )
+ A count of the total number of the various types of columns
+ in U (or rows in VT), as described in IDXC. The fourth column
+ type is any column which has been deflated.
+
+ Z (input) DOUBLE PRECISION array, dimension (K)
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating row vector.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ q_dim1 = *ldq;
+ q_offset = 1 + q_dim1 * 1;
+ q -= q_offset;
+ --dsigma;
+ u_dim1 = *ldu;
+ u_offset = 1 + u_dim1 * 1;
+ u -= u_offset;
+ u2_dim1 = *ldu2;
+ u2_offset = 1 + u2_dim1 * 1;
+ u2 -= u2_offset;
+ vt_dim1 = *ldvt;
+ vt_offset = 1 + vt_dim1 * 1;
+ vt -= vt_offset;
+ vt2_dim1 = *ldvt2;
+ vt2_offset = 1 + vt2_dim1 * 1;
+ vt2 -= vt2_offset;
+ --idxc;
+ --ctot;
+ --z__;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*nl < 1) {
+ *info = -1;
+ } else if (*nr < 1) {
+ *info = -2;
+ } else if ((*sqre != 1 && *sqre != 0)) {
+ *info = -3;
+ }
+
+ n = *nl + *nr + 1;
+ m = n + *sqre;
+ nlp1 = *nl + 1;
+ nlp2 = *nl + 2;
+
+ if (*k < 1 || *k > n) {
+ *info = -4;
+ } else if (*ldq < *k) {
+ *info = -7;
+ } else if (*ldu < n) {
+ *info = -10;
+ } else if (*ldu2 < n) {
+ *info = -12;
+ } else if (*ldvt < m) {
+ *info = -14;
+ } else if (*ldvt2 < m) {
+ *info = -16;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLASD3", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*k == 1) {
+ d__[1] = abs(z__[1]);
+ dcopy_(&m, &vt2[vt2_dim1 + 1], ldvt2, &vt[vt_dim1 + 1], ldvt);
+ if (z__[1] > 0.) {
+ dcopy_(&n, &u2[u2_dim1 + 1], &c__1, &u[u_dim1 + 1], &c__1);
+ } else {
+ i__1 = n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ u[i__ + u_dim1] = -u2[i__ + u2_dim1];
+/* L10: */
+ }
+ }
+ return 0;
+ }
+
+/*
+ Modify values DSIGMA(i) to make sure all DSIGMA(i)-DSIGMA(j) can
+ be computed with high relative accuracy (barring over/underflow).
+ This is a problem on machines without a guard digit in
+ add/subtract (Cray XMP, Cray YMP, Cray C 90 and Cray 2).
+ The following code replaces DSIGMA(I) by 2*DSIGMA(I)-DSIGMA(I),
+ which on any of these machines zeros out the bottommost
+ bit of DSIGMA(I) if it is 1; this makes the subsequent
+ subtractions DSIGMA(I)-DSIGMA(J) unproblematic when cancellation
+ occurs. On binary machines with a guard digit (almost all
+ machines) it does not change DSIGMA(I) at all. On hexadecimal
+ and decimal machines with a guard digit, it slightly
+ changes the bottommost bits of DSIGMA(I). It does not account
+ for hexadecimal or decimal machines without guard digits
+ (we know of none). We use a subroutine call to compute
+ 2*DLAMBDA(I) to prevent optimizing compilers from eliminating
+ this code.
+*/
+
+ i__1 = *k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dsigma[i__] = dlamc3_(&dsigma[i__], &dsigma[i__]) - dsigma[i__];
+/* L20: */
+ }
+
+/* Keep a copy of Z. */
+
+ dcopy_(k, &z__[1], &c__1, &q[q_offset], &c__1);
+
+/* Normalize Z. */
+
+ rho = dnrm2_(k, &z__[1], &c__1);
+ dlascl_("G", &c__0, &c__0, &rho, &c_b15, k, &c__1, &z__[1], k, info);
+ rho *= rho;
+
+/* Find the new singular values. */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dlasd4_(k, &j, &dsigma[1], &z__[1], &u[j * u_dim1 + 1], &rho, &d__[j],
+ &vt[j * vt_dim1 + 1], info);
+
+/* If the zero finder fails, the computation is terminated. */
+
+ if (*info != 0) {
+ return 0;
+ }
+/* L30: */
+ }
+
+/* Compute updated Z. */
+
+ i__1 = *k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ z__[i__] = u[i__ + *k * u_dim1] * vt[i__ + *k * vt_dim1];
+ i__2 = i__ - 1;
+ for (j = 1; j <= i__2; ++j) {
+ z__[i__] *= u[i__ + j * u_dim1] * vt[i__ + j * vt_dim1] / (dsigma[
+ i__] - dsigma[j]) / (dsigma[i__] + dsigma[j]);
+/* L40: */
+ }
+ i__2 = *k - 1;
+ for (j = i__; j <= i__2; ++j) {
+ z__[i__] *= u[i__ + j * u_dim1] * vt[i__ + j * vt_dim1] / (dsigma[
+ i__] - dsigma[j + 1]) / (dsigma[i__] + dsigma[j + 1]);
+/* L50: */
+ }
+ d__2 = sqrt((d__1 = z__[i__], abs(d__1)));
+ z__[i__] = d_sign(&d__2, &q[i__ + q_dim1]);
+/* L60: */
+ }
+
+/*
+ Compute left singular vectors of the modified diagonal matrix,
+ and store related information for the right singular vectors.
+*/
+
+ i__1 = *k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ vt[i__ * vt_dim1 + 1] = z__[1] / u[i__ * u_dim1 + 1] / vt[i__ *
+ vt_dim1 + 1];
+ u[i__ * u_dim1 + 1] = -1.;
+ i__2 = *k;
+ for (j = 2; j <= i__2; ++j) {
+ vt[j + i__ * vt_dim1] = z__[j] / u[j + i__ * u_dim1] / vt[j + i__
+ * vt_dim1];
+ u[j + i__ * u_dim1] = dsigma[j] * vt[j + i__ * vt_dim1];
+/* L70: */
+ }
+ temp = dnrm2_(k, &u[i__ * u_dim1 + 1], &c__1);
+ q[i__ * q_dim1 + 1] = u[i__ * u_dim1 + 1] / temp;
+ i__2 = *k;
+ for (j = 2; j <= i__2; ++j) {
+ jc = idxc[j];
+ q[j + i__ * q_dim1] = u[jc + i__ * u_dim1] / temp;
+/* L80: */
+ }
+/* L90: */
+ }
+
+/* Update the left singular vector matrix. */
+
+ if (*k == 2) {
+ dgemm_("N", "N", &n, k, k, &c_b15, &u2[u2_offset], ldu2, &q[q_offset],
+ ldq, &c_b29, &u[u_offset], ldu);
+ goto L100;
+ }
+ if (ctot[1] > 0) {
+ dgemm_("N", "N", nl, k, &ctot[1], &c_b15, &u2[((u2_dim1) << (1)) + 1],
+ ldu2, &q[q_dim1 + 2], ldq, &c_b29, &u[u_dim1 + 1], ldu);
+ if (ctot[3] > 0) {
+ ktemp = ctot[1] + 2 + ctot[2];
+ dgemm_("N", "N", nl, k, &ctot[3], &c_b15, &u2[ktemp * u2_dim1 + 1]
+ , ldu2, &q[ktemp + q_dim1], ldq, &c_b15, &u[u_dim1 + 1],
+ ldu);
+ }
+ } else if (ctot[3] > 0) {
+ ktemp = ctot[1] + 2 + ctot[2];
+ dgemm_("N", "N", nl, k, &ctot[3], &c_b15, &u2[ktemp * u2_dim1 + 1],
+ ldu2, &q[ktemp + q_dim1], ldq, &c_b29, &u[u_dim1 + 1], ldu);
+ } else {
+ dlacpy_("F", nl, k, &u2[u2_offset], ldu2, &u[u_offset], ldu);
+ }
+ dcopy_(k, &q[q_dim1 + 1], ldq, &u[nlp1 + u_dim1], ldu);
+ ktemp = ctot[1] + 2;
+ ctemp = ctot[2] + ctot[3];
+ dgemm_("N", "N", nr, k, &ctemp, &c_b15, &u2[nlp2 + ktemp * u2_dim1], ldu2,
+ &q[ktemp + q_dim1], ldq, &c_b29, &u[nlp2 + u_dim1], ldu);
+
+/* Generate the right singular vectors. */
+
+L100:
+ i__1 = *k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ temp = dnrm2_(k, &vt[i__ * vt_dim1 + 1], &c__1);
+ q[i__ + q_dim1] = vt[i__ * vt_dim1 + 1] / temp;
+ i__2 = *k;
+ for (j = 2; j <= i__2; ++j) {
+ jc = idxc[j];
+ q[i__ + j * q_dim1] = vt[jc + i__ * vt_dim1] / temp;
+/* L110: */
+ }
+/* L120: */
+ }
+
+/* Update the right singular vector matrix. */
+
+ if (*k == 2) {
+ dgemm_("N", "N", k, &m, k, &c_b15, &q[q_offset], ldq, &vt2[vt2_offset]
+ , ldvt2, &c_b29, &vt[vt_offset], ldvt);
+ return 0;
+ }
+ ktemp = ctot[1] + 1;
+ dgemm_("N", "N", k, &nlp1, &ktemp, &c_b15, &q[q_dim1 + 1], ldq, &vt2[
+ vt2_dim1 + 1], ldvt2, &c_b29, &vt[vt_dim1 + 1], ldvt);
+ ktemp = ctot[1] + 2 + ctot[2];
+ if (ktemp <= *ldvt2) {
+ dgemm_("N", "N", k, &nlp1, &ctot[3], &c_b15, &q[ktemp * q_dim1 + 1],
+ ldq, &vt2[ktemp + vt2_dim1], ldvt2, &c_b15, &vt[vt_dim1 + 1],
+ ldvt);
+ }
+
+ ktemp = ctot[1] + 1;
+ nrp1 = *nr + *sqre;
+ if (ktemp > 1) {
+ i__1 = *k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ q[i__ + ktemp * q_dim1] = q[i__ + q_dim1];
+/* L130: */
+ }
+ i__1 = m;
+ for (i__ = nlp2; i__ <= i__1; ++i__) {
+ vt2[ktemp + i__ * vt2_dim1] = vt2[i__ * vt2_dim1 + 1];
+/* L140: */
+ }
+ }
+ ctemp = ctot[2] + 1 + ctot[3];
+ dgemm_("N", "N", k, &nrp1, &ctemp, &c_b15, &q[ktemp * q_dim1 + 1], ldq, &
+ vt2[ktemp + nlp2 * vt2_dim1], ldvt2, &c_b29, &vt[nlp2 * vt_dim1 +
+ 1], ldvt);
+
+ return 0;
+
+/* End of DLASD3 */
+
+} /* dlasd3_ */
+
+/* Subroutine */ int dlasd4_(integer *n, integer *i__, doublereal *d__,
+ doublereal *z__, doublereal *delta, doublereal *rho, doublereal *
+ sigma, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static doublereal a, b, c__;
+ static integer j;
+ static doublereal w, dd[3];
+ static integer ii;
+ static doublereal dw, zz[3];
+ static integer ip1;
+ static doublereal eta, phi, eps, tau, psi;
+ static integer iim1, iip1;
+ static doublereal dphi, dpsi;
+ static integer iter;
+ static doublereal temp, prew, sg2lb, sg2ub, temp1, temp2, dtiim, delsq,
+ dtiip;
+ static integer niter;
+ static doublereal dtisq;
+ static logical swtch;
+ static doublereal dtnsq;
+ extern /* Subroutine */ int dlaed6_(integer *, logical *, doublereal *,
+ doublereal *, doublereal *, doublereal *, doublereal *, integer *)
+ , dlasd5_(integer *, doublereal *, doublereal *, doublereal *,
+ doublereal *, doublereal *, doublereal *);
+ static doublereal delsq2, dtnsq1;
+ static logical swtch3;
+
+ static logical orgati;
+ static doublereal erretm, dtipsq, rhoinv;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Oak Ridge National Lab, Argonne National Lab,
+ Courant Institute, NAG Ltd., and Rice University
+ October 31, 1999
+
+
+ Purpose
+ =======
+
+ This subroutine computes the square root of the I-th updated
+ eigenvalue of a positive symmetric rank-one modification to
+ a positive diagonal matrix whose entries are given as the squares
+ of the corresponding entries in the array d, and that
+
+ 0 <= D(i) < D(j) for i < j
+
+ and that RHO > 0. This is arranged by the calling routine, and is
+ no loss in generality. The rank-one modified system is thus
+
+ diag( D ) * diag( D ) + RHO * Z * Z_transpose.
+
+ where we assume the Euclidean norm of Z is 1.
+
+ The method consists of approximating the rational functions in the
+ secular equation by simpler interpolating rational functions.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The length of all arrays.
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. 1 <= I <= N.
+
+ D (input) DOUBLE PRECISION array, dimension ( N )
+ The original eigenvalues. It is assumed that they are in
+ order, 0 <= D(I) < D(J) for I < J.
+
+ Z (input) DOUBLE PRECISION array, dimension ( N )
+ The components of the updating vector.
+
+ DELTA (output) DOUBLE PRECISION array, dimension ( N )
+ If N .ne. 1, DELTA contains (D(j) - sigma_I) in its j-th
+ component. If N = 1, then DELTA(1) = 1. The vector DELTA
+ contains the information necessary to construct the
+ (singular) eigenvectors.
+
+ RHO (input) DOUBLE PRECISION
+ The scalar in the symmetric updating formula.
+
+ SIGMA (output) DOUBLE PRECISION
+ The computed lambda_I, the I-th updated eigenvalue.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension ( N )
+ If N .ne. 1, WORK contains (D(j) + sigma_I) in its j-th
+ component. If N = 1, then WORK( 1 ) = 1.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = 1, the updating process failed.
+
+ Internal Parameters
+ ===================
+
+ Logical variable ORGATI (origin-at-i?) is used for distinguishing
+ whether D(i) or D(i+1) is treated as the origin.
+
+ ORGATI = .true. origin at i
+ ORGATI = .false. origin at i+1
+
+ Logical variable SWTCH3 (switch-for-3-poles?) is for noting
+ if we are working with THREE poles!
+
+ MAXIT is the maximum number of iterations allowed for each
+ eigenvalue.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+
+ Since this routine is called in an inner loop, we do no argument
+ checking.
+
+ Quick return for N=1 and 2.
+*/
+
+ /* Parameter adjustments */
+ --work;
+ --delta;
+ --z__;
+ --d__;
+
+ /* Function Body */
+ *info = 0;
+ if (*n == 1) {
+
+/* Presumably, I=1 upon entry */
+
+ *sigma = sqrt(d__[1] * d__[1] + *rho * z__[1] * z__[1]);
+ delta[1] = 1.;
+ work[1] = 1.;
+ return 0;
+ }
+ if (*n == 2) {
+ dlasd5_(i__, &d__[1], &z__[1], &delta[1], rho, sigma, &work[1]);
+ return 0;
+ }
+
+/* Compute machine epsilon */
+
+ eps = EPSILON;
+ rhoinv = 1. / *rho;
+
+/* The case I = N */
+
+ if (*i__ == *n) {
+
+/* Initialize some basic variables */
+
+ ii = *n - 1;
+ niter = 1;
+
+/* Calculate initial guess */
+
+ temp = *rho / 2.;
+
+/*
+ If ||Z||_2 is not one, then TEMP should be set to
+ RHO * ||Z||_2^2 / TWO
+*/
+
+ temp1 = temp / (d__[*n] + sqrt(d__[*n] * d__[*n] + temp));
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ work[j] = d__[j] + d__[*n] + temp1;
+ delta[j] = d__[j] - d__[*n] - temp1;
+/* L10: */
+ }
+
+ psi = 0.;
+ i__1 = *n - 2;
+ for (j = 1; j <= i__1; ++j) {
+ psi += z__[j] * z__[j] / (delta[j] * work[j]);
+/* L20: */
+ }
+
+ c__ = rhoinv + psi;
+ w = c__ + z__[ii] * z__[ii] / (delta[ii] * work[ii]) + z__[*n] * z__[*
+ n] / (delta[*n] * work[*n]);
+
+ if (w <= 0.) {
+ temp1 = sqrt(d__[*n] * d__[*n] + *rho);
+ temp = z__[*n - 1] * z__[*n - 1] / ((d__[*n - 1] + temp1) * (d__[*
+ n] - d__[*n - 1] + *rho / (d__[*n] + temp1))) + z__[*n] *
+ z__[*n] / *rho;
+
+/*
+ The following TAU is to approximate
+ SIGMA_n^2 - D( N )*D( N )
+*/
+
+ if (c__ <= temp) {
+ tau = *rho;
+ } else {
+ delsq = (d__[*n] - d__[*n - 1]) * (d__[*n] + d__[*n - 1]);
+ a = -c__ * delsq + z__[*n - 1] * z__[*n - 1] + z__[*n] * z__[*
+ n];
+ b = z__[*n] * z__[*n] * delsq;
+ if (a < 0.) {
+ tau = b * 2. / (sqrt(a * a + b * 4. * c__) - a);
+ } else {
+ tau = (a + sqrt(a * a + b * 4. * c__)) / (c__ * 2.);
+ }
+ }
+
+/*
+ It can be proved that
+ D(N)^2+RHO/2 <= SIGMA_n^2 < D(N)^2+TAU <= D(N)^2+RHO
+*/
+
+ } else {
+ delsq = (d__[*n] - d__[*n - 1]) * (d__[*n] + d__[*n - 1]);
+ a = -c__ * delsq + z__[*n - 1] * z__[*n - 1] + z__[*n] * z__[*n];
+ b = z__[*n] * z__[*n] * delsq;
+
+/*
+ The following TAU is to approximate
+ SIGMA_n^2 - D( N )*D( N )
+*/
+
+ if (a < 0.) {
+ tau = b * 2. / (sqrt(a * a + b * 4. * c__) - a);
+ } else {
+ tau = (a + sqrt(a * a + b * 4. * c__)) / (c__ * 2.);
+ }
+
+/*
+ It can be proved that
+ D(N)^2 < D(N)^2+TAU < SIGMA(N)^2 < D(N)^2+RHO/2
+*/
+
+ }
+
+/* The following ETA is to approximate SIGMA_n - D( N ) */
+
+ eta = tau / (d__[*n] + sqrt(d__[*n] * d__[*n] + tau));
+
+ *sigma = d__[*n] + eta;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ delta[j] = d__[j] - d__[*i__] - eta;
+ work[j] = d__[j] + d__[*i__] + eta;
+/* L30: */
+ }
+
+/* Evaluate PSI and the derivative DPSI */
+
+ dpsi = 0.;
+ psi = 0.;
+ erretm = 0.;
+ i__1 = ii;
+ for (j = 1; j <= i__1; ++j) {
+ temp = z__[j] / (delta[j] * work[j]);
+ psi += z__[j] * temp;
+ dpsi += temp * temp;
+ erretm += psi;
+/* L40: */
+ }
+ erretm = abs(erretm);
+
+/* Evaluate PHI and the derivative DPHI */
+
+ temp = z__[*n] / (delta[*n] * work[*n]);
+ phi = z__[*n] * temp;
+ dphi = temp * temp;
+ erretm = (-phi - psi) * 8. + erretm - phi + rhoinv + abs(tau) * (dpsi
+ + dphi);
+
+ w = rhoinv + phi + psi;
+
+/* Test for convergence */
+
+ if (abs(w) <= eps * erretm) {
+ goto L240;
+ }
+
+/* Calculate the new step */
+
+ ++niter;
+ dtnsq1 = work[*n - 1] * delta[*n - 1];
+ dtnsq = work[*n] * delta[*n];
+ c__ = w - dtnsq1 * dpsi - dtnsq * dphi;
+ a = (dtnsq + dtnsq1) * w - dtnsq * dtnsq1 * (dpsi + dphi);
+ b = dtnsq * dtnsq1 * w;
+ if (c__ < 0.) {
+ c__ = abs(c__);
+ }
+ if (c__ == 0.) {
+ eta = *rho - *sigma * *sigma;
+ } else if (a >= 0.) {
+ eta = (a + sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))) / (c__
+ * 2.);
+ } else {
+ eta = b * 2. / (a - sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))
+ );
+ }
+
+/*
+ Note, eta should be positive if w is negative, and
+ eta should be negative otherwise. However,
+ if for some reason caused by roundoff, eta*w > 0,
+ we simply use one Newton step instead. This way
+ will guarantee eta*w < 0.
+*/
+
+ if (w * eta > 0.) {
+ eta = -w / (dpsi + dphi);
+ }
+ temp = eta - dtnsq;
+ if (temp > *rho) {
+ eta = *rho + dtnsq;
+ }
+
+ tau += eta;
+ eta /= *sigma + sqrt(eta + *sigma * *sigma);
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ delta[j] -= eta;
+ work[j] += eta;
+/* L50: */
+ }
+
+ *sigma += eta;
+
+/* Evaluate PSI and the derivative DPSI */
+
+ dpsi = 0.;
+ psi = 0.;
+ erretm = 0.;
+ i__1 = ii;
+ for (j = 1; j <= i__1; ++j) {
+ temp = z__[j] / (work[j] * delta[j]);
+ psi += z__[j] * temp;
+ dpsi += temp * temp;
+ erretm += psi;
+/* L60: */
+ }
+ erretm = abs(erretm);
+
+/* Evaluate PHI and the derivative DPHI */
+
+ temp = z__[*n] / (work[*n] * delta[*n]);
+ phi = z__[*n] * temp;
+ dphi = temp * temp;
+ erretm = (-phi - psi) * 8. + erretm - phi + rhoinv + abs(tau) * (dpsi
+ + dphi);
+
+ w = rhoinv + phi + psi;
+
+/* Main loop to update the values of the array DELTA */
+
+ iter = niter + 1;
+
+ for (niter = iter; niter <= 20; ++niter) {
+
+/* Test for convergence */
+
+ if (abs(w) <= eps * erretm) {
+ goto L240;
+ }
+
+/* Calculate the new step */
+
+ dtnsq1 = work[*n - 1] * delta[*n - 1];
+ dtnsq = work[*n] * delta[*n];
+ c__ = w - dtnsq1 * dpsi - dtnsq * dphi;
+ a = (dtnsq + dtnsq1) * w - dtnsq1 * dtnsq * (dpsi + dphi);
+ b = dtnsq1 * dtnsq * w;
+ if (a >= 0.) {
+ eta = (a + sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))) / (
+ c__ * 2.);
+ } else {
+ eta = b * 2. / (a - sqrt((d__1 = a * a - b * 4. * c__, abs(
+ d__1))));
+ }
+
+/*
+ Note, eta should be positive if w is negative, and
+ eta should be negative otherwise. However,
+ if for some reason caused by roundoff, eta*w > 0,
+ we simply use one Newton step instead. This way
+ will guarantee eta*w < 0.
+*/
+
+ if (w * eta > 0.) {
+ eta = -w / (dpsi + dphi);
+ }
+ temp = eta - dtnsq;
+ if (temp <= 0.) {
+ eta /= 2.;
+ }
+
+ tau += eta;
+ eta /= *sigma + sqrt(eta + *sigma * *sigma);
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ delta[j] -= eta;
+ work[j] += eta;
+/* L70: */
+ }
+
+ *sigma += eta;
+
+/* Evaluate PSI and the derivative DPSI */
+
+ dpsi = 0.;
+ psi = 0.;
+ erretm = 0.;
+ i__1 = ii;
+ for (j = 1; j <= i__1; ++j) {
+ temp = z__[j] / (work[j] * delta[j]);
+ psi += z__[j] * temp;
+ dpsi += temp * temp;
+ erretm += psi;
+/* L80: */
+ }
+ erretm = abs(erretm);
+
+/* Evaluate PHI and the derivative DPHI */
+
+ temp = z__[*n] / (work[*n] * delta[*n]);
+ phi = z__[*n] * temp;
+ dphi = temp * temp;
+ erretm = (-phi - psi) * 8. + erretm - phi + rhoinv + abs(tau) * (
+ dpsi + dphi);
+
+ w = rhoinv + phi + psi;
+/* L90: */
+ }
+
+/* Return with INFO = 1, NITER = MAXIT and not converged */
+
+ *info = 1;
+ goto L240;
+
+/* End for the case I = N */
+
+ } else {
+
+/* The case for I < N */
+
+ niter = 1;
+ ip1 = *i__ + 1;
+
+/* Calculate initial guess */
+
+ delsq = (d__[ip1] - d__[*i__]) * (d__[ip1] + d__[*i__]);
+ delsq2 = delsq / 2.;
+ temp = delsq2 / (d__[*i__] + sqrt(d__[*i__] * d__[*i__] + delsq2));
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ work[j] = d__[j] + d__[*i__] + temp;
+ delta[j] = d__[j] - d__[*i__] - temp;
+/* L100: */
+ }
+
+ psi = 0.;
+ i__1 = *i__ - 1;
+ for (j = 1; j <= i__1; ++j) {
+ psi += z__[j] * z__[j] / (work[j] * delta[j]);
+/* L110: */
+ }
+
+ phi = 0.;
+ i__1 = *i__ + 2;
+ for (j = *n; j >= i__1; --j) {
+ phi += z__[j] * z__[j] / (work[j] * delta[j]);
+/* L120: */
+ }
+ c__ = rhoinv + psi + phi;
+ w = c__ + z__[*i__] * z__[*i__] / (work[*i__] * delta[*i__]) + z__[
+ ip1] * z__[ip1] / (work[ip1] * delta[ip1]);
+
+ if (w > 0.) {
+
+/*
+ d(i)^2 < the ith sigma^2 < (d(i)^2+d(i+1)^2)/2
+
+ We choose d(i) as origin.
+*/
+
+ orgati = TRUE_;
+ sg2lb = 0.;
+ sg2ub = delsq2;
+ a = c__ * delsq + z__[*i__] * z__[*i__] + z__[ip1] * z__[ip1];
+ b = z__[*i__] * z__[*i__] * delsq;
+ if (a > 0.) {
+ tau = b * 2. / (a + sqrt((d__1 = a * a - b * 4. * c__, abs(
+ d__1))));
+ } else {
+ tau = (a - sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))) / (
+ c__ * 2.);
+ }
+
+/*
+ TAU now is an estimation of SIGMA^2 - D( I )^2. The
+ following, however, is the corresponding estimation of
+ SIGMA - D( I ).
+*/
+
+ eta = tau / (d__[*i__] + sqrt(d__[*i__] * d__[*i__] + tau));
+ } else {
+
+/*
+ (d(i)^2+d(i+1)^2)/2 <= the ith sigma^2 < d(i+1)^2/2
+
+ We choose d(i+1) as origin.
+*/
+
+ orgati = FALSE_;
+ sg2lb = -delsq2;
+ sg2ub = 0.;
+ a = c__ * delsq - z__[*i__] * z__[*i__] - z__[ip1] * z__[ip1];
+ b = z__[ip1] * z__[ip1] * delsq;
+ if (a < 0.) {
+ tau = b * 2. / (a - sqrt((d__1 = a * a + b * 4. * c__, abs(
+ d__1))));
+ } else {
+ tau = -(a + sqrt((d__1 = a * a + b * 4. * c__, abs(d__1)))) /
+ (c__ * 2.);
+ }
+
+/*
+ TAU now is an estimation of SIGMA^2 - D( IP1 )^2. The
+ following, however, is the corresponding estimation of
+ SIGMA - D( IP1 ).
+*/
+
+ eta = tau / (d__[ip1] + sqrt((d__1 = d__[ip1] * d__[ip1] + tau,
+ abs(d__1))));
+ }
+
+ if (orgati) {
+ ii = *i__;
+ *sigma = d__[*i__] + eta;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ work[j] = d__[j] + d__[*i__] + eta;
+ delta[j] = d__[j] - d__[*i__] - eta;
+/* L130: */
+ }
+ } else {
+ ii = *i__ + 1;
+ *sigma = d__[ip1] + eta;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ work[j] = d__[j] + d__[ip1] + eta;
+ delta[j] = d__[j] - d__[ip1] - eta;
+/* L140: */
+ }
+ }
+ iim1 = ii - 1;
+ iip1 = ii + 1;
+
+/* Evaluate PSI and the derivative DPSI */
+
+ dpsi = 0.;
+ psi = 0.;
+ erretm = 0.;
+ i__1 = iim1;
+ for (j = 1; j <= i__1; ++j) {
+ temp = z__[j] / (work[j] * delta[j]);
+ psi += z__[j] * temp;
+ dpsi += temp * temp;
+ erretm += psi;
+/* L150: */
+ }
+ erretm = abs(erretm);
+
+/* Evaluate PHI and the derivative DPHI */
+
+ dphi = 0.;
+ phi = 0.;
+ i__1 = iip1;
+ for (j = *n; j >= i__1; --j) {
+ temp = z__[j] / (work[j] * delta[j]);
+ phi += z__[j] * temp;
+ dphi += temp * temp;
+ erretm += phi;
+/* L160: */
+ }
+
+ w = rhoinv + phi + psi;
+
+/*
+ W is the value of the secular function with
+ its ii-th element removed.
+*/
+
+ swtch3 = FALSE_;
+ if (orgati) {
+ if (w < 0.) {
+ swtch3 = TRUE_;
+ }
+ } else {
+ if (w > 0.) {
+ swtch3 = TRUE_;
+ }
+ }
+ if (ii == 1 || ii == *n) {
+ swtch3 = FALSE_;
+ }
+
+ temp = z__[ii] / (work[ii] * delta[ii]);
+ dw = dpsi + dphi + temp * temp;
+ temp = z__[ii] * temp;
+ w += temp;
+ erretm = (phi - psi) * 8. + erretm + rhoinv * 2. + abs(temp) * 3. +
+ abs(tau) * dw;
+
+/* Test for convergence */
+
+ if (abs(w) <= eps * erretm) {
+ goto L240;
+ }
+
+ if (w <= 0.) {
+ sg2lb = max(sg2lb,tau);
+ } else {
+ sg2ub = min(sg2ub,tau);
+ }
+
+/* Calculate the new step */
+
+ ++niter;
+ if (! swtch3) {
+ dtipsq = work[ip1] * delta[ip1];
+ dtisq = work[*i__] * delta[*i__];
+ if (orgati) {
+/* Computing 2nd power */
+ d__1 = z__[*i__] / dtisq;
+ c__ = w - dtipsq * dw + delsq * (d__1 * d__1);
+ } else {
+/* Computing 2nd power */
+ d__1 = z__[ip1] / dtipsq;
+ c__ = w - dtisq * dw - delsq * (d__1 * d__1);
+ }
+ a = (dtipsq + dtisq) * w - dtipsq * dtisq * dw;
+ b = dtipsq * dtisq * w;
+ if (c__ == 0.) {
+ if (a == 0.) {
+ if (orgati) {
+ a = z__[*i__] * z__[*i__] + dtipsq * dtipsq * (dpsi +
+ dphi);
+ } else {
+ a = z__[ip1] * z__[ip1] + dtisq * dtisq * (dpsi +
+ dphi);
+ }
+ }
+ eta = b / a;
+ } else if (a <= 0.) {
+ eta = (a - sqrt((d__1 = a * a - b * 4. * c__, abs(d__1)))) / (
+ c__ * 2.);
+ } else {
+ eta = b * 2. / (a + sqrt((d__1 = a * a - b * 4. * c__, abs(
+ d__1))));
+ }
+ } else {
+
+/* Interpolation using THREE most relevant poles */
+
+ dtiim = work[iim1] * delta[iim1];
+ dtiip = work[iip1] * delta[iip1];
+ temp = rhoinv + psi + phi;
+ if (orgati) {
+ temp1 = z__[iim1] / dtiim;
+ temp1 *= temp1;
+ c__ = temp - dtiip * (dpsi + dphi) - (d__[iim1] - d__[iip1]) *
+ (d__[iim1] + d__[iip1]) * temp1;
+ zz[0] = z__[iim1] * z__[iim1];
+ if (dpsi < temp1) {
+ zz[2] = dtiip * dtiip * dphi;
+ } else {
+ zz[2] = dtiip * dtiip * (dpsi - temp1 + dphi);
+ }
+ } else {
+ temp1 = z__[iip1] / dtiip;
+ temp1 *= temp1;
+ c__ = temp - dtiim * (dpsi + dphi) - (d__[iip1] - d__[iim1]) *
+ (d__[iim1] + d__[iip1]) * temp1;
+ if (dphi < temp1) {
+ zz[0] = dtiim * dtiim * dpsi;
+ } else {
+ zz[0] = dtiim * dtiim * (dpsi + (dphi - temp1));
+ }
+ zz[2] = z__[iip1] * z__[iip1];
+ }
+ zz[1] = z__[ii] * z__[ii];
+ dd[0] = dtiim;
+ dd[1] = delta[ii] * work[ii];
+ dd[2] = dtiip;
+ dlaed6_(&niter, &orgati, &c__, dd, zz, &w, &eta, info);
+ if (*info != 0) {
+ goto L240;
+ }
+ }
+
+/*
+ Note, eta should be positive if w is negative, and
+ eta should be negative otherwise. However,
+ if for some reason caused by roundoff, eta*w > 0,
+ we simply use one Newton step instead. This way
+ will guarantee eta*w < 0.
+*/
+
+ if (w * eta >= 0.) {
+ eta = -w / dw;
+ }
+ if (orgati) {
+ temp1 = work[*i__] * delta[*i__];
+ temp = eta - temp1;
+ } else {
+ temp1 = work[ip1] * delta[ip1];
+ temp = eta - temp1;
+ }
+ if (temp > sg2ub || temp < sg2lb) {
+ if (w < 0.) {
+ eta = (sg2ub - tau) / 2.;
+ } else {
+ eta = (sg2lb - tau) / 2.;
+ }
+ }
+
+ tau += eta;
+ eta /= *sigma + sqrt(*sigma * *sigma + eta);
+
+ prew = w;
+
+ *sigma += eta;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ work[j] += eta;
+ delta[j] -= eta;
+/* L170: */
+ }
+
+/* Evaluate PSI and the derivative DPSI */
+
+ dpsi = 0.;
+ psi = 0.;
+ erretm = 0.;
+ i__1 = iim1;
+ for (j = 1; j <= i__1; ++j) {
+ temp = z__[j] / (work[j] * delta[j]);
+ psi += z__[j] * temp;
+ dpsi += temp * temp;
+ erretm += psi;
+/* L180: */
+ }
+ erretm = abs(erretm);
+
+/* Evaluate PHI and the derivative DPHI */
+
+ dphi = 0.;
+ phi = 0.;
+ i__1 = iip1;
+ for (j = *n; j >= i__1; --j) {
+ temp = z__[j] / (work[j] * delta[j]);
+ phi += z__[j] * temp;
+ dphi += temp * temp;
+ erretm += phi;
+/* L190: */
+ }
+
+ temp = z__[ii] / (work[ii] * delta[ii]);
+ dw = dpsi + dphi + temp * temp;
+ temp = z__[ii] * temp;
+ w = rhoinv + phi + psi + temp;
+ erretm = (phi - psi) * 8. + erretm + rhoinv * 2. + abs(temp) * 3. +
+ abs(tau) * dw;
+
+ if (w <= 0.) {
+ sg2lb = max(sg2lb,tau);
+ } else {
+ sg2ub = min(sg2ub,tau);
+ }
+
+ swtch = FALSE_;
+ if (orgati) {
+ if (-w > abs(prew) / 10.) {
+ swtch = TRUE_;
+ }
+ } else {
+ if (w > abs(prew) / 10.) {
+ swtch = TRUE_;
+ }
+ }
+
+/* Main loop to update the values of the array DELTA and WORK */
+
+ iter = niter + 1;
+
+ for (niter = iter; niter <= 20; ++niter) {
+
+/* Test for convergence */
+
+ if (abs(w) <= eps * erretm) {
+ goto L240;
+ }
+
+/* Calculate the new step */
+
+ if (! swtch3) {
+ dtipsq = work[ip1] * delta[ip1];
+ dtisq = work[*i__] * delta[*i__];
+ if (! swtch) {
+ if (orgati) {
+/* Computing 2nd power */
+ d__1 = z__[*i__] / dtisq;
+ c__ = w - dtipsq * dw + delsq * (d__1 * d__1);
+ } else {
+/* Computing 2nd power */
+ d__1 = z__[ip1] / dtipsq;
+ c__ = w - dtisq * dw - delsq * (d__1 * d__1);
+ }
+ } else {
+ temp = z__[ii] / (work[ii] * delta[ii]);
+ if (orgati) {
+ dpsi += temp * temp;
+ } else {
+ dphi += temp * temp;
+ }
+ c__ = w - dtisq * dpsi - dtipsq * dphi;
+ }
+ a = (dtipsq + dtisq) * w - dtipsq * dtisq * dw;
+ b = dtipsq * dtisq * w;
+ if (c__ == 0.) {
+ if (a == 0.) {
+ if (! swtch) {
+ if (orgati) {
+ a = z__[*i__] * z__[*i__] + dtipsq * dtipsq *
+ (dpsi + dphi);
+ } else {
+ a = z__[ip1] * z__[ip1] + dtisq * dtisq * (
+ dpsi + dphi);
+ }
+ } else {
+ a = dtisq * dtisq * dpsi + dtipsq * dtipsq * dphi;
+ }
+ }
+ eta = b / a;
+ } else if (a <= 0.) {
+ eta = (a - sqrt((d__1 = a * a - b * 4. * c__, abs(d__1))))
+ / (c__ * 2.);
+ } else {
+ eta = b * 2. / (a + sqrt((d__1 = a * a - b * 4. * c__,
+ abs(d__1))));
+ }
+ } else {
+
+/* Interpolation using THREE most relevant poles */
+
+ dtiim = work[iim1] * delta[iim1];
+ dtiip = work[iip1] * delta[iip1];
+ temp = rhoinv + psi + phi;
+ if (swtch) {
+ c__ = temp - dtiim * dpsi - dtiip * dphi;
+ zz[0] = dtiim * dtiim * dpsi;
+ zz[2] = dtiip * dtiip * dphi;
+ } else {
+ if (orgati) {
+ temp1 = z__[iim1] / dtiim;
+ temp1 *= temp1;
+ temp2 = (d__[iim1] - d__[iip1]) * (d__[iim1] + d__[
+ iip1]) * temp1;
+ c__ = temp - dtiip * (dpsi + dphi) - temp2;
+ zz[0] = z__[iim1] * z__[iim1];
+ if (dpsi < temp1) {
+ zz[2] = dtiip * dtiip * dphi;
+ } else {
+ zz[2] = dtiip * dtiip * (dpsi - temp1 + dphi);
+ }
+ } else {
+ temp1 = z__[iip1] / dtiip;
+ temp1 *= temp1;
+ temp2 = (d__[iip1] - d__[iim1]) * (d__[iim1] + d__[
+ iip1]) * temp1;
+ c__ = temp - dtiim * (dpsi + dphi) - temp2;
+ if (dphi < temp1) {
+ zz[0] = dtiim * dtiim * dpsi;
+ } else {
+ zz[0] = dtiim * dtiim * (dpsi + (dphi - temp1));
+ }
+ zz[2] = z__[iip1] * z__[iip1];
+ }
+ }
+ dd[0] = dtiim;
+ dd[1] = delta[ii] * work[ii];
+ dd[2] = dtiip;
+ dlaed6_(&niter, &orgati, &c__, dd, zz, &w, &eta, info);
+ if (*info != 0) {
+ goto L240;
+ }
+ }
+
+/*
+ Note, eta should be positive if w is negative, and
+ eta should be negative otherwise. However,
+ if for some reason caused by roundoff, eta*w > 0,
+ we simply use one Newton step instead. This way
+ will guarantee eta*w < 0.
+*/
+
+ if (w * eta >= 0.) {
+ eta = -w / dw;
+ }
+ if (orgati) {
+ temp1 = work[*i__] * delta[*i__];
+ temp = eta - temp1;
+ } else {
+ temp1 = work[ip1] * delta[ip1];
+ temp = eta - temp1;
+ }
+ if (temp > sg2ub || temp < sg2lb) {
+ if (w < 0.) {
+ eta = (sg2ub - tau) / 2.;
+ } else {
+ eta = (sg2lb - tau) / 2.;
+ }
+ }
+
+ tau += eta;
+ eta /= *sigma + sqrt(*sigma * *sigma + eta);
+
+ *sigma += eta;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ work[j] += eta;
+ delta[j] -= eta;
+/* L200: */
+ }
+
+ prew = w;
+
+/* Evaluate PSI and the derivative DPSI */
+
+ dpsi = 0.;
+ psi = 0.;
+ erretm = 0.;
+ i__1 = iim1;
+ for (j = 1; j <= i__1; ++j) {
+ temp = z__[j] / (work[j] * delta[j]);
+ psi += z__[j] * temp;
+ dpsi += temp * temp;
+ erretm += psi;
+/* L210: */
+ }
+ erretm = abs(erretm);
+
+/* Evaluate PHI and the derivative DPHI */
+
+ dphi = 0.;
+ phi = 0.;
+ i__1 = iip1;
+ for (j = *n; j >= i__1; --j) {
+ temp = z__[j] / (work[j] * delta[j]);
+ phi += z__[j] * temp;
+ dphi += temp * temp;
+ erretm += phi;
+/* L220: */
+ }
+
+ temp = z__[ii] / (work[ii] * delta[ii]);
+ dw = dpsi + dphi + temp * temp;
+ temp = z__[ii] * temp;
+ w = rhoinv + phi + psi + temp;
+ erretm = (phi - psi) * 8. + erretm + rhoinv * 2. + abs(temp) * 3.
+ + abs(tau) * dw;
+ if ((w * prew > 0. && abs(w) > abs(prew) / 10.)) {
+ swtch = ! swtch;
+ }
+
+ if (w <= 0.) {
+ sg2lb = max(sg2lb,tau);
+ } else {
+ sg2ub = min(sg2ub,tau);
+ }
+
+/* L230: */
+ }
+
+/* Return with INFO = 1, NITER = MAXIT and not converged */
+
+ *info = 1;
+
+ }
+
+L240:
+ return 0;
+
+/* End of DLASD4 */
+
+} /* dlasd4_ */
+
+/* Subroutine */ int dlasd5_(integer *i__, doublereal *d__, doublereal *z__,
+ doublereal *delta, doublereal *rho, doublereal *dsigma, doublereal *
+ work)
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static doublereal b, c__, w, del, tau, delsq;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Oak Ridge National Lab, Argonne National Lab,
+ Courant Institute, NAG Ltd., and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ This subroutine computes the square root of the I-th eigenvalue
+ of a positive symmetric rank-one modification of a 2-by-2 diagonal
+ matrix
+
+ diag( D ) * diag( D ) + RHO * Z * transpose(Z) .
+
+ The diagonal entries in the array D are assumed to satisfy
+
+ 0 <= D(i) < D(j) for i < j .
+
+ We also assume RHO > 0 and that the Euclidean norm of the vector
+ Z is one.
+
+ Arguments
+ =========
+
+ I (input) INTEGER
+ The index of the eigenvalue to be computed. I = 1 or I = 2.
+
+ D (input) DOUBLE PRECISION array, dimension ( 2 )
+ The original eigenvalues. We assume 0 <= D(1) < D(2).
+
+ Z (input) DOUBLE PRECISION array, dimension ( 2 )
+ The components of the updating vector.
+
+ DELTA (output) DOUBLE PRECISION array, dimension ( 2 )
+ Contains (D(j) - lambda_I) in its j-th component.
+ The vector DELTA contains the information necessary
+ to construct the eigenvectors.
+
+ RHO (input) DOUBLE PRECISION
+ The scalar in the symmetric updating formula.
+
+ DSIGMA (output) DOUBLE PRECISION
+ The computed lambda_I, the I-th updated eigenvalue.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension ( 2 )
+ WORK contains (D(j) + sigma_I) in its j-th component.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ren-Cang Li, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ --work;
+ --delta;
+ --z__;
+ --d__;
+
+ /* Function Body */
+ del = d__[2] - d__[1];
+ delsq = del * (d__[2] + d__[1]);
+ if (*i__ == 1) {
+ w = *rho * 4. * (z__[2] * z__[2] / (d__[1] + d__[2] * 3.) - z__[1] *
+ z__[1] / (d__[1] * 3. + d__[2])) / del + 1.;
+ if (w > 0.) {
+ b = delsq + *rho * (z__[1] * z__[1] + z__[2] * z__[2]);
+ c__ = *rho * z__[1] * z__[1] * delsq;
+
+/*
+ B > ZERO, always
+
+ The following TAU is DSIGMA * DSIGMA - D( 1 ) * D( 1 )
+*/
+
+ tau = c__ * 2. / (b + sqrt((d__1 = b * b - c__ * 4., abs(d__1))));
+
+/* The following TAU is DSIGMA - D( 1 ) */
+
+ tau /= d__[1] + sqrt(d__[1] * d__[1] + tau);
+ *dsigma = d__[1] + tau;
+ delta[1] = -tau;
+ delta[2] = del - tau;
+ work[1] = d__[1] * 2. + tau;
+ work[2] = d__[1] + tau + d__[2];
+/*
+ DELTA( 1 ) = -Z( 1 ) / TAU
+ DELTA( 2 ) = Z( 2 ) / ( DEL-TAU )
+*/
+ } else {
+ b = -delsq + *rho * (z__[1] * z__[1] + z__[2] * z__[2]);
+ c__ = *rho * z__[2] * z__[2] * delsq;
+
+/* The following TAU is DSIGMA * DSIGMA - D( 2 ) * D( 2 ) */
+
+ if (b > 0.) {
+ tau = c__ * -2. / (b + sqrt(b * b + c__ * 4.));
+ } else {
+ tau = (b - sqrt(b * b + c__ * 4.)) / 2.;
+ }
+
+/* The following TAU is DSIGMA - D( 2 ) */
+
+ tau /= d__[2] + sqrt((d__1 = d__[2] * d__[2] + tau, abs(d__1)));
+ *dsigma = d__[2] + tau;
+ delta[1] = -(del + tau);
+ delta[2] = -tau;
+ work[1] = d__[1] + tau + d__[2];
+ work[2] = d__[2] * 2. + tau;
+/*
+ DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU )
+ DELTA( 2 ) = -Z( 2 ) / TAU
+*/
+ }
+/*
+ TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) )
+ DELTA( 1 ) = DELTA( 1 ) / TEMP
+ DELTA( 2 ) = DELTA( 2 ) / TEMP
+*/
+ } else {
+
+/* Now I=2 */
+
+ b = -delsq + *rho * (z__[1] * z__[1] + z__[2] * z__[2]);
+ c__ = *rho * z__[2] * z__[2] * delsq;
+
+/* The following TAU is DSIGMA * DSIGMA - D( 2 ) * D( 2 ) */
+
+ if (b > 0.) {
+ tau = (b + sqrt(b * b + c__ * 4.)) / 2.;
+ } else {
+ tau = c__ * 2. / (-b + sqrt(b * b + c__ * 4.));
+ }
+
+/* The following TAU is DSIGMA - D( 2 ) */
+
+ tau /= d__[2] + sqrt(d__[2] * d__[2] + tau);
+ *dsigma = d__[2] + tau;
+ delta[1] = -(del + tau);
+ delta[2] = -tau;
+ work[1] = d__[1] + tau + d__[2];
+ work[2] = d__[2] * 2. + tau;
+/*
+ DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU )
+ DELTA( 2 ) = -Z( 2 ) / TAU
+ TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) )
+ DELTA( 1 ) = DELTA( 1 ) / TEMP
+ DELTA( 2 ) = DELTA( 2 ) / TEMP
+*/
+ }
+ return 0;
+
+/* End of DLASD5 */
+
+} /* dlasd5_ */
+
+/* Subroutine */ int dlasd6_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, doublereal *d__, doublereal *vf, doublereal *vl,
+ doublereal *alpha, doublereal *beta, integer *idxq, integer *perm,
+ integer *givptr, integer *givcol, integer *ldgcol, doublereal *givnum,
+ integer *ldgnum, doublereal *poles, doublereal *difl, doublereal *
+ difr, doublereal *z__, integer *k, doublereal *c__, doublereal *s,
+ doublereal *work, integer *iwork, integer *info)
+{
+ /* System generated locals */
+ integer givcol_dim1, givcol_offset, givnum_dim1, givnum_offset,
+ poles_dim1, poles_offset, i__1;
+ doublereal d__1, d__2;
+
+ /* Local variables */
+ static integer i__, m, n, n1, n2, iw, idx, idxc, idxp, ivfw, ivlw;
+ extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
+ doublereal *, integer *), dlasd7_(integer *, integer *, integer *,
+ integer *, integer *, doublereal *, doublereal *, doublereal *,
+ doublereal *, doublereal *, doublereal *, doublereal *,
+ doublereal *, doublereal *, doublereal *, integer *, integer *,
+ integer *, integer *, integer *, integer *, integer *, doublereal
+ *, integer *, doublereal *, doublereal *, integer *), dlasd8_(
+ integer *, integer *, doublereal *, doublereal *, doublereal *,
+ doublereal *, doublereal *, doublereal *, integer *, doublereal *,
+ doublereal *, integer *), dlascl_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, integer *, doublereal *,
+ integer *, integer *), dlamrg_(integer *, integer *,
+ doublereal *, integer *, integer *, integer *);
+ static integer isigma;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static doublereal orgnrm;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DLASD6 computes the SVD of an updated upper bidiagonal matrix B
+ obtained by merging two smaller ones by appending a row. This
+ routine is used only for the problem which requires all singular
+ values and optionally singular vector matrices in factored form.
+ B is an N-by-M matrix with N = NL + NR + 1 and M = N + SQRE.
+ A related subroutine, DLASD1, handles the case in which all singular
+ values and singular vectors of the bidiagonal matrix are desired.
+
+ DLASD6 computes the SVD as follows:
+
+ ( D1(in) 0 0 0 )
+ B = U(in) * ( Z1' a Z2' b ) * VT(in)
+ ( 0 0 D2(in) 0 )
+
+ = U(out) * ( D(out) 0) * VT(out)
+
+ where Z' = (Z1' a Z2' b) = u' VT', and u is a vector of dimension M
+ with ALPHA and BETA in the NL+1 and NL+2 th entries and zeros
+ elsewhere; and the entry b is empty if SQRE = 0.
+
+ The singular values of B can be computed using D1, D2, the first
+ components of all the right singular vectors of the lower block, and
+ the last components of all the right singular vectors of the upper
+ block. These components are stored and updated in VF and VL,
+ respectively, in DLASD6. Hence U and VT are not explicitly
+ referenced.
+
+ The singular values are stored in D. The algorithm consists of two
+ stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple singular values or if there is a zero
+ in the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine DLASD7.
+
+ The second stage consists of calculating the updated
+ singular values. This is done by finding the roots of the
+ secular equation via the routine DLASD4 (as called by DLASD8).
+ This routine also updates VF and VL and computes the distances
+ between the updated singular values and the old singular
+ values.
+
+ DLASD6 is called from DLASDA.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed in
+ factored form:
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors in factored form as well.
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has row dimension N = NL + NR + 1,
+ and column dimension M = N + SQRE.
+
+ D (input/output) DOUBLE PRECISION array, dimension ( NL+NR+1 ).
+ On entry D(1:NL,1:NL) contains the singular values of the
+ upper block, and D(NL+2:N) contains the singular values
+ of the lower block. On exit D(1:N) contains the singular
+ values of the modified matrix.
+
+ VF (input/output) DOUBLE PRECISION array, dimension ( M )
+ On entry, VF(1:NL+1) contains the first components of all
+ right singular vectors of the upper block; and VF(NL+2:M)
+ contains the first components of all right singular vectors
+ of the lower block. On exit, VF contains the first components
+ of all right singular vectors of the bidiagonal matrix.
+
+ VL (input/output) DOUBLE PRECISION array, dimension ( M )
+ On entry, VL(1:NL+1) contains the last components of all
+ right singular vectors of the upper block; and VL(NL+2:M)
+ contains the last components of all right singular vectors of
+ the lower block. On exit, VL contains the last components of
+ all right singular vectors of the bidiagonal matrix.
+
+ ALPHA (input) DOUBLE PRECISION
+ Contains the diagonal element associated with the added row.
+
+ BETA (input) DOUBLE PRECISION
+ Contains the off-diagonal element associated with the added
+ row.
+
+ IDXQ (output) INTEGER array, dimension ( N )
+ This contains the permutation which will reintegrate the
+ subproblem just solved back into sorted order, i.e.
+ D( IDXQ( I = 1, N ) ) will be in ascending order.
+
+ PERM (output) INTEGER array, dimension ( N )
+ The permutations (from deflation and sorting) to be applied
+ to each block. Not referenced if ICOMPQ = 0.
+
+ GIVPTR (output) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem. Not referenced if ICOMPQ = 0.
+
+ GIVCOL (output) INTEGER array, dimension ( LDGCOL, 2 )
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGCOL (input) INTEGER
+ leading dimension of GIVCOL, must be at least N.
+
+ GIVNUM (output) DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
+ Each number indicates the C or S value to be used in the
+ corresponding Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGNUM (input) INTEGER
+ The leading dimension of GIVNUM and POLES, must be at least N.
+
+ POLES (output) DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
+ On exit, POLES(1,*) is an array containing the new singular
+ values obtained from solving the secular equation, and
+ POLES(2,*) is an array containing the poles in the secular
+ equation. Not referenced if ICOMPQ = 0.
+
+ DIFL (output) DOUBLE PRECISION array, dimension ( N )
+ On exit, DIFL(I) is the distance between I-th updated
+ (undeflated) singular value and the I-th (undeflated) old
+ singular value.
+
+ DIFR (output) DOUBLE PRECISION array,
+ dimension ( LDGNUM, 2 ) if ICOMPQ = 1 and
+ dimension ( N ) if ICOMPQ = 0.
+ On exit, DIFR(I, 1) is the distance between I-th updated
+ (undeflated) singular value and the I+1-th (undeflated) old
+ singular value.
+
+ If ICOMPQ = 1, DIFR(1:K,2) is an array containing the
+ normalizing factors for the right singular vector matrix.
+
+ See DLASD8 for details on DIFL and DIFR.
+
+ Z (output) DOUBLE PRECISION array, dimension ( M )
+ The first elements of this array contain the components
+ of the deflation-adjusted updating row vector.
+
+ K (output) INTEGER
+ Contains the dimension of the non-deflated matrix,
+ This is the order of the related secular equation. 1 <= K <=N.
+
+ C (output) DOUBLE PRECISION
+ C contains garbage if SQRE =0 and the C-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ S (output) DOUBLE PRECISION
+ S contains garbage if SQRE =0 and the S-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension ( 4 * M )
+
+ IWORK (workspace) INTEGER array, dimension ( 3 * N )
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ --vf;
+ --vl;
+ --idxq;
+ --perm;
+ givcol_dim1 = *ldgcol;
+ givcol_offset = 1 + givcol_dim1 * 1;
+ givcol -= givcol_offset;
+ poles_dim1 = *ldgnum;
+ poles_offset = 1 + poles_dim1 * 1;
+ poles -= poles_offset;
+ givnum_dim1 = *ldgnum;
+ givnum_offset = 1 + givnum_dim1 * 1;
+ givnum -= givnum_offset;
+ --difl;
+ --difr;
+ --z__;
+ --work;
+ --iwork;
+
+ /* Function Body */
+ *info = 0;
+ n = *nl + *nr + 1;
+ m = n + *sqre;
+
+ if (*icompq < 0 || *icompq > 1) {
+ *info = -1;
+ } else if (*nl < 1) {
+ *info = -2;
+ } else if (*nr < 1) {
+ *info = -3;
+ } else if (*sqre < 0 || *sqre > 1) {
+ *info = -4;
+ } else if (*ldgcol < n) {
+ *info = -14;
+ } else if (*ldgnum < n) {
+ *info = -16;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLASD6", &i__1);
+ return 0;
+ }
+
+/*
+ The following values are for bookkeeping purposes only. They are
+ integer pointers which indicate the portion of the workspace
+ used by a particular array in DLASD7 and DLASD8.
+*/
+
+ isigma = 1;
+ iw = isigma + n;
+ ivfw = iw + m;
+ ivlw = ivfw + m;
+
+ idx = 1;
+ idxc = idx + n;
+ idxp = idxc + n;
+
+/*
+ Scale.
+
+ Computing MAX
+*/
+ d__1 = abs(*alpha), d__2 = abs(*beta);
+ orgnrm = max(d__1,d__2);
+ d__[*nl + 1] = 0.;
+ i__1 = n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if ((d__1 = d__[i__], abs(d__1)) > orgnrm) {
+ orgnrm = (d__1 = d__[i__], abs(d__1));
+ }
+/* L10: */
+ }
+ dlascl_("G", &c__0, &c__0, &orgnrm, &c_b15, &n, &c__1, &d__[1], &n, info);
+ *alpha /= orgnrm;
+ *beta /= orgnrm;
+
+/* Sort and Deflate singular values. */
+
+ dlasd7_(icompq, nl, nr, sqre, k, &d__[1], &z__[1], &work[iw], &vf[1], &
+ work[ivfw], &vl[1], &work[ivlw], alpha, beta, &work[isigma], &
+ iwork[idx], &iwork[idxp], &idxq[1], &perm[1], givptr, &givcol[
+ givcol_offset], ldgcol, &givnum[givnum_offset], ldgnum, c__, s,
+ info);
+
+/* Solve Secular Equation, compute DIFL, DIFR, and update VF, VL. */
+
+ dlasd8_(icompq, k, &d__[1], &z__[1], &vf[1], &vl[1], &difl[1], &difr[1],
+ ldgnum, &work[isigma], &work[iw], info);
+
+/* Save the poles if ICOMPQ = 1. */
+
+ if (*icompq == 1) {
+ dcopy_(k, &d__[1], &c__1, &poles[poles_dim1 + 1], &c__1);
+ dcopy_(k, &work[isigma], &c__1, &poles[((poles_dim1) << (1)) + 1], &
+ c__1);
+ }
+
+/* Unscale. */
+
+ dlascl_("G", &c__0, &c__0, &c_b15, &orgnrm, &n, &c__1, &d__[1], &n, info);
+
+/* Prepare the IDXQ sorting permutation. */
+
+ n1 = *k;
+ n2 = n - *k;
+ dlamrg_(&n1, &n2, &d__[1], &c__1, &c_n1, &idxq[1]);
+
+ return 0;
+
+/* End of DLASD6 */
+
+} /* dlasd6_ */
+
+/* Subroutine */ int dlasd7_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, integer *k, doublereal *d__, doublereal *z__,
+ doublereal *zw, doublereal *vf, doublereal *vfw, doublereal *vl,
+ doublereal *vlw, doublereal *alpha, doublereal *beta, doublereal *
+ dsigma, integer *idx, integer *idxp, integer *idxq, integer *perm,
+ integer *givptr, integer *givcol, integer *ldgcol, doublereal *givnum,
+ integer *ldgnum, doublereal *c__, doublereal *s, integer *info)
+{
+ /* System generated locals */
+ integer givcol_dim1, givcol_offset, givnum_dim1, givnum_offset, i__1;
+ doublereal d__1, d__2;
+
+ /* Local variables */
+ static integer i__, j, m, n, k2;
+ static doublereal z1;
+ static integer jp;
+ static doublereal eps, tau, tol;
+ static integer nlp1, nlp2, idxi, idxj;
+ extern /* Subroutine */ int drot_(integer *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *);
+ static integer idxjp;
+ extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
+ doublereal *, integer *);
+ static integer jprev;
+
+ extern /* Subroutine */ int dlamrg_(integer *, integer *, doublereal *,
+ integer *, integer *, integer *), xerbla_(char *, integer *);
+ static doublereal hlftol;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Oak Ridge National Lab, Argonne National Lab,
+ Courant Institute, NAG Ltd., and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DLASD7 merges the two sets of singular values together into a single
+ sorted set. Then it tries to deflate the size of the problem. There
+ are two ways in which deflation can occur: when two or more singular
+ values are close together or if there is a tiny entry in the Z
+ vector. For each such occurrence the order of the related
+ secular equation problem is reduced by one.
+
+ DLASD7 is called from DLASD6.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed
+ in compact form, as follows:
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors of upper
+ bidiagonal matrix in compact form.
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has
+ N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ K (output) INTEGER
+ Contains the dimension of the non-deflated matrix, this is
+ the order of the related secular equation. 1 <= K <=N.
+
+ D (input/output) DOUBLE PRECISION array, dimension ( N )
+ On entry D contains the singular values of the two submatrices
+ to be combined. On exit D contains the trailing (N-K) updated
+ singular values (those which were deflated) sorted into
+ increasing order.
+
+ Z (output) DOUBLE PRECISION array, dimension ( M )
+ On exit Z contains the updating row vector in the secular
+ equation.
+
+ ZW (workspace) DOUBLE PRECISION array, dimension ( M )
+ Workspace for Z.
+
+ VF (input/output) DOUBLE PRECISION array, dimension ( M )
+ On entry, VF(1:NL+1) contains the first components of all
+ right singular vectors of the upper block; and VF(NL+2:M)
+ contains the first components of all right singular vectors
+ of the lower block. On exit, VF contains the first components
+ of all right singular vectors of the bidiagonal matrix.
+
+ VFW (workspace) DOUBLE PRECISION array, dimension ( M )
+ Workspace for VF.
+
+ VL (input/output) DOUBLE PRECISION array, dimension ( M )
+ On entry, VL(1:NL+1) contains the last components of all
+ right singular vectors of the upper block; and VL(NL+2:M)
+ contains the last components of all right singular vectors
+ of the lower block. On exit, VL contains the last components
+ of all right singular vectors of the bidiagonal matrix.
+
+ VLW (workspace) DOUBLE PRECISION array, dimension ( M )
+ Workspace for VL.
+
+ ALPHA (input) DOUBLE PRECISION
+ Contains the diagonal element associated with the added row.
+
+ BETA (input) DOUBLE PRECISION
+ Contains the off-diagonal element associated with the added
+ row.
+
+ DSIGMA (output) DOUBLE PRECISION array, dimension ( N )
+ Contains a copy of the diagonal elements (K-1 singular values
+ and one zero) in the secular equation.
+
+ IDX (workspace) INTEGER array, dimension ( N )
+ This will contain the permutation used to sort the contents of
+ D into ascending order.
+
+ IDXP (workspace) INTEGER array, dimension ( N )
+ This will contain the permutation used to place deflated
+ values of D at the end of the array. On output IDXP(2:K)
+ points to the nondeflated D-values and IDXP(K+1:N)
+ points to the deflated singular values.
+
+ IDXQ (input) INTEGER array, dimension ( N )
+ This contains the permutation which separately sorts the two
+ sub-problems in D into ascending order. Note that entries in
+ the first half of this permutation must first be moved one
+ position backward; and entries in the second half
+ must first have NL+1 added to their values.
+
+ PERM (output) INTEGER array, dimension ( N )
+ The permutations (from deflation and sorting) to be applied
+ to each singular block. Not referenced if ICOMPQ = 0.
+
+ GIVPTR (output) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem. Not referenced if ICOMPQ = 0.
+
+ GIVCOL (output) INTEGER array, dimension ( LDGCOL, 2 )
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGCOL (input) INTEGER
+ The leading dimension of GIVCOL, must be at least N.
+
+ GIVNUM (output) DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
+ Each number indicates the C or S value to be used in the
+ corresponding Givens rotation. Not referenced if ICOMPQ = 0.
+
+ LDGNUM (input) INTEGER
+ The leading dimension of GIVNUM, must be at least N.
+
+ C (output) DOUBLE PRECISION
+ C contains garbage if SQRE =0 and the C-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ S (output) DOUBLE PRECISION
+ S contains garbage if SQRE =0 and the S-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ --z__;
+ --zw;
+ --vf;
+ --vfw;
+ --vl;
+ --vlw;
+ --dsigma;
+ --idx;
+ --idxp;
+ --idxq;
+ --perm;
+ givcol_dim1 = *ldgcol;
+ givcol_offset = 1 + givcol_dim1 * 1;
+ givcol -= givcol_offset;
+ givnum_dim1 = *ldgnum;
+ givnum_offset = 1 + givnum_dim1 * 1;
+ givnum -= givnum_offset;
+
+ /* Function Body */
+ *info = 0;
+ n = *nl + *nr + 1;
+ m = n + *sqre;
+
+ if (*icompq < 0 || *icompq > 1) {
+ *info = -1;
+ } else if (*nl < 1) {
+ *info = -2;
+ } else if (*nr < 1) {
+ *info = -3;
+ } else if (*sqre < 0 || *sqre > 1) {
+ *info = -4;
+ } else if (*ldgcol < n) {
+ *info = -22;
+ } else if (*ldgnum < n) {
+ *info = -24;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLASD7", &i__1);
+ return 0;
+ }
+
+ nlp1 = *nl + 1;
+ nlp2 = *nl + 2;
+ if (*icompq == 1) {
+ *givptr = 0;
+ }
+
+/*
+ Generate the first part of the vector Z and move the singular
+ values in the first part of D one position backward.
+*/
+
+ z1 = *alpha * vl[nlp1];
+ vl[nlp1] = 0.;
+ tau = vf[nlp1];
+ for (i__ = *nl; i__ >= 1; --i__) {
+ z__[i__ + 1] = *alpha * vl[i__];
+ vl[i__] = 0.;
+ vf[i__ + 1] = vf[i__];
+ d__[i__ + 1] = d__[i__];
+ idxq[i__ + 1] = idxq[i__] + 1;
+/* L10: */
+ }
+ vf[1] = tau;
+
+/* Generate the second part of the vector Z. */
+
+ i__1 = m;
+ for (i__ = nlp2; i__ <= i__1; ++i__) {
+ z__[i__] = *beta * vf[i__];
+ vf[i__] = 0.;
+/* L20: */
+ }
+
+/* Sort the singular values into increasing order */
+
+ i__1 = n;
+ for (i__ = nlp2; i__ <= i__1; ++i__) {
+ idxq[i__] += nlp1;
+/* L30: */
+ }
+
+/* DSIGMA, IDXC, IDXC, and ZW are used as storage space. */
+
+ i__1 = n;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ dsigma[i__] = d__[idxq[i__]];
+ zw[i__] = z__[idxq[i__]];
+ vfw[i__] = vf[idxq[i__]];
+ vlw[i__] = vl[idxq[i__]];
+/* L40: */
+ }
+
+ dlamrg_(nl, nr, &dsigma[2], &c__1, &c__1, &idx[2]);
+
+ i__1 = n;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ idxi = idx[i__] + 1;
+ d__[i__] = dsigma[idxi];
+ z__[i__] = zw[idxi];
+ vf[i__] = vfw[idxi];
+ vl[i__] = vlw[idxi];
+/* L50: */
+ }
+
+/* Calculate the allowable deflation tolerence */
+
+ eps = EPSILON;
+/* Computing MAX */
+ d__1 = abs(*alpha), d__2 = abs(*beta);
+ tol = max(d__1,d__2);
+/* Computing MAX */
+ d__2 = (d__1 = d__[n], abs(d__1));
+ tol = eps * 64. * max(d__2,tol);
+
+/*
+ There are 2 kinds of deflation -- first a value in the z-vector
+ is small, second two (or more) singular values are very close
+ together (their difference is small).
+
+ If the value in the z-vector is small, we simply permute the
+ array so that the corresponding singular value is moved to the
+ end.
+
+ If two values in the D-vector are close, we perform a two-sided
+ rotation designed to make one of the corresponding z-vector
+ entries zero, and then permute the array so that the deflated
+ singular value is moved to the end.
+
+ If there are multiple singular values then the problem deflates.
+ Here the number of equal singular values are found. As each equal
+ singular value is found, an elementary reflector is computed to
+ rotate the corresponding singular subspace so that the
+ corresponding components of Z are zero in this new basis.
+*/
+
+ *k = 1;
+ k2 = n + 1;
+ i__1 = n;
+ for (j = 2; j <= i__1; ++j) {
+ if ((d__1 = z__[j], abs(d__1)) <= tol) {
+
+/* Deflate due to small z component. */
+
+ --k2;
+ idxp[k2] = j;
+ if (j == n) {
+ goto L100;
+ }
+ } else {
+ jprev = j;
+ goto L70;
+ }
+/* L60: */
+ }
+L70:
+ j = jprev;
+L80:
+ ++j;
+ if (j > n) {
+ goto L90;
+ }
+ if ((d__1 = z__[j], abs(d__1)) <= tol) {
+
+/* Deflate due to small z component. */
+
+ --k2;
+ idxp[k2] = j;
+ } else {
+
+/* Check if singular values are close enough to allow deflation. */
+
+ if ((d__1 = d__[j] - d__[jprev], abs(d__1)) <= tol) {
+
+/* Deflation is possible. */
+
+ *s = z__[jprev];
+ *c__ = z__[j];
+
+/*
+ Find sqrt(a**2+b**2) without overflow or
+ destructive underflow.
+*/
+
+ tau = dlapy2_(c__, s);
+ z__[j] = tau;
+ z__[jprev] = 0.;
+ *c__ /= tau;
+ *s = -(*s) / tau;
+
+/* Record the appropriate Givens rotation */
+
+ if (*icompq == 1) {
+ ++(*givptr);
+ idxjp = idxq[idx[jprev] + 1];
+ idxj = idxq[idx[j] + 1];
+ if (idxjp <= nlp1) {
+ --idxjp;
+ }
+ if (idxj <= nlp1) {
+ --idxj;
+ }
+ givcol[*givptr + ((givcol_dim1) << (1))] = idxjp;
+ givcol[*givptr + givcol_dim1] = idxj;
+ givnum[*givptr + ((givnum_dim1) << (1))] = *c__;
+ givnum[*givptr + givnum_dim1] = *s;
+ }
+ drot_(&c__1, &vf[jprev], &c__1, &vf[j], &c__1, c__, s);
+ drot_(&c__1, &vl[jprev], &c__1, &vl[j], &c__1, c__, s);
+ --k2;
+ idxp[k2] = jprev;
+ jprev = j;
+ } else {
+ ++(*k);
+ zw[*k] = z__[jprev];
+ dsigma[*k] = d__[jprev];
+ idxp[*k] = jprev;
+ jprev = j;
+ }
+ }
+ goto L80;
+L90:
+
+/* Record the last singular value. */
+
+ ++(*k);
+ zw[*k] = z__[jprev];
+ dsigma[*k] = d__[jprev];
+ idxp[*k] = jprev;
+
+L100:
+
+/*
+ Sort the singular values into DSIGMA. The singular values which
+ were not deflated go into the first K slots of DSIGMA, except
+ that DSIGMA(1) is treated separately.
+*/
+
+ i__1 = n;
+ for (j = 2; j <= i__1; ++j) {
+ jp = idxp[j];
+ dsigma[j] = d__[jp];
+ vfw[j] = vf[jp];
+ vlw[j] = vl[jp];
+/* L110: */
+ }
+ if (*icompq == 1) {
+ i__1 = n;
+ for (j = 2; j <= i__1; ++j) {
+ jp = idxp[j];
+ perm[j] = idxq[idx[jp] + 1];
+ if (perm[j] <= nlp1) {
+ --perm[j];
+ }
+/* L120: */
+ }
+ }
+
+/*
+ The deflated singular values go back into the last N - K slots of
+ D.
+*/
+
+ i__1 = n - *k;
+ dcopy_(&i__1, &dsigma[*k + 1], &c__1, &d__[*k + 1], &c__1);
+
+/*
+ Determine DSIGMA(1), DSIGMA(2), Z(1), VF(1), VL(1), VF(M), and
+ VL(M).
+*/
+
+ dsigma[1] = 0.;
+ hlftol = tol / 2.;
+ if (abs(dsigma[2]) <= hlftol) {
+ dsigma[2] = hlftol;
+ }
+ if (m > n) {
+ z__[1] = dlapy2_(&z1, &z__[m]);
+ if (z__[1] <= tol) {
+ *c__ = 1.;
+ *s = 0.;
+ z__[1] = tol;
+ } else {
+ *c__ = z1 / z__[1];
+ *s = -z__[m] / z__[1];
+ }
+ drot_(&c__1, &vf[m], &c__1, &vf[1], &c__1, c__, s);
+ drot_(&c__1, &vl[m], &c__1, &vl[1], &c__1, c__, s);
+ } else {
+ if (abs(z1) <= tol) {
+ z__[1] = tol;
+ } else {
+ z__[1] = z1;
+ }
+ }
+
+/* Restore Z, VF, and VL. */
+
+ i__1 = *k - 1;
+ dcopy_(&i__1, &zw[2], &c__1, &z__[2], &c__1);
+ i__1 = n - 1;
+ dcopy_(&i__1, &vfw[2], &c__1, &vf[2], &c__1);
+ i__1 = n - 1;
+ dcopy_(&i__1, &vlw[2], &c__1, &vl[2], &c__1);
+
+ return 0;
+
+/* End of DLASD7 */
+
+} /* dlasd7_ */
+
+/* Subroutine */ int dlasd8_(integer *icompq, integer *k, doublereal *d__,
+ doublereal *z__, doublereal *vf, doublereal *vl, doublereal *difl,
+ doublereal *difr, integer *lddifr, doublereal *dsigma, doublereal *
+ work, integer *info)
+{
+ /* System generated locals */
+ integer difr_dim1, difr_offset, i__1, i__2;
+ doublereal d__1, d__2;
+
+ /* Builtin functions */
+ double sqrt(doublereal), d_sign(doublereal *, doublereal *);
+
+ /* Local variables */
+ static integer i__, j;
+ static doublereal dj, rho;
+ static integer iwk1, iwk2, iwk3;
+ extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *,
+ integer *);
+ static doublereal temp;
+ extern doublereal dnrm2_(integer *, doublereal *, integer *);
+ static integer iwk2i, iwk3i;
+ static doublereal diflj, difrj, dsigj;
+ extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
+ doublereal *, integer *);
+ extern doublereal dlamc3_(doublereal *, doublereal *);
+ extern /* Subroutine */ int dlasd4_(integer *, integer *, doublereal *,
+ doublereal *, doublereal *, doublereal *, doublereal *,
+ doublereal *, integer *), dlascl_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, integer *, doublereal *,
+ integer *, integer *), dlaset_(char *, integer *, integer
+ *, doublereal *, doublereal *, doublereal *, integer *),
+ xerbla_(char *, integer *);
+ static doublereal dsigjp;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Oak Ridge National Lab, Argonne National Lab,
+ Courant Institute, NAG Ltd., and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DLASD8 finds the square roots of the roots of the secular equation,
+ as defined by the values in DSIGMA and Z. It makes the appropriate
+ calls to DLASD4, and stores, for each element in D, the distance
+ to its two nearest poles (elements in DSIGMA). It also updates
+ the arrays VF and VL, the first and last components of all the
+ right singular vectors of the original bidiagonal matrix.
+
+ DLASD8 is called from DLASD6.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed in
+ factored form in the calling routine:
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors in factored form as well.
+
+ K (input) INTEGER
+ The number of terms in the rational function to be solved
+ by DLASD4. K >= 1.
+
+ D (output) DOUBLE PRECISION array, dimension ( K )
+ On output, D contains the updated singular values.
+
+ Z (input) DOUBLE PRECISION array, dimension ( K )
+ The first K elements of this array contain the components
+ of the deflation-adjusted updating row vector.
+
+ VF (input/output) DOUBLE PRECISION array, dimension ( K )
+ On entry, VF contains information passed through DBEDE8.
+ On exit, VF contains the first K components of the first
+ components of all right singular vectors of the bidiagonal
+ matrix.
+
+ VL (input/output) DOUBLE PRECISION array, dimension ( K )
+ On entry, VL contains information passed through DBEDE8.
+ On exit, VL contains the first K components of the last
+ components of all right singular vectors of the bidiagonal
+ matrix.
+
+ DIFL (output) DOUBLE PRECISION array, dimension ( K )
+ On exit, DIFL(I) = D(I) - DSIGMA(I).
+
+ DIFR (output) DOUBLE PRECISION array,
+ dimension ( LDDIFR, 2 ) if ICOMPQ = 1 and
+ dimension ( K ) if ICOMPQ = 0.
+ On exit, DIFR(I,1) = D(I) - DSIGMA(I+1), DIFR(K,1) is not
+ defined and will not be referenced.
+
+ If ICOMPQ = 1, DIFR(1:K,2) is an array containing the
+ normalizing factors for the right singular vector matrix.
+
+ LDDIFR (input) INTEGER
+ The leading dimension of DIFR, must be at least K.
+
+ DSIGMA (input) DOUBLE PRECISION array, dimension ( K )
+ The first K elements of this array contain the old roots
+ of the deflated updating problem. These are the poles
+ of the secular equation.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension at least 3 * K
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ --z__;
+ --vf;
+ --vl;
+ --difl;
+ difr_dim1 = *lddifr;
+ difr_offset = 1 + difr_dim1 * 1;
+ difr -= difr_offset;
+ --dsigma;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*icompq < 0 || *icompq > 1) {
+ *info = -1;
+ } else if (*k < 1) {
+ *info = -2;
+ } else if (*lddifr < *k) {
+ *info = -9;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLASD8", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*k == 1) {
+ d__[1] = abs(z__[1]);
+ difl[1] = d__[1];
+ if (*icompq == 1) {
+ difl[2] = 1.;
+ difr[((difr_dim1) << (1)) + 1] = 1.;
+ }
+ return 0;
+ }
+
+/*
+ Modify values DSIGMA(i) to make sure all DSIGMA(i)-DSIGMA(j) can
+ be computed with high relative accuracy (barring over/underflow).
+ This is a problem on machines without a guard digit in
+ add/subtract (Cray XMP, Cray YMP, Cray C 90 and Cray 2).
+ The following code replaces DSIGMA(I) by 2*DSIGMA(I)-DSIGMA(I),
+ which on any of these machines zeros out the bottommost
+ bit of DSIGMA(I) if it is 1; this makes the subsequent
+ subtractions DSIGMA(I)-DSIGMA(J) unproblematic when cancellation
+ occurs. On binary machines with a guard digit (almost all
+ machines) it does not change DSIGMA(I) at all. On hexadecimal
+ and decimal machines with a guard digit, it slightly
+ changes the bottommost bits of DSIGMA(I). It does not account
+ for hexadecimal or decimal machines without guard digits
+ (we know of none). We use a subroutine call to compute
+ 2*DLAMBDA(I) to prevent optimizing compilers from eliminating
+ this code.
+*/
+
+ i__1 = *k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dsigma[i__] = dlamc3_(&dsigma[i__], &dsigma[i__]) - dsigma[i__];
+/* L10: */
+ }
+
+/* Book keeping. */
+
+ iwk1 = 1;
+ iwk2 = iwk1 + *k;
+ iwk3 = iwk2 + *k;
+ iwk2i = iwk2 - 1;
+ iwk3i = iwk3 - 1;
+
+/* Normalize Z. */
+
+ rho = dnrm2_(k, &z__[1], &c__1);
+ dlascl_("G", &c__0, &c__0, &rho, &c_b15, k, &c__1, &z__[1], k, info);
+ rho *= rho;
+
+/* Initialize WORK(IWK3). */
+
+ dlaset_("A", k, &c__1, &c_b15, &c_b15, &work[iwk3], k);
+
+/*
+ Compute the updated singular values, the arrays DIFL, DIFR,
+ and the updated Z.
+*/
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dlasd4_(k, &j, &dsigma[1], &z__[1], &work[iwk1], &rho, &d__[j], &work[
+ iwk2], info);
+
+/* If the root finder fails, the computation is terminated. */
+
+ if (*info != 0) {
+ return 0;
+ }
+ work[iwk3i + j] = work[iwk3i + j] * work[j] * work[iwk2i + j];
+ difl[j] = -work[j];
+ difr[j + difr_dim1] = -work[j + 1];
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ work[iwk3i + i__] = work[iwk3i + i__] * work[i__] * work[iwk2i +
+ i__] / (dsigma[i__] - dsigma[j]) / (dsigma[i__] + dsigma[
+ j]);
+/* L20: */
+ }
+ i__2 = *k;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ work[iwk3i + i__] = work[iwk3i + i__] * work[i__] * work[iwk2i +
+ i__] / (dsigma[i__] - dsigma[j]) / (dsigma[i__] + dsigma[
+ j]);
+/* L30: */
+ }
+/* L40: */
+ }
+
+/* Compute updated Z. */
+
+ i__1 = *k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ d__2 = sqrt((d__1 = work[iwk3i + i__], abs(d__1)));
+ z__[i__] = d_sign(&d__2, &z__[i__]);
+/* L50: */
+ }
+
+/* Update VF and VL. */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ diflj = difl[j];
+ dj = d__[j];
+ dsigj = -dsigma[j];
+ if (j < *k) {
+ difrj = -difr[j + difr_dim1];
+ dsigjp = -dsigma[j + 1];
+ }
+ work[j] = -z__[j] / diflj / (dsigma[j] + dj);
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ work[i__] = z__[i__] / (dlamc3_(&dsigma[i__], &dsigj) - diflj) / (
+ dsigma[i__] + dj);
+/* L60: */
+ }
+ i__2 = *k;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ work[i__] = z__[i__] / (dlamc3_(&dsigma[i__], &dsigjp) + difrj) /
+ (dsigma[i__] + dj);
+/* L70: */
+ }
+ temp = dnrm2_(k, &work[1], &c__1);
+ work[iwk2i + j] = ddot_(k, &work[1], &c__1, &vf[1], &c__1) / temp;
+ work[iwk3i + j] = ddot_(k, &work[1], &c__1, &vl[1], &c__1) / temp;
+ if (*icompq == 1) {
+ difr[j + ((difr_dim1) << (1))] = temp;
+ }
+/* L80: */
+ }
+
+ dcopy_(k, &work[iwk2], &c__1, &vf[1], &c__1);
+ dcopy_(k, &work[iwk3], &c__1, &vl[1], &c__1);
+
+ return 0;
+
+/* End of DLASD8 */
+
+} /* dlasd8_ */
+
+/* Subroutine */ int dlasda_(integer *icompq, integer *smlsiz, integer *n,
+ integer *sqre, doublereal *d__, doublereal *e, doublereal *u, integer
+ *ldu, doublereal *vt, integer *k, doublereal *difl, doublereal *difr,
+ doublereal *z__, doublereal *poles, integer *givptr, integer *givcol,
+ integer *ldgcol, integer *perm, doublereal *givnum, doublereal *c__,
+ doublereal *s, doublereal *work, integer *iwork, integer *info)
+{
+ /* System generated locals */
+ integer givcol_dim1, givcol_offset, perm_dim1, perm_offset, difl_dim1,
+ difl_offset, difr_dim1, difr_offset, givnum_dim1, givnum_offset,
+ poles_dim1, poles_offset, u_dim1, u_offset, vt_dim1, vt_offset,
+ z_dim1, z_offset, i__1, i__2;
+
+ /* Builtin functions */
+ integer pow_ii(integer *, integer *);
+
+ /* Local variables */
+ static integer i__, j, m, i1, ic, lf, nd, ll, nl, vf, nr, vl, im1, ncc,
+ nlf, nrf, vfi, iwk, vli, lvl, nru, ndb1, nlp1, lvl2, nrp1;
+ static doublereal beta;
+ static integer idxq, nlvl;
+ static doublereal alpha;
+ static integer inode, ndiml, ndimr, idxqi, itemp;
+ extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
+ doublereal *, integer *);
+ static integer sqrei;
+ extern /* Subroutine */ int dlasd6_(integer *, integer *, integer *,
+ integer *, doublereal *, doublereal *, doublereal *, doublereal *,
+ doublereal *, integer *, integer *, integer *, integer *,
+ integer *, doublereal *, integer *, doublereal *, doublereal *,
+ doublereal *, doublereal *, integer *, doublereal *, doublereal *,
+ doublereal *, integer *, integer *);
+ static integer nwork1, nwork2;
+ extern /* Subroutine */ int dlasdq_(char *, integer *, integer *, integer
+ *, integer *, integer *, doublereal *, doublereal *, doublereal *,
+ integer *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, integer *), dlasdt_(integer *, integer *,
+ integer *, integer *, integer *, integer *, integer *), dlaset_(
+ char *, integer *, integer *, doublereal *, doublereal *,
+ doublereal *, integer *), xerbla_(char *, integer *);
+ static integer smlszp;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1999
+
+
+ Purpose
+ =======
+
+ Using a divide and conquer approach, DLASDA computes the singular
+ value decomposition (SVD) of a real upper bidiagonal N-by-M matrix
+ B with diagonal D and offdiagonal E, where M = N + SQRE. The
+ algorithm computes the singular values in the SVD B = U * S * VT.
+ The orthogonal matrices U and VT are optionally computed in
+ compact form.
+
+ A related subroutine, DLASD0, computes the singular values and
+ the singular vectors in explicit form.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed
+ in compact form, as follows
+ = 0: Compute singular values only.
+ = 1: Compute singular vectors of upper bidiagonal
+ matrix in compact form.
+
+ SMLSIZ (input) INTEGER
+ The maximum size of the subproblems at the bottom of the
+ computation tree.
+
+ N (input) INTEGER
+ The row dimension of the upper bidiagonal matrix. This is
+ also the dimension of the main diagonal array D.
+
+ SQRE (input) INTEGER
+ Specifies the column dimension of the bidiagonal matrix.
+ = 0: The bidiagonal matrix has column dimension M = N;
+ = 1: The bidiagonal matrix has column dimension M = N + 1.
+
+ D (input/output) DOUBLE PRECISION array, dimension ( N )
+ On entry D contains the main diagonal of the bidiagonal
+ matrix. On exit D, if INFO = 0, contains its singular values.
+
+ E (input) DOUBLE PRECISION array, dimension ( M-1 )
+ Contains the subdiagonal entries of the bidiagonal matrix.
+ On exit, E has been destroyed.
+
+ U (output) DOUBLE PRECISION array,
+ dimension ( LDU, SMLSIZ ) if ICOMPQ = 1, and not referenced
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, U contains the left
+ singular vector matrices of all subproblems at the bottom
+ level.
+
+ LDU (input) INTEGER, LDU = > N.
+ The leading dimension of arrays U, VT, DIFL, DIFR, POLES,
+ GIVNUM, and Z.
+
+ VT (output) DOUBLE PRECISION array,
+ dimension ( LDU, SMLSIZ+1 ) if ICOMPQ = 1, and not referenced
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, VT' contains the right
+ singular vector matrices of all subproblems at the bottom
+ level.
+
+ K (output) INTEGER array,
+ dimension ( N ) if ICOMPQ = 1 and dimension 1 if ICOMPQ = 0.
+ If ICOMPQ = 1, on exit, K(I) is the dimension of the I-th
+ secular equation on the computation tree.
+
+ DIFL (output) DOUBLE PRECISION array, dimension ( LDU, NLVL ),
+ where NLVL = floor(log_2 (N/SMLSIZ))).
+
+ DIFR (output) DOUBLE PRECISION array,
+ dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1 and
+ dimension ( N ) if ICOMPQ = 0.
+ If ICOMPQ = 1, on exit, DIFL(1:N, I) and DIFR(1:N, 2 * I - 1)
+ record distances between singular values on the I-th
+ level and singular values on the (I -1)-th level, and
+ DIFR(1:N, 2 * I ) contains the normalizing factors for
+ the right singular vector matrix. See DLASD8 for details.
+
+ Z (output) DOUBLE PRECISION array,
+ dimension ( LDU, NLVL ) if ICOMPQ = 1 and
+ dimension ( N ) if ICOMPQ = 0.
+ The first K elements of Z(1, I) contain the components of
+ the deflation-adjusted updating row vector for subproblems
+ on the I-th level.
+
+ POLES (output) DOUBLE PRECISION array,
+ dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1, and not referenced
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, POLES(1, 2*I - 1) and
+ POLES(1, 2*I) contain the new and old singular values
+ involved in the secular equations on the I-th level.
+
+ GIVPTR (output) INTEGER array,
+ dimension ( N ) if ICOMPQ = 1, and not referenced if
+ ICOMPQ = 0. If ICOMPQ = 1, on exit, GIVPTR( I ) records
+ the number of Givens rotations performed on the I-th
+ problem on the computation tree.
+
+ GIVCOL (output) INTEGER array,
+ dimension ( LDGCOL, 2 * NLVL ) if ICOMPQ = 1, and not
+ referenced if ICOMPQ = 0. If ICOMPQ = 1, on exit, for each I,
+ GIVCOL(1, 2 *I - 1) and GIVCOL(1, 2 *I) record the locations
+ of Givens rotations performed on the I-th level on the
+ computation tree.
+
+ LDGCOL (input) INTEGER, LDGCOL = > N.
+ The leading dimension of arrays GIVCOL and PERM.
+
+ PERM (output) INTEGER array,
+ dimension ( LDGCOL, NLVL ) if ICOMPQ = 1, and not referenced
+ if ICOMPQ = 0. If ICOMPQ = 1, on exit, PERM(1, I) records
+ permutations done on the I-th level of the computation tree.
+
+ GIVNUM (output) DOUBLE PRECISION array,
+ dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1, and not
+ referenced if ICOMPQ = 0. If ICOMPQ = 1, on exit, for each I,
+ GIVNUM(1, 2 *I - 1) and GIVNUM(1, 2 *I) record the C- and S-
+ values of Givens rotations performed on the I-th level on
+ the computation tree.
+
+ C (output) DOUBLE PRECISION array,
+ dimension ( N ) if ICOMPQ = 1, and dimension 1 if ICOMPQ = 0.
+ If ICOMPQ = 1 and the I-th subproblem is not square, on exit,
+ C( I ) contains the C-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ S (output) DOUBLE PRECISION array, dimension ( N ) if
+ ICOMPQ = 1, and dimension 1 if ICOMPQ = 0. If ICOMPQ = 1
+ and the I-th subproblem is not square, on exit, S( I )
+ contains the S-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (6 * N + (SMLSIZ + 1)*(SMLSIZ + 1)).
+
+ IWORK (workspace) INTEGER array.
+ Dimension must be at least (7 * N).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an singular value did not converge
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ --e;
+ givnum_dim1 = *ldu;
+ givnum_offset = 1 + givnum_dim1 * 1;
+ givnum -= givnum_offset;
+ poles_dim1 = *ldu;
+ poles_offset = 1 + poles_dim1 * 1;
+ poles -= poles_offset;
+ z_dim1 = *ldu;
+ z_offset = 1 + z_dim1 * 1;
+ z__ -= z_offset;
+ difr_dim1 = *ldu;
+ difr_offset = 1 + difr_dim1 * 1;
+ difr -= difr_offset;
+ difl_dim1 = *ldu;
+ difl_offset = 1 + difl_dim1 * 1;
+ difl -= difl_offset;
+ vt_dim1 = *ldu;
+ vt_offset = 1 + vt_dim1 * 1;
+ vt -= vt_offset;
+ u_dim1 = *ldu;
+ u_offset = 1 + u_dim1 * 1;
+ u -= u_offset;
+ --k;
+ --givptr;
+ perm_dim1 = *ldgcol;
+ perm_offset = 1 + perm_dim1 * 1;
+ perm -= perm_offset;
+ givcol_dim1 = *ldgcol;
+ givcol_offset = 1 + givcol_dim1 * 1;
+ givcol -= givcol_offset;
+ --c__;
+ --s;
+ --work;
+ --iwork;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*icompq < 0 || *icompq > 1) {
+ *info = -1;
+ } else if (*smlsiz < 3) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*sqre < 0 || *sqre > 1) {
+ *info = -4;
+ } else if (*ldu < *n + *sqre) {
+ *info = -8;
+ } else if (*ldgcol < *n) {
+ *info = -17;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLASDA", &i__1);
+ return 0;
+ }
+
+ m = *n + *sqre;
+
+/* If the input matrix is too small, call DLASDQ to find the SVD. */
+
+ if (*n <= *smlsiz) {
+ if (*icompq == 0) {
+ dlasdq_("U", sqre, n, &c__0, &c__0, &c__0, &d__[1], &e[1], &vt[
+ vt_offset], ldu, &u[u_offset], ldu, &u[u_offset], ldu, &
+ work[1], info);
+ } else {
+ dlasdq_("U", sqre, n, &m, n, &c__0, &d__[1], &e[1], &vt[vt_offset]
+ , ldu, &u[u_offset], ldu, &u[u_offset], ldu, &work[1],
+ info);
+ }
+ return 0;
+ }
+
+/* Book-keeping and set up the computation tree. */
+
+ inode = 1;
+ ndiml = inode + *n;
+ ndimr = ndiml + *n;
+ idxq = ndimr + *n;
+ iwk = idxq + *n;
+
+ ncc = 0;
+ nru = 0;
+
+ smlszp = *smlsiz + 1;
+ vf = 1;
+ vl = vf + m;
+ nwork1 = vl + m;
+ nwork2 = nwork1 + smlszp * smlszp;
+
+ dlasdt_(n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr],
+ smlsiz);
+
+/*
+ for the nodes on bottom level of the tree, solve
+ their subproblems by DLASDQ.
+*/
+
+ ndb1 = (nd + 1) / 2;
+ i__1 = nd;
+ for (i__ = ndb1; i__ <= i__1; ++i__) {
+
+/*
+ IC : center row of each node
+ NL : number of rows of left subproblem
+ NR : number of rows of right subproblem
+ NLF: starting row of the left subproblem
+ NRF: starting row of the right subproblem
+*/
+
+ i1 = i__ - 1;
+ ic = iwork[inode + i1];
+ nl = iwork[ndiml + i1];
+ nlp1 = nl + 1;
+ nr = iwork[ndimr + i1];
+ nlf = ic - nl;
+ nrf = ic + 1;
+ idxqi = idxq + nlf - 2;
+ vfi = vf + nlf - 1;
+ vli = vl + nlf - 1;
+ sqrei = 1;
+ if (*icompq == 0) {
+ dlaset_("A", &nlp1, &nlp1, &c_b29, &c_b15, &work[nwork1], &smlszp);
+ dlasdq_("U", &sqrei, &nl, &nlp1, &nru, &ncc, &d__[nlf], &e[nlf], &
+ work[nwork1], &smlszp, &work[nwork2], &nl, &work[nwork2],
+ &nl, &work[nwork2], info);
+ itemp = nwork1 + nl * smlszp;
+ dcopy_(&nlp1, &work[nwork1], &c__1, &work[vfi], &c__1);
+ dcopy_(&nlp1, &work[itemp], &c__1, &work[vli], &c__1);
+ } else {
+ dlaset_("A", &nl, &nl, &c_b29, &c_b15, &u[nlf + u_dim1], ldu);
+ dlaset_("A", &nlp1, &nlp1, &c_b29, &c_b15, &vt[nlf + vt_dim1],
+ ldu);
+ dlasdq_("U", &sqrei, &nl, &nlp1, &nl, &ncc, &d__[nlf], &e[nlf], &
+ vt[nlf + vt_dim1], ldu, &u[nlf + u_dim1], ldu, &u[nlf +
+ u_dim1], ldu, &work[nwork1], info);
+ dcopy_(&nlp1, &vt[nlf + vt_dim1], &c__1, &work[vfi], &c__1);
+ dcopy_(&nlp1, &vt[nlf + nlp1 * vt_dim1], &c__1, &work[vli], &c__1)
+ ;
+ }
+ if (*info != 0) {
+ return 0;
+ }
+ i__2 = nl;
+ for (j = 1; j <= i__2; ++j) {
+ iwork[idxqi + j] = j;
+/* L10: */
+ }
+ if ((i__ == nd && *sqre == 0)) {
+ sqrei = 0;
+ } else {
+ sqrei = 1;
+ }
+ idxqi += nlp1;
+ vfi += nlp1;
+ vli += nlp1;
+ nrp1 = nr + sqrei;
+ if (*icompq == 0) {
+ dlaset_("A", &nrp1, &nrp1, &c_b29, &c_b15, &work[nwork1], &smlszp);
+ dlasdq_("U", &sqrei, &nr, &nrp1, &nru, &ncc, &d__[nrf], &e[nrf], &
+ work[nwork1], &smlszp, &work[nwork2], &nr, &work[nwork2],
+ &nr, &work[nwork2], info);
+ itemp = nwork1 + (nrp1 - 1) * smlszp;
+ dcopy_(&nrp1, &work[nwork1], &c__1, &work[vfi], &c__1);
+ dcopy_(&nrp1, &work[itemp], &c__1, &work[vli], &c__1);
+ } else {
+ dlaset_("A", &nr, &nr, &c_b29, &c_b15, &u[nrf + u_dim1], ldu);
+ dlaset_("A", &nrp1, &nrp1, &c_b29, &c_b15, &vt[nrf + vt_dim1],
+ ldu);
+ dlasdq_("U", &sqrei, &nr, &nrp1, &nr, &ncc, &d__[nrf], &e[nrf], &
+ vt[nrf + vt_dim1], ldu, &u[nrf + u_dim1], ldu, &u[nrf +
+ u_dim1], ldu, &work[nwork1], info);
+ dcopy_(&nrp1, &vt[nrf + vt_dim1], &c__1, &work[vfi], &c__1);
+ dcopy_(&nrp1, &vt[nrf + nrp1 * vt_dim1], &c__1, &work[vli], &c__1)
+ ;
+ }
+ if (*info != 0) {
+ return 0;
+ }
+ i__2 = nr;
+ for (j = 1; j <= i__2; ++j) {
+ iwork[idxqi + j] = j;
+/* L20: */
+ }
+/* L30: */
+ }
+
+/* Now conquer each subproblem bottom-up. */
+
+ j = pow_ii(&c__2, &nlvl);
+ for (lvl = nlvl; lvl >= 1; --lvl) {
+ lvl2 = ((lvl) << (1)) - 1;
+
+/*
+ Find the first node LF and last node LL on
+ the current level LVL.
+*/
+
+ if (lvl == 1) {
+ lf = 1;
+ ll = 1;
+ } else {
+ i__1 = lvl - 1;
+ lf = pow_ii(&c__2, &i__1);
+ ll = ((lf) << (1)) - 1;
+ }
+ i__1 = ll;
+ for (i__ = lf; i__ <= i__1; ++i__) {
+ im1 = i__ - 1;
+ ic = iwork[inode + im1];
+ nl = iwork[ndiml + im1];
+ nr = iwork[ndimr + im1];
+ nlf = ic - nl;
+ nrf = ic + 1;
+ if (i__ == ll) {
+ sqrei = *sqre;
+ } else {
+ sqrei = 1;
+ }
+ vfi = vf + nlf - 1;
+ vli = vl + nlf - 1;
+ idxqi = idxq + nlf - 1;
+ alpha = d__[ic];
+ beta = e[ic];
+ if (*icompq == 0) {
+ dlasd6_(icompq, &nl, &nr, &sqrei, &d__[nlf], &work[vfi], &
+ work[vli], &alpha, &beta, &iwork[idxqi], &perm[
+ perm_offset], &givptr[1], &givcol[givcol_offset],
+ ldgcol, &givnum[givnum_offset], ldu, &poles[
+ poles_offset], &difl[difl_offset], &difr[difr_offset],
+ &z__[z_offset], &k[1], &c__[1], &s[1], &work[nwork1],
+ &iwork[iwk], info);
+ } else {
+ --j;
+ dlasd6_(icompq, &nl, &nr, &sqrei, &d__[nlf], &work[vfi], &
+ work[vli], &alpha, &beta, &iwork[idxqi], &perm[nlf +
+ lvl * perm_dim1], &givptr[j], &givcol[nlf + lvl2 *
+ givcol_dim1], ldgcol, &givnum[nlf + lvl2 *
+ givnum_dim1], ldu, &poles[nlf + lvl2 * poles_dim1], &
+ difl[nlf + lvl * difl_dim1], &difr[nlf + lvl2 *
+ difr_dim1], &z__[nlf + lvl * z_dim1], &k[j], &c__[j],
+ &s[j], &work[nwork1], &iwork[iwk], info);
+ }
+ if (*info != 0) {
+ return 0;
+ }
+/* L40: */
+ }
+/* L50: */
+ }
+
+ return 0;
+
+/* End of DLASDA */
+
+} /* dlasda_ */
+
+/* Subroutine */ int dlasdq_(char *uplo, integer *sqre, integer *n, integer *
+ ncvt, integer *nru, integer *ncc, doublereal *d__, doublereal *e,
+ doublereal *vt, integer *ldvt, doublereal *u, integer *ldu,
+ doublereal *c__, integer *ldc, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer c_dim1, c_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1,
+ i__2;
+
+ /* Local variables */
+ static integer i__, j;
+ static doublereal r__, cs, sn;
+ static integer np1, isub;
+ static doublereal smin;
+ static integer sqre1;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dlasr_(char *, char *, char *, integer *,
+ integer *, doublereal *, doublereal *, doublereal *, integer *), dswap_(integer *, doublereal *, integer *
+ , doublereal *, integer *);
+ static integer iuplo;
+ extern /* Subroutine */ int dlartg_(doublereal *, doublereal *,
+ doublereal *, doublereal *, doublereal *), xerbla_(char *,
+ integer *), dbdsqr_(char *, integer *, integer *, integer
+ *, integer *, doublereal *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ integer *);
+ static logical rotate;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1999
+
+
+ Purpose
+ =======
+
+ DLASDQ computes the singular value decomposition (SVD) of a real
+ (upper or lower) bidiagonal matrix with diagonal D and offdiagonal
+ E, accumulating the transformations if desired. Letting B denote
+ the input bidiagonal matrix, the algorithm computes orthogonal
+ matrices Q and P such that B = Q * S * P' (P' denotes the transpose
+ of P). The singular values S are overwritten on D.
+
+ The input matrix U is changed to U * Q if desired.
+ The input matrix VT is changed to P' * VT if desired.
+ The input matrix C is changed to Q' * C if desired.
+
+ See "Computing Small Singular Values of Bidiagonal Matrices With
+ Guaranteed High Relative Accuracy," by J. Demmel and W. Kahan,
+ LAPACK Working Note #3, for a detailed description of the algorithm.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ On entry, UPLO specifies whether the input bidiagonal matrix
+ is upper or lower bidiagonal, and wether it is square are
+ not.
+ UPLO = 'U' or 'u' B is upper bidiagonal.
+ UPLO = 'L' or 'l' B is lower bidiagonal.
+
+ SQRE (input) INTEGER
+ = 0: then the input matrix is N-by-N.
+ = 1: then the input matrix is N-by-(N+1) if UPLU = 'U' and
+ (N+1)-by-N if UPLU = 'L'.
+
+ The bidiagonal matrix has
+ N = NL + NR + 1 rows and
+ M = N + SQRE >= N columns.
+
+ N (input) INTEGER
+ On entry, N specifies the number of rows and columns
+ in the matrix. N must be at least 0.
+
+ NCVT (input) INTEGER
+ On entry, NCVT specifies the number of columns of
+ the matrix VT. NCVT must be at least 0.
+
+ NRU (input) INTEGER
+ On entry, NRU specifies the number of rows of
+ the matrix U. NRU must be at least 0.
+
+ NCC (input) INTEGER
+ On entry, NCC specifies the number of columns of
+ the matrix C. NCC must be at least 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, D contains the diagonal entries of the
+ bidiagonal matrix whose SVD is desired. On normal exit,
+ D contains the singular values in ascending order.
+
+ E (input/output) DOUBLE PRECISION array.
+ dimension is (N-1) if SQRE = 0 and N if SQRE = 1.
+ On entry, the entries of E contain the offdiagonal entries
+ of the bidiagonal matrix whose SVD is desired. On normal
+ exit, E will contain 0. If the algorithm does not converge,
+ D and E will contain the diagonal and superdiagonal entries
+ of a bidiagonal matrix orthogonally equivalent to the one
+ given as input.
+
+ VT (input/output) DOUBLE PRECISION array, dimension (LDVT, NCVT)
+ On entry, contains a matrix which on exit has been
+ premultiplied by P', dimension N-by-NCVT if SQRE = 0
+ and (N+1)-by-NCVT if SQRE = 1 (not referenced if NCVT=0).
+
+ LDVT (input) INTEGER
+ On entry, LDVT specifies the leading dimension of VT as
+ declared in the calling (sub) program. LDVT must be at
+ least 1. If NCVT is nonzero LDVT must also be at least N.
+
+ U (input/output) DOUBLE PRECISION array, dimension (LDU, N)
+ On entry, contains a matrix which on exit has been
+ postmultiplied by Q, dimension NRU-by-N if SQRE = 0
+ and NRU-by-(N+1) if SQRE = 1 (not referenced if NRU=0).
+
+ LDU (input) INTEGER
+ On entry, LDU specifies the leading dimension of U as
+ declared in the calling (sub) program. LDU must be at
+ least max( 1, NRU ) .
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC, NCC)
+ On entry, contains an N-by-NCC matrix which on exit
+ has been premultiplied by Q' dimension N-by-NCC if SQRE = 0
+ and (N+1)-by-NCC if SQRE = 1 (not referenced if NCC=0).
+
+ LDC (input) INTEGER
+ On entry, LDC specifies the leading dimension of C as
+ declared in the calling (sub) program. LDC must be at
+ least 1. If NCC is nonzero, LDC must also be at least N.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+ Workspace. Only referenced if one of NCVT, NRU, or NCC is
+ nonzero, and if N is at least 2.
+
+ INFO (output) INTEGER
+ On exit, a value of 0 indicates a successful exit.
+ If INFO < 0, argument number -INFO is illegal.
+ If INFO > 0, the algorithm did not converge, and INFO
+ specifies how many superdiagonals did not converge.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ --e;
+ vt_dim1 = *ldvt;
+ vt_offset = 1 + vt_dim1 * 1;
+ vt -= vt_offset;
+ u_dim1 = *ldu;
+ u_offset = 1 + u_dim1 * 1;
+ u -= u_offset;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ iuplo = 0;
+ if (lsame_(uplo, "U")) {
+ iuplo = 1;
+ }
+ if (lsame_(uplo, "L")) {
+ iuplo = 2;
+ }
+ if (iuplo == 0) {
+ *info = -1;
+ } else if (*sqre < 0 || *sqre > 1) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*ncvt < 0) {
+ *info = -4;
+ } else if (*nru < 0) {
+ *info = -5;
+ } else if (*ncc < 0) {
+ *info = -6;
+ } else if ((*ncvt == 0 && *ldvt < 1) || (*ncvt > 0 && *ldvt < max(1,*n)))
+ {
+ *info = -10;
+ } else if (*ldu < max(1,*nru)) {
+ *info = -12;
+ } else if ((*ncc == 0 && *ldc < 1) || (*ncc > 0 && *ldc < max(1,*n))) {
+ *info = -14;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLASDQ", &i__1);
+ return 0;
+ }
+ if (*n == 0) {
+ return 0;
+ }
+
+/* ROTATE is true if any singular vectors desired, false otherwise */
+
+ rotate = *ncvt > 0 || *nru > 0 || *ncc > 0;
+ np1 = *n + 1;
+ sqre1 = *sqre;
+
+/*
+ If matrix non-square upper bidiagonal, rotate to be lower
+ bidiagonal. The rotations are on the right.
+*/
+
+ if ((iuplo == 1 && sqre1 == 1)) {
+ i__1 = *n - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dlartg_(&d__[i__], &e[i__], &cs, &sn, &r__);
+ d__[i__] = r__;
+ e[i__] = sn * d__[i__ + 1];
+ d__[i__ + 1] = cs * d__[i__ + 1];
+ if (rotate) {
+ work[i__] = cs;
+ work[*n + i__] = sn;
+ }
+/* L10: */
+ }
+ dlartg_(&d__[*n], &e[*n], &cs, &sn, &r__);
+ d__[*n] = r__;
+ e[*n] = 0.;
+ if (rotate) {
+ work[*n] = cs;
+ work[*n + *n] = sn;
+ }
+ iuplo = 2;
+ sqre1 = 0;
+
+/* Update singular vectors if desired. */
+
+ if (*ncvt > 0) {
+ dlasr_("L", "V", "F", &np1, ncvt, &work[1], &work[np1], &vt[
+ vt_offset], ldvt);
+ }
+ }
+
+/*
+ If matrix lower bidiagonal, rotate to be upper bidiagonal
+ by applying Givens rotations on the left.
+*/
+
+ if (iuplo == 2) {
+ i__1 = *n - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dlartg_(&d__[i__], &e[i__], &cs, &sn, &r__);
+ d__[i__] = r__;
+ e[i__] = sn * d__[i__ + 1];
+ d__[i__ + 1] = cs * d__[i__ + 1];
+ if (rotate) {
+ work[i__] = cs;
+ work[*n + i__] = sn;
+ }
+/* L20: */
+ }
+
+/*
+ If matrix (N+1)-by-N lower bidiagonal, one additional
+ rotation is needed.
+*/
+
+ if (sqre1 == 1) {
+ dlartg_(&d__[*n], &e[*n], &cs, &sn, &r__);
+ d__[*n] = r__;
+ if (rotate) {
+ work[*n] = cs;
+ work[*n + *n] = sn;
+ }
+ }
+
+/* Update singular vectors if desired. */
+
+ if (*nru > 0) {
+ if (sqre1 == 0) {
+ dlasr_("R", "V", "F", nru, n, &work[1], &work[np1], &u[
+ u_offset], ldu);
+ } else {
+ dlasr_("R", "V", "F", nru, &np1, &work[1], &work[np1], &u[
+ u_offset], ldu);
+ }
+ }
+ if (*ncc > 0) {
+ if (sqre1 == 0) {
+ dlasr_("L", "V", "F", n, ncc, &work[1], &work[np1], &c__[
+ c_offset], ldc);
+ } else {
+ dlasr_("L", "V", "F", &np1, ncc, &work[1], &work[np1], &c__[
+ c_offset], ldc);
+ }
+ }
+ }
+
+/*
+ Call DBDSQR to compute the SVD of the reduced real
+ N-by-N upper bidiagonal matrix.
+*/
+
+ dbdsqr_("U", n, ncvt, nru, ncc, &d__[1], &e[1], &vt[vt_offset], ldvt, &u[
+ u_offset], ldu, &c__[c_offset], ldc, &work[1], info);
+
+/*
+ Sort the singular values into ascending order (insertion sort on
+ singular values, but only one transposition per singular vector)
+*/
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/* Scan for smallest D(I). */
+
+ isub = i__;
+ smin = d__[i__];
+ i__2 = *n;
+ for (j = i__ + 1; j <= i__2; ++j) {
+ if (d__[j] < smin) {
+ isub = j;
+ smin = d__[j];
+ }
+/* L30: */
+ }
+ if (isub != i__) {
+
+/* Swap singular values and vectors. */
+
+ d__[isub] = d__[i__];
+ d__[i__] = smin;
+ if (*ncvt > 0) {
+ dswap_(ncvt, &vt[isub + vt_dim1], ldvt, &vt[i__ + vt_dim1],
+ ldvt);
+ }
+ if (*nru > 0) {
+ dswap_(nru, &u[isub * u_dim1 + 1], &c__1, &u[i__ * u_dim1 + 1]
+ , &c__1);
+ }
+ if (*ncc > 0) {
+ dswap_(ncc, &c__[isub + c_dim1], ldc, &c__[i__ + c_dim1], ldc)
+ ;
+ }
+ }
+/* L40: */
+ }
+
+ return 0;
+
+/* End of DLASDQ */
+
+} /* dlasdq_ */
+
+/* Subroutine */ int dlasdt_(integer *n, integer *lvl, integer *nd, integer *
+ inode, integer *ndiml, integer *ndimr, integer *msub)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+
+ /* Builtin functions */
+ double log(doublereal);
+
+ /* Local variables */
+ static integer i__, il, ir, maxn;
+ static doublereal temp;
+ static integer nlvl, llst, ncrnt;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DLASDT creates a tree of subproblems for bidiagonal divide and
+ conquer.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ On entry, the number of diagonal elements of the
+ bidiagonal matrix.
+
+ LVL (output) INTEGER
+ On exit, the number of levels on the computation tree.
+
+ ND (output) INTEGER
+ On exit, the number of nodes on the tree.
+
+ INODE (output) INTEGER array, dimension ( N )
+ On exit, centers of subproblems.
+
+ NDIML (output) INTEGER array, dimension ( N )
+ On exit, row dimensions of left children.
+
+ NDIMR (output) INTEGER array, dimension ( N )
+ On exit, row dimensions of right children.
+
+ MSUB (input) INTEGER.
+ On entry, the maximum row dimension each subproblem at the
+ bottom of the tree can be of.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+
+ Find the number of levels on the tree.
+*/
+
+ /* Parameter adjustments */
+ --ndimr;
+ --ndiml;
+ --inode;
+
+ /* Function Body */
+ maxn = max(1,*n);
+ temp = log((doublereal) maxn / (doublereal) (*msub + 1)) / log(2.);
+ *lvl = (integer) temp + 1;
+
+ i__ = *n / 2;
+ inode[1] = i__ + 1;
+ ndiml[1] = i__;
+ ndimr[1] = *n - i__ - 1;
+ il = 0;
+ ir = 1;
+ llst = 1;
+ i__1 = *lvl - 1;
+ for (nlvl = 1; nlvl <= i__1; ++nlvl) {
+
+/*
+ Constructing the tree at (NLVL+1)-st level. The number of
+ nodes created on this level is LLST * 2.
+*/
+
+ i__2 = llst - 1;
+ for (i__ = 0; i__ <= i__2; ++i__) {
+ il += 2;
+ ir += 2;
+ ncrnt = llst + i__;
+ ndiml[il] = ndiml[ncrnt] / 2;
+ ndimr[il] = ndiml[ncrnt] - ndiml[il] - 1;
+ inode[il] = inode[ncrnt] - ndimr[il] - 1;
+ ndiml[ir] = ndimr[ncrnt] / 2;
+ ndimr[ir] = ndimr[ncrnt] - ndiml[ir] - 1;
+ inode[ir] = inode[ncrnt] + ndiml[ir] + 1;
+/* L10: */
+ }
+ llst <<= 1;
+/* L20: */
+ }
+ *nd = ((llst) << (1)) - 1;
+
+ return 0;
+
+/* End of DLASDT */
+
+} /* dlasdt_ */
+
+/* Subroutine */ int dlaset_(char *uplo, integer *m, integer *n, doublereal *
+ alpha, doublereal *beta, doublereal *a, integer *lda)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i__, j;
+ extern logical lsame_(char *, char *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLASET initializes an m-by-n matrix A to BETA on the diagonal and
+ ALPHA on the offdiagonals.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies the part of the matrix A to be set.
+ = 'U': Upper triangular part is set; the strictly lower
+ triangular part of A is not changed.
+ = 'L': Lower triangular part is set; the strictly upper
+ triangular part of A is not changed.
+ Otherwise: All of the matrix A is set.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ ALPHA (input) DOUBLE PRECISION
+ The constant to which the offdiagonal elements are to be set.
+
+ BETA (input) DOUBLE PRECISION
+ The constant to which the diagonal elements are to be set.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On exit, the leading m-by-n submatrix of A is set as follows:
+
+ if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n,
+ if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n,
+ otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j,
+
+ and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+
+ /* Function Body */
+ if (lsame_(uplo, "U")) {
+
+/*
+ Set the strictly upper triangular or trapezoidal part of the
+ array to ALPHA.
+*/
+
+ i__1 = *n;
+ for (j = 2; j <= i__1; ++j) {
+/* Computing MIN */
+ i__3 = j - 1;
+ i__2 = min(i__3,*m);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] = *alpha;
+/* L10: */
+ }
+/* L20: */
+ }
+
+ } else if (lsame_(uplo, "L")) {
+
+/*
+ Set the strictly lower triangular or trapezoidal part of the
+ array to ALPHA.
+*/
+
+ i__1 = min(*m,*n);
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] = *alpha;
+/* L30: */
+ }
+/* L40: */
+ }
+
+ } else {
+
+/* Set the leading m-by-n submatrix to ALPHA. */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] = *alpha;
+/* L50: */
+ }
+/* L60: */
+ }
+ }
+
+/* Set the first min(M,N) diagonal elements to BETA. */
+
+ i__1 = min(*m,*n);
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ a[i__ + i__ * a_dim1] = *beta;
+/* L70: */
+ }
+
+ return 0;
+
+/* End of DLASET */
+
+} /* dlaset_ */
+
+/* Subroutine */ int dlasq1_(integer *n, doublereal *d__, doublereal *e,
+ doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ doublereal d__1, d__2, d__3;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static integer i__;
+ static doublereal eps;
+ extern /* Subroutine */ int dlas2_(doublereal *, doublereal *, doublereal
+ *, doublereal *, doublereal *);
+ static doublereal scale;
+ static integer iinfo;
+ static doublereal sigmn;
+ extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
+ doublereal *, integer *);
+ static doublereal sigmx;
+ extern /* Subroutine */ int dlasq2_(integer *, doublereal *, integer *);
+
+ extern /* Subroutine */ int dlascl_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, integer *, doublereal *,
+ integer *, integer *);
+ static doublereal safmin;
+ extern /* Subroutine */ int xerbla_(char *, integer *), dlasrt_(
+ char *, integer *, doublereal *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1999
+
+
+ Purpose
+ =======
+
+ DLASQ1 computes the singular values of a real N-by-N bidiagonal
+ matrix with diagonal D and off-diagonal E. The singular values
+ are computed to high relative accuracy, in the absence of
+ denormalization, underflow and overflow. The algorithm was first
+ presented in
+
+ "Accurate singular values and differential qd algorithms" by K. V.
+ Fernando and B. N. Parlett, Numer. Math., Vol-67, No. 2, pp. 191-230,
+ 1994,
+
+ and the present implementation is described in "An implementation of
+ the dqds Algorithm (Positive Case)", LAPACK Working Note.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of rows and columns in the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, D contains the diagonal elements of the
+ bidiagonal matrix whose SVD is desired. On normal exit,
+ D contains the singular values in decreasing order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, elements E(1:N-1) contain the off-diagonal elements
+ of the bidiagonal matrix whose SVD is desired.
+ On exit, E is overwritten.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (4*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm failed
+ = 1, a split was marked by a positive value in E
+ = 2, current block of Z not diagonalized after 30*N
+ iterations (in inner while loop)
+ = 3, termination criterion of outer while loop not met
+ (program created more than N unreduced blocks)
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ --work;
+ --e;
+ --d__;
+
+ /* Function Body */
+ *info = 0;
+ if (*n < 0) {
+ *info = -2;
+ i__1 = -(*info);
+ xerbla_("DLASQ1", &i__1);
+ return 0;
+ } else if (*n == 0) {
+ return 0;
+ } else if (*n == 1) {
+ d__[1] = abs(d__[1]);
+ return 0;
+ } else if (*n == 2) {
+ dlas2_(&d__[1], &e[1], &d__[2], &sigmn, &sigmx);
+ d__[1] = sigmx;
+ d__[2] = sigmn;
+ return 0;
+ }
+
+/* Estimate the largest singular value. */
+
+ sigmx = 0.;
+ i__1 = *n - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ d__[i__] = (d__1 = d__[i__], abs(d__1));
+/* Computing MAX */
+ d__2 = sigmx, d__3 = (d__1 = e[i__], abs(d__1));
+ sigmx = max(d__2,d__3);
+/* L10: */
+ }
+ d__[*n] = (d__1 = d__[*n], abs(d__1));
+
+/* Early return if SIGMX is zero (matrix is already diagonal). */
+
+ if (sigmx == 0.) {
+ dlasrt_("D", n, &d__[1], &iinfo);
+ return 0;
+ }
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+/* Computing MAX */
+ d__1 = sigmx, d__2 = d__[i__];
+ sigmx = max(d__1,d__2);
+/* L20: */
+ }
+
+/*
+ Copy D and E into WORK (in the Z format) and scale (squaring the
+ input data makes scaling by a power of the radix pointless).
+*/
+
+ eps = PRECISION;
+ safmin = SAFEMINIMUM;
+ scale = sqrt(eps / safmin);
+ dcopy_(n, &d__[1], &c__1, &work[1], &c__2);
+ i__1 = *n - 1;
+ dcopy_(&i__1, &e[1], &c__1, &work[2], &c__2);
+ i__1 = ((*n) << (1)) - 1;
+ i__2 = ((*n) << (1)) - 1;
+ dlascl_("G", &c__0, &c__0, &sigmx, &scale, &i__1, &c__1, &work[1], &i__2,
+ &iinfo);
+
+/* Compute the q's and e's. */
+
+ i__1 = ((*n) << (1)) - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+/* Computing 2nd power */
+ d__1 = work[i__];
+ work[i__] = d__1 * d__1;
+/* L30: */
+ }
+ work[*n * 2] = 0.;
+
+ dlasq2_(n, &work[1], info);
+
+ if (*info == 0) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ d__[i__] = sqrt(work[i__]);
+/* L40: */
+ }
+ dlascl_("G", &c__0, &c__0, &scale, &sigmx, n, &c__1, &d__[1], n, &
+ iinfo);
+ }
+
+ return 0;
+
+/* End of DLASQ1 */
+
+} /* dlasq1_ */
+
+/* Subroutine */ int dlasq2_(integer *n, doublereal *z__, integer *info)
+{
+ /* System generated locals */
+ integer i__1, i__2, i__3;
+ doublereal d__1, d__2;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static doublereal d__, e;
+ static integer k;
+ static doublereal s, t;
+ static integer i0, i4, n0, pp;
+ static doublereal eps, tol;
+ static integer ipn4;
+ static doublereal tol2;
+ static logical ieee;
+ static integer nbig;
+ static doublereal dmin__, emin, emax;
+ static integer ndiv, iter;
+ static doublereal qmin, temp, qmax, zmax;
+ static integer splt, nfail;
+ static doublereal desig, trace, sigma;
+ static integer iinfo;
+ extern /* Subroutine */ int dlasq3_(integer *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, doublereal *, doublereal *,
+ integer *, integer *, integer *, logical *);
+
+ static integer iwhila, iwhilb;
+ static doublereal oldemn, safmin;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int dlasrt_(char *, integer *, doublereal *,
+ integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1999
+
+
+ Purpose
+ =======
+
+ DLASQ2 computes all the eigenvalues of the symmetric positive
+ definite tridiagonal matrix associated with the qd array Z to high
+ relative accuracy are computed to high relative accuracy, in the
+ absence of denormalization, underflow and overflow.
+
+ To see the relation of Z to the tridiagonal matrix, let L be a
+ unit lower bidiagonal matrix with subdiagonals Z(2,4,6,,..) and
+ let U be an upper bidiagonal matrix with 1's above and diagonal
+ Z(1,3,5,,..). The tridiagonal is L*U or, if you prefer, the
+ symmetric tridiagonal to which it is similar.
+
+ Note : DLASQ2 defines a logical variable, IEEE, which is true
+ on machines which follow ieee-754 floating-point standard in their
+ handling of infinities and NaNs, and false otherwise. This variable
+ is passed to DLASQ3.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of rows and columns in the matrix. N >= 0.
+
+ Z (workspace) DOUBLE PRECISION array, dimension ( 4*N )
+ On entry Z holds the qd array. On exit, entries 1 to N hold
+ the eigenvalues in decreasing order, Z( 2*N+1 ) holds the
+ trace, and Z( 2*N+2 ) holds the sum of the eigenvalues. If
+ N > 2, then Z( 2*N+3 ) holds the iteration count, Z( 2*N+4 )
+ holds NDIVS/NIN^2, and Z( 2*N+5 ) holds the percentage of
+ shifts that failed.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if the i-th argument is a scalar and had an illegal
+ value, then INFO = -i, if the i-th argument is an
+ array and the j-entry had an illegal value, then
+ INFO = -(i*100+j)
+ > 0: the algorithm failed
+ = 1, a split was marked by a positive value in E
+ = 2, current block of Z not diagonalized after 30*N
+ iterations (in inner while loop)
+ = 3, termination criterion of outer while loop not met
+ (program created more than N unreduced blocks)
+
+ Further Details
+ ===============
+ Local Variables: I0:N0 defines a current unreduced segment of Z.
+ The shifts are accumulated in SIGMA. Iteration count is in ITER.
+ Ping-pong is controlled by PP (alternates between 0 and 1).
+
+ =====================================================================
+
+
+ Test the input arguments.
+ (in case DLASQ2 is not called by DLASQ1)
+*/
+
+ /* Parameter adjustments */
+ --z__;
+
+ /* Function Body */
+ *info = 0;
+ eps = PRECISION;
+ safmin = SAFEMINIMUM;
+ tol = eps * 100.;
+/* Computing 2nd power */
+ d__1 = tol;
+ tol2 = d__1 * d__1;
+
+ if (*n < 0) {
+ *info = -1;
+ xerbla_("DLASQ2", &c__1);
+ return 0;
+ } else if (*n == 0) {
+ return 0;
+ } else if (*n == 1) {
+
+/* 1-by-1 case. */
+
+ if (z__[1] < 0.) {
+ *info = -201;
+ xerbla_("DLASQ2", &c__2);
+ }
+ return 0;
+ } else if (*n == 2) {
+
+/* 2-by-2 case. */
+
+ if (z__[2] < 0. || z__[3] < 0.) {
+ *info = -2;
+ xerbla_("DLASQ2", &c__2);
+ return 0;
+ } else if (z__[3] > z__[1]) {
+ d__ = z__[3];
+ z__[3] = z__[1];
+ z__[1] = d__;
+ }
+ z__[5] = z__[1] + z__[2] + z__[3];
+ if (z__[2] > z__[3] * tol2) {
+ t = (z__[1] - z__[3] + z__[2]) * .5;
+ s = z__[3] * (z__[2] / t);
+ if (s <= t) {
+ s = z__[3] * (z__[2] / (t * (sqrt(s / t + 1.) + 1.)));
+ } else {
+ s = z__[3] * (z__[2] / (t + sqrt(t) * sqrt(t + s)));
+ }
+ t = z__[1] + (s + z__[2]);
+ z__[3] *= z__[1] / t;
+ z__[1] = t;
+ }
+ z__[2] = z__[3];
+ z__[6] = z__[2] + z__[1];
+ return 0;
+ }
+
+/* Check for negative data and compute sums of q's and e's. */
+
+ z__[*n * 2] = 0.;
+ emin = z__[2];
+ qmax = 0.;
+ zmax = 0.;
+ d__ = 0.;
+ e = 0.;
+
+ i__1 = (*n - 1) << (1);
+ for (k = 1; k <= i__1; k += 2) {
+ if (z__[k] < 0.) {
+ *info = -(k + 200);
+ xerbla_("DLASQ2", &c__2);
+ return 0;
+ } else if (z__[k + 1] < 0.) {
+ *info = -(k + 201);
+ xerbla_("DLASQ2", &c__2);
+ return 0;
+ }
+ d__ += z__[k];
+ e += z__[k + 1];
+/* Computing MAX */
+ d__1 = qmax, d__2 = z__[k];
+ qmax = max(d__1,d__2);
+/* Computing MIN */
+ d__1 = emin, d__2 = z__[k + 1];
+ emin = min(d__1,d__2);
+/* Computing MAX */
+ d__1 = max(qmax,zmax), d__2 = z__[k + 1];
+ zmax = max(d__1,d__2);
+/* L10: */
+ }
+ if (z__[((*n) << (1)) - 1] < 0.) {
+ *info = -(((*n) << (1)) + 199);
+ xerbla_("DLASQ2", &c__2);
+ return 0;
+ }
+ d__ += z__[((*n) << (1)) - 1];
+/* Computing MAX */
+ d__1 = qmax, d__2 = z__[((*n) << (1)) - 1];
+ qmax = max(d__1,d__2);
+ zmax = max(qmax,zmax);
+
+/* Check for diagonality. */
+
+ if (e == 0.) {
+ i__1 = *n;
+ for (k = 2; k <= i__1; ++k) {
+ z__[k] = z__[((k) << (1)) - 1];
+/* L20: */
+ }
+ dlasrt_("D", n, &z__[1], &iinfo);
+ z__[((*n) << (1)) - 1] = d__;
+ return 0;
+ }
+
+ trace = d__ + e;
+
+/* Check for zero data. */
+
+ if (trace == 0.) {
+ z__[((*n) << (1)) - 1] = 0.;
+ return 0;
+ }
+
+/* Check whether the machine is IEEE conformable. */
+
+ ieee = (ilaenv_(&c__10, "DLASQ2", "N", &c__1, &c__2, &c__3, &c__4, (
+ ftnlen)6, (ftnlen)1) == 1 && ilaenv_(&c__11, "DLASQ2", "N", &c__1,
+ &c__2, &c__3, &c__4, (ftnlen)6, (ftnlen)1) == 1);
+
+/* Rearrange data for locality: Z=(q1,qq1,e1,ee1,q2,qq2,e2,ee2,...). */
+
+ for (k = (*n) << (1); k >= 2; k += -2) {
+ z__[k * 2] = 0.;
+ z__[((k) << (1)) - 1] = z__[k];
+ z__[((k) << (1)) - 2] = 0.;
+ z__[((k) << (1)) - 3] = z__[k - 1];
+/* L30: */
+ }
+
+ i0 = 1;
+ n0 = *n;
+
+/* Reverse the qd-array, if warranted. */
+
+ if (z__[((i0) << (2)) - 3] * 1.5 < z__[((n0) << (2)) - 3]) {
+ ipn4 = (i0 + n0) << (2);
+ i__1 = (i0 + n0 - 1) << (1);
+ for (i4 = (i0) << (2); i4 <= i__1; i4 += 4) {
+ temp = z__[i4 - 3];
+ z__[i4 - 3] = z__[ipn4 - i4 - 3];
+ z__[ipn4 - i4 - 3] = temp;
+ temp = z__[i4 - 1];
+ z__[i4 - 1] = z__[ipn4 - i4 - 5];
+ z__[ipn4 - i4 - 5] = temp;
+/* L40: */
+ }
+ }
+
+/* Initial split checking via dqd and Li's test. */
+
+ pp = 0;
+
+ for (k = 1; k <= 2; ++k) {
+
+ d__ = z__[((n0) << (2)) + pp - 3];
+ i__1 = ((i0) << (2)) + pp;
+ for (i4 = ((n0 - 1) << (2)) + pp; i4 >= i__1; i4 += -4) {
+ if (z__[i4 - 1] <= tol2 * d__) {
+ z__[i4 - 1] = -0.;
+ d__ = z__[i4 - 3];
+ } else {
+ d__ = z__[i4 - 3] * (d__ / (d__ + z__[i4 - 1]));
+ }
+/* L50: */
+ }
+
+/* dqd maps Z to ZZ plus Li's test. */
+
+ emin = z__[((i0) << (2)) + pp + 1];
+ d__ = z__[((i0) << (2)) + pp - 3];
+ i__1 = ((n0 - 1) << (2)) + pp;
+ for (i4 = ((i0) << (2)) + pp; i4 <= i__1; i4 += 4) {
+ z__[i4 - ((pp) << (1)) - 2] = d__ + z__[i4 - 1];
+ if (z__[i4 - 1] <= tol2 * d__) {
+ z__[i4 - 1] = -0.;
+ z__[i4 - ((pp) << (1)) - 2] = d__;
+ z__[i4 - ((pp) << (1))] = 0.;
+ d__ = z__[i4 + 1];
+ } else if ((safmin * z__[i4 + 1] < z__[i4 - ((pp) << (1)) - 2] &&
+ safmin * z__[i4 - ((pp) << (1)) - 2] < z__[i4 + 1])) {
+ temp = z__[i4 + 1] / z__[i4 - ((pp) << (1)) - 2];
+ z__[i4 - ((pp) << (1))] = z__[i4 - 1] * temp;
+ d__ *= temp;
+ } else {
+ z__[i4 - ((pp) << (1))] = z__[i4 + 1] * (z__[i4 - 1] / z__[i4
+ - ((pp) << (1)) - 2]);
+ d__ = z__[i4 + 1] * (d__ / z__[i4 - ((pp) << (1)) - 2]);
+ }
+/* Computing MIN */
+ d__1 = emin, d__2 = z__[i4 - ((pp) << (1))];
+ emin = min(d__1,d__2);
+/* L60: */
+ }
+ z__[((n0) << (2)) - pp - 2] = d__;
+
+/* Now find qmax. */
+
+ qmax = z__[((i0) << (2)) - pp - 2];
+ i__1 = ((n0) << (2)) - pp - 2;
+ for (i4 = ((i0) << (2)) - pp + 2; i4 <= i__1; i4 += 4) {
+/* Computing MAX */
+ d__1 = qmax, d__2 = z__[i4];
+ qmax = max(d__1,d__2);
+/* L70: */
+ }
+
+/* Prepare for the next iteration on K. */
+
+ pp = 1 - pp;
+/* L80: */
+ }
+
+ iter = 2;
+ nfail = 0;
+ ndiv = (n0 - i0) << (1);
+
+ i__1 = *n + 1;
+ for (iwhila = 1; iwhila <= i__1; ++iwhila) {
+ if (n0 < 1) {
+ goto L150;
+ }
+
+/*
+ While array unfinished do
+
+ E(N0) holds the value of SIGMA when submatrix in I0:N0
+ splits from the rest of the array, but is negated.
+*/
+
+ desig = 0.;
+ if (n0 == *n) {
+ sigma = 0.;
+ } else {
+ sigma = -z__[((n0) << (2)) - 1];
+ }
+ if (sigma < 0.) {
+ *info = 1;
+ return 0;
+ }
+
+/*
+ Find last unreduced submatrix's top index I0, find QMAX and
+ EMIN. Find Gershgorin-type bound if Q's much greater than E's.
+*/
+
+ emax = 0.;
+ if (n0 > i0) {
+ emin = (d__1 = z__[((n0) << (2)) - 5], abs(d__1));
+ } else {
+ emin = 0.;
+ }
+ qmin = z__[((n0) << (2)) - 3];
+ qmax = qmin;
+ for (i4 = (n0) << (2); i4 >= 8; i4 += -4) {
+ if (z__[i4 - 5] <= 0.) {
+ goto L100;
+ }
+ if (qmin >= emax * 4.) {
+/* Computing MIN */
+ d__1 = qmin, d__2 = z__[i4 - 3];
+ qmin = min(d__1,d__2);
+/* Computing MAX */
+ d__1 = emax, d__2 = z__[i4 - 5];
+ emax = max(d__1,d__2);
+ }
+/* Computing MAX */
+ d__1 = qmax, d__2 = z__[i4 - 7] + z__[i4 - 5];
+ qmax = max(d__1,d__2);
+/* Computing MIN */
+ d__1 = emin, d__2 = z__[i4 - 5];
+ emin = min(d__1,d__2);
+/* L90: */
+ }
+ i4 = 4;
+
+L100:
+ i0 = i4 / 4;
+
+/* Store EMIN for passing to DLASQ3. */
+
+ z__[((n0) << (2)) - 1] = emin;
+
+/*
+ Put -(initial shift) into DMIN.
+
+ Computing MAX
+*/
+ d__1 = 0., d__2 = qmin - sqrt(qmin) * 2. * sqrt(emax);
+ dmin__ = -max(d__1,d__2);
+
+/* Now I0:N0 is unreduced. PP = 0 for ping, PP = 1 for pong. */
+
+ pp = 0;
+
+ nbig = (n0 - i0 + 1) * 30;
+ i__2 = nbig;
+ for (iwhilb = 1; iwhilb <= i__2; ++iwhilb) {
+ if (i0 > n0) {
+ goto L130;
+ }
+
+/* While submatrix unfinished take a good dqds step. */
+
+ dlasq3_(&i0, &n0, &z__[1], &pp, &dmin__, &sigma, &desig, &qmax, &
+ nfail, &iter, &ndiv, &ieee);
+
+ pp = 1 - pp;
+
+/* When EMIN is very small check for splits. */
+
+ if ((pp == 0 && n0 - i0 >= 3)) {
+ if (z__[n0 * 4] <= tol2 * qmax || z__[((n0) << (2)) - 1] <=
+ tol2 * sigma) {
+ splt = i0 - 1;
+ qmax = z__[((i0) << (2)) - 3];
+ emin = z__[((i0) << (2)) - 1];
+ oldemn = z__[i0 * 4];
+ i__3 = (n0 - 3) << (2);
+ for (i4 = (i0) << (2); i4 <= i__3; i4 += 4) {
+ if (z__[i4] <= tol2 * z__[i4 - 3] || z__[i4 - 1] <=
+ tol2 * sigma) {
+ z__[i4 - 1] = -sigma;
+ splt = i4 / 4;
+ qmax = 0.;
+ emin = z__[i4 + 3];
+ oldemn = z__[i4 + 4];
+ } else {
+/* Computing MAX */
+ d__1 = qmax, d__2 = z__[i4 + 1];
+ qmax = max(d__1,d__2);
+/* Computing MIN */
+ d__1 = emin, d__2 = z__[i4 - 1];
+ emin = min(d__1,d__2);
+/* Computing MIN */
+ d__1 = oldemn, d__2 = z__[i4];
+ oldemn = min(d__1,d__2);
+ }
+/* L110: */
+ }
+ z__[((n0) << (2)) - 1] = emin;
+ z__[n0 * 4] = oldemn;
+ i0 = splt + 1;
+ }
+ }
+
+/* L120: */
+ }
+
+ *info = 2;
+ return 0;
+
+/* end IWHILB */
+
+L130:
+
+/* L140: */
+ ;
+ }
+
+ *info = 3;
+ return 0;
+
+/* end IWHILA */
+
+L150:
+
+/* Move q's to the front. */
+
+ i__1 = *n;
+ for (k = 2; k <= i__1; ++k) {
+ z__[k] = z__[((k) << (2)) - 3];
+/* L160: */
+ }
+
+/* Sort and compute sum of eigenvalues. */
+
+ dlasrt_("D", n, &z__[1], &iinfo);
+
+ e = 0.;
+ for (k = *n; k >= 1; --k) {
+ e += z__[k];
+/* L170: */
+ }
+
+/* Store trace, sum(eigenvalues) and information on performance. */
+
+ z__[((*n) << (1)) + 1] = trace;
+ z__[((*n) << (1)) + 2] = e;
+ z__[((*n) << (1)) + 3] = (doublereal) iter;
+/* Computing 2nd power */
+ i__1 = *n;
+ z__[((*n) << (1)) + 4] = (doublereal) ndiv / (doublereal) (i__1 * i__1);
+ z__[((*n) << (1)) + 5] = nfail * 100. / (doublereal) iter;
+ return 0;
+
+/* End of DLASQ2 */
+
+} /* dlasq2_ */
+
+/* Subroutine */ int dlasq3_(integer *i0, integer *n0, doublereal *z__,
+ integer *pp, doublereal *dmin__, doublereal *sigma, doublereal *desig,
+ doublereal *qmax, integer *nfail, integer *iter, integer *ndiv,
+ logical *ieee)
+{
+ /* Initialized data */
+
+ static integer ttype = 0;
+ static doublereal dmin1 = 0.;
+ static doublereal dmin2 = 0.;
+ static doublereal dn = 0.;
+ static doublereal dn1 = 0.;
+ static doublereal dn2 = 0.;
+ static doublereal tau = 0.;
+
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1, d__2;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static doublereal s, t;
+ static integer j4, nn;
+ static doublereal eps, tol;
+ static integer n0in, ipn4;
+ static doublereal tol2, temp;
+ extern /* Subroutine */ int dlasq4_(integer *, integer *, doublereal *,
+ integer *, integer *, doublereal *, doublereal *, doublereal *,
+ doublereal *, doublereal *, doublereal *, doublereal *, integer *)
+ , dlasq5_(integer *, integer *, doublereal *, integer *,
+ doublereal *, doublereal *, doublereal *, doublereal *,
+ doublereal *, doublereal *, doublereal *, logical *), dlasq6_(
+ integer *, integer *, doublereal *, integer *, doublereal *,
+ doublereal *, doublereal *, doublereal *, doublereal *,
+ doublereal *);
+
+ static doublereal safmin;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ May 17, 2000
+
+
+ Purpose
+ =======
+
+ DLASQ3 checks for deflation, computes a shift (TAU) and calls dqds.
+ In case of failure it changes shifts, and tries again until output
+ is positive.
+
+ Arguments
+ =========
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) DOUBLE PRECISION array, dimension ( 4*N )
+ Z holds the qd array.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ DMIN (output) DOUBLE PRECISION
+ Minimum value of d.
+
+ SIGMA (output) DOUBLE PRECISION
+ Sum of shifts used in current segment.
+
+ DESIG (input/output) DOUBLE PRECISION
+ Lower order part of SIGMA
+
+ QMAX (input) DOUBLE PRECISION
+ Maximum value of q.
+
+ NFAIL (output) INTEGER
+ Number of times shift was too big.
+
+ ITER (output) INTEGER
+ Number of iterations.
+
+ NDIV (output) INTEGER
+ Number of divisions.
+
+ TTYPE (output) INTEGER
+ Shift type.
+
+ IEEE (input) LOGICAL
+ Flag for IEEE or non IEEE arithmetic (passed to DLASQ5).
+
+ =====================================================================
+*/
+
+ /* Parameter adjustments */
+ --z__;
+
+ /* Function Body */
+
+ n0in = *n0;
+ eps = PRECISION;
+ safmin = SAFEMINIMUM;
+ tol = eps * 100.;
+/* Computing 2nd power */
+ d__1 = tol;
+ tol2 = d__1 * d__1;
+
+/* Check for deflation. */
+
+L10:
+
+ if (*n0 < *i0) {
+ return 0;
+ }
+ if (*n0 == *i0) {
+ goto L20;
+ }
+ nn = ((*n0) << (2)) + *pp;
+ if (*n0 == *i0 + 1) {
+ goto L40;
+ }
+
+/* Check whether E(N0-1) is negligible, 1 eigenvalue. */
+
+ if ((z__[nn - 5] > tol2 * (*sigma + z__[nn - 3]) && z__[nn - ((*pp) << (1)
+ ) - 4] > tol2 * z__[nn - 7])) {
+ goto L30;
+ }
+
+L20:
+
+ z__[((*n0) << (2)) - 3] = z__[((*n0) << (2)) + *pp - 3] + *sigma;
+ --(*n0);
+ goto L10;
+
+/* Check whether E(N0-2) is negligible, 2 eigenvalues. */
+
+L30:
+
+ if ((z__[nn - 9] > tol2 * *sigma && z__[nn - ((*pp) << (1)) - 8] > tol2 *
+ z__[nn - 11])) {
+ goto L50;
+ }
+
+L40:
+
+ if (z__[nn - 3] > z__[nn - 7]) {
+ s = z__[nn - 3];
+ z__[nn - 3] = z__[nn - 7];
+ z__[nn - 7] = s;
+ }
+ if (z__[nn - 5] > z__[nn - 3] * tol2) {
+ t = (z__[nn - 7] - z__[nn - 3] + z__[nn - 5]) * .5;
+ s = z__[nn - 3] * (z__[nn - 5] / t);
+ if (s <= t) {
+ s = z__[nn - 3] * (z__[nn - 5] / (t * (sqrt(s / t + 1.) + 1.)));
+ } else {
+ s = z__[nn - 3] * (z__[nn - 5] / (t + sqrt(t) * sqrt(t + s)));
+ }
+ t = z__[nn - 7] + (s + z__[nn - 5]);
+ z__[nn - 3] *= z__[nn - 7] / t;
+ z__[nn - 7] = t;
+ }
+ z__[((*n0) << (2)) - 7] = z__[nn - 7] + *sigma;
+ z__[((*n0) << (2)) - 3] = z__[nn - 3] + *sigma;
+ *n0 += -2;
+ goto L10;
+
+L50:
+
+/* Reverse the qd-array, if warranted. */
+
+ if (*dmin__ <= 0. || *n0 < n0in) {
+ if (z__[((*i0) << (2)) + *pp - 3] * 1.5 < z__[((*n0) << (2)) + *pp -
+ 3]) {
+ ipn4 = (*i0 + *n0) << (2);
+ i__1 = (*i0 + *n0 - 1) << (1);
+ for (j4 = (*i0) << (2); j4 <= i__1; j4 += 4) {
+ temp = z__[j4 - 3];
+ z__[j4 - 3] = z__[ipn4 - j4 - 3];
+ z__[ipn4 - j4 - 3] = temp;
+ temp = z__[j4 - 2];
+ z__[j4 - 2] = z__[ipn4 - j4 - 2];
+ z__[ipn4 - j4 - 2] = temp;
+ temp = z__[j4 - 1];
+ z__[j4 - 1] = z__[ipn4 - j4 - 5];
+ z__[ipn4 - j4 - 5] = temp;
+ temp = z__[j4];
+ z__[j4] = z__[ipn4 - j4 - 4];
+ z__[ipn4 - j4 - 4] = temp;
+/* L60: */
+ }
+ if (*n0 - *i0 <= 4) {
+ z__[((*n0) << (2)) + *pp - 1] = z__[((*i0) << (2)) + *pp - 1];
+ z__[((*n0) << (2)) - *pp] = z__[((*i0) << (2)) - *pp];
+ }
+/* Computing MIN */
+ d__1 = dmin2, d__2 = z__[((*n0) << (2)) + *pp - 1];
+ dmin2 = min(d__1,d__2);
+/* Computing MIN */
+ d__1 = z__[((*n0) << (2)) + *pp - 1], d__2 = z__[((*i0) << (2)) +
+ *pp - 1], d__1 = min(d__1,d__2), d__2 = z__[((*i0) << (2))
+ + *pp + 3];
+ z__[((*n0) << (2)) + *pp - 1] = min(d__1,d__2);
+/* Computing MIN */
+ d__1 = z__[((*n0) << (2)) - *pp], d__2 = z__[((*i0) << (2)) - *pp]
+ , d__1 = min(d__1,d__2), d__2 = z__[((*i0) << (2)) - *pp
+ + 4];
+ z__[((*n0) << (2)) - *pp] = min(d__1,d__2);
+/* Computing MAX */
+ d__1 = *qmax, d__2 = z__[((*i0) << (2)) + *pp - 3], d__1 = max(
+ d__1,d__2), d__2 = z__[((*i0) << (2)) + *pp + 1];
+ *qmax = max(d__1,d__2);
+ *dmin__ = -0.;
+ }
+ }
+
+/*
+ L70:
+
+ Computing MIN
+*/
+ d__1 = z__[((*n0) << (2)) + *pp - 1], d__2 = z__[((*n0) << (2)) + *pp - 9]
+ , d__1 = min(d__1,d__2), d__2 = dmin2 + z__[((*n0) << (2)) - *pp];
+ if (*dmin__ < 0. || safmin * *qmax < min(d__1,d__2)) {
+
+/* Choose a shift. */
+
+ dlasq4_(i0, n0, &z__[1], pp, &n0in, dmin__, &dmin1, &dmin2, &dn, &dn1,
+ &dn2, &tau, &ttype);
+
+/* Call dqds until DMIN > 0. */
+
+L80:
+
+ dlasq5_(i0, n0, &z__[1], pp, &tau, dmin__, &dmin1, &dmin2, &dn, &dn1,
+ &dn2, ieee);
+
+ *ndiv += *n0 - *i0 + 2;
+ ++(*iter);
+
+/* Check status. */
+
+ if ((*dmin__ >= 0. && dmin1 > 0.)) {
+
+/* Success. */
+
+ goto L100;
+
+ } else if ((((*dmin__ < 0. && dmin1 > 0.) && z__[((*n0 - 1) << (2)) -
+ *pp] < tol * (*sigma + dn1)) && abs(dn) < tol * *sigma)) {
+
+/* Convergence hidden by negative DN. */
+
+ z__[((*n0 - 1) << (2)) - *pp + 2] = 0.;
+ *dmin__ = 0.;
+ goto L100;
+ } else if (*dmin__ < 0.) {
+
+/* TAU too big. Select new TAU and try again. */
+
+ ++(*nfail);
+ if (ttype < -22) {
+
+/* Failed twice. Play it safe. */
+
+ tau = 0.;
+ } else if (dmin1 > 0.) {
+
+/* Late failure. Gives excellent shift. */
+
+ tau = (tau + *dmin__) * (1. - eps * 2.);
+ ttype += -11;
+ } else {
+
+/* Early failure. Divide by 4. */
+
+ tau *= .25;
+ ttype += -12;
+ }
+ goto L80;
+ } else if (*dmin__ != *dmin__) {
+
+/* NaN. */
+
+ tau = 0.;
+ goto L80;
+ } else {
+
+/* Possible underflow. Play it safe. */
+
+ goto L90;
+ }
+ }
+
+/* Risk of underflow. */
+
+L90:
+ dlasq6_(i0, n0, &z__[1], pp, dmin__, &dmin1, &dmin2, &dn, &dn1, &dn2);
+ *ndiv += *n0 - *i0 + 2;
+ ++(*iter);
+ tau = 0.;
+
+L100:
+ if (tau < *sigma) {
+ *desig += tau;
+ t = *sigma + *desig;
+ *desig -= t - *sigma;
+ } else {
+ t = *sigma + tau;
+ *desig = *sigma - (t - tau) + *desig;
+ }
+ *sigma = t;
+
+ return 0;
+
+/* End of DLASQ3 */
+
+} /* dlasq3_ */
+
+/* Subroutine */ int dlasq4_(integer *i0, integer *n0, doublereal *z__,
+ integer *pp, integer *n0in, doublereal *dmin__, doublereal *dmin1,
+ doublereal *dmin2, doublereal *dn, doublereal *dn1, doublereal *dn2,
+ doublereal *tau, integer *ttype)
+{
+ /* Initialized data */
+
+ static doublereal g = 0.;
+
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1, d__2;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static doublereal s, a2, b1, b2;
+ static integer i4, nn, np;
+ static doublereal gam, gap1, gap2;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1999
+
+
+ Purpose
+ =======
+
+ DLASQ4 computes an approximation TAU to the smallest eigenvalue
+ using values of d from the previous transform.
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) DOUBLE PRECISION array, dimension ( 4*N )
+ Z holds the qd array.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ NOIN (input) INTEGER
+ The value of N0 at start of EIGTEST.
+
+ DMIN (input) DOUBLE PRECISION
+ Minimum value of d.
+
+ DMIN1 (input) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ).
+
+ DMIN2 (input) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+
+ DN (input) DOUBLE PRECISION
+ d(N)
+
+ DN1 (input) DOUBLE PRECISION
+ d(N-1)
+
+ DN2 (input) DOUBLE PRECISION
+ d(N-2)
+
+ TAU (output) DOUBLE PRECISION
+ This is the shift.
+
+ TTYPE (output) INTEGER
+ Shift type.
+
+ Further Details
+ ===============
+ CNST1 = 9/16
+
+ =====================================================================
+*/
+
+ /* Parameter adjustments */
+ --z__;
+
+ /* Function Body */
+
+/*
+ A negative DMIN forces the shift to take that absolute value
+ TTYPE records the type of shift.
+*/
+
+ if (*dmin__ <= 0.) {
+ *tau = -(*dmin__);
+ *ttype = -1;
+ return 0;
+ }
+
+ nn = ((*n0) << (2)) + *pp;
+ if (*n0in == *n0) {
+
+/* No eigenvalues deflated. */
+
+ if (*dmin__ == *dn || *dmin__ == *dn1) {
+
+ b1 = sqrt(z__[nn - 3]) * sqrt(z__[nn - 5]);
+ b2 = sqrt(z__[nn - 7]) * sqrt(z__[nn - 9]);
+ a2 = z__[nn - 7] + z__[nn - 5];
+
+/* Cases 2 and 3. */
+
+ if ((*dmin__ == *dn && *dmin1 == *dn1)) {
+ gap2 = *dmin2 - a2 - *dmin2 * .25;
+ if ((gap2 > 0. && gap2 > b2)) {
+ gap1 = a2 - *dn - b2 / gap2 * b2;
+ } else {
+ gap1 = a2 - *dn - (b1 + b2);
+ }
+ if ((gap1 > 0. && gap1 > b1)) {
+/* Computing MAX */
+ d__1 = *dn - b1 / gap1 * b1, d__2 = *dmin__ * .5;
+ s = max(d__1,d__2);
+ *ttype = -2;
+ } else {
+ s = 0.;
+ if (*dn > b1) {
+ s = *dn - b1;
+ }
+ if (a2 > b1 + b2) {
+/* Computing MIN */
+ d__1 = s, d__2 = a2 - (b1 + b2);
+ s = min(d__1,d__2);
+ }
+/* Computing MAX */
+ d__1 = s, d__2 = *dmin__ * .333;
+ s = max(d__1,d__2);
+ *ttype = -3;
+ }
+ } else {
+
+/* Case 4. */
+
+ *ttype = -4;
+ s = *dmin__ * .25;
+ if (*dmin__ == *dn) {
+ gam = *dn;
+ a2 = 0.;
+ if (z__[nn - 5] > z__[nn - 7]) {
+ return 0;
+ }
+ b2 = z__[nn - 5] / z__[nn - 7];
+ np = nn - 9;
+ } else {
+ np = nn - ((*pp) << (1));
+ b2 = z__[np - 2];
+ gam = *dn1;
+ if (z__[np - 4] > z__[np - 2]) {
+ return 0;
+ }
+ a2 = z__[np - 4] / z__[np - 2];
+ if (z__[nn - 9] > z__[nn - 11]) {
+ return 0;
+ }
+ b2 = z__[nn - 9] / z__[nn - 11];
+ np = nn - 13;
+ }
+
+/* Approximate contribution to norm squared from I < NN-1. */
+
+ a2 += b2;
+ i__1 = ((*i0) << (2)) - 1 + *pp;
+ for (i4 = np; i4 >= i__1; i4 += -4) {
+ if (b2 == 0.) {
+ goto L20;
+ }
+ b1 = b2;
+ if (z__[i4] > z__[i4 - 2]) {
+ return 0;
+ }
+ b2 *= z__[i4] / z__[i4 - 2];
+ a2 += b2;
+ if (max(b2,b1) * 100. < a2 || .563 < a2) {
+ goto L20;
+ }
+/* L10: */
+ }
+L20:
+ a2 *= 1.05;
+
+/* Rayleigh quotient residual bound. */
+
+ if (a2 < .563) {
+ s = gam * (1. - sqrt(a2)) / (a2 + 1.);
+ }
+ }
+ } else if (*dmin__ == *dn2) {
+
+/* Case 5. */
+
+ *ttype = -5;
+ s = *dmin__ * .25;
+
+/* Compute contribution to norm squared from I > NN-2. */
+
+ np = nn - ((*pp) << (1));
+ b1 = z__[np - 2];
+ b2 = z__[np - 6];
+ gam = *dn2;
+ if (z__[np - 8] > b2 || z__[np - 4] > b1) {
+ return 0;
+ }
+ a2 = z__[np - 8] / b2 * (z__[np - 4] / b1 + 1.);
+
+/* Approximate contribution to norm squared from I < NN-2. */
+
+ if (*n0 - *i0 > 2) {
+ b2 = z__[nn - 13] / z__[nn - 15];
+ a2 += b2;
+ i__1 = ((*i0) << (2)) - 1 + *pp;
+ for (i4 = nn - 17; i4 >= i__1; i4 += -4) {
+ if (b2 == 0.) {
+ goto L40;
+ }
+ b1 = b2;
+ if (z__[i4] > z__[i4 - 2]) {
+ return 0;
+ }
+ b2 *= z__[i4] / z__[i4 - 2];
+ a2 += b2;
+ if (max(b2,b1) * 100. < a2 || .563 < a2) {
+ goto L40;
+ }
+/* L30: */
+ }
+L40:
+ a2 *= 1.05;
+ }
+
+ if (a2 < .563) {
+ s = gam * (1. - sqrt(a2)) / (a2 + 1.);
+ }
+ } else {
+
+/* Case 6, no information to guide us. */
+
+ if (*ttype == -6) {
+ g += (1. - g) * .333;
+ } else if (*ttype == -18) {
+ g = .083250000000000005;
+ } else {
+ g = .25;
+ }
+ s = g * *dmin__;
+ *ttype = -6;
+ }
+
+ } else if (*n0in == *n0 + 1) {
+
+/* One eigenvalue just deflated. Use DMIN1, DN1 for DMIN and DN. */
+
+ if ((*dmin1 == *dn1 && *dmin2 == *dn2)) {
+
+/* Cases 7 and 8. */
+
+ *ttype = -7;
+ s = *dmin1 * .333;
+ if (z__[nn - 5] > z__[nn - 7]) {
+ return 0;
+ }
+ b1 = z__[nn - 5] / z__[nn - 7];
+ b2 = b1;
+ if (b2 == 0.) {
+ goto L60;
+ }
+ i__1 = ((*i0) << (2)) - 1 + *pp;
+ for (i4 = ((*n0) << (2)) - 9 + *pp; i4 >= i__1; i4 += -4) {
+ a2 = b1;
+ if (z__[i4] > z__[i4 - 2]) {
+ return 0;
+ }
+ b1 *= z__[i4] / z__[i4 - 2];
+ b2 += b1;
+ if (max(b1,a2) * 100. < b2) {
+ goto L60;
+ }
+/* L50: */
+ }
+L60:
+ b2 = sqrt(b2 * 1.05);
+/* Computing 2nd power */
+ d__1 = b2;
+ a2 = *dmin1 / (d__1 * d__1 + 1.);
+ gap2 = *dmin2 * .5 - a2;
+ if ((gap2 > 0. && gap2 > b2 * a2)) {
+/* Computing MAX */
+ d__1 = s, d__2 = a2 * (1. - a2 * 1.01 * (b2 / gap2) * b2);
+ s = max(d__1,d__2);
+ } else {
+/* Computing MAX */
+ d__1 = s, d__2 = a2 * (1. - b2 * 1.01);
+ s = max(d__1,d__2);
+ *ttype = -8;
+ }
+ } else {
+
+/* Case 9. */
+
+ s = *dmin1 * .25;
+ if (*dmin1 == *dn1) {
+ s = *dmin1 * .5;
+ }
+ *ttype = -9;
+ }
+
+ } else if (*n0in == *n0 + 2) {
+
+/*
+ Two eigenvalues deflated. Use DMIN2, DN2 for DMIN and DN.
+
+ Cases 10 and 11.
+*/
+
+ if ((*dmin2 == *dn2 && z__[nn - 5] * 2. < z__[nn - 7])) {
+ *ttype = -10;
+ s = *dmin2 * .333;
+ if (z__[nn - 5] > z__[nn - 7]) {
+ return 0;
+ }
+ b1 = z__[nn - 5] / z__[nn - 7];
+ b2 = b1;
+ if (b2 == 0.) {
+ goto L80;
+ }
+ i__1 = ((*i0) << (2)) - 1 + *pp;
+ for (i4 = ((*n0) << (2)) - 9 + *pp; i4 >= i__1; i4 += -4) {
+ if (z__[i4] > z__[i4 - 2]) {
+ return 0;
+ }
+ b1 *= z__[i4] / z__[i4 - 2];
+ b2 += b1;
+ if (b1 * 100. < b2) {
+ goto L80;
+ }
+/* L70: */
+ }
+L80:
+ b2 = sqrt(b2 * 1.05);
+/* Computing 2nd power */
+ d__1 = b2;
+ a2 = *dmin2 / (d__1 * d__1 + 1.);
+ gap2 = z__[nn - 7] + z__[nn - 9] - sqrt(z__[nn - 11]) * sqrt(z__[
+ nn - 9]) - a2;
+ if ((gap2 > 0. && gap2 > b2 * a2)) {
+/* Computing MAX */
+ d__1 = s, d__2 = a2 * (1. - a2 * 1.01 * (b2 / gap2) * b2);
+ s = max(d__1,d__2);
+ } else {
+/* Computing MAX */
+ d__1 = s, d__2 = a2 * (1. - b2 * 1.01);
+ s = max(d__1,d__2);
+ }
+ } else {
+ s = *dmin2 * .25;
+ *ttype = -11;
+ }
+ } else if (*n0in > *n0 + 2) {
+
+/* Case 12, more than two eigenvalues deflated. No information. */
+
+ s = 0.;
+ *ttype = -12;
+ }
+
+ *tau = s;
+ return 0;
+
+/* End of DLASQ4 */
+
+} /* dlasq4_ */
+
+/* Subroutine */ int dlasq5_(integer *i0, integer *n0, doublereal *z__,
+ integer *pp, doublereal *tau, doublereal *dmin__, doublereal *dmin1,
+ doublereal *dmin2, doublereal *dn, doublereal *dnm1, doublereal *dnm2,
+ logical *ieee)
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1, d__2;
+
+ /* Local variables */
+ static doublereal d__;
+ static integer j4, j4p2;
+ static doublereal emin, temp;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ May 17, 2000
+
+
+ Purpose
+ =======
+
+ DLASQ5 computes one dqds transform in ping-pong form, one
+ version for IEEE machines another for non IEEE machines.
+
+ Arguments
+ =========
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) DOUBLE PRECISION array, dimension ( 4*N )
+ Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
+ an extra argument.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ TAU (input) DOUBLE PRECISION
+ This is the shift.
+
+ DMIN (output) DOUBLE PRECISION
+ Minimum value of d.
+
+ DMIN1 (output) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ).
+
+ DMIN2 (output) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+
+ DN (output) DOUBLE PRECISION
+ d(N0), the last value of d.
+
+ DNM1 (output) DOUBLE PRECISION
+ d(N0-1).
+
+ DNM2 (output) DOUBLE PRECISION
+ d(N0-2).
+
+ IEEE (input) LOGICAL
+ Flag for IEEE or non IEEE arithmetic.
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ --z__;
+
+ /* Function Body */
+ if (*n0 - *i0 - 1 <= 0) {
+ return 0;
+ }
+
+ j4 = ((*i0) << (2)) + *pp - 3;
+ emin = z__[j4 + 4];
+ d__ = z__[j4] - *tau;
+ *dmin__ = d__;
+ *dmin1 = -z__[j4];
+
+ if (*ieee) {
+
+/* Code for IEEE arithmetic. */
+
+ if (*pp == 0) {
+ i__1 = (*n0 - 3) << (2);
+ for (j4 = (*i0) << (2); j4 <= i__1; j4 += 4) {
+ z__[j4 - 2] = d__ + z__[j4 - 1];
+ temp = z__[j4 + 1] / z__[j4 - 2];
+ d__ = d__ * temp - *tau;
+ *dmin__ = min(*dmin__,d__);
+ z__[j4] = z__[j4 - 1] * temp;
+/* Computing MIN */
+ d__1 = z__[j4];
+ emin = min(d__1,emin);
+/* L10: */
+ }
+ } else {
+ i__1 = (*n0 - 3) << (2);
+ for (j4 = (*i0) << (2); j4 <= i__1; j4 += 4) {
+ z__[j4 - 3] = d__ + z__[j4];
+ temp = z__[j4 + 2] / z__[j4 - 3];
+ d__ = d__ * temp - *tau;
+ *dmin__ = min(*dmin__,d__);
+ z__[j4 - 1] = z__[j4] * temp;
+/* Computing MIN */
+ d__1 = z__[j4 - 1];
+ emin = min(d__1,emin);
+/* L20: */
+ }
+ }
+
+/* Unroll last two steps. */
+
+ *dnm2 = d__;
+ *dmin2 = *dmin__;
+ j4 = ((*n0 - 2) << (2)) - *pp;
+ j4p2 = j4 + ((*pp) << (1)) - 1;
+ z__[j4 - 2] = *dnm2 + z__[j4p2];
+ z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
+ *dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]) - *tau;
+ *dmin__ = min(*dmin__,*dnm1);
+
+ *dmin1 = *dmin__;
+ j4 += 4;
+ j4p2 = j4 + ((*pp) << (1)) - 1;
+ z__[j4 - 2] = *dnm1 + z__[j4p2];
+ z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
+ *dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]) - *tau;
+ *dmin__ = min(*dmin__,*dn);
+
+ } else {
+
+/* Code for non IEEE arithmetic. */
+
+ if (*pp == 0) {
+ i__1 = (*n0 - 3) << (2);
+ for (j4 = (*i0) << (2); j4 <= i__1; j4 += 4) {
+ z__[j4 - 2] = d__ + z__[j4 - 1];
+ if (d__ < 0.) {
+ return 0;
+ } else {
+ z__[j4] = z__[j4 + 1] * (z__[j4 - 1] / z__[j4 - 2]);
+ d__ = z__[j4 + 1] * (d__ / z__[j4 - 2]) - *tau;
+ }
+ *dmin__ = min(*dmin__,d__);
+/* Computing MIN */
+ d__1 = emin, d__2 = z__[j4];
+ emin = min(d__1,d__2);
+/* L30: */
+ }
+ } else {
+ i__1 = (*n0 - 3) << (2);
+ for (j4 = (*i0) << (2); j4 <= i__1; j4 += 4) {
+ z__[j4 - 3] = d__ + z__[j4];
+ if (d__ < 0.) {
+ return 0;
+ } else {
+ z__[j4 - 1] = z__[j4 + 2] * (z__[j4] / z__[j4 - 3]);
+ d__ = z__[j4 + 2] * (d__ / z__[j4 - 3]) - *tau;
+ }
+ *dmin__ = min(*dmin__,d__);
+/* Computing MIN */
+ d__1 = emin, d__2 = z__[j4 - 1];
+ emin = min(d__1,d__2);
+/* L40: */
+ }
+ }
+
+/* Unroll last two steps. */
+
+ *dnm2 = d__;
+ *dmin2 = *dmin__;
+ j4 = ((*n0 - 2) << (2)) - *pp;
+ j4p2 = j4 + ((*pp) << (1)) - 1;
+ z__[j4 - 2] = *dnm2 + z__[j4p2];
+ if (*dnm2 < 0.) {
+ return 0;
+ } else {
+ z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
+ *dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]) - *tau;
+ }
+ *dmin__ = min(*dmin__,*dnm1);
+
+ *dmin1 = *dmin__;
+ j4 += 4;
+ j4p2 = j4 + ((*pp) << (1)) - 1;
+ z__[j4 - 2] = *dnm1 + z__[j4p2];
+ if (*dnm1 < 0.) {
+ return 0;
+ } else {
+ z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
+ *dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]) - *tau;
+ }
+ *dmin__ = min(*dmin__,*dn);
+
+ }
+
+ z__[j4 + 2] = *dn;
+ z__[((*n0) << (2)) - *pp] = emin;
+ return 0;
+
+/* End of DLASQ5 */
+
+} /* dlasq5_ */
+
+/* Subroutine */ int dlasq6_(integer *i0, integer *n0, doublereal *z__,
+ integer *pp, doublereal *dmin__, doublereal *dmin1, doublereal *dmin2,
+ doublereal *dn, doublereal *dnm1, doublereal *dnm2)
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1, d__2;
+
+ /* Local variables */
+ static doublereal d__;
+ static integer j4, j4p2;
+ static doublereal emin, temp;
+
+ static doublereal safmin;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1999
+
+
+ Purpose
+ =======
+
+ DLASQ6 computes one dqd (shift equal to zero) transform in
+ ping-pong form, with protection against underflow and overflow.
+
+ Arguments
+ =========
+
+ I0 (input) INTEGER
+ First index.
+
+ N0 (input) INTEGER
+ Last index.
+
+ Z (input) DOUBLE PRECISION array, dimension ( 4*N )
+ Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
+ an extra argument.
+
+ PP (input) INTEGER
+ PP=0 for ping, PP=1 for pong.
+
+ DMIN (output) DOUBLE PRECISION
+ Minimum value of d.
+
+ DMIN1 (output) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ).
+
+ DMIN2 (output) DOUBLE PRECISION
+ Minimum value of d, excluding D( N0 ) and D( N0-1 ).
+
+ DN (output) DOUBLE PRECISION
+ d(N0), the last value of d.
+
+ DNM1 (output) DOUBLE PRECISION
+ d(N0-1).
+
+ DNM2 (output) DOUBLE PRECISION
+ d(N0-2).
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ --z__;
+
+ /* Function Body */
+ if (*n0 - *i0 - 1 <= 0) {
+ return 0;
+ }
+
+ safmin = SAFEMINIMUM;
+ j4 = ((*i0) << (2)) + *pp - 3;
+ emin = z__[j4 + 4];
+ d__ = z__[j4];
+ *dmin__ = d__;
+
+ if (*pp == 0) {
+ i__1 = (*n0 - 3) << (2);
+ for (j4 = (*i0) << (2); j4 <= i__1; j4 += 4) {
+ z__[j4 - 2] = d__ + z__[j4 - 1];
+ if (z__[j4 - 2] == 0.) {
+ z__[j4] = 0.;
+ d__ = z__[j4 + 1];
+ *dmin__ = d__;
+ emin = 0.;
+ } else if ((safmin * z__[j4 + 1] < z__[j4 - 2] && safmin * z__[j4
+ - 2] < z__[j4 + 1])) {
+ temp = z__[j4 + 1] / z__[j4 - 2];
+ z__[j4] = z__[j4 - 1] * temp;
+ d__ *= temp;
+ } else {
+ z__[j4] = z__[j4 + 1] * (z__[j4 - 1] / z__[j4 - 2]);
+ d__ = z__[j4 + 1] * (d__ / z__[j4 - 2]);
+ }
+ *dmin__ = min(*dmin__,d__);
+/* Computing MIN */
+ d__1 = emin, d__2 = z__[j4];
+ emin = min(d__1,d__2);
+/* L10: */
+ }
+ } else {
+ i__1 = (*n0 - 3) << (2);
+ for (j4 = (*i0) << (2); j4 <= i__1; j4 += 4) {
+ z__[j4 - 3] = d__ + z__[j4];
+ if (z__[j4 - 3] == 0.) {
+ z__[j4 - 1] = 0.;
+ d__ = z__[j4 + 2];
+ *dmin__ = d__;
+ emin = 0.;
+ } else if ((safmin * z__[j4 + 2] < z__[j4 - 3] && safmin * z__[j4
+ - 3] < z__[j4 + 2])) {
+ temp = z__[j4 + 2] / z__[j4 - 3];
+ z__[j4 - 1] = z__[j4] * temp;
+ d__ *= temp;
+ } else {
+ z__[j4 - 1] = z__[j4 + 2] * (z__[j4] / z__[j4 - 3]);
+ d__ = z__[j4 + 2] * (d__ / z__[j4 - 3]);
+ }
+ *dmin__ = min(*dmin__,d__);
+/* Computing MIN */
+ d__1 = emin, d__2 = z__[j4 - 1];
+ emin = min(d__1,d__2);
+/* L20: */
+ }
+ }
+
+/* Unroll last two steps. */
+
+ *dnm2 = d__;
+ *dmin2 = *dmin__;
+ j4 = ((*n0 - 2) << (2)) - *pp;
+ j4p2 = j4 + ((*pp) << (1)) - 1;
+ z__[j4 - 2] = *dnm2 + z__[j4p2];
+ if (z__[j4 - 2] == 0.) {
+ z__[j4] = 0.;
+ *dnm1 = z__[j4p2 + 2];
+ *dmin__ = *dnm1;
+ emin = 0.;
+ } else if ((safmin * z__[j4p2 + 2] < z__[j4 - 2] && safmin * z__[j4 - 2] <
+ z__[j4p2 + 2])) {
+ temp = z__[j4p2 + 2] / z__[j4 - 2];
+ z__[j4] = z__[j4p2] * temp;
+ *dnm1 = *dnm2 * temp;
+ } else {
+ z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
+ *dnm1 = z__[j4p2 + 2] * (*dnm2 / z__[j4 - 2]);
+ }
+ *dmin__ = min(*dmin__,*dnm1);
+
+ *dmin1 = *dmin__;
+ j4 += 4;
+ j4p2 = j4 + ((*pp) << (1)) - 1;
+ z__[j4 - 2] = *dnm1 + z__[j4p2];
+ if (z__[j4 - 2] == 0.) {
+ z__[j4] = 0.;
+ *dn = z__[j4p2 + 2];
+ *dmin__ = *dn;
+ emin = 0.;
+ } else if ((safmin * z__[j4p2 + 2] < z__[j4 - 2] && safmin * z__[j4 - 2] <
+ z__[j4p2 + 2])) {
+ temp = z__[j4p2 + 2] / z__[j4 - 2];
+ z__[j4] = z__[j4p2] * temp;
+ *dn = *dnm1 * temp;
+ } else {
+ z__[j4] = z__[j4p2 + 2] * (z__[j4p2] / z__[j4 - 2]);
+ *dn = z__[j4p2 + 2] * (*dnm1 / z__[j4 - 2]);
+ }
+ *dmin__ = min(*dmin__,*dn);
+
+ z__[j4 + 2] = *dn;
+ z__[((*n0) << (2)) - *pp] = emin;
+ return 0;
+
+/* End of DLASQ6 */
+
+} /* dlasq6_ */
+
+/* Subroutine */ int dlasr_(char *side, char *pivot, char *direct, integer *m,
+ integer *n, doublereal *c__, doublereal *s, doublereal *a, integer *
+ lda)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+
+ /* Local variables */
+ static integer i__, j, info;
+ static doublereal temp;
+ extern logical lsame_(char *, char *);
+ static doublereal ctemp, stemp;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLASR performs the transformation
+
+ A := P*A, when SIDE = 'L' or 'l' ( Left-hand side )
+
+ A := A*P', when SIDE = 'R' or 'r' ( Right-hand side )
+
+ where A is an m by n real matrix and P is an orthogonal matrix,
+ consisting of a sequence of plane rotations determined by the
+ parameters PIVOT and DIRECT as follows ( z = m when SIDE = 'L' or 'l'
+ and z = n when SIDE = 'R' or 'r' ):
+
+ When DIRECT = 'F' or 'f' ( Forward sequence ) then
+
+ P = P( z - 1 )*...*P( 2 )*P( 1 ),
+
+ and when DIRECT = 'B' or 'b' ( Backward sequence ) then
+
+ P = P( 1 )*P( 2 )*...*P( z - 1 ),
+
+ where P( k ) is a plane rotation matrix for the following planes:
+
+ when PIVOT = 'V' or 'v' ( Variable pivot ),
+ the plane ( k, k + 1 )
+
+ when PIVOT = 'T' or 't' ( Top pivot ),
+ the plane ( 1, k + 1 )
+
+ when PIVOT = 'B' or 'b' ( Bottom pivot ),
+ the plane ( k, z )
+
+ c( k ) and s( k ) must contain the cosine and sine that define the
+ matrix P( k ). The two by two plane rotation part of the matrix
+ P( k ), R( k ), is assumed to be of the form
+
+ R( k ) = ( c( k ) s( k ) ).
+ ( -s( k ) c( k ) )
+
+ This version vectorises across rows of the array A when SIDE = 'L'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ Specifies whether the plane rotation matrix P is applied to
+ A on the left or the right.
+ = 'L': Left, compute A := P*A
+ = 'R': Right, compute A:= A*P'
+
+ DIRECT (input) CHARACTER*1
+ Specifies whether P is a forward or backward sequence of
+ plane rotations.
+ = 'F': Forward, P = P( z - 1 )*...*P( 2 )*P( 1 )
+ = 'B': Backward, P = P( 1 )*P( 2 )*...*P( z - 1 )
+
+ PIVOT (input) CHARACTER*1
+ Specifies the plane for which P(k) is a plane rotation
+ matrix.
+ = 'V': Variable pivot, the plane (k,k+1)
+ = 'T': Top pivot, the plane (1,k+1)
+ = 'B': Bottom pivot, the plane (k,z)
+
+ M (input) INTEGER
+ The number of rows of the matrix A. If m <= 1, an immediate
+ return is effected.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. If n <= 1, an
+ immediate return is effected.
+
+ C, S (input) DOUBLE PRECISION arrays, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ c(k) and s(k) contain the cosine and sine that define the
+ matrix P(k). The two by two plane rotation part of the
+ matrix P(k), R(k), is assumed to be of the form
+ R( k ) = ( c( k ) s( k ) ).
+ ( -s( k ) c( k ) )
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ The m by n matrix A. On exit, A is overwritten by P*A if
+ SIDE = 'R' or by A*P' if SIDE = 'L'.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ =====================================================================
+
+
+ Test the input parameters
+*/
+
+ /* Parameter adjustments */
+ --c__;
+ --s;
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+
+ /* Function Body */
+ info = 0;
+ if (! (lsame_(side, "L") || lsame_(side, "R"))) {
+ info = 1;
+ } else if (! (lsame_(pivot, "V") || lsame_(pivot,
+ "T") || lsame_(pivot, "B"))) {
+ info = 2;
+ } else if (! (lsame_(direct, "F") || lsame_(direct,
+ "B"))) {
+ info = 3;
+ } else if (*m < 0) {
+ info = 4;
+ } else if (*n < 0) {
+ info = 5;
+ } else if (*lda < max(1,*m)) {
+ info = 9;
+ }
+ if (info != 0) {
+ xerbla_("DLASR ", &info);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0) {
+ return 0;
+ }
+ if (lsame_(side, "L")) {
+
+/* Form P * A */
+
+ if (lsame_(pivot, "V")) {
+ if (lsame_(direct, "F")) {
+ i__1 = *m - 1;
+ for (j = 1; j <= i__1; ++j) {
+ ctemp = c__[j];
+ stemp = s[j];
+ if (ctemp != 1. || stemp != 0.) {
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp = a[j + 1 + i__ * a_dim1];
+ a[j + 1 + i__ * a_dim1] = ctemp * temp - stemp *
+ a[j + i__ * a_dim1];
+ a[j + i__ * a_dim1] = stemp * temp + ctemp * a[j
+ + i__ * a_dim1];
+/* L10: */
+ }
+ }
+/* L20: */
+ }
+ } else if (lsame_(direct, "B")) {
+ for (j = *m - 1; j >= 1; --j) {
+ ctemp = c__[j];
+ stemp = s[j];
+ if (ctemp != 1. || stemp != 0.) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ temp = a[j + 1 + i__ * a_dim1];
+ a[j + 1 + i__ * a_dim1] = ctemp * temp - stemp *
+ a[j + i__ * a_dim1];
+ a[j + i__ * a_dim1] = stemp * temp + ctemp * a[j
+ + i__ * a_dim1];
+/* L30: */
+ }
+ }
+/* L40: */
+ }
+ }
+ } else if (lsame_(pivot, "T")) {
+ if (lsame_(direct, "F")) {
+ i__1 = *m;
+ for (j = 2; j <= i__1; ++j) {
+ ctemp = c__[j - 1];
+ stemp = s[j - 1];
+ if (ctemp != 1. || stemp != 0.) {
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp = a[j + i__ * a_dim1];
+ a[j + i__ * a_dim1] = ctemp * temp - stemp * a[
+ i__ * a_dim1 + 1];
+ a[i__ * a_dim1 + 1] = stemp * temp + ctemp * a[
+ i__ * a_dim1 + 1];
+/* L50: */
+ }
+ }
+/* L60: */
+ }
+ } else if (lsame_(direct, "B")) {
+ for (j = *m; j >= 2; --j) {
+ ctemp = c__[j - 1];
+ stemp = s[j - 1];
+ if (ctemp != 1. || stemp != 0.) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ temp = a[j + i__ * a_dim1];
+ a[j + i__ * a_dim1] = ctemp * temp - stemp * a[
+ i__ * a_dim1 + 1];
+ a[i__ * a_dim1 + 1] = stemp * temp + ctemp * a[
+ i__ * a_dim1 + 1];
+/* L70: */
+ }
+ }
+/* L80: */
+ }
+ }
+ } else if (lsame_(pivot, "B")) {
+ if (lsame_(direct, "F")) {
+ i__1 = *m - 1;
+ for (j = 1; j <= i__1; ++j) {
+ ctemp = c__[j];
+ stemp = s[j];
+ if (ctemp != 1. || stemp != 0.) {
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp = a[j + i__ * a_dim1];
+ a[j + i__ * a_dim1] = stemp * a[*m + i__ * a_dim1]
+ + ctemp * temp;
+ a[*m + i__ * a_dim1] = ctemp * a[*m + i__ *
+ a_dim1] - stemp * temp;
+/* L90: */
+ }
+ }
+/* L100: */
+ }
+ } else if (lsame_(direct, "B")) {
+ for (j = *m - 1; j >= 1; --j) {
+ ctemp = c__[j];
+ stemp = s[j];
+ if (ctemp != 1. || stemp != 0.) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ temp = a[j + i__ * a_dim1];
+ a[j + i__ * a_dim1] = stemp * a[*m + i__ * a_dim1]
+ + ctemp * temp;
+ a[*m + i__ * a_dim1] = ctemp * a[*m + i__ *
+ a_dim1] - stemp * temp;
+/* L110: */
+ }
+ }
+/* L120: */
+ }
+ }
+ }
+ } else if (lsame_(side, "R")) {
+
+/* Form A * P' */
+
+ if (lsame_(pivot, "V")) {
+ if (lsame_(direct, "F")) {
+ i__1 = *n - 1;
+ for (j = 1; j <= i__1; ++j) {
+ ctemp = c__[j];
+ stemp = s[j];
+ if (ctemp != 1. || stemp != 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp = a[i__ + (j + 1) * a_dim1];
+ a[i__ + (j + 1) * a_dim1] = ctemp * temp - stemp *
+ a[i__ + j * a_dim1];
+ a[i__ + j * a_dim1] = stemp * temp + ctemp * a[
+ i__ + j * a_dim1];
+/* L130: */
+ }
+ }
+/* L140: */
+ }
+ } else if (lsame_(direct, "B")) {
+ for (j = *n - 1; j >= 1; --j) {
+ ctemp = c__[j];
+ stemp = s[j];
+ if (ctemp != 1. || stemp != 0.) {
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ temp = a[i__ + (j + 1) * a_dim1];
+ a[i__ + (j + 1) * a_dim1] = ctemp * temp - stemp *
+ a[i__ + j * a_dim1];
+ a[i__ + j * a_dim1] = stemp * temp + ctemp * a[
+ i__ + j * a_dim1];
+/* L150: */
+ }
+ }
+/* L160: */
+ }
+ }
+ } else if (lsame_(pivot, "T")) {
+ if (lsame_(direct, "F")) {
+ i__1 = *n;
+ for (j = 2; j <= i__1; ++j) {
+ ctemp = c__[j - 1];
+ stemp = s[j - 1];
+ if (ctemp != 1. || stemp != 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp = a[i__ + j * a_dim1];
+ a[i__ + j * a_dim1] = ctemp * temp - stemp * a[
+ i__ + a_dim1];
+ a[i__ + a_dim1] = stemp * temp + ctemp * a[i__ +
+ a_dim1];
+/* L170: */
+ }
+ }
+/* L180: */
+ }
+ } else if (lsame_(direct, "B")) {
+ for (j = *n; j >= 2; --j) {
+ ctemp = c__[j - 1];
+ stemp = s[j - 1];
+ if (ctemp != 1. || stemp != 0.) {
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ temp = a[i__ + j * a_dim1];
+ a[i__ + j * a_dim1] = ctemp * temp - stemp * a[
+ i__ + a_dim1];
+ a[i__ + a_dim1] = stemp * temp + ctemp * a[i__ +
+ a_dim1];
+/* L190: */
+ }
+ }
+/* L200: */
+ }
+ }
+ } else if (lsame_(pivot, "B")) {
+ if (lsame_(direct, "F")) {
+ i__1 = *n - 1;
+ for (j = 1; j <= i__1; ++j) {
+ ctemp = c__[j];
+ stemp = s[j];
+ if (ctemp != 1. || stemp != 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp = a[i__ + j * a_dim1];
+ a[i__ + j * a_dim1] = stemp * a[i__ + *n * a_dim1]
+ + ctemp * temp;
+ a[i__ + *n * a_dim1] = ctemp * a[i__ + *n *
+ a_dim1] - stemp * temp;
+/* L210: */
+ }
+ }
+/* L220: */
+ }
+ } else if (lsame_(direct, "B")) {
+ for (j = *n - 1; j >= 1; --j) {
+ ctemp = c__[j];
+ stemp = s[j];
+ if (ctemp != 1. || stemp != 0.) {
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ temp = a[i__ + j * a_dim1];
+ a[i__ + j * a_dim1] = stemp * a[i__ + *n * a_dim1]
+ + ctemp * temp;
+ a[i__ + *n * a_dim1] = ctemp * a[i__ + *n *
+ a_dim1] - stemp * temp;
+/* L230: */
+ }
+ }
+/* L240: */
+ }
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DLASR */
+
+} /* dlasr_ */
+
+/* Subroutine */ int dlasrt_(char *id, integer *n, doublereal *d__, integer *
+ info)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+
+ /* Local variables */
+ static integer i__, j;
+ static doublereal d1, d2, d3;
+ static integer dir;
+ static doublereal tmp;
+ static integer endd;
+ extern logical lsame_(char *, char *);
+ static integer stack[64] /* was [2][32] */;
+ static doublereal dmnmx;
+ static integer start;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static integer stkpnt;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ Sort the numbers in D in increasing order (if ID = 'I') or
+ in decreasing order (if ID = 'D' ).
+
+ Use Quick Sort, reverting to Insertion sort on arrays of
+ size <= 20. Dimension of STACK limits N to about 2**32.
+
+ Arguments
+ =========
+
+ ID (input) CHARACTER*1
+ = 'I': sort D in increasing order;
+ = 'D': sort D in decreasing order.
+
+ N (input) INTEGER
+ The length of the array D.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the array to be sorted.
+ On exit, D has been sorted into increasing order
+ (D(1) <= ... <= D(N) ) or into decreasing order
+ (D(1) >= ... >= D(N) ), depending on ID.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input paramters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+
+ /* Function Body */
+ *info = 0;
+ dir = -1;
+ if (lsame_(id, "D")) {
+ dir = 0;
+ } else if (lsame_(id, "I")) {
+ dir = 1;
+ }
+ if (dir == -1) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLASRT", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n <= 1) {
+ return 0;
+ }
+
+ stkpnt = 1;
+ stack[0] = 1;
+ stack[1] = *n;
+L10:
+ start = stack[((stkpnt) << (1)) - 2];
+ endd = stack[((stkpnt) << (1)) - 1];
+ --stkpnt;
+ if ((endd - start <= 20 && endd - start > 0)) {
+
+/* Do Insertion sort on D( START:ENDD ) */
+
+ if (dir == 0) {
+
+/* Sort into decreasing order */
+
+ i__1 = endd;
+ for (i__ = start + 1; i__ <= i__1; ++i__) {
+ i__2 = start + 1;
+ for (j = i__; j >= i__2; --j) {
+ if (d__[j] > d__[j - 1]) {
+ dmnmx = d__[j];
+ d__[j] = d__[j - 1];
+ d__[j - 1] = dmnmx;
+ } else {
+ goto L30;
+ }
+/* L20: */
+ }
+L30:
+ ;
+ }
+
+ } else {
+
+/* Sort into increasing order */
+
+ i__1 = endd;
+ for (i__ = start + 1; i__ <= i__1; ++i__) {
+ i__2 = start + 1;
+ for (j = i__; j >= i__2; --j) {
+ if (d__[j] < d__[j - 1]) {
+ dmnmx = d__[j];
+ d__[j] = d__[j - 1];
+ d__[j - 1] = dmnmx;
+ } else {
+ goto L50;
+ }
+/* L40: */
+ }
+L50:
+ ;
+ }
+
+ }
+
+ } else if (endd - start > 20) {
+
+/*
+ Partition D( START:ENDD ) and stack parts, largest one first
+
+ Choose partition entry as median of 3
+*/
+
+ d1 = d__[start];
+ d2 = d__[endd];
+ i__ = (start + endd) / 2;
+ d3 = d__[i__];
+ if (d1 < d2) {
+ if (d3 < d1) {
+ dmnmx = d1;
+ } else if (d3 < d2) {
+ dmnmx = d3;
+ } else {
+ dmnmx = d2;
+ }
+ } else {
+ if (d3 < d2) {
+ dmnmx = d2;
+ } else if (d3 < d1) {
+ dmnmx = d3;
+ } else {
+ dmnmx = d1;
+ }
+ }
+
+ if (dir == 0) {
+
+/* Sort into decreasing order */
+
+ i__ = start - 1;
+ j = endd + 1;
+L60:
+L70:
+ --j;
+ if (d__[j] < dmnmx) {
+ goto L70;
+ }
+L80:
+ ++i__;
+ if (d__[i__] > dmnmx) {
+ goto L80;
+ }
+ if (i__ < j) {
+ tmp = d__[i__];
+ d__[i__] = d__[j];
+ d__[j] = tmp;
+ goto L60;
+ }
+ if (j - start > endd - j - 1) {
+ ++stkpnt;
+ stack[((stkpnt) << (1)) - 2] = start;
+ stack[((stkpnt) << (1)) - 1] = j;
+ ++stkpnt;
+ stack[((stkpnt) << (1)) - 2] = j + 1;
+ stack[((stkpnt) << (1)) - 1] = endd;
+ } else {
+ ++stkpnt;
+ stack[((stkpnt) << (1)) - 2] = j + 1;
+ stack[((stkpnt) << (1)) - 1] = endd;
+ ++stkpnt;
+ stack[((stkpnt) << (1)) - 2] = start;
+ stack[((stkpnt) << (1)) - 1] = j;
+ }
+ } else {
+
+/* Sort into increasing order */
+
+ i__ = start - 1;
+ j = endd + 1;
+L90:
+L100:
+ --j;
+ if (d__[j] > dmnmx) {
+ goto L100;
+ }
+L110:
+ ++i__;
+ if (d__[i__] < dmnmx) {
+ goto L110;
+ }
+ if (i__ < j) {
+ tmp = d__[i__];
+ d__[i__] = d__[j];
+ d__[j] = tmp;
+ goto L90;
+ }
+ if (j - start > endd - j - 1) {
+ ++stkpnt;
+ stack[((stkpnt) << (1)) - 2] = start;
+ stack[((stkpnt) << (1)) - 1] = j;
+ ++stkpnt;
+ stack[((stkpnt) << (1)) - 2] = j + 1;
+ stack[((stkpnt) << (1)) - 1] = endd;
+ } else {
+ ++stkpnt;
+ stack[((stkpnt) << (1)) - 2] = j + 1;
+ stack[((stkpnt) << (1)) - 1] = endd;
+ ++stkpnt;
+ stack[((stkpnt) << (1)) - 2] = start;
+ stack[((stkpnt) << (1)) - 1] = j;
+ }
+ }
+ }
+ if (stkpnt > 0) {
+ goto L10;
+ }
+ return 0;
+
+/* End of DLASRT */
+
+} /* dlasrt_ */
+
+/* Subroutine */ int dlassq_(integer *n, doublereal *x, integer *incx,
+ doublereal *scale, doublereal *sumsq)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer ix;
+ static doublereal absxi;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DLASSQ returns the values scl and smsq such that
+
+ ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
+
+ where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is
+ assumed to be non-negative and scl returns the value
+
+ scl = max( scale, abs( x( i ) ) ).
+
+ scale and sumsq must be supplied in SCALE and SUMSQ and
+ scl and smsq are overwritten on SCALE and SUMSQ respectively.
+
+ The routine makes only one pass through the vector x.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of elements to be used from the vector X.
+
+ X (input) DOUBLE PRECISION array, dimension (N)
+ The vector for which a scaled sum of squares is computed.
+ x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
+
+ INCX (input) INTEGER
+ The increment between successive values of the vector X.
+ INCX > 0.
+
+ SCALE (input/output) DOUBLE PRECISION
+ On entry, the value scale in the equation above.
+ On exit, SCALE is overwritten with scl , the scaling factor
+ for the sum of squares.
+
+ SUMSQ (input/output) DOUBLE PRECISION
+ On entry, the value sumsq in the equation above.
+ On exit, SUMSQ is overwritten with smsq , the basic sum of
+ squares from which scl has been factored out.
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ if (*n > 0) {
+ i__1 = (*n - 1) * *incx + 1;
+ i__2 = *incx;
+ for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {
+ if (x[ix] != 0.) {
+ absxi = (d__1 = x[ix], abs(d__1));
+ if (*scale < absxi) {
+/* Computing 2nd power */
+ d__1 = *scale / absxi;
+ *sumsq = *sumsq * (d__1 * d__1) + 1;
+ *scale = absxi;
+ } else {
+/* Computing 2nd power */
+ d__1 = absxi / *scale;
+ *sumsq += d__1 * d__1;
+ }
+ }
+/* L10: */
+ }
+ }
+ return 0;
+
+/* End of DLASSQ */
+
+} /* dlassq_ */
+
+/* Subroutine */ int dlasv2_(doublereal *f, doublereal *g, doublereal *h__,
+ doublereal *ssmin, doublereal *ssmax, doublereal *snr, doublereal *
+ csr, doublereal *snl, doublereal *csl)
+{
+ /* System generated locals */
+ doublereal d__1;
+
+ /* Builtin functions */
+ double sqrt(doublereal), d_sign(doublereal *, doublereal *);
+
+ /* Local variables */
+ static doublereal a, d__, l, m, r__, s, t, fa, ga, ha, ft, gt, ht, mm, tt,
+ clt, crt, slt, srt;
+ static integer pmax;
+ static doublereal temp;
+ static logical swap;
+ static doublereal tsign;
+
+ static logical gasmal;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLASV2 computes the singular value decomposition of a 2-by-2
+ triangular matrix
+ [ F G ]
+ [ 0 H ].
+ On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the
+ smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and
+ right singular vectors for abs(SSMAX), giving the decomposition
+
+ [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ]
+ [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ].
+
+ Arguments
+ =========
+
+ F (input) DOUBLE PRECISION
+ The (1,1) element of the 2-by-2 matrix.
+
+ G (input) DOUBLE PRECISION
+ The (1,2) element of the 2-by-2 matrix.
+
+ H (input) DOUBLE PRECISION
+ The (2,2) element of the 2-by-2 matrix.
+
+ SSMIN (output) DOUBLE PRECISION
+ abs(SSMIN) is the smaller singular value.
+
+ SSMAX (output) DOUBLE PRECISION
+ abs(SSMAX) is the larger singular value.
+
+ SNL (output) DOUBLE PRECISION
+ CSL (output) DOUBLE PRECISION
+ The vector (CSL, SNL) is a unit left singular vector for the
+ singular value abs(SSMAX).
+
+ SNR (output) DOUBLE PRECISION
+ CSR (output) DOUBLE PRECISION
+ The vector (CSR, SNR) is a unit right singular vector for the
+ singular value abs(SSMAX).
+
+ Further Details
+ ===============
+
+ Any input parameter may be aliased with any output parameter.
+
+ Barring over/underflow and assuming a guard digit in subtraction, all
+ output quantities are correct to within a few units in the last
+ place (ulps).
+
+ In IEEE arithmetic, the code works correctly if one matrix element is
+ infinite.
+
+ Overflow will not occur unless the largest singular value itself
+ overflows or is within a few ulps of overflow. (On machines with
+ partial overflow, like the Cray, overflow may occur if the largest
+ singular value is within a factor of 2 of overflow.)
+
+ Underflow is harmless if underflow is gradual. Otherwise, results
+ may correspond to a matrix modified by perturbations of size near
+ the underflow threshold.
+
+ =====================================================================
+*/
+
+
+ ft = *f;
+ fa = abs(ft);
+ ht = *h__;
+ ha = abs(*h__);
+
+/*
+ PMAX points to the maximum absolute element of matrix
+ PMAX = 1 if F largest in absolute values
+ PMAX = 2 if G largest in absolute values
+ PMAX = 3 if H largest in absolute values
+*/
+
+ pmax = 1;
+ swap = ha > fa;
+ if (swap) {
+ pmax = 3;
+ temp = ft;
+ ft = ht;
+ ht = temp;
+ temp = fa;
+ fa = ha;
+ ha = temp;
+
+/* Now FA .ge. HA */
+
+ }
+ gt = *g;
+ ga = abs(gt);
+ if (ga == 0.) {
+
+/* Diagonal matrix */
+
+ *ssmin = ha;
+ *ssmax = fa;
+ clt = 1.;
+ crt = 1.;
+ slt = 0.;
+ srt = 0.;
+ } else {
+ gasmal = TRUE_;
+ if (ga > fa) {
+ pmax = 2;
+ if (fa / ga < EPSILON) {
+
+/* Case of very large GA */
+
+ gasmal = FALSE_;
+ *ssmax = ga;
+ if (ha > 1.) {
+ *ssmin = fa / (ga / ha);
+ } else {
+ *ssmin = fa / ga * ha;
+ }
+ clt = 1.;
+ slt = ht / gt;
+ srt = 1.;
+ crt = ft / gt;
+ }
+ }
+ if (gasmal) {
+
+/* Normal case */
+
+ d__ = fa - ha;
+ if (d__ == fa) {
+
+/* Copes with infinite F or H */
+
+ l = 1.;
+ } else {
+ l = d__ / fa;
+ }
+
+/* Note that 0 .le. L .le. 1 */
+
+ m = gt / ft;
+
+/* Note that abs(M) .le. 1/macheps */
+
+ t = 2. - l;
+
+/* Note that T .ge. 1 */
+
+ mm = m * m;
+ tt = t * t;
+ s = sqrt(tt + mm);
+
+/* Note that 1 .le. S .le. 1 + 1/macheps */
+
+ if (l == 0.) {
+ r__ = abs(m);
+ } else {
+ r__ = sqrt(l * l + mm);
+ }
+
+/* Note that 0 .le. R .le. 1 + 1/macheps */
+
+ a = (s + r__) * .5;
+
+/* Note that 1 .le. A .le. 1 + abs(M) */
+
+ *ssmin = ha / a;
+ *ssmax = fa * a;
+ if (mm == 0.) {
+
+/* Note that M is very tiny */
+
+ if (l == 0.) {
+ t = d_sign(&c_b2804, &ft) * d_sign(&c_b15, &gt);
+ } else {
+ t = gt / d_sign(&d__, &ft) + m / t;
+ }
+ } else {
+ t = (m / (s + t) + m / (r__ + l)) * (a + 1.);
+ }
+ l = sqrt(t * t + 4.);
+ crt = 2. / l;
+ srt = t / l;
+ clt = (crt + srt * m) / a;
+ slt = ht / ft * srt / a;
+ }
+ }
+ if (swap) {
+ *csl = srt;
+ *snl = crt;
+ *csr = slt;
+ *snr = clt;
+ } else {
+ *csl = clt;
+ *snl = slt;
+ *csr = crt;
+ *snr = srt;
+ }
+
+/* Correct signs of SSMAX and SSMIN */
+
+ if (pmax == 1) {
+ tsign = d_sign(&c_b15, csr) * d_sign(&c_b15, csl) * d_sign(&c_b15, f);
+ }
+ if (pmax == 2) {
+ tsign = d_sign(&c_b15, snr) * d_sign(&c_b15, csl) * d_sign(&c_b15, g);
+ }
+ if (pmax == 3) {
+ tsign = d_sign(&c_b15, snr) * d_sign(&c_b15, snl) * d_sign(&c_b15,
+ h__);
+ }
+ *ssmax = d_sign(ssmax, &tsign);
+ d__1 = tsign * d_sign(&c_b15, f) * d_sign(&c_b15, h__);
+ *ssmin = d_sign(ssmin, &d__1);
+ return 0;
+
+/* End of DLASV2 */
+
+} /* dlasv2_ */
+
+/* Subroutine */ int dlaswp_(integer *n, doublereal *a, integer *lda, integer
+ *k1, integer *k2, integer *ipiv, integer *incx)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+
+ /* Local variables */
+ static integer i__, j, k, i1, i2, n32, ip, ix, ix0, inc;
+ static doublereal temp;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DLASWP performs a series of row interchanges on the matrix A.
+ One row interchange is initiated for each of rows K1 through K2 of A.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of columns of the matrix A.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the matrix of column dimension N to which the row
+ interchanges will be applied.
+ On exit, the permuted matrix.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+
+ K1 (input) INTEGER
+ The first element of IPIV for which a row interchange will
+ be done.
+
+ K2 (input) INTEGER
+ The last element of IPIV for which a row interchange will
+ be done.
+
+ IPIV (input) INTEGER array, dimension (M*abs(INCX))
+ The vector of pivot indices. Only the elements in positions
+ K1 through K2 of IPIV are accessed.
+ IPIV(K) = L implies rows K and L are to be interchanged.
+
+ INCX (input) INTEGER
+ The increment between successive values of IPIV. If IPIV
+ is negative, the pivots are applied in reverse order.
+
+ Further Details
+ ===============
+
+ Modified by
+ R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+ =====================================================================
+
+
+ Interchange row I with row IPIV(I) for each of rows K1 through K2.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --ipiv;
+
+ /* Function Body */
+ if (*incx > 0) {
+ ix0 = *k1;
+ i1 = *k1;
+ i2 = *k2;
+ inc = 1;
+ } else if (*incx < 0) {
+ ix0 = (1 - *k2) * *incx + 1;
+ i1 = *k2;
+ i2 = *k1;
+ inc = -1;
+ } else {
+ return 0;
+ }
+
+ n32 = (*n / 32) << (5);
+ if (n32 != 0) {
+ i__1 = n32;
+ for (j = 1; j <= i__1; j += 32) {
+ ix = ix0;
+ i__2 = i2;
+ i__3 = inc;
+ for (i__ = i1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__3)
+ {
+ ip = ipiv[ix];
+ if (ip != i__) {
+ i__4 = j + 31;
+ for (k = j; k <= i__4; ++k) {
+ temp = a[i__ + k * a_dim1];
+ a[i__ + k * a_dim1] = a[ip + k * a_dim1];
+ a[ip + k * a_dim1] = temp;
+/* L10: */
+ }
+ }
+ ix += *incx;
+/* L20: */
+ }
+/* L30: */
+ }
+ }
+ if (n32 != *n) {
+ ++n32;
+ ix = ix0;
+ i__1 = i2;
+ i__3 = inc;
+ for (i__ = i1; i__3 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__3) {
+ ip = ipiv[ix];
+ if (ip != i__) {
+ i__2 = *n;
+ for (k = n32; k <= i__2; ++k) {
+ temp = a[i__ + k * a_dim1];
+ a[i__ + k * a_dim1] = a[ip + k * a_dim1];
+ a[ip + k * a_dim1] = temp;
+/* L40: */
+ }
+ }
+ ix += *incx;
+/* L50: */
+ }
+ }
+
+ return 0;
+
+/* End of DLASWP */
+
+} /* dlaswp_ */
+
+/* Subroutine */ int dlatrd_(char *uplo, integer *n, integer *nb, doublereal *
+ a, integer *lda, doublereal *e, doublereal *tau, doublereal *w,
+ integer *ldw)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i__, iw;
+ extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *,
+ integer *);
+ static doublereal alpha;
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *);
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, doublereal *, integer *), daxpy_(integer *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *),
+ dsymv_(char *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *), dlarfg_(integer *, doublereal *, doublereal *, integer *,
+ doublereal *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DLATRD reduces NB rows and columns of a real symmetric matrix A to
+ symmetric tridiagonal form by an orthogonal similarity
+ transformation Q' * A * Q, and returns the matrices V and W which are
+ needed to apply the transformation to the unreduced part of A.
+
+ If UPLO = 'U', DLATRD reduces the last NB rows and columns of a
+ matrix, of which the upper triangle is supplied;
+ if UPLO = 'L', DLATRD reduces the first NB rows and columns of a
+ matrix, of which the lower triangle is supplied.
+
+ This is an auxiliary routine called by DSYTRD.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ NB (input) INTEGER
+ The number of rows and columns to be reduced.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit:
+ if UPLO = 'U', the last NB columns have been reduced to
+ tridiagonal form, with the diagonal elements overwriting
+ the diagonal elements of A; the elements above the diagonal
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors;
+ if UPLO = 'L', the first NB columns have been reduced to
+ tridiagonal form, with the diagonal elements overwriting
+ the diagonal elements of A; the elements below the diagonal
+ with the array TAU, represent the orthogonal matrix Q as a
+ product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= (1,N).
+
+ E (output) DOUBLE PRECISION array, dimension (N-1)
+ If UPLO = 'U', E(n-nb:n-1) contains the superdiagonal
+ elements of the last NB columns of the reduced matrix;
+ if UPLO = 'L', E(1:nb) contains the subdiagonal elements of
+ the first NB columns of the reduced matrix.
+
+ TAU (output) DOUBLE PRECISION array, dimension (N-1)
+ The scalar factors of the elementary reflectors, stored in
+ TAU(n-nb:n-1) if UPLO = 'U', and in TAU(1:nb) if UPLO = 'L'.
+ See Further Details.
+
+ W (output) DOUBLE PRECISION array, dimension (LDW,NB)
+ The n-by-nb matrix W required to update the unreduced part
+ of A.
+
+ LDW (input) INTEGER
+ The leading dimension of the array W. LDW >= max(1,N).
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n) H(n-1) . . . H(n-nb+1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(i:n) = 0 and v(i-1) = 1; v(1:i-1) is stored on exit in A(1:i-1,i),
+ and tau in TAU(i-1).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(nb).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+1:n) is stored on exit in A(i+1:n,i),
+ and tau in TAU(i).
+
+ The elements of the vectors v together form the n-by-nb matrix V
+ which is needed, with W, to apply the transformation to the unreduced
+ part of the matrix, using a symmetric rank-2k update of the form:
+ A := A - V*W' - W*V'.
+
+ The contents of A on exit are illustrated by the following examples
+ with n = 5 and nb = 2:
+
+ if UPLO = 'U': if UPLO = 'L':
+
+ ( a a a v4 v5 ) ( d )
+ ( a a v4 v5 ) ( 1 d )
+ ( a 1 v5 ) ( v1 1 a )
+ ( d 1 ) ( v1 v2 a a )
+ ( d ) ( v1 v2 a a a )
+
+ where d denotes a diagonal element of the reduced matrix, a denotes
+ an element of the original matrix that is unchanged, and vi denotes
+ an element of the vector defining H(i).
+
+ =====================================================================
+
+
+ Quick return if possible
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --e;
+ --tau;
+ w_dim1 = *ldw;
+ w_offset = 1 + w_dim1 * 1;
+ w -= w_offset;
+
+ /* Function Body */
+ if (*n <= 0) {
+ return 0;
+ }
+
+ if (lsame_(uplo, "U")) {
+
+/* Reduce last NB columns of upper triangle */
+
+ i__1 = *n - *nb + 1;
+ for (i__ = *n; i__ >= i__1; --i__) {
+ iw = i__ - *n + *nb;
+ if (i__ < *n) {
+
+/* Update A(1:i,i) */
+
+ i__2 = *n - i__;
+ dgemv_("No transpose", &i__, &i__2, &c_b151, &a[(i__ + 1) *
+ a_dim1 + 1], lda, &w[i__ + (iw + 1) * w_dim1], ldw, &
+ c_b15, &a[i__ * a_dim1 + 1], &c__1);
+ i__2 = *n - i__;
+ dgemv_("No transpose", &i__, &i__2, &c_b151, &w[(iw + 1) *
+ w_dim1 + 1], ldw, &a[i__ + (i__ + 1) * a_dim1], lda, &
+ c_b15, &a[i__ * a_dim1 + 1], &c__1);
+ }
+ if (i__ > 1) {
+
+/*
+ Generate elementary reflector H(i) to annihilate
+ A(1:i-2,i)
+*/
+
+ i__2 = i__ - 1;
+ dlarfg_(&i__2, &a[i__ - 1 + i__ * a_dim1], &a[i__ * a_dim1 +
+ 1], &c__1, &tau[i__ - 1]);
+ e[i__ - 1] = a[i__ - 1 + i__ * a_dim1];
+ a[i__ - 1 + i__ * a_dim1] = 1.;
+
+/* Compute W(1:i-1,i) */
+
+ i__2 = i__ - 1;
+ dsymv_("Upper", &i__2, &c_b15, &a[a_offset], lda, &a[i__ *
+ a_dim1 + 1], &c__1, &c_b29, &w[iw * w_dim1 + 1], &
+ c__1);
+ if (i__ < *n) {
+ i__2 = i__ - 1;
+ i__3 = *n - i__;
+ dgemv_("Transpose", &i__2, &i__3, &c_b15, &w[(iw + 1) *
+ w_dim1 + 1], ldw, &a[i__ * a_dim1 + 1], &c__1, &
+ c_b29, &w[i__ + 1 + iw * w_dim1], &c__1);
+ i__2 = i__ - 1;
+ i__3 = *n - i__;
+ dgemv_("No transpose", &i__2, &i__3, &c_b151, &a[(i__ + 1)
+ * a_dim1 + 1], lda, &w[i__ + 1 + iw * w_dim1], &
+ c__1, &c_b15, &w[iw * w_dim1 + 1], &c__1);
+ i__2 = i__ - 1;
+ i__3 = *n - i__;
+ dgemv_("Transpose", &i__2, &i__3, &c_b15, &a[(i__ + 1) *
+ a_dim1 + 1], lda, &a[i__ * a_dim1 + 1], &c__1, &
+ c_b29, &w[i__ + 1 + iw * w_dim1], &c__1);
+ i__2 = i__ - 1;
+ i__3 = *n - i__;
+ dgemv_("No transpose", &i__2, &i__3, &c_b151, &w[(iw + 1)
+ * w_dim1 + 1], ldw, &w[i__ + 1 + iw * w_dim1], &
+ c__1, &c_b15, &w[iw * w_dim1 + 1], &c__1);
+ }
+ i__2 = i__ - 1;
+ dscal_(&i__2, &tau[i__ - 1], &w[iw * w_dim1 + 1], &c__1);
+ i__2 = i__ - 1;
+ alpha = tau[i__ - 1] * -.5 * ddot_(&i__2, &w[iw * w_dim1 + 1],
+ &c__1, &a[i__ * a_dim1 + 1], &c__1);
+ i__2 = i__ - 1;
+ daxpy_(&i__2, &alpha, &a[i__ * a_dim1 + 1], &c__1, &w[iw *
+ w_dim1 + 1], &c__1);
+ }
+
+/* L10: */
+ }
+ } else {
+
+/* Reduce first NB columns of lower triangle */
+
+ i__1 = *nb;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/* Update A(i:n,i) */
+
+ i__2 = *n - i__ + 1;
+ i__3 = i__ - 1;
+ dgemv_("No transpose", &i__2, &i__3, &c_b151, &a[i__ + a_dim1],
+ lda, &w[i__ + w_dim1], ldw, &c_b15, &a[i__ + i__ * a_dim1]
+ , &c__1);
+ i__2 = *n - i__ + 1;
+ i__3 = i__ - 1;
+ dgemv_("No transpose", &i__2, &i__3, &c_b151, &w[i__ + w_dim1],
+ ldw, &a[i__ + a_dim1], lda, &c_b15, &a[i__ + i__ * a_dim1]
+ , &c__1);
+ if (i__ < *n) {
+
+/*
+ Generate elementary reflector H(i) to annihilate
+ A(i+2:n,i)
+*/
+
+ i__2 = *n - i__;
+/* Computing MIN */
+ i__3 = i__ + 2;
+ dlarfg_(&i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3,*n) +
+ i__ * a_dim1], &c__1, &tau[i__]);
+ e[i__] = a[i__ + 1 + i__ * a_dim1];
+ a[i__ + 1 + i__ * a_dim1] = 1.;
+
+/* Compute W(i+1:n,i) */
+
+ i__2 = *n - i__;
+ dsymv_("Lower", &i__2, &c_b15, &a[i__ + 1 + (i__ + 1) *
+ a_dim1], lda, &a[i__ + 1 + i__ * a_dim1], &c__1, &
+ c_b29, &w[i__ + 1 + i__ * w_dim1], &c__1);
+ i__2 = *n - i__;
+ i__3 = i__ - 1;
+ dgemv_("Transpose", &i__2, &i__3, &c_b15, &w[i__ + 1 + w_dim1]
+ , ldw, &a[i__ + 1 + i__ * a_dim1], &c__1, &c_b29, &w[
+ i__ * w_dim1 + 1], &c__1);
+ i__2 = *n - i__;
+ i__3 = i__ - 1;
+ dgemv_("No transpose", &i__2, &i__3, &c_b151, &a[i__ + 1 +
+ a_dim1], lda, &w[i__ * w_dim1 + 1], &c__1, &c_b15, &w[
+ i__ + 1 + i__ * w_dim1], &c__1);
+ i__2 = *n - i__;
+ i__3 = i__ - 1;
+ dgemv_("Transpose", &i__2, &i__3, &c_b15, &a[i__ + 1 + a_dim1]
+ , lda, &a[i__ + 1 + i__ * a_dim1], &c__1, &c_b29, &w[
+ i__ * w_dim1 + 1], &c__1);
+ i__2 = *n - i__;
+ i__3 = i__ - 1;
+ dgemv_("No transpose", &i__2, &i__3, &c_b151, &w[i__ + 1 +
+ w_dim1], ldw, &w[i__ * w_dim1 + 1], &c__1, &c_b15, &w[
+ i__ + 1 + i__ * w_dim1], &c__1);
+ i__2 = *n - i__;
+ dscal_(&i__2, &tau[i__], &w[i__ + 1 + i__ * w_dim1], &c__1);
+ i__2 = *n - i__;
+ alpha = tau[i__] * -.5 * ddot_(&i__2, &w[i__ + 1 + i__ *
+ w_dim1], &c__1, &a[i__ + 1 + i__ * a_dim1], &c__1);
+ i__2 = *n - i__;
+ daxpy_(&i__2, &alpha, &a[i__ + 1 + i__ * a_dim1], &c__1, &w[
+ i__ + 1 + i__ * w_dim1], &c__1);
+ }
+
+/* L20: */
+ }
+ }
+
+ return 0;
+
+/* End of DLATRD */
+
+} /* dlatrd_ */
+
+/* Subroutine */ int dorg2r_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer i__, j, l;
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *), dlarf_(char *, integer *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ February 29, 1992
+
+
+ Purpose
+ =======
+
+ DORG2R generates an m by n real matrix Q with orthonormal columns,
+ which is defined as the first n columns of a product of k elementary
+ reflectors of order m
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGEQRF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the i-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+ returned by DGEQRF in the first k columns of its array
+ argument A.
+ On exit, the m-by-n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQRF.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0 || *n > *m) {
+ *info = -2;
+ } else if (*k < 0 || *k > *n) {
+ *info = -3;
+ } else if (*lda < max(1,*m)) {
+ *info = -5;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORG2R", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n <= 0) {
+ return 0;
+ }
+
+/* Initialise columns k+1:n to columns of the unit matrix */
+
+ i__1 = *n;
+ for (j = *k + 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (l = 1; l <= i__2; ++l) {
+ a[l + j * a_dim1] = 0.;
+/* L10: */
+ }
+ a[j + j * a_dim1] = 1.;
+/* L20: */
+ }
+
+ for (i__ = *k; i__ >= 1; --i__) {
+
+/* Apply H(i) to A(i:m,i:n) from the left */
+
+ if (i__ < *n) {
+ a[i__ + i__ * a_dim1] = 1.;
+ i__1 = *m - i__ + 1;
+ i__2 = *n - i__;
+ dlarf_("Left", &i__1, &i__2, &a[i__ + i__ * a_dim1], &c__1, &tau[
+ i__], &a[i__ + (i__ + 1) * a_dim1], lda, &work[1]);
+ }
+ if (i__ < *m) {
+ i__1 = *m - i__;
+ d__1 = -tau[i__];
+ dscal_(&i__1, &d__1, &a[i__ + 1 + i__ * a_dim1], &c__1);
+ }
+ a[i__ + i__ * a_dim1] = 1. - tau[i__];
+
+/* Set A(1:i-1,i) to zero */
+
+ i__1 = i__ - 1;
+ for (l = 1; l <= i__1; ++l) {
+ a[l + i__ * a_dim1] = 0.;
+/* L30: */
+ }
+/* L40: */
+ }
+ return 0;
+
+/* End of DORG2R */
+
+} /* dorg2r_ */
+
+/* Subroutine */ int dorgbr_(char *vect, integer *m, integer *n, integer *k,
+ doublereal *a, integer *lda, doublereal *tau, doublereal *work,
+ integer *lwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i__, j, nb, mn;
+ extern logical lsame_(char *, char *);
+ static integer iinfo;
+ static logical wantq;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int dorglq_(integer *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ integer *), dorgqr_(integer *, integer *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *, integer *);
+ static integer lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DORGBR generates one of the real orthogonal matrices Q or P**T
+ determined by DGEBRD when reducing a real matrix A to bidiagonal
+ form: A = Q * B * P**T. Q and P**T are defined as products of
+ elementary reflectors H(i) or G(i) respectively.
+
+ If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q
+ is of order M:
+ if m >= k, Q = H(1) H(2) . . . H(k) and DORGBR returns the first n
+ columns of Q, where m >= n >= k;
+ if m < k, Q = H(1) H(2) . . . H(m-1) and DORGBR returns Q as an
+ M-by-M matrix.
+
+ If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T
+ is of order N:
+ if k < n, P**T = G(k) . . . G(2) G(1) and DORGBR returns the first m
+ rows of P**T, where n >= m >= k;
+ if k >= n, P**T = G(n-1) . . . G(2) G(1) and DORGBR returns P**T as
+ an N-by-N matrix.
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ Specifies whether the matrix Q or the matrix P**T is
+ required, as defined in the transformation applied by DGEBRD:
+ = 'Q': generate Q;
+ = 'P': generate P**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix Q or P**T to be returned.
+ M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q or P**T to be returned.
+ N >= 0.
+ If VECT = 'Q', M >= N >= min(M,K);
+ if VECT = 'P', N >= M >= min(N,K).
+
+ K (input) INTEGER
+ If VECT = 'Q', the number of columns in the original M-by-K
+ matrix reduced by DGEBRD.
+ If VECT = 'P', the number of rows in the original K-by-N
+ matrix reduced by DGEBRD.
+ K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the vectors which define the elementary reflectors,
+ as returned by DGEBRD.
+ On exit, the M-by-N matrix Q or P**T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension
+ (min(M,K)) if VECT = 'Q'
+ (min(N,K)) if VECT = 'P'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i) or G(i), which determines Q or P**T, as
+ returned by DGEBRD in its array argument TAUQ or TAUP.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,min(M,N)).
+ For optimum performance LWORK >= min(M,N)*NB, where NB
+ is the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ wantq = lsame_(vect, "Q");
+ mn = min(*m,*n);
+ lquery = *lwork == -1;
+ if ((! wantq && ! lsame_(vect, "P"))) {
+ *info = -1;
+ } else if (*m < 0) {
+ *info = -2;
+ } else if (*n < 0 || (wantq && (*n > *m || *n < min(*m,*k))) || (! wantq
+ && (*m > *n || *m < min(*n,*k)))) {
+ *info = -3;
+ } else if (*k < 0) {
+ *info = -4;
+ } else if (*lda < max(1,*m)) {
+ *info = -6;
+ } else if ((*lwork < max(1,mn) && ! lquery)) {
+ *info = -9;
+ }
+
+ if (*info == 0) {
+ if (wantq) {
+ nb = ilaenv_(&c__1, "DORGQR", " ", m, n, k, &c_n1, (ftnlen)6, (
+ ftnlen)1);
+ } else {
+ nb = ilaenv_(&c__1, "DORGLQ", " ", m, n, k, &c_n1, (ftnlen)6, (
+ ftnlen)1);
+ }
+ lwkopt = max(1,mn) * nb;
+ work[1] = (doublereal) lwkopt;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORGBR", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0) {
+ work[1] = 1.;
+ return 0;
+ }
+
+ if (wantq) {
+
+/*
+ Form Q, determined by a call to DGEBRD to reduce an m-by-k
+ matrix
+*/
+
+ if (*m >= *k) {
+
+/* If m >= k, assume m >= n >= k */
+
+ dorgqr_(m, n, k, &a[a_offset], lda, &tau[1], &work[1], lwork, &
+ iinfo);
+
+ } else {
+
+/*
+ If m < k, assume m = n
+
+ Shift the vectors which define the elementary reflectors one
+ column to the right, and set the first row and column of Q
+ to those of the unit matrix
+*/
+
+ for (j = *m; j >= 2; --j) {
+ a[j * a_dim1 + 1] = 0.;
+ i__1 = *m;
+ for (i__ = j + 1; i__ <= i__1; ++i__) {
+ a[i__ + j * a_dim1] = a[i__ + (j - 1) * a_dim1];
+/* L10: */
+ }
+/* L20: */
+ }
+ a[a_dim1 + 1] = 1.;
+ i__1 = *m;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ a[i__ + a_dim1] = 0.;
+/* L30: */
+ }
+ if (*m > 1) {
+
+/* Form Q(2:m,2:m) */
+
+ i__1 = *m - 1;
+ i__2 = *m - 1;
+ i__3 = *m - 1;
+ dorgqr_(&i__1, &i__2, &i__3, &a[((a_dim1) << (1)) + 2], lda, &
+ tau[1], &work[1], lwork, &iinfo);
+ }
+ }
+ } else {
+
+/*
+ Form P', determined by a call to DGEBRD to reduce a k-by-n
+ matrix
+*/
+
+ if (*k < *n) {
+
+/* If k < n, assume k <= m <= n */
+
+ dorglq_(m, n, k, &a[a_offset], lda, &tau[1], &work[1], lwork, &
+ iinfo);
+
+ } else {
+
+/*
+ If k >= n, assume m = n
+
+ Shift the vectors which define the elementary reflectors one
+ row downward, and set the first row and column of P' to
+ those of the unit matrix
+*/
+
+ a[a_dim1 + 1] = 1.;
+ i__1 = *n;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ a[i__ + a_dim1] = 0.;
+/* L40: */
+ }
+ i__1 = *n;
+ for (j = 2; j <= i__1; ++j) {
+ for (i__ = j - 1; i__ >= 2; --i__) {
+ a[i__ + j * a_dim1] = a[i__ - 1 + j * a_dim1];
+/* L50: */
+ }
+ a[j * a_dim1 + 1] = 0.;
+/* L60: */
+ }
+ if (*n > 1) {
+
+/* Form P'(2:n,2:n) */
+
+ i__1 = *n - 1;
+ i__2 = *n - 1;
+ i__3 = *n - 1;
+ dorglq_(&i__1, &i__2, &i__3, &a[((a_dim1) << (1)) + 2], lda, &
+ tau[1], &work[1], lwork, &iinfo);
+ }
+ }
+ }
+ work[1] = (doublereal) lwkopt;
+ return 0;
+
+/* End of DORGBR */
+
+} /* dorgbr_ */
+
+/* Subroutine */ int dorghr_(integer *n, integer *ilo, integer *ihi,
+ doublereal *a, integer *lda, doublereal *tau, doublereal *work,
+ integer *lwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+
+ /* Local variables */
+ static integer i__, j, nb, nh, iinfo;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int dorgqr_(integer *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ integer *);
+ static integer lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DORGHR generates a real orthogonal matrix Q which is defined as the
+ product of IHI-ILO elementary reflectors of order N, as returned by
+ DGEHRD:
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix Q. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ ILO and IHI must have the same values as in the previous call
+ of DGEHRD. Q is equal to the unit matrix except in the
+ submatrix Q(ilo+1:ihi,ilo+1:ihi).
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the vectors which define the elementary reflectors,
+ as returned by DGEHRD.
+ On exit, the N-by-N orthogonal matrix Q.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (input) DOUBLE PRECISION array, dimension (N-1)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEHRD.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= IHI-ILO.
+ For optimum performance LWORK >= (IHI-ILO)*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ nh = *ihi - *ilo;
+ lquery = *lwork == -1;
+ if (*n < 0) {
+ *info = -1;
+ } else if (*ilo < 1 || *ilo > max(1,*n)) {
+ *info = -2;
+ } else if (*ihi < min(*ilo,*n) || *ihi > *n) {
+ *info = -3;
+ } else if (*lda < max(1,*n)) {
+ *info = -5;
+ } else if ((*lwork < max(1,nh) && ! lquery)) {
+ *info = -8;
+ }
+
+ if (*info == 0) {
+ nb = ilaenv_(&c__1, "DORGQR", " ", &nh, &nh, &nh, &c_n1, (ftnlen)6, (
+ ftnlen)1);
+ lwkopt = max(1,nh) * nb;
+ work[1] = (doublereal) lwkopt;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORGHR", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ work[1] = 1.;
+ return 0;
+ }
+
+/*
+ Shift the vectors which define the elementary reflectors one
+ column to the right, and set the first ilo and the last n-ihi
+ rows and columns to those of the unit matrix
+*/
+
+ i__1 = *ilo + 1;
+ for (j = *ihi; j >= i__1; --j) {
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] = 0.;
+/* L10: */
+ }
+ i__2 = *ihi;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] = a[i__ + (j - 1) * a_dim1];
+/* L20: */
+ }
+ i__2 = *n;
+ for (i__ = *ihi + 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] = 0.;
+/* L30: */
+ }
+/* L40: */
+ }
+ i__1 = *ilo;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] = 0.;
+/* L50: */
+ }
+ a[j + j * a_dim1] = 1.;
+/* L60: */
+ }
+ i__1 = *n;
+ for (j = *ihi + 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] = 0.;
+/* L70: */
+ }
+ a[j + j * a_dim1] = 1.;
+/* L80: */
+ }
+
+ if (nh > 0) {
+
+/* Generate Q(ilo+1:ihi,ilo+1:ihi) */
+
+ dorgqr_(&nh, &nh, &nh, &a[*ilo + 1 + (*ilo + 1) * a_dim1], lda, &tau[*
+ ilo], &work[1], lwork, &iinfo);
+ }
+ work[1] = (doublereal) lwkopt;
+ return 0;
+
+/* End of DORGHR */
+
+} /* dorghr_ */
+
+/* Subroutine */ int dorgl2_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+ doublereal d__1;
+
+ /* Local variables */
+ static integer i__, j, l;
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *), dlarf_(char *, integer *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DORGL2 generates an m by n real matrix Q with orthonormal rows,
+ which is defined as the first m rows of a product of k elementary
+ reflectors of order n
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGELQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the i-th row must contain the vector which defines
+ the elementary reflector H(i), for i = 1,2,...,k, as returned
+ by DGELQF in the first k rows of its array argument A.
+ On exit, the m-by-n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGELQF.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < *m) {
+ *info = -2;
+ } else if (*k < 0 || *k > *m) {
+ *info = -3;
+ } else if (*lda < max(1,*m)) {
+ *info = -5;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORGL2", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m <= 0) {
+ return 0;
+ }
+
+ if (*k < *m) {
+
+/* Initialise rows k+1:m to rows of the unit matrix */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (l = *k + 1; l <= i__2; ++l) {
+ a[l + j * a_dim1] = 0.;
+/* L10: */
+ }
+ if ((j > *k && j <= *m)) {
+ a[j + j * a_dim1] = 1.;
+ }
+/* L20: */
+ }
+ }
+
+ for (i__ = *k; i__ >= 1; --i__) {
+
+/* Apply H(i) to A(i:m,i:n) from the right */
+
+ if (i__ < *n) {
+ if (i__ < *m) {
+ a[i__ + i__ * a_dim1] = 1.;
+ i__1 = *m - i__;
+ i__2 = *n - i__ + 1;
+ dlarf_("Right", &i__1, &i__2, &a[i__ + i__ * a_dim1], lda, &
+ tau[i__], &a[i__ + 1 + i__ * a_dim1], lda, &work[1]);
+ }
+ i__1 = *n - i__;
+ d__1 = -tau[i__];
+ dscal_(&i__1, &d__1, &a[i__ + (i__ + 1) * a_dim1], lda);
+ }
+ a[i__ + i__ * a_dim1] = 1. - tau[i__];
+
+/* Set A(i,1:i-1) to zero */
+
+ i__1 = i__ - 1;
+ for (l = 1; l <= i__1; ++l) {
+ a[i__ + l * a_dim1] = 0.;
+/* L30: */
+ }
+/* L40: */
+ }
+ return 0;
+
+/* End of DORGL2 */
+
+} /* dorgl2_ */
+
+/* Subroutine */ int dorglq_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *lwork,
+ integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo;
+ extern /* Subroutine */ int dorgl2_(integer *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *),
+ dlarfb_(char *, char *, char *, char *, integer *, integer *,
+ integer *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static integer ldwork, lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DORGLQ generates an M-by-N real matrix Q with orthonormal rows,
+ which is defined as the first M rows of a product of K elementary
+ reflectors of order N
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGELQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the i-th row must contain the vector which defines
+ the elementary reflector H(i), for i = 1,2,...,k, as returned
+ by DGELQF in the first k rows of its array argument A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGELQF.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ nb = ilaenv_(&c__1, "DORGLQ", " ", m, n, k, &c_n1, (ftnlen)6, (ftnlen)1);
+ lwkopt = max(1,*m) * nb;
+ work[1] = (doublereal) lwkopt;
+ lquery = *lwork == -1;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < *m) {
+ *info = -2;
+ } else if (*k < 0 || *k > *m) {
+ *info = -3;
+ } else if (*lda < max(1,*m)) {
+ *info = -5;
+ } else if ((*lwork < max(1,*m) && ! lquery)) {
+ *info = -8;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORGLQ", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m <= 0) {
+ work[1] = 1.;
+ return 0;
+ }
+
+ nbmin = 2;
+ nx = 0;
+ iws = *m;
+ if ((nb > 1 && nb < *k)) {
+
+/*
+ Determine when to cross over from blocked to unblocked code.
+
+ Computing MAX
+*/
+ i__1 = 0, i__2 = ilaenv_(&c__3, "DORGLQ", " ", m, n, k, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ nx = max(i__1,i__2);
+ if (nx < *k) {
+
+/* Determine if workspace is large enough for blocked code. */
+
+ ldwork = *m;
+ iws = ldwork * nb;
+ if (*lwork < iws) {
+
+/*
+ Not enough workspace to use optimal NB: reduce NB and
+ determine the minimum value of NB.
+*/
+
+ nb = *lwork / ldwork;
+/* Computing MAX */
+ i__1 = 2, i__2 = ilaenv_(&c__2, "DORGLQ", " ", m, n, k, &c_n1,
+ (ftnlen)6, (ftnlen)1);
+ nbmin = max(i__1,i__2);
+ }
+ }
+ }
+
+ if (((nb >= nbmin && nb < *k) && nx < *k)) {
+
+/*
+ Use blocked code after the last block.
+ The first kk rows are handled by the block method.
+*/
+
+ ki = (*k - nx - 1) / nb * nb;
+/* Computing MIN */
+ i__1 = *k, i__2 = ki + nb;
+ kk = min(i__1,i__2);
+
+/* Set A(kk+1:m,1:kk) to zero. */
+
+ i__1 = kk;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = kk + 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+ } else {
+ kk = 0;
+ }
+
+/* Use unblocked code for the last or only block. */
+
+ if (kk < *m) {
+ i__1 = *m - kk;
+ i__2 = *n - kk;
+ i__3 = *k - kk;
+ dorgl2_(&i__1, &i__2, &i__3, &a[kk + 1 + (kk + 1) * a_dim1], lda, &
+ tau[kk + 1], &work[1], &iinfo);
+ }
+
+ if (kk > 0) {
+
+/* Use blocked code */
+
+ i__1 = -nb;
+ for (i__ = ki + 1; i__1 < 0 ? i__ >= 1 : i__ <= 1; i__ += i__1) {
+/* Computing MIN */
+ i__2 = nb, i__3 = *k - i__ + 1;
+ ib = min(i__2,i__3);
+ if (i__ + ib <= *m) {
+
+/*
+ Form the triangular factor of the block reflector
+ H = H(i) H(i+1) . . . H(i+ib-1)
+*/
+
+ i__2 = *n - i__ + 1;
+ dlarft_("Forward", "Rowwise", &i__2, &ib, &a[i__ + i__ *
+ a_dim1], lda, &tau[i__], &work[1], &ldwork);
+
+/* Apply H' to A(i+ib:m,i:n) from the right */
+
+ i__2 = *m - i__ - ib + 1;
+ i__3 = *n - i__ + 1;
+ dlarfb_("Right", "Transpose", "Forward", "Rowwise", &i__2, &
+ i__3, &ib, &a[i__ + i__ * a_dim1], lda, &work[1], &
+ ldwork, &a[i__ + ib + i__ * a_dim1], lda, &work[ib +
+ 1], &ldwork);
+ }
+
+/* Apply H' to columns i:n of current block */
+
+ i__2 = *n - i__ + 1;
+ dorgl2_(&ib, &i__2, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &
+ work[1], &iinfo);
+
+/* Set columns 1:i-1 of current block to zero */
+
+ i__2 = i__ - 1;
+ for (j = 1; j <= i__2; ++j) {
+ i__3 = i__ + ib - 1;
+ for (l = i__; l <= i__3; ++l) {
+ a[l + j * a_dim1] = 0.;
+/* L30: */
+ }
+/* L40: */
+ }
+/* L50: */
+ }
+ }
+
+ work[1] = (doublereal) iws;
+ return 0;
+
+/* End of DORGLQ */
+
+} /* dorglq_ */
+
+/* Subroutine */ int dorgqr_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *lwork,
+ integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo;
+ extern /* Subroutine */ int dorg2r_(integer *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *),
+ dlarfb_(char *, char *, char *, char *, integer *, integer *,
+ integer *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static integer ldwork, lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DORGQR generates an M-by-N real matrix Q with orthonormal columns,
+ which is defined as the first N columns of a product of K elementary
+ reflectors of order M
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGEQRF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the i-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+ returned by DGEQRF in the first k columns of its array
+ argument A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQRF.
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ nb = ilaenv_(&c__1, "DORGQR", " ", m, n, k, &c_n1, (ftnlen)6, (ftnlen)1);
+ lwkopt = max(1,*n) * nb;
+ work[1] = (doublereal) lwkopt;
+ lquery = *lwork == -1;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0 || *n > *m) {
+ *info = -2;
+ } else if (*k < 0 || *k > *n) {
+ *info = -3;
+ } else if (*lda < max(1,*m)) {
+ *info = -5;
+ } else if ((*lwork < max(1,*n) && ! lquery)) {
+ *info = -8;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORGQR", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n <= 0) {
+ work[1] = 1.;
+ return 0;
+ }
+
+ nbmin = 2;
+ nx = 0;
+ iws = *n;
+ if ((nb > 1 && nb < *k)) {
+
+/*
+ Determine when to cross over from blocked to unblocked code.
+
+ Computing MAX
+*/
+ i__1 = 0, i__2 = ilaenv_(&c__3, "DORGQR", " ", m, n, k, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ nx = max(i__1,i__2);
+ if (nx < *k) {
+
+/* Determine if workspace is large enough for blocked code. */
+
+ ldwork = *n;
+ iws = ldwork * nb;
+ if (*lwork < iws) {
+
+/*
+ Not enough workspace to use optimal NB: reduce NB and
+ determine the minimum value of NB.
+*/
+
+ nb = *lwork / ldwork;
+/* Computing MAX */
+ i__1 = 2, i__2 = ilaenv_(&c__2, "DORGQR", " ", m, n, k, &c_n1,
+ (ftnlen)6, (ftnlen)1);
+ nbmin = max(i__1,i__2);
+ }
+ }
+ }
+
+ if (((nb >= nbmin && nb < *k) && nx < *k)) {
+
+/*
+ Use blocked code after the last block.
+ The first kk columns are handled by the block method.
+*/
+
+ ki = (*k - nx - 1) / nb * nb;
+/* Computing MIN */
+ i__1 = *k, i__2 = ki + nb;
+ kk = min(i__1,i__2);
+
+/* Set A(1:kk,kk+1:n) to zero. */
+
+ i__1 = *n;
+ for (j = kk + 1; j <= i__1; ++j) {
+ i__2 = kk;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+ } else {
+ kk = 0;
+ }
+
+/* Use unblocked code for the last or only block. */
+
+ if (kk < *n) {
+ i__1 = *m - kk;
+ i__2 = *n - kk;
+ i__3 = *k - kk;
+ dorg2r_(&i__1, &i__2, &i__3, &a[kk + 1 + (kk + 1) * a_dim1], lda, &
+ tau[kk + 1], &work[1], &iinfo);
+ }
+
+ if (kk > 0) {
+
+/* Use blocked code */
+
+ i__1 = -nb;
+ for (i__ = ki + 1; i__1 < 0 ? i__ >= 1 : i__ <= 1; i__ += i__1) {
+/* Computing MIN */
+ i__2 = nb, i__3 = *k - i__ + 1;
+ ib = min(i__2,i__3);
+ if (i__ + ib <= *n) {
+
+/*
+ Form the triangular factor of the block reflector
+ H = H(i) H(i+1) . . . H(i+ib-1)
+*/
+
+ i__2 = *m - i__ + 1;
+ dlarft_("Forward", "Columnwise", &i__2, &ib, &a[i__ + i__ *
+ a_dim1], lda, &tau[i__], &work[1], &ldwork);
+
+/* Apply H to A(i:m,i+ib:n) from the left */
+
+ i__2 = *m - i__ + 1;
+ i__3 = *n - i__ - ib + 1;
+ dlarfb_("Left", "No transpose", "Forward", "Columnwise", &
+ i__2, &i__3, &ib, &a[i__ + i__ * a_dim1], lda, &work[
+ 1], &ldwork, &a[i__ + (i__ + ib) * a_dim1], lda, &
+ work[ib + 1], &ldwork);
+ }
+
+/* Apply H to rows i:m of current block */
+
+ i__2 = *m - i__ + 1;
+ dorg2r_(&i__2, &ib, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &
+ work[1], &iinfo);
+
+/* Set rows 1:i-1 of current block to zero */
+
+ i__2 = i__ + ib - 1;
+ for (j = i__; j <= i__2; ++j) {
+ i__3 = i__ - 1;
+ for (l = 1; l <= i__3; ++l) {
+ a[l + j * a_dim1] = 0.;
+/* L30: */
+ }
+/* L40: */
+ }
+/* L50: */
+ }
+ }
+
+ work[1] = (doublereal) iws;
+ return 0;
+
+/* End of DORGQR */
+
+} /* dorgqr_ */
+
+/* Subroutine */ int dorm2l_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;
+
+ /* Local variables */
+ static integer i__, i1, i2, i3, mi, ni, nq;
+ static doublereal aii;
+ static logical left;
+ extern /* Subroutine */ int dlarf_(char *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *);
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static logical notran;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ February 29, 1992
+
+
+ Purpose
+ =======
+
+ DORM2L overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGEQLF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+ DGEQLF in the last k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQLF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+
+/* NQ is the order of Q */
+
+ if (left) {
+ nq = *m;
+ } else {
+ nq = *n;
+ }
+ if ((! left && ! lsame_(side, "R"))) {
+ *info = -1;
+ } else if ((! notran && ! lsame_(trans, "T"))) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,nq)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORM2L", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ return 0;
+ }
+
+ if ((left && notran) || (! left && ! notran)) {
+ i1 = 1;
+ i2 = *k;
+ i3 = 1;
+ } else {
+ i1 = *k;
+ i2 = 1;
+ i3 = -1;
+ }
+
+ if (left) {
+ ni = *n;
+ } else {
+ mi = *m;
+ }
+
+ i__1 = i2;
+ i__2 = i3;
+ for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+ if (left) {
+
+/* H(i) is applied to C(1:m-k+i,1:n) */
+
+ mi = *m - *k + i__;
+ } else {
+
+/* H(i) is applied to C(1:m,1:n-k+i) */
+
+ ni = *n - *k + i__;
+ }
+
+/* Apply H(i) */
+
+ aii = a[nq - *k + i__ + i__ * a_dim1];
+ a[nq - *k + i__ + i__ * a_dim1] = 1.;
+ dlarf_(side, &mi, &ni, &a[i__ * a_dim1 + 1], &c__1, &tau[i__], &c__[
+ c_offset], ldc, &work[1]);
+ a[nq - *k + i__ + i__ * a_dim1] = aii;
+/* L10: */
+ }
+ return 0;
+
+/* End of DORM2L */
+
+} /* dorm2l_ */
+
+/* Subroutine */ int dorm2r_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;
+
+ /* Local variables */
+ static integer i__, i1, i2, i3, ic, jc, mi, ni, nq;
+ static doublereal aii;
+ static logical left;
+ extern /* Subroutine */ int dlarf_(char *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *);
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static logical notran;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ February 29, 1992
+
+
+ Purpose
+ =======
+
+ DORM2R overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+ DGEQRF in the first k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQRF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+
+/* NQ is the order of Q */
+
+ if (left) {
+ nq = *m;
+ } else {
+ nq = *n;
+ }
+ if ((! left && ! lsame_(side, "R"))) {
+ *info = -1;
+ } else if ((! notran && ! lsame_(trans, "T"))) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,nq)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORM2R", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ return 0;
+ }
+
+ if ((left && ! notran) || (! left && notran)) {
+ i1 = 1;
+ i2 = *k;
+ i3 = 1;
+ } else {
+ i1 = *k;
+ i2 = 1;
+ i3 = -1;
+ }
+
+ if (left) {
+ ni = *n;
+ jc = 1;
+ } else {
+ mi = *m;
+ ic = 1;
+ }
+
+ i__1 = i2;
+ i__2 = i3;
+ for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+ if (left) {
+
+/* H(i) is applied to C(i:m,1:n) */
+
+ mi = *m - i__ + 1;
+ ic = i__;
+ } else {
+
+/* H(i) is applied to C(1:m,i:n) */
+
+ ni = *n - i__ + 1;
+ jc = i__;
+ }
+
+/* Apply H(i) */
+
+ aii = a[i__ + i__ * a_dim1];
+ a[i__ + i__ * a_dim1] = 1.;
+ dlarf_(side, &mi, &ni, &a[i__ + i__ * a_dim1], &c__1, &tau[i__], &c__[
+ ic + jc * c_dim1], ldc, &work[1]);
+ a[i__ + i__ * a_dim1] = aii;
+/* L10: */
+ }
+ return 0;
+
+/* End of DORM2R */
+
+} /* dorm2r_ */
+
+/* Subroutine */ int dormbr_(char *vect, char *side, char *trans, integer *m,
+ integer *n, integer *k, doublereal *a, integer *lda, doublereal *tau,
+ doublereal *c__, integer *ldc, doublereal *work, integer *lwork,
+ integer *info)
+{
+ /* System generated locals */
+ address a__1[2];
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2];
+ char ch__1[2];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
+
+ /* Local variables */
+ static integer i1, i2, nb, mi, ni, nq, nw;
+ static logical left;
+ extern logical lsame_(char *, char *);
+ static integer iinfo;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int dormlq_(char *, char *, integer *, integer *,
+ integer *, doublereal *, integer *, doublereal *, doublereal *,
+ integer *, doublereal *, integer *, integer *);
+ static logical notran;
+ extern /* Subroutine */ int dormqr_(char *, char *, integer *, integer *,
+ integer *, doublereal *, integer *, doublereal *, doublereal *,
+ integer *, doublereal *, integer *, integer *);
+ static logical applyq;
+ static char transt[1];
+ static integer lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ If VECT = 'Q', DORMBR overwrites the general real M-by-N matrix C
+ with
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ If VECT = 'P', DORMBR overwrites the general real M-by-N matrix C
+ with
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': P * C C * P
+ TRANS = 'T': P**T * C C * P**T
+
+ Here Q and P**T are the orthogonal matrices determined by DGEBRD when
+ reducing a real matrix A to bidiagonal form: A = Q * B * P**T. Q and
+ P**T are defined as products of elementary reflectors H(i) and G(i)
+ respectively.
+
+ Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the
+ order of the orthogonal matrix Q or P**T that is applied.
+
+ If VECT = 'Q', A is assumed to have been an NQ-by-K matrix:
+ if nq >= k, Q = H(1) H(2) . . . H(k);
+ if nq < k, Q = H(1) H(2) . . . H(nq-1).
+
+ If VECT = 'P', A is assumed to have been a K-by-NQ matrix:
+ if k < nq, P = G(1) G(2) . . . G(k);
+ if k >= nq, P = G(1) G(2) . . . G(nq-1).
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ = 'Q': apply Q or Q**T;
+ = 'P': apply P or P**T.
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q, Q**T, P or P**T from the Left;
+ = 'R': apply Q, Q**T, P or P**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q or P;
+ = 'T': Transpose, apply Q**T or P**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ If VECT = 'Q', the number of columns in the original
+ matrix reduced by DGEBRD.
+ If VECT = 'P', the number of rows in the original
+ matrix reduced by DGEBRD.
+ K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,min(nq,K)) if VECT = 'Q'
+ (LDA,nq) if VECT = 'P'
+ The vectors which define the elementary reflectors H(i) and
+ G(i), whose products determine the matrices Q and P, as
+ returned by DGEBRD.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If VECT = 'Q', LDA >= max(1,nq);
+ if VECT = 'P', LDA >= max(1,min(nq,K)).
+
+ TAU (input) DOUBLE PRECISION array, dimension (min(nq,K))
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i) or G(i) which determines Q or P, as returned
+ by DGEBRD in the array argument TAUQ or TAUP.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q
+ or P*C or P**T*C or C*P or C*P**T.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ applyq = lsame_(vect, "Q");
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+ lquery = *lwork == -1;
+
+/* NQ is the order of Q or P and NW is the minimum dimension of WORK */
+
+ if (left) {
+ nq = *m;
+ nw = *n;
+ } else {
+ nq = *n;
+ nw = *m;
+ }
+ if ((! applyq && ! lsame_(vect, "P"))) {
+ *info = -1;
+ } else if ((! left && ! lsame_(side, "R"))) {
+ *info = -2;
+ } else if ((! notran && ! lsame_(trans, "T"))) {
+ *info = -3;
+ } else if (*m < 0) {
+ *info = -4;
+ } else if (*n < 0) {
+ *info = -5;
+ } else if (*k < 0) {
+ *info = -6;
+ } else /* if(complicated condition) */ {
+/* Computing MAX */
+ i__1 = 1, i__2 = min(nq,*k);
+ if ((applyq && *lda < max(1,nq)) || (! applyq && *lda < max(i__1,i__2)
+ )) {
+ *info = -8;
+ } else if (*ldc < max(1,*m)) {
+ *info = -11;
+ } else if ((*lwork < max(1,nw) && ! lquery)) {
+ *info = -13;
+ }
+ }
+
+ if (*info == 0) {
+ if (applyq) {
+ if (left) {
+/* Writing concatenation */
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = *m - 1;
+ i__2 = *m - 1;
+ nb = ilaenv_(&c__1, "DORMQR", ch__1, &i__1, n, &i__2, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ } else {
+/* Writing concatenation */
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = *n - 1;
+ i__2 = *n - 1;
+ nb = ilaenv_(&c__1, "DORMQR", ch__1, m, &i__1, &i__2, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ }
+ } else {
+ if (left) {
+/* Writing concatenation */
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = *m - 1;
+ i__2 = *m - 1;
+ nb = ilaenv_(&c__1, "DORMLQ", ch__1, &i__1, n, &i__2, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ } else {
+/* Writing concatenation */
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = *n - 1;
+ i__2 = *n - 1;
+ nb = ilaenv_(&c__1, "DORMLQ", ch__1, m, &i__1, &i__2, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ }
+ }
+ lwkopt = max(1,nw) * nb;
+ work[1] = (doublereal) lwkopt;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORMBR", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ work[1] = 1.;
+ if (*m == 0 || *n == 0) {
+ return 0;
+ }
+
+ if (applyq) {
+
+/* Apply Q */
+
+ if (nq >= *k) {
+
+/* Q was determined by a call to DGEBRD with nq >= k */
+
+ dormqr_(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[
+ c_offset], ldc, &work[1], lwork, &iinfo);
+ } else if (nq > 1) {
+
+/* Q was determined by a call to DGEBRD with nq < k */
+
+ if (left) {
+ mi = *m - 1;
+ ni = *n;
+ i1 = 2;
+ i2 = 1;
+ } else {
+ mi = *m;
+ ni = *n - 1;
+ i1 = 1;
+ i2 = 2;
+ }
+ i__1 = nq - 1;
+ dormqr_(side, trans, &mi, &ni, &i__1, &a[a_dim1 + 2], lda, &tau[1]
+ , &c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo);
+ }
+ } else {
+
+/* Apply P */
+
+ if (notran) {
+ *(unsigned char *)transt = 'T';
+ } else {
+ *(unsigned char *)transt = 'N';
+ }
+ if (nq > *k) {
+
+/* P was determined by a call to DGEBRD with nq > k */
+
+ dormlq_(side, transt, m, n, k, &a[a_offset], lda, &tau[1], &c__[
+ c_offset], ldc, &work[1], lwork, &iinfo);
+ } else if (nq > 1) {
+
+/* P was determined by a call to DGEBRD with nq <= k */
+
+ if (left) {
+ mi = *m - 1;
+ ni = *n;
+ i1 = 2;
+ i2 = 1;
+ } else {
+ mi = *m;
+ ni = *n - 1;
+ i1 = 1;
+ i2 = 2;
+ }
+ i__1 = nq - 1;
+ dormlq_(side, transt, &mi, &ni, &i__1, &a[((a_dim1) << (1)) + 1],
+ lda, &tau[1], &c__[i1 + i2 * c_dim1], ldc, &work[1],
+ lwork, &iinfo);
+ }
+ }
+ work[1] = (doublereal) lwkopt;
+ return 0;
+
+/* End of DORMBR */
+
+} /* dormbr_ */
+
+/* Subroutine */ int dorml2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;
+
+ /* Local variables */
+ static integer i__, i1, i2, i3, ic, jc, mi, ni, nq;
+ static doublereal aii;
+ static logical left;
+ extern /* Subroutine */ int dlarf_(char *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *);
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static logical notran;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ February 29, 1992
+
+
+ Purpose
+ =======
+
+ DORML2 overwrites the general real m by n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'T', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'T',
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGELQF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'T': apply Q' (Transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+ DGELQF in the first k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGELQF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+
+/* NQ is the order of Q */
+
+ if (left) {
+ nq = *m;
+ } else {
+ nq = *n;
+ }
+ if ((! left && ! lsame_(side, "R"))) {
+ *info = -1;
+ } else if ((! notran && ! lsame_(trans, "T"))) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,*k)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORML2", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ return 0;
+ }
+
+ if ((left && notran) || (! left && ! notran)) {
+ i1 = 1;
+ i2 = *k;
+ i3 = 1;
+ } else {
+ i1 = *k;
+ i2 = 1;
+ i3 = -1;
+ }
+
+ if (left) {
+ ni = *n;
+ jc = 1;
+ } else {
+ mi = *m;
+ ic = 1;
+ }
+
+ i__1 = i2;
+ i__2 = i3;
+ for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+ if (left) {
+
+/* H(i) is applied to C(i:m,1:n) */
+
+ mi = *m - i__ + 1;
+ ic = i__;
+ } else {
+
+/* H(i) is applied to C(1:m,i:n) */
+
+ ni = *n - i__ + 1;
+ jc = i__;
+ }
+
+/* Apply H(i) */
+
+ aii = a[i__ + i__ * a_dim1];
+ a[i__ + i__ * a_dim1] = 1.;
+ dlarf_(side, &mi, &ni, &a[i__ + i__ * a_dim1], lda, &tau[i__], &c__[
+ ic + jc * c_dim1], ldc, &work[1]);
+ a[i__ + i__ * a_dim1] = aii;
+/* L10: */
+ }
+ return 0;
+
+/* End of DORML2 */
+
+} /* dorml2_ */
+
+/* Subroutine */ int dormlq_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ address a__1[2];
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4,
+ i__5;
+ char ch__1[2];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
+
+ /* Local variables */
+ static integer i__;
+ static doublereal t[4160] /* was [65][64] */;
+ static integer i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws;
+ static logical left;
+ extern logical lsame_(char *, char *);
+ static integer nbmin, iinfo;
+ extern /* Subroutine */ int dorml2_(char *, char *, integer *, integer *,
+ integer *, doublereal *, integer *, doublereal *, doublereal *,
+ integer *, doublereal *, integer *), dlarfb_(char
+ *, char *, char *, char *, integer *, integer *, integer *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal
+ *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static logical notran;
+ static integer ldwork;
+ static char transt[1];
+ static integer lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DORMLQ overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGELQF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+ DGELQF in the first k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGELQF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+ lquery = *lwork == -1;
+
+/* NQ is the order of Q and NW is the minimum dimension of WORK */
+
+ if (left) {
+ nq = *m;
+ nw = *n;
+ } else {
+ nq = *n;
+ nw = *m;
+ }
+ if ((! left && ! lsame_(side, "R"))) {
+ *info = -1;
+ } else if ((! notran && ! lsame_(trans, "T"))) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,*k)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ } else if ((*lwork < max(1,nw) && ! lquery)) {
+ *info = -12;
+ }
+
+ if (*info == 0) {
+
+/*
+ Determine the block size. NB may be at most NBMAX, where NBMAX
+ is used to define the local array T.
+
+ Computing MIN
+ Writing concatenation
+*/
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = 64, i__2 = ilaenv_(&c__1, "DORMLQ", ch__1, m, n, k, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ nb = min(i__1,i__2);
+ lwkopt = max(1,nw) * nb;
+ work[1] = (doublereal) lwkopt;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORMLQ", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ work[1] = 1.;
+ return 0;
+ }
+
+ nbmin = 2;
+ ldwork = nw;
+ if ((nb > 1 && nb < *k)) {
+ iws = nw * nb;
+ if (*lwork < iws) {
+ nb = *lwork / ldwork;
+/*
+ Computing MAX
+ Writing concatenation
+*/
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = 2, i__2 = ilaenv_(&c__2, "DORMLQ", ch__1, m, n, k, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ nbmin = max(i__1,i__2);
+ }
+ } else {
+ iws = nw;
+ }
+
+ if (nb < nbmin || nb >= *k) {
+
+/* Use unblocked code */
+
+ dorml2_(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[
+ c_offset], ldc, &work[1], &iinfo);
+ } else {
+
+/* Use blocked code */
+
+ if ((left && notran) || (! left && ! notran)) {
+ i1 = 1;
+ i2 = *k;
+ i3 = nb;
+ } else {
+ i1 = (*k - 1) / nb * nb + 1;
+ i2 = 1;
+ i3 = -nb;
+ }
+
+ if (left) {
+ ni = *n;
+ jc = 1;
+ } else {
+ mi = *m;
+ ic = 1;
+ }
+
+ if (notran) {
+ *(unsigned char *)transt = 'T';
+ } else {
+ *(unsigned char *)transt = 'N';
+ }
+
+ i__1 = i2;
+ i__2 = i3;
+ for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+/* Computing MIN */
+ i__4 = nb, i__5 = *k - i__ + 1;
+ ib = min(i__4,i__5);
+
+/*
+ Form the triangular factor of the block reflector
+ H = H(i) H(i+1) . . . H(i+ib-1)
+*/
+
+ i__4 = nq - i__ + 1;
+ dlarft_("Forward", "Rowwise", &i__4, &ib, &a[i__ + i__ * a_dim1],
+ lda, &tau[i__], t, &c__65);
+ if (left) {
+
+/* H or H' is applied to C(i:m,1:n) */
+
+ mi = *m - i__ + 1;
+ ic = i__;
+ } else {
+
+/* H or H' is applied to C(1:m,i:n) */
+
+ ni = *n - i__ + 1;
+ jc = i__;
+ }
+
+/* Apply H or H' */
+
+ dlarfb_(side, transt, "Forward", "Rowwise", &mi, &ni, &ib, &a[i__
+ + i__ * a_dim1], lda, t, &c__65, &c__[ic + jc * c_dim1],
+ ldc, &work[1], &ldwork);
+/* L10: */
+ }
+ }
+ work[1] = (doublereal) lwkopt;
+ return 0;
+
+/* End of DORMLQ */
+
+} /* dormlq_ */
+
+/* Subroutine */ int dormql_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ address a__1[2];
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4,
+ i__5;
+ char ch__1[2];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
+
+ /* Local variables */
+ static integer i__;
+ static doublereal t[4160] /* was [65][64] */;
+ static integer i1, i2, i3, ib, nb, mi, ni, nq, nw, iws;
+ static logical left;
+ extern logical lsame_(char *, char *);
+ static integer nbmin, iinfo;
+ extern /* Subroutine */ int dorm2l_(char *, char *, integer *, integer *,
+ integer *, doublereal *, integer *, doublereal *, doublereal *,
+ integer *, doublereal *, integer *), dlarfb_(char
+ *, char *, char *, char *, integer *, integer *, integer *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal
+ *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static logical notran;
+ static integer ldwork, lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DORMQL overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by DGEQLF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+ DGEQLF in the last k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQLF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+ lquery = *lwork == -1;
+
+/* NQ is the order of Q and NW is the minimum dimension of WORK */
+
+ if (left) {
+ nq = *m;
+ nw = *n;
+ } else {
+ nq = *n;
+ nw = *m;
+ }
+ if ((! left && ! lsame_(side, "R"))) {
+ *info = -1;
+ } else if ((! notran && ! lsame_(trans, "T"))) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,nq)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ } else if ((*lwork < max(1,nw) && ! lquery)) {
+ *info = -12;
+ }
+
+ if (*info == 0) {
+
+/*
+ Determine the block size. NB may be at most NBMAX, where NBMAX
+ is used to define the local array T.
+
+ Computing MIN
+ Writing concatenation
+*/
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = 64, i__2 = ilaenv_(&c__1, "DORMQL", ch__1, m, n, k, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ nb = min(i__1,i__2);
+ lwkopt = max(1,nw) * nb;
+ work[1] = (doublereal) lwkopt;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORMQL", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ work[1] = 1.;
+ return 0;
+ }
+
+ nbmin = 2;
+ ldwork = nw;
+ if ((nb > 1 && nb < *k)) {
+ iws = nw * nb;
+ if (*lwork < iws) {
+ nb = *lwork / ldwork;
+/*
+ Computing MAX
+ Writing concatenation
+*/
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = 2, i__2 = ilaenv_(&c__2, "DORMQL", ch__1, m, n, k, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ nbmin = max(i__1,i__2);
+ }
+ } else {
+ iws = nw;
+ }
+
+ if (nb < nbmin || nb >= *k) {
+
+/* Use unblocked code */
+
+ dorm2l_(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[
+ c_offset], ldc, &work[1], &iinfo);
+ } else {
+
+/* Use blocked code */
+
+ if ((left && notran) || (! left && ! notran)) {
+ i1 = 1;
+ i2 = *k;
+ i3 = nb;
+ } else {
+ i1 = (*k - 1) / nb * nb + 1;
+ i2 = 1;
+ i3 = -nb;
+ }
+
+ if (left) {
+ ni = *n;
+ } else {
+ mi = *m;
+ }
+
+ i__1 = i2;
+ i__2 = i3;
+ for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+/* Computing MIN */
+ i__4 = nb, i__5 = *k - i__ + 1;
+ ib = min(i__4,i__5);
+
+/*
+ Form the triangular factor of the block reflector
+ H = H(i+ib-1) . . . H(i+1) H(i)
+*/
+
+ i__4 = nq - *k + i__ + ib - 1;
+ dlarft_("Backward", "Columnwise", &i__4, &ib, &a[i__ * a_dim1 + 1]
+ , lda, &tau[i__], t, &c__65);
+ if (left) {
+
+/* H or H' is applied to C(1:m-k+i+ib-1,1:n) */
+
+ mi = *m - *k + i__ + ib - 1;
+ } else {
+
+/* H or H' is applied to C(1:m,1:n-k+i+ib-1) */
+
+ ni = *n - *k + i__ + ib - 1;
+ }
+
+/* Apply H or H' */
+
+ dlarfb_(side, trans, "Backward", "Columnwise", &mi, &ni, &ib, &a[
+ i__ * a_dim1 + 1], lda, t, &c__65, &c__[c_offset], ldc, &
+ work[1], &ldwork);
+/* L10: */
+ }
+ }
+ work[1] = (doublereal) lwkopt;
+ return 0;
+
+/* End of DORMQL */
+
+} /* dormql_ */
+
+/* Subroutine */ int dormqr_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ address a__1[2];
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4,
+ i__5;
+ char ch__1[2];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
+
+ /* Local variables */
+ static integer i__;
+ static doublereal t[4160] /* was [65][64] */;
+ static integer i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws;
+ static logical left;
+ extern logical lsame_(char *, char *);
+ static integer nbmin, iinfo;
+ extern /* Subroutine */ int dorm2r_(char *, char *, integer *, integer *,
+ integer *, doublereal *, integer *, doublereal *, doublereal *,
+ integer *, doublereal *, integer *), dlarfb_(char
+ *, char *, char *, char *, integer *, integer *, integer *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal
+ *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static logical notran;
+ static integer ldwork, lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DORMQR overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+ DGEQRF in the first k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) DOUBLE PRECISION array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DGEQRF.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+ lquery = *lwork == -1;
+
+/* NQ is the order of Q and NW is the minimum dimension of WORK */
+
+ if (left) {
+ nq = *m;
+ nw = *n;
+ } else {
+ nq = *n;
+ nw = *m;
+ }
+ if ((! left && ! lsame_(side, "R"))) {
+ *info = -1;
+ } else if ((! notran && ! lsame_(trans, "T"))) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,nq)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ } else if ((*lwork < max(1,nw) && ! lquery)) {
+ *info = -12;
+ }
+
+ if (*info == 0) {
+
+/*
+ Determine the block size. NB may be at most NBMAX, where NBMAX
+ is used to define the local array T.
+
+ Computing MIN
+ Writing concatenation
+*/
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = 64, i__2 = ilaenv_(&c__1, "DORMQR", ch__1, m, n, k, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ nb = min(i__1,i__2);
+ lwkopt = max(1,nw) * nb;
+ work[1] = (doublereal) lwkopt;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORMQR", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ work[1] = 1.;
+ return 0;
+ }
+
+ nbmin = 2;
+ ldwork = nw;
+ if ((nb > 1 && nb < *k)) {
+ iws = nw * nb;
+ if (*lwork < iws) {
+ nb = *lwork / ldwork;
+/*
+ Computing MAX
+ Writing concatenation
+*/
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = 2, i__2 = ilaenv_(&c__2, "DORMQR", ch__1, m, n, k, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ nbmin = max(i__1,i__2);
+ }
+ } else {
+ iws = nw;
+ }
+
+ if (nb < nbmin || nb >= *k) {
+
+/* Use unblocked code */
+
+ dorm2r_(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[
+ c_offset], ldc, &work[1], &iinfo);
+ } else {
+
+/* Use blocked code */
+
+ if ((left && ! notran) || (! left && notran)) {
+ i1 = 1;
+ i2 = *k;
+ i3 = nb;
+ } else {
+ i1 = (*k - 1) / nb * nb + 1;
+ i2 = 1;
+ i3 = -nb;
+ }
+
+ if (left) {
+ ni = *n;
+ jc = 1;
+ } else {
+ mi = *m;
+ ic = 1;
+ }
+
+ i__1 = i2;
+ i__2 = i3;
+ for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+/* Computing MIN */
+ i__4 = nb, i__5 = *k - i__ + 1;
+ ib = min(i__4,i__5);
+
+/*
+ Form the triangular factor of the block reflector
+ H = H(i) H(i+1) . . . H(i+ib-1)
+*/
+
+ i__4 = nq - i__ + 1;
+ dlarft_("Forward", "Columnwise", &i__4, &ib, &a[i__ + i__ *
+ a_dim1], lda, &tau[i__], t, &c__65)
+ ;
+ if (left) {
+
+/* H or H' is applied to C(i:m,1:n) */
+
+ mi = *m - i__ + 1;
+ ic = i__;
+ } else {
+
+/* H or H' is applied to C(1:m,i:n) */
+
+ ni = *n - i__ + 1;
+ jc = i__;
+ }
+
+/* Apply H or H' */
+
+ dlarfb_(side, trans, "Forward", "Columnwise", &mi, &ni, &ib, &a[
+ i__ + i__ * a_dim1], lda, t, &c__65, &c__[ic + jc *
+ c_dim1], ldc, &work[1], &ldwork);
+/* L10: */
+ }
+ }
+ work[1] = (doublereal) lwkopt;
+ return 0;
+
+/* End of DORMQR */
+
+} /* dormqr_ */
+
+/* Subroutine */ int dormtr_(char *side, char *uplo, char *trans, integer *m,
+ integer *n, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ address a__1[2];
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1[2], i__2, i__3;
+ char ch__1[2];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
+
+ /* Local variables */
+ static integer i1, i2, nb, mi, ni, nq, nw;
+ static logical left;
+ extern logical lsame_(char *, char *);
+ static integer iinfo;
+ static logical upper;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int dormql_(char *, char *, integer *, integer *,
+ integer *, doublereal *, integer *, doublereal *, doublereal *,
+ integer *, doublereal *, integer *, integer *),
+ dormqr_(char *, char *, integer *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *, integer *);
+ static integer lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DORMTR overwrites the general real M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'T': Q**T * C C * Q**T
+
+ where Q is a real orthogonal matrix of order nq, with nq = m if
+ SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
+ nq-1 elementary reflectors, as returned by DSYTRD:
+
+ if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1);
+
+ if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1).
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**T from the Left;
+ = 'R': apply Q or Q**T from the Right.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A contains elementary reflectors
+ from DSYTRD;
+ = 'L': Lower triangle of A contains elementary reflectors
+ from DSYTRD.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'T': Transpose, apply Q**T.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension
+ (LDA,M) if SIDE = 'L'
+ (LDA,N) if SIDE = 'R'
+ The vectors which define the elementary reflectors, as
+ returned by DSYTRD.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
+
+ TAU (input) DOUBLE PRECISION array, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by DSYTRD.
+
+ C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ left = lsame_(side, "L");
+ upper = lsame_(uplo, "U");
+ lquery = *lwork == -1;
+
+/* NQ is the order of Q and NW is the minimum dimension of WORK */
+
+ if (left) {
+ nq = *m;
+ nw = *n;
+ } else {
+ nq = *n;
+ nw = *m;
+ }
+ if ((! left && ! lsame_(side, "R"))) {
+ *info = -1;
+ } else if ((! upper && ! lsame_(uplo, "L"))) {
+ *info = -2;
+ } else if ((! lsame_(trans, "N") && ! lsame_(trans,
+ "T"))) {
+ *info = -3;
+ } else if (*m < 0) {
+ *info = -4;
+ } else if (*n < 0) {
+ *info = -5;
+ } else if (*lda < max(1,nq)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ } else if ((*lwork < max(1,nw) && ! lquery)) {
+ *info = -12;
+ }
+
+ if (*info == 0) {
+ if (upper) {
+ if (left) {
+/* Writing concatenation */
+ i__1[0] = 1, a__1[0] = side;
+ i__1[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
+ i__2 = *m - 1;
+ i__3 = *m - 1;
+ nb = ilaenv_(&c__1, "DORMQL", ch__1, &i__2, n, &i__3, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ } else {
+/* Writing concatenation */
+ i__1[0] = 1, a__1[0] = side;
+ i__1[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
+ i__2 = *n - 1;
+ i__3 = *n - 1;
+ nb = ilaenv_(&c__1, "DORMQL", ch__1, m, &i__2, &i__3, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ }
+ } else {
+ if (left) {
+/* Writing concatenation */
+ i__1[0] = 1, a__1[0] = side;
+ i__1[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
+ i__2 = *m - 1;
+ i__3 = *m - 1;
+ nb = ilaenv_(&c__1, "DORMQR", ch__1, &i__2, n, &i__3, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ } else {
+/* Writing concatenation */
+ i__1[0] = 1, a__1[0] = side;
+ i__1[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
+ i__2 = *n - 1;
+ i__3 = *n - 1;
+ nb = ilaenv_(&c__1, "DORMQR", ch__1, m, &i__2, &i__3, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ }
+ }
+ lwkopt = max(1,nw) * nb;
+ work[1] = (doublereal) lwkopt;
+ }
+
+ if (*info != 0) {
+ i__2 = -(*info);
+ xerbla_("DORMTR", &i__2);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || nq == 1) {
+ work[1] = 1.;
+ return 0;
+ }
+
+ if (left) {
+ mi = *m - 1;
+ ni = *n;
+ } else {
+ mi = *m;
+ ni = *n - 1;
+ }
+
+ if (upper) {
+
+/* Q was determined by a call to DSYTRD with UPLO = 'U' */
+
+ i__2 = nq - 1;
+ dormql_(side, trans, &mi, &ni, &i__2, &a[((a_dim1) << (1)) + 1], lda,
+ &tau[1], &c__[c_offset], ldc, &work[1], lwork, &iinfo);
+ } else {
+
+/* Q was determined by a call to DSYTRD with UPLO = 'L' */
+
+ if (left) {
+ i1 = 2;
+ i2 = 1;
+ } else {
+ i1 = 1;
+ i2 = 2;
+ }
+ i__2 = nq - 1;
+ dormqr_(side, trans, &mi, &ni, &i__2, &a[a_dim1 + 2], lda, &tau[1], &
+ c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo);
+ }
+ work[1] = (doublereal) lwkopt;
+ return 0;
+
+/* End of DORMTR */
+
+} /* dormtr_ */
+
+/* Subroutine */ int dpotf2_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+ doublereal d__1;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static integer j;
+ static doublereal ajj;
+ extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *,
+ integer *);
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *);
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, doublereal *, integer *);
+ static logical upper;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ February 29, 1992
+
+
+ Purpose
+ =======
+
+ DPOTF2 computes the Cholesky factorization of a real symmetric
+ positive definite matrix A.
+
+ The factorization has the form
+ A = U' * U , if UPLO = 'U', or
+ A = L * L', if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ This is the unblocked version of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored.
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n by n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n by n lower triangular part of A contains the lower
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U'*U or A = L*L'.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, the leading minor of order k is not
+ positive definite, and the factorization could not be
+ completed.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+
+ /* Function Body */
+ *info = 0;
+ upper = lsame_(uplo, "U");
+ if ((! upper && ! lsame_(uplo, "L"))) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*n)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DPOTF2", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+ if (upper) {
+
+/* Compute the Cholesky factorization A = U'*U. */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+
+/* Compute U(J,J) and test for non-positive-definiteness. */
+
+ i__2 = j - 1;
+ ajj = a[j + j * a_dim1] - ddot_(&i__2, &a[j * a_dim1 + 1], &c__1,
+ &a[j * a_dim1 + 1], &c__1);
+ if (ajj <= 0.) {
+ a[j + j * a_dim1] = ajj;
+ goto L30;
+ }
+ ajj = sqrt(ajj);
+ a[j + j * a_dim1] = ajj;
+
+/* Compute elements J+1:N of row J. */
+
+ if (j < *n) {
+ i__2 = j - 1;
+ i__3 = *n - j;
+ dgemv_("Transpose", &i__2, &i__3, &c_b151, &a[(j + 1) *
+ a_dim1 + 1], lda, &a[j * a_dim1 + 1], &c__1, &c_b15, &
+ a[j + (j + 1) * a_dim1], lda);
+ i__2 = *n - j;
+ d__1 = 1. / ajj;
+ dscal_(&i__2, &d__1, &a[j + (j + 1) * a_dim1], lda);
+ }
+/* L10: */
+ }
+ } else {
+
+/* Compute the Cholesky factorization A = L*L'. */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+
+/* Compute L(J,J) and test for non-positive-definiteness. */
+
+ i__2 = j - 1;
+ ajj = a[j + j * a_dim1] - ddot_(&i__2, &a[j + a_dim1], lda, &a[j
+ + a_dim1], lda);
+ if (ajj <= 0.) {
+ a[j + j * a_dim1] = ajj;
+ goto L30;
+ }
+ ajj = sqrt(ajj);
+ a[j + j * a_dim1] = ajj;
+
+/* Compute elements J+1:N of column J. */
+
+ if (j < *n) {
+ i__2 = *n - j;
+ i__3 = j - 1;
+ dgemv_("No transpose", &i__2, &i__3, &c_b151, &a[j + 1 +
+ a_dim1], lda, &a[j + a_dim1], lda, &c_b15, &a[j + 1 +
+ j * a_dim1], &c__1);
+ i__2 = *n - j;
+ d__1 = 1. / ajj;
+ dscal_(&i__2, &d__1, &a[j + 1 + j * a_dim1], &c__1);
+ }
+/* L20: */
+ }
+ }
+ goto L40;
+
+L30:
+ *info = j;
+
+L40:
+ return 0;
+
+/* End of DPOTF2 */
+
+} /* dpotf2_ */
+
+/* Subroutine */ int dpotrf_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+
+ /* Local variables */
+ static integer j, jb, nb;
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *);
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dtrsm_(char *, char *, char *, char *,
+ integer *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *);
+ static logical upper;
+ extern /* Subroutine */ int dsyrk_(char *, char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, doublereal *, doublereal *,
+ integer *), dpotf2_(char *, integer *,
+ doublereal *, integer *, integer *), xerbla_(char *,
+ integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ March 31, 1993
+
+
+ Purpose
+ =======
+
+ DPOTRF computes the Cholesky factorization of a real symmetric
+ positive definite matrix A.
+
+ The factorization has the form
+ A = U**T * U, if UPLO = 'U', or
+ A = L * L**T, if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ This is the block version of the algorithm, calling Level 3 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U**T*U or A = L*L**T.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i is not
+ positive definite, and the factorization could not be
+ completed.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+
+ /* Function Body */
+ *info = 0;
+ upper = lsame_(uplo, "U");
+ if ((! upper && ! lsame_(uplo, "L"))) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*n)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DPOTRF", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+/* Determine the block size for this environment. */
+
+ nb = ilaenv_(&c__1, "DPOTRF", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (
+ ftnlen)1);
+ if (nb <= 1 || nb >= *n) {
+
+/* Use unblocked code. */
+
+ dpotf2_(uplo, n, &a[a_offset], lda, info);
+ } else {
+
+/* Use blocked code. */
+
+ if (upper) {
+
+/* Compute the Cholesky factorization A = U'*U. */
+
+ i__1 = *n;
+ i__2 = nb;
+ for (j = 1; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
+
+/*
+ Update and factorize the current diagonal block and test
+ for non-positive-definiteness.
+
+ Computing MIN
+*/
+ i__3 = nb, i__4 = *n - j + 1;
+ jb = min(i__3,i__4);
+ i__3 = j - 1;
+ dsyrk_("Upper", "Transpose", &jb, &i__3, &c_b151, &a[j *
+ a_dim1 + 1], lda, &c_b15, &a[j + j * a_dim1], lda);
+ dpotf2_("Upper", &jb, &a[j + j * a_dim1], lda, info);
+ if (*info != 0) {
+ goto L30;
+ }
+ if (j + jb <= *n) {
+
+/* Compute the current block row. */
+
+ i__3 = *n - j - jb + 1;
+ i__4 = j - 1;
+ dgemm_("Transpose", "No transpose", &jb, &i__3, &i__4, &
+ c_b151, &a[j * a_dim1 + 1], lda, &a[(j + jb) *
+ a_dim1 + 1], lda, &c_b15, &a[j + (j + jb) *
+ a_dim1], lda);
+ i__3 = *n - j - jb + 1;
+ dtrsm_("Left", "Upper", "Transpose", "Non-unit", &jb, &
+ i__3, &c_b15, &a[j + j * a_dim1], lda, &a[j + (j
+ + jb) * a_dim1], lda);
+ }
+/* L10: */
+ }
+
+ } else {
+
+/* Compute the Cholesky factorization A = L*L'. */
+
+ i__2 = *n;
+ i__1 = nb;
+ for (j = 1; i__1 < 0 ? j >= i__2 : j <= i__2; j += i__1) {
+
+/*
+ Update and factorize the current diagonal block and test
+ for non-positive-definiteness.
+
+ Computing MIN
+*/
+ i__3 = nb, i__4 = *n - j + 1;
+ jb = min(i__3,i__4);
+ i__3 = j - 1;
+ dsyrk_("Lower", "No transpose", &jb, &i__3, &c_b151, &a[j +
+ a_dim1], lda, &c_b15, &a[j + j * a_dim1], lda);
+ dpotf2_("Lower", &jb, &a[j + j * a_dim1], lda, info);
+ if (*info != 0) {
+ goto L30;
+ }
+ if (j + jb <= *n) {
+
+/* Compute the current block column. */
+
+ i__3 = *n - j - jb + 1;
+ i__4 = j - 1;
+ dgemm_("No transpose", "Transpose", &i__3, &jb, &i__4, &
+ c_b151, &a[j + jb + a_dim1], lda, &a[j + a_dim1],
+ lda, &c_b15, &a[j + jb + j * a_dim1], lda);
+ i__3 = *n - j - jb + 1;
+ dtrsm_("Right", "Lower", "Transpose", "Non-unit", &i__3, &
+ jb, &c_b15, &a[j + j * a_dim1], lda, &a[j + jb +
+ j * a_dim1], lda);
+ }
+/* L20: */
+ }
+ }
+ }
+ goto L40;
+
+L30:
+ *info = *info + j - 1;
+
+L40:
+ return 0;
+
+/* End of DPOTRF */
+
+} /* dpotrf_ */
+
+/* Subroutine */ int dstedc_(char *compz, integer *n, doublereal *d__,
+ doublereal *e, doublereal *z__, integer *ldz, doublereal *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info)
+{
+ /* System generated locals */
+ integer z_dim1, z_offset, i__1, i__2;
+ doublereal d__1, d__2;
+
+ /* Builtin functions */
+ double log(doublereal);
+ integer pow_ii(integer *, integer *);
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static integer i__, j, k, m;
+ static doublereal p;
+ static integer ii, end, lgn;
+ static doublereal eps, tiny;
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *);
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dswap_(integer *, doublereal *, integer *,
+ doublereal *, integer *);
+ static integer lwmin;
+ extern /* Subroutine */ int dlaed0_(integer *, integer *, integer *,
+ doublereal *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, integer *, integer *);
+ static integer start;
+
+ extern /* Subroutine */ int dlascl_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, integer *, doublereal *,
+ integer *, integer *), dlacpy_(char *, integer *, integer
+ *, doublereal *, integer *, doublereal *, integer *),
+ dlaset_(char *, integer *, integer *, doublereal *, doublereal *,
+ doublereal *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *);
+ extern /* Subroutine */ int dsterf_(integer *, doublereal *, doublereal *,
+ integer *), dlasrt_(char *, integer *, doublereal *, integer *);
+ static integer liwmin, icompz;
+ extern /* Subroutine */ int dsteqr_(char *, integer *, doublereal *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *);
+ static doublereal orgnrm;
+ static logical lquery;
+ static integer smlsiz, dtrtrw, storez;
+
+
+/*
+ -- LAPACK driver routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DSTEDC computes all eigenvalues and, optionally, eigenvectors of a
+ symmetric tridiagonal matrix using the divide and conquer method.
+ The eigenvectors of a full or band real symmetric matrix can also be
+ found if DSYTRD or DSPTRD or DSBTRD has been used to reduce this
+ matrix to tridiagonal form.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none. See DLAED3 for details.
+
+ Arguments
+ =========
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only.
+ = 'I': Compute eigenvectors of tridiagonal matrix also.
+ = 'V': Compute eigenvectors of original dense symmetric
+ matrix also. On entry, Z contains the orthogonal
+ matrix used to reduce the original matrix to
+ tridiagonal form.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the diagonal elements of the tridiagonal matrix.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the subdiagonal elements of the tridiagonal matrix.
+ On exit, E has been destroyed.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
+ On entry, if COMPZ = 'V', then Z contains the orthogonal
+ matrix used in the reduction to tridiagonal form.
+ On exit, if INFO = 0, then if COMPZ = 'V', Z contains the
+ orthonormal eigenvectors of the original symmetric matrix,
+ and if COMPZ = 'I', Z contains the orthonormal eigenvectors
+ of the symmetric tridiagonal matrix.
+ If COMPZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1.
+ If eigenvectors are desired, then LDZ >= max(1,N).
+
+ WORK (workspace/output) DOUBLE PRECISION array,
+ dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If COMPZ = 'N' or N <= 1 then LWORK must be at least 1.
+ If COMPZ = 'V' and N > 1 then LWORK must be at least
+ ( 1 + 3*N + 2*N*lg N + 3*N**2 ),
+ where lg( N ) = smallest integer k such
+ that 2**k >= N.
+ If COMPZ = 'I' and N > 1 then LWORK must be at least
+ ( 1 + 4*N + N**2 ).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (LIWORK)
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If COMPZ = 'N' or N <= 1 then LIWORK must be at least 1.
+ If COMPZ = 'V' and N > 1 then LIWORK must be at least
+ ( 6 + 6*N + 5*N*lg N ).
+ If COMPZ = 'I' and N > 1 then LIWORK must be at least
+ ( 3 + 5*N ).
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an eigenvalue while
+ working on the submatrix lying in rows and columns
+ INFO/(N+1) through mod(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ --e;
+ z_dim1 = *ldz;
+ z_offset = 1 + z_dim1 * 1;
+ z__ -= z_offset;
+ --work;
+ --iwork;
+
+ /* Function Body */
+ *info = 0;
+ lquery = *lwork == -1 || *liwork == -1;
+
+ if (lsame_(compz, "N")) {
+ icompz = 0;
+ } else if (lsame_(compz, "V")) {
+ icompz = 1;
+ } else if (lsame_(compz, "I")) {
+ icompz = 2;
+ } else {
+ icompz = -1;
+ }
+ if (*n <= 1 || icompz <= 0) {
+ liwmin = 1;
+ lwmin = 1;
+ } else {
+ lgn = (integer) (log((doublereal) (*n)) / log(2.));
+ if (pow_ii(&c__2, &lgn) < *n) {
+ ++lgn;
+ }
+ if (pow_ii(&c__2, &lgn) < *n) {
+ ++lgn;
+ }
+ if (icompz == 1) {
+/* Computing 2nd power */
+ i__1 = *n;
+ lwmin = *n * 3 + 1 + ((*n) << (1)) * lgn + i__1 * i__1 * 3;
+ liwmin = *n * 6 + 6 + *n * 5 * lgn;
+ } else if (icompz == 2) {
+/* Computing 2nd power */
+ i__1 = *n;
+ lwmin = ((*n) << (2)) + 1 + i__1 * i__1;
+ liwmin = *n * 5 + 3;
+ }
+ }
+ if (icompz < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*ldz < 1 || (icompz > 0 && *ldz < max(1,*n))) {
+ *info = -6;
+ } else if ((*lwork < lwmin && ! lquery)) {
+ *info = -8;
+ } else if ((*liwork < liwmin && ! lquery)) {
+ *info = -10;
+ }
+
+ if (*info == 0) {
+ work[1] = (doublereal) lwmin;
+ iwork[1] = liwmin;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DSTEDC", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+ if (*n == 1) {
+ if (icompz != 0) {
+ z__[z_dim1 + 1] = 1.;
+ }
+ return 0;
+ }
+
+ smlsiz = ilaenv_(&c__9, "DSTEDC", " ", &c__0, &c__0, &c__0, &c__0, (
+ ftnlen)6, (ftnlen)1);
+
+/*
+ If the following conditional clause is removed, then the routine
+ will use the Divide and Conquer routine to compute only the
+ eigenvalues, which requires (3N + 3N**2) real workspace and
+ (2 + 5N + 2N lg(N)) integer workspace.
+ Since on many architectures DSTERF is much faster than any other
+ algorithm for finding eigenvalues only, it is used here
+ as the default.
+
+ If COMPZ = 'N', use DSTERF to compute the eigenvalues.
+*/
+
+ if (icompz == 0) {
+ dsterf_(n, &d__[1], &e[1], info);
+ return 0;
+ }
+
+/*
+ If N is smaller than the minimum divide size (SMLSIZ+1), then
+ solve the problem with another solver.
+*/
+
+ if (*n <= smlsiz) {
+ if (icompz == 0) {
+ dsterf_(n, &d__[1], &e[1], info);
+ return 0;
+ } else if (icompz == 2) {
+ dsteqr_("I", n, &d__[1], &e[1], &z__[z_offset], ldz, &work[1],
+ info);
+ return 0;
+ } else {
+ dsteqr_("V", n, &d__[1], &e[1], &z__[z_offset], ldz, &work[1],
+ info);
+ return 0;
+ }
+ }
+
+/*
+ If COMPZ = 'V', the Z matrix must be stored elsewhere for later
+ use.
+*/
+
+ if (icompz == 1) {
+ storez = *n * *n + 1;
+ } else {
+ storez = 1;
+ }
+
+ if (icompz == 2) {
+ dlaset_("Full", n, n, &c_b29, &c_b15, &z__[z_offset], ldz);
+ }
+
+/* Scale. */
+
+ orgnrm = dlanst_("M", n, &d__[1], &e[1]);
+ if (orgnrm == 0.) {
+ return 0;
+ }
+
+ eps = EPSILON;
+
+ start = 1;
+
+/* while ( START <= N ) */
+
+L10:
+ if (start <= *n) {
+
+/*
+ Let END be the position of the next subdiagonal entry such that
+ E( END ) <= TINY or END = N if no such subdiagonal exists. The
+ matrix identified by the elements between START and END
+ constitutes an independent sub-problem.
+*/
+
+ end = start;
+L20:
+ if (end < *n) {
+ tiny = eps * sqrt((d__1 = d__[end], abs(d__1))) * sqrt((d__2 =
+ d__[end + 1], abs(d__2)));
+ if ((d__1 = e[end], abs(d__1)) > tiny) {
+ ++end;
+ goto L20;
+ }
+ }
+
+/* (Sub) Problem determined. Compute its size and solve it. */
+
+ m = end - start + 1;
+ if (m == 1) {
+ start = end + 1;
+ goto L10;
+ }
+ if (m > smlsiz) {
+ *info = smlsiz;
+
+/* Scale. */
+
+ orgnrm = dlanst_("M", &m, &d__[start], &e[start]);
+ dlascl_("G", &c__0, &c__0, &orgnrm, &c_b15, &m, &c__1, &d__[start]
+ , &m, info);
+ i__1 = m - 1;
+ i__2 = m - 1;
+ dlascl_("G", &c__0, &c__0, &orgnrm, &c_b15, &i__1, &c__1, &e[
+ start], &i__2, info);
+
+ if (icompz == 1) {
+ dtrtrw = 1;
+ } else {
+ dtrtrw = start;
+ }
+ dlaed0_(&icompz, n, &m, &d__[start], &e[start], &z__[dtrtrw +
+ start * z_dim1], ldz, &work[1], n, &work[storez], &iwork[
+ 1], info);
+ if (*info != 0) {
+ *info = (*info / (m + 1) + start - 1) * (*n + 1) + *info % (m
+ + 1) + start - 1;
+ return 0;
+ }
+
+/* Scale back. */
+
+ dlascl_("G", &c__0, &c__0, &c_b15, &orgnrm, &m, &c__1, &d__[start]
+ , &m, info);
+
+ } else {
+ if (icompz == 1) {
+
+/*
+ Since QR won't update a Z matrix which is larger than the
+ length of D, we must solve the sub-problem in a workspace and
+ then multiply back into Z.
+*/
+
+ dsteqr_("I", &m, &d__[start], &e[start], &work[1], &m, &work[
+ m * m + 1], info);
+ dlacpy_("A", n, &m, &z__[start * z_dim1 + 1], ldz, &work[
+ storez], n);
+ dgemm_("N", "N", n, &m, &m, &c_b15, &work[storez], ldz, &work[
+ 1], &m, &c_b29, &z__[start * z_dim1 + 1], ldz);
+ } else if (icompz == 2) {
+ dsteqr_("I", &m, &d__[start], &e[start], &z__[start + start *
+ z_dim1], ldz, &work[1], info);
+ } else {
+ dsterf_(&m, &d__[start], &e[start], info);
+ }
+ if (*info != 0) {
+ *info = start * (*n + 1) + end;
+ return 0;
+ }
+ }
+
+ start = end + 1;
+ goto L10;
+ }
+
+/*
+ endwhile
+
+ If the problem split any number of times, then the eigenvalues
+ will not be properly ordered. Here we permute the eigenvalues
+ (and the associated eigenvectors) into ascending order.
+*/
+
+ if (m != *n) {
+ if (icompz == 0) {
+
+/* Use Quick Sort */
+
+ dlasrt_("I", n, &d__[1], info);
+
+ } else {
+
+/* Use Selection Sort to minimize swaps of eigenvectors */
+
+ i__1 = *n;
+ for (ii = 2; ii <= i__1; ++ii) {
+ i__ = ii - 1;
+ k = i__;
+ p = d__[i__];
+ i__2 = *n;
+ for (j = ii; j <= i__2; ++j) {
+ if (d__[j] < p) {
+ k = j;
+ p = d__[j];
+ }
+/* L30: */
+ }
+ if (k != i__) {
+ d__[k] = d__[i__];
+ d__[i__] = p;
+ dswap_(n, &z__[i__ * z_dim1 + 1], &c__1, &z__[k * z_dim1
+ + 1], &c__1);
+ }
+/* L40: */
+ }
+ }
+ }
+
+ work[1] = (doublereal) lwmin;
+ iwork[1] = liwmin;
+
+ return 0;
+
+/* End of DSTEDC */
+
+} /* dstedc_ */
+
+/* Subroutine */ int dsteqr_(char *compz, integer *n, doublereal *d__,
+ doublereal *e, doublereal *z__, integer *ldz, doublereal *work,
+ integer *info)
+{
+ /* System generated locals */
+ integer z_dim1, z_offset, i__1, i__2;
+ doublereal d__1, d__2;
+
+ /* Builtin functions */
+ double sqrt(doublereal), d_sign(doublereal *, doublereal *);
+
+ /* Local variables */
+ static doublereal b, c__, f, g;
+ static integer i__, j, k, l, m;
+ static doublereal p, r__, s;
+ static integer l1, ii, mm, lm1, mm1, nm1;
+ static doublereal rt1, rt2, eps;
+ static integer lsv;
+ static doublereal tst, eps2;
+ static integer lend, jtot;
+ extern /* Subroutine */ int dlae2_(doublereal *, doublereal *, doublereal
+ *, doublereal *, doublereal *);
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dlasr_(char *, char *, char *, integer *,
+ integer *, doublereal *, doublereal *, doublereal *, integer *);
+ static doublereal anorm;
+ extern /* Subroutine */ int dswap_(integer *, doublereal *, integer *,
+ doublereal *, integer *), dlaev2_(doublereal *, doublereal *,
+ doublereal *, doublereal *, doublereal *, doublereal *,
+ doublereal *);
+ static integer lendm1, lendp1;
+
+ static integer iscale;
+ extern /* Subroutine */ int dlascl_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, integer *, doublereal *,
+ integer *, integer *), dlaset_(char *, integer *, integer
+ *, doublereal *, doublereal *, doublereal *, integer *);
+ static doublereal safmin;
+ extern /* Subroutine */ int dlartg_(doublereal *, doublereal *,
+ doublereal *, doublereal *, doublereal *);
+ static doublereal safmax;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *);
+ extern /* Subroutine */ int dlasrt_(char *, integer *, doublereal *,
+ integer *);
+ static integer lendsv;
+ static doublereal ssfmin;
+ static integer nmaxit, icompz;
+ static doublereal ssfmax;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ DSTEQR computes all eigenvalues and, optionally, eigenvectors of a
+ symmetric tridiagonal matrix using the implicit QL or QR method.
+ The eigenvectors of a full or band symmetric matrix can also be found
+ if DSYTRD or DSPTRD or DSBTRD has been used to reduce this matrix to
+ tridiagonal form.
+
+ Arguments
+ =========
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only.
+ = 'V': Compute eigenvalues and eigenvectors of the original
+ symmetric matrix. On entry, Z must contain the
+ orthogonal matrix used to reduce the original matrix
+ to tridiagonal form.
+ = 'I': Compute eigenvalues and eigenvectors of the
+ tridiagonal matrix. Z is initialized to the identity
+ matrix.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the diagonal elements of the tridiagonal matrix.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix.
+ On exit, E has been destroyed.
+
+ Z (input/output) DOUBLE PRECISION array, dimension (LDZ, N)
+ On entry, if COMPZ = 'V', then Z contains the orthogonal
+ matrix used in the reduction to tridiagonal form.
+ On exit, if INFO = 0, then if COMPZ = 'V', Z contains the
+ orthonormal eigenvectors of the original symmetric matrix,
+ and if COMPZ = 'I', Z contains the orthonormal eigenvectors
+ of the symmetric tridiagonal matrix.
+ If COMPZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ eigenvectors are desired, then LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (max(1,2*N-2))
+ If COMPZ = 'N', then WORK is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm has failed to find all the eigenvalues in
+ a total of 30*N iterations; if INFO = i, then i
+ elements of E have not converged to zero; on exit, D
+ and E contain the elements of a symmetric tridiagonal
+ matrix which is orthogonally similar to the original
+ matrix.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ --e;
+ z_dim1 = *ldz;
+ z_offset = 1 + z_dim1 * 1;
+ z__ -= z_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+
+ if (lsame_(compz, "N")) {
+ icompz = 0;
+ } else if (lsame_(compz, "V")) {
+ icompz = 1;
+ } else if (lsame_(compz, "I")) {
+ icompz = 2;
+ } else {
+ icompz = -1;
+ }
+ if (icompz < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*ldz < 1 || (icompz > 0 && *ldz < max(1,*n))) {
+ *info = -6;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DSTEQR", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+ if (*n == 1) {
+ if (icompz == 2) {
+ z__[z_dim1 + 1] = 1.;
+ }
+ return 0;
+ }
+
+/* Determine the unit roundoff and over/underflow thresholds. */
+
+ eps = EPSILON;
+/* Computing 2nd power */
+ d__1 = eps;
+ eps2 = d__1 * d__1;
+ safmin = SAFEMINIMUM;
+ safmax = 1. / safmin;
+ ssfmax = sqrt(safmax) / 3.;
+ ssfmin = sqrt(safmin) / eps2;
+
+/*
+ Compute the eigenvalues and eigenvectors of the tridiagonal
+ matrix.
+*/
+
+ if (icompz == 2) {
+ dlaset_("Full", n, n, &c_b29, &c_b15, &z__[z_offset], ldz);
+ }
+
+ nmaxit = *n * 30;
+ jtot = 0;
+
+/*
+ Determine where the matrix splits and choose QL or QR iteration
+ for each block, according to whether top or bottom diagonal
+ element is smaller.
+*/
+
+ l1 = 1;
+ nm1 = *n - 1;
+
+L10:
+ if (l1 > *n) {
+ goto L160;
+ }
+ if (l1 > 1) {
+ e[l1 - 1] = 0.;
+ }
+ if (l1 <= nm1) {
+ i__1 = nm1;
+ for (m = l1; m <= i__1; ++m) {
+ tst = (d__1 = e[m], abs(d__1));
+ if (tst == 0.) {
+ goto L30;
+ }
+ if (tst <= sqrt((d__1 = d__[m], abs(d__1))) * sqrt((d__2 = d__[m
+ + 1], abs(d__2))) * eps) {
+ e[m] = 0.;
+ goto L30;
+ }
+/* L20: */
+ }
+ }
+ m = *n;
+
+L30:
+ l = l1;
+ lsv = l;
+ lend = m;
+ lendsv = lend;
+ l1 = m + 1;
+ if (lend == l) {
+ goto L10;
+ }
+
+/* Scale submatrix in rows and columns L to LEND */
+
+ i__1 = lend - l + 1;
+ anorm = dlanst_("I", &i__1, &d__[l], &e[l]);
+ iscale = 0;
+ if (anorm == 0.) {
+ goto L10;
+ }
+ if (anorm > ssfmax) {
+ iscale = 1;
+ i__1 = lend - l + 1;
+ dlascl_("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &d__[l], n,
+ info);
+ i__1 = lend - l;
+ dlascl_("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &e[l], n,
+ info);
+ } else if (anorm < ssfmin) {
+ iscale = 2;
+ i__1 = lend - l + 1;
+ dlascl_("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &d__[l], n,
+ info);
+ i__1 = lend - l;
+ dlascl_("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &e[l], n,
+ info);
+ }
+
+/* Choose between QL and QR iteration */
+
+ if ((d__1 = d__[lend], abs(d__1)) < (d__2 = d__[l], abs(d__2))) {
+ lend = lsv;
+ l = lendsv;
+ }
+
+ if (lend > l) {
+
+/*
+ QL Iteration
+
+ Look for small subdiagonal element.
+*/
+
+L40:
+ if (l != lend) {
+ lendm1 = lend - 1;
+ i__1 = lendm1;
+ for (m = l; m <= i__1; ++m) {
+/* Computing 2nd power */
+ d__2 = (d__1 = e[m], abs(d__1));
+ tst = d__2 * d__2;
+ if (tst <= eps2 * (d__1 = d__[m], abs(d__1)) * (d__2 = d__[m
+ + 1], abs(d__2)) + safmin) {
+ goto L60;
+ }
+/* L50: */
+ }
+ }
+
+ m = lend;
+
+L60:
+ if (m < lend) {
+ e[m] = 0.;
+ }
+ p = d__[l];
+ if (m == l) {
+ goto L80;
+ }
+
+/*
+ If remaining matrix is 2-by-2, use DLAE2 or SLAEV2
+ to compute its eigensystem.
+*/
+
+ if (m == l + 1) {
+ if (icompz > 0) {
+ dlaev2_(&d__[l], &e[l], &d__[l + 1], &rt1, &rt2, &c__, &s);
+ work[l] = c__;
+ work[*n - 1 + l] = s;
+ dlasr_("R", "V", "B", n, &c__2, &work[l], &work[*n - 1 + l], &
+ z__[l * z_dim1 + 1], ldz);
+ } else {
+ dlae2_(&d__[l], &e[l], &d__[l + 1], &rt1, &rt2);
+ }
+ d__[l] = rt1;
+ d__[l + 1] = rt2;
+ e[l] = 0.;
+ l += 2;
+ if (l <= lend) {
+ goto L40;
+ }
+ goto L140;
+ }
+
+ if (jtot == nmaxit) {
+ goto L140;
+ }
+ ++jtot;
+
+/* Form shift. */
+
+ g = (d__[l + 1] - p) / (e[l] * 2.);
+ r__ = dlapy2_(&g, &c_b15);
+ g = d__[m] - p + e[l] / (g + d_sign(&r__, &g));
+
+ s = 1.;
+ c__ = 1.;
+ p = 0.;
+
+/* Inner loop */
+
+ mm1 = m - 1;
+ i__1 = l;
+ for (i__ = mm1; i__ >= i__1; --i__) {
+ f = s * e[i__];
+ b = c__ * e[i__];
+ dlartg_(&g, &f, &c__, &s, &r__);
+ if (i__ != m - 1) {
+ e[i__ + 1] = r__;
+ }
+ g = d__[i__ + 1] - p;
+ r__ = (d__[i__] - g) * s + c__ * 2. * b;
+ p = s * r__;
+ d__[i__ + 1] = g + p;
+ g = c__ * r__ - b;
+
+/* If eigenvectors are desired, then save rotations. */
+
+ if (icompz > 0) {
+ work[i__] = c__;
+ work[*n - 1 + i__] = -s;
+ }
+
+/* L70: */
+ }
+
+/* If eigenvectors are desired, then apply saved rotations. */
+
+ if (icompz > 0) {
+ mm = m - l + 1;
+ dlasr_("R", "V", "B", n, &mm, &work[l], &work[*n - 1 + l], &z__[l
+ * z_dim1 + 1], ldz);
+ }
+
+ d__[l] -= p;
+ e[l] = g;
+ goto L40;
+
+/* Eigenvalue found. */
+
+L80:
+ d__[l] = p;
+
+ ++l;
+ if (l <= lend) {
+ goto L40;
+ }
+ goto L140;
+
+ } else {
+
+/*
+ QR Iteration
+
+ Look for small superdiagonal element.
+*/
+
+L90:
+ if (l != lend) {
+ lendp1 = lend + 1;
+ i__1 = lendp1;
+ for (m = l; m >= i__1; --m) {
+/* Computing 2nd power */
+ d__2 = (d__1 = e[m - 1], abs(d__1));
+ tst = d__2 * d__2;
+ if (tst <= eps2 * (d__1 = d__[m], abs(d__1)) * (d__2 = d__[m
+ - 1], abs(d__2)) + safmin) {
+ goto L110;
+ }
+/* L100: */
+ }
+ }
+
+ m = lend;
+
+L110:
+ if (m > lend) {
+ e[m - 1] = 0.;
+ }
+ p = d__[l];
+ if (m == l) {
+ goto L130;
+ }
+
+/*
+ If remaining matrix is 2-by-2, use DLAE2 or SLAEV2
+ to compute its eigensystem.
+*/
+
+ if (m == l - 1) {
+ if (icompz > 0) {
+ dlaev2_(&d__[l - 1], &e[l - 1], &d__[l], &rt1, &rt2, &c__, &s)
+ ;
+ work[m] = c__;
+ work[*n - 1 + m] = s;
+ dlasr_("R", "V", "F", n, &c__2, &work[m], &work[*n - 1 + m], &
+ z__[(l - 1) * z_dim1 + 1], ldz);
+ } else {
+ dlae2_(&d__[l - 1], &e[l - 1], &d__[l], &rt1, &rt2);
+ }
+ d__[l - 1] = rt1;
+ d__[l] = rt2;
+ e[l - 1] = 0.;
+ l += -2;
+ if (l >= lend) {
+ goto L90;
+ }
+ goto L140;
+ }
+
+ if (jtot == nmaxit) {
+ goto L140;
+ }
+ ++jtot;
+
+/* Form shift. */
+
+ g = (d__[l - 1] - p) / (e[l - 1] * 2.);
+ r__ = dlapy2_(&g, &c_b15);
+ g = d__[m] - p + e[l - 1] / (g + d_sign(&r__, &g));
+
+ s = 1.;
+ c__ = 1.;
+ p = 0.;
+
+/* Inner loop */
+
+ lm1 = l - 1;
+ i__1 = lm1;
+ for (i__ = m; i__ <= i__1; ++i__) {
+ f = s * e[i__];
+ b = c__ * e[i__];
+ dlartg_(&g, &f, &c__, &s, &r__);
+ if (i__ != m) {
+ e[i__ - 1] = r__;
+ }
+ g = d__[i__] - p;
+ r__ = (d__[i__ + 1] - g) * s + c__ * 2. * b;
+ p = s * r__;
+ d__[i__] = g + p;
+ g = c__ * r__ - b;
+
+/* If eigenvectors are desired, then save rotations. */
+
+ if (icompz > 0) {
+ work[i__] = c__;
+ work[*n - 1 + i__] = s;
+ }
+
+/* L120: */
+ }
+
+/* If eigenvectors are desired, then apply saved rotations. */
+
+ if (icompz > 0) {
+ mm = l - m + 1;
+ dlasr_("R", "V", "F", n, &mm, &work[m], &work[*n - 1 + m], &z__[m
+ * z_dim1 + 1], ldz);
+ }
+
+ d__[l] -= p;
+ e[lm1] = g;
+ goto L90;
+
+/* Eigenvalue found. */
+
+L130:
+ d__[l] = p;
+
+ --l;
+ if (l >= lend) {
+ goto L90;
+ }
+ goto L140;
+
+ }
+
+/* Undo scaling if necessary */
+
+L140:
+ if (iscale == 1) {
+ i__1 = lendsv - lsv + 1;
+ dlascl_("G", &c__0, &c__0, &ssfmax, &anorm, &i__1, &c__1, &d__[lsv],
+ n, info);
+ i__1 = lendsv - lsv;
+ dlascl_("G", &c__0, &c__0, &ssfmax, &anorm, &i__1, &c__1, &e[lsv], n,
+ info);
+ } else if (iscale == 2) {
+ i__1 = lendsv - lsv + 1;
+ dlascl_("G", &c__0, &c__0, &ssfmin, &anorm, &i__1, &c__1, &d__[lsv],
+ n, info);
+ i__1 = lendsv - lsv;
+ dlascl_("G", &c__0, &c__0, &ssfmin, &anorm, &i__1, &c__1, &e[lsv], n,
+ info);
+ }
+
+/*
+ Check for no convergence to an eigenvalue after a total
+ of N*MAXIT iterations.
+*/
+
+ if (jtot < nmaxit) {
+ goto L10;
+ }
+ i__1 = *n - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if (e[i__] != 0.) {
+ ++(*info);
+ }
+/* L150: */
+ }
+ goto L190;
+
+/* Order eigenvalues and eigenvectors. */
+
+L160:
+ if (icompz == 0) {
+
+/* Use Quick Sort */
+
+ dlasrt_("I", n, &d__[1], info);
+
+ } else {
+
+/* Use Selection Sort to minimize swaps of eigenvectors */
+
+ i__1 = *n;
+ for (ii = 2; ii <= i__1; ++ii) {
+ i__ = ii - 1;
+ k = i__;
+ p = d__[i__];
+ i__2 = *n;
+ for (j = ii; j <= i__2; ++j) {
+ if (d__[j] < p) {
+ k = j;
+ p = d__[j];
+ }
+/* L170: */
+ }
+ if (k != i__) {
+ d__[k] = d__[i__];
+ d__[i__] = p;
+ dswap_(n, &z__[i__ * z_dim1 + 1], &c__1, &z__[k * z_dim1 + 1],
+ &c__1);
+ }
+/* L180: */
+ }
+ }
+
+L190:
+ return 0;
+
+/* End of DSTEQR */
+
+} /* dsteqr_ */
+
+/* Subroutine */ int dsterf_(integer *n, doublereal *d__, doublereal *e,
+ integer *info)
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1, d__2, d__3;
+
+ /* Builtin functions */
+ double sqrt(doublereal), d_sign(doublereal *, doublereal *);
+
+ /* Local variables */
+ static doublereal c__;
+ static integer i__, l, m;
+ static doublereal p, r__, s;
+ static integer l1;
+ static doublereal bb, rt1, rt2, eps, rte;
+ static integer lsv;
+ static doublereal eps2, oldc;
+ static integer lend, jtot;
+ extern /* Subroutine */ int dlae2_(doublereal *, doublereal *, doublereal
+ *, doublereal *, doublereal *);
+ static doublereal gamma, alpha, sigma, anorm;
+
+ static integer iscale;
+ extern /* Subroutine */ int dlascl_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, integer *, doublereal *,
+ integer *, integer *);
+ static doublereal oldgam, safmin;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static doublereal safmax;
+ extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *);
+ extern /* Subroutine */ int dlasrt_(char *, integer *, doublereal *,
+ integer *);
+ static integer lendsv;
+ static doublereal ssfmin;
+ static integer nmaxit;
+ static doublereal ssfmax;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DSTERF computes all eigenvalues of a symmetric tridiagonal matrix
+ using the Pal-Walker-Kahan variant of the QL or QR algorithm.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the n diagonal elements of the tridiagonal matrix.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix.
+ On exit, E has been destroyed.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm failed to find all of the eigenvalues in
+ a total of 30*N iterations; if INFO = i, then i
+ elements of E have not converged to zero.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --e;
+ --d__;
+
+ /* Function Body */
+ *info = 0;
+
+/* Quick return if possible */
+
+ if (*n < 0) {
+ *info = -1;
+ i__1 = -(*info);
+ xerbla_("DSTERF", &i__1);
+ return 0;
+ }
+ if (*n <= 1) {
+ return 0;
+ }
+
+/* Determine the unit roundoff for this environment. */
+
+ eps = EPSILON;
+/* Computing 2nd power */
+ d__1 = eps;
+ eps2 = d__1 * d__1;
+ safmin = SAFEMINIMUM;
+ safmax = 1. / safmin;
+ ssfmax = sqrt(safmax) / 3.;
+ ssfmin = sqrt(safmin) / eps2;
+
+/* Compute the eigenvalues of the tridiagonal matrix. */
+
+ nmaxit = *n * 30;
+ sigma = 0.;
+ jtot = 0;
+
+/*
+ Determine where the matrix splits and choose QL or QR iteration
+ for each block, according to whether top or bottom diagonal
+ element is smaller.
+*/
+
+ l1 = 1;
+
+L10:
+ if (l1 > *n) {
+ goto L170;
+ }
+ if (l1 > 1) {
+ e[l1 - 1] = 0.;
+ }
+ i__1 = *n - 1;
+ for (m = l1; m <= i__1; ++m) {
+ if ((d__3 = e[m], abs(d__3)) <= sqrt((d__1 = d__[m], abs(d__1))) *
+ sqrt((d__2 = d__[m + 1], abs(d__2))) * eps) {
+ e[m] = 0.;
+ goto L30;
+ }
+/* L20: */
+ }
+ m = *n;
+
+L30:
+ l = l1;
+ lsv = l;
+ lend = m;
+ lendsv = lend;
+ l1 = m + 1;
+ if (lend == l) {
+ goto L10;
+ }
+
+/* Scale submatrix in rows and columns L to LEND */
+
+ i__1 = lend - l + 1;
+ anorm = dlanst_("I", &i__1, &d__[l], &e[l]);
+ iscale = 0;
+ if (anorm > ssfmax) {
+ iscale = 1;
+ i__1 = lend - l + 1;
+ dlascl_("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &d__[l], n,
+ info);
+ i__1 = lend - l;
+ dlascl_("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &e[l], n,
+ info);
+ } else if (anorm < ssfmin) {
+ iscale = 2;
+ i__1 = lend - l + 1;
+ dlascl_("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &d__[l], n,
+ info);
+ i__1 = lend - l;
+ dlascl_("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &e[l], n,
+ info);
+ }
+
+ i__1 = lend - 1;
+ for (i__ = l; i__ <= i__1; ++i__) {
+/* Computing 2nd power */
+ d__1 = e[i__];
+ e[i__] = d__1 * d__1;
+/* L40: */
+ }
+
+/* Choose between QL and QR iteration */
+
+ if ((d__1 = d__[lend], abs(d__1)) < (d__2 = d__[l], abs(d__2))) {
+ lend = lsv;
+ l = lendsv;
+ }
+
+ if (lend >= l) {
+
+/*
+ QL Iteration
+
+ Look for small subdiagonal element.
+*/
+
+L50:
+ if (l != lend) {
+ i__1 = lend - 1;
+ for (m = l; m <= i__1; ++m) {
+ if ((d__2 = e[m], abs(d__2)) <= eps2 * (d__1 = d__[m] * d__[m
+ + 1], abs(d__1))) {
+ goto L70;
+ }
+/* L60: */
+ }
+ }
+ m = lend;
+
+L70:
+ if (m < lend) {
+ e[m] = 0.;
+ }
+ p = d__[l];
+ if (m == l) {
+ goto L90;
+ }
+
+/*
+ If remaining matrix is 2 by 2, use DLAE2 to compute its
+ eigenvalues.
+*/
+
+ if (m == l + 1) {
+ rte = sqrt(e[l]);
+ dlae2_(&d__[l], &rte, &d__[l + 1], &rt1, &rt2);
+ d__[l] = rt1;
+ d__[l + 1] = rt2;
+ e[l] = 0.;
+ l += 2;
+ if (l <= lend) {
+ goto L50;
+ }
+ goto L150;
+ }
+
+ if (jtot == nmaxit) {
+ goto L150;
+ }
+ ++jtot;
+
+/* Form shift. */
+
+ rte = sqrt(e[l]);
+ sigma = (d__[l + 1] - p) / (rte * 2.);
+ r__ = dlapy2_(&sigma, &c_b15);
+ sigma = p - rte / (sigma + d_sign(&r__, &sigma));
+
+ c__ = 1.;
+ s = 0.;
+ gamma = d__[m] - sigma;
+ p = gamma * gamma;
+
+/* Inner loop */
+
+ i__1 = l;
+ for (i__ = m - 1; i__ >= i__1; --i__) {
+ bb = e[i__];
+ r__ = p + bb;
+ if (i__ != m - 1) {
+ e[i__ + 1] = s * r__;
+ }
+ oldc = c__;
+ c__ = p / r__;
+ s = bb / r__;
+ oldgam = gamma;
+ alpha = d__[i__];
+ gamma = c__ * (alpha - sigma) - s * oldgam;
+ d__[i__ + 1] = oldgam + (alpha - gamma);
+ if (c__ != 0.) {
+ p = gamma * gamma / c__;
+ } else {
+ p = oldc * bb;
+ }
+/* L80: */
+ }
+
+ e[l] = s * p;
+ d__[l] = sigma + gamma;
+ goto L50;
+
+/* Eigenvalue found. */
+
+L90:
+ d__[l] = p;
+
+ ++l;
+ if (l <= lend) {
+ goto L50;
+ }
+ goto L150;
+
+ } else {
+
+/*
+ QR Iteration
+
+ Look for small superdiagonal element.
+*/
+
+L100:
+ i__1 = lend + 1;
+ for (m = l; m >= i__1; --m) {
+ if ((d__2 = e[m - 1], abs(d__2)) <= eps2 * (d__1 = d__[m] * d__[m
+ - 1], abs(d__1))) {
+ goto L120;
+ }
+/* L110: */
+ }
+ m = lend;
+
+L120:
+ if (m > lend) {
+ e[m - 1] = 0.;
+ }
+ p = d__[l];
+ if (m == l) {
+ goto L140;
+ }
+
+/*
+ If remaining matrix is 2 by 2, use DLAE2 to compute its
+ eigenvalues.
+*/
+
+ if (m == l - 1) {
+ rte = sqrt(e[l - 1]);
+ dlae2_(&d__[l], &rte, &d__[l - 1], &rt1, &rt2);
+ d__[l] = rt1;
+ d__[l - 1] = rt2;
+ e[l - 1] = 0.;
+ l += -2;
+ if (l >= lend) {
+ goto L100;
+ }
+ goto L150;
+ }
+
+ if (jtot == nmaxit) {
+ goto L150;
+ }
+ ++jtot;
+
+/* Form shift. */
+
+ rte = sqrt(e[l - 1]);
+ sigma = (d__[l - 1] - p) / (rte * 2.);
+ r__ = dlapy2_(&sigma, &c_b15);
+ sigma = p - rte / (sigma + d_sign(&r__, &sigma));
+
+ c__ = 1.;
+ s = 0.;
+ gamma = d__[m] - sigma;
+ p = gamma * gamma;
+
+/* Inner loop */
+
+ i__1 = l - 1;
+ for (i__ = m; i__ <= i__1; ++i__) {
+ bb = e[i__];
+ r__ = p + bb;
+ if (i__ != m) {
+ e[i__ - 1] = s * r__;
+ }
+ oldc = c__;
+ c__ = p / r__;
+ s = bb / r__;
+ oldgam = gamma;
+ alpha = d__[i__ + 1];
+ gamma = c__ * (alpha - sigma) - s * oldgam;
+ d__[i__] = oldgam + (alpha - gamma);
+ if (c__ != 0.) {
+ p = gamma * gamma / c__;
+ } else {
+ p = oldc * bb;
+ }
+/* L130: */
+ }
+
+ e[l - 1] = s * p;
+ d__[l] = sigma + gamma;
+ goto L100;
+
+/* Eigenvalue found. */
+
+L140:
+ d__[l] = p;
+
+ --l;
+ if (l >= lend) {
+ goto L100;
+ }
+ goto L150;
+
+ }
+
+/* Undo scaling if necessary */
+
+L150:
+ if (iscale == 1) {
+ i__1 = lendsv - lsv + 1;
+ dlascl_("G", &c__0, &c__0, &ssfmax, &anorm, &i__1, &c__1, &d__[lsv],
+ n, info);
+ }
+ if (iscale == 2) {
+ i__1 = lendsv - lsv + 1;
+ dlascl_("G", &c__0, &c__0, &ssfmin, &anorm, &i__1, &c__1, &d__[lsv],
+ n, info);
+ }
+
+/*
+ Check for no convergence to an eigenvalue after a total
+ of N*MAXIT iterations.
+*/
+
+ if (jtot < nmaxit) {
+ goto L10;
+ }
+ i__1 = *n - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if (e[i__] != 0.) {
+ ++(*info);
+ }
+/* L160: */
+ }
+ goto L180;
+
+/* Sort eigenvalues in increasing order. */
+
+L170:
+ dlasrt_("I", n, &d__[1], info);
+
+L180:
+ return 0;
+
+/* End of DSTERF */
+
+} /* dsterf_ */
+
+/* Subroutine */ int dsyevd_(char *jobz, char *uplo, integer *n, doublereal *
+ a, integer *lda, doublereal *w, doublereal *work, integer *lwork,
+ integer *iwork, integer *liwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+ doublereal d__1;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static doublereal eps;
+ static integer inde;
+ static doublereal anrm, rmin, rmax;
+ static integer lopt;
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *);
+ static doublereal sigma;
+ extern logical lsame_(char *, char *);
+ static integer iinfo, lwmin, liopt;
+ static logical lower, wantz;
+ static integer indwk2, llwrk2;
+
+ static integer iscale;
+ extern /* Subroutine */ int dlascl_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, integer *, doublereal *,
+ integer *, integer *), dstedc_(char *, integer *,
+ doublereal *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, integer *, integer *, integer *), dlacpy_(
+ char *, integer *, integer *, doublereal *, integer *, doublereal
+ *, integer *);
+ static doublereal safmin;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static doublereal bignum;
+ static integer indtau;
+ extern /* Subroutine */ int dsterf_(integer *, doublereal *, doublereal *,
+ integer *);
+ extern doublereal dlansy_(char *, char *, integer *, doublereal *,
+ integer *, doublereal *);
+ static integer indwrk, liwmin;
+ extern /* Subroutine */ int dormtr_(char *, char *, char *, integer *,
+ integer *, doublereal *, integer *, doublereal *, doublereal *,
+ integer *, doublereal *, integer *, integer *), dsytrd_(char *, integer *, doublereal *, integer *,
+ doublereal *, doublereal *, doublereal *, doublereal *, integer *,
+ integer *);
+ static integer llwork;
+ static doublereal smlnum;
+ static logical lquery;
+
+
+/*
+ -- LAPACK driver routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DSYEVD computes all eigenvalues and, optionally, eigenvectors of a
+ real symmetric matrix A. If eigenvectors are desired, it uses a
+ divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ Because of large use of BLAS of level 3, DSYEVD needs N**2 more
+ workspace than DSYEVX.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA, N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+ On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+ orthonormal eigenvectors of the matrix A.
+ If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+ or the upper triangle (if UPLO='U') of A, including the
+ diagonal, is destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ WORK (workspace/output) DOUBLE PRECISION array,
+ dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If N <= 1, LWORK must be at least 1.
+ If JOBZ = 'N' and N > 1, LWORK must be at least 2*N+1.
+ If JOBZ = 'V' and N > 1, LWORK must be at least
+ 1 + 6*N + 2*N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (LIWORK)
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If N <= 1, LIWORK must be at least 1.
+ If JOBZ = 'N' and N > 1, LIWORK must be at least 1.
+ If JOBZ = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+ Modified by Francoise Tisseur, University of Tennessee.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --w;
+ --work;
+ --iwork;
+
+ /* Function Body */
+ wantz = lsame_(jobz, "V");
+ lower = lsame_(uplo, "L");
+ lquery = *lwork == -1 || *liwork == -1;
+
+ *info = 0;
+ if (*n <= 1) {
+ liwmin = 1;
+ lwmin = 1;
+ lopt = lwmin;
+ liopt = liwmin;
+ } else {
+ if (wantz) {
+ liwmin = *n * 5 + 3;
+/* Computing 2nd power */
+ i__1 = *n;
+ lwmin = *n * 6 + 1 + ((i__1 * i__1) << (1));
+ } else {
+ liwmin = 1;
+ lwmin = ((*n) << (1)) + 1;
+ }
+ lopt = lwmin;
+ liopt = liwmin;
+ }
+ if (! (wantz || lsame_(jobz, "N"))) {
+ *info = -1;
+ } else if (! (lower || lsame_(uplo, "U"))) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*lda < max(1,*n)) {
+ *info = -5;
+ } else if ((*lwork < lwmin && ! lquery)) {
+ *info = -8;
+ } else if ((*liwork < liwmin && ! lquery)) {
+ *info = -10;
+ }
+
+ if (*info == 0) {
+ work[1] = (doublereal) lopt;
+ iwork[1] = liopt;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DSYEVD", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+ if (*n == 1) {
+ w[1] = a[a_dim1 + 1];
+ if (wantz) {
+ a[a_dim1 + 1] = 1.;
+ }
+ return 0;
+ }
+
+/* Get machine constants. */
+
+ safmin = SAFEMINIMUM;
+ eps = PRECISION;
+ smlnum = safmin / eps;
+ bignum = 1. / smlnum;
+ rmin = sqrt(smlnum);
+ rmax = sqrt(bignum);
+
+/* Scale matrix to allowable range, if necessary. */
+
+ anrm = dlansy_("M", uplo, n, &a[a_offset], lda, &work[1]);
+ iscale = 0;
+ if ((anrm > 0. && anrm < rmin)) {
+ iscale = 1;
+ sigma = rmin / anrm;
+ } else if (anrm > rmax) {
+ iscale = 1;
+ sigma = rmax / anrm;
+ }
+ if (iscale == 1) {
+ dlascl_(uplo, &c__0, &c__0, &c_b15, &sigma, n, n, &a[a_offset], lda,
+ info);
+ }
+
+/* Call DSYTRD to reduce symmetric matrix to tridiagonal form. */
+
+ inde = 1;
+ indtau = inde + *n;
+ indwrk = indtau + *n;
+ llwork = *lwork - indwrk + 1;
+ indwk2 = indwrk + *n * *n;
+ llwrk2 = *lwork - indwk2 + 1;
+
+ dsytrd_(uplo, n, &a[a_offset], lda, &w[1], &work[inde], &work[indtau], &
+ work[indwrk], &llwork, &iinfo);
+ lopt = (integer) (((*n) << (1)) + work[indwrk]);
+
+/*
+ For eigenvalues only, call DSTERF. For eigenvectors, first call
+ DSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the
+ tridiagonal matrix, then call DORMTR to multiply it by the
+ Householder transformations stored in A.
+*/
+
+ if (! wantz) {
+ dsterf_(n, &w[1], &work[inde], info);
+ } else {
+ dstedc_("I", n, &w[1], &work[inde], &work[indwrk], n, &work[indwk2], &
+ llwrk2, &iwork[1], liwork, info);
+ dormtr_("L", uplo, "N", n, n, &a[a_offset], lda, &work[indtau], &work[
+ indwrk], n, &work[indwk2], &llwrk2, &iinfo);
+ dlacpy_("A", n, n, &work[indwrk], n, &a[a_offset], lda);
+/*
+ Computing MAX
+ Computing 2nd power
+*/
+ i__3 = *n;
+ i__1 = lopt, i__2 = *n * 6 + 1 + ((i__3 * i__3) << (1));
+ lopt = max(i__1,i__2);
+ }
+
+/* If matrix was scaled, then rescale eigenvalues appropriately. */
+
+ if (iscale == 1) {
+ d__1 = 1. / sigma;
+ dscal_(n, &d__1, &w[1], &c__1);
+ }
+
+ work[1] = (doublereal) lopt;
+ iwork[1] = liopt;
+
+ return 0;
+
+/* End of DSYEVD */
+
+} /* dsyevd_ */
+
+/* Subroutine */ int dsytd2_(char *uplo, integer *n, doublereal *a, integer *
+ lda, doublereal *d__, doublereal *e, doublereal *tau, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i__;
+ extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *,
+ integer *);
+ static doublereal taui;
+ extern /* Subroutine */ int dsyr2_(char *, integer *, doublereal *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ integer *);
+ static doublereal alpha;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int daxpy_(integer *, doublereal *, doublereal *,
+ integer *, doublereal *, integer *);
+ static logical upper;
+ extern /* Subroutine */ int dsymv_(char *, integer *, doublereal *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ doublereal *, integer *), dlarfg_(integer *, doublereal *,
+ doublereal *, integer *, doublereal *), xerbla_(char *, integer *
+ );
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ DSYTD2 reduces a real symmetric matrix A to symmetric tridiagonal
+ form T by an orthogonal similarity transformation: Q' * A * Q = T.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ symmetric matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit, if UPLO = 'U', the diagonal and first superdiagonal
+ of A are overwritten by the corresponding elements of the
+ tridiagonal matrix T, and the elements above the first
+ superdiagonal, with the array TAU, represent the orthogonal
+ matrix Q as a product of elementary reflectors; if UPLO
+ = 'L', the diagonal and first subdiagonal of A are over-
+ written by the corresponding elements of the tridiagonal
+ matrix T, and the elements below the first subdiagonal, with
+ the array TAU, represent the orthogonal matrix Q as a product
+ of elementary reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ D (output) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T:
+ D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
+
+ TAU (output) DOUBLE PRECISION array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+ Details).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n-1) . . . H(2) H(1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
+ A(1:i-1,i+1), and tau in TAU(i).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(n-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
+ and tau in TAU(i).
+
+ The contents of A on exit are illustrated by the following examples
+ with n = 5:
+
+ if UPLO = 'U': if UPLO = 'L':
+
+ ( d e v2 v3 v4 ) ( d )
+ ( d e v3 v4 ) ( e d )
+ ( d e v4 ) ( v1 e d )
+ ( d e ) ( v1 v2 e d )
+ ( d ) ( v1 v2 v3 e d )
+
+ where d and e denote diagonal and off-diagonal elements of T, and vi
+ denotes an element of the vector defining H(i).
+
+ =====================================================================
+
+
+ Test the input parameters
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --d__;
+ --e;
+ --tau;
+
+ /* Function Body */
+ *info = 0;
+ upper = lsame_(uplo, "U");
+ if ((! upper && ! lsame_(uplo, "L"))) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*n)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DSYTD2", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n <= 0) {
+ return 0;
+ }
+
+ if (upper) {
+
+/* Reduce the upper triangle of A */
+
+ for (i__ = *n - 1; i__ >= 1; --i__) {
+
+/*
+ Generate elementary reflector H(i) = I - tau * v * v'
+ to annihilate A(1:i-1,i+1)
+*/
+
+ dlarfg_(&i__, &a[i__ + (i__ + 1) * a_dim1], &a[(i__ + 1) * a_dim1
+ + 1], &c__1, &taui);
+ e[i__] = a[i__ + (i__ + 1) * a_dim1];
+
+ if (taui != 0.) {
+
+/* Apply H(i) from both sides to A(1:i,1:i) */
+
+ a[i__ + (i__ + 1) * a_dim1] = 1.;
+
+/* Compute x := tau * A * v storing x in TAU(1:i) */
+
+ dsymv_(uplo, &i__, &taui, &a[a_offset], lda, &a[(i__ + 1) *
+ a_dim1 + 1], &c__1, &c_b29, &tau[1], &c__1)
+ ;
+
+/* Compute w := x - 1/2 * tau * (x'*v) * v */
+
+ alpha = taui * -.5 * ddot_(&i__, &tau[1], &c__1, &a[(i__ + 1)
+ * a_dim1 + 1], &c__1);
+ daxpy_(&i__, &alpha, &a[(i__ + 1) * a_dim1 + 1], &c__1, &tau[
+ 1], &c__1);
+
+/*
+ Apply the transformation as a rank-2 update:
+ A := A - v * w' - w * v'
+*/
+
+ dsyr2_(uplo, &i__, &c_b151, &a[(i__ + 1) * a_dim1 + 1], &c__1,
+ &tau[1], &c__1, &a[a_offset], lda);
+
+ a[i__ + (i__ + 1) * a_dim1] = e[i__];
+ }
+ d__[i__ + 1] = a[i__ + 1 + (i__ + 1) * a_dim1];
+ tau[i__] = taui;
+/* L10: */
+ }
+ d__[1] = a[a_dim1 + 1];
+ } else {
+
+/* Reduce the lower triangle of A */
+
+ i__1 = *n - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/*
+ Generate elementary reflector H(i) = I - tau * v * v'
+ to annihilate A(i+2:n,i)
+*/
+
+ i__2 = *n - i__;
+/* Computing MIN */
+ i__3 = i__ + 2;
+ dlarfg_(&i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3,*n) + i__ *
+ a_dim1], &c__1, &taui);
+ e[i__] = a[i__ + 1 + i__ * a_dim1];
+
+ if (taui != 0.) {
+
+/* Apply H(i) from both sides to A(i+1:n,i+1:n) */
+
+ a[i__ + 1 + i__ * a_dim1] = 1.;
+
+/* Compute x := tau * A * v storing y in TAU(i:n-1) */
+
+ i__2 = *n - i__;
+ dsymv_(uplo, &i__2, &taui, &a[i__ + 1 + (i__ + 1) * a_dim1],
+ lda, &a[i__ + 1 + i__ * a_dim1], &c__1, &c_b29, &tau[
+ i__], &c__1);
+
+/* Compute w := x - 1/2 * tau * (x'*v) * v */
+
+ i__2 = *n - i__;
+ alpha = taui * -.5 * ddot_(&i__2, &tau[i__], &c__1, &a[i__ +
+ 1 + i__ * a_dim1], &c__1);
+ i__2 = *n - i__;
+ daxpy_(&i__2, &alpha, &a[i__ + 1 + i__ * a_dim1], &c__1, &tau[
+ i__], &c__1);
+
+/*
+ Apply the transformation as a rank-2 update:
+ A := A - v * w' - w * v'
+*/
+
+ i__2 = *n - i__;
+ dsyr2_(uplo, &i__2, &c_b151, &a[i__ + 1 + i__ * a_dim1], &
+ c__1, &tau[i__], &c__1, &a[i__ + 1 + (i__ + 1) *
+ a_dim1], lda);
+
+ a[i__ + 1 + i__ * a_dim1] = e[i__];
+ }
+ d__[i__] = a[i__ + i__ * a_dim1];
+ tau[i__] = taui;
+/* L20: */
+ }
+ d__[*n] = a[*n + *n * a_dim1];
+ }
+
+ return 0;
+
+/* End of DSYTD2 */
+
+} /* dsytd2_ */
+
+/* Subroutine */ int dsytrd_(char *uplo, integer *n, doublereal *a, integer *
+ lda, doublereal *d__, doublereal *e, doublereal *tau, doublereal *
+ work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i__, j, nb, kk, nx, iws;
+ extern logical lsame_(char *, char *);
+ static integer nbmin, iinfo;
+ static logical upper;
+ extern /* Subroutine */ int dsytd2_(char *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, doublereal *, integer *), dsyr2k_(char *, char *, integer *, integer *, doublereal
+ *, doublereal *, integer *, doublereal *, integer *, doublereal *,
+ doublereal *, integer *), dlatrd_(char *,
+ integer *, integer *, doublereal *, integer *, doublereal *,
+ doublereal *, doublereal *, integer *), xerbla_(char *,
+ integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static integer ldwork, lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DSYTRD reduces a real symmetric matrix A to real symmetric
+ tridiagonal form T by an orthogonal similarity transformation:
+ Q**T * A * Q = T.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
+ On entry, the symmetric matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit, if UPLO = 'U', the diagonal and first superdiagonal
+ of A are overwritten by the corresponding elements of the
+ tridiagonal matrix T, and the elements above the first
+ superdiagonal, with the array TAU, represent the orthogonal
+ matrix Q as a product of elementary reflectors; if UPLO
+ = 'L', the diagonal and first subdiagonal of A are over-
+ written by the corresponding elements of the tridiagonal
+ matrix T, and the elements below the first subdiagonal, with
+ the array TAU, represent the orthogonal matrix Q as a product
+ of elementary reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ D (output) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T:
+ D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
+
+ TAU (output) DOUBLE PRECISION array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+ Details).
+
+ WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 1.
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n-1) . . . H(2) H(1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
+ A(1:i-1,i+1), and tau in TAU(i).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(n-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a real scalar, and v is a real vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
+ and tau in TAU(i).
+
+ The contents of A on exit are illustrated by the following examples
+ with n = 5:
+
+ if UPLO = 'U': if UPLO = 'L':
+
+ ( d e v2 v3 v4 ) ( d )
+ ( d e v3 v4 ) ( e d )
+ ( d e v4 ) ( v1 e d )
+ ( d e ) ( v1 v2 e d )
+ ( d ) ( v1 v2 v3 e d )
+
+ where d and e denote diagonal and off-diagonal elements of T, and vi
+ denotes an element of the vector defining H(i).
+
+ =====================================================================
+
+
+ Test the input parameters
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --d__;
+ --e;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ upper = lsame_(uplo, "U");
+ lquery = *lwork == -1;
+ if ((! upper && ! lsame_(uplo, "L"))) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*n)) {
+ *info = -4;
+ } else if ((*lwork < 1 && ! lquery)) {
+ *info = -9;
+ }
+
+ if (*info == 0) {
+
+/* Determine the block size. */
+
+ nb = ilaenv_(&c__1, "DSYTRD", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6,
+ (ftnlen)1);
+ lwkopt = *n * nb;
+ work[1] = (doublereal) lwkopt;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DSYTRD", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ work[1] = 1.;
+ return 0;
+ }
+
+ nx = *n;
+ iws = 1;
+ if ((nb > 1 && nb < *n)) {
+
+/*
+ Determine when to cross over from blocked to unblocked code
+ (last block is always handled by unblocked code).
+
+ Computing MAX
+*/
+ i__1 = nb, i__2 = ilaenv_(&c__3, "DSYTRD", uplo, n, &c_n1, &c_n1, &
+ c_n1, (ftnlen)6, (ftnlen)1);
+ nx = max(i__1,i__2);
+ if (nx < *n) {
+
+/* Determine if workspace is large enough for blocked code. */
+
+ ldwork = *n;
+ iws = ldwork * nb;
+ if (*lwork < iws) {
+
+/*
+ Not enough workspace to use optimal NB: determine the
+ minimum value of NB, and reduce NB or force use of
+ unblocked code by setting NX = N.
+
+ Computing MAX
+*/
+ i__1 = *lwork / ldwork;
+ nb = max(i__1,1);
+ nbmin = ilaenv_(&c__2, "DSYTRD", uplo, n, &c_n1, &c_n1, &c_n1,
+ (ftnlen)6, (ftnlen)1);
+ if (nb < nbmin) {
+ nx = *n;
+ }
+ }
+ } else {
+ nx = *n;
+ }
+ } else {
+ nb = 1;
+ }
+
+ if (upper) {
+
+/*
+ Reduce the upper triangle of A.
+ Columns 1:kk are handled by the unblocked method.
+*/
+
+ kk = *n - (*n - nx + nb - 1) / nb * nb;
+ i__1 = kk + 1;
+ i__2 = -nb;
+ for (i__ = *n - nb + 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ +=
+ i__2) {
+
+/*
+ Reduce columns i:i+nb-1 to tridiagonal form and form the
+ matrix W which is needed to update the unreduced part of
+ the matrix
+*/
+
+ i__3 = i__ + nb - 1;
+ dlatrd_(uplo, &i__3, &nb, &a[a_offset], lda, &e[1], &tau[1], &
+ work[1], &ldwork);
+
+/*
+ Update the unreduced submatrix A(1:i-1,1:i-1), using an
+ update of the form: A := A - V*W' - W*V'
+*/
+
+ i__3 = i__ - 1;
+ dsyr2k_(uplo, "No transpose", &i__3, &nb, &c_b151, &a[i__ *
+ a_dim1 + 1], lda, &work[1], &ldwork, &c_b15, &a[a_offset],
+ lda);
+
+/*
+ Copy superdiagonal elements back into A, and diagonal
+ elements into D
+*/
+
+ i__3 = i__ + nb - 1;
+ for (j = i__; j <= i__3; ++j) {
+ a[j - 1 + j * a_dim1] = e[j - 1];
+ d__[j] = a[j + j * a_dim1];
+/* L10: */
+ }
+/* L20: */
+ }
+
+/* Use unblocked code to reduce the last or only block */
+
+ dsytd2_(uplo, &kk, &a[a_offset], lda, &d__[1], &e[1], &tau[1], &iinfo);
+ } else {
+
+/* Reduce the lower triangle of A */
+
+ i__2 = *n - nx;
+ i__1 = nb;
+ for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {
+
+/*
+ Reduce columns i:i+nb-1 to tridiagonal form and form the
+ matrix W which is needed to update the unreduced part of
+ the matrix
+*/
+
+ i__3 = *n - i__ + 1;
+ dlatrd_(uplo, &i__3, &nb, &a[i__ + i__ * a_dim1], lda, &e[i__], &
+ tau[i__], &work[1], &ldwork);
+
+/*
+ Update the unreduced submatrix A(i+ib:n,i+ib:n), using
+ an update of the form: A := A - V*W' - W*V'
+*/
+
+ i__3 = *n - i__ - nb + 1;
+ dsyr2k_(uplo, "No transpose", &i__3, &nb, &c_b151, &a[i__ + nb +
+ i__ * a_dim1], lda, &work[nb + 1], &ldwork, &c_b15, &a[
+ i__ + nb + (i__ + nb) * a_dim1], lda);
+
+/*
+ Copy subdiagonal elements back into A, and diagonal
+ elements into D
+*/
+
+ i__3 = i__ + nb - 1;
+ for (j = i__; j <= i__3; ++j) {
+ a[j + 1 + j * a_dim1] = e[j];
+ d__[j] = a[j + j * a_dim1];
+/* L30: */
+ }
+/* L40: */
+ }
+
+/* Use unblocked code to reduce the last or only block */
+
+ i__1 = *n - i__ + 1;
+ dsytd2_(uplo, &i__1, &a[i__ + i__ * a_dim1], lda, &d__[i__], &e[i__],
+ &tau[i__], &iinfo);
+ }
+
+ work[1] = (doublereal) lwkopt;
+ return 0;
+
+/* End of DSYTRD */
+
+} /* dsytrd_ */
+
+/* Subroutine */ int dtrevc_(char *side, char *howmny, logical *select,
+ integer *n, doublereal *t, integer *ldt, doublereal *vl, integer *
+ ldvl, doublereal *vr, integer *ldvr, integer *mm, integer *m,
+ doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1,
+ i__2, i__3;
+ doublereal d__1, d__2, d__3, d__4;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static integer i__, j, k;
+ static doublereal x[4] /* was [2][2] */;
+ static integer j1, j2, n2, ii, ki, ip, is;
+ static doublereal wi, wr, rec, ulp, beta, emax;
+ static logical pair;
+ extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *,
+ integer *);
+ static logical allv;
+ static integer ierr;
+ static doublereal unfl, ovfl, smin;
+ static logical over;
+ static doublereal vmax;
+ static integer jnxt;
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *);
+ static doublereal scale;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, doublereal *, integer *);
+ static doublereal remax;
+ extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
+ doublereal *, integer *);
+ static logical leftv, bothv;
+ extern /* Subroutine */ int daxpy_(integer *, doublereal *, doublereal *,
+ integer *, doublereal *, integer *);
+ static doublereal vcrit;
+ static logical somev;
+ static doublereal xnorm;
+ extern /* Subroutine */ int dlaln2_(logical *, integer *, integer *,
+ doublereal *, doublereal *, doublereal *, integer *, doublereal *,
+ doublereal *, doublereal *, integer *, doublereal *, doublereal *
+ , doublereal *, integer *, doublereal *, doublereal *, integer *),
+ dlabad_(doublereal *, doublereal *);
+
+ extern integer idamax_(integer *, doublereal *, integer *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static doublereal bignum;
+ static logical rightv;
+ static doublereal smlnum;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ DTREVC computes some or all of the right and/or left eigenvectors of
+ a real upper quasi-triangular matrix T.
+
+ The right eigenvector x and the left eigenvector y of T corresponding
+ to an eigenvalue w are defined by:
+
+ T*x = w*x, y'*T = w*y'
+
+ where y' denotes the conjugate transpose of the vector y.
+
+ If all eigenvectors are requested, the routine may either return the
+ matrices X and/or Y of right or left eigenvectors of T, or the
+ products Q*X and/or Q*Y, where Q is an input orthogonal
+ matrix. If T was obtained from the real-Schur factorization of an
+ original matrix A = Q*T*Q', then Q*X and Q*Y are the matrices of
+ right or left eigenvectors of A.
+
+ T must be in Schur canonical form (as returned by DHSEQR), that is,
+ block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each
+ 2-by-2 diagonal block has its diagonal elements equal and its
+ off-diagonal elements of opposite sign. Corresponding to each 2-by-2
+ diagonal block is a complex conjugate pair of eigenvalues and
+ eigenvectors; only one eigenvector of the pair is computed, namely
+ the one corresponding to the eigenvalue with positive imaginary part.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'R': compute right eigenvectors only;
+ = 'L': compute left eigenvectors only;
+ = 'B': compute both right and left eigenvectors.
+
+ HOWMNY (input) CHARACTER*1
+ = 'A': compute all right and/or left eigenvectors;
+ = 'B': compute all right and/or left eigenvectors,
+ and backtransform them using the input matrices
+ supplied in VR and/or VL;
+ = 'S': compute selected right and/or left eigenvectors,
+ specified by the logical array SELECT.
+
+ SELECT (input/output) LOGICAL array, dimension (N)
+ If HOWMNY = 'S', SELECT specifies the eigenvectors to be
+ computed.
+ If HOWMNY = 'A' or 'B', SELECT is not referenced.
+ To select the real eigenvector corresponding to a real
+ eigenvalue w(j), SELECT(j) must be set to .TRUE.. To select
+ the complex eigenvector corresponding to a complex conjugate
+ pair w(j) and w(j+1), either SELECT(j) or SELECT(j+1) must be
+ set to .TRUE.; then on exit SELECT(j) is .TRUE. and
+ SELECT(j+1) is .FALSE..
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input) DOUBLE PRECISION array, dimension (LDT,N)
+ The upper quasi-triangular matrix T in Schur canonical form.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ VL (input/output) DOUBLE PRECISION array, dimension (LDVL,MM)
+ On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
+ contain an N-by-N matrix Q (usually the orthogonal matrix Q
+ of Schur vectors returned by DHSEQR).
+ On exit, if SIDE = 'L' or 'B', VL contains:
+ if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
+ VL has the same quasi-lower triangular form
+ as T'. If T(i,i) is a real eigenvalue, then
+ the i-th column VL(i) of VL is its
+ corresponding eigenvector. If T(i:i+1,i:i+1)
+ is a 2-by-2 block whose eigenvalues are
+ complex-conjugate eigenvalues of T, then
+ VL(i)+sqrt(-1)*VL(i+1) is the complex
+ eigenvector corresponding to the eigenvalue
+ with positive real part.
+ if HOWMNY = 'B', the matrix Q*Y;
+ if HOWMNY = 'S', the left eigenvectors of T specified by
+ SELECT, stored consecutively in the columns
+ of VL, in the same order as their
+ eigenvalues.
+ A complex eigenvector corresponding to a complex eigenvalue
+ is stored in two consecutive columns, the first holding the
+ real part, and the second the imaginary part.
+ If SIDE = 'R', VL is not referenced.
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= max(1,N) if
+ SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+
+ VR (input/output) DOUBLE PRECISION array, dimension (LDVR,MM)
+ On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
+ contain an N-by-N matrix Q (usually the orthogonal matrix Q
+ of Schur vectors returned by DHSEQR).
+ On exit, if SIDE = 'R' or 'B', VR contains:
+ if HOWMNY = 'A', the matrix X of right eigenvectors of T;
+ VR has the same quasi-upper triangular form
+ as T. If T(i,i) is a real eigenvalue, then
+ the i-th column VR(i) of VR is its
+ corresponding eigenvector. If T(i:i+1,i:i+1)
+ is a 2-by-2 block whose eigenvalues are
+ complex-conjugate eigenvalues of T, then
+ VR(i)+sqrt(-1)*VR(i+1) is the complex
+ eigenvector corresponding to the eigenvalue
+ with positive real part.
+ if HOWMNY = 'B', the matrix Q*X;
+ if HOWMNY = 'S', the right eigenvectors of T specified by
+ SELECT, stored consecutively in the columns
+ of VR, in the same order as their
+ eigenvalues.
+ A complex eigenvector corresponding to a complex eigenvalue
+ is stored in two consecutive columns, the first holding the
+ real part and the second the imaginary part.
+ If SIDE = 'L', VR is not referenced.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= max(1,N) if
+ SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+
+ MM (input) INTEGER
+ The number of columns in the arrays VL and/or VR. MM >= M.
+
+ M (output) INTEGER
+ The number of columns in the arrays VL and/or VR actually
+ used to store the eigenvectors.
+ If HOWMNY = 'A' or 'B', M is set to N.
+ Each selected real eigenvector occupies one column and each
+ selected complex eigenvector occupies two columns.
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (3*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The algorithm used in this program is basically backward (forward)
+ substitution, with scaling to make the the code robust against
+ possible overflow.
+
+ Each eigenvector is normalized so that the element of largest
+ magnitude has magnitude 1; here the magnitude of a complex number
+ (x,y) is taken to be |x| + |y|.
+
+ =====================================================================
+
+
+ Decode and test the input parameters
+*/
+
+ /* Parameter adjustments */
+ --select;
+ t_dim1 = *ldt;
+ t_offset = 1 + t_dim1 * 1;
+ t -= t_offset;
+ vl_dim1 = *ldvl;
+ vl_offset = 1 + vl_dim1 * 1;
+ vl -= vl_offset;
+ vr_dim1 = *ldvr;
+ vr_offset = 1 + vr_dim1 * 1;
+ vr -= vr_offset;
+ --work;
+
+ /* Function Body */
+ bothv = lsame_(side, "B");
+ rightv = lsame_(side, "R") || bothv;
+ leftv = lsame_(side, "L") || bothv;
+
+ allv = lsame_(howmny, "A");
+ over = lsame_(howmny, "B");
+ somev = lsame_(howmny, "S");
+
+ *info = 0;
+ if ((! rightv && ! leftv)) {
+ *info = -1;
+ } else if (((! allv && ! over) && ! somev)) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*ldt < max(1,*n)) {
+ *info = -6;
+ } else if (*ldvl < 1 || (leftv && *ldvl < *n)) {
+ *info = -8;
+ } else if (*ldvr < 1 || (rightv && *ldvr < *n)) {
+ *info = -10;
+ } else {
+
+/*
+ Set M to the number of columns required to store the selected
+ eigenvectors, standardize the array SELECT if necessary, and
+ test MM.
+*/
+
+ if (somev) {
+ *m = 0;
+ pair = FALSE_;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (pair) {
+ pair = FALSE_;
+ select[j] = FALSE_;
+ } else {
+ if (j < *n) {
+ if (t[j + 1 + j * t_dim1] == 0.) {
+ if (select[j]) {
+ ++(*m);
+ }
+ } else {
+ pair = TRUE_;
+ if (select[j] || select[j + 1]) {
+ select[j] = TRUE_;
+ *m += 2;
+ }
+ }
+ } else {
+ if (select[*n]) {
+ ++(*m);
+ }
+ }
+ }
+/* L10: */
+ }
+ } else {
+ *m = *n;
+ }
+
+ if (*mm < *m) {
+ *info = -11;
+ }
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DTREVC", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+/* Set the constants to control overflow. */
+
+ unfl = SAFEMINIMUM;
+ ovfl = 1. / unfl;
+ dlabad_(&unfl, &ovfl);
+ ulp = PRECISION;
+ smlnum = unfl * (*n / ulp);
+ bignum = (1. - ulp) / smlnum;
+
+/*
+ Compute 1-norm of each column of strictly upper triangular
+ part of T to control overflow in triangular solver.
+*/
+
+ work[1] = 0.;
+ i__1 = *n;
+ for (j = 2; j <= i__1; ++j) {
+ work[j] = 0.;
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ work[j] += (d__1 = t[i__ + j * t_dim1], abs(d__1));
+/* L20: */
+ }
+/* L30: */
+ }
+
+/*
+ Index IP is used to specify the real or complex eigenvalue:
+ IP = 0, real eigenvalue,
+ 1, first of conjugate complex pair: (wr,wi)
+ -1, second of conjugate complex pair: (wr,wi)
+*/
+
+ n2 = (*n) << (1);
+
+ if (rightv) {
+
+/* Compute right eigenvectors. */
+
+ ip = 0;
+ is = *m;
+ for (ki = *n; ki >= 1; --ki) {
+
+ if (ip == 1) {
+ goto L130;
+ }
+ if (ki == 1) {
+ goto L40;
+ }
+ if (t[ki + (ki - 1) * t_dim1] == 0.) {
+ goto L40;
+ }
+ ip = -1;
+
+L40:
+ if (somev) {
+ if (ip == 0) {
+ if (! select[ki]) {
+ goto L130;
+ }
+ } else {
+ if (! select[ki - 1]) {
+ goto L130;
+ }
+ }
+ }
+
+/* Compute the KI-th eigenvalue (WR,WI). */
+
+ wr = t[ki + ki * t_dim1];
+ wi = 0.;
+ if (ip != 0) {
+ wi = sqrt((d__1 = t[ki + (ki - 1) * t_dim1], abs(d__1))) *
+ sqrt((d__2 = t[ki - 1 + ki * t_dim1], abs(d__2)));
+ }
+/* Computing MAX */
+ d__1 = ulp * (abs(wr) + abs(wi));
+ smin = max(d__1,smlnum);
+
+ if (ip == 0) {
+
+/* Real right eigenvector */
+
+ work[ki + *n] = 1.;
+
+/* Form right-hand side */
+
+ i__1 = ki - 1;
+ for (k = 1; k <= i__1; ++k) {
+ work[k + *n] = -t[k + ki * t_dim1];
+/* L50: */
+ }
+
+/*
+ Solve the upper quasi-triangular system:
+ (T(1:KI-1,1:KI-1) - WR)*X = SCALE*WORK.
+*/
+
+ jnxt = ki - 1;
+ for (j = ki - 1; j >= 1; --j) {
+ if (j > jnxt) {
+ goto L60;
+ }
+ j1 = j;
+ j2 = j;
+ jnxt = j - 1;
+ if (j > 1) {
+ if (t[j + (j - 1) * t_dim1] != 0.) {
+ j1 = j - 1;
+ jnxt = j - 2;
+ }
+ }
+
+ if (j1 == j2) {
+
+/* 1-by-1 diagonal block */
+
+ dlaln2_(&c_false, &c__1, &c__1, &smin, &c_b15, &t[j +
+ j * t_dim1], ldt, &c_b15, &c_b15, &work[j + *
+ n], n, &wr, &c_b29, x, &c__2, &scale, &xnorm,
+ &ierr);
+
+/*
+ Scale X(1,1) to avoid overflow when updating
+ the right-hand side.
+*/
+
+ if (xnorm > 1.) {
+ if (work[j] > bignum / xnorm) {
+ x[0] /= xnorm;
+ scale /= xnorm;
+ }
+ }
+
+/* Scale if necessary */
+
+ if (scale != 1.) {
+ dscal_(&ki, &scale, &work[*n + 1], &c__1);
+ }
+ work[j + *n] = x[0];
+
+/* Update right-hand side */
+
+ i__1 = j - 1;
+ d__1 = -x[0];
+ daxpy_(&i__1, &d__1, &t[j * t_dim1 + 1], &c__1, &work[
+ *n + 1], &c__1);
+
+ } else {
+
+/* 2-by-2 diagonal block */
+
+ dlaln2_(&c_false, &c__2, &c__1, &smin, &c_b15, &t[j -
+ 1 + (j - 1) * t_dim1], ldt, &c_b15, &c_b15, &
+ work[j - 1 + *n], n, &wr, &c_b29, x, &c__2, &
+ scale, &xnorm, &ierr);
+
+/*
+ Scale X(1,1) and X(2,1) to avoid overflow when
+ updating the right-hand side.
+*/
+
+ if (xnorm > 1.) {
+/* Computing MAX */
+ d__1 = work[j - 1], d__2 = work[j];
+ beta = max(d__1,d__2);
+ if (beta > bignum / xnorm) {
+ x[0] /= xnorm;
+ x[1] /= xnorm;
+ scale /= xnorm;
+ }
+ }
+
+/* Scale if necessary */
+
+ if (scale != 1.) {
+ dscal_(&ki, &scale, &work[*n + 1], &c__1);
+ }
+ work[j - 1 + *n] = x[0];
+ work[j + *n] = x[1];
+
+/* Update right-hand side */
+
+ i__1 = j - 2;
+ d__1 = -x[0];
+ daxpy_(&i__1, &d__1, &t[(j - 1) * t_dim1 + 1], &c__1,
+ &work[*n + 1], &c__1);
+ i__1 = j - 2;
+ d__1 = -x[1];
+ daxpy_(&i__1, &d__1, &t[j * t_dim1 + 1], &c__1, &work[
+ *n + 1], &c__1);
+ }
+L60:
+ ;
+ }
+
+/* Copy the vector x or Q*x to VR and normalize. */
+
+ if (! over) {
+ dcopy_(&ki, &work[*n + 1], &c__1, &vr[is * vr_dim1 + 1], &
+ c__1);
+
+ ii = idamax_(&ki, &vr[is * vr_dim1 + 1], &c__1);
+ remax = 1. / (d__1 = vr[ii + is * vr_dim1], abs(d__1));
+ dscal_(&ki, &remax, &vr[is * vr_dim1 + 1], &c__1);
+
+ i__1 = *n;
+ for (k = ki + 1; k <= i__1; ++k) {
+ vr[k + is * vr_dim1] = 0.;
+/* L70: */
+ }
+ } else {
+ if (ki > 1) {
+ i__1 = ki - 1;
+ dgemv_("N", n, &i__1, &c_b15, &vr[vr_offset], ldvr, &
+ work[*n + 1], &c__1, &work[ki + *n], &vr[ki *
+ vr_dim1 + 1], &c__1);
+ }
+
+ ii = idamax_(n, &vr[ki * vr_dim1 + 1], &c__1);
+ remax = 1. / (d__1 = vr[ii + ki * vr_dim1], abs(d__1));
+ dscal_(n, &remax, &vr[ki * vr_dim1 + 1], &c__1);
+ }
+
+ } else {
+
+/*
+ Complex right eigenvector.
+
+ Initial solve
+ [ (T(KI-1,KI-1) T(KI-1,KI) ) - (WR + I* WI)]*X = 0.
+ [ (T(KI,KI-1) T(KI,KI) ) ]
+*/
+
+ if ((d__1 = t[ki - 1 + ki * t_dim1], abs(d__1)) >= (d__2 = t[
+ ki + (ki - 1) * t_dim1], abs(d__2))) {
+ work[ki - 1 + *n] = 1.;
+ work[ki + n2] = wi / t[ki - 1 + ki * t_dim1];
+ } else {
+ work[ki - 1 + *n] = -wi / t[ki + (ki - 1) * t_dim1];
+ work[ki + n2] = 1.;
+ }
+ work[ki + *n] = 0.;
+ work[ki - 1 + n2] = 0.;
+
+/* Form right-hand side */
+
+ i__1 = ki - 2;
+ for (k = 1; k <= i__1; ++k) {
+ work[k + *n] = -work[ki - 1 + *n] * t[k + (ki - 1) *
+ t_dim1];
+ work[k + n2] = -work[ki + n2] * t[k + ki * t_dim1];
+/* L80: */
+ }
+
+/*
+ Solve upper quasi-triangular system:
+ (T(1:KI-2,1:KI-2) - (WR+i*WI))*X = SCALE*(WORK+i*WORK2)
+*/
+
+ jnxt = ki - 2;
+ for (j = ki - 2; j >= 1; --j) {
+ if (j > jnxt) {
+ goto L90;
+ }
+ j1 = j;
+ j2 = j;
+ jnxt = j - 1;
+ if (j > 1) {
+ if (t[j + (j - 1) * t_dim1] != 0.) {
+ j1 = j - 1;
+ jnxt = j - 2;
+ }
+ }
+
+ if (j1 == j2) {
+
+/* 1-by-1 diagonal block */
+
+ dlaln2_(&c_false, &c__1, &c__2, &smin, &c_b15, &t[j +
+ j * t_dim1], ldt, &c_b15, &c_b15, &work[j + *
+ n], n, &wr, &wi, x, &c__2, &scale, &xnorm, &
+ ierr);
+
+/*
+ Scale X(1,1) and X(1,2) to avoid overflow when
+ updating the right-hand side.
+*/
+
+ if (xnorm > 1.) {
+ if (work[j] > bignum / xnorm) {
+ x[0] /= xnorm;
+ x[2] /= xnorm;
+ scale /= xnorm;
+ }
+ }
+
+/* Scale if necessary */
+
+ if (scale != 1.) {
+ dscal_(&ki, &scale, &work[*n + 1], &c__1);
+ dscal_(&ki, &scale, &work[n2 + 1], &c__1);
+ }
+ work[j + *n] = x[0];
+ work[j + n2] = x[2];
+
+/* Update the right-hand side */
+
+ i__1 = j - 1;
+ d__1 = -x[0];
+ daxpy_(&i__1, &d__1, &t[j * t_dim1 + 1], &c__1, &work[
+ *n + 1], &c__1);
+ i__1 = j - 1;
+ d__1 = -x[2];
+ daxpy_(&i__1, &d__1, &t[j * t_dim1 + 1], &c__1, &work[
+ n2 + 1], &c__1);
+
+ } else {
+
+/* 2-by-2 diagonal block */
+
+ dlaln2_(&c_false, &c__2, &c__2, &smin, &c_b15, &t[j -
+ 1 + (j - 1) * t_dim1], ldt, &c_b15, &c_b15, &
+ work[j - 1 + *n], n, &wr, &wi, x, &c__2, &
+ scale, &xnorm, &ierr);
+
+/*
+ Scale X to avoid overflow when updating
+ the right-hand side.
+*/
+
+ if (xnorm > 1.) {
+/* Computing MAX */
+ d__1 = work[j - 1], d__2 = work[j];
+ beta = max(d__1,d__2);
+ if (beta > bignum / xnorm) {
+ rec = 1. / xnorm;
+ x[0] *= rec;
+ x[2] *= rec;
+ x[1] *= rec;
+ x[3] *= rec;
+ scale *= rec;
+ }
+ }
+
+/* Scale if necessary */
+
+ if (scale != 1.) {
+ dscal_(&ki, &scale, &work[*n + 1], &c__1);
+ dscal_(&ki, &scale, &work[n2 + 1], &c__1);
+ }
+ work[j - 1 + *n] = x[0];
+ work[j + *n] = x[1];
+ work[j - 1 + n2] = x[2];
+ work[j + n2] = x[3];
+
+/* Update the right-hand side */
+
+ i__1 = j - 2;
+ d__1 = -x[0];
+ daxpy_(&i__1, &d__1, &t[(j - 1) * t_dim1 + 1], &c__1,
+ &work[*n + 1], &c__1);
+ i__1 = j - 2;
+ d__1 = -x[1];
+ daxpy_(&i__1, &d__1, &t[j * t_dim1 + 1], &c__1, &work[
+ *n + 1], &c__1);
+ i__1 = j - 2;
+ d__1 = -x[2];
+ daxpy_(&i__1, &d__1, &t[(j - 1) * t_dim1 + 1], &c__1,
+ &work[n2 + 1], &c__1);
+ i__1 = j - 2;
+ d__1 = -x[3];
+ daxpy_(&i__1, &d__1, &t[j * t_dim1 + 1], &c__1, &work[
+ n2 + 1], &c__1);
+ }
+L90:
+ ;
+ }
+
+/* Copy the vector x or Q*x to VR and normalize. */
+
+ if (! over) {
+ dcopy_(&ki, &work[*n + 1], &c__1, &vr[(is - 1) * vr_dim1
+ + 1], &c__1);
+ dcopy_(&ki, &work[n2 + 1], &c__1, &vr[is * vr_dim1 + 1], &
+ c__1);
+
+ emax = 0.;
+ i__1 = ki;
+ for (k = 1; k <= i__1; ++k) {
+/* Computing MAX */
+ d__3 = emax, d__4 = (d__1 = vr[k + (is - 1) * vr_dim1]
+ , abs(d__1)) + (d__2 = vr[k + is * vr_dim1],
+ abs(d__2));
+ emax = max(d__3,d__4);
+/* L100: */
+ }
+
+ remax = 1. / emax;
+ dscal_(&ki, &remax, &vr[(is - 1) * vr_dim1 + 1], &c__1);
+ dscal_(&ki, &remax, &vr[is * vr_dim1 + 1], &c__1);
+
+ i__1 = *n;
+ for (k = ki + 1; k <= i__1; ++k) {
+ vr[k + (is - 1) * vr_dim1] = 0.;
+ vr[k + is * vr_dim1] = 0.;
+/* L110: */
+ }
+
+ } else {
+
+ if (ki > 2) {
+ i__1 = ki - 2;
+ dgemv_("N", n, &i__1, &c_b15, &vr[vr_offset], ldvr, &
+ work[*n + 1], &c__1, &work[ki - 1 + *n], &vr[(
+ ki - 1) * vr_dim1 + 1], &c__1);
+ i__1 = ki - 2;
+ dgemv_("N", n, &i__1, &c_b15, &vr[vr_offset], ldvr, &
+ work[n2 + 1], &c__1, &work[ki + n2], &vr[ki *
+ vr_dim1 + 1], &c__1);
+ } else {
+ dscal_(n, &work[ki - 1 + *n], &vr[(ki - 1) * vr_dim1
+ + 1], &c__1);
+ dscal_(n, &work[ki + n2], &vr[ki * vr_dim1 + 1], &
+ c__1);
+ }
+
+ emax = 0.;
+ i__1 = *n;
+ for (k = 1; k <= i__1; ++k) {
+/* Computing MAX */
+ d__3 = emax, d__4 = (d__1 = vr[k + (ki - 1) * vr_dim1]
+ , abs(d__1)) + (d__2 = vr[k + ki * vr_dim1],
+ abs(d__2));
+ emax = max(d__3,d__4);
+/* L120: */
+ }
+ remax = 1. / emax;
+ dscal_(n, &remax, &vr[(ki - 1) * vr_dim1 + 1], &c__1);
+ dscal_(n, &remax, &vr[ki * vr_dim1 + 1], &c__1);
+ }
+ }
+
+ --is;
+ if (ip != 0) {
+ --is;
+ }
+L130:
+ if (ip == 1) {
+ ip = 0;
+ }
+ if (ip == -1) {
+ ip = 1;
+ }
+/* L140: */
+ }
+ }
+
+ if (leftv) {
+
+/* Compute left eigenvectors. */
+
+ ip = 0;
+ is = 1;
+ i__1 = *n;
+ for (ki = 1; ki <= i__1; ++ki) {
+
+ if (ip == -1) {
+ goto L250;
+ }
+ if (ki == *n) {
+ goto L150;
+ }
+ if (t[ki + 1 + ki * t_dim1] == 0.) {
+ goto L150;
+ }
+ ip = 1;
+
+L150:
+ if (somev) {
+ if (! select[ki]) {
+ goto L250;
+ }
+ }
+
+/* Compute the KI-th eigenvalue (WR,WI). */
+
+ wr = t[ki + ki * t_dim1];
+ wi = 0.;
+ if (ip != 0) {
+ wi = sqrt((d__1 = t[ki + (ki + 1) * t_dim1], abs(d__1))) *
+ sqrt((d__2 = t[ki + 1 + ki * t_dim1], abs(d__2)));
+ }
+/* Computing MAX */
+ d__1 = ulp * (abs(wr) + abs(wi));
+ smin = max(d__1,smlnum);
+
+ if (ip == 0) {
+
+/* Real left eigenvector. */
+
+ work[ki + *n] = 1.;
+
+/* Form right-hand side */
+
+ i__2 = *n;
+ for (k = ki + 1; k <= i__2; ++k) {
+ work[k + *n] = -t[ki + k * t_dim1];
+/* L160: */
+ }
+
+/*
+ Solve the quasi-triangular system:
+ (T(KI+1:N,KI+1:N) - WR)'*X = SCALE*WORK
+*/
+
+ vmax = 1.;
+ vcrit = bignum;
+
+ jnxt = ki + 1;
+ i__2 = *n;
+ for (j = ki + 1; j <= i__2; ++j) {
+ if (j < jnxt) {
+ goto L170;
+ }
+ j1 = j;
+ j2 = j;
+ jnxt = j + 1;
+ if (j < *n) {
+ if (t[j + 1 + j * t_dim1] != 0.) {
+ j2 = j + 1;
+ jnxt = j + 2;
+ }
+ }
+
+ if (j1 == j2) {
+
+/*
+ 1-by-1 diagonal block
+
+ Scale if necessary to avoid overflow when forming
+ the right-hand side.
+*/
+
+ if (work[j] > vcrit) {
+ rec = 1. / vmax;
+ i__3 = *n - ki + 1;
+ dscal_(&i__3, &rec, &work[ki + *n], &c__1);
+ vmax = 1.;
+ vcrit = bignum;
+ }
+
+ i__3 = j - ki - 1;
+ work[j + *n] -= ddot_(&i__3, &t[ki + 1 + j * t_dim1],
+ &c__1, &work[ki + 1 + *n], &c__1);
+
+/* Solve (T(J,J)-WR)'*X = WORK */
+
+ dlaln2_(&c_false, &c__1, &c__1, &smin, &c_b15, &t[j +
+ j * t_dim1], ldt, &c_b15, &c_b15, &work[j + *
+ n], n, &wr, &c_b29, x, &c__2, &scale, &xnorm,
+ &ierr);
+
+/* Scale if necessary */
+
+ if (scale != 1.) {
+ i__3 = *n - ki + 1;
+ dscal_(&i__3, &scale, &work[ki + *n], &c__1);
+ }
+ work[j + *n] = x[0];
+/* Computing MAX */
+ d__2 = (d__1 = work[j + *n], abs(d__1));
+ vmax = max(d__2,vmax);
+ vcrit = bignum / vmax;
+
+ } else {
+
+/*
+ 2-by-2 diagonal block
+
+ Scale if necessary to avoid overflow when forming
+ the right-hand side.
+
+ Computing MAX
+*/
+ d__1 = work[j], d__2 = work[j + 1];
+ beta = max(d__1,d__2);
+ if (beta > vcrit) {
+ rec = 1. / vmax;
+ i__3 = *n - ki + 1;
+ dscal_(&i__3, &rec, &work[ki + *n], &c__1);
+ vmax = 1.;
+ vcrit = bignum;
+ }
+
+ i__3 = j - ki - 1;
+ work[j + *n] -= ddot_(&i__3, &t[ki + 1 + j * t_dim1],
+ &c__1, &work[ki + 1 + *n], &c__1);
+
+ i__3 = j - ki - 1;
+ work[j + 1 + *n] -= ddot_(&i__3, &t[ki + 1 + (j + 1) *
+ t_dim1], &c__1, &work[ki + 1 + *n], &c__1);
+
+/*
+ Solve
+ [T(J,J)-WR T(J,J+1) ]'* X = SCALE*( WORK1 )
+ [T(J+1,J) T(J+1,J+1)-WR] ( WORK2 )
+*/
+
+ dlaln2_(&c_true, &c__2, &c__1, &smin, &c_b15, &t[j +
+ j * t_dim1], ldt, &c_b15, &c_b15, &work[j + *
+ n], n, &wr, &c_b29, x, &c__2, &scale, &xnorm,
+ &ierr);
+
+/* Scale if necessary */
+
+ if (scale != 1.) {
+ i__3 = *n - ki + 1;
+ dscal_(&i__3, &scale, &work[ki + *n], &c__1);
+ }
+ work[j + *n] = x[0];
+ work[j + 1 + *n] = x[1];
+
+/* Computing MAX */
+ d__3 = (d__1 = work[j + *n], abs(d__1)), d__4 = (d__2
+ = work[j + 1 + *n], abs(d__2)), d__3 = max(
+ d__3,d__4);
+ vmax = max(d__3,vmax);
+ vcrit = bignum / vmax;
+
+ }
+L170:
+ ;
+ }
+
+/* Copy the vector x or Q*x to VL and normalize. */
+
+ if (! over) {
+ i__2 = *n - ki + 1;
+ dcopy_(&i__2, &work[ki + *n], &c__1, &vl[ki + is *
+ vl_dim1], &c__1);
+
+ i__2 = *n - ki + 1;
+ ii = idamax_(&i__2, &vl[ki + is * vl_dim1], &c__1) + ki -
+ 1;
+ remax = 1. / (d__1 = vl[ii + is * vl_dim1], abs(d__1));
+ i__2 = *n - ki + 1;
+ dscal_(&i__2, &remax, &vl[ki + is * vl_dim1], &c__1);
+
+ i__2 = ki - 1;
+ for (k = 1; k <= i__2; ++k) {
+ vl[k + is * vl_dim1] = 0.;
+/* L180: */
+ }
+
+ } else {
+
+ if (ki < *n) {
+ i__2 = *n - ki;
+ dgemv_("N", n, &i__2, &c_b15, &vl[(ki + 1) * vl_dim1
+ + 1], ldvl, &work[ki + 1 + *n], &c__1, &work[
+ ki + *n], &vl[ki * vl_dim1 + 1], &c__1);
+ }
+
+ ii = idamax_(n, &vl[ki * vl_dim1 + 1], &c__1);
+ remax = 1. / (d__1 = vl[ii + ki * vl_dim1], abs(d__1));
+ dscal_(n, &remax, &vl[ki * vl_dim1 + 1], &c__1);
+
+ }
+
+ } else {
+
+/*
+ Complex left eigenvector.
+
+ Initial solve:
+ ((T(KI,KI) T(KI,KI+1) )' - (WR - I* WI))*X = 0.
+ ((T(KI+1,KI) T(KI+1,KI+1)) )
+*/
+
+ if ((d__1 = t[ki + (ki + 1) * t_dim1], abs(d__1)) >= (d__2 =
+ t[ki + 1 + ki * t_dim1], abs(d__2))) {
+ work[ki + *n] = wi / t[ki + (ki + 1) * t_dim1];
+ work[ki + 1 + n2] = 1.;
+ } else {
+ work[ki + *n] = 1.;
+ work[ki + 1 + n2] = -wi / t[ki + 1 + ki * t_dim1];
+ }
+ work[ki + 1 + *n] = 0.;
+ work[ki + n2] = 0.;
+
+/* Form right-hand side */
+
+ i__2 = *n;
+ for (k = ki + 2; k <= i__2; ++k) {
+ work[k + *n] = -work[ki + *n] * t[ki + k * t_dim1];
+ work[k + n2] = -work[ki + 1 + n2] * t[ki + 1 + k * t_dim1]
+ ;
+/* L190: */
+ }
+
+/*
+ Solve complex quasi-triangular system:
+ ( T(KI+2,N:KI+2,N) - (WR-i*WI) )*X = WORK1+i*WORK2
+*/
+
+ vmax = 1.;
+ vcrit = bignum;
+
+ jnxt = ki + 2;
+ i__2 = *n;
+ for (j = ki + 2; j <= i__2; ++j) {
+ if (j < jnxt) {
+ goto L200;
+ }
+ j1 = j;
+ j2 = j;
+ jnxt = j + 1;
+ if (j < *n) {
+ if (t[j + 1 + j * t_dim1] != 0.) {
+ j2 = j + 1;
+ jnxt = j + 2;
+ }
+ }
+
+ if (j1 == j2) {
+
+/*
+ 1-by-1 diagonal block
+
+ Scale if necessary to avoid overflow when
+ forming the right-hand side elements.
+*/
+
+ if (work[j] > vcrit) {
+ rec = 1. / vmax;
+ i__3 = *n - ki + 1;
+ dscal_(&i__3, &rec, &work[ki + *n], &c__1);
+ i__3 = *n - ki + 1;
+ dscal_(&i__3, &rec, &work[ki + n2], &c__1);
+ vmax = 1.;
+ vcrit = bignum;
+ }
+
+ i__3 = j - ki - 2;
+ work[j + *n] -= ddot_(&i__3, &t[ki + 2 + j * t_dim1],
+ &c__1, &work[ki + 2 + *n], &c__1);
+ i__3 = j - ki - 2;
+ work[j + n2] -= ddot_(&i__3, &t[ki + 2 + j * t_dim1],
+ &c__1, &work[ki + 2 + n2], &c__1);
+
+/* Solve (T(J,J)-(WR-i*WI))*(X11+i*X12)= WK+I*WK2 */
+
+ d__1 = -wi;
+ dlaln2_(&c_false, &c__1, &c__2, &smin, &c_b15, &t[j +
+ j * t_dim1], ldt, &c_b15, &c_b15, &work[j + *
+ n], n, &wr, &d__1, x, &c__2, &scale, &xnorm, &
+ ierr);
+
+/* Scale if necessary */
+
+ if (scale != 1.) {
+ i__3 = *n - ki + 1;
+ dscal_(&i__3, &scale, &work[ki + *n], &c__1);
+ i__3 = *n - ki + 1;
+ dscal_(&i__3, &scale, &work[ki + n2], &c__1);
+ }
+ work[j + *n] = x[0];
+ work[j + n2] = x[2];
+/* Computing MAX */
+ d__3 = (d__1 = work[j + *n], abs(d__1)), d__4 = (d__2
+ = work[j + n2], abs(d__2)), d__3 = max(d__3,
+ d__4);
+ vmax = max(d__3,vmax);
+ vcrit = bignum / vmax;
+
+ } else {
+
+/*
+ 2-by-2 diagonal block
+
+ Scale if necessary to avoid overflow when forming
+ the right-hand side elements.
+
+ Computing MAX
+*/
+ d__1 = work[j], d__2 = work[j + 1];
+ beta = max(d__1,d__2);
+ if (beta > vcrit) {
+ rec = 1. / vmax;
+ i__3 = *n - ki + 1;
+ dscal_(&i__3, &rec, &work[ki + *n], &c__1);
+ i__3 = *n - ki + 1;
+ dscal_(&i__3, &rec, &work[ki + n2], &c__1);
+ vmax = 1.;
+ vcrit = bignum;
+ }
+
+ i__3 = j - ki - 2;
+ work[j + *n] -= ddot_(&i__3, &t[ki + 2 + j * t_dim1],
+ &c__1, &work[ki + 2 + *n], &c__1);
+
+ i__3 = j - ki - 2;
+ work[j + n2] -= ddot_(&i__3, &t[ki + 2 + j * t_dim1],
+ &c__1, &work[ki + 2 + n2], &c__1);
+
+ i__3 = j - ki - 2;
+ work[j + 1 + *n] -= ddot_(&i__3, &t[ki + 2 + (j + 1) *
+ t_dim1], &c__1, &work[ki + 2 + *n], &c__1);
+
+ i__3 = j - ki - 2;
+ work[j + 1 + n2] -= ddot_(&i__3, &t[ki + 2 + (j + 1) *
+ t_dim1], &c__1, &work[ki + 2 + n2], &c__1);
+
+/*
+ Solve 2-by-2 complex linear equation
+ ([T(j,j) T(j,j+1) ]'-(wr-i*wi)*I)*X = SCALE*B
+ ([T(j+1,j) T(j+1,j+1)] )
+*/
+
+ d__1 = -wi;
+ dlaln2_(&c_true, &c__2, &c__2, &smin, &c_b15, &t[j +
+ j * t_dim1], ldt, &c_b15, &c_b15, &work[j + *
+ n], n, &wr, &d__1, x, &c__2, &scale, &xnorm, &
+ ierr);
+
+/* Scale if necessary */
+
+ if (scale != 1.) {
+ i__3 = *n - ki + 1;
+ dscal_(&i__3, &scale, &work[ki + *n], &c__1);
+ i__3 = *n - ki + 1;
+ dscal_(&i__3, &scale, &work[ki + n2], &c__1);
+ }
+ work[j + *n] = x[0];
+ work[j + n2] = x[2];
+ work[j + 1 + *n] = x[1];
+ work[j + 1 + n2] = x[3];
+/* Computing MAX */
+ d__1 = abs(x[0]), d__2 = abs(x[2]), d__1 = max(d__1,
+ d__2), d__2 = abs(x[1]), d__1 = max(d__1,d__2)
+ , d__2 = abs(x[3]), d__1 = max(d__1,d__2);
+ vmax = max(d__1,vmax);
+ vcrit = bignum / vmax;
+
+ }
+L200:
+ ;
+ }
+
+/*
+ Copy the vector x or Q*x to VL and normalize.
+
+ L210:
+*/
+ if (! over) {
+ i__2 = *n - ki + 1;
+ dcopy_(&i__2, &work[ki + *n], &c__1, &vl[ki + is *
+ vl_dim1], &c__1);
+ i__2 = *n - ki + 1;
+ dcopy_(&i__2, &work[ki + n2], &c__1, &vl[ki + (is + 1) *
+ vl_dim1], &c__1);
+
+ emax = 0.;
+ i__2 = *n;
+ for (k = ki; k <= i__2; ++k) {
+/* Computing MAX */
+ d__3 = emax, d__4 = (d__1 = vl[k + is * vl_dim1], abs(
+ d__1)) + (d__2 = vl[k + (is + 1) * vl_dim1],
+ abs(d__2));
+ emax = max(d__3,d__4);
+/* L220: */
+ }
+ remax = 1. / emax;
+ i__2 = *n - ki + 1;
+ dscal_(&i__2, &remax, &vl[ki + is * vl_dim1], &c__1);
+ i__2 = *n - ki + 1;
+ dscal_(&i__2, &remax, &vl[ki + (is + 1) * vl_dim1], &c__1)
+ ;
+
+ i__2 = ki - 1;
+ for (k = 1; k <= i__2; ++k) {
+ vl[k + is * vl_dim1] = 0.;
+ vl[k + (is + 1) * vl_dim1] = 0.;
+/* L230: */
+ }
+ } else {
+ if (ki < *n - 1) {
+ i__2 = *n - ki - 1;
+ dgemv_("N", n, &i__2, &c_b15, &vl[(ki + 2) * vl_dim1
+ + 1], ldvl, &work[ki + 2 + *n], &c__1, &work[
+ ki + *n], &vl[ki * vl_dim1 + 1], &c__1);
+ i__2 = *n - ki - 1;
+ dgemv_("N", n, &i__2, &c_b15, &vl[(ki + 2) * vl_dim1
+ + 1], ldvl, &work[ki + 2 + n2], &c__1, &work[
+ ki + 1 + n2], &vl[(ki + 1) * vl_dim1 + 1], &
+ c__1);
+ } else {
+ dscal_(n, &work[ki + *n], &vl[ki * vl_dim1 + 1], &
+ c__1);
+ dscal_(n, &work[ki + 1 + n2], &vl[(ki + 1) * vl_dim1
+ + 1], &c__1);
+ }
+
+ emax = 0.;
+ i__2 = *n;
+ for (k = 1; k <= i__2; ++k) {
+/* Computing MAX */
+ d__3 = emax, d__4 = (d__1 = vl[k + ki * vl_dim1], abs(
+ d__1)) + (d__2 = vl[k + (ki + 1) * vl_dim1],
+ abs(d__2));
+ emax = max(d__3,d__4);
+/* L240: */
+ }
+ remax = 1. / emax;
+ dscal_(n, &remax, &vl[ki * vl_dim1 + 1], &c__1);
+ dscal_(n, &remax, &vl[(ki + 1) * vl_dim1 + 1], &c__1);
+
+ }
+
+ }
+
+ ++is;
+ if (ip != 0) {
+ ++is;
+ }
+L250:
+ if (ip == -1) {
+ ip = 0;
+ }
+ if (ip == 1) {
+ ip = -1;
+ }
+
+/* L260: */
+ }
+
+ }
+
+ return 0;
+
+/* End of DTREVC */
+
+} /* dtrevc_ */
+
+integer ieeeck_(integer *ispec, real *zero, real *one)
+{
+ /* System generated locals */
+ integer ret_val;
+
+ /* Local variables */
+ static real nan1, nan2, nan3, nan4, nan5, nan6, neginf, posinf, negzro,
+ newzro;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1998
+
+
+ Purpose
+ =======
+
+ IEEECK is called from the ILAENV to verify that Infinity and
+ possibly NaN arithmetic is safe (i.e. will not trap).
+
+ Arguments
+ =========
+
+ ISPEC (input) INTEGER
+ Specifies whether to test just for inifinity arithmetic
+ or whether to test for infinity and NaN arithmetic.
+ = 0: Verify infinity arithmetic only.
+ = 1: Verify infinity and NaN arithmetic.
+
+ ZERO (input) REAL
+ Must contain the value 0.0
+ This is passed to prevent the compiler from optimizing
+ away this code.
+
+ ONE (input) REAL
+ Must contain the value 1.0
+ This is passed to prevent the compiler from optimizing
+ away this code.
+
+ RETURN VALUE: INTEGER
+ = 0: Arithmetic failed to produce the correct answers
+ = 1: Arithmetic produced the correct answers
+*/
+
+ ret_val = 1;
+
+ posinf = *one / *zero;
+ if (posinf <= *one) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ neginf = -(*one) / *zero;
+ if (neginf >= *zero) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ negzro = *one / (neginf + *one);
+ if (negzro != *zero) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ neginf = *one / negzro;
+ if (neginf >= *zero) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ newzro = negzro + *zero;
+ if (newzro != *zero) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ posinf = *one / newzro;
+ if (posinf <= *one) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ neginf *= posinf;
+ if (neginf >= *zero) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ posinf *= posinf;
+ if (posinf <= *one) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+
+/* Return if we were only asked to check infinity arithmetic */
+
+ if (*ispec == 0) {
+ return ret_val;
+ }
+
+ nan1 = posinf + neginf;
+
+ nan2 = posinf / neginf;
+
+ nan3 = posinf / posinf;
+
+ nan4 = posinf * *zero;
+
+ nan5 = neginf * negzro;
+
+ nan6 = nan5 * 0.f;
+
+ if (nan1 == nan1) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ if (nan2 == nan2) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ if (nan3 == nan3) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ if (nan4 == nan4) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ if (nan5 == nan5) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ if (nan6 == nan6) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ return ret_val;
+} /* ieeeck_ */
+
+integer ilaenv_(integer *ispec, char *name__, char *opts, integer *n1,
+ integer *n2, integer *n3, integer *n4, ftnlen name_len, ftnlen
+ opts_len)
+{
+ /* System generated locals */
+ integer ret_val;
+
+ /* Builtin functions */
+ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
+ integer s_cmp(char *, char *, ftnlen, ftnlen);
+
+ /* Local variables */
+ static integer i__;
+ static char c1[1], c2[2], c3[3], c4[2];
+ static integer ic, nb, iz, nx;
+ static logical cname, sname;
+ static integer nbmin;
+ extern integer ieeeck_(integer *, real *, real *);
+ static char subnam[6];
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ILAENV is called from the LAPACK routines to choose problem-dependent
+ parameters for the local environment. See ISPEC for a description of
+ the parameters.
+
+ This version provides a set of parameters which should give good,
+ but not optimal, performance on many of the currently available
+ computers. Users are encouraged to modify this subroutine to set
+ the tuning parameters for their particular machine using the option
+ and problem size information in the arguments.
+
+ This routine will not function correctly if it is converted to all
+ lower case. Converting it to all upper case is allowed.
+
+ Arguments
+ =========
+
+ ISPEC (input) INTEGER
+ Specifies the parameter to be returned as the value of
+ ILAENV.
+ = 1: the optimal blocksize; if this value is 1, an unblocked
+ algorithm will give the best performance.
+ = 2: the minimum block size for which the block routine
+ should be used; if the usable block size is less than
+ this value, an unblocked routine should be used.
+ = 3: the crossover point (in a block routine, for N less
+ than this value, an unblocked routine should be used)
+ = 4: the number of shifts, used in the nonsymmetric
+ eigenvalue routines
+ = 5: the minimum column dimension for blocking to be used;
+ rectangular blocks must have dimension at least k by m,
+ where k is given by ILAENV(2,...) and m by ILAENV(5,...)
+ = 6: the crossover point for the SVD (when reducing an m by n
+ matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds
+ this value, a QR factorization is used first to reduce
+ the matrix to a triangular form.)
+ = 7: the number of processors
+ = 8: the crossover point for the multishift QR and QZ methods
+ for nonsymmetric eigenvalue problems.
+ = 9: maximum size of the subproblems at the bottom of the
+ computation tree in the divide-and-conquer algorithm
+ (used by xGELSD and xGESDD)
+ =10: ieee NaN arithmetic can be trusted not to trap
+ =11: infinity arithmetic can be trusted not to trap
+
+ NAME (input) CHARACTER*(*)
+ The name of the calling subroutine, in either upper case or
+ lower case.
+
+ OPTS (input) CHARACTER*(*)
+ The character options to the subroutine NAME, concatenated
+ into a single character string. For example, UPLO = 'U',
+ TRANS = 'T', and DIAG = 'N' for a triangular routine would
+ be specified as OPTS = 'UTN'.
+
+ N1 (input) INTEGER
+ N2 (input) INTEGER
+ N3 (input) INTEGER
+ N4 (input) INTEGER
+ Problem dimensions for the subroutine NAME; these may not all
+ be required.
+
+ (ILAENV) (output) INTEGER
+ >= 0: the value of the parameter specified by ISPEC
+ < 0: if ILAENV = -k, the k-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The following conventions have been used when calling ILAENV from the
+ LAPACK routines:
+ 1) OPTS is a concatenation of all of the character options to
+ subroutine NAME, in the same order that they appear in the
+ argument list for NAME, even if they are not used in determining
+ the value of the parameter specified by ISPEC.
+ 2) The problem dimensions N1, N2, N3, N4 are specified in the order
+ that they appear in the argument list for NAME. N1 is used
+ first, N2 second, and so on, and unused problem dimensions are
+ passed a value of -1.
+ 3) The parameter value returned by ILAENV is checked for validity in
+ the calling subroutine. For example, ILAENV is used to retrieve
+ the optimal blocksize for STRTRI as follows:
+
+ NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
+ IF( NB.LE.1 ) NB = MAX( 1, N )
+
+ =====================================================================
+*/
+
+
+ switch (*ispec) {
+ case 1: goto L100;
+ case 2: goto L100;
+ case 3: goto L100;
+ case 4: goto L400;
+ case 5: goto L500;
+ case 6: goto L600;
+ case 7: goto L700;
+ case 8: goto L800;
+ case 9: goto L900;
+ case 10: goto L1000;
+ case 11: goto L1100;
+ }
+
+/* Invalid value for ISPEC */
+
+ ret_val = -1;
+ return ret_val;
+
+L100:
+
+/* Convert NAME to upper case if the first character is lower case. */
+
+ ret_val = 1;
+ s_copy(subnam, name__, (ftnlen)6, name_len);
+ ic = *(unsigned char *)subnam;
+ iz = 'Z';
+ if (iz == 90 || iz == 122) {
+
+/* ASCII character set */
+
+ if ((ic >= 97 && ic <= 122)) {
+ *(unsigned char *)subnam = (char) (ic - 32);
+ for (i__ = 2; i__ <= 6; ++i__) {
+ ic = *(unsigned char *)&subnam[i__ - 1];
+ if ((ic >= 97 && ic <= 122)) {
+ *(unsigned char *)&subnam[i__ - 1] = (char) (ic - 32);
+ }
+/* L10: */
+ }
+ }
+
+ } else if (iz == 233 || iz == 169) {
+
+/* EBCDIC character set */
+
+ if ((ic >= 129 && ic <= 137) || (ic >= 145 && ic <= 153) || (ic >=
+ 162 && ic <= 169)) {
+ *(unsigned char *)subnam = (char) (ic + 64);
+ for (i__ = 2; i__ <= 6; ++i__) {
+ ic = *(unsigned char *)&subnam[i__ - 1];
+ if ((ic >= 129 && ic <= 137) || (ic >= 145 && ic <= 153) || (
+ ic >= 162 && ic <= 169)) {
+ *(unsigned char *)&subnam[i__ - 1] = (char) (ic + 64);
+ }
+/* L20: */
+ }
+ }
+
+ } else if (iz == 218 || iz == 250) {
+
+/* Prime machines: ASCII+128 */
+
+ if ((ic >= 225 && ic <= 250)) {
+ *(unsigned char *)subnam = (char) (ic - 32);
+ for (i__ = 2; i__ <= 6; ++i__) {
+ ic = *(unsigned char *)&subnam[i__ - 1];
+ if ((ic >= 225 && ic <= 250)) {
+ *(unsigned char *)&subnam[i__ - 1] = (char) (ic - 32);
+ }
+/* L30: */
+ }
+ }
+ }
+
+ *(unsigned char *)c1 = *(unsigned char *)subnam;
+ sname = *(unsigned char *)c1 == 'S' || *(unsigned char *)c1 == 'D';
+ cname = *(unsigned char *)c1 == 'C' || *(unsigned char *)c1 == 'Z';
+ if (! (cname || sname)) {
+ return ret_val;
+ }
+ s_copy(c2, subnam + 1, (ftnlen)2, (ftnlen)2);
+ s_copy(c3, subnam + 3, (ftnlen)3, (ftnlen)3);
+ s_copy(c4, c3 + 1, (ftnlen)2, (ftnlen)2);
+
+ switch (*ispec) {
+ case 1: goto L110;
+ case 2: goto L200;
+ case 3: goto L300;
+ }
+
+L110:
+
+/*
+ ISPEC = 1: block size
+
+ In these examples, separate code is provided for setting NB for
+ real and complex. We assume that NB will take the same value in
+ single or double precision.
+*/
+
+ nb = 1;
+
+ if (s_cmp(c2, "GE", (ftnlen)2, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
+ if (sname) {
+ nb = 64;
+ } else {
+ nb = 64;
+ }
+ } else if (s_cmp(c3, "QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3,
+ "RQF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)
+ 3, (ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)3, (ftnlen)3)
+ == 0) {
+ if (sname) {
+ nb = 32;
+ } else {
+ nb = 32;
+ }
+ } else if (s_cmp(c3, "HRD", (ftnlen)3, (ftnlen)3) == 0) {
+ if (sname) {
+ nb = 32;
+ } else {
+ nb = 32;
+ }
+ } else if (s_cmp(c3, "BRD", (ftnlen)3, (ftnlen)3) == 0) {
+ if (sname) {
+ nb = 32;
+ } else {
+ nb = 32;
+ }
+ } else if (s_cmp(c3, "TRI", (ftnlen)3, (ftnlen)3) == 0) {
+ if (sname) {
+ nb = 64;
+ } else {
+ nb = 64;
+ }
+ }
+ } else if (s_cmp(c2, "PO", (ftnlen)2, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
+ if (sname) {
+ nb = 64;
+ } else {
+ nb = 64;
+ }
+ }
+ } else if (s_cmp(c2, "SY", (ftnlen)2, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
+ if (sname) {
+ nb = 64;
+ } else {
+ nb = 64;
+ }
+ } else if ((sname && s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0)) {
+ nb = 32;
+ } else if ((sname && s_cmp(c3, "GST", (ftnlen)3, (ftnlen)3) == 0)) {
+ nb = 64;
+ }
+ } else if ((cname && s_cmp(c2, "HE", (ftnlen)2, (ftnlen)2) == 0)) {
+ if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
+ nb = 64;
+ } else if (s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
+ nb = 32;
+ } else if (s_cmp(c3, "GST", (ftnlen)3, (ftnlen)3) == 0) {
+ nb = 64;
+ }
+ } else if ((sname && s_cmp(c2, "OR", (ftnlen)2, (ftnlen)2) == 0)) {
+ if (*(unsigned char *)c3 == 'G') {
+ if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)2, (ftnlen)2) == 0) {
+ nb = 32;
+ }
+ } else if (*(unsigned char *)c3 == 'M') {
+ if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)2, (ftnlen)2) == 0) {
+ nb = 32;
+ }
+ }
+ } else if ((cname && s_cmp(c2, "UN", (ftnlen)2, (ftnlen)2) == 0)) {
+ if (*(unsigned char *)c3 == 'G') {
+ if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)2, (ftnlen)2) == 0) {
+ nb = 32;
+ }
+ } else if (*(unsigned char *)c3 == 'M') {
+ if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)2, (ftnlen)2) == 0) {
+ nb = 32;
+ }
+ }
+ } else if (s_cmp(c2, "GB", (ftnlen)2, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
+ if (sname) {
+ if (*n4 <= 64) {
+ nb = 1;
+ } else {
+ nb = 32;
+ }
+ } else {
+ if (*n4 <= 64) {
+ nb = 1;
+ } else {
+ nb = 32;
+ }
+ }
+ }
+ } else if (s_cmp(c2, "PB", (ftnlen)2, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
+ if (sname) {
+ if (*n2 <= 64) {
+ nb = 1;
+ } else {
+ nb = 32;
+ }
+ } else {
+ if (*n2 <= 64) {
+ nb = 1;
+ } else {
+ nb = 32;
+ }
+ }
+ }
+ } else if (s_cmp(c2, "TR", (ftnlen)2, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "TRI", (ftnlen)3, (ftnlen)3) == 0) {
+ if (sname) {
+ nb = 64;
+ } else {
+ nb = 64;
+ }
+ }
+ } else if (s_cmp(c2, "LA", (ftnlen)2, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "UUM", (ftnlen)3, (ftnlen)3) == 0) {
+ if (sname) {
+ nb = 64;
+ } else {
+ nb = 64;
+ }
+ }
+ } else if ((sname && s_cmp(c2, "ST", (ftnlen)2, (ftnlen)2) == 0)) {
+ if (s_cmp(c3, "EBZ", (ftnlen)3, (ftnlen)3) == 0) {
+ nb = 1;
+ }
+ }
+ ret_val = nb;
+ return ret_val;
+
+L200:
+
+/* ISPEC = 2: minimum block size */
+
+ nbmin = 2;
+ if (s_cmp(c2, "GE", (ftnlen)2, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "RQF", (
+ ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)3, (
+ ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)3, (ftnlen)3) == 0)
+ {
+ if (sname) {
+ nbmin = 2;
+ } else {
+ nbmin = 2;
+ }
+ } else if (s_cmp(c3, "HRD", (ftnlen)3, (ftnlen)3) == 0) {
+ if (sname) {
+ nbmin = 2;
+ } else {
+ nbmin = 2;
+ }
+ } else if (s_cmp(c3, "BRD", (ftnlen)3, (ftnlen)3) == 0) {
+ if (sname) {
+ nbmin = 2;
+ } else {
+ nbmin = 2;
+ }
+ } else if (s_cmp(c3, "TRI", (ftnlen)3, (ftnlen)3) == 0) {
+ if (sname) {
+ nbmin = 2;
+ } else {
+ nbmin = 2;
+ }
+ }
+ } else if (s_cmp(c2, "SY", (ftnlen)2, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "TRF", (ftnlen)3, (ftnlen)3) == 0) {
+ if (sname) {
+ nbmin = 8;
+ } else {
+ nbmin = 8;
+ }
+ } else if ((sname && s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0)) {
+ nbmin = 2;
+ }
+ } else if ((cname && s_cmp(c2, "HE", (ftnlen)2, (ftnlen)2) == 0)) {
+ if (s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
+ nbmin = 2;
+ }
+ } else if ((sname && s_cmp(c2, "OR", (ftnlen)2, (ftnlen)2) == 0)) {
+ if (*(unsigned char *)c3 == 'G') {
+ if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)2, (ftnlen)2) == 0) {
+ nbmin = 2;
+ }
+ } else if (*(unsigned char *)c3 == 'M') {
+ if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)2, (ftnlen)2) == 0) {
+ nbmin = 2;
+ }
+ }
+ } else if ((cname && s_cmp(c2, "UN", (ftnlen)2, (ftnlen)2) == 0)) {
+ if (*(unsigned char *)c3 == 'G') {
+ if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)2, (ftnlen)2) == 0) {
+ nbmin = 2;
+ }
+ } else if (*(unsigned char *)c3 == 'M') {
+ if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)2, (ftnlen)2) == 0) {
+ nbmin = 2;
+ }
+ }
+ }
+ ret_val = nbmin;
+ return ret_val;
+
+L300:
+
+/* ISPEC = 3: crossover point */
+
+ nx = 0;
+ if (s_cmp(c2, "GE", (ftnlen)2, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "RQF", (
+ ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)3, (
+ ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)3, (ftnlen)3) == 0)
+ {
+ if (sname) {
+ nx = 128;
+ } else {
+ nx = 128;
+ }
+ } else if (s_cmp(c3, "HRD", (ftnlen)3, (ftnlen)3) == 0) {
+ if (sname) {
+ nx = 128;
+ } else {
+ nx = 128;
+ }
+ } else if (s_cmp(c3, "BRD", (ftnlen)3, (ftnlen)3) == 0) {
+ if (sname) {
+ nx = 128;
+ } else {
+ nx = 128;
+ }
+ }
+ } else if (s_cmp(c2, "SY", (ftnlen)2, (ftnlen)2) == 0) {
+ if ((sname && s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0)) {
+ nx = 32;
+ }
+ } else if ((cname && s_cmp(c2, "HE", (ftnlen)2, (ftnlen)2) == 0)) {
+ if (s_cmp(c3, "TRD", (ftnlen)3, (ftnlen)3) == 0) {
+ nx = 32;
+ }
+ } else if ((sname && s_cmp(c2, "OR", (ftnlen)2, (ftnlen)2) == 0)) {
+ if (*(unsigned char *)c3 == 'G') {
+ if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)2, (ftnlen)2) == 0) {
+ nx = 128;
+ }
+ }
+ } else if ((cname && s_cmp(c2, "UN", (ftnlen)2, (ftnlen)2) == 0)) {
+ if (*(unsigned char *)c3 == 'G') {
+ if (s_cmp(c4, "QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)2, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)2, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)2, (ftnlen)2) == 0) {
+ nx = 128;
+ }
+ }
+ }
+ ret_val = nx;
+ return ret_val;
+
+L400:
+
+/* ISPEC = 4: number of shifts (used by xHSEQR) */
+
+ ret_val = 6;
+ return ret_val;
+
+L500:
+
+/* ISPEC = 5: minimum column dimension (not used) */
+
+ ret_val = 2;
+ return ret_val;
+
+L600:
+
+/* ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD) */
+
+ ret_val = (integer) ((real) min(*n1,*n2) * 1.6f);
+ return ret_val;
+
+L700:
+
+/* ISPEC = 7: number of processors (not used) */
+
+ ret_val = 1;
+ return ret_val;
+
+L800:
+
+/* ISPEC = 8: crossover point for multishift (used by xHSEQR) */
+
+ ret_val = 50;
+ return ret_val;
+
+L900:
+
+/*
+ ISPEC = 9: maximum size of the subproblems at the bottom of the
+ computation tree in the divide-and-conquer algorithm
+ (used by xGELSD and xGESDD)
+*/
+
+ ret_val = 25;
+ return ret_val;
+
+L1000:
+
+/*
+ ISPEC = 10: ieee NaN arithmetic can be trusted not to trap
+
+ ILAENV = 0
+*/
+ ret_val = 1;
+ if (ret_val == 1) {
+ ret_val = ieeeck_(&c__0, &c_b3825, &c_b3826);
+ }
+ return ret_val;
+
+L1100:
+
+/*
+ ISPEC = 11: infinity arithmetic can be trusted not to trap
+
+ ILAENV = 0
+*/
+ ret_val = 1;
+ if (ret_val == 1) {
+ ret_val = ieeeck_(&c__1, &c_b3825, &c_b3826);
+ }
+ return ret_val;
+
+/* End of ILAENV */
+
+} /* ilaenv_ */
+
diff --git a/numpy/linalg/f2c.h b/numpy/linalg/f2c.h
new file mode 100644
index 000000000..e27d7ae57
--- /dev/null
+++ b/numpy/linalg/f2c.h
@@ -0,0 +1,217 @@
+/* f2c.h -- Standard Fortran to C header file */
+
+/** barf [ba:rf] 2. "He suggested using FORTRAN, and everybody barfed."
+
+ - From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) */
+
+#ifndef F2C_INCLUDE
+#define F2C_INCLUDE
+
+typedef int integer;
+typedef char *address;
+typedef short int shortint;
+typedef float real;
+typedef double doublereal;
+typedef struct { real r, i; } complex;
+typedef struct { doublereal r, i; } doublecomplex;
+typedef int logical;
+typedef short int shortlogical;
+typedef char logical1;
+typedef char integer1;
+
+#define TRUE_ (1)
+#define FALSE_ (0)
+
+/* Extern is for use with -E */
+#ifndef Extern
+#define Extern extern
+#endif
+
+/* I/O stuff */
+
+#ifdef f2c_i2
+/* for -i2 */
+typedef short flag;
+typedef short ftnlen;
+typedef short ftnint;
+#else
+typedef int flag;
+typedef int ftnlen;
+typedef int ftnint;
+#endif
+
+/*external read, write*/
+typedef struct
+{ flag cierr;
+ ftnint ciunit;
+ flag ciend;
+ char *cifmt;
+ ftnint cirec;
+} cilist;
+
+/*internal read, write*/
+typedef struct
+{ flag icierr;
+ char *iciunit;
+ flag iciend;
+ char *icifmt;
+ ftnint icirlen;
+ ftnint icirnum;
+} icilist;
+
+/*open*/
+typedef struct
+{ flag oerr;
+ ftnint ounit;
+ char *ofnm;
+ ftnlen ofnmlen;
+ char *osta;
+ char *oacc;
+ char *ofm;
+ ftnint orl;
+ char *oblnk;
+} olist;
+
+/*close*/
+typedef struct
+{ flag cerr;
+ ftnint cunit;
+ char *csta;
+} cllist;
+
+/*rewind, backspace, endfile*/
+typedef struct
+{ flag aerr;
+ ftnint aunit;
+} alist;
+
+/* inquire */
+typedef struct
+{ flag inerr;
+ ftnint inunit;
+ char *infile;
+ ftnlen infilen;
+ ftnint *inex; /*parameters in standard's order*/
+ ftnint *inopen;
+ ftnint *innum;
+ ftnint *innamed;
+ char *inname;
+ ftnlen innamlen;
+ char *inacc;
+ ftnlen inacclen;
+ char *inseq;
+ ftnlen inseqlen;
+ char *indir;
+ ftnlen indirlen;
+ char *infmt;
+ ftnlen infmtlen;
+ char *inform;
+ ftnint informlen;
+ char *inunf;
+ ftnlen inunflen;
+ ftnint *inrecl;
+ ftnint *innrec;
+ char *inblank;
+ ftnlen inblanklen;
+} inlist;
+
+#define VOID void
+
+union Multitype { /* for multiple entry points */
+ shortint h;
+ integer i;
+ real r;
+ doublereal d;
+ complex c;
+ doublecomplex z;
+ };
+
+typedef union Multitype Multitype;
+
+typedef long Long; /* No longer used; formerly in Namelist */
+
+struct Vardesc { /* for Namelist */
+ char *name;
+ char *addr;
+ ftnlen *dims;
+ int type;
+ };
+typedef struct Vardesc Vardesc;
+
+struct Namelist {
+ char *name;
+ Vardesc **vars;
+ int nvars;
+ };
+typedef struct Namelist Namelist;
+
+#ifndef abs
+#define abs(x) ((x) >= 0 ? (x) : -(x))
+#endif
+#define dabs(x) (doublereal)abs(x)
+#ifndef min
+#define min(a,b) ((a) <= (b) ? (a) : (b))
+#endif
+#ifndef max
+#define max(a,b) ((a) >= (b) ? (a) : (b))
+#endif
+#define dmin(a,b) (doublereal)min(a,b)
+#define dmax(a,b) (doublereal)max(a,b)
+
+/* procedure parameter types for -A and -C++ */
+
+#define F2C_proc_par_types 1
+#ifdef __cplusplus
+typedef int /* Unknown procedure type */ (*U_fp)(...);
+typedef shortint (*J_fp)(...);
+typedef integer (*I_fp)(...);
+typedef real (*R_fp)(...);
+typedef doublereal (*D_fp)(...), (*E_fp)(...);
+typedef /* Complex */ VOID (*C_fp)(...);
+typedef /* Double Complex */ VOID (*Z_fp)(...);
+typedef logical (*L_fp)(...);
+typedef shortlogical (*K_fp)(...);
+typedef /* Character */ VOID (*H_fp)(...);
+typedef /* Subroutine */ int (*S_fp)(...);
+#else
+typedef int /* Unknown procedure type */ (*U_fp)(void);
+typedef shortint (*J_fp)(void);
+typedef integer (*I_fp)(void);
+typedef real (*R_fp)(void);
+typedef doublereal (*D_fp)(void), (*E_fp)(void);
+typedef /* Complex */ VOID (*C_fp)(void);
+typedef /* Double Complex */ VOID (*Z_fp)(void);
+typedef logical (*L_fp)(void);
+typedef shortlogical (*K_fp)(void);
+typedef /* Character */ VOID (*H_fp)(void);
+typedef /* Subroutine */ int (*S_fp)(void);
+#endif
+/* E_fp is for real functions when -R is not specified */
+typedef VOID C_f; /* complex function */
+typedef VOID H_f; /* character function */
+typedef VOID Z_f; /* double complex function */
+typedef doublereal E_f; /* real function with -R not specified */
+
+/* undef any lower-case symbols that your C compiler predefines, e.g.: */
+
+#ifndef Skip_f2c_Undefs
+#undef cray
+#undef gcos
+#undef mc68010
+#undef mc68020
+#undef mips
+#undef pdp11
+#undef sgi
+#undef sparc
+#undef sun
+#undef sun2
+#undef sun3
+#undef sun4
+#undef u370
+#undef u3b
+#undef u3b2
+#undef u3b5
+#undef unix
+#undef vax
+#endif
+#endif
diff --git a/numpy/linalg/f2c_lite.c b/numpy/linalg/f2c_lite.c
new file mode 100644
index 000000000..6402271c9
--- /dev/null
+++ b/numpy/linalg/f2c_lite.c
@@ -0,0 +1,492 @@
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "f2c.h"
+
+
+extern void s_wsfe(cilist *f) {;}
+extern void e_wsfe(void) {;}
+extern void do_fio(integer *c, char *s, ftnlen l) {;}
+
+/* You'll want this if you redo the *_lite.c files with the -C option
+ * to f2c for checking array subscripts. (It's not suggested you do that
+ * for production use, of course.) */
+extern int
+s_rnge(char *var, int index, char *routine, int lineno)
+{
+ fprintf(stderr, "array index out-of-bounds for %s[%d] in routine %s:%d\n",
+ var, index, routine, lineno);
+ fflush(stderr);
+ abort();
+}
+
+
+#ifdef KR_headers
+extern double sqrt();
+double f__cabs(real, imag) double real, imag;
+#else
+#undef abs
+
+double f__cabs(double real, double imag)
+#endif
+{
+double temp;
+
+if(real < 0)
+ real = -real;
+if(imag < 0)
+ imag = -imag;
+if(imag > real){
+ temp = real;
+ real = imag;
+ imag = temp;
+}
+if((imag+real) == real)
+ return((double)real);
+
+temp = imag/real;
+temp = real*sqrt(1.0 + temp*temp); /*overflow!!*/
+return(temp);
+}
+
+
+ VOID
+#ifdef KR_headers
+d_cnjg(r, z) doublecomplex *r, *z;
+#else
+d_cnjg(doublecomplex *r, doublecomplex *z)
+#endif
+{
+r->r = z->r;
+r->i = - z->i;
+}
+
+
+#ifdef KR_headers
+double d_imag(z) doublecomplex *z;
+#else
+double d_imag(doublecomplex *z)
+#endif
+{
+return(z->i);
+}
+
+
+#define log10e 0.43429448190325182765
+
+#ifdef KR_headers
+double log();
+double d_lg10(x) doublereal *x;
+#else
+#undef abs
+
+double d_lg10(doublereal *x)
+#endif
+{
+return( log10e * log(*x) );
+}
+
+
+#ifdef KR_headers
+double d_sign(a,b) doublereal *a, *b;
+#else
+double d_sign(doublereal *a, doublereal *b)
+#endif
+{
+double x;
+x = (*a >= 0 ? *a : - *a);
+return( *b >= 0 ? x : -x);
+}
+
+
+#ifdef KR_headers
+double floor();
+integer i_dnnt(x) doublereal *x;
+#else
+#undef abs
+
+integer i_dnnt(doublereal *x)
+#endif
+{
+return( (*x)>=0 ?
+ floor(*x + .5) : -floor(.5 - *x) );
+}
+
+
+#ifdef KR_headers
+double pow();
+double pow_dd(ap, bp) doublereal *ap, *bp;
+#else
+#undef abs
+
+double pow_dd(doublereal *ap, doublereal *bp)
+#endif
+{
+return(pow(*ap, *bp) );
+}
+
+
+#ifdef KR_headers
+double pow_di(ap, bp) doublereal *ap; integer *bp;
+#else
+double pow_di(doublereal *ap, integer *bp)
+#endif
+{
+double pow, x;
+integer n;
+unsigned long u;
+
+pow = 1;
+x = *ap;
+n = *bp;
+
+if(n != 0)
+ {
+ if(n < 0)
+ {
+ n = -n;
+ x = 1/x;
+ }
+ for(u = n; ; )
+ {
+ if(u & 01)
+ pow *= x;
+ if(u >>= 1)
+ x *= x;
+ else
+ break;
+ }
+ }
+return(pow);
+}
+/* Unless compiled with -DNO_OVERWRITE, this variant of s_cat allows the
+ * target of a concatenation to appear on its right-hand side (contrary
+ * to the Fortran 77 Standard, but in accordance with Fortran 90).
+ */
+#define NO_OVERWRITE
+
+
+#ifndef NO_OVERWRITE
+
+#undef abs
+#ifdef KR_headers
+ extern char *F77_aloc();
+ extern void free();
+ extern void exit_();
+#else
+
+ extern char *F77_aloc(ftnlen, char*);
+#endif
+
+#endif /* NO_OVERWRITE */
+
+ VOID
+#ifdef KR_headers
+s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnlen rnp[], *np, ll;
+#else
+s_cat(char *lp, char *rpp[], ftnlen rnp[], ftnlen *np, ftnlen ll)
+#endif
+{
+ ftnlen i, nc;
+ char *rp;
+ ftnlen n = *np;
+#ifndef NO_OVERWRITE
+ ftnlen L, m;
+ char *lp0, *lp1;
+
+ lp0 = 0;
+ lp1 = lp;
+ L = ll;
+ i = 0;
+ while(i < n) {
+ rp = rpp[i];
+ m = rnp[i++];
+ if (rp >= lp1 || rp + m <= lp) {
+ if ((L -= m) <= 0) {
+ n = i;
+ break;
+ }
+ lp1 += m;
+ continue;
+ }
+ lp0 = lp;
+ lp = lp1 = F77_aloc(L = ll, "s_cat");
+ break;
+ }
+ lp1 = lp;
+#endif /* NO_OVERWRITE */
+ for(i = 0 ; i < n ; ++i) {
+ nc = ll;
+ if(rnp[i] < nc)
+ nc = rnp[i];
+ ll -= nc;
+ rp = rpp[i];
+ while(--nc >= 0)
+ *lp++ = *rp++;
+ }
+ while(--ll >= 0)
+ *lp++ = ' ';
+#ifndef NO_OVERWRITE
+ if (lp0) {
+ memmove(lp0, lp1, L);
+ free(lp1);
+ }
+#endif
+ }
+
+
+/* compare two strings */
+
+#ifdef KR_headers
+integer s_cmp(a0, b0, la, lb) char *a0, *b0; ftnlen la, lb;
+#else
+integer s_cmp(char *a0, char *b0, ftnlen la, ftnlen lb)
+#endif
+{
+register unsigned char *a, *aend, *b, *bend;
+a = (unsigned char *)a0;
+b = (unsigned char *)b0;
+aend = a + la;
+bend = b + lb;
+
+if(la <= lb)
+ {
+ while(a < aend)
+ if(*a != *b)
+ return( *a - *b );
+ else
+ { ++a; ++b; }
+
+ while(b < bend)
+ if(*b != ' ')
+ return( ' ' - *b );
+ else ++b;
+ }
+
+else
+ {
+ while(b < bend)
+ if(*a == *b)
+ { ++a; ++b; }
+ else
+ return( *a - *b );
+ while(a < aend)
+ if(*a != ' ')
+ return(*a - ' ');
+ else ++a;
+ }
+return(0);
+}
+/* Unless compiled with -DNO_OVERWRITE, this variant of s_copy allows the
+ * target of an assignment to appear on its right-hand side (contrary
+ * to the Fortran 77 Standard, but in accordance with Fortran 90),
+ * as in a(2:5) = a(4:7) .
+ */
+
+
+
+/* assign strings: a = b */
+
+#ifdef KR_headers
+VOID s_copy(a, b, la, lb) register char *a, *b; ftnlen la, lb;
+#else
+void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb)
+#endif
+{
+ register char *aend, *bend;
+
+ aend = a + la;
+
+ if(la <= lb)
+#ifndef NO_OVERWRITE
+ if (a <= b || a >= b + la)
+#endif
+ while(a < aend)
+ *a++ = *b++;
+#ifndef NO_OVERWRITE
+ else
+ for(b += la; a < aend; )
+ *--aend = *--b;
+#endif
+
+ else {
+ bend = b + lb;
+#ifndef NO_OVERWRITE
+ if (a <= b || a >= bend)
+#endif
+ while(b < bend)
+ *a++ = *b++;
+#ifndef NO_OVERWRITE
+ else {
+ a += lb;
+ while(b < bend)
+ *--a = *--bend;
+ a += lb;
+ }
+#endif
+ while(a < aend)
+ *a++ = ' ';
+ }
+ }
+
+
+#ifdef KR_headers
+double f__cabs();
+double z_abs(z) doublecomplex *z;
+#else
+double f__cabs(double, double);
+double z_abs(doublecomplex *z)
+#endif
+{
+return( f__cabs( z->r, z->i ) );
+}
+
+
+#ifdef KR_headers
+extern void sig_die();
+VOID z_div(c, a, b) doublecomplex *a, *b, *c;
+#else
+extern void sig_die(char*, int);
+void z_div(doublecomplex *c, doublecomplex *a, doublecomplex *b)
+#endif
+{
+double ratio, den;
+double abr, abi;
+
+if( (abr = b->r) < 0.)
+ abr = - abr;
+if( (abi = b->i) < 0.)
+ abi = - abi;
+if( abr <= abi )
+ {
+ /*Let IEEE Infinties handle this ;( */
+ /*if(abi == 0)
+ sig_die("complex division by zero", 1);*/
+ ratio = b->r / b->i ;
+ den = b->i * (1 + ratio*ratio);
+ c->r = (a->r*ratio + a->i) / den;
+ c->i = (a->i*ratio - a->r) / den;
+ }
+
+else
+ {
+ ratio = b->i / b->r ;
+ den = b->r * (1 + ratio*ratio);
+ c->r = (a->r + a->i*ratio) / den;
+ c->i = (a->i - a->r*ratio) / den;
+ }
+
+}
+
+
+#ifdef KR_headers
+double sqrt(), f__cabs();
+VOID z_sqrt(r, z) doublecomplex *r, *z;
+#else
+#undef abs
+
+extern double f__cabs(double, double);
+void z_sqrt(doublecomplex *r, doublecomplex *z)
+#endif
+{
+double mag;
+
+if( (mag = f__cabs(z->r, z->i)) == 0.)
+ r->r = r->i = 0.;
+else if(z->r > 0)
+ {
+ r->r = sqrt(0.5 * (mag + z->r) );
+ r->i = z->i / r->r / 2;
+ }
+else
+ {
+ r->i = sqrt(0.5 * (mag - z->r) );
+ if(z->i < 0)
+ r->i = - r->i;
+ r->r = z->i / r->i / 2;
+ }
+}
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef KR_headers
+integer pow_ii(ap, bp) integer *ap, *bp;
+#else
+integer pow_ii(integer *ap, integer *bp)
+#endif
+{
+ integer pow, x, n;
+ unsigned long u;
+
+ x = *ap;
+ n = *bp;
+
+ if (n <= 0) {
+ if (n == 0 || x == 1)
+ return 1;
+ if (x != -1)
+ return x == 0 ? 1/x : 0;
+ n = -n;
+ }
+ u = n;
+ for(pow = 1; ; )
+ {
+ if(u & 01)
+ pow *= x;
+ if(u >>= 1)
+ x *= x;
+ else
+ break;
+ }
+ return(pow);
+ }
+#ifdef __cplusplus
+}
+#endif
+
+#ifdef KR_headers
+extern void f_exit();
+VOID s_stop(s, n) char *s; ftnlen n;
+#else
+#undef abs
+#undef min
+#undef max
+#ifdef __cplusplus
+extern "C" {
+#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+void f_exit(void);
+
+int s_stop(char *s, ftnlen n)
+#endif
+{
+int i;
+
+if(n > 0)
+ {
+ fprintf(stderr, "STOP ");
+ for(i = 0; i<n ; ++i)
+ putc(*s++, stderr);
+ fprintf(stderr, " statement executed\n");
+ }
+#ifdef NO_ONEXIT
+f_exit();
+#endif
+exit(0);
+
+/* We cannot avoid (useless) compiler diagnostics here: */
+/* some compilers complain if there is no return statement, */
+/* and others complain that this one cannot be reached. */
+
+return 0; /* NOT REACHED */
+}
+#ifdef __cplusplus
+}
+#endif
+#ifdef __cplusplus
+}
+#endif
diff --git a/numpy/linalg/info.py b/numpy/linalg/info.py
new file mode 100644
index 000000000..fce02b836
--- /dev/null
+++ b/numpy/linalg/info.py
@@ -0,0 +1,25 @@
+"""\
+Core Linear Algebra Tools
+===========
+
+ Linear Algebra Basics:
+
+ norm --- Vector or matrix norm
+ inv --- Inverse of a square matrix
+ solve --- Solve a linear system of equations
+ det --- Determinant of a square matrix
+ lstsq --- Solve linear least-squares problem
+ pinv --- Pseudo-inverse (Moore-Penrose) using lstsq
+
+ Eigenvalues and Decompositions:
+
+ eig --- Eigenvalues and vectors of a square matrix
+ eigh --- Eigenvalues and eigenvectors of a Hermitian matrix
+ eigvals --- Eigenvalues of a square matrix
+ eigvalsh --- Eigenvalues of a Hermitian matrix.
+ svd --- Singular value decomposition of a matrix
+ cholesky --- Cholesky decomposition of a matrix
+
+"""
+
+depends = ['core']
diff --git a/numpy/linalg/lapack_lite/README b/numpy/linalg/lapack_lite/README
new file mode 100644
index 000000000..1c97d4d1e
--- /dev/null
+++ b/numpy/linalg/lapack_lite/README
@@ -0,0 +1,40 @@
+Regenerating lapack_lite source
+===============================
+
+:Author: David M. Cooke <cookedm@physics.mcmaster.ca>
+
+The ``numpy/linalg/blas_lite.c``, ``numpy/linalg/dlapack_lite.c``, and
+``numpy/linalg/zlapack_lite.c`` are ``f2c``'d versions of the LAPACK routines
+required by the ``LinearAlgebra`` module, and wrapped by the ``lapack_lite``
+module. The scripts in this directory can be used to create these files
+automatically from a directory of LAPACK source files.
+
+You'll need `Plex 1.1.4`_ installed to do the appropriate scrubbing.
+
+.. _Plex 1.1.4: http://www.cosc.canterbury.ac.nz/~greg/python/Plex/
+
+The routines that ``lapack_litemodule.c`` wraps are listed in
+``wrapped_routines``, along with a few exceptions that aren't picked up
+properly. Assuming that you have an unpacked LAPACK source tree in
+``~/LAPACK``, you generate the new routines in a directory ``new-lite/`` with::
+
+$ python ./make_lite.py wrapped_routines ~/LAPACK new-lite/
+
+This will grab the right routines, with dependencies, put them into the
+appropiate ``blas_lite.f``, ``dlapack_lite.f``, or ``zlapack_lite.f`` files,
+run ``f2c`` over them, then do some scrubbing similiar to that done to
+generate the CLAPACK_ distribution.
+
+.. _CLAPACK: http://netlib.org/clapack/index.html
+
+The versions in Numeric CVS as of 2005-04-12 use the LAPACK source from the
+`Debian package lapack3`_, version 3.0.20000531a-6. It was found that these
+(being regularly maintained) worked better than the patches to the last
+released version of LAPACK available at the LAPACK_ page.
+
+.. _Debian package lapack3: http://packages.debian.org/unstable/libs/lapack3
+.. _LAPACK: http://netlib.org/lapack/index.html
+
+A slightly-patched ``f2c`` was used to add parentheses around ``||`` expressions
+and the arguments to ``<<`` to silence gcc warnings. Edit
+the ``src/output.c`` in the ``f2c`` source to do this.
diff --git a/numpy/linalg/lapack_lite/clapack_scrub.py b/numpy/linalg/lapack_lite/clapack_scrub.py
new file mode 100644
index 000000000..df00851c3
--- /dev/null
+++ b/numpy/linalg/lapack_lite/clapack_scrub.py
@@ -0,0 +1,276 @@
+#!/usr/bin/env python2.4
+
+import sys, os
+from cStringIO import StringIO
+import re
+
+from Plex import *
+from Plex.Traditional import re as Re
+
+class MyScanner(Scanner):
+ def __init__(self, info, name='<default>'):
+ Scanner.__init__(self, self.lexicon, info, name)
+
+ def begin(self, state_name):
+# if self.state_name == '':
+# print '<default>'
+# else:
+# print self.state_name
+ Scanner.begin(self, state_name)
+
+def sep_seq(sequence, sep):
+ pat = Str(sequence[0])
+ for s in sequence[1:]:
+ pat += sep + Str(s)
+ return pat
+
+def runScanner(data, scanner_class, lexicon=None):
+ info = StringIO(data)
+ outfo = StringIO()
+ if lexicon is not None:
+ scanner = scanner_class(lexicon, info)
+ else:
+ scanner = scanner_class(info)
+ while 1:
+ value, text = scanner.read()
+ if value is None:
+ break
+ elif value is IGNORE:
+ pass
+ else:
+ outfo.write(value)
+ return outfo.getvalue(), scanner
+
+class LenSubsScanner(MyScanner):
+ """Following clapack, we remove ftnlen arguments, which f2c puts after
+ a char * argument to hold the length of the passed string. This is just
+ a nuisance in C.
+ """
+ def __init__(self, info, name='<ftnlen>'):
+ MyScanner.__init__(self, info, name)
+ self.paren_count = 0
+
+ def beginArgs(self, text):
+ if self.paren_count == 0:
+ self.begin('args')
+ self.paren_count += 1
+ return text
+
+ def endArgs(self, text):
+ self.paren_count -= 1
+ if self.paren_count == 0:
+ self.begin('')
+ return text
+
+ digits = Re('[0-9]+')
+ iofun = Re(r'\([^;]*;')
+ decl = Re(r'\([^)]*\)[,;'+'\n]')
+ any = Re('[.]*')
+ S = Re('[ \t\n]*')
+ cS = Str(',') + S
+ len_ = Re('[a-z][a-z0-9]*_len')
+
+ iofunctions = Str("s_cat", "s_copy", "s_stop", "s_cmp",
+ "i_len", "do_fio", "do_lio") + iofun
+
+ # Routines to not scrub the ftnlen argument from
+ keep_ftnlen = (Str('ilaenv_') | Str('s_rnge')) + Str('(')
+
+ lexicon = Lexicon([
+ (iofunctions, TEXT),
+ (keep_ftnlen, beginArgs),
+ State('args', [
+ (Str(')'), endArgs),
+ (Str('('), beginArgs),
+ (AnyChar, TEXT),
+ ]),
+ (cS+Re(r'[1-9][0-9]*L'), IGNORE),
+ (cS+Str('ftnlen')+Opt(S+len_), IGNORE),
+ (cS+sep_seq(['(', 'ftnlen', ')'], S)+S+digits, IGNORE),
+ (Bol+Str('ftnlen ')+len_+Str(';\n'), IGNORE),
+ (cS+len_, TEXT),
+ (AnyChar, TEXT),
+ ])
+
+def scrubFtnlen(source):
+ return runScanner(source, LenSubsScanner)[0]
+
+def cleanSource(source):
+ # remove whitespace at end of lines
+ source = re.sub(r'[\t ]+\n', '\n', source)
+ # remove comments like .. Scalar Arguments ..
+ source = re.sub(r'(?m)^[\t ]*/\* *\.\. .*?\n', '', source)
+ # collapse blanks of more than two in-a-row to two
+ source = re.sub(r'\n\n\n\n+', r'\n\n\n', source)
+ return source
+
+class LineQueue(object):
+ def __init__(self):
+ object.__init__(self)
+ self._queue = []
+
+ def add(self, line):
+ self._queue.append(line)
+
+ def clear(self):
+ self._queue = []
+
+ def flushTo(self, other_queue):
+ for line in self._queue:
+ other_queue.add(line)
+ self.clear()
+
+ def getValue(self):
+ q = LineQueue()
+ self.flushTo(q)
+ s = ''.join(q._queue)
+ self.clear()
+ return s
+
+class CommentQueue(LineQueue):
+ def __init__(self):
+ LineQueue.__init__(self)
+
+ def add(self, line):
+ if line.strip() == '':
+ LineQueue.add(self, '\n')
+ else:
+ line = ' ' + line[2:-3].rstrip() + '\n'
+ LineQueue.add(self, line)
+
+ def flushTo(self, other_queue):
+ if len(self._queue) == 0:
+ pass
+ elif len(self._queue) == 1:
+ other_queue.add('/*' + self._queue[0][2:].rstrip() + ' */\n')
+ else:
+ other_queue.add('/*\n')
+ LineQueue.flushTo(self, other_queue)
+ other_queue.add('*/\n')
+ self.clear()
+
+# This really seems to be about 4x longer than it needs to be
+def cleanComments(source):
+ lines = LineQueue()
+ comments = CommentQueue()
+ def isCommentLine(line):
+ return line.startswith('/*') and line.endswith('*/\n')
+
+ blanks = LineQueue()
+ def isBlank(line):
+ return line.strip() == ''
+
+ def SourceLines(line):
+ if isCommentLine(line):
+ comments.add(line)
+ return HaveCommentLines
+ else:
+ lines.add(line)
+ return SourceLines
+ def HaveCommentLines(line):
+ if isBlank(line):
+ blanks.add('\n')
+ return HaveBlankLines
+ elif isCommentLine(line):
+ comments.add(line)
+ return HaveCommentLines
+ else:
+ comments.flushTo(lines)
+ lines.add(line)
+ return SourceLines
+ def HaveBlankLines(line):
+ if isBlank(line):
+ blanks.add('\n')
+ return HaveBlankLines
+ elif isCommentLine(line):
+ blanks.flushTo(comments)
+ comments.add(line)
+ return HaveCommentLines
+ else:
+ comments.flushTo(lines)
+ blanks.flushTo(lines)
+ lines.add(line)
+ return SourceLines
+
+ state = SourceLines
+ for line in StringIO(source):
+ state = state(line)
+ comments.flushTo(lines)
+ return lines.getValue()
+
+def removeHeader(source):
+ lines = LineQueue()
+
+ def LookingForHeader(line):
+ m = re.match(r'/\*[^\n]*-- translated', line)
+ if m:
+ return InHeader
+ else:
+ lines.add(line)
+ return LookingForHeader
+ def InHeader(line):
+ if line.startswith('*/'):
+ return OutOfHeader
+ else:
+ return InHeader
+ def OutOfHeader(line):
+ if line.startswith('#include "f2c.h"'):
+ pass
+ else:
+ lines.add(line)
+ return OutOfHeader
+
+ state = LookingForHeader
+ for line in StringIO(source):
+ state = state(line)
+ return lines.getValue()
+
+def replaceDlamch(source):
+ """Replace dlamch_ calls with appropiate macros"""
+ def repl(m):
+ s = m.group(1)
+ return dict(E='EPSILON', P='PRECISION', S='SAFEMINIMUM',
+ B='BASE')[s[0]]
+ source = re.sub(r'dlamch_\("(.*?)"\)', repl, source)
+ source = re.sub(r'^\s+extern.*? dlamch_.*?;$(?m)', '', source)
+ return source
+
+# do it
+
+def scrubSource(source, nsteps=None, verbose=False):
+ steps = [
+ ('scrubbing ftnlen', scrubFtnlen),
+ ('remove header', removeHeader),
+ ('clean source', cleanSource),
+ ('clean comments', cleanComments),
+ ('replace dlamch_() calls', replaceDlamch),
+ ]
+
+ if nsteps is not None:
+ steps = steps[:nsteps]
+
+ for msg, step in steps:
+ if verbose:
+ print msg
+ source = step(source)
+
+ return source
+
+if __name__ == '__main__':
+ filename = sys.argv[1]
+ outfilename = os.path.join(sys.argv[2], os.path.basename(filename))
+ fo = open(filename, 'r')
+ source = fo.read()
+ fo.close()
+
+ if len(sys.argv) > 3:
+ nsteps = int(sys.argv[3])
+ else:
+ nsteps = None
+
+ source = scrub_source(source, nsteps, verbose=True)
+
+ writefo = open(outfilename, 'w')
+ writefo.write(source)
+ writefo.close()
+
diff --git a/numpy/linalg/lapack_lite/fortran.py b/numpy/linalg/lapack_lite/fortran.py
new file mode 100644
index 000000000..7be986a8e
--- /dev/null
+++ b/numpy/linalg/lapack_lite/fortran.py
@@ -0,0 +1,114 @@
+import re
+import itertools
+
+def isBlank(line):
+ return not line
+def isLabel(line):
+ return line[0].isdigit()
+def isComment(line):
+ return line[0] != ' '
+def isContinuation(line):
+ return line[5] != ' '
+
+COMMENT, STATEMENT, CONTINUATION = 0, 1, 2
+def lineType(line):
+ """Return the type of a line of Fortan code."""
+ if isBlank(line):
+ return COMMENT
+ elif isLabel(line):
+ return STATEMENT
+ elif isComment(line):
+ return COMMENT
+ elif isContinuation(line):
+ return CONTINUATION
+ else:
+ return STATEMENT
+
+class LineIterator(object):
+ """LineIterator(iterable)
+
+ Return rstrip()'d lines from iterable, while keeping a count of the
+ line number in the .lineno attribute.
+ """
+ def __init__(self, iterable):
+ object.__init__(self)
+ self.iterable = iter(iterable)
+ self.lineno = 0
+ def __iter__(self):
+ return self
+ def next(self):
+ self.lineno += 1
+ line = self.iterable.next()
+ line = line.rstrip()
+ return line
+
+class PushbackIterator(object):
+ """PushbackIterator(iterable)
+
+ Return an iterator for which items can be pushed back into.
+ Call the .pushback(item) method to have item returned as the next
+ value of .next().
+ """
+ def __init__(self, iterable):
+ object.__init__(self)
+ self.iterable = iter(iterable)
+ self.buffer = []
+
+ def __iter__(self):
+ return self
+
+ def next(self):
+ if self.buffer:
+ return self.buffer.pop()
+ else:
+ return self.iterable.next()
+
+ def pushback(self, item):
+ self.buffer.append(item)
+
+def fortranSourceLines(fo):
+ """Return an iterator over statement lines of a Fortran source file.
+
+ Comment and blank lines are stripped out, and continuation lines are
+ merged.
+ """
+ numberingiter = LineIterator(fo)
+ # add an extra '' at the end
+ with_extra = itertools.chain(numberingiter, [''])
+ pushbackiter = PushbackIterator(with_extra)
+ for line in pushbackiter:
+ t = lineType(line)
+ if t == COMMENT:
+ continue
+ elif t == STATEMENT:
+ lines = [line]
+ # this is where we need the extra '', so we don't finish reading
+ # the iterator when we don't want to handle that
+ for next_line in pushbackiter:
+ t = lineType(next_line)
+ if t == CONTINUATION:
+ lines.append(next_line[6:])
+ else:
+ pushbackiter.pushback(next_line)
+ break
+ yield numberingiter.lineno, ''.join(lines)
+ else:
+ raise ValueError("jammed: continuation line not expected: %s:%d" %
+ (fo.name, numberingiter.lineno))
+
+def getDependencies(filename):
+ """For a Fortran source file, return a list of routines declared as EXTERNAL
+ in it.
+ """
+ fo = open(filename)
+ external_pat = re.compile(r'^\s*EXTERNAL\s', re.I)
+ routines = []
+ for lineno, line in fortranSourceLines(fo):
+ m = external_pat.match(line)
+ if m:
+ names = line = line[m.end():].strip().split(',')
+ names = [n.strip().lower() for n in names]
+ names = [n for n in names if n]
+ routines.extend(names)
+ fo.close()
+ return routines
diff --git a/numpy/linalg/lapack_lite/make_lite.py b/numpy/linalg/lapack_lite/make_lite.py
new file mode 100755
index 000000000..dec0be017
--- /dev/null
+++ b/numpy/linalg/lapack_lite/make_lite.py
@@ -0,0 +1,264 @@
+#!/usr/bin/env python
+
+import sys, os
+import fortran
+import clapack_scrub
+
+try: set
+except NameError:
+ from sets import Set as set
+
+# Arguments to pass to f2c. You'll always want -A for ANSI C prototypes
+# Others of interest: -a to not make variables static by default
+# -C to check array subscripts
+F2C_ARGS = '-A'
+
+# The header to add to the top of the *_lite.c file. Note that dlamch_() calls
+# will be replaced by the macros below by clapack_scrub.scrub_source()
+HEADER = '''\
+/*
+NOTE: This is generated code. Look in Misc/lapack_lite for information on
+ remaking this file.
+*/
+#include "Numeric/f2c.h"
+
+#ifdef HAVE_CONFIG
+#include "config.h"
+#else
+extern doublereal dlamch_(char *);
+#define EPSILON dlamch_("Epsilon")
+#define SAFEMINIMUM dlamch_("Safe minimum")
+#define PRECISION dlamch_("Precision")
+#define BASE dlamch_("Base")
+#endif
+
+extern doublereal dlapy2_(doublereal *x, doublereal *y);
+
+'''
+
+class FortranRoutine:
+ """Wrapper for a Fortran routine in a file.
+ """
+ type = 'generic'
+ def __init__(self, name=None, filename=None):
+ self.filename = filename
+ if name is None:
+ root, ext = os.path.splitext(filename)
+ name = root
+ self.name = name
+ self._dependencies = None
+
+ def dependencies(self):
+ if self._dependencies is None:
+ deps = fortran.getDependencies(self.filename)
+ self._dependencies = [d.lower() for d in deps]
+ return self._dependencies
+
+class UnknownFortranRoutine(FortranRoutine):
+ """Wrapper for a Fortran routine for which the corresponding file
+ is not known.
+ """
+ type = 'unknown'
+ def __init__(self, name):
+ FortranRoutine.__init__(self, name=name, filename='<unknown>')
+
+ def dependencies(self):
+ return []
+
+class FortranLibrary:
+ """Container for a bunch of Fortran routines.
+ """
+ def __init__(self, src_dirs):
+ self._src_dirs = src_dirs
+ self.names_to_routines = {}
+
+ def _findRoutine(self, rname):
+ rname = rname.lower()
+ for s in self._src_dirs:
+ ffilename = os.path.join(s, rname + '.f')
+ if os.path.exists(ffilename):
+ return self._newFortranRoutine(rname, ffilename)
+ return UnknownFortranRoutine(rname)
+
+ def _newFortranRoutine(self, rname, filename):
+ return FortranRoutine(rname, filename)
+
+ def addIgnorableRoutine(self, rname):
+ """Add a routine that we don't want to consider when looking at
+ dependencies.
+ """
+ rname = rname.lower()
+ routine = UnknownFortranRoutine(rname)
+ self.names_to_routines[rname] = routine
+
+ def addRoutine(self, rname):
+ """Add a routine to the library.
+ """
+ self.getRoutine(rname)
+
+ def getRoutine(self, rname):
+ """Get a routine from the library. Will add if it's not found.
+ """
+ unique = []
+ rname = rname.lower()
+ routine = self.names_to_routines.get(rname, unique)
+ if routine is unique:
+ routine = self._findRoutine(rname)
+ self.names_to_routines[rname] = routine
+ return routine
+
+ def allRoutineNames(self):
+ """Return the names of all the routines.
+ """
+ return self.names_to_routines.keys()
+
+ def allRoutines(self):
+ """Return all the routines.
+ """
+ return self.names_to_routines.values()
+
+ def resolveAllDependencies(self):
+ """Try to add routines to the library to satisfy all the dependencies
+ for each routine in the library.
+
+ Returns a set of routine names that have the dependencies unresolved.
+ """
+ done_this = set()
+ last_todo = set()
+ while 1:
+ todo = set(self.allRoutineNames()) - done_this
+ if todo == last_todo:
+ break
+ for rn in todo:
+ r = self.getRoutine(rn)
+ deps = r.dependencies()
+ for d in deps:
+ self.addRoutine(d)
+ done_this.add(rn)
+ last_todo = todo
+ return todo
+
+class LapackLibrary(FortranLibrary):
+ def _newFortranRoutine(self, rname, filename):
+ routine = FortranLibrary._newFortranRoutine(self, rname, filename)
+ if filename.find('BLAS') != -1:
+ routine.type = 'blas'
+ elif rname.startswith('z'):
+ routine.type = 'zlapack'
+ else:
+ routine.type = 'dlapack'
+ return routine
+
+ def allRoutinesByType(self, typename):
+ routines = [(r.name,r) for r in self.allRoutines() if r.type == typename]
+ routines.sort()
+ return [a[1] for a in routines]
+
+def printRoutineNames(desc, routines):
+ print desc
+ for r in routines:
+ print '\t%s' % r.name
+
+def getLapackRoutines(wrapped_routines, ignores, lapack_dir):
+ blas_src_dir = os.path.join(lapack_dir, 'BLAS', 'SRC')
+ if not os.path.exists(blas_src_dir):
+ blas_src_dir = os.path.join(lapack_dir, 'blas', 'src')
+ lapack_src_dir = os.path.join(lapack_dir, 'SRC')
+ if not os.path.exists(lapack_src_dir):
+ lapack_src_dir = os.path.join(lapack_dir, 'src')
+ library = LapackLibrary([blas_src_dir, lapack_src_dir])
+
+ for r in ignores:
+ library.addIgnorableRoutine(r)
+
+ for w in wrapped_routines:
+ library.addRoutine(w)
+
+ library.resolveAllDependencies()
+
+ return library
+
+def getWrappedRoutineNames(wrapped_routines_file):
+ fo = open(wrapped_routines_file)
+ routines = []
+ ignores = []
+ for line in fo:
+ line = line.strip()
+ if not line or line.startswith('#'):
+ continue
+ if line.startswith('IGNORE:'):
+ line = line[7:].strip()
+ ig = line.split()
+ ignores.extend(ig)
+ else:
+ routines.append(line)
+ return routines, ignores
+
+def dumpRoutineNames(library, output_dir):
+ for typename in ['unknown', 'blas', 'dlapack', 'zlapack']:
+ routines = library.allRoutinesByType(typename)
+ filename = os.path.join(output_dir, typename + '_routines.lst')
+ fo = open(filename, 'w')
+ for r in routines:
+ deps = r.dependencies()
+ fo.write('%s: %s\n' % (r.name, ' '.join(deps)))
+ fo.close()
+
+def concatenateRoutines(routines, output_file):
+ output_fo = open(output_file, 'w')
+ for r in routines:
+ fo = open(r.filename, 'r')
+ source = fo.read()
+ fo.close()
+ output_fo.write(source)
+ output_fo.close()
+
+class F2CError(Exception):
+ pass
+
+def runF2C(fortran_filename, output_dir):
+ # we're assuming no funny business that needs to be quoted for the shell
+ cmd = "f2c %s -d %s %s" % (F2C_ARGS, output_dir, fortran_filename)
+ rc = os.system(cmd)
+ if rc != 0:
+ raise F2CError
+
+def scrubF2CSource(c_file):
+ fo = open(c_file, 'r')
+ source = fo.read()
+ fo.close()
+ source = clapack_scrub.scrubSource(source, verbose=True)
+ fo = open(c_file, 'w')
+ fo.write(HEADER)
+ fo.write(source)
+ fo.close()
+
+def main():
+ if len(sys.argv) != 4:
+ print 'Usage: %s wrapped_routines_file lapack_dir output_dir' % \
+ (sys.argv[0],)
+ return
+ wrapped_routines_file = sys.argv[1]
+ lapack_src_dir = sys.argv[2]
+ output_dir = sys.argv[3]
+
+ wrapped_routines, ignores = getWrappedRoutineNames(wrapped_routines_file)
+ library = getLapackRoutines(wrapped_routines, ignores, lapack_src_dir)
+
+ dumpRoutineNames(library, output_dir)
+
+ for typename in ['blas', 'dlapack', 'zlapack']:
+ print 'creating %s_lite.c ...' % typename
+ routines = library.allRoutinesByType(typename)
+ fortran_file = os.path.join(output_dir, typename+'_lite.f')
+ c_file = fortran_file[:-2] + '.c'
+ concatenateRoutines(routines, fortran_file)
+ try:
+ runF2C(fortran_file, output_dir)
+ except F2CError:
+ print 'f2c failed on %s' % fortran_file
+ break
+ scrubF2CSource(c_file)
+
+if __name__ == '__main__':
+ main()
diff --git a/numpy/linalg/lapack_lite/wrapped_routines b/numpy/linalg/lapack_lite/wrapped_routines
new file mode 100644
index 000000000..2045c12cd
--- /dev/null
+++ b/numpy/linalg/lapack_lite/wrapped_routines
@@ -0,0 +1,19 @@
+dgeev
+zgeev
+dsyevd
+zheevd
+dgelsd
+zgelsd
+dgesv
+zgesv
+dgetrf
+zgetrf
+dpotrf
+zpotrf
+dgesdd
+zgesdd
+dgeqrf
+zgeqrf
+# need this b/c it's not properly declared as external in the BLAS source
+dcabs1
+IGNORE: dlamch
diff --git a/numpy/linalg/lapack_litemodule.c b/numpy/linalg/lapack_litemodule.c
new file mode 100644
index 000000000..778aa55de
--- /dev/null
+++ b/numpy/linalg/lapack_litemodule.c
@@ -0,0 +1,836 @@
+/*This module contributed by Doug Heisterkamp
+Modified by Jim Hugunin
+More modifications by Jeff Whitaker
+*/
+
+#include "Python.h"
+#include "numpy/noprefix.h"
+
+#ifdef NO_APPEND_FORTRAN
+# define FNAME(x) x
+#else
+# define FNAME(x) x##_
+#endif
+
+typedef struct { float r, i; } f2c_complex;
+typedef struct { double r, i; } f2c_doublecomplex;
+/* typedef long int (*L_fp)(); */
+
+extern int FNAME(dgeev)(char *jobvl, char *jobvr, int *n,
+ double a[], int *lda, double wr[], double wi[],
+ double vl[], int *ldvl, double vr[], int *ldvr,
+ double work[], int lwork[], int *info);
+extern int FNAME(zgeev)(char *jobvl, char *jobvr, int *n,
+ f2c_doublecomplex a[], int *lda,
+ f2c_doublecomplex w[],
+ f2c_doublecomplex vl[], int *ldvl,
+ f2c_doublecomplex vr[], int *ldvr,
+ f2c_doublecomplex work[], int *lwork,
+ double rwork[], int *info);
+
+extern int FNAME(dsyevd)(char *jobz, char *uplo, int *n,
+ double a[], int *lda, double w[], double work[],
+ int *lwork, int iwork[], int *liwork, int *info);
+extern int FNAME(zheevd)(char *jobz, char *uplo, int *n,
+ f2c_doublecomplex a[], int *lda,
+ double w[], f2c_doublecomplex work[],
+ int *lwork, double rwork[], int *lrwork, int iwork[],
+ int *liwork, int *info);
+
+extern int FNAME(dgelsd)(int *m, int *n, int *nrhs,
+ double a[], int *lda, double b[], int *ldb,
+ double s[], double *rcond, int *rank,
+ double work[], int *lwork, int iwork[], int *info);
+extern int FNAME(zgelsd)(int *m, int *n, int *nrhs,
+ f2c_doublecomplex a[], int *lda,
+ f2c_doublecomplex b[], int *ldb,
+ double s[], double *rcond, int *rank,
+ f2c_doublecomplex work[], int *lwork,
+ double rwork[], int iwork[], int *info);
+
+extern int FNAME(dgesv)(int *n, int *nrhs,
+ double a[], int *lda, int ipiv[],
+ double b[], int *ldb, int *info);
+extern int FNAME(zgesv)(int *n, int *nrhs,
+ f2c_doublecomplex a[], int *lda, int ipiv[],
+ f2c_doublecomplex b[], int *ldb, int *info);
+
+extern int FNAME(dgetrf)(int *m, int *n,
+ double a[], int *lda, int ipiv[], int *info);
+extern int FNAME(zgetrf)(int *m, int *n,
+ f2c_doublecomplex a[], int *lda, int ipiv[],
+ int *info);
+
+extern int FNAME(dpotrf)(char *uplo, int *n, double a[], int *lda, int *info);
+extern int FNAME(zpotrf)(char *uplo, int *n,
+ f2c_doublecomplex a[], int *lda, int *info);
+
+extern int FNAME(dgesdd)(char *jobz, int *m, int *n,
+ double a[], int *lda, double s[], double u[],
+ int *ldu, double vt[], int *ldvt, double work[],
+ int *lwork, int iwork[], int *info);
+extern int FNAME(zgesdd)(char *jobz, int *m, int *n,
+ f2c_doublecomplex a[], int *lda,
+ double s[], f2c_doublecomplex u[], int *ldu,
+ f2c_doublecomplex vt[], int *ldvt,
+ f2c_doublecomplex work[], int *lwork,
+ double rwork[], int iwork[], int *info);
+
+extern int FNAME(dgeqrf)(int *m, int *n, double a[], int *lda,
+ double tau[], double work[],
+ int *lwork, int *info);
+
+extern int FNAME(zgeqrf)(int *m, int *n, f2c_doublecomplex a[], int *lda,
+ f2c_doublecomplex tau[], f2c_doublecomplex work[],
+ int *lwork, int *info);
+
+extern int FNAME(dorgqr)(int *m, int *n, int *k, double a[], int *lda,
+ double tau[], double work[],
+ int *lwork, int *info);
+
+extern int FNAME(zungqr)(int *m, int *n, int *k, f2c_doublecomplex a[],
+ int *lda, f2c_doublecomplex tau[],
+ f2c_doublecomplex work[], int *lwork, int *info);
+
+static PyObject *LapackError;
+
+#define TRY(E) if (!(E)) return NULL
+
+static int
+check_object(PyObject *ob, int t, char *obname,
+ char *tname, char *funname)
+{
+ if (!PyArray_Check(ob)) {
+ PyErr_Format(LapackError,
+ "Expected an array for parameter %s in lapack_lite.%s",
+ obname, funname);
+ return 0;
+ } else if (!(((PyArrayObject *)ob)->flags & CONTIGUOUS)) {
+ PyErr_Format(LapackError,
+ "Parameter %s is not contiguous in lapack_lite.%s",
+ obname, funname);
+ return 0;
+ } else if (!(((PyArrayObject *)ob)->descr->type_num == t)) {
+ PyErr_Format(LapackError,
+ "Parameter %s is not of type %s in lapack_lite.%s",
+ obname, tname, funname);
+ return 0;
+ } else {
+ return 1;
+ }
+}
+
+#define CHDATA(p) ((char *) (((PyArrayObject *)p)->data))
+#define SHDATA(p) ((short int *) (((PyArrayObject *)p)->data))
+#define DDATA(p) ((double *) (((PyArrayObject *)p)->data))
+#define FDATA(p) ((float *) (((PyArrayObject *)p)->data))
+#define CDATA(p) ((f2c_complex *) (((PyArrayObject *)p)->data))
+#define ZDATA(p) ((f2c_doublecomplex *) (((PyArrayObject *)p)->data))
+#define IDATA(p) ((int *) (((PyArrayObject *)p)->data))
+
+static PyObject *
+lapack_lite_dgeev(PyObject *self, PyObject *args)
+{
+ int lapack_lite_status__;
+ char jobvl;
+ char jobvr;
+ int n;
+ PyObject *a;
+ int lda;
+ PyObject *wr;
+ PyObject *wi;
+ PyObject *vl;
+ int ldvl;
+ PyObject *vr;
+ int ldvr;
+ PyObject *work;
+ int lwork;
+ int info;
+ TRY(PyArg_ParseTuple(args,"cciOiOOOiOiOii",
+ &jobvl,&jobvr,&n,&a,&lda,&wr,&wi,&vl,&ldvl,
+ &vr,&ldvr,&work,&lwork,&info));
+
+ TRY(check_object(a,PyArray_DOUBLE,"a","PyArray_DOUBLE","dgeev"));
+ TRY(check_object(wr,PyArray_DOUBLE,"wr","PyArray_DOUBLE","dgeev"));
+ TRY(check_object(wi,PyArray_DOUBLE,"wi","PyArray_DOUBLE","dgeev"));
+ TRY(check_object(vl,PyArray_DOUBLE,"vl","PyArray_DOUBLE","dgeev"));
+ TRY(check_object(vr,PyArray_DOUBLE,"vr","PyArray_DOUBLE","dgeev"));
+ TRY(check_object(work,PyArray_DOUBLE,"work","PyArray_DOUBLE","dgeev"));
+
+ lapack_lite_status__ = \
+ FNAME(dgeev)(&jobvl,&jobvr,&n,DDATA(a),&lda,DDATA(wr),DDATA(wi),
+ DDATA(vl),&ldvl,DDATA(vr),&ldvr,DDATA(work),&lwork,
+ &info);
+
+ return Py_BuildValue("{s:i,s:c,s:c,s:i,s:i,s:i,s:i,s:i,s:i}","dgeev_",
+ lapack_lite_status__,"jobvl",jobvl,"jobvr",jobvr,
+ "n",n,"lda",lda,"ldvl",ldvl,"ldvr",ldvr,
+ "lwork",lwork,"info",info);
+}
+
+static PyObject *
+lapack_lite_dsyevd(PyObject *self, PyObject *args)
+{
+ /* Arguments */
+ /* ========= */
+
+ char jobz;
+ /* JOBZ (input) CHARACTER*1 */
+ /* = 'N': Compute eigenvalues only; */
+ /* = 'V': Compute eigenvalues and eigenvectors. */
+
+ char uplo;
+ /* UPLO (input) CHARACTER*1 */
+ /* = 'U': Upper triangle of A is stored; */
+ /* = 'L': Lower triangle of A is stored. */
+
+ int n;
+ /* N (input) INTEGER */
+ /* The order of the matrix A. N >= 0. */
+
+ PyObject *a;
+ /* A (input/output) DOUBLE PRECISION array, dimension (LDA, N) */
+ /* On entry, the symmetric matrix A. If UPLO = 'U', the */
+ /* leading N-by-N upper triangular part of A contains the */
+ /* upper triangular part of the matrix A. If UPLO = 'L', */
+ /* the leading N-by-N lower triangular part of A contains */
+ /* the lower triangular part of the matrix A. */
+ /* On exit, if JOBZ = 'V', then if INFO = 0, A contains the */
+ /* orthonormal eigenvectors of the matrix A. */
+ /* If JOBZ = 'N', then on exit the lower triangle (if UPLO='L') */
+ /* or the upper triangle (if UPLO='U') of A, including the */
+ /* diagonal, is destroyed. */
+
+ int lda;
+ /* LDA (input) INTEGER */
+ /* The leading dimension of the array A. LDA >= max(1,N). */
+
+ PyObject *w;
+ /* W (output) DOUBLE PRECISION array, dimension (N) */
+ /* If INFO = 0, the eigenvalues in ascending order. */
+
+ PyObject *work;
+ /* WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK) */
+ /* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
+
+ int lwork;
+ /* LWORK (input) INTEGER */
+ /* The length of the array WORK. LWORK >= max(1,3*N-1). */
+ /* For optimal efficiency, LWORK >= (NB+2)*N, */
+ /* where NB is the blocksize for DSYTRD returned by ILAENV. */
+
+ PyObject *iwork;
+ int liwork;
+
+ int info;
+ /* INFO (output) INTEGER */
+ /* = 0: successful exit */
+ /* < 0: if INFO = -i, the i-th argument had an illegal value */
+ /* > 0: if INFO = i, the algorithm failed to converge; i */
+ /* off-diagonal elements of an intermediate tridiagonal */
+ /* form did not converge to zero. */
+
+ int lapack_lite_status__;
+
+ TRY(PyArg_ParseTuple(args,"cciOiOOiOii",
+ &jobz,&uplo,&n,&a,&lda,&w,&work,&lwork,
+ &iwork,&liwork,&info));
+
+ TRY(check_object(a,PyArray_DOUBLE,"a","PyArray_DOUBLE","dsyevd"));
+ TRY(check_object(w,PyArray_DOUBLE,"w","PyArray_DOUBLE","dsyevd"));
+ TRY(check_object(work,PyArray_DOUBLE,"work","PyArray_DOUBLE","dsyevd"));
+ TRY(check_object(iwork,PyArray_INT,"iwork","PyArray_INT","dsyevd"));
+
+ lapack_lite_status__ = \
+ FNAME(dsyevd)(&jobz,&uplo,&n,DDATA(a),&lda,DDATA(w),DDATA(work),
+ &lwork,IDATA(iwork),&liwork,&info);
+
+ return Py_BuildValue("{s:i,s:c,s:c,s:i,s:i,s:i,s:i,s:i}","dsyevd_",
+ lapack_lite_status__,"jobz",jobz,"uplo",uplo,
+ "n",n,"lda",lda,"lwork",lwork,"liwork",liwork,"info",info);
+}
+
+static PyObject *
+lapack_lite_zheevd(PyObject *self, PyObject *args)
+{
+ /* Arguments */
+ /* ========= */
+
+ char jobz;
+ /* JOBZ (input) CHARACTER*1 */
+ /* = 'N': Compute eigenvalues only; */
+ /* = 'V': Compute eigenvalues and eigenvectors. */
+
+ char uplo;
+ /* UPLO (input) CHARACTER*1 */
+ /* = 'U': Upper triangle of A is stored; */
+ /* = 'L': Lower triangle of A is stored. */
+
+ int n;
+ /* N (input) INTEGER */
+ /* The order of the matrix A. N >= 0. */
+
+ PyObject *a;
+ /* A (input/output) COMPLEX*16 array, dimension (LDA, N) */
+ /* On entry, the Hermitian matrix A. If UPLO = 'U', the */
+ /* leading N-by-N upper triangular part of A contains the */
+ /* upper triangular part of the matrix A. If UPLO = 'L', */
+ /* the leading N-by-N lower triangular part of A contains */
+ /* the lower triangular part of the matrix A. */
+ /* On exit, if JOBZ = 'V', then if INFO = 0, A contains the */
+ /* orthonormal eigenvectors of the matrix A. */
+ /* If JOBZ = 'N', then on exit the lower triangle (if UPLO='L') */
+ /* or the upper triangle (if UPLO='U') of A, including the */
+ /* diagonal, is destroyed. */
+
+ int lda;
+ /* LDA (input) INTEGER */
+ /* The leading dimension of the array A. LDA >= max(1,N). */
+
+ PyObject *w;
+ /* W (output) DOUBLE PRECISION array, dimension (N) */
+ /* If INFO = 0, the eigenvalues in ascending order. */
+
+ PyObject *work;
+ /* WORK (workspace/output) COMPLEX*16 array, dimension (LWORK) */
+ /* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
+
+ int lwork;
+ /* LWORK (input) INTEGER */
+ /* The length of the array WORK. LWORK >= max(1,3*N-1). */
+ /* For optimal efficiency, LWORK >= (NB+2)*N, */
+ /* where NB is the blocksize for DSYTRD returned by ILAENV. */
+
+ PyObject *rwork;
+ /* RWORK (workspace) DOUBLE PRECISION array, dimension (max(1, 3*N-2)) */
+ int lrwork;
+
+ PyObject *iwork;
+ int liwork;
+
+ int info;
+ /* INFO (output) INTEGER */
+ /* = 0: successful exit */
+ /* < 0: if INFO = -i, the i-th argument had an illegal value */
+ /* > 0: if INFO = i, the algorithm failed to converge; i */
+ /* off-diagonal elements of an intermediate tridiagonal */
+ /* form did not converge to zero. */
+
+ int lapack_lite_status__;
+
+ TRY(PyArg_ParseTuple(args,"cciOiOOiOiOii",
+ &jobz,&uplo,&n,&a,&lda,&w,&work,&lwork,&rwork,
+ &lrwork,&iwork,&liwork,&info));
+
+ TRY(check_object(a,PyArray_CDOUBLE,"a","PyArray_CDOUBLE","zheevd"));
+ TRY(check_object(w,PyArray_DOUBLE,"w","PyArray_DOUBLE","zheevd"));
+ TRY(check_object(work,PyArray_CDOUBLE,"work","PyArray_CDOUBLE","zheevd"));
+ TRY(check_object(w,PyArray_DOUBLE,"rwork","PyArray_DOUBLE","zheevd"));
+ TRY(check_object(iwork,PyArray_INT,"iwork","PyArray_INT","zheevd"));
+
+ lapack_lite_status__ = \
+ FNAME(zheevd)(&jobz,&uplo,&n,ZDATA(a),&lda,DDATA(w),ZDATA(work),
+ &lwork,DDATA(rwork),&lrwork,IDATA(iwork),&liwork,&info);
+
+ return Py_BuildValue("{s:i,s:c,s:c,s:i,s:i,s:i,s:i,s:i,s:i}","zheevd_",
+ lapack_lite_status__,"jobz",jobz,"uplo",uplo,"n",n,
+ "lda",lda,"lwork",lwork,"lrwork",lrwork,
+ "liwork",liwork,"info",info);
+}
+
+static PyObject *
+lapack_lite_dgelsd(PyObject *self, PyObject *args)
+{
+ int lapack_lite_status__;
+ int m;
+ int n;
+ int nrhs;
+ PyObject *a;
+ int lda;
+ PyObject *b;
+ int ldb;
+ PyObject *s;
+ double rcond;
+ int rank;
+ PyObject *work;
+ PyObject *iwork;
+ int lwork;
+ int info;
+ TRY(PyArg_ParseTuple(args,"iiiOiOiOdiOiOi",
+ &m,&n,&nrhs,&a,&lda,&b,&ldb,&s,&rcond,
+ &rank,&work,&lwork,&iwork,&info));
+
+ TRY(check_object(a,PyArray_DOUBLE,"a","PyArray_DOUBLE","dgelsd"));
+ TRY(check_object(b,PyArray_DOUBLE,"b","PyArray_DOUBLE","dgelsd"));
+ TRY(check_object(s,PyArray_DOUBLE,"s","PyArray_DOUBLE","dgelsd"));
+ TRY(check_object(work,PyArray_DOUBLE,"work","PyArray_DOUBLE","dgelsd"));
+ TRY(check_object(iwork,PyArray_INT,"iwork","PyArray_INT","dgelsd"));
+
+ lapack_lite_status__ = \
+ FNAME(dgelsd)(&m,&n,&nrhs,DDATA(a),&lda,DDATA(b),&ldb,
+ DDATA(s),&rcond,&rank,DDATA(work),&lwork,
+ IDATA(iwork),&info);
+
+ return Py_BuildValue("{s:i,s:i,s:i,s:i,s:i,s:i,s:d,s:i,s:i,s:i}","dgelsd_",
+ lapack_lite_status__,"m",m,"n",n,"nrhs",nrhs,
+ "lda",lda,"ldb",ldb,"rcond",rcond,"rank",rank,
+ "lwork",lwork,"info",info);
+}
+
+static PyObject *
+lapack_lite_dgesv(PyObject *self, PyObject *args)
+{
+ int lapack_lite_status__;
+ int n;
+ int nrhs;
+ PyObject *a;
+ int lda;
+ PyObject *ipiv;
+ PyObject *b;
+ int ldb;
+ int info;
+ TRY(PyArg_ParseTuple(args,"iiOiOOii",&n,&nrhs,&a,&lda,&ipiv,&b,&ldb,&info));
+
+ TRY(check_object(a,PyArray_DOUBLE,"a","PyArray_DOUBLE","dgesv"));
+ TRY(check_object(ipiv,PyArray_INT,"ipiv","PyArray_INT","dgesv"));
+ TRY(check_object(b,PyArray_DOUBLE,"b","PyArray_DOUBLE","dgesv"));
+
+ lapack_lite_status__ = \
+ FNAME(dgesv)(&n,&nrhs,DDATA(a),&lda,IDATA(ipiv),DDATA(b),&ldb,&info);
+
+ return Py_BuildValue("{s:i,s:i,s:i,s:i,s:i,s:i}","dgesv_",
+ lapack_lite_status__,"n",n,"nrhs",nrhs,"lda",lda,
+ "ldb",ldb,"info",info);
+}
+
+static PyObject *
+lapack_lite_dgesdd(PyObject *self, PyObject *args)
+{
+ int lapack_lite_status__;
+ char jobz;
+ int m;
+ int n;
+ PyObject *a;
+ int lda;
+ PyObject *s;
+ PyObject *u;
+ int ldu;
+ PyObject *vt;
+ int ldvt;
+ PyObject *work;
+ int lwork;
+ PyObject *iwork;
+ int info;
+ TRY(PyArg_ParseTuple(args,"ciiOiOOiOiOiOi",
+ &jobz,&m,&n,&a,&lda,&s,&u,&ldu,&vt,&ldvt,
+ &work,&lwork,&iwork,&info));
+
+ TRY(check_object(a,PyArray_DOUBLE,"a","PyArray_DOUBLE","dgesdd"));
+ TRY(check_object(s,PyArray_DOUBLE,"s","PyArray_DOUBLE","dgesdd"));
+ TRY(check_object(u,PyArray_DOUBLE,"u","PyArray_DOUBLE","dgesdd"));
+ TRY(check_object(vt,PyArray_DOUBLE,"vt","PyArray_DOUBLE","dgesdd"));
+ TRY(check_object(work,PyArray_DOUBLE,"work","PyArray_DOUBLE","dgesdd"));
+ TRY(check_object(iwork,PyArray_INT,"iwork","PyArray_INT","dgesdd"));
+
+ lapack_lite_status__ = \
+ FNAME(dgesdd)(&jobz,&m,&n,DDATA(a),&lda,DDATA(s),DDATA(u),&ldu,
+ DDATA(vt),&ldvt,DDATA(work),&lwork,IDATA(iwork),
+ &info);
+
+ if (info == 0 && lwork == -1) {
+ /* We need to check the result because
+ sometimes the "optimal" value is actually
+ too small.
+ Change it to the maximum of the minimum and the optimal.
+ */
+ long work0 = (long) *DDATA(work);
+ int mn = MIN(m,n);
+ int mx = MAX(m,n);
+
+ switch(jobz){
+ case 'N':
+ work0 = MAX(work0,3*mn + MAX(mx,6*mn)+500);
+ break;
+ case 'O':
+ work0 = MAX(work0,3*mn*mn + \
+ MAX(mx,5*mn*mn+4*mn+500));
+ break;
+ case 'S':
+ case 'A':
+ work0 = MAX(work0,3*mn*mn + \
+ MAX(mx,4*mn*(mn+1))+500);
+ break;
+ }
+ *DDATA(work) = (double) work0;
+ }
+ return Py_BuildValue("{s:i,s:c,s:i,s:i,s:i,s:i,s:i,s:i,s:i}","dgesdd_",
+ lapack_lite_status__,"jobz",jobz,"m",m,"n",n,
+ "lda",lda,"ldu",ldu,"ldvt",ldvt,"lwork",lwork,
+ "info",info);
+}
+
+static PyObject *
+lapack_lite_dgetrf(PyObject *self, PyObject *args)
+{
+ int lapack_lite_status__;
+ int m;
+ int n;
+ PyObject *a;
+ int lda;
+ PyObject *ipiv;
+ int info;
+ TRY(PyArg_ParseTuple(args,"iiOiOi",&m,&n,&a,&lda,&ipiv,&info));
+
+ TRY(check_object(a,PyArray_DOUBLE,"a","PyArray_DOUBLE","dgetrf"));
+ TRY(check_object(ipiv,PyArray_INT,"ipiv","PyArray_INT","dgetrf"));
+
+ lapack_lite_status__ = \
+ FNAME(dgetrf)(&m,&n,DDATA(a),&lda,IDATA(ipiv),&info);
+
+ return Py_BuildValue("{s:i,s:i,s:i,s:i,s:i}","dgetrf_",lapack_lite_status__,
+ "m",m,"n",n,"lda",lda,"info",info);
+}
+
+static PyObject *
+lapack_lite_dpotrf(PyObject *self, PyObject *args)
+{
+ int lapack_lite_status__;
+ int n;
+ PyObject *a;
+ int lda;
+ char uplo;
+ int info;
+
+ TRY(PyArg_ParseTuple(args,"ciOii",&uplo,&n,&a,&lda,&info));
+ TRY(check_object(a,PyArray_DOUBLE,"a","PyArray_DOUBLE","dpotrf"));
+
+ lapack_lite_status__ = \
+ FNAME(dpotrf)(&uplo,&n,DDATA(a),&lda,&info);
+
+ return Py_BuildValue("{s:i,s:i,s:i,s:i}","dpotrf_",lapack_lite_status__,
+ "n",n,"lda",lda,"info",info);
+}
+
+static PyObject *
+lapack_lite_dgeqrf(PyObject *self, PyObject *args)
+{
+ int lapack_lite_status__;
+ int m, n, lwork;
+ PyObject *a, *tau, *work;
+ int lda;
+ int info;
+
+ TRY(PyArg_ParseTuple(args,"iiOiOOii",&m,&n,&a,&lda,&tau,&work,&lwork,&info));
+
+ /* check objects and convert to right storage order */
+ TRY(check_object(a,PyArray_DOUBLE,"a","PyArray_DOUBLE","dgeqrf"));
+ TRY(check_object(tau,PyArray_DOUBLE,"tau","PyArray_DOUBLE","dgeqrf"));
+ TRY(check_object(work,PyArray_DOUBLE,"work","PyArray_DOUBLE","dgeqrf"));
+
+ lapack_lite_status__ = \
+ FNAME(dgeqrf)(&m, &n, DDATA(a), &lda, DDATA(tau),
+ DDATA(work), &lwork, &info);
+
+ return Py_BuildValue("{s:i,s:i,s:i,s:i,s:i,s:i}","dgeqrf_",
+ lapack_lite_status__,"m",m,"n",n,"lda",lda,
+ "lwork",lwork,"info",info);
+}
+
+
+static PyObject *
+lapack_lite_dorgqr(PyObject *self, PyObject *args)
+{
+ int lapack_lite_status__;
+ int m, n, k, lwork;
+ PyObject *a, *tau, *work;
+ int lda;
+ int info;
+
+ TRY(PyArg_ParseTuple(args,"iiiOiOOii", &m, &n, &k, &a, &lda, &tau, &work, &lwork, &info));
+ TRY(check_object(a,PyArray_DOUBLE,"a","PyArray_DOUBLE","dorgqr"));
+ TRY(check_object(tau,PyArray_DOUBLE,"tau","PyArray_DOUBLE","dorgqr"));
+ TRY(check_object(work,PyArray_DOUBLE,"work","PyArray_DOUBLE","dorgqr"));
+ lapack_lite_status__ = \
+ FNAME(dorgqr)(&m, &n, &k, DDATA(a), &lda, DDATA(tau), DDATA(work), &lwork, &info);
+
+ return Py_BuildValue("{s:i,s:i}","dorgqr_",lapack_lite_status__,
+ "info",info);
+}
+
+
+static PyObject *
+lapack_lite_zgeev(PyObject *self, PyObject *args)
+{
+ int lapack_lite_status__;
+ char jobvl;
+ char jobvr;
+ int n;
+ PyObject *a;
+ int lda;
+ PyObject *w;
+ PyObject *vl;
+ int ldvl;
+ PyObject *vr;
+ int ldvr;
+ PyObject *work;
+ int lwork;
+ PyObject *rwork;
+ int info;
+ TRY(PyArg_ParseTuple(args,"cciOiOOiOiOiOi",
+ &jobvl,&jobvr,&n,&a,&lda,&w,&vl,&ldvl,
+ &vr,&ldvr,&work,&lwork,&rwork,&info));
+
+ TRY(check_object(a,PyArray_CDOUBLE,"a","PyArray_CDOUBLE","zgeev"));
+ TRY(check_object(w,PyArray_CDOUBLE,"w","PyArray_CDOUBLE","zgeev"));
+ TRY(check_object(vl,PyArray_CDOUBLE,"vl","PyArray_CDOUBLE","zgeev"));
+ TRY(check_object(vr,PyArray_CDOUBLE,"vr","PyArray_CDOUBLE","zgeev"));
+ TRY(check_object(work,PyArray_CDOUBLE,"work","PyArray_CDOUBLE","zgeev"));
+ TRY(check_object(rwork,PyArray_DOUBLE,"rwork","PyArray_DOUBLE","zgeev"));
+
+ lapack_lite_status__ = \
+ FNAME(zgeev)(&jobvl,&jobvr,&n,ZDATA(a),&lda,ZDATA(w),ZDATA(vl),
+ &ldvl,ZDATA(vr),&ldvr,ZDATA(work),&lwork,
+ DDATA(rwork),&info);
+
+ return Py_BuildValue("{s:i,s:c,s:c,s:i,s:i,s:i,s:i,s:i,s:i}","zgeev_",
+ lapack_lite_status__,"jobvl",jobvl,"jobvr",jobvr,
+ "n",n,"lda",lda,"ldvl",ldvl,"ldvr",ldvr,
+ "lwork",lwork,"info",info);
+}
+
+static PyObject *
+lapack_lite_zgelsd(PyObject *self, PyObject *args)
+{
+ int lapack_lite_status__;
+ int m;
+ int n;
+ int nrhs;
+ PyObject *a;
+ int lda;
+ PyObject *b;
+ int ldb;
+ PyObject *s;
+ double rcond;
+ int rank;
+ PyObject *work;
+ int lwork;
+ PyObject *rwork;
+ PyObject *iwork;
+ int info;
+ TRY(PyArg_ParseTuple(args,"iiiOiOiOdiOiOOi",
+ &m,&n,&nrhs,&a,&lda,&b,&ldb,&s,&rcond,
+ &rank,&work,&lwork,&rwork,&iwork,&info));
+
+ TRY(check_object(a,PyArray_CDOUBLE,"a","PyArray_CDOUBLE","zgelsd"));
+ TRY(check_object(b,PyArray_CDOUBLE,"b","PyArray_CDOUBLE","zgelsd"));
+ TRY(check_object(s,PyArray_DOUBLE,"s","PyArray_DOUBLE","zgelsd"));
+ TRY(check_object(work,PyArray_CDOUBLE,"work","PyArray_CDOUBLE","zgelsd"));
+ TRY(check_object(rwork,PyArray_DOUBLE,"rwork","PyArray_DOUBLE","zgelsd"));
+ TRY(check_object(iwork,PyArray_INT,"iwork","PyArray_INT","zgelsd"));
+
+ lapack_lite_status__ = \
+ FNAME(zgelsd)(&m,&n,&nrhs,ZDATA(a),&lda,ZDATA(b),&ldb,DDATA(s),&rcond,
+ &rank,ZDATA(work),&lwork,DDATA(rwork),IDATA(iwork),&info);
+
+ return Py_BuildValue("{s:i,s:i,s:i,s:i,s:i,s:i,s:i,s:i,s:i}","zgelsd_",
+ lapack_lite_status__,"m",m,"n",n,"nrhs",nrhs,"lda",lda,
+ "ldb",ldb,"rank",rank,"lwork",lwork,"info",info);
+}
+
+static PyObject *
+lapack_lite_zgesv(PyObject *self, PyObject *args)
+{
+ int lapack_lite_status__;
+ int n;
+ int nrhs;
+ PyObject *a;
+ int lda;
+ PyObject *ipiv;
+ PyObject *b;
+ int ldb;
+ int info;
+ TRY(PyArg_ParseTuple(args,"iiOiOOii",&n,&nrhs,&a,&lda,&ipiv,&b,&ldb,&info));
+
+ TRY(check_object(a,PyArray_CDOUBLE,"a","PyArray_CDOUBLE","zgesv"));
+ TRY(check_object(ipiv,PyArray_INT,"ipiv","PyArray_INT","zgesv"));
+ TRY(check_object(b,PyArray_CDOUBLE,"b","PyArray_CDOUBLE","zgesv"));
+
+ lapack_lite_status__ = \
+ FNAME(zgesv)(&n,&nrhs,ZDATA(a),&lda,IDATA(ipiv),ZDATA(b),&ldb,&info);
+
+ return Py_BuildValue("{s:i,s:i,s:i,s:i,s:i,s:i}","zgesv_",
+ lapack_lite_status__,"n",n,"nrhs",nrhs,"lda",lda,
+ "ldb",ldb,"info",info);
+}
+
+static PyObject *
+lapack_lite_zgesdd(PyObject *self, PyObject *args)
+{
+ int lapack_lite_status__;
+ char jobz;
+ int m;
+ int n;
+ PyObject *a;
+ int lda;
+ PyObject *s;
+ PyObject *u;
+ int ldu;
+ PyObject *vt;
+ int ldvt;
+ PyObject *work;
+ int lwork;
+ PyObject *rwork;
+ PyObject *iwork;
+ int info;
+ TRY(PyArg_ParseTuple(args,"ciiOiOOiOiOiOOi",
+ &jobz,&m,&n,&a,&lda,&s,&u,&ldu,
+ &vt,&ldvt,&work,&lwork,&rwork,&iwork,&info));
+
+ TRY(check_object(a,PyArray_CDOUBLE,"a","PyArray_CDOUBLE","zgesdd"));
+ TRY(check_object(s,PyArray_DOUBLE,"s","PyArray_DOUBLE","zgesdd"));
+ TRY(check_object(u,PyArray_CDOUBLE,"u","PyArray_CDOUBLE","zgesdd"));
+ TRY(check_object(vt,PyArray_CDOUBLE,"vt","PyArray_CDOUBLE","zgesdd"));
+ TRY(check_object(work,PyArray_CDOUBLE,"work","PyArray_CDOUBLE","zgesdd"));
+ TRY(check_object(rwork,PyArray_DOUBLE,"rwork","PyArray_DOUBLE","zgesdd"));
+ TRY(check_object(iwork,PyArray_INT,"iwork","PyArray_INT","zgesdd"));
+
+ lapack_lite_status__ = \
+ FNAME(zgesdd)(&jobz,&m,&n,ZDATA(a),&lda,DDATA(s),ZDATA(u),&ldu,
+ ZDATA(vt),&ldvt,ZDATA(work),&lwork,DDATA(rwork),
+ IDATA(iwork),&info);
+
+ return Py_BuildValue("{s:i,s:c,s:i,s:i,s:i,s:i,s:i,s:i,s:i}","zgesdd_",
+ lapack_lite_status__,"jobz",jobz,"m",m,"n",n,
+ "lda",lda,"ldu",ldu,"ldvt",ldvt,"lwork",lwork,
+ "info",info);
+}
+
+static PyObject *
+lapack_lite_zgetrf(PyObject *self, PyObject *args)
+{
+ int lapack_lite_status__;
+ int m;
+ int n;
+ PyObject *a;
+ int lda;
+ PyObject *ipiv;
+ int info;
+ TRY(PyArg_ParseTuple(args,"iiOiOi",&m,&n,&a,&lda,&ipiv,&info));
+
+ TRY(check_object(a,PyArray_CDOUBLE,"a","PyArray_CDOUBLE","zgetrf"));
+ TRY(check_object(ipiv,PyArray_INT,"ipiv","PyArray_INT","zgetrf"));
+
+ lapack_lite_status__ = \
+ FNAME(zgetrf)(&m,&n,ZDATA(a),&lda,IDATA(ipiv),&info);
+
+ return Py_BuildValue("{s:i,s:i,s:i,s:i,s:i}","zgetrf_",
+ lapack_lite_status__,"m",m,"n",n,"lda",lda,"info",info);
+}
+
+static PyObject *
+lapack_lite_zpotrf(PyObject *self, PyObject *args)
+{
+ int lapack_lite_status__;
+ int n;
+ PyObject *a;
+ int lda;
+ char uplo;
+ int info;
+
+ TRY(PyArg_ParseTuple(args,"ciOii",&uplo,&n,&a,&lda,&info));
+ TRY(check_object(a,PyArray_CDOUBLE,"a","PyArray_CDOUBLE","zpotrf"));
+ lapack_lite_status__ = \
+ FNAME(zpotrf)(&uplo,&n,ZDATA(a),&lda,&info);
+
+ return Py_BuildValue("{s:i,s:i,s:i,s:i}","zpotrf_",
+ lapack_lite_status__,"n",n,"lda",lda,"info",info);
+}
+
+static PyObject *
+lapack_lite_zgeqrf(PyObject *self, PyObject *args)
+{
+ int lapack_lite_status__;
+ int m, n, lwork;
+ PyObject *a, *tau, *work;
+ int lda;
+ int info;
+
+ TRY(PyArg_ParseTuple(args,"llOlOOll",&m,&n,&a,&lda,&tau,&work,&lwork,&info));
+
+/* check objects and convert to right storage order */
+ TRY(check_object(a,PyArray_CDOUBLE,"a","PyArray_CDOUBLE","zgeqrf"));
+ TRY(check_object(tau,PyArray_CDOUBLE,"tau","PyArray_CDOUBLE","zgeqrf"));
+ TRY(check_object(work,PyArray_CDOUBLE,"work","PyArray_CDOUBLE","zgeqrf"));
+
+ lapack_lite_status__ = \
+ FNAME(zgeqrf)(&m, &n, ZDATA(a), &lda, ZDATA(tau), ZDATA(work), &lwork, &info);
+
+ return Py_BuildValue("{s:l,s:l,s:l,s:l,s:l,s:l}","zgeqrf_",lapack_lite_status__,"m",m,"n",n,"lda",lda,"lwork",lwork,"info",info);
+}
+
+
+static PyObject *
+lapack_lite_zungqr(PyObject *self, PyObject *args)
+{
+ int lapack_lite_status__;
+ int m, n, k, lwork;
+ PyObject *a, *tau, *work;
+ int lda;
+ int info;
+
+ TRY(PyArg_ParseTuple(args,"iiiOiOOii", &m, &n, &k, &a, &lda, &tau, &work, &lwork, &info));
+ TRY(check_object(a,PyArray_CDOUBLE,"a","PyArray_CDOUBLE","zungqr"));
+ TRY(check_object(tau,PyArray_CDOUBLE,"tau","PyArray_CDOUBLE","zungqr"));
+ TRY(check_object(work,PyArray_CDOUBLE,"work","PyArray_CDOUBLE","zungqr"));
+
+
+ lapack_lite_status__ = \
+ FNAME(zungqr)(&m, &n, &k, ZDATA(a), &lda, ZDATA(tau), ZDATA(work),
+ &lwork, &info);
+
+ return Py_BuildValue("{s:i,s:i}","zungqr_",lapack_lite_status__,
+ "info",info);
+}
+
+
+
+#define STR(x) #x
+#define lameth(name) {STR(name), lapack_lite_##name, METH_VARARGS, NULL}
+static struct PyMethodDef lapack_lite_module_methods[] = {
+ lameth(zheevd),
+ lameth(dsyevd),
+ lameth(dgeev),
+ lameth(dgelsd),
+ lameth(dgesv),
+ lameth(dgesdd),
+ lameth(dgetrf),
+ lameth(dpotrf),
+ lameth(dgeqrf),
+ lameth(dorgqr),
+ lameth(zgeev),
+ lameth(zgelsd),
+ lameth(zgesv),
+ lameth(zgesdd),
+ lameth(zgetrf),
+ lameth(zpotrf),
+ lameth(zgeqrf),
+ lameth(zungqr),
+ { NULL,NULL,0}
+};
+
+static char lapack_lite_module_documentation[] = "";
+
+DL_EXPORT(void)
+initlapack_lite(void)
+{
+ PyObject *m,*d;
+ m = Py_InitModule4("lapack_lite", lapack_lite_module_methods,
+ lapack_lite_module_documentation,
+ (PyObject*)NULL,PYTHON_API_VERSION);
+ import_array();
+ d = PyModule_GetDict(m);
+ LapackError = PyErr_NewException("lapack_lite.LapackError", NULL, NULL);
+ PyDict_SetItemString(d, "LapackError", LapackError);
+
+ return;
+}
diff --git a/numpy/linalg/linalg.py b/numpy/linalg/linalg.py
new file mode 100644
index 000000000..7d6d986e0
--- /dev/null
+++ b/numpy/linalg/linalg.py
@@ -0,0 +1,968 @@
+"""Lite version of scipy.linalg.
+
+This module is a lite version of the linalg.py module in SciPy which contains
+high-level Python interface to the LAPACK library. The lite version
+only accesses the following LAPACK functions: dgesv, zgesv, dgeev,
+zgeev, dgesdd, zgesdd, dgelsd, zgelsd, dsyevd, zheevd, dgetrf, dpotrf.
+"""
+
+__all__ = ['solve', 'tensorsolve', 'tensorinv',
+ 'inv', 'cholesky',
+ 'eigvals',
+ 'eigvalsh', 'pinv',
+ 'det', 'svd',
+ 'eig', 'eigh','lstsq', 'norm',
+ 'qr',
+ 'LinAlgError'
+ ]
+
+from numpy.core import array, asarray, zeros, empty, transpose, \
+ intc, single, double, csingle, cdouble, inexact, complexfloating, \
+ newaxis, ravel, all, Inf, dot, add, multiply, identity, sqrt, \
+ maximum, flatnonzero, diagonal, arange, fastCopyAndTranspose, sum, \
+ isfinite
+from numpy.lib import triu
+from numpy.linalg import lapack_lite
+
+fortran_int = intc
+
+# Error object
+class LinAlgError(Exception):
+ pass
+
+def _makearray(a):
+ new = asarray(a)
+ wrap = getattr(a, "__array_wrap__", new.__array_wrap__)
+ return new, wrap
+
+def isComplexType(t):
+ return issubclass(t, complexfloating)
+
+_real_types_map = {single : single,
+ double : double,
+ csingle : single,
+ cdouble : double}
+
+_complex_types_map = {single : csingle,
+ double : cdouble,
+ csingle : csingle,
+ cdouble : cdouble}
+
+def _realType(t, default=double):
+ return _real_types_map.get(t, default)
+
+def _complexType(t, default=cdouble):
+ return _complex_types_map.get(t, default)
+
+def _linalgRealType(t):
+ """Cast the type t to either double or cdouble."""
+ return double
+
+_complex_types_map = {single : csingle,
+ double : cdouble,
+ csingle : csingle,
+ cdouble : cdouble}
+
+def _commonType(*arrays):
+ # in lite version, use higher precision (always double or cdouble)
+ result_type = single
+ is_complex = False
+ for a in arrays:
+ if issubclass(a.dtype.type, inexact):
+ if isComplexType(a.dtype.type):
+ is_complex = True
+ rt = _realType(a.dtype.type, default=None)
+ if rt is None:
+ # unsupported inexact scalar
+ raise TypeError("array type %s is unsupported in linalg" %
+ (a.dtype.name,))
+ else:
+ rt = double
+ if rt is double:
+ result_type = double
+ if is_complex:
+ t = cdouble
+ result_type = _complex_types_map[result_type]
+ else:
+ t = double
+ return t, result_type
+
+def _castCopyAndTranspose(type, *arrays):
+ if len(arrays) == 1:
+ return transpose(arrays[0]).astype(type)
+ else:
+ return [transpose(a).astype(type) for a in arrays]
+
+# _fastCopyAndTranpose is an optimized version of _castCopyAndTranspose.
+# It assumes the input is 2D (as all the calls in here are).
+
+_fastCT = fastCopyAndTranspose
+
+def _fastCopyAndTranspose(type, *arrays):
+ cast_arrays = ()
+ for a in arrays:
+ if a.dtype.type is type:
+ cast_arrays = cast_arrays + (_fastCT(a),)
+ else:
+ cast_arrays = cast_arrays + (_fastCT(a.astype(type)),)
+ if len(cast_arrays) == 1:
+ return cast_arrays[0]
+ else:
+ return cast_arrays
+
+def _assertRank2(*arrays):
+ for a in arrays:
+ if len(a.shape) != 2:
+ raise LinAlgError, '%d-dimensional array given. Array must be \
+ two-dimensional' % len(a.shape)
+
+def _assertSquareness(*arrays):
+ for a in arrays:
+ if max(a.shape) != min(a.shape):
+ raise LinAlgError, 'Array must be square'
+
+def _assertFinite(*arrays):
+ for a in arrays:
+ if not (isfinite(a).all()):
+ raise LinAlgError, "Array must not contain infs or NaNs"
+
+# Linear equations
+
+def tensorsolve(a, b, axes=None):
+ """Solves the tensor equation a x = b for x
+
+ where it is assumed that all the indices of x are summed over in
+ the product.
+
+ a can be N-dimensional. x will have the dimensions of A subtracted from
+ the dimensions of b.
+ """
+ a = asarray(a)
+ b = asarray(b)
+ an = a.ndim
+
+ if axes is not None:
+ allaxes = range(0, an)
+ for k in axes:
+ allaxes.remove(k)
+ allaxes.insert(an, k)
+ a = a.transpose(allaxes)
+
+ oldshape = a.shape[-(an-b.ndim):]
+ prod = 1
+ for k in oldshape:
+ prod *= k
+
+ a = a.reshape(-1, prod)
+ b = b.ravel()
+ res = solve(a, b)
+ res.shape = oldshape
+ return res
+
+def solve(a, b):
+ """Return the solution of a*x = b
+ """
+ one_eq = len(b.shape) == 1
+ if one_eq:
+ b = b[:, newaxis]
+ _assertRank2(a, b)
+ _assertSquareness(a)
+ n_eq = a.shape[0]
+ n_rhs = b.shape[1]
+ if n_eq != b.shape[0]:
+ raise LinAlgError, 'Incompatible dimensions'
+ t, result_t = _commonType(a, b)
+# lapack_routine = _findLapackRoutine('gesv', t)
+ if isComplexType(t):
+ lapack_routine = lapack_lite.zgesv
+ else:
+ lapack_routine = lapack_lite.dgesv
+ a, b = _fastCopyAndTranspose(t, a, b)
+ pivots = zeros(n_eq, fortran_int)
+ results = lapack_routine(n_eq, n_rhs, a, n_eq, pivots, b, n_eq, 0)
+ if results['info'] > 0:
+ raise LinAlgError, 'Singular matrix'
+ if one_eq:
+ return b.ravel().astype(result_t)
+ else:
+ return b.transpose().astype(result_t)
+
+
+def tensorinv(a, ind=2):
+ """Find the 'inverse' of a N-d array
+
+ ind must be a positive integer specifying
+ how many indices at the front of the array are involved
+ in the inverse sum.
+
+ the result is ainv with shape a.shape[ind:] + a.shape[:ind]
+
+ tensordot(ainv, a, ind) is an identity operator
+
+ and so is
+
+ tensordot(a, ainv, a.shape-newind)
+
+ Example:
+
+ a = rand(4,6,8,3)
+ ainv = tensorinv(a)
+ # ainv.shape is (8,3,4,6)
+ # suppose b has shape (4,6)
+ tensordot(ainv, b) # produces same (8,3)-shaped output as
+ tensorsolve(a, b)
+
+ a = rand(24,8,3)
+ ainv = tensorinv(a,1)
+ # ainv.shape is (8,3,24)
+ # suppose b has shape (24,)
+ tensordot(ainv, b, 1) # produces the same (8,3)-shaped output as
+ tensorsolve(a, b)
+
+ """
+ a = asarray(a)
+ oldshape = a.shape
+ prod = 1
+ if ind > 0:
+ invshape = oldshape[ind:] + oldshape[:ind]
+ for k in oldshape[ind:]:
+ prod *= k
+ else:
+ raise ValueError, "Invalid ind argument."
+ a = a.reshape(prod, -1)
+ ia = inv(a)
+ return ia.reshape(*invshape)
+
+
+# Matrix inversion
+
+def inv(a):
+ a, wrap = _makearray(a)
+ return wrap(solve(a, identity(a.shape[0], dtype=a.dtype)))
+
+# Cholesky decomposition
+
+def cholesky(a):
+ _assertRank2(a)
+ _assertSquareness(a)
+ t, result_t = _commonType(a)
+ a = _fastCopyAndTranspose(t, a)
+ m = a.shape[0]
+ n = a.shape[1]
+ if isComplexType(t):
+ lapack_routine = lapack_lite.zpotrf
+ else:
+ lapack_routine = lapack_lite.dpotrf
+ results = lapack_routine('L', n, a, m, 0)
+ if results['info'] > 0:
+ raise LinAlgError, 'Matrix is not positive definite - \
+ Cholesky decomposition cannot be computed'
+ s = triu(a, k=0).transpose()
+ if (s.dtype != result_t):
+ return s.astype(result_t)
+ return s
+
+# QR decompostion
+
+def qr(a, mode='full'):
+ """cacluates A=QR, Q orthonormal, R upper triangular
+
+ mode: 'full' --> (Q,R)
+ 'r' --> R
+ 'economic' --> A2 where the diagonal + upper triangle
+ part of A2 is R. This is faster if you only need R
+ """
+ _assertRank2(a)
+ m, n = a.shape
+ t, result_t = _commonType(a)
+ a = _fastCopyAndTranspose(t, a)
+ mn = min(m, n)
+ tau = zeros((mn,), t)
+ if isComplexType(t):
+ lapack_routine = lapack_lite.zgeqrf
+ routine_name = 'zgeqrf'
+ else:
+ lapack_routine = lapack_lite.dgeqrf
+ routine_name = 'dgeqrf'
+
+ # calculate optimal size of work data 'work'
+ lwork = 1
+ work = zeros((lwork,), t)
+ results = lapack_routine(m, n, a, m, tau, work, -1, 0)
+ if results['info'] != 0:
+ raise LinAlgError, '%s returns %d' % (routine_name, results['info'])
+
+ # do qr decomposition
+ lwork = int(abs(work[0]))
+ work = zeros((lwork,), t)
+ results = lapack_routine(m, n, a, m, tau, work, lwork, 0)
+
+ if results['info'] != 0:
+ raise LinAlgError, '%s returns %d' % (routine_name, results['info'])
+
+ # economic mode. Isn't actually economic.
+ if mode[0] == 'e':
+ if t != result_t :
+ a = a.astype(result_t)
+ return a.T
+
+ # generate r
+ r = _fastCopyAndTranspose(result_t, a[:,:mn])
+ for i in range(mn):
+ r[i,:i].fill(0.0)
+
+ # 'r'-mode, that is, calculate only r
+ if mode[0] == 'r':
+ return r
+
+ # from here on: build orthonormal matrix q from a
+
+ if isComplexType(t):
+ lapack_routine = lapack_lite.zungqr
+ routine_name = 'zungqr'
+ else:
+ lapack_routine = lapack_lite.dorgqr
+ routine_name = 'dorgqr'
+
+ # determine optimal lwork
+ lwork = 1
+ work = zeros((lwork,), t)
+ results = lapack_routine(m, mn, mn, a, m, tau, work, -1, 0)
+ if results['info'] != 0:
+ raise LinAlgError, '%s returns %d' % (routine_name, results['info'])
+
+ # compute q
+ lwork = int(abs(work[0]))
+ work = zeros((lwork,), t)
+ results = lapack_routine(m, mn, mn, a, m, tau, work, lwork, 0)
+ if results['info'] != 0:
+ raise LinAlgError, '%s returns %d' % (routine_name, results['info'])
+
+ q = _fastCopyAndTranspose(result_t, a[:mn,:])
+
+ return q, r
+
+
+# Eigenvalues
+
+
+def eigvals(a):
+ """Compute the eigenvalues of the general 2-d array a.
+
+ A simple interface to the LAPACK routines dgeev and zgeev that sets the
+ flags to return only the eigenvalues of general real and complex arrays
+ respectively.
+
+ :Parameters:
+
+ a : 2-d array
+ A complex or real 2-d array whose eigenvalues and eigenvectors
+ will be computed.
+
+ :Returns:
+
+ w : 1-d double or complex array
+ The eigenvalues. The eigenvalues are not necessarily ordered, nor
+ are they necessarily real for real matrices.
+
+ :SeeAlso:
+
+ - eig : eigenvalues and right eigenvectors of general arrays
+ - eigvalsh : eigenvalues of symmetric or Hemitiean arrays.
+ - eigh : eigenvalues and eigenvectors of symmetric/Hermitean arrays.
+
+ :Notes:
+ -------
+
+ The number w is an eigenvalue of a if there exists a vector v
+ satisfying the equation dot(a,v) = w*v. Alternately, if w is a root of
+ the characteristic equation det(a - w[i]*I) = 0, where det is the
+ determinant and I is the identity matrix.
+
+ """
+ _assertRank2(a)
+ _assertSquareness(a)
+ _assertFinite(a)
+ t, result_t = _commonType(a)
+ real_t = _linalgRealType(t)
+ a = _fastCopyAndTranspose(t, a)
+ n = a.shape[0]
+ dummy = zeros((1,), t)
+ if isComplexType(t):
+ lapack_routine = lapack_lite.zgeev
+ w = zeros((n,), t)
+ rwork = zeros((n,), real_t)
+ lwork = 1
+ work = zeros((lwork,), t)
+ results = lapack_routine('N', 'N', n, a, n, w,
+ dummy, 1, dummy, 1, work, -1, rwork, 0)
+ lwork = int(abs(work[0]))
+ work = zeros((lwork,), t)
+ results = lapack_routine('N', 'N', n, a, n, w,
+ dummy, 1, dummy, 1, work, lwork, rwork, 0)
+ else:
+ lapack_routine = lapack_lite.dgeev
+ wr = zeros((n,), t)
+ wi = zeros((n,), t)
+ lwork = 1
+ work = zeros((lwork,), t)
+ results = lapack_routine('N', 'N', n, a, n, wr, wi,
+ dummy, 1, dummy, 1, work, -1, 0)
+ lwork = int(work[0])
+ work = zeros((lwork,), t)
+ results = lapack_routine('N', 'N', n, a, n, wr, wi,
+ dummy, 1, dummy, 1, work, lwork, 0)
+ if all(wi == 0.):
+ w = wr
+ result_t = _realType(result_t)
+ else:
+ w = wr+1j*wi
+ result_t = _complexType(result_t)
+ if results['info'] > 0:
+ raise LinAlgError, 'Eigenvalues did not converge'
+ return w.astype(result_t)
+
+
+def eigvalsh(a, UPLO='L'):
+ """Compute the eigenvalues of the symmetric or Hermitean 2-d array a.
+
+ A simple interface to the LAPACK routines dsyevd and zheevd that sets the
+ flags to return only the eigenvalues of real symmetric and complex
+ Hermetian arrays respectively.
+
+ :Parameters:
+
+ a : 2-d array
+ A complex or real 2-d array whose eigenvalues and eigenvectors
+ will be computed.
+
+ UPLO : string
+ Specifies whether the pertinent array date is taken from the upper
+ or lower triangular part of a. Possible values are 'L', and 'U' for
+ upper and lower respectively. Default is 'L'.
+
+ :Returns:
+
+ w : 1-d double array
+ The eigenvalues. The eigenvalues are not necessarily ordered.
+
+ :SeeAlso:
+
+ - eigh : eigenvalues and eigenvectors of symmetric/Hermitean arrays.
+ - eigvals : eigenvalues of general real or complex arrays.
+ - eig : eigenvalues and eigenvectors of general real or complex arrays.
+
+ :Notes:
+ -------
+
+ The number w is an eigenvalue of a if there exists a vector v
+ satisfying the equation dot(a,v) = w*v. Alternately, if w is a root of
+ the characteristic equation det(a - w[i]*I) = 0, where det is the
+ determinant and I is the identity matrix. The eigenvalues of real
+ symmetric or complex Hermitean matrices are always real.
+
+ """
+ _assertRank2(a)
+ _assertSquareness(a)
+ t, result_t = _commonType(a)
+ real_t = _linalgRealType(t)
+ a = _fastCopyAndTranspose(t, a)
+ n = a.shape[0]
+ liwork = 5*n+3
+ iwork = zeros((liwork,), fortran_int)
+ if isComplexType(t):
+ lapack_routine = lapack_lite.zheevd
+ w = zeros((n,), real_t)
+ lwork = 1
+ work = zeros((lwork,), t)
+ lrwork = 1
+ rwork = zeros((lrwork,), real_t)
+ results = lapack_routine('N', UPLO, n, a, n, w, work, -1,
+ rwork, -1, iwork, liwork, 0)
+ lwork = int(abs(work[0]))
+ work = zeros((lwork,), t)
+ lrwork = int(rwork[0])
+ rwork = zeros((lrwork,), real_t)
+ results = lapack_routine('N', UPLO, n, a, n, w, work, lwork,
+ rwork, lrwork, iwork, liwork, 0)
+ else:
+ lapack_routine = lapack_lite.dsyevd
+ w = zeros((n,), t)
+ lwork = 1
+ work = zeros((lwork,), t)
+ results = lapack_routine('N', UPLO, n, a, n, w, work, -1,
+ iwork, liwork, 0)
+ lwork = int(work[0])
+ work = zeros((lwork,), t)
+ results = lapack_routine('N', UPLO, n, a, n, w, work, lwork,
+ iwork, liwork, 0)
+ if results['info'] > 0:
+ raise LinAlgError, 'Eigenvalues did not converge'
+ return w.astype(result_t)
+
+def _convertarray(a):
+ t, result_t = _commonType(a)
+ a = _fastCT(a.astype(t))
+ return a, t, result_t
+
+
+# Eigenvectors
+
+
+def eig(a):
+ """Eigenvalues and right eigenvectors of a general matrix.
+
+ A simple interface to the LAPACK routines dgeev and zgeev that compute the
+ eigenvalues and eigenvectors of general real and complex arrays
+ respectively.
+
+ :Parameters:
+
+ a : 2-d array
+ A complex or real 2-d array whose eigenvalues and eigenvectors
+ will be computed.
+
+ :Returns:
+
+ w : 1-d double or complex array
+ The eigenvalues. The eigenvalues are not necessarily ordered, nor
+ are they necessarily real for real matrices.
+
+ v : 2-d double or complex double array.
+ The normalized eigenvector corresponding to the eigenvalue w[i] is
+ the column v[:,i].
+
+ :SeeAlso:
+
+ - eigvalsh : eigenvalues of symmetric or Hemitiean arrays.
+ - eig : eigenvalues and right eigenvectors for non-symmetric arrays
+ - eigvals : eigenvalues of non-symmetric array.
+
+ :Notes:
+ -------
+
+ The number w is an eigenvalue of a if there exists a vector v
+ satisfying the equation dot(a,v) = w*v. Alternately, if w is a root of
+ the characteristic equation det(a - w[i]*I) = 0, where det is the
+ determinant and I is the identity matrix. The arrays a, w, and v
+ satisfy the equation dot(a,v[i]) = w[i]*v[:,i].
+
+ The array v of eigenvectors may not be of maximum rank, that is, some
+ of the columns may be dependent, although roundoff error may obscure
+ that fact. If the eigenvalues are all different, then theoretically the
+ eigenvectors are independent. Likewise, the matrix of eigenvectors is
+ unitary if the matrix a is normal, i.e., if dot(a, a.H) = dot(a.H, a).
+
+ The left and right eigenvectors are not necessarily the (Hemitian)
+ transposes of each other.
+
+ """
+ a, wrap = _makearray(a)
+ _assertRank2(a)
+ _assertSquareness(a)
+ _assertFinite(a)
+ a, t, result_t = _convertarray(a) # convert to double or cdouble type
+ real_t = _linalgRealType(t)
+ n = a.shape[0]
+ dummy = zeros((1,), t)
+ if isComplexType(t):
+ # Complex routines take different arguments
+ lapack_routine = lapack_lite.zgeev
+ w = zeros((n,), t)
+ v = zeros((n, n), t)
+ lwork = 1
+ work = zeros((lwork,), t)
+ rwork = zeros((2*n,), real_t)
+ results = lapack_routine('N', 'V', n, a, n, w,
+ dummy, 1, v, n, work, -1, rwork, 0)
+ lwork = int(abs(work[0]))
+ work = zeros((lwork,), t)
+ results = lapack_routine('N', 'V', n, a, n, w,
+ dummy, 1, v, n, work, lwork, rwork, 0)
+ else:
+ lapack_routine = lapack_lite.dgeev
+ wr = zeros((n,), t)
+ wi = zeros((n,), t)
+ vr = zeros((n, n), t)
+ lwork = 1
+ work = zeros((lwork,), t)
+ results = lapack_routine('N', 'V', n, a, n, wr, wi,
+ dummy, 1, vr, n, work, -1, 0)
+ lwork = int(work[0])
+ work = zeros((lwork,), t)
+ results = lapack_routine('N', 'V', n, a, n, wr, wi,
+ dummy, 1, vr, n, work, lwork, 0)
+ if all(wi == 0.0):
+ w = wr
+ v = vr
+ result_t = _realType(result_t)
+ else:
+ w = wr+1j*wi
+ v = array(vr, w.dtype)
+ ind = flatnonzero(wi != 0.0) # indices of complex e-vals
+ for i in range(len(ind)/2):
+ v[ind[2*i]] = vr[ind[2*i]] + 1j*vr[ind[2*i+1]]
+ v[ind[2*i+1]] = vr[ind[2*i]] - 1j*vr[ind[2*i+1]]
+ result_t = _complexType(result_t)
+
+ if results['info'] > 0:
+ raise LinAlgError, 'Eigenvalues did not converge'
+ vt = v.transpose().astype(result_t)
+ return w.astype(result_t), wrap(vt)
+
+
+def eigh(a, UPLO='L'):
+ """Compute eigenvalues for a Hermitian-symmetric matrix.
+
+ A simple interface to the LAPACK routines dsyevd and zheevd that compute
+ the eigenvalues and eigenvectors of real symmetric and complex Hermitian
+ arrays respectively.
+
+ :Parameters:
+
+ a : 2-d array
+ A complex Hermitian or symmetric real 2-d array whose eigenvalues
+ and eigenvectors will be computed.
+
+ UPLO : string
+ Specifies whether the pertinent array date is taken from the upper
+ or lower triangular part of a. Possible values are 'L', and 'U'.
+ Default is 'L'.
+
+ :Returns:
+
+ w : 1-d double array
+ The eigenvalues. The eigenvalues are not necessarily ordered.
+
+ v : 2-d double or complex double array, depending on input array type
+ The normalized eigenvector corresponding to the eigenvalue w[i] is
+ the column v[:,i].
+
+ :SeeAlso:
+
+ - eigvalsh : eigenvalues of symmetric or Hemitiean arrays.
+ - eig : eigenvalues and right eigenvectors for non-symmetric arrays
+ - eigvals : eigenvalues of non-symmetric array.
+
+ :Notes:
+ -------
+
+ The number w is an eigenvalue of a if there exists a vector v
+ satisfying the equation dot(a,v) = w*v. Alternately, if w is a root of
+ the characteristic equation det(a - w[i]*I) = 0, where det is the
+ determinant and I is the identity matrix. The eigenvalues of real
+ symmetric or complex Hermitean matrices are always real. The array v
+ of eigenvectors is unitary and a, w, and v satisfy the equation
+ dot(a,v[i]) = w[i]*v[:,i].
+
+ """
+ a, wrap = _makearray(a)
+ _assertRank2(a)
+ _assertSquareness(a)
+ t, result_t = _commonType(a)
+ real_t = _linalgRealType(t)
+ a = _fastCopyAndTranspose(t, a)
+ n = a.shape[0]
+ liwork = 5*n+3
+ iwork = zeros((liwork,), fortran_int)
+ if isComplexType(t):
+ lapack_routine = lapack_lite.zheevd
+ w = zeros((n,), real_t)
+ lwork = 1
+ work = zeros((lwork,), t)
+ lrwork = 1
+ rwork = zeros((lrwork,), real_t)
+ results = lapack_routine('V', UPLO, n, a, n, w, work, -1,
+ rwork, -1, iwork, liwork, 0)
+ lwork = int(abs(work[0]))
+ work = zeros((lwork,), t)
+ lrwork = int(rwork[0])
+ rwork = zeros((lrwork,), real_t)
+ results = lapack_routine('V', UPLO, n, a, n, w, work, lwork,
+ rwork, lrwork, iwork, liwork, 0)
+ else:
+ lapack_routine = lapack_lite.dsyevd
+ w = zeros((n,), t)
+ lwork = 1
+ work = zeros((lwork,), t)
+ results = lapack_routine('V', UPLO, n, a, n, w, work, -1,
+ iwork, liwork, 0)
+ lwork = int(work[0])
+ work = zeros((lwork,), t)
+ results = lapack_routine('V', UPLO, n, a, n, w, work, lwork,
+ iwork, liwork, 0)
+ if results['info'] > 0:
+ raise LinAlgError, 'Eigenvalues did not converge'
+ at = a.transpose().astype(result_t)
+ return w.astype(_realType(result_t)), wrap(at)
+
+
+# Singular value decomposition
+
+def svd(a, full_matrices=1, compute_uv=1):
+ """Singular Value Decomposition.
+
+ u,s,vh = svd(a)
+
+ If a is an M x N array, then the svd produces a factoring of the array
+ into two unitary (orthogonal) 2-d arrays u (MxM) and vh (NxN) and a
+ min(M,N)-length array of singular values such that
+
+ a == dot(u,dot(S,vh))
+
+ where S is an MxN array of zeros whose main diagonal is s.
+
+ if compute_uv == 0, then return only the singular values
+ if full_matrices == 0, then only part of either u or vh is
+ returned so that it is MxN
+ """
+ a, wrap = _makearray(a)
+ _assertRank2(a)
+ m, n = a.shape
+ t, result_t = _commonType(a)
+ real_t = _linalgRealType(t)
+ a = _fastCopyAndTranspose(t, a)
+ s = zeros((min(n, m),), real_t)
+ if compute_uv:
+ if full_matrices:
+ nu = m
+ nvt = n
+ option = 'A'
+ else:
+ nu = min(n, m)
+ nvt = min(n, m)
+ option = 'S'
+ u = zeros((nu, m), t)
+ vt = zeros((n, nvt), t)
+ else:
+ option = 'N'
+ nu = 1
+ nvt = 1
+ u = empty((1, 1), t)
+ vt = empty((1, 1), t)
+
+ iwork = zeros((8*min(m, n),), fortran_int)
+ if isComplexType(t):
+ lapack_routine = lapack_lite.zgesdd
+ rwork = zeros((5*min(m, n)*min(m, n) + 5*min(m, n),), real_t)
+ lwork = 1
+ work = zeros((lwork,), t)
+ results = lapack_routine(option, m, n, a, m, s, u, m, vt, nvt,
+ work, -1, rwork, iwork, 0)
+ lwork = int(abs(work[0]))
+ work = zeros((lwork,), t)
+ results = lapack_routine(option, m, n, a, m, s, u, m, vt, nvt,
+ work, lwork, rwork, iwork, 0)
+ else:
+ lapack_routine = lapack_lite.dgesdd
+ lwork = 1
+ work = zeros((lwork,), t)
+ results = lapack_routine(option, m, n, a, m, s, u, m, vt, nvt,
+ work, -1, iwork, 0)
+ lwork = int(work[0])
+ work = zeros((lwork,), t)
+ results = lapack_routine(option, m, n, a, m, s, u, m, vt, nvt,
+ work, lwork, iwork, 0)
+ if results['info'] > 0:
+ raise LinAlgError, 'SVD did not converge'
+ s = s.astype(_realType(result_t))
+ if compute_uv:
+ u = u.transpose().astype(result_t)
+ vt = vt.transpose().astype(result_t)
+ return wrap(u), s, wrap(vt)
+ else:
+ return s
+
+# Generalized inverse
+
+def pinv(a, rcond=1e-15 ):
+ """Return the (Moore-Penrose) pseudo-inverse of a 2-d array
+
+ This method computes the generalized inverse using the
+ singular-value decomposition and all singular values larger than
+ rcond of the largest.
+ """
+ a, wrap = _makearray(a)
+ a = a.conjugate()
+ u, s, vt = svd(a, 0)
+ m = u.shape[0]
+ n = vt.shape[1]
+ cutoff = rcond*maximum.reduce(s)
+ for i in range(min(n, m)):
+ if s[i] > cutoff:
+ s[i] = 1./s[i]
+ else:
+ s[i] = 0.;
+ return wrap(dot(transpose(vt),
+ multiply(s[:, newaxis],transpose(u))))
+
+# Determinant
+
+def det(a):
+ "The determinant of the 2-d array a"
+ a = asarray(a)
+ _assertRank2(a)
+ _assertSquareness(a)
+ t, result_t = _commonType(a)
+ a = _fastCopyAndTranspose(t, a)
+ n = a.shape[0]
+ if isComplexType(t):
+ lapack_routine = lapack_lite.zgetrf
+ else:
+ lapack_routine = lapack_lite.dgetrf
+ pivots = zeros((n,), fortran_int)
+ results = lapack_routine(n, n, a, n, pivots, 0)
+ info = results['info']
+ if (info < 0):
+ raise TypeError, "Illegal input to Fortran routine"
+ elif (info > 0):
+ return 0.0
+ sign = add.reduce(pivots != arange(1, n+1)) % 2
+ return (1.-2.*sign)*multiply.reduce(diagonal(a), axis=-1)
+
+# Linear Least Squares
+
+def lstsq(a, b, rcond=-1):
+ """returns x,resids,rank,s
+ where x minimizes 2-norm(|b - Ax|)
+ resids is the sum square residuals
+ rank is the rank of A
+ s is the rank of the singular values of A in descending order
+
+ If b is a matrix then x is also a matrix with corresponding columns.
+ If the rank of A is less than the number of columns of A or greater than
+ the number of rows, then residuals will be returned as an empty array
+ otherwise resids = sum((b-dot(A,x)**2).
+ Singular values less than s[0]*rcond are treated as zero.
+"""
+ import math
+ a = asarray(a)
+ b, wrap = _makearray(b)
+ one_eq = len(b.shape) == 1
+ if one_eq:
+ b = b[:, newaxis]
+ _assertRank2(a, b)
+ m = a.shape[0]
+ n = a.shape[1]
+ n_rhs = b.shape[1]
+ ldb = max(n, m)
+ if m != b.shape[0]:
+ raise LinAlgError, 'Incompatible dimensions'
+ t, result_t = _commonType(a, b)
+ real_t = _linalgRealType(t)
+ bstar = zeros((ldb, n_rhs), t)
+ bstar[:b.shape[0],:n_rhs] = b.copy()
+ a, bstar = _fastCopyAndTranspose(t, a, bstar)
+ s = zeros((min(m, n),), real_t)
+ nlvl = max( 0, int( math.log( float(min(m, n))/2. ) ) + 1 )
+ iwork = zeros((3*min(m, n)*nlvl+11*min(m, n),), fortran_int)
+ if isComplexType(t):
+ lapack_routine = lapack_lite.zgelsd
+ lwork = 1
+ rwork = zeros((lwork,), real_t)
+ work = zeros((lwork,), t)
+ results = lapack_routine(m, n, n_rhs, a, m, bstar, ldb, s, rcond,
+ 0, work, -1, rwork, iwork, 0)
+ lwork = int(abs(work[0]))
+ rwork = zeros((lwork,), real_t)
+ a_real = zeros((m, n), real_t)
+ bstar_real = zeros((ldb, n_rhs,), real_t)
+ results = lapack_lite.dgelsd(m, n, n_rhs, a_real, m,
+ bstar_real, ldb, s, rcond,
+ 0, rwork, -1, iwork, 0)
+ lrwork = int(rwork[0])
+ work = zeros((lwork,), t)
+ rwork = zeros((lrwork,), real_t)
+ results = lapack_routine(m, n, n_rhs, a, m, bstar, ldb, s, rcond,
+ 0, work, lwork, rwork, iwork, 0)
+ else:
+ lapack_routine = lapack_lite.dgelsd
+ lwork = 1
+ work = zeros((lwork,), t)
+ results = lapack_routine(m, n, n_rhs, a, m, bstar, ldb, s, rcond,
+ 0, work, -1, iwork, 0)
+ lwork = int(work[0])
+ work = zeros((lwork,), t)
+ results = lapack_routine(m, n, n_rhs, a, m, bstar, ldb, s, rcond,
+ 0, work, lwork, iwork, 0)
+ if results['info'] > 0:
+ raise LinAlgError, 'SVD did not converge in Linear Least Squares'
+ resids = array([], t)
+ if one_eq:
+ x = array(ravel(bstar)[:n], dtype=result_t, copy=True)
+ if results['rank'] == n and m > n:
+ resids = array([sum((ravel(bstar)[n:])**2)], dtype=result_t)
+ else:
+ x = array(transpose(bstar)[:n,:], dtype=result_t, copy=True)
+ if results['rank'] == n and m > n:
+ resids = sum((transpose(bstar)[n:,:])**2, axis=0).astype(result_t)
+ st = s[:min(n, m)].copy().astype(_realType(result_t))
+ return wrap(x), resids, results['rank'], st
+
+def norm(x, ord=None):
+ """ norm(x, ord=None) -> n
+
+ Matrix or vector norm.
+
+ Inputs:
+
+ x -- a rank-1 (vector) or rank-2 (matrix) array
+ ord -- the order of the norm.
+
+ Comments:
+ For arrays of any rank, if ord is None:
+ calculate the square norm (Euclidean norm for vectors,
+ Frobenius norm for matrices)
+
+ For vectors ord can be any real number including Inf or -Inf.
+ ord = Inf, computes the maximum of the magnitudes
+ ord = -Inf, computes minimum of the magnitudes
+ ord is finite, computes sum(abs(x)**ord,axis=0)**(1.0/ord)
+
+ For matrices ord can only be one of the following values:
+ ord = 2 computes the largest singular value
+ ord = -2 computes the smallest singular value
+ ord = 1 computes the largest column sum of absolute values
+ ord = -1 computes the smallest column sum of absolute values
+ ord = Inf computes the largest row sum of absolute values
+ ord = -Inf computes the smallest row sum of absolute values
+ ord = 'fro' computes the frobenius norm sqrt(sum(diag(X.H * X),axis=0))
+
+ For values ord < 0, the result is, strictly speaking, not a
+ mathematical 'norm', but it may still be useful for numerical purposes.
+ """
+ x = asarray(x)
+ nd = len(x.shape)
+ if ord is None: # check the default case first and handle it immediately
+ return sqrt(add.reduce((x.conj() * x).ravel().real))
+
+ if nd == 1:
+ if ord == Inf:
+ return abs(x).max()
+ elif ord == -Inf:
+ return abs(x).min()
+ elif ord == 1:
+ return abs(x).sum() # special case for speedup
+ elif ord == 2:
+ return sqrt(((x.conj()*x).real).sum()) # special case for speedup
+ else:
+ return ((abs(x)**ord).sum())**(1.0/ord)
+ elif nd == 2:
+ if ord == 2:
+ return svd(x, compute_uv=0).max()
+ elif ord == -2:
+ return svd(x, compute_uv=0).min()
+ elif ord == 1:
+ return abs(x).sum(axis=0).max()
+ elif ord == Inf:
+ return abs(x).sum(axis=1).max()
+ elif ord == -1:
+ return abs(x).sum(axis=0).min()
+ elif ord == -Inf:
+ return abs(x).sum(axis=1).min()
+ elif ord in ['fro','f']:
+ return sqrt(add.reduce((x.conj() * x).real.ravel()))
+ else:
+ raise ValueError, "Invalid norm order for matrices."
+ else:
+ raise ValueError, "Improper number of dimensions to norm."
diff --git a/numpy/linalg/setup.py b/numpy/linalg/setup.py
new file mode 100644
index 000000000..a41126a08
--- /dev/null
+++ b/numpy/linalg/setup.py
@@ -0,0 +1,31 @@
+
+def configuration(parent_package='',top_path=None):
+ from numpy.distutils.misc_util import Configuration
+ from numpy.distutils.system_info import get_info
+ config = Configuration('linalg',parent_package,top_path)
+
+ config.add_data_dir('tests')
+
+ # Configure lapack_lite
+ lapack_info = get_info('lapack_opt',0)
+ def get_lapack_lite_sources(ext, build_dir):
+ if not lapack_info:
+ print "### Warning: Using unoptimized lapack ###"
+ return ext.depends[:-1]
+ else:
+ return ext.depends[:1]
+
+ config.add_extension('lapack_lite',
+ sources = [get_lapack_lite_sources],
+ depends= ['lapack_litemodule.c',
+ 'zlapack_lite.c', 'dlapack_lite.c',
+ 'blas_lite.c', 'dlamch.c',
+ 'f2c_lite.c','f2c.h'],
+ extra_info = lapack_info
+ )
+
+ return config
+
+if __name__ == '__main__':
+ from numpy.distutils.core import setup
+ setup(configuration=configuration)
diff --git a/numpy/linalg/tests/test_linalg.py b/numpy/linalg/tests/test_linalg.py
new file mode 100644
index 000000000..af7914200
--- /dev/null
+++ b/numpy/linalg/tests/test_linalg.py
@@ -0,0 +1,90 @@
+""" Test functions for linalg module
+"""
+
+from numpy.testing import *
+set_package_path()
+from numpy import array, single, double, csingle, cdouble, dot, identity, \
+ multiply
+from numpy import linalg
+restore_path()
+
+old_assert_almost_equal = assert_almost_equal
+def assert_almost_equal(a, b, **kw):
+ if a.dtype.type in (single, csingle):
+ decimal = 6
+ else:
+ decimal = 12
+ old_assert_almost_equal(a, b, decimal=decimal, **kw)
+
+class LinalgTestCase(NumpyTestCase):
+ def check_single(self):
+ a = array([[1.,2.], [3.,4.]], dtype=single)
+ b = array([2., 1.], dtype=single)
+ self.do(a, b)
+
+ def check_double(self):
+ a = array([[1.,2.], [3.,4.]], dtype=double)
+ b = array([2., 1.], dtype=double)
+ self.do(a, b)
+
+ def check_csingle(self):
+ a = array([[1.+2j,2+3j], [3+4j,4+5j]], dtype=csingle)
+ b = array([2.+1j, 1.+2j], dtype=csingle)
+ self.do(a, b)
+
+ def check_cdouble(self):
+ a = array([[1.+2j,2+3j], [3+4j,4+5j]], dtype=cdouble)
+ b = array([2.+1j, 1.+2j], dtype=cdouble)
+ self.do(a, b)
+
+class test_solve(LinalgTestCase):
+ def do(self, a, b):
+ x = linalg.solve(a, b)
+ assert_almost_equal(b, dot(a, x))
+
+class test_inv(LinalgTestCase):
+ def do(self, a, b):
+ a_inv = linalg.inv(a)
+ assert_almost_equal(dot(a, a_inv), identity(a.shape[0]))
+
+class test_eigvals(LinalgTestCase):
+ def do(self, a, b):
+ ev = linalg.eigvals(a)
+ evalues, evectors = linalg.eig(a)
+ assert_almost_equal(ev, evalues)
+
+class test_eig(LinalgTestCase):
+ def do(self, a, b):
+ evalues, evectors = linalg.eig(a)
+ assert_almost_equal(dot(a, evectors), evectors*evalues)
+
+class test_svd(LinalgTestCase):
+ def do(self, a, b):
+ u, s, vt = linalg.svd(a, 0)
+ assert_almost_equal(a, dot(u*s, vt))
+
+class test_pinv(LinalgTestCase):
+ def do(self, a, b):
+ a_ginv = linalg.pinv(a)
+ assert_almost_equal(dot(a, a_ginv), identity(a.shape[0]))
+
+class test_det(LinalgTestCase):
+ def do(self, a, b):
+ d = linalg.det(a)
+ if a.dtype.type in (single, double):
+ ad = a.astype(double)
+ else:
+ ad = a.astype(cdouble)
+ ev = linalg.eigvals(ad)
+ assert_almost_equal(d, multiply.reduce(ev))
+
+class test_lstsq(LinalgTestCase):
+ def do(self, a, b):
+ u, s, vt = linalg.svd(a, 0)
+ x, residuals, rank, sv = linalg.lstsq(a, b)
+ assert_almost_equal(b, dot(a, x))
+ assert_equal(rank, a.shape[0])
+ assert_almost_equal(sv, s)
+
+if __name__ == '__main__':
+ NumpyTest().run()
diff --git a/numpy/linalg/zlapack_lite.c b/numpy/linalg/zlapack_lite.c
new file mode 100644
index 000000000..4549f68b5
--- /dev/null
+++ b/numpy/linalg/zlapack_lite.c
@@ -0,0 +1,26018 @@
+/*
+NOTE: This is generated code. Look in Misc/lapack_lite for information on
+ remaking this file.
+*/
+#include "f2c.h"
+
+#ifdef HAVE_CONFIG
+#include "config.h"
+#else
+extern doublereal dlamch_(char *);
+#define EPSILON dlamch_("Epsilon")
+#define SAFEMINIMUM dlamch_("Safe minimum")
+#define PRECISION dlamch_("Precision")
+#define BASE dlamch_("Base")
+#endif
+
+extern doublereal dlapy2_(doublereal *x, doublereal *y);
+
+
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static doublecomplex c_b59 = {0.,0.};
+static doublecomplex c_b60 = {1.,0.};
+static integer c_n1 = -1;
+static integer c__3 = 3;
+static integer c__2 = 2;
+static integer c__0 = 0;
+static integer c__8 = 8;
+static integer c__4 = 4;
+static integer c__65 = 65;
+static integer c__6 = 6;
+static integer c__9 = 9;
+static doublereal c_b324 = 0.;
+static doublereal c_b1015 = 1.;
+static integer c__15 = 15;
+static logical c_false = FALSE_;
+static doublereal c_b1294 = -1.;
+static doublereal c_b2210 = .5;
+
+/* Subroutine */ int zdrot_(integer *n, doublecomplex *cx, integer *incx,
+ doublecomplex *cy, integer *incy, doublereal *c__, doublereal *s)
+{
+ /* System generated locals */
+ integer i__1, i__2, i__3, i__4;
+ doublecomplex z__1, z__2, z__3;
+
+ /* Local variables */
+ static integer i__, ix, iy;
+ static doublecomplex ctemp;
+
+
+/*
+ applies a plane rotation, where the cos and sin (c and s) are real
+ and the vectors cx and cy are complex.
+ jack dongarra, linpack, 3/11/78.
+
+
+ =====================================================================
+*/
+
+ /* Parameter adjustments */
+ --cy;
+ --cx;
+
+ /* Function Body */
+ if (*n <= 0) {
+ return 0;
+ }
+ if ((*incx == 1 && *incy == 1)) {
+ goto L20;
+ }
+
+/*
+ code for unequal increments or equal increments not equal
+ to 1
+*/
+
+ ix = 1;
+ iy = 1;
+ if (*incx < 0) {
+ ix = (-(*n) + 1) * *incx + 1;
+ }
+ if (*incy < 0) {
+ iy = (-(*n) + 1) * *incy + 1;
+ }
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = ix;
+ z__2.r = *c__ * cx[i__2].r, z__2.i = *c__ * cx[i__2].i;
+ i__3 = iy;
+ z__3.r = *s * cy[i__3].r, z__3.i = *s * cy[i__3].i;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ ctemp.r = z__1.r, ctemp.i = z__1.i;
+ i__2 = iy;
+ i__3 = iy;
+ z__2.r = *c__ * cy[i__3].r, z__2.i = *c__ * cy[i__3].i;
+ i__4 = ix;
+ z__3.r = *s * cx[i__4].r, z__3.i = *s * cx[i__4].i;
+ z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - z__3.i;
+ cy[i__2].r = z__1.r, cy[i__2].i = z__1.i;
+ i__2 = ix;
+ cx[i__2].r = ctemp.r, cx[i__2].i = ctemp.i;
+ ix += *incx;
+ iy += *incy;
+/* L10: */
+ }
+ return 0;
+
+/* code for both increments equal to 1 */
+
+L20:
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ z__2.r = *c__ * cx[i__2].r, z__2.i = *c__ * cx[i__2].i;
+ i__3 = i__;
+ z__3.r = *s * cy[i__3].r, z__3.i = *s * cy[i__3].i;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ ctemp.r = z__1.r, ctemp.i = z__1.i;
+ i__2 = i__;
+ i__3 = i__;
+ z__2.r = *c__ * cy[i__3].r, z__2.i = *c__ * cy[i__3].i;
+ i__4 = i__;
+ z__3.r = *s * cx[i__4].r, z__3.i = *s * cx[i__4].i;
+ z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - z__3.i;
+ cy[i__2].r = z__1.r, cy[i__2].i = z__1.i;
+ i__2 = i__;
+ cx[i__2].r = ctemp.r, cx[i__2].i = ctemp.i;
+/* L30: */
+ }
+ return 0;
+} /* zdrot_ */
+
+/* Subroutine */ int zgebak_(char *job, char *side, integer *n, integer *ilo,
+ integer *ihi, doublereal *scale, integer *m, doublecomplex *v,
+ integer *ldv, integer *info)
+{
+ /* System generated locals */
+ integer v_dim1, v_offset, i__1;
+
+ /* Local variables */
+ static integer i__, k;
+ static doublereal s;
+ static integer ii;
+ extern logical lsame_(char *, char *);
+ static logical leftv;
+ extern /* Subroutine */ int zswap_(integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *), xerbla_(char *, integer *),
+ zdscal_(integer *, doublereal *, doublecomplex *, integer *);
+ static logical rightv;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZGEBAK forms the right or left eigenvectors of a complex general
+ matrix by backward transformation on the computed eigenvectors of the
+ balanced matrix output by ZGEBAL.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the type of backward transformation required:
+ = 'N', do nothing, return immediately;
+ = 'P', do backward transformation for permutation only;
+ = 'S', do backward transformation for scaling only;
+ = 'B', do backward transformations for both permutation and
+ scaling.
+ JOB must be the same as the argument JOB supplied to ZGEBAL.
+
+ SIDE (input) CHARACTER*1
+ = 'R': V contains right eigenvectors;
+ = 'L': V contains left eigenvectors.
+
+ N (input) INTEGER
+ The number of rows of the matrix V. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ The integers ILO and IHI determined by ZGEBAL.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ SCALE (input) DOUBLE PRECISION array, dimension (N)
+ Details of the permutation and scaling factors, as returned
+ by ZGEBAL.
+
+ M (input) INTEGER
+ The number of columns of the matrix V. M >= 0.
+
+ V (input/output) COMPLEX*16 array, dimension (LDV,M)
+ On entry, the matrix of right or left eigenvectors to be
+ transformed, as returned by ZHSEIN or ZTREVC.
+ On exit, V is overwritten by the transformed eigenvectors.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V. LDV >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+
+ Decode and Test the input parameters
+*/
+
+ /* Parameter adjustments */
+ --scale;
+ v_dim1 = *ldv;
+ v_offset = 1 + v_dim1 * 1;
+ v -= v_offset;
+
+ /* Function Body */
+ rightv = lsame_(side, "R");
+ leftv = lsame_(side, "L");
+
+ *info = 0;
+ if ((((! lsame_(job, "N") && ! lsame_(job, "P")) && ! lsame_(job, "S"))
+ && ! lsame_(job, "B"))) {
+ *info = -1;
+ } else if ((! rightv && ! leftv)) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*ilo < 1 || *ilo > max(1,*n)) {
+ *info = -4;
+ } else if (*ihi < min(*ilo,*n) || *ihi > *n) {
+ *info = -5;
+ } else if (*m < 0) {
+ *info = -7;
+ } else if (*ldv < max(1,*n)) {
+ *info = -9;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGEBAK", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+ if (*m == 0) {
+ return 0;
+ }
+ if (lsame_(job, "N")) {
+ return 0;
+ }
+
+ if (*ilo == *ihi) {
+ goto L30;
+ }
+
+/* Backward balance */
+
+ if (lsame_(job, "S") || lsame_(job, "B")) {
+
+ if (rightv) {
+ i__1 = *ihi;
+ for (i__ = *ilo; i__ <= i__1; ++i__) {
+ s = scale[i__];
+ zdscal_(m, &s, &v[i__ + v_dim1], ldv);
+/* L10: */
+ }
+ }
+
+ if (leftv) {
+ i__1 = *ihi;
+ for (i__ = *ilo; i__ <= i__1; ++i__) {
+ s = 1. / scale[i__];
+ zdscal_(m, &s, &v[i__ + v_dim1], ldv);
+/* L20: */
+ }
+ }
+
+ }
+
+/*
+ Backward permutation
+
+ For I = ILO-1 step -1 until 1,
+ IHI+1 step 1 until N do --
+*/
+
+L30:
+ if (lsame_(job, "P") || lsame_(job, "B")) {
+ if (rightv) {
+ i__1 = *n;
+ for (ii = 1; ii <= i__1; ++ii) {
+ i__ = ii;
+ if ((i__ >= *ilo && i__ <= *ihi)) {
+ goto L40;
+ }
+ if (i__ < *ilo) {
+ i__ = *ilo - ii;
+ }
+ k = (integer) scale[i__];
+ if (k == i__) {
+ goto L40;
+ }
+ zswap_(m, &v[i__ + v_dim1], ldv, &v[k + v_dim1], ldv);
+L40:
+ ;
+ }
+ }
+
+ if (leftv) {
+ i__1 = *n;
+ for (ii = 1; ii <= i__1; ++ii) {
+ i__ = ii;
+ if ((i__ >= *ilo && i__ <= *ihi)) {
+ goto L50;
+ }
+ if (i__ < *ilo) {
+ i__ = *ilo - ii;
+ }
+ k = (integer) scale[i__];
+ if (k == i__) {
+ goto L50;
+ }
+ zswap_(m, &v[i__ + v_dim1], ldv, &v[k + v_dim1], ldv);
+L50:
+ ;
+ }
+ }
+ }
+
+ return 0;
+
+/* End of ZGEBAK */
+
+} /* zgebak_ */
+
+/* Subroutine */ int zgebal_(char *job, integer *n, doublecomplex *a, integer
+ *lda, integer *ilo, integer *ihi, doublereal *scale, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+ doublereal d__1, d__2;
+
+ /* Builtin functions */
+ double d_imag(doublecomplex *), z_abs(doublecomplex *);
+
+ /* Local variables */
+ static doublereal c__, f, g;
+ static integer i__, j, k, l, m;
+ static doublereal r__, s, ca, ra;
+ static integer ica, ira, iexc;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int zswap_(integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *);
+ static doublereal sfmin1, sfmin2, sfmax1, sfmax2;
+
+ extern /* Subroutine */ int xerbla_(char *, integer *), zdscal_(
+ integer *, doublereal *, doublecomplex *, integer *);
+ extern integer izamax_(integer *, doublecomplex *, integer *);
+ static logical noconv;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZGEBAL balances a general complex matrix A. This involves, first,
+ permuting A by a similarity transformation to isolate eigenvalues
+ in the first 1 to ILO-1 and last IHI+1 to N elements on the
+ diagonal; and second, applying a diagonal similarity transformation
+ to rows and columns ILO to IHI to make the rows and columns as
+ close in norm as possible. Both steps are optional.
+
+ Balancing may reduce the 1-norm of the matrix, and improve the
+ accuracy of the computed eigenvalues and/or eigenvectors.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ Specifies the operations to be performed on A:
+ = 'N': none: simply set ILO = 1, IHI = N, SCALE(I) = 1.0
+ for i = 1,...,N;
+ = 'P': permute only;
+ = 'S': scale only;
+ = 'B': both permute and scale.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the input matrix A.
+ On exit, A is overwritten by the balanced matrix.
+ If JOB = 'N', A is not referenced.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ ILO (output) INTEGER
+ IHI (output) INTEGER
+ ILO and IHI are set to integers such that on exit
+ A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N.
+ If JOB = 'N' or 'S', ILO = 1 and IHI = N.
+
+ SCALE (output) DOUBLE PRECISION array, dimension (N)
+ Details of the permutations and scaling factors applied to
+ A. If P(j) is the index of the row and column interchanged
+ with row and column j and D(j) is the scaling factor
+ applied to row and column j, then
+ SCALE(j) = P(j) for j = 1,...,ILO-1
+ = D(j) for j = ILO,...,IHI
+ = P(j) for j = IHI+1,...,N.
+ The order in which the interchanges are made is N to IHI+1,
+ then 1 to ILO-1.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The permutations consist of row and column interchanges which put
+ the matrix in the form
+
+ ( T1 X Y )
+ P A P = ( 0 B Z )
+ ( 0 0 T2 )
+
+ where T1 and T2 are upper triangular matrices whose eigenvalues lie
+ along the diagonal. The column indices ILO and IHI mark the starting
+ and ending columns of the submatrix B. Balancing consists of applying
+ a diagonal similarity transformation inv(D) * B * D to make the
+ 1-norms of each row of B and its corresponding column nearly equal.
+ The output matrix is
+
+ ( T1 X*D Y )
+ ( 0 inv(D)*B*D inv(D)*Z ).
+ ( 0 0 T2 )
+
+ Information about the permutations P and the diagonal matrix D is
+ returned in the vector SCALE.
+
+ This subroutine is based on the EISPACK routine CBAL.
+
+ Modified by Tzu-Yi Chen, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input parameters
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --scale;
+
+ /* Function Body */
+ *info = 0;
+ if ((((! lsame_(job, "N") && ! lsame_(job, "P")) && ! lsame_(job, "S"))
+ && ! lsame_(job, "B"))) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*n)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGEBAL", &i__1);
+ return 0;
+ }
+
+ k = 1;
+ l = *n;
+
+ if (*n == 0) {
+ goto L210;
+ }
+
+ if (lsame_(job, "N")) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ scale[i__] = 1.;
+/* L10: */
+ }
+ goto L210;
+ }
+
+ if (lsame_(job, "S")) {
+ goto L120;
+ }
+
+/* Permutation to isolate eigenvalues if possible */
+
+ goto L50;
+
+/* Row and column exchange. */
+
+L20:
+ scale[m] = (doublereal) j;
+ if (j == m) {
+ goto L30;
+ }
+
+ zswap_(&l, &a[j * a_dim1 + 1], &c__1, &a[m * a_dim1 + 1], &c__1);
+ i__1 = *n - k + 1;
+ zswap_(&i__1, &a[j + k * a_dim1], lda, &a[m + k * a_dim1], lda);
+
+L30:
+ switch (iexc) {
+ case 1: goto L40;
+ case 2: goto L80;
+ }
+
+/* Search for rows isolating an eigenvalue and push them down. */
+
+L40:
+ if (l == 1) {
+ goto L210;
+ }
+ --l;
+
+L50:
+ for (j = l; j >= 1; --j) {
+
+ i__1 = l;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if (i__ == j) {
+ goto L60;
+ }
+ i__2 = j + i__ * a_dim1;
+ if (a[i__2].r != 0. || d_imag(&a[j + i__ * a_dim1]) != 0.) {
+ goto L70;
+ }
+L60:
+ ;
+ }
+
+ m = l;
+ iexc = 1;
+ goto L20;
+L70:
+ ;
+ }
+
+ goto L90;
+
+/* Search for columns isolating an eigenvalue and push them left. */
+
+L80:
+ ++k;
+
+L90:
+ i__1 = l;
+ for (j = k; j <= i__1; ++j) {
+
+ i__2 = l;
+ for (i__ = k; i__ <= i__2; ++i__) {
+ if (i__ == j) {
+ goto L100;
+ }
+ i__3 = i__ + j * a_dim1;
+ if (a[i__3].r != 0. || d_imag(&a[i__ + j * a_dim1]) != 0.) {
+ goto L110;
+ }
+L100:
+ ;
+ }
+
+ m = k;
+ iexc = 2;
+ goto L20;
+L110:
+ ;
+ }
+
+L120:
+ i__1 = l;
+ for (i__ = k; i__ <= i__1; ++i__) {
+ scale[i__] = 1.;
+/* L130: */
+ }
+
+ if (lsame_(job, "P")) {
+ goto L210;
+ }
+
+/*
+ Balance the submatrix in rows K to L.
+
+ Iterative loop for norm reduction
+*/
+
+ sfmin1 = SAFEMINIMUM / PRECISION;
+ sfmax1 = 1. / sfmin1;
+ sfmin2 = sfmin1 * 8.;
+ sfmax2 = 1. / sfmin2;
+L140:
+ noconv = FALSE_;
+
+ i__1 = l;
+ for (i__ = k; i__ <= i__1; ++i__) {
+ c__ = 0.;
+ r__ = 0.;
+
+ i__2 = l;
+ for (j = k; j <= i__2; ++j) {
+ if (j == i__) {
+ goto L150;
+ }
+ i__3 = j + i__ * a_dim1;
+ c__ += (d__1 = a[i__3].r, abs(d__1)) + (d__2 = d_imag(&a[j + i__ *
+ a_dim1]), abs(d__2));
+ i__3 = i__ + j * a_dim1;
+ r__ += (d__1 = a[i__3].r, abs(d__1)) + (d__2 = d_imag(&a[i__ + j *
+ a_dim1]), abs(d__2));
+L150:
+ ;
+ }
+ ica = izamax_(&l, &a[i__ * a_dim1 + 1], &c__1);
+ ca = z_abs(&a[ica + i__ * a_dim1]);
+ i__2 = *n - k + 1;
+ ira = izamax_(&i__2, &a[i__ + k * a_dim1], lda);
+ ra = z_abs(&a[i__ + (ira + k - 1) * a_dim1]);
+
+/* Guard against zero C or R due to underflow. */
+
+ if (c__ == 0. || r__ == 0.) {
+ goto L200;
+ }
+ g = r__ / 8.;
+ f = 1.;
+ s = c__ + r__;
+L160:
+/* Computing MAX */
+ d__1 = max(f,c__);
+/* Computing MIN */
+ d__2 = min(r__,g);
+ if (c__ >= g || max(d__1,ca) >= sfmax2 || min(d__2,ra) <= sfmin2) {
+ goto L170;
+ }
+ f *= 8.;
+ c__ *= 8.;
+ ca *= 8.;
+ r__ /= 8.;
+ g /= 8.;
+ ra /= 8.;
+ goto L160;
+
+L170:
+ g = c__ / 8.;
+L180:
+/* Computing MIN */
+ d__1 = min(f,c__), d__1 = min(d__1,g);
+ if (g < r__ || max(r__,ra) >= sfmax2 || min(d__1,ca) <= sfmin2) {
+ goto L190;
+ }
+ f /= 8.;
+ c__ /= 8.;
+ g /= 8.;
+ ca /= 8.;
+ r__ *= 8.;
+ ra *= 8.;
+ goto L180;
+
+/* Now balance. */
+
+L190:
+ if (c__ + r__ >= s * .95) {
+ goto L200;
+ }
+ if ((f < 1. && scale[i__] < 1.)) {
+ if (f * scale[i__] <= sfmin1) {
+ goto L200;
+ }
+ }
+ if ((f > 1. && scale[i__] > 1.)) {
+ if (scale[i__] >= sfmax1 / f) {
+ goto L200;
+ }
+ }
+ g = 1. / f;
+ scale[i__] *= f;
+ noconv = TRUE_;
+
+ i__2 = *n - k + 1;
+ zdscal_(&i__2, &g, &a[i__ + k * a_dim1], lda);
+ zdscal_(&l, &f, &a[i__ * a_dim1 + 1], &c__1);
+
+L200:
+ ;
+ }
+
+ if (noconv) {
+ goto L140;
+ }
+
+L210:
+ *ilo = k;
+ *ihi = l;
+
+ return 0;
+
+/* End of ZGEBAL */
+
+} /* zgebal_ */
+
+/* Subroutine */ int zgebd2_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublereal *d__, doublereal *e, doublecomplex *tauq,
+ doublecomplex *taup, doublecomplex *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+ doublecomplex z__1;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__;
+ static doublecomplex alpha;
+ extern /* Subroutine */ int zlarf_(char *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *, doublecomplex *), xerbla_(char *, integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *,
+ integer *, doublecomplex *), zlacgv_(integer *, doublecomplex *,
+ integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZGEBD2 reduces a complex general m by n matrix A to upper or lower
+ real bidiagonal form B by a unitary transformation: Q' * A * P = B.
+
+ If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows in the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns in the matrix A. N >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the m by n general matrix to be reduced.
+ On exit,
+ if m >= n, the diagonal and the first superdiagonal are
+ overwritten with the upper bidiagonal matrix B; the
+ elements below the diagonal, with the array TAUQ, represent
+ the unitary matrix Q as a product of elementary
+ reflectors, and the elements above the first superdiagonal,
+ with the array TAUP, represent the unitary matrix P as
+ a product of elementary reflectors;
+ if m < n, the diagonal and the first subdiagonal are
+ overwritten with the lower bidiagonal matrix B; the
+ elements below the first subdiagonal, with the array TAUQ,
+ represent the unitary matrix Q as a product of
+ elementary reflectors, and the elements above the diagonal,
+ with the array TAUP, represent the unitary matrix P as
+ a product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ D (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The diagonal elements of the bidiagonal matrix B:
+ D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (min(M,N)-1)
+ The off-diagonal elements of the bidiagonal matrix B:
+ if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
+ if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
+
+ TAUQ (output) COMPLEX*16 array dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the unitary matrix Q. See Further Details.
+
+ TAUP (output) COMPLEX*16 array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the unitary matrix P. See Further Details.
+
+ WORK (workspace) COMPLEX*16 array, dimension (max(M,N))
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrices Q and P are represented as products of elementary
+ reflectors:
+
+ If m >= n,
+
+ Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are complex scalars, and v and u are complex
+ vectors; v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in
+ A(i+1:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in
+ A(i,i+2:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ If m < n,
+
+ Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are complex scalars, v and u are complex vectors;
+ v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
+ u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
+ tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ The contents of A on exit are illustrated by the following examples:
+
+ m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
+
+ ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
+ ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
+ ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
+ ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
+ ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
+ ( v1 v2 v3 v4 v5 )
+
+ where d and e denote diagonal and off-diagonal elements of B, vi
+ denotes an element of the vector defining H(i), and ui an element of
+ the vector defining G(i).
+
+ =====================================================================
+
+
+ Test the input parameters
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --d__;
+ --e;
+ --tauq;
+ --taup;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ }
+ if (*info < 0) {
+ i__1 = -(*info);
+ xerbla_("ZGEBD2", &i__1);
+ return 0;
+ }
+
+ if (*m >= *n) {
+
+/* Reduce to upper bidiagonal form */
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/* Generate elementary reflector H(i) to annihilate A(i+1:m,i) */
+
+ i__2 = i__ + i__ * a_dim1;
+ alpha.r = a[i__2].r, alpha.i = a[i__2].i;
+ i__2 = *m - i__ + 1;
+/* Computing MIN */
+ i__3 = i__ + 1;
+ zlarfg_(&i__2, &alpha, &a[min(i__3,*m) + i__ * a_dim1], &c__1, &
+ tauq[i__]);
+ i__2 = i__;
+ d__[i__2] = alpha.r;
+ i__2 = i__ + i__ * a_dim1;
+ a[i__2].r = 1., a[i__2].i = 0.;
+
+/* Apply H(i)' to A(i:m,i+1:n) from the left */
+
+ i__2 = *m - i__ + 1;
+ i__3 = *n - i__;
+ d_cnjg(&z__1, &tauq[i__]);
+ zlarf_("Left", &i__2, &i__3, &a[i__ + i__ * a_dim1], &c__1, &z__1,
+ &a[i__ + (i__ + 1) * a_dim1], lda, &work[1]);
+ i__2 = i__ + i__ * a_dim1;
+ i__3 = i__;
+ a[i__2].r = d__[i__3], a[i__2].i = 0.;
+
+ if (i__ < *n) {
+
+/*
+ Generate elementary reflector G(i) to annihilate
+ A(i,i+2:n)
+*/
+
+ i__2 = *n - i__;
+ zlacgv_(&i__2, &a[i__ + (i__ + 1) * a_dim1], lda);
+ i__2 = i__ + (i__ + 1) * a_dim1;
+ alpha.r = a[i__2].r, alpha.i = a[i__2].i;
+ i__2 = *n - i__;
+/* Computing MIN */
+ i__3 = i__ + 2;
+ zlarfg_(&i__2, &alpha, &a[i__ + min(i__3,*n) * a_dim1], lda, &
+ taup[i__]);
+ i__2 = i__;
+ e[i__2] = alpha.r;
+ i__2 = i__ + (i__ + 1) * a_dim1;
+ a[i__2].r = 1., a[i__2].i = 0.;
+
+/* Apply G(i) to A(i+1:m,i+1:n) from the right */
+
+ i__2 = *m - i__;
+ i__3 = *n - i__;
+ zlarf_("Right", &i__2, &i__3, &a[i__ + (i__ + 1) * a_dim1],
+ lda, &taup[i__], &a[i__ + 1 + (i__ + 1) * a_dim1],
+ lda, &work[1]);
+ i__2 = *n - i__;
+ zlacgv_(&i__2, &a[i__ + (i__ + 1) * a_dim1], lda);
+ i__2 = i__ + (i__ + 1) * a_dim1;
+ i__3 = i__;
+ a[i__2].r = e[i__3], a[i__2].i = 0.;
+ } else {
+ i__2 = i__;
+ taup[i__2].r = 0., taup[i__2].i = 0.;
+ }
+/* L10: */
+ }
+ } else {
+
+/* Reduce to lower bidiagonal form */
+
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/* Generate elementary reflector G(i) to annihilate A(i,i+1:n) */
+
+ i__2 = *n - i__ + 1;
+ zlacgv_(&i__2, &a[i__ + i__ * a_dim1], lda);
+ i__2 = i__ + i__ * a_dim1;
+ alpha.r = a[i__2].r, alpha.i = a[i__2].i;
+ i__2 = *n - i__ + 1;
+/* Computing MIN */
+ i__3 = i__ + 1;
+ zlarfg_(&i__2, &alpha, &a[i__ + min(i__3,*n) * a_dim1], lda, &
+ taup[i__]);
+ i__2 = i__;
+ d__[i__2] = alpha.r;
+ i__2 = i__ + i__ * a_dim1;
+ a[i__2].r = 1., a[i__2].i = 0.;
+
+/* Apply G(i) to A(i+1:m,i:n) from the right */
+
+ i__2 = *m - i__;
+ i__3 = *n - i__ + 1;
+/* Computing MIN */
+ i__4 = i__ + 1;
+ zlarf_("Right", &i__2, &i__3, &a[i__ + i__ * a_dim1], lda, &taup[
+ i__], &a[min(i__4,*m) + i__ * a_dim1], lda, &work[1]);
+ i__2 = *n - i__ + 1;
+ zlacgv_(&i__2, &a[i__ + i__ * a_dim1], lda);
+ i__2 = i__ + i__ * a_dim1;
+ i__3 = i__;
+ a[i__2].r = d__[i__3], a[i__2].i = 0.;
+
+ if (i__ < *m) {
+
+/*
+ Generate elementary reflector H(i) to annihilate
+ A(i+2:m,i)
+*/
+
+ i__2 = i__ + 1 + i__ * a_dim1;
+ alpha.r = a[i__2].r, alpha.i = a[i__2].i;
+ i__2 = *m - i__;
+/* Computing MIN */
+ i__3 = i__ + 2;
+ zlarfg_(&i__2, &alpha, &a[min(i__3,*m) + i__ * a_dim1], &c__1,
+ &tauq[i__]);
+ i__2 = i__;
+ e[i__2] = alpha.r;
+ i__2 = i__ + 1 + i__ * a_dim1;
+ a[i__2].r = 1., a[i__2].i = 0.;
+
+/* Apply H(i)' to A(i+1:m,i+1:n) from the left */
+
+ i__2 = *m - i__;
+ i__3 = *n - i__;
+ d_cnjg(&z__1, &tauq[i__]);
+ zlarf_("Left", &i__2, &i__3, &a[i__ + 1 + i__ * a_dim1], &
+ c__1, &z__1, &a[i__ + 1 + (i__ + 1) * a_dim1], lda, &
+ work[1]);
+ i__2 = i__ + 1 + i__ * a_dim1;
+ i__3 = i__;
+ a[i__2].r = e[i__3], a[i__2].i = 0.;
+ } else {
+ i__2 = i__;
+ tauq[i__2].r = 0., tauq[i__2].i = 0.;
+ }
+/* L20: */
+ }
+ }
+ return 0;
+
+/* End of ZGEBD2 */
+
+} /* zgebd2_ */
+
+/* Subroutine */ int zgebrd_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublereal *d__, doublereal *e, doublecomplex *tauq,
+ doublecomplex *taup, doublecomplex *work, integer *lwork, integer *
+ info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
+ doublereal d__1;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer i__, j, nb, nx;
+ static doublereal ws;
+ static integer nbmin, iinfo, minmn;
+ extern /* Subroutine */ int zgemm_(char *, char *, integer *, integer *,
+ integer *, doublecomplex *, doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *), zgebd2_(integer *, integer *,
+ doublecomplex *, integer *, doublereal *, doublereal *,
+ doublecomplex *, doublecomplex *, doublecomplex *, integer *),
+ xerbla_(char *, integer *), zlabrd_(integer *, integer *,
+ integer *, doublecomplex *, integer *, doublereal *, doublereal *,
+ doublecomplex *, doublecomplex *, doublecomplex *, integer *,
+ doublecomplex *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static integer ldwrkx, ldwrky, lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZGEBRD reduces a general complex M-by-N matrix A to upper or lower
+ bidiagonal form B by a unitary transformation: Q**H * A * P = B.
+
+ If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows in the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns in the matrix A. N >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the M-by-N general matrix to be reduced.
+ On exit,
+ if m >= n, the diagonal and the first superdiagonal are
+ overwritten with the upper bidiagonal matrix B; the
+ elements below the diagonal, with the array TAUQ, represent
+ the unitary matrix Q as a product of elementary
+ reflectors, and the elements above the first superdiagonal,
+ with the array TAUP, represent the unitary matrix P as
+ a product of elementary reflectors;
+ if m < n, the diagonal and the first subdiagonal are
+ overwritten with the lower bidiagonal matrix B; the
+ elements below the first subdiagonal, with the array TAUQ,
+ represent the unitary matrix Q as a product of
+ elementary reflectors, and the elements above the diagonal,
+ with the array TAUP, represent the unitary matrix P as
+ a product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ D (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The diagonal elements of the bidiagonal matrix B:
+ D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (min(M,N)-1)
+ The off-diagonal elements of the bidiagonal matrix B:
+ if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
+ if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
+
+ TAUQ (output) COMPLEX*16 array dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the unitary matrix Q. See Further Details.
+
+ TAUP (output) COMPLEX*16 array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors which
+ represent the unitary matrix P. See Further Details.
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,M,N).
+ For optimum performance LWORK >= (M+N)*NB, where NB
+ is the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrices Q and P are represented as products of elementary
+ reflectors:
+
+ If m >= n,
+
+ Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are complex scalars, and v and u are complex
+ vectors; v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in
+ A(i+1:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in
+ A(i,i+2:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ If m < n,
+
+ Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are complex scalars, and v and u are complex
+ vectors; v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in
+ A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in
+ A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ The contents of A on exit are illustrated by the following examples:
+
+ m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
+
+ ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
+ ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
+ ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
+ ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
+ ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
+ ( v1 v2 v3 v4 v5 )
+
+ where d and e denote diagonal and off-diagonal elements of B, vi
+ denotes an element of the vector defining H(i), and ui an element of
+ the vector defining G(i).
+
+ =====================================================================
+
+
+ Test the input parameters
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --d__;
+ --e;
+ --tauq;
+ --taup;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+/* Computing MAX */
+ i__1 = 1, i__2 = ilaenv_(&c__1, "ZGEBRD", " ", m, n, &c_n1, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ nb = max(i__1,i__2);
+ lwkopt = (*m + *n) * nb;
+ d__1 = (doublereal) lwkopt;
+ work[1].r = d__1, work[1].i = 0.;
+ lquery = *lwork == -1;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ } else /* if(complicated condition) */ {
+/* Computing MAX */
+ i__1 = max(1,*m);
+ if ((*lwork < max(i__1,*n) && ! lquery)) {
+ *info = -10;
+ }
+ }
+ if (*info < 0) {
+ i__1 = -(*info);
+ xerbla_("ZGEBRD", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ minmn = min(*m,*n);
+ if (minmn == 0) {
+ work[1].r = 1., work[1].i = 0.;
+ return 0;
+ }
+
+ ws = (doublereal) max(*m,*n);
+ ldwrkx = *m;
+ ldwrky = *n;
+
+ if ((nb > 1 && nb < minmn)) {
+
+/*
+ Set the crossover point NX.
+
+ Computing MAX
+*/
+ i__1 = nb, i__2 = ilaenv_(&c__3, "ZGEBRD", " ", m, n, &c_n1, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ nx = max(i__1,i__2);
+
+/* Determine when to switch from blocked to unblocked code. */
+
+ if (nx < minmn) {
+ ws = (doublereal) ((*m + *n) * nb);
+ if ((doublereal) (*lwork) < ws) {
+
+/*
+ Not enough work space for the optimal NB, consider using
+ a smaller block size.
+*/
+
+ nbmin = ilaenv_(&c__2, "ZGEBRD", " ", m, n, &c_n1, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ if (*lwork >= (*m + *n) * nbmin) {
+ nb = *lwork / (*m + *n);
+ } else {
+ nb = 1;
+ nx = minmn;
+ }
+ }
+ }
+ } else {
+ nx = minmn;
+ }
+
+ i__1 = minmn - nx;
+ i__2 = nb;
+ for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+
+/*
+ Reduce rows and columns i:i+ib-1 to bidiagonal form and return
+ the matrices X and Y which are needed to update the unreduced
+ part of the matrix
+*/
+
+ i__3 = *m - i__ + 1;
+ i__4 = *n - i__ + 1;
+ zlabrd_(&i__3, &i__4, &nb, &a[i__ + i__ * a_dim1], lda, &d__[i__], &e[
+ i__], &tauq[i__], &taup[i__], &work[1], &ldwrkx, &work[ldwrkx
+ * nb + 1], &ldwrky);
+
+/*
+ Update the trailing submatrix A(i+ib:m,i+ib:n), using
+ an update of the form A := A - V*Y' - X*U'
+*/
+
+ i__3 = *m - i__ - nb + 1;
+ i__4 = *n - i__ - nb + 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemm_("No transpose", "Conjugate transpose", &i__3, &i__4, &nb, &
+ z__1, &a[i__ + nb + i__ * a_dim1], lda, &work[ldwrkx * nb +
+ nb + 1], &ldwrky, &c_b60, &a[i__ + nb + (i__ + nb) * a_dim1],
+ lda);
+ i__3 = *m - i__ - nb + 1;
+ i__4 = *n - i__ - nb + 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemm_("No transpose", "No transpose", &i__3, &i__4, &nb, &z__1, &
+ work[nb + 1], &ldwrkx, &a[i__ + (i__ + nb) * a_dim1], lda, &
+ c_b60, &a[i__ + nb + (i__ + nb) * a_dim1], lda);
+
+/* Copy diagonal and off-diagonal elements of B back into A */
+
+ if (*m >= *n) {
+ i__3 = i__ + nb - 1;
+ for (j = i__; j <= i__3; ++j) {
+ i__4 = j + j * a_dim1;
+ i__5 = j;
+ a[i__4].r = d__[i__5], a[i__4].i = 0.;
+ i__4 = j + (j + 1) * a_dim1;
+ i__5 = j;
+ a[i__4].r = e[i__5], a[i__4].i = 0.;
+/* L10: */
+ }
+ } else {
+ i__3 = i__ + nb - 1;
+ for (j = i__; j <= i__3; ++j) {
+ i__4 = j + j * a_dim1;
+ i__5 = j;
+ a[i__4].r = d__[i__5], a[i__4].i = 0.;
+ i__4 = j + 1 + j * a_dim1;
+ i__5 = j;
+ a[i__4].r = e[i__5], a[i__4].i = 0.;
+/* L20: */
+ }
+ }
+/* L30: */
+ }
+
+/* Use unblocked code to reduce the remainder of the matrix */
+
+ i__2 = *m - i__ + 1;
+ i__1 = *n - i__ + 1;
+ zgebd2_(&i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &d__[i__], &e[i__], &
+ tauq[i__], &taup[i__], &work[1], &iinfo);
+ work[1].r = ws, work[1].i = 0.;
+ return 0;
+
+/* End of ZGEBRD */
+
+} /* zgebrd_ */
+
+/* Subroutine */ int zgeev_(char *jobvl, char *jobvr, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *w, doublecomplex *vl,
+ integer *ldvl, doublecomplex *vr, integer *ldvr, doublecomplex *work,
+ integer *lwork, doublereal *rwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1,
+ i__2, i__3, i__4;
+ doublereal d__1, d__2;
+ doublecomplex z__1, z__2;
+
+ /* Builtin functions */
+ double sqrt(doublereal), d_imag(doublecomplex *);
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, k, ihi;
+ static doublereal scl;
+ static integer ilo;
+ static doublereal dum[1], eps;
+ static doublecomplex tmp;
+ static integer ibal;
+ static char side[1];
+ static integer maxb;
+ static doublereal anrm;
+ static integer ierr, itau, iwrk, nout;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int zscal_(integer *, doublecomplex *,
+ doublecomplex *, integer *), dlabad_(doublereal *, doublereal *);
+ extern doublereal dznrm2_(integer *, doublecomplex *, integer *);
+ static logical scalea;
+
+ static doublereal cscale;
+ extern /* Subroutine */ int zgebak_(char *, char *, integer *, integer *,
+ integer *, doublereal *, integer *, doublecomplex *, integer *,
+ integer *), zgebal_(char *, integer *,
+ doublecomplex *, integer *, integer *, integer *, doublereal *,
+ integer *);
+ extern integer idamax_(integer *, doublereal *, integer *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static logical select[1];
+ extern /* Subroutine */ int zdscal_(integer *, doublereal *,
+ doublecomplex *, integer *);
+ static doublereal bignum;
+ extern doublereal zlange_(char *, integer *, integer *, doublecomplex *,
+ integer *, doublereal *);
+ extern /* Subroutine */ int zgehrd_(integer *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *, integer *), zlascl_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, integer *, doublecomplex *,
+ integer *, integer *), zlacpy_(char *, integer *,
+ integer *, doublecomplex *, integer *, doublecomplex *, integer *);
+ static integer minwrk, maxwrk;
+ static logical wantvl;
+ static doublereal smlnum;
+ static integer hswork, irwork;
+ extern /* Subroutine */ int zhseqr_(char *, char *, integer *, integer *,
+ integer *, doublecomplex *, integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *, integer *), ztrevc_(char *, char *, logical *, integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *, integer *, integer *, doublecomplex *,
+ doublereal *, integer *);
+ static logical lquery, wantvr;
+ extern /* Subroutine */ int zunghr_(integer *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *, integer *);
+
+
+/*
+ -- LAPACK driver routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZGEEV computes for an N-by-N complex nonsymmetric matrix A, the
+ eigenvalues and, optionally, the left and/or right eigenvectors.
+
+ The right eigenvector v(j) of A satisfies
+ A * v(j) = lambda(j) * v(j)
+ where lambda(j) is its eigenvalue.
+ The left eigenvector u(j) of A satisfies
+ u(j)**H * A = lambda(j) * u(j)**H
+ where u(j)**H denotes the conjugate transpose of u(j).
+
+ The computed eigenvectors are normalized to have Euclidean norm
+ equal to 1 and largest component real.
+
+ Arguments
+ =========
+
+ JOBVL (input) CHARACTER*1
+ = 'N': left eigenvectors of A are not computed;
+ = 'V': left eigenvectors of are computed.
+
+ JOBVR (input) CHARACTER*1
+ = 'N': right eigenvectors of A are not computed;
+ = 'V': right eigenvectors of A are computed.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the N-by-N matrix A.
+ On exit, A has been overwritten.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ W (output) COMPLEX*16 array, dimension (N)
+ W contains the computed eigenvalues.
+
+ VL (output) COMPLEX*16 array, dimension (LDVL,N)
+ If JOBVL = 'V', the left eigenvectors u(j) are stored one
+ after another in the columns of VL, in the same order
+ as their eigenvalues.
+ If JOBVL = 'N', VL is not referenced.
+ u(j) = VL(:,j), the j-th column of VL.
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= 1; if
+ JOBVL = 'V', LDVL >= N.
+
+ VR (output) COMPLEX*16 array, dimension (LDVR,N)
+ If JOBVR = 'V', the right eigenvectors v(j) are stored one
+ after another in the columns of VR, in the same order
+ as their eigenvalues.
+ If JOBVR = 'N', VR is not referenced.
+ v(j) = VR(:,j), the j-th column of VR.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= 1; if
+ JOBVR = 'V', LDVR >= N.
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,2*N).
+ For good performance, LWORK must generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ RWORK (workspace) DOUBLE PRECISION array, dimension (2*N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = i, the QR algorithm failed to compute all the
+ eigenvalues, and no eigenvectors have been computed;
+ elements and i+1:N of W contain eigenvalues which have
+ converged.
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --w;
+ vl_dim1 = *ldvl;
+ vl_offset = 1 + vl_dim1 * 1;
+ vl -= vl_offset;
+ vr_dim1 = *ldvr;
+ vr_offset = 1 + vr_dim1 * 1;
+ vr -= vr_offset;
+ --work;
+ --rwork;
+
+ /* Function Body */
+ *info = 0;
+ lquery = *lwork == -1;
+ wantvl = lsame_(jobvl, "V");
+ wantvr = lsame_(jobvr, "V");
+ if ((! wantvl && ! lsame_(jobvl, "N"))) {
+ *info = -1;
+ } else if ((! wantvr && ! lsame_(jobvr, "N"))) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*lda < max(1,*n)) {
+ *info = -5;
+ } else if (*ldvl < 1 || (wantvl && *ldvl < *n)) {
+ *info = -8;
+ } else if (*ldvr < 1 || (wantvr && *ldvr < *n)) {
+ *info = -10;
+ }
+
+/*
+ Compute workspace
+ (Note: Comments in the code beginning "Workspace:" describe the
+ minimal amount of workspace needed at that point in the code,
+ as well as the preferred amount for good performance.
+ CWorkspace refers to complex workspace, and RWorkspace to real
+ workspace. NB refers to the optimal block size for the
+ immediately following subroutine, as returned by ILAENV.
+ HSWORK refers to the workspace preferred by ZHSEQR, as
+ calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
+ the worst case.)
+*/
+
+ minwrk = 1;
+ if ((*info == 0 && (*lwork >= 1 || lquery))) {
+ maxwrk = *n + *n * ilaenv_(&c__1, "ZGEHRD", " ", n, &c__1, n, &c__0, (
+ ftnlen)6, (ftnlen)1);
+ if ((! wantvl && ! wantvr)) {
+/* Computing MAX */
+ i__1 = 1, i__2 = (*n) << (1);
+ minwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = ilaenv_(&c__8, "ZHSEQR", "EN", n, &c__1, n, &c_n1, (ftnlen)
+ 6, (ftnlen)2);
+ maxb = max(i__1,2);
+/*
+ Computing MIN
+ Computing MAX
+*/
+ i__3 = 2, i__4 = ilaenv_(&c__4, "ZHSEQR", "EN", n, &c__1, n, &
+ c_n1, (ftnlen)6, (ftnlen)2);
+ i__1 = min(maxb,*n), i__2 = max(i__3,i__4);
+ k = min(i__1,i__2);
+/* Computing MAX */
+ i__1 = k * (k + 2), i__2 = (*n) << (1);
+ hswork = max(i__1,i__2);
+ maxwrk = max(maxwrk,hswork);
+ } else {
+/* Computing MAX */
+ i__1 = 1, i__2 = (*n) << (1);
+ minwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *n + (*n - 1) * ilaenv_(&c__1, "ZUNGHR",
+ " ", n, &c__1, n, &c_n1, (ftnlen)6, (ftnlen)1);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = ilaenv_(&c__8, "ZHSEQR", "SV", n, &c__1, n, &c_n1, (ftnlen)
+ 6, (ftnlen)2);
+ maxb = max(i__1,2);
+/*
+ Computing MIN
+ Computing MAX
+*/
+ i__3 = 2, i__4 = ilaenv_(&c__4, "ZHSEQR", "SV", n, &c__1, n, &
+ c_n1, (ftnlen)6, (ftnlen)2);
+ i__1 = min(maxb,*n), i__2 = max(i__3,i__4);
+ k = min(i__1,i__2);
+/* Computing MAX */
+ i__1 = k * (k + 2), i__2 = (*n) << (1);
+ hswork = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = max(maxwrk,hswork), i__2 = (*n) << (1);
+ maxwrk = max(i__1,i__2);
+ }
+ work[1].r = (doublereal) maxwrk, work[1].i = 0.;
+ }
+ if ((*lwork < minwrk && ! lquery)) {
+ *info = -12;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGEEV ", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+/* Get machine constants */
+
+ eps = PRECISION;
+ smlnum = SAFEMINIMUM;
+ bignum = 1. / smlnum;
+ dlabad_(&smlnum, &bignum);
+ smlnum = sqrt(smlnum) / eps;
+ bignum = 1. / smlnum;
+
+/* Scale A if max element outside range [SMLNUM,BIGNUM] */
+
+ anrm = zlange_("M", n, n, &a[a_offset], lda, dum);
+ scalea = FALSE_;
+ if ((anrm > 0. && anrm < smlnum)) {
+ scalea = TRUE_;
+ cscale = smlnum;
+ } else if (anrm > bignum) {
+ scalea = TRUE_;
+ cscale = bignum;
+ }
+ if (scalea) {
+ zlascl_("G", &c__0, &c__0, &anrm, &cscale, n, n, &a[a_offset], lda, &
+ ierr);
+ }
+
+/*
+ Balance the matrix
+ (CWorkspace: none)
+ (RWorkspace: need N)
+*/
+
+ ibal = 1;
+ zgebal_("B", n, &a[a_offset], lda, &ilo, &ihi, &rwork[ibal], &ierr);
+
+/*
+ Reduce to upper Hessenberg form
+ (CWorkspace: need 2*N, prefer N+N*NB)
+ (RWorkspace: none)
+*/
+
+ itau = 1;
+ iwrk = itau + *n;
+ i__1 = *lwork - iwrk + 1;
+ zgehrd_(n, &ilo, &ihi, &a[a_offset], lda, &work[itau], &work[iwrk], &i__1,
+ &ierr);
+
+ if (wantvl) {
+
+/*
+ Want left eigenvectors
+ Copy Householder vectors to VL
+*/
+
+ *(unsigned char *)side = 'L';
+ zlacpy_("L", n, n, &a[a_offset], lda, &vl[vl_offset], ldvl)
+ ;
+
+/*
+ Generate unitary matrix in VL
+ (CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
+ (RWorkspace: none)
+*/
+
+ i__1 = *lwork - iwrk + 1;
+ zunghr_(n, &ilo, &ihi, &vl[vl_offset], ldvl, &work[itau], &work[iwrk],
+ &i__1, &ierr);
+
+/*
+ Perform QR iteration, accumulating Schur vectors in VL
+ (CWorkspace: need 1, prefer HSWORK (see comments) )
+ (RWorkspace: none)
+*/
+
+ iwrk = itau;
+ i__1 = *lwork - iwrk + 1;
+ zhseqr_("S", "V", n, &ilo, &ihi, &a[a_offset], lda, &w[1], &vl[
+ vl_offset], ldvl, &work[iwrk], &i__1, info);
+
+ if (wantvr) {
+
+/*
+ Want left and right eigenvectors
+ Copy Schur vectors to VR
+*/
+
+ *(unsigned char *)side = 'B';
+ zlacpy_("F", n, n, &vl[vl_offset], ldvl, &vr[vr_offset], ldvr);
+ }
+
+ } else if (wantvr) {
+
+/*
+ Want right eigenvectors
+ Copy Householder vectors to VR
+*/
+
+ *(unsigned char *)side = 'R';
+ zlacpy_("L", n, n, &a[a_offset], lda, &vr[vr_offset], ldvr)
+ ;
+
+/*
+ Generate unitary matrix in VR
+ (CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
+ (RWorkspace: none)
+*/
+
+ i__1 = *lwork - iwrk + 1;
+ zunghr_(n, &ilo, &ihi, &vr[vr_offset], ldvr, &work[itau], &work[iwrk],
+ &i__1, &ierr);
+
+/*
+ Perform QR iteration, accumulating Schur vectors in VR
+ (CWorkspace: need 1, prefer HSWORK (see comments) )
+ (RWorkspace: none)
+*/
+
+ iwrk = itau;
+ i__1 = *lwork - iwrk + 1;
+ zhseqr_("S", "V", n, &ilo, &ihi, &a[a_offset], lda, &w[1], &vr[
+ vr_offset], ldvr, &work[iwrk], &i__1, info);
+
+ } else {
+
+/*
+ Compute eigenvalues only
+ (CWorkspace: need 1, prefer HSWORK (see comments) )
+ (RWorkspace: none)
+*/
+
+ iwrk = itau;
+ i__1 = *lwork - iwrk + 1;
+ zhseqr_("E", "N", n, &ilo, &ihi, &a[a_offset], lda, &w[1], &vr[
+ vr_offset], ldvr, &work[iwrk], &i__1, info);
+ }
+
+/* If INFO > 0 from ZHSEQR, then quit */
+
+ if (*info > 0) {
+ goto L50;
+ }
+
+ if (wantvl || wantvr) {
+
+/*
+ Compute left and/or right eigenvectors
+ (CWorkspace: need 2*N)
+ (RWorkspace: need 2*N)
+*/
+
+ irwork = ibal + *n;
+ ztrevc_(side, "B", select, n, &a[a_offset], lda, &vl[vl_offset], ldvl,
+ &vr[vr_offset], ldvr, n, &nout, &work[iwrk], &rwork[irwork],
+ &ierr);
+ }
+
+ if (wantvl) {
+
+/*
+ Undo balancing of left eigenvectors
+ (CWorkspace: none)
+ (RWorkspace: need N)
+*/
+
+ zgebak_("B", "L", n, &ilo, &ihi, &rwork[ibal], n, &vl[vl_offset],
+ ldvl, &ierr);
+
+/* Normalize left eigenvectors and make largest component real */
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ scl = 1. / dznrm2_(n, &vl[i__ * vl_dim1 + 1], &c__1);
+ zdscal_(n, &scl, &vl[i__ * vl_dim1 + 1], &c__1);
+ i__2 = *n;
+ for (k = 1; k <= i__2; ++k) {
+ i__3 = k + i__ * vl_dim1;
+/* Computing 2nd power */
+ d__1 = vl[i__3].r;
+/* Computing 2nd power */
+ d__2 = d_imag(&vl[k + i__ * vl_dim1]);
+ rwork[irwork + k - 1] = d__1 * d__1 + d__2 * d__2;
+/* L10: */
+ }
+ k = idamax_(n, &rwork[irwork], &c__1);
+ d_cnjg(&z__2, &vl[k + i__ * vl_dim1]);
+ d__1 = sqrt(rwork[irwork + k - 1]);
+ z__1.r = z__2.r / d__1, z__1.i = z__2.i / d__1;
+ tmp.r = z__1.r, tmp.i = z__1.i;
+ zscal_(n, &tmp, &vl[i__ * vl_dim1 + 1], &c__1);
+ i__2 = k + i__ * vl_dim1;
+ i__3 = k + i__ * vl_dim1;
+ d__1 = vl[i__3].r;
+ z__1.r = d__1, z__1.i = 0.;
+ vl[i__2].r = z__1.r, vl[i__2].i = z__1.i;
+/* L20: */
+ }
+ }
+
+ if (wantvr) {
+
+/*
+ Undo balancing of right eigenvectors
+ (CWorkspace: none)
+ (RWorkspace: need N)
+*/
+
+ zgebak_("B", "R", n, &ilo, &ihi, &rwork[ibal], n, &vr[vr_offset],
+ ldvr, &ierr);
+
+/* Normalize right eigenvectors and make largest component real */
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ scl = 1. / dznrm2_(n, &vr[i__ * vr_dim1 + 1], &c__1);
+ zdscal_(n, &scl, &vr[i__ * vr_dim1 + 1], &c__1);
+ i__2 = *n;
+ for (k = 1; k <= i__2; ++k) {
+ i__3 = k + i__ * vr_dim1;
+/* Computing 2nd power */
+ d__1 = vr[i__3].r;
+/* Computing 2nd power */
+ d__2 = d_imag(&vr[k + i__ * vr_dim1]);
+ rwork[irwork + k - 1] = d__1 * d__1 + d__2 * d__2;
+/* L30: */
+ }
+ k = idamax_(n, &rwork[irwork], &c__1);
+ d_cnjg(&z__2, &vr[k + i__ * vr_dim1]);
+ d__1 = sqrt(rwork[irwork + k - 1]);
+ z__1.r = z__2.r / d__1, z__1.i = z__2.i / d__1;
+ tmp.r = z__1.r, tmp.i = z__1.i;
+ zscal_(n, &tmp, &vr[i__ * vr_dim1 + 1], &c__1);
+ i__2 = k + i__ * vr_dim1;
+ i__3 = k + i__ * vr_dim1;
+ d__1 = vr[i__3].r;
+ z__1.r = d__1, z__1.i = 0.;
+ vr[i__2].r = z__1.r, vr[i__2].i = z__1.i;
+/* L40: */
+ }
+ }
+
+/* Undo scaling if necessary */
+
+L50:
+ if (scalea) {
+ i__1 = *n - *info;
+/* Computing MAX */
+ i__3 = *n - *info;
+ i__2 = max(i__3,1);
+ zlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &w[*info + 1]
+ , &i__2, &ierr);
+ if (*info > 0) {
+ i__1 = ilo - 1;
+ zlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &w[1], n,
+ &ierr);
+ }
+ }
+
+ work[1].r = (doublereal) maxwrk, work[1].i = 0.;
+ return 0;
+
+/* End of ZGEEV */
+
+} /* zgeev_ */
+
+/* Subroutine */ int zgehd2_(integer *n, integer *ilo, integer *ihi,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+ doublecomplex z__1;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__;
+ static doublecomplex alpha;
+ extern /* Subroutine */ int zlarf_(char *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *, doublecomplex *), xerbla_(char *, integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *,
+ integer *, doublecomplex *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZGEHD2 reduces a complex general matrix A to upper Hessenberg form H
+ by a unitary similarity transformation: Q' * A * Q = H .
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that A is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+ set by a previous call to ZGEBAL; otherwise they should be
+ set to 1 and N respectively. See Further Details.
+ 1 <= ILO <= IHI <= max(1,N).
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the n by n general matrix to be reduced.
+ On exit, the upper triangle and the first subdiagonal of A
+ are overwritten with the upper Hessenberg matrix H, and the
+ elements below the first subdiagonal, with the array TAU,
+ represent the unitary matrix Q as a product of elementary
+ reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) COMPLEX*16 array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+ Details).
+
+ WORK (workspace) COMPLEX*16 array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of (ihi-ilo) elementary
+ reflectors
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a complex scalar, and v is a complex vector with
+ v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
+ exit in A(i+2:ihi,i), and tau in TAU(i).
+
+ The contents of A are illustrated by the following example, with
+ n = 7, ilo = 2 and ihi = 6:
+
+ on entry, on exit,
+
+ ( a a a a a a a ) ( a a h h h h a )
+ ( a a a a a a ) ( a h h h h a )
+ ( a a a a a a ) ( h h h h h h )
+ ( a a a a a a ) ( v2 h h h h h )
+ ( a a a a a a ) ( v2 v3 h h h h )
+ ( a a a a a a ) ( v2 v3 v4 h h h )
+ ( a ) ( a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+ element of the vector defining H(i).
+
+ =====================================================================
+
+
+ Test the input parameters
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ if (*n < 0) {
+ *info = -1;
+ } else if (*ilo < 1 || *ilo > max(1,*n)) {
+ *info = -2;
+ } else if (*ihi < min(*ilo,*n) || *ihi > *n) {
+ *info = -3;
+ } else if (*lda < max(1,*n)) {
+ *info = -5;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGEHD2", &i__1);
+ return 0;
+ }
+
+ i__1 = *ihi - 1;
+ for (i__ = *ilo; i__ <= i__1; ++i__) {
+
+/* Compute elementary reflector H(i) to annihilate A(i+2:ihi,i) */
+
+ i__2 = i__ + 1 + i__ * a_dim1;
+ alpha.r = a[i__2].r, alpha.i = a[i__2].i;
+ i__2 = *ihi - i__;
+/* Computing MIN */
+ i__3 = i__ + 2;
+ zlarfg_(&i__2, &alpha, &a[min(i__3,*n) + i__ * a_dim1], &c__1, &tau[
+ i__]);
+ i__2 = i__ + 1 + i__ * a_dim1;
+ a[i__2].r = 1., a[i__2].i = 0.;
+
+/* Apply H(i) to A(1:ihi,i+1:ihi) from the right */
+
+ i__2 = *ihi - i__;
+ zlarf_("Right", ihi, &i__2, &a[i__ + 1 + i__ * a_dim1], &c__1, &tau[
+ i__], &a[(i__ + 1) * a_dim1 + 1], lda, &work[1]);
+
+/* Apply H(i)' to A(i+1:ihi,i+1:n) from the left */
+
+ i__2 = *ihi - i__;
+ i__3 = *n - i__;
+ d_cnjg(&z__1, &tau[i__]);
+ zlarf_("Left", &i__2, &i__3, &a[i__ + 1 + i__ * a_dim1], &c__1, &z__1,
+ &a[i__ + 1 + (i__ + 1) * a_dim1], lda, &work[1]);
+
+ i__2 = i__ + 1 + i__ * a_dim1;
+ a[i__2].r = alpha.r, a[i__2].i = alpha.i;
+/* L10: */
+ }
+
+ return 0;
+
+/* End of ZGEHD2 */
+
+} /* zgehd2_ */
+
+/* Subroutine */ int zgehrd_(integer *n, integer *ilo, integer *ihi,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer i__;
+ static doublecomplex t[4160] /* was [65][64] */;
+ static integer ib;
+ static doublecomplex ei;
+ static integer nb, nh, nx, iws, nbmin, iinfo;
+ extern /* Subroutine */ int zgemm_(char *, char *, integer *, integer *,
+ integer *, doublecomplex *, doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *), zgehd2_(integer *, integer *, integer
+ *, doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *,
+ integer *, integer *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *),
+ zlahrd_(integer *, integer *, integer *, doublecomplex *, integer
+ *, doublecomplex *, doublecomplex *, integer *, doublecomplex *,
+ integer *);
+ static integer ldwork, lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZGEHRD reduces a complex general matrix A to upper Hessenberg form H
+ by a unitary similarity transformation: Q' * A * Q = H .
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that A is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+ set by a previous call to ZGEBAL; otherwise they should be
+ set to 1 and N respectively. See Further Details.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the N-by-N general matrix to be reduced.
+ On exit, the upper triangle and the first subdiagonal of A
+ are overwritten with the upper Hessenberg matrix H, and the
+ elements below the first subdiagonal, with the array TAU,
+ represent the unitary matrix Q as a product of elementary
+ reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) COMPLEX*16 array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+ Details). Elements 1:ILO-1 and IHI:N-1 of TAU are set to
+ zero.
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of (ihi-ilo) elementary
+ reflectors
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a complex scalar, and v is a complex vector with
+ v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
+ exit in A(i+2:ihi,i), and tau in TAU(i).
+
+ The contents of A are illustrated by the following example, with
+ n = 7, ilo = 2 and ihi = 6:
+
+ on entry, on exit,
+
+ ( a a a a a a a ) ( a a h h h h a )
+ ( a a a a a a ) ( a h h h h a )
+ ( a a a a a a ) ( h h h h h h )
+ ( a a a a a a ) ( v2 h h h h h )
+ ( a a a a a a ) ( v2 v3 h h h h )
+ ( a a a a a a ) ( v2 v3 v4 h h h )
+ ( a ) ( a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+ element of the vector defining H(i).
+
+ =====================================================================
+
+
+ Test the input parameters
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+/* Computing MIN */
+ i__1 = 64, i__2 = ilaenv_(&c__1, "ZGEHRD", " ", n, ilo, ihi, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ nb = min(i__1,i__2);
+ lwkopt = *n * nb;
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ lquery = *lwork == -1;
+ if (*n < 0) {
+ *info = -1;
+ } else if (*ilo < 1 || *ilo > max(1,*n)) {
+ *info = -2;
+ } else if (*ihi < min(*ilo,*n) || *ihi > *n) {
+ *info = -3;
+ } else if (*lda < max(1,*n)) {
+ *info = -5;
+ } else if ((*lwork < max(1,*n) && ! lquery)) {
+ *info = -8;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGEHRD", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Set elements 1:ILO-1 and IHI:N-1 of TAU to zero */
+
+ i__1 = *ilo - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ tau[i__2].r = 0., tau[i__2].i = 0.;
+/* L10: */
+ }
+ i__1 = *n - 1;
+ for (i__ = max(1,*ihi); i__ <= i__1; ++i__) {
+ i__2 = i__;
+ tau[i__2].r = 0., tau[i__2].i = 0.;
+/* L20: */
+ }
+
+/* Quick return if possible */
+
+ nh = *ihi - *ilo + 1;
+ if (nh <= 1) {
+ work[1].r = 1., work[1].i = 0.;
+ return 0;
+ }
+
+ nbmin = 2;
+ iws = 1;
+ if ((nb > 1 && nb < nh)) {
+
+/*
+ Determine when to cross over from blocked to unblocked code
+ (last block is always handled by unblocked code).
+
+ Computing MAX
+*/
+ i__1 = nb, i__2 = ilaenv_(&c__3, "ZGEHRD", " ", n, ilo, ihi, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ nx = max(i__1,i__2);
+ if (nx < nh) {
+
+/* Determine if workspace is large enough for blocked code. */
+
+ iws = *n * nb;
+ if (*lwork < iws) {
+
+/*
+ Not enough workspace to use optimal NB: determine the
+ minimum value of NB, and reduce NB or force use of
+ unblocked code.
+
+ Computing MAX
+*/
+ i__1 = 2, i__2 = ilaenv_(&c__2, "ZGEHRD", " ", n, ilo, ihi, &
+ c_n1, (ftnlen)6, (ftnlen)1);
+ nbmin = max(i__1,i__2);
+ if (*lwork >= *n * nbmin) {
+ nb = *lwork / *n;
+ } else {
+ nb = 1;
+ }
+ }
+ }
+ }
+ ldwork = *n;
+
+ if (nb < nbmin || nb >= nh) {
+
+/* Use unblocked code below */
+
+ i__ = *ilo;
+
+ } else {
+
+/* Use blocked code */
+
+ i__1 = *ihi - 1 - nx;
+ i__2 = nb;
+ for (i__ = *ilo; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+/* Computing MIN */
+ i__3 = nb, i__4 = *ihi - i__;
+ ib = min(i__3,i__4);
+
+/*
+ Reduce columns i:i+ib-1 to Hessenberg form, returning the
+ matrices V and T of the block reflector H = I - V*T*V'
+ which performs the reduction, and also the matrix Y = A*V*T
+*/
+
+ zlahrd_(ihi, &i__, &ib, &a[i__ * a_dim1 + 1], lda, &tau[i__], t, &
+ c__65, &work[1], &ldwork);
+
+/*
+ Apply the block reflector H to A(1:ihi,i+ib:ihi) from the
+ right, computing A := A - Y * V'. V(i+ib,ib-1) must be set
+ to 1.
+*/
+
+ i__3 = i__ + ib + (i__ + ib - 1) * a_dim1;
+ ei.r = a[i__3].r, ei.i = a[i__3].i;
+ i__3 = i__ + ib + (i__ + ib - 1) * a_dim1;
+ a[i__3].r = 1., a[i__3].i = 0.;
+ i__3 = *ihi - i__ - ib + 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemm_("No transpose", "Conjugate transpose", ihi, &i__3, &ib, &
+ z__1, &work[1], &ldwork, &a[i__ + ib + i__ * a_dim1], lda,
+ &c_b60, &a[(i__ + ib) * a_dim1 + 1], lda);
+ i__3 = i__ + ib + (i__ + ib - 1) * a_dim1;
+ a[i__3].r = ei.r, a[i__3].i = ei.i;
+
+/*
+ Apply the block reflector H to A(i+1:ihi,i+ib:n) from the
+ left
+*/
+
+ i__3 = *ihi - i__;
+ i__4 = *n - i__ - ib + 1;
+ zlarfb_("Left", "Conjugate transpose", "Forward", "Columnwise", &
+ i__3, &i__4, &ib, &a[i__ + 1 + i__ * a_dim1], lda, t, &
+ c__65, &a[i__ + 1 + (i__ + ib) * a_dim1], lda, &work[1], &
+ ldwork);
+/* L30: */
+ }
+ }
+
+/* Use unblocked code to reduce the rest of the matrix */
+
+ zgehd2_(n, &i__, ihi, &a[a_offset], lda, &tau[1], &work[1], &iinfo);
+ work[1].r = (doublereal) iws, work[1].i = 0.;
+
+ return 0;
+
+/* End of ZGEHRD */
+
+} /* zgehrd_ */
+
+/* Subroutine */ int zgelq2_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i__, k;
+ static doublecomplex alpha;
+ extern /* Subroutine */ int zlarf_(char *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *, doublecomplex *), xerbla_(char *, integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *,
+ integer *, doublecomplex *), zlacgv_(integer *, doublecomplex *,
+ integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZGELQ2 computes an LQ factorization of a complex m by n matrix A:
+ A = L * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, the elements on and below the diagonal of the array
+ contain the m by min(m,n) lower trapezoidal matrix L (L is
+ lower triangular if m <= n); the elements above the diagonal,
+ with the array TAU, represent the unitary matrix Q as a
+ product of elementary reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) COMPLEX*16 array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+ Details).
+
+ WORK (workspace) COMPLEX*16 array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k)' . . . H(2)' H(1)', where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a complex scalar, and v is a complex vector with
+ v(1:i-1) = 0 and v(i) = 1; conjg(v(i+1:n)) is stored on exit in
+ A(i,i+1:n), and tau in TAU(i).
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGELQ2", &i__1);
+ return 0;
+ }
+
+ k = min(*m,*n);
+
+ i__1 = k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/* Generate elementary reflector H(i) to annihilate A(i,i+1:n) */
+
+ i__2 = *n - i__ + 1;
+ zlacgv_(&i__2, &a[i__ + i__ * a_dim1], lda);
+ i__2 = i__ + i__ * a_dim1;
+ alpha.r = a[i__2].r, alpha.i = a[i__2].i;
+ i__2 = *n - i__ + 1;
+/* Computing MIN */
+ i__3 = i__ + 1;
+ zlarfg_(&i__2, &alpha, &a[i__ + min(i__3,*n) * a_dim1], lda, &tau[i__]
+ );
+ if (i__ < *m) {
+
+/* Apply H(i) to A(i+1:m,i:n) from the right */
+
+ i__2 = i__ + i__ * a_dim1;
+ a[i__2].r = 1., a[i__2].i = 0.;
+ i__2 = *m - i__;
+ i__3 = *n - i__ + 1;
+ zlarf_("Right", &i__2, &i__3, &a[i__ + i__ * a_dim1], lda, &tau[
+ i__], &a[i__ + 1 + i__ * a_dim1], lda, &work[1]);
+ }
+ i__2 = i__ + i__ * a_dim1;
+ a[i__2].r = alpha.r, a[i__2].i = alpha.i;
+ i__2 = *n - i__ + 1;
+ zlacgv_(&i__2, &a[i__ + i__ * a_dim1], lda);
+/* L10: */
+ }
+ return 0;
+
+/* End of ZGELQ2 */
+
+} /* zgelq2_ */
+
+/* Subroutine */ int zgelqf_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork,
+ integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+
+ /* Local variables */
+ static integer i__, k, ib, nb, nx, iws, nbmin, iinfo;
+ extern /* Subroutine */ int zgelq2_(integer *, integer *, doublecomplex *,
+ integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(
+ char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *,
+ integer *, integer *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *);
+ static integer ldwork;
+ extern /* Subroutine */ int zlarft_(char *, char *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *);
+ static integer lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZGELQF computes an LQ factorization of a complex M-by-N matrix A:
+ A = L * Q.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the elements on and below the diagonal of the array
+ contain the m-by-min(m,n) lower trapezoidal matrix L (L is
+ lower triangular if m <= n); the elements above the diagonal,
+ with the array TAU, represent the unitary matrix Q as a
+ product of elementary reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) COMPLEX*16 array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+ Details).
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(k)' . . . H(2)' H(1)', where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a complex scalar, and v is a complex vector with
+ v(1:i-1) = 0 and v(i) = 1; conjg(v(i+1:n)) is stored on exit in
+ A(i,i+1:n), and tau in TAU(i).
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ nb = ilaenv_(&c__1, "ZGELQF", " ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)
+ 1);
+ lwkopt = *m * nb;
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ lquery = *lwork == -1;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ } else if ((*lwork < max(1,*m) && ! lquery)) {
+ *info = -7;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGELQF", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ k = min(*m,*n);
+ if (k == 0) {
+ work[1].r = 1., work[1].i = 0.;
+ return 0;
+ }
+
+ nbmin = 2;
+ nx = 0;
+ iws = *m;
+ if ((nb > 1 && nb < k)) {
+
+/*
+ Determine when to cross over from blocked to unblocked code.
+
+ Computing MAX
+*/
+ i__1 = 0, i__2 = ilaenv_(&c__3, "ZGELQF", " ", m, n, &c_n1, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ nx = max(i__1,i__2);
+ if (nx < k) {
+
+/* Determine if workspace is large enough for blocked code. */
+
+ ldwork = *m;
+ iws = ldwork * nb;
+ if (*lwork < iws) {
+
+/*
+ Not enough workspace to use optimal NB: reduce NB and
+ determine the minimum value of NB.
+*/
+
+ nb = *lwork / ldwork;
+/* Computing MAX */
+ i__1 = 2, i__2 = ilaenv_(&c__2, "ZGELQF", " ", m, n, &c_n1, &
+ c_n1, (ftnlen)6, (ftnlen)1);
+ nbmin = max(i__1,i__2);
+ }
+ }
+ }
+
+ if (((nb >= nbmin && nb < k) && nx < k)) {
+
+/* Use blocked code initially */
+
+ i__1 = k - nx;
+ i__2 = nb;
+ for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+/* Computing MIN */
+ i__3 = k - i__ + 1;
+ ib = min(i__3,nb);
+
+/*
+ Compute the LQ factorization of the current block
+ A(i:i+ib-1,i:n)
+*/
+
+ i__3 = *n - i__ + 1;
+ zgelq2_(&ib, &i__3, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[
+ 1], &iinfo);
+ if (i__ + ib <= *m) {
+
+/*
+ Form the triangular factor of the block reflector
+ H = H(i) H(i+1) . . . H(i+ib-1)
+*/
+
+ i__3 = *n - i__ + 1;
+ zlarft_("Forward", "Rowwise", &i__3, &ib, &a[i__ + i__ *
+ a_dim1], lda, &tau[i__], &work[1], &ldwork);
+
+/* Apply H to A(i+ib:m,i:n) from the right */
+
+ i__3 = *m - i__ - ib + 1;
+ i__4 = *n - i__ + 1;
+ zlarfb_("Right", "No transpose", "Forward", "Rowwise", &i__3,
+ &i__4, &ib, &a[i__ + i__ * a_dim1], lda, &work[1], &
+ ldwork, &a[i__ + ib + i__ * a_dim1], lda, &work[ib +
+ 1], &ldwork);
+ }
+/* L10: */
+ }
+ } else {
+ i__ = 1;
+ }
+
+/* Use unblocked code to factor the last or only block. */
+
+ if (i__ <= k) {
+ i__2 = *m - i__ + 1;
+ i__1 = *n - i__ + 1;
+ zgelq2_(&i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1]
+ , &iinfo);
+ }
+
+ work[1].r = (doublereal) iws, work[1].i = 0.;
+ return 0;
+
+/* End of ZGELQF */
+
+} /* zgelqf_ */
+
+/* Subroutine */ int zgelsd_(integer *m, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublereal *s, doublereal *rcond, integer *rank, doublecomplex *work,
+ integer *lwork, doublereal *rwork, integer *iwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4;
+ doublereal d__1;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer ie, il, mm;
+ static doublereal eps, anrm, bnrm;
+ static integer itau, iascl, ibscl;
+ static doublereal sfmin;
+ static integer minmn, maxmn, itaup, itauq, mnthr, nwork;
+ extern /* Subroutine */ int dlabad_(doublereal *, doublereal *);
+
+ extern /* Subroutine */ int dlascl_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, integer *, doublereal *,
+ integer *, integer *), dlaset_(char *, integer *, integer
+ *, doublereal *, doublereal *, doublereal *, integer *),
+ xerbla_(char *, integer *), zgebrd_(integer *, integer *,
+ doublecomplex *, integer *, doublereal *, doublereal *,
+ doublecomplex *, doublecomplex *, doublecomplex *, integer *,
+ integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern doublereal zlange_(char *, integer *, integer *, doublecomplex *,
+ integer *, doublereal *);
+ static doublereal bignum;
+ extern /* Subroutine */ int zgelqf_(integer *, integer *, doublecomplex *,
+ integer *, doublecomplex *, doublecomplex *, integer *, integer *
+ ), zlalsd_(char *, integer *, integer *, integer *, doublereal *,
+ doublereal *, doublecomplex *, integer *, doublereal *, integer *,
+ doublecomplex *, doublereal *, integer *, integer *),
+ zlascl_(char *, integer *, integer *, doublereal *, doublereal *,
+ integer *, integer *, doublecomplex *, integer *, integer *), zgeqrf_(integer *, integer *, doublecomplex *, integer *,
+ doublecomplex *, doublecomplex *, integer *, integer *);
+ static integer ldwork;
+ extern /* Subroutine */ int zlacpy_(char *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *),
+ zlaset_(char *, integer *, integer *, doublecomplex *,
+ doublecomplex *, doublecomplex *, integer *);
+ static integer minwrk, maxwrk;
+ static doublereal smlnum;
+ extern /* Subroutine */ int zunmbr_(char *, char *, char *, integer *,
+ integer *, integer *, doublecomplex *, integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *, integer *
+ );
+ static logical lquery;
+ static integer nrwork, smlsiz;
+ extern /* Subroutine */ int zunmlq_(char *, char *, integer *, integer *,
+ integer *, doublecomplex *, integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *, integer *), zunmqr_(char *, char *, integer *, integer *,
+ integer *, doublecomplex *, integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *, integer *);
+
+
+/*
+ -- LAPACK driver routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1999
+
+
+ Purpose
+ =======
+
+ ZGELSD computes the minimum-norm solution to a real linear least
+ squares problem:
+ minimize 2-norm(| b - A*x |)
+ using the singular value decomposition (SVD) of A. A is an M-by-N
+ matrix which may be rank-deficient.
+
+ Several right hand side vectors b and solution vectors x can be
+ handled in a single call; they are stored as the columns of the
+ M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+ matrix X.
+
+ The problem is solved in three steps:
+ (1) Reduce the coefficient matrix A to bidiagonal form with
+ Householder tranformations, reducing the original problem
+ into a "bidiagonal least squares problem" (BLS)
+ (2) Solve the BLS using a divide and conquer approach.
+ (3) Apply back all the Householder tranformations to solve
+ the original least squares problem.
+
+ The effective rank of A is determined by treating as zero those
+ singular values which are less than RCOND times the largest singular
+ value.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrices B and X. NRHS >= 0.
+
+ A (input) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, A has been destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (input/output) COMPLEX*16 array, dimension (LDB,NRHS)
+ On entry, the M-by-NRHS right hand side matrix B.
+ On exit, B is overwritten by the N-by-NRHS solution matrix X.
+ If m >= n and RANK = n, the residual sum-of-squares for
+ the solution in the i-th column is given by the sum of
+ squares of elements n+1:m in that column.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,M,N).
+
+ S (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The singular values of A in decreasing order.
+ The condition number of A in the 2-norm = S(1)/S(min(m,n)).
+
+ RCOND (input) DOUBLE PRECISION
+ RCOND is used to determine the effective rank of A.
+ Singular values S(i) <= RCOND*S(1) are treated as zero.
+ If RCOND < 0, machine precision is used instead.
+
+ RANK (output) INTEGER
+ The effective rank of A, i.e., the number of singular values
+ which are greater than RCOND*S(1).
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK must be at least 1.
+ The exact minimum amount of workspace needed depends on M,
+ N and NRHS. As long as LWORK is at least
+ 2 * N + N * NRHS
+ if M is greater than or equal to N or
+ 2 * M + M * NRHS
+ if M is less than N, the code will execute correctly.
+ For good performance, LWORK should generally be larger.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ RWORK (workspace) DOUBLE PRECISION array, dimension at least
+ 10*N + 2*N*SMLSIZ + 8*N*NLVL + 3*SMLSIZ*NRHS +
+ (SMLSIZ+1)**2
+ if M is greater than or equal to N or
+ 10*M + 2*M*SMLSIZ + 8*M*NLVL + 3*SMLSIZ*NRHS +
+ (SMLSIZ+1)**2
+ if M is less than N, the code will execute correctly.
+ SMLSIZ is returned by ILAENV and is equal to the maximum
+ size of the subproblems at the bottom of the computation
+ tree (usually about 25), and
+ NLVL = MAX( 0, INT( LOG_2( MIN( M,N )/(SMLSIZ+1) ) ) + 1 )
+
+ IWORK (workspace) INTEGER array, dimension (LIWORK)
+ LIWORK >= 3 * MINMN * NLVL + 11 * MINMN,
+ where MINMN = MIN( M,N ).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: the algorithm for computing the SVD failed to converge;
+ if INFO = i, i off-diagonal elements of an intermediate
+ bidiagonal form did not converge to zero.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+
+ Test the input arguments.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ --s;
+ --work;
+ --rwork;
+ --iwork;
+
+ /* Function Body */
+ *info = 0;
+ minmn = min(*m,*n);
+ maxmn = max(*m,*n);
+ mnthr = ilaenv_(&c__6, "ZGELSD", " ", m, n, nrhs, &c_n1, (ftnlen)6, (
+ ftnlen)1);
+ lquery = *lwork == -1;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*nrhs < 0) {
+ *info = -3;
+ } else if (*lda < max(1,*m)) {
+ *info = -5;
+ } else if (*ldb < max(1,maxmn)) {
+ *info = -7;
+ }
+
+ smlsiz = ilaenv_(&c__9, "ZGELSD", " ", &c__0, &c__0, &c__0, &c__0, (
+ ftnlen)6, (ftnlen)1);
+
+/*
+ Compute workspace.
+ (Note: Comments in the code beginning "Workspace:" describe the
+ minimal amount of workspace needed at that point in the code,
+ as well as the preferred amount for good performance.
+ NB refers to the optimal block size for the immediately
+ following subroutine, as returned by ILAENV.)
+*/
+
+ minwrk = 1;
+ if (*info == 0) {
+ maxwrk = 0;
+ mm = *m;
+ if ((*m >= *n && *m >= mnthr)) {
+
+/* Path 1a - overdetermined, with many more rows than columns. */
+
+ mm = *n;
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *n * ilaenv_(&c__1, "ZGEQRF", " ", m, n, &
+ c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *nrhs * ilaenv_(&c__1, "ZUNMQR", "LC", m,
+ nrhs, n, &c_n1, (ftnlen)6, (ftnlen)2);
+ maxwrk = max(i__1,i__2);
+ }
+ if (*m >= *n) {
+
+/*
+ Path 1 - overdetermined or exactly determined.
+
+ Computing MAX
+*/
+ i__1 = maxwrk, i__2 = ((*n) << (1)) + (mm + *n) * ilaenv_(&c__1,
+ "ZGEBRD", " ", &mm, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1)
+ ;
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*n) << (1)) + *nrhs * ilaenv_(&c__1,
+ "ZUNMBR", "QLC", &mm, nrhs, n, &c_n1, (ftnlen)6, (ftnlen)
+ 3);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*n) << (1)) + (*n - 1) * ilaenv_(&c__1,
+ "ZUNMBR", "PLN", n, nrhs, n, &c_n1, (ftnlen)6, (ftnlen)3);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*n) << (1)) + *n * *nrhs;
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = ((*n) << (1)) + mm, i__2 = ((*n) << (1)) + *n * *nrhs;
+ minwrk = max(i__1,i__2);
+ }
+ if (*n > *m) {
+ if (*n >= mnthr) {
+
+/*
+ Path 2a - underdetermined, with many more columns
+ than rows.
+*/
+
+ maxwrk = *m + *m * ilaenv_(&c__1, "ZGELQF", " ", m, n, &c_n1,
+ &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *m * *m + ((*m) << (2)) + ((*m) << (1))
+ * ilaenv_(&c__1, "ZGEBRD", " ", m, m, &c_n1, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *m * *m + ((*m) << (2)) + *nrhs *
+ ilaenv_(&c__1, "ZUNMBR", "QLC", m, nrhs, m, &c_n1, (
+ ftnlen)6, (ftnlen)3);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *m * *m + ((*m) << (2)) + (*m - 1) *
+ ilaenv_(&c__1, "ZUNMLQ", "LC", n, nrhs, m, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ maxwrk = max(i__1,i__2);
+ if (*nrhs > 1) {
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *m * *m + *m + *m * *nrhs;
+ maxwrk = max(i__1,i__2);
+ } else {
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *m * *m + ((*m) << (1));
+ maxwrk = max(i__1,i__2);
+ }
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = *m * *m + ((*m) << (2)) + *m * *nrhs;
+ maxwrk = max(i__1,i__2);
+ } else {
+
+/* Path 2 - underdetermined. */
+
+ maxwrk = ((*m) << (1)) + (*n + *m) * ilaenv_(&c__1, "ZGEBRD",
+ " ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*m) << (1)) + *nrhs * ilaenv_(&c__1,
+ "ZUNMBR", "QLC", m, nrhs, m, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*m) << (1)) + *m * ilaenv_(&c__1,
+ "ZUNMBR", "PLN", n, nrhs, m, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*m) << (1)) + *m * *nrhs;
+ maxwrk = max(i__1,i__2);
+ }
+/* Computing MAX */
+ i__1 = ((*m) << (1)) + *n, i__2 = ((*m) << (1)) + *m * *nrhs;
+ minwrk = max(i__1,i__2);
+ }
+ minwrk = min(minwrk,maxwrk);
+ d__1 = (doublereal) maxwrk;
+ z__1.r = d__1, z__1.i = 0.;
+ work[1].r = z__1.r, work[1].i = z__1.i;
+ if ((*lwork < minwrk && ! lquery)) {
+ *info = -12;
+ }
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGELSD", &i__1);
+ return 0;
+ } else if (lquery) {
+ goto L10;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0) {
+ *rank = 0;
+ return 0;
+ }
+
+/* Get machine parameters. */
+
+ eps = PRECISION;
+ sfmin = SAFEMINIMUM;
+ smlnum = sfmin / eps;
+ bignum = 1. / smlnum;
+ dlabad_(&smlnum, &bignum);
+
+/* Scale A if max entry outside range [SMLNUM,BIGNUM]. */
+
+ anrm = zlange_("M", m, n, &a[a_offset], lda, &rwork[1]);
+ iascl = 0;
+ if ((anrm > 0. && anrm < smlnum)) {
+
+/* Scale matrix norm up to SMLNUM */
+
+ zlascl_("G", &c__0, &c__0, &anrm, &smlnum, m, n, &a[a_offset], lda,
+ info);
+ iascl = 1;
+ } else if (anrm > bignum) {
+
+/* Scale matrix norm down to BIGNUM. */
+
+ zlascl_("G", &c__0, &c__0, &anrm, &bignum, m, n, &a[a_offset], lda,
+ info);
+ iascl = 2;
+ } else if (anrm == 0.) {
+
+/* Matrix all zero. Return zero solution. */
+
+ i__1 = max(*m,*n);
+ zlaset_("F", &i__1, nrhs, &c_b59, &c_b59, &b[b_offset], ldb);
+ dlaset_("F", &minmn, &c__1, &c_b324, &c_b324, &s[1], &c__1)
+ ;
+ *rank = 0;
+ goto L10;
+ }
+
+/* Scale B if max entry outside range [SMLNUM,BIGNUM]. */
+
+ bnrm = zlange_("M", m, nrhs, &b[b_offset], ldb, &rwork[1]);
+ ibscl = 0;
+ if ((bnrm > 0. && bnrm < smlnum)) {
+
+/* Scale matrix norm up to SMLNUM. */
+
+ zlascl_("G", &c__0, &c__0, &bnrm, &smlnum, m, nrhs, &b[b_offset], ldb,
+ info);
+ ibscl = 1;
+ } else if (bnrm > bignum) {
+
+/* Scale matrix norm down to BIGNUM. */
+
+ zlascl_("G", &c__0, &c__0, &bnrm, &bignum, m, nrhs, &b[b_offset], ldb,
+ info);
+ ibscl = 2;
+ }
+
+/* If M < N make sure B(M+1:N,:) = 0 */
+
+ if (*m < *n) {
+ i__1 = *n - *m;
+ zlaset_("F", &i__1, nrhs, &c_b59, &c_b59, &b[*m + 1 + b_dim1], ldb);
+ }
+
+/* Overdetermined case. */
+
+ if (*m >= *n) {
+
+/* Path 1 - overdetermined or exactly determined. */
+
+ mm = *m;
+ if (*m >= mnthr) {
+
+/* Path 1a - overdetermined, with many more rows than columns */
+
+ mm = *n;
+ itau = 1;
+ nwork = itau + *n;
+
+/*
+ Compute A=Q*R.
+ (RWorkspace: need N)
+ (CWorkspace: need N, prefer N*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &i__1,
+ info);
+
+/*
+ Multiply B by transpose(Q).
+ (RWorkspace: need N)
+ (CWorkspace: need NRHS, prefer NRHS*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zunmqr_("L", "C", m, nrhs, n, &a[a_offset], lda, &work[itau], &b[
+ b_offset], ldb, &work[nwork], &i__1, info);
+
+/* Zero out below R. */
+
+ if (*n > 1) {
+ i__1 = *n - 1;
+ i__2 = *n - 1;
+ zlaset_("L", &i__1, &i__2, &c_b59, &c_b59, &a[a_dim1 + 2],
+ lda);
+ }
+ }
+
+ itauq = 1;
+ itaup = itauq + *n;
+ nwork = itaup + *n;
+ ie = 1;
+ nrwork = ie + *n;
+
+/*
+ Bidiagonalize R in A.
+ (RWorkspace: need N)
+ (CWorkspace: need 2*N+MM, prefer 2*N+(MM+N)*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zgebrd_(&mm, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[itauq], &
+ work[itaup], &work[nwork], &i__1, info);
+
+/*
+ Multiply B by transpose of left bidiagonalizing vectors of R.
+ (CWorkspace: need 2*N+NRHS, prefer 2*N+NRHS*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zunmbr_("Q", "L", "C", &mm, nrhs, n, &a[a_offset], lda, &work[itauq],
+ &b[b_offset], ldb, &work[nwork], &i__1, info);
+
+/* Solve the bidiagonal least squares problem. */
+
+ zlalsd_("U", &smlsiz, n, nrhs, &s[1], &rwork[ie], &b[b_offset], ldb,
+ rcond, rank, &work[nwork], &rwork[nrwork], &iwork[1], info);
+ if (*info != 0) {
+ goto L10;
+ }
+
+/* Multiply B by right bidiagonalizing vectors of R. */
+
+ i__1 = *lwork - nwork + 1;
+ zunmbr_("P", "L", "N", n, nrhs, n, &a[a_offset], lda, &work[itaup], &
+ b[b_offset], ldb, &work[nwork], &i__1, info);
+
+ } else /* if(complicated condition) */ {
+/* Computing MAX */
+ i__1 = *m, i__2 = ((*m) << (1)) - 4, i__1 = max(i__1,i__2), i__1 =
+ max(i__1,*nrhs), i__2 = *n - *m * 3;
+ if ((*n >= mnthr && *lwork >= ((*m) << (2)) + *m * *m + max(i__1,i__2)
+ )) {
+
+/*
+ Path 2a - underdetermined, with many more columns than rows
+ and sufficient workspace for an efficient algorithm.
+*/
+
+ ldwork = *m;
+/*
+ Computing MAX
+ Computing MAX
+*/
+ i__3 = *m, i__4 = ((*m) << (1)) - 4, i__3 = max(i__3,i__4), i__3 =
+ max(i__3,*nrhs), i__4 = *n - *m * 3;
+ i__1 = ((*m) << (2)) + *m * *lda + max(i__3,i__4), i__2 = *m * *
+ lda + *m + *m * *nrhs;
+ if (*lwork >= max(i__1,i__2)) {
+ ldwork = *lda;
+ }
+ itau = 1;
+ nwork = *m + 1;
+
+/*
+ Compute A=L*Q.
+ (CWorkspace: need 2*M, prefer M+M*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &i__1,
+ info);
+ il = nwork;
+
+/* Copy L to WORK(IL), zeroing out above its diagonal. */
+
+ zlacpy_("L", m, m, &a[a_offset], lda, &work[il], &ldwork);
+ i__1 = *m - 1;
+ i__2 = *m - 1;
+ zlaset_("U", &i__1, &i__2, &c_b59, &c_b59, &work[il + ldwork], &
+ ldwork);
+ itauq = il + ldwork * *m;
+ itaup = itauq + *m;
+ nwork = itaup + *m;
+ ie = 1;
+ nrwork = ie + *m;
+
+/*
+ Bidiagonalize L in WORK(IL).
+ (RWorkspace: need M)
+ (CWorkspace: need M*M+4*M, prefer M*M+4*M+2*M*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zgebrd_(m, m, &work[il], &ldwork, &s[1], &rwork[ie], &work[itauq],
+ &work[itaup], &work[nwork], &i__1, info);
+
+/*
+ Multiply B by transpose of left bidiagonalizing vectors of L.
+ (CWorkspace: need M*M+4*M+NRHS, prefer M*M+4*M+NRHS*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zunmbr_("Q", "L", "C", m, nrhs, m, &work[il], &ldwork, &work[
+ itauq], &b[b_offset], ldb, &work[nwork], &i__1, info);
+
+/* Solve the bidiagonal least squares problem. */
+
+ zlalsd_("U", &smlsiz, m, nrhs, &s[1], &rwork[ie], &b[b_offset],
+ ldb, rcond, rank, &work[nwork], &rwork[nrwork], &iwork[1],
+ info);
+ if (*info != 0) {
+ goto L10;
+ }
+
+/* Multiply B by right bidiagonalizing vectors of L. */
+
+ i__1 = *lwork - nwork + 1;
+ zunmbr_("P", "L", "N", m, nrhs, m, &work[il], &ldwork, &work[
+ itaup], &b[b_offset], ldb, &work[nwork], &i__1, info);
+
+/* Zero out below first M rows of B. */
+
+ i__1 = *n - *m;
+ zlaset_("F", &i__1, nrhs, &c_b59, &c_b59, &b[*m + 1 + b_dim1],
+ ldb);
+ nwork = itau + *m;
+
+/*
+ Multiply transpose(Q) by B.
+ (CWorkspace: need NRHS, prefer NRHS*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zunmlq_("L", "C", n, nrhs, m, &a[a_offset], lda, &work[itau], &b[
+ b_offset], ldb, &work[nwork], &i__1, info);
+
+ } else {
+
+/* Path 2 - remaining underdetermined cases. */
+
+ itauq = 1;
+ itaup = itauq + *m;
+ nwork = itaup + *m;
+ ie = 1;
+ nrwork = ie + *m;
+
+/*
+ Bidiagonalize A.
+ (RWorkspace: need M)
+ (CWorkspace: need 2*M+N, prefer 2*M+(M+N)*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zgebrd_(m, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[itauq],
+ &work[itaup], &work[nwork], &i__1, info);
+
+/*
+ Multiply B by transpose of left bidiagonalizing vectors.
+ (CWorkspace: need 2*M+NRHS, prefer 2*M+NRHS*NB)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zunmbr_("Q", "L", "C", m, nrhs, n, &a[a_offset], lda, &work[itauq]
+ , &b[b_offset], ldb, &work[nwork], &i__1, info);
+
+/* Solve the bidiagonal least squares problem. */
+
+ zlalsd_("L", &smlsiz, m, nrhs, &s[1], &rwork[ie], &b[b_offset],
+ ldb, rcond, rank, &work[nwork], &rwork[nrwork], &iwork[1],
+ info);
+ if (*info != 0) {
+ goto L10;
+ }
+
+/* Multiply B by right bidiagonalizing vectors of A. */
+
+ i__1 = *lwork - nwork + 1;
+ zunmbr_("P", "L", "N", n, nrhs, m, &a[a_offset], lda, &work[itaup]
+ , &b[b_offset], ldb, &work[nwork], &i__1, info);
+
+ }
+ }
+
+/* Undo scaling. */
+
+ if (iascl == 1) {
+ zlascl_("G", &c__0, &c__0, &anrm, &smlnum, n, nrhs, &b[b_offset], ldb,
+ info);
+ dlascl_("G", &c__0, &c__0, &smlnum, &anrm, &minmn, &c__1, &s[1], &
+ minmn, info);
+ } else if (iascl == 2) {
+ zlascl_("G", &c__0, &c__0, &anrm, &bignum, n, nrhs, &b[b_offset], ldb,
+ info);
+ dlascl_("G", &c__0, &c__0, &bignum, &anrm, &minmn, &c__1, &s[1], &
+ minmn, info);
+ }
+ if (ibscl == 1) {
+ zlascl_("G", &c__0, &c__0, &smlnum, &bnrm, n, nrhs, &b[b_offset], ldb,
+ info);
+ } else if (ibscl == 2) {
+ zlascl_("G", &c__0, &c__0, &bignum, &bnrm, n, nrhs, &b[b_offset], ldb,
+ info);
+ }
+
+L10:
+ d__1 = (doublereal) maxwrk;
+ z__1.r = d__1, z__1.i = 0.;
+ work[1].r = z__1.r, work[1].i = z__1.i;
+ return 0;
+
+/* End of ZGELSD */
+
+} /* zgelsd_ */
+
+/* Subroutine */ int zgeqr2_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+ doublecomplex z__1;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, k;
+ static doublecomplex alpha;
+ extern /* Subroutine */ int zlarf_(char *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *, doublecomplex *), xerbla_(char *, integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *,
+ integer *, doublecomplex *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZGEQR2 computes a QR factorization of a complex m by n matrix A:
+ A = Q * R.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, the elements on and above the diagonal of the array
+ contain the min(m,n) by n upper trapezoidal matrix R (R is
+ upper triangular if m >= n); the elements below the diagonal,
+ with the array TAU, represent the unitary matrix Q as a
+ product of elementary reflectors (see Further Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) COMPLEX*16 array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+ Details).
+
+ WORK (workspace) COMPLEX*16 array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a complex scalar, and v is a complex vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
+ and tau in TAU(i).
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGEQR2", &i__1);
+ return 0;
+ }
+
+ k = min(*m,*n);
+
+ i__1 = k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/* Generate elementary reflector H(i) to annihilate A(i+1:m,i) */
+
+ i__2 = *m - i__ + 1;
+/* Computing MIN */
+ i__3 = i__ + 1;
+ zlarfg_(&i__2, &a[i__ + i__ * a_dim1], &a[min(i__3,*m) + i__ * a_dim1]
+ , &c__1, &tau[i__]);
+ if (i__ < *n) {
+
+/* Apply H(i)' to A(i:m,i+1:n) from the left */
+
+ i__2 = i__ + i__ * a_dim1;
+ alpha.r = a[i__2].r, alpha.i = a[i__2].i;
+ i__2 = i__ + i__ * a_dim1;
+ a[i__2].r = 1., a[i__2].i = 0.;
+ i__2 = *m - i__ + 1;
+ i__3 = *n - i__;
+ d_cnjg(&z__1, &tau[i__]);
+ zlarf_("Left", &i__2, &i__3, &a[i__ + i__ * a_dim1], &c__1, &z__1,
+ &a[i__ + (i__ + 1) * a_dim1], lda, &work[1]);
+ i__2 = i__ + i__ * a_dim1;
+ a[i__2].r = alpha.r, a[i__2].i = alpha.i;
+ }
+/* L10: */
+ }
+ return 0;
+
+/* End of ZGEQR2 */
+
+} /* zgeqr2_ */
+
+/* Subroutine */ int zgeqrf_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork,
+ integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+
+ /* Local variables */
+ static integer i__, k, ib, nb, nx, iws, nbmin, iinfo;
+ extern /* Subroutine */ int zgeqr2_(integer *, integer *, doublecomplex *,
+ integer *, doublecomplex *, doublecomplex *, integer *), xerbla_(
+ char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *,
+ integer *, integer *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *);
+ static integer ldwork;
+ extern /* Subroutine */ int zlarft_(char *, char *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *);
+ static integer lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZGEQRF computes a QR factorization of a complex M-by-N matrix A:
+ A = Q * R.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit, the elements on and above the diagonal of the array
+ contain the min(M,N)-by-N upper trapezoidal matrix R (R is
+ upper triangular if m >= n); the elements below the diagonal,
+ with the array TAU, represent the unitary matrix Q as a
+ product of min(m,n) elementary reflectors (see Further
+ Details).
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ TAU (output) COMPLEX*16 array, dimension (min(M,N))
+ The scalar factors of the elementary reflectors (see Further
+ Details).
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of elementary reflectors
+
+ Q = H(1) H(2) . . . H(k), where k = min(m,n).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a complex scalar, and v is a complex vector with
+ v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
+ and tau in TAU(i).
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ nb = ilaenv_(&c__1, "ZGEQRF", " ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)
+ 1);
+ lwkopt = *n * nb;
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ lquery = *lwork == -1;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ } else if ((*lwork < max(1,*n) && ! lquery)) {
+ *info = -7;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGEQRF", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ k = min(*m,*n);
+ if (k == 0) {
+ work[1].r = 1., work[1].i = 0.;
+ return 0;
+ }
+
+ nbmin = 2;
+ nx = 0;
+ iws = *n;
+ if ((nb > 1 && nb < k)) {
+
+/*
+ Determine when to cross over from blocked to unblocked code.
+
+ Computing MAX
+*/
+ i__1 = 0, i__2 = ilaenv_(&c__3, "ZGEQRF", " ", m, n, &c_n1, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ nx = max(i__1,i__2);
+ if (nx < k) {
+
+/* Determine if workspace is large enough for blocked code. */
+
+ ldwork = *n;
+ iws = ldwork * nb;
+ if (*lwork < iws) {
+
+/*
+ Not enough workspace to use optimal NB: reduce NB and
+ determine the minimum value of NB.
+*/
+
+ nb = *lwork / ldwork;
+/* Computing MAX */
+ i__1 = 2, i__2 = ilaenv_(&c__2, "ZGEQRF", " ", m, n, &c_n1, &
+ c_n1, (ftnlen)6, (ftnlen)1);
+ nbmin = max(i__1,i__2);
+ }
+ }
+ }
+
+ if (((nb >= nbmin && nb < k) && nx < k)) {
+
+/* Use blocked code initially */
+
+ i__1 = k - nx;
+ i__2 = nb;
+ for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+/* Computing MIN */
+ i__3 = k - i__ + 1;
+ ib = min(i__3,nb);
+
+/*
+ Compute the QR factorization of the current block
+ A(i:m,i:i+ib-1)
+*/
+
+ i__3 = *m - i__ + 1;
+ zgeqr2_(&i__3, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[
+ 1], &iinfo);
+ if (i__ + ib <= *n) {
+
+/*
+ Form the triangular factor of the block reflector
+ H = H(i) H(i+1) . . . H(i+ib-1)
+*/
+
+ i__3 = *m - i__ + 1;
+ zlarft_("Forward", "Columnwise", &i__3, &ib, &a[i__ + i__ *
+ a_dim1], lda, &tau[i__], &work[1], &ldwork);
+
+/* Apply H' to A(i:m,i+ib:n) from the left */
+
+ i__3 = *m - i__ + 1;
+ i__4 = *n - i__ - ib + 1;
+ zlarfb_("Left", "Conjugate transpose", "Forward", "Columnwise"
+ , &i__3, &i__4, &ib, &a[i__ + i__ * a_dim1], lda, &
+ work[1], &ldwork, &a[i__ + (i__ + ib) * a_dim1], lda,
+ &work[ib + 1], &ldwork);
+ }
+/* L10: */
+ }
+ } else {
+ i__ = 1;
+ }
+
+/* Use unblocked code to factor the last or only block. */
+
+ if (i__ <= k) {
+ i__2 = *m - i__ + 1;
+ i__1 = *n - i__ + 1;
+ zgeqr2_(&i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1]
+ , &iinfo);
+ }
+
+ work[1].r = (doublereal) iws, work[1].i = 0.;
+ return 0;
+
+/* End of ZGEQRF */
+
+} /* zgeqrf_ */
+
+/* Subroutine */ int zgesdd_(char *jobz, integer *m, integer *n,
+ doublecomplex *a, integer *lda, doublereal *s, doublecomplex *u,
+ integer *ldu, doublecomplex *vt, integer *ldvt, doublecomplex *work,
+ integer *lwork, doublereal *rwork, integer *iwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1,
+ i__2, i__3;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static integer i__, ie, il, ir, iu, blk;
+ static doublereal dum[1], eps;
+ static integer iru, ivt, iscl;
+ static doublereal anrm;
+ static integer idum[1], ierr, itau, irvt;
+ extern logical lsame_(char *, char *);
+ static integer chunk, minmn;
+ extern /* Subroutine */ int zgemm_(char *, char *, integer *, integer *,
+ integer *, doublecomplex *, doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *);
+ static integer wrkbl, itaup, itauq;
+ static logical wntqa;
+ static integer nwork;
+ static logical wntqn, wntqo, wntqs;
+ extern /* Subroutine */ int zlacp2_(char *, integer *, integer *,
+ doublereal *, integer *, doublecomplex *, integer *);
+ static integer mnthr1, mnthr2;
+ extern /* Subroutine */ int dbdsdc_(char *, char *, integer *, doublereal
+ *, doublereal *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, integer *, integer *);
+
+ extern /* Subroutine */ int dlascl_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, integer *, doublereal *,
+ integer *, integer *), xerbla_(char *, integer *),
+ zgebrd_(integer *, integer *, doublecomplex *, integer *,
+ doublereal *, doublereal *, doublecomplex *, doublecomplex *,
+ doublecomplex *, integer *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static doublereal bignum;
+ extern doublereal zlange_(char *, integer *, integer *, doublecomplex *,
+ integer *, doublereal *);
+ extern /* Subroutine */ int zgelqf_(integer *, integer *, doublecomplex *,
+ integer *, doublecomplex *, doublecomplex *, integer *, integer *
+ ), zlacrm_(integer *, integer *, doublecomplex *, integer *,
+ doublereal *, integer *, doublecomplex *, integer *, doublereal *)
+ , zlarcm_(integer *, integer *, doublereal *, integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *,
+ doublereal *), zlascl_(char *, integer *, integer *, doublereal *,
+ doublereal *, integer *, integer *, doublecomplex *, integer *,
+ integer *), zgeqrf_(integer *, integer *, doublecomplex *,
+ integer *, doublecomplex *, doublecomplex *, integer *, integer *
+ );
+ static integer ldwrkl;
+ extern /* Subroutine */ int zlacpy_(char *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *),
+ zlaset_(char *, integer *, integer *, doublecomplex *,
+ doublecomplex *, doublecomplex *, integer *);
+ static integer ldwrkr, minwrk, ldwrku, maxwrk;
+ extern /* Subroutine */ int zungbr_(char *, integer *, integer *, integer
+ *, doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *, integer *);
+ static integer ldwkvt;
+ static doublereal smlnum;
+ static logical wntqas;
+ extern /* Subroutine */ int zunmbr_(char *, char *, char *, integer *,
+ integer *, integer *, doublecomplex *, integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *, integer *
+ ), zunglq_(integer *, integer *, integer *
+ , doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *, integer *);
+ static logical lquery;
+ static integer nrwork;
+ extern /* Subroutine */ int zungqr_(integer *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *, integer *);
+
+
+/*
+ -- LAPACK driver routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1999
+
+
+ Purpose
+ =======
+
+ ZGESDD computes the singular value decomposition (SVD) of a complex
+ M-by-N matrix A, optionally computing the left and/or right singular
+ vectors, by using divide-and-conquer method. The SVD is written
+
+ A = U * SIGMA * conjugate-transpose(V)
+
+ where SIGMA is an M-by-N matrix which is zero except for its
+ min(m,n) diagonal elements, U is an M-by-M unitary matrix, and
+ V is an N-by-N unitary matrix. The diagonal elements of SIGMA
+ are the singular values of A; they are real and non-negative, and
+ are returned in descending order. The first min(m,n) columns of
+ U and V are the left and right singular vectors of A.
+
+ Note that the routine returns VT = V**H, not V.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ Specifies options for computing all or part of the matrix U:
+ = 'A': all M columns of U and all N rows of V**H are
+ returned in the arrays U and VT;
+ = 'S': the first min(M,N) columns of U and the first
+ min(M,N) rows of V**H are returned in the arrays U
+ and VT;
+ = 'O': If M >= N, the first N columns of U are overwritten
+ on the array A and all rows of V**H are returned in
+ the array VT;
+ otherwise, all columns of U are returned in the
+ array U and the first M rows of V**H are overwritten
+ in the array VT;
+ = 'N': no columns of U or rows of V**H are computed.
+
+ M (input) INTEGER
+ The number of rows of the input matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the input matrix A. N >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the M-by-N matrix A.
+ On exit,
+ if JOBZ = 'O', A is overwritten with the first N columns
+ of U (the left singular vectors, stored
+ columnwise) if M >= N;
+ A is overwritten with the first M rows
+ of V**H (the right singular vectors, stored
+ rowwise) otherwise.
+ if JOBZ .ne. 'O', the contents of A are destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ S (output) DOUBLE PRECISION array, dimension (min(M,N))
+ The singular values of A, sorted so that S(i) >= S(i+1).
+
+ U (output) COMPLEX*16 array, dimension (LDU,UCOL)
+ UCOL = M if JOBZ = 'A' or JOBZ = 'O' and M < N;
+ UCOL = min(M,N) if JOBZ = 'S'.
+ If JOBZ = 'A' or JOBZ = 'O' and M < N, U contains the M-by-M
+ unitary matrix U;
+ if JOBZ = 'S', U contains the first min(M,N) columns of U
+ (the left singular vectors, stored columnwise);
+ if JOBZ = 'O' and M >= N, or JOBZ = 'N', U is not referenced.
+
+ LDU (input) INTEGER
+ The leading dimension of the array U. LDU >= 1; if
+ JOBZ = 'S' or 'A' or JOBZ = 'O' and M < N, LDU >= M.
+
+ VT (output) COMPLEX*16 array, dimension (LDVT,N)
+ If JOBZ = 'A' or JOBZ = 'O' and M >= N, VT contains the
+ N-by-N unitary matrix V**H;
+ if JOBZ = 'S', VT contains the first min(M,N) rows of
+ V**H (the right singular vectors, stored rowwise);
+ if JOBZ = 'O' and M < N, or JOBZ = 'N', VT is not referenced.
+
+ LDVT (input) INTEGER
+ The leading dimension of the array VT. LDVT >= 1; if
+ JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N;
+ if JOBZ = 'S', LDVT >= min(M,N).
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 1.
+ if JOBZ = 'N', LWORK >= 2*min(M,N)+max(M,N).
+ if JOBZ = 'O',
+ LWORK >= 2*min(M,N)*min(M,N)+2*min(M,N)+max(M,N).
+ if JOBZ = 'S' or 'A',
+ LWORK >= min(M,N)*min(M,N)+2*min(M,N)+max(M,N).
+ For good performance, LWORK should generally be larger.
+ If LWORK < 0 but other input arguments are legal, WORK(1)
+ returns the optimal LWORK.
+
+ RWORK (workspace) DOUBLE PRECISION array, dimension (LRWORK)
+ If JOBZ = 'N', LRWORK >= 7*min(M,N).
+ Otherwise, LRWORK >= 5*min(M,N)*min(M,N) + 5*min(M,N)
+
+ IWORK (workspace) INTEGER array, dimension (8*min(M,N))
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The updating process of DBDSDC did not converge.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Huan Ren, Computer Science Division, University of
+ California at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --s;
+ u_dim1 = *ldu;
+ u_offset = 1 + u_dim1 * 1;
+ u -= u_offset;
+ vt_dim1 = *ldvt;
+ vt_offset = 1 + vt_dim1 * 1;
+ vt -= vt_offset;
+ --work;
+ --rwork;
+ --iwork;
+
+ /* Function Body */
+ *info = 0;
+ minmn = min(*m,*n);
+ mnthr1 = (integer) (minmn * 17. / 9.);
+ mnthr2 = (integer) (minmn * 5. / 3.);
+ wntqa = lsame_(jobz, "A");
+ wntqs = lsame_(jobz, "S");
+ wntqas = wntqa || wntqs;
+ wntqo = lsame_(jobz, "O");
+ wntqn = lsame_(jobz, "N");
+ minwrk = 1;
+ maxwrk = 1;
+ lquery = *lwork == -1;
+
+ if (! (wntqa || wntqs || wntqo || wntqn)) {
+ *info = -1;
+ } else if (*m < 0) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*lda < max(1,*m)) {
+ *info = -5;
+ } else if (*ldu < 1 || (wntqas && *ldu < *m) || ((wntqo && *m < *n) && *
+ ldu < *m)) {
+ *info = -8;
+ } else if (*ldvt < 1 || (wntqa && *ldvt < *n) || (wntqs && *ldvt < minmn)
+ || ((wntqo && *m >= *n) && *ldvt < *n)) {
+ *info = -10;
+ }
+
+/*
+ Compute workspace
+ (Note: Comments in the code beginning "Workspace:" describe the
+ minimal amount of workspace needed at that point in the code,
+ as well as the preferred amount for good performance.
+ CWorkspace refers to complex workspace, and RWorkspace to
+ real workspace. NB refers to the optimal block size for the
+ immediately following subroutine, as returned by ILAENV.)
+*/
+
+ if (((*info == 0 && *m > 0) && *n > 0)) {
+ if (*m >= *n) {
+
+/*
+ There is no complex work space needed for bidiagonal SVD
+ The real work space needed for bidiagonal SVD is BDSPAC,
+ BDSPAC = 3*N*N + 4*N
+*/
+
+ if (*m >= mnthr1) {
+ if (wntqn) {
+
+/* Path 1 (M much larger than N, JOBZ='N') */
+
+ wrkbl = *n + *n * ilaenv_(&c__1, "ZGEQRF", " ", m, n, &
+ c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = ((*n) << (1)) + ((*n) << (1)) *
+ ilaenv_(&c__1, "ZGEBRD", " ", n, n, &c_n1, &c_n1,
+ (ftnlen)6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+ maxwrk = wrkbl;
+ minwrk = *n * 3;
+ } else if (wntqo) {
+
+/* Path 2 (M much larger than N, JOBZ='O') */
+
+ wrkbl = *n + *n * ilaenv_(&c__1, "ZGEQRF", " ", m, n, &
+ c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n + *n * ilaenv_(&c__1, "ZUNGQR",
+ " ", m, n, n, &c_n1, (ftnlen)6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = ((*n) << (1)) + ((*n) << (1)) *
+ ilaenv_(&c__1, "ZGEBRD", " ", n, n, &c_n1, &c_n1,
+ (ftnlen)6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = ((*n) << (1)) + *n * ilaenv_(&c__1,
+ "ZUNMBR", "QLN", n, n, n, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = ((*n) << (1)) + *n * ilaenv_(&c__1,
+ "ZUNMBR", "PRC", n, n, n, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ wrkbl = max(i__1,i__2);
+ maxwrk = *m * *n + *n * *n + wrkbl;
+ minwrk = ((*n) << (1)) * *n + *n * 3;
+ } else if (wntqs) {
+
+/* Path 3 (M much larger than N, JOBZ='S') */
+
+ wrkbl = *n + *n * ilaenv_(&c__1, "ZGEQRF", " ", m, n, &
+ c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n + *n * ilaenv_(&c__1, "ZUNGQR",
+ " ", m, n, n, &c_n1, (ftnlen)6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = ((*n) << (1)) + ((*n) << (1)) *
+ ilaenv_(&c__1, "ZGEBRD", " ", n, n, &c_n1, &c_n1,
+ (ftnlen)6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = ((*n) << (1)) + *n * ilaenv_(&c__1,
+ "ZUNMBR", "QLN", n, n, n, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = ((*n) << (1)) + *n * ilaenv_(&c__1,
+ "ZUNMBR", "PRC", n, n, n, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ wrkbl = max(i__1,i__2);
+ maxwrk = *n * *n + wrkbl;
+ minwrk = *n * *n + *n * 3;
+ } else if (wntqa) {
+
+/* Path 4 (M much larger than N, JOBZ='A') */
+
+ wrkbl = *n + *n * ilaenv_(&c__1, "ZGEQRF", " ", m, n, &
+ c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *n + *m * ilaenv_(&c__1, "ZUNGQR",
+ " ", m, m, n, &c_n1, (ftnlen)6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = ((*n) << (1)) + ((*n) << (1)) *
+ ilaenv_(&c__1, "ZGEBRD", " ", n, n, &c_n1, &c_n1,
+ (ftnlen)6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = ((*n) << (1)) + *n * ilaenv_(&c__1,
+ "ZUNMBR", "QLN", n, n, n, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = ((*n) << (1)) + *n * ilaenv_(&c__1,
+ "ZUNMBR", "PRC", n, n, n, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ wrkbl = max(i__1,i__2);
+ maxwrk = *n * *n + wrkbl;
+ minwrk = *n * *n + ((*n) << (1)) + *m;
+ }
+ } else if (*m >= mnthr2) {
+
+/* Path 5 (M much larger than N, but not as much as MNTHR1) */
+
+ maxwrk = ((*n) << (1)) + (*m + *n) * ilaenv_(&c__1, "ZGEBRD",
+ " ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+ minwrk = ((*n) << (1)) + *m;
+ if (wntqo) {
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*n) << (1)) + *n * ilaenv_(&c__1,
+ "ZUNGBR", "P", n, n, n, &c_n1, (ftnlen)6, (ftnlen)
+ 1);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*n) << (1)) + *n * ilaenv_(&c__1,
+ "ZUNGBR", "Q", m, n, n, &c_n1, (ftnlen)6, (ftnlen)
+ 1);
+ maxwrk = max(i__1,i__2);
+ maxwrk += *m * *n;
+ minwrk += *n * *n;
+ } else if (wntqs) {
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*n) << (1)) + *n * ilaenv_(&c__1,
+ "ZUNGBR", "P", n, n, n, &c_n1, (ftnlen)6, (ftnlen)
+ 1);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*n) << (1)) + *n * ilaenv_(&c__1,
+ "ZUNGBR", "Q", m, n, n, &c_n1, (ftnlen)6, (ftnlen)
+ 1);
+ maxwrk = max(i__1,i__2);
+ } else if (wntqa) {
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*n) << (1)) + *n * ilaenv_(&c__1,
+ "ZUNGBR", "P", n, n, n, &c_n1, (ftnlen)6, (ftnlen)
+ 1);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*n) << (1)) + *m * ilaenv_(&c__1,
+ "ZUNGBR", "Q", m, m, n, &c_n1, (ftnlen)6, (ftnlen)
+ 1);
+ maxwrk = max(i__1,i__2);
+ }
+ } else {
+
+/* Path 6 (M at least N, but not much larger) */
+
+ maxwrk = ((*n) << (1)) + (*m + *n) * ilaenv_(&c__1, "ZGEBRD",
+ " ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+ minwrk = ((*n) << (1)) + *m;
+ if (wntqo) {
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*n) << (1)) + *n * ilaenv_(&c__1,
+ "ZUNMBR", "PRC", n, n, n, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*n) << (1)) + *n * ilaenv_(&c__1,
+ "ZUNMBR", "QLN", m, n, n, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ maxwrk = max(i__1,i__2);
+ maxwrk += *m * *n;
+ minwrk += *n * *n;
+ } else if (wntqs) {
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*n) << (1)) + *n * ilaenv_(&c__1,
+ "ZUNMBR", "PRC", n, n, n, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*n) << (1)) + *n * ilaenv_(&c__1,
+ "ZUNMBR", "QLN", m, n, n, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ maxwrk = max(i__1,i__2);
+ } else if (wntqa) {
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*n) << (1)) + *n * ilaenv_(&c__1,
+ "ZUNGBR", "PRC", n, n, n, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*n) << (1)) + *m * ilaenv_(&c__1,
+ "ZUNGBR", "QLN", m, m, n, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ maxwrk = max(i__1,i__2);
+ }
+ }
+ } else {
+
+/*
+ There is no complex work space needed for bidiagonal SVD
+ The real work space needed for bidiagonal SVD is BDSPAC,
+ BDSPAC = 3*M*M + 4*M
+*/
+
+ if (*n >= mnthr1) {
+ if (wntqn) {
+
+/* Path 1t (N much larger than M, JOBZ='N') */
+
+ maxwrk = *m + *m * ilaenv_(&c__1, "ZGELQF", " ", m, n, &
+ c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*m) << (1)) + ((*m) << (1)) *
+ ilaenv_(&c__1, "ZGEBRD", " ", m, m, &c_n1, &c_n1,
+ (ftnlen)6, (ftnlen)1);
+ maxwrk = max(i__1,i__2);
+ minwrk = *m * 3;
+ } else if (wntqo) {
+
+/* Path 2t (N much larger than M, JOBZ='O') */
+
+ wrkbl = *m + *m * ilaenv_(&c__1, "ZGELQF", " ", m, n, &
+ c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m + *m * ilaenv_(&c__1, "ZUNGLQ",
+ " ", m, n, m, &c_n1, (ftnlen)6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = ((*m) << (1)) + ((*m) << (1)) *
+ ilaenv_(&c__1, "ZGEBRD", " ", m, m, &c_n1, &c_n1,
+ (ftnlen)6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = ((*m) << (1)) + *m * ilaenv_(&c__1,
+ "ZUNMBR", "PRC", m, m, m, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = ((*m) << (1)) + *m * ilaenv_(&c__1,
+ "ZUNMBR", "QLN", m, m, m, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ wrkbl = max(i__1,i__2);
+ maxwrk = *m * *n + *m * *m + wrkbl;
+ minwrk = ((*m) << (1)) * *m + *m * 3;
+ } else if (wntqs) {
+
+/* Path 3t (N much larger than M, JOBZ='S') */
+
+ wrkbl = *m + *m * ilaenv_(&c__1, "ZGELQF", " ", m, n, &
+ c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m + *m * ilaenv_(&c__1, "ZUNGLQ",
+ " ", m, n, m, &c_n1, (ftnlen)6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = ((*m) << (1)) + ((*m) << (1)) *
+ ilaenv_(&c__1, "ZGEBRD", " ", m, m, &c_n1, &c_n1,
+ (ftnlen)6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = ((*m) << (1)) + *m * ilaenv_(&c__1,
+ "ZUNMBR", "PRC", m, m, m, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = ((*m) << (1)) + *m * ilaenv_(&c__1,
+ "ZUNMBR", "QLN", m, m, m, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ wrkbl = max(i__1,i__2);
+ maxwrk = *m * *m + wrkbl;
+ minwrk = *m * *m + *m * 3;
+ } else if (wntqa) {
+
+/* Path 4t (N much larger than M, JOBZ='A') */
+
+ wrkbl = *m + *m * ilaenv_(&c__1, "ZGELQF", " ", m, n, &
+ c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = *m + *n * ilaenv_(&c__1, "ZUNGLQ",
+ " ", n, n, m, &c_n1, (ftnlen)6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = ((*m) << (1)) + ((*m) << (1)) *
+ ilaenv_(&c__1, "ZGEBRD", " ", m, m, &c_n1, &c_n1,
+ (ftnlen)6, (ftnlen)1);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = ((*m) << (1)) + *m * ilaenv_(&c__1,
+ "ZUNMBR", "PRC", m, m, m, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ wrkbl = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = wrkbl, i__2 = ((*m) << (1)) + *m * ilaenv_(&c__1,
+ "ZUNMBR", "QLN", m, m, m, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ wrkbl = max(i__1,i__2);
+ maxwrk = *m * *m + wrkbl;
+ minwrk = *m * *m + ((*m) << (1)) + *n;
+ }
+ } else if (*n >= mnthr2) {
+
+/* Path 5t (N much larger than M, but not as much as MNTHR1) */
+
+ maxwrk = ((*m) << (1)) + (*m + *n) * ilaenv_(&c__1, "ZGEBRD",
+ " ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+ minwrk = ((*m) << (1)) + *n;
+ if (wntqo) {
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*m) << (1)) + *m * ilaenv_(&c__1,
+ "ZUNGBR", "P", m, n, m, &c_n1, (ftnlen)6, (ftnlen)
+ 1);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*m) << (1)) + *m * ilaenv_(&c__1,
+ "ZUNGBR", "Q", m, m, n, &c_n1, (ftnlen)6, (ftnlen)
+ 1);
+ maxwrk = max(i__1,i__2);
+ maxwrk += *m * *n;
+ minwrk += *m * *m;
+ } else if (wntqs) {
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*m) << (1)) + *m * ilaenv_(&c__1,
+ "ZUNGBR", "P", m, n, m, &c_n1, (ftnlen)6, (ftnlen)
+ 1);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*m) << (1)) + *m * ilaenv_(&c__1,
+ "ZUNGBR", "Q", m, m, n, &c_n1, (ftnlen)6, (ftnlen)
+ 1);
+ maxwrk = max(i__1,i__2);
+ } else if (wntqa) {
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*m) << (1)) + *n * ilaenv_(&c__1,
+ "ZUNGBR", "P", n, n, m, &c_n1, (ftnlen)6, (ftnlen)
+ 1);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*m) << (1)) + *m * ilaenv_(&c__1,
+ "ZUNGBR", "Q", m, m, n, &c_n1, (ftnlen)6, (ftnlen)
+ 1);
+ maxwrk = max(i__1,i__2);
+ }
+ } else {
+
+/* Path 6t (N greater than M, but not much larger) */
+
+ maxwrk = ((*m) << (1)) + (*m + *n) * ilaenv_(&c__1, "ZGEBRD",
+ " ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+ minwrk = ((*m) << (1)) + *n;
+ if (wntqo) {
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*m) << (1)) + *m * ilaenv_(&c__1,
+ "ZUNMBR", "PRC", m, n, m, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*m) << (1)) + *m * ilaenv_(&c__1,
+ "ZUNMBR", "QLN", m, m, n, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ maxwrk = max(i__1,i__2);
+ maxwrk += *m * *n;
+ minwrk += *m * *m;
+ } else if (wntqs) {
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*m) << (1)) + *m * ilaenv_(&c__1,
+ "ZUNGBR", "PRC", m, n, m, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*m) << (1)) + *m * ilaenv_(&c__1,
+ "ZUNGBR", "QLN", m, m, n, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ maxwrk = max(i__1,i__2);
+ } else if (wntqa) {
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*m) << (1)) + *n * ilaenv_(&c__1,
+ "ZUNGBR", "PRC", n, n, m, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ maxwrk = max(i__1,i__2);
+/* Computing MAX */
+ i__1 = maxwrk, i__2 = ((*m) << (1)) + *m * ilaenv_(&c__1,
+ "ZUNGBR", "QLN", m, m, n, &c_n1, (ftnlen)6, (
+ ftnlen)3);
+ maxwrk = max(i__1,i__2);
+ }
+ }
+ }
+ maxwrk = max(maxwrk,minwrk);
+ work[1].r = (doublereal) maxwrk, work[1].i = 0.;
+ }
+
+ if ((*lwork < minwrk && ! lquery)) {
+ *info = -13;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGESDD", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0) {
+ if (*lwork >= 1) {
+ work[1].r = 1., work[1].i = 0.;
+ }
+ return 0;
+ }
+
+/* Get machine constants */
+
+ eps = PRECISION;
+ smlnum = sqrt(SAFEMINIMUM) / eps;
+ bignum = 1. / smlnum;
+
+/* Scale A if max element outside range [SMLNUM,BIGNUM] */
+
+ anrm = zlange_("M", m, n, &a[a_offset], lda, dum);
+ iscl = 0;
+ if ((anrm > 0. && anrm < smlnum)) {
+ iscl = 1;
+ zlascl_("G", &c__0, &c__0, &anrm, &smlnum, m, n, &a[a_offset], lda, &
+ ierr);
+ } else if (anrm > bignum) {
+ iscl = 1;
+ zlascl_("G", &c__0, &c__0, &anrm, &bignum, m, n, &a[a_offset], lda, &
+ ierr);
+ }
+
+ if (*m >= *n) {
+
+/*
+ A has at least as many rows as columns. If A has sufficiently
+ more rows than columns, first reduce using the QR
+ decomposition (if sufficient workspace available)
+*/
+
+ if (*m >= mnthr1) {
+
+ if (wntqn) {
+
+/*
+ Path 1 (M much larger than N, JOBZ='N')
+ No singular vectors to be computed
+*/
+
+ itau = 1;
+ nwork = itau + *n;
+
+/*
+ Compute A=Q*R
+ (CWorkspace: need 2*N, prefer N+N*NB)
+ (RWorkspace: need 0)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
+ i__1, &ierr);
+
+/* Zero out below R */
+
+ i__1 = *n - 1;
+ i__2 = *n - 1;
+ zlaset_("L", &i__1, &i__2, &c_b59, &c_b59, &a[a_dim1 + 2],
+ lda);
+ ie = 1;
+ itauq = 1;
+ itaup = itauq + *n;
+ nwork = itaup + *n;
+
+/*
+ Bidiagonalize R in A
+ (CWorkspace: need 3*N, prefer 2*N+2*N*NB)
+ (RWorkspace: need N)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zgebrd_(n, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[
+ itauq], &work[itaup], &work[nwork], &i__1, &ierr);
+ nrwork = ie + *n;
+
+/*
+ Perform bidiagonal SVD, compute singular values only
+ (CWorkspace: 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ dbdsdc_("U", "N", n, &s[1], &rwork[ie], dum, &c__1, dum, &
+ c__1, dum, idum, &rwork[nrwork], &iwork[1], info);
+
+ } else if (wntqo) {
+
+/*
+ Path 2 (M much larger than N, JOBZ='O')
+ N left singular vectors to be overwritten on A and
+ N right singular vectors to be computed in VT
+*/
+
+ iu = 1;
+
+/* WORK(IU) is N by N */
+
+ ldwrku = *n;
+ ir = iu + ldwrku * *n;
+ if (*lwork >= *m * *n + *n * *n + *n * 3) {
+
+/* WORK(IR) is M by N */
+
+ ldwrkr = *m;
+ } else {
+ ldwrkr = (*lwork - *n * *n - *n * 3) / *n;
+ }
+ itau = ir + ldwrkr * *n;
+ nwork = itau + *n;
+
+/*
+ Compute A=Q*R
+ (CWorkspace: need N*N+2*N, prefer M*N+N+N*NB)
+ (RWorkspace: 0)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
+ i__1, &ierr);
+
+/* Copy R to WORK( IR ), zeroing out below it */
+
+ zlacpy_("U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr);
+ i__1 = *n - 1;
+ i__2 = *n - 1;
+ zlaset_("L", &i__1, &i__2, &c_b59, &c_b59, &work[ir + 1], &
+ ldwrkr);
+
+/*
+ Generate Q in A
+ (CWorkspace: need 2*N, prefer N+N*NB)
+ (RWorkspace: 0)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zungqr_(m, n, n, &a[a_offset], lda, &work[itau], &work[nwork],
+ &i__1, &ierr);
+ ie = 1;
+ itauq = itau;
+ itaup = itauq + *n;
+ nwork = itaup + *n;
+
+/*
+ Bidiagonalize R in WORK(IR)
+ (CWorkspace: need N*N+3*N, prefer M*N+2*N+2*N*NB)
+ (RWorkspace: need N)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zgebrd_(n, n, &work[ir], &ldwrkr, &s[1], &rwork[ie], &work[
+ itauq], &work[itaup], &work[nwork], &i__1, &ierr);
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of R in WORK(IRU) and computing right singular vectors
+ of R in WORK(IRVT)
+ (CWorkspace: need 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ iru = ie + *n;
+ irvt = iru + *n * *n;
+ nrwork = irvt + *n * *n;
+ dbdsdc_("U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &
+ rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1],
+ info);
+
+/*
+ Copy real matrix RWORK(IRU) to complex matrix WORK(IU)
+ Overwrite WORK(IU) by the left singular vectors of R
+ (CWorkspace: need 2*N*N+3*N, prefer M*N+N*N+2*N+N*NB)
+ (RWorkspace: 0)
+*/
+
+ zlacp2_("F", n, n, &rwork[iru], n, &work[iu], &ldwrku);
+ i__1 = *lwork - nwork + 1;
+ zunmbr_("Q", "L", "N", n, n, n, &work[ir], &ldwrkr, &work[
+ itauq], &work[iu], &ldwrku, &work[nwork], &i__1, &
+ ierr);
+
+/*
+ Copy real matrix RWORK(IRVT) to complex matrix VT
+ Overwrite VT by the right singular vectors of R
+ (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB)
+ (RWorkspace: 0)
+*/
+
+ zlacp2_("F", n, n, &rwork[irvt], n, &vt[vt_offset], ldvt);
+ i__1 = *lwork - nwork + 1;
+ zunmbr_("P", "R", "C", n, n, n, &work[ir], &ldwrkr, &work[
+ itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
+ ierr);
+
+/*
+ Multiply Q in A by left singular vectors of R in
+ WORK(IU), storing result in WORK(IR) and copying to A
+ (CWorkspace: need 2*N*N, prefer N*N+M*N)
+ (RWorkspace: 0)
+*/
+
+ i__1 = *m;
+ i__2 = ldwrkr;
+ for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ +=
+ i__2) {
+/* Computing MIN */
+ i__3 = *m - i__ + 1;
+ chunk = min(i__3,ldwrkr);
+ zgemm_("N", "N", &chunk, n, n, &c_b60, &a[i__ + a_dim1],
+ lda, &work[iu], &ldwrku, &c_b59, &work[ir], &
+ ldwrkr);
+ zlacpy_("F", &chunk, n, &work[ir], &ldwrkr, &a[i__ +
+ a_dim1], lda);
+/* L10: */
+ }
+
+ } else if (wntqs) {
+
+/*
+ Path 3 (M much larger than N, JOBZ='S')
+ N left singular vectors to be computed in U and
+ N right singular vectors to be computed in VT
+*/
+
+ ir = 1;
+
+/* WORK(IR) is N by N */
+
+ ldwrkr = *n;
+ itau = ir + ldwrkr * *n;
+ nwork = itau + *n;
+
+/*
+ Compute A=Q*R
+ (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
+ (RWorkspace: 0)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
+ i__2, &ierr);
+
+/* Copy R to WORK(IR), zeroing out below it */
+
+ zlacpy_("U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr);
+ i__2 = *n - 1;
+ i__1 = *n - 1;
+ zlaset_("L", &i__2, &i__1, &c_b59, &c_b59, &work[ir + 1], &
+ ldwrkr);
+
+/*
+ Generate Q in A
+ (CWorkspace: need 2*N, prefer N+N*NB)
+ (RWorkspace: 0)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ zungqr_(m, n, n, &a[a_offset], lda, &work[itau], &work[nwork],
+ &i__2, &ierr);
+ ie = 1;
+ itauq = itau;
+ itaup = itauq + *n;
+ nwork = itaup + *n;
+
+/*
+ Bidiagonalize R in WORK(IR)
+ (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB)
+ (RWorkspace: need N)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ zgebrd_(n, n, &work[ir], &ldwrkr, &s[1], &rwork[ie], &work[
+ itauq], &work[itaup], &work[nwork], &i__2, &ierr);
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in RWORK(IRU) and computing right
+ singular vectors of bidiagonal matrix in RWORK(IRVT)
+ (CWorkspace: need 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ iru = ie + *n;
+ irvt = iru + *n * *n;
+ nrwork = irvt + *n * *n;
+ dbdsdc_("U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &
+ rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1],
+ info);
+
+/*
+ Copy real matrix RWORK(IRU) to complex matrix U
+ Overwrite U by left singular vectors of R
+ (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB)
+ (RWorkspace: 0)
+*/
+
+ zlacp2_("F", n, n, &rwork[iru], n, &u[u_offset], ldu);
+ i__2 = *lwork - nwork + 1;
+ zunmbr_("Q", "L", "N", n, n, n, &work[ir], &ldwrkr, &work[
+ itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr);
+
+/*
+ Copy real matrix RWORK(IRVT) to complex matrix VT
+ Overwrite VT by right singular vectors of R
+ (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB)
+ (RWorkspace: 0)
+*/
+
+ zlacp2_("F", n, n, &rwork[irvt], n, &vt[vt_offset], ldvt);
+ i__2 = *lwork - nwork + 1;
+ zunmbr_("P", "R", "C", n, n, n, &work[ir], &ldwrkr, &work[
+ itaup], &vt[vt_offset], ldvt, &work[nwork], &i__2, &
+ ierr);
+
+/*
+ Multiply Q in A by left singular vectors of R in
+ WORK(IR), storing result in U
+ (CWorkspace: need N*N)
+ (RWorkspace: 0)
+*/
+
+ zlacpy_("F", n, n, &u[u_offset], ldu, &work[ir], &ldwrkr);
+ zgemm_("N", "N", m, n, n, &c_b60, &a[a_offset], lda, &work[ir]
+ , &ldwrkr, &c_b59, &u[u_offset], ldu);
+
+ } else if (wntqa) {
+
+/*
+ Path 4 (M much larger than N, JOBZ='A')
+ M left singular vectors to be computed in U and
+ N right singular vectors to be computed in VT
+*/
+
+ iu = 1;
+
+/* WORK(IU) is N by N */
+
+ ldwrku = *n;
+ itau = iu + ldwrku * *n;
+ nwork = itau + *n;
+
+/*
+ Compute A=Q*R, copying result to U
+ (CWorkspace: need 2*N, prefer N+N*NB)
+ (RWorkspace: 0)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ zgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
+ i__2, &ierr);
+ zlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);
+
+/*
+ Generate Q in U
+ (CWorkspace: need N+M, prefer N+M*NB)
+ (RWorkspace: 0)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ zungqr_(m, m, n, &u[u_offset], ldu, &work[itau], &work[nwork],
+ &i__2, &ierr);
+
+/* Produce R in A, zeroing out below it */
+
+ i__2 = *n - 1;
+ i__1 = *n - 1;
+ zlaset_("L", &i__2, &i__1, &c_b59, &c_b59, &a[a_dim1 + 2],
+ lda);
+ ie = 1;
+ itauq = itau;
+ itaup = itauq + *n;
+ nwork = itaup + *n;
+
+/*
+ Bidiagonalize R in A
+ (CWorkspace: need 3*N, prefer 2*N+2*N*NB)
+ (RWorkspace: need N)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ zgebrd_(n, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[
+ itauq], &work[itaup], &work[nwork], &i__2, &ierr);
+ iru = ie + *n;
+ irvt = iru + *n * *n;
+ nrwork = irvt + *n * *n;
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in RWORK(IRU) and computing right
+ singular vectors of bidiagonal matrix in RWORK(IRVT)
+ (CWorkspace: need 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ dbdsdc_("U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &
+ rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1],
+ info);
+
+/*
+ Copy real matrix RWORK(IRU) to complex matrix WORK(IU)
+ Overwrite WORK(IU) by left singular vectors of R
+ (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB)
+ (RWorkspace: 0)
+*/
+
+ zlacp2_("F", n, n, &rwork[iru], n, &work[iu], &ldwrku);
+ i__2 = *lwork - nwork + 1;
+ zunmbr_("Q", "L", "N", n, n, n, &a[a_offset], lda, &work[
+ itauq], &work[iu], &ldwrku, &work[nwork], &i__2, &
+ ierr);
+
+/*
+ Copy real matrix RWORK(IRVT) to complex matrix VT
+ Overwrite VT by right singular vectors of R
+ (CWorkspace: need 3*N, prefer 2*N+N*NB)
+ (RWorkspace: 0)
+*/
+
+ zlacp2_("F", n, n, &rwork[irvt], n, &vt[vt_offset], ldvt);
+ i__2 = *lwork - nwork + 1;
+ zunmbr_("P", "R", "C", n, n, n, &a[a_offset], lda, &work[
+ itaup], &vt[vt_offset], ldvt, &work[nwork], &i__2, &
+ ierr);
+
+/*
+ Multiply Q in U by left singular vectors of R in
+ WORK(IU), storing result in A
+ (CWorkspace: need N*N)
+ (RWorkspace: 0)
+*/
+
+ zgemm_("N", "N", m, n, n, &c_b60, &u[u_offset], ldu, &work[iu]
+ , &ldwrku, &c_b59, &a[a_offset], lda);
+
+/* Copy left singular vectors of A from A to U */
+
+ zlacpy_("F", m, n, &a[a_offset], lda, &u[u_offset], ldu);
+
+ }
+
+ } else if (*m >= mnthr2) {
+
+/*
+ MNTHR2 <= M < MNTHR1
+
+ Path 5 (M much larger than N, but not as much as MNTHR1)
+ Reduce to bidiagonal form without QR decomposition, use
+ ZUNGBR and matrix multiplication to compute singular vectors
+*/
+
+ ie = 1;
+ nrwork = ie + *n;
+ itauq = 1;
+ itaup = itauq + *n;
+ nwork = itaup + *n;
+
+/*
+ Bidiagonalize A
+ (CWorkspace: need 2*N+M, prefer 2*N+(M+N)*NB)
+ (RWorkspace: need N)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ zgebrd_(m, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[itauq],
+ &work[itaup], &work[nwork], &i__2, &ierr);
+ if (wntqn) {
+
+/*
+ Compute singular values only
+ (Cworkspace: 0)
+ (Rworkspace: need BDSPAC)
+*/
+
+ dbdsdc_("U", "N", n, &s[1], &rwork[ie], dum, &c__1, dum, &
+ c__1, dum, idum, &rwork[nrwork], &iwork[1], info);
+ } else if (wntqo) {
+ iu = nwork;
+ iru = nrwork;
+ irvt = iru + *n * *n;
+ nrwork = irvt + *n * *n;
+
+/*
+ Copy A to VT, generate P**H
+ (Cworkspace: need 2*N, prefer N+N*NB)
+ (Rworkspace: 0)
+*/
+
+ zlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
+ i__2 = *lwork - nwork + 1;
+ zungbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &
+ work[nwork], &i__2, &ierr);
+
+/*
+ Generate Q in A
+ (CWorkspace: need 2*N, prefer N+N*NB)
+ (RWorkspace: 0)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ zungbr_("Q", m, n, n, &a[a_offset], lda, &work[itauq], &work[
+ nwork], &i__2, &ierr);
+
+ if (*lwork >= *m * *n + *n * 3) {
+
+/* WORK( IU ) is M by N */
+
+ ldwrku = *m;
+ } else {
+
+/* WORK(IU) is LDWRKU by N */
+
+ ldwrku = (*lwork - *n * 3) / *n;
+ }
+ nwork = iu + ldwrku * *n;
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in RWORK(IRU) and computing right
+ singular vectors of bidiagonal matrix in RWORK(IRVT)
+ (CWorkspace: need 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ dbdsdc_("U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &
+ rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1],
+ info);
+
+/*
+ Multiply real matrix RWORK(IRVT) by P**H in VT,
+ storing the result in WORK(IU), copying to VT
+ (Cworkspace: need 0)
+ (Rworkspace: need 3*N*N)
+*/
+
+ zlarcm_(n, n, &rwork[irvt], n, &vt[vt_offset], ldvt, &work[iu]
+ , &ldwrku, &rwork[nrwork]);
+ zlacpy_("F", n, n, &work[iu], &ldwrku, &vt[vt_offset], ldvt);
+
+/*
+ Multiply Q in A by real matrix RWORK(IRU), storing the
+ result in WORK(IU), copying to A
+ (CWorkspace: need N*N, prefer M*N)
+ (Rworkspace: need 3*N*N, prefer N*N+2*M*N)
+*/
+
+ nrwork = irvt;
+ i__2 = *m;
+ i__1 = ldwrku;
+ for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ +=
+ i__1) {
+/* Computing MIN */
+ i__3 = *m - i__ + 1;
+ chunk = min(i__3,ldwrku);
+ zlacrm_(&chunk, n, &a[i__ + a_dim1], lda, &rwork[iru], n,
+ &work[iu], &ldwrku, &rwork[nrwork]);
+ zlacpy_("F", &chunk, n, &work[iu], &ldwrku, &a[i__ +
+ a_dim1], lda);
+/* L20: */
+ }
+
+ } else if (wntqs) {
+
+/*
+ Copy A to VT, generate P**H
+ (Cworkspace: need 2*N, prefer N+N*NB)
+ (Rworkspace: 0)
+*/
+
+ zlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
+ i__1 = *lwork - nwork + 1;
+ zungbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &
+ work[nwork], &i__1, &ierr);
+
+/*
+ Copy A to U, generate Q
+ (Cworkspace: need 2*N, prefer N+N*NB)
+ (Rworkspace: 0)
+*/
+
+ zlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);
+ i__1 = *lwork - nwork + 1;
+ zungbr_("Q", m, n, n, &u[u_offset], ldu, &work[itauq], &work[
+ nwork], &i__1, &ierr);
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in RWORK(IRU) and computing right
+ singular vectors of bidiagonal matrix in RWORK(IRVT)
+ (CWorkspace: need 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ iru = nrwork;
+ irvt = iru + *n * *n;
+ nrwork = irvt + *n * *n;
+ dbdsdc_("U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &
+ rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1],
+ info);
+
+/*
+ Multiply real matrix RWORK(IRVT) by P**H in VT,
+ storing the result in A, copying to VT
+ (Cworkspace: need 0)
+ (Rworkspace: need 3*N*N)
+*/
+
+ zlarcm_(n, n, &rwork[irvt], n, &vt[vt_offset], ldvt, &a[
+ a_offset], lda, &rwork[nrwork]);
+ zlacpy_("F", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
+
+/*
+ Multiply Q in U by real matrix RWORK(IRU), storing the
+ result in A, copying to U
+ (CWorkspace: need 0)
+ (Rworkspace: need N*N+2*M*N)
+*/
+
+ nrwork = irvt;
+ zlacrm_(m, n, &u[u_offset], ldu, &rwork[iru], n, &a[a_offset],
+ lda, &rwork[nrwork]);
+ zlacpy_("F", m, n, &a[a_offset], lda, &u[u_offset], ldu);
+ } else {
+
+/*
+ Copy A to VT, generate P**H
+ (Cworkspace: need 2*N, prefer N+N*NB)
+ (Rworkspace: 0)
+*/
+
+ zlacpy_("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
+ i__1 = *lwork - nwork + 1;
+ zungbr_("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &
+ work[nwork], &i__1, &ierr);
+
+/*
+ Copy A to U, generate Q
+ (Cworkspace: need 2*N, prefer N+N*NB)
+ (Rworkspace: 0)
+*/
+
+ zlacpy_("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);
+ i__1 = *lwork - nwork + 1;
+ zungbr_("Q", m, m, n, &u[u_offset], ldu, &work[itauq], &work[
+ nwork], &i__1, &ierr);
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in RWORK(IRU) and computing right
+ singular vectors of bidiagonal matrix in RWORK(IRVT)
+ (CWorkspace: need 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ iru = nrwork;
+ irvt = iru + *n * *n;
+ nrwork = irvt + *n * *n;
+ dbdsdc_("U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &
+ rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1],
+ info);
+
+/*
+ Multiply real matrix RWORK(IRVT) by P**H in VT,
+ storing the result in A, copying to VT
+ (Cworkspace: need 0)
+ (Rworkspace: need 3*N*N)
+*/
+
+ zlarcm_(n, n, &rwork[irvt], n, &vt[vt_offset], ldvt, &a[
+ a_offset], lda, &rwork[nrwork]);
+ zlacpy_("F", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
+
+/*
+ Multiply Q in U by real matrix RWORK(IRU), storing the
+ result in A, copying to U
+ (CWorkspace: 0)
+ (Rworkspace: need 3*N*N)
+*/
+
+ nrwork = irvt;
+ zlacrm_(m, n, &u[u_offset], ldu, &rwork[iru], n, &a[a_offset],
+ lda, &rwork[nrwork]);
+ zlacpy_("F", m, n, &a[a_offset], lda, &u[u_offset], ldu);
+ }
+
+ } else {
+
+/*
+ M .LT. MNTHR2
+
+ Path 6 (M at least N, but not much larger)
+ Reduce to bidiagonal form without QR decomposition
+ Use ZUNMBR to compute singular vectors
+*/
+
+ ie = 1;
+ nrwork = ie + *n;
+ itauq = 1;
+ itaup = itauq + *n;
+ nwork = itaup + *n;
+
+/*
+ Bidiagonalize A
+ (CWorkspace: need 2*N+M, prefer 2*N+(M+N)*NB)
+ (RWorkspace: need N)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zgebrd_(m, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[itauq],
+ &work[itaup], &work[nwork], &i__1, &ierr);
+ if (wntqn) {
+
+/*
+ Compute singular values only
+ (Cworkspace: 0)
+ (Rworkspace: need BDSPAC)
+*/
+
+ dbdsdc_("U", "N", n, &s[1], &rwork[ie], dum, &c__1, dum, &
+ c__1, dum, idum, &rwork[nrwork], &iwork[1], info);
+ } else if (wntqo) {
+ iu = nwork;
+ iru = nrwork;
+ irvt = iru + *n * *n;
+ nrwork = irvt + *n * *n;
+ if (*lwork >= *m * *n + *n * 3) {
+
+/* WORK( IU ) is M by N */
+
+ ldwrku = *m;
+ } else {
+
+/* WORK( IU ) is LDWRKU by N */
+
+ ldwrku = (*lwork - *n * 3) / *n;
+ }
+ nwork = iu + ldwrku * *n;
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in RWORK(IRU) and computing right
+ singular vectors of bidiagonal matrix in RWORK(IRVT)
+ (CWorkspace: need 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ dbdsdc_("U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &
+ rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1],
+ info);
+
+/*
+ Copy real matrix RWORK(IRVT) to complex matrix VT
+ Overwrite VT by right singular vectors of A
+ (Cworkspace: need 2*N, prefer N+N*NB)
+ (Rworkspace: need 0)
+*/
+
+ zlacp2_("F", n, n, &rwork[irvt], n, &vt[vt_offset], ldvt);
+ i__1 = *lwork - nwork + 1;
+ zunmbr_("P", "R", "C", n, n, n, &a[a_offset], lda, &work[
+ itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
+ ierr);
+
+ if (*lwork >= *m * *n + *n * 3) {
+
+/*
+ Copy real matrix RWORK(IRU) to complex matrix WORK(IU)
+ Overwrite WORK(IU) by left singular vectors of A, copying
+ to A
+ (Cworkspace: need M*N+2*N, prefer M*N+N+N*NB)
+ (Rworkspace: need 0)
+*/
+
+ zlaset_("F", m, n, &c_b59, &c_b59, &work[iu], &ldwrku);
+ zlacp2_("F", n, n, &rwork[iru], n, &work[iu], &ldwrku);
+ i__1 = *lwork - nwork + 1;
+ zunmbr_("Q", "L", "N", m, n, n, &a[a_offset], lda, &work[
+ itauq], &work[iu], &ldwrku, &work[nwork], &i__1, &
+ ierr);
+ zlacpy_("F", m, n, &work[iu], &ldwrku, &a[a_offset], lda);
+ } else {
+
+/*
+ Generate Q in A
+ (Cworkspace: need 2*N, prefer N+N*NB)
+ (Rworkspace: need 0)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zungbr_("Q", m, n, n, &a[a_offset], lda, &work[itauq], &
+ work[nwork], &i__1, &ierr);
+
+/*
+ Multiply Q in A by real matrix RWORK(IRU), storing the
+ result in WORK(IU), copying to A
+ (CWorkspace: need N*N, prefer M*N)
+ (Rworkspace: need 3*N*N, prefer N*N+2*M*N)
+*/
+
+ nrwork = irvt;
+ i__1 = *m;
+ i__2 = ldwrku;
+ for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ +=
+ i__2) {
+/* Computing MIN */
+ i__3 = *m - i__ + 1;
+ chunk = min(i__3,ldwrku);
+ zlacrm_(&chunk, n, &a[i__ + a_dim1], lda, &rwork[iru],
+ n, &work[iu], &ldwrku, &rwork[nrwork]);
+ zlacpy_("F", &chunk, n, &work[iu], &ldwrku, &a[i__ +
+ a_dim1], lda);
+/* L30: */
+ }
+ }
+
+ } else if (wntqs) {
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in RWORK(IRU) and computing right
+ singular vectors of bidiagonal matrix in RWORK(IRVT)
+ (CWorkspace: need 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ iru = nrwork;
+ irvt = iru + *n * *n;
+ nrwork = irvt + *n * *n;
+ dbdsdc_("U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &
+ rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1],
+ info);
+
+/*
+ Copy real matrix RWORK(IRU) to complex matrix U
+ Overwrite U by left singular vectors of A
+ (CWorkspace: need 3*N, prefer 2*N+N*NB)
+ (RWorkspace: 0)
+*/
+
+ zlaset_("F", m, n, &c_b59, &c_b59, &u[u_offset], ldu);
+ zlacp2_("F", n, n, &rwork[iru], n, &u[u_offset], ldu);
+ i__2 = *lwork - nwork + 1;
+ zunmbr_("Q", "L", "N", m, n, n, &a[a_offset], lda, &work[
+ itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr);
+
+/*
+ Copy real matrix RWORK(IRVT) to complex matrix VT
+ Overwrite VT by right singular vectors of A
+ (CWorkspace: need 3*N, prefer 2*N+N*NB)
+ (RWorkspace: 0)
+*/
+
+ zlacp2_("F", n, n, &rwork[irvt], n, &vt[vt_offset], ldvt);
+ i__2 = *lwork - nwork + 1;
+ zunmbr_("P", "R", "C", n, n, n, &a[a_offset], lda, &work[
+ itaup], &vt[vt_offset], ldvt, &work[nwork], &i__2, &
+ ierr);
+ } else {
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in RWORK(IRU) and computing right
+ singular vectors of bidiagonal matrix in RWORK(IRVT)
+ (CWorkspace: need 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ iru = nrwork;
+ irvt = iru + *n * *n;
+ nrwork = irvt + *n * *n;
+ dbdsdc_("U", "I", n, &s[1], &rwork[ie], &rwork[iru], n, &
+ rwork[irvt], n, dum, idum, &rwork[nrwork], &iwork[1],
+ info);
+
+/* Set the right corner of U to identity matrix */
+
+ zlaset_("F", m, m, &c_b59, &c_b59, &u[u_offset], ldu);
+ i__2 = *m - *n;
+ i__1 = *m - *n;
+ zlaset_("F", &i__2, &i__1, &c_b59, &c_b60, &u[*n + 1 + (*n +
+ 1) * u_dim1], ldu);
+
+/*
+ Copy real matrix RWORK(IRU) to complex matrix U
+ Overwrite U by left singular vectors of A
+ (CWorkspace: need 2*N+M, prefer 2*N+M*NB)
+ (RWorkspace: 0)
+*/
+
+ zlacp2_("F", n, n, &rwork[iru], n, &u[u_offset], ldu);
+ i__2 = *lwork - nwork + 1;
+ zunmbr_("Q", "L", "N", m, m, n, &a[a_offset], lda, &work[
+ itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr);
+
+/*
+ Copy real matrix RWORK(IRVT) to complex matrix VT
+ Overwrite VT by right singular vectors of A
+ (CWorkspace: need 3*N, prefer 2*N+N*NB)
+ (RWorkspace: 0)
+*/
+
+ zlacp2_("F", n, n, &rwork[irvt], n, &vt[vt_offset], ldvt);
+ i__2 = *lwork - nwork + 1;
+ zunmbr_("P", "R", "C", n, n, n, &a[a_offset], lda, &work[
+ itaup], &vt[vt_offset], ldvt, &work[nwork], &i__2, &
+ ierr);
+ }
+
+ }
+
+ } else {
+
+/*
+ A has more columns than rows. If A has sufficiently more
+ columns than rows, first reduce using the LQ decomposition
+ (if sufficient workspace available)
+*/
+
+ if (*n >= mnthr1) {
+
+ if (wntqn) {
+
+/*
+ Path 1t (N much larger than M, JOBZ='N')
+ No singular vectors to be computed
+*/
+
+ itau = 1;
+ nwork = itau + *m;
+
+/*
+ Compute A=L*Q
+ (CWorkspace: need 2*M, prefer M+M*NB)
+ (RWorkspace: 0)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
+ i__2, &ierr);
+
+/* Zero out above L */
+
+ i__2 = *m - 1;
+ i__1 = *m - 1;
+ zlaset_("U", &i__2, &i__1, &c_b59, &c_b59, &a[((a_dim1) << (1)
+ ) + 1], lda);
+ ie = 1;
+ itauq = 1;
+ itaup = itauq + *m;
+ nwork = itaup + *m;
+
+/*
+ Bidiagonalize L in A
+ (CWorkspace: need 3*M, prefer 2*M+2*M*NB)
+ (RWorkspace: need M)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ zgebrd_(m, m, &a[a_offset], lda, &s[1], &rwork[ie], &work[
+ itauq], &work[itaup], &work[nwork], &i__2, &ierr);
+ nrwork = ie + *m;
+
+/*
+ Perform bidiagonal SVD, compute singular values only
+ (CWorkspace: 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ dbdsdc_("U", "N", m, &s[1], &rwork[ie], dum, &c__1, dum, &
+ c__1, dum, idum, &rwork[nrwork], &iwork[1], info);
+
+ } else if (wntqo) {
+
+/*
+ Path 2t (N much larger than M, JOBZ='O')
+ M right singular vectors to be overwritten on A and
+ M left singular vectors to be computed in U
+*/
+
+ ivt = 1;
+ ldwkvt = *m;
+
+/* WORK(IVT) is M by M */
+
+ il = ivt + ldwkvt * *m;
+ if (*lwork >= *m * *n + *m * *m + *m * 3) {
+
+/* WORK(IL) M by N */
+
+ ldwrkl = *m;
+ chunk = *n;
+ } else {
+
+/* WORK(IL) is M by CHUNK */
+
+ ldwrkl = *m;
+ chunk = (*lwork - *m * *m - *m * 3) / *m;
+ }
+ itau = il + ldwrkl * chunk;
+ nwork = itau + *m;
+
+/*
+ Compute A=L*Q
+ (CWorkspace: need 2*M, prefer M+M*NB)
+ (RWorkspace: 0)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
+ i__2, &ierr);
+
+/* Copy L to WORK(IL), zeroing about above it */
+
+ zlacpy_("L", m, m, &a[a_offset], lda, &work[il], &ldwrkl);
+ i__2 = *m - 1;
+ i__1 = *m - 1;
+ zlaset_("U", &i__2, &i__1, &c_b59, &c_b59, &work[il + ldwrkl],
+ &ldwrkl);
+
+/*
+ Generate Q in A
+ (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
+ (RWorkspace: 0)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ zunglq_(m, n, m, &a[a_offset], lda, &work[itau], &work[nwork],
+ &i__2, &ierr);
+ ie = 1;
+ itauq = itau;
+ itaup = itauq + *m;
+ nwork = itaup + *m;
+
+/*
+ Bidiagonalize L in WORK(IL)
+ (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB)
+ (RWorkspace: need M)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ zgebrd_(m, m, &work[il], &ldwrkl, &s[1], &rwork[ie], &work[
+ itauq], &work[itaup], &work[nwork], &i__2, &ierr);
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in RWORK(IRU) and computing right
+ singular vectors of bidiagonal matrix in RWORK(IRVT)
+ (CWorkspace: need 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ iru = ie + *m;
+ irvt = iru + *m * *m;
+ nrwork = irvt + *m * *m;
+ dbdsdc_("U", "I", m, &s[1], &rwork[ie], &rwork[iru], m, &
+ rwork[irvt], m, dum, idum, &rwork[nrwork], &iwork[1],
+ info);
+
+/*
+ Copy real matrix RWORK(IRU) to complex matrix WORK(IU)
+ Overwrite WORK(IU) by the left singular vectors of L
+ (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB)
+ (RWorkspace: 0)
+*/
+
+ zlacp2_("F", m, m, &rwork[iru], m, &u[u_offset], ldu);
+ i__2 = *lwork - nwork + 1;
+ zunmbr_("Q", "L", "N", m, m, m, &work[il], &ldwrkl, &work[
+ itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr);
+
+/*
+ Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT)
+ Overwrite WORK(IVT) by the right singular vectors of L
+ (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB)
+ (RWorkspace: 0)
+*/
+
+ zlacp2_("F", m, m, &rwork[irvt], m, &work[ivt], &ldwkvt);
+ i__2 = *lwork - nwork + 1;
+ zunmbr_("P", "R", "C", m, m, m, &work[il], &ldwrkl, &work[
+ itaup], &work[ivt], &ldwkvt, &work[nwork], &i__2, &
+ ierr);
+
+/*
+ Multiply right singular vectors of L in WORK(IL) by Q
+ in A, storing result in WORK(IL) and copying to A
+ (CWorkspace: need 2*M*M, prefer M*M+M*N))
+ (RWorkspace: 0)
+*/
+
+ i__2 = *n;
+ i__1 = chunk;
+ for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ +=
+ i__1) {
+/* Computing MIN */
+ i__3 = *n - i__ + 1;
+ blk = min(i__3,chunk);
+ zgemm_("N", "N", m, &blk, m, &c_b60, &work[ivt], m, &a[
+ i__ * a_dim1 + 1], lda, &c_b59, &work[il], &
+ ldwrkl);
+ zlacpy_("F", m, &blk, &work[il], &ldwrkl, &a[i__ * a_dim1
+ + 1], lda);
+/* L40: */
+ }
+
+ } else if (wntqs) {
+
+/*
+ Path 3t (N much larger than M, JOBZ='S')
+ M right singular vectors to be computed in VT and
+ M left singular vectors to be computed in U
+*/
+
+ il = 1;
+
+/* WORK(IL) is M by M */
+
+ ldwrkl = *m;
+ itau = il + ldwrkl * *m;
+ nwork = itau + *m;
+
+/*
+ Compute A=L*Q
+ (CWorkspace: need 2*M, prefer M+M*NB)
+ (RWorkspace: 0)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
+ i__1, &ierr);
+
+/* Copy L to WORK(IL), zeroing out above it */
+
+ zlacpy_("L", m, m, &a[a_offset], lda, &work[il], &ldwrkl);
+ i__1 = *m - 1;
+ i__2 = *m - 1;
+ zlaset_("U", &i__1, &i__2, &c_b59, &c_b59, &work[il + ldwrkl],
+ &ldwrkl);
+
+/*
+ Generate Q in A
+ (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
+ (RWorkspace: 0)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zunglq_(m, n, m, &a[a_offset], lda, &work[itau], &work[nwork],
+ &i__1, &ierr);
+ ie = 1;
+ itauq = itau;
+ itaup = itauq + *m;
+ nwork = itaup + *m;
+
+/*
+ Bidiagonalize L in WORK(IL)
+ (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB)
+ (RWorkspace: need M)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zgebrd_(m, m, &work[il], &ldwrkl, &s[1], &rwork[ie], &work[
+ itauq], &work[itaup], &work[nwork], &i__1, &ierr);
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in RWORK(IRU) and computing right
+ singular vectors of bidiagonal matrix in RWORK(IRVT)
+ (CWorkspace: need 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ iru = ie + *m;
+ irvt = iru + *m * *m;
+ nrwork = irvt + *m * *m;
+ dbdsdc_("U", "I", m, &s[1], &rwork[ie], &rwork[iru], m, &
+ rwork[irvt], m, dum, idum, &rwork[nrwork], &iwork[1],
+ info);
+
+/*
+ Copy real matrix RWORK(IRU) to complex matrix U
+ Overwrite U by left singular vectors of L
+ (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB)
+ (RWorkspace: 0)
+*/
+
+ zlacp2_("F", m, m, &rwork[iru], m, &u[u_offset], ldu);
+ i__1 = *lwork - nwork + 1;
+ zunmbr_("Q", "L", "N", m, m, m, &work[il], &ldwrkl, &work[
+ itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr);
+
+/*
+ Copy real matrix RWORK(IRVT) to complex matrix VT
+ Overwrite VT by left singular vectors of L
+ (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB)
+ (RWorkspace: 0)
+*/
+
+ zlacp2_("F", m, m, &rwork[irvt], m, &vt[vt_offset], ldvt);
+ i__1 = *lwork - nwork + 1;
+ zunmbr_("P", "R", "C", m, m, m, &work[il], &ldwrkl, &work[
+ itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
+ ierr);
+
+/*
+ Copy VT to WORK(IL), multiply right singular vectors of L
+ in WORK(IL) by Q in A, storing result in VT
+ (CWorkspace: need M*M)
+ (RWorkspace: 0)
+*/
+
+ zlacpy_("F", m, m, &vt[vt_offset], ldvt, &work[il], &ldwrkl);
+ zgemm_("N", "N", m, n, m, &c_b60, &work[il], &ldwrkl, &a[
+ a_offset], lda, &c_b59, &vt[vt_offset], ldvt);
+
+ } else if (wntqa) {
+
+/*
+ Path 9t (N much larger than M, JOBZ='A')
+ N right singular vectors to be computed in VT and
+ M left singular vectors to be computed in U
+*/
+
+ ivt = 1;
+
+/* WORK(IVT) is M by M */
+
+ ldwkvt = *m;
+ itau = ivt + ldwkvt * *m;
+ nwork = itau + *m;
+
+/*
+ Compute A=L*Q, copying result to VT
+ (CWorkspace: need 2*M, prefer M+M*NB)
+ (RWorkspace: 0)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &
+ i__1, &ierr);
+ zlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
+
+/*
+ Generate Q in VT
+ (CWorkspace: need M+N, prefer M+N*NB)
+ (RWorkspace: 0)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zunglq_(n, n, m, &vt[vt_offset], ldvt, &work[itau], &work[
+ nwork], &i__1, &ierr);
+
+/* Produce L in A, zeroing out above it */
+
+ i__1 = *m - 1;
+ i__2 = *m - 1;
+ zlaset_("U", &i__1, &i__2, &c_b59, &c_b59, &a[((a_dim1) << (1)
+ ) + 1], lda);
+ ie = 1;
+ itauq = itau;
+ itaup = itauq + *m;
+ nwork = itaup + *m;
+
+/*
+ Bidiagonalize L in A
+ (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB)
+ (RWorkspace: need M)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zgebrd_(m, m, &a[a_offset], lda, &s[1], &rwork[ie], &work[
+ itauq], &work[itaup], &work[nwork], &i__1, &ierr);
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in RWORK(IRU) and computing right
+ singular vectors of bidiagonal matrix in RWORK(IRVT)
+ (CWorkspace: need 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ iru = ie + *m;
+ irvt = iru + *m * *m;
+ nrwork = irvt + *m * *m;
+ dbdsdc_("U", "I", m, &s[1], &rwork[ie], &rwork[iru], m, &
+ rwork[irvt], m, dum, idum, &rwork[nrwork], &iwork[1],
+ info);
+
+/*
+ Copy real matrix RWORK(IRU) to complex matrix U
+ Overwrite U by left singular vectors of L
+ (CWorkspace: need 3*M, prefer 2*M+M*NB)
+ (RWorkspace: 0)
+*/
+
+ zlacp2_("F", m, m, &rwork[iru], m, &u[u_offset], ldu);
+ i__1 = *lwork - nwork + 1;
+ zunmbr_("Q", "L", "N", m, m, m, &a[a_offset], lda, &work[
+ itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr);
+
+/*
+ Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT)
+ Overwrite WORK(IVT) by right singular vectors of L
+ (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB)
+ (RWorkspace: 0)
+*/
+
+ zlacp2_("F", m, m, &rwork[irvt], m, &work[ivt], &ldwkvt);
+ i__1 = *lwork - nwork + 1;
+ zunmbr_("P", "R", "C", m, m, m, &a[a_offset], lda, &work[
+ itaup], &work[ivt], &ldwkvt, &work[nwork], &i__1, &
+ ierr);
+
+/*
+ Multiply right singular vectors of L in WORK(IVT) by
+ Q in VT, storing result in A
+ (CWorkspace: need M*M)
+ (RWorkspace: 0)
+*/
+
+ zgemm_("N", "N", m, n, m, &c_b60, &work[ivt], &ldwkvt, &vt[
+ vt_offset], ldvt, &c_b59, &a[a_offset], lda);
+
+/* Copy right singular vectors of A from A to VT */
+
+ zlacpy_("F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
+
+ }
+
+ } else if (*n >= mnthr2) {
+
+/*
+ MNTHR2 <= N < MNTHR1
+
+ Path 5t (N much larger than M, but not as much as MNTHR1)
+ Reduce to bidiagonal form without QR decomposition, use
+ ZUNGBR and matrix multiplication to compute singular vectors
+*/
+
+
+ ie = 1;
+ nrwork = ie + *m;
+ itauq = 1;
+ itaup = itauq + *m;
+ nwork = itaup + *m;
+
+/*
+ Bidiagonalize A
+ (CWorkspace: need 2*M+N, prefer 2*M+(M+N)*NB)
+ (RWorkspace: M)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zgebrd_(m, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[itauq],
+ &work[itaup], &work[nwork], &i__1, &ierr);
+
+ if (wntqn) {
+
+/*
+ Compute singular values only
+ (Cworkspace: 0)
+ (Rworkspace: need BDSPAC)
+*/
+
+ dbdsdc_("L", "N", m, &s[1], &rwork[ie], dum, &c__1, dum, &
+ c__1, dum, idum, &rwork[nrwork], &iwork[1], info);
+ } else if (wntqo) {
+ irvt = nrwork;
+ iru = irvt + *m * *m;
+ nrwork = iru + *m * *m;
+ ivt = nwork;
+
+/*
+ Copy A to U, generate Q
+ (Cworkspace: need 2*M, prefer M+M*NB)
+ (Rworkspace: 0)
+*/
+
+ zlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset], ldu);
+ i__1 = *lwork - nwork + 1;
+ zungbr_("Q", m, m, n, &u[u_offset], ldu, &work[itauq], &work[
+ nwork], &i__1, &ierr);
+
+/*
+ Generate P**H in A
+ (Cworkspace: need 2*M, prefer M+M*NB)
+ (Rworkspace: 0)
+*/
+
+ i__1 = *lwork - nwork + 1;
+ zungbr_("P", m, n, m, &a[a_offset], lda, &work[itaup], &work[
+ nwork], &i__1, &ierr);
+
+ ldwkvt = *m;
+ if (*lwork >= *m * *n + *m * 3) {
+
+/* WORK( IVT ) is M by N */
+
+ nwork = ivt + ldwkvt * *n;
+ chunk = *n;
+ } else {
+
+/* WORK( IVT ) is M by CHUNK */
+
+ chunk = (*lwork - *m * 3) / *m;
+ nwork = ivt + ldwkvt * chunk;
+ }
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in RWORK(IRU) and computing right
+ singular vectors of bidiagonal matrix in RWORK(IRVT)
+ (CWorkspace: need 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ dbdsdc_("L", "I", m, &s[1], &rwork[ie], &rwork[iru], m, &
+ rwork[irvt], m, dum, idum, &rwork[nrwork], &iwork[1],
+ info);
+
+/*
+ Multiply Q in U by real matrix RWORK(IRVT)
+ storing the result in WORK(IVT), copying to U
+ (Cworkspace: need 0)
+ (Rworkspace: need 2*M*M)
+*/
+
+ zlacrm_(m, m, &u[u_offset], ldu, &rwork[iru], m, &work[ivt], &
+ ldwkvt, &rwork[nrwork]);
+ zlacpy_("F", m, m, &work[ivt], &ldwkvt, &u[u_offset], ldu);
+
+/*
+ Multiply RWORK(IRVT) by P**H in A, storing the
+ result in WORK(IVT), copying to A
+ (CWorkspace: need M*M, prefer M*N)
+ (Rworkspace: need 2*M*M, prefer 2*M*N)
+*/
+
+ nrwork = iru;
+ i__1 = *n;
+ i__2 = chunk;
+ for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ +=
+ i__2) {
+/* Computing MIN */
+ i__3 = *n - i__ + 1;
+ blk = min(i__3,chunk);
+ zlarcm_(m, &blk, &rwork[irvt], m, &a[i__ * a_dim1 + 1],
+ lda, &work[ivt], &ldwkvt, &rwork[nrwork]);
+ zlacpy_("F", m, &blk, &work[ivt], &ldwkvt, &a[i__ *
+ a_dim1 + 1], lda);
+/* L50: */
+ }
+ } else if (wntqs) {
+
+/*
+ Copy A to U, generate Q
+ (Cworkspace: need 2*M, prefer M+M*NB)
+ (Rworkspace: 0)
+*/
+
+ zlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset], ldu);
+ i__2 = *lwork - nwork + 1;
+ zungbr_("Q", m, m, n, &u[u_offset], ldu, &work[itauq], &work[
+ nwork], &i__2, &ierr);
+
+/*
+ Copy A to VT, generate P**H
+ (Cworkspace: need 2*M, prefer M+M*NB)
+ (Rworkspace: 0)
+*/
+
+ zlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
+ i__2 = *lwork - nwork + 1;
+ zungbr_("P", m, n, m, &vt[vt_offset], ldvt, &work[itaup], &
+ work[nwork], &i__2, &ierr);
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in RWORK(IRU) and computing right
+ singular vectors of bidiagonal matrix in RWORK(IRVT)
+ (CWorkspace: need 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ irvt = nrwork;
+ iru = irvt + *m * *m;
+ nrwork = iru + *m * *m;
+ dbdsdc_("L", "I", m, &s[1], &rwork[ie], &rwork[iru], m, &
+ rwork[irvt], m, dum, idum, &rwork[nrwork], &iwork[1],
+ info);
+
+/*
+ Multiply Q in U by real matrix RWORK(IRU), storing the
+ result in A, copying to U
+ (CWorkspace: need 0)
+ (Rworkspace: need 3*M*M)
+*/
+
+ zlacrm_(m, m, &u[u_offset], ldu, &rwork[iru], m, &a[a_offset],
+ lda, &rwork[nrwork]);
+ zlacpy_("F", m, m, &a[a_offset], lda, &u[u_offset], ldu);
+
+/*
+ Multiply real matrix RWORK(IRVT) by P**H in VT,
+ storing the result in A, copying to VT
+ (Cworkspace: need 0)
+ (Rworkspace: need M*M+2*M*N)
+*/
+
+ nrwork = iru;
+ zlarcm_(m, n, &rwork[irvt], m, &vt[vt_offset], ldvt, &a[
+ a_offset], lda, &rwork[nrwork]);
+ zlacpy_("F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
+ } else {
+
+/*
+ Copy A to U, generate Q
+ (Cworkspace: need 2*M, prefer M+M*NB)
+ (Rworkspace: 0)
+*/
+
+ zlacpy_("L", m, m, &a[a_offset], lda, &u[u_offset], ldu);
+ i__2 = *lwork - nwork + 1;
+ zungbr_("Q", m, m, n, &u[u_offset], ldu, &work[itauq], &work[
+ nwork], &i__2, &ierr);
+
+/*
+ Copy A to VT, generate P**H
+ (Cworkspace: need 2*M, prefer M+M*NB)
+ (Rworkspace: 0)
+*/
+
+ zlacpy_("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
+ i__2 = *lwork - nwork + 1;
+ zungbr_("P", n, n, m, &vt[vt_offset], ldvt, &work[itaup], &
+ work[nwork], &i__2, &ierr);
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in RWORK(IRU) and computing right
+ singular vectors of bidiagonal matrix in RWORK(IRVT)
+ (CWorkspace: need 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ irvt = nrwork;
+ iru = irvt + *m * *m;
+ nrwork = iru + *m * *m;
+ dbdsdc_("L", "I", m, &s[1], &rwork[ie], &rwork[iru], m, &
+ rwork[irvt], m, dum, idum, &rwork[nrwork], &iwork[1],
+ info);
+
+/*
+ Multiply Q in U by real matrix RWORK(IRU), storing the
+ result in A, copying to U
+ (CWorkspace: need 0)
+ (Rworkspace: need 3*M*M)
+*/
+
+ zlacrm_(m, m, &u[u_offset], ldu, &rwork[iru], m, &a[a_offset],
+ lda, &rwork[nrwork]);
+ zlacpy_("F", m, m, &a[a_offset], lda, &u[u_offset], ldu);
+
+/*
+ Multiply real matrix RWORK(IRVT) by P**H in VT,
+ storing the result in A, copying to VT
+ (Cworkspace: need 0)
+ (Rworkspace: need M*M+2*M*N)
+*/
+
+ zlarcm_(m, n, &rwork[irvt], m, &vt[vt_offset], ldvt, &a[
+ a_offset], lda, &rwork[nrwork]);
+ zlacpy_("F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
+ }
+
+ } else {
+
+/*
+ N .LT. MNTHR2
+
+ Path 6t (N greater than M, but not much larger)
+ Reduce to bidiagonal form without LQ decomposition
+ Use ZUNMBR to compute singular vectors
+*/
+
+ ie = 1;
+ nrwork = ie + *m;
+ itauq = 1;
+ itaup = itauq + *m;
+ nwork = itaup + *m;
+
+/*
+ Bidiagonalize A
+ (CWorkspace: need 2*M+N, prefer 2*M+(M+N)*NB)
+ (RWorkspace: M)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ zgebrd_(m, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[itauq],
+ &work[itaup], &work[nwork], &i__2, &ierr);
+ if (wntqn) {
+
+/*
+ Compute singular values only
+ (Cworkspace: 0)
+ (Rworkspace: need BDSPAC)
+*/
+
+ dbdsdc_("L", "N", m, &s[1], &rwork[ie], dum, &c__1, dum, &
+ c__1, dum, idum, &rwork[nrwork], &iwork[1], info);
+ } else if (wntqo) {
+ ldwkvt = *m;
+ ivt = nwork;
+ if (*lwork >= *m * *n + *m * 3) {
+
+/* WORK( IVT ) is M by N */
+
+ zlaset_("F", m, n, &c_b59, &c_b59, &work[ivt], &ldwkvt);
+ nwork = ivt + ldwkvt * *n;
+ } else {
+
+/* WORK( IVT ) is M by CHUNK */
+
+ chunk = (*lwork - *m * 3) / *m;
+ nwork = ivt + ldwkvt * chunk;
+ }
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in RWORK(IRU) and computing right
+ singular vectors of bidiagonal matrix in RWORK(IRVT)
+ (CWorkspace: need 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ irvt = nrwork;
+ iru = irvt + *m * *m;
+ nrwork = iru + *m * *m;
+ dbdsdc_("L", "I", m, &s[1], &rwork[ie], &rwork[iru], m, &
+ rwork[irvt], m, dum, idum, &rwork[nrwork], &iwork[1],
+ info);
+
+/*
+ Copy real matrix RWORK(IRU) to complex matrix U
+ Overwrite U by left singular vectors of A
+ (Cworkspace: need 2*M, prefer M+M*NB)
+ (Rworkspace: need 0)
+*/
+
+ zlacp2_("F", m, m, &rwork[iru], m, &u[u_offset], ldu);
+ i__2 = *lwork - nwork + 1;
+ zunmbr_("Q", "L", "N", m, m, n, &a[a_offset], lda, &work[
+ itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr);
+
+ if (*lwork >= *m * *n + *m * 3) {
+
+/*
+ Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT)
+ Overwrite WORK(IVT) by right singular vectors of A,
+ copying to A
+ (Cworkspace: need M*N+2*M, prefer M*N+M+M*NB)
+ (Rworkspace: need 0)
+*/
+
+ zlacp2_("F", m, m, &rwork[irvt], m, &work[ivt], &ldwkvt);
+ i__2 = *lwork - nwork + 1;
+ zunmbr_("P", "R", "C", m, n, m, &a[a_offset], lda, &work[
+ itaup], &work[ivt], &ldwkvt, &work[nwork], &i__2,
+ &ierr);
+ zlacpy_("F", m, n, &work[ivt], &ldwkvt, &a[a_offset], lda);
+ } else {
+
+/*
+ Generate P**H in A
+ (Cworkspace: need 2*M, prefer M+M*NB)
+ (Rworkspace: need 0)
+*/
+
+ i__2 = *lwork - nwork + 1;
+ zungbr_("P", m, n, m, &a[a_offset], lda, &work[itaup], &
+ work[nwork], &i__2, &ierr);
+
+/*
+ Multiply Q in A by real matrix RWORK(IRU), storing the
+ result in WORK(IU), copying to A
+ (CWorkspace: need M*M, prefer M*N)
+ (Rworkspace: need 3*M*M, prefer M*M+2*M*N)
+*/
+
+ nrwork = iru;
+ i__2 = *n;
+ i__1 = chunk;
+ for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ +=
+ i__1) {
+/* Computing MIN */
+ i__3 = *n - i__ + 1;
+ blk = min(i__3,chunk);
+ zlarcm_(m, &blk, &rwork[irvt], m, &a[i__ * a_dim1 + 1]
+ , lda, &work[ivt], &ldwkvt, &rwork[nrwork]);
+ zlacpy_("F", m, &blk, &work[ivt], &ldwkvt, &a[i__ *
+ a_dim1 + 1], lda);
+/* L60: */
+ }
+ }
+ } else if (wntqs) {
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in RWORK(IRU) and computing right
+ singular vectors of bidiagonal matrix in RWORK(IRVT)
+ (CWorkspace: need 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ irvt = nrwork;
+ iru = irvt + *m * *m;
+ nrwork = iru + *m * *m;
+ dbdsdc_("L", "I", m, &s[1], &rwork[ie], &rwork[iru], m, &
+ rwork[irvt], m, dum, idum, &rwork[nrwork], &iwork[1],
+ info);
+
+/*
+ Copy real matrix RWORK(IRU) to complex matrix U
+ Overwrite U by left singular vectors of A
+ (CWorkspace: need 3*M, prefer 2*M+M*NB)
+ (RWorkspace: M*M)
+*/
+
+ zlacp2_("F", m, m, &rwork[iru], m, &u[u_offset], ldu);
+ i__1 = *lwork - nwork + 1;
+ zunmbr_("Q", "L", "N", m, m, n, &a[a_offset], lda, &work[
+ itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr);
+
+/*
+ Copy real matrix RWORK(IRVT) to complex matrix VT
+ Overwrite VT by right singular vectors of A
+ (CWorkspace: need 3*M, prefer 2*M+M*NB)
+ (RWorkspace: M*M)
+*/
+
+ zlaset_("F", m, n, &c_b59, &c_b59, &vt[vt_offset], ldvt);
+ zlacp2_("F", m, m, &rwork[irvt], m, &vt[vt_offset], ldvt);
+ i__1 = *lwork - nwork + 1;
+ zunmbr_("P", "R", "C", m, n, m, &a[a_offset], lda, &work[
+ itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
+ ierr);
+ } else {
+
+/*
+ Perform bidiagonal SVD, computing left singular vectors
+ of bidiagonal matrix in RWORK(IRU) and computing right
+ singular vectors of bidiagonal matrix in RWORK(IRVT)
+ (CWorkspace: need 0)
+ (RWorkspace: need BDSPAC)
+*/
+
+ irvt = nrwork;
+ iru = irvt + *m * *m;
+ nrwork = iru + *m * *m;
+
+ dbdsdc_("L", "I", m, &s[1], &rwork[ie], &rwork[iru], m, &
+ rwork[irvt], m, dum, idum, &rwork[nrwork], &iwork[1],
+ info);
+
+/*
+ Copy real matrix RWORK(IRU) to complex matrix U
+ Overwrite U by left singular vectors of A
+ (CWorkspace: need 3*M, prefer 2*M+M*NB)
+ (RWorkspace: M*M)
+*/
+
+ zlacp2_("F", m, m, &rwork[iru], m, &u[u_offset], ldu);
+ i__1 = *lwork - nwork + 1;
+ zunmbr_("Q", "L", "N", m, m, n, &a[a_offset], lda, &work[
+ itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr);
+
+/* Set the right corner of VT to identity matrix */
+
+ i__1 = *n - *m;
+ i__2 = *n - *m;
+ zlaset_("F", &i__1, &i__2, &c_b59, &c_b60, &vt[*m + 1 + (*m +
+ 1) * vt_dim1], ldvt);
+
+/*
+ Copy real matrix RWORK(IRVT) to complex matrix VT
+ Overwrite VT by right singular vectors of A
+ (CWorkspace: need 2*M+N, prefer 2*M+N*NB)
+ (RWorkspace: M*M)
+*/
+
+ zlaset_("F", n, n, &c_b59, &c_b59, &vt[vt_offset], ldvt);
+ zlacp2_("F", m, m, &rwork[irvt], m, &vt[vt_offset], ldvt);
+ i__1 = *lwork - nwork + 1;
+ zunmbr_("P", "R", "C", n, n, m, &a[a_offset], lda, &work[
+ itaup], &vt[vt_offset], ldvt, &work[nwork], &i__1, &
+ ierr);
+ }
+
+ }
+
+ }
+
+/* Undo scaling if necessary */
+
+ if (iscl == 1) {
+ if (anrm > bignum) {
+ dlascl_("G", &c__0, &c__0, &bignum, &anrm, &minmn, &c__1, &s[1], &
+ minmn, &ierr);
+ }
+ if (anrm < smlnum) {
+ dlascl_("G", &c__0, &c__0, &smlnum, &anrm, &minmn, &c__1, &s[1], &
+ minmn, &ierr);
+ }
+ }
+
+/* Return optimal workspace in WORK(1) */
+
+ work[1].r = (doublereal) maxwrk, work[1].i = 0.;
+
+ return 0;
+
+/* End of ZGESDD */
+
+} /* zgesdd_ */
+
+/* Subroutine */ int zgesv_(integer *n, integer *nrhs, doublecomplex *a,
+ integer *lda, integer *ipiv, doublecomplex *b, integer *ldb, integer *
+ info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1;
+
+ /* Local variables */
+ extern /* Subroutine */ int xerbla_(char *, integer *), zgetrf_(
+ integer *, integer *, doublecomplex *, integer *, integer *,
+ integer *), zgetrs_(char *, integer *, integer *, doublecomplex *,
+ integer *, integer *, doublecomplex *, integer *, integer *);
+
+
+/*
+ -- LAPACK driver routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ March 31, 1993
+
+
+ Purpose
+ =======
+
+ ZGESV computes the solution to a complex system of linear equations
+ A * X = B,
+ where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
+
+ The LU decomposition with partial pivoting and row interchanges is
+ used to factor A as
+ A = P * L * U,
+ where P is a permutation matrix, L is unit lower triangular, and U is
+ upper triangular. The factored form of A is then used to solve the
+ system of equations A * X = B.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of linear equations, i.e., the order of the
+ matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the N-by-N coefficient matrix A.
+ On exit, the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (output) INTEGER array, dimension (N)
+ The pivot indices that define the permutation matrix P;
+ row i of the matrix was interchanged with row IPIV(i).
+
+ B (input/output) COMPLEX*16 array, dimension (LDB,NRHS)
+ On entry, the N-by-NRHS matrix of right hand side matrix B.
+ On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+ singular, so the solution could not be computed.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --ipiv;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+
+ /* Function Body */
+ *info = 0;
+ if (*n < 0) {
+ *info = -1;
+ } else if (*nrhs < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*n)) {
+ *info = -4;
+ } else if (*ldb < max(1,*n)) {
+ *info = -7;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGESV ", &i__1);
+ return 0;
+ }
+
+/* Compute the LU factorization of A. */
+
+ zgetrf_(n, n, &a[a_offset], lda, &ipiv[1], info);
+ if (*info == 0) {
+
+/* Solve the system A*X = B, overwriting B with X. */
+
+ zgetrs_("No transpose", n, nrhs, &a[a_offset], lda, &ipiv[1], &b[
+ b_offset], ldb, info);
+ }
+ return 0;
+
+/* End of ZGESV */
+
+} /* zgesv_ */
+
+/* Subroutine */ int zgetf2_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+ doublecomplex z__1;
+
+ /* Builtin functions */
+ void z_div(doublecomplex *, doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer j, jp;
+ extern /* Subroutine */ int zscal_(integer *, doublecomplex *,
+ doublecomplex *, integer *), zgeru_(integer *, integer *,
+ doublecomplex *, doublecomplex *, integer *, doublecomplex *,
+ integer *, doublecomplex *, integer *), zswap_(integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(
+ char *, integer *);
+ extern integer izamax_(integer *, doublecomplex *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZGETF2 computes an LU factorization of a general m-by-n matrix A
+ using partial pivoting with row interchanges.
+
+ The factorization has the form
+ A = P * L * U
+ where P is a permutation matrix, L is lower triangular with unit
+ diagonal elements (lower trapezoidal if m > n), and U is upper
+ triangular (upper trapezoidal if m < n).
+
+ This is the right-looking Level 2 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the m by n matrix to be factored.
+ On exit, the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, U(k,k) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+ to solve a system of equations.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --ipiv;
+
+ /* Function Body */
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGETF2", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0) {
+ return 0;
+ }
+
+ i__1 = min(*m,*n);
+ for (j = 1; j <= i__1; ++j) {
+
+/* Find pivot and test for singularity. */
+
+ i__2 = *m - j + 1;
+ jp = j - 1 + izamax_(&i__2, &a[j + j * a_dim1], &c__1);
+ ipiv[j] = jp;
+ i__2 = jp + j * a_dim1;
+ if (a[i__2].r != 0. || a[i__2].i != 0.) {
+
+/* Apply the interchange to columns 1:N. */
+
+ if (jp != j) {
+ zswap_(n, &a[j + a_dim1], lda, &a[jp + a_dim1], lda);
+ }
+
+/* Compute elements J+1:M of J-th column. */
+
+ if (j < *m) {
+ i__2 = *m - j;
+ z_div(&z__1, &c_b60, &a[j + j * a_dim1]);
+ zscal_(&i__2, &z__1, &a[j + 1 + j * a_dim1], &c__1);
+ }
+
+ } else if (*info == 0) {
+
+ *info = j;
+ }
+
+ if (j < min(*m,*n)) {
+
+/* Update trailing submatrix. */
+
+ i__2 = *m - j;
+ i__3 = *n - j;
+ z__1.r = -1., z__1.i = -0.;
+ zgeru_(&i__2, &i__3, &z__1, &a[j + 1 + j * a_dim1], &c__1, &a[j +
+ (j + 1) * a_dim1], lda, &a[j + 1 + (j + 1) * a_dim1], lda)
+ ;
+ }
+/* L10: */
+ }
+ return 0;
+
+/* End of ZGETF2 */
+
+} /* zgetf2_ */
+
+/* Subroutine */ int zgetrf_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer i__, j, jb, nb, iinfo;
+ extern /* Subroutine */ int zgemm_(char *, char *, integer *, integer *,
+ integer *, doublecomplex *, doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *), ztrsm_(char *, char *, char *, char *,
+ integer *, integer *, doublecomplex *, doublecomplex *, integer *
+ , doublecomplex *, integer *),
+ zgetf2_(integer *, integer *, doublecomplex *, integer *, integer
+ *, integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int zlaswp_(integer *, doublecomplex *, integer *,
+ integer *, integer *, integer *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZGETRF computes an LU factorization of a general M-by-N matrix A
+ using partial pivoting with row interchanges.
+
+ The factorization has the form
+ A = P * L * U
+ where P is a permutation matrix, L is lower triangular with unit
+ diagonal elements (lower trapezoidal if m > n), and U is upper
+ triangular (upper trapezoidal if m < n).
+
+ This is the right-looking Level 3 BLAS version of the algorithm.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the M-by-N matrix to be factored.
+ On exit, the factors L and U from the factorization
+ A = P*L*U; the unit diagonal elements of L are not stored.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ IPIV (output) INTEGER array, dimension (min(M,N))
+ The pivot indices; for 1 <= i <= min(M,N), row i of the
+ matrix was interchanged with row IPIV(i).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, U(i,i) is exactly zero. The factorization
+ has been completed, but the factor U is exactly
+ singular, and division by zero will occur if it is used
+ to solve a system of equations.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --ipiv;
+
+ /* Function Body */
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGETRF", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0) {
+ return 0;
+ }
+
+/* Determine the block size for this environment. */
+
+ nb = ilaenv_(&c__1, "ZGETRF", " ", m, n, &c_n1, &c_n1, (ftnlen)6, (ftnlen)
+ 1);
+ if (nb <= 1 || nb >= min(*m,*n)) {
+
+/* Use unblocked code. */
+
+ zgetf2_(m, n, &a[a_offset], lda, &ipiv[1], info);
+ } else {
+
+/* Use blocked code. */
+
+ i__1 = min(*m,*n);
+ i__2 = nb;
+ for (j = 1; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
+/* Computing MIN */
+ i__3 = min(*m,*n) - j + 1;
+ jb = min(i__3,nb);
+
+/*
+ Factor diagonal and subdiagonal blocks and test for exact
+ singularity.
+*/
+
+ i__3 = *m - j + 1;
+ zgetf2_(&i__3, &jb, &a[j + j * a_dim1], lda, &ipiv[j], &iinfo);
+
+/* Adjust INFO and the pivot indices. */
+
+ if ((*info == 0 && iinfo > 0)) {
+ *info = iinfo + j - 1;
+ }
+/* Computing MIN */
+ i__4 = *m, i__5 = j + jb - 1;
+ i__3 = min(i__4,i__5);
+ for (i__ = j; i__ <= i__3; ++i__) {
+ ipiv[i__] = j - 1 + ipiv[i__];
+/* L10: */
+ }
+
+/* Apply interchanges to columns 1:J-1. */
+
+ i__3 = j - 1;
+ i__4 = j + jb - 1;
+ zlaswp_(&i__3, &a[a_offset], lda, &j, &i__4, &ipiv[1], &c__1);
+
+ if (j + jb <= *n) {
+
+/* Apply interchanges to columns J+JB:N. */
+
+ i__3 = *n - j - jb + 1;
+ i__4 = j + jb - 1;
+ zlaswp_(&i__3, &a[(j + jb) * a_dim1 + 1], lda, &j, &i__4, &
+ ipiv[1], &c__1);
+
+/* Compute block row of U. */
+
+ i__3 = *n - j - jb + 1;
+ ztrsm_("Left", "Lower", "No transpose", "Unit", &jb, &i__3, &
+ c_b60, &a[j + j * a_dim1], lda, &a[j + (j + jb) *
+ a_dim1], lda);
+ if (j + jb <= *m) {
+
+/* Update trailing submatrix. */
+
+ i__3 = *m - j - jb + 1;
+ i__4 = *n - j - jb + 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemm_("No transpose", "No transpose", &i__3, &i__4, &jb,
+ &z__1, &a[j + jb + j * a_dim1], lda, &a[j + (j +
+ jb) * a_dim1], lda, &c_b60, &a[j + jb + (j + jb) *
+ a_dim1], lda);
+ }
+ }
+/* L20: */
+ }
+ }
+ return 0;
+
+/* End of ZGETRF */
+
+} /* zgetrf_ */
+
+/* Subroutine */ int zgetrs_(char *trans, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, integer *ipiv, doublecomplex *b,
+ integer *ldb, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1;
+
+ /* Local variables */
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int ztrsm_(char *, char *, char *, char *,
+ integer *, integer *, doublecomplex *, doublecomplex *, integer *,
+ doublecomplex *, integer *),
+ xerbla_(char *, integer *);
+ static logical notran;
+ extern /* Subroutine */ int zlaswp_(integer *, doublecomplex *, integer *,
+ integer *, integer *, integer *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZGETRS solves a system of linear equations
+ A * X = B, A**T * X = B, or A**H * X = B
+ with a general N-by-N matrix A using the LU factorization computed
+ by ZGETRF.
+
+ Arguments
+ =========
+
+ TRANS (input) CHARACTER*1
+ Specifies the form of the system of equations:
+ = 'N': A * X = B (No transpose)
+ = 'T': A**T * X = B (Transpose)
+ = 'C': A**H * X = B (Conjugate transpose)
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of right hand sides, i.e., the number of columns
+ of the matrix B. NRHS >= 0.
+
+ A (input) COMPLEX*16 array, dimension (LDA,N)
+ The factors L and U from the factorization A = P*L*U
+ as computed by ZGETRF.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ IPIV (input) INTEGER array, dimension (N)
+ The pivot indices from ZGETRF; for 1<=i<=N, row i of the
+ matrix was interchanged with row IPIV(i).
+
+ B (input/output) COMPLEX*16 array, dimension (LDB,NRHS)
+ On entry, the right hand side matrix B.
+ On exit, the solution matrix X.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --ipiv;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+
+ /* Function Body */
+ *info = 0;
+ notran = lsame_(trans, "N");
+ if (((! notran && ! lsame_(trans, "T")) && ! lsame_(
+ trans, "C"))) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*nrhs < 0) {
+ *info = -3;
+ } else if (*lda < max(1,*n)) {
+ *info = -5;
+ } else if (*ldb < max(1,*n)) {
+ *info = -8;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZGETRS", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0 || *nrhs == 0) {
+ return 0;
+ }
+
+ if (notran) {
+
+/*
+ Solve A * X = B.
+
+ Apply row interchanges to the right hand sides.
+*/
+
+ zlaswp_(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c__1);
+
+/* Solve L*X = B, overwriting B with X. */
+
+ ztrsm_("Left", "Lower", "No transpose", "Unit", n, nrhs, &c_b60, &a[
+ a_offset], lda, &b[b_offset], ldb);
+
+/* Solve U*X = B, overwriting B with X. */
+
+ ztrsm_("Left", "Upper", "No transpose", "Non-unit", n, nrhs, &c_b60, &
+ a[a_offset], lda, &b[b_offset], ldb);
+ } else {
+
+/*
+ Solve A**T * X = B or A**H * X = B.
+
+ Solve U'*X = B, overwriting B with X.
+*/
+
+ ztrsm_("Left", "Upper", trans, "Non-unit", n, nrhs, &c_b60, &a[
+ a_offset], lda, &b[b_offset], ldb);
+
+/* Solve L'*X = B, overwriting B with X. */
+
+ ztrsm_("Left", "Lower", trans, "Unit", n, nrhs, &c_b60, &a[a_offset],
+ lda, &b[b_offset], ldb);
+
+/* Apply row interchanges to the solution vectors. */
+
+ zlaswp_(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c_n1);
+ }
+
+ return 0;
+
+/* End of ZGETRS */
+
+} /* zgetrs_ */
+
+/* Subroutine */ int zheevd_(char *jobz, char *uplo, integer *n,
+ doublecomplex *a, integer *lda, doublereal *w, doublecomplex *work,
+ integer *lwork, doublereal *rwork, integer *lrwork, integer *iwork,
+ integer *liwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+ doublereal d__1, d__2;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static doublereal eps;
+ static integer inde;
+ static doublereal anrm;
+ static integer imax;
+ static doublereal rmin, rmax;
+ static integer lopt;
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *);
+ static doublereal sigma;
+ extern logical lsame_(char *, char *);
+ static integer iinfo, lwmin, liopt;
+ static logical lower;
+ static integer llrwk, lropt;
+ static logical wantz;
+ static integer indwk2, llwrk2;
+
+ static integer iscale;
+ static doublereal safmin;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static doublereal bignum;
+ extern doublereal zlanhe_(char *, char *, integer *, doublecomplex *,
+ integer *, doublereal *);
+ static integer indtau;
+ extern /* Subroutine */ int dsterf_(integer *, doublereal *, doublereal *,
+ integer *), zlascl_(char *, integer *, integer *, doublereal *,
+ doublereal *, integer *, integer *, doublecomplex *, integer *,
+ integer *), zstedc_(char *, integer *, doublereal *,
+ doublereal *, doublecomplex *, integer *, doublecomplex *,
+ integer *, doublereal *, integer *, integer *, integer *, integer
+ *);
+ static integer indrwk, indwrk, liwmin;
+ extern /* Subroutine */ int zhetrd_(char *, integer *, doublecomplex *,
+ integer *, doublereal *, doublereal *, doublecomplex *,
+ doublecomplex *, integer *, integer *), zlacpy_(char *,
+ integer *, integer *, doublecomplex *, integer *, doublecomplex *,
+ integer *);
+ static integer lrwmin, llwork;
+ static doublereal smlnum;
+ static logical lquery;
+ extern /* Subroutine */ int zunmtr_(char *, char *, char *, integer *,
+ integer *, doublecomplex *, integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *, integer *);
+
+
+/*
+ -- LAPACK driver routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZHEEVD computes all eigenvalues and, optionally, eigenvectors of a
+ complex Hermitian matrix A. If eigenvectors are desired, it uses a
+ divide and conquer algorithm.
+
+ The divide and conquer algorithm makes very mild assumptions about
+ floating point arithmetic. It will work on machines with a guard
+ digit in add/subtract, or on those binary machines without guard
+ digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
+ Cray-2. It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ JOBZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only;
+ = 'V': Compute eigenvalues and eigenvectors.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA, N)
+ On entry, the Hermitian matrix A. If UPLO = 'U', the
+ leading N-by-N upper triangular part of A contains the
+ upper triangular part of the matrix A. If UPLO = 'L',
+ the leading N-by-N lower triangular part of A contains
+ the lower triangular part of the matrix A.
+ On exit, if JOBZ = 'V', then if INFO = 0, A contains the
+ orthonormal eigenvectors of the matrix A.
+ If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
+ or the upper triangle (if UPLO='U') of A, including the
+ diagonal, is destroyed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ If INFO = 0, the eigenvalues in ascending order.
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The length of the array WORK.
+ If N <= 1, LWORK must be at least 1.
+ If JOBZ = 'N' and N > 1, LWORK must be at least N + 1.
+ If JOBZ = 'V' and N > 1, LWORK must be at least 2*N + N**2.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ RWORK (workspace/output) DOUBLE PRECISION array,
+ dimension (LRWORK)
+ On exit, if INFO = 0, RWORK(1) returns the optimal LRWORK.
+
+ LRWORK (input) INTEGER
+ The dimension of the array RWORK.
+ If N <= 1, LRWORK must be at least 1.
+ If JOBZ = 'N' and N > 1, LRWORK must be at least N.
+ If JOBZ = 'V' and N > 1, LRWORK must be at least
+ 1 + 5*N + 2*N**2.
+
+ If LRWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the RWORK array,
+ returns this value as the first entry of the RWORK array, and
+ no error message related to LRWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (LIWORK)
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If N <= 1, LIWORK must be at least 1.
+ If JOBZ = 'N' and N > 1, LIWORK must be at least 1.
+ If JOBZ = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the algorithm failed to converge; i
+ off-diagonal elements of an intermediate tridiagonal
+ form did not converge to zero.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --w;
+ --work;
+ --rwork;
+ --iwork;
+
+ /* Function Body */
+ wantz = lsame_(jobz, "V");
+ lower = lsame_(uplo, "L");
+ lquery = *lwork == -1 || *lrwork == -1 || *liwork == -1;
+
+ *info = 0;
+ if (*n <= 1) {
+ lwmin = 1;
+ lrwmin = 1;
+ liwmin = 1;
+ lopt = lwmin;
+ lropt = lrwmin;
+ liopt = liwmin;
+ } else {
+ if (wantz) {
+ lwmin = ((*n) << (1)) + *n * *n;
+/* Computing 2nd power */
+ i__1 = *n;
+ lrwmin = *n * 5 + 1 + ((i__1 * i__1) << (1));
+ liwmin = *n * 5 + 3;
+ } else {
+ lwmin = *n + 1;
+ lrwmin = *n;
+ liwmin = 1;
+ }
+ lopt = lwmin;
+ lropt = lrwmin;
+ liopt = liwmin;
+ }
+ if (! (wantz || lsame_(jobz, "N"))) {
+ *info = -1;
+ } else if (! (lower || lsame_(uplo, "U"))) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*lda < max(1,*n)) {
+ *info = -5;
+ } else if ((*lwork < lwmin && ! lquery)) {
+ *info = -8;
+ } else if ((*lrwork < lrwmin && ! lquery)) {
+ *info = -10;
+ } else if ((*liwork < liwmin && ! lquery)) {
+ *info = -12;
+ }
+
+ if (*info == 0) {
+ work[1].r = (doublereal) lopt, work[1].i = 0.;
+ rwork[1] = (doublereal) lropt;
+ iwork[1] = liopt;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZHEEVD", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+ if (*n == 1) {
+ i__1 = a_dim1 + 1;
+ w[1] = a[i__1].r;
+ if (wantz) {
+ i__1 = a_dim1 + 1;
+ a[i__1].r = 1., a[i__1].i = 0.;
+ }
+ return 0;
+ }
+
+/* Get machine constants. */
+
+ safmin = SAFEMINIMUM;
+ eps = PRECISION;
+ smlnum = safmin / eps;
+ bignum = 1. / smlnum;
+ rmin = sqrt(smlnum);
+ rmax = sqrt(bignum);
+
+/* Scale matrix to allowable range, if necessary. */
+
+ anrm = zlanhe_("M", uplo, n, &a[a_offset], lda, &rwork[1]);
+ iscale = 0;
+ if ((anrm > 0. && anrm < rmin)) {
+ iscale = 1;
+ sigma = rmin / anrm;
+ } else if (anrm > rmax) {
+ iscale = 1;
+ sigma = rmax / anrm;
+ }
+ if (iscale == 1) {
+ zlascl_(uplo, &c__0, &c__0, &c_b1015, &sigma, n, n, &a[a_offset], lda,
+ info);
+ }
+
+/* Call ZHETRD to reduce Hermitian matrix to tridiagonal form. */
+
+ inde = 1;
+ indtau = 1;
+ indwrk = indtau + *n;
+ indrwk = inde + *n;
+ indwk2 = indwrk + *n * *n;
+ llwork = *lwork - indwrk + 1;
+ llwrk2 = *lwork - indwk2 + 1;
+ llrwk = *lrwork - indrwk + 1;
+ zhetrd_(uplo, n, &a[a_offset], lda, &w[1], &rwork[inde], &work[indtau], &
+ work[indwrk], &llwork, &iinfo);
+/* Computing MAX */
+ i__1 = indwrk;
+ d__1 = (doublereal) lopt, d__2 = (doublereal) (*n) + work[i__1].r;
+ lopt = (integer) max(d__1,d__2);
+
+/*
+ For eigenvalues only, call DSTERF. For eigenvectors, first call
+ ZSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the
+ tridiagonal matrix, then call ZUNMTR to multiply it to the
+ Householder transformations represented as Householder vectors in
+ A.
+*/
+
+ if (! wantz) {
+ dsterf_(n, &w[1], &rwork[inde], info);
+ } else {
+ zstedc_("I", n, &w[1], &rwork[inde], &work[indwrk], n, &work[indwk2],
+ &llwrk2, &rwork[indrwk], &llrwk, &iwork[1], liwork, info);
+ zunmtr_("L", uplo, "N", n, n, &a[a_offset], lda, &work[indtau], &work[
+ indwrk], n, &work[indwk2], &llwrk2, &iinfo);
+ zlacpy_("A", n, n, &work[indwrk], n, &a[a_offset], lda);
+/*
+ Computing MAX
+ Computing 2nd power
+*/
+ i__3 = *n;
+ i__4 = indwk2;
+ i__1 = lopt, i__2 = *n + i__3 * i__3 + (integer) work[i__4].r;
+ lopt = max(i__1,i__2);
+ }
+
+/* If matrix was scaled, then rescale eigenvalues appropriately. */
+
+ if (iscale == 1) {
+ if (*info == 0) {
+ imax = *n;
+ } else {
+ imax = *info - 1;
+ }
+ d__1 = 1. / sigma;
+ dscal_(&imax, &d__1, &w[1], &c__1);
+ }
+
+ work[1].r = (doublereal) lopt, work[1].i = 0.;
+ rwork[1] = (doublereal) lropt;
+ iwork[1] = liopt;
+
+ return 0;
+
+/* End of ZHEEVD */
+
+} /* zheevd_ */
+
+/* Subroutine */ int zhetd2_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, doublereal *d__, doublereal *e, doublecomplex *tau,
+ integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+ doublereal d__1;
+ doublecomplex z__1, z__2, z__3, z__4;
+
+ /* Local variables */
+ static integer i__;
+ static doublecomplex taui;
+ extern /* Subroutine */ int zher2_(char *, integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *);
+ static doublecomplex alpha;
+ extern logical lsame_(char *, char *);
+ extern /* Double Complex */ VOID zdotc_(doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *);
+ extern /* Subroutine */ int zhemv_(char *, integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *,
+ doublecomplex *, doublecomplex *, integer *);
+ static logical upper;
+ extern /* Subroutine */ int zaxpy_(integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(
+ char *, integer *), zlarfg_(integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1999
+
+
+ Purpose
+ =======
+
+ ZHETD2 reduces a complex Hermitian matrix A to real symmetric
+ tridiagonal form T by a unitary similarity transformation:
+ Q' * A * Q = T.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ Hermitian matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the Hermitian matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit, if UPLO = 'U', the diagonal and first superdiagonal
+ of A are overwritten by the corresponding elements of the
+ tridiagonal matrix T, and the elements above the first
+ superdiagonal, with the array TAU, represent the unitary
+ matrix Q as a product of elementary reflectors; if UPLO
+ = 'L', the diagonal and first subdiagonal of A are over-
+ written by the corresponding elements of the tridiagonal
+ matrix T, and the elements below the first subdiagonal, with
+ the array TAU, represent the unitary matrix Q as a product
+ of elementary reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ D (output) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T:
+ D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
+
+ TAU (output) COMPLEX*16 array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+ Details).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n-1) . . . H(2) H(1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a complex scalar, and v is a complex vector with
+ v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
+ A(1:i-1,i+1), and tau in TAU(i).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(n-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a complex scalar, and v is a complex vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
+ and tau in TAU(i).
+
+ The contents of A on exit are illustrated by the following examples
+ with n = 5:
+
+ if UPLO = 'U': if UPLO = 'L':
+
+ ( d e v2 v3 v4 ) ( d )
+ ( d e v3 v4 ) ( e d )
+ ( d e v4 ) ( v1 e d )
+ ( d e ) ( v1 v2 e d )
+ ( d ) ( v1 v2 v3 e d )
+
+ where d and e denote diagonal and off-diagonal elements of T, and vi
+ denotes an element of the vector defining H(i).
+
+ =====================================================================
+
+
+ Test the input parameters
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --d__;
+ --e;
+ --tau;
+
+ /* Function Body */
+ *info = 0;
+ upper = lsame_(uplo, "U");
+ if ((! upper && ! lsame_(uplo, "L"))) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*n)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZHETD2", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n <= 0) {
+ return 0;
+ }
+
+ if (upper) {
+
+/* Reduce the upper triangle of A */
+
+ i__1 = *n + *n * a_dim1;
+ i__2 = *n + *n * a_dim1;
+ d__1 = a[i__2].r;
+ a[i__1].r = d__1, a[i__1].i = 0.;
+ for (i__ = *n - 1; i__ >= 1; --i__) {
+
+/*
+ Generate elementary reflector H(i) = I - tau * v * v'
+ to annihilate A(1:i-1,i+1)
+*/
+
+ i__1 = i__ + (i__ + 1) * a_dim1;
+ alpha.r = a[i__1].r, alpha.i = a[i__1].i;
+ zlarfg_(&i__, &alpha, &a[(i__ + 1) * a_dim1 + 1], &c__1, &taui);
+ i__1 = i__;
+ e[i__1] = alpha.r;
+
+ if (taui.r != 0. || taui.i != 0.) {
+
+/* Apply H(i) from both sides to A(1:i,1:i) */
+
+ i__1 = i__ + (i__ + 1) * a_dim1;
+ a[i__1].r = 1., a[i__1].i = 0.;
+
+/* Compute x := tau * A * v storing x in TAU(1:i) */
+
+ zhemv_(uplo, &i__, &taui, &a[a_offset], lda, &a[(i__ + 1) *
+ a_dim1 + 1], &c__1, &c_b59, &tau[1], &c__1)
+ ;
+
+/* Compute w := x - 1/2 * tau * (x'*v) * v */
+
+ z__3.r = -.5, z__3.i = -0.;
+ z__2.r = z__3.r * taui.r - z__3.i * taui.i, z__2.i = z__3.r *
+ taui.i + z__3.i * taui.r;
+ zdotc_(&z__4, &i__, &tau[1], &c__1, &a[(i__ + 1) * a_dim1 + 1]
+ , &c__1);
+ z__1.r = z__2.r * z__4.r - z__2.i * z__4.i, z__1.i = z__2.r *
+ z__4.i + z__2.i * z__4.r;
+ alpha.r = z__1.r, alpha.i = z__1.i;
+ zaxpy_(&i__, &alpha, &a[(i__ + 1) * a_dim1 + 1], &c__1, &tau[
+ 1], &c__1);
+
+/*
+ Apply the transformation as a rank-2 update:
+ A := A - v * w' - w * v'
+*/
+
+ z__1.r = -1., z__1.i = -0.;
+ zher2_(uplo, &i__, &z__1, &a[(i__ + 1) * a_dim1 + 1], &c__1, &
+ tau[1], &c__1, &a[a_offset], lda);
+
+ } else {
+ i__1 = i__ + i__ * a_dim1;
+ i__2 = i__ + i__ * a_dim1;
+ d__1 = a[i__2].r;
+ a[i__1].r = d__1, a[i__1].i = 0.;
+ }
+ i__1 = i__ + (i__ + 1) * a_dim1;
+ i__2 = i__;
+ a[i__1].r = e[i__2], a[i__1].i = 0.;
+ i__1 = i__ + 1;
+ i__2 = i__ + 1 + (i__ + 1) * a_dim1;
+ d__[i__1] = a[i__2].r;
+ i__1 = i__;
+ tau[i__1].r = taui.r, tau[i__1].i = taui.i;
+/* L10: */
+ }
+ i__1 = a_dim1 + 1;
+ d__[1] = a[i__1].r;
+ } else {
+
+/* Reduce the lower triangle of A */
+
+ i__1 = a_dim1 + 1;
+ i__2 = a_dim1 + 1;
+ d__1 = a[i__2].r;
+ a[i__1].r = d__1, a[i__1].i = 0.;
+ i__1 = *n - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/*
+ Generate elementary reflector H(i) = I - tau * v * v'
+ to annihilate A(i+2:n,i)
+*/
+
+ i__2 = i__ + 1 + i__ * a_dim1;
+ alpha.r = a[i__2].r, alpha.i = a[i__2].i;
+ i__2 = *n - i__;
+/* Computing MIN */
+ i__3 = i__ + 2;
+ zlarfg_(&i__2, &alpha, &a[min(i__3,*n) + i__ * a_dim1], &c__1, &
+ taui);
+ i__2 = i__;
+ e[i__2] = alpha.r;
+
+ if (taui.r != 0. || taui.i != 0.) {
+
+/* Apply H(i) from both sides to A(i+1:n,i+1:n) */
+
+ i__2 = i__ + 1 + i__ * a_dim1;
+ a[i__2].r = 1., a[i__2].i = 0.;
+
+/* Compute x := tau * A * v storing y in TAU(i:n-1) */
+
+ i__2 = *n - i__;
+ zhemv_(uplo, &i__2, &taui, &a[i__ + 1 + (i__ + 1) * a_dim1],
+ lda, &a[i__ + 1 + i__ * a_dim1], &c__1, &c_b59, &tau[
+ i__], &c__1);
+
+/* Compute w := x - 1/2 * tau * (x'*v) * v */
+
+ z__3.r = -.5, z__3.i = -0.;
+ z__2.r = z__3.r * taui.r - z__3.i * taui.i, z__2.i = z__3.r *
+ taui.i + z__3.i * taui.r;
+ i__2 = *n - i__;
+ zdotc_(&z__4, &i__2, &tau[i__], &c__1, &a[i__ + 1 + i__ *
+ a_dim1], &c__1);
+ z__1.r = z__2.r * z__4.r - z__2.i * z__4.i, z__1.i = z__2.r *
+ z__4.i + z__2.i * z__4.r;
+ alpha.r = z__1.r, alpha.i = z__1.i;
+ i__2 = *n - i__;
+ zaxpy_(&i__2, &alpha, &a[i__ + 1 + i__ * a_dim1], &c__1, &tau[
+ i__], &c__1);
+
+/*
+ Apply the transformation as a rank-2 update:
+ A := A - v * w' - w * v'
+*/
+
+ i__2 = *n - i__;
+ z__1.r = -1., z__1.i = -0.;
+ zher2_(uplo, &i__2, &z__1, &a[i__ + 1 + i__ * a_dim1], &c__1,
+ &tau[i__], &c__1, &a[i__ + 1 + (i__ + 1) * a_dim1],
+ lda);
+
+ } else {
+ i__2 = i__ + 1 + (i__ + 1) * a_dim1;
+ i__3 = i__ + 1 + (i__ + 1) * a_dim1;
+ d__1 = a[i__3].r;
+ a[i__2].r = d__1, a[i__2].i = 0.;
+ }
+ i__2 = i__ + 1 + i__ * a_dim1;
+ i__3 = i__;
+ a[i__2].r = e[i__3], a[i__2].i = 0.;
+ i__2 = i__;
+ i__3 = i__ + i__ * a_dim1;
+ d__[i__2] = a[i__3].r;
+ i__2 = i__;
+ tau[i__2].r = taui.r, tau[i__2].i = taui.i;
+/* L20: */
+ }
+ i__1 = *n;
+ i__2 = *n + *n * a_dim1;
+ d__[i__1] = a[i__2].r;
+ }
+
+ return 0;
+
+/* End of ZHETD2 */
+
+} /* zhetd2_ */
+
+/* Subroutine */ int zhetrd_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, doublereal *d__, doublereal *e, doublecomplex *tau,
+ doublecomplex *work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer i__, j, nb, kk, nx, iws;
+ extern logical lsame_(char *, char *);
+ static integer nbmin, iinfo;
+ static logical upper;
+ extern /* Subroutine */ int zhetd2_(char *, integer *, doublecomplex *,
+ integer *, doublereal *, doublereal *, doublecomplex *, integer *), zher2k_(char *, char *, integer *, integer *,
+ doublecomplex *, doublecomplex *, integer *, doublecomplex *,
+ integer *, doublereal *, doublecomplex *, integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int zlatrd_(char *, integer *, integer *,
+ doublecomplex *, integer *, doublereal *, doublecomplex *,
+ doublecomplex *, integer *);
+ static integer ldwork, lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZHETRD reduces a complex Hermitian matrix A to real symmetric
+ tridiagonal form T by a unitary similarity transformation:
+ Q**H * A * Q = T.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the Hermitian matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit, if UPLO = 'U', the diagonal and first superdiagonal
+ of A are overwritten by the corresponding elements of the
+ tridiagonal matrix T, and the elements above the first
+ superdiagonal, with the array TAU, represent the unitary
+ matrix Q as a product of elementary reflectors; if UPLO
+ = 'L', the diagonal and first subdiagonal of A are over-
+ written by the corresponding elements of the tridiagonal
+ matrix T, and the elements below the first subdiagonal, with
+ the array TAU, represent the unitary matrix Q as a product
+ of elementary reflectors. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ D (output) DOUBLE PRECISION array, dimension (N)
+ The diagonal elements of the tridiagonal matrix T:
+ D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (N-1)
+ The off-diagonal elements of the tridiagonal matrix T:
+ E(i) = A(i,i+1) if UPLO = 'U', E(i) = A(i+1,i) if UPLO = 'L'.
+
+ TAU (output) COMPLEX*16 array, dimension (N-1)
+ The scalar factors of the elementary reflectors (see Further
+ Details).
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= 1.
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n-1) . . . H(2) H(1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a complex scalar, and v is a complex vector with
+ v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in
+ A(1:i-1,i+1), and tau in TAU(i).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(n-1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a complex scalar, and v is a complex vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i),
+ and tau in TAU(i).
+
+ The contents of A on exit are illustrated by the following examples
+ with n = 5:
+
+ if UPLO = 'U': if UPLO = 'L':
+
+ ( d e v2 v3 v4 ) ( d )
+ ( d e v3 v4 ) ( e d )
+ ( d e v4 ) ( v1 e d )
+ ( d e ) ( v1 v2 e d )
+ ( d ) ( v1 v2 v3 e d )
+
+ where d and e denote diagonal and off-diagonal elements of T, and vi
+ denotes an element of the vector defining H(i).
+
+ =====================================================================
+
+
+ Test the input parameters
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --d__;
+ --e;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ upper = lsame_(uplo, "U");
+ lquery = *lwork == -1;
+ if ((! upper && ! lsame_(uplo, "L"))) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*n)) {
+ *info = -4;
+ } else if ((*lwork < 1 && ! lquery)) {
+ *info = -9;
+ }
+
+ if (*info == 0) {
+
+/* Determine the block size. */
+
+ nb = ilaenv_(&c__1, "ZHETRD", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6,
+ (ftnlen)1);
+ lwkopt = *n * nb;
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZHETRD", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ work[1].r = 1., work[1].i = 0.;
+ return 0;
+ }
+
+ nx = *n;
+ iws = 1;
+ if ((nb > 1 && nb < *n)) {
+
+/*
+ Determine when to cross over from blocked to unblocked code
+ (last block is always handled by unblocked code).
+
+ Computing MAX
+*/
+ i__1 = nb, i__2 = ilaenv_(&c__3, "ZHETRD", uplo, n, &c_n1, &c_n1, &
+ c_n1, (ftnlen)6, (ftnlen)1);
+ nx = max(i__1,i__2);
+ if (nx < *n) {
+
+/* Determine if workspace is large enough for blocked code. */
+
+ ldwork = *n;
+ iws = ldwork * nb;
+ if (*lwork < iws) {
+
+/*
+ Not enough workspace to use optimal NB: determine the
+ minimum value of NB, and reduce NB or force use of
+ unblocked code by setting NX = N.
+
+ Computing MAX
+*/
+ i__1 = *lwork / ldwork;
+ nb = max(i__1,1);
+ nbmin = ilaenv_(&c__2, "ZHETRD", uplo, n, &c_n1, &c_n1, &c_n1,
+ (ftnlen)6, (ftnlen)1);
+ if (nb < nbmin) {
+ nx = *n;
+ }
+ }
+ } else {
+ nx = *n;
+ }
+ } else {
+ nb = 1;
+ }
+
+ if (upper) {
+
+/*
+ Reduce the upper triangle of A.
+ Columns 1:kk are handled by the unblocked method.
+*/
+
+ kk = *n - (*n - nx + nb - 1) / nb * nb;
+ i__1 = kk + 1;
+ i__2 = -nb;
+ for (i__ = *n - nb + 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ +=
+ i__2) {
+
+/*
+ Reduce columns i:i+nb-1 to tridiagonal form and form the
+ matrix W which is needed to update the unreduced part of
+ the matrix
+*/
+
+ i__3 = i__ + nb - 1;
+ zlatrd_(uplo, &i__3, &nb, &a[a_offset], lda, &e[1], &tau[1], &
+ work[1], &ldwork);
+
+/*
+ Update the unreduced submatrix A(1:i-1,1:i-1), using an
+ update of the form: A := A - V*W' - W*V'
+*/
+
+ i__3 = i__ - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zher2k_(uplo, "No transpose", &i__3, &nb, &z__1, &a[i__ * a_dim1
+ + 1], lda, &work[1], &ldwork, &c_b1015, &a[a_offset], lda);
+
+/*
+ Copy superdiagonal elements back into A, and diagonal
+ elements into D
+*/
+
+ i__3 = i__ + nb - 1;
+ for (j = i__; j <= i__3; ++j) {
+ i__4 = j - 1 + j * a_dim1;
+ i__5 = j - 1;
+ a[i__4].r = e[i__5], a[i__4].i = 0.;
+ i__4 = j;
+ i__5 = j + j * a_dim1;
+ d__[i__4] = a[i__5].r;
+/* L10: */
+ }
+/* L20: */
+ }
+
+/* Use unblocked code to reduce the last or only block */
+
+ zhetd2_(uplo, &kk, &a[a_offset], lda, &d__[1], &e[1], &tau[1], &iinfo);
+ } else {
+
+/* Reduce the lower triangle of A */
+
+ i__2 = *n - nx;
+ i__1 = nb;
+ for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {
+
+/*
+ Reduce columns i:i+nb-1 to tridiagonal form and form the
+ matrix W which is needed to update the unreduced part of
+ the matrix
+*/
+
+ i__3 = *n - i__ + 1;
+ zlatrd_(uplo, &i__3, &nb, &a[i__ + i__ * a_dim1], lda, &e[i__], &
+ tau[i__], &work[1], &ldwork);
+
+/*
+ Update the unreduced submatrix A(i+nb:n,i+nb:n), using
+ an update of the form: A := A - V*W' - W*V'
+*/
+
+ i__3 = *n - i__ - nb + 1;
+ z__1.r = -1., z__1.i = -0.;
+ zher2k_(uplo, "No transpose", &i__3, &nb, &z__1, &a[i__ + nb +
+ i__ * a_dim1], lda, &work[nb + 1], &ldwork, &c_b1015, &a[
+ i__ + nb + (i__ + nb) * a_dim1], lda);
+
+/*
+ Copy subdiagonal elements back into A, and diagonal
+ elements into D
+*/
+
+ i__3 = i__ + nb - 1;
+ for (j = i__; j <= i__3; ++j) {
+ i__4 = j + 1 + j * a_dim1;
+ i__5 = j;
+ a[i__4].r = e[i__5], a[i__4].i = 0.;
+ i__4 = j;
+ i__5 = j + j * a_dim1;
+ d__[i__4] = a[i__5].r;
+/* L30: */
+ }
+/* L40: */
+ }
+
+/* Use unblocked code to reduce the last or only block */
+
+ i__1 = *n - i__ + 1;
+ zhetd2_(uplo, &i__1, &a[i__ + i__ * a_dim1], lda, &d__[i__], &e[i__],
+ &tau[i__], &iinfo);
+ }
+
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ return 0;
+
+/* End of ZHETRD */
+
+} /* zhetrd_ */
+
+/* Subroutine */ int zhseqr_(char *job, char *compz, integer *n, integer *ilo,
+ integer *ihi, doublecomplex *h__, integer *ldh, doublecomplex *w,
+ doublecomplex *z__, integer *ldz, doublecomplex *work, integer *lwork,
+ integer *info)
+{
+ /* System generated locals */
+ address a__1[2];
+ integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4[2],
+ i__5, i__6;
+ doublereal d__1, d__2, d__3, d__4;
+ doublecomplex z__1;
+ char ch__1[2];
+
+ /* Builtin functions */
+ double d_imag(doublecomplex *);
+ void d_cnjg(doublecomplex *, doublecomplex *);
+ /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
+
+ /* Local variables */
+ static integer i__, j, k, l;
+ static doublecomplex s[225] /* was [15][15] */, v[16];
+ static integer i1, i2, ii, nh, nr, ns, nv;
+ static doublecomplex vv[16];
+ static integer itn;
+ static doublecomplex tau;
+ static integer its;
+ static doublereal ulp, tst1;
+ static integer maxb, ierr;
+ static doublereal unfl;
+ static doublecomplex temp;
+ static doublereal ovfl;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int zscal_(integer *, doublecomplex *,
+ doublecomplex *, integer *);
+ static integer itemp;
+ static doublereal rtemp;
+ extern /* Subroutine */ int zgemv_(char *, integer *, integer *,
+ doublecomplex *, doublecomplex *, integer *, doublecomplex *,
+ integer *, doublecomplex *, doublecomplex *, integer *);
+ static logical initz, wantt, wantz;
+ static doublereal rwork[1];
+ extern /* Subroutine */ int zcopy_(integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *);
+ extern doublereal dlapy2_(doublereal *, doublereal *);
+ extern /* Subroutine */ int dlabad_(doublereal *, doublereal *);
+
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int zdscal_(integer *, doublereal *,
+ doublecomplex *, integer *), zlarfg_(integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *);
+ extern integer izamax_(integer *, doublecomplex *, integer *);
+ extern doublereal zlanhs_(char *, integer *, doublecomplex *, integer *,
+ doublereal *);
+ extern /* Subroutine */ int zlahqr_(logical *, logical *, integer *,
+ integer *, integer *, doublecomplex *, integer *, doublecomplex *,
+ integer *, integer *, doublecomplex *, integer *, integer *),
+ zlacpy_(char *, integer *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *), zlaset_(char *, integer *,
+ integer *, doublecomplex *, doublecomplex *, doublecomplex *,
+ integer *), zlarfx_(char *, integer *, integer *,
+ doublecomplex *, doublecomplex *, doublecomplex *, integer *,
+ doublecomplex *);
+ static doublereal smlnum;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZHSEQR computes the eigenvalues of a complex upper Hessenberg
+ matrix H, and, optionally, the matrices T and Z from the Schur
+ decomposition H = Z T Z**H, where T is an upper triangular matrix
+ (the Schur form), and Z is the unitary matrix of Schur vectors.
+
+ Optionally Z may be postmultiplied into an input unitary matrix Q,
+ so that this routine can give the Schur factorization of a matrix A
+ which has been reduced to the Hessenberg form H by the unitary
+ matrix Q: A = Q*H*Q**H = (QZ)*T*(QZ)**H.
+
+ Arguments
+ =========
+
+ JOB (input) CHARACTER*1
+ = 'E': compute eigenvalues only;
+ = 'S': compute eigenvalues and the Schur form T.
+
+ COMPZ (input) CHARACTER*1
+ = 'N': no Schur vectors are computed;
+ = 'I': Z is initialized to the unit matrix and the matrix Z
+ of Schur vectors of H is returned;
+ = 'V': Z must contain an unitary matrix Q on entry, and
+ the product Q*Z is returned.
+
+ N (input) INTEGER
+ The order of the matrix H. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper triangular in rows
+ and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
+ set by a previous call to ZGEBAL, and then passed to CGEHRD
+ when the matrix output by ZGEBAL is reduced to Hessenberg
+ form. Otherwise ILO and IHI should be set to 1 and N
+ respectively.
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ H (input/output) COMPLEX*16 array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if JOB = 'S', H contains the upper triangular matrix
+ T from the Schur decomposition (the Schur form). If
+ JOB = 'E', the contents of H are unspecified on exit.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max(1,N).
+
+ W (output) COMPLEX*16 array, dimension (N)
+ The computed eigenvalues. If JOB = 'S', the eigenvalues are
+ stored in the same order as on the diagonal of the Schur form
+ returned in H, with W(i) = H(i,i).
+
+ Z (input/output) COMPLEX*16 array, dimension (LDZ,N)
+ If COMPZ = 'N': Z is not referenced.
+ If COMPZ = 'I': on entry, Z need not be set, and on exit, Z
+ contains the unitary matrix Z of the Schur vectors of H.
+ If COMPZ = 'V': on entry Z must contain an N-by-N matrix Q,
+ which is assumed to be equal to the unit matrix except for
+ the submatrix Z(ILO:IHI,ILO:IHI); on exit Z contains Q*Z.
+ Normally Q is the unitary matrix generated by ZUNGHR after
+ the call to ZGEHRD which formed the Hessenberg matrix H.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z.
+ LDZ >= max(1,N) if COMPZ = 'I' or 'V'; LDZ >= 1 otherwise.
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, ZHSEQR failed to compute all the
+ eigenvalues in a total of 30*(IHI-ILO+1) iterations;
+ elements 1:ilo-1 and i+1:n of W contain those
+ eigenvalues which have been successfully computed.
+
+ =====================================================================
+
+
+ Decode and test the input parameters
+*/
+
+ /* Parameter adjustments */
+ h_dim1 = *ldh;
+ h_offset = 1 + h_dim1 * 1;
+ h__ -= h_offset;
+ --w;
+ z_dim1 = *ldz;
+ z_offset = 1 + z_dim1 * 1;
+ z__ -= z_offset;
+ --work;
+
+ /* Function Body */
+ wantt = lsame_(job, "S");
+ initz = lsame_(compz, "I");
+ wantz = initz || lsame_(compz, "V");
+
+ *info = 0;
+ i__1 = max(1,*n);
+ work[1].r = (doublereal) i__1, work[1].i = 0.;
+ lquery = *lwork == -1;
+ if ((! lsame_(job, "E") && ! wantt)) {
+ *info = -1;
+ } else if ((! lsame_(compz, "N") && ! wantz)) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*ilo < 1 || *ilo > max(1,*n)) {
+ *info = -4;
+ } else if (*ihi < min(*ilo,*n) || *ihi > *n) {
+ *info = -5;
+ } else if (*ldh < max(1,*n)) {
+ *info = -7;
+ } else if (*ldz < 1 || (wantz && *ldz < max(1,*n))) {
+ *info = -10;
+ } else if ((*lwork < max(1,*n) && ! lquery)) {
+ *info = -12;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZHSEQR", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Initialize Z, if necessary */
+
+ if (initz) {
+ zlaset_("Full", n, n, &c_b59, &c_b60, &z__[z_offset], ldz);
+ }
+
+/* Store the eigenvalues isolated by ZGEBAL. */
+
+ i__1 = *ilo - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ i__3 = i__ + i__ * h_dim1;
+ w[i__2].r = h__[i__3].r, w[i__2].i = h__[i__3].i;
+/* L10: */
+ }
+ i__1 = *n;
+ for (i__ = *ihi + 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ i__3 = i__ + i__ * h_dim1;
+ w[i__2].r = h__[i__3].r, w[i__2].i = h__[i__3].i;
+/* L20: */
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return 0;
+ }
+ if (*ilo == *ihi) {
+ i__1 = *ilo;
+ i__2 = *ilo + *ilo * h_dim1;
+ w[i__1].r = h__[i__2].r, w[i__1].i = h__[i__2].i;
+ return 0;
+ }
+
+/*
+ Set rows and columns ILO to IHI to zero below the first
+ subdiagonal.
+*/
+
+ i__1 = *ihi - 2;
+ for (j = *ilo; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = j + 2; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * h_dim1;
+ h__[i__3].r = 0., h__[i__3].i = 0.;
+/* L30: */
+ }
+/* L40: */
+ }
+ nh = *ihi - *ilo + 1;
+
+/*
+ I1 and I2 are the indices of the first row and last column of H
+ to which transformations must be applied. If eigenvalues only are
+ being computed, I1 and I2 are re-set inside the main loop.
+*/
+
+ if (wantt) {
+ i1 = 1;
+ i2 = *n;
+ } else {
+ i1 = *ilo;
+ i2 = *ihi;
+ }
+
+/* Ensure that the subdiagonal elements are real. */
+
+ i__1 = *ihi;
+ for (i__ = *ilo + 1; i__ <= i__1; ++i__) {
+ i__2 = i__ + (i__ - 1) * h_dim1;
+ temp.r = h__[i__2].r, temp.i = h__[i__2].i;
+ if (d_imag(&temp) != 0.) {
+ d__1 = temp.r;
+ d__2 = d_imag(&temp);
+ rtemp = dlapy2_(&d__1, &d__2);
+ i__2 = i__ + (i__ - 1) * h_dim1;
+ h__[i__2].r = rtemp, h__[i__2].i = 0.;
+ z__1.r = temp.r / rtemp, z__1.i = temp.i / rtemp;
+ temp.r = z__1.r, temp.i = z__1.i;
+ if (i2 > i__) {
+ i__2 = i2 - i__;
+ d_cnjg(&z__1, &temp);
+ zscal_(&i__2, &z__1, &h__[i__ + (i__ + 1) * h_dim1], ldh);
+ }
+ i__2 = i__ - i1;
+ zscal_(&i__2, &temp, &h__[i1 + i__ * h_dim1], &c__1);
+ if (i__ < *ihi) {
+ i__2 = i__ + 1 + i__ * h_dim1;
+ i__3 = i__ + 1 + i__ * h_dim1;
+ z__1.r = temp.r * h__[i__3].r - temp.i * h__[i__3].i, z__1.i =
+ temp.r * h__[i__3].i + temp.i * h__[i__3].r;
+ h__[i__2].r = z__1.r, h__[i__2].i = z__1.i;
+ }
+ if (wantz) {
+ zscal_(&nh, &temp, &z__[*ilo + i__ * z_dim1], &c__1);
+ }
+ }
+/* L50: */
+ }
+
+/*
+ Determine the order of the multi-shift QR algorithm to be used.
+
+ Writing concatenation
+*/
+ i__4[0] = 1, a__1[0] = job;
+ i__4[1] = 1, a__1[1] = compz;
+ s_cat(ch__1, a__1, i__4, &c__2, (ftnlen)2);
+ ns = ilaenv_(&c__4, "ZHSEQR", ch__1, n, ilo, ihi, &c_n1, (ftnlen)6, (
+ ftnlen)2);
+/* Writing concatenation */
+ i__4[0] = 1, a__1[0] = job;
+ i__4[1] = 1, a__1[1] = compz;
+ s_cat(ch__1, a__1, i__4, &c__2, (ftnlen)2);
+ maxb = ilaenv_(&c__8, "ZHSEQR", ch__1, n, ilo, ihi, &c_n1, (ftnlen)6, (
+ ftnlen)2);
+ if (ns <= 1 || ns > nh || maxb >= nh) {
+
+/* Use the standard double-shift algorithm */
+
+ zlahqr_(&wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &w[1], ilo,
+ ihi, &z__[z_offset], ldz, info);
+ return 0;
+ }
+ maxb = max(2,maxb);
+/* Computing MIN */
+ i__1 = min(ns,maxb);
+ ns = min(i__1,15);
+
+/*
+ Now 1 < NS <= MAXB < NH.
+
+ Set machine-dependent constants for the stopping criterion.
+ If norm(H) <= sqrt(OVFL), overflow should not occur.
+*/
+
+ unfl = SAFEMINIMUM;
+ ovfl = 1. / unfl;
+ dlabad_(&unfl, &ovfl);
+ ulp = PRECISION;
+ smlnum = unfl * (nh / ulp);
+
+/* ITN is the total number of multiple-shift QR iterations allowed. */
+
+ itn = nh * 30;
+
+/*
+ The main loop begins here. I is the loop index and decreases from
+ IHI to ILO in steps of at most MAXB. Each iteration of the loop
+ works with the active submatrix in rows and columns L to I.
+ Eigenvalues I+1 to IHI have already converged. Either L = ILO, or
+ H(L,L-1) is negligible so that the matrix splits.
+*/
+
+ i__ = *ihi;
+L60:
+ if (i__ < *ilo) {
+ goto L180;
+ }
+
+/*
+ Perform multiple-shift QR iterations on rows and columns ILO to I
+ until a submatrix of order at most MAXB splits off at the bottom
+ because a subdiagonal element has become negligible.
+*/
+
+ l = *ilo;
+ i__1 = itn;
+ for (its = 0; its <= i__1; ++its) {
+
+/* Look for a single small subdiagonal element. */
+
+ i__2 = l + 1;
+ for (k = i__; k >= i__2; --k) {
+ i__3 = k - 1 + (k - 1) * h_dim1;
+ i__5 = k + k * h_dim1;
+ tst1 = (d__1 = h__[i__3].r, abs(d__1)) + (d__2 = d_imag(&h__[k -
+ 1 + (k - 1) * h_dim1]), abs(d__2)) + ((d__3 = h__[i__5].r,
+ abs(d__3)) + (d__4 = d_imag(&h__[k + k * h_dim1]), abs(
+ d__4)));
+ if (tst1 == 0.) {
+ i__3 = i__ - l + 1;
+ tst1 = zlanhs_("1", &i__3, &h__[l + l * h_dim1], ldh, rwork);
+ }
+ i__3 = k + (k - 1) * h_dim1;
+/* Computing MAX */
+ d__2 = ulp * tst1;
+ if ((d__1 = h__[i__3].r, abs(d__1)) <= max(d__2,smlnum)) {
+ goto L80;
+ }
+/* L70: */
+ }
+L80:
+ l = k;
+ if (l > *ilo) {
+
+/* H(L,L-1) is negligible. */
+
+ i__2 = l + (l - 1) * h_dim1;
+ h__[i__2].r = 0., h__[i__2].i = 0.;
+ }
+
+/* Exit from loop if a submatrix of order <= MAXB has split off. */
+
+ if (l >= i__ - maxb + 1) {
+ goto L170;
+ }
+
+/*
+ Now the active submatrix is in rows and columns L to I. If
+ eigenvalues only are being computed, only the active submatrix
+ need be transformed.
+*/
+
+ if (! wantt) {
+ i1 = l;
+ i2 = i__;
+ }
+
+ if (its == 20 || its == 30) {
+
+/* Exceptional shifts. */
+
+ i__2 = i__;
+ for (ii = i__ - ns + 1; ii <= i__2; ++ii) {
+ i__3 = ii;
+ i__5 = ii + (ii - 1) * h_dim1;
+ i__6 = ii + ii * h_dim1;
+ d__3 = ((d__1 = h__[i__5].r, abs(d__1)) + (d__2 = h__[i__6].r,
+ abs(d__2))) * 1.5;
+ w[i__3].r = d__3, w[i__3].i = 0.;
+/* L90: */
+ }
+ } else {
+
+/* Use eigenvalues of trailing submatrix of order NS as shifts. */
+
+ zlacpy_("Full", &ns, &ns, &h__[i__ - ns + 1 + (i__ - ns + 1) *
+ h_dim1], ldh, s, &c__15);
+ zlahqr_(&c_false, &c_false, &ns, &c__1, &ns, s, &c__15, &w[i__ -
+ ns + 1], &c__1, &ns, &z__[z_offset], ldz, &ierr);
+ if (ierr > 0) {
+
+/*
+ If ZLAHQR failed to compute all NS eigenvalues, use the
+ unconverged diagonal elements as the remaining shifts.
+*/
+
+ i__2 = ierr;
+ for (ii = 1; ii <= i__2; ++ii) {
+ i__3 = i__ - ns + ii;
+ i__5 = ii + ii * 15 - 16;
+ w[i__3].r = s[i__5].r, w[i__3].i = s[i__5].i;
+/* L100: */
+ }
+ }
+ }
+
+/*
+ Form the first column of (G-w(1)) (G-w(2)) . . . (G-w(ns))
+ where G is the Hessenberg submatrix H(L:I,L:I) and w is
+ the vector of shifts (stored in W). The result is
+ stored in the local array V.
+*/
+
+ v[0].r = 1., v[0].i = 0.;
+ i__2 = ns + 1;
+ for (ii = 2; ii <= i__2; ++ii) {
+ i__3 = ii - 1;
+ v[i__3].r = 0., v[i__3].i = 0.;
+/* L110: */
+ }
+ nv = 1;
+ i__2 = i__;
+ for (j = i__ - ns + 1; j <= i__2; ++j) {
+ i__3 = nv + 1;
+ zcopy_(&i__3, v, &c__1, vv, &c__1);
+ i__3 = nv + 1;
+ i__5 = j;
+ z__1.r = -w[i__5].r, z__1.i = -w[i__5].i;
+ zgemv_("No transpose", &i__3, &nv, &c_b60, &h__[l + l * h_dim1],
+ ldh, vv, &c__1, &z__1, v, &c__1);
+ ++nv;
+
+/*
+ Scale V(1:NV) so that max(abs(V(i))) = 1. If V is zero,
+ reset it to the unit vector.
+*/
+
+ itemp = izamax_(&nv, v, &c__1);
+ i__3 = itemp - 1;
+ rtemp = (d__1 = v[i__3].r, abs(d__1)) + (d__2 = d_imag(&v[itemp -
+ 1]), abs(d__2));
+ if (rtemp == 0.) {
+ v[0].r = 1., v[0].i = 0.;
+ i__3 = nv;
+ for (ii = 2; ii <= i__3; ++ii) {
+ i__5 = ii - 1;
+ v[i__5].r = 0., v[i__5].i = 0.;
+/* L120: */
+ }
+ } else {
+ rtemp = max(rtemp,smlnum);
+ d__1 = 1. / rtemp;
+ zdscal_(&nv, &d__1, v, &c__1);
+ }
+/* L130: */
+ }
+
+/* Multiple-shift QR step */
+
+ i__2 = i__ - 1;
+ for (k = l; k <= i__2; ++k) {
+
+/*
+ The first iteration of this loop determines a reflection G
+ from the vector V and applies it from left and right to H,
+ thus creating a nonzero bulge below the subdiagonal.
+
+ Each subsequent iteration determines a reflection G to
+ restore the Hessenberg form in the (K-1)th column, and thus
+ chases the bulge one step toward the bottom of the active
+ submatrix. NR is the order of G.
+
+ Computing MIN
+*/
+ i__3 = ns + 1, i__5 = i__ - k + 1;
+ nr = min(i__3,i__5);
+ if (k > l) {
+ zcopy_(&nr, &h__[k + (k - 1) * h_dim1], &c__1, v, &c__1);
+ }
+ zlarfg_(&nr, v, &v[1], &c__1, &tau);
+ if (k > l) {
+ i__3 = k + (k - 1) * h_dim1;
+ h__[i__3].r = v[0].r, h__[i__3].i = v[0].i;
+ i__3 = i__;
+ for (ii = k + 1; ii <= i__3; ++ii) {
+ i__5 = ii + (k - 1) * h_dim1;
+ h__[i__5].r = 0., h__[i__5].i = 0.;
+/* L140: */
+ }
+ }
+ v[0].r = 1., v[0].i = 0.;
+
+/*
+ Apply G' from the left to transform the rows of the matrix
+ in columns K to I2.
+*/
+
+ i__3 = i2 - k + 1;
+ d_cnjg(&z__1, &tau);
+ zlarfx_("Left", &nr, &i__3, v, &z__1, &h__[k + k * h_dim1], ldh, &
+ work[1]);
+
+/*
+ Apply G from the right to transform the columns of the
+ matrix in rows I1 to min(K+NR,I).
+
+ Computing MIN
+*/
+ i__5 = k + nr;
+ i__3 = min(i__5,i__) - i1 + 1;
+ zlarfx_("Right", &i__3, &nr, v, &tau, &h__[i1 + k * h_dim1], ldh,
+ &work[1]);
+
+ if (wantz) {
+
+/* Accumulate transformations in the matrix Z */
+
+ zlarfx_("Right", &nh, &nr, v, &tau, &z__[*ilo + k * z_dim1],
+ ldz, &work[1]);
+ }
+/* L150: */
+ }
+
+/* Ensure that H(I,I-1) is real. */
+
+ i__2 = i__ + (i__ - 1) * h_dim1;
+ temp.r = h__[i__2].r, temp.i = h__[i__2].i;
+ if (d_imag(&temp) != 0.) {
+ d__1 = temp.r;
+ d__2 = d_imag(&temp);
+ rtemp = dlapy2_(&d__1, &d__2);
+ i__2 = i__ + (i__ - 1) * h_dim1;
+ h__[i__2].r = rtemp, h__[i__2].i = 0.;
+ z__1.r = temp.r / rtemp, z__1.i = temp.i / rtemp;
+ temp.r = z__1.r, temp.i = z__1.i;
+ if (i2 > i__) {
+ i__2 = i2 - i__;
+ d_cnjg(&z__1, &temp);
+ zscal_(&i__2, &z__1, &h__[i__ + (i__ + 1) * h_dim1], ldh);
+ }
+ i__2 = i__ - i1;
+ zscal_(&i__2, &temp, &h__[i1 + i__ * h_dim1], &c__1);
+ if (wantz) {
+ zscal_(&nh, &temp, &z__[*ilo + i__ * z_dim1], &c__1);
+ }
+ }
+
+/* L160: */
+ }
+
+/* Failure to converge in remaining number of iterations */
+
+ *info = i__;
+ return 0;
+
+L170:
+
+/*
+ A submatrix of order <= MAXB in rows and columns L to I has split
+ off. Use the double-shift QR algorithm to handle it.
+*/
+
+ zlahqr_(&wantt, &wantz, n, &l, &i__, &h__[h_offset], ldh, &w[1], ilo, ihi,
+ &z__[z_offset], ldz, info);
+ if (*info > 0) {
+ return 0;
+ }
+
+/*
+ Decrement number of remaining iterations, and return to start of
+ the main loop with a new value of I.
+*/
+
+ itn -= its;
+ i__ = l - 1;
+ goto L60;
+
+L180:
+ i__1 = max(1,*n);
+ work[1].r = (doublereal) i__1, work[1].i = 0.;
+ return 0;
+
+/* End of ZHSEQR */
+
+} /* zhseqr_ */
+
+/* Subroutine */ int zlabrd_(integer *m, integer *n, integer *nb,
+ doublecomplex *a, integer *lda, doublereal *d__, doublereal *e,
+ doublecomplex *tauq, doublecomplex *taup, doublecomplex *x, integer *
+ ldx, doublecomplex *y, integer *ldy)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, x_dim1, x_offset, y_dim1, y_offset, i__1, i__2,
+ i__3;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer i__;
+ static doublecomplex alpha;
+ extern /* Subroutine */ int zscal_(integer *, doublecomplex *,
+ doublecomplex *, integer *), zgemv_(char *, integer *, integer *,
+ doublecomplex *, doublecomplex *, integer *, doublecomplex *,
+ integer *, doublecomplex *, doublecomplex *, integer *),
+ zlarfg_(integer *, doublecomplex *, doublecomplex *, integer *,
+ doublecomplex *), zlacgv_(integer *, doublecomplex *, integer *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZLABRD reduces the first NB rows and columns of a complex general
+ m by n matrix A to upper or lower real bidiagonal form by a unitary
+ transformation Q' * A * P, and returns the matrices X and Y which
+ are needed to apply the transformation to the unreduced part of A.
+
+ If m >= n, A is reduced to upper bidiagonal form; if m < n, to lower
+ bidiagonal form.
+
+ This is an auxiliary routine called by ZGEBRD
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows in the matrix A.
+
+ N (input) INTEGER
+ The number of columns in the matrix A.
+
+ NB (input) INTEGER
+ The number of leading rows and columns of A to be reduced.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the m by n general matrix to be reduced.
+ On exit, the first NB rows and columns of the matrix are
+ overwritten; the rest of the array is unchanged.
+ If m >= n, elements on and below the diagonal in the first NB
+ columns, with the array TAUQ, represent the unitary
+ matrix Q as a product of elementary reflectors; and
+ elements above the diagonal in the first NB rows, with the
+ array TAUP, represent the unitary matrix P as a product
+ of elementary reflectors.
+ If m < n, elements below the diagonal in the first NB
+ columns, with the array TAUQ, represent the unitary
+ matrix Q as a product of elementary reflectors, and
+ elements on and above the diagonal in the first NB rows,
+ with the array TAUP, represent the unitary matrix P as
+ a product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ D (output) DOUBLE PRECISION array, dimension (NB)
+ The diagonal elements of the first NB rows and columns of
+ the reduced matrix. D(i) = A(i,i).
+
+ E (output) DOUBLE PRECISION array, dimension (NB)
+ The off-diagonal elements of the first NB rows and columns of
+ the reduced matrix.
+
+ TAUQ (output) COMPLEX*16 array dimension (NB)
+ The scalar factors of the elementary reflectors which
+ represent the unitary matrix Q. See Further Details.
+
+ TAUP (output) COMPLEX*16 array, dimension (NB)
+ The scalar factors of the elementary reflectors which
+ represent the unitary matrix P. See Further Details.
+
+ X (output) COMPLEX*16 array, dimension (LDX,NB)
+ The m-by-nb matrix X required to update the unreduced part
+ of A.
+
+ LDX (input) INTEGER
+ The leading dimension of the array X. LDX >= max(1,M).
+
+ Y (output) COMPLEX*16 array, dimension (LDY,NB)
+ The n-by-nb matrix Y required to update the unreduced part
+ of A.
+
+ LDY (output) INTEGER
+ The leading dimension of the array Y. LDY >= max(1,N).
+
+ Further Details
+ ===============
+
+ The matrices Q and P are represented as products of elementary
+ reflectors:
+
+ Q = H(1) H(2) . . . H(nb) and P = G(1) G(2) . . . G(nb)
+
+ Each H(i) and G(i) has the form:
+
+ H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
+
+ where tauq and taup are complex scalars, and v and u are complex
+ vectors.
+
+ If m >= n, v(1:i-1) = 0, v(i) = 1, and v(i:m) is stored on exit in
+ A(i:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+1:n) is stored on exit in
+ A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ If m < n, v(1:i) = 0, v(i+1) = 1, and v(i+1:m) is stored on exit in
+ A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i:n) is stored on exit in
+ A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).
+
+ The elements of the vectors v and u together form the m-by-nb matrix
+ V and the nb-by-n matrix U' which are needed, with X and Y, to apply
+ the transformation to the unreduced part of the matrix, using a block
+ update of the form: A := A - V*Y' - X*U'.
+
+ The contents of A on exit are illustrated by the following examples
+ with nb = 2:
+
+ m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
+
+ ( 1 1 u1 u1 u1 ) ( 1 u1 u1 u1 u1 u1 )
+ ( v1 1 1 u2 u2 ) ( 1 1 u2 u2 u2 u2 )
+ ( v1 v2 a a a ) ( v1 1 a a a a )
+ ( v1 v2 a a a ) ( v1 v2 a a a a )
+ ( v1 v2 a a a ) ( v1 v2 a a a a )
+ ( v1 v2 a a a )
+
+ where a denotes an element of the original matrix which is unchanged,
+ vi denotes an element of the vector defining H(i), and ui an element
+ of the vector defining G(i).
+
+ =====================================================================
+
+
+ Quick return if possible
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --d__;
+ --e;
+ --tauq;
+ --taup;
+ x_dim1 = *ldx;
+ x_offset = 1 + x_dim1 * 1;
+ x -= x_offset;
+ y_dim1 = *ldy;
+ y_offset = 1 + y_dim1 * 1;
+ y -= y_offset;
+
+ /* Function Body */
+ if (*m <= 0 || *n <= 0) {
+ return 0;
+ }
+
+ if (*m >= *n) {
+
+/* Reduce to upper bidiagonal form */
+
+ i__1 = *nb;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/* Update A(i:m,i) */
+
+ i__2 = i__ - 1;
+ zlacgv_(&i__2, &y[i__ + y_dim1], ldy);
+ i__2 = *m - i__ + 1;
+ i__3 = i__ - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__3, &z__1, &a[i__ + a_dim1], lda,
+ &y[i__ + y_dim1], ldy, &c_b60, &a[i__ + i__ * a_dim1], &
+ c__1);
+ i__2 = i__ - 1;
+ zlacgv_(&i__2, &y[i__ + y_dim1], ldy);
+ i__2 = *m - i__ + 1;
+ i__3 = i__ - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__3, &z__1, &x[i__ + x_dim1], ldx,
+ &a[i__ * a_dim1 + 1], &c__1, &c_b60, &a[i__ + i__ *
+ a_dim1], &c__1);
+
+/* Generate reflection Q(i) to annihilate A(i+1:m,i) */
+
+ i__2 = i__ + i__ * a_dim1;
+ alpha.r = a[i__2].r, alpha.i = a[i__2].i;
+ i__2 = *m - i__ + 1;
+/* Computing MIN */
+ i__3 = i__ + 1;
+ zlarfg_(&i__2, &alpha, &a[min(i__3,*m) + i__ * a_dim1], &c__1, &
+ tauq[i__]);
+ i__2 = i__;
+ d__[i__2] = alpha.r;
+ if (i__ < *n) {
+ i__2 = i__ + i__ * a_dim1;
+ a[i__2].r = 1., a[i__2].i = 0.;
+
+/* Compute Y(i+1:n,i) */
+
+ i__2 = *m - i__ + 1;
+ i__3 = *n - i__;
+ zgemv_("Conjugate transpose", &i__2, &i__3, &c_b60, &a[i__ + (
+ i__ + 1) * a_dim1], lda, &a[i__ + i__ * a_dim1], &
+ c__1, &c_b59, &y[i__ + 1 + i__ * y_dim1], &c__1);
+ i__2 = *m - i__ + 1;
+ i__3 = i__ - 1;
+ zgemv_("Conjugate transpose", &i__2, &i__3, &c_b60, &a[i__ +
+ a_dim1], lda, &a[i__ + i__ * a_dim1], &c__1, &c_b59, &
+ y[i__ * y_dim1 + 1], &c__1);
+ i__2 = *n - i__;
+ i__3 = i__ - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__3, &z__1, &y[i__ + 1 +
+ y_dim1], ldy, &y[i__ * y_dim1 + 1], &c__1, &c_b60, &y[
+ i__ + 1 + i__ * y_dim1], &c__1);
+ i__2 = *m - i__ + 1;
+ i__3 = i__ - 1;
+ zgemv_("Conjugate transpose", &i__2, &i__3, &c_b60, &x[i__ +
+ x_dim1], ldx, &a[i__ + i__ * a_dim1], &c__1, &c_b59, &
+ y[i__ * y_dim1 + 1], &c__1);
+ i__2 = i__ - 1;
+ i__3 = *n - i__;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("Conjugate transpose", &i__2, &i__3, &z__1, &a[(i__ +
+ 1) * a_dim1 + 1], lda, &y[i__ * y_dim1 + 1], &c__1, &
+ c_b60, &y[i__ + 1 + i__ * y_dim1], &c__1);
+ i__2 = *n - i__;
+ zscal_(&i__2, &tauq[i__], &y[i__ + 1 + i__ * y_dim1], &c__1);
+
+/* Update A(i,i+1:n) */
+
+ i__2 = *n - i__;
+ zlacgv_(&i__2, &a[i__ + (i__ + 1) * a_dim1], lda);
+ zlacgv_(&i__, &a[i__ + a_dim1], lda);
+ i__2 = *n - i__;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__, &z__1, &y[i__ + 1 +
+ y_dim1], ldy, &a[i__ + a_dim1], lda, &c_b60, &a[i__ +
+ (i__ + 1) * a_dim1], lda);
+ zlacgv_(&i__, &a[i__ + a_dim1], lda);
+ i__2 = i__ - 1;
+ zlacgv_(&i__2, &x[i__ + x_dim1], ldx);
+ i__2 = i__ - 1;
+ i__3 = *n - i__;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("Conjugate transpose", &i__2, &i__3, &z__1, &a[(i__ +
+ 1) * a_dim1 + 1], lda, &x[i__ + x_dim1], ldx, &c_b60,
+ &a[i__ + (i__ + 1) * a_dim1], lda);
+ i__2 = i__ - 1;
+ zlacgv_(&i__2, &x[i__ + x_dim1], ldx);
+
+/* Generate reflection P(i) to annihilate A(i,i+2:n) */
+
+ i__2 = i__ + (i__ + 1) * a_dim1;
+ alpha.r = a[i__2].r, alpha.i = a[i__2].i;
+ i__2 = *n - i__;
+/* Computing MIN */
+ i__3 = i__ + 2;
+ zlarfg_(&i__2, &alpha, &a[i__ + min(i__3,*n) * a_dim1], lda, &
+ taup[i__]);
+ i__2 = i__;
+ e[i__2] = alpha.r;
+ i__2 = i__ + (i__ + 1) * a_dim1;
+ a[i__2].r = 1., a[i__2].i = 0.;
+
+/* Compute X(i+1:m,i) */
+
+ i__2 = *m - i__;
+ i__3 = *n - i__;
+ zgemv_("No transpose", &i__2, &i__3, &c_b60, &a[i__ + 1 + (
+ i__ + 1) * a_dim1], lda, &a[i__ + (i__ + 1) * a_dim1],
+ lda, &c_b59, &x[i__ + 1 + i__ * x_dim1], &c__1);
+ i__2 = *n - i__;
+ zgemv_("Conjugate transpose", &i__2, &i__, &c_b60, &y[i__ + 1
+ + y_dim1], ldy, &a[i__ + (i__ + 1) * a_dim1], lda, &
+ c_b59, &x[i__ * x_dim1 + 1], &c__1);
+ i__2 = *m - i__;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__, &z__1, &a[i__ + 1 +
+ a_dim1], lda, &x[i__ * x_dim1 + 1], &c__1, &c_b60, &x[
+ i__ + 1 + i__ * x_dim1], &c__1);
+ i__2 = i__ - 1;
+ i__3 = *n - i__;
+ zgemv_("No transpose", &i__2, &i__3, &c_b60, &a[(i__ + 1) *
+ a_dim1 + 1], lda, &a[i__ + (i__ + 1) * a_dim1], lda, &
+ c_b59, &x[i__ * x_dim1 + 1], &c__1);
+ i__2 = *m - i__;
+ i__3 = i__ - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__3, &z__1, &x[i__ + 1 +
+ x_dim1], ldx, &x[i__ * x_dim1 + 1], &c__1, &c_b60, &x[
+ i__ + 1 + i__ * x_dim1], &c__1);
+ i__2 = *m - i__;
+ zscal_(&i__2, &taup[i__], &x[i__ + 1 + i__ * x_dim1], &c__1);
+ i__2 = *n - i__;
+ zlacgv_(&i__2, &a[i__ + (i__ + 1) * a_dim1], lda);
+ }
+/* L10: */
+ }
+ } else {
+
+/* Reduce to lower bidiagonal form */
+
+ i__1 = *nb;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/* Update A(i,i:n) */
+
+ i__2 = *n - i__ + 1;
+ zlacgv_(&i__2, &a[i__ + i__ * a_dim1], lda);
+ i__2 = i__ - 1;
+ zlacgv_(&i__2, &a[i__ + a_dim1], lda);
+ i__2 = *n - i__ + 1;
+ i__3 = i__ - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__3, &z__1, &y[i__ + y_dim1], ldy,
+ &a[i__ + a_dim1], lda, &c_b60, &a[i__ + i__ * a_dim1],
+ lda);
+ i__2 = i__ - 1;
+ zlacgv_(&i__2, &a[i__ + a_dim1], lda);
+ i__2 = i__ - 1;
+ zlacgv_(&i__2, &x[i__ + x_dim1], ldx);
+ i__2 = i__ - 1;
+ i__3 = *n - i__ + 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("Conjugate transpose", &i__2, &i__3, &z__1, &a[i__ *
+ a_dim1 + 1], lda, &x[i__ + x_dim1], ldx, &c_b60, &a[i__ +
+ i__ * a_dim1], lda);
+ i__2 = i__ - 1;
+ zlacgv_(&i__2, &x[i__ + x_dim1], ldx);
+
+/* Generate reflection P(i) to annihilate A(i,i+1:n) */
+
+ i__2 = i__ + i__ * a_dim1;
+ alpha.r = a[i__2].r, alpha.i = a[i__2].i;
+ i__2 = *n - i__ + 1;
+/* Computing MIN */
+ i__3 = i__ + 1;
+ zlarfg_(&i__2, &alpha, &a[i__ + min(i__3,*n) * a_dim1], lda, &
+ taup[i__]);
+ i__2 = i__;
+ d__[i__2] = alpha.r;
+ if (i__ < *m) {
+ i__2 = i__ + i__ * a_dim1;
+ a[i__2].r = 1., a[i__2].i = 0.;
+
+/* Compute X(i+1:m,i) */
+
+ i__2 = *m - i__;
+ i__3 = *n - i__ + 1;
+ zgemv_("No transpose", &i__2, &i__3, &c_b60, &a[i__ + 1 + i__
+ * a_dim1], lda, &a[i__ + i__ * a_dim1], lda, &c_b59, &
+ x[i__ + 1 + i__ * x_dim1], &c__1);
+ i__2 = *n - i__ + 1;
+ i__3 = i__ - 1;
+ zgemv_("Conjugate transpose", &i__2, &i__3, &c_b60, &y[i__ +
+ y_dim1], ldy, &a[i__ + i__ * a_dim1], lda, &c_b59, &x[
+ i__ * x_dim1 + 1], &c__1);
+ i__2 = *m - i__;
+ i__3 = i__ - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__3, &z__1, &a[i__ + 1 +
+ a_dim1], lda, &x[i__ * x_dim1 + 1], &c__1, &c_b60, &x[
+ i__ + 1 + i__ * x_dim1], &c__1);
+ i__2 = i__ - 1;
+ i__3 = *n - i__ + 1;
+ zgemv_("No transpose", &i__2, &i__3, &c_b60, &a[i__ * a_dim1
+ + 1], lda, &a[i__ + i__ * a_dim1], lda, &c_b59, &x[
+ i__ * x_dim1 + 1], &c__1);
+ i__2 = *m - i__;
+ i__3 = i__ - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__3, &z__1, &x[i__ + 1 +
+ x_dim1], ldx, &x[i__ * x_dim1 + 1], &c__1, &c_b60, &x[
+ i__ + 1 + i__ * x_dim1], &c__1);
+ i__2 = *m - i__;
+ zscal_(&i__2, &taup[i__], &x[i__ + 1 + i__ * x_dim1], &c__1);
+ i__2 = *n - i__ + 1;
+ zlacgv_(&i__2, &a[i__ + i__ * a_dim1], lda);
+
+/* Update A(i+1:m,i) */
+
+ i__2 = i__ - 1;
+ zlacgv_(&i__2, &y[i__ + y_dim1], ldy);
+ i__2 = *m - i__;
+ i__3 = i__ - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__3, &z__1, &a[i__ + 1 +
+ a_dim1], lda, &y[i__ + y_dim1], ldy, &c_b60, &a[i__ +
+ 1 + i__ * a_dim1], &c__1);
+ i__2 = i__ - 1;
+ zlacgv_(&i__2, &y[i__ + y_dim1], ldy);
+ i__2 = *m - i__;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__, &z__1, &x[i__ + 1 +
+ x_dim1], ldx, &a[i__ * a_dim1 + 1], &c__1, &c_b60, &a[
+ i__ + 1 + i__ * a_dim1], &c__1);
+
+/* Generate reflection Q(i) to annihilate A(i+2:m,i) */
+
+ i__2 = i__ + 1 + i__ * a_dim1;
+ alpha.r = a[i__2].r, alpha.i = a[i__2].i;
+ i__2 = *m - i__;
+/* Computing MIN */
+ i__3 = i__ + 2;
+ zlarfg_(&i__2, &alpha, &a[min(i__3,*m) + i__ * a_dim1], &c__1,
+ &tauq[i__]);
+ i__2 = i__;
+ e[i__2] = alpha.r;
+ i__2 = i__ + 1 + i__ * a_dim1;
+ a[i__2].r = 1., a[i__2].i = 0.;
+
+/* Compute Y(i+1:n,i) */
+
+ i__2 = *m - i__;
+ i__3 = *n - i__;
+ zgemv_("Conjugate transpose", &i__2, &i__3, &c_b60, &a[i__ +
+ 1 + (i__ + 1) * a_dim1], lda, &a[i__ + 1 + i__ *
+ a_dim1], &c__1, &c_b59, &y[i__ + 1 + i__ * y_dim1], &
+ c__1);
+ i__2 = *m - i__;
+ i__3 = i__ - 1;
+ zgemv_("Conjugate transpose", &i__2, &i__3, &c_b60, &a[i__ +
+ 1 + a_dim1], lda, &a[i__ + 1 + i__ * a_dim1], &c__1, &
+ c_b59, &y[i__ * y_dim1 + 1], &c__1);
+ i__2 = *n - i__;
+ i__3 = i__ - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__3, &z__1, &y[i__ + 1 +
+ y_dim1], ldy, &y[i__ * y_dim1 + 1], &c__1, &c_b60, &y[
+ i__ + 1 + i__ * y_dim1], &c__1);
+ i__2 = *m - i__;
+ zgemv_("Conjugate transpose", &i__2, &i__, &c_b60, &x[i__ + 1
+ + x_dim1], ldx, &a[i__ + 1 + i__ * a_dim1], &c__1, &
+ c_b59, &y[i__ * y_dim1 + 1], &c__1);
+ i__2 = *n - i__;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("Conjugate transpose", &i__, &i__2, &z__1, &a[(i__ + 1)
+ * a_dim1 + 1], lda, &y[i__ * y_dim1 + 1], &c__1, &
+ c_b60, &y[i__ + 1 + i__ * y_dim1], &c__1);
+ i__2 = *n - i__;
+ zscal_(&i__2, &tauq[i__], &y[i__ + 1 + i__ * y_dim1], &c__1);
+ } else {
+ i__2 = *n - i__ + 1;
+ zlacgv_(&i__2, &a[i__ + i__ * a_dim1], lda);
+ }
+/* L20: */
+ }
+ }
+ return 0;
+
+/* End of ZLABRD */
+
+} /* zlabrd_ */
+
+/* Subroutine */ int zlacgv_(integer *n, doublecomplex *x, integer *incx)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ doublecomplex z__1;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, ioff;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ ZLACGV conjugates a complex vector of length N.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The length of the vector X. N >= 0.
+
+ X (input/output) COMPLEX*16 array, dimension
+ (1+(N-1)*abs(INCX))
+ On entry, the vector of length N to be conjugated.
+ On exit, X is overwritten with conjg(X).
+
+ INCX (input) INTEGER
+ The spacing between successive elements of X.
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ if (*incx == 1) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ d_cnjg(&z__1, &x[i__]);
+ x[i__2].r = z__1.r, x[i__2].i = z__1.i;
+/* L10: */
+ }
+ } else {
+ ioff = 1;
+ if (*incx < 0) {
+ ioff = 1 - (*n - 1) * *incx;
+ }
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = ioff;
+ d_cnjg(&z__1, &x[ioff]);
+ x[i__2].r = z__1.r, x[i__2].i = z__1.i;
+ ioff += *incx;
+/* L20: */
+ }
+ }
+ return 0;
+
+/* End of ZLACGV */
+
+} /* zlacgv_ */
+
+/* Subroutine */ int zlacp2_(char *uplo, integer *m, integer *n, doublereal *
+ a, integer *lda, doublecomplex *b, integer *ldb)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4;
+
+ /* Local variables */
+ static integer i__, j;
+ extern logical lsame_(char *, char *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZLACP2 copies all or part of a real two-dimensional matrix A to a
+ complex matrix B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies the part of the matrix A to be copied to B.
+ = 'U': Upper triangular part
+ = 'L': Lower triangular part
+ Otherwise: All of the matrix A
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA,N)
+ The m by n matrix A. If UPLO = 'U', only the upper trapezium
+ is accessed; if UPLO = 'L', only the lower trapezium is
+ accessed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (output) COMPLEX*16 array, dimension (LDB,N)
+ On exit, B = A in the locations specified by UPLO.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,M).
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+
+ /* Function Body */
+ if (lsame_(uplo, "U")) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = min(j,*m);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ i__4 = i__ + j * a_dim1;
+ b[i__3].r = a[i__4], b[i__3].i = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+
+ } else if (lsame_(uplo, "L")) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ i__4 = i__ + j * a_dim1;
+ b[i__3].r = a[i__4], b[i__3].i = 0.;
+/* L30: */
+ }
+/* L40: */
+ }
+
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ i__4 = i__ + j * a_dim1;
+ b[i__3].r = a[i__4], b[i__3].i = 0.;
+/* L50: */
+ }
+/* L60: */
+ }
+ }
+
+ return 0;
+
+/* End of ZLACP2 */
+
+} /* zlacp2_ */
+
+/* Subroutine */ int zlacpy_(char *uplo, integer *m, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4;
+
+ /* Local variables */
+ static integer i__, j;
+ extern logical lsame_(char *, char *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ February 29, 1992
+
+
+ Purpose
+ =======
+
+ ZLACPY copies all or part of a two-dimensional matrix A to another
+ matrix B.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies the part of the matrix A to be copied to B.
+ = 'U': Upper triangular part
+ = 'L': Lower triangular part
+ Otherwise: All of the matrix A
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input) COMPLEX*16 array, dimension (LDA,N)
+ The m by n matrix A. If UPLO = 'U', only the upper trapezium
+ is accessed; if UPLO = 'L', only the lower trapezium is
+ accessed.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ B (output) COMPLEX*16 array, dimension (LDB,N)
+ On exit, B = A in the locations specified by UPLO.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >= max(1,M).
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+
+ /* Function Body */
+ if (lsame_(uplo, "U")) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = min(j,*m);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ i__4 = i__ + j * a_dim1;
+ b[i__3].r = a[i__4].r, b[i__3].i = a[i__4].i;
+/* L10: */
+ }
+/* L20: */
+ }
+
+ } else if (lsame_(uplo, "L")) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ i__4 = i__ + j * a_dim1;
+ b[i__3].r = a[i__4].r, b[i__3].i = a[i__4].i;
+/* L30: */
+ }
+/* L40: */
+ }
+
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ i__4 = i__ + j * a_dim1;
+ b[i__3].r = a[i__4].r, b[i__3].i = a[i__4].i;
+/* L50: */
+ }
+/* L60: */
+ }
+ }
+
+ return 0;
+
+/* End of ZLACPY */
+
+} /* zlacpy_ */
+
+/* Subroutine */ int zlacrm_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublereal *b, integer *ldb, doublecomplex *c__,
+ integer *ldc, doublereal *rwork)
+{
+ /* System generated locals */
+ integer b_dim1, b_offset, a_dim1, a_offset, c_dim1, c_offset, i__1, i__2,
+ i__3, i__4, i__5;
+ doublereal d__1;
+ doublecomplex z__1;
+
+ /* Builtin functions */
+ double d_imag(doublecomplex *);
+
+ /* Local variables */
+ static integer i__, j, l;
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZLACRM performs a very simple matrix-matrix multiplication:
+ C := A * B,
+ where A is M by N and complex; B is N by N and real;
+ C is M by N and complex.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A and of the matrix C.
+ M >= 0.
+
+ N (input) INTEGER
+ The number of columns and rows of the matrix B and
+ the number of columns of the matrix C.
+ N >= 0.
+
+ A (input) COMPLEX*16 array, dimension (LDA, N)
+ A contains the M by N matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >=max(1,M).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB, N)
+ B contains the N by N matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >=max(1,N).
+
+ C (input) COMPLEX*16 array, dimension (LDC, N)
+ C contains the M by N matrix C.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >=max(1,N).
+
+ RWORK (workspace) DOUBLE PRECISION array, dimension (2*M*N)
+
+ =====================================================================
+
+
+ Quick return if possible.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --rwork;
+
+ /* Function Body */
+ if (*m == 0 || *n == 0) {
+ return 0;
+ }
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ rwork[(j - 1) * *m + i__] = a[i__3].r;
+/* L10: */
+ }
+/* L20: */
+ }
+
+ l = *m * *n + 1;
+ dgemm_("N", "N", m, n, n, &c_b1015, &rwork[1], m, &b[b_offset], ldb, &
+ c_b324, &rwork[l], m);
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ i__4 = l + (j - 1) * *m + i__ - 1;
+ c__[i__3].r = rwork[i__4], c__[i__3].i = 0.;
+/* L30: */
+ }
+/* L40: */
+ }
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ rwork[(j - 1) * *m + i__] = d_imag(&a[i__ + j * a_dim1]);
+/* L50: */
+ }
+/* L60: */
+ }
+ dgemm_("N", "N", m, n, n, &c_b1015, &rwork[1], m, &b[b_offset], ldb, &
+ c_b324, &rwork[l], m);
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ i__4 = i__ + j * c_dim1;
+ d__1 = c__[i__4].r;
+ i__5 = l + (j - 1) * *m + i__ - 1;
+ z__1.r = d__1, z__1.i = rwork[i__5];
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L70: */
+ }
+/* L80: */
+ }
+
+ return 0;
+
+/* End of ZLACRM */
+
+} /* zlacrm_ */
+
+/* Double Complex */ VOID zladiv_(doublecomplex * ret_val, doublecomplex *x,
+ doublecomplex *y)
+{
+ /* System generated locals */
+ doublereal d__1, d__2, d__3, d__4;
+ doublecomplex z__1;
+
+ /* Builtin functions */
+ double d_imag(doublecomplex *);
+
+ /* Local variables */
+ static doublereal zi, zr;
+ extern /* Subroutine */ int dladiv_(doublereal *, doublereal *,
+ doublereal *, doublereal *, doublereal *, doublereal *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ ZLADIV := X / Y, where X and Y are complex. The computation of X / Y
+ will not overflow on an intermediary step unless the results
+ overflows.
+
+ Arguments
+ =========
+
+ X (input) COMPLEX*16
+ Y (input) COMPLEX*16
+ The complex scalars X and Y.
+
+ =====================================================================
+*/
+
+
+ d__1 = x->r;
+ d__2 = d_imag(x);
+ d__3 = y->r;
+ d__4 = d_imag(y);
+ dladiv_(&d__1, &d__2, &d__3, &d__4, &zr, &zi);
+ z__1.r = zr, z__1.i = zi;
+ ret_val->r = z__1.r, ret_val->i = z__1.i;
+
+ return ;
+
+/* End of ZLADIV */
+
+} /* zladiv_ */
+
+/* Subroutine */ int zlaed0_(integer *qsiz, integer *n, doublereal *d__,
+ doublereal *e, doublecomplex *q, integer *ldq, doublecomplex *qstore,
+ integer *ldqs, doublereal *rwork, integer *iwork, integer *info)
+{
+ /* System generated locals */
+ integer q_dim1, q_offset, qstore_dim1, qstore_offset, i__1, i__2;
+ doublereal d__1;
+
+ /* Builtin functions */
+ double log(doublereal);
+ integer pow_ii(integer *, integer *);
+
+ /* Local variables */
+ static integer i__, j, k, ll, iq, lgn, msd2, smm1, spm1, spm2;
+ static doublereal temp;
+ static integer curr, iperm;
+ extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
+ doublereal *, integer *);
+ static integer indxq, iwrem, iqptr, tlvls;
+ extern /* Subroutine */ int zcopy_(integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *), zlaed7_(integer *, integer *,
+ integer *, integer *, integer *, integer *, doublereal *,
+ doublecomplex *, integer *, doublereal *, integer *, doublereal *,
+ integer *, integer *, integer *, integer *, integer *,
+ doublereal *, doublecomplex *, doublereal *, integer *, integer *)
+ ;
+ static integer igivcl;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int zlacrm_(integer *, integer *, doublecomplex *,
+ integer *, doublereal *, integer *, doublecomplex *, integer *,
+ doublereal *);
+ static integer igivnm, submat, curprb, subpbs, igivpt;
+ extern /* Subroutine */ int dsteqr_(char *, integer *, doublereal *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *);
+ static integer curlvl, matsiz, iprmpt, smlsiz;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ Using the divide and conquer method, ZLAED0 computes all eigenvalues
+ of a symmetric tridiagonal matrix which is one diagonal block of
+ those from reducing a dense or band Hermitian matrix and
+ corresponding eigenvectors of the dense or band matrix.
+
+ Arguments
+ =========
+
+ QSIZ (input) INTEGER
+ The dimension of the unitary matrix used to reduce
+ the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the diagonal elements of the tridiagonal matrix.
+ On exit, the eigenvalues in ascending order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the off-diagonal elements of the tridiagonal matrix.
+ On exit, E has been destroyed.
+
+ Q (input/output) COMPLEX*16 array, dimension (LDQ,N)
+ On entry, Q must contain an QSIZ x N matrix whose columns
+ unitarily orthonormal. It is a part of the unitary matrix
+ that reduces the full dense Hermitian matrix to a
+ (reducible) symmetric tridiagonal matrix.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ IWORK (workspace) INTEGER array,
+ the dimension of IWORK must be at least
+ 6 + 6*N + 5*N*lg N
+ ( lg( N ) = smallest integer k
+ such that 2^k >= N )
+
+ RWORK (workspace) DOUBLE PRECISION array,
+ dimension (1 + 3*N + 2*N*lg N + 3*N**2)
+ ( lg( N ) = smallest integer k
+ such that 2^k >= N )
+
+ QSTORE (workspace) COMPLEX*16 array, dimension (LDQS, N)
+ Used to store parts of
+ the eigenvector matrix when the updating matrix multiplies
+ take place.
+
+ LDQS (input) INTEGER
+ The leading dimension of the array QSTORE.
+ LDQS >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an eigenvalue while
+ working on the submatrix lying in rows and columns
+ INFO/(N+1) through mod(INFO,N+1).
+
+ =====================================================================
+
+ Warning: N could be as big as QSIZ!
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ --e;
+ q_dim1 = *ldq;
+ q_offset = 1 + q_dim1 * 1;
+ q -= q_offset;
+ qstore_dim1 = *ldqs;
+ qstore_offset = 1 + qstore_dim1 * 1;
+ qstore -= qstore_offset;
+ --rwork;
+ --iwork;
+
+ /* Function Body */
+ *info = 0;
+
+/*
+ IF( ICOMPQ .LT. 0 .OR. ICOMPQ .GT. 2 ) THEN
+ INFO = -1
+ ELSE IF( ( ICOMPQ .EQ. 1 ) .AND. ( QSIZ .LT. MAX( 0, N ) ) )
+ $ THEN
+*/
+ if (*qsiz < max(0,*n)) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*ldq < max(1,*n)) {
+ *info = -6;
+ } else if (*ldqs < max(1,*n)) {
+ *info = -8;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZLAED0", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+ smlsiz = ilaenv_(&c__9, "ZLAED0", " ", &c__0, &c__0, &c__0, &c__0, (
+ ftnlen)6, (ftnlen)1);
+
+/*
+ Determine the size and placement of the submatrices, and save in
+ the leading elements of IWORK.
+*/
+
+ iwork[1] = *n;
+ subpbs = 1;
+ tlvls = 0;
+L10:
+ if (iwork[subpbs] > smlsiz) {
+ for (j = subpbs; j >= 1; --j) {
+ iwork[j * 2] = (iwork[j] + 1) / 2;
+ iwork[((j) << (1)) - 1] = iwork[j] / 2;
+/* L20: */
+ }
+ ++tlvls;
+ subpbs <<= 1;
+ goto L10;
+ }
+ i__1 = subpbs;
+ for (j = 2; j <= i__1; ++j) {
+ iwork[j] += iwork[j - 1];
+/* L30: */
+ }
+
+/*
+ Divide the matrix into SUBPBS submatrices of size at most SMLSIZ+1
+ using rank-1 modifications (cuts).
+*/
+
+ spm1 = subpbs - 1;
+ i__1 = spm1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ submat = iwork[i__] + 1;
+ smm1 = submat - 1;
+ d__[smm1] -= (d__1 = e[smm1], abs(d__1));
+ d__[submat] -= (d__1 = e[smm1], abs(d__1));
+/* L40: */
+ }
+
+ indxq = ((*n) << (2)) + 3;
+
+/*
+ Set up workspaces for eigenvalues only/accumulate new vectors
+ routine
+*/
+
+ temp = log((doublereal) (*n)) / log(2.);
+ lgn = (integer) temp;
+ if (pow_ii(&c__2, &lgn) < *n) {
+ ++lgn;
+ }
+ if (pow_ii(&c__2, &lgn) < *n) {
+ ++lgn;
+ }
+ iprmpt = indxq + *n + 1;
+ iperm = iprmpt + *n * lgn;
+ iqptr = iperm + *n * lgn;
+ igivpt = iqptr + *n + 2;
+ igivcl = igivpt + *n * lgn;
+
+ igivnm = 1;
+ iq = igivnm + ((*n) << (1)) * lgn;
+/* Computing 2nd power */
+ i__1 = *n;
+ iwrem = iq + i__1 * i__1 + 1;
+/* Initialize pointers */
+ i__1 = subpbs;
+ for (i__ = 0; i__ <= i__1; ++i__) {
+ iwork[iprmpt + i__] = 1;
+ iwork[igivpt + i__] = 1;
+/* L50: */
+ }
+ iwork[iqptr] = 1;
+
+/*
+ Solve each submatrix eigenproblem at the bottom of the divide and
+ conquer tree.
+*/
+
+ curr = 0;
+ i__1 = spm1;
+ for (i__ = 0; i__ <= i__1; ++i__) {
+ if (i__ == 0) {
+ submat = 1;
+ matsiz = iwork[1];
+ } else {
+ submat = iwork[i__] + 1;
+ matsiz = iwork[i__ + 1] - iwork[i__];
+ }
+ ll = iq - 1 + iwork[iqptr + curr];
+ dsteqr_("I", &matsiz, &d__[submat], &e[submat], &rwork[ll], &matsiz, &
+ rwork[1], info);
+ zlacrm_(qsiz, &matsiz, &q[submat * q_dim1 + 1], ldq, &rwork[ll], &
+ matsiz, &qstore[submat * qstore_dim1 + 1], ldqs, &rwork[iwrem]
+ );
+/* Computing 2nd power */
+ i__2 = matsiz;
+ iwork[iqptr + curr + 1] = iwork[iqptr + curr] + i__2 * i__2;
+ ++curr;
+ if (*info > 0) {
+ *info = submat * (*n + 1) + submat + matsiz - 1;
+ return 0;
+ }
+ k = 1;
+ i__2 = iwork[i__ + 1];
+ for (j = submat; j <= i__2; ++j) {
+ iwork[indxq + j] = k;
+ ++k;
+/* L60: */
+ }
+/* L70: */
+ }
+
+/*
+ Successively merge eigensystems of adjacent submatrices
+ into eigensystem for the corresponding larger matrix.
+
+ while ( SUBPBS > 1 )
+*/
+
+ curlvl = 1;
+L80:
+ if (subpbs > 1) {
+ spm2 = subpbs - 2;
+ i__1 = spm2;
+ for (i__ = 0; i__ <= i__1; i__ += 2) {
+ if (i__ == 0) {
+ submat = 1;
+ matsiz = iwork[2];
+ msd2 = iwork[1];
+ curprb = 0;
+ } else {
+ submat = iwork[i__] + 1;
+ matsiz = iwork[i__ + 2] - iwork[i__];
+ msd2 = matsiz / 2;
+ ++curprb;
+ }
+
+/*
+ Merge lower order eigensystems (of size MSD2 and MATSIZ - MSD2)
+ into an eigensystem of size MATSIZ. ZLAED7 handles the case
+ when the eigenvectors of a full or band Hermitian matrix (which
+ was reduced to tridiagonal form) are desired.
+
+ I am free to use Q as a valuable working space until Loop 150.
+*/
+
+ zlaed7_(&matsiz, &msd2, qsiz, &tlvls, &curlvl, &curprb, &d__[
+ submat], &qstore[submat * qstore_dim1 + 1], ldqs, &e[
+ submat + msd2 - 1], &iwork[indxq + submat], &rwork[iq], &
+ iwork[iqptr], &iwork[iprmpt], &iwork[iperm], &iwork[
+ igivpt], &iwork[igivcl], &rwork[igivnm], &q[submat *
+ q_dim1 + 1], &rwork[iwrem], &iwork[subpbs + 1], info);
+ if (*info > 0) {
+ *info = submat * (*n + 1) + submat + matsiz - 1;
+ return 0;
+ }
+ iwork[i__ / 2 + 1] = iwork[i__ + 2];
+/* L90: */
+ }
+ subpbs /= 2;
+ ++curlvl;
+ goto L80;
+ }
+
+/*
+ end while
+
+ Re-merge the eigenvalues/vectors which were deflated at the final
+ merge step.
+*/
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ j = iwork[indxq + i__];
+ rwork[i__] = d__[j];
+ zcopy_(qsiz, &qstore[j * qstore_dim1 + 1], &c__1, &q[i__ * q_dim1 + 1]
+ , &c__1);
+/* L100: */
+ }
+ dcopy_(n, &rwork[1], &c__1, &d__[1], &c__1);
+
+ return 0;
+
+/* End of ZLAED0 */
+
+} /* zlaed0_ */
+
+/* Subroutine */ int zlaed7_(integer *n, integer *cutpnt, integer *qsiz,
+ integer *tlvls, integer *curlvl, integer *curpbm, doublereal *d__,
+ doublecomplex *q, integer *ldq, doublereal *rho, integer *indxq,
+ doublereal *qstore, integer *qptr, integer *prmptr, integer *perm,
+ integer *givptr, integer *givcol, doublereal *givnum, doublecomplex *
+ work, doublereal *rwork, integer *iwork, integer *info)
+{
+ /* System generated locals */
+ integer q_dim1, q_offset, i__1, i__2;
+
+ /* Builtin functions */
+ integer pow_ii(integer *, integer *);
+
+ /* Local variables */
+ static integer i__, k, n1, n2, iq, iw, iz, ptr, ind1, ind2, indx, curr,
+ indxc, indxp;
+ extern /* Subroutine */ int dlaed9_(integer *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ doublereal *, doublereal *, doublereal *, integer *, integer *),
+ zlaed8_(integer *, integer *, integer *, doublecomplex *, integer
+ *, doublereal *, doublereal *, integer *, doublereal *,
+ doublereal *, doublecomplex *, integer *, doublereal *, integer *,
+ integer *, integer *, integer *, integer *, integer *,
+ doublereal *, integer *), dlaeda_(integer *, integer *, integer *,
+ integer *, integer *, integer *, integer *, integer *,
+ doublereal *, doublereal *, integer *, doublereal *, doublereal *,
+ integer *);
+ static integer idlmda;
+ extern /* Subroutine */ int dlamrg_(integer *, integer *, doublereal *,
+ integer *, integer *, integer *), xerbla_(char *, integer *), zlacrm_(integer *, integer *, doublecomplex *, integer *,
+ doublereal *, integer *, doublecomplex *, integer *, doublereal *
+ );
+ static integer coltyp;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZLAED7 computes the updated eigensystem of a diagonal
+ matrix after modification by a rank-one symmetric matrix. This
+ routine is used only for the eigenproblem which requires all
+ eigenvalues and optionally eigenvectors of a dense or banded
+ Hermitian matrix that has been reduced to tridiagonal form.
+
+ T = Q(in) ( D(in) + RHO * Z*Z' ) Q'(in) = Q(out) * D(out) * Q'(out)
+
+ where Z = Q'u, u is a vector of length N with ones in the
+ CUTPNT and CUTPNT + 1 th elements and zeros elsewhere.
+
+ The eigenvectors of the original matrix are stored in Q, and the
+ eigenvalues are in D. The algorithm consists of three stages:
+
+ The first stage consists of deflating the size of the problem
+ when there are multiple eigenvalues or if there is a zero in
+ the Z vector. For each such occurence the dimension of the
+ secular equation problem is reduced by one. This stage is
+ performed by the routine DLAED2.
+
+ The second stage consists of calculating the updated
+ eigenvalues. This is done by finding the roots of the secular
+ equation via the routine DLAED4 (as called by SLAED3).
+ This routine also calculates the eigenvectors of the current
+ problem.
+
+ The final stage consists of computing the updated eigenvectors
+ directly using the updated eigenvalues. The eigenvectors for
+ the current problem are multiplied with the eigenvectors from
+ the overall problem.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ CUTPNT (input) INTEGER
+ Contains the location of the last eigenvalue in the leading
+ sub-matrix. min(1,N) <= CUTPNT <= N.
+
+ QSIZ (input) INTEGER
+ The dimension of the unitary matrix used to reduce
+ the full matrix to tridiagonal form. QSIZ >= N.
+
+ TLVLS (input) INTEGER
+ The total number of merging levels in the overall divide and
+ conquer tree.
+
+ CURLVL (input) INTEGER
+ The current level in the overall merge routine,
+ 0 <= curlvl <= tlvls.
+
+ CURPBM (input) INTEGER
+ The current problem in the current level in the overall
+ merge routine (counting from upper left to lower right).
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the eigenvalues of the rank-1-perturbed matrix.
+ On exit, the eigenvalues of the repaired matrix.
+
+ Q (input/output) COMPLEX*16 array, dimension (LDQ,N)
+ On entry, the eigenvectors of the rank-1-perturbed matrix.
+ On exit, the eigenvectors of the repaired tridiagonal matrix.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max(1,N).
+
+ RHO (input) DOUBLE PRECISION
+ Contains the subdiagonal element used to create the rank-1
+ modification.
+
+ INDXQ (output) INTEGER array, dimension (N)
+ This contains the permutation which will reintegrate the
+ subproblem just solved back into sorted order,
+ ie. D( INDXQ( I = 1, N ) ) will be in ascending order.
+
+ IWORK (workspace) INTEGER array, dimension (4*N)
+
+ RWORK (workspace) DOUBLE PRECISION array,
+ dimension (3*N+2*QSIZ*N)
+
+ WORK (workspace) COMPLEX*16 array, dimension (QSIZ*N)
+
+ QSTORE (input/output) DOUBLE PRECISION array, dimension (N**2+1)
+ Stores eigenvectors of submatrices encountered during
+ divide and conquer, packed together. QPTR points to
+ beginning of the submatrices.
+
+ QPTR (input/output) INTEGER array, dimension (N+2)
+ List of indices pointing to beginning of submatrices stored
+ in QSTORE. The submatrices are numbered starting at the
+ bottom left of the divide and conquer tree, from left to
+ right and bottom to top.
+
+ PRMPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in PERM a
+ level's permutation is stored. PRMPTR(i+1) - PRMPTR(i)
+ indicates the size of the permutation and also the size of
+ the full, non-deflated problem.
+
+ PERM (input) INTEGER array, dimension (N lg N)
+ Contains the permutations (from deflation and sorting) to be
+ applied to each eigenblock.
+
+ GIVPTR (input) INTEGER array, dimension (N lg N)
+ Contains a list of pointers which indicate where in GIVCOL a
+ level's Givens rotations are stored. GIVPTR(i+1) - GIVPTR(i)
+ indicates the number of Givens rotations.
+
+ GIVCOL (input) INTEGER array, dimension (2, N lg N)
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation.
+
+ GIVNUM (input) DOUBLE PRECISION array, dimension (2, N lg N)
+ Each number indicates the S value to be used in the
+ corresponding Givens rotation.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: if INFO = 1, an eigenvalue did not converge
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ q_dim1 = *ldq;
+ q_offset = 1 + q_dim1 * 1;
+ q -= q_offset;
+ --indxq;
+ --qstore;
+ --qptr;
+ --prmptr;
+ --perm;
+ --givptr;
+ givcol -= 3;
+ givnum -= 3;
+ --work;
+ --rwork;
+ --iwork;
+
+ /* Function Body */
+ *info = 0;
+
+/*
+ IF( ICOMPQ.LT.0 .OR. ICOMPQ.GT.1 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+*/
+ if (*n < 0) {
+ *info = -1;
+ } else if (min(1,*n) > *cutpnt || *n < *cutpnt) {
+ *info = -2;
+ } else if (*qsiz < *n) {
+ *info = -3;
+ } else if (*ldq < max(1,*n)) {
+ *info = -9;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZLAED7", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+/*
+ The following values are for bookkeeping purposes only. They are
+ integer pointers which indicate the portion of the workspace
+ used by a particular array in DLAED2 and SLAED3.
+*/
+
+ iz = 1;
+ idlmda = iz + *n;
+ iw = idlmda + *n;
+ iq = iw + *n;
+
+ indx = 1;
+ indxc = indx + *n;
+ coltyp = indxc + *n;
+ indxp = coltyp + *n;
+
+/*
+ Form the z-vector which consists of the last row of Q_1 and the
+ first row of Q_2.
+*/
+
+ ptr = pow_ii(&c__2, tlvls) + 1;
+ i__1 = *curlvl - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = *tlvls - i__;
+ ptr += pow_ii(&c__2, &i__2);
+/* L10: */
+ }
+ curr = ptr + *curpbm;
+ dlaeda_(n, tlvls, curlvl, curpbm, &prmptr[1], &perm[1], &givptr[1], &
+ givcol[3], &givnum[3], &qstore[1], &qptr[1], &rwork[iz], &rwork[
+ iz + *n], info);
+
+/*
+ When solving the final problem, we no longer need the stored data,
+ so we will overwrite the data from this level onto the previously
+ used storage space.
+*/
+
+ if (*curlvl == *tlvls) {
+ qptr[curr] = 1;
+ prmptr[curr] = 1;
+ givptr[curr] = 1;
+ }
+
+/* Sort and Deflate eigenvalues. */
+
+ zlaed8_(&k, n, qsiz, &q[q_offset], ldq, &d__[1], rho, cutpnt, &rwork[iz],
+ &rwork[idlmda], &work[1], qsiz, &rwork[iw], &iwork[indxp], &iwork[
+ indx], &indxq[1], &perm[prmptr[curr]], &givptr[curr + 1], &givcol[
+ ((givptr[curr]) << (1)) + 1], &givnum[((givptr[curr]) << (1)) + 1]
+ , info);
+ prmptr[curr + 1] = prmptr[curr] + *n;
+ givptr[curr + 1] += givptr[curr];
+
+/* Solve Secular Equation. */
+
+ if (k != 0) {
+ dlaed9_(&k, &c__1, &k, n, &d__[1], &rwork[iq], &k, rho, &rwork[idlmda]
+ , &rwork[iw], &qstore[qptr[curr]], &k, info);
+ zlacrm_(qsiz, &k, &work[1], qsiz, &qstore[qptr[curr]], &k, &q[
+ q_offset], ldq, &rwork[iq]);
+/* Computing 2nd power */
+ i__1 = k;
+ qptr[curr + 1] = qptr[curr] + i__1 * i__1;
+ if (*info != 0) {
+ return 0;
+ }
+
+/* Prepare the INDXQ sorting premutation. */
+
+ n1 = k;
+ n2 = *n - k;
+ ind1 = 1;
+ ind2 = *n;
+ dlamrg_(&n1, &n2, &d__[1], &c__1, &c_n1, &indxq[1]);
+ } else {
+ qptr[curr + 1] = qptr[curr];
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ indxq[i__] = i__;
+/* L20: */
+ }
+ }
+
+ return 0;
+
+/* End of ZLAED7 */
+
+} /* zlaed7_ */
+
+/* Subroutine */ int zlaed8_(integer *k, integer *n, integer *qsiz,
+ doublecomplex *q, integer *ldq, doublereal *d__, doublereal *rho,
+ integer *cutpnt, doublereal *z__, doublereal *dlamda, doublecomplex *
+ q2, integer *ldq2, doublereal *w, integer *indxp, integer *indx,
+ integer *indxq, integer *perm, integer *givptr, integer *givcol,
+ doublereal *givnum, integer *info)
+{
+ /* System generated locals */
+ integer q_dim1, q_offset, q2_dim1, q2_offset, i__1;
+ doublereal d__1;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static doublereal c__;
+ static integer i__, j;
+ static doublereal s, t;
+ static integer k2, n1, n2, jp, n1p1;
+ static doublereal eps, tau, tol;
+ static integer jlam, imax, jmax;
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *), dcopy_(integer *, doublereal *, integer *, doublereal
+ *, integer *), zdrot_(integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *, doublereal *, doublereal *), zcopy_(
+ integer *, doublecomplex *, integer *, doublecomplex *, integer *)
+ ;
+
+ extern integer idamax_(integer *, doublereal *, integer *);
+ extern /* Subroutine */ int dlamrg_(integer *, integer *, doublereal *,
+ integer *, integer *, integer *), xerbla_(char *, integer *), zlacpy_(char *, integer *, integer *, doublecomplex *,
+ integer *, doublecomplex *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Oak Ridge National Lab, Argonne National Lab,
+ Courant Institute, NAG Ltd., and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZLAED8 merges the two sets of eigenvalues together into a single
+ sorted set. Then it tries to deflate the size of the problem.
+ There are two ways in which deflation can occur: when two or more
+ eigenvalues are close together or if there is a tiny element in the
+ Z vector. For each such occurrence the order of the related secular
+ equation problem is reduced by one.
+
+ Arguments
+ =========
+
+ K (output) INTEGER
+ Contains the number of non-deflated eigenvalues.
+ This is the order of the related secular equation.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ QSIZ (input) INTEGER
+ The dimension of the unitary matrix used to reduce
+ the dense or band matrix to tridiagonal form.
+ QSIZ >= N if ICOMPQ = 1.
+
+ Q (input/output) COMPLEX*16 array, dimension (LDQ,N)
+ On entry, Q contains the eigenvectors of the partially solved
+ system which has been previously updated in matrix
+ multiplies with other partially solved eigensystems.
+ On exit, Q contains the trailing (N-K) updated eigenvectors
+ (those which were deflated) in its last N-K columns.
+
+ LDQ (input) INTEGER
+ The leading dimension of the array Q. LDQ >= max( 1, N ).
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, D contains the eigenvalues of the two submatrices to
+ be combined. On exit, D contains the trailing (N-K) updated
+ eigenvalues (those which were deflated) sorted into increasing
+ order.
+
+ RHO (input/output) DOUBLE PRECISION
+ Contains the off diagonal element associated with the rank-1
+ cut which originally split the two submatrices which are now
+ being recombined. RHO is modified during the computation to
+ the value required by DLAED3.
+
+ CUTPNT (input) INTEGER
+ Contains the location of the last eigenvalue in the leading
+ sub-matrix. MIN(1,N) <= CUTPNT <= N.
+
+ Z (input) DOUBLE PRECISION array, dimension (N)
+ On input this vector contains the updating vector (the last
+ row of the first sub-eigenvector matrix and the first row of
+ the second sub-eigenvector matrix). The contents of Z are
+ destroyed during the updating process.
+
+ DLAMDA (output) DOUBLE PRECISION array, dimension (N)
+ Contains a copy of the first K eigenvalues which will be used
+ by DLAED3 to form the secular equation.
+
+ Q2 (output) COMPLEX*16 array, dimension (LDQ2,N)
+ If ICOMPQ = 0, Q2 is not referenced. Otherwise,
+ Contains a copy of the first K eigenvectors which will be used
+ by DLAED7 in a matrix multiply (DGEMM) to update the new
+ eigenvectors.
+
+ LDQ2 (input) INTEGER
+ The leading dimension of the array Q2. LDQ2 >= max( 1, N ).
+
+ W (output) DOUBLE PRECISION array, dimension (N)
+ This will hold the first k values of the final
+ deflation-altered z-vector and will be passed to DLAED3.
+
+ INDXP (workspace) INTEGER array, dimension (N)
+ This will contain the permutation used to place deflated
+ values of D at the end of the array. On output INDXP(1:K)
+ points to the nondeflated D-values and INDXP(K+1:N)
+ points to the deflated eigenvalues.
+
+ INDX (workspace) INTEGER array, dimension (N)
+ This will contain the permutation used to sort the contents of
+ D into ascending order.
+
+ INDXQ (input) INTEGER array, dimension (N)
+ This contains the permutation which separately sorts the two
+ sub-problems in D into ascending order. Note that elements in
+ the second half of this permutation must first have CUTPNT
+ added to their values in order to be accurate.
+
+ PERM (output) INTEGER array, dimension (N)
+ Contains the permutations (from deflation and sorting) to be
+ applied to each eigenblock.
+
+ GIVPTR (output) INTEGER
+ Contains the number of Givens rotations which took place in
+ this subproblem.
+
+ GIVCOL (output) INTEGER array, dimension (2, N)
+ Each pair of numbers indicates a pair of columns to take place
+ in a Givens rotation.
+
+ GIVNUM (output) DOUBLE PRECISION array, dimension (2, N)
+ Each number indicates the S value to be used in the
+ corresponding Givens rotation.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ q_dim1 = *ldq;
+ q_offset = 1 + q_dim1 * 1;
+ q -= q_offset;
+ --d__;
+ --z__;
+ --dlamda;
+ q2_dim1 = *ldq2;
+ q2_offset = 1 + q2_dim1 * 1;
+ q2 -= q2_offset;
+ --w;
+ --indxp;
+ --indx;
+ --indxq;
+ --perm;
+ givcol -= 3;
+ givnum -= 3;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*n < 0) {
+ *info = -2;
+ } else if (*qsiz < *n) {
+ *info = -3;
+ } else if (*ldq < max(1,*n)) {
+ *info = -5;
+ } else if (*cutpnt < min(1,*n) || *cutpnt > *n) {
+ *info = -8;
+ } else if (*ldq2 < max(1,*n)) {
+ *info = -12;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZLAED8", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+ n1 = *cutpnt;
+ n2 = *n - n1;
+ n1p1 = n1 + 1;
+
+ if (*rho < 0.) {
+ dscal_(&n2, &c_b1294, &z__[n1p1], &c__1);
+ }
+
+/* Normalize z so that norm(z) = 1 */
+
+ t = 1. / sqrt(2.);
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ indx[j] = j;
+/* L10: */
+ }
+ dscal_(n, &t, &z__[1], &c__1);
+ *rho = (d__1 = *rho * 2., abs(d__1));
+
+/* Sort the eigenvalues into increasing order */
+
+ i__1 = *n;
+ for (i__ = *cutpnt + 1; i__ <= i__1; ++i__) {
+ indxq[i__] += *cutpnt;
+/* L20: */
+ }
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dlamda[i__] = d__[indxq[i__]];
+ w[i__] = z__[indxq[i__]];
+/* L30: */
+ }
+ i__ = 1;
+ j = *cutpnt + 1;
+ dlamrg_(&n1, &n2, &dlamda[1], &c__1, &c__1, &indx[1]);
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ d__[i__] = dlamda[indx[i__]];
+ z__[i__] = w[indx[i__]];
+/* L40: */
+ }
+
+/* Calculate the allowable deflation tolerance */
+
+ imax = idamax_(n, &z__[1], &c__1);
+ jmax = idamax_(n, &d__[1], &c__1);
+ eps = EPSILON;
+ tol = eps * 8. * (d__1 = d__[jmax], abs(d__1));
+
+/*
+ If the rank-1 modifier is small enough, no more needs to be done
+ -- except to reorganize Q so that its columns correspond with the
+ elements in D.
+*/
+
+ if (*rho * (d__1 = z__[imax], abs(d__1)) <= tol) {
+ *k = 0;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ perm[j] = indxq[indx[j]];
+ zcopy_(qsiz, &q[perm[j] * q_dim1 + 1], &c__1, &q2[j * q2_dim1 + 1]
+ , &c__1);
+/* L50: */
+ }
+ zlacpy_("A", qsiz, n, &q2[q2_dim1 + 1], ldq2, &q[q_dim1 + 1], ldq);
+ return 0;
+ }
+
+/*
+ If there are multiple eigenvalues then the problem deflates. Here
+ the number of equal eigenvalues are found. As each equal
+ eigenvalue is found, an elementary reflector is computed to rotate
+ the corresponding eigensubspace so that the corresponding
+ components of Z are zero in this new basis.
+*/
+
+ *k = 0;
+ *givptr = 0;
+ k2 = *n + 1;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*rho * (d__1 = z__[j], abs(d__1)) <= tol) {
+
+/* Deflate due to small z component. */
+
+ --k2;
+ indxp[k2] = j;
+ if (j == *n) {
+ goto L100;
+ }
+ } else {
+ jlam = j;
+ goto L70;
+ }
+/* L60: */
+ }
+L70:
+ ++j;
+ if (j > *n) {
+ goto L90;
+ }
+ if (*rho * (d__1 = z__[j], abs(d__1)) <= tol) {
+
+/* Deflate due to small z component. */
+
+ --k2;
+ indxp[k2] = j;
+ } else {
+
+/* Check if eigenvalues are close enough to allow deflation. */
+
+ s = z__[jlam];
+ c__ = z__[j];
+
+/*
+ Find sqrt(a**2+b**2) without overflow or
+ destructive underflow.
+*/
+
+ tau = dlapy2_(&c__, &s);
+ t = d__[j] - d__[jlam];
+ c__ /= tau;
+ s = -s / tau;
+ if ((d__1 = t * c__ * s, abs(d__1)) <= tol) {
+
+/* Deflation is possible. */
+
+ z__[j] = tau;
+ z__[jlam] = 0.;
+
+/* Record the appropriate Givens rotation */
+
+ ++(*givptr);
+ givcol[((*givptr) << (1)) + 1] = indxq[indx[jlam]];
+ givcol[((*givptr) << (1)) + 2] = indxq[indx[j]];
+ givnum[((*givptr) << (1)) + 1] = c__;
+ givnum[((*givptr) << (1)) + 2] = s;
+ zdrot_(qsiz, &q[indxq[indx[jlam]] * q_dim1 + 1], &c__1, &q[indxq[
+ indx[j]] * q_dim1 + 1], &c__1, &c__, &s);
+ t = d__[jlam] * c__ * c__ + d__[j] * s * s;
+ d__[j] = d__[jlam] * s * s + d__[j] * c__ * c__;
+ d__[jlam] = t;
+ --k2;
+ i__ = 1;
+L80:
+ if (k2 + i__ <= *n) {
+ if (d__[jlam] < d__[indxp[k2 + i__]]) {
+ indxp[k2 + i__ - 1] = indxp[k2 + i__];
+ indxp[k2 + i__] = jlam;
+ ++i__;
+ goto L80;
+ } else {
+ indxp[k2 + i__ - 1] = jlam;
+ }
+ } else {
+ indxp[k2 + i__ - 1] = jlam;
+ }
+ jlam = j;
+ } else {
+ ++(*k);
+ w[*k] = z__[jlam];
+ dlamda[*k] = d__[jlam];
+ indxp[*k] = jlam;
+ jlam = j;
+ }
+ }
+ goto L70;
+L90:
+
+/* Record the last eigenvalue. */
+
+ ++(*k);
+ w[*k] = z__[jlam];
+ dlamda[*k] = d__[jlam];
+ indxp[*k] = jlam;
+
+L100:
+
+/*
+ Sort the eigenvalues and corresponding eigenvectors into DLAMDA
+ and Q2 respectively. The eigenvalues/vectors which were not
+ deflated go into the first K slots of DLAMDA and Q2 respectively,
+ while those which were deflated go into the last N - K slots.
+*/
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ jp = indxp[j];
+ dlamda[j] = d__[jp];
+ perm[j] = indxq[indx[jp]];
+ zcopy_(qsiz, &q[perm[j] * q_dim1 + 1], &c__1, &q2[j * q2_dim1 + 1], &
+ c__1);
+/* L110: */
+ }
+
+/*
+ The deflated eigenvalues and their corresponding vectors go back
+ into the last N - K slots of D and Q respectively.
+*/
+
+ if (*k < *n) {
+ i__1 = *n - *k;
+ dcopy_(&i__1, &dlamda[*k + 1], &c__1, &d__[*k + 1], &c__1);
+ i__1 = *n - *k;
+ zlacpy_("A", qsiz, &i__1, &q2[(*k + 1) * q2_dim1 + 1], ldq2, &q[(*k +
+ 1) * q_dim1 + 1], ldq);
+ }
+
+ return 0;
+
+/* End of ZLAED8 */
+
+} /* zlaed8_ */
+
+/* Subroutine */ int zlahqr_(logical *wantt, logical *wantz, integer *n,
+ integer *ilo, integer *ihi, doublecomplex *h__, integer *ldh,
+ doublecomplex *w, integer *iloz, integer *ihiz, doublecomplex *z__,
+ integer *ldz, integer *info)
+{
+ /* System generated locals */
+ integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5;
+ doublereal d__1, d__2, d__3, d__4, d__5, d__6;
+ doublecomplex z__1, z__2, z__3, z__4;
+
+ /* Builtin functions */
+ double d_imag(doublecomplex *);
+ void z_sqrt(doublecomplex *, doublecomplex *), d_cnjg(doublecomplex *,
+ doublecomplex *);
+ double z_abs(doublecomplex *);
+
+ /* Local variables */
+ static integer i__, j, k, l, m;
+ static doublereal s;
+ static doublecomplex t, u, v[2], x, y;
+ static integer i1, i2;
+ static doublecomplex t1;
+ static doublereal t2;
+ static doublecomplex v2;
+ static doublereal h10;
+ static doublecomplex h11;
+ static doublereal h21;
+ static doublecomplex h22;
+ static integer nh, nz;
+ static doublecomplex h11s;
+ static integer itn, its;
+ static doublereal ulp;
+ static doublecomplex sum;
+ static doublereal tst1;
+ static doublecomplex temp;
+ extern /* Subroutine */ int zscal_(integer *, doublecomplex *,
+ doublecomplex *, integer *);
+ static doublereal rtemp, rwork[1];
+ extern /* Subroutine */ int zcopy_(integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *);
+
+ extern /* Subroutine */ int zlarfg_(integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *);
+ extern /* Double Complex */ VOID zladiv_(doublecomplex *, doublecomplex *,
+ doublecomplex *);
+ extern doublereal zlanhs_(char *, integer *, doublecomplex *, integer *,
+ doublereal *);
+ static doublereal smlnum;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZLAHQR is an auxiliary routine called by ZHSEQR to update the
+ eigenvalues and Schur decomposition already computed by ZHSEQR, by
+ dealing with the Hessenberg submatrix in rows and columns ILO to IHI.
+
+ Arguments
+ =========
+
+ WANTT (input) LOGICAL
+ = .TRUE. : the full Schur form T is required;
+ = .FALSE.: only eigenvalues are required.
+
+ WANTZ (input) LOGICAL
+ = .TRUE. : the matrix of Schur vectors Z is required;
+ = .FALSE.: Schur vectors are not required.
+
+ N (input) INTEGER
+ The order of the matrix H. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ It is assumed that H is already upper triangular in rows and
+ columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless ILO = 1).
+ ZLAHQR works primarily with the Hessenberg submatrix in rows
+ and columns ILO to IHI, but applies transformations to all of
+ H if WANTT is .TRUE..
+ 1 <= ILO <= max(1,IHI); IHI <= N.
+
+ H (input/output) COMPLEX*16 array, dimension (LDH,N)
+ On entry, the upper Hessenberg matrix H.
+ On exit, if WANTT is .TRUE., H is upper triangular in rows
+ and columns ILO:IHI, with any 2-by-2 diagonal blocks in
+ standard form. If WANTT is .FALSE., the contents of H are
+ unspecified on exit.
+
+ LDH (input) INTEGER
+ The leading dimension of the array H. LDH >= max(1,N).
+
+ W (output) COMPLEX*16 array, dimension (N)
+ The computed eigenvalues ILO to IHI are stored in the
+ corresponding elements of W. If WANTT is .TRUE., the
+ eigenvalues are stored in the same order as on the diagonal
+ of the Schur form returned in H, with W(i) = H(i,i).
+
+ ILOZ (input) INTEGER
+ IHIZ (input) INTEGER
+ Specify the rows of Z to which transformations must be
+ applied if WANTZ is .TRUE..
+ 1 <= ILOZ <= ILO; IHI <= IHIZ <= N.
+
+ Z (input/output) COMPLEX*16 array, dimension (LDZ,N)
+ If WANTZ is .TRUE., on entry Z must contain the current
+ matrix Z of transformations accumulated by ZHSEQR, and on
+ exit Z has been updated; transformations are applied only to
+ the submatrix Z(ILOZ:IHIZ,ILO:IHI).
+ If WANTZ is .FALSE., Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ > 0: if INFO = i, ZLAHQR failed to compute all the
+ eigenvalues ILO to IHI in a total of 30*(IHI-ILO+1)
+ iterations; elements i+1:ihi of W contain those
+ eigenvalues which have been successfully computed.
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ h_dim1 = *ldh;
+ h_offset = 1 + h_dim1 * 1;
+ h__ -= h_offset;
+ --w;
+ z_dim1 = *ldz;
+ z_offset = 1 + z_dim1 * 1;
+ z__ -= z_offset;
+
+ /* Function Body */
+ *info = 0;
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+ if (*ilo == *ihi) {
+ i__1 = *ilo;
+ i__2 = *ilo + *ilo * h_dim1;
+ w[i__1].r = h__[i__2].r, w[i__1].i = h__[i__2].i;
+ return 0;
+ }
+
+ nh = *ihi - *ilo + 1;
+ nz = *ihiz - *iloz + 1;
+
+/*
+ Set machine-dependent constants for the stopping criterion.
+ If norm(H) <= sqrt(OVFL), overflow should not occur.
+*/
+
+ ulp = PRECISION;
+ smlnum = SAFEMINIMUM / ulp;
+
+/*
+ I1 and I2 are the indices of the first row and last column of H
+ to which transformations must be applied. If eigenvalues only are
+ being computed, I1 and I2 are set inside the main loop.
+*/
+
+ if (*wantt) {
+ i1 = 1;
+ i2 = *n;
+ }
+
+/* ITN is the total number of QR iterations allowed. */
+
+ itn = nh * 30;
+
+/*
+ The main loop begins here. I is the loop index and decreases from
+ IHI to ILO in steps of 1. Each iteration of the loop works
+ with the active submatrix in rows and columns L to I.
+ Eigenvalues I+1 to IHI have already converged. Either L = ILO, or
+ H(L,L-1) is negligible so that the matrix splits.
+*/
+
+ i__ = *ihi;
+L10:
+ if (i__ < *ilo) {
+ goto L130;
+ }
+
+/*
+ Perform QR iterations on rows and columns ILO to I until a
+ submatrix of order 1 splits off at the bottom because a
+ subdiagonal element has become negligible.
+*/
+
+ l = *ilo;
+ i__1 = itn;
+ for (its = 0; its <= i__1; ++its) {
+
+/* Look for a single small subdiagonal element. */
+
+ i__2 = l + 1;
+ for (k = i__; k >= i__2; --k) {
+ i__3 = k - 1 + (k - 1) * h_dim1;
+ i__4 = k + k * h_dim1;
+ tst1 = (d__1 = h__[i__3].r, abs(d__1)) + (d__2 = d_imag(&h__[k -
+ 1 + (k - 1) * h_dim1]), abs(d__2)) + ((d__3 = h__[i__4].r,
+ abs(d__3)) + (d__4 = d_imag(&h__[k + k * h_dim1]), abs(
+ d__4)));
+ if (tst1 == 0.) {
+ i__3 = i__ - l + 1;
+ tst1 = zlanhs_("1", &i__3, &h__[l + l * h_dim1], ldh, rwork);
+ }
+ i__3 = k + (k - 1) * h_dim1;
+/* Computing MAX */
+ d__2 = ulp * tst1;
+ if ((d__1 = h__[i__3].r, abs(d__1)) <= max(d__2,smlnum)) {
+ goto L30;
+ }
+/* L20: */
+ }
+L30:
+ l = k;
+ if (l > *ilo) {
+
+/* H(L,L-1) is negligible */
+
+ i__2 = l + (l - 1) * h_dim1;
+ h__[i__2].r = 0., h__[i__2].i = 0.;
+ }
+
+/* Exit from loop if a submatrix of order 1 has split off. */
+
+ if (l >= i__) {
+ goto L120;
+ }
+
+/*
+ Now the active submatrix is in rows and columns L to I. If
+ eigenvalues only are being computed, only the active submatrix
+ need be transformed.
+*/
+
+ if (! (*wantt)) {
+ i1 = l;
+ i2 = i__;
+ }
+
+ if (its == 10 || its == 20) {
+
+/* Exceptional shift. */
+
+ i__2 = i__ + (i__ - 1) * h_dim1;
+ s = (d__1 = h__[i__2].r, abs(d__1)) * .75;
+ i__2 = i__ + i__ * h_dim1;
+ z__1.r = s + h__[i__2].r, z__1.i = h__[i__2].i;
+ t.r = z__1.r, t.i = z__1.i;
+ } else {
+
+/* Wilkinson's shift. */
+
+ i__2 = i__ + i__ * h_dim1;
+ t.r = h__[i__2].r, t.i = h__[i__2].i;
+ i__2 = i__ - 1 + i__ * h_dim1;
+ i__3 = i__ + (i__ - 1) * h_dim1;
+ d__1 = h__[i__3].r;
+ z__1.r = d__1 * h__[i__2].r, z__1.i = d__1 * h__[i__2].i;
+ u.r = z__1.r, u.i = z__1.i;
+ if (u.r != 0. || u.i != 0.) {
+ i__2 = i__ - 1 + (i__ - 1) * h_dim1;
+ z__2.r = h__[i__2].r - t.r, z__2.i = h__[i__2].i - t.i;
+ z__1.r = z__2.r * .5, z__1.i = z__2.i * .5;
+ x.r = z__1.r, x.i = z__1.i;
+ z__3.r = x.r * x.r - x.i * x.i, z__3.i = x.r * x.i + x.i *
+ x.r;
+ z__2.r = z__3.r + u.r, z__2.i = z__3.i + u.i;
+ z_sqrt(&z__1, &z__2);
+ y.r = z__1.r, y.i = z__1.i;
+ if (x.r * y.r + d_imag(&x) * d_imag(&y) < 0.) {
+ z__1.r = -y.r, z__1.i = -y.i;
+ y.r = z__1.r, y.i = z__1.i;
+ }
+ z__3.r = x.r + y.r, z__3.i = x.i + y.i;
+ zladiv_(&z__2, &u, &z__3);
+ z__1.r = t.r - z__2.r, z__1.i = t.i - z__2.i;
+ t.r = z__1.r, t.i = z__1.i;
+ }
+ }
+
+/* Look for two consecutive small subdiagonal elements. */
+
+ i__2 = l + 1;
+ for (m = i__ - 1; m >= i__2; --m) {
+
+/*
+ Determine the effect of starting the single-shift QR
+ iteration at row M, and see if this would make H(M,M-1)
+ negligible.
+*/
+
+ i__3 = m + m * h_dim1;
+ h11.r = h__[i__3].r, h11.i = h__[i__3].i;
+ i__3 = m + 1 + (m + 1) * h_dim1;
+ h22.r = h__[i__3].r, h22.i = h__[i__3].i;
+ z__1.r = h11.r - t.r, z__1.i = h11.i - t.i;
+ h11s.r = z__1.r, h11s.i = z__1.i;
+ i__3 = m + 1 + m * h_dim1;
+ h21 = h__[i__3].r;
+ s = (d__1 = h11s.r, abs(d__1)) + (d__2 = d_imag(&h11s), abs(d__2))
+ + abs(h21);
+ z__1.r = h11s.r / s, z__1.i = h11s.i / s;
+ h11s.r = z__1.r, h11s.i = z__1.i;
+ h21 /= s;
+ v[0].r = h11s.r, v[0].i = h11s.i;
+ v[1].r = h21, v[1].i = 0.;
+ i__3 = m + (m - 1) * h_dim1;
+ h10 = h__[i__3].r;
+ tst1 = ((d__1 = h11s.r, abs(d__1)) + (d__2 = d_imag(&h11s), abs(
+ d__2))) * ((d__3 = h11.r, abs(d__3)) + (d__4 = d_imag(&
+ h11), abs(d__4)) + ((d__5 = h22.r, abs(d__5)) + (d__6 =
+ d_imag(&h22), abs(d__6))));
+ if ((d__1 = h10 * h21, abs(d__1)) <= ulp * tst1) {
+ goto L50;
+ }
+/* L40: */
+ }
+ i__2 = l + l * h_dim1;
+ h11.r = h__[i__2].r, h11.i = h__[i__2].i;
+ i__2 = l + 1 + (l + 1) * h_dim1;
+ h22.r = h__[i__2].r, h22.i = h__[i__2].i;
+ z__1.r = h11.r - t.r, z__1.i = h11.i - t.i;
+ h11s.r = z__1.r, h11s.i = z__1.i;
+ i__2 = l + 1 + l * h_dim1;
+ h21 = h__[i__2].r;
+ s = (d__1 = h11s.r, abs(d__1)) + (d__2 = d_imag(&h11s), abs(d__2)) +
+ abs(h21);
+ z__1.r = h11s.r / s, z__1.i = h11s.i / s;
+ h11s.r = z__1.r, h11s.i = z__1.i;
+ h21 /= s;
+ v[0].r = h11s.r, v[0].i = h11s.i;
+ v[1].r = h21, v[1].i = 0.;
+L50:
+
+/* Single-shift QR step */
+
+ i__2 = i__ - 1;
+ for (k = m; k <= i__2; ++k) {
+
+/*
+ The first iteration of this loop determines a reflection G
+ from the vector V and applies it from left and right to H,
+ thus creating a nonzero bulge below the subdiagonal.
+
+ Each subsequent iteration determines a reflection G to
+ restore the Hessenberg form in the (K-1)th column, and thus
+ chases the bulge one step toward the bottom of the active
+ submatrix.
+
+ V(2) is always real before the call to ZLARFG, and hence
+ after the call T2 ( = T1*V(2) ) is also real.
+*/
+
+ if (k > m) {
+ zcopy_(&c__2, &h__[k + (k - 1) * h_dim1], &c__1, v, &c__1);
+ }
+ zlarfg_(&c__2, v, &v[1], &c__1, &t1);
+ if (k > m) {
+ i__3 = k + (k - 1) * h_dim1;
+ h__[i__3].r = v[0].r, h__[i__3].i = v[0].i;
+ i__3 = k + 1 + (k - 1) * h_dim1;
+ h__[i__3].r = 0., h__[i__3].i = 0.;
+ }
+ v2.r = v[1].r, v2.i = v[1].i;
+ z__1.r = t1.r * v2.r - t1.i * v2.i, z__1.i = t1.r * v2.i + t1.i *
+ v2.r;
+ t2 = z__1.r;
+
+/*
+ Apply G from the left to transform the rows of the matrix
+ in columns K to I2.
+*/
+
+ i__3 = i2;
+ for (j = k; j <= i__3; ++j) {
+ d_cnjg(&z__3, &t1);
+ i__4 = k + j * h_dim1;
+ z__2.r = z__3.r * h__[i__4].r - z__3.i * h__[i__4].i, z__2.i =
+ z__3.r * h__[i__4].i + z__3.i * h__[i__4].r;
+ i__5 = k + 1 + j * h_dim1;
+ z__4.r = t2 * h__[i__5].r, z__4.i = t2 * h__[i__5].i;
+ z__1.r = z__2.r + z__4.r, z__1.i = z__2.i + z__4.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__4 = k + j * h_dim1;
+ i__5 = k + j * h_dim1;
+ z__1.r = h__[i__5].r - sum.r, z__1.i = h__[i__5].i - sum.i;
+ h__[i__4].r = z__1.r, h__[i__4].i = z__1.i;
+ i__4 = k + 1 + j * h_dim1;
+ i__5 = k + 1 + j * h_dim1;
+ z__2.r = sum.r * v2.r - sum.i * v2.i, z__2.i = sum.r * v2.i +
+ sum.i * v2.r;
+ z__1.r = h__[i__5].r - z__2.r, z__1.i = h__[i__5].i - z__2.i;
+ h__[i__4].r = z__1.r, h__[i__4].i = z__1.i;
+/* L60: */
+ }
+
+/*
+ Apply G from the right to transform the columns of the
+ matrix in rows I1 to min(K+2,I).
+
+ Computing MIN
+*/
+ i__4 = k + 2;
+ i__3 = min(i__4,i__);
+ for (j = i1; j <= i__3; ++j) {
+ i__4 = j + k * h_dim1;
+ z__2.r = t1.r * h__[i__4].r - t1.i * h__[i__4].i, z__2.i =
+ t1.r * h__[i__4].i + t1.i * h__[i__4].r;
+ i__5 = j + (k + 1) * h_dim1;
+ z__3.r = t2 * h__[i__5].r, z__3.i = t2 * h__[i__5].i;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__4 = j + k * h_dim1;
+ i__5 = j + k * h_dim1;
+ z__1.r = h__[i__5].r - sum.r, z__1.i = h__[i__5].i - sum.i;
+ h__[i__4].r = z__1.r, h__[i__4].i = z__1.i;
+ i__4 = j + (k + 1) * h_dim1;
+ i__5 = j + (k + 1) * h_dim1;
+ d_cnjg(&z__3, &v2);
+ z__2.r = sum.r * z__3.r - sum.i * z__3.i, z__2.i = sum.r *
+ z__3.i + sum.i * z__3.r;
+ z__1.r = h__[i__5].r - z__2.r, z__1.i = h__[i__5].i - z__2.i;
+ h__[i__4].r = z__1.r, h__[i__4].i = z__1.i;
+/* L70: */
+ }
+
+ if (*wantz) {
+
+/* Accumulate transformations in the matrix Z */
+
+ i__3 = *ihiz;
+ for (j = *iloz; j <= i__3; ++j) {
+ i__4 = j + k * z_dim1;
+ z__2.r = t1.r * z__[i__4].r - t1.i * z__[i__4].i, z__2.i =
+ t1.r * z__[i__4].i + t1.i * z__[i__4].r;
+ i__5 = j + (k + 1) * z_dim1;
+ z__3.r = t2 * z__[i__5].r, z__3.i = t2 * z__[i__5].i;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__4 = j + k * z_dim1;
+ i__5 = j + k * z_dim1;
+ z__1.r = z__[i__5].r - sum.r, z__1.i = z__[i__5].i -
+ sum.i;
+ z__[i__4].r = z__1.r, z__[i__4].i = z__1.i;
+ i__4 = j + (k + 1) * z_dim1;
+ i__5 = j + (k + 1) * z_dim1;
+ d_cnjg(&z__3, &v2);
+ z__2.r = sum.r * z__3.r - sum.i * z__3.i, z__2.i = sum.r *
+ z__3.i + sum.i * z__3.r;
+ z__1.r = z__[i__5].r - z__2.r, z__1.i = z__[i__5].i -
+ z__2.i;
+ z__[i__4].r = z__1.r, z__[i__4].i = z__1.i;
+/* L80: */
+ }
+ }
+
+ if ((k == m && m > l)) {
+
+/*
+ If the QR step was started at row M > L because two
+ consecutive small subdiagonals were found, then extra
+ scaling must be performed to ensure that H(M,M-1) remains
+ real.
+*/
+
+ z__1.r = 1. - t1.r, z__1.i = 0. - t1.i;
+ temp.r = z__1.r, temp.i = z__1.i;
+ d__1 = z_abs(&temp);
+ z__1.r = temp.r / d__1, z__1.i = temp.i / d__1;
+ temp.r = z__1.r, temp.i = z__1.i;
+ i__3 = m + 1 + m * h_dim1;
+ i__4 = m + 1 + m * h_dim1;
+ d_cnjg(&z__2, &temp);
+ z__1.r = h__[i__4].r * z__2.r - h__[i__4].i * z__2.i, z__1.i =
+ h__[i__4].r * z__2.i + h__[i__4].i * z__2.r;
+ h__[i__3].r = z__1.r, h__[i__3].i = z__1.i;
+ if (m + 2 <= i__) {
+ i__3 = m + 2 + (m + 1) * h_dim1;
+ i__4 = m + 2 + (m + 1) * h_dim1;
+ z__1.r = h__[i__4].r * temp.r - h__[i__4].i * temp.i,
+ z__1.i = h__[i__4].r * temp.i + h__[i__4].i *
+ temp.r;
+ h__[i__3].r = z__1.r, h__[i__3].i = z__1.i;
+ }
+ i__3 = i__;
+ for (j = m; j <= i__3; ++j) {
+ if (j != m + 1) {
+ if (i2 > j) {
+ i__4 = i2 - j;
+ zscal_(&i__4, &temp, &h__[j + (j + 1) * h_dim1],
+ ldh);
+ }
+ i__4 = j - i1;
+ d_cnjg(&z__1, &temp);
+ zscal_(&i__4, &z__1, &h__[i1 + j * h_dim1], &c__1);
+ if (*wantz) {
+ d_cnjg(&z__1, &temp);
+ zscal_(&nz, &z__1, &z__[*iloz + j * z_dim1], &
+ c__1);
+ }
+ }
+/* L90: */
+ }
+ }
+/* L100: */
+ }
+
+/* Ensure that H(I,I-1) is real. */
+
+ i__2 = i__ + (i__ - 1) * h_dim1;
+ temp.r = h__[i__2].r, temp.i = h__[i__2].i;
+ if (d_imag(&temp) != 0.) {
+ rtemp = z_abs(&temp);
+ i__2 = i__ + (i__ - 1) * h_dim1;
+ h__[i__2].r = rtemp, h__[i__2].i = 0.;
+ z__1.r = temp.r / rtemp, z__1.i = temp.i / rtemp;
+ temp.r = z__1.r, temp.i = z__1.i;
+ if (i2 > i__) {
+ i__2 = i2 - i__;
+ d_cnjg(&z__1, &temp);
+ zscal_(&i__2, &z__1, &h__[i__ + (i__ + 1) * h_dim1], ldh);
+ }
+ i__2 = i__ - i1;
+ zscal_(&i__2, &temp, &h__[i1 + i__ * h_dim1], &c__1);
+ if (*wantz) {
+ zscal_(&nz, &temp, &z__[*iloz + i__ * z_dim1], &c__1);
+ }
+ }
+
+/* L110: */
+ }
+
+/* Failure to converge in remaining number of iterations */
+
+ *info = i__;
+ return 0;
+
+L120:
+
+/* H(I,I-1) is negligible: one eigenvalue has converged. */
+
+ i__1 = i__;
+ i__2 = i__ + i__ * h_dim1;
+ w[i__1].r = h__[i__2].r, w[i__1].i = h__[i__2].i;
+
+/*
+ Decrement number of remaining iterations, and return to start of
+ the main loop with new value of I.
+*/
+
+ itn -= its;
+ i__ = l - 1;
+ goto L10;
+
+L130:
+ return 0;
+
+/* End of ZLAHQR */
+
+} /* zlahqr_ */
+
+/* Subroutine */ int zlahrd_(integer *n, integer *k, integer *nb,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *t,
+ integer *ldt, doublecomplex *y, integer *ldy)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, t_dim1, t_offset, y_dim1, y_offset, i__1, i__2,
+ i__3;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer i__;
+ static doublecomplex ei;
+ extern /* Subroutine */ int zscal_(integer *, doublecomplex *,
+ doublecomplex *, integer *), zgemv_(char *, integer *, integer *,
+ doublecomplex *, doublecomplex *, integer *, doublecomplex *,
+ integer *, doublecomplex *, doublecomplex *, integer *),
+ zcopy_(integer *, doublecomplex *, integer *, doublecomplex *,
+ integer *), zaxpy_(integer *, doublecomplex *, doublecomplex *,
+ integer *, doublecomplex *, integer *), ztrmv_(char *, char *,
+ char *, integer *, doublecomplex *, integer *, doublecomplex *,
+ integer *), zlarfg_(integer *,
+ doublecomplex *, doublecomplex *, integer *, doublecomplex *),
+ zlacgv_(integer *, doublecomplex *, integer *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZLAHRD reduces the first NB columns of a complex general n-by-(n-k+1)
+ matrix A so that elements below the k-th subdiagonal are zero. The
+ reduction is performed by a unitary similarity transformation
+ Q' * A * Q. The routine returns the matrices V and T which determine
+ Q as a block reflector I - V*T*V', and also the matrix Y = A * V * T.
+
+ This is an auxiliary routine called by ZGEHRD.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ K (input) INTEGER
+ The offset for the reduction. Elements below the k-th
+ subdiagonal in the first NB columns are reduced to zero.
+
+ NB (input) INTEGER
+ The number of columns to be reduced.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N-K+1)
+ On entry, the n-by-(n-k+1) general matrix A.
+ On exit, the elements on and above the k-th subdiagonal in
+ the first NB columns are overwritten with the corresponding
+ elements of the reduced matrix; the elements below the k-th
+ subdiagonal, with the array TAU, represent the matrix Q as a
+ product of elementary reflectors. The other columns of A are
+ unchanged. See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (output) COMPLEX*16 array, dimension (NB)
+ The scalar factors of the elementary reflectors. See Further
+ Details.
+
+ T (output) COMPLEX*16 array, dimension (LDT,NB)
+ The upper triangular matrix T.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= NB.
+
+ Y (output) COMPLEX*16 array, dimension (LDY,NB)
+ The n-by-nb matrix Y.
+
+ LDY (input) INTEGER
+ The leading dimension of the array Y. LDY >= max(1,N).
+
+ Further Details
+ ===============
+
+ The matrix Q is represented as a product of nb elementary reflectors
+
+ Q = H(1) H(2) . . . H(nb).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a complex scalar, and v is a complex vector with
+ v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in
+ A(i+k+1:n,i), and tau in TAU(i).
+
+ The elements of the vectors v together form the (n-k+1)-by-nb matrix
+ V which is needed, with T and Y, to apply the transformation to the
+ unreduced part of the matrix, using an update of the form:
+ A := (I - V*T*V') * (A - Y*V').
+
+ The contents of A on exit are illustrated by the following example
+ with n = 7, k = 3 and nb = 2:
+
+ ( a h a a a )
+ ( a h a a a )
+ ( a h a a a )
+ ( h h a a a )
+ ( v1 h a a a )
+ ( v1 v2 a a a )
+ ( v1 v2 a a a )
+
+ where a denotes an element of the original matrix A, h denotes a
+ modified element of the upper Hessenberg matrix H, and vi denotes an
+ element of the vector defining H(i).
+
+ =====================================================================
+
+
+ Quick return if possible
+*/
+
+ /* Parameter adjustments */
+ --tau;
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ t_dim1 = *ldt;
+ t_offset = 1 + t_dim1 * 1;
+ t -= t_offset;
+ y_dim1 = *ldy;
+ y_offset = 1 + y_dim1 * 1;
+ y -= y_offset;
+
+ /* Function Body */
+ if (*n <= 1) {
+ return 0;
+ }
+
+ i__1 = *nb;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if (i__ > 1) {
+
+/*
+ Update A(1:n,i)
+
+ Compute i-th column of A - Y * V'
+*/
+
+ i__2 = i__ - 1;
+ zlacgv_(&i__2, &a[*k + i__ - 1 + a_dim1], lda);
+ i__2 = i__ - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", n, &i__2, &z__1, &y[y_offset], ldy, &a[*k
+ + i__ - 1 + a_dim1], lda, &c_b60, &a[i__ * a_dim1 + 1], &
+ c__1);
+ i__2 = i__ - 1;
+ zlacgv_(&i__2, &a[*k + i__ - 1 + a_dim1], lda);
+
+/*
+ Apply I - V * T' * V' to this column (call it b) from the
+ left, using the last column of T as workspace
+
+ Let V = ( V1 ) and b = ( b1 ) (first I-1 rows)
+ ( V2 ) ( b2 )
+
+ where V1 is unit lower triangular
+
+ w := V1' * b1
+*/
+
+ i__2 = i__ - 1;
+ zcopy_(&i__2, &a[*k + 1 + i__ * a_dim1], &c__1, &t[*nb * t_dim1 +
+ 1], &c__1);
+ i__2 = i__ - 1;
+ ztrmv_("Lower", "Conjugate transpose", "Unit", &i__2, &a[*k + 1 +
+ a_dim1], lda, &t[*nb * t_dim1 + 1], &c__1);
+
+/* w := w + V2'*b2 */
+
+ i__2 = *n - *k - i__ + 1;
+ i__3 = i__ - 1;
+ zgemv_("Conjugate transpose", &i__2, &i__3, &c_b60, &a[*k + i__ +
+ a_dim1], lda, &a[*k + i__ + i__ * a_dim1], &c__1, &c_b60,
+ &t[*nb * t_dim1 + 1], &c__1);
+
+/* w := T'*w */
+
+ i__2 = i__ - 1;
+ ztrmv_("Upper", "Conjugate transpose", "Non-unit", &i__2, &t[
+ t_offset], ldt, &t[*nb * t_dim1 + 1], &c__1);
+
+/* b2 := b2 - V2*w */
+
+ i__2 = *n - *k - i__ + 1;
+ i__3 = i__ - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__3, &z__1, &a[*k + i__ + a_dim1],
+ lda, &t[*nb * t_dim1 + 1], &c__1, &c_b60, &a[*k + i__ +
+ i__ * a_dim1], &c__1);
+
+/* b1 := b1 - V1*w */
+
+ i__2 = i__ - 1;
+ ztrmv_("Lower", "No transpose", "Unit", &i__2, &a[*k + 1 + a_dim1]
+ , lda, &t[*nb * t_dim1 + 1], &c__1);
+ i__2 = i__ - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zaxpy_(&i__2, &z__1, &t[*nb * t_dim1 + 1], &c__1, &a[*k + 1 + i__
+ * a_dim1], &c__1);
+
+ i__2 = *k + i__ - 1 + (i__ - 1) * a_dim1;
+ a[i__2].r = ei.r, a[i__2].i = ei.i;
+ }
+
+/*
+ Generate the elementary reflector H(i) to annihilate
+ A(k+i+1:n,i)
+*/
+
+ i__2 = *k + i__ + i__ * a_dim1;
+ ei.r = a[i__2].r, ei.i = a[i__2].i;
+ i__2 = *n - *k - i__ + 1;
+/* Computing MIN */
+ i__3 = *k + i__ + 1;
+ zlarfg_(&i__2, &ei, &a[min(i__3,*n) + i__ * a_dim1], &c__1, &tau[i__])
+ ;
+ i__2 = *k + i__ + i__ * a_dim1;
+ a[i__2].r = 1., a[i__2].i = 0.;
+
+/* Compute Y(1:n,i) */
+
+ i__2 = *n - *k - i__ + 1;
+ zgemv_("No transpose", n, &i__2, &c_b60, &a[(i__ + 1) * a_dim1 + 1],
+ lda, &a[*k + i__ + i__ * a_dim1], &c__1, &c_b59, &y[i__ *
+ y_dim1 + 1], &c__1);
+ i__2 = *n - *k - i__ + 1;
+ i__3 = i__ - 1;
+ zgemv_("Conjugate transpose", &i__2, &i__3, &c_b60, &a[*k + i__ +
+ a_dim1], lda, &a[*k + i__ + i__ * a_dim1], &c__1, &c_b59, &t[
+ i__ * t_dim1 + 1], &c__1);
+ i__2 = i__ - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", n, &i__2, &z__1, &y[y_offset], ldy, &t[i__ *
+ t_dim1 + 1], &c__1, &c_b60, &y[i__ * y_dim1 + 1], &c__1);
+ zscal_(n, &tau[i__], &y[i__ * y_dim1 + 1], &c__1);
+
+/* Compute T(1:i,i) */
+
+ i__2 = i__ - 1;
+ i__3 = i__;
+ z__1.r = -tau[i__3].r, z__1.i = -tau[i__3].i;
+ zscal_(&i__2, &z__1, &t[i__ * t_dim1 + 1], &c__1);
+ i__2 = i__ - 1;
+ ztrmv_("Upper", "No transpose", "Non-unit", &i__2, &t[t_offset], ldt,
+ &t[i__ * t_dim1 + 1], &c__1)
+ ;
+ i__2 = i__ + i__ * t_dim1;
+ i__3 = i__;
+ t[i__2].r = tau[i__3].r, t[i__2].i = tau[i__3].i;
+
+/* L10: */
+ }
+ i__1 = *k + *nb + *nb * a_dim1;
+ a[i__1].r = ei.r, a[i__1].i = ei.i;
+
+ return 0;
+
+/* End of ZLAHRD */
+
+} /* zlahrd_ */
+
+/* Subroutine */ int zlals0_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, integer *nrhs, doublecomplex *b, integer *ldb,
+ doublecomplex *bx, integer *ldbx, integer *perm, integer *givptr,
+ integer *givcol, integer *ldgcol, doublereal *givnum, integer *ldgnum,
+ doublereal *poles, doublereal *difl, doublereal *difr, doublereal *
+ z__, integer *k, doublereal *c__, doublereal *s, doublereal *rwork,
+ integer *info)
+{
+ /* System generated locals */
+ integer givcol_dim1, givcol_offset, difr_dim1, difr_offset, givnum_dim1,
+ givnum_offset, poles_dim1, poles_offset, b_dim1, b_offset,
+ bx_dim1, bx_offset, i__1, i__2, i__3, i__4, i__5;
+ doublereal d__1;
+ doublecomplex z__1;
+
+ /* Builtin functions */
+ double d_imag(doublecomplex *);
+
+ /* Local variables */
+ static integer i__, j, m, n;
+ static doublereal dj;
+ static integer nlp1, jcol;
+ static doublereal temp;
+ static integer jrow;
+ extern doublereal dnrm2_(integer *, doublereal *, integer *);
+ static doublereal diflj, difrj, dsigj;
+ extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, doublereal *, integer *), zdrot_(integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *,
+ doublereal *, doublereal *);
+ extern doublereal dlamc3_(doublereal *, doublereal *);
+ extern /* Subroutine */ int zcopy_(integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *), xerbla_(char *, integer *);
+ static doublereal dsigjp;
+ extern /* Subroutine */ int zdscal_(integer *, doublereal *,
+ doublecomplex *, integer *), zlascl_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, integer *, doublecomplex *
+ , integer *, integer *), zlacpy_(char *, integer *,
+ integer *, doublecomplex *, integer *, doublecomplex *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ December 1, 1999
+
+
+ Purpose
+ =======
+
+ ZLALS0 applies back the multiplying factors of either the left or the
+ right singular vector matrix of a diagonal matrix appended by a row
+ to the right hand side matrix B in solving the least squares problem
+ using the divide-and-conquer SVD approach.
+
+ For the left singular vector matrix, three types of orthogonal
+ matrices are involved:
+
+ (1L) Givens rotations: the number of such rotations is GIVPTR; the
+ pairs of columns/rows they were applied to are stored in GIVCOL;
+ and the C- and S-values of these rotations are stored in GIVNUM.
+
+ (2L) Permutation. The (NL+1)-st row of B is to be moved to the first
+ row, and for J=2:N, PERM(J)-th row of B is to be moved to the
+ J-th row.
+
+ (3L) The left singular vector matrix of the remaining matrix.
+
+ For the right singular vector matrix, four types of orthogonal
+ matrices are involved:
+
+ (1R) The right singular vector matrix of the remaining matrix.
+
+ (2R) If SQRE = 1, one extra Givens rotation to generate the right
+ null space.
+
+ (3R) The inverse transformation of (2L).
+
+ (4R) The inverse transformation of (1L).
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether singular vectors are to be computed in
+ factored form:
+ = 0: Left singular vector matrix.
+ = 1: Right singular vector matrix.
+
+ NL (input) INTEGER
+ The row dimension of the upper block. NL >= 1.
+
+ NR (input) INTEGER
+ The row dimension of the lower block. NR >= 1.
+
+ SQRE (input) INTEGER
+ = 0: the lower block is an NR-by-NR square matrix.
+ = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
+
+ The bidiagonal matrix has row dimension N = NL + NR + 1,
+ and column dimension M = N + SQRE.
+
+ NRHS (input) INTEGER
+ The number of columns of B and BX. NRHS must be at least 1.
+
+ B (input/output) COMPLEX*16 array, dimension ( LDB, NRHS )
+ On input, B contains the right hand sides of the least
+ squares problem in rows 1 through M. On output, B contains
+ the solution X in rows 1 through N.
+
+ LDB (input) INTEGER
+ The leading dimension of B. LDB must be at least
+ max(1,MAX( M, N ) ).
+
+ BX (workspace) COMPLEX*16 array, dimension ( LDBX, NRHS )
+
+ LDBX (input) INTEGER
+ The leading dimension of BX.
+
+ PERM (input) INTEGER array, dimension ( N )
+ The permutations (from deflation and sorting) applied
+ to the two blocks.
+
+ GIVPTR (input) INTEGER
+ The number of Givens rotations which took place in this
+ subproblem.
+
+ GIVCOL (input) INTEGER array, dimension ( LDGCOL, 2 )
+ Each pair of numbers indicates a pair of rows/columns
+ involved in a Givens rotation.
+
+ LDGCOL (input) INTEGER
+ The leading dimension of GIVCOL, must be at least N.
+
+ GIVNUM (input) DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
+ Each number indicates the C or S value used in the
+ corresponding Givens rotation.
+
+ LDGNUM (input) INTEGER
+ The leading dimension of arrays DIFR, POLES and
+ GIVNUM, must be at least K.
+
+ POLES (input) DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
+ On entry, POLES(1:K, 1) contains the new singular
+ values obtained from solving the secular equation, and
+ POLES(1:K, 2) is an array containing the poles in the secular
+ equation.
+
+ DIFL (input) DOUBLE PRECISION array, dimension ( K ).
+ On entry, DIFL(I) is the distance between I-th updated
+ (undeflated) singular value and the I-th (undeflated) old
+ singular value.
+
+ DIFR (input) DOUBLE PRECISION array, dimension ( LDGNUM, 2 ).
+ On entry, DIFR(I, 1) contains the distances between I-th
+ updated (undeflated) singular value and the I+1-th
+ (undeflated) old singular value. And DIFR(I, 2) is the
+ normalizing factor for the I-th right singular vector.
+
+ Z (input) DOUBLE PRECISION array, dimension ( K )
+ Contain the components of the deflation-adjusted updating row
+ vector.
+
+ K (input) INTEGER
+ Contains the dimension of the non-deflated matrix,
+ This is the order of the related secular equation. 1 <= K <=N.
+
+ C (input) DOUBLE PRECISION
+ C contains garbage if SQRE =0 and the C-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ S (input) DOUBLE PRECISION
+ S contains garbage if SQRE =0 and the S-value of a Givens
+ rotation related to the right null space if SQRE = 1.
+
+ RWORK (workspace) DOUBLE PRECISION array, dimension
+ ( K*(1+NRHS) + 2*NRHS )
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ bx_dim1 = *ldbx;
+ bx_offset = 1 + bx_dim1 * 1;
+ bx -= bx_offset;
+ --perm;
+ givcol_dim1 = *ldgcol;
+ givcol_offset = 1 + givcol_dim1 * 1;
+ givcol -= givcol_offset;
+ difr_dim1 = *ldgnum;
+ difr_offset = 1 + difr_dim1 * 1;
+ difr -= difr_offset;
+ poles_dim1 = *ldgnum;
+ poles_offset = 1 + poles_dim1 * 1;
+ poles -= poles_offset;
+ givnum_dim1 = *ldgnum;
+ givnum_offset = 1 + givnum_dim1 * 1;
+ givnum -= givnum_offset;
+ --difl;
+ --z__;
+ --rwork;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*icompq < 0 || *icompq > 1) {
+ *info = -1;
+ } else if (*nl < 1) {
+ *info = -2;
+ } else if (*nr < 1) {
+ *info = -3;
+ } else if (*sqre < 0 || *sqre > 1) {
+ *info = -4;
+ }
+
+ n = *nl + *nr + 1;
+
+ if (*nrhs < 1) {
+ *info = -5;
+ } else if (*ldb < n) {
+ *info = -7;
+ } else if (*ldbx < n) {
+ *info = -9;
+ } else if (*givptr < 0) {
+ *info = -11;
+ } else if (*ldgcol < n) {
+ *info = -13;
+ } else if (*ldgnum < n) {
+ *info = -15;
+ } else if (*k < 1) {
+ *info = -20;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZLALS0", &i__1);
+ return 0;
+ }
+
+ m = n + *sqre;
+ nlp1 = *nl + 1;
+
+ if (*icompq == 0) {
+
+/*
+ Apply back orthogonal transformations from the left.
+
+ Step (1L): apply back the Givens rotations performed.
+*/
+
+ i__1 = *givptr;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ zdrot_(nrhs, &b[givcol[i__ + ((givcol_dim1) << (1))] + b_dim1],
+ ldb, &b[givcol[i__ + givcol_dim1] + b_dim1], ldb, &givnum[
+ i__ + ((givnum_dim1) << (1))], &givnum[i__ + givnum_dim1])
+ ;
+/* L10: */
+ }
+
+/* Step (2L): permute rows of B. */
+
+ zcopy_(nrhs, &b[nlp1 + b_dim1], ldb, &bx[bx_dim1 + 1], ldbx);
+ i__1 = n;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ zcopy_(nrhs, &b[perm[i__] + b_dim1], ldb, &bx[i__ + bx_dim1],
+ ldbx);
+/* L20: */
+ }
+
+/*
+ Step (3L): apply the inverse of the left singular vector
+ matrix to BX.
+*/
+
+ if (*k == 1) {
+ zcopy_(nrhs, &bx[bx_offset], ldbx, &b[b_offset], ldb);
+ if (z__[1] < 0.) {
+ zdscal_(nrhs, &c_b1294, &b[b_offset], ldb);
+ }
+ } else {
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ diflj = difl[j];
+ dj = poles[j + poles_dim1];
+ dsigj = -poles[j + ((poles_dim1) << (1))];
+ if (j < *k) {
+ difrj = -difr[j + difr_dim1];
+ dsigjp = -poles[j + 1 + ((poles_dim1) << (1))];
+ }
+ if (z__[j] == 0. || poles[j + ((poles_dim1) << (1))] == 0.) {
+ rwork[j] = 0.;
+ } else {
+ rwork[j] = -poles[j + ((poles_dim1) << (1))] * z__[j] /
+ diflj / (poles[j + ((poles_dim1) << (1))] + dj);
+ }
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ if (z__[i__] == 0. || poles[i__ + ((poles_dim1) << (1))]
+ == 0.) {
+ rwork[i__] = 0.;
+ } else {
+ rwork[i__] = poles[i__ + ((poles_dim1) << (1))] * z__[
+ i__] / (dlamc3_(&poles[i__ + ((poles_dim1) <<
+ (1))], &dsigj) - diflj) / (poles[i__ + ((
+ poles_dim1) << (1))] + dj);
+ }
+/* L30: */
+ }
+ i__2 = *k;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ if (z__[i__] == 0. || poles[i__ + ((poles_dim1) << (1))]
+ == 0.) {
+ rwork[i__] = 0.;
+ } else {
+ rwork[i__] = poles[i__ + ((poles_dim1) << (1))] * z__[
+ i__] / (dlamc3_(&poles[i__ + ((poles_dim1) <<
+ (1))], &dsigjp) + difrj) / (poles[i__ + ((
+ poles_dim1) << (1))] + dj);
+ }
+/* L40: */
+ }
+ rwork[1] = -1.;
+ temp = dnrm2_(k, &rwork[1], &c__1);
+
+/*
+ Since B and BX are complex, the following call to DGEMV
+ is performed in two steps (real and imaginary parts).
+
+ CALL DGEMV( 'T', K, NRHS, ONE, BX, LDBX, WORK, 1, ZERO,
+ $ B( J, 1 ), LDB )
+*/
+
+ i__ = *k + ((*nrhs) << (1));
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = *k;
+ for (jrow = 1; jrow <= i__3; ++jrow) {
+ ++i__;
+ i__4 = jrow + jcol * bx_dim1;
+ rwork[i__] = bx[i__4].r;
+/* L50: */
+ }
+/* L60: */
+ }
+ dgemv_("T", k, nrhs, &c_b1015, &rwork[*k + 1 + ((*nrhs) << (1)
+ )], k, &rwork[1], &c__1, &c_b324, &rwork[*k + 1], &
+ c__1);
+ i__ = *k + ((*nrhs) << (1));
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = *k;
+ for (jrow = 1; jrow <= i__3; ++jrow) {
+ ++i__;
+ rwork[i__] = d_imag(&bx[jrow + jcol * bx_dim1]);
+/* L70: */
+ }
+/* L80: */
+ }
+ dgemv_("T", k, nrhs, &c_b1015, &rwork[*k + 1 + ((*nrhs) << (1)
+ )], k, &rwork[1], &c__1, &c_b324, &rwork[*k + 1 + *
+ nrhs], &c__1);
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = j + jcol * b_dim1;
+ i__4 = jcol + *k;
+ i__5 = jcol + *k + *nrhs;
+ z__1.r = rwork[i__4], z__1.i = rwork[i__5];
+ b[i__3].r = z__1.r, b[i__3].i = z__1.i;
+/* L90: */
+ }
+ zlascl_("G", &c__0, &c__0, &temp, &c_b1015, &c__1, nrhs, &b[j
+ + b_dim1], ldb, info);
+/* L100: */
+ }
+ }
+
+/* Move the deflated rows of BX to B also. */
+
+ if (*k < max(m,n)) {
+ i__1 = n - *k;
+ zlacpy_("A", &i__1, nrhs, &bx[*k + 1 + bx_dim1], ldbx, &b[*k + 1
+ + b_dim1], ldb);
+ }
+ } else {
+
+/*
+ Apply back the right orthogonal transformations.
+
+ Step (1R): apply back the new right singular vector matrix
+ to B.
+*/
+
+ if (*k == 1) {
+ zcopy_(nrhs, &b[b_offset], ldb, &bx[bx_offset], ldbx);
+ } else {
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dsigj = poles[j + ((poles_dim1) << (1))];
+ if (z__[j] == 0.) {
+ rwork[j] = 0.;
+ } else {
+ rwork[j] = -z__[j] / difl[j] / (dsigj + poles[j +
+ poles_dim1]) / difr[j + ((difr_dim1) << (1))];
+ }
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ if (z__[j] == 0.) {
+ rwork[i__] = 0.;
+ } else {
+ d__1 = -poles[i__ + 1 + ((poles_dim1) << (1))];
+ rwork[i__] = z__[j] / (dlamc3_(&dsigj, &d__1) - difr[
+ i__ + difr_dim1]) / (dsigj + poles[i__ +
+ poles_dim1]) / difr[i__ + ((difr_dim1) << (1))
+ ];
+ }
+/* L110: */
+ }
+ i__2 = *k;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ if (z__[j] == 0.) {
+ rwork[i__] = 0.;
+ } else {
+ d__1 = -poles[i__ + ((poles_dim1) << (1))];
+ rwork[i__] = z__[j] / (dlamc3_(&dsigj, &d__1) - difl[
+ i__]) / (dsigj + poles[i__ + poles_dim1]) /
+ difr[i__ + ((difr_dim1) << (1))];
+ }
+/* L120: */
+ }
+
+/*
+ Since B and BX are complex, the following call to DGEMV
+ is performed in two steps (real and imaginary parts).
+
+ CALL DGEMV( 'T', K, NRHS, ONE, B, LDB, WORK, 1, ZERO,
+ $ BX( J, 1 ), LDBX )
+*/
+
+ i__ = *k + ((*nrhs) << (1));
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = *k;
+ for (jrow = 1; jrow <= i__3; ++jrow) {
+ ++i__;
+ i__4 = jrow + jcol * b_dim1;
+ rwork[i__] = b[i__4].r;
+/* L130: */
+ }
+/* L140: */
+ }
+ dgemv_("T", k, nrhs, &c_b1015, &rwork[*k + 1 + ((*nrhs) << (1)
+ )], k, &rwork[1], &c__1, &c_b324, &rwork[*k + 1], &
+ c__1);
+ i__ = *k + ((*nrhs) << (1));
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = *k;
+ for (jrow = 1; jrow <= i__3; ++jrow) {
+ ++i__;
+ rwork[i__] = d_imag(&b[jrow + jcol * b_dim1]);
+/* L150: */
+ }
+/* L160: */
+ }
+ dgemv_("T", k, nrhs, &c_b1015, &rwork[*k + 1 + ((*nrhs) << (1)
+ )], k, &rwork[1], &c__1, &c_b324, &rwork[*k + 1 + *
+ nrhs], &c__1);
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = j + jcol * bx_dim1;
+ i__4 = jcol + *k;
+ i__5 = jcol + *k + *nrhs;
+ z__1.r = rwork[i__4], z__1.i = rwork[i__5];
+ bx[i__3].r = z__1.r, bx[i__3].i = z__1.i;
+/* L170: */
+ }
+/* L180: */
+ }
+ }
+
+/*
+ Step (2R): if SQRE = 1, apply back the rotation that is
+ related to the right null space of the subproblem.
+*/
+
+ if (*sqre == 1) {
+ zcopy_(nrhs, &b[m + b_dim1], ldb, &bx[m + bx_dim1], ldbx);
+ zdrot_(nrhs, &bx[bx_dim1 + 1], ldbx, &bx[m + bx_dim1], ldbx, c__,
+ s);
+ }
+ if (*k < max(m,n)) {
+ i__1 = n - *k;
+ zlacpy_("A", &i__1, nrhs, &b[*k + 1 + b_dim1], ldb, &bx[*k + 1 +
+ bx_dim1], ldbx);
+ }
+
+/* Step (3R): permute rows of B. */
+
+ zcopy_(nrhs, &bx[bx_dim1 + 1], ldbx, &b[nlp1 + b_dim1], ldb);
+ if (*sqre == 1) {
+ zcopy_(nrhs, &bx[m + bx_dim1], ldbx, &b[m + b_dim1], ldb);
+ }
+ i__1 = n;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ zcopy_(nrhs, &bx[i__ + bx_dim1], ldbx, &b[perm[i__] + b_dim1],
+ ldb);
+/* L190: */
+ }
+
+/* Step (4R): apply back the Givens rotations performed. */
+
+ for (i__ = *givptr; i__ >= 1; --i__) {
+ d__1 = -givnum[i__ + givnum_dim1];
+ zdrot_(nrhs, &b[givcol[i__ + ((givcol_dim1) << (1))] + b_dim1],
+ ldb, &b[givcol[i__ + givcol_dim1] + b_dim1], ldb, &givnum[
+ i__ + ((givnum_dim1) << (1))], &d__1);
+/* L200: */
+ }
+ }
+
+ return 0;
+
+/* End of ZLALS0 */
+
+} /* zlals0_ */
+
+/* Subroutine */ int zlalsa_(integer *icompq, integer *smlsiz, integer *n,
+ integer *nrhs, doublecomplex *b, integer *ldb, doublecomplex *bx,
+ integer *ldbx, doublereal *u, integer *ldu, doublereal *vt, integer *
+ k, doublereal *difl, doublereal *difr, doublereal *z__, doublereal *
+ poles, integer *givptr, integer *givcol, integer *ldgcol, integer *
+ perm, doublereal *givnum, doublereal *c__, doublereal *s, doublereal *
+ rwork, integer *iwork, integer *info)
+{
+ /* System generated locals */
+ integer givcol_dim1, givcol_offset, perm_dim1, perm_offset, difl_dim1,
+ difl_offset, difr_dim1, difr_offset, givnum_dim1, givnum_offset,
+ poles_dim1, poles_offset, u_dim1, u_offset, vt_dim1, vt_offset,
+ z_dim1, z_offset, b_dim1, b_offset, bx_dim1, bx_offset, i__1,
+ i__2, i__3, i__4, i__5, i__6;
+ doublecomplex z__1;
+
+ /* Builtin functions */
+ double d_imag(doublecomplex *);
+ integer pow_ii(integer *, integer *);
+
+ /* Local variables */
+ static integer i__, j, i1, ic, lf, nd, ll, nl, nr, im1, nlf, nrf, lvl,
+ ndb1, nlp1, lvl2, nrp1, jcol, nlvl, sqre, jrow, jimag;
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *);
+ static integer jreal, inode, ndiml, ndimr;
+ extern /* Subroutine */ int zcopy_(integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *), zlals0_(integer *, integer *,
+ integer *, integer *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *, integer *, integer *, integer *,
+ integer *, doublereal *, integer *, doublereal *, doublereal *,
+ doublereal *, doublereal *, integer *, doublereal *, doublereal *,
+ doublereal *, integer *), dlasdt_(integer *, integer *, integer *
+ , integer *, integer *, integer *, integer *), xerbla_(char *,
+ integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZLALSA is an itermediate step in solving the least squares problem
+ by computing the SVD of the coefficient matrix in compact form (The
+ singular vectors are computed as products of simple orthorgonal
+ matrices.).
+
+ If ICOMPQ = 0, ZLALSA applies the inverse of the left singular vector
+ matrix of an upper bidiagonal matrix to the right hand side; and if
+ ICOMPQ = 1, ZLALSA applies the right singular vector matrix to the
+ right hand side. The singular vector matrices were generated in
+ compact form by ZLALSA.
+
+ Arguments
+ =========
+
+ ICOMPQ (input) INTEGER
+ Specifies whether the left or the right singular vector
+ matrix is involved.
+ = 0: Left singular vector matrix
+ = 1: Right singular vector matrix
+
+ SMLSIZ (input) INTEGER
+ The maximum size of the subproblems at the bottom of the
+ computation tree.
+
+ N (input) INTEGER
+ The row and column dimensions of the upper bidiagonal matrix.
+
+ NRHS (input) INTEGER
+ The number of columns of B and BX. NRHS must be at least 1.
+
+ B (input) COMPLEX*16 array, dimension ( LDB, NRHS )
+ On input, B contains the right hand sides of the least
+ squares problem in rows 1 through M. On output, B contains
+ the solution X in rows 1 through N.
+
+ LDB (input) INTEGER
+ The leading dimension of B in the calling subprogram.
+ LDB must be at least max(1,MAX( M, N ) ).
+
+ BX (output) COMPLEX*16 array, dimension ( LDBX, NRHS )
+ On exit, the result of applying the left or right singular
+ vector matrix to B.
+
+ LDBX (input) INTEGER
+ The leading dimension of BX.
+
+ U (input) DOUBLE PRECISION array, dimension ( LDU, SMLSIZ ).
+ On entry, U contains the left singular vector matrices of all
+ subproblems at the bottom level.
+
+ LDU (input) INTEGER, LDU = > N.
+ The leading dimension of arrays U, VT, DIFL, DIFR,
+ POLES, GIVNUM, and Z.
+
+ VT (input) DOUBLE PRECISION array, dimension ( LDU, SMLSIZ+1 ).
+ On entry, VT' contains the right singular vector matrices of
+ all subproblems at the bottom level.
+
+ K (input) INTEGER array, dimension ( N ).
+
+ DIFL (input) DOUBLE PRECISION array, dimension ( LDU, NLVL ).
+ where NLVL = INT(log_2 (N/(SMLSIZ+1))) + 1.
+
+ DIFR (input) DOUBLE PRECISION array, dimension ( LDU, 2 * NLVL ).
+ On entry, DIFL(*, I) and DIFR(*, 2 * I -1) record
+ distances between singular values on the I-th level and
+ singular values on the (I -1)-th level, and DIFR(*, 2 * I)
+ record the normalizing factors of the right singular vectors
+ matrices of subproblems on I-th level.
+
+ Z (input) DOUBLE PRECISION array, dimension ( LDU, NLVL ).
+ On entry, Z(1, I) contains the components of the deflation-
+ adjusted updating row vector for subproblems on the I-th
+ level.
+
+ POLES (input) DOUBLE PRECISION array, dimension ( LDU, 2 * NLVL ).
+ On entry, POLES(*, 2 * I -1: 2 * I) contains the new and old
+ singular values involved in the secular equations on the I-th
+ level.
+
+ GIVPTR (input) INTEGER array, dimension ( N ).
+ On entry, GIVPTR( I ) records the number of Givens
+ rotations performed on the I-th problem on the computation
+ tree.
+
+ GIVCOL (input) INTEGER array, dimension ( LDGCOL, 2 * NLVL ).
+ On entry, for each I, GIVCOL(*, 2 * I - 1: 2 * I) records the
+ locations of Givens rotations performed on the I-th level on
+ the computation tree.
+
+ LDGCOL (input) INTEGER, LDGCOL = > N.
+ The leading dimension of arrays GIVCOL and PERM.
+
+ PERM (input) INTEGER array, dimension ( LDGCOL, NLVL ).
+ On entry, PERM(*, I) records permutations done on the I-th
+ level of the computation tree.
+
+ GIVNUM (input) DOUBLE PRECISION array, dimension ( LDU, 2 * NLVL ).
+ On entry, GIVNUM(*, 2 *I -1 : 2 * I) records the C- and S-
+ values of Givens rotations performed on the I-th level on the
+ computation tree.
+
+ C (input) DOUBLE PRECISION array, dimension ( N ).
+ On entry, if the I-th subproblem is not square,
+ C( I ) contains the C-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ S (input) DOUBLE PRECISION array, dimension ( N ).
+ On entry, if the I-th subproblem is not square,
+ S( I ) contains the S-value of a Givens rotation related to
+ the right null space of the I-th subproblem.
+
+ RWORK (workspace) DOUBLE PRECISION array, dimension at least
+ max ( N, (SMLSZ+1)*NRHS*3 ).
+
+ IWORK (workspace) INTEGER array.
+ The dimension must be at least 3 * N
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ bx_dim1 = *ldbx;
+ bx_offset = 1 + bx_dim1 * 1;
+ bx -= bx_offset;
+ givnum_dim1 = *ldu;
+ givnum_offset = 1 + givnum_dim1 * 1;
+ givnum -= givnum_offset;
+ poles_dim1 = *ldu;
+ poles_offset = 1 + poles_dim1 * 1;
+ poles -= poles_offset;
+ z_dim1 = *ldu;
+ z_offset = 1 + z_dim1 * 1;
+ z__ -= z_offset;
+ difr_dim1 = *ldu;
+ difr_offset = 1 + difr_dim1 * 1;
+ difr -= difr_offset;
+ difl_dim1 = *ldu;
+ difl_offset = 1 + difl_dim1 * 1;
+ difl -= difl_offset;
+ vt_dim1 = *ldu;
+ vt_offset = 1 + vt_dim1 * 1;
+ vt -= vt_offset;
+ u_dim1 = *ldu;
+ u_offset = 1 + u_dim1 * 1;
+ u -= u_offset;
+ --k;
+ --givptr;
+ perm_dim1 = *ldgcol;
+ perm_offset = 1 + perm_dim1 * 1;
+ perm -= perm_offset;
+ givcol_dim1 = *ldgcol;
+ givcol_offset = 1 + givcol_dim1 * 1;
+ givcol -= givcol_offset;
+ --c__;
+ --s;
+ --rwork;
+ --iwork;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*icompq < 0 || *icompq > 1) {
+ *info = -1;
+ } else if (*smlsiz < 3) {
+ *info = -2;
+ } else if (*n < *smlsiz) {
+ *info = -3;
+ } else if (*nrhs < 1) {
+ *info = -4;
+ } else if (*ldb < *n) {
+ *info = -6;
+ } else if (*ldbx < *n) {
+ *info = -8;
+ } else if (*ldu < *n) {
+ *info = -10;
+ } else if (*ldgcol < *n) {
+ *info = -19;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZLALSA", &i__1);
+ return 0;
+ }
+
+/* Book-keeping and setting up the computation tree. */
+
+ inode = 1;
+ ndiml = inode + *n;
+ ndimr = ndiml + *n;
+
+ dlasdt_(n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr],
+ smlsiz);
+
+/*
+ The following code applies back the left singular vector factors.
+ For applying back the right singular vector factors, go to 170.
+*/
+
+ if (*icompq == 1) {
+ goto L170;
+ }
+
+/*
+ The nodes on the bottom level of the tree were solved
+ by DLASDQ. The corresponding left and right singular vector
+ matrices are in explicit form. First apply back the left
+ singular vector matrices.
+*/
+
+ ndb1 = (nd + 1) / 2;
+ i__1 = nd;
+ for (i__ = ndb1; i__ <= i__1; ++i__) {
+
+/*
+ IC : center row of each node
+ NL : number of rows of left subproblem
+ NR : number of rows of right subproblem
+ NLF: starting row of the left subproblem
+ NRF: starting row of the right subproblem
+*/
+
+ i1 = i__ - 1;
+ ic = iwork[inode + i1];
+ nl = iwork[ndiml + i1];
+ nr = iwork[ndimr + i1];
+ nlf = ic - nl;
+ nrf = ic + 1;
+
+/*
+ Since B and BX are complex, the following call to DGEMM
+ is performed in two steps (real and imaginary parts).
+
+ CALL DGEMM( 'T', 'N', NL, NRHS, NL, ONE, U( NLF, 1 ), LDU,
+ $ B( NLF, 1 ), LDB, ZERO, BX( NLF, 1 ), LDBX )
+*/
+
+ j = (nl * *nrhs) << (1);
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = nlf + nl - 1;
+ for (jrow = nlf; jrow <= i__3; ++jrow) {
+ ++j;
+ i__4 = jrow + jcol * b_dim1;
+ rwork[j] = b[i__4].r;
+/* L10: */
+ }
+/* L20: */
+ }
+ dgemm_("T", "N", &nl, nrhs, &nl, &c_b1015, &u[nlf + u_dim1], ldu, &
+ rwork[((nl * *nrhs) << (1)) + 1], &nl, &c_b324, &rwork[1], &
+ nl);
+ j = (nl * *nrhs) << (1);
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = nlf + nl - 1;
+ for (jrow = nlf; jrow <= i__3; ++jrow) {
+ ++j;
+ rwork[j] = d_imag(&b[jrow + jcol * b_dim1]);
+/* L30: */
+ }
+/* L40: */
+ }
+ dgemm_("T", "N", &nl, nrhs, &nl, &c_b1015, &u[nlf + u_dim1], ldu, &
+ rwork[((nl * *nrhs) << (1)) + 1], &nl, &c_b324, &rwork[nl * *
+ nrhs + 1], &nl);
+ jreal = 0;
+ jimag = nl * *nrhs;
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = nlf + nl - 1;
+ for (jrow = nlf; jrow <= i__3; ++jrow) {
+ ++jreal;
+ ++jimag;
+ i__4 = jrow + jcol * bx_dim1;
+ i__5 = jreal;
+ i__6 = jimag;
+ z__1.r = rwork[i__5], z__1.i = rwork[i__6];
+ bx[i__4].r = z__1.r, bx[i__4].i = z__1.i;
+/* L50: */
+ }
+/* L60: */
+ }
+
+/*
+ Since B and BX are complex, the following call to DGEMM
+ is performed in two steps (real and imaginary parts).
+
+ CALL DGEMM( 'T', 'N', NR, NRHS, NR, ONE, U( NRF, 1 ), LDU,
+ $ B( NRF, 1 ), LDB, ZERO, BX( NRF, 1 ), LDBX )
+*/
+
+ j = (nr * *nrhs) << (1);
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = nrf + nr - 1;
+ for (jrow = nrf; jrow <= i__3; ++jrow) {
+ ++j;
+ i__4 = jrow + jcol * b_dim1;
+ rwork[j] = b[i__4].r;
+/* L70: */
+ }
+/* L80: */
+ }
+ dgemm_("T", "N", &nr, nrhs, &nr, &c_b1015, &u[nrf + u_dim1], ldu, &
+ rwork[((nr * *nrhs) << (1)) + 1], &nr, &c_b324, &rwork[1], &
+ nr);
+ j = (nr * *nrhs) << (1);
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = nrf + nr - 1;
+ for (jrow = nrf; jrow <= i__3; ++jrow) {
+ ++j;
+ rwork[j] = d_imag(&b[jrow + jcol * b_dim1]);
+/* L90: */
+ }
+/* L100: */
+ }
+ dgemm_("T", "N", &nr, nrhs, &nr, &c_b1015, &u[nrf + u_dim1], ldu, &
+ rwork[((nr * *nrhs) << (1)) + 1], &nr, &c_b324, &rwork[nr * *
+ nrhs + 1], &nr);
+ jreal = 0;
+ jimag = nr * *nrhs;
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = nrf + nr - 1;
+ for (jrow = nrf; jrow <= i__3; ++jrow) {
+ ++jreal;
+ ++jimag;
+ i__4 = jrow + jcol * bx_dim1;
+ i__5 = jreal;
+ i__6 = jimag;
+ z__1.r = rwork[i__5], z__1.i = rwork[i__6];
+ bx[i__4].r = z__1.r, bx[i__4].i = z__1.i;
+/* L110: */
+ }
+/* L120: */
+ }
+
+/* L130: */
+ }
+
+/*
+ Next copy the rows of B that correspond to unchanged rows
+ in the bidiagonal matrix to BX.
+*/
+
+ i__1 = nd;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ ic = iwork[inode + i__ - 1];
+ zcopy_(nrhs, &b[ic + b_dim1], ldb, &bx[ic + bx_dim1], ldbx);
+/* L140: */
+ }
+
+/*
+ Finally go through the left singular vector matrices of all
+ the other subproblems bottom-up on the tree.
+*/
+
+ j = pow_ii(&c__2, &nlvl);
+ sqre = 0;
+
+ for (lvl = nlvl; lvl >= 1; --lvl) {
+ lvl2 = ((lvl) << (1)) - 1;
+
+/*
+ find the first node LF and last node LL on
+ the current level LVL
+*/
+
+ if (lvl == 1) {
+ lf = 1;
+ ll = 1;
+ } else {
+ i__1 = lvl - 1;
+ lf = pow_ii(&c__2, &i__1);
+ ll = ((lf) << (1)) - 1;
+ }
+ i__1 = ll;
+ for (i__ = lf; i__ <= i__1; ++i__) {
+ im1 = i__ - 1;
+ ic = iwork[inode + im1];
+ nl = iwork[ndiml + im1];
+ nr = iwork[ndimr + im1];
+ nlf = ic - nl;
+ nrf = ic + 1;
+ --j;
+ zlals0_(icompq, &nl, &nr, &sqre, nrhs, &bx[nlf + bx_dim1], ldbx, &
+ b[nlf + b_dim1], ldb, &perm[nlf + lvl * perm_dim1], &
+ givptr[j], &givcol[nlf + lvl2 * givcol_dim1], ldgcol, &
+ givnum[nlf + lvl2 * givnum_dim1], ldu, &poles[nlf + lvl2 *
+ poles_dim1], &difl[nlf + lvl * difl_dim1], &difr[nlf +
+ lvl2 * difr_dim1], &z__[nlf + lvl * z_dim1], &k[j], &c__[
+ j], &s[j], &rwork[1], info);
+/* L150: */
+ }
+/* L160: */
+ }
+ goto L330;
+
+/* ICOMPQ = 1: applying back the right singular vector factors. */
+
+L170:
+
+/*
+ First now go through the right singular vector matrices of all
+ the tree nodes top-down.
+*/
+
+ j = 0;
+ i__1 = nlvl;
+ for (lvl = 1; lvl <= i__1; ++lvl) {
+ lvl2 = ((lvl) << (1)) - 1;
+
+/*
+ Find the first node LF and last node LL on
+ the current level LVL.
+*/
+
+ if (lvl == 1) {
+ lf = 1;
+ ll = 1;
+ } else {
+ i__2 = lvl - 1;
+ lf = pow_ii(&c__2, &i__2);
+ ll = ((lf) << (1)) - 1;
+ }
+ i__2 = lf;
+ for (i__ = ll; i__ >= i__2; --i__) {
+ im1 = i__ - 1;
+ ic = iwork[inode + im1];
+ nl = iwork[ndiml + im1];
+ nr = iwork[ndimr + im1];
+ nlf = ic - nl;
+ nrf = ic + 1;
+ if (i__ == ll) {
+ sqre = 0;
+ } else {
+ sqre = 1;
+ }
+ ++j;
+ zlals0_(icompq, &nl, &nr, &sqre, nrhs, &b[nlf + b_dim1], ldb, &bx[
+ nlf + bx_dim1], ldbx, &perm[nlf + lvl * perm_dim1], &
+ givptr[j], &givcol[nlf + lvl2 * givcol_dim1], ldgcol, &
+ givnum[nlf + lvl2 * givnum_dim1], ldu, &poles[nlf + lvl2 *
+ poles_dim1], &difl[nlf + lvl * difl_dim1], &difr[nlf +
+ lvl2 * difr_dim1], &z__[nlf + lvl * z_dim1], &k[j], &c__[
+ j], &s[j], &rwork[1], info);
+/* L180: */
+ }
+/* L190: */
+ }
+
+/*
+ The nodes on the bottom level of the tree were solved
+ by DLASDQ. The corresponding right singular vector
+ matrices are in explicit form. Apply them back.
+*/
+
+ ndb1 = (nd + 1) / 2;
+ i__1 = nd;
+ for (i__ = ndb1; i__ <= i__1; ++i__) {
+ i1 = i__ - 1;
+ ic = iwork[inode + i1];
+ nl = iwork[ndiml + i1];
+ nr = iwork[ndimr + i1];
+ nlp1 = nl + 1;
+ if (i__ == nd) {
+ nrp1 = nr;
+ } else {
+ nrp1 = nr + 1;
+ }
+ nlf = ic - nl;
+ nrf = ic + 1;
+
+/*
+ Since B and BX are complex, the following call to DGEMM is
+ performed in two steps (real and imaginary parts).
+
+ CALL DGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), LDU,
+ $ B( NLF, 1 ), LDB, ZERO, BX( NLF, 1 ), LDBX )
+*/
+
+ j = (nlp1 * *nrhs) << (1);
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = nlf + nlp1 - 1;
+ for (jrow = nlf; jrow <= i__3; ++jrow) {
+ ++j;
+ i__4 = jrow + jcol * b_dim1;
+ rwork[j] = b[i__4].r;
+/* L200: */
+ }
+/* L210: */
+ }
+ dgemm_("T", "N", &nlp1, nrhs, &nlp1, &c_b1015, &vt[nlf + vt_dim1],
+ ldu, &rwork[((nlp1 * *nrhs) << (1)) + 1], &nlp1, &c_b324, &
+ rwork[1], &nlp1);
+ j = (nlp1 * *nrhs) << (1);
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = nlf + nlp1 - 1;
+ for (jrow = nlf; jrow <= i__3; ++jrow) {
+ ++j;
+ rwork[j] = d_imag(&b[jrow + jcol * b_dim1]);
+/* L220: */
+ }
+/* L230: */
+ }
+ dgemm_("T", "N", &nlp1, nrhs, &nlp1, &c_b1015, &vt[nlf + vt_dim1],
+ ldu, &rwork[((nlp1 * *nrhs) << (1)) + 1], &nlp1, &c_b324, &
+ rwork[nlp1 * *nrhs + 1], &nlp1);
+ jreal = 0;
+ jimag = nlp1 * *nrhs;
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = nlf + nlp1 - 1;
+ for (jrow = nlf; jrow <= i__3; ++jrow) {
+ ++jreal;
+ ++jimag;
+ i__4 = jrow + jcol * bx_dim1;
+ i__5 = jreal;
+ i__6 = jimag;
+ z__1.r = rwork[i__5], z__1.i = rwork[i__6];
+ bx[i__4].r = z__1.r, bx[i__4].i = z__1.i;
+/* L240: */
+ }
+/* L250: */
+ }
+
+/*
+ Since B and BX are complex, the following call to DGEMM is
+ performed in two steps (real and imaginary parts).
+
+ CALL DGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), LDU,
+ $ B( NRF, 1 ), LDB, ZERO, BX( NRF, 1 ), LDBX )
+*/
+
+ j = (nrp1 * *nrhs) << (1);
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = nrf + nrp1 - 1;
+ for (jrow = nrf; jrow <= i__3; ++jrow) {
+ ++j;
+ i__4 = jrow + jcol * b_dim1;
+ rwork[j] = b[i__4].r;
+/* L260: */
+ }
+/* L270: */
+ }
+ dgemm_("T", "N", &nrp1, nrhs, &nrp1, &c_b1015, &vt[nrf + vt_dim1],
+ ldu, &rwork[((nrp1 * *nrhs) << (1)) + 1], &nrp1, &c_b324, &
+ rwork[1], &nrp1);
+ j = (nrp1 * *nrhs) << (1);
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = nrf + nrp1 - 1;
+ for (jrow = nrf; jrow <= i__3; ++jrow) {
+ ++j;
+ rwork[j] = d_imag(&b[jrow + jcol * b_dim1]);
+/* L280: */
+ }
+/* L290: */
+ }
+ dgemm_("T", "N", &nrp1, nrhs, &nrp1, &c_b1015, &vt[nrf + vt_dim1],
+ ldu, &rwork[((nrp1 * *nrhs) << (1)) + 1], &nrp1, &c_b324, &
+ rwork[nrp1 * *nrhs + 1], &nrp1);
+ jreal = 0;
+ jimag = nrp1 * *nrhs;
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = nrf + nrp1 - 1;
+ for (jrow = nrf; jrow <= i__3; ++jrow) {
+ ++jreal;
+ ++jimag;
+ i__4 = jrow + jcol * bx_dim1;
+ i__5 = jreal;
+ i__6 = jimag;
+ z__1.r = rwork[i__5], z__1.i = rwork[i__6];
+ bx[i__4].r = z__1.r, bx[i__4].i = z__1.i;
+/* L300: */
+ }
+/* L310: */
+ }
+
+/* L320: */
+ }
+
+L330:
+
+ return 0;
+
+/* End of ZLALSA */
+
+} /* zlalsa_ */
+
+/* Subroutine */ int zlalsd_(char *uplo, integer *smlsiz, integer *n, integer
+ *nrhs, doublereal *d__, doublereal *e, doublecomplex *b, integer *ldb,
+ doublereal *rcond, integer *rank, doublecomplex *work, doublereal *
+ rwork, integer *iwork, integer *info)
+{
+ /* System generated locals */
+ integer b_dim1, b_offset, i__1, i__2, i__3, i__4, i__5, i__6;
+ doublereal d__1;
+ doublecomplex z__1;
+
+ /* Builtin functions */
+ double d_imag(doublecomplex *), log(doublereal), d_sign(doublereal *,
+ doublereal *);
+
+ /* Local variables */
+ static integer c__, i__, j, k;
+ static doublereal r__;
+ static integer s, u, z__;
+ static doublereal cs;
+ static integer bx;
+ static doublereal sn;
+ static integer st, vt, nm1, st1;
+ static doublereal eps;
+ static integer iwk;
+ static doublereal tol;
+ static integer difl, difr, jcol, irwb, perm, nsub, nlvl, sqre, bxst, jrow,
+ irwu, jimag;
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *);
+ static integer jreal, irwib, poles, sizei, irwrb, nsize;
+ extern /* Subroutine */ int zdrot_(integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *, doublereal *, doublereal *), zcopy_(
+ integer *, doublecomplex *, integer *, doublecomplex *, integer *)
+ ;
+ static integer irwvt, icmpq1, icmpq2;
+
+ extern /* Subroutine */ int dlasda_(integer *, integer *, integer *,
+ integer *, doublereal *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, doublereal *,
+ doublereal *, integer *, integer *, integer *, integer *,
+ doublereal *, doublereal *, doublereal *, doublereal *, integer *,
+ integer *), dlascl_(char *, integer *, integer *, doublereal *,
+ doublereal *, integer *, integer *, doublereal *, integer *,
+ integer *);
+ extern integer idamax_(integer *, doublereal *, integer *);
+ extern /* Subroutine */ int dlasdq_(char *, integer *, integer *, integer
+ *, integer *, integer *, doublereal *, doublereal *, doublereal *,
+ integer *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, integer *), dlaset_(char *, integer *,
+ integer *, doublereal *, doublereal *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *,
+ doublereal *, doublereal *), xerbla_(char *, integer *);
+ static integer givcol;
+ extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *);
+ extern /* Subroutine */ int zlalsa_(integer *, integer *, integer *,
+ integer *, doublecomplex *, integer *, doublecomplex *, integer *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ doublereal *, doublereal *, doublereal *, integer *, integer *,
+ integer *, integer *, doublereal *, doublereal *, doublereal *,
+ doublereal *, integer *, integer *), zlascl_(char *, integer *,
+ integer *, doublereal *, doublereal *, integer *, integer *,
+ doublecomplex *, integer *, integer *), dlasrt_(char *,
+ integer *, doublereal *, integer *), zlacpy_(char *,
+ integer *, integer *, doublecomplex *, integer *, doublecomplex *,
+ integer *), zlaset_(char *, integer *, integer *,
+ doublecomplex *, doublecomplex *, doublecomplex *, integer *);
+ static doublereal orgnrm;
+ static integer givnum, givptr, nrwork, irwwrk, smlszp;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1999
+
+
+ Purpose
+ =======
+
+ ZLALSD uses the singular value decomposition of A to solve the least
+ squares problem of finding X to minimize the Euclidean norm of each
+ column of A*X-B, where A is N-by-N upper bidiagonal, and X and B
+ are N-by-NRHS. The solution X overwrites B.
+
+ The singular values of A smaller than RCOND times the largest
+ singular value are treated as zero in solving the least squares
+ problem; in this case a minimum norm solution is returned.
+ The actual singular values are returned in D in ascending order.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray XMP, Cray YMP, Cray C 90, or Cray 2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': D and E define an upper bidiagonal matrix.
+ = 'L': D and E define a lower bidiagonal matrix.
+
+ SMLSIZ (input) INTEGER
+ The maximum size of the subproblems at the bottom of the
+ computation tree.
+
+ N (input) INTEGER
+ The dimension of the bidiagonal matrix. N >= 0.
+
+ NRHS (input) INTEGER
+ The number of columns of B. NRHS must be at least 1.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry D contains the main diagonal of the bidiagonal
+ matrix. On exit, if INFO = 0, D contains its singular values.
+
+ E (input) DOUBLE PRECISION array, dimension (N-1)
+ Contains the super-diagonal entries of the bidiagonal matrix.
+ On exit, E has been destroyed.
+
+ B (input/output) COMPLEX*16 array, dimension (LDB,NRHS)
+ On input, B contains the right hand sides of the least
+ squares problem. On output, B contains the solution X.
+
+ LDB (input) INTEGER
+ The leading dimension of B in the calling subprogram.
+ LDB must be at least max(1,N).
+
+ RCOND (input) DOUBLE PRECISION
+ The singular values of A less than or equal to RCOND times
+ the largest singular value are treated as zero in solving
+ the least squares problem. If RCOND is negative,
+ machine precision is used instead.
+ For example, if diag(S)*X=B were the least squares problem,
+ where diag(S) is a diagonal matrix of singular values, the
+ solution would be X(i) = B(i) / S(i) if S(i) is greater than
+ RCOND*max(S), and X(i) = 0 if S(i) is less than or equal to
+ RCOND*max(S).
+
+ RANK (output) INTEGER
+ The number of singular values of A greater than RCOND times
+ the largest singular value.
+
+ WORK (workspace) COMPLEX*16 array, dimension at least
+ (N * NRHS).
+
+ RWORK (workspace) DOUBLE PRECISION array, dimension at least
+ (9*N + 2*N*SMLSIZ + 8*N*NLVL + 3*SMLSIZ*NRHS + (SMLSIZ+1)**2),
+ where
+ NLVL = MAX( 0, INT( LOG_2( MIN( M,N )/(SMLSIZ+1) ) ) + 1 )
+
+ IWORK (workspace) INTEGER array, dimension at least
+ (3*N*NLVL + 11*N).
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an singular value while
+ working on the submatrix lying in rows and columns
+ INFO/(N+1) through MOD(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Ming Gu and Ren-Cang Li, Computer Science Division, University of
+ California at Berkeley, USA
+ Osni Marques, LBNL/NERSC, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ --e;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ --work;
+ --rwork;
+ --iwork;
+
+ /* Function Body */
+ *info = 0;
+
+ if (*n < 0) {
+ *info = -3;
+ } else if (*nrhs < 1) {
+ *info = -4;
+ } else if (*ldb < 1 || *ldb < *n) {
+ *info = -8;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZLALSD", &i__1);
+ return 0;
+ }
+
+ eps = EPSILON;
+
+/* Set up the tolerance. */
+
+ if (*rcond <= 0. || *rcond >= 1.) {
+ *rcond = eps;
+ }
+
+ *rank = 0;
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return 0;
+ } else if (*n == 1) {
+ if (d__[1] == 0.) {
+ zlaset_("A", &c__1, nrhs, &c_b59, &c_b59, &b[b_offset], ldb);
+ } else {
+ *rank = 1;
+ zlascl_("G", &c__0, &c__0, &d__[1], &c_b1015, &c__1, nrhs, &b[
+ b_offset], ldb, info);
+ d__[1] = abs(d__[1]);
+ }
+ return 0;
+ }
+
+/* Rotate the matrix if it is lower bidiagonal. */
+
+ if (*(unsigned char *)uplo == 'L') {
+ i__1 = *n - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dlartg_(&d__[i__], &e[i__], &cs, &sn, &r__);
+ d__[i__] = r__;
+ e[i__] = sn * d__[i__ + 1];
+ d__[i__ + 1] = cs * d__[i__ + 1];
+ if (*nrhs == 1) {
+ zdrot_(&c__1, &b[i__ + b_dim1], &c__1, &b[i__ + 1 + b_dim1], &
+ c__1, &cs, &sn);
+ } else {
+ rwork[((i__) << (1)) - 1] = cs;
+ rwork[i__ * 2] = sn;
+ }
+/* L10: */
+ }
+ if (*nrhs > 1) {
+ i__1 = *nrhs;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = *n - 1;
+ for (j = 1; j <= i__2; ++j) {
+ cs = rwork[((j) << (1)) - 1];
+ sn = rwork[j * 2];
+ zdrot_(&c__1, &b[j + i__ * b_dim1], &c__1, &b[j + 1 + i__
+ * b_dim1], &c__1, &cs, &sn);
+/* L20: */
+ }
+/* L30: */
+ }
+ }
+ }
+
+/* Scale. */
+
+ nm1 = *n - 1;
+ orgnrm = dlanst_("M", n, &d__[1], &e[1]);
+ if (orgnrm == 0.) {
+ zlaset_("A", n, nrhs, &c_b59, &c_b59, &b[b_offset], ldb);
+ return 0;
+ }
+
+ dlascl_("G", &c__0, &c__0, &orgnrm, &c_b1015, n, &c__1, &d__[1], n, info);
+ dlascl_("G", &c__0, &c__0, &orgnrm, &c_b1015, &nm1, &c__1, &e[1], &nm1,
+ info);
+
+/*
+ If N is smaller than the minimum divide size SMLSIZ, then solve
+ the problem with another solver.
+*/
+
+ if (*n <= *smlsiz) {
+ irwu = 1;
+ irwvt = irwu + *n * *n;
+ irwwrk = irwvt + *n * *n;
+ irwrb = irwwrk;
+ irwib = irwrb + *n * *nrhs;
+ irwb = irwib + *n * *nrhs;
+ dlaset_("A", n, n, &c_b324, &c_b1015, &rwork[irwu], n);
+ dlaset_("A", n, n, &c_b324, &c_b1015, &rwork[irwvt], n);
+ dlasdq_("U", &c__0, n, n, n, &c__0, &d__[1], &e[1], &rwork[irwvt], n,
+ &rwork[irwu], n, &rwork[irwwrk], &c__1, &rwork[irwwrk], info);
+ if (*info != 0) {
+ return 0;
+ }
+
+/*
+ In the real version, B is passed to DLASDQ and multiplied
+ internally by Q'. Here B is complex and that product is
+ computed below in two steps (real and imaginary parts).
+*/
+
+ j = irwb - 1;
+ i__1 = *nrhs;
+ for (jcol = 1; jcol <= i__1; ++jcol) {
+ i__2 = *n;
+ for (jrow = 1; jrow <= i__2; ++jrow) {
+ ++j;
+ i__3 = jrow + jcol * b_dim1;
+ rwork[j] = b[i__3].r;
+/* L40: */
+ }
+/* L50: */
+ }
+ dgemm_("T", "N", n, nrhs, n, &c_b1015, &rwork[irwu], n, &rwork[irwb],
+ n, &c_b324, &rwork[irwrb], n);
+ j = irwb - 1;
+ i__1 = *nrhs;
+ for (jcol = 1; jcol <= i__1; ++jcol) {
+ i__2 = *n;
+ for (jrow = 1; jrow <= i__2; ++jrow) {
+ ++j;
+ rwork[j] = d_imag(&b[jrow + jcol * b_dim1]);
+/* L60: */
+ }
+/* L70: */
+ }
+ dgemm_("T", "N", n, nrhs, n, &c_b1015, &rwork[irwu], n, &rwork[irwb],
+ n, &c_b324, &rwork[irwib], n);
+ jreal = irwrb - 1;
+ jimag = irwib - 1;
+ i__1 = *nrhs;
+ for (jcol = 1; jcol <= i__1; ++jcol) {
+ i__2 = *n;
+ for (jrow = 1; jrow <= i__2; ++jrow) {
+ ++jreal;
+ ++jimag;
+ i__3 = jrow + jcol * b_dim1;
+ i__4 = jreal;
+ i__5 = jimag;
+ z__1.r = rwork[i__4], z__1.i = rwork[i__5];
+ b[i__3].r = z__1.r, b[i__3].i = z__1.i;
+/* L80: */
+ }
+/* L90: */
+ }
+
+ tol = *rcond * (d__1 = d__[idamax_(n, &d__[1], &c__1)], abs(d__1));
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if (d__[i__] <= tol) {
+ zlaset_("A", &c__1, nrhs, &c_b59, &c_b59, &b[i__ + b_dim1],
+ ldb);
+ } else {
+ zlascl_("G", &c__0, &c__0, &d__[i__], &c_b1015, &c__1, nrhs, &
+ b[i__ + b_dim1], ldb, info);
+ ++(*rank);
+ }
+/* L100: */
+ }
+
+/*
+ Since B is complex, the following call to DGEMM is performed
+ in two steps (real and imaginary parts). That is for V * B
+ (in the real version of the code V' is stored in WORK).
+
+ CALL DGEMM( 'T', 'N', N, NRHS, N, ONE, WORK, N, B, LDB, ZERO,
+ $ WORK( NWORK ), N )
+*/
+
+ j = irwb - 1;
+ i__1 = *nrhs;
+ for (jcol = 1; jcol <= i__1; ++jcol) {
+ i__2 = *n;
+ for (jrow = 1; jrow <= i__2; ++jrow) {
+ ++j;
+ i__3 = jrow + jcol * b_dim1;
+ rwork[j] = b[i__3].r;
+/* L110: */
+ }
+/* L120: */
+ }
+ dgemm_("T", "N", n, nrhs, n, &c_b1015, &rwork[irwvt], n, &rwork[irwb],
+ n, &c_b324, &rwork[irwrb], n);
+ j = irwb - 1;
+ i__1 = *nrhs;
+ for (jcol = 1; jcol <= i__1; ++jcol) {
+ i__2 = *n;
+ for (jrow = 1; jrow <= i__2; ++jrow) {
+ ++j;
+ rwork[j] = d_imag(&b[jrow + jcol * b_dim1]);
+/* L130: */
+ }
+/* L140: */
+ }
+ dgemm_("T", "N", n, nrhs, n, &c_b1015, &rwork[irwvt], n, &rwork[irwb],
+ n, &c_b324, &rwork[irwib], n);
+ jreal = irwrb - 1;
+ jimag = irwib - 1;
+ i__1 = *nrhs;
+ for (jcol = 1; jcol <= i__1; ++jcol) {
+ i__2 = *n;
+ for (jrow = 1; jrow <= i__2; ++jrow) {
+ ++jreal;
+ ++jimag;
+ i__3 = jrow + jcol * b_dim1;
+ i__4 = jreal;
+ i__5 = jimag;
+ z__1.r = rwork[i__4], z__1.i = rwork[i__5];
+ b[i__3].r = z__1.r, b[i__3].i = z__1.i;
+/* L150: */
+ }
+/* L160: */
+ }
+
+/* Unscale. */
+
+ dlascl_("G", &c__0, &c__0, &c_b1015, &orgnrm, n, &c__1, &d__[1], n,
+ info);
+ dlasrt_("D", n, &d__[1], info);
+ zlascl_("G", &c__0, &c__0, &orgnrm, &c_b1015, n, nrhs, &b[b_offset],
+ ldb, info);
+
+ return 0;
+ }
+
+/* Book-keeping and setting up some constants. */
+
+ nlvl = (integer) (log((doublereal) (*n) / (doublereal) (*smlsiz + 1)) /
+ log(2.)) + 1;
+
+ smlszp = *smlsiz + 1;
+
+ u = 1;
+ vt = *smlsiz * *n + 1;
+ difl = vt + smlszp * *n;
+ difr = difl + nlvl * *n;
+ z__ = difr + ((nlvl * *n) << (1));
+ c__ = z__ + nlvl * *n;
+ s = c__ + *n;
+ poles = s + *n;
+ givnum = poles + ((nlvl) << (1)) * *n;
+ nrwork = givnum + ((nlvl) << (1)) * *n;
+ bx = 1;
+
+ irwrb = nrwork;
+ irwib = irwrb + *smlsiz * *nrhs;
+ irwb = irwib + *smlsiz * *nrhs;
+
+ sizei = *n + 1;
+ k = sizei + *n;
+ givptr = k + *n;
+ perm = givptr + *n;
+ givcol = perm + nlvl * *n;
+ iwk = givcol + ((nlvl * *n) << (1));
+
+ st = 1;
+ sqre = 0;
+ icmpq1 = 1;
+ icmpq2 = 0;
+ nsub = 0;
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if ((d__1 = d__[i__], abs(d__1)) < eps) {
+ d__[i__] = d_sign(&eps, &d__[i__]);
+ }
+/* L170: */
+ }
+
+ i__1 = nm1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if ((d__1 = e[i__], abs(d__1)) < eps || i__ == nm1) {
+ ++nsub;
+ iwork[nsub] = st;
+
+/*
+ Subproblem found. First determine its size and then
+ apply divide and conquer on it.
+*/
+
+ if (i__ < nm1) {
+
+/* A subproblem with E(I) small for I < NM1. */
+
+ nsize = i__ - st + 1;
+ iwork[sizei + nsub - 1] = nsize;
+ } else if ((d__1 = e[i__], abs(d__1)) >= eps) {
+
+/* A subproblem with E(NM1) not too small but I = NM1. */
+
+ nsize = *n - st + 1;
+ iwork[sizei + nsub - 1] = nsize;
+ } else {
+
+/*
+ A subproblem with E(NM1) small. This implies an
+ 1-by-1 subproblem at D(N), which is not solved
+ explicitly.
+*/
+
+ nsize = i__ - st + 1;
+ iwork[sizei + nsub - 1] = nsize;
+ ++nsub;
+ iwork[nsub] = *n;
+ iwork[sizei + nsub - 1] = 1;
+ zcopy_(nrhs, &b[*n + b_dim1], ldb, &work[bx + nm1], n);
+ }
+ st1 = st - 1;
+ if (nsize == 1) {
+
+/*
+ This is a 1-by-1 subproblem and is not solved
+ explicitly.
+*/
+
+ zcopy_(nrhs, &b[st + b_dim1], ldb, &work[bx + st1], n);
+ } else if (nsize <= *smlsiz) {
+
+/* This is a small subproblem and is solved by DLASDQ. */
+
+ dlaset_("A", &nsize, &nsize, &c_b324, &c_b1015, &rwork[vt +
+ st1], n);
+ dlaset_("A", &nsize, &nsize, &c_b324, &c_b1015, &rwork[u +
+ st1], n);
+ dlasdq_("U", &c__0, &nsize, &nsize, &nsize, &c__0, &d__[st], &
+ e[st], &rwork[vt + st1], n, &rwork[u + st1], n, &
+ rwork[nrwork], &c__1, &rwork[nrwork], info)
+ ;
+ if (*info != 0) {
+ return 0;
+ }
+
+/*
+ In the real version, B is passed to DLASDQ and multiplied
+ internally by Q'. Here B is complex and that product is
+ computed below in two steps (real and imaginary parts).
+*/
+
+ j = irwb - 1;
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = st + nsize - 1;
+ for (jrow = st; jrow <= i__3; ++jrow) {
+ ++j;
+ i__4 = jrow + jcol * b_dim1;
+ rwork[j] = b[i__4].r;
+/* L180: */
+ }
+/* L190: */
+ }
+ dgemm_("T", "N", &nsize, nrhs, &nsize, &c_b1015, &rwork[u +
+ st1], n, &rwork[irwb], &nsize, &c_b324, &rwork[irwrb],
+ &nsize);
+ j = irwb - 1;
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = st + nsize - 1;
+ for (jrow = st; jrow <= i__3; ++jrow) {
+ ++j;
+ rwork[j] = d_imag(&b[jrow + jcol * b_dim1]);
+/* L200: */
+ }
+/* L210: */
+ }
+ dgemm_("T", "N", &nsize, nrhs, &nsize, &c_b1015, &rwork[u +
+ st1], n, &rwork[irwb], &nsize, &c_b324, &rwork[irwib],
+ &nsize);
+ jreal = irwrb - 1;
+ jimag = irwib - 1;
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = st + nsize - 1;
+ for (jrow = st; jrow <= i__3; ++jrow) {
+ ++jreal;
+ ++jimag;
+ i__4 = jrow + jcol * b_dim1;
+ i__5 = jreal;
+ i__6 = jimag;
+ z__1.r = rwork[i__5], z__1.i = rwork[i__6];
+ b[i__4].r = z__1.r, b[i__4].i = z__1.i;
+/* L220: */
+ }
+/* L230: */
+ }
+
+ zlacpy_("A", &nsize, nrhs, &b[st + b_dim1], ldb, &work[bx +
+ st1], n);
+ } else {
+
+/* A large problem. Solve it using divide and conquer. */
+
+ dlasda_(&icmpq1, smlsiz, &nsize, &sqre, &d__[st], &e[st], &
+ rwork[u + st1], n, &rwork[vt + st1], &iwork[k + st1],
+ &rwork[difl + st1], &rwork[difr + st1], &rwork[z__ +
+ st1], &rwork[poles + st1], &iwork[givptr + st1], &
+ iwork[givcol + st1], n, &iwork[perm + st1], &rwork[
+ givnum + st1], &rwork[c__ + st1], &rwork[s + st1], &
+ rwork[nrwork], &iwork[iwk], info);
+ if (*info != 0) {
+ return 0;
+ }
+ bxst = bx + st1;
+ zlalsa_(&icmpq2, smlsiz, &nsize, nrhs, &b[st + b_dim1], ldb, &
+ work[bxst], n, &rwork[u + st1], n, &rwork[vt + st1], &
+ iwork[k + st1], &rwork[difl + st1], &rwork[difr + st1]
+ , &rwork[z__ + st1], &rwork[poles + st1], &iwork[
+ givptr + st1], &iwork[givcol + st1], n, &iwork[perm +
+ st1], &rwork[givnum + st1], &rwork[c__ + st1], &rwork[
+ s + st1], &rwork[nrwork], &iwork[iwk], info);
+ if (*info != 0) {
+ return 0;
+ }
+ }
+ st = i__ + 1;
+ }
+/* L240: */
+ }
+
+/* Apply the singular values and treat the tiny ones as zero. */
+
+ tol = *rcond * (d__1 = d__[idamax_(n, &d__[1], &c__1)], abs(d__1));
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/*
+ Some of the elements in D can be negative because 1-by-1
+ subproblems were not solved explicitly.
+*/
+
+ if ((d__1 = d__[i__], abs(d__1)) <= tol) {
+ zlaset_("A", &c__1, nrhs, &c_b59, &c_b59, &work[bx + i__ - 1], n);
+ } else {
+ ++(*rank);
+ zlascl_("G", &c__0, &c__0, &d__[i__], &c_b1015, &c__1, nrhs, &
+ work[bx + i__ - 1], n, info);
+ }
+ d__[i__] = (d__1 = d__[i__], abs(d__1));
+/* L250: */
+ }
+
+/* Now apply back the right singular vectors. */
+
+ icmpq2 = 1;
+ i__1 = nsub;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ st = iwork[i__];
+ st1 = st - 1;
+ nsize = iwork[sizei + i__ - 1];
+ bxst = bx + st1;
+ if (nsize == 1) {
+ zcopy_(nrhs, &work[bxst], n, &b[st + b_dim1], ldb);
+ } else if (nsize <= *smlsiz) {
+
+/*
+ Since B and BX are complex, the following call to DGEMM
+ is performed in two steps (real and imaginary parts).
+
+ CALL DGEMM( 'T', 'N', NSIZE, NRHS, NSIZE, ONE,
+ $ RWORK( VT+ST1 ), N, RWORK( BXST ), N, ZERO,
+ $ B( ST, 1 ), LDB )
+*/
+
+ j = bxst - *n - 1;
+ jreal = irwb - 1;
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ j += *n;
+ i__3 = nsize;
+ for (jrow = 1; jrow <= i__3; ++jrow) {
+ ++jreal;
+ i__4 = j + jrow;
+ rwork[jreal] = work[i__4].r;
+/* L260: */
+ }
+/* L270: */
+ }
+ dgemm_("T", "N", &nsize, nrhs, &nsize, &c_b1015, &rwork[vt + st1],
+ n, &rwork[irwb], &nsize, &c_b324, &rwork[irwrb], &nsize);
+ j = bxst - *n - 1;
+ jimag = irwb - 1;
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ j += *n;
+ i__3 = nsize;
+ for (jrow = 1; jrow <= i__3; ++jrow) {
+ ++jimag;
+ rwork[jimag] = d_imag(&work[j + jrow]);
+/* L280: */
+ }
+/* L290: */
+ }
+ dgemm_("T", "N", &nsize, nrhs, &nsize, &c_b1015, &rwork[vt + st1],
+ n, &rwork[irwb], &nsize, &c_b324, &rwork[irwib], &nsize);
+ jreal = irwrb - 1;
+ jimag = irwib - 1;
+ i__2 = *nrhs;
+ for (jcol = 1; jcol <= i__2; ++jcol) {
+ i__3 = st + nsize - 1;
+ for (jrow = st; jrow <= i__3; ++jrow) {
+ ++jreal;
+ ++jimag;
+ i__4 = jrow + jcol * b_dim1;
+ i__5 = jreal;
+ i__6 = jimag;
+ z__1.r = rwork[i__5], z__1.i = rwork[i__6];
+ b[i__4].r = z__1.r, b[i__4].i = z__1.i;
+/* L300: */
+ }
+/* L310: */
+ }
+ } else {
+ zlalsa_(&icmpq2, smlsiz, &nsize, nrhs, &work[bxst], n, &b[st +
+ b_dim1], ldb, &rwork[u + st1], n, &rwork[vt + st1], &
+ iwork[k + st1], &rwork[difl + st1], &rwork[difr + st1], &
+ rwork[z__ + st1], &rwork[poles + st1], &iwork[givptr +
+ st1], &iwork[givcol + st1], n, &iwork[perm + st1], &rwork[
+ givnum + st1], &rwork[c__ + st1], &rwork[s + st1], &rwork[
+ nrwork], &iwork[iwk], info);
+ if (*info != 0) {
+ return 0;
+ }
+ }
+/* L320: */
+ }
+
+/* Unscale and sort the singular values. */
+
+ dlascl_("G", &c__0, &c__0, &c_b1015, &orgnrm, n, &c__1, &d__[1], n, info);
+ dlasrt_("D", n, &d__[1], info);
+ zlascl_("G", &c__0, &c__0, &orgnrm, &c_b1015, n, nrhs, &b[b_offset], ldb,
+ info);
+
+ return 0;
+
+/* End of ZLALSD */
+
+} /* zlalsd_ */
+
+doublereal zlange_(char *norm, integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublereal *work)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+ doublereal ret_val, d__1, d__2;
+
+ /* Builtin functions */
+ double z_abs(doublecomplex *), sqrt(doublereal);
+
+ /* Local variables */
+ static integer i__, j;
+ static doublereal sum, scale;
+ extern logical lsame_(char *, char *);
+ static doublereal value;
+ extern /* Subroutine */ int zlassq_(integer *, doublecomplex *, integer *,
+ doublereal *, doublereal *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ ZLANGE returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ complex matrix A.
+
+ Description
+ ===========
+
+ ZLANGE returns the value
+
+ ZLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a matrix norm.
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in ZLANGE as described
+ above.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0. When M = 0,
+ ZLANGE is set to zero.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0. When N = 0,
+ ZLANGE is set to zero.
+
+ A (input) COMPLEX*16 array, dimension (LDA,N)
+ The m by n matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(M,1).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (LWORK),
+ where LWORK >= M when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --work;
+
+ /* Function Body */
+ if (min(*m,*n) == 0) {
+ value = 0.;
+ } else if (lsame_(norm, "M")) {
+
+/* Find max(abs(A(i,j))). */
+
+ value = 0.;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+/* Computing MAX */
+ d__1 = value, d__2 = z_abs(&a[i__ + j * a_dim1]);
+ value = max(d__1,d__2);
+/* L10: */
+ }
+/* L20: */
+ }
+ } else if (lsame_(norm, "O") || *(unsigned char *)
+ norm == '1') {
+
+/* Find norm1(A). */
+
+ value = 0.;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ sum = 0.;
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ sum += z_abs(&a[i__ + j * a_dim1]);
+/* L30: */
+ }
+ value = max(value,sum);
+/* L40: */
+ }
+ } else if (lsame_(norm, "I")) {
+
+/* Find normI(A). */
+
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ work[i__] = 0.;
+/* L50: */
+ }
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ work[i__] += z_abs(&a[i__ + j * a_dim1]);
+/* L60: */
+ }
+/* L70: */
+ }
+ value = 0.;
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+/* Computing MAX */
+ d__1 = value, d__2 = work[i__];
+ value = max(d__1,d__2);
+/* L80: */
+ }
+ } else if (lsame_(norm, "F") || lsame_(norm, "E")) {
+
+/* Find normF(A). */
+
+ scale = 0.;
+ sum = 1.;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ zlassq_(m, &a[j * a_dim1 + 1], &c__1, &scale, &sum);
+/* L90: */
+ }
+ value = scale * sqrt(sum);
+ }
+
+ ret_val = value;
+ return ret_val;
+
+/* End of ZLANGE */
+
+} /* zlange_ */
+
+doublereal zlanhe_(char *norm, char *uplo, integer *n, doublecomplex *a,
+ integer *lda, doublereal *work)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+ doublereal ret_val, d__1, d__2, d__3;
+
+ /* Builtin functions */
+ double z_abs(doublecomplex *), sqrt(doublereal);
+
+ /* Local variables */
+ static integer i__, j;
+ static doublereal sum, absa, scale;
+ extern logical lsame_(char *, char *);
+ static doublereal value;
+ extern /* Subroutine */ int zlassq_(integer *, doublecomplex *, integer *,
+ doublereal *, doublereal *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ ZLANHE returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ complex hermitian matrix A.
+
+ Description
+ ===========
+
+ ZLANHE returns the value
+
+ ZLANHE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a matrix norm.
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in ZLANHE as described
+ above.
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ hermitian matrix A is to be referenced.
+ = 'U': Upper triangular part of A is referenced
+ = 'L': Lower triangular part of A is referenced
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, ZLANHE is
+ set to zero.
+
+ A (input) COMPLEX*16 array, dimension (LDA,N)
+ The hermitian matrix A. If UPLO = 'U', the leading n by n
+ upper triangular part of A contains the upper triangular part
+ of the matrix A, and the strictly lower triangular part of A
+ is not referenced. If UPLO = 'L', the leading n by n lower
+ triangular part of A contains the lower triangular part of
+ the matrix A, and the strictly upper triangular part of A is
+ not referenced. Note that the imaginary parts of the diagonal
+ elements need not be set and are assumed to be zero.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(N,1).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (LWORK),
+ where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
+ WORK is not referenced.
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --work;
+
+ /* Function Body */
+ if (*n == 0) {
+ value = 0.;
+ } else if (lsame_(norm, "M")) {
+
+/* Find max(abs(A(i,j))). */
+
+ value = 0.;
+ if (lsame_(uplo, "U")) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+/* Computing MAX */
+ d__1 = value, d__2 = z_abs(&a[i__ + j * a_dim1]);
+ value = max(d__1,d__2);
+/* L10: */
+ }
+/* Computing MAX */
+ i__2 = j + j * a_dim1;
+ d__2 = value, d__3 = (d__1 = a[i__2].r, abs(d__1));
+ value = max(d__2,d__3);
+/* L20: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MAX */
+ i__2 = j + j * a_dim1;
+ d__2 = value, d__3 = (d__1 = a[i__2].r, abs(d__1));
+ value = max(d__2,d__3);
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+/* Computing MAX */
+ d__1 = value, d__2 = z_abs(&a[i__ + j * a_dim1]);
+ value = max(d__1,d__2);
+/* L30: */
+ }
+/* L40: */
+ }
+ }
+ } else if (lsame_(norm, "I") || lsame_(norm, "O") || *(unsigned char *)norm == '1') {
+
+/* Find normI(A) ( = norm1(A), since A is hermitian). */
+
+ value = 0.;
+ if (lsame_(uplo, "U")) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ sum = 0.;
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ absa = z_abs(&a[i__ + j * a_dim1]);
+ sum += absa;
+ work[i__] += absa;
+/* L50: */
+ }
+ i__2 = j + j * a_dim1;
+ work[j] = sum + (d__1 = a[i__2].r, abs(d__1));
+/* L60: */
+ }
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+/* Computing MAX */
+ d__1 = value, d__2 = work[i__];
+ value = max(d__1,d__2);
+/* L70: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ work[i__] = 0.;
+/* L80: */
+ }
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j + j * a_dim1;
+ sum = work[j] + (d__1 = a[i__2].r, abs(d__1));
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ absa = z_abs(&a[i__ + j * a_dim1]);
+ sum += absa;
+ work[i__] += absa;
+/* L90: */
+ }
+ value = max(value,sum);
+/* L100: */
+ }
+ }
+ } else if (lsame_(norm, "F") || lsame_(norm, "E")) {
+
+/* Find normF(A). */
+
+ scale = 0.;
+ sum = 1.;
+ if (lsame_(uplo, "U")) {
+ i__1 = *n;
+ for (j = 2; j <= i__1; ++j) {
+ i__2 = j - 1;
+ zlassq_(&i__2, &a[j * a_dim1 + 1], &c__1, &scale, &sum);
+/* L110: */
+ }
+ } else {
+ i__1 = *n - 1;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n - j;
+ zlassq_(&i__2, &a[j + 1 + j * a_dim1], &c__1, &scale, &sum);
+/* L120: */
+ }
+ }
+ sum *= 2;
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__ + i__ * a_dim1;
+ if (a[i__2].r != 0.) {
+ i__2 = i__ + i__ * a_dim1;
+ absa = (d__1 = a[i__2].r, abs(d__1));
+ if (scale < absa) {
+/* Computing 2nd power */
+ d__1 = scale / absa;
+ sum = sum * (d__1 * d__1) + 1.;
+ scale = absa;
+ } else {
+/* Computing 2nd power */
+ d__1 = absa / scale;
+ sum += d__1 * d__1;
+ }
+ }
+/* L130: */
+ }
+ value = scale * sqrt(sum);
+ }
+
+ ret_val = value;
+ return ret_val;
+
+/* End of ZLANHE */
+
+} /* zlanhe_ */
+
+doublereal zlanhs_(char *norm, integer *n, doublecomplex *a, integer *lda,
+ doublereal *work)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+ doublereal ret_val, d__1, d__2;
+
+ /* Builtin functions */
+ double z_abs(doublecomplex *), sqrt(doublereal);
+
+ /* Local variables */
+ static integer i__, j;
+ static doublereal sum, scale;
+ extern logical lsame_(char *, char *);
+ static doublereal value;
+ extern /* Subroutine */ int zlassq_(integer *, doublecomplex *, integer *,
+ doublereal *, doublereal *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ ZLANHS returns the value of the one norm, or the Frobenius norm, or
+ the infinity norm, or the element of largest absolute value of a
+ Hessenberg matrix A.
+
+ Description
+ ===========
+
+ ZLANHS returns the value
+
+ ZLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+ (
+ ( norm1(A), NORM = '1', 'O' or 'o'
+ (
+ ( normI(A), NORM = 'I' or 'i'
+ (
+ ( normF(A), NORM = 'F', 'f', 'E' or 'e'
+
+ where norm1 denotes the one norm of a matrix (maximum column sum),
+ normI denotes the infinity norm of a matrix (maximum row sum) and
+ normF denotes the Frobenius norm of a matrix (square root of sum of
+ squares). Note that max(abs(A(i,j))) is not a matrix norm.
+
+ Arguments
+ =========
+
+ NORM (input) CHARACTER*1
+ Specifies the value to be returned in ZLANHS as described
+ above.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0. When N = 0, ZLANHS is
+ set to zero.
+
+ A (input) COMPLEX*16 array, dimension (LDA,N)
+ The n by n upper Hessenberg matrix A; the part of A below the
+ first sub-diagonal is not referenced.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(N,1).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (LWORK),
+ where LWORK >= N when NORM = 'I'; otherwise, WORK is not
+ referenced.
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --work;
+
+ /* Function Body */
+ if (*n == 0) {
+ value = 0.;
+ } else if (lsame_(norm, "M")) {
+
+/* Find max(abs(A(i,j))). */
+
+ value = 0.;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MIN */
+ i__3 = *n, i__4 = j + 1;
+ i__2 = min(i__3,i__4);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+/* Computing MAX */
+ d__1 = value, d__2 = z_abs(&a[i__ + j * a_dim1]);
+ value = max(d__1,d__2);
+/* L10: */
+ }
+/* L20: */
+ }
+ } else if (lsame_(norm, "O") || *(unsigned char *)
+ norm == '1') {
+
+/* Find norm1(A). */
+
+ value = 0.;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ sum = 0.;
+/* Computing MIN */
+ i__3 = *n, i__4 = j + 1;
+ i__2 = min(i__3,i__4);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ sum += z_abs(&a[i__ + j * a_dim1]);
+/* L30: */
+ }
+ value = max(value,sum);
+/* L40: */
+ }
+ } else if (lsame_(norm, "I")) {
+
+/* Find normI(A). */
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ work[i__] = 0.;
+/* L50: */
+ }
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MIN */
+ i__3 = *n, i__4 = j + 1;
+ i__2 = min(i__3,i__4);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ work[i__] += z_abs(&a[i__ + j * a_dim1]);
+/* L60: */
+ }
+/* L70: */
+ }
+ value = 0.;
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+/* Computing MAX */
+ d__1 = value, d__2 = work[i__];
+ value = max(d__1,d__2);
+/* L80: */
+ }
+ } else if (lsame_(norm, "F") || lsame_(norm, "E")) {
+
+/* Find normF(A). */
+
+ scale = 0.;
+ sum = 1.;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MIN */
+ i__3 = *n, i__4 = j + 1;
+ i__2 = min(i__3,i__4);
+ zlassq_(&i__2, &a[j * a_dim1 + 1], &c__1, &scale, &sum);
+/* L90: */
+ }
+ value = scale * sqrt(sum);
+ }
+
+ ret_val = value;
+ return ret_val;
+
+/* End of ZLANHS */
+
+} /* zlanhs_ */
+
+/* Subroutine */ int zlarcm_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublecomplex *b, integer *ldb, doublecomplex *c__, integer *ldc,
+ doublereal *rwork)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
+ i__3, i__4, i__5;
+ doublereal d__1;
+ doublecomplex z__1;
+
+ /* Builtin functions */
+ double d_imag(doublecomplex *);
+
+ /* Local variables */
+ static integer i__, j, l;
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZLARCM performs a very simple matrix-matrix multiplication:
+ C := A * B,
+ where A is M by M and real; B is M by N and complex;
+ C is M by N and complex.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix A and of the matrix C.
+ M >= 0.
+
+ N (input) INTEGER
+ The number of columns and rows of the matrix B and
+ the number of columns of the matrix C.
+ N >= 0.
+
+ A (input) DOUBLE PRECISION array, dimension (LDA, M)
+ A contains the M by M matrix A.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >=max(1,M).
+
+ B (input) DOUBLE PRECISION array, dimension (LDB, N)
+ B contains the M by N matrix B.
+
+ LDB (input) INTEGER
+ The leading dimension of the array B. LDB >=max(1,M).
+
+ C (input) COMPLEX*16 array, dimension (LDC, N)
+ C contains the M by N matrix C.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >=max(1,M).
+
+ RWORK (workspace) DOUBLE PRECISION array, dimension (2*M*N)
+
+ =====================================================================
+
+
+ Quick return if possible.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1 * 1;
+ b -= b_offset;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --rwork;
+
+ /* Function Body */
+ if (*m == 0 || *n == 0) {
+ return 0;
+ }
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * b_dim1;
+ rwork[(j - 1) * *m + i__] = b[i__3].r;
+/* L10: */
+ }
+/* L20: */
+ }
+
+ l = *m * *n + 1;
+ dgemm_("N", "N", m, n, m, &c_b1015, &a[a_offset], lda, &rwork[1], m, &
+ c_b324, &rwork[l], m);
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ i__4 = l + (j - 1) * *m + i__ - 1;
+ c__[i__3].r = rwork[i__4], c__[i__3].i = 0.;
+/* L30: */
+ }
+/* L40: */
+ }
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ rwork[(j - 1) * *m + i__] = d_imag(&b[i__ + j * b_dim1]);
+/* L50: */
+ }
+/* L60: */
+ }
+ dgemm_("N", "N", m, n, m, &c_b1015, &a[a_offset], lda, &rwork[1], m, &
+ c_b324, &rwork[l], m);
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ i__4 = i__ + j * c_dim1;
+ d__1 = c__[i__4].r;
+ i__5 = l + (j - 1) * *m + i__ - 1;
+ z__1.r = d__1, z__1.i = rwork[i__5];
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L70: */
+ }
+/* L80: */
+ }
+
+ return 0;
+
+/* End of ZLARCM */
+
+} /* zlarcm_ */
+
+/* Subroutine */ int zlarf_(char *side, integer *m, integer *n, doublecomplex
+ *v, integer *incv, doublecomplex *tau, doublecomplex *c__, integer *
+ ldc, doublecomplex *work)
+{
+ /* System generated locals */
+ integer c_dim1, c_offset;
+ doublecomplex z__1;
+
+ /* Local variables */
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int zgerc_(integer *, integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *), zgemv_(char *, integer *, integer *,
+ doublecomplex *, doublecomplex *, integer *, doublecomplex *,
+ integer *, doublecomplex *, doublecomplex *, integer *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZLARF applies a complex elementary reflector H to a complex M-by-N
+ matrix C, from either the left or the right. H is represented in the
+ form
+
+ H = I - tau * v * v'
+
+ where tau is a complex scalar and v is a complex vector.
+
+ If tau = 0, then H is taken to be the unit matrix.
+
+ To apply H' (the conjugate transpose of H), supply conjg(tau) instead
+ tau.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form H * C
+ = 'R': form C * H
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ V (input) COMPLEX*16 array, dimension
+ (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+ or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+ The vector v in the representation of H. V is not used if
+ TAU = 0.
+
+ INCV (input) INTEGER
+ The increment between elements of v. INCV <> 0.
+
+ TAU (input) COMPLEX*16
+ The value tau in the representation of H.
+
+ C (input/output) COMPLEX*16 array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+ or C * H if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) COMPLEX*16 array, dimension
+ (N) if SIDE = 'L'
+ or (M) if SIDE = 'R'
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ --v;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ if (lsame_(side, "L")) {
+
+/* Form H * C */
+
+ if (tau->r != 0. || tau->i != 0.) {
+
+/* w := C' * v */
+
+ zgemv_("Conjugate transpose", m, n, &c_b60, &c__[c_offset], ldc, &
+ v[1], incv, &c_b59, &work[1], &c__1);
+
+/* C := C - v * w' */
+
+ z__1.r = -tau->r, z__1.i = -tau->i;
+ zgerc_(m, n, &z__1, &v[1], incv, &work[1], &c__1, &c__[c_offset],
+ ldc);
+ }
+ } else {
+
+/* Form C * H */
+
+ if (tau->r != 0. || tau->i != 0.) {
+
+/* w := C * v */
+
+ zgemv_("No transpose", m, n, &c_b60, &c__[c_offset], ldc, &v[1],
+ incv, &c_b59, &work[1], &c__1);
+
+/* C := C - w * v' */
+
+ z__1.r = -tau->r, z__1.i = -tau->i;
+ zgerc_(m, n, &z__1, &work[1], &c__1, &v[1], incv, &c__[c_offset],
+ ldc);
+ }
+ }
+ return 0;
+
+/* End of ZLARF */
+
+} /* zlarf_ */
+
+/* Subroutine */ int zlarfb_(char *side, char *trans, char *direct, char *
+ storev, integer *m, integer *n, integer *k, doublecomplex *v, integer
+ *ldv, doublecomplex *t, integer *ldt, doublecomplex *c__, integer *
+ ldc, doublecomplex *work, integer *ldwork)
+{
+ /* System generated locals */
+ integer c_dim1, c_offset, t_dim1, t_offset, v_dim1, v_offset, work_dim1,
+ work_offset, i__1, i__2, i__3, i__4, i__5;
+ doublecomplex z__1, z__2;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, j;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int zgemm_(char *, char *, integer *, integer *,
+ integer *, doublecomplex *, doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *), zcopy_(integer *, doublecomplex *,
+ integer *, doublecomplex *, integer *), ztrmm_(char *, char *,
+ char *, char *, integer *, integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *), zlacgv_(integer *, doublecomplex *,
+ integer *);
+ static char transt[1];
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZLARFB applies a complex block reflector H or its transpose H' to a
+ complex M-by-N matrix C, from either the left or the right.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply H or H' from the Left
+ = 'R': apply H or H' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply H (No transpose)
+ = 'C': apply H' (Conjugate transpose)
+
+ DIRECT (input) CHARACTER*1
+ Indicates how H is formed from a product of elementary
+ reflectors
+ = 'F': H = H(1) H(2) . . . H(k) (Forward)
+ = 'B': H = H(k) . . . H(2) H(1) (Backward)
+
+ STOREV (input) CHARACTER*1
+ Indicates how the vectors which define the elementary
+ reflectors are stored:
+ = 'C': Columnwise
+ = 'R': Rowwise
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ K (input) INTEGER
+ The order of the matrix T (= the number of elementary
+ reflectors whose product defines the block reflector).
+
+ V (input) COMPLEX*16 array, dimension
+ (LDV,K) if STOREV = 'C'
+ (LDV,M) if STOREV = 'R' and SIDE = 'L'
+ (LDV,N) if STOREV = 'R' and SIDE = 'R'
+ The matrix V. See further details.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
+ if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
+ if STOREV = 'R', LDV >= K.
+
+ T (input) COMPLEX*16 array, dimension (LDT,K)
+ The triangular K-by-K matrix T in the representation of the
+ block reflector.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ C (input/output) COMPLEX*16 array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) COMPLEX*16 array, dimension (LDWORK,K)
+
+ LDWORK (input) INTEGER
+ The leading dimension of the array WORK.
+ If SIDE = 'L', LDWORK >= max(1,N);
+ if SIDE = 'R', LDWORK >= max(1,M).
+
+ =====================================================================
+
+
+ Quick return if possible
+*/
+
+ /* Parameter adjustments */
+ v_dim1 = *ldv;
+ v_offset = 1 + v_dim1 * 1;
+ v -= v_offset;
+ t_dim1 = *ldt;
+ t_offset = 1 + t_dim1 * 1;
+ t -= t_offset;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ work_dim1 = *ldwork;
+ work_offset = 1 + work_dim1 * 1;
+ work -= work_offset;
+
+ /* Function Body */
+ if (*m <= 0 || *n <= 0) {
+ return 0;
+ }
+
+ if (lsame_(trans, "N")) {
+ *(unsigned char *)transt = 'C';
+ } else {
+ *(unsigned char *)transt = 'N';
+ }
+
+ if (lsame_(storev, "C")) {
+
+ if (lsame_(direct, "F")) {
+
+/*
+ Let V = ( V1 ) (first K rows)
+ ( V2 )
+ where V1 is unit lower triangular.
+*/
+
+ if (lsame_(side, "L")) {
+
+/*
+ Form H * C or H' * C where C = ( C1 )
+ ( C2 )
+
+ W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK)
+
+ W := C1'
+*/
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ zcopy_(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1],
+ &c__1);
+ zlacgv_(n, &work[j * work_dim1 + 1], &c__1);
+/* L10: */
+ }
+
+/* W := W * V1 */
+
+ ztrmm_("Right", "Lower", "No transpose", "Unit", n, k, &c_b60,
+ &v[v_offset], ldv, &work[work_offset], ldwork);
+ if (*m > *k) {
+
+/* W := W + C2'*V2 */
+
+ i__1 = *m - *k;
+ zgemm_("Conjugate transpose", "No transpose", n, k, &i__1,
+ &c_b60, &c__[*k + 1 + c_dim1], ldc, &v[*k + 1 +
+ v_dim1], ldv, &c_b60, &work[work_offset], ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ ztrmm_("Right", "Upper", transt, "Non-unit", n, k, &c_b60, &t[
+ t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - V * W' */
+
+ if (*m > *k) {
+
+/* C2 := C2 - V2 * W' */
+
+ i__1 = *m - *k;
+ z__1.r = -1., z__1.i = -0.;
+ zgemm_("No transpose", "Conjugate transpose", &i__1, n, k,
+ &z__1, &v[*k + 1 + v_dim1], ldv, &work[
+ work_offset], ldwork, &c_b60, &c__[*k + 1 +
+ c_dim1], ldc);
+ }
+
+/* W := W * V1' */
+
+ ztrmm_("Right", "Lower", "Conjugate transpose", "Unit", n, k,
+ &c_b60, &v[v_offset], ldv, &work[work_offset], ldwork);
+
+/* C1 := C1 - W' */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = j + i__ * c_dim1;
+ i__4 = j + i__ * c_dim1;
+ d_cnjg(&z__2, &work[i__ + j * work_dim1]);
+ z__1.r = c__[i__4].r - z__2.r, z__1.i = c__[i__4].i -
+ z__2.i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L20: */
+ }
+/* L30: */
+ }
+
+ } else if (lsame_(side, "R")) {
+
+/*
+ Form C * H or C * H' where C = ( C1 C2 )
+
+ W := C * V = (C1*V1 + C2*V2) (stored in WORK)
+
+ W := C1
+*/
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ zcopy_(m, &c__[j * c_dim1 + 1], &c__1, &work[j *
+ work_dim1 + 1], &c__1);
+/* L40: */
+ }
+
+/* W := W * V1 */
+
+ ztrmm_("Right", "Lower", "No transpose", "Unit", m, k, &c_b60,
+ &v[v_offset], ldv, &work[work_offset], ldwork);
+ if (*n > *k) {
+
+/* W := W + C2 * V2 */
+
+ i__1 = *n - *k;
+ zgemm_("No transpose", "No transpose", m, k, &i__1, &
+ c_b60, &c__[(*k + 1) * c_dim1 + 1], ldc, &v[*k +
+ 1 + v_dim1], ldv, &c_b60, &work[work_offset],
+ ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ ztrmm_("Right", "Upper", trans, "Non-unit", m, k, &c_b60, &t[
+ t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - W * V' */
+
+ if (*n > *k) {
+
+/* C2 := C2 - W * V2' */
+
+ i__1 = *n - *k;
+ z__1.r = -1., z__1.i = -0.;
+ zgemm_("No transpose", "Conjugate transpose", m, &i__1, k,
+ &z__1, &work[work_offset], ldwork, &v[*k + 1 +
+ v_dim1], ldv, &c_b60, &c__[(*k + 1) * c_dim1 + 1],
+ ldc);
+ }
+
+/* W := W * V1' */
+
+ ztrmm_("Right", "Lower", "Conjugate transpose", "Unit", m, k,
+ &c_b60, &v[v_offset], ldv, &work[work_offset], ldwork);
+
+/* C1 := C1 - W */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ i__4 = i__ + j * c_dim1;
+ i__5 = i__ + j * work_dim1;
+ z__1.r = c__[i__4].r - work[i__5].r, z__1.i = c__[
+ i__4].i - work[i__5].i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L50: */
+ }
+/* L60: */
+ }
+ }
+
+ } else {
+
+/*
+ Let V = ( V1 )
+ ( V2 ) (last K rows)
+ where V2 is unit upper triangular.
+*/
+
+ if (lsame_(side, "L")) {
+
+/*
+ Form H * C or H' * C where C = ( C1 )
+ ( C2 )
+
+ W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK)
+
+ W := C2'
+*/
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ zcopy_(n, &c__[*m - *k + j + c_dim1], ldc, &work[j *
+ work_dim1 + 1], &c__1);
+ zlacgv_(n, &work[j * work_dim1 + 1], &c__1);
+/* L70: */
+ }
+
+/* W := W * V2 */
+
+ ztrmm_("Right", "Upper", "No transpose", "Unit", n, k, &c_b60,
+ &v[*m - *k + 1 + v_dim1], ldv, &work[work_offset],
+ ldwork);
+ if (*m > *k) {
+
+/* W := W + C1'*V1 */
+
+ i__1 = *m - *k;
+ zgemm_("Conjugate transpose", "No transpose", n, k, &i__1,
+ &c_b60, &c__[c_offset], ldc, &v[v_offset], ldv, &
+ c_b60, &work[work_offset], ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ ztrmm_("Right", "Lower", transt, "Non-unit", n, k, &c_b60, &t[
+ t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - V * W' */
+
+ if (*m > *k) {
+
+/* C1 := C1 - V1 * W' */
+
+ i__1 = *m - *k;
+ z__1.r = -1., z__1.i = -0.;
+ zgemm_("No transpose", "Conjugate transpose", &i__1, n, k,
+ &z__1, &v[v_offset], ldv, &work[work_offset],
+ ldwork, &c_b60, &c__[c_offset], ldc);
+ }
+
+/* W := W * V2' */
+
+ ztrmm_("Right", "Upper", "Conjugate transpose", "Unit", n, k,
+ &c_b60, &v[*m - *k + 1 + v_dim1], ldv, &work[
+ work_offset], ldwork);
+
+/* C2 := C2 - W' */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = *m - *k + j + i__ * c_dim1;
+ i__4 = *m - *k + j + i__ * c_dim1;
+ d_cnjg(&z__2, &work[i__ + j * work_dim1]);
+ z__1.r = c__[i__4].r - z__2.r, z__1.i = c__[i__4].i -
+ z__2.i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L80: */
+ }
+/* L90: */
+ }
+
+ } else if (lsame_(side, "R")) {
+
+/*
+ Form C * H or C * H' where C = ( C1 C2 )
+
+ W := C * V = (C1*V1 + C2*V2) (stored in WORK)
+
+ W := C2
+*/
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ zcopy_(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[
+ j * work_dim1 + 1], &c__1);
+/* L100: */
+ }
+
+/* W := W * V2 */
+
+ ztrmm_("Right", "Upper", "No transpose", "Unit", m, k, &c_b60,
+ &v[*n - *k + 1 + v_dim1], ldv, &work[work_offset],
+ ldwork);
+ if (*n > *k) {
+
+/* W := W + C1 * V1 */
+
+ i__1 = *n - *k;
+ zgemm_("No transpose", "No transpose", m, k, &i__1, &
+ c_b60, &c__[c_offset], ldc, &v[v_offset], ldv, &
+ c_b60, &work[work_offset], ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ ztrmm_("Right", "Lower", trans, "Non-unit", m, k, &c_b60, &t[
+ t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - W * V' */
+
+ if (*n > *k) {
+
+/* C1 := C1 - W * V1' */
+
+ i__1 = *n - *k;
+ z__1.r = -1., z__1.i = -0.;
+ zgemm_("No transpose", "Conjugate transpose", m, &i__1, k,
+ &z__1, &work[work_offset], ldwork, &v[v_offset],
+ ldv, &c_b60, &c__[c_offset], ldc);
+ }
+
+/* W := W * V2' */
+
+ ztrmm_("Right", "Upper", "Conjugate transpose", "Unit", m, k,
+ &c_b60, &v[*n - *k + 1 + v_dim1], ldv, &work[
+ work_offset], ldwork);
+
+/* C2 := C2 - W */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + (*n - *k + j) * c_dim1;
+ i__4 = i__ + (*n - *k + j) * c_dim1;
+ i__5 = i__ + j * work_dim1;
+ z__1.r = c__[i__4].r - work[i__5].r, z__1.i = c__[
+ i__4].i - work[i__5].i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L110: */
+ }
+/* L120: */
+ }
+ }
+ }
+
+ } else if (lsame_(storev, "R")) {
+
+ if (lsame_(direct, "F")) {
+
+/*
+ Let V = ( V1 V2 ) (V1: first K columns)
+ where V1 is unit upper triangular.
+*/
+
+ if (lsame_(side, "L")) {
+
+/*
+ Form H * C or H' * C where C = ( C1 )
+ ( C2 )
+
+ W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK)
+
+ W := C1'
+*/
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ zcopy_(n, &c__[j + c_dim1], ldc, &work[j * work_dim1 + 1],
+ &c__1);
+ zlacgv_(n, &work[j * work_dim1 + 1], &c__1);
+/* L130: */
+ }
+
+/* W := W * V1' */
+
+ ztrmm_("Right", "Upper", "Conjugate transpose", "Unit", n, k,
+ &c_b60, &v[v_offset], ldv, &work[work_offset], ldwork);
+ if (*m > *k) {
+
+/* W := W + C2'*V2' */
+
+ i__1 = *m - *k;
+ zgemm_("Conjugate transpose", "Conjugate transpose", n, k,
+ &i__1, &c_b60, &c__[*k + 1 + c_dim1], ldc, &v[(*
+ k + 1) * v_dim1 + 1], ldv, &c_b60, &work[
+ work_offset], ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ ztrmm_("Right", "Upper", transt, "Non-unit", n, k, &c_b60, &t[
+ t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - V' * W' */
+
+ if (*m > *k) {
+
+/* C2 := C2 - V2' * W' */
+
+ i__1 = *m - *k;
+ z__1.r = -1., z__1.i = -0.;
+ zgemm_("Conjugate transpose", "Conjugate transpose", &
+ i__1, n, k, &z__1, &v[(*k + 1) * v_dim1 + 1], ldv,
+ &work[work_offset], ldwork, &c_b60, &c__[*k + 1
+ + c_dim1], ldc);
+ }
+
+/* W := W * V1 */
+
+ ztrmm_("Right", "Upper", "No transpose", "Unit", n, k, &c_b60,
+ &v[v_offset], ldv, &work[work_offset], ldwork);
+
+/* C1 := C1 - W' */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = j + i__ * c_dim1;
+ i__4 = j + i__ * c_dim1;
+ d_cnjg(&z__2, &work[i__ + j * work_dim1]);
+ z__1.r = c__[i__4].r - z__2.r, z__1.i = c__[i__4].i -
+ z__2.i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L140: */
+ }
+/* L150: */
+ }
+
+ } else if (lsame_(side, "R")) {
+
+/*
+ Form C * H or C * H' where C = ( C1 C2 )
+
+ W := C * V' = (C1*V1' + C2*V2') (stored in WORK)
+
+ W := C1
+*/
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ zcopy_(m, &c__[j * c_dim1 + 1], &c__1, &work[j *
+ work_dim1 + 1], &c__1);
+/* L160: */
+ }
+
+/* W := W * V1' */
+
+ ztrmm_("Right", "Upper", "Conjugate transpose", "Unit", m, k,
+ &c_b60, &v[v_offset], ldv, &work[work_offset], ldwork);
+ if (*n > *k) {
+
+/* W := W + C2 * V2' */
+
+ i__1 = *n - *k;
+ zgemm_("No transpose", "Conjugate transpose", m, k, &i__1,
+ &c_b60, &c__[(*k + 1) * c_dim1 + 1], ldc, &v[(*k
+ + 1) * v_dim1 + 1], ldv, &c_b60, &work[
+ work_offset], ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ ztrmm_("Right", "Upper", trans, "Non-unit", m, k, &c_b60, &t[
+ t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - W * V */
+
+ if (*n > *k) {
+
+/* C2 := C2 - W * V2 */
+
+ i__1 = *n - *k;
+ z__1.r = -1., z__1.i = -0.;
+ zgemm_("No transpose", "No transpose", m, &i__1, k, &z__1,
+ &work[work_offset], ldwork, &v[(*k + 1) * v_dim1
+ + 1], ldv, &c_b60, &c__[(*k + 1) * c_dim1 + 1],
+ ldc);
+ }
+
+/* W := W * V1 */
+
+ ztrmm_("Right", "Upper", "No transpose", "Unit", m, k, &c_b60,
+ &v[v_offset], ldv, &work[work_offset], ldwork);
+
+/* C1 := C1 - W */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * c_dim1;
+ i__4 = i__ + j * c_dim1;
+ i__5 = i__ + j * work_dim1;
+ z__1.r = c__[i__4].r - work[i__5].r, z__1.i = c__[
+ i__4].i - work[i__5].i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L170: */
+ }
+/* L180: */
+ }
+
+ }
+
+ } else {
+
+/*
+ Let V = ( V1 V2 ) (V2: last K columns)
+ where V2 is unit lower triangular.
+*/
+
+ if (lsame_(side, "L")) {
+
+/*
+ Form H * C or H' * C where C = ( C1 )
+ ( C2 )
+
+ W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK)
+
+ W := C2'
+*/
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ zcopy_(n, &c__[*m - *k + j + c_dim1], ldc, &work[j *
+ work_dim1 + 1], &c__1);
+ zlacgv_(n, &work[j * work_dim1 + 1], &c__1);
+/* L190: */
+ }
+
+/* W := W * V2' */
+
+ ztrmm_("Right", "Lower", "Conjugate transpose", "Unit", n, k,
+ &c_b60, &v[(*m - *k + 1) * v_dim1 + 1], ldv, &work[
+ work_offset], ldwork);
+ if (*m > *k) {
+
+/* W := W + C1'*V1' */
+
+ i__1 = *m - *k;
+ zgemm_("Conjugate transpose", "Conjugate transpose", n, k,
+ &i__1, &c_b60, &c__[c_offset], ldc, &v[v_offset],
+ ldv, &c_b60, &work[work_offset], ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ ztrmm_("Right", "Lower", transt, "Non-unit", n, k, &c_b60, &t[
+ t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - V' * W' */
+
+ if (*m > *k) {
+
+/* C1 := C1 - V1' * W' */
+
+ i__1 = *m - *k;
+ z__1.r = -1., z__1.i = -0.;
+ zgemm_("Conjugate transpose", "Conjugate transpose", &
+ i__1, n, k, &z__1, &v[v_offset], ldv, &work[
+ work_offset], ldwork, &c_b60, &c__[c_offset], ldc);
+ }
+
+/* W := W * V2 */
+
+ ztrmm_("Right", "Lower", "No transpose", "Unit", n, k, &c_b60,
+ &v[(*m - *k + 1) * v_dim1 + 1], ldv, &work[
+ work_offset], ldwork);
+
+/* C2 := C2 - W' */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = *m - *k + j + i__ * c_dim1;
+ i__4 = *m - *k + j + i__ * c_dim1;
+ d_cnjg(&z__2, &work[i__ + j * work_dim1]);
+ z__1.r = c__[i__4].r - z__2.r, z__1.i = c__[i__4].i -
+ z__2.i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L200: */
+ }
+/* L210: */
+ }
+
+ } else if (lsame_(side, "R")) {
+
+/*
+ Form C * H or C * H' where C = ( C1 C2 )
+
+ W := C * V' = (C1*V1' + C2*V2') (stored in WORK)
+
+ W := C2
+*/
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ zcopy_(m, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &work[
+ j * work_dim1 + 1], &c__1);
+/* L220: */
+ }
+
+/* W := W * V2' */
+
+ ztrmm_("Right", "Lower", "Conjugate transpose", "Unit", m, k,
+ &c_b60, &v[(*n - *k + 1) * v_dim1 + 1], ldv, &work[
+ work_offset], ldwork);
+ if (*n > *k) {
+
+/* W := W + C1 * V1' */
+
+ i__1 = *n - *k;
+ zgemm_("No transpose", "Conjugate transpose", m, k, &i__1,
+ &c_b60, &c__[c_offset], ldc, &v[v_offset], ldv, &
+ c_b60, &work[work_offset], ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ ztrmm_("Right", "Lower", trans, "Non-unit", m, k, &c_b60, &t[
+ t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - W * V */
+
+ if (*n > *k) {
+
+/* C1 := C1 - W * V1 */
+
+ i__1 = *n - *k;
+ z__1.r = -1., z__1.i = -0.;
+ zgemm_("No transpose", "No transpose", m, &i__1, k, &z__1,
+ &work[work_offset], ldwork, &v[v_offset], ldv, &
+ c_b60, &c__[c_offset], ldc);
+ }
+
+/* W := W * V2 */
+
+ ztrmm_("Right", "Lower", "No transpose", "Unit", m, k, &c_b60,
+ &v[(*n - *k + 1) * v_dim1 + 1], ldv, &work[
+ work_offset], ldwork);
+
+/* C1 := C1 - W */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + (*n - *k + j) * c_dim1;
+ i__4 = i__ + (*n - *k + j) * c_dim1;
+ i__5 = i__ + j * work_dim1;
+ z__1.r = c__[i__4].r - work[i__5].r, z__1.i = c__[
+ i__4].i - work[i__5].i;
+ c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
+/* L230: */
+ }
+/* L240: */
+ }
+
+ }
+
+ }
+ }
+
+ return 0;
+
+/* End of ZLARFB */
+
+} /* zlarfb_ */
+
+/* Subroutine */ int zlarfg_(integer *n, doublecomplex *alpha, doublecomplex *
+ x, integer *incx, doublecomplex *tau)
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1, d__2;
+ doublecomplex z__1, z__2;
+
+ /* Builtin functions */
+ double d_imag(doublecomplex *), d_sign(doublereal *, doublereal *);
+
+ /* Local variables */
+ static integer j, knt;
+ static doublereal beta, alphi, alphr;
+ extern /* Subroutine */ int zscal_(integer *, doublecomplex *,
+ doublecomplex *, integer *);
+ static doublereal xnorm;
+ extern doublereal dlapy3_(doublereal *, doublereal *, doublereal *),
+ dznrm2_(integer *, doublecomplex *, integer *), dlamch_(char *);
+ static doublereal safmin;
+ extern /* Subroutine */ int zdscal_(integer *, doublereal *,
+ doublecomplex *, integer *);
+ static doublereal rsafmn;
+ extern /* Double Complex */ VOID zladiv_(doublecomplex *, doublecomplex *,
+ doublecomplex *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZLARFG generates a complex elementary reflector H of order n, such
+ that
+
+ H' * ( alpha ) = ( beta ), H' * H = I.
+ ( x ) ( 0 )
+
+ where alpha and beta are scalars, with beta real, and x is an
+ (n-1)-element complex vector. H is represented in the form
+
+ H = I - tau * ( 1 ) * ( 1 v' ) ,
+ ( v )
+
+ where tau is a complex scalar and v is a complex (n-1)-element
+ vector. Note that H is not hermitian.
+
+ If the elements of x are all zero and alpha is real, then tau = 0
+ and H is taken to be the unit matrix.
+
+ Otherwise 1 <= real(tau) <= 2 and abs(tau-1) <= 1 .
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the elementary reflector.
+
+ ALPHA (input/output) COMPLEX*16
+ On entry, the value alpha.
+ On exit, it is overwritten with the value beta.
+
+ X (input/output) COMPLEX*16 array, dimension
+ (1+(N-2)*abs(INCX))
+ On entry, the vector x.
+ On exit, it is overwritten with the vector v.
+
+ INCX (input) INTEGER
+ The increment between elements of X. INCX > 0.
+
+ TAU (output) COMPLEX*16
+ The value tau.
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ if (*n <= 0) {
+ tau->r = 0., tau->i = 0.;
+ return 0;
+ }
+
+ i__1 = *n - 1;
+ xnorm = dznrm2_(&i__1, &x[1], incx);
+ alphr = alpha->r;
+ alphi = d_imag(alpha);
+
+ if ((xnorm == 0. && alphi == 0.)) {
+
+/* H = I */
+
+ tau->r = 0., tau->i = 0.;
+ } else {
+
+/* general case */
+
+ d__1 = dlapy3_(&alphr, &alphi, &xnorm);
+ beta = -d_sign(&d__1, &alphr);
+ safmin = SAFEMINIMUM / EPSILON;
+ rsafmn = 1. / safmin;
+
+ if (abs(beta) < safmin) {
+
+/* XNORM, BETA may be inaccurate; scale X and recompute them */
+
+ knt = 0;
+L10:
+ ++knt;
+ i__1 = *n - 1;
+ zdscal_(&i__1, &rsafmn, &x[1], incx);
+ beta *= rsafmn;
+ alphi *= rsafmn;
+ alphr *= rsafmn;
+ if (abs(beta) < safmin) {
+ goto L10;
+ }
+
+/* New BETA is at most 1, at least SAFMIN */
+
+ i__1 = *n - 1;
+ xnorm = dznrm2_(&i__1, &x[1], incx);
+ z__1.r = alphr, z__1.i = alphi;
+ alpha->r = z__1.r, alpha->i = z__1.i;
+ d__1 = dlapy3_(&alphr, &alphi, &xnorm);
+ beta = -d_sign(&d__1, &alphr);
+ d__1 = (beta - alphr) / beta;
+ d__2 = -alphi / beta;
+ z__1.r = d__1, z__1.i = d__2;
+ tau->r = z__1.r, tau->i = z__1.i;
+ z__2.r = alpha->r - beta, z__2.i = alpha->i;
+ zladiv_(&z__1, &c_b60, &z__2);
+ alpha->r = z__1.r, alpha->i = z__1.i;
+ i__1 = *n - 1;
+ zscal_(&i__1, alpha, &x[1], incx);
+
+/* If ALPHA is subnormal, it may lose relative accuracy */
+
+ alpha->r = beta, alpha->i = 0.;
+ i__1 = knt;
+ for (j = 1; j <= i__1; ++j) {
+ z__1.r = safmin * alpha->r, z__1.i = safmin * alpha->i;
+ alpha->r = z__1.r, alpha->i = z__1.i;
+/* L20: */
+ }
+ } else {
+ d__1 = (beta - alphr) / beta;
+ d__2 = -alphi / beta;
+ z__1.r = d__1, z__1.i = d__2;
+ tau->r = z__1.r, tau->i = z__1.i;
+ z__2.r = alpha->r - beta, z__2.i = alpha->i;
+ zladiv_(&z__1, &c_b60, &z__2);
+ alpha->r = z__1.r, alpha->i = z__1.i;
+ i__1 = *n - 1;
+ zscal_(&i__1, alpha, &x[1], incx);
+ alpha->r = beta, alpha->i = 0.;
+ }
+ }
+
+ return 0;
+
+/* End of ZLARFG */
+
+} /* zlarfg_ */
+
+/* Subroutine */ int zlarft_(char *direct, char *storev, integer *n, integer *
+ k, doublecomplex *v, integer *ldv, doublecomplex *tau, doublecomplex *
+ t, integer *ldt)
+{
+ /* System generated locals */
+ integer t_dim1, t_offset, v_dim1, v_offset, i__1, i__2, i__3, i__4;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer i__, j;
+ static doublecomplex vii;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int zgemv_(char *, integer *, integer *,
+ doublecomplex *, doublecomplex *, integer *, doublecomplex *,
+ integer *, doublecomplex *, doublecomplex *, integer *),
+ ztrmv_(char *, char *, char *, integer *, doublecomplex *,
+ integer *, doublecomplex *, integer *),
+ zlacgv_(integer *, doublecomplex *, integer *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZLARFT forms the triangular factor T of a complex block reflector H
+ of order n, which is defined as a product of k elementary reflectors.
+
+ If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
+
+ If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
+
+ If STOREV = 'C', the vector which defines the elementary reflector
+ H(i) is stored in the i-th column of the array V, and
+
+ H = I - V * T * V'
+
+ If STOREV = 'R', the vector which defines the elementary reflector
+ H(i) is stored in the i-th row of the array V, and
+
+ H = I - V' * T * V
+
+ Arguments
+ =========
+
+ DIRECT (input) CHARACTER*1
+ Specifies the order in which the elementary reflectors are
+ multiplied to form the block reflector:
+ = 'F': H = H(1) H(2) . . . H(k) (Forward)
+ = 'B': H = H(k) . . . H(2) H(1) (Backward)
+
+ STOREV (input) CHARACTER*1
+ Specifies how the vectors which define the elementary
+ reflectors are stored (see also Further Details):
+ = 'C': columnwise
+ = 'R': rowwise
+
+ N (input) INTEGER
+ The order of the block reflector H. N >= 0.
+
+ K (input) INTEGER
+ The order of the triangular factor T (= the number of
+ elementary reflectors). K >= 1.
+
+ V (input/output) COMPLEX*16 array, dimension
+ (LDV,K) if STOREV = 'C'
+ (LDV,N) if STOREV = 'R'
+ The matrix V. See further details.
+
+ LDV (input) INTEGER
+ The leading dimension of the array V.
+ If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
+
+ TAU (input) COMPLEX*16 array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i).
+
+ T (output) COMPLEX*16 array, dimension (LDT,K)
+ The k by k triangular factor T of the block reflector.
+ If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is
+ lower triangular. The rest of the array is not used.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= K.
+
+ Further Details
+ ===============
+
+ The shape of the matrix V and the storage of the vectors which define
+ the H(i) is best illustrated by the following example with n = 5 and
+ k = 3. The elements equal to 1 are not stored; the corresponding
+ array elements are modified but restored on exit. The rest of the
+ array is not used.
+
+ DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
+
+ V = ( 1 ) V = ( 1 v1 v1 v1 v1 )
+ ( v1 1 ) ( 1 v2 v2 v2 )
+ ( v1 v2 1 ) ( 1 v3 v3 )
+ ( v1 v2 v3 )
+ ( v1 v2 v3 )
+
+ DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
+
+ V = ( v1 v2 v3 ) V = ( v1 v1 1 )
+ ( v1 v2 v3 ) ( v2 v2 v2 1 )
+ ( 1 v2 v3 ) ( v3 v3 v3 v3 1 )
+ ( 1 v3 )
+ ( 1 )
+
+ =====================================================================
+
+
+ Quick return if possible
+*/
+
+ /* Parameter adjustments */
+ v_dim1 = *ldv;
+ v_offset = 1 + v_dim1 * 1;
+ v -= v_offset;
+ --tau;
+ t_dim1 = *ldt;
+ t_offset = 1 + t_dim1 * 1;
+ t -= t_offset;
+
+ /* Function Body */
+ if (*n == 0) {
+ return 0;
+ }
+
+ if (lsame_(direct, "F")) {
+ i__1 = *k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ if ((tau[i__2].r == 0. && tau[i__2].i == 0.)) {
+
+/* H(i) = I */
+
+ i__2 = i__;
+ for (j = 1; j <= i__2; ++j) {
+ i__3 = j + i__ * t_dim1;
+ t[i__3].r = 0., t[i__3].i = 0.;
+/* L10: */
+ }
+ } else {
+
+/* general case */
+
+ i__2 = i__ + i__ * v_dim1;
+ vii.r = v[i__2].r, vii.i = v[i__2].i;
+ i__2 = i__ + i__ * v_dim1;
+ v[i__2].r = 1., v[i__2].i = 0.;
+ if (lsame_(storev, "C")) {
+
+/* T(1:i-1,i) := - tau(i) * V(i:n,1:i-1)' * V(i:n,i) */
+
+ i__2 = *n - i__ + 1;
+ i__3 = i__ - 1;
+ i__4 = i__;
+ z__1.r = -tau[i__4].r, z__1.i = -tau[i__4].i;
+ zgemv_("Conjugate transpose", &i__2, &i__3, &z__1, &v[i__
+ + v_dim1], ldv, &v[i__ + i__ * v_dim1], &c__1, &
+ c_b59, &t[i__ * t_dim1 + 1], &c__1);
+ } else {
+
+/* T(1:i-1,i) := - tau(i) * V(1:i-1,i:n) * V(i,i:n)' */
+
+ if (i__ < *n) {
+ i__2 = *n - i__;
+ zlacgv_(&i__2, &v[i__ + (i__ + 1) * v_dim1], ldv);
+ }
+ i__2 = i__ - 1;
+ i__3 = *n - i__ + 1;
+ i__4 = i__;
+ z__1.r = -tau[i__4].r, z__1.i = -tau[i__4].i;
+ zgemv_("No transpose", &i__2, &i__3, &z__1, &v[i__ *
+ v_dim1 + 1], ldv, &v[i__ + i__ * v_dim1], ldv, &
+ c_b59, &t[i__ * t_dim1 + 1], &c__1);
+ if (i__ < *n) {
+ i__2 = *n - i__;
+ zlacgv_(&i__2, &v[i__ + (i__ + 1) * v_dim1], ldv);
+ }
+ }
+ i__2 = i__ + i__ * v_dim1;
+ v[i__2].r = vii.r, v[i__2].i = vii.i;
+
+/* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) */
+
+ i__2 = i__ - 1;
+ ztrmv_("Upper", "No transpose", "Non-unit", &i__2, &t[
+ t_offset], ldt, &t[i__ * t_dim1 + 1], &c__1);
+ i__2 = i__ + i__ * t_dim1;
+ i__3 = i__;
+ t[i__2].r = tau[i__3].r, t[i__2].i = tau[i__3].i;
+ }
+/* L20: */
+ }
+ } else {
+ for (i__ = *k; i__ >= 1; --i__) {
+ i__1 = i__;
+ if ((tau[i__1].r == 0. && tau[i__1].i == 0.)) {
+
+/* H(i) = I */
+
+ i__1 = *k;
+ for (j = i__; j <= i__1; ++j) {
+ i__2 = j + i__ * t_dim1;
+ t[i__2].r = 0., t[i__2].i = 0.;
+/* L30: */
+ }
+ } else {
+
+/* general case */
+
+ if (i__ < *k) {
+ if (lsame_(storev, "C")) {
+ i__1 = *n - *k + i__ + i__ * v_dim1;
+ vii.r = v[i__1].r, vii.i = v[i__1].i;
+ i__1 = *n - *k + i__ + i__ * v_dim1;
+ v[i__1].r = 1., v[i__1].i = 0.;
+
+/*
+ T(i+1:k,i) :=
+ - tau(i) * V(1:n-k+i,i+1:k)' * V(1:n-k+i,i)
+*/
+
+ i__1 = *n - *k + i__;
+ i__2 = *k - i__;
+ i__3 = i__;
+ z__1.r = -tau[i__3].r, z__1.i = -tau[i__3].i;
+ zgemv_("Conjugate transpose", &i__1, &i__2, &z__1, &v[
+ (i__ + 1) * v_dim1 + 1], ldv, &v[i__ * v_dim1
+ + 1], &c__1, &c_b59, &t[i__ + 1 + i__ *
+ t_dim1], &c__1);
+ i__1 = *n - *k + i__ + i__ * v_dim1;
+ v[i__1].r = vii.r, v[i__1].i = vii.i;
+ } else {
+ i__1 = i__ + (*n - *k + i__) * v_dim1;
+ vii.r = v[i__1].r, vii.i = v[i__1].i;
+ i__1 = i__ + (*n - *k + i__) * v_dim1;
+ v[i__1].r = 1., v[i__1].i = 0.;
+
+/*
+ T(i+1:k,i) :=
+ - tau(i) * V(i+1:k,1:n-k+i) * V(i,1:n-k+i)'
+*/
+
+ i__1 = *n - *k + i__ - 1;
+ zlacgv_(&i__1, &v[i__ + v_dim1], ldv);
+ i__1 = *k - i__;
+ i__2 = *n - *k + i__;
+ i__3 = i__;
+ z__1.r = -tau[i__3].r, z__1.i = -tau[i__3].i;
+ zgemv_("No transpose", &i__1, &i__2, &z__1, &v[i__ +
+ 1 + v_dim1], ldv, &v[i__ + v_dim1], ldv, &
+ c_b59, &t[i__ + 1 + i__ * t_dim1], &c__1);
+ i__1 = *n - *k + i__ - 1;
+ zlacgv_(&i__1, &v[i__ + v_dim1], ldv);
+ i__1 = i__ + (*n - *k + i__) * v_dim1;
+ v[i__1].r = vii.r, v[i__1].i = vii.i;
+ }
+
+/* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) */
+
+ i__1 = *k - i__;
+ ztrmv_("Lower", "No transpose", "Non-unit", &i__1, &t[i__
+ + 1 + (i__ + 1) * t_dim1], ldt, &t[i__ + 1 + i__ *
+ t_dim1], &c__1)
+ ;
+ }
+ i__1 = i__ + i__ * t_dim1;
+ i__2 = i__;
+ t[i__1].r = tau[i__2].r, t[i__1].i = tau[i__2].i;
+ }
+/* L40: */
+ }
+ }
+ return 0;
+
+/* End of ZLARFT */
+
+} /* zlarft_ */
+
+/* Subroutine */ int zlarfx_(char *side, integer *m, integer *n,
+ doublecomplex *v, doublecomplex *tau, doublecomplex *c__, integer *
+ ldc, doublecomplex *work)
+{
+ /* System generated locals */
+ integer c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8,
+ i__9, i__10, i__11;
+ doublecomplex z__1, z__2, z__3, z__4, z__5, z__6, z__7, z__8, z__9, z__10,
+ z__11, z__12, z__13, z__14, z__15, z__16, z__17, z__18, z__19;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer j;
+ static doublecomplex t1, t2, t3, t4, t5, t6, t7, t8, t9, v1, v2, v3, v4,
+ v5, v6, v7, v8, v9, t10, v10, sum;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int zgerc_(integer *, integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *), zgemv_(char *, integer *, integer *,
+ doublecomplex *, doublecomplex *, integer *, doublecomplex *,
+ integer *, doublecomplex *, doublecomplex *, integer *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZLARFX applies a complex elementary reflector H to a complex m by n
+ matrix C, from either the left or the right. H is represented in the
+ form
+
+ H = I - tau * v * v'
+
+ where tau is a complex scalar and v is a complex vector.
+
+ If tau = 0, then H is taken to be the unit matrix
+
+ This version uses inline code if H has order < 11.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': form H * C
+ = 'R': form C * H
+
+ M (input) INTEGER
+ The number of rows of the matrix C.
+
+ N (input) INTEGER
+ The number of columns of the matrix C.
+
+ V (input) COMPLEX*16 array, dimension (M) if SIDE = 'L'
+ or (N) if SIDE = 'R'
+ The vector v in the representation of H.
+
+ TAU (input) COMPLEX*16
+ The value tau in the representation of H.
+
+ C (input/output) COMPLEX*16 array, dimension (LDC,N)
+ On entry, the m by n matrix C.
+ On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+ or C * H if SIDE = 'R'.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDA >= max(1,M).
+
+ WORK (workspace) COMPLEX*16 array, dimension (N) if SIDE = 'L'
+ or (M) if SIDE = 'R'
+ WORK is not referenced if H has order < 11.
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ --v;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ if ((tau->r == 0. && tau->i == 0.)) {
+ return 0;
+ }
+ if (lsame_(side, "L")) {
+
+/* Form H * C, where H has order m. */
+
+ switch (*m) {
+ case 1: goto L10;
+ case 2: goto L30;
+ case 3: goto L50;
+ case 4: goto L70;
+ case 5: goto L90;
+ case 6: goto L110;
+ case 7: goto L130;
+ case 8: goto L150;
+ case 9: goto L170;
+ case 10: goto L190;
+ }
+
+/*
+ Code for general M
+
+ w := C'*v
+*/
+
+ zgemv_("Conjugate transpose", m, n, &c_b60, &c__[c_offset], ldc, &v[1]
+ , &c__1, &c_b59, &work[1], &c__1);
+
+/* C := C - tau * v * w' */
+
+ z__1.r = -tau->r, z__1.i = -tau->i;
+ zgerc_(m, n, &z__1, &v[1], &c__1, &work[1], &c__1, &c__[c_offset],
+ ldc);
+ goto L410;
+L10:
+
+/* Special code for 1 x 1 Householder */
+
+ z__3.r = tau->r * v[1].r - tau->i * v[1].i, z__3.i = tau->r * v[1].i
+ + tau->i * v[1].r;
+ d_cnjg(&z__4, &v[1]);
+ z__2.r = z__3.r * z__4.r - z__3.i * z__4.i, z__2.i = z__3.r * z__4.i
+ + z__3.i * z__4.r;
+ z__1.r = 1. - z__2.r, z__1.i = 0. - z__2.i;
+ t1.r = z__1.r, t1.i = z__1.i;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j * c_dim1 + 1;
+ i__3 = j * c_dim1 + 1;
+ z__1.r = t1.r * c__[i__3].r - t1.i * c__[i__3].i, z__1.i = t1.r *
+ c__[i__3].i + t1.i * c__[i__3].r;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L20: */
+ }
+ goto L410;
+L30:
+
+/* Special code for 2 x 2 Householder */
+
+ d_cnjg(&z__1, &v[1]);
+ v1.r = z__1.r, v1.i = z__1.i;
+ d_cnjg(&z__2, &v1);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t1.r = z__1.r, t1.i = z__1.i;
+ d_cnjg(&z__1, &v[2]);
+ v2.r = z__1.r, v2.i = z__1.i;
+ d_cnjg(&z__2, &v2);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t2.r = z__1.r, t2.i = z__1.i;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j * c_dim1 + 1;
+ z__2.r = v1.r * c__[i__2].r - v1.i * c__[i__2].i, z__2.i = v1.r *
+ c__[i__2].i + v1.i * c__[i__2].r;
+ i__3 = j * c_dim1 + 2;
+ z__3.r = v2.r * c__[i__3].r - v2.i * c__[i__3].i, z__3.i = v2.r *
+ c__[i__3].i + v2.i * c__[i__3].r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__2 = j * c_dim1 + 1;
+ i__3 = j * c_dim1 + 1;
+ z__2.r = sum.r * t1.r - sum.i * t1.i, z__2.i = sum.r * t1.i +
+ sum.i * t1.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 2;
+ i__3 = j * c_dim1 + 2;
+ z__2.r = sum.r * t2.r - sum.i * t2.i, z__2.i = sum.r * t2.i +
+ sum.i * t2.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L40: */
+ }
+ goto L410;
+L50:
+
+/* Special code for 3 x 3 Householder */
+
+ d_cnjg(&z__1, &v[1]);
+ v1.r = z__1.r, v1.i = z__1.i;
+ d_cnjg(&z__2, &v1);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t1.r = z__1.r, t1.i = z__1.i;
+ d_cnjg(&z__1, &v[2]);
+ v2.r = z__1.r, v2.i = z__1.i;
+ d_cnjg(&z__2, &v2);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t2.r = z__1.r, t2.i = z__1.i;
+ d_cnjg(&z__1, &v[3]);
+ v3.r = z__1.r, v3.i = z__1.i;
+ d_cnjg(&z__2, &v3);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t3.r = z__1.r, t3.i = z__1.i;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j * c_dim1 + 1;
+ z__3.r = v1.r * c__[i__2].r - v1.i * c__[i__2].i, z__3.i = v1.r *
+ c__[i__2].i + v1.i * c__[i__2].r;
+ i__3 = j * c_dim1 + 2;
+ z__4.r = v2.r * c__[i__3].r - v2.i * c__[i__3].i, z__4.i = v2.r *
+ c__[i__3].i + v2.i * c__[i__3].r;
+ z__2.r = z__3.r + z__4.r, z__2.i = z__3.i + z__4.i;
+ i__4 = j * c_dim1 + 3;
+ z__5.r = v3.r * c__[i__4].r - v3.i * c__[i__4].i, z__5.i = v3.r *
+ c__[i__4].i + v3.i * c__[i__4].r;
+ z__1.r = z__2.r + z__5.r, z__1.i = z__2.i + z__5.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__2 = j * c_dim1 + 1;
+ i__3 = j * c_dim1 + 1;
+ z__2.r = sum.r * t1.r - sum.i * t1.i, z__2.i = sum.r * t1.i +
+ sum.i * t1.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 2;
+ i__3 = j * c_dim1 + 2;
+ z__2.r = sum.r * t2.r - sum.i * t2.i, z__2.i = sum.r * t2.i +
+ sum.i * t2.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 3;
+ i__3 = j * c_dim1 + 3;
+ z__2.r = sum.r * t3.r - sum.i * t3.i, z__2.i = sum.r * t3.i +
+ sum.i * t3.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L60: */
+ }
+ goto L410;
+L70:
+
+/* Special code for 4 x 4 Householder */
+
+ d_cnjg(&z__1, &v[1]);
+ v1.r = z__1.r, v1.i = z__1.i;
+ d_cnjg(&z__2, &v1);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t1.r = z__1.r, t1.i = z__1.i;
+ d_cnjg(&z__1, &v[2]);
+ v2.r = z__1.r, v2.i = z__1.i;
+ d_cnjg(&z__2, &v2);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t2.r = z__1.r, t2.i = z__1.i;
+ d_cnjg(&z__1, &v[3]);
+ v3.r = z__1.r, v3.i = z__1.i;
+ d_cnjg(&z__2, &v3);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t3.r = z__1.r, t3.i = z__1.i;
+ d_cnjg(&z__1, &v[4]);
+ v4.r = z__1.r, v4.i = z__1.i;
+ d_cnjg(&z__2, &v4);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t4.r = z__1.r, t4.i = z__1.i;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j * c_dim1 + 1;
+ z__4.r = v1.r * c__[i__2].r - v1.i * c__[i__2].i, z__4.i = v1.r *
+ c__[i__2].i + v1.i * c__[i__2].r;
+ i__3 = j * c_dim1 + 2;
+ z__5.r = v2.r * c__[i__3].r - v2.i * c__[i__3].i, z__5.i = v2.r *
+ c__[i__3].i + v2.i * c__[i__3].r;
+ z__3.r = z__4.r + z__5.r, z__3.i = z__4.i + z__5.i;
+ i__4 = j * c_dim1 + 3;
+ z__6.r = v3.r * c__[i__4].r - v3.i * c__[i__4].i, z__6.i = v3.r *
+ c__[i__4].i + v3.i * c__[i__4].r;
+ z__2.r = z__3.r + z__6.r, z__2.i = z__3.i + z__6.i;
+ i__5 = j * c_dim1 + 4;
+ z__7.r = v4.r * c__[i__5].r - v4.i * c__[i__5].i, z__7.i = v4.r *
+ c__[i__5].i + v4.i * c__[i__5].r;
+ z__1.r = z__2.r + z__7.r, z__1.i = z__2.i + z__7.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__2 = j * c_dim1 + 1;
+ i__3 = j * c_dim1 + 1;
+ z__2.r = sum.r * t1.r - sum.i * t1.i, z__2.i = sum.r * t1.i +
+ sum.i * t1.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 2;
+ i__3 = j * c_dim1 + 2;
+ z__2.r = sum.r * t2.r - sum.i * t2.i, z__2.i = sum.r * t2.i +
+ sum.i * t2.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 3;
+ i__3 = j * c_dim1 + 3;
+ z__2.r = sum.r * t3.r - sum.i * t3.i, z__2.i = sum.r * t3.i +
+ sum.i * t3.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 4;
+ i__3 = j * c_dim1 + 4;
+ z__2.r = sum.r * t4.r - sum.i * t4.i, z__2.i = sum.r * t4.i +
+ sum.i * t4.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L80: */
+ }
+ goto L410;
+L90:
+
+/* Special code for 5 x 5 Householder */
+
+ d_cnjg(&z__1, &v[1]);
+ v1.r = z__1.r, v1.i = z__1.i;
+ d_cnjg(&z__2, &v1);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t1.r = z__1.r, t1.i = z__1.i;
+ d_cnjg(&z__1, &v[2]);
+ v2.r = z__1.r, v2.i = z__1.i;
+ d_cnjg(&z__2, &v2);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t2.r = z__1.r, t2.i = z__1.i;
+ d_cnjg(&z__1, &v[3]);
+ v3.r = z__1.r, v3.i = z__1.i;
+ d_cnjg(&z__2, &v3);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t3.r = z__1.r, t3.i = z__1.i;
+ d_cnjg(&z__1, &v[4]);
+ v4.r = z__1.r, v4.i = z__1.i;
+ d_cnjg(&z__2, &v4);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t4.r = z__1.r, t4.i = z__1.i;
+ d_cnjg(&z__1, &v[5]);
+ v5.r = z__1.r, v5.i = z__1.i;
+ d_cnjg(&z__2, &v5);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t5.r = z__1.r, t5.i = z__1.i;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j * c_dim1 + 1;
+ z__5.r = v1.r * c__[i__2].r - v1.i * c__[i__2].i, z__5.i = v1.r *
+ c__[i__2].i + v1.i * c__[i__2].r;
+ i__3 = j * c_dim1 + 2;
+ z__6.r = v2.r * c__[i__3].r - v2.i * c__[i__3].i, z__6.i = v2.r *
+ c__[i__3].i + v2.i * c__[i__3].r;
+ z__4.r = z__5.r + z__6.r, z__4.i = z__5.i + z__6.i;
+ i__4 = j * c_dim1 + 3;
+ z__7.r = v3.r * c__[i__4].r - v3.i * c__[i__4].i, z__7.i = v3.r *
+ c__[i__4].i + v3.i * c__[i__4].r;
+ z__3.r = z__4.r + z__7.r, z__3.i = z__4.i + z__7.i;
+ i__5 = j * c_dim1 + 4;
+ z__8.r = v4.r * c__[i__5].r - v4.i * c__[i__5].i, z__8.i = v4.r *
+ c__[i__5].i + v4.i * c__[i__5].r;
+ z__2.r = z__3.r + z__8.r, z__2.i = z__3.i + z__8.i;
+ i__6 = j * c_dim1 + 5;
+ z__9.r = v5.r * c__[i__6].r - v5.i * c__[i__6].i, z__9.i = v5.r *
+ c__[i__6].i + v5.i * c__[i__6].r;
+ z__1.r = z__2.r + z__9.r, z__1.i = z__2.i + z__9.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__2 = j * c_dim1 + 1;
+ i__3 = j * c_dim1 + 1;
+ z__2.r = sum.r * t1.r - sum.i * t1.i, z__2.i = sum.r * t1.i +
+ sum.i * t1.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 2;
+ i__3 = j * c_dim1 + 2;
+ z__2.r = sum.r * t2.r - sum.i * t2.i, z__2.i = sum.r * t2.i +
+ sum.i * t2.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 3;
+ i__3 = j * c_dim1 + 3;
+ z__2.r = sum.r * t3.r - sum.i * t3.i, z__2.i = sum.r * t3.i +
+ sum.i * t3.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 4;
+ i__3 = j * c_dim1 + 4;
+ z__2.r = sum.r * t4.r - sum.i * t4.i, z__2.i = sum.r * t4.i +
+ sum.i * t4.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 5;
+ i__3 = j * c_dim1 + 5;
+ z__2.r = sum.r * t5.r - sum.i * t5.i, z__2.i = sum.r * t5.i +
+ sum.i * t5.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L100: */
+ }
+ goto L410;
+L110:
+
+/* Special code for 6 x 6 Householder */
+
+ d_cnjg(&z__1, &v[1]);
+ v1.r = z__1.r, v1.i = z__1.i;
+ d_cnjg(&z__2, &v1);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t1.r = z__1.r, t1.i = z__1.i;
+ d_cnjg(&z__1, &v[2]);
+ v2.r = z__1.r, v2.i = z__1.i;
+ d_cnjg(&z__2, &v2);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t2.r = z__1.r, t2.i = z__1.i;
+ d_cnjg(&z__1, &v[3]);
+ v3.r = z__1.r, v3.i = z__1.i;
+ d_cnjg(&z__2, &v3);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t3.r = z__1.r, t3.i = z__1.i;
+ d_cnjg(&z__1, &v[4]);
+ v4.r = z__1.r, v4.i = z__1.i;
+ d_cnjg(&z__2, &v4);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t4.r = z__1.r, t4.i = z__1.i;
+ d_cnjg(&z__1, &v[5]);
+ v5.r = z__1.r, v5.i = z__1.i;
+ d_cnjg(&z__2, &v5);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t5.r = z__1.r, t5.i = z__1.i;
+ d_cnjg(&z__1, &v[6]);
+ v6.r = z__1.r, v6.i = z__1.i;
+ d_cnjg(&z__2, &v6);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t6.r = z__1.r, t6.i = z__1.i;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j * c_dim1 + 1;
+ z__6.r = v1.r * c__[i__2].r - v1.i * c__[i__2].i, z__6.i = v1.r *
+ c__[i__2].i + v1.i * c__[i__2].r;
+ i__3 = j * c_dim1 + 2;
+ z__7.r = v2.r * c__[i__3].r - v2.i * c__[i__3].i, z__7.i = v2.r *
+ c__[i__3].i + v2.i * c__[i__3].r;
+ z__5.r = z__6.r + z__7.r, z__5.i = z__6.i + z__7.i;
+ i__4 = j * c_dim1 + 3;
+ z__8.r = v3.r * c__[i__4].r - v3.i * c__[i__4].i, z__8.i = v3.r *
+ c__[i__4].i + v3.i * c__[i__4].r;
+ z__4.r = z__5.r + z__8.r, z__4.i = z__5.i + z__8.i;
+ i__5 = j * c_dim1 + 4;
+ z__9.r = v4.r * c__[i__5].r - v4.i * c__[i__5].i, z__9.i = v4.r *
+ c__[i__5].i + v4.i * c__[i__5].r;
+ z__3.r = z__4.r + z__9.r, z__3.i = z__4.i + z__9.i;
+ i__6 = j * c_dim1 + 5;
+ z__10.r = v5.r * c__[i__6].r - v5.i * c__[i__6].i, z__10.i = v5.r
+ * c__[i__6].i + v5.i * c__[i__6].r;
+ z__2.r = z__3.r + z__10.r, z__2.i = z__3.i + z__10.i;
+ i__7 = j * c_dim1 + 6;
+ z__11.r = v6.r * c__[i__7].r - v6.i * c__[i__7].i, z__11.i = v6.r
+ * c__[i__7].i + v6.i * c__[i__7].r;
+ z__1.r = z__2.r + z__11.r, z__1.i = z__2.i + z__11.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__2 = j * c_dim1 + 1;
+ i__3 = j * c_dim1 + 1;
+ z__2.r = sum.r * t1.r - sum.i * t1.i, z__2.i = sum.r * t1.i +
+ sum.i * t1.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 2;
+ i__3 = j * c_dim1 + 2;
+ z__2.r = sum.r * t2.r - sum.i * t2.i, z__2.i = sum.r * t2.i +
+ sum.i * t2.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 3;
+ i__3 = j * c_dim1 + 3;
+ z__2.r = sum.r * t3.r - sum.i * t3.i, z__2.i = sum.r * t3.i +
+ sum.i * t3.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 4;
+ i__3 = j * c_dim1 + 4;
+ z__2.r = sum.r * t4.r - sum.i * t4.i, z__2.i = sum.r * t4.i +
+ sum.i * t4.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 5;
+ i__3 = j * c_dim1 + 5;
+ z__2.r = sum.r * t5.r - sum.i * t5.i, z__2.i = sum.r * t5.i +
+ sum.i * t5.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 6;
+ i__3 = j * c_dim1 + 6;
+ z__2.r = sum.r * t6.r - sum.i * t6.i, z__2.i = sum.r * t6.i +
+ sum.i * t6.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L120: */
+ }
+ goto L410;
+L130:
+
+/* Special code for 7 x 7 Householder */
+
+ d_cnjg(&z__1, &v[1]);
+ v1.r = z__1.r, v1.i = z__1.i;
+ d_cnjg(&z__2, &v1);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t1.r = z__1.r, t1.i = z__1.i;
+ d_cnjg(&z__1, &v[2]);
+ v2.r = z__1.r, v2.i = z__1.i;
+ d_cnjg(&z__2, &v2);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t2.r = z__1.r, t2.i = z__1.i;
+ d_cnjg(&z__1, &v[3]);
+ v3.r = z__1.r, v3.i = z__1.i;
+ d_cnjg(&z__2, &v3);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t3.r = z__1.r, t3.i = z__1.i;
+ d_cnjg(&z__1, &v[4]);
+ v4.r = z__1.r, v4.i = z__1.i;
+ d_cnjg(&z__2, &v4);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t4.r = z__1.r, t4.i = z__1.i;
+ d_cnjg(&z__1, &v[5]);
+ v5.r = z__1.r, v5.i = z__1.i;
+ d_cnjg(&z__2, &v5);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t5.r = z__1.r, t5.i = z__1.i;
+ d_cnjg(&z__1, &v[6]);
+ v6.r = z__1.r, v6.i = z__1.i;
+ d_cnjg(&z__2, &v6);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t6.r = z__1.r, t6.i = z__1.i;
+ d_cnjg(&z__1, &v[7]);
+ v7.r = z__1.r, v7.i = z__1.i;
+ d_cnjg(&z__2, &v7);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t7.r = z__1.r, t7.i = z__1.i;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j * c_dim1 + 1;
+ z__7.r = v1.r * c__[i__2].r - v1.i * c__[i__2].i, z__7.i = v1.r *
+ c__[i__2].i + v1.i * c__[i__2].r;
+ i__3 = j * c_dim1 + 2;
+ z__8.r = v2.r * c__[i__3].r - v2.i * c__[i__3].i, z__8.i = v2.r *
+ c__[i__3].i + v2.i * c__[i__3].r;
+ z__6.r = z__7.r + z__8.r, z__6.i = z__7.i + z__8.i;
+ i__4 = j * c_dim1 + 3;
+ z__9.r = v3.r * c__[i__4].r - v3.i * c__[i__4].i, z__9.i = v3.r *
+ c__[i__4].i + v3.i * c__[i__4].r;
+ z__5.r = z__6.r + z__9.r, z__5.i = z__6.i + z__9.i;
+ i__5 = j * c_dim1 + 4;
+ z__10.r = v4.r * c__[i__5].r - v4.i * c__[i__5].i, z__10.i = v4.r
+ * c__[i__5].i + v4.i * c__[i__5].r;
+ z__4.r = z__5.r + z__10.r, z__4.i = z__5.i + z__10.i;
+ i__6 = j * c_dim1 + 5;
+ z__11.r = v5.r * c__[i__6].r - v5.i * c__[i__6].i, z__11.i = v5.r
+ * c__[i__6].i + v5.i * c__[i__6].r;
+ z__3.r = z__4.r + z__11.r, z__3.i = z__4.i + z__11.i;
+ i__7 = j * c_dim1 + 6;
+ z__12.r = v6.r * c__[i__7].r - v6.i * c__[i__7].i, z__12.i = v6.r
+ * c__[i__7].i + v6.i * c__[i__7].r;
+ z__2.r = z__3.r + z__12.r, z__2.i = z__3.i + z__12.i;
+ i__8 = j * c_dim1 + 7;
+ z__13.r = v7.r * c__[i__8].r - v7.i * c__[i__8].i, z__13.i = v7.r
+ * c__[i__8].i + v7.i * c__[i__8].r;
+ z__1.r = z__2.r + z__13.r, z__1.i = z__2.i + z__13.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__2 = j * c_dim1 + 1;
+ i__3 = j * c_dim1 + 1;
+ z__2.r = sum.r * t1.r - sum.i * t1.i, z__2.i = sum.r * t1.i +
+ sum.i * t1.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 2;
+ i__3 = j * c_dim1 + 2;
+ z__2.r = sum.r * t2.r - sum.i * t2.i, z__2.i = sum.r * t2.i +
+ sum.i * t2.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 3;
+ i__3 = j * c_dim1 + 3;
+ z__2.r = sum.r * t3.r - sum.i * t3.i, z__2.i = sum.r * t3.i +
+ sum.i * t3.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 4;
+ i__3 = j * c_dim1 + 4;
+ z__2.r = sum.r * t4.r - sum.i * t4.i, z__2.i = sum.r * t4.i +
+ sum.i * t4.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 5;
+ i__3 = j * c_dim1 + 5;
+ z__2.r = sum.r * t5.r - sum.i * t5.i, z__2.i = sum.r * t5.i +
+ sum.i * t5.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 6;
+ i__3 = j * c_dim1 + 6;
+ z__2.r = sum.r * t6.r - sum.i * t6.i, z__2.i = sum.r * t6.i +
+ sum.i * t6.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 7;
+ i__3 = j * c_dim1 + 7;
+ z__2.r = sum.r * t7.r - sum.i * t7.i, z__2.i = sum.r * t7.i +
+ sum.i * t7.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L140: */
+ }
+ goto L410;
+L150:
+
+/* Special code for 8 x 8 Householder */
+
+ d_cnjg(&z__1, &v[1]);
+ v1.r = z__1.r, v1.i = z__1.i;
+ d_cnjg(&z__2, &v1);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t1.r = z__1.r, t1.i = z__1.i;
+ d_cnjg(&z__1, &v[2]);
+ v2.r = z__1.r, v2.i = z__1.i;
+ d_cnjg(&z__2, &v2);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t2.r = z__1.r, t2.i = z__1.i;
+ d_cnjg(&z__1, &v[3]);
+ v3.r = z__1.r, v3.i = z__1.i;
+ d_cnjg(&z__2, &v3);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t3.r = z__1.r, t3.i = z__1.i;
+ d_cnjg(&z__1, &v[4]);
+ v4.r = z__1.r, v4.i = z__1.i;
+ d_cnjg(&z__2, &v4);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t4.r = z__1.r, t4.i = z__1.i;
+ d_cnjg(&z__1, &v[5]);
+ v5.r = z__1.r, v5.i = z__1.i;
+ d_cnjg(&z__2, &v5);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t5.r = z__1.r, t5.i = z__1.i;
+ d_cnjg(&z__1, &v[6]);
+ v6.r = z__1.r, v6.i = z__1.i;
+ d_cnjg(&z__2, &v6);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t6.r = z__1.r, t6.i = z__1.i;
+ d_cnjg(&z__1, &v[7]);
+ v7.r = z__1.r, v7.i = z__1.i;
+ d_cnjg(&z__2, &v7);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t7.r = z__1.r, t7.i = z__1.i;
+ d_cnjg(&z__1, &v[8]);
+ v8.r = z__1.r, v8.i = z__1.i;
+ d_cnjg(&z__2, &v8);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t8.r = z__1.r, t8.i = z__1.i;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j * c_dim1 + 1;
+ z__8.r = v1.r * c__[i__2].r - v1.i * c__[i__2].i, z__8.i = v1.r *
+ c__[i__2].i + v1.i * c__[i__2].r;
+ i__3 = j * c_dim1 + 2;
+ z__9.r = v2.r * c__[i__3].r - v2.i * c__[i__3].i, z__9.i = v2.r *
+ c__[i__3].i + v2.i * c__[i__3].r;
+ z__7.r = z__8.r + z__9.r, z__7.i = z__8.i + z__9.i;
+ i__4 = j * c_dim1 + 3;
+ z__10.r = v3.r * c__[i__4].r - v3.i * c__[i__4].i, z__10.i = v3.r
+ * c__[i__4].i + v3.i * c__[i__4].r;
+ z__6.r = z__7.r + z__10.r, z__6.i = z__7.i + z__10.i;
+ i__5 = j * c_dim1 + 4;
+ z__11.r = v4.r * c__[i__5].r - v4.i * c__[i__5].i, z__11.i = v4.r
+ * c__[i__5].i + v4.i * c__[i__5].r;
+ z__5.r = z__6.r + z__11.r, z__5.i = z__6.i + z__11.i;
+ i__6 = j * c_dim1 + 5;
+ z__12.r = v5.r * c__[i__6].r - v5.i * c__[i__6].i, z__12.i = v5.r
+ * c__[i__6].i + v5.i * c__[i__6].r;
+ z__4.r = z__5.r + z__12.r, z__4.i = z__5.i + z__12.i;
+ i__7 = j * c_dim1 + 6;
+ z__13.r = v6.r * c__[i__7].r - v6.i * c__[i__7].i, z__13.i = v6.r
+ * c__[i__7].i + v6.i * c__[i__7].r;
+ z__3.r = z__4.r + z__13.r, z__3.i = z__4.i + z__13.i;
+ i__8 = j * c_dim1 + 7;
+ z__14.r = v7.r * c__[i__8].r - v7.i * c__[i__8].i, z__14.i = v7.r
+ * c__[i__8].i + v7.i * c__[i__8].r;
+ z__2.r = z__3.r + z__14.r, z__2.i = z__3.i + z__14.i;
+ i__9 = j * c_dim1 + 8;
+ z__15.r = v8.r * c__[i__9].r - v8.i * c__[i__9].i, z__15.i = v8.r
+ * c__[i__9].i + v8.i * c__[i__9].r;
+ z__1.r = z__2.r + z__15.r, z__1.i = z__2.i + z__15.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__2 = j * c_dim1 + 1;
+ i__3 = j * c_dim1 + 1;
+ z__2.r = sum.r * t1.r - sum.i * t1.i, z__2.i = sum.r * t1.i +
+ sum.i * t1.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 2;
+ i__3 = j * c_dim1 + 2;
+ z__2.r = sum.r * t2.r - sum.i * t2.i, z__2.i = sum.r * t2.i +
+ sum.i * t2.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 3;
+ i__3 = j * c_dim1 + 3;
+ z__2.r = sum.r * t3.r - sum.i * t3.i, z__2.i = sum.r * t3.i +
+ sum.i * t3.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 4;
+ i__3 = j * c_dim1 + 4;
+ z__2.r = sum.r * t4.r - sum.i * t4.i, z__2.i = sum.r * t4.i +
+ sum.i * t4.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 5;
+ i__3 = j * c_dim1 + 5;
+ z__2.r = sum.r * t5.r - sum.i * t5.i, z__2.i = sum.r * t5.i +
+ sum.i * t5.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 6;
+ i__3 = j * c_dim1 + 6;
+ z__2.r = sum.r * t6.r - sum.i * t6.i, z__2.i = sum.r * t6.i +
+ sum.i * t6.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 7;
+ i__3 = j * c_dim1 + 7;
+ z__2.r = sum.r * t7.r - sum.i * t7.i, z__2.i = sum.r * t7.i +
+ sum.i * t7.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 8;
+ i__3 = j * c_dim1 + 8;
+ z__2.r = sum.r * t8.r - sum.i * t8.i, z__2.i = sum.r * t8.i +
+ sum.i * t8.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L160: */
+ }
+ goto L410;
+L170:
+
+/* Special code for 9 x 9 Householder */
+
+ d_cnjg(&z__1, &v[1]);
+ v1.r = z__1.r, v1.i = z__1.i;
+ d_cnjg(&z__2, &v1);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t1.r = z__1.r, t1.i = z__1.i;
+ d_cnjg(&z__1, &v[2]);
+ v2.r = z__1.r, v2.i = z__1.i;
+ d_cnjg(&z__2, &v2);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t2.r = z__1.r, t2.i = z__1.i;
+ d_cnjg(&z__1, &v[3]);
+ v3.r = z__1.r, v3.i = z__1.i;
+ d_cnjg(&z__2, &v3);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t3.r = z__1.r, t3.i = z__1.i;
+ d_cnjg(&z__1, &v[4]);
+ v4.r = z__1.r, v4.i = z__1.i;
+ d_cnjg(&z__2, &v4);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t4.r = z__1.r, t4.i = z__1.i;
+ d_cnjg(&z__1, &v[5]);
+ v5.r = z__1.r, v5.i = z__1.i;
+ d_cnjg(&z__2, &v5);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t5.r = z__1.r, t5.i = z__1.i;
+ d_cnjg(&z__1, &v[6]);
+ v6.r = z__1.r, v6.i = z__1.i;
+ d_cnjg(&z__2, &v6);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t6.r = z__1.r, t6.i = z__1.i;
+ d_cnjg(&z__1, &v[7]);
+ v7.r = z__1.r, v7.i = z__1.i;
+ d_cnjg(&z__2, &v7);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t7.r = z__1.r, t7.i = z__1.i;
+ d_cnjg(&z__1, &v[8]);
+ v8.r = z__1.r, v8.i = z__1.i;
+ d_cnjg(&z__2, &v8);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t8.r = z__1.r, t8.i = z__1.i;
+ d_cnjg(&z__1, &v[9]);
+ v9.r = z__1.r, v9.i = z__1.i;
+ d_cnjg(&z__2, &v9);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t9.r = z__1.r, t9.i = z__1.i;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j * c_dim1 + 1;
+ z__9.r = v1.r * c__[i__2].r - v1.i * c__[i__2].i, z__9.i = v1.r *
+ c__[i__2].i + v1.i * c__[i__2].r;
+ i__3 = j * c_dim1 + 2;
+ z__10.r = v2.r * c__[i__3].r - v2.i * c__[i__3].i, z__10.i = v2.r
+ * c__[i__3].i + v2.i * c__[i__3].r;
+ z__8.r = z__9.r + z__10.r, z__8.i = z__9.i + z__10.i;
+ i__4 = j * c_dim1 + 3;
+ z__11.r = v3.r * c__[i__4].r - v3.i * c__[i__4].i, z__11.i = v3.r
+ * c__[i__4].i + v3.i * c__[i__4].r;
+ z__7.r = z__8.r + z__11.r, z__7.i = z__8.i + z__11.i;
+ i__5 = j * c_dim1 + 4;
+ z__12.r = v4.r * c__[i__5].r - v4.i * c__[i__5].i, z__12.i = v4.r
+ * c__[i__5].i + v4.i * c__[i__5].r;
+ z__6.r = z__7.r + z__12.r, z__6.i = z__7.i + z__12.i;
+ i__6 = j * c_dim1 + 5;
+ z__13.r = v5.r * c__[i__6].r - v5.i * c__[i__6].i, z__13.i = v5.r
+ * c__[i__6].i + v5.i * c__[i__6].r;
+ z__5.r = z__6.r + z__13.r, z__5.i = z__6.i + z__13.i;
+ i__7 = j * c_dim1 + 6;
+ z__14.r = v6.r * c__[i__7].r - v6.i * c__[i__7].i, z__14.i = v6.r
+ * c__[i__7].i + v6.i * c__[i__7].r;
+ z__4.r = z__5.r + z__14.r, z__4.i = z__5.i + z__14.i;
+ i__8 = j * c_dim1 + 7;
+ z__15.r = v7.r * c__[i__8].r - v7.i * c__[i__8].i, z__15.i = v7.r
+ * c__[i__8].i + v7.i * c__[i__8].r;
+ z__3.r = z__4.r + z__15.r, z__3.i = z__4.i + z__15.i;
+ i__9 = j * c_dim1 + 8;
+ z__16.r = v8.r * c__[i__9].r - v8.i * c__[i__9].i, z__16.i = v8.r
+ * c__[i__9].i + v8.i * c__[i__9].r;
+ z__2.r = z__3.r + z__16.r, z__2.i = z__3.i + z__16.i;
+ i__10 = j * c_dim1 + 9;
+ z__17.r = v9.r * c__[i__10].r - v9.i * c__[i__10].i, z__17.i =
+ v9.r * c__[i__10].i + v9.i * c__[i__10].r;
+ z__1.r = z__2.r + z__17.r, z__1.i = z__2.i + z__17.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__2 = j * c_dim1 + 1;
+ i__3 = j * c_dim1 + 1;
+ z__2.r = sum.r * t1.r - sum.i * t1.i, z__2.i = sum.r * t1.i +
+ sum.i * t1.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 2;
+ i__3 = j * c_dim1 + 2;
+ z__2.r = sum.r * t2.r - sum.i * t2.i, z__2.i = sum.r * t2.i +
+ sum.i * t2.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 3;
+ i__3 = j * c_dim1 + 3;
+ z__2.r = sum.r * t3.r - sum.i * t3.i, z__2.i = sum.r * t3.i +
+ sum.i * t3.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 4;
+ i__3 = j * c_dim1 + 4;
+ z__2.r = sum.r * t4.r - sum.i * t4.i, z__2.i = sum.r * t4.i +
+ sum.i * t4.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 5;
+ i__3 = j * c_dim1 + 5;
+ z__2.r = sum.r * t5.r - sum.i * t5.i, z__2.i = sum.r * t5.i +
+ sum.i * t5.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 6;
+ i__3 = j * c_dim1 + 6;
+ z__2.r = sum.r * t6.r - sum.i * t6.i, z__2.i = sum.r * t6.i +
+ sum.i * t6.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 7;
+ i__3 = j * c_dim1 + 7;
+ z__2.r = sum.r * t7.r - sum.i * t7.i, z__2.i = sum.r * t7.i +
+ sum.i * t7.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 8;
+ i__3 = j * c_dim1 + 8;
+ z__2.r = sum.r * t8.r - sum.i * t8.i, z__2.i = sum.r * t8.i +
+ sum.i * t8.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 9;
+ i__3 = j * c_dim1 + 9;
+ z__2.r = sum.r * t9.r - sum.i * t9.i, z__2.i = sum.r * t9.i +
+ sum.i * t9.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L180: */
+ }
+ goto L410;
+L190:
+
+/* Special code for 10 x 10 Householder */
+
+ d_cnjg(&z__1, &v[1]);
+ v1.r = z__1.r, v1.i = z__1.i;
+ d_cnjg(&z__2, &v1);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t1.r = z__1.r, t1.i = z__1.i;
+ d_cnjg(&z__1, &v[2]);
+ v2.r = z__1.r, v2.i = z__1.i;
+ d_cnjg(&z__2, &v2);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t2.r = z__1.r, t2.i = z__1.i;
+ d_cnjg(&z__1, &v[3]);
+ v3.r = z__1.r, v3.i = z__1.i;
+ d_cnjg(&z__2, &v3);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t3.r = z__1.r, t3.i = z__1.i;
+ d_cnjg(&z__1, &v[4]);
+ v4.r = z__1.r, v4.i = z__1.i;
+ d_cnjg(&z__2, &v4);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t4.r = z__1.r, t4.i = z__1.i;
+ d_cnjg(&z__1, &v[5]);
+ v5.r = z__1.r, v5.i = z__1.i;
+ d_cnjg(&z__2, &v5);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t5.r = z__1.r, t5.i = z__1.i;
+ d_cnjg(&z__1, &v[6]);
+ v6.r = z__1.r, v6.i = z__1.i;
+ d_cnjg(&z__2, &v6);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t6.r = z__1.r, t6.i = z__1.i;
+ d_cnjg(&z__1, &v[7]);
+ v7.r = z__1.r, v7.i = z__1.i;
+ d_cnjg(&z__2, &v7);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t7.r = z__1.r, t7.i = z__1.i;
+ d_cnjg(&z__1, &v[8]);
+ v8.r = z__1.r, v8.i = z__1.i;
+ d_cnjg(&z__2, &v8);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t8.r = z__1.r, t8.i = z__1.i;
+ d_cnjg(&z__1, &v[9]);
+ v9.r = z__1.r, v9.i = z__1.i;
+ d_cnjg(&z__2, &v9);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t9.r = z__1.r, t9.i = z__1.i;
+ d_cnjg(&z__1, &v[10]);
+ v10.r = z__1.r, v10.i = z__1.i;
+ d_cnjg(&z__2, &v10);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t10.r = z__1.r, t10.i = z__1.i;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j * c_dim1 + 1;
+ z__10.r = v1.r * c__[i__2].r - v1.i * c__[i__2].i, z__10.i = v1.r
+ * c__[i__2].i + v1.i * c__[i__2].r;
+ i__3 = j * c_dim1 + 2;
+ z__11.r = v2.r * c__[i__3].r - v2.i * c__[i__3].i, z__11.i = v2.r
+ * c__[i__3].i + v2.i * c__[i__3].r;
+ z__9.r = z__10.r + z__11.r, z__9.i = z__10.i + z__11.i;
+ i__4 = j * c_dim1 + 3;
+ z__12.r = v3.r * c__[i__4].r - v3.i * c__[i__4].i, z__12.i = v3.r
+ * c__[i__4].i + v3.i * c__[i__4].r;
+ z__8.r = z__9.r + z__12.r, z__8.i = z__9.i + z__12.i;
+ i__5 = j * c_dim1 + 4;
+ z__13.r = v4.r * c__[i__5].r - v4.i * c__[i__5].i, z__13.i = v4.r
+ * c__[i__5].i + v4.i * c__[i__5].r;
+ z__7.r = z__8.r + z__13.r, z__7.i = z__8.i + z__13.i;
+ i__6 = j * c_dim1 + 5;
+ z__14.r = v5.r * c__[i__6].r - v5.i * c__[i__6].i, z__14.i = v5.r
+ * c__[i__6].i + v5.i * c__[i__6].r;
+ z__6.r = z__7.r + z__14.r, z__6.i = z__7.i + z__14.i;
+ i__7 = j * c_dim1 + 6;
+ z__15.r = v6.r * c__[i__7].r - v6.i * c__[i__7].i, z__15.i = v6.r
+ * c__[i__7].i + v6.i * c__[i__7].r;
+ z__5.r = z__6.r + z__15.r, z__5.i = z__6.i + z__15.i;
+ i__8 = j * c_dim1 + 7;
+ z__16.r = v7.r * c__[i__8].r - v7.i * c__[i__8].i, z__16.i = v7.r
+ * c__[i__8].i + v7.i * c__[i__8].r;
+ z__4.r = z__5.r + z__16.r, z__4.i = z__5.i + z__16.i;
+ i__9 = j * c_dim1 + 8;
+ z__17.r = v8.r * c__[i__9].r - v8.i * c__[i__9].i, z__17.i = v8.r
+ * c__[i__9].i + v8.i * c__[i__9].r;
+ z__3.r = z__4.r + z__17.r, z__3.i = z__4.i + z__17.i;
+ i__10 = j * c_dim1 + 9;
+ z__18.r = v9.r * c__[i__10].r - v9.i * c__[i__10].i, z__18.i =
+ v9.r * c__[i__10].i + v9.i * c__[i__10].r;
+ z__2.r = z__3.r + z__18.r, z__2.i = z__3.i + z__18.i;
+ i__11 = j * c_dim1 + 10;
+ z__19.r = v10.r * c__[i__11].r - v10.i * c__[i__11].i, z__19.i =
+ v10.r * c__[i__11].i + v10.i * c__[i__11].r;
+ z__1.r = z__2.r + z__19.r, z__1.i = z__2.i + z__19.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__2 = j * c_dim1 + 1;
+ i__3 = j * c_dim1 + 1;
+ z__2.r = sum.r * t1.r - sum.i * t1.i, z__2.i = sum.r * t1.i +
+ sum.i * t1.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 2;
+ i__3 = j * c_dim1 + 2;
+ z__2.r = sum.r * t2.r - sum.i * t2.i, z__2.i = sum.r * t2.i +
+ sum.i * t2.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 3;
+ i__3 = j * c_dim1 + 3;
+ z__2.r = sum.r * t3.r - sum.i * t3.i, z__2.i = sum.r * t3.i +
+ sum.i * t3.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 4;
+ i__3 = j * c_dim1 + 4;
+ z__2.r = sum.r * t4.r - sum.i * t4.i, z__2.i = sum.r * t4.i +
+ sum.i * t4.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 5;
+ i__3 = j * c_dim1 + 5;
+ z__2.r = sum.r * t5.r - sum.i * t5.i, z__2.i = sum.r * t5.i +
+ sum.i * t5.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 6;
+ i__3 = j * c_dim1 + 6;
+ z__2.r = sum.r * t6.r - sum.i * t6.i, z__2.i = sum.r * t6.i +
+ sum.i * t6.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 7;
+ i__3 = j * c_dim1 + 7;
+ z__2.r = sum.r * t7.r - sum.i * t7.i, z__2.i = sum.r * t7.i +
+ sum.i * t7.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 8;
+ i__3 = j * c_dim1 + 8;
+ z__2.r = sum.r * t8.r - sum.i * t8.i, z__2.i = sum.r * t8.i +
+ sum.i * t8.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 9;
+ i__3 = j * c_dim1 + 9;
+ z__2.r = sum.r * t9.r - sum.i * t9.i, z__2.i = sum.r * t9.i +
+ sum.i * t9.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j * c_dim1 + 10;
+ i__3 = j * c_dim1 + 10;
+ z__2.r = sum.r * t10.r - sum.i * t10.i, z__2.i = sum.r * t10.i +
+ sum.i * t10.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L200: */
+ }
+ goto L410;
+ } else {
+
+/* Form C * H, where H has order n. */
+
+ switch (*n) {
+ case 1: goto L210;
+ case 2: goto L230;
+ case 3: goto L250;
+ case 4: goto L270;
+ case 5: goto L290;
+ case 6: goto L310;
+ case 7: goto L330;
+ case 8: goto L350;
+ case 9: goto L370;
+ case 10: goto L390;
+ }
+
+/*
+ Code for general N
+
+ w := C * v
+*/
+
+ zgemv_("No transpose", m, n, &c_b60, &c__[c_offset], ldc, &v[1], &
+ c__1, &c_b59, &work[1], &c__1);
+
+/* C := C - tau * w * v' */
+
+ z__1.r = -tau->r, z__1.i = -tau->i;
+ zgerc_(m, n, &z__1, &work[1], &c__1, &v[1], &c__1, &c__[c_offset],
+ ldc);
+ goto L410;
+L210:
+
+/* Special code for 1 x 1 Householder */
+
+ z__3.r = tau->r * v[1].r - tau->i * v[1].i, z__3.i = tau->r * v[1].i
+ + tau->i * v[1].r;
+ d_cnjg(&z__4, &v[1]);
+ z__2.r = z__3.r * z__4.r - z__3.i * z__4.i, z__2.i = z__3.r * z__4.i
+ + z__3.i * z__4.r;
+ z__1.r = 1. - z__2.r, z__1.i = 0. - z__2.i;
+ t1.r = z__1.r, t1.i = z__1.i;
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j + c_dim1;
+ i__3 = j + c_dim1;
+ z__1.r = t1.r * c__[i__3].r - t1.i * c__[i__3].i, z__1.i = t1.r *
+ c__[i__3].i + t1.i * c__[i__3].r;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L220: */
+ }
+ goto L410;
+L230:
+
+/* Special code for 2 x 2 Householder */
+
+ v1.r = v[1].r, v1.i = v[1].i;
+ d_cnjg(&z__2, &v1);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t1.r = z__1.r, t1.i = z__1.i;
+ v2.r = v[2].r, v2.i = v[2].i;
+ d_cnjg(&z__2, &v2);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t2.r = z__1.r, t2.i = z__1.i;
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j + c_dim1;
+ z__2.r = v1.r * c__[i__2].r - v1.i * c__[i__2].i, z__2.i = v1.r *
+ c__[i__2].i + v1.i * c__[i__2].r;
+ i__3 = j + ((c_dim1) << (1));
+ z__3.r = v2.r * c__[i__3].r - v2.i * c__[i__3].i, z__3.i = v2.r *
+ c__[i__3].i + v2.i * c__[i__3].r;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__2 = j + c_dim1;
+ i__3 = j + c_dim1;
+ z__2.r = sum.r * t1.r - sum.i * t1.i, z__2.i = sum.r * t1.i +
+ sum.i * t1.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + ((c_dim1) << (1));
+ i__3 = j + ((c_dim1) << (1));
+ z__2.r = sum.r * t2.r - sum.i * t2.i, z__2.i = sum.r * t2.i +
+ sum.i * t2.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L240: */
+ }
+ goto L410;
+L250:
+
+/* Special code for 3 x 3 Householder */
+
+ v1.r = v[1].r, v1.i = v[1].i;
+ d_cnjg(&z__2, &v1);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t1.r = z__1.r, t1.i = z__1.i;
+ v2.r = v[2].r, v2.i = v[2].i;
+ d_cnjg(&z__2, &v2);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t2.r = z__1.r, t2.i = z__1.i;
+ v3.r = v[3].r, v3.i = v[3].i;
+ d_cnjg(&z__2, &v3);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t3.r = z__1.r, t3.i = z__1.i;
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j + c_dim1;
+ z__3.r = v1.r * c__[i__2].r - v1.i * c__[i__2].i, z__3.i = v1.r *
+ c__[i__2].i + v1.i * c__[i__2].r;
+ i__3 = j + ((c_dim1) << (1));
+ z__4.r = v2.r * c__[i__3].r - v2.i * c__[i__3].i, z__4.i = v2.r *
+ c__[i__3].i + v2.i * c__[i__3].r;
+ z__2.r = z__3.r + z__4.r, z__2.i = z__3.i + z__4.i;
+ i__4 = j + c_dim1 * 3;
+ z__5.r = v3.r * c__[i__4].r - v3.i * c__[i__4].i, z__5.i = v3.r *
+ c__[i__4].i + v3.i * c__[i__4].r;
+ z__1.r = z__2.r + z__5.r, z__1.i = z__2.i + z__5.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__2 = j + c_dim1;
+ i__3 = j + c_dim1;
+ z__2.r = sum.r * t1.r - sum.i * t1.i, z__2.i = sum.r * t1.i +
+ sum.i * t1.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + ((c_dim1) << (1));
+ i__3 = j + ((c_dim1) << (1));
+ z__2.r = sum.r * t2.r - sum.i * t2.i, z__2.i = sum.r * t2.i +
+ sum.i * t2.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 3;
+ i__3 = j + c_dim1 * 3;
+ z__2.r = sum.r * t3.r - sum.i * t3.i, z__2.i = sum.r * t3.i +
+ sum.i * t3.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L260: */
+ }
+ goto L410;
+L270:
+
+/* Special code for 4 x 4 Householder */
+
+ v1.r = v[1].r, v1.i = v[1].i;
+ d_cnjg(&z__2, &v1);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t1.r = z__1.r, t1.i = z__1.i;
+ v2.r = v[2].r, v2.i = v[2].i;
+ d_cnjg(&z__2, &v2);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t2.r = z__1.r, t2.i = z__1.i;
+ v3.r = v[3].r, v3.i = v[3].i;
+ d_cnjg(&z__2, &v3);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t3.r = z__1.r, t3.i = z__1.i;
+ v4.r = v[4].r, v4.i = v[4].i;
+ d_cnjg(&z__2, &v4);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t4.r = z__1.r, t4.i = z__1.i;
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j + c_dim1;
+ z__4.r = v1.r * c__[i__2].r - v1.i * c__[i__2].i, z__4.i = v1.r *
+ c__[i__2].i + v1.i * c__[i__2].r;
+ i__3 = j + ((c_dim1) << (1));
+ z__5.r = v2.r * c__[i__3].r - v2.i * c__[i__3].i, z__5.i = v2.r *
+ c__[i__3].i + v2.i * c__[i__3].r;
+ z__3.r = z__4.r + z__5.r, z__3.i = z__4.i + z__5.i;
+ i__4 = j + c_dim1 * 3;
+ z__6.r = v3.r * c__[i__4].r - v3.i * c__[i__4].i, z__6.i = v3.r *
+ c__[i__4].i + v3.i * c__[i__4].r;
+ z__2.r = z__3.r + z__6.r, z__2.i = z__3.i + z__6.i;
+ i__5 = j + ((c_dim1) << (2));
+ z__7.r = v4.r * c__[i__5].r - v4.i * c__[i__5].i, z__7.i = v4.r *
+ c__[i__5].i + v4.i * c__[i__5].r;
+ z__1.r = z__2.r + z__7.r, z__1.i = z__2.i + z__7.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__2 = j + c_dim1;
+ i__3 = j + c_dim1;
+ z__2.r = sum.r * t1.r - sum.i * t1.i, z__2.i = sum.r * t1.i +
+ sum.i * t1.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + ((c_dim1) << (1));
+ i__3 = j + ((c_dim1) << (1));
+ z__2.r = sum.r * t2.r - sum.i * t2.i, z__2.i = sum.r * t2.i +
+ sum.i * t2.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 3;
+ i__3 = j + c_dim1 * 3;
+ z__2.r = sum.r * t3.r - sum.i * t3.i, z__2.i = sum.r * t3.i +
+ sum.i * t3.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + ((c_dim1) << (2));
+ i__3 = j + ((c_dim1) << (2));
+ z__2.r = sum.r * t4.r - sum.i * t4.i, z__2.i = sum.r * t4.i +
+ sum.i * t4.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L280: */
+ }
+ goto L410;
+L290:
+
+/* Special code for 5 x 5 Householder */
+
+ v1.r = v[1].r, v1.i = v[1].i;
+ d_cnjg(&z__2, &v1);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t1.r = z__1.r, t1.i = z__1.i;
+ v2.r = v[2].r, v2.i = v[2].i;
+ d_cnjg(&z__2, &v2);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t2.r = z__1.r, t2.i = z__1.i;
+ v3.r = v[3].r, v3.i = v[3].i;
+ d_cnjg(&z__2, &v3);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t3.r = z__1.r, t3.i = z__1.i;
+ v4.r = v[4].r, v4.i = v[4].i;
+ d_cnjg(&z__2, &v4);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t4.r = z__1.r, t4.i = z__1.i;
+ v5.r = v[5].r, v5.i = v[5].i;
+ d_cnjg(&z__2, &v5);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t5.r = z__1.r, t5.i = z__1.i;
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j + c_dim1;
+ z__5.r = v1.r * c__[i__2].r - v1.i * c__[i__2].i, z__5.i = v1.r *
+ c__[i__2].i + v1.i * c__[i__2].r;
+ i__3 = j + ((c_dim1) << (1));
+ z__6.r = v2.r * c__[i__3].r - v2.i * c__[i__3].i, z__6.i = v2.r *
+ c__[i__3].i + v2.i * c__[i__3].r;
+ z__4.r = z__5.r + z__6.r, z__4.i = z__5.i + z__6.i;
+ i__4 = j + c_dim1 * 3;
+ z__7.r = v3.r * c__[i__4].r - v3.i * c__[i__4].i, z__7.i = v3.r *
+ c__[i__4].i + v3.i * c__[i__4].r;
+ z__3.r = z__4.r + z__7.r, z__3.i = z__4.i + z__7.i;
+ i__5 = j + ((c_dim1) << (2));
+ z__8.r = v4.r * c__[i__5].r - v4.i * c__[i__5].i, z__8.i = v4.r *
+ c__[i__5].i + v4.i * c__[i__5].r;
+ z__2.r = z__3.r + z__8.r, z__2.i = z__3.i + z__8.i;
+ i__6 = j + c_dim1 * 5;
+ z__9.r = v5.r * c__[i__6].r - v5.i * c__[i__6].i, z__9.i = v5.r *
+ c__[i__6].i + v5.i * c__[i__6].r;
+ z__1.r = z__2.r + z__9.r, z__1.i = z__2.i + z__9.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__2 = j + c_dim1;
+ i__3 = j + c_dim1;
+ z__2.r = sum.r * t1.r - sum.i * t1.i, z__2.i = sum.r * t1.i +
+ sum.i * t1.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + ((c_dim1) << (1));
+ i__3 = j + ((c_dim1) << (1));
+ z__2.r = sum.r * t2.r - sum.i * t2.i, z__2.i = sum.r * t2.i +
+ sum.i * t2.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 3;
+ i__3 = j + c_dim1 * 3;
+ z__2.r = sum.r * t3.r - sum.i * t3.i, z__2.i = sum.r * t3.i +
+ sum.i * t3.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + ((c_dim1) << (2));
+ i__3 = j + ((c_dim1) << (2));
+ z__2.r = sum.r * t4.r - sum.i * t4.i, z__2.i = sum.r * t4.i +
+ sum.i * t4.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 5;
+ i__3 = j + c_dim1 * 5;
+ z__2.r = sum.r * t5.r - sum.i * t5.i, z__2.i = sum.r * t5.i +
+ sum.i * t5.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L300: */
+ }
+ goto L410;
+L310:
+
+/* Special code for 6 x 6 Householder */
+
+ v1.r = v[1].r, v1.i = v[1].i;
+ d_cnjg(&z__2, &v1);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t1.r = z__1.r, t1.i = z__1.i;
+ v2.r = v[2].r, v2.i = v[2].i;
+ d_cnjg(&z__2, &v2);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t2.r = z__1.r, t2.i = z__1.i;
+ v3.r = v[3].r, v3.i = v[3].i;
+ d_cnjg(&z__2, &v3);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t3.r = z__1.r, t3.i = z__1.i;
+ v4.r = v[4].r, v4.i = v[4].i;
+ d_cnjg(&z__2, &v4);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t4.r = z__1.r, t4.i = z__1.i;
+ v5.r = v[5].r, v5.i = v[5].i;
+ d_cnjg(&z__2, &v5);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t5.r = z__1.r, t5.i = z__1.i;
+ v6.r = v[6].r, v6.i = v[6].i;
+ d_cnjg(&z__2, &v6);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t6.r = z__1.r, t6.i = z__1.i;
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j + c_dim1;
+ z__6.r = v1.r * c__[i__2].r - v1.i * c__[i__2].i, z__6.i = v1.r *
+ c__[i__2].i + v1.i * c__[i__2].r;
+ i__3 = j + ((c_dim1) << (1));
+ z__7.r = v2.r * c__[i__3].r - v2.i * c__[i__3].i, z__7.i = v2.r *
+ c__[i__3].i + v2.i * c__[i__3].r;
+ z__5.r = z__6.r + z__7.r, z__5.i = z__6.i + z__7.i;
+ i__4 = j + c_dim1 * 3;
+ z__8.r = v3.r * c__[i__4].r - v3.i * c__[i__4].i, z__8.i = v3.r *
+ c__[i__4].i + v3.i * c__[i__4].r;
+ z__4.r = z__5.r + z__8.r, z__4.i = z__5.i + z__8.i;
+ i__5 = j + ((c_dim1) << (2));
+ z__9.r = v4.r * c__[i__5].r - v4.i * c__[i__5].i, z__9.i = v4.r *
+ c__[i__5].i + v4.i * c__[i__5].r;
+ z__3.r = z__4.r + z__9.r, z__3.i = z__4.i + z__9.i;
+ i__6 = j + c_dim1 * 5;
+ z__10.r = v5.r * c__[i__6].r - v5.i * c__[i__6].i, z__10.i = v5.r
+ * c__[i__6].i + v5.i * c__[i__6].r;
+ z__2.r = z__3.r + z__10.r, z__2.i = z__3.i + z__10.i;
+ i__7 = j + c_dim1 * 6;
+ z__11.r = v6.r * c__[i__7].r - v6.i * c__[i__7].i, z__11.i = v6.r
+ * c__[i__7].i + v6.i * c__[i__7].r;
+ z__1.r = z__2.r + z__11.r, z__1.i = z__2.i + z__11.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__2 = j + c_dim1;
+ i__3 = j + c_dim1;
+ z__2.r = sum.r * t1.r - sum.i * t1.i, z__2.i = sum.r * t1.i +
+ sum.i * t1.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + ((c_dim1) << (1));
+ i__3 = j + ((c_dim1) << (1));
+ z__2.r = sum.r * t2.r - sum.i * t2.i, z__2.i = sum.r * t2.i +
+ sum.i * t2.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 3;
+ i__3 = j + c_dim1 * 3;
+ z__2.r = sum.r * t3.r - sum.i * t3.i, z__2.i = sum.r * t3.i +
+ sum.i * t3.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + ((c_dim1) << (2));
+ i__3 = j + ((c_dim1) << (2));
+ z__2.r = sum.r * t4.r - sum.i * t4.i, z__2.i = sum.r * t4.i +
+ sum.i * t4.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 5;
+ i__3 = j + c_dim1 * 5;
+ z__2.r = sum.r * t5.r - sum.i * t5.i, z__2.i = sum.r * t5.i +
+ sum.i * t5.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 6;
+ i__3 = j + c_dim1 * 6;
+ z__2.r = sum.r * t6.r - sum.i * t6.i, z__2.i = sum.r * t6.i +
+ sum.i * t6.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L320: */
+ }
+ goto L410;
+L330:
+
+/* Special code for 7 x 7 Householder */
+
+ v1.r = v[1].r, v1.i = v[1].i;
+ d_cnjg(&z__2, &v1);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t1.r = z__1.r, t1.i = z__1.i;
+ v2.r = v[2].r, v2.i = v[2].i;
+ d_cnjg(&z__2, &v2);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t2.r = z__1.r, t2.i = z__1.i;
+ v3.r = v[3].r, v3.i = v[3].i;
+ d_cnjg(&z__2, &v3);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t3.r = z__1.r, t3.i = z__1.i;
+ v4.r = v[4].r, v4.i = v[4].i;
+ d_cnjg(&z__2, &v4);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t4.r = z__1.r, t4.i = z__1.i;
+ v5.r = v[5].r, v5.i = v[5].i;
+ d_cnjg(&z__2, &v5);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t5.r = z__1.r, t5.i = z__1.i;
+ v6.r = v[6].r, v6.i = v[6].i;
+ d_cnjg(&z__2, &v6);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t6.r = z__1.r, t6.i = z__1.i;
+ v7.r = v[7].r, v7.i = v[7].i;
+ d_cnjg(&z__2, &v7);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t7.r = z__1.r, t7.i = z__1.i;
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j + c_dim1;
+ z__7.r = v1.r * c__[i__2].r - v1.i * c__[i__2].i, z__7.i = v1.r *
+ c__[i__2].i + v1.i * c__[i__2].r;
+ i__3 = j + ((c_dim1) << (1));
+ z__8.r = v2.r * c__[i__3].r - v2.i * c__[i__3].i, z__8.i = v2.r *
+ c__[i__3].i + v2.i * c__[i__3].r;
+ z__6.r = z__7.r + z__8.r, z__6.i = z__7.i + z__8.i;
+ i__4 = j + c_dim1 * 3;
+ z__9.r = v3.r * c__[i__4].r - v3.i * c__[i__4].i, z__9.i = v3.r *
+ c__[i__4].i + v3.i * c__[i__4].r;
+ z__5.r = z__6.r + z__9.r, z__5.i = z__6.i + z__9.i;
+ i__5 = j + ((c_dim1) << (2));
+ z__10.r = v4.r * c__[i__5].r - v4.i * c__[i__5].i, z__10.i = v4.r
+ * c__[i__5].i + v4.i * c__[i__5].r;
+ z__4.r = z__5.r + z__10.r, z__4.i = z__5.i + z__10.i;
+ i__6 = j + c_dim1 * 5;
+ z__11.r = v5.r * c__[i__6].r - v5.i * c__[i__6].i, z__11.i = v5.r
+ * c__[i__6].i + v5.i * c__[i__6].r;
+ z__3.r = z__4.r + z__11.r, z__3.i = z__4.i + z__11.i;
+ i__7 = j + c_dim1 * 6;
+ z__12.r = v6.r * c__[i__7].r - v6.i * c__[i__7].i, z__12.i = v6.r
+ * c__[i__7].i + v6.i * c__[i__7].r;
+ z__2.r = z__3.r + z__12.r, z__2.i = z__3.i + z__12.i;
+ i__8 = j + c_dim1 * 7;
+ z__13.r = v7.r * c__[i__8].r - v7.i * c__[i__8].i, z__13.i = v7.r
+ * c__[i__8].i + v7.i * c__[i__8].r;
+ z__1.r = z__2.r + z__13.r, z__1.i = z__2.i + z__13.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__2 = j + c_dim1;
+ i__3 = j + c_dim1;
+ z__2.r = sum.r * t1.r - sum.i * t1.i, z__2.i = sum.r * t1.i +
+ sum.i * t1.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + ((c_dim1) << (1));
+ i__3 = j + ((c_dim1) << (1));
+ z__2.r = sum.r * t2.r - sum.i * t2.i, z__2.i = sum.r * t2.i +
+ sum.i * t2.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 3;
+ i__3 = j + c_dim1 * 3;
+ z__2.r = sum.r * t3.r - sum.i * t3.i, z__2.i = sum.r * t3.i +
+ sum.i * t3.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + ((c_dim1) << (2));
+ i__3 = j + ((c_dim1) << (2));
+ z__2.r = sum.r * t4.r - sum.i * t4.i, z__2.i = sum.r * t4.i +
+ sum.i * t4.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 5;
+ i__3 = j + c_dim1 * 5;
+ z__2.r = sum.r * t5.r - sum.i * t5.i, z__2.i = sum.r * t5.i +
+ sum.i * t5.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 6;
+ i__3 = j + c_dim1 * 6;
+ z__2.r = sum.r * t6.r - sum.i * t6.i, z__2.i = sum.r * t6.i +
+ sum.i * t6.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 7;
+ i__3 = j + c_dim1 * 7;
+ z__2.r = sum.r * t7.r - sum.i * t7.i, z__2.i = sum.r * t7.i +
+ sum.i * t7.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L340: */
+ }
+ goto L410;
+L350:
+
+/* Special code for 8 x 8 Householder */
+
+ v1.r = v[1].r, v1.i = v[1].i;
+ d_cnjg(&z__2, &v1);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t1.r = z__1.r, t1.i = z__1.i;
+ v2.r = v[2].r, v2.i = v[2].i;
+ d_cnjg(&z__2, &v2);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t2.r = z__1.r, t2.i = z__1.i;
+ v3.r = v[3].r, v3.i = v[3].i;
+ d_cnjg(&z__2, &v3);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t3.r = z__1.r, t3.i = z__1.i;
+ v4.r = v[4].r, v4.i = v[4].i;
+ d_cnjg(&z__2, &v4);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t4.r = z__1.r, t4.i = z__1.i;
+ v5.r = v[5].r, v5.i = v[5].i;
+ d_cnjg(&z__2, &v5);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t5.r = z__1.r, t5.i = z__1.i;
+ v6.r = v[6].r, v6.i = v[6].i;
+ d_cnjg(&z__2, &v6);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t6.r = z__1.r, t6.i = z__1.i;
+ v7.r = v[7].r, v7.i = v[7].i;
+ d_cnjg(&z__2, &v7);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t7.r = z__1.r, t7.i = z__1.i;
+ v8.r = v[8].r, v8.i = v[8].i;
+ d_cnjg(&z__2, &v8);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t8.r = z__1.r, t8.i = z__1.i;
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j + c_dim1;
+ z__8.r = v1.r * c__[i__2].r - v1.i * c__[i__2].i, z__8.i = v1.r *
+ c__[i__2].i + v1.i * c__[i__2].r;
+ i__3 = j + ((c_dim1) << (1));
+ z__9.r = v2.r * c__[i__3].r - v2.i * c__[i__3].i, z__9.i = v2.r *
+ c__[i__3].i + v2.i * c__[i__3].r;
+ z__7.r = z__8.r + z__9.r, z__7.i = z__8.i + z__9.i;
+ i__4 = j + c_dim1 * 3;
+ z__10.r = v3.r * c__[i__4].r - v3.i * c__[i__4].i, z__10.i = v3.r
+ * c__[i__4].i + v3.i * c__[i__4].r;
+ z__6.r = z__7.r + z__10.r, z__6.i = z__7.i + z__10.i;
+ i__5 = j + ((c_dim1) << (2));
+ z__11.r = v4.r * c__[i__5].r - v4.i * c__[i__5].i, z__11.i = v4.r
+ * c__[i__5].i + v4.i * c__[i__5].r;
+ z__5.r = z__6.r + z__11.r, z__5.i = z__6.i + z__11.i;
+ i__6 = j + c_dim1 * 5;
+ z__12.r = v5.r * c__[i__6].r - v5.i * c__[i__6].i, z__12.i = v5.r
+ * c__[i__6].i + v5.i * c__[i__6].r;
+ z__4.r = z__5.r + z__12.r, z__4.i = z__5.i + z__12.i;
+ i__7 = j + c_dim1 * 6;
+ z__13.r = v6.r * c__[i__7].r - v6.i * c__[i__7].i, z__13.i = v6.r
+ * c__[i__7].i + v6.i * c__[i__7].r;
+ z__3.r = z__4.r + z__13.r, z__3.i = z__4.i + z__13.i;
+ i__8 = j + c_dim1 * 7;
+ z__14.r = v7.r * c__[i__8].r - v7.i * c__[i__8].i, z__14.i = v7.r
+ * c__[i__8].i + v7.i * c__[i__8].r;
+ z__2.r = z__3.r + z__14.r, z__2.i = z__3.i + z__14.i;
+ i__9 = j + ((c_dim1) << (3));
+ z__15.r = v8.r * c__[i__9].r - v8.i * c__[i__9].i, z__15.i = v8.r
+ * c__[i__9].i + v8.i * c__[i__9].r;
+ z__1.r = z__2.r + z__15.r, z__1.i = z__2.i + z__15.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__2 = j + c_dim1;
+ i__3 = j + c_dim1;
+ z__2.r = sum.r * t1.r - sum.i * t1.i, z__2.i = sum.r * t1.i +
+ sum.i * t1.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + ((c_dim1) << (1));
+ i__3 = j + ((c_dim1) << (1));
+ z__2.r = sum.r * t2.r - sum.i * t2.i, z__2.i = sum.r * t2.i +
+ sum.i * t2.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 3;
+ i__3 = j + c_dim1 * 3;
+ z__2.r = sum.r * t3.r - sum.i * t3.i, z__2.i = sum.r * t3.i +
+ sum.i * t3.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + ((c_dim1) << (2));
+ i__3 = j + ((c_dim1) << (2));
+ z__2.r = sum.r * t4.r - sum.i * t4.i, z__2.i = sum.r * t4.i +
+ sum.i * t4.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 5;
+ i__3 = j + c_dim1 * 5;
+ z__2.r = sum.r * t5.r - sum.i * t5.i, z__2.i = sum.r * t5.i +
+ sum.i * t5.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 6;
+ i__3 = j + c_dim1 * 6;
+ z__2.r = sum.r * t6.r - sum.i * t6.i, z__2.i = sum.r * t6.i +
+ sum.i * t6.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 7;
+ i__3 = j + c_dim1 * 7;
+ z__2.r = sum.r * t7.r - sum.i * t7.i, z__2.i = sum.r * t7.i +
+ sum.i * t7.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + ((c_dim1) << (3));
+ i__3 = j + ((c_dim1) << (3));
+ z__2.r = sum.r * t8.r - sum.i * t8.i, z__2.i = sum.r * t8.i +
+ sum.i * t8.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L360: */
+ }
+ goto L410;
+L370:
+
+/* Special code for 9 x 9 Householder */
+
+ v1.r = v[1].r, v1.i = v[1].i;
+ d_cnjg(&z__2, &v1);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t1.r = z__1.r, t1.i = z__1.i;
+ v2.r = v[2].r, v2.i = v[2].i;
+ d_cnjg(&z__2, &v2);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t2.r = z__1.r, t2.i = z__1.i;
+ v3.r = v[3].r, v3.i = v[3].i;
+ d_cnjg(&z__2, &v3);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t3.r = z__1.r, t3.i = z__1.i;
+ v4.r = v[4].r, v4.i = v[4].i;
+ d_cnjg(&z__2, &v4);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t4.r = z__1.r, t4.i = z__1.i;
+ v5.r = v[5].r, v5.i = v[5].i;
+ d_cnjg(&z__2, &v5);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t5.r = z__1.r, t5.i = z__1.i;
+ v6.r = v[6].r, v6.i = v[6].i;
+ d_cnjg(&z__2, &v6);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t6.r = z__1.r, t6.i = z__1.i;
+ v7.r = v[7].r, v7.i = v[7].i;
+ d_cnjg(&z__2, &v7);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t7.r = z__1.r, t7.i = z__1.i;
+ v8.r = v[8].r, v8.i = v[8].i;
+ d_cnjg(&z__2, &v8);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t8.r = z__1.r, t8.i = z__1.i;
+ v9.r = v[9].r, v9.i = v[9].i;
+ d_cnjg(&z__2, &v9);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t9.r = z__1.r, t9.i = z__1.i;
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j + c_dim1;
+ z__9.r = v1.r * c__[i__2].r - v1.i * c__[i__2].i, z__9.i = v1.r *
+ c__[i__2].i + v1.i * c__[i__2].r;
+ i__3 = j + ((c_dim1) << (1));
+ z__10.r = v2.r * c__[i__3].r - v2.i * c__[i__3].i, z__10.i = v2.r
+ * c__[i__3].i + v2.i * c__[i__3].r;
+ z__8.r = z__9.r + z__10.r, z__8.i = z__9.i + z__10.i;
+ i__4 = j + c_dim1 * 3;
+ z__11.r = v3.r * c__[i__4].r - v3.i * c__[i__4].i, z__11.i = v3.r
+ * c__[i__4].i + v3.i * c__[i__4].r;
+ z__7.r = z__8.r + z__11.r, z__7.i = z__8.i + z__11.i;
+ i__5 = j + ((c_dim1) << (2));
+ z__12.r = v4.r * c__[i__5].r - v4.i * c__[i__5].i, z__12.i = v4.r
+ * c__[i__5].i + v4.i * c__[i__5].r;
+ z__6.r = z__7.r + z__12.r, z__6.i = z__7.i + z__12.i;
+ i__6 = j + c_dim1 * 5;
+ z__13.r = v5.r * c__[i__6].r - v5.i * c__[i__6].i, z__13.i = v5.r
+ * c__[i__6].i + v5.i * c__[i__6].r;
+ z__5.r = z__6.r + z__13.r, z__5.i = z__6.i + z__13.i;
+ i__7 = j + c_dim1 * 6;
+ z__14.r = v6.r * c__[i__7].r - v6.i * c__[i__7].i, z__14.i = v6.r
+ * c__[i__7].i + v6.i * c__[i__7].r;
+ z__4.r = z__5.r + z__14.r, z__4.i = z__5.i + z__14.i;
+ i__8 = j + c_dim1 * 7;
+ z__15.r = v7.r * c__[i__8].r - v7.i * c__[i__8].i, z__15.i = v7.r
+ * c__[i__8].i + v7.i * c__[i__8].r;
+ z__3.r = z__4.r + z__15.r, z__3.i = z__4.i + z__15.i;
+ i__9 = j + ((c_dim1) << (3));
+ z__16.r = v8.r * c__[i__9].r - v8.i * c__[i__9].i, z__16.i = v8.r
+ * c__[i__9].i + v8.i * c__[i__9].r;
+ z__2.r = z__3.r + z__16.r, z__2.i = z__3.i + z__16.i;
+ i__10 = j + c_dim1 * 9;
+ z__17.r = v9.r * c__[i__10].r - v9.i * c__[i__10].i, z__17.i =
+ v9.r * c__[i__10].i + v9.i * c__[i__10].r;
+ z__1.r = z__2.r + z__17.r, z__1.i = z__2.i + z__17.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__2 = j + c_dim1;
+ i__3 = j + c_dim1;
+ z__2.r = sum.r * t1.r - sum.i * t1.i, z__2.i = sum.r * t1.i +
+ sum.i * t1.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + ((c_dim1) << (1));
+ i__3 = j + ((c_dim1) << (1));
+ z__2.r = sum.r * t2.r - sum.i * t2.i, z__2.i = sum.r * t2.i +
+ sum.i * t2.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 3;
+ i__3 = j + c_dim1 * 3;
+ z__2.r = sum.r * t3.r - sum.i * t3.i, z__2.i = sum.r * t3.i +
+ sum.i * t3.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + ((c_dim1) << (2));
+ i__3 = j + ((c_dim1) << (2));
+ z__2.r = sum.r * t4.r - sum.i * t4.i, z__2.i = sum.r * t4.i +
+ sum.i * t4.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 5;
+ i__3 = j + c_dim1 * 5;
+ z__2.r = sum.r * t5.r - sum.i * t5.i, z__2.i = sum.r * t5.i +
+ sum.i * t5.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 6;
+ i__3 = j + c_dim1 * 6;
+ z__2.r = sum.r * t6.r - sum.i * t6.i, z__2.i = sum.r * t6.i +
+ sum.i * t6.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 7;
+ i__3 = j + c_dim1 * 7;
+ z__2.r = sum.r * t7.r - sum.i * t7.i, z__2.i = sum.r * t7.i +
+ sum.i * t7.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + ((c_dim1) << (3));
+ i__3 = j + ((c_dim1) << (3));
+ z__2.r = sum.r * t8.r - sum.i * t8.i, z__2.i = sum.r * t8.i +
+ sum.i * t8.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 9;
+ i__3 = j + c_dim1 * 9;
+ z__2.r = sum.r * t9.r - sum.i * t9.i, z__2.i = sum.r * t9.i +
+ sum.i * t9.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L380: */
+ }
+ goto L410;
+L390:
+
+/* Special code for 10 x 10 Householder */
+
+ v1.r = v[1].r, v1.i = v[1].i;
+ d_cnjg(&z__2, &v1);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t1.r = z__1.r, t1.i = z__1.i;
+ v2.r = v[2].r, v2.i = v[2].i;
+ d_cnjg(&z__2, &v2);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t2.r = z__1.r, t2.i = z__1.i;
+ v3.r = v[3].r, v3.i = v[3].i;
+ d_cnjg(&z__2, &v3);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t3.r = z__1.r, t3.i = z__1.i;
+ v4.r = v[4].r, v4.i = v[4].i;
+ d_cnjg(&z__2, &v4);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t4.r = z__1.r, t4.i = z__1.i;
+ v5.r = v[5].r, v5.i = v[5].i;
+ d_cnjg(&z__2, &v5);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t5.r = z__1.r, t5.i = z__1.i;
+ v6.r = v[6].r, v6.i = v[6].i;
+ d_cnjg(&z__2, &v6);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t6.r = z__1.r, t6.i = z__1.i;
+ v7.r = v[7].r, v7.i = v[7].i;
+ d_cnjg(&z__2, &v7);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t7.r = z__1.r, t7.i = z__1.i;
+ v8.r = v[8].r, v8.i = v[8].i;
+ d_cnjg(&z__2, &v8);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t8.r = z__1.r, t8.i = z__1.i;
+ v9.r = v[9].r, v9.i = v[9].i;
+ d_cnjg(&z__2, &v9);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t9.r = z__1.r, t9.i = z__1.i;
+ v10.r = v[10].r, v10.i = v[10].i;
+ d_cnjg(&z__2, &v10);
+ z__1.r = tau->r * z__2.r - tau->i * z__2.i, z__1.i = tau->r * z__2.i
+ + tau->i * z__2.r;
+ t10.r = z__1.r, t10.i = z__1.i;
+ i__1 = *m;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j + c_dim1;
+ z__10.r = v1.r * c__[i__2].r - v1.i * c__[i__2].i, z__10.i = v1.r
+ * c__[i__2].i + v1.i * c__[i__2].r;
+ i__3 = j + ((c_dim1) << (1));
+ z__11.r = v2.r * c__[i__3].r - v2.i * c__[i__3].i, z__11.i = v2.r
+ * c__[i__3].i + v2.i * c__[i__3].r;
+ z__9.r = z__10.r + z__11.r, z__9.i = z__10.i + z__11.i;
+ i__4 = j + c_dim1 * 3;
+ z__12.r = v3.r * c__[i__4].r - v3.i * c__[i__4].i, z__12.i = v3.r
+ * c__[i__4].i + v3.i * c__[i__4].r;
+ z__8.r = z__9.r + z__12.r, z__8.i = z__9.i + z__12.i;
+ i__5 = j + ((c_dim1) << (2));
+ z__13.r = v4.r * c__[i__5].r - v4.i * c__[i__5].i, z__13.i = v4.r
+ * c__[i__5].i + v4.i * c__[i__5].r;
+ z__7.r = z__8.r + z__13.r, z__7.i = z__8.i + z__13.i;
+ i__6 = j + c_dim1 * 5;
+ z__14.r = v5.r * c__[i__6].r - v5.i * c__[i__6].i, z__14.i = v5.r
+ * c__[i__6].i + v5.i * c__[i__6].r;
+ z__6.r = z__7.r + z__14.r, z__6.i = z__7.i + z__14.i;
+ i__7 = j + c_dim1 * 6;
+ z__15.r = v6.r * c__[i__7].r - v6.i * c__[i__7].i, z__15.i = v6.r
+ * c__[i__7].i + v6.i * c__[i__7].r;
+ z__5.r = z__6.r + z__15.r, z__5.i = z__6.i + z__15.i;
+ i__8 = j + c_dim1 * 7;
+ z__16.r = v7.r * c__[i__8].r - v7.i * c__[i__8].i, z__16.i = v7.r
+ * c__[i__8].i + v7.i * c__[i__8].r;
+ z__4.r = z__5.r + z__16.r, z__4.i = z__5.i + z__16.i;
+ i__9 = j + ((c_dim1) << (3));
+ z__17.r = v8.r * c__[i__9].r - v8.i * c__[i__9].i, z__17.i = v8.r
+ * c__[i__9].i + v8.i * c__[i__9].r;
+ z__3.r = z__4.r + z__17.r, z__3.i = z__4.i + z__17.i;
+ i__10 = j + c_dim1 * 9;
+ z__18.r = v9.r * c__[i__10].r - v9.i * c__[i__10].i, z__18.i =
+ v9.r * c__[i__10].i + v9.i * c__[i__10].r;
+ z__2.r = z__3.r + z__18.r, z__2.i = z__3.i + z__18.i;
+ i__11 = j + c_dim1 * 10;
+ z__19.r = v10.r * c__[i__11].r - v10.i * c__[i__11].i, z__19.i =
+ v10.r * c__[i__11].i + v10.i * c__[i__11].r;
+ z__1.r = z__2.r + z__19.r, z__1.i = z__2.i + z__19.i;
+ sum.r = z__1.r, sum.i = z__1.i;
+ i__2 = j + c_dim1;
+ i__3 = j + c_dim1;
+ z__2.r = sum.r * t1.r - sum.i * t1.i, z__2.i = sum.r * t1.i +
+ sum.i * t1.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + ((c_dim1) << (1));
+ i__3 = j + ((c_dim1) << (1));
+ z__2.r = sum.r * t2.r - sum.i * t2.i, z__2.i = sum.r * t2.i +
+ sum.i * t2.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 3;
+ i__3 = j + c_dim1 * 3;
+ z__2.r = sum.r * t3.r - sum.i * t3.i, z__2.i = sum.r * t3.i +
+ sum.i * t3.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + ((c_dim1) << (2));
+ i__3 = j + ((c_dim1) << (2));
+ z__2.r = sum.r * t4.r - sum.i * t4.i, z__2.i = sum.r * t4.i +
+ sum.i * t4.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 5;
+ i__3 = j + c_dim1 * 5;
+ z__2.r = sum.r * t5.r - sum.i * t5.i, z__2.i = sum.r * t5.i +
+ sum.i * t5.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 6;
+ i__3 = j + c_dim1 * 6;
+ z__2.r = sum.r * t6.r - sum.i * t6.i, z__2.i = sum.r * t6.i +
+ sum.i * t6.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 7;
+ i__3 = j + c_dim1 * 7;
+ z__2.r = sum.r * t7.r - sum.i * t7.i, z__2.i = sum.r * t7.i +
+ sum.i * t7.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + ((c_dim1) << (3));
+ i__3 = j + ((c_dim1) << (3));
+ z__2.r = sum.r * t8.r - sum.i * t8.i, z__2.i = sum.r * t8.i +
+ sum.i * t8.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 9;
+ i__3 = j + c_dim1 * 9;
+ z__2.r = sum.r * t9.r - sum.i * t9.i, z__2.i = sum.r * t9.i +
+ sum.i * t9.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+ i__2 = j + c_dim1 * 10;
+ i__3 = j + c_dim1 * 10;
+ z__2.r = sum.r * t10.r - sum.i * t10.i, z__2.i = sum.r * t10.i +
+ sum.i * t10.r;
+ z__1.r = c__[i__3].r - z__2.r, z__1.i = c__[i__3].i - z__2.i;
+ c__[i__2].r = z__1.r, c__[i__2].i = z__1.i;
+/* L400: */
+ }
+ goto L410;
+ }
+L410:
+ return 0;
+
+/* End of ZLARFX */
+
+} /* zlarfx_ */
+
+/* Subroutine */ int zlascl_(char *type__, integer *kl, integer *ku,
+ doublereal *cfrom, doublereal *cto, integer *m, integer *n,
+ doublecomplex *a, integer *lda, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer i__, j, k1, k2, k3, k4;
+ static doublereal mul, cto1;
+ static logical done;
+ static doublereal ctoc;
+ extern logical lsame_(char *, char *);
+ static integer itype;
+ static doublereal cfrom1;
+
+ static doublereal cfromc;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ static doublereal bignum, smlnum;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ February 29, 1992
+
+
+ Purpose
+ =======
+
+ ZLASCL multiplies the M by N complex matrix A by the real scalar
+ CTO/CFROM. This is done without over/underflow as long as the final
+ result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that
+ A may be full, upper triangular, lower triangular, upper Hessenberg,
+ or banded.
+
+ Arguments
+ =========
+
+ TYPE (input) CHARACTER*1
+ TYPE indices the storage type of the input matrix.
+ = 'G': A is a full matrix.
+ = 'L': A is a lower triangular matrix.
+ = 'U': A is an upper triangular matrix.
+ = 'H': A is an upper Hessenberg matrix.
+ = 'B': A is a symmetric band matrix with lower bandwidth KL
+ and upper bandwidth KU and with the only the lower
+ half stored.
+ = 'Q': A is a symmetric band matrix with lower bandwidth KL
+ and upper bandwidth KU and with the only the upper
+ half stored.
+ = 'Z': A is a band matrix with lower bandwidth KL and upper
+ bandwidth KU.
+
+ KL (input) INTEGER
+ The lower bandwidth of A. Referenced only if TYPE = 'B',
+ 'Q' or 'Z'.
+
+ KU (input) INTEGER
+ The upper bandwidth of A. Referenced only if TYPE = 'B',
+ 'Q' or 'Z'.
+
+ CFROM (input) DOUBLE PRECISION
+ CTO (input) DOUBLE PRECISION
+ The matrix A is multiplied by CTO/CFROM. A(I,J) is computed
+ without over/underflow if the final result CTO*A(I,J)/CFROM
+ can be represented without over/underflow. CFROM must be
+ nonzero.
+
+ M (input) INTEGER
+ The number of rows of the matrix A. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. N >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,M)
+ The matrix to be multiplied by CTO/CFROM. See TYPE for the
+ storage type.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ INFO (output) INTEGER
+ 0 - successful exit
+ <0 - if INFO = -i, the i-th argument had an illegal value.
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+
+ /* Function Body */
+ *info = 0;
+
+ if (lsame_(type__, "G")) {
+ itype = 0;
+ } else if (lsame_(type__, "L")) {
+ itype = 1;
+ } else if (lsame_(type__, "U")) {
+ itype = 2;
+ } else if (lsame_(type__, "H")) {
+ itype = 3;
+ } else if (lsame_(type__, "B")) {
+ itype = 4;
+ } else if (lsame_(type__, "Q")) {
+ itype = 5;
+ } else if (lsame_(type__, "Z")) {
+ itype = 6;
+ } else {
+ itype = -1;
+ }
+
+ if (itype == -1) {
+ *info = -1;
+ } else if (*cfrom == 0.) {
+ *info = -4;
+ } else if (*m < 0) {
+ *info = -6;
+ } else if (*n < 0 || (itype == 4 && *n != *m) || (itype == 5 && *n != *m))
+ {
+ *info = -7;
+ } else if ((itype <= 3 && *lda < max(1,*m))) {
+ *info = -9;
+ } else if (itype >= 4) {
+/* Computing MAX */
+ i__1 = *m - 1;
+ if (*kl < 0 || *kl > max(i__1,0)) {
+ *info = -2;
+ } else /* if(complicated condition) */ {
+/* Computing MAX */
+ i__1 = *n - 1;
+ if (*ku < 0 || *ku > max(i__1,0) || ((itype == 4 || itype == 5) &&
+ *kl != *ku)) {
+ *info = -3;
+ } else if ((itype == 4 && *lda < *kl + 1) || (itype == 5 && *lda <
+ *ku + 1) || (itype == 6 && *lda < ((*kl) << (1)) + *ku +
+ 1)) {
+ *info = -9;
+ }
+ }
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZLASCL", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0 || *m == 0) {
+ return 0;
+ }
+
+/* Get machine parameters */
+
+ smlnum = SAFEMINIMUM;
+ bignum = 1. / smlnum;
+
+ cfromc = *cfrom;
+ ctoc = *cto;
+
+L10:
+ cfrom1 = cfromc * smlnum;
+ cto1 = ctoc / bignum;
+ if ((abs(cfrom1) > abs(ctoc) && ctoc != 0.)) {
+ mul = smlnum;
+ done = FALSE_;
+ cfromc = cfrom1;
+ } else if (abs(cto1) > abs(cfromc)) {
+ mul = bignum;
+ done = FALSE_;
+ ctoc = cto1;
+ } else {
+ mul = ctoc / cfromc;
+ done = TRUE_;
+ }
+
+ if (itype == 0) {
+
+/* Full matrix */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ i__4 = i__ + j * a_dim1;
+ z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+/* L20: */
+ }
+/* L30: */
+ }
+
+ } else if (itype == 1) {
+
+/* Lower triangular matrix */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ i__4 = i__ + j * a_dim1;
+ z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+/* L40: */
+ }
+/* L50: */
+ }
+
+ } else if (itype == 2) {
+
+/* Upper triangular matrix */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = min(j,*m);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ i__4 = i__ + j * a_dim1;
+ z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+/* L60: */
+ }
+/* L70: */
+ }
+
+ } else if (itype == 3) {
+
+/* Upper Hessenberg matrix */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MIN */
+ i__3 = j + 1;
+ i__2 = min(i__3,*m);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ i__4 = i__ + j * a_dim1;
+ z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+/* L80: */
+ }
+/* L90: */
+ }
+
+ } else if (itype == 4) {
+
+/* Lower half of a symmetric band matrix */
+
+ k3 = *kl + 1;
+ k4 = *n + 1;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MIN */
+ i__3 = k3, i__4 = k4 - j;
+ i__2 = min(i__3,i__4);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ i__4 = i__ + j * a_dim1;
+ z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+/* L100: */
+ }
+/* L110: */
+ }
+
+ } else if (itype == 5) {
+
+/* Upper half of a symmetric band matrix */
+
+ k1 = *ku + 2;
+ k3 = *ku + 1;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MAX */
+ i__2 = k1 - j;
+ i__3 = k3;
+ for (i__ = max(i__2,1); i__ <= i__3; ++i__) {
+ i__2 = i__ + j * a_dim1;
+ i__4 = i__ + j * a_dim1;
+ z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
+ a[i__2].r = z__1.r, a[i__2].i = z__1.i;
+/* L120: */
+ }
+/* L130: */
+ }
+
+ } else if (itype == 6) {
+
+/* Band matrix */
+
+ k1 = *kl + *ku + 2;
+ k2 = *kl + 1;
+ k3 = ((*kl) << (1)) + *ku + 1;
+ k4 = *kl + *ku + 1 + *m;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MAX */
+ i__3 = k1 - j;
+/* Computing MIN */
+ i__4 = k3, i__5 = k4 - j;
+ i__2 = min(i__4,i__5);
+ for (i__ = max(i__3,k2); i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ i__4 = i__ + j * a_dim1;
+ z__1.r = mul * a[i__4].r, z__1.i = mul * a[i__4].i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+/* L140: */
+ }
+/* L150: */
+ }
+
+ }
+
+ if (! done) {
+ goto L10;
+ }
+
+ return 0;
+
+/* End of ZLASCL */
+
+} /* zlascl_ */
+
+/* Subroutine */ int zlaset_(char *uplo, integer *m, integer *n,
+ doublecomplex *alpha, doublecomplex *beta, doublecomplex *a, integer *
+ lda)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i__, j;
+ extern logical lsame_(char *, char *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ ZLASET initializes a 2-D array A to BETA on the diagonal and
+ ALPHA on the offdiagonals.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies the part of the matrix A to be set.
+ = 'U': Upper triangular part is set. The lower triangle
+ is unchanged.
+ = 'L': Lower triangular part is set. The upper triangle
+ is unchanged.
+ Otherwise: All of the matrix A is set.
+
+ M (input) INTEGER
+ On entry, M specifies the number of rows of A.
+
+ N (input) INTEGER
+ On entry, N specifies the number of columns of A.
+
+ ALPHA (input) COMPLEX*16
+ All the offdiagonal array elements are set to ALPHA.
+
+ BETA (input) COMPLEX*16
+ All the diagonal array elements are set to BETA.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the m by n matrix A.
+ On exit, A(i,j) = ALPHA, 1 <= i <= m, 1 <= j <= n, i.ne.j;
+ A(i,i) = BETA , 1 <= i <= min(m,n)
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+
+ /* Function Body */
+ if (lsame_(uplo, "U")) {
+
+/*
+ Set the diagonal to BETA and the strictly upper triangular
+ part of the array to ALPHA.
+*/
+
+ i__1 = *n;
+ for (j = 2; j <= i__1; ++j) {
+/* Computing MIN */
+ i__3 = j - 1;
+ i__2 = min(i__3,*m);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ a[i__3].r = alpha->r, a[i__3].i = alpha->i;
+/* L10: */
+ }
+/* L20: */
+ }
+ i__1 = min(*n,*m);
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__ + i__ * a_dim1;
+ a[i__2].r = beta->r, a[i__2].i = beta->i;
+/* L30: */
+ }
+
+ } else if (lsame_(uplo, "L")) {
+
+/*
+ Set the diagonal to BETA and the strictly lower triangular
+ part of the array to ALPHA.
+*/
+
+ i__1 = min(*m,*n);
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ a[i__3].r = alpha->r, a[i__3].i = alpha->i;
+/* L40: */
+ }
+/* L50: */
+ }
+ i__1 = min(*n,*m);
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__ + i__ * a_dim1;
+ a[i__2].r = beta->r, a[i__2].i = beta->i;
+/* L60: */
+ }
+
+ } else {
+
+/*
+ Set the array to BETA on the diagonal and ALPHA on the
+ offdiagonal.
+*/
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ a[i__3].r = alpha->r, a[i__3].i = alpha->i;
+/* L70: */
+ }
+/* L80: */
+ }
+ i__1 = min(*m,*n);
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__ + i__ * a_dim1;
+ a[i__2].r = beta->r, a[i__2].i = beta->i;
+/* L90: */
+ }
+ }
+
+ return 0;
+
+/* End of ZLASET */
+
+} /* zlaset_ */
+
+/* Subroutine */ int zlasr_(char *side, char *pivot, char *direct, integer *m,
+ integer *n, doublereal *c__, doublereal *s, doublecomplex *a,
+ integer *lda)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+ doublecomplex z__1, z__2, z__3;
+
+ /* Local variables */
+ static integer i__, j, info;
+ static doublecomplex temp;
+ extern logical lsame_(char *, char *);
+ static doublereal ctemp, stemp;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ October 31, 1992
+
+
+ Purpose
+ =======
+
+ ZLASR performs the transformation
+
+ A := P*A, when SIDE = 'L' or 'l' ( Left-hand side )
+
+ A := A*P', when SIDE = 'R' or 'r' ( Right-hand side )
+
+ where A is an m by n complex matrix and P is an orthogonal matrix,
+ consisting of a sequence of plane rotations determined by the
+ parameters PIVOT and DIRECT as follows ( z = m when SIDE = 'L' or 'l'
+ and z = n when SIDE = 'R' or 'r' ):
+
+ When DIRECT = 'F' or 'f' ( Forward sequence ) then
+
+ P = P( z - 1 )*...*P( 2 )*P( 1 ),
+
+ and when DIRECT = 'B' or 'b' ( Backward sequence ) then
+
+ P = P( 1 )*P( 2 )*...*P( z - 1 ),
+
+ where P( k ) is a plane rotation matrix for the following planes:
+
+ when PIVOT = 'V' or 'v' ( Variable pivot ),
+ the plane ( k, k + 1 )
+
+ when PIVOT = 'T' or 't' ( Top pivot ),
+ the plane ( 1, k + 1 )
+
+ when PIVOT = 'B' or 'b' ( Bottom pivot ),
+ the plane ( k, z )
+
+ c( k ) and s( k ) must contain the cosine and sine that define the
+ matrix P( k ). The two by two plane rotation part of the matrix
+ P( k ), R( k ), is assumed to be of the form
+
+ R( k ) = ( c( k ) s( k ) ).
+ ( -s( k ) c( k ) )
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ Specifies whether the plane rotation matrix P is applied to
+ A on the left or the right.
+ = 'L': Left, compute A := P*A
+ = 'R': Right, compute A:= A*P'
+
+ DIRECT (input) CHARACTER*1
+ Specifies whether P is a forward or backward sequence of
+ plane rotations.
+ = 'F': Forward, P = P( z - 1 )*...*P( 2 )*P( 1 )
+ = 'B': Backward, P = P( 1 )*P( 2 )*...*P( z - 1 )
+
+ PIVOT (input) CHARACTER*1
+ Specifies the plane for which P(k) is a plane rotation
+ matrix.
+ = 'V': Variable pivot, the plane (k,k+1)
+ = 'T': Top pivot, the plane (1,k+1)
+ = 'B': Bottom pivot, the plane (k,z)
+
+ M (input) INTEGER
+ The number of rows of the matrix A. If m <= 1, an immediate
+ return is effected.
+
+ N (input) INTEGER
+ The number of columns of the matrix A. If n <= 1, an
+ immediate return is effected.
+
+ C, S (input) DOUBLE PRECISION arrays, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ c(k) and s(k) contain the cosine and sine that define the
+ matrix P(k). The two by two plane rotation part of the
+ matrix P(k), R(k), is assumed to be of the form
+ R( k ) = ( c( k ) s( k ) ).
+ ( -s( k ) c( k ) )
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ The m by n matrix A. On exit, A is overwritten by P*A if
+ SIDE = 'R' or by A*P' if SIDE = 'L'.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,M).
+
+ =====================================================================
+
+
+ Test the input parameters
+*/
+
+ /* Parameter adjustments */
+ --c__;
+ --s;
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+
+ /* Function Body */
+ info = 0;
+ if (! (lsame_(side, "L") || lsame_(side, "R"))) {
+ info = 1;
+ } else if (! (lsame_(pivot, "V") || lsame_(pivot,
+ "T") || lsame_(pivot, "B"))) {
+ info = 2;
+ } else if (! (lsame_(direct, "F") || lsame_(direct,
+ "B"))) {
+ info = 3;
+ } else if (*m < 0) {
+ info = 4;
+ } else if (*n < 0) {
+ info = 5;
+ } else if (*lda < max(1,*m)) {
+ info = 9;
+ }
+ if (info != 0) {
+ xerbla_("ZLASR ", &info);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0) {
+ return 0;
+ }
+ if (lsame_(side, "L")) {
+
+/* Form P * A */
+
+ if (lsame_(pivot, "V")) {
+ if (lsame_(direct, "F")) {
+ i__1 = *m - 1;
+ for (j = 1; j <= i__1; ++j) {
+ ctemp = c__[j];
+ stemp = s[j];
+ if (ctemp != 1. || stemp != 0.) {
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = j + 1 + i__ * a_dim1;
+ temp.r = a[i__3].r, temp.i = a[i__3].i;
+ i__3 = j + 1 + i__ * a_dim1;
+ z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
+ i__4 = j + i__ * a_dim1;
+ z__3.r = stemp * a[i__4].r, z__3.i = stemp * a[
+ i__4].i;
+ z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
+ z__3.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+ i__3 = j + i__ * a_dim1;
+ z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
+ i__4 = j + i__ * a_dim1;
+ z__3.r = ctemp * a[i__4].r, z__3.i = ctemp * a[
+ i__4].i;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
+ z__3.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+/* L10: */
+ }
+ }
+/* L20: */
+ }
+ } else if (lsame_(direct, "B")) {
+ for (j = *m - 1; j >= 1; --j) {
+ ctemp = c__[j];
+ stemp = s[j];
+ if (ctemp != 1. || stemp != 0.) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = j + 1 + i__ * a_dim1;
+ temp.r = a[i__2].r, temp.i = a[i__2].i;
+ i__2 = j + 1 + i__ * a_dim1;
+ z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
+ i__3 = j + i__ * a_dim1;
+ z__3.r = stemp * a[i__3].r, z__3.i = stemp * a[
+ i__3].i;
+ z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
+ z__3.i;
+ a[i__2].r = z__1.r, a[i__2].i = z__1.i;
+ i__2 = j + i__ * a_dim1;
+ z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
+ i__3 = j + i__ * a_dim1;
+ z__3.r = ctemp * a[i__3].r, z__3.i = ctemp * a[
+ i__3].i;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
+ z__3.i;
+ a[i__2].r = z__1.r, a[i__2].i = z__1.i;
+/* L30: */
+ }
+ }
+/* L40: */
+ }
+ }
+ } else if (lsame_(pivot, "T")) {
+ if (lsame_(direct, "F")) {
+ i__1 = *m;
+ for (j = 2; j <= i__1; ++j) {
+ ctemp = c__[j - 1];
+ stemp = s[j - 1];
+ if (ctemp != 1. || stemp != 0.) {
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = j + i__ * a_dim1;
+ temp.r = a[i__3].r, temp.i = a[i__3].i;
+ i__3 = j + i__ * a_dim1;
+ z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
+ i__4 = i__ * a_dim1 + 1;
+ z__3.r = stemp * a[i__4].r, z__3.i = stemp * a[
+ i__4].i;
+ z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
+ z__3.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+ i__3 = i__ * a_dim1 + 1;
+ z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
+ i__4 = i__ * a_dim1 + 1;
+ z__3.r = ctemp * a[i__4].r, z__3.i = ctemp * a[
+ i__4].i;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
+ z__3.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+/* L50: */
+ }
+ }
+/* L60: */
+ }
+ } else if (lsame_(direct, "B")) {
+ for (j = *m; j >= 2; --j) {
+ ctemp = c__[j - 1];
+ stemp = s[j - 1];
+ if (ctemp != 1. || stemp != 0.) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = j + i__ * a_dim1;
+ temp.r = a[i__2].r, temp.i = a[i__2].i;
+ i__2 = j + i__ * a_dim1;
+ z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
+ i__3 = i__ * a_dim1 + 1;
+ z__3.r = stemp * a[i__3].r, z__3.i = stemp * a[
+ i__3].i;
+ z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
+ z__3.i;
+ a[i__2].r = z__1.r, a[i__2].i = z__1.i;
+ i__2 = i__ * a_dim1 + 1;
+ z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
+ i__3 = i__ * a_dim1 + 1;
+ z__3.r = ctemp * a[i__3].r, z__3.i = ctemp * a[
+ i__3].i;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
+ z__3.i;
+ a[i__2].r = z__1.r, a[i__2].i = z__1.i;
+/* L70: */
+ }
+ }
+/* L80: */
+ }
+ }
+ } else if (lsame_(pivot, "B")) {
+ if (lsame_(direct, "F")) {
+ i__1 = *m - 1;
+ for (j = 1; j <= i__1; ++j) {
+ ctemp = c__[j];
+ stemp = s[j];
+ if (ctemp != 1. || stemp != 0.) {
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = j + i__ * a_dim1;
+ temp.r = a[i__3].r, temp.i = a[i__3].i;
+ i__3 = j + i__ * a_dim1;
+ i__4 = *m + i__ * a_dim1;
+ z__2.r = stemp * a[i__4].r, z__2.i = stemp * a[
+ i__4].i;
+ z__3.r = ctemp * temp.r, z__3.i = ctemp * temp.i;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
+ z__3.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+ i__3 = *m + i__ * a_dim1;
+ i__4 = *m + i__ * a_dim1;
+ z__2.r = ctemp * a[i__4].r, z__2.i = ctemp * a[
+ i__4].i;
+ z__3.r = stemp * temp.r, z__3.i = stemp * temp.i;
+ z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
+ z__3.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+/* L90: */
+ }
+ }
+/* L100: */
+ }
+ } else if (lsame_(direct, "B")) {
+ for (j = *m - 1; j >= 1; --j) {
+ ctemp = c__[j];
+ stemp = s[j];
+ if (ctemp != 1. || stemp != 0.) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = j + i__ * a_dim1;
+ temp.r = a[i__2].r, temp.i = a[i__2].i;
+ i__2 = j + i__ * a_dim1;
+ i__3 = *m + i__ * a_dim1;
+ z__2.r = stemp * a[i__3].r, z__2.i = stemp * a[
+ i__3].i;
+ z__3.r = ctemp * temp.r, z__3.i = ctemp * temp.i;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
+ z__3.i;
+ a[i__2].r = z__1.r, a[i__2].i = z__1.i;
+ i__2 = *m + i__ * a_dim1;
+ i__3 = *m + i__ * a_dim1;
+ z__2.r = ctemp * a[i__3].r, z__2.i = ctemp * a[
+ i__3].i;
+ z__3.r = stemp * temp.r, z__3.i = stemp * temp.i;
+ z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
+ z__3.i;
+ a[i__2].r = z__1.r, a[i__2].i = z__1.i;
+/* L110: */
+ }
+ }
+/* L120: */
+ }
+ }
+ }
+ } else if (lsame_(side, "R")) {
+
+/* Form A * P' */
+
+ if (lsame_(pivot, "V")) {
+ if (lsame_(direct, "F")) {
+ i__1 = *n - 1;
+ for (j = 1; j <= i__1; ++j) {
+ ctemp = c__[j];
+ stemp = s[j];
+ if (ctemp != 1. || stemp != 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + (j + 1) * a_dim1;
+ temp.r = a[i__3].r, temp.i = a[i__3].i;
+ i__3 = i__ + (j + 1) * a_dim1;
+ z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
+ i__4 = i__ + j * a_dim1;
+ z__3.r = stemp * a[i__4].r, z__3.i = stemp * a[
+ i__4].i;
+ z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
+ z__3.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+ i__3 = i__ + j * a_dim1;
+ z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
+ i__4 = i__ + j * a_dim1;
+ z__3.r = ctemp * a[i__4].r, z__3.i = ctemp * a[
+ i__4].i;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
+ z__3.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+/* L130: */
+ }
+ }
+/* L140: */
+ }
+ } else if (lsame_(direct, "B")) {
+ for (j = *n - 1; j >= 1; --j) {
+ ctemp = c__[j];
+ stemp = s[j];
+ if (ctemp != 1. || stemp != 0.) {
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__ + (j + 1) * a_dim1;
+ temp.r = a[i__2].r, temp.i = a[i__2].i;
+ i__2 = i__ + (j + 1) * a_dim1;
+ z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
+ i__3 = i__ + j * a_dim1;
+ z__3.r = stemp * a[i__3].r, z__3.i = stemp * a[
+ i__3].i;
+ z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
+ z__3.i;
+ a[i__2].r = z__1.r, a[i__2].i = z__1.i;
+ i__2 = i__ + j * a_dim1;
+ z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
+ i__3 = i__ + j * a_dim1;
+ z__3.r = ctemp * a[i__3].r, z__3.i = ctemp * a[
+ i__3].i;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
+ z__3.i;
+ a[i__2].r = z__1.r, a[i__2].i = z__1.i;
+/* L150: */
+ }
+ }
+/* L160: */
+ }
+ }
+ } else if (lsame_(pivot, "T")) {
+ if (lsame_(direct, "F")) {
+ i__1 = *n;
+ for (j = 2; j <= i__1; ++j) {
+ ctemp = c__[j - 1];
+ stemp = s[j - 1];
+ if (ctemp != 1. || stemp != 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ temp.r = a[i__3].r, temp.i = a[i__3].i;
+ i__3 = i__ + j * a_dim1;
+ z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
+ i__4 = i__ + a_dim1;
+ z__3.r = stemp * a[i__4].r, z__3.i = stemp * a[
+ i__4].i;
+ z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
+ z__3.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+ i__3 = i__ + a_dim1;
+ z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
+ i__4 = i__ + a_dim1;
+ z__3.r = ctemp * a[i__4].r, z__3.i = ctemp * a[
+ i__4].i;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
+ z__3.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+/* L170: */
+ }
+ }
+/* L180: */
+ }
+ } else if (lsame_(direct, "B")) {
+ for (j = *n; j >= 2; --j) {
+ ctemp = c__[j - 1];
+ stemp = s[j - 1];
+ if (ctemp != 1. || stemp != 0.) {
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__ + j * a_dim1;
+ temp.r = a[i__2].r, temp.i = a[i__2].i;
+ i__2 = i__ + j * a_dim1;
+ z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
+ i__3 = i__ + a_dim1;
+ z__3.r = stemp * a[i__3].r, z__3.i = stemp * a[
+ i__3].i;
+ z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
+ z__3.i;
+ a[i__2].r = z__1.r, a[i__2].i = z__1.i;
+ i__2 = i__ + a_dim1;
+ z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
+ i__3 = i__ + a_dim1;
+ z__3.r = ctemp * a[i__3].r, z__3.i = ctemp * a[
+ i__3].i;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
+ z__3.i;
+ a[i__2].r = z__1.r, a[i__2].i = z__1.i;
+/* L190: */
+ }
+ }
+/* L200: */
+ }
+ }
+ } else if (lsame_(pivot, "B")) {
+ if (lsame_(direct, "F")) {
+ i__1 = *n - 1;
+ for (j = 1; j <= i__1; ++j) {
+ ctemp = c__[j];
+ stemp = s[j];
+ if (ctemp != 1. || stemp != 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ temp.r = a[i__3].r, temp.i = a[i__3].i;
+ i__3 = i__ + j * a_dim1;
+ i__4 = i__ + *n * a_dim1;
+ z__2.r = stemp * a[i__4].r, z__2.i = stemp * a[
+ i__4].i;
+ z__3.r = ctemp * temp.r, z__3.i = ctemp * temp.i;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
+ z__3.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+ i__3 = i__ + *n * a_dim1;
+ i__4 = i__ + *n * a_dim1;
+ z__2.r = ctemp * a[i__4].r, z__2.i = ctemp * a[
+ i__4].i;
+ z__3.r = stemp * temp.r, z__3.i = stemp * temp.i;
+ z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
+ z__3.i;
+ a[i__3].r = z__1.r, a[i__3].i = z__1.i;
+/* L210: */
+ }
+ }
+/* L220: */
+ }
+ } else if (lsame_(direct, "B")) {
+ for (j = *n - 1; j >= 1; --j) {
+ ctemp = c__[j];
+ stemp = s[j];
+ if (ctemp != 1. || stemp != 0.) {
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__ + j * a_dim1;
+ temp.r = a[i__2].r, temp.i = a[i__2].i;
+ i__2 = i__ + j * a_dim1;
+ i__3 = i__ + *n * a_dim1;
+ z__2.r = stemp * a[i__3].r, z__2.i = stemp * a[
+ i__3].i;
+ z__3.r = ctemp * temp.r, z__3.i = ctemp * temp.i;
+ z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
+ z__3.i;
+ a[i__2].r = z__1.r, a[i__2].i = z__1.i;
+ i__2 = i__ + *n * a_dim1;
+ i__3 = i__ + *n * a_dim1;
+ z__2.r = ctemp * a[i__3].r, z__2.i = ctemp * a[
+ i__3].i;
+ z__3.r = stemp * temp.r, z__3.i = stemp * temp.i;
+ z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
+ z__3.i;
+ a[i__2].r = z__1.r, a[i__2].i = z__1.i;
+/* L230: */
+ }
+ }
+/* L240: */
+ }
+ }
+ }
+ }
+
+ return 0;
+
+/* End of ZLASR */
+
+} /* zlasr_ */
+
+/* Subroutine */ int zlassq_(integer *n, doublecomplex *x, integer *incx,
+ doublereal *scale, doublereal *sumsq)
+{
+ /* System generated locals */
+ integer i__1, i__2, i__3;
+ doublereal d__1;
+
+ /* Builtin functions */
+ double d_imag(doublecomplex *);
+
+ /* Local variables */
+ static integer ix;
+ static doublereal temp1;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZLASSQ returns the values scl and ssq such that
+
+ ( scl**2 )*ssq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
+
+ where x( i ) = abs( X( 1 + ( i - 1 )*INCX ) ). The value of sumsq is
+ assumed to be at least unity and the value of ssq will then satisfy
+
+ 1.0 .le. ssq .le. ( sumsq + 2*n ).
+
+ scale is assumed to be non-negative and scl returns the value
+
+ scl = max( scale, abs( real( x( i ) ) ), abs( aimag( x( i ) ) ) ),
+ i
+
+ scale and sumsq must be supplied in SCALE and SUMSQ respectively.
+ SCALE and SUMSQ are overwritten by scl and ssq respectively.
+
+ The routine makes only one pass through the vector X.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of elements to be used from the vector X.
+
+ X (input) COMPLEX*16 array, dimension (N)
+ The vector x as described above.
+ x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
+
+ INCX (input) INTEGER
+ The increment between successive values of the vector X.
+ INCX > 0.
+
+ SCALE (input/output) DOUBLE PRECISION
+ On entry, the value scale in the equation above.
+ On exit, SCALE is overwritten with the value scl .
+
+ SUMSQ (input/output) DOUBLE PRECISION
+ On entry, the value sumsq in the equation above.
+ On exit, SUMSQ is overwritten with the value ssq .
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ if (*n > 0) {
+ i__1 = (*n - 1) * *incx + 1;
+ i__2 = *incx;
+ for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {
+ i__3 = ix;
+ if (x[i__3].r != 0.) {
+ i__3 = ix;
+ temp1 = (d__1 = x[i__3].r, abs(d__1));
+ if (*scale < temp1) {
+/* Computing 2nd power */
+ d__1 = *scale / temp1;
+ *sumsq = *sumsq * (d__1 * d__1) + 1;
+ *scale = temp1;
+ } else {
+/* Computing 2nd power */
+ d__1 = temp1 / *scale;
+ *sumsq += d__1 * d__1;
+ }
+ }
+ if (d_imag(&x[ix]) != 0.) {
+ temp1 = (d__1 = d_imag(&x[ix]), abs(d__1));
+ if (*scale < temp1) {
+/* Computing 2nd power */
+ d__1 = *scale / temp1;
+ *sumsq = *sumsq * (d__1 * d__1) + 1;
+ *scale = temp1;
+ } else {
+/* Computing 2nd power */
+ d__1 = temp1 / *scale;
+ *sumsq += d__1 * d__1;
+ }
+ }
+/* L10: */
+ }
+ }
+
+ return 0;
+
+/* End of ZLASSQ */
+
+} /* zlassq_ */
+
+/* Subroutine */ int zlaswp_(integer *n, doublecomplex *a, integer *lda,
+ integer *k1, integer *k2, integer *ipiv, integer *incx)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6;
+
+ /* Local variables */
+ static integer i__, j, k, i1, i2, n32, ip, ix, ix0, inc;
+ static doublecomplex temp;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZLASWP performs a series of row interchanges on the matrix A.
+ One row interchange is initiated for each of rows K1 through K2 of A.
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The number of columns of the matrix A.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the matrix of column dimension N to which the row
+ interchanges will be applied.
+ On exit, the permuted matrix.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+
+ K1 (input) INTEGER
+ The first element of IPIV for which a row interchange will
+ be done.
+
+ K2 (input) INTEGER
+ The last element of IPIV for which a row interchange will
+ be done.
+
+ IPIV (input) INTEGER array, dimension (M*abs(INCX))
+ The vector of pivot indices. Only the elements in positions
+ K1 through K2 of IPIV are accessed.
+ IPIV(K) = L implies rows K and L are to be interchanged.
+
+ INCX (input) INTEGER
+ The increment between successive values of IPIV. If IPIV
+ is negative, the pivots are applied in reverse order.
+
+ Further Details
+ ===============
+
+ Modified by
+ R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+
+ =====================================================================
+
+
+ Interchange row I with row IPIV(I) for each of rows K1 through K2.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --ipiv;
+
+ /* Function Body */
+ if (*incx > 0) {
+ ix0 = *k1;
+ i1 = *k1;
+ i2 = *k2;
+ inc = 1;
+ } else if (*incx < 0) {
+ ix0 = (1 - *k2) * *incx + 1;
+ i1 = *k2;
+ i2 = *k1;
+ inc = -1;
+ } else {
+ return 0;
+ }
+
+ n32 = (*n / 32) << (5);
+ if (n32 != 0) {
+ i__1 = n32;
+ for (j = 1; j <= i__1; j += 32) {
+ ix = ix0;
+ i__2 = i2;
+ i__3 = inc;
+ for (i__ = i1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__3)
+ {
+ ip = ipiv[ix];
+ if (ip != i__) {
+ i__4 = j + 31;
+ for (k = j; k <= i__4; ++k) {
+ i__5 = i__ + k * a_dim1;
+ temp.r = a[i__5].r, temp.i = a[i__5].i;
+ i__5 = i__ + k * a_dim1;
+ i__6 = ip + k * a_dim1;
+ a[i__5].r = a[i__6].r, a[i__5].i = a[i__6].i;
+ i__5 = ip + k * a_dim1;
+ a[i__5].r = temp.r, a[i__5].i = temp.i;
+/* L10: */
+ }
+ }
+ ix += *incx;
+/* L20: */
+ }
+/* L30: */
+ }
+ }
+ if (n32 != *n) {
+ ++n32;
+ ix = ix0;
+ i__1 = i2;
+ i__3 = inc;
+ for (i__ = i1; i__3 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__3) {
+ ip = ipiv[ix];
+ if (ip != i__) {
+ i__2 = *n;
+ for (k = n32; k <= i__2; ++k) {
+ i__4 = i__ + k * a_dim1;
+ temp.r = a[i__4].r, temp.i = a[i__4].i;
+ i__4 = i__ + k * a_dim1;
+ i__5 = ip + k * a_dim1;
+ a[i__4].r = a[i__5].r, a[i__4].i = a[i__5].i;
+ i__4 = ip + k * a_dim1;
+ a[i__4].r = temp.r, a[i__4].i = temp.i;
+/* L40: */
+ }
+ }
+ ix += *incx;
+/* L50: */
+ }
+ }
+
+ return 0;
+
+/* End of ZLASWP */
+
+} /* zlaswp_ */
+
+/* Subroutine */ int zlatrd_(char *uplo, integer *n, integer *nb,
+ doublecomplex *a, integer *lda, doublereal *e, doublecomplex *tau,
+ doublecomplex *w, integer *ldw)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3;
+ doublereal d__1;
+ doublecomplex z__1, z__2, z__3, z__4;
+
+ /* Local variables */
+ static integer i__, iw;
+ static doublecomplex alpha;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int zscal_(integer *, doublecomplex *,
+ doublecomplex *, integer *);
+ extern /* Double Complex */ VOID zdotc_(doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *);
+ extern /* Subroutine */ int zgemv_(char *, integer *, integer *,
+ doublecomplex *, doublecomplex *, integer *, doublecomplex *,
+ integer *, doublecomplex *, doublecomplex *, integer *),
+ zhemv_(char *, integer *, doublecomplex *, doublecomplex *,
+ integer *, doublecomplex *, integer *, doublecomplex *,
+ doublecomplex *, integer *), zaxpy_(integer *,
+ doublecomplex *, doublecomplex *, integer *, doublecomplex *,
+ integer *), zlarfg_(integer *, doublecomplex *, doublecomplex *,
+ integer *, doublecomplex *), zlacgv_(integer *, doublecomplex *,
+ integer *);
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZLATRD reduces NB rows and columns of a complex Hermitian matrix A to
+ Hermitian tridiagonal form by a unitary similarity
+ transformation Q' * A * Q, and returns the matrices V and W which are
+ needed to apply the transformation to the unreduced part of A.
+
+ If UPLO = 'U', ZLATRD reduces the last NB rows and columns of a
+ matrix, of which the upper triangle is supplied;
+ if UPLO = 'L', ZLATRD reduces the first NB rows and columns of a
+ matrix, of which the lower triangle is supplied.
+
+ This is an auxiliary routine called by ZHETRD.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER
+ Specifies whether the upper or lower triangular part of the
+ Hermitian matrix A is stored:
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A.
+
+ NB (input) INTEGER
+ The number of rows and columns to be reduced.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the Hermitian matrix A. If UPLO = 'U', the leading
+ n-by-n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n-by-n lower triangular part of A contains the lower
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+ On exit:
+ if UPLO = 'U', the last NB columns have been reduced to
+ tridiagonal form, with the diagonal elements overwriting
+ the diagonal elements of A; the elements above the diagonal
+ with the array TAU, represent the unitary matrix Q as a
+ product of elementary reflectors;
+ if UPLO = 'L', the first NB columns have been reduced to
+ tridiagonal form, with the diagonal elements overwriting
+ the diagonal elements of A; the elements below the diagonal
+ with the array TAU, represent the unitary matrix Q as a
+ product of elementary reflectors.
+ See Further Details.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ E (output) DOUBLE PRECISION array, dimension (N-1)
+ If UPLO = 'U', E(n-nb:n-1) contains the superdiagonal
+ elements of the last NB columns of the reduced matrix;
+ if UPLO = 'L', E(1:nb) contains the subdiagonal elements of
+ the first NB columns of the reduced matrix.
+
+ TAU (output) COMPLEX*16 array, dimension (N-1)
+ The scalar factors of the elementary reflectors, stored in
+ TAU(n-nb:n-1) if UPLO = 'U', and in TAU(1:nb) if UPLO = 'L'.
+ See Further Details.
+
+ W (output) COMPLEX*16 array, dimension (LDW,NB)
+ The n-by-nb matrix W required to update the unreduced part
+ of A.
+
+ LDW (input) INTEGER
+ The leading dimension of the array W. LDW >= max(1,N).
+
+ Further Details
+ ===============
+
+ If UPLO = 'U', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(n) H(n-1) . . . H(n-nb+1).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a complex scalar, and v is a complex vector with
+ v(i:n) = 0 and v(i-1) = 1; v(1:i-1) is stored on exit in A(1:i-1,i),
+ and tau in TAU(i-1).
+
+ If UPLO = 'L', the matrix Q is represented as a product of elementary
+ reflectors
+
+ Q = H(1) H(2) . . . H(nb).
+
+ Each H(i) has the form
+
+ H(i) = I - tau * v * v'
+
+ where tau is a complex scalar, and v is a complex vector with
+ v(1:i) = 0 and v(i+1) = 1; v(i+1:n) is stored on exit in A(i+1:n,i),
+ and tau in TAU(i).
+
+ The elements of the vectors v together form the n-by-nb matrix V
+ which is needed, with W, to apply the transformation to the unreduced
+ part of the matrix, using a Hermitian rank-2k update of the form:
+ A := A - V*W' - W*V'.
+
+ The contents of A on exit are illustrated by the following examples
+ with n = 5 and nb = 2:
+
+ if UPLO = 'U': if UPLO = 'L':
+
+ ( a a a v4 v5 ) ( d )
+ ( a a v4 v5 ) ( 1 d )
+ ( a 1 v5 ) ( v1 1 a )
+ ( d 1 ) ( v1 v2 a a )
+ ( d ) ( v1 v2 a a a )
+
+ where d denotes a diagonal element of the reduced matrix, a denotes
+ an element of the original matrix that is unchanged, and vi denotes
+ an element of the vector defining H(i).
+
+ =====================================================================
+
+
+ Quick return if possible
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --e;
+ --tau;
+ w_dim1 = *ldw;
+ w_offset = 1 + w_dim1 * 1;
+ w -= w_offset;
+
+ /* Function Body */
+ if (*n <= 0) {
+ return 0;
+ }
+
+ if (lsame_(uplo, "U")) {
+
+/* Reduce last NB columns of upper triangle */
+
+ i__1 = *n - *nb + 1;
+ for (i__ = *n; i__ >= i__1; --i__) {
+ iw = i__ - *n + *nb;
+ if (i__ < *n) {
+
+/* Update A(1:i,i) */
+
+ i__2 = i__ + i__ * a_dim1;
+ i__3 = i__ + i__ * a_dim1;
+ d__1 = a[i__3].r;
+ a[i__2].r = d__1, a[i__2].i = 0.;
+ i__2 = *n - i__;
+ zlacgv_(&i__2, &w[i__ + (iw + 1) * w_dim1], ldw);
+ i__2 = *n - i__;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__, &i__2, &z__1, &a[(i__ + 1) *
+ a_dim1 + 1], lda, &w[i__ + (iw + 1) * w_dim1], ldw, &
+ c_b60, &a[i__ * a_dim1 + 1], &c__1);
+ i__2 = *n - i__;
+ zlacgv_(&i__2, &w[i__ + (iw + 1) * w_dim1], ldw);
+ i__2 = *n - i__;
+ zlacgv_(&i__2, &a[i__ + (i__ + 1) * a_dim1], lda);
+ i__2 = *n - i__;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__, &i__2, &z__1, &w[(iw + 1) *
+ w_dim1 + 1], ldw, &a[i__ + (i__ + 1) * a_dim1], lda, &
+ c_b60, &a[i__ * a_dim1 + 1], &c__1);
+ i__2 = *n - i__;
+ zlacgv_(&i__2, &a[i__ + (i__ + 1) * a_dim1], lda);
+ i__2 = i__ + i__ * a_dim1;
+ i__3 = i__ + i__ * a_dim1;
+ d__1 = a[i__3].r;
+ a[i__2].r = d__1, a[i__2].i = 0.;
+ }
+ if (i__ > 1) {
+
+/*
+ Generate elementary reflector H(i) to annihilate
+ A(1:i-2,i)
+*/
+
+ i__2 = i__ - 1 + i__ * a_dim1;
+ alpha.r = a[i__2].r, alpha.i = a[i__2].i;
+ i__2 = i__ - 1;
+ zlarfg_(&i__2, &alpha, &a[i__ * a_dim1 + 1], &c__1, &tau[i__
+ - 1]);
+ i__2 = i__ - 1;
+ e[i__2] = alpha.r;
+ i__2 = i__ - 1 + i__ * a_dim1;
+ a[i__2].r = 1., a[i__2].i = 0.;
+
+/* Compute W(1:i-1,i) */
+
+ i__2 = i__ - 1;
+ zhemv_("Upper", &i__2, &c_b60, &a[a_offset], lda, &a[i__ *
+ a_dim1 + 1], &c__1, &c_b59, &w[iw * w_dim1 + 1], &
+ c__1);
+ if (i__ < *n) {
+ i__2 = i__ - 1;
+ i__3 = *n - i__;
+ zgemv_("Conjugate transpose", &i__2, &i__3, &c_b60, &w[(
+ iw + 1) * w_dim1 + 1], ldw, &a[i__ * a_dim1 + 1],
+ &c__1, &c_b59, &w[i__ + 1 + iw * w_dim1], &c__1);
+ i__2 = i__ - 1;
+ i__3 = *n - i__;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__3, &z__1, &a[(i__ + 1) *
+ a_dim1 + 1], lda, &w[i__ + 1 + iw * w_dim1], &
+ c__1, &c_b60, &w[iw * w_dim1 + 1], &c__1);
+ i__2 = i__ - 1;
+ i__3 = *n - i__;
+ zgemv_("Conjugate transpose", &i__2, &i__3, &c_b60, &a[(
+ i__ + 1) * a_dim1 + 1], lda, &a[i__ * a_dim1 + 1],
+ &c__1, &c_b59, &w[i__ + 1 + iw * w_dim1], &c__1);
+ i__2 = i__ - 1;
+ i__3 = *n - i__;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__3, &z__1, &w[(iw + 1) *
+ w_dim1 + 1], ldw, &w[i__ + 1 + iw * w_dim1], &
+ c__1, &c_b60, &w[iw * w_dim1 + 1], &c__1);
+ }
+ i__2 = i__ - 1;
+ zscal_(&i__2, &tau[i__ - 1], &w[iw * w_dim1 + 1], &c__1);
+ z__3.r = -.5, z__3.i = -0.;
+ i__2 = i__ - 1;
+ z__2.r = z__3.r * tau[i__2].r - z__3.i * tau[i__2].i, z__2.i =
+ z__3.r * tau[i__2].i + z__3.i * tau[i__2].r;
+ i__3 = i__ - 1;
+ zdotc_(&z__4, &i__3, &w[iw * w_dim1 + 1], &c__1, &a[i__ *
+ a_dim1 + 1], &c__1);
+ z__1.r = z__2.r * z__4.r - z__2.i * z__4.i, z__1.i = z__2.r *
+ z__4.i + z__2.i * z__4.r;
+ alpha.r = z__1.r, alpha.i = z__1.i;
+ i__2 = i__ - 1;
+ zaxpy_(&i__2, &alpha, &a[i__ * a_dim1 + 1], &c__1, &w[iw *
+ w_dim1 + 1], &c__1);
+ }
+
+/* L10: */
+ }
+ } else {
+
+/* Reduce first NB columns of lower triangle */
+
+ i__1 = *nb;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/* Update A(i:n,i) */
+
+ i__2 = i__ + i__ * a_dim1;
+ i__3 = i__ + i__ * a_dim1;
+ d__1 = a[i__3].r;
+ a[i__2].r = d__1, a[i__2].i = 0.;
+ i__2 = i__ - 1;
+ zlacgv_(&i__2, &w[i__ + w_dim1], ldw);
+ i__2 = *n - i__ + 1;
+ i__3 = i__ - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__3, &z__1, &a[i__ + a_dim1], lda,
+ &w[i__ + w_dim1], ldw, &c_b60, &a[i__ + i__ * a_dim1], &
+ c__1);
+ i__2 = i__ - 1;
+ zlacgv_(&i__2, &w[i__ + w_dim1], ldw);
+ i__2 = i__ - 1;
+ zlacgv_(&i__2, &a[i__ + a_dim1], lda);
+ i__2 = *n - i__ + 1;
+ i__3 = i__ - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__3, &z__1, &w[i__ + w_dim1], ldw,
+ &a[i__ + a_dim1], lda, &c_b60, &a[i__ + i__ * a_dim1], &
+ c__1);
+ i__2 = i__ - 1;
+ zlacgv_(&i__2, &a[i__ + a_dim1], lda);
+ i__2 = i__ + i__ * a_dim1;
+ i__3 = i__ + i__ * a_dim1;
+ d__1 = a[i__3].r;
+ a[i__2].r = d__1, a[i__2].i = 0.;
+ if (i__ < *n) {
+
+/*
+ Generate elementary reflector H(i) to annihilate
+ A(i+2:n,i)
+*/
+
+ i__2 = i__ + 1 + i__ * a_dim1;
+ alpha.r = a[i__2].r, alpha.i = a[i__2].i;
+ i__2 = *n - i__;
+/* Computing MIN */
+ i__3 = i__ + 2;
+ zlarfg_(&i__2, &alpha, &a[min(i__3,*n) + i__ * a_dim1], &c__1,
+ &tau[i__]);
+ i__2 = i__;
+ e[i__2] = alpha.r;
+ i__2 = i__ + 1 + i__ * a_dim1;
+ a[i__2].r = 1., a[i__2].i = 0.;
+
+/* Compute W(i+1:n,i) */
+
+ i__2 = *n - i__;
+ zhemv_("Lower", &i__2, &c_b60, &a[i__ + 1 + (i__ + 1) *
+ a_dim1], lda, &a[i__ + 1 + i__ * a_dim1], &c__1, &
+ c_b59, &w[i__ + 1 + i__ * w_dim1], &c__1);
+ i__2 = *n - i__;
+ i__3 = i__ - 1;
+ zgemv_("Conjugate transpose", &i__2, &i__3, &c_b60, &w[i__ +
+ 1 + w_dim1], ldw, &a[i__ + 1 + i__ * a_dim1], &c__1, &
+ c_b59, &w[i__ * w_dim1 + 1], &c__1);
+ i__2 = *n - i__;
+ i__3 = i__ - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__3, &z__1, &a[i__ + 1 +
+ a_dim1], lda, &w[i__ * w_dim1 + 1], &c__1, &c_b60, &w[
+ i__ + 1 + i__ * w_dim1], &c__1);
+ i__2 = *n - i__;
+ i__3 = i__ - 1;
+ zgemv_("Conjugate transpose", &i__2, &i__3, &c_b60, &a[i__ +
+ 1 + a_dim1], lda, &a[i__ + 1 + i__ * a_dim1], &c__1, &
+ c_b59, &w[i__ * w_dim1 + 1], &c__1);
+ i__2 = *n - i__;
+ i__3 = i__ - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__3, &z__1, &w[i__ + 1 +
+ w_dim1], ldw, &w[i__ * w_dim1 + 1], &c__1, &c_b60, &w[
+ i__ + 1 + i__ * w_dim1], &c__1);
+ i__2 = *n - i__;
+ zscal_(&i__2, &tau[i__], &w[i__ + 1 + i__ * w_dim1], &c__1);
+ z__3.r = -.5, z__3.i = -0.;
+ i__2 = i__;
+ z__2.r = z__3.r * tau[i__2].r - z__3.i * tau[i__2].i, z__2.i =
+ z__3.r * tau[i__2].i + z__3.i * tau[i__2].r;
+ i__3 = *n - i__;
+ zdotc_(&z__4, &i__3, &w[i__ + 1 + i__ * w_dim1], &c__1, &a[
+ i__ + 1 + i__ * a_dim1], &c__1);
+ z__1.r = z__2.r * z__4.r - z__2.i * z__4.i, z__1.i = z__2.r *
+ z__4.i + z__2.i * z__4.r;
+ alpha.r = z__1.r, alpha.i = z__1.i;
+ i__2 = *n - i__;
+ zaxpy_(&i__2, &alpha, &a[i__ + 1 + i__ * a_dim1], &c__1, &w[
+ i__ + 1 + i__ * w_dim1], &c__1);
+ }
+
+/* L20: */
+ }
+ }
+
+ return 0;
+
+/* End of ZLATRD */
+
+} /* zlatrd_ */
+
+/* Subroutine */ int zlatrs_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, doublecomplex *a, integer *lda, doublecomplex *x,
+ doublereal *scale, doublereal *cnorm, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
+ doublereal d__1, d__2, d__3, d__4;
+ doublecomplex z__1, z__2, z__3, z__4;
+
+ /* Builtin functions */
+ double d_imag(doublecomplex *);
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, j;
+ static doublereal xj, rec, tjj;
+ static integer jinc;
+ static doublereal xbnd;
+ static integer imax;
+ static doublereal tmax;
+ static doublecomplex tjjs;
+ static doublereal xmax, grow;
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *);
+ extern logical lsame_(char *, char *);
+ static doublereal tscal;
+ static doublecomplex uscal;
+ static integer jlast;
+ static doublecomplex csumj;
+ extern /* Double Complex */ VOID zdotc_(doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *);
+ static logical upper;
+ extern /* Double Complex */ VOID zdotu_(doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *);
+ extern /* Subroutine */ int zaxpy_(integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *), ztrsv_(
+ char *, char *, char *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *), dlabad_(
+ doublereal *, doublereal *);
+
+ extern integer idamax_(integer *, doublereal *, integer *);
+ extern /* Subroutine */ int xerbla_(char *, integer *), zdscal_(
+ integer *, doublereal *, doublecomplex *, integer *);
+ static doublereal bignum;
+ extern integer izamax_(integer *, doublecomplex *, integer *);
+ extern /* Double Complex */ VOID zladiv_(doublecomplex *, doublecomplex *,
+ doublecomplex *);
+ static logical notran;
+ static integer jfirst;
+ extern doublereal dzasum_(integer *, doublecomplex *, integer *);
+ static doublereal smlnum;
+ static logical nounit;
+
+
+/*
+ -- LAPACK auxiliary routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1992
+
+
+ Purpose
+ =======
+
+ ZLATRS solves one of the triangular systems
+
+ A * x = s*b, A**T * x = s*b, or A**H * x = s*b,
+
+ with scaling to prevent overflow. Here A is an upper or lower
+ triangular matrix, A**T denotes the transpose of A, A**H denotes the
+ conjugate transpose of A, x and b are n-element vectors, and s is a
+ scaling factor, usually less than or equal to 1, chosen so that the
+ components of x will be less than the overflow threshold. If the
+ unscaled problem will not cause overflow, the Level 2 BLAS routine
+ ZTRSV is called. If the matrix A is singular (A(j,j) = 0 for some j),
+ then s is set to 0 and a non-trivial solution to A*x = 0 is returned.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the matrix A is upper or lower triangular.
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ TRANS (input) CHARACTER*1
+ Specifies the operation applied to A.
+ = 'N': Solve A * x = s*b (No transpose)
+ = 'T': Solve A**T * x = s*b (Transpose)
+ = 'C': Solve A**H * x = s*b (Conjugate transpose)
+
+ DIAG (input) CHARACTER*1
+ Specifies whether or not the matrix A is unit triangular.
+ = 'N': Non-unit triangular
+ = 'U': Unit triangular
+
+ NORMIN (input) CHARACTER*1
+ Specifies whether CNORM has been set or not.
+ = 'Y': CNORM contains the column norms on entry
+ = 'N': CNORM is not set on entry. On exit, the norms will
+ be computed and stored in CNORM.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input) COMPLEX*16 array, dimension (LDA,N)
+ The triangular matrix A. If UPLO = 'U', the leading n by n
+ upper triangular part of the array A contains the upper
+ triangular matrix, and the strictly lower triangular part of
+ A is not referenced. If UPLO = 'L', the leading n by n lower
+ triangular part of the array A contains the lower triangular
+ matrix, and the strictly upper triangular part of A is not
+ referenced. If DIAG = 'U', the diagonal elements of A are
+ also not referenced and are assumed to be 1.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max (1,N).
+
+ X (input/output) COMPLEX*16 array, dimension (N)
+ On entry, the right hand side b of the triangular system.
+ On exit, X is overwritten by the solution vector x.
+
+ SCALE (output) DOUBLE PRECISION
+ The scaling factor s for the triangular system
+ A * x = s*b, A**T * x = s*b, or A**H * x = s*b.
+ If SCALE = 0, the matrix A is singular or badly scaled, and
+ the vector x is an exact or approximate solution to A*x = 0.
+
+ CNORM (input or output) DOUBLE PRECISION array, dimension (N)
+
+ If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
+ contains the norm of the off-diagonal part of the j-th column
+ of A. If TRANS = 'N', CNORM(j) must be greater than or equal
+ to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
+ must be greater than or equal to the 1-norm.
+
+ If NORMIN = 'N', CNORM is an output argument and CNORM(j)
+ returns the 1-norm of the offdiagonal part of the j-th column
+ of A.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+
+ Further Details
+ ======= =======
+
+ A rough bound on x is computed; if that is less than overflow, ZTRSV
+ is called, otherwise, specific code is used which checks for possible
+ overflow or divide-by-zero at every operation.
+
+ A columnwise scheme is used for solving A*x = b. The basic algorithm
+ if A is lower triangular is
+
+ x[1:n] := b[1:n]
+ for j = 1, ..., n
+ x(j) := x(j) / A(j,j)
+ x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
+ end
+
+ Define bounds on the components of x after j iterations of the loop:
+ M(j) = bound on x[1:j]
+ G(j) = bound on x[j+1:n]
+ Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
+
+ Then for iteration j+1 we have
+ M(j+1) <= G(j) / | A(j+1,j+1) |
+ G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
+ <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
+
+ where CNORM(j+1) is greater than or equal to the infinity-norm of
+ column j+1 of A, not counting the diagonal. Hence
+
+ G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
+ 1<=i<=j
+ and
+
+ |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
+ 1<=i< j
+
+ Since |x(j)| <= M(j), we use the Level 2 BLAS routine ZTRSV if the
+ reciprocal of the largest M(j), j=1,..,n, is larger than
+ max(underflow, 1/overflow).
+
+ The bound on x(j) is also used to determine when a step in the
+ columnwise method can be performed without fear of overflow. If
+ the computed bound is greater than a large constant, x is scaled to
+ prevent overflow, but if the bound overflows, x is set to 0, x(j) to
+ 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
+
+ Similarly, a row-wise scheme is used to solve A**T *x = b or
+ A**H *x = b. The basic algorithm for A upper triangular is
+
+ for j = 1, ..., n
+ x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j)
+ end
+
+ We simultaneously compute two bounds
+ G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j
+ M(j) = bound on x(i), 1<=i<=j
+
+ The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
+ add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
+ Then the bound on x(j) is
+
+ M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
+
+ <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
+ 1<=i<=j
+
+ and we can safely call ZTRSV if 1/M(n) and 1/G(n) are both greater
+ than max(underflow, 1/overflow).
+
+ =====================================================================
+*/
+
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --x;
+ --cnorm;
+
+ /* Function Body */
+ *info = 0;
+ upper = lsame_(uplo, "U");
+ notran = lsame_(trans, "N");
+ nounit = lsame_(diag, "N");
+
+/* Test the input parameters. */
+
+ if ((! upper && ! lsame_(uplo, "L"))) {
+ *info = -1;
+ } else if (((! notran && ! lsame_(trans, "T")) && !
+ lsame_(trans, "C"))) {
+ *info = -2;
+ } else if ((! nounit && ! lsame_(diag, "U"))) {
+ *info = -3;
+ } else if ((! lsame_(normin, "Y") && ! lsame_(
+ normin, "N"))) {
+ *info = -4;
+ } else if (*n < 0) {
+ *info = -5;
+ } else if (*lda < max(1,*n)) {
+ *info = -7;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZLATRS", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+/* Determine machine dependent parameters to control overflow. */
+
+ smlnum = SAFEMINIMUM;
+ bignum = 1. / smlnum;
+ dlabad_(&smlnum, &bignum);
+ smlnum /= PRECISION;
+ bignum = 1. / smlnum;
+ *scale = 1.;
+
+ if (lsame_(normin, "N")) {
+
+/* Compute the 1-norm of each column, not including the diagonal. */
+
+ if (upper) {
+
+/* A is upper triangular. */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = j - 1;
+ cnorm[j] = dzasum_(&i__2, &a[j * a_dim1 + 1], &c__1);
+/* L10: */
+ }
+ } else {
+
+/* A is lower triangular. */
+
+ i__1 = *n - 1;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n - j;
+ cnorm[j] = dzasum_(&i__2, &a[j + 1 + j * a_dim1], &c__1);
+/* L20: */
+ }
+ cnorm[*n] = 0.;
+ }
+ }
+
+/*
+ Scale the column norms by TSCAL if the maximum element in CNORM is
+ greater than BIGNUM/2.
+*/
+
+ imax = idamax_(n, &cnorm[1], &c__1);
+ tmax = cnorm[imax];
+ if (tmax <= bignum * .5) {
+ tscal = 1.;
+ } else {
+ tscal = .5 / (smlnum * tmax);
+ dscal_(n, &tscal, &cnorm[1], &c__1);
+ }
+
+/*
+ Compute a bound on the computed solution vector to see if the
+ Level 2 BLAS routine ZTRSV can be used.
+*/
+
+ xmax = 0.;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MAX */
+ i__2 = j;
+ d__3 = xmax, d__4 = (d__1 = x[i__2].r / 2., abs(d__1)) + (d__2 =
+ d_imag(&x[j]) / 2., abs(d__2));
+ xmax = max(d__3,d__4);
+/* L30: */
+ }
+ xbnd = xmax;
+
+ if (notran) {
+
+/* Compute the growth in A * x = b. */
+
+ if (upper) {
+ jfirst = *n;
+ jlast = 1;
+ jinc = -1;
+ } else {
+ jfirst = 1;
+ jlast = *n;
+ jinc = 1;
+ }
+
+ if (tscal != 1.) {
+ grow = 0.;
+ goto L60;
+ }
+
+ if (nounit) {
+
+/*
+ A is non-unit triangular.
+
+ Compute GROW = 1/G(j) and XBND = 1/M(j).
+ Initially, G(0) = max{x(i), i=1,...,n}.
+*/
+
+ grow = .5 / max(xbnd,smlnum);
+ xbnd = grow;
+ i__1 = jlast;
+ i__2 = jinc;
+ for (j = jfirst; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
+
+/* Exit the loop if the growth factor is too small. */
+
+ if (grow <= smlnum) {
+ goto L60;
+ }
+
+ i__3 = j + j * a_dim1;
+ tjjs.r = a[i__3].r, tjjs.i = a[i__3].i;
+ tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs), abs(
+ d__2));
+
+ if (tjj >= smlnum) {
+
+/*
+ M(j) = G(j-1) / abs(A(j,j))
+
+ Computing MIN
+*/
+ d__1 = xbnd, d__2 = min(1.,tjj) * grow;
+ xbnd = min(d__1,d__2);
+ } else {
+
+/* M(j) could overflow, set XBND to 0. */
+
+ xbnd = 0.;
+ }
+
+ if (tjj + cnorm[j] >= smlnum) {
+
+/* G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) ) */
+
+ grow *= tjj / (tjj + cnorm[j]);
+ } else {
+
+/* G(j) could overflow, set GROW to 0. */
+
+ grow = 0.;
+ }
+/* L40: */
+ }
+ grow = xbnd;
+ } else {
+
+/*
+ A is unit triangular.
+
+ Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
+
+ Computing MIN
+*/
+ d__1 = 1., d__2 = .5 / max(xbnd,smlnum);
+ grow = min(d__1,d__2);
+ i__2 = jlast;
+ i__1 = jinc;
+ for (j = jfirst; i__1 < 0 ? j >= i__2 : j <= i__2; j += i__1) {
+
+/* Exit the loop if the growth factor is too small. */
+
+ if (grow <= smlnum) {
+ goto L60;
+ }
+
+/* G(j) = G(j-1)*( 1 + CNORM(j) ) */
+
+ grow *= 1. / (cnorm[j] + 1.);
+/* L50: */
+ }
+ }
+L60:
+
+ ;
+ } else {
+
+/* Compute the growth in A**T * x = b or A**H * x = b. */
+
+ if (upper) {
+ jfirst = 1;
+ jlast = *n;
+ jinc = 1;
+ } else {
+ jfirst = *n;
+ jlast = 1;
+ jinc = -1;
+ }
+
+ if (tscal != 1.) {
+ grow = 0.;
+ goto L90;
+ }
+
+ if (nounit) {
+
+/*
+ A is non-unit triangular.
+
+ Compute GROW = 1/G(j) and XBND = 1/M(j).
+ Initially, M(0) = max{x(i), i=1,...,n}.
+*/
+
+ grow = .5 / max(xbnd,smlnum);
+ xbnd = grow;
+ i__1 = jlast;
+ i__2 = jinc;
+ for (j = jfirst; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
+
+/* Exit the loop if the growth factor is too small. */
+
+ if (grow <= smlnum) {
+ goto L90;
+ }
+
+/* G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) ) */
+
+ xj = cnorm[j] + 1.;
+/* Computing MIN */
+ d__1 = grow, d__2 = xbnd / xj;
+ grow = min(d__1,d__2);
+
+ i__3 = j + j * a_dim1;
+ tjjs.r = a[i__3].r, tjjs.i = a[i__3].i;
+ tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs), abs(
+ d__2));
+
+ if (tjj >= smlnum) {
+
+/* M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j)) */
+
+ if (xj > tjj) {
+ xbnd *= tjj / xj;
+ }
+ } else {
+
+/* M(j) could overflow, set XBND to 0. */
+
+ xbnd = 0.;
+ }
+/* L70: */
+ }
+ grow = min(grow,xbnd);
+ } else {
+
+/*
+ A is unit triangular.
+
+ Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}.
+
+ Computing MIN
+*/
+ d__1 = 1., d__2 = .5 / max(xbnd,smlnum);
+ grow = min(d__1,d__2);
+ i__2 = jlast;
+ i__1 = jinc;
+ for (j = jfirst; i__1 < 0 ? j >= i__2 : j <= i__2; j += i__1) {
+
+/* Exit the loop if the growth factor is too small. */
+
+ if (grow <= smlnum) {
+ goto L90;
+ }
+
+/* G(j) = ( 1 + CNORM(j) )*G(j-1) */
+
+ xj = cnorm[j] + 1.;
+ grow /= xj;
+/* L80: */
+ }
+ }
+L90:
+ ;
+ }
+
+ if (grow * tscal > smlnum) {
+
+/*
+ Use the Level 2 BLAS solve if the reciprocal of the bound on
+ elements of X is not too small.
+*/
+
+ ztrsv_(uplo, trans, diag, n, &a[a_offset], lda, &x[1], &c__1);
+ } else {
+
+/* Use a Level 1 BLAS solve, scaling intermediate results. */
+
+ if (xmax > bignum * .5) {
+
+/*
+ Scale X so that its components are less than or equal to
+ BIGNUM in absolute value.
+*/
+
+ *scale = bignum * .5 / xmax;
+ zdscal_(n, scale, &x[1], &c__1);
+ xmax = bignum;
+ } else {
+ xmax *= 2.;
+ }
+
+ if (notran) {
+
+/* Solve A * x = b */
+
+ i__1 = jlast;
+ i__2 = jinc;
+ for (j = jfirst; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
+
+/* Compute x(j) = b(j) / A(j,j), scaling x if necessary. */
+
+ i__3 = j;
+ xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j]),
+ abs(d__2));
+ if (nounit) {
+ i__3 = j + j * a_dim1;
+ z__1.r = tscal * a[i__3].r, z__1.i = tscal * a[i__3].i;
+ tjjs.r = z__1.r, tjjs.i = z__1.i;
+ } else {
+ tjjs.r = tscal, tjjs.i = 0.;
+ if (tscal == 1.) {
+ goto L110;
+ }
+ }
+ tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs), abs(
+ d__2));
+ if (tjj > smlnum) {
+
+/* abs(A(j,j)) > SMLNUM: */
+
+ if (tjj < 1.) {
+ if (xj > tjj * bignum) {
+
+/* Scale x by 1/b(j). */
+
+ rec = 1. / xj;
+ zdscal_(n, &rec, &x[1], &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ }
+ i__3 = j;
+ zladiv_(&z__1, &x[j], &tjjs);
+ x[i__3].r = z__1.r, x[i__3].i = z__1.i;
+ i__3 = j;
+ xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j])
+ , abs(d__2));
+ } else if (tjj > 0.) {
+
+/* 0 < abs(A(j,j)) <= SMLNUM: */
+
+ if (xj > tjj * bignum) {
+
+/*
+ Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM
+ to avoid overflow when dividing by A(j,j).
+*/
+
+ rec = tjj * bignum / xj;
+ if (cnorm[j] > 1.) {
+
+/*
+ Scale by 1/CNORM(j) to avoid overflow when
+ multiplying x(j) times column j.
+*/
+
+ rec /= cnorm[j];
+ }
+ zdscal_(n, &rec, &x[1], &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ i__3 = j;
+ zladiv_(&z__1, &x[j], &tjjs);
+ x[i__3].r = z__1.r, x[i__3].i = z__1.i;
+ i__3 = j;
+ xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j])
+ , abs(d__2));
+ } else {
+
+/*
+ A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
+ scale = 0, and compute a solution to A*x = 0.
+*/
+
+ i__3 = *n;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ i__4 = i__;
+ x[i__4].r = 0., x[i__4].i = 0.;
+/* L100: */
+ }
+ i__3 = j;
+ x[i__3].r = 1., x[i__3].i = 0.;
+ xj = 1.;
+ *scale = 0.;
+ xmax = 0.;
+ }
+L110:
+
+/*
+ Scale x if necessary to avoid overflow when adding a
+ multiple of column j of A.
+*/
+
+ if (xj > 1.) {
+ rec = 1. / xj;
+ if (cnorm[j] > (bignum - xmax) * rec) {
+
+/* Scale x by 1/(2*abs(x(j))). */
+
+ rec *= .5;
+ zdscal_(n, &rec, &x[1], &c__1);
+ *scale *= rec;
+ }
+ } else if (xj * cnorm[j] > bignum - xmax) {
+
+/* Scale x by 1/2. */
+
+ zdscal_(n, &c_b2210, &x[1], &c__1);
+ *scale *= .5;
+ }
+
+ if (upper) {
+ if (j > 1) {
+
+/*
+ Compute the update
+ x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j)
+*/
+
+ i__3 = j - 1;
+ i__4 = j;
+ z__2.r = -x[i__4].r, z__2.i = -x[i__4].i;
+ z__1.r = tscal * z__2.r, z__1.i = tscal * z__2.i;
+ zaxpy_(&i__3, &z__1, &a[j * a_dim1 + 1], &c__1, &x[1],
+ &c__1);
+ i__3 = j - 1;
+ i__ = izamax_(&i__3, &x[1], &c__1);
+ i__3 = i__;
+ xmax = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(
+ &x[i__]), abs(d__2));
+ }
+ } else {
+ if (j < *n) {
+
+/*
+ Compute the update
+ x(j+1:n) := x(j+1:n) - x(j) * A(j+1:n,j)
+*/
+
+ i__3 = *n - j;
+ i__4 = j;
+ z__2.r = -x[i__4].r, z__2.i = -x[i__4].i;
+ z__1.r = tscal * z__2.r, z__1.i = tscal * z__2.i;
+ zaxpy_(&i__3, &z__1, &a[j + 1 + j * a_dim1], &c__1, &
+ x[j + 1], &c__1);
+ i__3 = *n - j;
+ i__ = j + izamax_(&i__3, &x[j + 1], &c__1);
+ i__3 = i__;
+ xmax = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(
+ &x[i__]), abs(d__2));
+ }
+ }
+/* L120: */
+ }
+
+ } else if (lsame_(trans, "T")) {
+
+/* Solve A**T * x = b */
+
+ i__2 = jlast;
+ i__1 = jinc;
+ for (j = jfirst; i__1 < 0 ? j >= i__2 : j <= i__2; j += i__1) {
+
+/*
+ Compute x(j) = b(j) - sum A(k,j)*x(k).
+ k<>j
+*/
+
+ i__3 = j;
+ xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j]),
+ abs(d__2));
+ uscal.r = tscal, uscal.i = 0.;
+ rec = 1. / max(xmax,1.);
+ if (cnorm[j] > (bignum - xj) * rec) {
+
+/* If x(j) could overflow, scale x by 1/(2*XMAX). */
+
+ rec *= .5;
+ if (nounit) {
+ i__3 = j + j * a_dim1;
+ z__1.r = tscal * a[i__3].r, z__1.i = tscal * a[i__3]
+ .i;
+ tjjs.r = z__1.r, tjjs.i = z__1.i;
+ } else {
+ tjjs.r = tscal, tjjs.i = 0.;
+ }
+ tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs),
+ abs(d__2));
+ if (tjj > 1.) {
+
+/*
+ Divide by A(j,j) when scaling x if A(j,j) > 1.
+
+ Computing MIN
+*/
+ d__1 = 1., d__2 = rec * tjj;
+ rec = min(d__1,d__2);
+ zladiv_(&z__1, &uscal, &tjjs);
+ uscal.r = z__1.r, uscal.i = z__1.i;
+ }
+ if (rec < 1.) {
+ zdscal_(n, &rec, &x[1], &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ }
+
+ csumj.r = 0., csumj.i = 0.;
+ if ((uscal.r == 1. && uscal.i == 0.)) {
+
+/*
+ If the scaling needed for A in the dot product is 1,
+ call ZDOTU to perform the dot product.
+*/
+
+ if (upper) {
+ i__3 = j - 1;
+ zdotu_(&z__1, &i__3, &a[j * a_dim1 + 1], &c__1, &x[1],
+ &c__1);
+ csumj.r = z__1.r, csumj.i = z__1.i;
+ } else if (j < *n) {
+ i__3 = *n - j;
+ zdotu_(&z__1, &i__3, &a[j + 1 + j * a_dim1], &c__1, &
+ x[j + 1], &c__1);
+ csumj.r = z__1.r, csumj.i = z__1.i;
+ }
+ } else {
+
+/* Otherwise, use in-line code for the dot product. */
+
+ if (upper) {
+ i__3 = j - 1;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ i__4 = i__ + j * a_dim1;
+ z__3.r = a[i__4].r * uscal.r - a[i__4].i *
+ uscal.i, z__3.i = a[i__4].r * uscal.i + a[
+ i__4].i * uscal.r;
+ i__5 = i__;
+ z__2.r = z__3.r * x[i__5].r - z__3.i * x[i__5].i,
+ z__2.i = z__3.r * x[i__5].i + z__3.i * x[
+ i__5].r;
+ z__1.r = csumj.r + z__2.r, z__1.i = csumj.i +
+ z__2.i;
+ csumj.r = z__1.r, csumj.i = z__1.i;
+/* L130: */
+ }
+ } else if (j < *n) {
+ i__3 = *n;
+ for (i__ = j + 1; i__ <= i__3; ++i__) {
+ i__4 = i__ + j * a_dim1;
+ z__3.r = a[i__4].r * uscal.r - a[i__4].i *
+ uscal.i, z__3.i = a[i__4].r * uscal.i + a[
+ i__4].i * uscal.r;
+ i__5 = i__;
+ z__2.r = z__3.r * x[i__5].r - z__3.i * x[i__5].i,
+ z__2.i = z__3.r * x[i__5].i + z__3.i * x[
+ i__5].r;
+ z__1.r = csumj.r + z__2.r, z__1.i = csumj.i +
+ z__2.i;
+ csumj.r = z__1.r, csumj.i = z__1.i;
+/* L140: */
+ }
+ }
+ }
+
+ z__1.r = tscal, z__1.i = 0.;
+ if ((uscal.r == z__1.r && uscal.i == z__1.i)) {
+
+/*
+ Compute x(j) := ( x(j) - CSUMJ ) / A(j,j) if 1/A(j,j)
+ was not used to scale the dotproduct.
+*/
+
+ i__3 = j;
+ i__4 = j;
+ z__1.r = x[i__4].r - csumj.r, z__1.i = x[i__4].i -
+ csumj.i;
+ x[i__3].r = z__1.r, x[i__3].i = z__1.i;
+ i__3 = j;
+ xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j])
+ , abs(d__2));
+ if (nounit) {
+ i__3 = j + j * a_dim1;
+ z__1.r = tscal * a[i__3].r, z__1.i = tscal * a[i__3]
+ .i;
+ tjjs.r = z__1.r, tjjs.i = z__1.i;
+ } else {
+ tjjs.r = tscal, tjjs.i = 0.;
+ if (tscal == 1.) {
+ goto L160;
+ }
+ }
+
+/* Compute x(j) = x(j) / A(j,j), scaling if necessary. */
+
+ tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs),
+ abs(d__2));
+ if (tjj > smlnum) {
+
+/* abs(A(j,j)) > SMLNUM: */
+
+ if (tjj < 1.) {
+ if (xj > tjj * bignum) {
+
+/* Scale X by 1/abs(x(j)). */
+
+ rec = 1. / xj;
+ zdscal_(n, &rec, &x[1], &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ }
+ i__3 = j;
+ zladiv_(&z__1, &x[j], &tjjs);
+ x[i__3].r = z__1.r, x[i__3].i = z__1.i;
+ } else if (tjj > 0.) {
+
+/* 0 < abs(A(j,j)) <= SMLNUM: */
+
+ if (xj > tjj * bignum) {
+
+/* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM. */
+
+ rec = tjj * bignum / xj;
+ zdscal_(n, &rec, &x[1], &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ i__3 = j;
+ zladiv_(&z__1, &x[j], &tjjs);
+ x[i__3].r = z__1.r, x[i__3].i = z__1.i;
+ } else {
+
+/*
+ A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
+ scale = 0 and compute a solution to A**T *x = 0.
+*/
+
+ i__3 = *n;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ i__4 = i__;
+ x[i__4].r = 0., x[i__4].i = 0.;
+/* L150: */
+ }
+ i__3 = j;
+ x[i__3].r = 1., x[i__3].i = 0.;
+ *scale = 0.;
+ xmax = 0.;
+ }
+L160:
+ ;
+ } else {
+
+/*
+ Compute x(j) := x(j) / A(j,j) - CSUMJ if the dot
+ product has already been divided by 1/A(j,j).
+*/
+
+ i__3 = j;
+ zladiv_(&z__2, &x[j], &tjjs);
+ z__1.r = z__2.r - csumj.r, z__1.i = z__2.i - csumj.i;
+ x[i__3].r = z__1.r, x[i__3].i = z__1.i;
+ }
+/* Computing MAX */
+ i__3 = j;
+ d__3 = xmax, d__4 = (d__1 = x[i__3].r, abs(d__1)) + (d__2 =
+ d_imag(&x[j]), abs(d__2));
+ xmax = max(d__3,d__4);
+/* L170: */
+ }
+
+ } else {
+
+/* Solve A**H * x = b */
+
+ i__1 = jlast;
+ i__2 = jinc;
+ for (j = jfirst; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
+
+/*
+ Compute x(j) = b(j) - sum A(k,j)*x(k).
+ k<>j
+*/
+
+ i__3 = j;
+ xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j]),
+ abs(d__2));
+ uscal.r = tscal, uscal.i = 0.;
+ rec = 1. / max(xmax,1.);
+ if (cnorm[j] > (bignum - xj) * rec) {
+
+/* If x(j) could overflow, scale x by 1/(2*XMAX). */
+
+ rec *= .5;
+ if (nounit) {
+ d_cnjg(&z__2, &a[j + j * a_dim1]);
+ z__1.r = tscal * z__2.r, z__1.i = tscal * z__2.i;
+ tjjs.r = z__1.r, tjjs.i = z__1.i;
+ } else {
+ tjjs.r = tscal, tjjs.i = 0.;
+ }
+ tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs),
+ abs(d__2));
+ if (tjj > 1.) {
+
+/*
+ Divide by A(j,j) when scaling x if A(j,j) > 1.
+
+ Computing MIN
+*/
+ d__1 = 1., d__2 = rec * tjj;
+ rec = min(d__1,d__2);
+ zladiv_(&z__1, &uscal, &tjjs);
+ uscal.r = z__1.r, uscal.i = z__1.i;
+ }
+ if (rec < 1.) {
+ zdscal_(n, &rec, &x[1], &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ }
+
+ csumj.r = 0., csumj.i = 0.;
+ if ((uscal.r == 1. && uscal.i == 0.)) {
+
+/*
+ If the scaling needed for A in the dot product is 1,
+ call ZDOTC to perform the dot product.
+*/
+
+ if (upper) {
+ i__3 = j - 1;
+ zdotc_(&z__1, &i__3, &a[j * a_dim1 + 1], &c__1, &x[1],
+ &c__1);
+ csumj.r = z__1.r, csumj.i = z__1.i;
+ } else if (j < *n) {
+ i__3 = *n - j;
+ zdotc_(&z__1, &i__3, &a[j + 1 + j * a_dim1], &c__1, &
+ x[j + 1], &c__1);
+ csumj.r = z__1.r, csumj.i = z__1.i;
+ }
+ } else {
+
+/* Otherwise, use in-line code for the dot product. */
+
+ if (upper) {
+ i__3 = j - 1;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ d_cnjg(&z__4, &a[i__ + j * a_dim1]);
+ z__3.r = z__4.r * uscal.r - z__4.i * uscal.i,
+ z__3.i = z__4.r * uscal.i + z__4.i *
+ uscal.r;
+ i__4 = i__;
+ z__2.r = z__3.r * x[i__4].r - z__3.i * x[i__4].i,
+ z__2.i = z__3.r * x[i__4].i + z__3.i * x[
+ i__4].r;
+ z__1.r = csumj.r + z__2.r, z__1.i = csumj.i +
+ z__2.i;
+ csumj.r = z__1.r, csumj.i = z__1.i;
+/* L180: */
+ }
+ } else if (j < *n) {
+ i__3 = *n;
+ for (i__ = j + 1; i__ <= i__3; ++i__) {
+ d_cnjg(&z__4, &a[i__ + j * a_dim1]);
+ z__3.r = z__4.r * uscal.r - z__4.i * uscal.i,
+ z__3.i = z__4.r * uscal.i + z__4.i *
+ uscal.r;
+ i__4 = i__;
+ z__2.r = z__3.r * x[i__4].r - z__3.i * x[i__4].i,
+ z__2.i = z__3.r * x[i__4].i + z__3.i * x[
+ i__4].r;
+ z__1.r = csumj.r + z__2.r, z__1.i = csumj.i +
+ z__2.i;
+ csumj.r = z__1.r, csumj.i = z__1.i;
+/* L190: */
+ }
+ }
+ }
+
+ z__1.r = tscal, z__1.i = 0.;
+ if ((uscal.r == z__1.r && uscal.i == z__1.i)) {
+
+/*
+ Compute x(j) := ( x(j) - CSUMJ ) / A(j,j) if 1/A(j,j)
+ was not used to scale the dotproduct.
+*/
+
+ i__3 = j;
+ i__4 = j;
+ z__1.r = x[i__4].r - csumj.r, z__1.i = x[i__4].i -
+ csumj.i;
+ x[i__3].r = z__1.r, x[i__3].i = z__1.i;
+ i__3 = j;
+ xj = (d__1 = x[i__3].r, abs(d__1)) + (d__2 = d_imag(&x[j])
+ , abs(d__2));
+ if (nounit) {
+ d_cnjg(&z__2, &a[j + j * a_dim1]);
+ z__1.r = tscal * z__2.r, z__1.i = tscal * z__2.i;
+ tjjs.r = z__1.r, tjjs.i = z__1.i;
+ } else {
+ tjjs.r = tscal, tjjs.i = 0.;
+ if (tscal == 1.) {
+ goto L210;
+ }
+ }
+
+/* Compute x(j) = x(j) / A(j,j), scaling if necessary. */
+
+ tjj = (d__1 = tjjs.r, abs(d__1)) + (d__2 = d_imag(&tjjs),
+ abs(d__2));
+ if (tjj > smlnum) {
+
+/* abs(A(j,j)) > SMLNUM: */
+
+ if (tjj < 1.) {
+ if (xj > tjj * bignum) {
+
+/* Scale X by 1/abs(x(j)). */
+
+ rec = 1. / xj;
+ zdscal_(n, &rec, &x[1], &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ }
+ i__3 = j;
+ zladiv_(&z__1, &x[j], &tjjs);
+ x[i__3].r = z__1.r, x[i__3].i = z__1.i;
+ } else if (tjj > 0.) {
+
+/* 0 < abs(A(j,j)) <= SMLNUM: */
+
+ if (xj > tjj * bignum) {
+
+/* Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM. */
+
+ rec = tjj * bignum / xj;
+ zdscal_(n, &rec, &x[1], &c__1);
+ *scale *= rec;
+ xmax *= rec;
+ }
+ i__3 = j;
+ zladiv_(&z__1, &x[j], &tjjs);
+ x[i__3].r = z__1.r, x[i__3].i = z__1.i;
+ } else {
+
+/*
+ A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and
+ scale = 0 and compute a solution to A**H *x = 0.
+*/
+
+ i__3 = *n;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ i__4 = i__;
+ x[i__4].r = 0., x[i__4].i = 0.;
+/* L200: */
+ }
+ i__3 = j;
+ x[i__3].r = 1., x[i__3].i = 0.;
+ *scale = 0.;
+ xmax = 0.;
+ }
+L210:
+ ;
+ } else {
+
+/*
+ Compute x(j) := x(j) / A(j,j) - CSUMJ if the dot
+ product has already been divided by 1/A(j,j).
+*/
+
+ i__3 = j;
+ zladiv_(&z__2, &x[j], &tjjs);
+ z__1.r = z__2.r - csumj.r, z__1.i = z__2.i - csumj.i;
+ x[i__3].r = z__1.r, x[i__3].i = z__1.i;
+ }
+/* Computing MAX */
+ i__3 = j;
+ d__3 = xmax, d__4 = (d__1 = x[i__3].r, abs(d__1)) + (d__2 =
+ d_imag(&x[j]), abs(d__2));
+ xmax = max(d__3,d__4);
+/* L220: */
+ }
+ }
+ *scale /= tscal;
+ }
+
+/* Scale the column norms by 1/TSCAL for return. */
+
+ if (tscal != 1.) {
+ d__1 = 1. / tscal;
+ dscal_(n, &d__1, &cnorm[1], &c__1);
+ }
+
+ return 0;
+
+/* End of ZLATRS */
+
+} /* zlatrs_ */
+
+/* Subroutine */ int zpotf2_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+ doublereal d__1;
+ doublecomplex z__1, z__2;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static integer j;
+ static doublereal ajj;
+ extern logical lsame_(char *, char *);
+ extern /* Double Complex */ VOID zdotc_(doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *);
+ extern /* Subroutine */ int zgemv_(char *, integer *, integer *,
+ doublecomplex *, doublecomplex *, integer *, doublecomplex *,
+ integer *, doublecomplex *, doublecomplex *, integer *);
+ static logical upper;
+ extern /* Subroutine */ int xerbla_(char *, integer *), zdscal_(
+ integer *, doublereal *, doublecomplex *, integer *), zlacgv_(
+ integer *, doublecomplex *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZPOTF2 computes the Cholesky factorization of a complex Hermitian
+ positive definite matrix A.
+
+ The factorization has the form
+ A = U' * U , if UPLO = 'U', or
+ A = L * L', if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ This is the unblocked version of the algorithm, calling Level 2 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ Specifies whether the upper or lower triangular part of the
+ Hermitian matrix A is stored.
+ = 'U': Upper triangular
+ = 'L': Lower triangular
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the Hermitian matrix A. If UPLO = 'U', the leading
+ n by n upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading n by n lower triangular part of A contains the lower
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U'*U or A = L*L'.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -k, the k-th argument had an illegal value
+ > 0: if INFO = k, the leading minor of order k is not
+ positive definite, and the factorization could not be
+ completed.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+
+ /* Function Body */
+ *info = 0;
+ upper = lsame_(uplo, "U");
+ if ((! upper && ! lsame_(uplo, "L"))) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*n)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZPOTF2", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+ if (upper) {
+
+/* Compute the Cholesky factorization A = U'*U. */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+
+/* Compute U(J,J) and test for non-positive-definiteness. */
+
+ i__2 = j + j * a_dim1;
+ d__1 = a[i__2].r;
+ i__3 = j - 1;
+ zdotc_(&z__2, &i__3, &a[j * a_dim1 + 1], &c__1, &a[j * a_dim1 + 1]
+ , &c__1);
+ z__1.r = d__1 - z__2.r, z__1.i = -z__2.i;
+ ajj = z__1.r;
+ if (ajj <= 0.) {
+ i__2 = j + j * a_dim1;
+ a[i__2].r = ajj, a[i__2].i = 0.;
+ goto L30;
+ }
+ ajj = sqrt(ajj);
+ i__2 = j + j * a_dim1;
+ a[i__2].r = ajj, a[i__2].i = 0.;
+
+/* Compute elements J+1:N of row J. */
+
+ if (j < *n) {
+ i__2 = j - 1;
+ zlacgv_(&i__2, &a[j * a_dim1 + 1], &c__1);
+ i__2 = j - 1;
+ i__3 = *n - j;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("Transpose", &i__2, &i__3, &z__1, &a[(j + 1) * a_dim1
+ + 1], lda, &a[j * a_dim1 + 1], &c__1, &c_b60, &a[j + (
+ j + 1) * a_dim1], lda);
+ i__2 = j - 1;
+ zlacgv_(&i__2, &a[j * a_dim1 + 1], &c__1);
+ i__2 = *n - j;
+ d__1 = 1. / ajj;
+ zdscal_(&i__2, &d__1, &a[j + (j + 1) * a_dim1], lda);
+ }
+/* L10: */
+ }
+ } else {
+
+/* Compute the Cholesky factorization A = L*L'. */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+
+/* Compute L(J,J) and test for non-positive-definiteness. */
+
+ i__2 = j + j * a_dim1;
+ d__1 = a[i__2].r;
+ i__3 = j - 1;
+ zdotc_(&z__2, &i__3, &a[j + a_dim1], lda, &a[j + a_dim1], lda);
+ z__1.r = d__1 - z__2.r, z__1.i = -z__2.i;
+ ajj = z__1.r;
+ if (ajj <= 0.) {
+ i__2 = j + j * a_dim1;
+ a[i__2].r = ajj, a[i__2].i = 0.;
+ goto L30;
+ }
+ ajj = sqrt(ajj);
+ i__2 = j + j * a_dim1;
+ a[i__2].r = ajj, a[i__2].i = 0.;
+
+/* Compute elements J+1:N of column J. */
+
+ if (j < *n) {
+ i__2 = j - 1;
+ zlacgv_(&i__2, &a[j + a_dim1], lda);
+ i__2 = *n - j;
+ i__3 = j - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemv_("No transpose", &i__2, &i__3, &z__1, &a[j + 1 + a_dim1]
+ , lda, &a[j + a_dim1], lda, &c_b60, &a[j + 1 + j *
+ a_dim1], &c__1);
+ i__2 = j - 1;
+ zlacgv_(&i__2, &a[j + a_dim1], lda);
+ i__2 = *n - j;
+ d__1 = 1. / ajj;
+ zdscal_(&i__2, &d__1, &a[j + 1 + j * a_dim1], &c__1);
+ }
+/* L20: */
+ }
+ }
+ goto L40;
+
+L30:
+ *info = j;
+
+L40:
+ return 0;
+
+/* End of ZPOTF2 */
+
+} /* zpotf2_ */
+
+/* Subroutine */ int zpotrf_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer j, jb, nb;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int zgemm_(char *, char *, integer *, integer *,
+ integer *, doublecomplex *, doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *), zherk_(char *, char *, integer *,
+ integer *, doublereal *, doublecomplex *, integer *, doublereal *,
+ doublecomplex *, integer *);
+ static logical upper;
+ extern /* Subroutine */ int ztrsm_(char *, char *, char *, char *,
+ integer *, integer *, doublecomplex *, doublecomplex *, integer *,
+ doublecomplex *, integer *),
+ zpotf2_(char *, integer *, doublecomplex *, integer *, integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZPOTRF computes the Cholesky factorization of a complex Hermitian
+ positive definite matrix A.
+
+ The factorization has the form
+ A = U**H * U, if UPLO = 'U', or
+ A = L * L**H, if UPLO = 'L',
+ where U is an upper triangular matrix and L is lower triangular.
+
+ This is the block version of the algorithm, calling Level 3 BLAS.
+
+ Arguments
+ =========
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A is stored;
+ = 'L': Lower triangle of A is stored.
+
+ N (input) INTEGER
+ The order of the matrix A. N >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the Hermitian matrix A. If UPLO = 'U', the leading
+ N-by-N upper triangular part of A contains the upper
+ triangular part of the matrix A, and the strictly lower
+ triangular part of A is not referenced. If UPLO = 'L', the
+ leading N-by-N lower triangular part of A contains the lower
+ triangular part of the matrix A, and the strictly upper
+ triangular part of A is not referenced.
+
+ On exit, if INFO = 0, the factor U or L from the Cholesky
+ factorization A = U**H*U or A = L*L**H.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: if INFO = i, the leading minor of order i is not
+ positive definite, and the factorization could not be
+ completed.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+
+ /* Function Body */
+ *info = 0;
+ upper = lsame_(uplo, "U");
+ if ((! upper && ! lsame_(uplo, "L"))) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*n)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZPOTRF", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+/* Determine the block size for this environment. */
+
+ nb = ilaenv_(&c__1, "ZPOTRF", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (
+ ftnlen)1);
+ if (nb <= 1 || nb >= *n) {
+
+/* Use unblocked code. */
+
+ zpotf2_(uplo, n, &a[a_offset], lda, info);
+ } else {
+
+/* Use blocked code. */
+
+ if (upper) {
+
+/* Compute the Cholesky factorization A = U'*U. */
+
+ i__1 = *n;
+ i__2 = nb;
+ for (j = 1; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
+
+/*
+ Update and factorize the current diagonal block and test
+ for non-positive-definiteness.
+
+ Computing MIN
+*/
+ i__3 = nb, i__4 = *n - j + 1;
+ jb = min(i__3,i__4);
+ i__3 = j - 1;
+ zherk_("Upper", "Conjugate transpose", &jb, &i__3, &c_b1294, &
+ a[j * a_dim1 + 1], lda, &c_b1015, &a[j + j * a_dim1],
+ lda);
+ zpotf2_("Upper", &jb, &a[j + j * a_dim1], lda, info);
+ if (*info != 0) {
+ goto L30;
+ }
+ if (j + jb <= *n) {
+
+/* Compute the current block row. */
+
+ i__3 = *n - j - jb + 1;
+ i__4 = j - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemm_("Conjugate transpose", "No transpose", &jb, &i__3,
+ &i__4, &z__1, &a[j * a_dim1 + 1], lda, &a[(j + jb)
+ * a_dim1 + 1], lda, &c_b60, &a[j + (j + jb) *
+ a_dim1], lda);
+ i__3 = *n - j - jb + 1;
+ ztrsm_("Left", "Upper", "Conjugate transpose", "Non-unit",
+ &jb, &i__3, &c_b60, &a[j + j * a_dim1], lda, &a[
+ j + (j + jb) * a_dim1], lda);
+ }
+/* L10: */
+ }
+
+ } else {
+
+/* Compute the Cholesky factorization A = L*L'. */
+
+ i__2 = *n;
+ i__1 = nb;
+ for (j = 1; i__1 < 0 ? j >= i__2 : j <= i__2; j += i__1) {
+
+/*
+ Update and factorize the current diagonal block and test
+ for non-positive-definiteness.
+
+ Computing MIN
+*/
+ i__3 = nb, i__4 = *n - j + 1;
+ jb = min(i__3,i__4);
+ i__3 = j - 1;
+ zherk_("Lower", "No transpose", &jb, &i__3, &c_b1294, &a[j +
+ a_dim1], lda, &c_b1015, &a[j + j * a_dim1], lda);
+ zpotf2_("Lower", &jb, &a[j + j * a_dim1], lda, info);
+ if (*info != 0) {
+ goto L30;
+ }
+ if (j + jb <= *n) {
+
+/* Compute the current block column. */
+
+ i__3 = *n - j - jb + 1;
+ i__4 = j - 1;
+ z__1.r = -1., z__1.i = -0.;
+ zgemm_("No transpose", "Conjugate transpose", &i__3, &jb,
+ &i__4, &z__1, &a[j + jb + a_dim1], lda, &a[j +
+ a_dim1], lda, &c_b60, &a[j + jb + j * a_dim1],
+ lda);
+ i__3 = *n - j - jb + 1;
+ ztrsm_("Right", "Lower", "Conjugate transpose", "Non-unit"
+ , &i__3, &jb, &c_b60, &a[j + j * a_dim1], lda, &a[
+ j + jb + j * a_dim1], lda);
+ }
+/* L20: */
+ }
+ }
+ }
+ goto L40;
+
+L30:
+ *info = *info + j - 1;
+
+L40:
+ return 0;
+
+/* End of ZPOTRF */
+
+} /* zpotrf_ */
+
+/* Subroutine */ int zstedc_(char *compz, integer *n, doublereal *d__,
+ doublereal *e, doublecomplex *z__, integer *ldz, doublecomplex *work,
+ integer *lwork, doublereal *rwork, integer *lrwork, integer *iwork,
+ integer *liwork, integer *info)
+{
+ /* System generated locals */
+ integer z_dim1, z_offset, i__1, i__2, i__3, i__4;
+ doublereal d__1, d__2;
+
+ /* Builtin functions */
+ double log(doublereal);
+ integer pow_ii(integer *, integer *);
+ double sqrt(doublereal);
+
+ /* Local variables */
+ static integer i__, j, k, m;
+ static doublereal p;
+ static integer ii, ll, end, lgn;
+ static doublereal eps, tiny;
+ extern logical lsame_(char *, char *);
+ static integer lwmin, start;
+ extern /* Subroutine */ int zswap_(integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *), zlaed0_(integer *, integer *,
+ doublereal *, doublereal *, doublecomplex *, integer *,
+ doublecomplex *, integer *, doublereal *, integer *, integer *);
+
+ extern /* Subroutine */ int dlascl_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, integer *, doublereal *,
+ integer *, integer *), dstedc_(char *, integer *,
+ doublereal *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, integer *, integer *, integer *), dlaset_(
+ char *, integer *, integer *, doublereal *, doublereal *,
+ doublereal *, integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *);
+ extern /* Subroutine */ int dsterf_(integer *, doublereal *, doublereal *,
+ integer *), zlacrm_(integer *, integer *, doublecomplex *,
+ integer *, doublereal *, integer *, doublecomplex *, integer *,
+ doublereal *);
+ static integer liwmin, icompz;
+ extern /* Subroutine */ int dsteqr_(char *, integer *, doublereal *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *), zlacpy_(char *, integer *, integer *, doublecomplex *,
+ integer *, doublecomplex *, integer *);
+ static doublereal orgnrm;
+ static integer lrwmin;
+ static logical lquery;
+ static integer smlsiz;
+ extern /* Subroutine */ int zsteqr_(char *, integer *, doublereal *,
+ doublereal *, doublecomplex *, integer *, doublereal *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZSTEDC computes all eigenvalues and, optionally, eigenvectors of a
+ symmetric tridiagonal matrix using the divide and conquer method.
+ The eigenvectors of a full or band complex Hermitian matrix can also
+ be found if ZHETRD or ZHPTRD or ZHBTRD has been used to reduce this
+ matrix to tridiagonal form.
+
+ This code makes very mild assumptions about floating point
+ arithmetic. It will work on machines with a guard digit in
+ add/subtract, or on those binary machines without guard digits
+ which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2.
+ It could conceivably fail on hexadecimal or decimal machines
+ without guard digits, but we know of none. See DLAED3 for details.
+
+ Arguments
+ =========
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only.
+ = 'I': Compute eigenvectors of tridiagonal matrix also.
+ = 'V': Compute eigenvectors of original Hermitian matrix
+ also. On entry, Z contains the unitary matrix used
+ to reduce the original matrix to tridiagonal form.
+
+ N (input) INTEGER
+ The dimension of the symmetric tridiagonal matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the diagonal elements of the tridiagonal matrix.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the subdiagonal elements of the tridiagonal matrix.
+ On exit, E has been destroyed.
+
+ Z (input/output) COMPLEX*16 array, dimension (LDZ,N)
+ On entry, if COMPZ = 'V', then Z contains the unitary
+ matrix used in the reduction to tridiagonal form.
+ On exit, if INFO = 0, then if COMPZ = 'V', Z contains the
+ orthonormal eigenvectors of the original Hermitian matrix,
+ and if COMPZ = 'I', Z contains the orthonormal eigenvectors
+ of the symmetric tridiagonal matrix.
+ If COMPZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1.
+ If eigenvectors are desired, then LDZ >= max(1,N).
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If COMPZ = 'N' or 'I', or N <= 1, LWORK must be at least 1.
+ If COMPZ = 'V' and N > 1, LWORK must be at least N*N.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ RWORK (workspace/output) DOUBLE PRECISION array,
+ dimension (LRWORK)
+ On exit, if INFO = 0, RWORK(1) returns the optimal LRWORK.
+
+ LRWORK (input) INTEGER
+ The dimension of the array RWORK.
+ If COMPZ = 'N' or N <= 1, LRWORK must be at least 1.
+ If COMPZ = 'V' and N > 1, LRWORK must be at least
+ 1 + 3*N + 2*N*lg N + 3*N**2 ,
+ where lg( N ) = smallest integer k such
+ that 2**k >= N.
+ If COMPZ = 'I' and N > 1, LRWORK must be at least
+ 1 + 4*N + 2*N**2 .
+
+ If LRWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the RWORK array,
+ returns this value as the first entry of the RWORK array, and
+ no error message related to LRWORK is issued by XERBLA.
+
+ IWORK (workspace/output) INTEGER array, dimension (LIWORK)
+ On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
+
+ LIWORK (input) INTEGER
+ The dimension of the array IWORK.
+ If COMPZ = 'N' or N <= 1, LIWORK must be at least 1.
+ If COMPZ = 'V' or N > 1, LIWORK must be at least
+ 6 + 6*N + 5*N*lg N.
+ If COMPZ = 'I' or N > 1, LIWORK must be at least
+ 3 + 5*N .
+
+ If LIWORK = -1, then a workspace query is assumed; the
+ routine only calculates the optimal size of the IWORK array,
+ returns this value as the first entry of the IWORK array, and
+ no error message related to LIWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit.
+ < 0: if INFO = -i, the i-th argument had an illegal value.
+ > 0: The algorithm failed to compute an eigenvalue while
+ working on the submatrix lying in rows and columns
+ INFO/(N+1) through mod(INFO,N+1).
+
+ Further Details
+ ===============
+
+ Based on contributions by
+ Jeff Rutter, Computer Science Division, University of California
+ at Berkeley, USA
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ --e;
+ z_dim1 = *ldz;
+ z_offset = 1 + z_dim1 * 1;
+ z__ -= z_offset;
+ --work;
+ --rwork;
+ --iwork;
+
+ /* Function Body */
+ *info = 0;
+ lquery = *lwork == -1 || *lrwork == -1 || *liwork == -1;
+
+ if (lsame_(compz, "N")) {
+ icompz = 0;
+ } else if (lsame_(compz, "V")) {
+ icompz = 1;
+ } else if (lsame_(compz, "I")) {
+ icompz = 2;
+ } else {
+ icompz = -1;
+ }
+ if (*n <= 1 || icompz <= 0) {
+ lwmin = 1;
+ liwmin = 1;
+ lrwmin = 1;
+ } else {
+ lgn = (integer) (log((doublereal) (*n)) / log(2.));
+ if (pow_ii(&c__2, &lgn) < *n) {
+ ++lgn;
+ }
+ if (pow_ii(&c__2, &lgn) < *n) {
+ ++lgn;
+ }
+ if (icompz == 1) {
+ lwmin = *n * *n;
+/* Computing 2nd power */
+ i__1 = *n;
+ lrwmin = *n * 3 + 1 + ((*n) << (1)) * lgn + i__1 * i__1 * 3;
+ liwmin = *n * 6 + 6 + *n * 5 * lgn;
+ } else if (icompz == 2) {
+ lwmin = 1;
+/* Computing 2nd power */
+ i__1 = *n;
+ lrwmin = ((*n) << (2)) + 1 + ((i__1 * i__1) << (1));
+ liwmin = *n * 5 + 3;
+ }
+ }
+ if (icompz < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*ldz < 1 || (icompz > 0 && *ldz < max(1,*n))) {
+ *info = -6;
+ } else if ((*lwork < lwmin && ! lquery)) {
+ *info = -8;
+ } else if ((*lrwork < lrwmin && ! lquery)) {
+ *info = -10;
+ } else if ((*liwork < liwmin && ! lquery)) {
+ *info = -12;
+ }
+
+ if (*info == 0) {
+ work[1].r = (doublereal) lwmin, work[1].i = 0.;
+ rwork[1] = (doublereal) lrwmin;
+ iwork[1] = liwmin;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZSTEDC", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+ if (*n == 1) {
+ if (icompz != 0) {
+ i__1 = z_dim1 + 1;
+ z__[i__1].r = 1., z__[i__1].i = 0.;
+ }
+ return 0;
+ }
+
+ smlsiz = ilaenv_(&c__9, "ZSTEDC", " ", &c__0, &c__0, &c__0, &c__0, (
+ ftnlen)6, (ftnlen)1);
+
+/*
+ If the following conditional clause is removed, then the routine
+ will use the Divide and Conquer routine to compute only the
+ eigenvalues, which requires (3N + 3N**2) real workspace and
+ (2 + 5N + 2N lg(N)) integer workspace.
+ Since on many architectures DSTERF is much faster than any other
+ algorithm for finding eigenvalues only, it is used here
+ as the default.
+
+ If COMPZ = 'N', use DSTERF to compute the eigenvalues.
+*/
+
+ if (icompz == 0) {
+ dsterf_(n, &d__[1], &e[1], info);
+ return 0;
+ }
+
+/*
+ If N is smaller than the minimum divide size (SMLSIZ+1), then
+ solve the problem with another solver.
+*/
+
+ if (*n <= smlsiz) {
+ if (icompz == 0) {
+ dsterf_(n, &d__[1], &e[1], info);
+ return 0;
+ } else if (icompz == 2) {
+ zsteqr_("I", n, &d__[1], &e[1], &z__[z_offset], ldz, &rwork[1],
+ info);
+ return 0;
+ } else {
+ zsteqr_("V", n, &d__[1], &e[1], &z__[z_offset], ldz, &rwork[1],
+ info);
+ return 0;
+ }
+ }
+
+/* If COMPZ = 'I', we simply call DSTEDC instead. */
+
+ if (icompz == 2) {
+ dlaset_("Full", n, n, &c_b324, &c_b1015, &rwork[1], n);
+ ll = *n * *n + 1;
+ i__1 = *lrwork - ll + 1;
+ dstedc_("I", n, &d__[1], &e[1], &rwork[1], n, &rwork[ll], &i__1, &
+ iwork[1], liwork, info);
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * z_dim1;
+ i__4 = (j - 1) * *n + i__;
+ z__[i__3].r = rwork[i__4], z__[i__3].i = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+ return 0;
+ }
+
+/*
+ From now on, only option left to be handled is COMPZ = 'V',
+ i.e. ICOMPZ = 1.
+
+ Scale.
+*/
+
+ orgnrm = dlanst_("M", n, &d__[1], &e[1]);
+ if (orgnrm == 0.) {
+ return 0;
+ }
+
+ eps = EPSILON;
+
+ start = 1;
+
+/* while ( START <= N ) */
+
+L30:
+ if (start <= *n) {
+
+/*
+ Let END be the position of the next subdiagonal entry such that
+ E( END ) <= TINY or END = N if no such subdiagonal exists. The
+ matrix identified by the elements between START and END
+ constitutes an independent sub-problem.
+*/
+
+ end = start;
+L40:
+ if (end < *n) {
+ tiny = eps * sqrt((d__1 = d__[end], abs(d__1))) * sqrt((d__2 =
+ d__[end + 1], abs(d__2)));
+ if ((d__1 = e[end], abs(d__1)) > tiny) {
+ ++end;
+ goto L40;
+ }
+ }
+
+/* (Sub) Problem determined. Compute its size and solve it. */
+
+ m = end - start + 1;
+ if (m > smlsiz) {
+ *info = smlsiz;
+
+/* Scale. */
+
+ orgnrm = dlanst_("M", &m, &d__[start], &e[start]);
+ dlascl_("G", &c__0, &c__0, &orgnrm, &c_b1015, &m, &c__1, &d__[
+ start], &m, info);
+ i__1 = m - 1;
+ i__2 = m - 1;
+ dlascl_("G", &c__0, &c__0, &orgnrm, &c_b1015, &i__1, &c__1, &e[
+ start], &i__2, info);
+
+ zlaed0_(n, &m, &d__[start], &e[start], &z__[start * z_dim1 + 1],
+ ldz, &work[1], n, &rwork[1], &iwork[1], info);
+ if (*info > 0) {
+ *info = (*info / (m + 1) + start - 1) * (*n + 1) + *info % (m
+ + 1) + start - 1;
+ return 0;
+ }
+
+/* Scale back. */
+
+ dlascl_("G", &c__0, &c__0, &c_b1015, &orgnrm, &m, &c__1, &d__[
+ start], &m, info);
+
+ } else {
+ dsteqr_("I", &m, &d__[start], &e[start], &rwork[1], &m, &rwork[m *
+ m + 1], info);
+ zlacrm_(n, &m, &z__[start * z_dim1 + 1], ldz, &rwork[1], &m, &
+ work[1], n, &rwork[m * m + 1]);
+ zlacpy_("A", n, &m, &work[1], n, &z__[start * z_dim1 + 1], ldz);
+ if (*info > 0) {
+ *info = start * (*n + 1) + end;
+ return 0;
+ }
+ }
+
+ start = end + 1;
+ goto L30;
+ }
+
+/*
+ endwhile
+
+ If the problem split any number of times, then the eigenvalues
+ will not be properly ordered. Here we permute the eigenvalues
+ (and the associated eigenvectors) into ascending order.
+*/
+
+ if (m != *n) {
+
+/* Use Selection Sort to minimize swaps of eigenvectors */
+
+ i__1 = *n;
+ for (ii = 2; ii <= i__1; ++ii) {
+ i__ = ii - 1;
+ k = i__;
+ p = d__[i__];
+ i__2 = *n;
+ for (j = ii; j <= i__2; ++j) {
+ if (d__[j] < p) {
+ k = j;
+ p = d__[j];
+ }
+/* L50: */
+ }
+ if (k != i__) {
+ d__[k] = d__[i__];
+ d__[i__] = p;
+ zswap_(n, &z__[i__ * z_dim1 + 1], &c__1, &z__[k * z_dim1 + 1],
+ &c__1);
+ }
+/* L60: */
+ }
+ }
+
+ work[1].r = (doublereal) lwmin, work[1].i = 0.;
+ rwork[1] = (doublereal) lrwmin;
+ iwork[1] = liwmin;
+
+ return 0;
+
+/* End of ZSTEDC */
+
+} /* zstedc_ */
+
+/* Subroutine */ int zsteqr_(char *compz, integer *n, doublereal *d__,
+ doublereal *e, doublecomplex *z__, integer *ldz, doublereal *work,
+ integer *info)
+{
+ /* System generated locals */
+ integer z_dim1, z_offset, i__1, i__2;
+ doublereal d__1, d__2;
+
+ /* Builtin functions */
+ double sqrt(doublereal), d_sign(doublereal *, doublereal *);
+
+ /* Local variables */
+ static doublereal b, c__, f, g;
+ static integer i__, j, k, l, m;
+ static doublereal p, r__, s;
+ static integer l1, ii, mm, lm1, mm1, nm1;
+ static doublereal rt1, rt2, eps;
+ static integer lsv;
+ static doublereal tst, eps2;
+ static integer lend, jtot;
+ extern /* Subroutine */ int dlae2_(doublereal *, doublereal *, doublereal
+ *, doublereal *, doublereal *);
+ extern logical lsame_(char *, char *);
+ static doublereal anorm;
+ extern /* Subroutine */ int zlasr_(char *, char *, char *, integer *,
+ integer *, doublereal *, doublereal *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *,
+ integer *, doublecomplex *, integer *), dlaev2_(doublereal *,
+ doublereal *, doublereal *, doublereal *, doublereal *,
+ doublereal *, doublereal *);
+ static integer lendm1, lendp1;
+
+ static integer iscale;
+ extern /* Subroutine */ int dlascl_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, integer *, doublereal *,
+ integer *, integer *);
+ static doublereal safmin;
+ extern /* Subroutine */ int dlartg_(doublereal *, doublereal *,
+ doublereal *, doublereal *, doublereal *);
+ static doublereal safmax;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *);
+ extern /* Subroutine */ int dlasrt_(char *, integer *, doublereal *,
+ integer *);
+ static integer lendsv;
+ static doublereal ssfmin;
+ static integer nmaxit, icompz;
+ static doublereal ssfmax;
+ extern /* Subroutine */ int zlaset_(char *, integer *, integer *,
+ doublecomplex *, doublecomplex *, doublecomplex *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZSTEQR computes all eigenvalues and, optionally, eigenvectors of a
+ symmetric tridiagonal matrix using the implicit QL or QR method.
+ The eigenvectors of a full or band complex Hermitian matrix can also
+ be found if ZHETRD or ZHPTRD or ZHBTRD has been used to reduce this
+ matrix to tridiagonal form.
+
+ Arguments
+ =========
+
+ COMPZ (input) CHARACTER*1
+ = 'N': Compute eigenvalues only.
+ = 'V': Compute eigenvalues and eigenvectors of the original
+ Hermitian matrix. On entry, Z must contain the
+ unitary matrix used to reduce the original matrix
+ to tridiagonal form.
+ = 'I': Compute eigenvalues and eigenvectors of the
+ tridiagonal matrix. Z is initialized to the identity
+ matrix.
+
+ N (input) INTEGER
+ The order of the matrix. N >= 0.
+
+ D (input/output) DOUBLE PRECISION array, dimension (N)
+ On entry, the diagonal elements of the tridiagonal matrix.
+ On exit, if INFO = 0, the eigenvalues in ascending order.
+
+ E (input/output) DOUBLE PRECISION array, dimension (N-1)
+ On entry, the (n-1) subdiagonal elements of the tridiagonal
+ matrix.
+ On exit, E has been destroyed.
+
+ Z (input/output) COMPLEX*16 array, dimension (LDZ, N)
+ On entry, if COMPZ = 'V', then Z contains the unitary
+ matrix used in the reduction to tridiagonal form.
+ On exit, if INFO = 0, then if COMPZ = 'V', Z contains the
+ orthonormal eigenvectors of the original Hermitian matrix,
+ and if COMPZ = 'I', Z contains the orthonormal eigenvectors
+ of the symmetric tridiagonal matrix.
+ If COMPZ = 'N', then Z is not referenced.
+
+ LDZ (input) INTEGER
+ The leading dimension of the array Z. LDZ >= 1, and if
+ eigenvectors are desired, then LDZ >= max(1,N).
+
+ WORK (workspace) DOUBLE PRECISION array, dimension (max(1,2*N-2))
+ If COMPZ = 'N', then WORK is not referenced.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+ > 0: the algorithm has failed to find all the eigenvalues in
+ a total of 30*N iterations; if INFO = i, then i
+ elements of E have not converged to zero; on exit, D
+ and E contain the elements of a symmetric tridiagonal
+ matrix which is unitarily similar to the original
+ matrix.
+
+ =====================================================================
+
+
+ Test the input parameters.
+*/
+
+ /* Parameter adjustments */
+ --d__;
+ --e;
+ z_dim1 = *ldz;
+ z_offset = 1 + z_dim1 * 1;
+ z__ -= z_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+
+ if (lsame_(compz, "N")) {
+ icompz = 0;
+ } else if (lsame_(compz, "V")) {
+ icompz = 1;
+ } else if (lsame_(compz, "I")) {
+ icompz = 2;
+ } else {
+ icompz = -1;
+ }
+ if (icompz < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*ldz < 1 || (icompz > 0 && *ldz < max(1,*n))) {
+ *info = -6;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZSTEQR", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+ if (*n == 1) {
+ if (icompz == 2) {
+ i__1 = z_dim1 + 1;
+ z__[i__1].r = 1., z__[i__1].i = 0.;
+ }
+ return 0;
+ }
+
+/* Determine the unit roundoff and over/underflow thresholds. */
+
+ eps = EPSILON;
+/* Computing 2nd power */
+ d__1 = eps;
+ eps2 = d__1 * d__1;
+ safmin = SAFEMINIMUM;
+ safmax = 1. / safmin;
+ ssfmax = sqrt(safmax) / 3.;
+ ssfmin = sqrt(safmin) / eps2;
+
+/*
+ Compute the eigenvalues and eigenvectors of the tridiagonal
+ matrix.
+*/
+
+ if (icompz == 2) {
+ zlaset_("Full", n, n, &c_b59, &c_b60, &z__[z_offset], ldz);
+ }
+
+ nmaxit = *n * 30;
+ jtot = 0;
+
+/*
+ Determine where the matrix splits and choose QL or QR iteration
+ for each block, according to whether top or bottom diagonal
+ element is smaller.
+*/
+
+ l1 = 1;
+ nm1 = *n - 1;
+
+L10:
+ if (l1 > *n) {
+ goto L160;
+ }
+ if (l1 > 1) {
+ e[l1 - 1] = 0.;
+ }
+ if (l1 <= nm1) {
+ i__1 = nm1;
+ for (m = l1; m <= i__1; ++m) {
+ tst = (d__1 = e[m], abs(d__1));
+ if (tst == 0.) {
+ goto L30;
+ }
+ if (tst <= sqrt((d__1 = d__[m], abs(d__1))) * sqrt((d__2 = d__[m
+ + 1], abs(d__2))) * eps) {
+ e[m] = 0.;
+ goto L30;
+ }
+/* L20: */
+ }
+ }
+ m = *n;
+
+L30:
+ l = l1;
+ lsv = l;
+ lend = m;
+ lendsv = lend;
+ l1 = m + 1;
+ if (lend == l) {
+ goto L10;
+ }
+
+/* Scale submatrix in rows and columns L to LEND */
+
+ i__1 = lend - l + 1;
+ anorm = dlanst_("I", &i__1, &d__[l], &e[l]);
+ iscale = 0;
+ if (anorm == 0.) {
+ goto L10;
+ }
+ if (anorm > ssfmax) {
+ iscale = 1;
+ i__1 = lend - l + 1;
+ dlascl_("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &d__[l], n,
+ info);
+ i__1 = lend - l;
+ dlascl_("G", &c__0, &c__0, &anorm, &ssfmax, &i__1, &c__1, &e[l], n,
+ info);
+ } else if (anorm < ssfmin) {
+ iscale = 2;
+ i__1 = lend - l + 1;
+ dlascl_("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &d__[l], n,
+ info);
+ i__1 = lend - l;
+ dlascl_("G", &c__0, &c__0, &anorm, &ssfmin, &i__1, &c__1, &e[l], n,
+ info);
+ }
+
+/* Choose between QL and QR iteration */
+
+ if ((d__1 = d__[lend], abs(d__1)) < (d__2 = d__[l], abs(d__2))) {
+ lend = lsv;
+ l = lendsv;
+ }
+
+ if (lend > l) {
+
+/*
+ QL Iteration
+
+ Look for small subdiagonal element.
+*/
+
+L40:
+ if (l != lend) {
+ lendm1 = lend - 1;
+ i__1 = lendm1;
+ for (m = l; m <= i__1; ++m) {
+/* Computing 2nd power */
+ d__2 = (d__1 = e[m], abs(d__1));
+ tst = d__2 * d__2;
+ if (tst <= eps2 * (d__1 = d__[m], abs(d__1)) * (d__2 = d__[m
+ + 1], abs(d__2)) + safmin) {
+ goto L60;
+ }
+/* L50: */
+ }
+ }
+
+ m = lend;
+
+L60:
+ if (m < lend) {
+ e[m] = 0.;
+ }
+ p = d__[l];
+ if (m == l) {
+ goto L80;
+ }
+
+/*
+ If remaining matrix is 2-by-2, use DLAE2 or SLAEV2
+ to compute its eigensystem.
+*/
+
+ if (m == l + 1) {
+ if (icompz > 0) {
+ dlaev2_(&d__[l], &e[l], &d__[l + 1], &rt1, &rt2, &c__, &s);
+ work[l] = c__;
+ work[*n - 1 + l] = s;
+ zlasr_("R", "V", "B", n, &c__2, &work[l], &work[*n - 1 + l], &
+ z__[l * z_dim1 + 1], ldz);
+ } else {
+ dlae2_(&d__[l], &e[l], &d__[l + 1], &rt1, &rt2);
+ }
+ d__[l] = rt1;
+ d__[l + 1] = rt2;
+ e[l] = 0.;
+ l += 2;
+ if (l <= lend) {
+ goto L40;
+ }
+ goto L140;
+ }
+
+ if (jtot == nmaxit) {
+ goto L140;
+ }
+ ++jtot;
+
+/* Form shift. */
+
+ g = (d__[l + 1] - p) / (e[l] * 2.);
+ r__ = dlapy2_(&g, &c_b1015);
+ g = d__[m] - p + e[l] / (g + d_sign(&r__, &g));
+
+ s = 1.;
+ c__ = 1.;
+ p = 0.;
+
+/* Inner loop */
+
+ mm1 = m - 1;
+ i__1 = l;
+ for (i__ = mm1; i__ >= i__1; --i__) {
+ f = s * e[i__];
+ b = c__ * e[i__];
+ dlartg_(&g, &f, &c__, &s, &r__);
+ if (i__ != m - 1) {
+ e[i__ + 1] = r__;
+ }
+ g = d__[i__ + 1] - p;
+ r__ = (d__[i__] - g) * s + c__ * 2. * b;
+ p = s * r__;
+ d__[i__ + 1] = g + p;
+ g = c__ * r__ - b;
+
+/* If eigenvectors are desired, then save rotations. */
+
+ if (icompz > 0) {
+ work[i__] = c__;
+ work[*n - 1 + i__] = -s;
+ }
+
+/* L70: */
+ }
+
+/* If eigenvectors are desired, then apply saved rotations. */
+
+ if (icompz > 0) {
+ mm = m - l + 1;
+ zlasr_("R", "V", "B", n, &mm, &work[l], &work[*n - 1 + l], &z__[l
+ * z_dim1 + 1], ldz);
+ }
+
+ d__[l] -= p;
+ e[l] = g;
+ goto L40;
+
+/* Eigenvalue found. */
+
+L80:
+ d__[l] = p;
+
+ ++l;
+ if (l <= lend) {
+ goto L40;
+ }
+ goto L140;
+
+ } else {
+
+/*
+ QR Iteration
+
+ Look for small superdiagonal element.
+*/
+
+L90:
+ if (l != lend) {
+ lendp1 = lend + 1;
+ i__1 = lendp1;
+ for (m = l; m >= i__1; --m) {
+/* Computing 2nd power */
+ d__2 = (d__1 = e[m - 1], abs(d__1));
+ tst = d__2 * d__2;
+ if (tst <= eps2 * (d__1 = d__[m], abs(d__1)) * (d__2 = d__[m
+ - 1], abs(d__2)) + safmin) {
+ goto L110;
+ }
+/* L100: */
+ }
+ }
+
+ m = lend;
+
+L110:
+ if (m > lend) {
+ e[m - 1] = 0.;
+ }
+ p = d__[l];
+ if (m == l) {
+ goto L130;
+ }
+
+/*
+ If remaining matrix is 2-by-2, use DLAE2 or SLAEV2
+ to compute its eigensystem.
+*/
+
+ if (m == l - 1) {
+ if (icompz > 0) {
+ dlaev2_(&d__[l - 1], &e[l - 1], &d__[l], &rt1, &rt2, &c__, &s)
+ ;
+ work[m] = c__;
+ work[*n - 1 + m] = s;
+ zlasr_("R", "V", "F", n, &c__2, &work[m], &work[*n - 1 + m], &
+ z__[(l - 1) * z_dim1 + 1], ldz);
+ } else {
+ dlae2_(&d__[l - 1], &e[l - 1], &d__[l], &rt1, &rt2);
+ }
+ d__[l - 1] = rt1;
+ d__[l] = rt2;
+ e[l - 1] = 0.;
+ l += -2;
+ if (l >= lend) {
+ goto L90;
+ }
+ goto L140;
+ }
+
+ if (jtot == nmaxit) {
+ goto L140;
+ }
+ ++jtot;
+
+/* Form shift. */
+
+ g = (d__[l - 1] - p) / (e[l - 1] * 2.);
+ r__ = dlapy2_(&g, &c_b1015);
+ g = d__[m] - p + e[l - 1] / (g + d_sign(&r__, &g));
+
+ s = 1.;
+ c__ = 1.;
+ p = 0.;
+
+/* Inner loop */
+
+ lm1 = l - 1;
+ i__1 = lm1;
+ for (i__ = m; i__ <= i__1; ++i__) {
+ f = s * e[i__];
+ b = c__ * e[i__];
+ dlartg_(&g, &f, &c__, &s, &r__);
+ if (i__ != m) {
+ e[i__ - 1] = r__;
+ }
+ g = d__[i__] - p;
+ r__ = (d__[i__ + 1] - g) * s + c__ * 2. * b;
+ p = s * r__;
+ d__[i__] = g + p;
+ g = c__ * r__ - b;
+
+/* If eigenvectors are desired, then save rotations. */
+
+ if (icompz > 0) {
+ work[i__] = c__;
+ work[*n - 1 + i__] = s;
+ }
+
+/* L120: */
+ }
+
+/* If eigenvectors are desired, then apply saved rotations. */
+
+ if (icompz > 0) {
+ mm = l - m + 1;
+ zlasr_("R", "V", "F", n, &mm, &work[m], &work[*n - 1 + m], &z__[m
+ * z_dim1 + 1], ldz);
+ }
+
+ d__[l] -= p;
+ e[lm1] = g;
+ goto L90;
+
+/* Eigenvalue found. */
+
+L130:
+ d__[l] = p;
+
+ --l;
+ if (l >= lend) {
+ goto L90;
+ }
+ goto L140;
+
+ }
+
+/* Undo scaling if necessary */
+
+L140:
+ if (iscale == 1) {
+ i__1 = lendsv - lsv + 1;
+ dlascl_("G", &c__0, &c__0, &ssfmax, &anorm, &i__1, &c__1, &d__[lsv],
+ n, info);
+ i__1 = lendsv - lsv;
+ dlascl_("G", &c__0, &c__0, &ssfmax, &anorm, &i__1, &c__1, &e[lsv], n,
+ info);
+ } else if (iscale == 2) {
+ i__1 = lendsv - lsv + 1;
+ dlascl_("G", &c__0, &c__0, &ssfmin, &anorm, &i__1, &c__1, &d__[lsv],
+ n, info);
+ i__1 = lendsv - lsv;
+ dlascl_("G", &c__0, &c__0, &ssfmin, &anorm, &i__1, &c__1, &e[lsv], n,
+ info);
+ }
+
+/*
+ Check for no convergence to an eigenvalue after a total
+ of N*MAXIT iterations.
+*/
+
+ if (jtot == nmaxit) {
+ i__1 = *n - 1;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if (e[i__] != 0.) {
+ ++(*info);
+ }
+/* L150: */
+ }
+ return 0;
+ }
+ goto L10;
+
+/* Order eigenvalues and eigenvectors. */
+
+L160:
+ if (icompz == 0) {
+
+/* Use Quick Sort */
+
+ dlasrt_("I", n, &d__[1], info);
+
+ } else {
+
+/* Use Selection Sort to minimize swaps of eigenvectors */
+
+ i__1 = *n;
+ for (ii = 2; ii <= i__1; ++ii) {
+ i__ = ii - 1;
+ k = i__;
+ p = d__[i__];
+ i__2 = *n;
+ for (j = ii; j <= i__2; ++j) {
+ if (d__[j] < p) {
+ k = j;
+ p = d__[j];
+ }
+/* L170: */
+ }
+ if (k != i__) {
+ d__[k] = d__[i__];
+ d__[i__] = p;
+ zswap_(n, &z__[i__ * z_dim1 + 1], &c__1, &z__[k * z_dim1 + 1],
+ &c__1);
+ }
+/* L180: */
+ }
+ }
+ return 0;
+
+/* End of ZSTEQR */
+
+} /* zsteqr_ */
+
+/* Subroutine */ int ztrevc_(char *side, char *howmny, logical *select,
+ integer *n, doublecomplex *t, integer *ldt, doublecomplex *vl,
+ integer *ldvl, doublecomplex *vr, integer *ldvr, integer *mm, integer
+ *m, doublecomplex *work, doublereal *rwork, integer *info)
+{
+ /* System generated locals */
+ integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1,
+ i__2, i__3, i__4, i__5;
+ doublereal d__1, d__2, d__3;
+ doublecomplex z__1, z__2;
+
+ /* Builtin functions */
+ double d_imag(doublecomplex *);
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, j, k, ii, ki, is;
+ static doublereal ulp;
+ static logical allv;
+ static doublereal unfl, ovfl, smin;
+ static logical over;
+ static doublereal scale;
+ extern logical lsame_(char *, char *);
+ static doublereal remax;
+ static logical leftv, bothv;
+ extern /* Subroutine */ int zgemv_(char *, integer *, integer *,
+ doublecomplex *, doublecomplex *, integer *, doublecomplex *,
+ integer *, doublecomplex *, doublecomplex *, integer *);
+ static logical somev;
+ extern /* Subroutine */ int zcopy_(integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *), dlabad_(doublereal *, doublereal *);
+
+ extern /* Subroutine */ int xerbla_(char *, integer *), zdscal_(
+ integer *, doublereal *, doublecomplex *, integer *);
+ extern integer izamax_(integer *, doublecomplex *, integer *);
+ static logical rightv;
+ extern doublereal dzasum_(integer *, doublecomplex *, integer *);
+ static doublereal smlnum;
+ extern /* Subroutine */ int zlatrs_(char *, char *, char *, char *,
+ integer *, doublecomplex *, integer *, doublecomplex *,
+ doublereal *, doublereal *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZTREVC computes some or all of the right and/or left eigenvectors of
+ a complex upper triangular matrix T.
+
+ The right eigenvector x and the left eigenvector y of T corresponding
+ to an eigenvalue w are defined by:
+
+ T*x = w*x, y'*T = w*y'
+
+ where y' denotes the conjugate transpose of the vector y.
+
+ If all eigenvectors are requested, the routine may either return the
+ matrices X and/or Y of right or left eigenvectors of T, or the
+ products Q*X and/or Q*Y, where Q is an input unitary
+ matrix. If T was obtained from the Schur factorization of an
+ original matrix A = Q*T*Q', then Q*X and Q*Y are the matrices of
+ right or left eigenvectors of A.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'R': compute right eigenvectors only;
+ = 'L': compute left eigenvectors only;
+ = 'B': compute both right and left eigenvectors.
+
+ HOWMNY (input) CHARACTER*1
+ = 'A': compute all right and/or left eigenvectors;
+ = 'B': compute all right and/or left eigenvectors,
+ and backtransform them using the input matrices
+ supplied in VR and/or VL;
+ = 'S': compute selected right and/or left eigenvectors,
+ specified by the logical array SELECT.
+
+ SELECT (input) LOGICAL array, dimension (N)
+ If HOWMNY = 'S', SELECT specifies the eigenvectors to be
+ computed.
+ If HOWMNY = 'A' or 'B', SELECT is not referenced.
+ To select the eigenvector corresponding to the j-th
+ eigenvalue, SELECT(j) must be set to .TRUE..
+
+ N (input) INTEGER
+ The order of the matrix T. N >= 0.
+
+ T (input/output) COMPLEX*16 array, dimension (LDT,N)
+ The upper triangular matrix T. T is modified, but restored
+ on exit.
+
+ LDT (input) INTEGER
+ The leading dimension of the array T. LDT >= max(1,N).
+
+ VL (input/output) COMPLEX*16 array, dimension (LDVL,MM)
+ On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must
+ contain an N-by-N matrix Q (usually the unitary matrix Q of
+ Schur vectors returned by ZHSEQR).
+ On exit, if SIDE = 'L' or 'B', VL contains:
+ if HOWMNY = 'A', the matrix Y of left eigenvectors of T;
+ VL is lower triangular. The i-th column
+ VL(i) of VL is the eigenvector corresponding
+ to T(i,i).
+ if HOWMNY = 'B', the matrix Q*Y;
+ if HOWMNY = 'S', the left eigenvectors of T specified by
+ SELECT, stored consecutively in the columns
+ of VL, in the same order as their
+ eigenvalues.
+ If SIDE = 'R', VL is not referenced.
+
+ LDVL (input) INTEGER
+ The leading dimension of the array VL. LDVL >= max(1,N) if
+ SIDE = 'L' or 'B'; LDVL >= 1 otherwise.
+
+ VR (input/output) COMPLEX*16 array, dimension (LDVR,MM)
+ On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must
+ contain an N-by-N matrix Q (usually the unitary matrix Q of
+ Schur vectors returned by ZHSEQR).
+ On exit, if SIDE = 'R' or 'B', VR contains:
+ if HOWMNY = 'A', the matrix X of right eigenvectors of T;
+ VR is upper triangular. The i-th column
+ VR(i) of VR is the eigenvector corresponding
+ to T(i,i).
+ if HOWMNY = 'B', the matrix Q*X;
+ if HOWMNY = 'S', the right eigenvectors of T specified by
+ SELECT, stored consecutively in the columns
+ of VR, in the same order as their
+ eigenvalues.
+ If SIDE = 'L', VR is not referenced.
+
+ LDVR (input) INTEGER
+ The leading dimension of the array VR. LDVR >= max(1,N) if
+ SIDE = 'R' or 'B'; LDVR >= 1 otherwise.
+
+ MM (input) INTEGER
+ The number of columns in the arrays VL and/or VR. MM >= M.
+
+ M (output) INTEGER
+ The number of columns in the arrays VL and/or VR actually
+ used to store the eigenvectors. If HOWMNY = 'A' or 'B', M
+ is set to N. Each selected eigenvector occupies one
+ column.
+
+ WORK (workspace) COMPLEX*16 array, dimension (2*N)
+
+ RWORK (workspace) DOUBLE PRECISION array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ Further Details
+ ===============
+
+ The algorithm used in this program is basically backward (forward)
+ substitution, with scaling to make the the code robust against
+ possible overflow.
+
+ Each eigenvector is normalized so that the element of largest
+ magnitude has magnitude 1; here the magnitude of a complex number
+ (x,y) is taken to be |x| + |y|.
+
+ =====================================================================
+
+
+ Decode and test the input parameters
+*/
+
+ /* Parameter adjustments */
+ --select;
+ t_dim1 = *ldt;
+ t_offset = 1 + t_dim1 * 1;
+ t -= t_offset;
+ vl_dim1 = *ldvl;
+ vl_offset = 1 + vl_dim1 * 1;
+ vl -= vl_offset;
+ vr_dim1 = *ldvr;
+ vr_offset = 1 + vr_dim1 * 1;
+ vr -= vr_offset;
+ --work;
+ --rwork;
+
+ /* Function Body */
+ bothv = lsame_(side, "B");
+ rightv = lsame_(side, "R") || bothv;
+ leftv = lsame_(side, "L") || bothv;
+
+ allv = lsame_(howmny, "A");
+ over = lsame_(howmny, "B");
+ somev = lsame_(howmny, "S");
+
+/*
+ Set M to the number of columns required to store the selected
+ eigenvectors.
+*/
+
+ if (somev) {
+ *m = 0;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (select[j]) {
+ ++(*m);
+ }
+/* L10: */
+ }
+ } else {
+ *m = *n;
+ }
+
+ *info = 0;
+ if ((! rightv && ! leftv)) {
+ *info = -1;
+ } else if (((! allv && ! over) && ! somev)) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*ldt < max(1,*n)) {
+ *info = -6;
+ } else if (*ldvl < 1 || (leftv && *ldvl < *n)) {
+ *info = -8;
+ } else if (*ldvr < 1 || (rightv && *ldvr < *n)) {
+ *info = -10;
+ } else if (*mm < *m) {
+ *info = -11;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZTREVC", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+/* Set the constants to control overflow. */
+
+ unfl = SAFEMINIMUM;
+ ovfl = 1. / unfl;
+ dlabad_(&unfl, &ovfl);
+ ulp = PRECISION;
+ smlnum = unfl * (*n / ulp);
+
+/* Store the diagonal elements of T in working array WORK. */
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__ + *n;
+ i__3 = i__ + i__ * t_dim1;
+ work[i__2].r = t[i__3].r, work[i__2].i = t[i__3].i;
+/* L20: */
+ }
+
+/*
+ Compute 1-norm of each column of strictly upper triangular
+ part of T to control overflow in triangular solver.
+*/
+
+ rwork[1] = 0.;
+ i__1 = *n;
+ for (j = 2; j <= i__1; ++j) {
+ i__2 = j - 1;
+ rwork[j] = dzasum_(&i__2, &t[j * t_dim1 + 1], &c__1);
+/* L30: */
+ }
+
+ if (rightv) {
+
+/* Compute right eigenvectors. */
+
+ is = *m;
+ for (ki = *n; ki >= 1; --ki) {
+
+ if (somev) {
+ if (! select[ki]) {
+ goto L80;
+ }
+ }
+/* Computing MAX */
+ i__1 = ki + ki * t_dim1;
+ d__3 = ulp * ((d__1 = t[i__1].r, abs(d__1)) + (d__2 = d_imag(&t[
+ ki + ki * t_dim1]), abs(d__2)));
+ smin = max(d__3,smlnum);
+
+ work[1].r = 1., work[1].i = 0.;
+
+/* Form right-hand side. */
+
+ i__1 = ki - 1;
+ for (k = 1; k <= i__1; ++k) {
+ i__2 = k;
+ i__3 = k + ki * t_dim1;
+ z__1.r = -t[i__3].r, z__1.i = -t[i__3].i;
+ work[i__2].r = z__1.r, work[i__2].i = z__1.i;
+/* L40: */
+ }
+
+/*
+ Solve the triangular system:
+ (T(1:KI-1,1:KI-1) - T(KI,KI))*X = SCALE*WORK.
+*/
+
+ i__1 = ki - 1;
+ for (k = 1; k <= i__1; ++k) {
+ i__2 = k + k * t_dim1;
+ i__3 = k + k * t_dim1;
+ i__4 = ki + ki * t_dim1;
+ z__1.r = t[i__3].r - t[i__4].r, z__1.i = t[i__3].i - t[i__4]
+ .i;
+ t[i__2].r = z__1.r, t[i__2].i = z__1.i;
+ i__2 = k + k * t_dim1;
+ if ((d__1 = t[i__2].r, abs(d__1)) + (d__2 = d_imag(&t[k + k *
+ t_dim1]), abs(d__2)) < smin) {
+ i__3 = k + k * t_dim1;
+ t[i__3].r = smin, t[i__3].i = 0.;
+ }
+/* L50: */
+ }
+
+ if (ki > 1) {
+ i__1 = ki - 1;
+ zlatrs_("Upper", "No transpose", "Non-unit", "Y", &i__1, &t[
+ t_offset], ldt, &work[1], &scale, &rwork[1], info);
+ i__1 = ki;
+ work[i__1].r = scale, work[i__1].i = 0.;
+ }
+
+/* Copy the vector x or Q*x to VR and normalize. */
+
+ if (! over) {
+ zcopy_(&ki, &work[1], &c__1, &vr[is * vr_dim1 + 1], &c__1);
+
+ ii = izamax_(&ki, &vr[is * vr_dim1 + 1], &c__1);
+ i__1 = ii + is * vr_dim1;
+ remax = 1. / ((d__1 = vr[i__1].r, abs(d__1)) + (d__2 = d_imag(
+ &vr[ii + is * vr_dim1]), abs(d__2)));
+ zdscal_(&ki, &remax, &vr[is * vr_dim1 + 1], &c__1);
+
+ i__1 = *n;
+ for (k = ki + 1; k <= i__1; ++k) {
+ i__2 = k + is * vr_dim1;
+ vr[i__2].r = 0., vr[i__2].i = 0.;
+/* L60: */
+ }
+ } else {
+ if (ki > 1) {
+ i__1 = ki - 1;
+ z__1.r = scale, z__1.i = 0.;
+ zgemv_("N", n, &i__1, &c_b60, &vr[vr_offset], ldvr, &work[
+ 1], &c__1, &z__1, &vr[ki * vr_dim1 + 1], &c__1);
+ }
+
+ ii = izamax_(n, &vr[ki * vr_dim1 + 1], &c__1);
+ i__1 = ii + ki * vr_dim1;
+ remax = 1. / ((d__1 = vr[i__1].r, abs(d__1)) + (d__2 = d_imag(
+ &vr[ii + ki * vr_dim1]), abs(d__2)));
+ zdscal_(n, &remax, &vr[ki * vr_dim1 + 1], &c__1);
+ }
+
+/* Set back the original diagonal elements of T. */
+
+ i__1 = ki - 1;
+ for (k = 1; k <= i__1; ++k) {
+ i__2 = k + k * t_dim1;
+ i__3 = k + *n;
+ t[i__2].r = work[i__3].r, t[i__2].i = work[i__3].i;
+/* L70: */
+ }
+
+ --is;
+L80:
+ ;
+ }
+ }
+
+ if (leftv) {
+
+/* Compute left eigenvectors. */
+
+ is = 1;
+ i__1 = *n;
+ for (ki = 1; ki <= i__1; ++ki) {
+
+ if (somev) {
+ if (! select[ki]) {
+ goto L130;
+ }
+ }
+/* Computing MAX */
+ i__2 = ki + ki * t_dim1;
+ d__3 = ulp * ((d__1 = t[i__2].r, abs(d__1)) + (d__2 = d_imag(&t[
+ ki + ki * t_dim1]), abs(d__2)));
+ smin = max(d__3,smlnum);
+
+ i__2 = *n;
+ work[i__2].r = 1., work[i__2].i = 0.;
+
+/* Form right-hand side. */
+
+ i__2 = *n;
+ for (k = ki + 1; k <= i__2; ++k) {
+ i__3 = k;
+ d_cnjg(&z__2, &t[ki + k * t_dim1]);
+ z__1.r = -z__2.r, z__1.i = -z__2.i;
+ work[i__3].r = z__1.r, work[i__3].i = z__1.i;
+/* L90: */
+ }
+
+/*
+ Solve the triangular system:
+ (T(KI+1:N,KI+1:N) - T(KI,KI))'*X = SCALE*WORK.
+*/
+
+ i__2 = *n;
+ for (k = ki + 1; k <= i__2; ++k) {
+ i__3 = k + k * t_dim1;
+ i__4 = k + k * t_dim1;
+ i__5 = ki + ki * t_dim1;
+ z__1.r = t[i__4].r - t[i__5].r, z__1.i = t[i__4].i - t[i__5]
+ .i;
+ t[i__3].r = z__1.r, t[i__3].i = z__1.i;
+ i__3 = k + k * t_dim1;
+ if ((d__1 = t[i__3].r, abs(d__1)) + (d__2 = d_imag(&t[k + k *
+ t_dim1]), abs(d__2)) < smin) {
+ i__4 = k + k * t_dim1;
+ t[i__4].r = smin, t[i__4].i = 0.;
+ }
+/* L100: */
+ }
+
+ if (ki < *n) {
+ i__2 = *n - ki;
+ zlatrs_("Upper", "Conjugate transpose", "Non-unit", "Y", &
+ i__2, &t[ki + 1 + (ki + 1) * t_dim1], ldt, &work[ki +
+ 1], &scale, &rwork[1], info);
+ i__2 = ki;
+ work[i__2].r = scale, work[i__2].i = 0.;
+ }
+
+/* Copy the vector x or Q*x to VL and normalize. */
+
+ if (! over) {
+ i__2 = *n - ki + 1;
+ zcopy_(&i__2, &work[ki], &c__1, &vl[ki + is * vl_dim1], &c__1)
+ ;
+
+ i__2 = *n - ki + 1;
+ ii = izamax_(&i__2, &vl[ki + is * vl_dim1], &c__1) + ki - 1;
+ i__2 = ii + is * vl_dim1;
+ remax = 1. / ((d__1 = vl[i__2].r, abs(d__1)) + (d__2 = d_imag(
+ &vl[ii + is * vl_dim1]), abs(d__2)));
+ i__2 = *n - ki + 1;
+ zdscal_(&i__2, &remax, &vl[ki + is * vl_dim1], &c__1);
+
+ i__2 = ki - 1;
+ for (k = 1; k <= i__2; ++k) {
+ i__3 = k + is * vl_dim1;
+ vl[i__3].r = 0., vl[i__3].i = 0.;
+/* L110: */
+ }
+ } else {
+ if (ki < *n) {
+ i__2 = *n - ki;
+ z__1.r = scale, z__1.i = 0.;
+ zgemv_("N", n, &i__2, &c_b60, &vl[(ki + 1) * vl_dim1 + 1],
+ ldvl, &work[ki + 1], &c__1, &z__1, &vl[ki *
+ vl_dim1 + 1], &c__1);
+ }
+
+ ii = izamax_(n, &vl[ki * vl_dim1 + 1], &c__1);
+ i__2 = ii + ki * vl_dim1;
+ remax = 1. / ((d__1 = vl[i__2].r, abs(d__1)) + (d__2 = d_imag(
+ &vl[ii + ki * vl_dim1]), abs(d__2)));
+ zdscal_(n, &remax, &vl[ki * vl_dim1 + 1], &c__1);
+ }
+
+/* Set back the original diagonal elements of T. */
+
+ i__2 = *n;
+ for (k = ki + 1; k <= i__2; ++k) {
+ i__3 = k + k * t_dim1;
+ i__4 = k + *n;
+ t[i__3].r = work[i__4].r, t[i__3].i = work[i__4].i;
+/* L120: */
+ }
+
+ ++is;
+L130:
+ ;
+ }
+ }
+
+ return 0;
+
+/* End of ZTREVC */
+
+} /* ztrevc_ */
+
+/* Subroutine */ int zung2r_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+ doublecomplex z__1;
+
+ /* Local variables */
+ static integer i__, j, l;
+ extern /* Subroutine */ int zscal_(integer *, doublecomplex *,
+ doublecomplex *, integer *), zlarf_(char *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *, doublecomplex *), xerbla_(char *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZUNG2R generates an m by n complex matrix Q with orthonormal columns,
+ which is defined as the first n columns of a product of k elementary
+ reflectors of order m
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by ZGEQRF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the i-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+ returned by ZGEQRF in the first k columns of its array
+ argument A.
+ On exit, the m by n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) COMPLEX*16 array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by ZGEQRF.
+
+ WORK (workspace) COMPLEX*16 array, dimension (N)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0 || *n > *m) {
+ *info = -2;
+ } else if (*k < 0 || *k > *n) {
+ *info = -3;
+ } else if (*lda < max(1,*m)) {
+ *info = -5;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZUNG2R", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n <= 0) {
+ return 0;
+ }
+
+/* Initialise columns k+1:n to columns of the unit matrix */
+
+ i__1 = *n;
+ for (j = *k + 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (l = 1; l <= i__2; ++l) {
+ i__3 = l + j * a_dim1;
+ a[i__3].r = 0., a[i__3].i = 0.;
+/* L10: */
+ }
+ i__2 = j + j * a_dim1;
+ a[i__2].r = 1., a[i__2].i = 0.;
+/* L20: */
+ }
+
+ for (i__ = *k; i__ >= 1; --i__) {
+
+/* Apply H(i) to A(i:m,i:n) from the left */
+
+ if (i__ < *n) {
+ i__1 = i__ + i__ * a_dim1;
+ a[i__1].r = 1., a[i__1].i = 0.;
+ i__1 = *m - i__ + 1;
+ i__2 = *n - i__;
+ zlarf_("Left", &i__1, &i__2, &a[i__ + i__ * a_dim1], &c__1, &tau[
+ i__], &a[i__ + (i__ + 1) * a_dim1], lda, &work[1]);
+ }
+ if (i__ < *m) {
+ i__1 = *m - i__;
+ i__2 = i__;
+ z__1.r = -tau[i__2].r, z__1.i = -tau[i__2].i;
+ zscal_(&i__1, &z__1, &a[i__ + 1 + i__ * a_dim1], &c__1);
+ }
+ i__1 = i__ + i__ * a_dim1;
+ i__2 = i__;
+ z__1.r = 1. - tau[i__2].r, z__1.i = 0. - tau[i__2].i;
+ a[i__1].r = z__1.r, a[i__1].i = z__1.i;
+
+/* Set A(1:i-1,i) to zero */
+
+ i__1 = i__ - 1;
+ for (l = 1; l <= i__1; ++l) {
+ i__2 = l + i__ * a_dim1;
+ a[i__2].r = 0., a[i__2].i = 0.;
+/* L30: */
+ }
+/* L40: */
+ }
+ return 0;
+
+/* End of ZUNG2R */
+
+} /* zung2r_ */
+
+/* Subroutine */ int zungbr_(char *vect, integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ static integer i__, j, nb, mn;
+ extern logical lsame_(char *, char *);
+ static integer iinfo;
+ static logical wantq;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static integer lwkopt;
+ static logical lquery;
+ extern /* Subroutine */ int zunglq_(integer *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *, integer *), zungqr_(integer *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZUNGBR generates one of the complex unitary matrices Q or P**H
+ determined by ZGEBRD when reducing a complex matrix A to bidiagonal
+ form: A = Q * B * P**H. Q and P**H are defined as products of
+ elementary reflectors H(i) or G(i) respectively.
+
+ If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q
+ is of order M:
+ if m >= k, Q = H(1) H(2) . . . H(k) and ZUNGBR returns the first n
+ columns of Q, where m >= n >= k;
+ if m < k, Q = H(1) H(2) . . . H(m-1) and ZUNGBR returns Q as an
+ M-by-M matrix.
+
+ If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**H
+ is of order N:
+ if k < n, P**H = G(k) . . . G(2) G(1) and ZUNGBR returns the first m
+ rows of P**H, where n >= m >= k;
+ if k >= n, P**H = G(n-1) . . . G(2) G(1) and ZUNGBR returns P**H as
+ an N-by-N matrix.
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ Specifies whether the matrix Q or the matrix P**H is
+ required, as defined in the transformation applied by ZGEBRD:
+ = 'Q': generate Q;
+ = 'P': generate P**H.
+
+ M (input) INTEGER
+ The number of rows of the matrix Q or P**H to be returned.
+ M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q or P**H to be returned.
+ N >= 0.
+ If VECT = 'Q', M >= N >= min(M,K);
+ if VECT = 'P', N >= M >= min(N,K).
+
+ K (input) INTEGER
+ If VECT = 'Q', the number of columns in the original M-by-K
+ matrix reduced by ZGEBRD.
+ If VECT = 'P', the number of rows in the original K-by-N
+ matrix reduced by ZGEBRD.
+ K >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the vectors which define the elementary reflectors,
+ as returned by ZGEBRD.
+ On exit, the M-by-N matrix Q or P**H.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= M.
+
+ TAU (input) COMPLEX*16 array, dimension
+ (min(M,K)) if VECT = 'Q'
+ (min(N,K)) if VECT = 'P'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i) or G(i), which determines Q or P**H, as
+ returned by ZGEBRD in its array argument TAUQ or TAUP.
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,min(M,N)).
+ For optimum performance LWORK >= min(M,N)*NB, where NB
+ is the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ wantq = lsame_(vect, "Q");
+ mn = min(*m,*n);
+ lquery = *lwork == -1;
+ if ((! wantq && ! lsame_(vect, "P"))) {
+ *info = -1;
+ } else if (*m < 0) {
+ *info = -2;
+ } else if (*n < 0 || (wantq && (*n > *m || *n < min(*m,*k))) || (! wantq
+ && (*m > *n || *m < min(*n,*k)))) {
+ *info = -3;
+ } else if (*k < 0) {
+ *info = -4;
+ } else if (*lda < max(1,*m)) {
+ *info = -6;
+ } else if ((*lwork < max(1,mn) && ! lquery)) {
+ *info = -9;
+ }
+
+ if (*info == 0) {
+ if (wantq) {
+ nb = ilaenv_(&c__1, "ZUNGQR", " ", m, n, k, &c_n1, (ftnlen)6, (
+ ftnlen)1);
+ } else {
+ nb = ilaenv_(&c__1, "ZUNGLQ", " ", m, n, k, &c_n1, (ftnlen)6, (
+ ftnlen)1);
+ }
+ lwkopt = max(1,mn) * nb;
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZUNGBR", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0) {
+ work[1].r = 1., work[1].i = 0.;
+ return 0;
+ }
+
+ if (wantq) {
+
+/*
+ Form Q, determined by a call to ZGEBRD to reduce an m-by-k
+ matrix
+*/
+
+ if (*m >= *k) {
+
+/* If m >= k, assume m >= n >= k */
+
+ zungqr_(m, n, k, &a[a_offset], lda, &tau[1], &work[1], lwork, &
+ iinfo);
+
+ } else {
+
+/*
+ If m < k, assume m = n
+
+ Shift the vectors which define the elementary reflectors one
+ column to the right, and set the first row and column of Q
+ to those of the unit matrix
+*/
+
+ for (j = *m; j >= 2; --j) {
+ i__1 = j * a_dim1 + 1;
+ a[i__1].r = 0., a[i__1].i = 0.;
+ i__1 = *m;
+ for (i__ = j + 1; i__ <= i__1; ++i__) {
+ i__2 = i__ + j * a_dim1;
+ i__3 = i__ + (j - 1) * a_dim1;
+ a[i__2].r = a[i__3].r, a[i__2].i = a[i__3].i;
+/* L10: */
+ }
+/* L20: */
+ }
+ i__1 = a_dim1 + 1;
+ a[i__1].r = 1., a[i__1].i = 0.;
+ i__1 = *m;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ i__2 = i__ + a_dim1;
+ a[i__2].r = 0., a[i__2].i = 0.;
+/* L30: */
+ }
+ if (*m > 1) {
+
+/* Form Q(2:m,2:m) */
+
+ i__1 = *m - 1;
+ i__2 = *m - 1;
+ i__3 = *m - 1;
+ zungqr_(&i__1, &i__2, &i__3, &a[((a_dim1) << (1)) + 2], lda, &
+ tau[1], &work[1], lwork, &iinfo);
+ }
+ }
+ } else {
+
+/*
+ Form P', determined by a call to ZGEBRD to reduce a k-by-n
+ matrix
+*/
+
+ if (*k < *n) {
+
+/* If k < n, assume k <= m <= n */
+
+ zunglq_(m, n, k, &a[a_offset], lda, &tau[1], &work[1], lwork, &
+ iinfo);
+
+ } else {
+
+/*
+ If k >= n, assume m = n
+
+ Shift the vectors which define the elementary reflectors one
+ row downward, and set the first row and column of P' to
+ those of the unit matrix
+*/
+
+ i__1 = a_dim1 + 1;
+ a[i__1].r = 1., a[i__1].i = 0.;
+ i__1 = *n;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ i__2 = i__ + a_dim1;
+ a[i__2].r = 0., a[i__2].i = 0.;
+/* L40: */
+ }
+ i__1 = *n;
+ for (j = 2; j <= i__1; ++j) {
+ for (i__ = j - 1; i__ >= 2; --i__) {
+ i__2 = i__ + j * a_dim1;
+ i__3 = i__ - 1 + j * a_dim1;
+ a[i__2].r = a[i__3].r, a[i__2].i = a[i__3].i;
+/* L50: */
+ }
+ i__2 = j * a_dim1 + 1;
+ a[i__2].r = 0., a[i__2].i = 0.;
+/* L60: */
+ }
+ if (*n > 1) {
+
+/* Form P'(2:n,2:n) */
+
+ i__1 = *n - 1;
+ i__2 = *n - 1;
+ i__3 = *n - 1;
+ zunglq_(&i__1, &i__2, &i__3, &a[((a_dim1) << (1)) + 2], lda, &
+ tau[1], &work[1], lwork, &iinfo);
+ }
+ }
+ }
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ return 0;
+
+/* End of ZUNGBR */
+
+} /* zungbr_ */
+
+/* Subroutine */ int zunghr_(integer *n, integer *ilo, integer *ihi,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+
+ /* Local variables */
+ static integer i__, j, nb, nh, iinfo;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static integer lwkopt;
+ static logical lquery;
+ extern /* Subroutine */ int zungqr_(integer *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZUNGHR generates a complex unitary matrix Q which is defined as the
+ product of IHI-ILO elementary reflectors of order N, as returned by
+ ZGEHRD:
+
+ Q = H(ilo) H(ilo+1) . . . H(ihi-1).
+
+ Arguments
+ =========
+
+ N (input) INTEGER
+ The order of the matrix Q. N >= 0.
+
+ ILO (input) INTEGER
+ IHI (input) INTEGER
+ ILO and IHI must have the same values as in the previous call
+ of ZGEHRD. Q is equal to the unit matrix except in the
+ submatrix Q(ilo+1:ihi,ilo+1:ihi).
+ 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the vectors which define the elementary reflectors,
+ as returned by ZGEHRD.
+ On exit, the N-by-N unitary matrix Q.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,N).
+
+ TAU (input) COMPLEX*16 array, dimension (N-1)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by ZGEHRD.
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= IHI-ILO.
+ For optimum performance LWORK >= (IHI-ILO)*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ nh = *ihi - *ilo;
+ lquery = *lwork == -1;
+ if (*n < 0) {
+ *info = -1;
+ } else if (*ilo < 1 || *ilo > max(1,*n)) {
+ *info = -2;
+ } else if (*ihi < min(*ilo,*n) || *ihi > *n) {
+ *info = -3;
+ } else if (*lda < max(1,*n)) {
+ *info = -5;
+ } else if ((*lwork < max(1,nh) && ! lquery)) {
+ *info = -8;
+ }
+
+ if (*info == 0) {
+ nb = ilaenv_(&c__1, "ZUNGQR", " ", &nh, &nh, &nh, &c_n1, (ftnlen)6, (
+ ftnlen)1);
+ lwkopt = max(1,nh) * nb;
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZUNGHR", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ work[1].r = 1., work[1].i = 0.;
+ return 0;
+ }
+
+/*
+ Shift the vectors which define the elementary reflectors one
+ column to the right, and set the first ilo and the last n-ihi
+ rows and columns to those of the unit matrix
+*/
+
+ i__1 = *ilo + 1;
+ for (j = *ihi; j >= i__1; --j) {
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ a[i__3].r = 0., a[i__3].i = 0.;
+/* L10: */
+ }
+ i__2 = *ihi;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ i__4 = i__ + (j - 1) * a_dim1;
+ a[i__3].r = a[i__4].r, a[i__3].i = a[i__4].i;
+/* L20: */
+ }
+ i__2 = *n;
+ for (i__ = *ihi + 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ a[i__3].r = 0., a[i__3].i = 0.;
+/* L30: */
+ }
+/* L40: */
+ }
+ i__1 = *ilo;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ a[i__3].r = 0., a[i__3].i = 0.;
+/* L50: */
+ }
+ i__2 = j + j * a_dim1;
+ a[i__2].r = 1., a[i__2].i = 0.;
+/* L60: */
+ }
+ i__1 = *n;
+ for (j = *ihi + 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ a[i__3].r = 0., a[i__3].i = 0.;
+/* L70: */
+ }
+ i__2 = j + j * a_dim1;
+ a[i__2].r = 1., a[i__2].i = 0.;
+/* L80: */
+ }
+
+ if (nh > 0) {
+
+/* Generate Q(ilo+1:ihi,ilo+1:ihi) */
+
+ zungqr_(&nh, &nh, &nh, &a[*ilo + 1 + (*ilo + 1) * a_dim1], lda, &tau[*
+ ilo], &work[1], lwork, &iinfo);
+ }
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ return 0;
+
+/* End of ZUNGHR */
+
+} /* zunghr_ */
+
+/* Subroutine */ int zungl2_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+ doublecomplex z__1, z__2;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, j, l;
+ extern /* Subroutine */ int zscal_(integer *, doublecomplex *,
+ doublecomplex *, integer *), zlarf_(char *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *, doublecomplex *), xerbla_(char *, integer *), zlacgv_(integer *, doublecomplex *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZUNGL2 generates an m-by-n complex matrix Q with orthonormal rows,
+ which is defined as the first m rows of a product of k elementary
+ reflectors of order n
+
+ Q = H(k)' . . . H(2)' H(1)'
+
+ as returned by ZGELQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the i-th row must contain the vector which defines
+ the elementary reflector H(i), for i = 1,2,...,k, as returned
+ by ZGELQF in the first k rows of its array argument A.
+ On exit, the m by n matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) COMPLEX*16 array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by ZGELQF.
+
+ WORK (workspace) COMPLEX*16 array, dimension (M)
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < *m) {
+ *info = -2;
+ } else if (*k < 0 || *k > *m) {
+ *info = -3;
+ } else if (*lda < max(1,*m)) {
+ *info = -5;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZUNGL2", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m <= 0) {
+ return 0;
+ }
+
+ if (*k < *m) {
+
+/* Initialise rows k+1:m to rows of the unit matrix */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (l = *k + 1; l <= i__2; ++l) {
+ i__3 = l + j * a_dim1;
+ a[i__3].r = 0., a[i__3].i = 0.;
+/* L10: */
+ }
+ if ((j > *k && j <= *m)) {
+ i__2 = j + j * a_dim1;
+ a[i__2].r = 1., a[i__2].i = 0.;
+ }
+/* L20: */
+ }
+ }
+
+ for (i__ = *k; i__ >= 1; --i__) {
+
+/* Apply H(i)' to A(i:m,i:n) from the right */
+
+ if (i__ < *n) {
+ i__1 = *n - i__;
+ zlacgv_(&i__1, &a[i__ + (i__ + 1) * a_dim1], lda);
+ if (i__ < *m) {
+ i__1 = i__ + i__ * a_dim1;
+ a[i__1].r = 1., a[i__1].i = 0.;
+ i__1 = *m - i__;
+ i__2 = *n - i__ + 1;
+ d_cnjg(&z__1, &tau[i__]);
+ zlarf_("Right", &i__1, &i__2, &a[i__ + i__ * a_dim1], lda, &
+ z__1, &a[i__ + 1 + i__ * a_dim1], lda, &work[1]);
+ }
+ i__1 = *n - i__;
+ i__2 = i__;
+ z__1.r = -tau[i__2].r, z__1.i = -tau[i__2].i;
+ zscal_(&i__1, &z__1, &a[i__ + (i__ + 1) * a_dim1], lda);
+ i__1 = *n - i__;
+ zlacgv_(&i__1, &a[i__ + (i__ + 1) * a_dim1], lda);
+ }
+ i__1 = i__ + i__ * a_dim1;
+ d_cnjg(&z__2, &tau[i__]);
+ z__1.r = 1. - z__2.r, z__1.i = 0. - z__2.i;
+ a[i__1].r = z__1.r, a[i__1].i = z__1.i;
+
+/* Set A(i,1:i-1) to zero */
+
+ i__1 = i__ - 1;
+ for (l = 1; l <= i__1; ++l) {
+ i__2 = i__ + l * a_dim1;
+ a[i__2].r = 0., a[i__2].i = 0.;
+/* L30: */
+ }
+/* L40: */
+ }
+ return 0;
+
+/* End of ZUNGL2 */
+
+} /* zungl2_ */
+
+/* Subroutine */ int zunglq_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+
+ /* Local variables */
+ static integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo;
+ extern /* Subroutine */ int zungl2_(integer *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *,
+ integer *, integer *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *);
+ static integer ldwork;
+ extern /* Subroutine */ int zlarft_(char *, char *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *);
+ static logical lquery;
+ static integer lwkopt;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZUNGLQ generates an M-by-N complex matrix Q with orthonormal rows,
+ which is defined as the first M rows of a product of K elementary
+ reflectors of order N
+
+ Q = H(k)' . . . H(2)' H(1)'
+
+ as returned by ZGELQF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. N >= M.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. M >= K >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the i-th row must contain the vector which defines
+ the elementary reflector H(i), for i = 1,2,...,k, as returned
+ by ZGELQF in the first k rows of its array argument A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) COMPLEX*16 array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by ZGELQF.
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,M).
+ For optimum performance LWORK >= M*NB, where NB is
+ the optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit;
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ nb = ilaenv_(&c__1, "ZUNGLQ", " ", m, n, k, &c_n1, (ftnlen)6, (ftnlen)1);
+ lwkopt = max(1,*m) * nb;
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ lquery = *lwork == -1;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < *m) {
+ *info = -2;
+ } else if (*k < 0 || *k > *m) {
+ *info = -3;
+ } else if (*lda < max(1,*m)) {
+ *info = -5;
+ } else if ((*lwork < max(1,*m) && ! lquery)) {
+ *info = -8;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZUNGLQ", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m <= 0) {
+ work[1].r = 1., work[1].i = 0.;
+ return 0;
+ }
+
+ nbmin = 2;
+ nx = 0;
+ iws = *m;
+ if ((nb > 1 && nb < *k)) {
+
+/*
+ Determine when to cross over from blocked to unblocked code.
+
+ Computing MAX
+*/
+ i__1 = 0, i__2 = ilaenv_(&c__3, "ZUNGLQ", " ", m, n, k, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ nx = max(i__1,i__2);
+ if (nx < *k) {
+
+/* Determine if workspace is large enough for blocked code. */
+
+ ldwork = *m;
+ iws = ldwork * nb;
+ if (*lwork < iws) {
+
+/*
+ Not enough workspace to use optimal NB: reduce NB and
+ determine the minimum value of NB.
+*/
+
+ nb = *lwork / ldwork;
+/* Computing MAX */
+ i__1 = 2, i__2 = ilaenv_(&c__2, "ZUNGLQ", " ", m, n, k, &c_n1,
+ (ftnlen)6, (ftnlen)1);
+ nbmin = max(i__1,i__2);
+ }
+ }
+ }
+
+ if (((nb >= nbmin && nb < *k) && nx < *k)) {
+
+/*
+ Use blocked code after the last block.
+ The first kk rows are handled by the block method.
+*/
+
+ ki = (*k - nx - 1) / nb * nb;
+/* Computing MIN */
+ i__1 = *k, i__2 = ki + nb;
+ kk = min(i__1,i__2);
+
+/* Set A(kk+1:m,1:kk) to zero. */
+
+ i__1 = kk;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = kk + 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ a[i__3].r = 0., a[i__3].i = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+ } else {
+ kk = 0;
+ }
+
+/* Use unblocked code for the last or only block. */
+
+ if (kk < *m) {
+ i__1 = *m - kk;
+ i__2 = *n - kk;
+ i__3 = *k - kk;
+ zungl2_(&i__1, &i__2, &i__3, &a[kk + 1 + (kk + 1) * a_dim1], lda, &
+ tau[kk + 1], &work[1], &iinfo);
+ }
+
+ if (kk > 0) {
+
+/* Use blocked code */
+
+ i__1 = -nb;
+ for (i__ = ki + 1; i__1 < 0 ? i__ >= 1 : i__ <= 1; i__ += i__1) {
+/* Computing MIN */
+ i__2 = nb, i__3 = *k - i__ + 1;
+ ib = min(i__2,i__3);
+ if (i__ + ib <= *m) {
+
+/*
+ Form the triangular factor of the block reflector
+ H = H(i) H(i+1) . . . H(i+ib-1)
+*/
+
+ i__2 = *n - i__ + 1;
+ zlarft_("Forward", "Rowwise", &i__2, &ib, &a[i__ + i__ *
+ a_dim1], lda, &tau[i__], &work[1], &ldwork);
+
+/* Apply H' to A(i+ib:m,i:n) from the right */
+
+ i__2 = *m - i__ - ib + 1;
+ i__3 = *n - i__ + 1;
+ zlarfb_("Right", "Conjugate transpose", "Forward", "Rowwise",
+ &i__2, &i__3, &ib, &a[i__ + i__ * a_dim1], lda, &work[
+ 1], &ldwork, &a[i__ + ib + i__ * a_dim1], lda, &work[
+ ib + 1], &ldwork);
+ }
+
+/* Apply H' to columns i:n of current block */
+
+ i__2 = *n - i__ + 1;
+ zungl2_(&ib, &i__2, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &
+ work[1], &iinfo);
+
+/* Set columns 1:i-1 of current block to zero */
+
+ i__2 = i__ - 1;
+ for (j = 1; j <= i__2; ++j) {
+ i__3 = i__ + ib - 1;
+ for (l = i__; l <= i__3; ++l) {
+ i__4 = l + j * a_dim1;
+ a[i__4].r = 0., a[i__4].i = 0.;
+/* L30: */
+ }
+/* L40: */
+ }
+/* L50: */
+ }
+ }
+
+ work[1].r = (doublereal) iws, work[1].i = 0.;
+ return 0;
+
+/* End of ZUNGLQ */
+
+} /* zunglq_ */
+
+/* Subroutine */ int zungqr_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+
+ /* Local variables */
+ static integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo;
+ extern /* Subroutine */ int zung2r_(integer *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *,
+ integer *, integer *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *);
+ static integer ldwork;
+ extern /* Subroutine */ int zlarft_(char *, char *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *);
+ static integer lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZUNGQR generates an M-by-N complex matrix Q with orthonormal columns,
+ which is defined as the first N columns of a product of K elementary
+ reflectors of order M
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by ZGEQRF.
+
+ Arguments
+ =========
+
+ M (input) INTEGER
+ The number of rows of the matrix Q. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix Q. M >= N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines the
+ matrix Q. N >= K >= 0.
+
+ A (input/output) COMPLEX*16 array, dimension (LDA,N)
+ On entry, the i-th column must contain the vector which
+ defines the elementary reflector H(i), for i = 1,2,...,k, as
+ returned by ZGEQRF in the first k columns of its array
+ argument A.
+ On exit, the M-by-N matrix Q.
+
+ LDA (input) INTEGER
+ The first dimension of the array A. LDA >= max(1,M).
+
+ TAU (input) COMPLEX*16 array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by ZGEQRF.
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK. LWORK >= max(1,N).
+ For optimum performance LWORK >= N*NB, where NB is the
+ optimal blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument has an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ nb = ilaenv_(&c__1, "ZUNGQR", " ", m, n, k, &c_n1, (ftnlen)6, (ftnlen)1);
+ lwkopt = max(1,*n) * nb;
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ lquery = *lwork == -1;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0 || *n > *m) {
+ *info = -2;
+ } else if (*k < 0 || *k > *n) {
+ *info = -3;
+ } else if (*lda < max(1,*m)) {
+ *info = -5;
+ } else if ((*lwork < max(1,*n) && ! lquery)) {
+ *info = -8;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZUNGQR", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n <= 0) {
+ work[1].r = 1., work[1].i = 0.;
+ return 0;
+ }
+
+ nbmin = 2;
+ nx = 0;
+ iws = *n;
+ if ((nb > 1 && nb < *k)) {
+
+/*
+ Determine when to cross over from blocked to unblocked code.
+
+ Computing MAX
+*/
+ i__1 = 0, i__2 = ilaenv_(&c__3, "ZUNGQR", " ", m, n, k, &c_n1, (
+ ftnlen)6, (ftnlen)1);
+ nx = max(i__1,i__2);
+ if (nx < *k) {
+
+/* Determine if workspace is large enough for blocked code. */
+
+ ldwork = *n;
+ iws = ldwork * nb;
+ if (*lwork < iws) {
+
+/*
+ Not enough workspace to use optimal NB: reduce NB and
+ determine the minimum value of NB.
+*/
+
+ nb = *lwork / ldwork;
+/* Computing MAX */
+ i__1 = 2, i__2 = ilaenv_(&c__2, "ZUNGQR", " ", m, n, k, &c_n1,
+ (ftnlen)6, (ftnlen)1);
+ nbmin = max(i__1,i__2);
+ }
+ }
+ }
+
+ if (((nb >= nbmin && nb < *k) && nx < *k)) {
+
+/*
+ Use blocked code after the last block.
+ The first kk columns are handled by the block method.
+*/
+
+ ki = (*k - nx - 1) / nb * nb;
+/* Computing MIN */
+ i__1 = *k, i__2 = ki + nb;
+ kk = min(i__1,i__2);
+
+/* Set A(1:kk,kk+1:n) to zero. */
+
+ i__1 = *n;
+ for (j = kk + 1; j <= i__1; ++j) {
+ i__2 = kk;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ i__3 = i__ + j * a_dim1;
+ a[i__3].r = 0., a[i__3].i = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+ } else {
+ kk = 0;
+ }
+
+/* Use unblocked code for the last or only block. */
+
+ if (kk < *n) {
+ i__1 = *m - kk;
+ i__2 = *n - kk;
+ i__3 = *k - kk;
+ zung2r_(&i__1, &i__2, &i__3, &a[kk + 1 + (kk + 1) * a_dim1], lda, &
+ tau[kk + 1], &work[1], &iinfo);
+ }
+
+ if (kk > 0) {
+
+/* Use blocked code */
+
+ i__1 = -nb;
+ for (i__ = ki + 1; i__1 < 0 ? i__ >= 1 : i__ <= 1; i__ += i__1) {
+/* Computing MIN */
+ i__2 = nb, i__3 = *k - i__ + 1;
+ ib = min(i__2,i__3);
+ if (i__ + ib <= *n) {
+
+/*
+ Form the triangular factor of the block reflector
+ H = H(i) H(i+1) . . . H(i+ib-1)
+*/
+
+ i__2 = *m - i__ + 1;
+ zlarft_("Forward", "Columnwise", &i__2, &ib, &a[i__ + i__ *
+ a_dim1], lda, &tau[i__], &work[1], &ldwork);
+
+/* Apply H to A(i:m,i+ib:n) from the left */
+
+ i__2 = *m - i__ + 1;
+ i__3 = *n - i__ - ib + 1;
+ zlarfb_("Left", "No transpose", "Forward", "Columnwise", &
+ i__2, &i__3, &ib, &a[i__ + i__ * a_dim1], lda, &work[
+ 1], &ldwork, &a[i__ + (i__ + ib) * a_dim1], lda, &
+ work[ib + 1], &ldwork);
+ }
+
+/* Apply H to rows i:m of current block */
+
+ i__2 = *m - i__ + 1;
+ zung2r_(&i__2, &ib, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &
+ work[1], &iinfo);
+
+/* Set rows 1:i-1 of current block to zero */
+
+ i__2 = i__ + ib - 1;
+ for (j = i__; j <= i__2; ++j) {
+ i__3 = i__ - 1;
+ for (l = 1; l <= i__3; ++l) {
+ i__4 = l + j * a_dim1;
+ a[i__4].r = 0., a[i__4].i = 0.;
+/* L30: */
+ }
+/* L40: */
+ }
+/* L50: */
+ }
+ }
+
+ work[1].r = (doublereal) iws, work[1].i = 0.;
+ return 0;
+
+/* End of ZUNGQR */
+
+} /* zungqr_ */
+
+/* Subroutine */ int zunm2l_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3;
+ doublecomplex z__1;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, i1, i2, i3, mi, ni, nq;
+ static doublecomplex aii;
+ static logical left;
+ static doublecomplex taui;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int zlarf_(char *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *, doublecomplex *), xerbla_(char *, integer *);
+ static logical notran;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZUNM2L overwrites the general complex m-by-n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'C', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'C',
+
+ where Q is a complex unitary matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by ZGEQLF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'C': apply Q' (Conjugate transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) COMPLEX*16 array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+ ZGEQLF in the last k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) COMPLEX*16 array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by ZGEQLF.
+
+ C (input/output) COMPLEX*16 array, dimension (LDC,N)
+ On entry, the m-by-n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) COMPLEX*16 array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+
+/* NQ is the order of Q */
+
+ if (left) {
+ nq = *m;
+ } else {
+ nq = *n;
+ }
+ if ((! left && ! lsame_(side, "R"))) {
+ *info = -1;
+ } else if ((! notran && ! lsame_(trans, "C"))) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,nq)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZUNM2L", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ return 0;
+ }
+
+ if ((left && notran) || (! left && ! notran)) {
+ i1 = 1;
+ i2 = *k;
+ i3 = 1;
+ } else {
+ i1 = *k;
+ i2 = 1;
+ i3 = -1;
+ }
+
+ if (left) {
+ ni = *n;
+ } else {
+ mi = *m;
+ }
+
+ i__1 = i2;
+ i__2 = i3;
+ for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+ if (left) {
+
+/* H(i) or H(i)' is applied to C(1:m-k+i,1:n) */
+
+ mi = *m - *k + i__;
+ } else {
+
+/* H(i) or H(i)' is applied to C(1:m,1:n-k+i) */
+
+ ni = *n - *k + i__;
+ }
+
+/* Apply H(i) or H(i)' */
+
+ if (notran) {
+ i__3 = i__;
+ taui.r = tau[i__3].r, taui.i = tau[i__3].i;
+ } else {
+ d_cnjg(&z__1, &tau[i__]);
+ taui.r = z__1.r, taui.i = z__1.i;
+ }
+ i__3 = nq - *k + i__ + i__ * a_dim1;
+ aii.r = a[i__3].r, aii.i = a[i__3].i;
+ i__3 = nq - *k + i__ + i__ * a_dim1;
+ a[i__3].r = 1., a[i__3].i = 0.;
+ zlarf_(side, &mi, &ni, &a[i__ * a_dim1 + 1], &c__1, &taui, &c__[
+ c_offset], ldc, &work[1]);
+ i__3 = nq - *k + i__ + i__ * a_dim1;
+ a[i__3].r = aii.r, a[i__3].i = aii.i;
+/* L10: */
+ }
+ return 0;
+
+/* End of ZUNM2L */
+
+} /* zunm2l_ */
+
+/* Subroutine */ int zunm2r_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3;
+ doublecomplex z__1;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, i1, i2, i3, ic, jc, mi, ni, nq;
+ static doublecomplex aii;
+ static logical left;
+ static doublecomplex taui;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int zlarf_(char *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *, doublecomplex *), xerbla_(char *, integer *);
+ static logical notran;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZUNM2R overwrites the general complex m-by-n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'C', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'C',
+
+ where Q is a complex unitary matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by ZGEQRF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'C': apply Q' (Conjugate transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) COMPLEX*16 array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+ ZGEQRF in the first k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) COMPLEX*16 array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by ZGEQRF.
+
+ C (input/output) COMPLEX*16 array, dimension (LDC,N)
+ On entry, the m-by-n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) COMPLEX*16 array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+
+/* NQ is the order of Q */
+
+ if (left) {
+ nq = *m;
+ } else {
+ nq = *n;
+ }
+ if ((! left && ! lsame_(side, "R"))) {
+ *info = -1;
+ } else if ((! notran && ! lsame_(trans, "C"))) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,nq)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZUNM2R", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ return 0;
+ }
+
+ if ((left && ! notran) || (! left && notran)) {
+ i1 = 1;
+ i2 = *k;
+ i3 = 1;
+ } else {
+ i1 = *k;
+ i2 = 1;
+ i3 = -1;
+ }
+
+ if (left) {
+ ni = *n;
+ jc = 1;
+ } else {
+ mi = *m;
+ ic = 1;
+ }
+
+ i__1 = i2;
+ i__2 = i3;
+ for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+ if (left) {
+
+/* H(i) or H(i)' is applied to C(i:m,1:n) */
+
+ mi = *m - i__ + 1;
+ ic = i__;
+ } else {
+
+/* H(i) or H(i)' is applied to C(1:m,i:n) */
+
+ ni = *n - i__ + 1;
+ jc = i__;
+ }
+
+/* Apply H(i) or H(i)' */
+
+ if (notran) {
+ i__3 = i__;
+ taui.r = tau[i__3].r, taui.i = tau[i__3].i;
+ } else {
+ d_cnjg(&z__1, &tau[i__]);
+ taui.r = z__1.r, taui.i = z__1.i;
+ }
+ i__3 = i__ + i__ * a_dim1;
+ aii.r = a[i__3].r, aii.i = a[i__3].i;
+ i__3 = i__ + i__ * a_dim1;
+ a[i__3].r = 1., a[i__3].i = 0.;
+ zlarf_(side, &mi, &ni, &a[i__ + i__ * a_dim1], &c__1, &taui, &c__[ic
+ + jc * c_dim1], ldc, &work[1]);
+ i__3 = i__ + i__ * a_dim1;
+ a[i__3].r = aii.r, a[i__3].i = aii.i;
+/* L10: */
+ }
+ return 0;
+
+/* End of ZUNM2R */
+
+} /* zunm2r_ */
+
+/* Subroutine */ int zunmbr_(char *vect, char *side, char *trans, integer *m,
+ integer *n, integer *k, doublecomplex *a, integer *lda, doublecomplex
+ *tau, doublecomplex *c__, integer *ldc, doublecomplex *work, integer *
+ lwork, integer *info)
+{
+ /* System generated locals */
+ address a__1[2];
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2];
+ char ch__1[2];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
+
+ /* Local variables */
+ static integer i1, i2, nb, mi, ni, nq, nw;
+ static logical left;
+ extern logical lsame_(char *, char *);
+ static integer iinfo;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static logical notran, applyq;
+ static char transt[1];
+ static integer lwkopt;
+ static logical lquery;
+ extern /* Subroutine */ int zunmlq_(char *, char *, integer *, integer *,
+ integer *, doublecomplex *, integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *, integer *), zunmqr_(char *, char *, integer *, integer *,
+ integer *, doublecomplex *, integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ If VECT = 'Q', ZUNMBR overwrites the general complex M-by-N matrix C
+ with
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'C': Q**H * C C * Q**H
+
+ If VECT = 'P', ZUNMBR overwrites the general complex M-by-N matrix C
+ with
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': P * C C * P
+ TRANS = 'C': P**H * C C * P**H
+
+ Here Q and P**H are the unitary matrices determined by ZGEBRD when
+ reducing a complex matrix A to bidiagonal form: A = Q * B * P**H. Q
+ and P**H are defined as products of elementary reflectors H(i) and
+ G(i) respectively.
+
+ Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the
+ order of the unitary matrix Q or P**H that is applied.
+
+ If VECT = 'Q', A is assumed to have been an NQ-by-K matrix:
+ if nq >= k, Q = H(1) H(2) . . . H(k);
+ if nq < k, Q = H(1) H(2) . . . H(nq-1).
+
+ If VECT = 'P', A is assumed to have been a K-by-NQ matrix:
+ if k < nq, P = G(1) G(2) . . . G(k);
+ if k >= nq, P = G(1) G(2) . . . G(nq-1).
+
+ Arguments
+ =========
+
+ VECT (input) CHARACTER*1
+ = 'Q': apply Q or Q**H;
+ = 'P': apply P or P**H.
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q, Q**H, P or P**H from the Left;
+ = 'R': apply Q, Q**H, P or P**H from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q or P;
+ = 'C': Conjugate transpose, apply Q**H or P**H.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ If VECT = 'Q', the number of columns in the original
+ matrix reduced by ZGEBRD.
+ If VECT = 'P', the number of rows in the original
+ matrix reduced by ZGEBRD.
+ K >= 0.
+
+ A (input) COMPLEX*16 array, dimension
+ (LDA,min(nq,K)) if VECT = 'Q'
+ (LDA,nq) if VECT = 'P'
+ The vectors which define the elementary reflectors H(i) and
+ G(i), whose products determine the matrices Q and P, as
+ returned by ZGEBRD.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If VECT = 'Q', LDA >= max(1,nq);
+ if VECT = 'P', LDA >= max(1,min(nq,K)).
+
+ TAU (input) COMPLEX*16 array, dimension (min(nq,K))
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i) or G(i) which determines Q or P, as returned
+ by ZGEBRD in the array argument TAUQ or TAUP.
+
+ C (input/output) COMPLEX*16 array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q
+ or P*C or P**H*C or C*P or C*P**H.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ applyq = lsame_(vect, "Q");
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+ lquery = *lwork == -1;
+
+/* NQ is the order of Q or P and NW is the minimum dimension of WORK */
+
+ if (left) {
+ nq = *m;
+ nw = *n;
+ } else {
+ nq = *n;
+ nw = *m;
+ }
+ if ((! applyq && ! lsame_(vect, "P"))) {
+ *info = -1;
+ } else if ((! left && ! lsame_(side, "R"))) {
+ *info = -2;
+ } else if ((! notran && ! lsame_(trans, "C"))) {
+ *info = -3;
+ } else if (*m < 0) {
+ *info = -4;
+ } else if (*n < 0) {
+ *info = -5;
+ } else if (*k < 0) {
+ *info = -6;
+ } else /* if(complicated condition) */ {
+/* Computing MAX */
+ i__1 = 1, i__2 = min(nq,*k);
+ if ((applyq && *lda < max(1,nq)) || (! applyq && *lda < max(i__1,i__2)
+ )) {
+ *info = -8;
+ } else if (*ldc < max(1,*m)) {
+ *info = -11;
+ } else if ((*lwork < max(1,nw) && ! lquery)) {
+ *info = -13;
+ }
+ }
+
+ if (*info == 0) {
+ if (applyq) {
+ if (left) {
+/* Writing concatenation */
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = *m - 1;
+ i__2 = *m - 1;
+ nb = ilaenv_(&c__1, "ZUNMQR", ch__1, &i__1, n, &i__2, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ } else {
+/* Writing concatenation */
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = *n - 1;
+ i__2 = *n - 1;
+ nb = ilaenv_(&c__1, "ZUNMQR", ch__1, m, &i__1, &i__2, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ }
+ } else {
+ if (left) {
+/* Writing concatenation */
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = *m - 1;
+ i__2 = *m - 1;
+ nb = ilaenv_(&c__1, "ZUNMLQ", ch__1, &i__1, n, &i__2, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ } else {
+/* Writing concatenation */
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = *n - 1;
+ i__2 = *n - 1;
+ nb = ilaenv_(&c__1, "ZUNMLQ", ch__1, m, &i__1, &i__2, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ }
+ }
+ lwkopt = max(1,nw) * nb;
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZUNMBR", &i__1);
+ return 0;
+ } else if (lquery) {
+ }
+
+/* Quick return if possible */
+
+ work[1].r = 1., work[1].i = 0.;
+ if (*m == 0 || *n == 0) {
+ return 0;
+ }
+
+ if (applyq) {
+
+/* Apply Q */
+
+ if (nq >= *k) {
+
+/* Q was determined by a call to ZGEBRD with nq >= k */
+
+ zunmqr_(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[
+ c_offset], ldc, &work[1], lwork, &iinfo);
+ } else if (nq > 1) {
+
+/* Q was determined by a call to ZGEBRD with nq < k */
+
+ if (left) {
+ mi = *m - 1;
+ ni = *n;
+ i1 = 2;
+ i2 = 1;
+ } else {
+ mi = *m;
+ ni = *n - 1;
+ i1 = 1;
+ i2 = 2;
+ }
+ i__1 = nq - 1;
+ zunmqr_(side, trans, &mi, &ni, &i__1, &a[a_dim1 + 2], lda, &tau[1]
+ , &c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo);
+ }
+ } else {
+
+/* Apply P */
+
+ if (notran) {
+ *(unsigned char *)transt = 'C';
+ } else {
+ *(unsigned char *)transt = 'N';
+ }
+ if (nq > *k) {
+
+/* P was determined by a call to ZGEBRD with nq > k */
+
+ zunmlq_(side, transt, m, n, k, &a[a_offset], lda, &tau[1], &c__[
+ c_offset], ldc, &work[1], lwork, &iinfo);
+ } else if (nq > 1) {
+
+/* P was determined by a call to ZGEBRD with nq <= k */
+
+ if (left) {
+ mi = *m - 1;
+ ni = *n;
+ i1 = 2;
+ i2 = 1;
+ } else {
+ mi = *m;
+ ni = *n - 1;
+ i1 = 1;
+ i2 = 2;
+ }
+ i__1 = nq - 1;
+ zunmlq_(side, transt, &mi, &ni, &i__1, &a[((a_dim1) << (1)) + 1],
+ lda, &tau[1], &c__[i1 + i2 * c_dim1], ldc, &work[1],
+ lwork, &iinfo);
+ }
+ }
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ return 0;
+
+/* End of ZUNMBR */
+
+} /* zunmbr_ */
+
+/* Subroutine */ int zunml2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3;
+ doublecomplex z__1;
+
+ /* Builtin functions */
+ void d_cnjg(doublecomplex *, doublecomplex *);
+
+ /* Local variables */
+ static integer i__, i1, i2, i3, ic, jc, mi, ni, nq;
+ static doublecomplex aii;
+ static logical left;
+ static doublecomplex taui;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int zlarf_(char *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *, doublecomplex *), xerbla_(char *, integer *), zlacgv_(integer *, doublecomplex *, integer *);
+ static logical notran;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ September 30, 1994
+
+
+ Purpose
+ =======
+
+ ZUNML2 overwrites the general complex m-by-n matrix C with
+
+ Q * C if SIDE = 'L' and TRANS = 'N', or
+
+ Q'* C if SIDE = 'L' and TRANS = 'C', or
+
+ C * Q if SIDE = 'R' and TRANS = 'N', or
+
+ C * Q' if SIDE = 'R' and TRANS = 'C',
+
+ where Q is a complex unitary matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k)' . . . H(2)' H(1)'
+
+ as returned by ZGELQF. Q is of order m if SIDE = 'L' and of order n
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q' from the Left
+ = 'R': apply Q or Q' from the Right
+
+ TRANS (input) CHARACTER*1
+ = 'N': apply Q (No transpose)
+ = 'C': apply Q' (Conjugate transpose)
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) COMPLEX*16 array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+ ZGELQF in the first k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) COMPLEX*16 array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by ZGELQF.
+
+ C (input/output) COMPLEX*16 array, dimension (LDC,N)
+ On entry, the m-by-n matrix C.
+ On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace) COMPLEX*16 array, dimension
+ (N) if SIDE = 'L',
+ (M) if SIDE = 'R'
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+
+/* NQ is the order of Q */
+
+ if (left) {
+ nq = *m;
+ } else {
+ nq = *n;
+ }
+ if ((! left && ! lsame_(side, "R"))) {
+ *info = -1;
+ } else if ((! notran && ! lsame_(trans, "C"))) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,*k)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZUNML2", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ return 0;
+ }
+
+ if ((left && notran) || (! left && ! notran)) {
+ i1 = 1;
+ i2 = *k;
+ i3 = 1;
+ } else {
+ i1 = *k;
+ i2 = 1;
+ i3 = -1;
+ }
+
+ if (left) {
+ ni = *n;
+ jc = 1;
+ } else {
+ mi = *m;
+ ic = 1;
+ }
+
+ i__1 = i2;
+ i__2 = i3;
+ for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+ if (left) {
+
+/* H(i) or H(i)' is applied to C(i:m,1:n) */
+
+ mi = *m - i__ + 1;
+ ic = i__;
+ } else {
+
+/* H(i) or H(i)' is applied to C(1:m,i:n) */
+
+ ni = *n - i__ + 1;
+ jc = i__;
+ }
+
+/* Apply H(i) or H(i)' */
+
+ if (notran) {
+ d_cnjg(&z__1, &tau[i__]);
+ taui.r = z__1.r, taui.i = z__1.i;
+ } else {
+ i__3 = i__;
+ taui.r = tau[i__3].r, taui.i = tau[i__3].i;
+ }
+ if (i__ < nq) {
+ i__3 = nq - i__;
+ zlacgv_(&i__3, &a[i__ + (i__ + 1) * a_dim1], lda);
+ }
+ i__3 = i__ + i__ * a_dim1;
+ aii.r = a[i__3].r, aii.i = a[i__3].i;
+ i__3 = i__ + i__ * a_dim1;
+ a[i__3].r = 1., a[i__3].i = 0.;
+ zlarf_(side, &mi, &ni, &a[i__ + i__ * a_dim1], lda, &taui, &c__[ic +
+ jc * c_dim1], ldc, &work[1]);
+ i__3 = i__ + i__ * a_dim1;
+ a[i__3].r = aii.r, a[i__3].i = aii.i;
+ if (i__ < nq) {
+ i__3 = nq - i__;
+ zlacgv_(&i__3, &a[i__ + (i__ + 1) * a_dim1], lda);
+ }
+/* L10: */
+ }
+ return 0;
+
+/* End of ZUNML2 */
+
+} /* zunml2_ */
+
+/* Subroutine */ int zunmlq_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork,
+ integer *info)
+{
+ /* System generated locals */
+ address a__1[2];
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4,
+ i__5;
+ char ch__1[2];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
+
+ /* Local variables */
+ static integer i__;
+ static doublecomplex t[4160] /* was [65][64] */;
+ static integer i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws;
+ static logical left;
+ extern logical lsame_(char *, char *);
+ static integer nbmin, iinfo;
+ extern /* Subroutine */ int zunml2_(char *, char *, integer *, integer *,
+ integer *, doublecomplex *, integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *,
+ integer *, integer *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *);
+ static logical notran;
+ static integer ldwork;
+ extern /* Subroutine */ int zlarft_(char *, char *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *);
+ static char transt[1];
+ static integer lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZUNMLQ overwrites the general complex M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'C': Q**H * C C * Q**H
+
+ where Q is a complex unitary matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k)' . . . H(2)' H(1)'
+
+ as returned by ZGELQF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**H from the Left;
+ = 'R': apply Q or Q**H from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'C': Conjugate transpose, apply Q**H.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) COMPLEX*16 array, dimension
+ (LDA,M) if SIDE = 'L',
+ (LDA,N) if SIDE = 'R'
+ The i-th row must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+ ZGELQF in the first k rows of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A. LDA >= max(1,K).
+
+ TAU (input) COMPLEX*16 array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by ZGELQF.
+
+ C (input/output) COMPLEX*16 array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+ lquery = *lwork == -1;
+
+/* NQ is the order of Q and NW is the minimum dimension of WORK */
+
+ if (left) {
+ nq = *m;
+ nw = *n;
+ } else {
+ nq = *n;
+ nw = *m;
+ }
+ if ((! left && ! lsame_(side, "R"))) {
+ *info = -1;
+ } else if ((! notran && ! lsame_(trans, "C"))) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,*k)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ } else if ((*lwork < max(1,nw) && ! lquery)) {
+ *info = -12;
+ }
+
+ if (*info == 0) {
+
+/*
+ Determine the block size. NB may be at most NBMAX, where NBMAX
+ is used to define the local array T.
+
+ Computing MIN
+ Writing concatenation
+*/
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = 64, i__2 = ilaenv_(&c__1, "ZUNMLQ", ch__1, m, n, k, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ nb = min(i__1,i__2);
+ lwkopt = max(1,nw) * nb;
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZUNMLQ", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ work[1].r = 1., work[1].i = 0.;
+ return 0;
+ }
+
+ nbmin = 2;
+ ldwork = nw;
+ if ((nb > 1 && nb < *k)) {
+ iws = nw * nb;
+ if (*lwork < iws) {
+ nb = *lwork / ldwork;
+/*
+ Computing MAX
+ Writing concatenation
+*/
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = 2, i__2 = ilaenv_(&c__2, "ZUNMLQ", ch__1, m, n, k, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ nbmin = max(i__1,i__2);
+ }
+ } else {
+ iws = nw;
+ }
+
+ if (nb < nbmin || nb >= *k) {
+
+/* Use unblocked code */
+
+ zunml2_(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[
+ c_offset], ldc, &work[1], &iinfo);
+ } else {
+
+/* Use blocked code */
+
+ if ((left && notran) || (! left && ! notran)) {
+ i1 = 1;
+ i2 = *k;
+ i3 = nb;
+ } else {
+ i1 = (*k - 1) / nb * nb + 1;
+ i2 = 1;
+ i3 = -nb;
+ }
+
+ if (left) {
+ ni = *n;
+ jc = 1;
+ } else {
+ mi = *m;
+ ic = 1;
+ }
+
+ if (notran) {
+ *(unsigned char *)transt = 'C';
+ } else {
+ *(unsigned char *)transt = 'N';
+ }
+
+ i__1 = i2;
+ i__2 = i3;
+ for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+/* Computing MIN */
+ i__4 = nb, i__5 = *k - i__ + 1;
+ ib = min(i__4,i__5);
+
+/*
+ Form the triangular factor of the block reflector
+ H = H(i) H(i+1) . . . H(i+ib-1)
+*/
+
+ i__4 = nq - i__ + 1;
+ zlarft_("Forward", "Rowwise", &i__4, &ib, &a[i__ + i__ * a_dim1],
+ lda, &tau[i__], t, &c__65);
+ if (left) {
+
+/* H or H' is applied to C(i:m,1:n) */
+
+ mi = *m - i__ + 1;
+ ic = i__;
+ } else {
+
+/* H or H' is applied to C(1:m,i:n) */
+
+ ni = *n - i__ + 1;
+ jc = i__;
+ }
+
+/* Apply H or H' */
+
+ zlarfb_(side, transt, "Forward", "Rowwise", &mi, &ni, &ib, &a[i__
+ + i__ * a_dim1], lda, t, &c__65, &c__[ic + jc * c_dim1],
+ ldc, &work[1], &ldwork);
+/* L10: */
+ }
+ }
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ return 0;
+
+/* End of ZUNMLQ */
+
+} /* zunmlq_ */
+
+/* Subroutine */ int zunmql_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork,
+ integer *info)
+{
+ /* System generated locals */
+ address a__1[2];
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4,
+ i__5;
+ char ch__1[2];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
+
+ /* Local variables */
+ static integer i__;
+ static doublecomplex t[4160] /* was [65][64] */;
+ static integer i1, i2, i3, ib, nb, mi, ni, nq, nw, iws;
+ static logical left;
+ extern logical lsame_(char *, char *);
+ static integer nbmin, iinfo;
+ extern /* Subroutine */ int zunm2l_(char *, char *, integer *, integer *,
+ integer *, doublecomplex *, integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *,
+ integer *, integer *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *);
+ static logical notran;
+ static integer ldwork;
+ extern /* Subroutine */ int zlarft_(char *, char *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *);
+ static integer lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZUNMQL overwrites the general complex M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'C': Q**H * C C * Q**H
+
+ where Q is a complex unitary matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(k) . . . H(2) H(1)
+
+ as returned by ZGEQLF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**H from the Left;
+ = 'R': apply Q or Q**H from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'C': Transpose, apply Q**H.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) COMPLEX*16 array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+ ZGEQLF in the last k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) COMPLEX*16 array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by ZGEQLF.
+
+ C (input/output) COMPLEX*16 array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+ lquery = *lwork == -1;
+
+/* NQ is the order of Q and NW is the minimum dimension of WORK */
+
+ if (left) {
+ nq = *m;
+ nw = *n;
+ } else {
+ nq = *n;
+ nw = *m;
+ }
+ if ((! left && ! lsame_(side, "R"))) {
+ *info = -1;
+ } else if ((! notran && ! lsame_(trans, "C"))) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,nq)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ } else if ((*lwork < max(1,nw) && ! lquery)) {
+ *info = -12;
+ }
+
+ if (*info == 0) {
+
+/*
+ Determine the block size. NB may be at most NBMAX, where NBMAX
+ is used to define the local array T.
+
+ Computing MIN
+ Writing concatenation
+*/
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = 64, i__2 = ilaenv_(&c__1, "ZUNMQL", ch__1, m, n, k, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ nb = min(i__1,i__2);
+ lwkopt = max(1,nw) * nb;
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZUNMQL", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ work[1].r = 1., work[1].i = 0.;
+ return 0;
+ }
+
+ nbmin = 2;
+ ldwork = nw;
+ if ((nb > 1 && nb < *k)) {
+ iws = nw * nb;
+ if (*lwork < iws) {
+ nb = *lwork / ldwork;
+/*
+ Computing MAX
+ Writing concatenation
+*/
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = 2, i__2 = ilaenv_(&c__2, "ZUNMQL", ch__1, m, n, k, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ nbmin = max(i__1,i__2);
+ }
+ } else {
+ iws = nw;
+ }
+
+ if (nb < nbmin || nb >= *k) {
+
+/* Use unblocked code */
+
+ zunm2l_(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[
+ c_offset], ldc, &work[1], &iinfo);
+ } else {
+
+/* Use blocked code */
+
+ if ((left && notran) || (! left && ! notran)) {
+ i1 = 1;
+ i2 = *k;
+ i3 = nb;
+ } else {
+ i1 = (*k - 1) / nb * nb + 1;
+ i2 = 1;
+ i3 = -nb;
+ }
+
+ if (left) {
+ ni = *n;
+ } else {
+ mi = *m;
+ }
+
+ i__1 = i2;
+ i__2 = i3;
+ for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+/* Computing MIN */
+ i__4 = nb, i__5 = *k - i__ + 1;
+ ib = min(i__4,i__5);
+
+/*
+ Form the triangular factor of the block reflector
+ H = H(i+ib-1) . . . H(i+1) H(i)
+*/
+
+ i__4 = nq - *k + i__ + ib - 1;
+ zlarft_("Backward", "Columnwise", &i__4, &ib, &a[i__ * a_dim1 + 1]
+ , lda, &tau[i__], t, &c__65);
+ if (left) {
+
+/* H or H' is applied to C(1:m-k+i+ib-1,1:n) */
+
+ mi = *m - *k + i__ + ib - 1;
+ } else {
+
+/* H or H' is applied to C(1:m,1:n-k+i+ib-1) */
+
+ ni = *n - *k + i__ + ib - 1;
+ }
+
+/* Apply H or H' */
+
+ zlarfb_(side, trans, "Backward", "Columnwise", &mi, &ni, &ib, &a[
+ i__ * a_dim1 + 1], lda, t, &c__65, &c__[c_offset], ldc, &
+ work[1], &ldwork);
+/* L10: */
+ }
+ }
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ return 0;
+
+/* End of ZUNMQL */
+
+} /* zunmql_ */
+
+/* Subroutine */ int zunmqr_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork,
+ integer *info)
+{
+ /* System generated locals */
+ address a__1[2];
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4,
+ i__5;
+ char ch__1[2];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
+
+ /* Local variables */
+ static integer i__;
+ static doublecomplex t[4160] /* was [65][64] */;
+ static integer i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws;
+ static logical left;
+ extern logical lsame_(char *, char *);
+ static integer nbmin, iinfo;
+ extern /* Subroutine */ int zunm2r_(char *, char *, integer *, integer *,
+ integer *, doublecomplex *, integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ extern /* Subroutine */ int zlarfb_(char *, char *, char *, char *,
+ integer *, integer *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *, doublecomplex *, integer *,
+ doublecomplex *, integer *);
+ static logical notran;
+ static integer ldwork;
+ extern /* Subroutine */ int zlarft_(char *, char *, integer *, integer *,
+ doublecomplex *, integer *, doublecomplex *, doublecomplex *,
+ integer *);
+ static integer lwkopt;
+ static logical lquery;
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZUNMQR overwrites the general complex M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'C': Q**H * C C * Q**H
+
+ where Q is a complex unitary matrix defined as the product of k
+ elementary reflectors
+
+ Q = H(1) H(2) . . . H(k)
+
+ as returned by ZGEQRF. Q is of order M if SIDE = 'L' and of order N
+ if SIDE = 'R'.
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**H from the Left;
+ = 'R': apply Q or Q**H from the Right.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'C': Conjugate transpose, apply Q**H.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ K (input) INTEGER
+ The number of elementary reflectors whose product defines
+ the matrix Q.
+ If SIDE = 'L', M >= K >= 0;
+ if SIDE = 'R', N >= K >= 0.
+
+ A (input) COMPLEX*16 array, dimension (LDA,K)
+ The i-th column must contain the vector which defines the
+ elementary reflector H(i), for i = 1,2,...,k, as returned by
+ ZGEQRF in the first k columns of its array argument A.
+ A is modified by the routine but restored on exit.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ If SIDE = 'L', LDA >= max(1,M);
+ if SIDE = 'R', LDA >= max(1,N).
+
+ TAU (input) COMPLEX*16 array, dimension (K)
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by ZGEQRF.
+
+ C (input/output) COMPLEX*16 array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+ lquery = *lwork == -1;
+
+/* NQ is the order of Q and NW is the minimum dimension of WORK */
+
+ if (left) {
+ nq = *m;
+ nw = *n;
+ } else {
+ nq = *n;
+ nw = *m;
+ }
+ if ((! left && ! lsame_(side, "R"))) {
+ *info = -1;
+ } else if ((! notran && ! lsame_(trans, "C"))) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,nq)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ } else if ((*lwork < max(1,nw) && ! lquery)) {
+ *info = -12;
+ }
+
+ if (*info == 0) {
+
+/*
+ Determine the block size. NB may be at most NBMAX, where NBMAX
+ is used to define the local array T.
+
+ Computing MIN
+ Writing concatenation
+*/
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = 64, i__2 = ilaenv_(&c__1, "ZUNMQR", ch__1, m, n, k, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ nb = min(i__1,i__2);
+ lwkopt = max(1,nw) * nb;
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("ZUNMQR", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ work[1].r = 1., work[1].i = 0.;
+ return 0;
+ }
+
+ nbmin = 2;
+ ldwork = nw;
+ if ((nb > 1 && nb < *k)) {
+ iws = nw * nb;
+ if (*lwork < iws) {
+ nb = *lwork / ldwork;
+/*
+ Computing MAX
+ Writing concatenation
+*/
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = 2, i__2 = ilaenv_(&c__2, "ZUNMQR", ch__1, m, n, k, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ nbmin = max(i__1,i__2);
+ }
+ } else {
+ iws = nw;
+ }
+
+ if (nb < nbmin || nb >= *k) {
+
+/* Use unblocked code */
+
+ zunm2r_(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[
+ c_offset], ldc, &work[1], &iinfo);
+ } else {
+
+/* Use blocked code */
+
+ if ((left && ! notran) || (! left && notran)) {
+ i1 = 1;
+ i2 = *k;
+ i3 = nb;
+ } else {
+ i1 = (*k - 1) / nb * nb + 1;
+ i2 = 1;
+ i3 = -nb;
+ }
+
+ if (left) {
+ ni = *n;
+ jc = 1;
+ } else {
+ mi = *m;
+ ic = 1;
+ }
+
+ i__1 = i2;
+ i__2 = i3;
+ for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+/* Computing MIN */
+ i__4 = nb, i__5 = *k - i__ + 1;
+ ib = min(i__4,i__5);
+
+/*
+ Form the triangular factor of the block reflector
+ H = H(i) H(i+1) . . . H(i+ib-1)
+*/
+
+ i__4 = nq - i__ + 1;
+ zlarft_("Forward", "Columnwise", &i__4, &ib, &a[i__ + i__ *
+ a_dim1], lda, &tau[i__], t, &c__65)
+ ;
+ if (left) {
+
+/* H or H' is applied to C(i:m,1:n) */
+
+ mi = *m - i__ + 1;
+ ic = i__;
+ } else {
+
+/* H or H' is applied to C(1:m,i:n) */
+
+ ni = *n - i__ + 1;
+ jc = i__;
+ }
+
+/* Apply H or H' */
+
+ zlarfb_(side, trans, "Forward", "Columnwise", &mi, &ni, &ib, &a[
+ i__ + i__ * a_dim1], lda, t, &c__65, &c__[ic + jc *
+ c_dim1], ldc, &work[1], &ldwork);
+/* L10: */
+ }
+ }
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ return 0;
+
+/* End of ZUNMQR */
+
+} /* zunmqr_ */
+
+/* Subroutine */ int zunmtr_(char *side, char *uplo, char *trans, integer *m,
+ integer *n, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork,
+ integer *info)
+{
+ /* System generated locals */
+ address a__1[2];
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1[2], i__2, i__3;
+ char ch__1[2];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
+
+ /* Local variables */
+ static integer i1, i2, nb, mi, ni, nq, nw;
+ static logical left;
+ extern logical lsame_(char *, char *);
+ static integer iinfo;
+ static logical upper;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *, ftnlen, ftnlen);
+ static integer lwkopt;
+ static logical lquery;
+ extern /* Subroutine */ int zunmql_(char *, char *, integer *, integer *,
+ integer *, doublecomplex *, integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *, integer *), zunmqr_(char *, char *, integer *, integer *,
+ integer *, doublecomplex *, integer *, doublecomplex *,
+ doublecomplex *, integer *, doublecomplex *, integer *, integer *);
+
+
+/*
+ -- LAPACK routine (version 3.0) --
+ Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+ Courant Institute, Argonne National Lab, and Rice University
+ June 30, 1999
+
+
+ Purpose
+ =======
+
+ ZUNMTR overwrites the general complex M-by-N matrix C with
+
+ SIDE = 'L' SIDE = 'R'
+ TRANS = 'N': Q * C C * Q
+ TRANS = 'C': Q**H * C C * Q**H
+
+ where Q is a complex unitary matrix of order nq, with nq = m if
+ SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
+ nq-1 elementary reflectors, as returned by ZHETRD:
+
+ if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1);
+
+ if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1).
+
+ Arguments
+ =========
+
+ SIDE (input) CHARACTER*1
+ = 'L': apply Q or Q**H from the Left;
+ = 'R': apply Q or Q**H from the Right.
+
+ UPLO (input) CHARACTER*1
+ = 'U': Upper triangle of A contains elementary reflectors
+ from ZHETRD;
+ = 'L': Lower triangle of A contains elementary reflectors
+ from ZHETRD.
+
+ TRANS (input) CHARACTER*1
+ = 'N': No transpose, apply Q;
+ = 'C': Conjugate transpose, apply Q**H.
+
+ M (input) INTEGER
+ The number of rows of the matrix C. M >= 0.
+
+ N (input) INTEGER
+ The number of columns of the matrix C. N >= 0.
+
+ A (input) COMPLEX*16 array, dimension
+ (LDA,M) if SIDE = 'L'
+ (LDA,N) if SIDE = 'R'
+ The vectors which define the elementary reflectors, as
+ returned by ZHETRD.
+
+ LDA (input) INTEGER
+ The leading dimension of the array A.
+ LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
+
+ TAU (input) COMPLEX*16 array, dimension
+ (M-1) if SIDE = 'L'
+ (N-1) if SIDE = 'R'
+ TAU(i) must contain the scalar factor of the elementary
+ reflector H(i), as returned by ZHETRD.
+
+ C (input/output) COMPLEX*16 array, dimension (LDC,N)
+ On entry, the M-by-N matrix C.
+ On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
+
+ LDC (input) INTEGER
+ The leading dimension of the array C. LDC >= max(1,M).
+
+ WORK (workspace/output) COMPLEX*16 array, dimension (LWORK)
+ On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+
+ LWORK (input) INTEGER
+ The dimension of the array WORK.
+ If SIDE = 'L', LWORK >= max(1,N);
+ if SIDE = 'R', LWORK >= max(1,M).
+ For optimum performance LWORK >= N*NB if SIDE = 'L', and
+ LWORK >=M*NB if SIDE = 'R', where NB is the optimal
+ blocksize.
+
+ If LWORK = -1, then a workspace query is assumed; the routine
+ only calculates the optimal size of the WORK array, returns
+ this value as the first entry of the WORK array, and no error
+ message related to LWORK is issued by XERBLA.
+
+ INFO (output) INTEGER
+ = 0: successful exit
+ < 0: if INFO = -i, the i-th argument had an illegal value
+
+ =====================================================================
+
+
+ Test the input arguments
+*/
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1 * 1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1 * 1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ left = lsame_(side, "L");
+ upper = lsame_(uplo, "U");
+ lquery = *lwork == -1;
+
+/* NQ is the order of Q and NW is the minimum dimension of WORK */
+
+ if (left) {
+ nq = *m;
+ nw = *n;
+ } else {
+ nq = *n;
+ nw = *m;
+ }
+ if ((! left && ! lsame_(side, "R"))) {
+ *info = -1;
+ } else if ((! upper && ! lsame_(uplo, "L"))) {
+ *info = -2;
+ } else if ((! lsame_(trans, "N") && ! lsame_(trans,
+ "C"))) {
+ *info = -3;
+ } else if (*m < 0) {
+ *info = -4;
+ } else if (*n < 0) {
+ *info = -5;
+ } else if (*lda < max(1,nq)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ } else if ((*lwork < max(1,nw) && ! lquery)) {
+ *info = -12;
+ }
+
+ if (*info == 0) {
+ if (upper) {
+ if (left) {
+/* Writing concatenation */
+ i__1[0] = 1, a__1[0] = side;
+ i__1[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
+ i__2 = *m - 1;
+ i__3 = *m - 1;
+ nb = ilaenv_(&c__1, "ZUNMQL", ch__1, &i__2, n, &i__3, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ } else {
+/* Writing concatenation */
+ i__1[0] = 1, a__1[0] = side;
+ i__1[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
+ i__2 = *n - 1;
+ i__3 = *n - 1;
+ nb = ilaenv_(&c__1, "ZUNMQL", ch__1, m, &i__2, &i__3, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ }
+ } else {
+ if (left) {
+/* Writing concatenation */
+ i__1[0] = 1, a__1[0] = side;
+ i__1[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
+ i__2 = *m - 1;
+ i__3 = *m - 1;
+ nb = ilaenv_(&c__1, "ZUNMQR", ch__1, &i__2, n, &i__3, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ } else {
+/* Writing concatenation */
+ i__1[0] = 1, a__1[0] = side;
+ i__1[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
+ i__2 = *n - 1;
+ i__3 = *n - 1;
+ nb = ilaenv_(&c__1, "ZUNMQR", ch__1, m, &i__2, &i__3, &c_n1, (
+ ftnlen)6, (ftnlen)2);
+ }
+ }
+ lwkopt = max(1,nw) * nb;
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ }
+
+ if (*info != 0) {
+ i__2 = -(*info);
+ xerbla_("ZUNMTR", &i__2);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || nq == 1) {
+ work[1].r = 1., work[1].i = 0.;
+ return 0;
+ }
+
+ if (left) {
+ mi = *m - 1;
+ ni = *n;
+ } else {
+ mi = *m;
+ ni = *n - 1;
+ }
+
+ if (upper) {
+
+/* Q was determined by a call to ZHETRD with UPLO = 'U' */
+
+ i__2 = nq - 1;
+ zunmql_(side, trans, &mi, &ni, &i__2, &a[((a_dim1) << (1)) + 1], lda,
+ &tau[1], &c__[c_offset], ldc, &work[1], lwork, &iinfo);
+ } else {
+
+/* Q was determined by a call to ZHETRD with UPLO = 'L' */
+
+ if (left) {
+ i1 = 2;
+ i2 = 1;
+ } else {
+ i1 = 1;
+ i2 = 2;
+ }
+ i__2 = nq - 1;
+ zunmqr_(side, trans, &mi, &ni, &i__2, &a[a_dim1 + 2], lda, &tau[1], &
+ c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo);
+ }
+ work[1].r = (doublereal) lwkopt, work[1].i = 0.;
+ return 0;
+
+/* End of ZUNMTR */
+
+} /* zunmtr_ */
+
diff --git a/numpy/matlib.py b/numpy/matlib.py
new file mode 100644
index 000000000..a4720bc3c
--- /dev/null
+++ b/numpy/matlib.py
@@ -0,0 +1,65 @@
+from numpy.core.defmatrix import matrix, asmatrix
+from numpy import ndarray, array
+import numpy as N
+from numpy import *
+
+__version__ = N.__version__
+
+__all__ = N.__all__[:] # copy numpy namespace
+__all__ += ['rand', 'randn', 'repmat']
+
+def empty(shape, dtype=None, order='C'):
+ """return an empty matrix of the given shape
+ """
+ return ndarray.__new__(matrix, shape, dtype, order=order)
+
+def ones(shape, dtype=None, order='C'):
+ """return a matrix initialized to all ones
+ """
+ a = ndarray.__new__(matrix, shape, dtype, order=order)
+ a.fill(1)
+ return a
+
+def zeros(shape, dtype=None, order='C'):
+ """return a matrix initialized to all zeros
+ """
+ a = ndarray.__new__(matrix, shape, dtype, order=order)
+ a.fill(0)
+ return a
+
+def identity(n,dtype=None):
+ """identity(n) returns the identity matrix of shape n x n.
+ """
+ a = array([1]+n*[0],dtype=dtype)
+ b = empty((n,n),dtype=dtype)
+ b.flat = a
+ return b
+
+def eye(n,M=None, k=0, dtype=float):
+ return asmatrix(N.eye(n,M,k,dtype))
+
+def rand(*args):
+ if isinstance(args[0], tuple):
+ args = args[0]
+ return asmatrix(N.random.rand(*args))
+
+def randn(*args):
+ if isinstance(args[0], tuple):
+ args = args[0]
+ return asmatrix(N.random.randn(*args))
+
+def repmat(a, m, n):
+ """Repeat a 0-d to 2-d array mxn times
+ """
+ a = asanyarray(a)
+ ndim = a.ndim
+ if ndim == 0:
+ origrows, origcols = (1,1)
+ elif ndim == 1:
+ origrows, origcols = (1, a.shape[0])
+ else:
+ origrows, origcols = a.shape
+ rows = origrows * m
+ cols = origcols * n
+ c = a.reshape(1,a.size).repeat(m, 0).reshape(rows, origcols).repeat(n,0)
+ return c.reshape(rows, cols)
diff --git a/numpy/numarray/__init__.py b/numpy/numarray/__init__.py
new file mode 100644
index 000000000..b0819d127
--- /dev/null
+++ b/numpy/numarray/__init__.py
@@ -0,0 +1,26 @@
+from util import *
+from numerictypes import *
+from functions import *
+from ufuncs import *
+from compat import *
+from session import *
+
+import util
+import numerictypes
+import functions
+import ufuncs
+import compat
+import session
+
+__all__ = ['session', 'numerictypes']
+__all__ += util.__all__
+__all__ += numerictypes.__all__
+__all__ += functions.__all__
+__all__ += ufuncs.__all__
+__all__ += compat.__all__
+__all__ += session.__all__
+
+del util
+del functions
+del ufuncs
+del compat
diff --git a/numpy/numarray/_capi.c b/numpy/numarray/_capi.c
new file mode 100644
index 000000000..0ba1be221
--- /dev/null
+++ b/numpy/numarray/_capi.c
@@ -0,0 +1,3337 @@
+#include <Python.h>
+
+#define _libnumarray_MODULE
+#include "numpy/libnumarray.h"
+#include <float.h>
+
+#if defined(__GLIBC__) || defined(__APPLE__) || defined(__MINGW32__)
+#include <fenv.h>
+#elif defined(__CYGWIN__)
+#include "numpy/fenv/fenv.h"
+#include "numpy/fenv/fenv.c"
+#endif
+
+static PyObject *pCfuncClass;
+static PyTypeObject CfuncType;
+static PyObject *pHandleErrorFunc;
+
+static int
+deferred_libnumarray_init(void)
+{
+ static int initialized=0;
+
+ if (initialized) return 0;
+
+ pCfuncClass = (PyObject *) &CfuncType;
+ Py_INCREF(pCfuncClass);
+
+ pHandleErrorFunc =
+ NA_initModuleGlobal("numpy.numarray.util", "handleError");
+
+ if (!pHandleErrorFunc) goto _fail;
+
+
+ /* _exit: */
+ initialized = 1;
+ return 0;
+
+ _fail:
+ initialized = 0;
+ return -1;
+}
+
+
+
+/**********************************************************************/
+/* Buffer Utility Functions */
+/**********************************************************************/
+
+static PyObject *
+getBuffer( PyObject *obj)
+{
+ if (!obj) return PyErr_Format(PyExc_RuntimeError,
+ "NULL object passed to getBuffer()");
+ if (obj->ob_type->tp_as_buffer == NULL) {
+ return PyObject_CallMethod(obj, "__buffer__", NULL);
+ } else {
+ Py_INCREF(obj); /* Since CallMethod returns a new object when it
+ succeeds, We'll need to DECREF later to free it.
+ INCREF ordinary buffers here so we don't have to
+ remember where the buffer came from at DECREF time.
+ */
+ return obj;
+ }
+}
+
+/* Either it defines the buffer API, or it is an instance which returns
+a buffer when obj.__buffer__() is called */
+static int
+isBuffer (PyObject *obj)
+{
+ PyObject *buf = getBuffer(obj);
+ int ans = 0;
+ if (buf) {
+ ans = buf->ob_type->tp_as_buffer != NULL;
+ Py_DECREF(buf);
+ } else {
+ PyErr_Clear();
+ }
+ return ans;
+}
+
+/**********************************************************************/
+
+static int
+getWriteBufferDataPtr(PyObject *buffobj, void **buff)
+{
+ int rval = -1;
+ PyObject *buff2;
+ if ((buff2 = getBuffer(buffobj)))
+ {
+ if (buff2->ob_type->tp_as_buffer->bf_getwritebuffer)
+ rval = buff2->ob_type->tp_as_buffer->bf_getwritebuffer(buff2,
+ 0, buff);
+ Py_DECREF(buff2);
+ }
+ return rval;
+}
+
+/**********************************************************************/
+
+static int
+isBufferWriteable (PyObject *buffobj)
+{
+ void *ptr;
+ int rval = -1;
+ rval = getWriteBufferDataPtr(buffobj, &ptr);
+ if (rval == -1)
+ PyErr_Clear(); /* Since we're just "testing", it's not really an error */
+ return rval != -1;
+}
+
+/**********************************************************************/
+
+static int
+getReadBufferDataPtr(PyObject *buffobj, void **buff)
+{
+ int rval = -1;
+ PyObject *buff2;
+ if ((buff2 = getBuffer(buffobj))) {
+ if (buff2->ob_type->tp_as_buffer->bf_getreadbuffer)
+ rval = buff2->ob_type->tp_as_buffer->bf_getreadbuffer(buff2,
+ 0, buff);
+ Py_DECREF(buff2);
+ }
+ return rval;
+}
+
+/**********************************************************************/
+
+static int
+getBufferSize(PyObject *buffobj)
+{
+ Py_ssize_t size=0;
+ PyObject *buff2;
+ if ((buff2 = getBuffer(buffobj)))
+ {
+ (void) buff2->ob_type->tp_as_buffer->bf_getsegcount(buff2, &size);
+ Py_DECREF(buff2);
+ }
+ else
+ size = -1;
+ return size;
+}
+
+
+static double numarray_zero = 0.0;
+
+static double raiseDivByZero(void)
+{
+ return 1.0/numarray_zero;
+}
+
+static double raiseNegDivByZero(void)
+{
+ return -1.0/numarray_zero;
+}
+
+static double num_log(double x)
+{
+ if (x == 0.0)
+ return raiseNegDivByZero();
+ else
+ return log(x);
+}
+
+static double num_log10(double x)
+{
+ if (x == 0.0)
+ return raiseNegDivByZero();
+ else
+ return log10(x);
+}
+
+static double num_pow(double x, double y)
+{
+ int z = (int) y;
+ if ((x < 0.0) && (y != z))
+ return raiseDivByZero();
+ else
+ return pow(x, y);
+}
+
+/* Inverse hyperbolic trig functions from Numeric */
+static double num_acosh(double x)
+{
+ return log(x + sqrt((x-1.0)*(x+1.0)));
+}
+
+static double num_asinh(double xx)
+{
+ double x;
+ int sign;
+ if (xx < 0.0) {
+ sign = -1;
+ x = -xx;
+ }
+ else {
+ sign = 1;
+ x = xx;
+ }
+ return sign*log(x + sqrt(x*x+1.0));
+}
+
+static double num_atanh(double x)
+{
+ return 0.5*log((1.0+x)/(1.0-x));
+}
+
+/* NUM_CROUND (in numcomplex.h) also calls num_round */
+static double num_round(double x)
+{
+ return (x >= 0) ? floor(x+0.5) : ceil(x-0.5);
+}
+
+
+/* The following routine is used in the event of a detected integer *
+** divide by zero so that a floating divide by zero is generated. *
+** This is done since numarray uses the floating point exception *
+** sticky bits to detect errors. The last bit is an attempt to *
+** prevent optimization of the divide by zero away, the input value *
+** should always be 0 *
+*/
+
+static int int_dividebyzero_error(long value, long unused) {
+ double dummy;
+ dummy = 1./numarray_zero;
+ if (dummy) /* to prevent optimizer from eliminating expression */
+ return 0;
+ else
+ return 1;
+}
+
+/* Likewise for Integer overflows */
+#if defined(__GLIBC__) || defined(__APPLE__) || defined(__CYGWIN__) || defined(__MINGW32__)
+static int int_overflow_error(Float64 value) { /* For x86_64 */
+ feraiseexcept(FE_OVERFLOW);
+ return (int) value;
+}
+#else
+static int int_overflow_error(Float64 value) {
+ double dummy;
+ dummy = pow(1.e10, fabs(value/2));
+ if (dummy) /* to prevent optimizer from eliminating expression */
+ return (int) value;
+ else
+ return 1;
+}
+#endif
+
+static int umult64_overflow(UInt64 a, UInt64 b)
+{
+ UInt64 ah, al, bh, bl, w, x, y, z;
+
+ ah = (a >> 32);
+ al = (a & 0xFFFFFFFFL);
+ bh = (b >> 32);
+ bl = (b & 0xFFFFFFFFL);
+
+ /* 128-bit product: z*2**64 + (x+y)*2**32 + w */
+ w = al*bl;
+ x = bh*al;
+ y = ah*bl;
+ z = ah*bh;
+
+ /* *c = ((x + y)<<32) + w; */
+ return z || (x>>32) || (y>>32) ||
+ (((x & 0xFFFFFFFFL) + (y & 0xFFFFFFFFL) + (w >> 32)) >> 32);
+}
+
+static int smult64_overflow(Int64 a0, Int64 b0)
+{
+ UInt64 a, b;
+ UInt64 ah, al, bh, bl, w, x, y, z;
+
+ /* Convert to non-negative quantities */
+ if (a0 < 0) { a = -a0; } else { a = a0; }
+ if (b0 < 0) { b = -b0; } else { b = b0; }
+
+ ah = (a >> 32);
+ al = (a & 0xFFFFFFFFL);
+ bh = (b >> 32);
+ bl = (b & 0xFFFFFFFFL);
+
+ w = al*bl;
+ x = bh*al;
+ y = ah*bl;
+ z = ah*bh;
+
+ /*
+ UInt64 c = ((x + y)<<32) + w;
+ if ((a0 < 0) ^ (b0 < 0))
+ *c = -c;
+ else
+ *c = c
+ */
+
+ return z || (x>>31) || (y>>31) ||
+ (((x & 0xFFFFFFFFL) + (y & 0xFFFFFFFFL) + (w >> 32)) >> 31);
+}
+
+
+static void
+NA_Done(void)
+{
+ return;
+}
+
+static PyArrayObject *
+NA_NewAll(int ndim, maybelong *shape, NumarrayType type,
+ void *buffer, maybelong byteoffset, maybelong bytestride,
+ int byteorder, int aligned, int writeable)
+{
+ PyArrayObject *result = NA_NewAllFromBuffer(
+ ndim, shape, type, Py_None, byteoffset, bytestride,
+ byteorder, aligned, writeable);
+
+ if (result) {
+ if (!NA_NumArrayCheck((PyObject *) result)) {
+ PyErr_Format( PyExc_TypeError,
+ "NA_NewAll: non-NumArray result");
+ result = NULL;
+ } else {
+ if (buffer) {
+ memcpy(result->data, buffer, NA_NBYTES(result));
+ } else {
+ memset(result->data, 0, NA_NBYTES(result));
+ }
+ }
+ }
+ return result;
+}
+
+static PyArrayObject *
+NA_NewAllStrides(int ndim, maybelong *shape, maybelong *strides,
+ NumarrayType type, void *buffer, maybelong byteoffset,
+ int byteorder, int aligned, int writeable)
+{
+ int i;
+ PyArrayObject *result = NA_NewAll(ndim, shape, type, buffer,
+ byteoffset, 0,
+ byteorder, aligned, writeable);
+ for(i=0; i<ndim; i++)
+ result->strides[i] = strides[i];
+ return result;
+}
+
+
+static PyArrayObject *
+NA_New(void *buffer, NumarrayType type, int ndim, ...)
+{
+ int i;
+ maybelong shape[MAXDIM];
+ va_list ap;
+ va_start(ap, ndim);
+ for(i=0; i<ndim; i++)
+ shape[i] = va_arg(ap, int);
+ va_end(ap);
+ return NA_NewAll(ndim, shape, type, buffer, 0, 0,
+ NA_ByteOrder(), 1, 1);
+}
+
+static PyArrayObject *
+NA_Empty(int ndim, maybelong *shape, NumarrayType type)
+{
+ return NA_NewAll(ndim, shape, type, NULL, 0, 0,
+ NA_ByteOrder(), 1, 1);
+}
+
+
+/* Create a new numarray which is initially a C_array, or which
+references a C_array: aligned, !byteswapped, contiguous, ...
+Call with buffer==NULL to allocate storage.
+*/
+static PyArrayObject *
+NA_vNewArray(void *buffer, NumarrayType type, int ndim, maybelong *shape)
+{
+ return (PyArrayObject *) NA_NewAll(ndim, shape, type, buffer, 0, 0,
+ NA_ByteOrder(), 1, 1);
+}
+
+static PyArrayObject *
+NA_NewArray(void *buffer, NumarrayType type, int ndim, ...)
+{
+ int i;
+ maybelong shape[MAXDIM];
+ va_list ap;
+ va_start(ap, ndim);
+ for(i=0; i<ndim; i++)
+ shape[i] = va_arg(ap, int); /* literals will still be ints */
+ va_end(ap);
+ return NA_vNewArray(buffer, type, ndim, shape);
+}
+
+
+static PyObject*
+NA_ReturnOutput(PyObject *out, PyArrayObject *shadow)
+{
+ if ((out == Py_None) || (out == NULL)) {
+ /* default behavior: return shadow array as the result */
+ return (PyObject *) shadow;
+ } else {
+ PyObject *rval;
+ /* specified output behavior: return None */
+ /* del(shadow) --> out.copyFrom(shadow) */
+ Py_DECREF(shadow);
+ Py_INCREF(Py_None);
+ rval = Py_None;
+ return rval;
+ }
+}
+
+static long NA_getBufferPtrAndSize(PyObject *buffobj, int readonly, void **ptr)
+{
+ long rval;
+ if (readonly)
+ rval = getReadBufferDataPtr(buffobj, ptr);
+ else
+ rval = getWriteBufferDataPtr(buffobj, ptr);
+ return rval;
+}
+
+
+static int NA_checkIo(char *name,
+ int wantIn, int wantOut, int gotIn, int gotOut)
+{
+ if (wantIn != gotIn) {
+ PyErr_Format(_Error,
+ "%s: wrong # of input buffers. Expected %d. Got %d.",
+ name, wantIn, gotIn);
+ return -1;
+ }
+ if (wantOut != gotOut) {
+ PyErr_Format(_Error,
+ "%s: wrong # of output buffers. Expected %d. Got %d.",
+ name, wantOut, gotOut);
+ return -1;
+ }
+ return 0;
+}
+
+static int NA_checkOneCBuffer(char *name, long niter,
+ void *buffer, long bsize, size_t typesize)
+{
+ Int64 lniter = niter, ltypesize = typesize;
+
+ if (lniter*ltypesize > bsize) {
+ PyErr_Format(_Error,
+ "%s: access out of buffer. niter=%d typesize=%d bsize=%d",
+ name, (int) niter, (int) typesize, (int) bsize);
+ return -1;
+ }
+ if ((typesize <= sizeof(Float64)) && (((long) buffer) % typesize)) {
+ PyErr_Format(_Error,
+ "%s: buffer not aligned on %d byte boundary.",
+ name, (int) typesize);
+ return -1;
+ }
+ return 0;
+}
+
+
+static int NA_checkNCBuffers(char *name, int N, long niter,
+ void **buffers, long *bsizes,
+ Int8 *typesizes, Int8 *iters)
+{
+ int i;
+ for (i=0; i<N; i++)
+ if (NA_checkOneCBuffer(name, iters[i] ? iters[i] : niter,
+ buffers[i], bsizes[i], typesizes[i]))
+ return -1;
+ return 0;
+}
+
+static int NA_checkOneStriding(char *name, long dim, maybelong *shape,
+ long offset, maybelong *stride, long buffersize, long itemsize,
+ int align)
+{
+ int i;
+ long omin=offset, omax=offset;
+ long alignsize = (itemsize <= sizeof(Float64) ? itemsize : sizeof(Float64));
+
+ if (align && (offset % alignsize)) {
+ PyErr_Format(_Error,
+ "%s: buffer not aligned on %d byte boundary.",
+ name, (int) alignsize);
+ return -1;
+ }
+ for(i=0; i<dim; i++) {
+ long strideN = stride[i] * (shape[i]-1);
+ long tmax = omax + strideN;
+ long tmin = omin + strideN;
+ if (shape[i]-1 >= 0) { /* Skip dimension == 0. */
+ omax = MAX(omax, tmax);
+ omin = MIN(omin, tmin);
+ if (align && (ABS(stride[i]) % alignsize)) {
+ PyErr_Format(_Error,
+ "%s: stride %d not aligned on %d byte boundary.",
+ name, (int) stride[i], (int) alignsize);
+ return -1;
+ }
+ if (omax + itemsize > buffersize) {
+ PyErr_Format(_Error,
+ "%s: access beyond buffer. offset=%d buffersize=%d",
+ name, (int) (omax+itemsize-1), (int) buffersize);
+ return -1;
+ }
+ if (omin < 0) {
+ PyErr_Format(_Error,
+ "%s: access before buffer. offset=%d buffersize=%d",
+ name, (int) omin, (int) buffersize);
+ return -1;
+ }
+ }
+ }
+ return 0;
+}
+
+/* Function to call standard C Ufuncs
+**
+** The C Ufuncs expect contiguous 1-d data numarray, input and output numarray
+** iterate with standard increments of one data element over all numarray.
+** (There are some exceptions like arrayrangexxx which use one or more of
+** the data numarray as parameter or other sources of information and do not
+** iterate over every buffer).
+**
+** Arguments:
+**
+** Number of iterations (simple integer value).
+** Number of input numarray.
+** Number of output numarray.
+** Tuple of tuples, one tuple per input/output array. Each of these
+** tuples consists of a buffer object and a byte offset to start.
+**
+** Returns None
+*/
+
+
+static PyObject *
+NA_callCUFuncCore(PyObject *self,
+ long niter, long ninargs, long noutargs,
+ PyObject **BufferObj, long *offset)
+{
+ CfuncObject *me = (CfuncObject *) self;
+ char *buffers[MAXARGS];
+ long bsizes[MAXARGS];
+ long i, pnargs = ninargs + noutargs;
+ UFUNC ufuncptr;
+
+ if (pnargs > MAXARGS)
+ return PyErr_Format(PyExc_RuntimeError, "NA_callCUFuncCore: too many parameters");
+
+ if (!PyObject_IsInstance(self, (PyObject *) &CfuncType)
+ || me->descr.type != CFUNC_UFUNC)
+ return PyErr_Format(PyExc_TypeError,
+ "NA_callCUFuncCore: problem with cfunc.");
+
+ for (i=0; i<pnargs; i++) {
+ int readonly = (i < ninargs);
+ if (offset[i] < 0)
+ return PyErr_Format(_Error,
+ "%s: invalid negative offset:%d for buffer[%d]",
+ me->descr.name, (int) offset[i], (int) i);
+ if ((bsizes[i] = NA_getBufferPtrAndSize(BufferObj[i], readonly,
+ (void *) &buffers[i])) < 0)
+ return PyErr_Format(_Error,
+ "%s: Problem with %s buffer[%d].",
+ me->descr.name,
+ readonly ? "read" : "write", (int) i);
+ buffers[i] += offset[i];
+ bsizes[i] -= offset[i]; /* "shorten" buffer size by offset. */
+ }
+
+ ufuncptr = (UFUNC) me->descr.fptr;
+
+ /* If it's not a self-checking ufunc, check arg count match,
+ buffer size, and alignment for all buffers */
+ if (!me->descr.chkself &&
+ (NA_checkIo(me->descr.name,
+ me->descr.wantIn, me->descr.wantOut, ninargs, noutargs) ||
+ NA_checkNCBuffers(me->descr.name, pnargs,
+ niter, (void **) buffers, bsizes,
+ me->descr.sizes, me->descr.iters)))
+ return NULL;
+
+ /* Since the parameters are valid, call the C Ufunc */
+ if (!(*ufuncptr)(niter, ninargs, noutargs, (void **)buffers, bsizes)) {
+ Py_INCREF(Py_None);
+ return Py_None;
+ } else {
+ return NULL;
+ }
+}
+
+static PyObject *
+callCUFunc(PyObject *self, PyObject *args) {
+ PyObject *DataArgs, *ArgTuple;
+ long pnargs, ninargs, noutargs, niter, i;
+ CfuncObject *me = (CfuncObject *) self;
+ PyObject *BufferObj[MAXARGS];
+ long offset[MAXARGS];
+
+ if (!PyArg_ParseTuple(args, "lllO",
+ &niter, &ninargs, &noutargs, &DataArgs))
+ return PyErr_Format(_Error,
+ "%s: Problem with argument list", me->descr.name);
+
+ /* check consistency of stated inputs/outputs and supplied buffers */
+ pnargs = PyObject_Length(DataArgs);
+ if ((pnargs != (ninargs+noutargs)) || (pnargs > MAXARGS))
+ return PyErr_Format(_Error,
+ "%s: wrong buffer count for function", me->descr.name);
+
+ /* Unpack buffers and offsets, get data pointers */
+ for (i=0; i<pnargs; i++) {
+ ArgTuple = PySequence_GetItem(DataArgs, i);
+ Py_DECREF(ArgTuple);
+ if (!PyArg_ParseTuple(ArgTuple, "Ol", &BufferObj[i], &offset[i]))
+ return PyErr_Format(_Error,
+ "%s: Problem with buffer/offset tuple", me->descr.name);
+ }
+ return NA_callCUFuncCore(self, niter, ninargs, noutargs, BufferObj, offset);
+}
+
+static PyObject *
+callStrideConvCFunc(PyObject *self, PyObject *args) {
+ PyObject *inbuffObj, *outbuffObj, *shapeObj;
+ PyObject *inbstridesObj, *outbstridesObj;
+ CfuncObject *me = (CfuncObject *) self;
+ int nshape, ninbstrides, noutbstrides;
+ maybelong shape[MAXDIM], inbstrides[MAXDIM],
+ outbstrides[MAXDIM], *outbstrides1 = outbstrides;
+ long inboffset, outboffset, nbytes=0;
+
+ if (!PyArg_ParseTuple(args, "OOlOOlO|l",
+ &shapeObj, &inbuffObj, &inboffset, &inbstridesObj,
+ &outbuffObj, &outboffset, &outbstridesObj,
+ &nbytes)) {
+ return PyErr_Format(_Error,
+ "%s: Problem with argument list",
+ me->descr.name);
+ }
+
+ nshape = NA_maybeLongsFromIntTuple(MAXDIM, shape, shapeObj);
+ if (nshape < 0) return NULL;
+
+ ninbstrides = NA_maybeLongsFromIntTuple(MAXDIM, inbstrides, inbstridesObj);
+ if (ninbstrides < 0) return NULL;
+
+ noutbstrides= NA_maybeLongsFromIntTuple(MAXDIM, outbstrides, outbstridesObj);
+ if (noutbstrides < 0) return NULL;
+
+ if (nshape && (nshape != ninbstrides)) {
+ return PyErr_Format(_Error,
+ "%s: Missmatch between input iteration and strides tuples",
+ me->descr.name);
+ }
+
+ if (nshape && (nshape != noutbstrides)) {
+ if (noutbstrides < 1 ||
+ outbstrides[ noutbstrides - 1 ])/* allow 0 for reductions. */
+ return PyErr_Format(_Error,
+ "%s: Missmatch between output "
+ "iteration and strides tuples",
+ me->descr.name);
+ }
+
+ return NA_callStrideConvCFuncCore(
+ self, nshape, shape,
+ inbuffObj, inboffset, ninbstrides, inbstrides,
+ outbuffObj, outboffset, noutbstrides, outbstrides1, nbytes);
+}
+
+static int
+_NA_callStridingHelper(PyObject *aux, long dim,
+ long nnumarray, PyArrayObject *numarray[], char *data[],
+ CFUNC_STRIDED_FUNC f)
+{
+ int i, j, status=0;
+ dim -= 1;
+ for(i=0; i<numarray[0]->dimensions[dim]; i++) {
+ for (j=0; j<nnumarray; j++)
+ data[j] += numarray[j]->strides[dim]*i;
+ if (dim == 0)
+ status |= f(aux, nnumarray, numarray, data);
+ else
+ status |= _NA_callStridingHelper(
+ aux, dim, nnumarray, numarray, data, f);
+ for (j=0; j<nnumarray; j++)
+ data[j] -= numarray[j]->strides[dim]*i;
+ }
+ return status;
+}
+
+
+static PyObject *
+callStridingCFunc(PyObject *self, PyObject *args) {
+ CfuncObject *me = (CfuncObject *) self;
+ PyObject *aux;
+ PyArrayObject *numarray[MAXARRAYS];
+ char *data[MAXARRAYS];
+ CFUNC_STRIDED_FUNC f;
+ int i;
+
+ int nnumarray = PySequence_Length(args)-1;
+ if ((nnumarray < 1) || (nnumarray > MAXARRAYS))
+ return PyErr_Format(_Error, "%s, too many or too few numarray.",
+ me->descr.name);
+
+ aux = PySequence_GetItem(args, 0);
+ if (!aux)
+ return NULL;
+
+ for(i=0; i<nnumarray; i++) {
+ PyObject *otemp = PySequence_GetItem(args, i+1);
+ if (!otemp)
+ return PyErr_Format(_Error, "%s couldn't get array[%d]",
+ me->descr.name, i);
+ if (!NA_NDArrayCheck(otemp))
+ return PyErr_Format(PyExc_TypeError,
+ "%s arg[%d] is not an array.",
+ me->descr.name, i);
+ numarray[i] = (PyArrayObject *) otemp;
+ data[i] = numarray[i]->data;
+ Py_DECREF(otemp);
+ if (!NA_updateDataPtr(numarray[i]))
+ return NULL;
+ }
+
+ /* Cast function pointer and perform stride operation */
+ f = (CFUNC_STRIDED_FUNC) me->descr.fptr;
+
+ if (_NA_callStridingHelper(aux, numarray[0]->nd,
+ nnumarray, numarray, data, f)) {
+ return NULL;
+ } else {
+ Py_INCREF(Py_None);
+ return Py_None;
+ }
+}
+
+/* Convert a standard C numeric value to a Python numeric value.
+**
+** Handles both nonaligned and/or byteswapped C data.
+**
+** Input arguments are:
+**
+** Buffer object that contains the C numeric value.
+** Offset (in bytes) into the buffer that the data is located at.
+** The size of the C numeric data item in bytes.
+** Flag indicating if the C data is byteswapped from the processor's
+** natural representation.
+**
+** Returns a Python numeric value.
+*/
+
+static PyObject *
+NumTypeAsPyValue(PyObject *self, PyObject *args) {
+ PyObject *bufferObj;
+ long offset, itemsize, byteswap, i, buffersize;
+ Py_complex temp; /* to hold copies of largest possible type */
+ void *buffer;
+ char *tempptr;
+ CFUNCasPyValue funcptr;
+ CfuncObject *me = (CfuncObject *) self;
+
+ if (!PyArg_ParseTuple(args, "Olll",
+ &bufferObj, &offset, &itemsize, &byteswap))
+ return PyErr_Format(_Error,
+ "NumTypeAsPyValue: Problem with argument list");
+
+ if ((buffersize = NA_getBufferPtrAndSize(bufferObj, 1, &buffer)) < 0)
+ return PyErr_Format(_Error,
+ "NumTypeAsPyValue: Problem with array buffer");
+
+ if (offset < 0)
+ return PyErr_Format(_Error,
+ "NumTypeAsPyValue: invalid negative offset: %d", (int) offset);
+
+ /* Guarantee valid buffer pointer */
+ if (offset+itemsize > buffersize)
+ return PyErr_Format(_Error,
+ "NumTypeAsPyValue: buffer too small for offset and itemsize.");
+
+ /* Do byteswapping. Guarantee double alignment by using temp. */
+ tempptr = (char *) &temp;
+ if (!byteswap) {
+ for (i=0; i<itemsize; i++)
+ *(tempptr++) = *(((char *) buffer)+offset+i);
+ } else {
+ tempptr += itemsize-1;
+ for (i=0; i<itemsize; i++)
+ *(tempptr--) = *(((char *) buffer)+offset+i);
+ }
+
+ funcptr = (CFUNCasPyValue) me->descr.fptr;
+
+ /* Call function to build PyObject. Bad parameters to this function
+ may render call meaningless, but "temp" guarantees that its safe. */
+ return (*funcptr)((void *)(&temp));
+}
+
+/* Convert a Python numeric value to a standard C numeric value.
+**
+** Handles both nonaligned and/or byteswapped C data.
+**
+** Input arguments are:
+**
+** The Python numeric value to be converted.
+** Buffer object to contain the C numeric value.
+** Offset (in bytes) into the buffer that the data is to be copied to.
+** The size of the C numeric data item in bytes.
+** Flag indicating if the C data is byteswapped from the processor's
+** natural representation.
+**
+** Returns None
+*/
+
+static PyObject *
+NumTypeFromPyValue(PyObject *self, PyObject *args) {
+ PyObject *bufferObj, *valueObj;
+ long offset, itemsize, byteswap, i, buffersize;
+ Py_complex temp; /* to hold copies of largest possible type */
+ void *buffer;
+ char *tempptr;
+ CFUNCfromPyValue funcptr;
+ CfuncObject *me = (CfuncObject *) self;
+
+ if (!PyArg_ParseTuple(args, "OOlll",
+ &valueObj, &bufferObj, &offset, &itemsize, &byteswap))
+ return PyErr_Format(_Error,
+ "%s: Problem with argument list", me->descr.name);
+
+ if ((buffersize = NA_getBufferPtrAndSize(bufferObj, 0, &buffer)) < 0)
+ return PyErr_Format(_Error,
+ "%s: Problem with array buffer (read only?)", me->descr.name);
+
+ funcptr = (CFUNCfromPyValue) me->descr.fptr;
+
+ /* Convert python object into "temp". Always safe. */
+ if (!((*funcptr)(valueObj, (void *)( &temp))))
+ return PyErr_Format(_Error,
+ "%s: Problem converting value", me->descr.name);
+
+ /* Check buffer offset. */
+ if (offset < 0)
+ return PyErr_Format(_Error,
+ "%s: invalid negative offset: %d", me->descr.name, (int) offset);
+
+ if (offset+itemsize > buffersize)
+ return PyErr_Format(_Error,
+ "%s: buffer too small(%d) for offset(%d) and itemsize(%d)",
+ me->descr.name, (int) buffersize, (int) offset, (int) itemsize);
+
+ /* Copy "temp" to array buffer. */
+ tempptr = (char *) &temp;
+ if (!byteswap) {
+ for (i=0; i<itemsize; i++)
+ *(((char *) buffer)+offset+i) = *(tempptr++);
+ } else {
+ tempptr += itemsize-1;
+ for (i=0; i<itemsize; i++)
+ *(((char *) buffer)+offset+i) = *(tempptr--);
+ }
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+/* Handle "calling" the cfunc object at the python level.
+ Dispatch the call to the appropriate python-c wrapper based
+ on the cfunc type. Do this dispatch to avoid having to
+ check that python code didn't somehow create a mismatch between
+ cfunc and wrapper.
+*/
+static PyObject *
+cfunc_call(PyObject *self, PyObject *argsTuple, PyObject *argsDict)
+{
+ CfuncObject *me = (CfuncObject *) self;
+ switch(me->descr.type) {
+ case CFUNC_UFUNC:
+ return callCUFunc(self, argsTuple);
+ break;
+ case CFUNC_STRIDING:
+ return callStrideConvCFunc(self, argsTuple);
+ break;
+ case CFUNC_NSTRIDING:
+ return callStridingCFunc(self, argsTuple);
+ case CFUNC_FROM_PY_VALUE:
+ return NumTypeFromPyValue(self, argsTuple);
+ break;
+ case CFUNC_AS_PY_VALUE:
+ return NumTypeAsPyValue(self, argsTuple);
+ break;
+ default:
+ return PyErr_Format( _Error,
+ "cfunc_call: Can't dispatch cfunc '%s' with type: %d.",
+ me->descr.name, me->descr.type);
+ }
+}
+
+staticforward PyTypeObject CfuncType;
+
+static void
+cfunc_dealloc(PyObject* self)
+{
+ PyObject_Del(self);
+}
+
+static PyObject *
+cfunc_repr(PyObject *self)
+{
+ char buf[256];
+ CfuncObject *me = (CfuncObject *) self;
+ sprintf(buf, "<cfunc '%s' at %08lx check-self:%d align:%d io:(%d, %d)>",
+ me->descr.name, (unsigned long ) me->descr.fptr,
+ me->descr.chkself, me->descr.align,
+ me->descr.wantIn, me->descr.wantOut);
+ return PyString_FromString(buf);
+}
+
+static PyTypeObject CfuncType = {
+ PyObject_HEAD_INIT(NULL)
+ 0,
+ "Cfunc",
+ sizeof(CfuncObject),
+ 0,
+ cfunc_dealloc, /*tp_dealloc*/
+ 0, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ cfunc_repr, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+ 0, /*tp_hash */
+ cfunc_call, /* tp_call */
+};
+
+/* CfuncObjects are created at the c-level only. They ensure that each
+cfunc is called via the correct python-c-wrapper as defined by its
+CfuncDescriptor. The wrapper, in turn, does conversions and buffer size
+and alignment checking. Allowing these to be created at the python level
+would enable them to be created *wrong* at the python level, and thereby
+enable python code to *crash* python.
+*/
+static PyObject*
+NA_new_cfunc(CfuncDescriptor *cfd)
+{
+ CfuncObject* cfunc;
+
+ CfuncType.ob_type = &PyType_Type; /* Should be done once at init.
+ Do now since there is no init. */
+
+ cfunc = PyObject_New(CfuncObject, &CfuncType);
+
+ if (!cfunc) {
+ return PyErr_Format(_Error,
+ "NA_new_cfunc: failed creating '%s'",
+ cfd->name);
+ }
+
+ cfunc->descr = *cfd;
+
+ return (PyObject*)cfunc;
+}
+
+static int NA_add_cfunc(PyObject *dict, char *keystr, CfuncDescriptor *descr)
+{
+ PyObject *c = (PyObject *) NA_new_cfunc(descr);
+ if (!c) return -1;
+ return PyDict_SetItemString(dict, keystr, c);
+}
+
+static PyArrayObject*
+NA_InputArray(PyObject *a, NumarrayType t, int requires)
+{
+ PyArray_Descr *descr;
+ if (t == tAny) descr = NULL;
+ else descr = PyArray_DescrFromType(t);
+ return (PyArrayObject *) \
+ PyArray_CheckFromAny(a, descr, 0, 0, requires, NULL);
+}
+
+/* satisfies ensures that 'a' meets a set of requirements and matches
+the specified type.
+*/
+static int
+satisfies(PyArrayObject *a, int requirements, NumarrayType t)
+{
+ int type_ok = (a->descr->type_num == t) || (t == tAny);
+
+ if (PyArray_ISCARRAY(a))
+ return type_ok;
+ if (PyArray_ISBYTESWAPPED(a) && (requirements & NUM_NOTSWAPPED))
+ return 0;
+ if (!PyArray_ISALIGNED(a) && (requirements & NUM_ALIGNED))
+ return 0;
+ if (!PyArray_ISCONTIGUOUS(a) && (requirements & NUM_CONTIGUOUS))
+ return 0;
+ if (!PyArray_ISWRITABLE(a) && (requirements & NUM_WRITABLE))
+ return 0;
+ if (requirements & NUM_COPY)
+ return 0;
+ return type_ok;
+}
+
+
+static PyArrayObject *
+NA_OutputArray(PyObject *a, NumarrayType t, int requires)
+{
+ PyArray_Descr *dtype;
+ PyArrayObject *ret;
+
+ if (!PyArray_Check(a) || !PyArray_ISWRITEABLE(a)) {
+ PyErr_Format(PyExc_TypeError,
+ "NA_OutputArray: only writeable arrays work for output.");
+ return NULL;
+ }
+
+ if (satisfies((PyArrayObject *)a, requires, t)) {
+ Py_INCREF(a);
+ return (PyArrayObject *)a;
+ }
+ if (t == tAny) {
+ dtype = PyArray_DESCR(a);
+ Py_INCREF(dtype);
+ }
+ else {
+ dtype = PyArray_DescrFromType(t);
+ }
+ ret = (PyArrayObject *)PyArray_Empty(PyArray_NDIM(a), PyArray_DIMS(a),
+ dtype, 0);
+ ret->flags |= NPY_UPDATEIFCOPY;
+ ret->base = a;
+ PyArray_FLAGS(a) &= ~NPY_WRITEABLE;
+ Py_INCREF(a);
+ return ret;
+}
+
+
+/* NA_IoArray is a combination of NA_InputArray and NA_OutputArray.
+
+Unlike NA_OutputArray, if a temporary is required it is initialized to a copy
+of the input array.
+
+Unlike NA_InputArray, deallocating any resulting temporary array results in a
+copy from the temporary back to the original.
+*/
+static PyArrayObject *
+NA_IoArray(PyObject *a, NumarrayType t, int requires)
+{
+ PyArrayObject *shadow = NA_InputArray(a, t, requires | NPY_UPDATEIFCOPY );
+
+ if (!shadow) return NULL;
+
+ /* Guard against non-writable, but otherwise satisfying requires.
+ In this case, shadow == a.
+ */
+ if (!PyArray_ISWRITABLE(shadow)) {
+ PyErr_Format(PyExc_TypeError,
+ "NA_IoArray: I/O array must be writable array");
+ PyArray_XDECREF_ERR(shadow);
+ return NULL;
+ }
+
+ return shadow;
+}
+
+/* NA_OptionalOutputArray works like NA_OutputArray, but handles the case
+where the output array 'optional' is omitted entirely at the python level,
+resulting in 'optional'==Py_None. When 'optional' is Py_None, the return
+value is cloned (but with NumarrayType 't') from 'master', typically an input
+array with the same shape as the output array.
+*/
+static PyArrayObject *
+NA_OptionalOutputArray(PyObject *optional, NumarrayType t, int requires,
+ PyArrayObject *master)
+{
+ if ((optional == Py_None) || (optional == NULL)) {
+ PyObject *rval;
+ PyArray_Descr *descr;
+ if (t == tAny) descr=NULL;
+ else descr = PyArray_DescrFromType(t);
+ rval = PyArray_FromArray(
+ master, descr, NUM_C_ARRAY | NUM_COPY | NUM_WRITABLE);
+ return (PyArrayObject *)rval;
+ } else {
+ return NA_OutputArray(optional, t, requires);
+ }
+}
+
+Complex64 NA_get_Complex64(PyArrayObject *a, long offset)
+{
+ Complex32 v0;
+ Complex64 v;
+
+ switch(a->descr->type_num) {
+ case tComplex32:
+ v0 = NA_GETP(a, Complex32, (NA_PTR(a)+offset));
+ v.r = v0.r;
+ v.i = v0.i;
+ break;
+ case tComplex64:
+ v = NA_GETP(a, Complex64, (NA_PTR(a)+offset));
+ break;
+ default:
+ v.r = NA_get_Float64(a, offset);
+ v.i = 0;
+ break;
+ }
+ return v;
+}
+
+void NA_set_Complex64(PyArrayObject *a, long offset, Complex64 v)
+{
+ Complex32 v0;
+
+ switch(a->descr->type_num) {
+ case tComplex32:
+ v0.r = v.r;
+ v0.i = v.i;
+ NA_SETP(a, Complex32, (NA_PTR(a)+offset), v0);
+ break;
+ case tComplex64:
+ NA_SETP(a, Complex64, (NA_PTR(a)+offset), v);
+ break;
+ default:
+ NA_set_Float64(a, offset, v.r);
+ break;
+ }
+}
+
+Int64 NA_get_Int64(PyArrayObject *a, long offset)
+{
+ switch(a->descr->type_num) {
+ case tBool:
+ return NA_GETP(a, Bool, (NA_PTR(a)+offset)) != 0;
+ case tInt8:
+ return NA_GETP(a, Int8, (NA_PTR(a)+offset));
+ case tUInt8:
+ return NA_GETP(a, UInt8, (NA_PTR(a)+offset));
+ case tInt16:
+ return NA_GETP(a, Int16, (NA_PTR(a)+offset));
+ case tUInt16:
+ return NA_GETP(a, UInt16, (NA_PTR(a)+offset));
+ case tInt32:
+ return NA_GETP(a, Int32, (NA_PTR(a)+offset));
+ case tUInt32:
+ return NA_GETP(a, UInt32, (NA_PTR(a)+offset));
+ case tInt64:
+ return NA_GETP(a, Int64, (NA_PTR(a)+offset));
+ case tUInt64:
+ return NA_GETP(a, UInt64, (NA_PTR(a)+offset));
+ case tFloat32:
+ return NA_GETP(a, Float32, (NA_PTR(a)+offset));
+ case tFloat64:
+ return NA_GETP(a, Float64, (NA_PTR(a)+offset));
+ case tComplex32:
+ return NA_GETP(a, Float32, (NA_PTR(a)+offset));
+ case tComplex64:
+ return NA_GETP(a, Float64, (NA_PTR(a)+offset));
+ default:
+ PyErr_Format( PyExc_TypeError,
+ "Unknown type %d in NA_get_Int64",
+ a->descr->type_num);
+ PyErr_Print();
+ }
+ return 0; /* suppress warning */
+}
+
+void NA_set_Int64(PyArrayObject *a, long offset, Int64 v)
+{
+ Bool b;
+
+ switch(a->descr->type_num) {
+ case tBool:
+ b = (v != 0);
+ NA_SETP(a, Bool, (NA_PTR(a)+offset), b);
+ break;
+ case tInt8: NA_SETP(a, Int8, (NA_PTR(a)+offset), v);
+ break;
+ case tUInt8: NA_SETP(a, UInt8, (NA_PTR(a)+offset), v);
+ break;
+ case tInt16: NA_SETP(a, Int16, (NA_PTR(a)+offset), v);
+ break;
+ case tUInt16: NA_SETP(a, UInt16, (NA_PTR(a)+offset), v);
+ break;
+ case tInt32: NA_SETP(a, Int32, (NA_PTR(a)+offset), v);
+ break;
+ case tUInt32: NA_SETP(a, UInt32, (NA_PTR(a)+offset), v);
+ break;
+ case tInt64: NA_SETP(a, Int64, (NA_PTR(a)+offset), v);
+ break;
+ case tUInt64: NA_SETP(a, UInt64, (NA_PTR(a)+offset), v);
+ break;
+ case tFloat32:
+ NA_SETP(a, Float32, (NA_PTR(a)+offset), v);
+ break;
+ case tFloat64:
+ NA_SETP(a, Float64, (NA_PTR(a)+offset), v);
+ break;
+ case tComplex32:
+ NA_SETP(a, Float32, (NA_PTR(a)+offset), v);
+ NA_SETP(a, Float32, (NA_PTR(a)+offset+sizeof(Float32)), 0);
+ break;
+ case tComplex64:
+ NA_SETP(a, Float64, (NA_PTR(a)+offset), v);
+ NA_SETP(a, Float64, (NA_PTR(a)+offset+sizeof(Float64)), 0);
+ break;
+ default:
+ PyErr_Format( PyExc_TypeError,
+ "Unknown type %d in NA_set_Int64",
+ a->descr->type_num);
+ PyErr_Print();
+ }
+}
+
+/* NA_get_offset computes the offset specified by the set of indices.
+If N > 0, the indices are taken from the outer dimensions of the array.
+If N < 0, the indices are taken from the inner dimensions of the array.
+If N == 0, the offset is 0.
+*/
+long NA_get_offset(PyArrayObject *a, int N, ...)
+{
+ int i;
+ long offset = 0;
+ va_list ap;
+ va_start(ap, N);
+ if (N > 0) { /* compute offset of "outer" indices. */
+ for(i=0; i<N; i++)
+ offset += va_arg(ap, long) * a->strides[i];
+ } else { /* compute offset of "inner" indices. */
+ N = -N;
+ for(i=0; i<N; i++)
+ offset += va_arg(ap, long) * a->strides[a->nd-N+i];
+ }
+ va_end(ap);
+ return offset;
+}
+
+Float64 NA_get_Float64(PyArrayObject *a, long offset)
+{
+ switch(a->descr->type_num) {
+ case tBool:
+ return NA_GETP(a, Bool, (NA_PTR(a)+offset)) != 0;
+ case tInt8:
+ return NA_GETP(a, Int8, (NA_PTR(a)+offset));
+ case tUInt8:
+ return NA_GETP(a, UInt8, (NA_PTR(a)+offset));
+ case tInt16:
+ return NA_GETP(a, Int16, (NA_PTR(a)+offset));
+ case tUInt16:
+ return NA_GETP(a, UInt16, (NA_PTR(a)+offset));
+ case tInt32:
+ return NA_GETP(a, Int32, (NA_PTR(a)+offset));
+ case tUInt32:
+ return NA_GETP(a, UInt32, (NA_PTR(a)+offset));
+ case tInt64:
+ return NA_GETP(a, Int64, (NA_PTR(a)+offset));
+ #if HAS_UINT64
+ case tUInt64:
+ return NA_GETP(a, UInt64, (NA_PTR(a)+offset));
+ #endif
+ case tFloat32:
+ return NA_GETP(a, Float32, (NA_PTR(a)+offset));
+ case tFloat64:
+ return NA_GETP(a, Float64, (NA_PTR(a)+offset));
+ case tComplex32: /* Since real value is first */
+ return NA_GETP(a, Float32, (NA_PTR(a)+offset));
+ case tComplex64: /* Since real value is first */
+ return NA_GETP(a, Float64, (NA_PTR(a)+offset));
+ default:
+ PyErr_Format( PyExc_TypeError,
+ "Unknown type %d in NA_get_Float64",
+ a->descr->type_num);
+ }
+ return 0; /* suppress warning */
+}
+
+void NA_set_Float64(PyArrayObject *a, long offset, Float64 v)
+{
+ Bool b;
+
+ switch(a->descr->type_num) {
+ case tBool:
+ b = (v != 0);
+ NA_SETP(a, Bool, (NA_PTR(a)+offset), b);
+ break;
+ case tInt8: NA_SETP(a, Int8, (NA_PTR(a)+offset), v);
+ break;
+ case tUInt8: NA_SETP(a, UInt8, (NA_PTR(a)+offset), v);
+ break;
+ case tInt16: NA_SETP(a, Int16, (NA_PTR(a)+offset), v);
+ break;
+ case tUInt16: NA_SETP(a, UInt16, (NA_PTR(a)+offset), v);
+ break;
+ case tInt32: NA_SETP(a, Int32, (NA_PTR(a)+offset), v);
+ break;
+ case tUInt32: NA_SETP(a, UInt32, (NA_PTR(a)+offset), v);
+ break;
+ case tInt64: NA_SETP(a, Int64, (NA_PTR(a)+offset), v);
+ break;
+ #if HAS_UINT64
+ case tUInt64: NA_SETP(a, UInt64, (NA_PTR(a)+offset), v);
+ break;
+ #endif
+ case tFloat32:
+ NA_SETP(a, Float32, (NA_PTR(a)+offset), v);
+ break;
+ case tFloat64:
+ NA_SETP(a, Float64, (NA_PTR(a)+offset), v);
+ break;
+ case tComplex32: {
+ NA_SETP(a, Float32, (NA_PTR(a)+offset), v);
+ NA_SETP(a, Float32, (NA_PTR(a)+offset+sizeof(Float32)), 0);
+ break;
+ }
+ case tComplex64: {
+ NA_SETP(a, Float64, (NA_PTR(a)+offset), v);
+ NA_SETP(a, Float64, (NA_PTR(a)+offset+sizeof(Float64)), 0);
+ break;
+ }
+ default:
+ PyErr_Format( PyExc_TypeError,
+ "Unknown type %d in NA_set_Float64",
+ a->descr->type_num );
+ PyErr_Print();
+ }
+}
+
+
+Float64 NA_get1_Float64(PyArrayObject *a, long i)
+{
+ long offset = i * a->strides[0];
+ return NA_get_Float64(a, offset);
+}
+
+Float64 NA_get2_Float64(PyArrayObject *a, long i, long j)
+{
+ long offset = i * a->strides[0]
+ + j * a->strides[1];
+ return NA_get_Float64(a, offset);
+}
+
+Float64 NA_get3_Float64(PyArrayObject *a, long i, long j, long k)
+{
+ long offset = i * a->strides[0]
+ + j * a->strides[1]
+ + k * a->strides[2];
+ return NA_get_Float64(a, offset);
+}
+
+void NA_set1_Float64(PyArrayObject *a, long i, Float64 v)
+{
+ long offset = i * a->strides[0];
+ NA_set_Float64(a, offset, v);
+}
+
+void NA_set2_Float64(PyArrayObject *a, long i, long j, Float64 v)
+{
+ long offset = i * a->strides[0]
+ + j * a->strides[1];
+ NA_set_Float64(a, offset, v);
+}
+
+void NA_set3_Float64(PyArrayObject *a, long i, long j, long k, Float64 v)
+{
+ long offset = i * a->strides[0]
+ + j * a->strides[1]
+ + k * a->strides[2];
+ NA_set_Float64(a, offset, v);
+}
+
+Complex64 NA_get1_Complex64(PyArrayObject *a, long i)
+{
+ long offset = i * a->strides[0];
+ return NA_get_Complex64(a, offset);
+}
+
+Complex64 NA_get2_Complex64(PyArrayObject *a, long i, long j)
+{
+ long offset = i * a->strides[0]
+ + j * a->strides[1];
+ return NA_get_Complex64(a, offset);
+}
+
+Complex64 NA_get3_Complex64(PyArrayObject *a, long i, long j, long k)
+{
+ long offset = i * a->strides[0]
+ + j * a->strides[1]
+ + k * a->strides[2];
+ return NA_get_Complex64(a, offset);
+}
+
+void NA_set1_Complex64(PyArrayObject *a, long i, Complex64 v)
+{
+ long offset = i * a->strides[0];
+ NA_set_Complex64(a, offset, v);
+}
+
+void NA_set2_Complex64(PyArrayObject *a, long i, long j, Complex64 v)
+{
+ long offset = i * a->strides[0]
+ + j * a->strides[1];
+ NA_set_Complex64(a, offset, v);
+}
+
+void NA_set3_Complex64(PyArrayObject *a, long i, long j, long k, Complex64 v)
+{
+ long offset = i * a->strides[0]
+ + j * a->strides[1]
+ + k * a->strides[2];
+ NA_set_Complex64(a, offset, v);
+}
+
+Int64 NA_get1_Int64(PyArrayObject *a, long i)
+{
+ long offset = i * a->strides[0];
+ return NA_get_Int64(a, offset);
+}
+
+Int64 NA_get2_Int64(PyArrayObject *a, long i, long j)
+{
+ long offset = i * a->strides[0]
+ + j * a->strides[1];
+ return NA_get_Int64(a, offset);
+}
+
+Int64 NA_get3_Int64(PyArrayObject *a, long i, long j, long k)
+{
+ long offset = i * a->strides[0]
+ + j * a->strides[1]
+ + k * a->strides[2];
+ return NA_get_Int64(a, offset);
+}
+
+void NA_set1_Int64(PyArrayObject *a, long i, Int64 v)
+{
+ long offset = i * a->strides[0];
+ NA_set_Int64(a, offset, v);
+}
+
+void NA_set2_Int64(PyArrayObject *a, long i, long j, Int64 v)
+{
+ long offset = i * a->strides[0]
+ + j * a->strides[1];
+ NA_set_Int64(a, offset, v);
+}
+
+void NA_set3_Int64(PyArrayObject *a, long i, long j, long k, Int64 v)
+{
+ long offset = i * a->strides[0]
+ + j * a->strides[1]
+ + k * a->strides[2];
+ NA_set_Int64(a, offset, v);
+}
+
+/* SET_CMPLX could be made faster by factoring it into 3 seperate loops.
+*/
+#define NA_SET_CMPLX(a, type, base, cnt, in) \
+{ \
+ int i; \
+ int stride = a->strides[ a->nd - 1]; \
+ NA_SET1D(a, type, base, cnt, in); \
+ base = NA_PTR(a) + offset + sizeof(type); \
+ for(i=0; i<cnt; i++) { \
+ NA_SETP(a, Float32, base, 0); \
+ base += stride; \
+ } \
+}
+
+static int
+NA_get1D_Float64(PyArrayObject *a, long offset, int cnt, Float64*out)
+{
+ char *base = NA_PTR(a) + offset;
+
+ switch(a->descr->type_num) {
+ case tBool:
+ NA_GET1D(a, Bool, base, cnt, out);
+ break;
+ case tInt8:
+ NA_GET1D(a, Int8, base, cnt, out);
+ break;
+ case tUInt8:
+ NA_GET1D(a, UInt8, base, cnt, out);
+ break;
+ case tInt16:
+ NA_GET1D(a, Int16, base, cnt, out);
+ break;
+ case tUInt16:
+ NA_GET1D(a, UInt16, base, cnt, out);
+ break;
+ case tInt32:
+ NA_GET1D(a, Int32, base, cnt, out);
+ break;
+ case tUInt32:
+ NA_GET1D(a, UInt32, base, cnt, out);
+ break;
+ case tInt64:
+ NA_GET1D(a, Int64, base, cnt, out);
+ break;
+ #if HAS_UINT64
+ case tUInt64:
+ NA_GET1D(a, UInt64, base, cnt, out);
+ break;
+ #endif
+ case tFloat32:
+ NA_GET1D(a, Float32, base, cnt, out);
+ break;
+ case tFloat64:
+ NA_GET1D(a, Float64, base, cnt, out);
+ break;
+ case tComplex32:
+ NA_GET1D(a, Float32, base, cnt, out);
+ break;
+ case tComplex64:
+ NA_GET1D(a, Float64, base, cnt, out);
+ break;
+ default:
+ PyErr_Format( PyExc_TypeError,
+ "Unknown type %d in NA_get1D_Float64",
+ a->descr->type_num);
+ PyErr_Print();
+ return -1;
+ }
+ return 0;
+}
+
+static Float64 *
+NA_alloc1D_Float64(PyArrayObject *a, long offset, int cnt)
+{
+ Float64 *result = PyMem_New(Float64, cnt);
+ if (!result) return NULL;
+ if (NA_get1D_Float64(a, offset, cnt, result) < 0) {
+ PyMem_Free(result);
+ return NULL;
+ }
+ return result;
+}
+
+static int
+NA_set1D_Float64(PyArrayObject *a, long offset, int cnt, Float64*in)
+{
+ char *base = NA_PTR(a) + offset;
+
+ switch(a->descr->type_num) {
+ case tBool:
+ NA_SET1D(a, Bool, base, cnt, in);
+ break;
+ case tInt8:
+ NA_SET1D(a, Int8, base, cnt, in);
+ break;
+ case tUInt8:
+ NA_SET1D(a, UInt8, base, cnt, in);
+ break;
+ case tInt16:
+ NA_SET1D(a, Int16, base, cnt, in);
+ break;
+ case tUInt16:
+ NA_SET1D(a, UInt16, base, cnt, in);
+ break;
+ case tInt32:
+ NA_SET1D(a, Int32, base, cnt, in);
+ break;
+ case tUInt32:
+ NA_SET1D(a, UInt32, base, cnt, in);
+ break;
+ case tInt64:
+ NA_SET1D(a, Int64, base, cnt, in);
+ break;
+ #if HAS_UINT64
+ case tUInt64:
+ NA_SET1D(a, UInt64, base, cnt, in);
+ break;
+ #endif
+ case tFloat32:
+ NA_SET1D(a, Float32, base, cnt, in);
+ break;
+ case tFloat64:
+ NA_SET1D(a, Float64, base, cnt, in);
+ break;
+ case tComplex32:
+ NA_SET_CMPLX(a, Float32, base, cnt, in);
+ break;
+ case tComplex64:
+ NA_SET_CMPLX(a, Float64, base, cnt, in);
+ break;
+ default:
+ PyErr_Format( PyExc_TypeError,
+ "Unknown type %d in NA_set1D_Float64",
+ a->descr->type_num);
+ PyErr_Print();
+ return -1;
+ }
+ return 0;
+}
+
+static int
+NA_get1D_Int64(PyArrayObject *a, long offset, int cnt, Int64*out)
+{
+ char *base = NA_PTR(a) + offset;
+
+ switch(a->descr->type_num) {
+ case tBool:
+ NA_GET1D(a, Bool, base, cnt, out);
+ break;
+ case tInt8:
+ NA_GET1D(a, Int8, base, cnt, out);
+ break;
+ case tUInt8:
+ NA_GET1D(a, UInt8, base, cnt, out);
+ break;
+ case tInt16:
+ NA_GET1D(a, Int16, base, cnt, out);
+ break;
+ case tUInt16:
+ NA_GET1D(a, UInt16, base, cnt, out);
+ break;
+ case tInt32:
+ NA_GET1D(a, Int32, base, cnt, out);
+ break;
+ case tUInt32:
+ NA_GET1D(a, UInt32, base, cnt, out);
+ break;
+ case tInt64:
+ NA_GET1D(a, Int64, base, cnt, out);
+ break;
+ case tUInt64:
+ NA_GET1D(a, UInt64, base, cnt, out);
+ break;
+ case tFloat32:
+ NA_GET1D(a, Float32, base, cnt, out);
+ break;
+ case tFloat64:
+ NA_GET1D(a, Float64, base, cnt, out);
+ break;
+ case tComplex32:
+ NA_GET1D(a, Float32, base, cnt, out);
+ break;
+ case tComplex64:
+ NA_GET1D(a, Float64, base, cnt, out);
+ break;
+ default:
+ PyErr_Format( PyExc_TypeError,
+ "Unknown type %d in NA_get1D_Int64",
+ a->descr->type_num);
+ PyErr_Print();
+ return -1;
+ }
+ return 0;
+}
+
+static Int64 *
+NA_alloc1D_Int64(PyArrayObject *a, long offset, int cnt)
+{
+ Int64 *result = PyMem_New(Int64, cnt);
+ if (!result) return NULL;
+ if (NA_get1D_Int64(a, offset, cnt, result) < 0) {
+ PyMem_Free(result);
+ return NULL;
+ }
+ return result;
+}
+
+static int
+NA_set1D_Int64(PyArrayObject *a, long offset, int cnt, Int64*in)
+{
+ char *base = NA_PTR(a) + offset;
+
+ switch(a->descr->type_num) {
+ case tBool:
+ NA_SET1D(a, Bool, base, cnt, in);
+ break;
+ case tInt8:
+ NA_SET1D(a, Int8, base, cnt, in);
+ break;
+ case tUInt8:
+ NA_SET1D(a, UInt8, base, cnt, in);
+ break;
+ case tInt16:
+ NA_SET1D(a, Int16, base, cnt, in);
+ break;
+ case tUInt16:
+ NA_SET1D(a, UInt16, base, cnt, in);
+ break;
+ case tInt32:
+ NA_SET1D(a, Int32, base, cnt, in);
+ break;
+ case tUInt32:
+ NA_SET1D(a, UInt32, base, cnt, in);
+ break;
+ case tInt64:
+ NA_SET1D(a, Int64, base, cnt, in);
+ break;
+ case tUInt64:
+ NA_SET1D(a, UInt64, base, cnt, in);
+ break;
+ case tFloat32:
+ NA_SET1D(a, Float32, base, cnt, in);
+ break;
+ case tFloat64:
+ NA_SET1D(a, Float64, base, cnt, in);
+ break;
+ case tComplex32:
+ NA_SET_CMPLX(a, Float32, base, cnt, in);
+ break;
+ case tComplex64:
+ NA_SET_CMPLX(a, Float64, base, cnt, in);
+ break;
+ default:
+ PyErr_Format( PyExc_TypeError,
+ "Unknown type %d in NA_set1D_Int64",
+ a->descr->type_num);
+ PyErr_Print();
+ return -1;
+ }
+ return 0;
+}
+
+static int
+NA_get1D_Complex64(PyArrayObject *a, long offset, int cnt, Complex64*out)
+{
+ char *base = NA_PTR(a) + offset;
+
+ switch(a->descr->type_num) {
+ case tComplex64:
+ NA_GET1D(a, Complex64, base, cnt, out);
+ break;
+ default:
+ PyErr_Format( PyExc_TypeError,
+ "Unsupported type %d in NA_get1D_Complex64",
+ a->descr->type_num);
+ PyErr_Print();
+ return -1;
+ }
+ return 0;
+}
+
+static int
+NA_set1D_Complex64(PyArrayObject *a, long offset, int cnt, Complex64*in)
+{
+ char *base = NA_PTR(a) + offset;
+
+ switch(a->descr->type_num) {
+ case tComplex64:
+ NA_SET1D(a, Complex64, base, cnt, in);
+ break;
+ default:
+ PyErr_Format( PyExc_TypeError,
+ "Unsupported type %d in NA_set1D_Complex64",
+ a->descr->type_num);
+ PyErr_Print();
+ return -1;
+ }
+ return 0;
+}
+
+
+/* NA_ShapeEqual returns 1 if 'a' and 'b' have the same shape, 0 otherwise.
+*/
+static int
+NA_ShapeEqual(PyArrayObject *a, PyArrayObject *b)
+{
+ int i;
+
+ if (!NA_NDArrayCheck((PyObject *) a) ||
+ !NA_NDArrayCheck((PyObject*) b)) {
+ PyErr_Format(
+ PyExc_TypeError,
+ "NA_ShapeEqual: non-array as parameter.");
+ return -1;
+ }
+ if (a->nd != b->nd)
+ return 0;
+ for(i=0; i<a->nd; i++)
+ if (a->dimensions[i] != b->dimensions[i])
+ return 0;
+ return 1;
+}
+
+/* NA_ShapeLessThan returns 1 if a.shape[i] < b.shape[i] for all i, else 0.
+If they have a different number of dimensions, it compares the innermost
+overlapping dimensions of each.
+*/
+static int
+NA_ShapeLessThan(PyArrayObject *a, PyArrayObject *b)
+{
+ int i;
+ int mindim, aoff, boff;
+ if (!NA_NDArrayCheck((PyObject *) a) ||
+ !NA_NDArrayCheck((PyObject *) b)) {
+ PyErr_Format(PyExc_TypeError,
+ "NA_ShapeLessThan: non-array as parameter.");
+ return -1;
+ }
+ mindim = MIN(a->nd, b->nd);
+ aoff = a->nd - mindim;
+ boff = b->nd - mindim;
+ for(i=0; i<mindim; i++)
+ if (a->dimensions[i+aoff] >= b->dimensions[i+boff])
+ return 0;
+ return 1;
+}
+
+static int
+NA_ByteOrder(void)
+{
+ unsigned long byteorder_test;
+ byteorder_test = 1;
+ if (*((char *) &byteorder_test))
+ return NUM_LITTLE_ENDIAN;
+ else
+ return NUM_BIG_ENDIAN;
+}
+
+static Bool
+NA_IeeeSpecial32( Float32 *f, Int32 *mask)
+{
+ return NA_IeeeMask32(*f, *mask);
+}
+
+static Bool
+NA_IeeeSpecial64( Float64 *f, Int32 *mask)
+{
+ return NA_IeeeMask64(*f, *mask);
+}
+
+static PyArrayObject *
+NA_updateDataPtr(PyArrayObject *me)
+{
+ return me;
+}
+
+
+#define ELEM(x) (sizeof(x)/sizeof(x[0]))
+
+typedef struct
+{
+ char *name;
+ int typeno;
+} NumarrayTypeNameMapping;
+
+static NumarrayTypeNameMapping NumarrayTypeNameMap[] = {
+ {"Any", tAny},
+ {"Bool", tBool},
+ {"Int8", tInt8},
+ {"UInt8", tUInt8},
+ {"Int16", tInt16},
+ {"UInt16", tUInt16},
+ {"Int32", tInt32},
+ {"UInt32", tUInt32},
+ {"Int64", tInt64},
+ {"UInt64", tUInt64},
+ {"Float32", tFloat32},
+ {"Float64", tFloat64},
+ {"Complex32", tComplex32},
+ {"Complex64", tComplex64},
+ {"Object", tObject},
+ {"Long", tLong},
+};
+
+
+/* Convert NumarrayType 'typeno' into the string of the type's name. */
+static char *
+NA_typeNoToName(int typeno)
+{
+ int i;
+ PyObject *typeObj;
+ int typeno2;
+
+ for(i=0; i<ELEM(NumarrayTypeNameMap); i++)
+ if (typeno == NumarrayTypeNameMap[i].typeno)
+ return NumarrayTypeNameMap[i].name;
+
+ /* Handle Numeric typecodes */
+ typeObj = NA_typeNoToTypeObject(typeno);
+ if (!typeObj) return 0;
+ typeno2 = NA_typeObjectToTypeNo(typeObj);
+ Py_DECREF(typeObj);
+
+ return NA_typeNoToName(typeno2);
+}
+
+/* Look up the NumarrayType which corresponds to typename */
+
+static int
+NA_nameToTypeNo(char *typename)
+{
+ int i;
+ for(i=0; i<ELEM(NumarrayTypeNameMap); i++)
+ if (!strcmp(typename, NumarrayTypeNameMap[i].name))
+ return NumarrayTypeNameMap[i].typeno;
+ return -1;
+}
+
+static PyObject *
+getTypeObject(NumarrayType type)
+{
+ return (PyObject *)PyArray_DescrFromType(type);
+}
+
+
+static PyObject *
+NA_typeNoToTypeObject(int typeno)
+{
+ PyObject *o;
+ o = getTypeObject(typeno);
+ if (o) Py_INCREF(o);
+ return o;
+}
+
+
+static PyObject *
+NA_intTupleFromMaybeLongs(int len, maybelong *Longs)
+{
+ return PyArray_IntTupleFromIntp(len, Longs);
+}
+
+static long
+NA_maybeLongsFromIntTuple(int len, maybelong *arr, PyObject *sequence)
+{
+ return PyArray_IntpFromSequence(sequence, arr, len);
+}
+
+
+static int
+NA_intTupleProduct(PyObject *shape, long *prod)
+{
+ int i, nshape, rval = -1;
+
+ if (!PySequence_Check(shape)) {
+ PyErr_Format(PyExc_TypeError,
+ "NA_intSequenceProduct: object is not a sequence.");
+ goto _exit;
+ }
+ nshape = PySequence_Size(shape);
+
+ for(i=0, *prod=1; i<nshape; i++) {
+ PyObject *obj = PySequence_GetItem(shape, i);
+ if (!obj || !(PyInt_Check(obj) || PyLong_Check(obj))) {
+ PyErr_Format(PyExc_TypeError,
+ "NA_intTupleProduct: non-integer in shape.");
+ Py_XDECREF(obj);
+ goto _exit;
+ }
+ *prod *= PyInt_AsLong(obj);
+ Py_DECREF(obj);
+ if (PyErr_Occurred())
+ goto _exit;
+ }
+ rval = 0;
+ _exit:
+ return rval;
+}
+
+static long
+NA_isIntegerSequence(PyObject *sequence)
+{
+ PyObject *o;
+ long i, size, isInt = 1;
+ if (!sequence) {
+ isInt = -1;
+ goto _exit;
+ }
+ if (!PySequence_Check(sequence)) {
+ isInt = 0;
+ goto _exit;
+ }
+ if ((size = PySequence_Length(sequence)) < 0) {
+ isInt = -1;
+ goto _exit;
+ }
+ for(i=0; i<size; i++) {
+ o = PySequence_GetItem(sequence, i);
+ if (!PyInt_Check(o) && !PyLong_Check(o)) {
+ isInt = 0;
+ Py_XDECREF(o);
+ goto _exit;
+ }
+ Py_XDECREF(o);
+ }
+ _exit:
+ return isInt;
+}
+
+static int
+getShape(PyObject *a, maybelong *shape, int dims)
+{
+ long slen;
+
+ if (PyString_Check(a)) {
+ PyErr_Format(PyExc_TypeError,
+ "getShape: numerical sequences can't contain strings.");
+ return -1;
+ }
+
+ if (!PySequence_Check(a) ||
+ (NA_NDArrayCheck(a) && (PyArray(a)->nd == 0)))
+ return dims;
+ slen = PySequence_Length(a);
+ if (slen < 0) {
+ PyErr_Format(_Error,
+ "getShape: couldn't get sequence length.");
+ return -1;
+ }
+ if (!slen) {
+ *shape = 0;
+ return dims+1;
+ } else if (dims < MAXDIM) {
+ PyObject *item0 = PySequence_GetItem(a, 0);
+ if (item0) {
+ *shape = PySequence_Length(a);
+ dims = getShape(item0, ++shape, dims+1);
+ Py_DECREF(item0);
+ } else {
+ PyErr_Format(_Error,
+ "getShape: couldn't get sequence item.");
+ return -1;
+ }
+ } else {
+ PyErr_Format(_Error,
+ "getShape: sequence object nested more than MAXDIM deep.");
+ return -1;
+ }
+ return dims;
+}
+
+
+
+typedef enum {
+ NOTHING,
+ NUMBER,
+ SEQUENCE
+} SequenceConstraint;
+
+static int
+setArrayFromSequence(PyArrayObject *a, PyObject *s, int dim, long offset)
+{
+ SequenceConstraint mustbe = NOTHING;
+ int i, seqlen=-1, slen = PySequence_Length(s);
+
+ if (dim > a->nd) {
+ PyErr_Format(PyExc_ValueError,
+ "setArrayFromSequence: sequence/array dimensions mismatch.");
+ return -1;
+ }
+
+ if (slen != a->dimensions[dim]) {
+ PyErr_Format(PyExc_ValueError,
+ "setArrayFromSequence: sequence/array shape mismatch.");
+ return -1;
+ }
+
+ for(i=0; i<slen; i++) {
+ PyObject *o = PySequence_GetItem(s, i);
+ if (!o) {
+ PyErr_SetString(_Error,
+ "setArrayFromSequence: Can't get a sequence item");
+ return -1;
+ } else if ((NA_isPythonScalar(o) ||
+ (NA_NumArrayCheck(o) && PyArray(o)->nd == 0)) &&
+ ((mustbe == NOTHING) || (mustbe == NUMBER))) {
+ if (NA_setFromPythonScalar(a, offset, o) < 0)
+ return -2;
+ mustbe = NUMBER;
+ } else if (PyString_Check(o)) {
+ PyErr_SetString( PyExc_ValueError,
+ "setArrayFromSequence: strings can't define numeric numarray.");
+ return -3;
+ } else if (PySequence_Check(o)) {
+ if ((mustbe == NOTHING) || (mustbe == SEQUENCE)) {
+ if (mustbe == NOTHING) {
+ mustbe = SEQUENCE;
+ seqlen = PySequence_Length(o);
+ } else if (PySequence_Length(o) != seqlen) {
+ PyErr_SetString(
+ PyExc_ValueError,
+ "Nested sequences with different lengths.");
+ return -5;
+ }
+ setArrayFromSequence(a, o, dim+1, offset);
+ } else {
+ PyErr_SetString(PyExc_ValueError,
+ "Nested sequences with different lengths.");
+ return -4;
+ }
+ } else {
+ PyErr_SetString(PyExc_ValueError, "Invalid sequence.");
+ return -6;
+ }
+ Py_DECREF(o);
+ offset += a->strides[dim];
+ }
+ return 0;
+}
+
+static PyObject *
+NA_setArrayFromSequence(PyArrayObject *a, PyObject *s)
+{
+ maybelong shape[MAXDIM];
+
+ if (!PySequence_Check(s))
+ return PyErr_Format( PyExc_TypeError,
+ "NA_setArrayFromSequence: (array, seq) expected.");
+
+ if (getShape(s, shape, 0) < 0)
+ return NULL;
+
+ if (!NA_updateDataPtr(a))
+ return NULL;
+
+ if (setArrayFromSequence(a, s, 0, 0) < 0)
+ return NULL;
+
+ Py_INCREF(Py_None);
+ return Py_None;
+}
+
+enum {
+ BOOL_SCALAR,
+ INT_SCALAR,
+ LONG_SCALAR,
+ FLOAT_SCALAR,
+ COMPLEX_SCALAR
+};
+
+
+static int
+_NA_maxType(PyObject *seq, int limit)
+{
+ if (limit > MAXDIM) {
+ PyErr_Format( PyExc_ValueError,
+ "NA_maxType: sequence nested too deep." );
+ return -1;
+ }
+ if (NA_NumArrayCheck(seq)) {
+ switch(PyArray(seq)->descr->type_num) {
+ case tBool:
+ return BOOL_SCALAR;
+ case tInt8:
+ case tUInt8:
+ case tInt16:
+ case tUInt16:
+ case tInt32:
+ case tUInt32:
+ return INT_SCALAR;
+ case tInt64:
+ case tUInt64:
+ return LONG_SCALAR;
+ case tFloat32:
+ case tFloat64:
+ return FLOAT_SCALAR;
+ case tComplex32:
+ case tComplex64:
+ return COMPLEX_SCALAR;
+ default:
+ PyErr_Format(PyExc_TypeError,
+ "Expecting a python numeric type, got something else.");
+ return -1;
+ }
+ } else if (PySequence_Check(seq) && !PyString_Check(seq)) {
+ long i, maxtype=BOOL_SCALAR, slen;
+
+ slen = PySequence_Length(seq);
+ if (slen < 0) return -1;
+
+ if (slen == 0) return INT_SCALAR;
+
+ for(i=0; i<slen; i++) {
+ long newmax;
+ PyObject *o = PySequence_GetItem(seq, i);
+ if (!o) return -1;
+ newmax = _NA_maxType(o, limit+1);
+ if (newmax < 0)
+ return -1;
+ else if (newmax > maxtype) {
+ maxtype = newmax;
+ }
+ Py_DECREF(o);
+ }
+ return maxtype;
+ } else {
+#if PY_VERSION_HEX >= 0x02030000
+ if (PyBool_Check(seq))
+ return BOOL_SCALAR;
+ else
+#endif
+ if (PyInt_Check(seq))
+ return INT_SCALAR;
+ else if (PyLong_Check(seq))
+ return LONG_SCALAR;
+ else if (PyFloat_Check(seq))
+ return FLOAT_SCALAR;
+ else if (PyComplex_Check(seq))
+ return COMPLEX_SCALAR;
+ else {
+ PyErr_Format(PyExc_TypeError,
+ "Expecting a python numeric type, got something else.");
+ return -1;
+ }
+ }
+}
+
+static int
+NA_maxType(PyObject *seq)
+{
+ int rval;
+ rval = _NA_maxType(seq, 0);
+ return rval;
+}
+
+static int
+NA_isPythonScalar(PyObject *o)
+{
+ int rval;
+ rval = PyInt_Check(o) ||
+ PyLong_Check(o) ||
+ PyFloat_Check(o) ||
+ PyComplex_Check(o) ||
+ (PyString_Check(o) && (PyString_Size(o) == 1));
+ return rval;
+}
+
+#if (NPY_SIZEOF_INTP == 8)
+#define PlatBigInt PyInt_FromLong
+#define PlatBigUInt PyLong_FromUnsignedLong
+#else
+#define PlatBigInt PyLong_FromLongLong
+#define PlatBigUInt PyLong_FromUnsignedLongLong
+#endif
+
+
+static PyObject *
+NA_getPythonScalar(PyArrayObject *a, long offset)
+{
+ int type = a->descr->type_num;
+ PyObject *rval = NULL;
+
+ switch(type) {
+ case tBool:
+ case tInt8:
+ case tUInt8:
+ case tInt16:
+ case tUInt16:
+ case tInt32: {
+ Int64 v = NA_get_Int64(a, offset);
+ rval = PyInt_FromLong(v);
+ break;
+ }
+ case tUInt32: {
+ Int64 v = NA_get_Int64(a, offset);
+ rval = PlatBigUInt(v);
+ break;
+ }
+ case tInt64: {
+ Int64 v = NA_get_Int64(a, offset);
+ rval = PlatBigInt( v);
+ break;
+ }
+ case tUInt64: {
+ Int64 v = NA_get_Int64(a, offset);
+ rval = PlatBigUInt( v);
+ break;
+ }
+ case tFloat32:
+ case tFloat64: {
+ Float64 v = NA_get_Float64(a, offset);
+ rval = PyFloat_FromDouble( v );
+ break;
+ }
+ case tComplex32:
+ case tComplex64:
+ {
+ Complex64 v = NA_get_Complex64(a, offset);
+ rval = PyComplex_FromDoubles(v.r, v.i);
+ break;
+ }
+ default:
+ rval = PyErr_Format(PyExc_TypeError,
+ "NA_getPythonScalar: bad type %d\n",
+ type);
+ }
+ return rval;
+}
+
+static int
+NA_overflow(PyArrayObject *a, Float64 v)
+{
+ if ((a->flags & CHECKOVERFLOW) == 0) return 0;
+
+ switch(a->descr->type_num) {
+ case tBool:
+ return 0;
+ case tInt8:
+ if ((v < -128) || (v > 127)) goto _fail;
+ return 0;
+ case tUInt8:
+ if ((v < 0) || (v > 255)) goto _fail;
+ return 0;
+ case tInt16:
+ if ((v < -32768) || (v > 32767)) goto _fail;
+ return 0;
+ case tUInt16:
+ if ((v < 0) || (v > 65535)) goto _fail;
+ return 0;
+ case tInt32:
+ if ((v < -2147483648.) ||
+ (v > 2147483647.)) goto _fail;
+ return 0;
+ case tUInt32:
+ if ((v < 0) || (v > 4294967295.)) goto _fail;
+ return 0;
+ case tInt64:
+ if ((v < -9223372036854775808.) ||
+ (v > 9223372036854775807.)) goto _fail;
+ return 0;
+ #if HAS_UINT64
+ case tUInt64:
+ if ((v < 0) ||
+ (v > 18446744073709551615.)) goto _fail;
+ return 0;
+ #endif
+ case tFloat32:
+ if ((v < -FLT_MAX) || (v > FLT_MAX)) goto _fail;
+ return 0;
+ case tFloat64:
+ return 0;
+ case tComplex32:
+ if ((v < -FLT_MAX) || (v > FLT_MAX)) goto _fail;
+ return 0;
+ case tComplex64:
+ return 0;
+ default:
+ PyErr_Format( PyExc_TypeError,
+ "Unknown type %d in NA_overflow",
+ a->descr->type_num );
+ PyErr_Print();
+ return -1;
+ }
+ _fail:
+ PyErr_Format(PyExc_OverflowError, "value out of range for array");
+ return -1;
+}
+
+static int
+_setFromPythonScalarCore(PyArrayObject *a, long offset, PyObject*value, int entries)
+{
+ Int64 v;
+ if (entries >= 100) {
+ PyErr_Format(PyExc_RuntimeError,
+ "NA_setFromPythonScalar: __tonumtype__ conversion chain too long");
+ return -1;
+ } else if (PyInt_Check(value)) {
+ v = PyInt_AsLong(value);
+ if (NA_overflow(a, v) < 0)
+ return -1;
+ NA_set_Int64(a, offset, v);
+ } else if (PyLong_Check(value)) {
+ if (a->descr->type_num == tInt64) {
+ v = (Int64) PyLong_AsLongLong( value );
+ } else if (a->descr->type_num == tUInt64) {
+ v = (UInt64) PyLong_AsUnsignedLongLong( value );
+ } else if (a->descr->type_num == tUInt32) {
+ v = PyLong_AsUnsignedLong(value);
+ } else {
+ v = PyLong_AsLongLong(value);
+ }
+ if (PyErr_Occurred())
+ return -1;
+ if (NA_overflow(a, v) < 0)
+ return -1;
+ NA_set_Int64(a, offset, v);
+ } else if (PyFloat_Check(value)) {
+ Float64 v = PyFloat_AsDouble(value);
+ if (NA_overflow(a, v) < 0)
+ return -1;
+ NA_set_Float64(a, offset, v);
+ } else if (PyComplex_Check(value)) {
+ Complex64 vc;
+ vc.r = PyComplex_RealAsDouble(value);
+ vc.i = PyComplex_ImagAsDouble(value);
+ if (NA_overflow(a, vc.r) < 0)
+ return -1;
+ if (NA_overflow(a, vc.i) < 0)
+ return -1;
+ NA_set_Complex64(a, offset, vc);
+ } else if (PyObject_HasAttrString(value, "__tonumtype__")) {
+ int rval;
+ PyObject *type = NA_typeNoToTypeObject(a->descr->type_num);
+ if (!type) return -1;
+ value = PyObject_CallMethod(
+ value, "__tonumtype__", "(N)", type);
+ if (!value) return -1;
+ rval = _setFromPythonScalarCore(a, offset, value, entries+1);
+ Py_DECREF(value);
+ return rval;
+ } else if (PyString_Check(value)) {
+ long size = PyString_Size(value);
+ if ((size <= 0) || (size > 1)) {
+ PyErr_Format( PyExc_ValueError,
+ "NA_setFromPythonScalar: len(string) must be 1.");
+ return -1;
+ }
+ NA_set_Int64(a, offset, *PyString_AsString(value));
+ } else {
+ PyErr_Format(PyExc_TypeError,
+ "NA_setFromPythonScalar: bad value type.");
+ return -1;
+ }
+ return 0;
+}
+
+static int
+NA_setFromPythonScalar(PyArrayObject *a, long offset, PyObject *value)
+{
+ if (a->flags & WRITABLE)
+ return _setFromPythonScalarCore(a, offset, value, 0);
+ else {
+ PyErr_Format(
+ PyExc_ValueError, "NA_setFromPythonScalar: assigment to readonly array buffer");
+ return -1;
+ }
+}
+
+
+static int
+NA_NDArrayCheck(PyObject *obj) {
+ return PyArray_Check(obj);
+}
+
+static int
+NA_NumArrayCheck(PyObject *obj) {
+ return PyArray_Check(obj);
+}
+
+static int
+NA_ComplexArrayCheck(PyObject *a)
+{
+ int rval = NA_NumArrayCheck(a);
+ if (rval > 0) {
+ PyArrayObject *arr = (PyArrayObject *) a;
+ switch(arr->descr->type_num) {
+ case tComplex64: case tComplex32:
+ return 1;
+ default:
+ return 0;
+ }
+ }
+ return rval;
+}
+
+static unsigned long
+NA_elements(PyArrayObject *a)
+{
+ int i;
+ unsigned long n = 1;
+ for(i = 0; i<a->nd; i++)
+ n *= a->dimensions[i];
+ return n;
+}
+
+static int
+NA_typeObjectToTypeNo(PyObject *typeObj)
+{
+ PyArray_Descr *dtype;
+ int i;
+ if (PyArray_DescrConverter(typeObj, &dtype) == NPY_FAIL) i=-1;
+ else i=dtype->type_num;
+ return i;
+}
+
+static int
+NA_copyArray(PyArrayObject *to, const PyArrayObject *from)
+{
+ return PyArray_CopyInto(to, (PyArrayObject *)from);
+}
+
+static PyArrayObject *
+NA_copy(PyArrayObject *from)
+{
+ return (PyArrayObject *)PyArray_NewCopy(from, 0);
+}
+
+
+static PyObject *
+NA_getType( PyObject *type)
+{
+ PyArray_Descr *typeobj = NULL;
+ if (!type && PyArray_DescrConverter(type, &typeobj) == NPY_FAIL) {
+ PyErr_Format(PyExc_ValueError, "NA_getType: unknown type.");
+ typeobj = NULL;
+ }
+ return (PyObject *)typeobj;
+}
+
+
+/* Call a standard "stride" function
+**
+** Stride functions always take one input and one output array.
+** They can handle n-dimensional data with arbitrary strides (of
+** either sign) for both the input and output numarray. Typically
+** these functions are used to copy data, byteswap, or align data.
+**
+**
+** It expects the following arguments:
+**
+** Number of iterations for each dimension as a tuple
+** Input Buffer Object
+** Offset in bytes for input buffer
+** Input strides (in bytes) for each dimension as a tuple
+** Output Buffer Object
+** Offset in bytes for output buffer
+** Output strides (in bytes) for each dimension as a tuple
+** An integer (Optional), typically the number of bytes to copy per
+* element.
+**
+** Returns None
+**
+** The arguments expected by the standard stride functions that this
+** function calls are:
+**
+** Number of dimensions to iterate over
+** Long int value (from the optional last argument to
+** callStrideConvCFunc)
+** often unused by the C Function
+** An array of long ints. Each is the number of iterations for each
+** dimension. NOTE: the previous argument as well as the stride
+** arguments are reversed in order with respect to how they are
+** used in Python. Fastest changing dimension is the first element
+** in the numarray!
+** A void pointer to the input data buffer.
+** The starting offset for the input data buffer in bytes (long int).
+** An array of long int input strides (in bytes) [reversed as with
+** the iteration array]
+** A void pointer to the output data buffer.
+** The starting offset for the output data buffer in bytes (long int).
+** An array of long int output strides (in bytes) [also reversed]
+*/
+
+
+static PyObject *
+NA_callStrideConvCFuncCore(
+ PyObject *self, int nshape, maybelong *shape,
+ PyObject *inbuffObj, long inboffset,
+ int ninbstrides, maybelong *inbstrides,
+ PyObject *outbuffObj, long outboffset,
+ int noutbstrides, maybelong *outbstrides,
+ long nbytes)
+{
+ CfuncObject *me = (CfuncObject *) self;
+ CFUNC_STRIDE_CONV_FUNC funcptr;
+ void *inbuffer, *outbuffer;
+ long inbsize, outbsize;
+ maybelong i, lshape[MAXDIM], in_strides[MAXDIM], out_strides[MAXDIM];
+ maybelong shape_0, inbstr_0, outbstr_0;
+
+ if (nshape == 0) { /* handle rank-0 numarray. */
+ nshape = 1;
+ shape = &shape_0;
+ inbstrides = &inbstr_0;
+ outbstrides = &outbstr_0;
+ shape[0] = 1;
+ inbstrides[0] = outbstrides[0] = 0;
+ }
+
+ for(i=0; i<nshape; i++)
+ lshape[i] = shape[nshape-1-i];
+ for(i=0; i<nshape; i++)
+ in_strides[i] = inbstrides[nshape-1-i];
+ for(i=0; i<nshape; i++)
+ out_strides[i] = outbstrides[nshape-1-i];
+
+ if (!PyObject_IsInstance(self , (PyObject *) &CfuncType)
+ || me->descr.type != CFUNC_STRIDING)
+ return PyErr_Format(PyExc_TypeError,
+ "NA_callStrideConvCFuncCore: problem with cfunc");
+
+ if ((inbsize = NA_getBufferPtrAndSize(inbuffObj, 1, &inbuffer)) < 0)
+ return PyErr_Format(_Error,
+ "%s: Problem with input buffer", me->descr.name);
+
+ if ((outbsize = NA_getBufferPtrAndSize(outbuffObj, 0, &outbuffer)) < 0)
+ return PyErr_Format(_Error,
+ "%s: Problem with output buffer (read only?)",
+ me->descr.name);
+
+ /* Check buffer alignment and bounds */
+ if (NA_checkOneStriding(me->descr.name, nshape, lshape,
+ inboffset, in_strides, inbsize,
+ (me->descr.sizes[0] == -1) ?
+ nbytes : me->descr.sizes[0],
+ me->descr.align) ||
+ NA_checkOneStriding(me->descr.name, nshape, lshape,
+ outboffset, out_strides, outbsize,
+ (me->descr.sizes[1] == -1) ?
+ nbytes : me->descr.sizes[1],
+ me->descr.align))
+ return NULL;
+
+ /* Cast function pointer and perform stride operation */
+ funcptr = (CFUNC_STRIDE_CONV_FUNC) me->descr.fptr;
+ if ((*funcptr)(nshape-1, nbytes, lshape,
+ inbuffer, inboffset, in_strides,
+ outbuffer, outboffset, out_strides) == 0) {
+ Py_INCREF(Py_None);
+ return Py_None;
+ } else {
+ return NULL;
+ }
+}
+
+static void
+NA_stridesFromShape(int nshape, maybelong *shape, maybelong bytestride,
+ maybelong *strides)
+{
+ int i;
+ if (nshape > 0) {
+ for(i=0; i<nshape; i++)
+ strides[i] = bytestride;
+ for(i=nshape-2; i>=0; i--)
+ strides[i] = strides[i+1]*shape[i+1];
+ }
+}
+
+static int
+NA_OperatorCheck(PyObject *op) {
+ return 0;
+}
+
+static int
+NA_ConverterCheck(PyObject *op) {
+ return 0;
+}
+
+static int
+NA_UfuncCheck(PyObject *op) {
+ return 0;
+}
+
+static int
+NA_CfuncCheck(PyObject *op) {
+ return PyObject_TypeCheck(op, &CfuncType);
+}
+
+static int
+NA_getByteOffset(PyArrayObject *array, int nindices, maybelong *indices,
+ long *offset)
+{
+ return 0;
+}
+
+static int
+NA_swapAxes(PyArrayObject *array, int x, int y)
+{
+ long temp;
+
+ if (((PyObject *) array) == Py_None) return 0;
+
+ if (array->nd < 2) return 0;
+
+ if (x < 0) x += array->nd;
+ if (y < 0) y += array->nd;
+
+ if ((x < 0) || (x >= array->nd) ||
+ (y < 0) || (y >= array->nd)) {
+ PyErr_Format(PyExc_ValueError,
+ "Specified dimension does not exist");
+ return -1;
+ }
+
+ temp = array->dimensions[x];
+ array->dimensions[x] = array->dimensions[y];
+ array->dimensions[y] = temp;
+
+ temp = array->strides[x];
+ array->strides[x] = array->strides[y];
+ array->strides[y] = temp;
+
+ PyArray_UpdateFlags(array, NPY_UPDATE_ALL);
+
+ return 0;
+}
+
+static PyObject *
+NA_initModuleGlobal(char *modulename, char *globalname)
+{
+ PyObject *module, *dict, *global = NULL;
+ module = PyImport_ImportModule(modulename);
+ if (!module) {
+ PyErr_Format(PyExc_RuntimeError,
+ "Can't import '%s' module",
+ modulename);
+ goto _exit;
+ }
+ dict = PyModule_GetDict(module);
+ global = PyDict_GetItemString(dict, globalname);
+ if (!global) {
+ PyErr_Format(PyExc_RuntimeError,
+ "Can't find '%s' global in '%s' module.",
+ globalname, modulename);
+ goto _exit;
+ }
+ Py_DECREF(module);
+ Py_INCREF(global);
+ _exit:
+ return global;
+}
+
+NumarrayType
+NA_NumarrayType(PyObject *seq)
+{
+ int maxtype = NA_maxType(seq);
+ int rval;
+ switch(maxtype) {
+ case BOOL_SCALAR:
+ rval = tBool;
+ goto _exit;
+ case INT_SCALAR:
+ case LONG_SCALAR:
+ rval = tLong; /* tLong corresponds to C long int,
+ not Python long int */
+ goto _exit;
+ case FLOAT_SCALAR:
+ rval = tFloat64;
+ goto _exit;
+ case COMPLEX_SCALAR:
+ rval = tComplex64;
+ goto _exit;
+ default:
+ PyErr_Format(PyExc_TypeError,
+ "expecting Python numeric scalar value; got something else.");
+ rval = -1;
+ }
+ _exit:
+ return rval;
+}
+
+/* ignores bytestride */
+static PyArrayObject *
+NA_NewAllFromBuffer(int ndim, maybelong *shape, NumarrayType type,
+ PyObject *bufferObject, maybelong byteoffset, maybelong bytestride,
+ int byteorder, int aligned, int writeable)
+{
+ PyArrayObject *self = NULL;
+ PyArray_Descr *dtype;
+
+ if (type == tAny)
+ type = tDefault;
+
+ dtype = PyArray_DescrFromType(type);
+ if (dtype == NULL) return NULL;
+
+ if (byteorder != NA_ByteOrder()) {
+ PyArray_Descr *temp;
+ temp = PyArray_DescrNewByteorder(dtype, PyArray_SWAP);
+ Py_DECREF(dtype);
+ if (temp == NULL) return NULL;
+ dtype = temp;
+ }
+
+ if (bufferObject == Py_None || bufferObject == NULL) {
+ self = (PyArrayObject *) \
+ PyArray_NewFromDescr(&PyArray_Type, dtype,
+ ndim, shape, NULL, NULL,
+ 0, NULL);
+ }
+ else {
+ npy_intp size = 1;
+ int i;
+ PyArrayObject *newself;
+ PyArray_Dims newdims;
+ for(i=0; i<ndim; i++) {
+ size *= shape[i];
+ }
+ self = (PyArrayObject *)\
+ PyArray_FromBuffer(bufferObject, dtype,
+ size, byteoffset);
+
+ if (self == NULL) return self;
+ newdims.len = ndim;
+ newdims.ptr = shape;
+ newself = (PyArrayObject *)\
+ PyArray_Newshape(self, &newdims, PyArray_CORDER);
+ Py_DECREF(self);
+ self = newself;
+ }
+
+ return self;
+}
+
+static void
+NA_updateAlignment(PyArrayObject *self)
+{
+ PyArray_UpdateFlags(self, NPY_ALIGNED);
+}
+
+static void
+NA_updateContiguous(PyArrayObject *self)
+{
+ PyArray_UpdateFlags(self, NPY_CONTIGUOUS | NPY_FORTRAN);
+}
+
+
+static void
+NA_updateStatus(PyArrayObject *self)
+{
+ PyArray_UpdateFlags(self, NPY_UPDATE_ALL);
+}
+
+static int
+NA_NumArrayCheckExact(PyObject *op) {
+ return (op->ob_type == &PyArray_Type);
+}
+
+static int
+NA_NDArrayCheckExact(PyObject *op) {
+ return (op->ob_type == &PyArray_Type);
+}
+
+static int
+NA_OperatorCheckExact(PyObject *op) {
+ return 0;
+}
+
+static int
+NA_ConverterCheckExact(PyObject *op) {
+ return 0;
+}
+
+static int
+NA_UfuncCheckExact(PyObject *op) {
+ return 0;
+}
+
+
+static int
+NA_CfuncCheckExact(PyObject *op) {
+ return op->ob_type == &CfuncType;
+}
+
+static char *
+NA_getArrayData(PyArrayObject *obj)
+{
+ if (!NA_NDArrayCheck((PyObject *) obj)) {
+ PyErr_Format(PyExc_TypeError,
+ "expected an NDArray");
+ }
+ return obj->data;
+}
+
+/* Byteswap is not a flag of the array --- it is implicit in the data-type */
+static void
+NA_updateByteswap(PyArrayObject *self)
+{
+ return;
+}
+
+static PyArray_Descr *
+NA_DescrFromType(int type)
+{
+ if (type == tAny)
+ type = tDefault;
+ return PyArray_DescrFromType(type);
+}
+
+static PyObject *
+NA_Cast(PyArrayObject *a, int type)
+{
+ return PyArray_Cast(a, type);
+}
+
+
+/* The following function has much platform dependent code since
+** there is no platform-independent way of checking Floating Point
+** status bits
+*/
+
+/* OSF/Alpha (Tru64) ---------------------------------------------*/
+#if defined(__osf__) && defined(__alpha)
+
+static int
+NA_checkFPErrors(void)
+{
+ unsigned long fpstatus;
+ int retstatus;
+
+#include <machine/fpu.h> /* Should migrate to global scope */
+
+ fpstatus = ieee_get_fp_control();
+ /* clear status bits as well as disable exception mode if on */
+ ieee_set_fp_control( 0 );
+ retstatus =
+ pyFPE_DIVIDE_BY_ZERO* (int)((IEEE_STATUS_DZE & fpstatus) != 0)
+ + pyFPE_OVERFLOW * (int)((IEEE_STATUS_OVF & fpstatus) != 0)
+ + pyFPE_UNDERFLOW * (int)((IEEE_STATUS_UNF & fpstatus) != 0)
+ + pyFPE_INVALID * (int)((IEEE_STATUS_INV & fpstatus) != 0);
+
+ return retstatus;
+}
+
+/* MS Windows -----------------------------------------------------*/
+#elif defined(_MSC_VER)
+
+#include <float.h>
+
+static int
+NA_checkFPErrors(void)
+{
+ int fpstatus = (int) _clear87();
+ int retstatus =
+ pyFPE_DIVIDE_BY_ZERO * ((SW_ZERODIVIDE & fpstatus) != 0)
+ + pyFPE_OVERFLOW * ((SW_OVERFLOW & fpstatus) != 0)
+ + pyFPE_UNDERFLOW * ((SW_UNDERFLOW & fpstatus) != 0)
+ + pyFPE_INVALID * ((SW_INVALID & fpstatus) != 0);
+
+
+ return retstatus;
+}
+
+/* Solaris --------------------------------------------------------*/
+/* --------ignoring SunOS ieee_flags approach, someone else can
+** deal with that! */
+#elif defined(sun)
+#include <ieeefp.h>
+
+static int
+NA_checkFPErrors(void)
+{
+ int fpstatus;
+ int retstatus;
+
+ fpstatus = (int) fpgetsticky();
+ retstatus = pyFPE_DIVIDE_BY_ZERO * ((FP_X_DZ & fpstatus) != 0)
+ + pyFPE_OVERFLOW * ((FP_X_OFL & fpstatus) != 0)
+ + pyFPE_UNDERFLOW * ((FP_X_UFL & fpstatus) != 0)
+ + pyFPE_INVALID * ((FP_X_INV & fpstatus) != 0);
+ (void) fpsetsticky(0);
+
+ return retstatus;
+}
+
+#elif defined(__GLIBC__) || defined(__APPLE__) || defined(__CYGWIN__) || defined(__MINGW32__)
+
+static int
+NA_checkFPErrors(void)
+{
+ int fpstatus = (int) fetestexcept(
+ FE_DIVBYZERO | FE_OVERFLOW | FE_UNDERFLOW | FE_INVALID);
+ int retstatus =
+ pyFPE_DIVIDE_BY_ZERO * ((FE_DIVBYZERO & fpstatus) != 0)
+ + pyFPE_OVERFLOW * ((FE_OVERFLOW & fpstatus) != 0)
+ + pyFPE_UNDERFLOW * ((FE_UNDERFLOW & fpstatus) != 0)
+ + pyFPE_INVALID * ((FE_INVALID & fpstatus) != 0);
+ (void) feclearexcept(FE_DIVBYZERO | FE_OVERFLOW |
+ FE_UNDERFLOW | FE_INVALID);
+ return retstatus;
+}
+
+#else
+
+static int
+NA_checkFPErrors(void)
+{
+ return 0;
+}
+
+#endif
+
+static void
+NA_clearFPErrors()
+{
+ NA_checkFPErrors();
+}
+
+/* Not supported yet */
+static int
+NA_checkAndReportFPErrors(char *name)
+{
+ int error = NA_checkFPErrors();
+ if (error) {
+ PyObject *ans;
+ char msg[128];
+ strcpy(msg, " in ");
+ strncat(msg, name, 100);
+ ans = PyObject_CallFunction(pHandleErrorFunc, "(is)", error, msg);
+ if (!ans) return -1;
+ Py_DECREF(ans); /* Py_None */
+ }
+ return 0;
+
+}
+
+
+#define WITHIN32(v, f) (((v) >= f##_MIN32) && ((v) <= f##_MAX32))
+#define WITHIN64(v, f) (((v) >= f##_MIN64) && ((v) <= f##_MAX64))
+
+static Bool
+NA_IeeeMask32( Float32 f, Int32 mask)
+{
+ Int32 category;
+ UInt32 v = *(UInt32 *) &f;
+
+ if (v & BIT(31)) {
+ if (WITHIN32(v, NEG_NORMALIZED)) {
+ category = MSK_NEG_NOR;
+ } else if (WITHIN32(v, NEG_DENORMALIZED)) {
+ category = MSK_NEG_DEN;
+ } else if (WITHIN32(v, NEG_SIGNAL_NAN)) {
+ category = MSK_NEG_SNAN;
+ } else if (WITHIN32(v, NEG_QUIET_NAN)) {
+ category = MSK_NEG_QNAN;
+ } else if (v == NEG_INFINITY_MIN32) {
+ category = MSK_NEG_INF;
+ } else if (v == NEG_ZERO_MIN32) {
+ category = MSK_NEG_ZERO;
+ } else if (v == INDETERMINATE_MIN32) {
+ category = MSK_INDETERM;
+ } else {
+ category = MSK_BUG;
+ }
+ } else {
+ if (WITHIN32(v, POS_NORMALIZED)) {
+ category = MSK_POS_NOR;
+ } else if (WITHIN32(v, POS_DENORMALIZED)) {
+ category = MSK_POS_DEN;
+ } else if (WITHIN32(v, POS_SIGNAL_NAN)) {
+ category = MSK_POS_SNAN;
+ } else if (WITHIN32(v, POS_QUIET_NAN)) {
+ category = MSK_POS_QNAN;
+ } else if (v == POS_INFINITY_MIN32) {
+ category = MSK_POS_INF;
+ } else if (v == POS_ZERO_MIN32) {
+ category = MSK_POS_ZERO;
+ } else {
+ category = MSK_BUG;
+ }
+ }
+ return (category & mask) != 0;
+}
+
+static Bool
+NA_IeeeMask64( Float64 f, Int32 mask)
+{
+ Int32 category;
+ UInt64 v = *(UInt64 *) &f;
+
+ if (v & BIT(63)) {
+ if (WITHIN64(v, NEG_NORMALIZED)) {
+ category = MSK_NEG_NOR;
+ } else if (WITHIN64(v, NEG_DENORMALIZED)) {
+ category = MSK_NEG_DEN;
+ } else if (WITHIN64(v, NEG_SIGNAL_NAN)) {
+ category = MSK_NEG_SNAN;
+ } else if (WITHIN64(v, NEG_QUIET_NAN)) {
+ category = MSK_NEG_QNAN;
+ } else if (v == NEG_INFINITY_MIN64) {
+ category = MSK_NEG_INF;
+ } else if (v == NEG_ZERO_MIN64) {
+ category = MSK_NEG_ZERO;
+ } else if (v == INDETERMINATE_MIN64) {
+ category = MSK_INDETERM;
+ } else {
+ category = MSK_BUG;
+ }
+ } else {
+ if (WITHIN64(v, POS_NORMALIZED)) {
+ category = MSK_POS_NOR;
+ } else if (WITHIN64(v, POS_DENORMALIZED)) {
+ category = MSK_POS_DEN;
+ } else if (WITHIN64(v, POS_SIGNAL_NAN)) {
+ category = MSK_POS_SNAN;
+ } else if (WITHIN64(v, POS_QUIET_NAN)) {
+ category = MSK_POS_QNAN;
+ } else if (v == POS_INFINITY_MIN64) {
+ category = MSK_POS_INF;
+ } else if (v == POS_ZERO_MIN64) {
+ category = MSK_POS_ZERO;
+ } else {
+ category = MSK_BUG;
+ }
+ }
+ return (category & mask) != 0;
+}
+
+static PyArrayObject *
+NA_FromDimsStridesDescrAndData(int nd, maybelong *d, maybelong *s, PyArray_Descr *descr, char *data)
+{
+ return (PyArrayObject *)\
+ PyArray_NewFromDescr(&PyArray_Type, descr, nd, d,
+ s, data, 0, NULL);
+}
+
+static PyArrayObject *
+NA_FromDimsTypeAndData(int nd, maybelong *d, int type, char *data)
+{
+ PyArray_Descr *descr = NA_DescrFromType(type);
+ return NA_FromDimsStridesDescrAndData(nd, d, NULL, descr, data);
+}
+
+static PyArrayObject *
+NA_FromDimsStridesTypeAndData(int nd, maybelong *shape, maybelong *strides,
+ int type, char *data)
+{
+ PyArray_Descr *descr = NA_DescrFromType(type);
+ return NA_FromDimsStridesDescrAndData(nd, shape, strides, descr, data);
+}
+
+
+typedef struct
+{
+ NumarrayType type_num;
+ char suffix[5];
+ int itemsize;
+} scipy_typestr;
+
+static scipy_typestr scipy_descriptors[ ] = {
+ { tAny, ""},
+
+ { tBool, "b1", 1},
+
+ { tInt8, "i1", 1},
+ { tUInt8, "u1", 1},
+
+ { tInt16, "i2", 2},
+ { tUInt16, "u2", 2},
+
+ { tInt32, "i4", 4},
+ { tUInt32, "u4", 4},
+
+ { tInt64, "i8", 8},
+ { tUInt64, "u8", 8},
+
+ { tFloat32, "f4", 4},
+ { tFloat64, "f8", 8},
+
+ { tComplex32, "c8", 8},
+ { tComplex64, "c16", 16}
+};
+
+
+static int
+NA_scipy_typestr(NumarrayType t, int byteorder, char *typestr)
+{
+ int i;
+ if (byteorder)
+ strcpy(typestr, ">");
+ else
+ strcpy(typestr, "<");
+ for(i=0; i<ELEM(scipy_descriptors); i++) {
+ scipy_typestr *ts = &scipy_descriptors[i];
+ if (ts->type_num == t) {
+ strncat(typestr, ts->suffix, 4);
+ return 0;
+ }
+ }
+ return -1;
+}
+
+static PyArrayObject *
+NA_FromArrayStruct(PyObject *obj)
+{
+ return (PyArrayObject *)PyArray_FromStructInterface(obj);
+}
+
+
+static PyObject *_Error;
+
+void *libnumarray_API[] = {
+ (void*) getBuffer,
+ (void*) isBuffer,
+ (void*) getWriteBufferDataPtr,
+ (void*) isBufferWriteable,
+ (void*) getReadBufferDataPtr,
+ (void*) getBufferSize,
+ (void*) num_log,
+ (void*) num_log10,
+ (void*) num_pow,
+ (void*) num_acosh,
+ (void*) num_asinh,
+ (void*) num_atanh,
+ (void*) num_round,
+ (void*) int_dividebyzero_error,
+ (void*) int_overflow_error,
+ (void*) umult64_overflow,
+ (void*) smult64_overflow,
+ (void*) NA_Done,
+ (void*) NA_NewAll,
+ (void*) NA_NewAllStrides,
+ (void*) NA_New,
+ (void*) NA_Empty,
+ (void*) NA_NewArray,
+ (void*) NA_vNewArray,
+ (void*) NA_ReturnOutput,
+ (void*) NA_getBufferPtrAndSize,
+ (void*) NA_checkIo,
+ (void*) NA_checkOneCBuffer,
+ (void*) NA_checkNCBuffers,
+ (void*) NA_checkOneStriding,
+ (void*) NA_new_cfunc,
+ (void*) NA_add_cfunc,
+ (void*) NA_InputArray,
+ (void*) NA_OutputArray,
+ (void*) NA_IoArray,
+ (void*) NA_OptionalOutputArray,
+ (void*) NA_get_offset,
+ (void*) NA_get_Float64,
+ (void*) NA_set_Float64,
+ (void*) NA_get_Complex64,
+ (void*) NA_set_Complex64,
+ (void*) NA_get_Int64,
+ (void*) NA_set_Int64,
+ (void*) NA_get1_Float64,
+ (void*) NA_get2_Float64,
+ (void*) NA_get3_Float64,
+ (void*) NA_set1_Float64,
+ (void*) NA_set2_Float64,
+ (void*) NA_set3_Float64,
+ (void*) NA_get1_Complex64,
+ (void*) NA_get2_Complex64,
+ (void*) NA_get3_Complex64,
+ (void*) NA_set1_Complex64,
+ (void*) NA_set2_Complex64,
+ (void*) NA_set3_Complex64,
+ (void*) NA_get1_Int64,
+ (void*) NA_get2_Int64,
+ (void*) NA_get3_Int64,
+ (void*) NA_set1_Int64,
+ (void*) NA_set2_Int64,
+ (void*) NA_set3_Int64,
+ (void*) NA_get1D_Float64,
+ (void*) NA_set1D_Float64,
+ (void*) NA_get1D_Int64,
+ (void*) NA_set1D_Int64,
+ (void*) NA_get1D_Complex64,
+ (void*) NA_set1D_Complex64,
+ (void*) NA_ShapeEqual,
+ (void*) NA_ShapeLessThan,
+ (void*) NA_ByteOrder,
+ (void*) NA_IeeeSpecial32,
+ (void*) NA_IeeeSpecial64,
+ (void*) NA_updateDataPtr,
+ (void*) NA_typeNoToName,
+ (void*) NA_nameToTypeNo,
+ (void*) NA_typeNoToTypeObject,
+ (void*) NA_intTupleFromMaybeLongs,
+ (void*) NA_maybeLongsFromIntTuple,
+ (void*) NA_intTupleProduct,
+ (void*) NA_isIntegerSequence,
+ (void*) NA_setArrayFromSequence,
+ (void*) NA_maxType,
+ (void*) NA_isPythonScalar,
+ (void*) NA_getPythonScalar,
+ (void*) NA_setFromPythonScalar,
+ (void*) NA_NDArrayCheck,
+ (void*) NA_NumArrayCheck,
+ (void*) NA_ComplexArrayCheck,
+ (void*) NA_elements,
+ (void*) NA_typeObjectToTypeNo,
+ (void*) NA_copyArray,
+ (void*) NA_copy,
+ (void*) NA_getType,
+ (void*) NA_callCUFuncCore,
+ (void*) NA_callStrideConvCFuncCore,
+ (void*) NA_stridesFromShape,
+ (void*) NA_OperatorCheck,
+ (void*) NA_ConverterCheck,
+ (void*) NA_UfuncCheck,
+ (void*) NA_CfuncCheck,
+ (void*) NA_getByteOffset,
+ (void*) NA_swapAxes,
+ (void*) NA_initModuleGlobal,
+ (void*) NA_NumarrayType,
+ (void*) NA_NewAllFromBuffer,
+ (void*) NA_alloc1D_Float64,
+ (void*) NA_alloc1D_Int64,
+ (void*) NA_updateAlignment,
+ (void*) NA_updateContiguous,
+ (void*) NA_updateStatus,
+ (void*) NA_NumArrayCheckExact,
+ (void*) NA_NDArrayCheckExact,
+ (void*) NA_OperatorCheckExact,
+ (void*) NA_ConverterCheckExact,
+ (void*) NA_UfuncCheckExact,
+ (void*) NA_CfuncCheckExact,
+ (void*) NA_getArrayData,
+ (void*) NA_updateByteswap,
+ (void*) NA_DescrFromType,
+ (void*) NA_Cast,
+ (void*) NA_checkFPErrors,
+ (void*) NA_clearFPErrors,
+ (void*) NA_checkAndReportFPErrors,
+ (void*) NA_IeeeMask32,
+ (void*) NA_IeeeMask64,
+ (void*) _NA_callStridingHelper,
+ (void*) NA_FromDimsStridesDescrAndData,
+ (void*) NA_FromDimsTypeAndData,
+ (void*) NA_FromDimsStridesTypeAndData,
+ (void*) NA_scipy_typestr,
+ (void*) NA_FromArrayStruct
+};
+
+#if (!defined(METHOD_TABLE_EXISTS))
+static PyMethodDef _libnumarrayMethods[] = {
+ {NULL, NULL} /* Sentinel */
+};
+#endif
+
+/* boiler plate API init */
+PyMODINIT_FUNC init_capi(void)
+{
+ PyObject *m = Py_InitModule("_capi", _libnumarrayMethods);
+ PyObject *c_api_object;
+
+ _Error = PyErr_NewException("numpy.numarray._capi.error", NULL, NULL);
+
+ /* Create a CObject containing the API pointer array's address */
+ c_api_object = PyCObject_FromVoidPtr((void *)libnumarray_API, NULL);
+
+ if (c_api_object != NULL) {
+ /* Create a name for this object in the module's namespace */
+ PyObject *d = PyModule_GetDict(m);
+
+ PyDict_SetItemString(d, "_C_API", c_api_object);
+ PyDict_SetItemString(d, "error", _Error);
+ Py_DECREF(c_api_object);
+ } else {
+ return;
+ }
+ if (PyModule_AddObject(m, "__version__",
+ PyString_FromString("0.9")) < 0) return;
+
+ if (_import_array() < 0) return;
+ deferred_libnumarray_init();
+ return;
+}
+
+
diff --git a/numpy/numarray/alter_code1.py b/numpy/numarray/alter_code1.py
new file mode 100644
index 000000000..ae950e7e0
--- /dev/null
+++ b/numpy/numarray/alter_code1.py
@@ -0,0 +1,265 @@
+"""
+This module converts code written for numarray to run with numpy
+
+Makes the following changes:
+ * Changes import statements
+
+ import numarray.package
+ --> import numpy.numarray.package as numarray_package
+ with all numarray.package in code changed to numarray_package
+
+ import numarray --> import numpy.numarray as numarray
+ import numarray.package as <yyy> --> import numpy.numarray.package as <yyy>
+
+ from numarray import <xxx> --> from numpy.numarray import <xxx>
+ from numarray.package import <xxx>
+ --> from numpy.numarray.package import <xxx>
+
+ package can be convolve, image, nd_image, mlab, linear_algebra, ma,
+ matrix, fft, random_array
+
+
+ * Makes search and replace changes to:
+ - .imaginary --> .imag
+ - .flat --> .ravel() (most of the time)
+ - .byteswapped() --> .byteswap(False)
+ - .byteswap() --> .byteswap(True)
+ - .info() --> numarray.info(self)
+ - .isaligned() --> .flags.aligned
+ - .isbyteswapped() --> (not .dtype.isnative)
+ - .typecode() --> .dtype.char
+ - .iscontiguous() --> .flags.contiguous
+ - .is_c_array() --> .flags.carray and .dtype.isnative
+ - .is_fortran_contiguous() --> .flags.fortran
+ - .is_f_array() --> .dtype.isnative and .flags.farray
+ - .itemsize() --> .itemsize
+ - .nelements() --> .size
+ - self.new(type) --> numarray.newobj(self, type)
+ - .repeat(r) --> .repeat(r, axis=0)
+ - .size() --> .size
+ - self.type() -- numarray.typefrom(self)
+ - .typecode() --> .dtype.char
+ - .stddev() --> .std()
+ - .togglebyteorder() --> numarray.togglebyteorder(self)
+ - .getshape() --> .shape
+ - .setshape(obj) --> .shape=obj
+ - .getflat() --> .ravel()
+ - .getreal() --> .real
+ - .setreal() --> .real =
+ - .getimag() --> .imag
+ - .setimag() --> .imag =
+ - .getimaginary() --> .imag
+ - .setimaginary() --> .imag
+
+"""
+__all__ = ['convertfile', 'convertall', 'converttree', 'convertsrc']
+
+import sys
+import os
+import re
+import glob
+
+def changeimports(fstr, name, newname):
+ importstr = 'import %s' % name
+ importasstr = 'import %s as ' % name
+ fromstr = 'from %s import ' % name
+ fromall=0
+
+ name_ = name
+ if ('.' in name):
+ name_ = name.replace('.','_')
+
+ fstr = re.sub(r'(import\s+[^,\n\r]+,\s*)(%s)' % name,
+ "\\1%s as %s" % (newname, name), fstr)
+ fstr = fstr.replace(importasstr, 'import %s as ' % newname)
+ fstr = fstr.replace(importstr, 'import %s as %s' % (newname,name_))
+ if (name_ != name):
+ fstr = fstr.replace(name, name_)
+
+ ind = 0
+ Nlen = len(fromstr)
+ Nlen2 = len("from %s import " % newname)
+ while 1:
+ found = fstr.find(fromstr,ind)
+ if (found < 0):
+ break
+ ind = found + Nlen
+ if fstr[ind] == '*':
+ continue
+ fstr = "%sfrom %s import %s" % (fstr[:found], newname, fstr[ind:])
+ ind += Nlen2 - Nlen
+ return fstr, fromall
+
+flatindex_re = re.compile('([.]flat(\s*?[[=]))')
+
+
+def addimport(astr):
+ # find the first line with import on it
+ ind = astr.find('import')
+ start = astr.rfind(os.linesep, 0, ind)
+ astr = "%s%s%s%s" % (astr[:start], os.linesep,
+ "import numpy.numarray as numarray",
+ astr[start:])
+ return astr
+
+def replaceattr(astr):
+ astr = astr.replace(".imaginary", ".imag")
+ astr = astr.replace(".byteswapped()",".byteswap(False)")
+ astr = astr.replace(".byteswap()", ".byteswap(True)")
+ astr = astr.replace(".isaligned()", ".flags.aligned")
+ astr = astr.replace(".iscontiguous()",".flags.contiguous")
+ astr = astr.replace(".is_fortran_contiguous()",".flags.fortran")
+ astr = astr.replace(".itemsize()",".itemsize")
+ astr = astr.replace(".size()",".size")
+ astr = astr.replace(".nelements()",".size")
+ astr = astr.replace(".typecode()",".dtype.char")
+ astr = astr.replace(".stddev()",".std()")
+ astr = astr.replace(".getshape()", ".shape")
+ astr = astr.replace(".getflat()", ".ravel()")
+ astr = astr.replace(".getreal", ".real")
+ astr = astr.replace(".getimag", ".imag")
+ astr = astr.replace(".getimaginary", ".imag")
+
+ # preserve uses of flat that should be o.k.
+ tmpstr = flatindex_re.sub(r"@@@@\2",astr)
+ # replace other uses of flat
+ tmpstr = tmpstr.replace(".flat",".ravel()")
+ # put back .flat where it was valid
+ astr = tmpstr.replace("@@@@", ".flat")
+ return astr
+
+info_re = re.compile(r'(\S+)\s*[.]\s*info\s*[(]\s*[)]')
+new_re = re.compile(r'(\S+)\s*[.]\s*new\s*[(]\s*(\S+)\s*[)]')
+toggle_re = re.compile(r'(\S+)\s*[.]\s*togglebyteorder\s*[(]\s*[)]')
+type_re = re.compile(r'(\S+)\s*[.]\s*type\s*[(]\s*[)]')
+
+isbyte_re = re.compile(r'(\S+)\s*[.]\s*isbyteswapped\s*[(]\s*[)]')
+iscarr_re = re.compile(r'(\S+)\s*[.]\s*is_c_array\s*[(]\s*[)]')
+isfarr_re = re.compile(r'(\S+)\s*[.]\s*is_f_array\s*[(]\s*[)]')
+repeat_re = re.compile(r'(\S+)\s*[.]\s*repeat\s*[(]\s*(\S+)\s*[)]')
+
+setshape_re = re.compile(r'(\S+)\s*[.]\s*setshape\s*[(]\s*(\S+)\s*[)]')
+setreal_re = re.compile(r'(\S+)\s*[.]\s*setreal\s*[(]\s*(\S+)\s*[)]')
+setimag_re = re.compile(r'(\S+)\s*[.]\s*setimag\s*[(]\s*(\S+)\s*[)]')
+setimaginary_re = re.compile(r'(\S+)\s*[.]\s*setimaginary\s*[(]\s*(\S+)\s*[)]')
+def replaceother(astr):
+ # self.info() --> numarray.info(self)
+ # self.new(type) --> numarray.newobj(self, type)
+ # self.togglebyteorder() --> numarray.togglebyteorder(self)
+ # self.type() --> numarray.typefrom(self)
+ (astr, n1) = info_re.subn('numarray.info(\\1)', astr)
+ (astr, n2) = new_re.subn('numarray.newobj(\\1, \\2)', astr)
+ (astr, n3) = toggle_re.subn('numarray.togglebyteorder(\\1)', astr)
+ (astr, n4) = type_re.subn('numarray.typefrom(\\1)', astr)
+ if (n1+n2+n3+n4 > 0):
+ astr = addimport(astr)
+
+ astr = isbyte_re.sub('not \\1.dtype.isnative', astr)
+ astr = iscarr_re.sub('\\1.dtype.isnative and \\1.flags.carray', astr)
+ astr = isfarr_re.sub('\\1.dtype.isnative and \\1.flags.farray', astr)
+ astr = repeat_re.sub('\\1.repeat(\\2, axis=0)', astr)
+ astr = setshape_re.sub('\\1.shape = \\2', astr)
+ astr = setreal_re.sub('\\1.real = \\2', astr)
+ astr = setimag_re.sub('\\1.imag = \\2', astr)
+ astr = setimaginary_re.sub('\\1.imag = \\2', astr)
+ return astr
+
+import datetime
+def fromstr(filestr):
+ savestr = filestr[:]
+ filestr, fromall = changeimports(filestr, 'numarray', 'numpy.numarray')
+ base = 'numarray'
+ newbase = 'numpy.numarray'
+ for sub in ['', 'convolve', 'image', 'nd_image', 'mlab', 'linear_algebra',
+ 'ma', 'matrix', 'fft', 'random_array']:
+ if sub != '':
+ sub = '.'+sub
+ filestr, fromall = changeimports(filestr, base+sub, newbase+sub)
+
+ filestr = replaceattr(filestr)
+ filestr = replaceother(filestr)
+ if savestr != filestr:
+ name = os.path.split(sys.argv[0])[-1]
+ today = datetime.date.today().strftime('%b %d, %Y')
+ filestr = '## Automatically adapted for '\
+ 'numpy.numarray %s by %s\n\n%s' % (today, name, filestr)
+ return filestr, 1
+ return filestr, 0
+
+def makenewfile(name, filestr):
+ fid = file(name, 'w')
+ fid.write(filestr)
+ fid.close()
+
+def convertfile(filename, orig=1):
+ """Convert the filename given from using Numarray to using NumPy
+
+ Copies the file to filename.orig and then over-writes the file
+ with the updated code
+ """
+ fid = open(filename)
+ filestr = fid.read()
+ fid.close()
+ filestr, changed = fromstr(filestr)
+ if changed:
+ if orig:
+ base, ext = os.path.splitext(filename)
+ os.rename(filename, base+".orig")
+ else:
+ os.remove(filename)
+ makenewfile(filename, filestr)
+
+def fromargs(args):
+ filename = args[1]
+ convertfile(filename)
+
+def convertall(direc=os.path.curdir, orig=1):
+ """Convert all .py files to use numpy.oldnumeric (from Numeric) in the directory given
+
+ For each file, a backup of <usesnumeric>.py is made as
+ <usesnumeric>.py.orig. A new file named <usesnumeric>.py
+ is then written with the updated code.
+ """
+ files = glob.glob(os.path.join(direc,'*.py'))
+ for afile in files:
+ if afile[-8:] == 'setup.py': continue
+ convertfile(afile, orig)
+
+header_re = re.compile(r'(numarray/libnumarray.h)')
+
+def convertsrc(direc=os.path.curdir, ext=None, orig=1):
+ """Replace Numeric/arrayobject.h with numpy/oldnumeric.h in all files in the
+ directory with extension give by list ext (if ext is None, then all files are
+ replaced)."""
+ if ext is None:
+ files = glob.glob(os.path.join(direc,'*'))
+ else:
+ files = []
+ for aext in ext:
+ files.extend(glob.glob(os.path.join(direc,"*.%s" % aext)))
+ for afile in files:
+ fid = open(afile)
+ fstr = fid.read()
+ fid.close()
+ fstr, n = header_re.subn(r'numpy/libnumarray.h',fstr)
+ if n > 0:
+ if orig:
+ base, ext = os.path.splitext(afile)
+ os.rename(afile, base+".orig")
+ else:
+ os.remove(afile)
+ makenewfile(afile, fstr)
+
+def _func(arg, dirname, fnames):
+ convertall(dirname, orig=0)
+ convertsrc(dirname, ['h','c'], orig=0)
+
+def converttree(direc=os.path.curdir):
+ """Convert all .py files in the tree given
+
+ """
+ os.path.walk(direc, _func, None)
+
+
+if __name__ == '__main__':
+ converttree(sys.argv)
diff --git a/numpy/numarray/alter_code2.py b/numpy/numarray/alter_code2.py
new file mode 100644
index 000000000..87ec5aa07
--- /dev/null
+++ b/numpy/numarray/alter_code2.py
@@ -0,0 +1,70 @@
+"""
+This module converts code written for numpy.numarray to work
+with numpy
+
+FIXME: finish this.
+
+"""
+#__all__ = ['convertfile', 'convertall', 'converttree']
+__all__ = []
+
+import warnings
+warnings.warn("numpy.numarray.alter_code2 is not working yet.")
+import sys
+
+
+import os
+import re
+import glob
+
+
+def makenewfile(name, filestr):
+ fid = file(name, 'w')
+ fid.write(filestr)
+ fid.close()
+
+def getandcopy(name):
+ fid = file(name)
+ filestr = fid.read()
+ fid.close()
+ base, ext = os.path.splitext(name)
+ makenewfile(base+'.orig', filestr)
+ return filestr
+
+def convertfile(filename):
+ """Convert the filename given from using Numeric to using NumPy
+
+ Copies the file to filename.orig and then over-writes the file
+ with the updated code
+ """
+ filestr = getandcopy(filename)
+ filestr = fromstr(filestr)
+ makenewfile(filename, filestr)
+
+def fromargs(args):
+ filename = args[1]
+ convertfile(filename)
+
+def convertall(direc=os.path.curdir):
+ """Convert all .py files to use NumPy (from Numeric) in the directory given
+
+ For each file, a backup of <usesnumeric>.py is made as
+ <usesnumeric>.py.orig. A new file named <usesnumeric>.py
+ is then written with the updated code.
+ """
+ files = glob.glob(os.path.join(direc,'*.py'))
+ for afile in files:
+ convertfile(afile)
+
+def _func(arg, dirname, fnames):
+ convertall(dirname)
+
+def converttree(direc=os.path.curdir):
+ """Convert all .py files in the tree given
+
+ """
+ os.path.walk(direc, _func, None)
+
+
+if __name__ == '__main__':
+ fromargs(sys.argv)
diff --git a/numpy/numarray/compat.py b/numpy/numarray/compat.py
new file mode 100644
index 000000000..e0d13a7c2
--- /dev/null
+++ b/numpy/numarray/compat.py
@@ -0,0 +1,4 @@
+
+__all__ = ['NewAxis', 'ArrayType']
+
+from numpy import newaxis as NewAxis, ndarray as ArrayType
diff --git a/numpy/numarray/convolve.py b/numpy/numarray/convolve.py
new file mode 100644
index 000000000..68a4730a1
--- /dev/null
+++ b/numpy/numarray/convolve.py
@@ -0,0 +1,14 @@
+try:
+ from stsci.convolve import *
+except ImportError:
+ try:
+ from scipy.stsci.convolve import *
+ except ImportError:
+ msg = \
+"""The convolve package is not installed.
+
+It can be downloaded by checking out the latest source from
+http://svn.scipy.org/svn/scipy/trunk/Lib/stsci or by downloading and
+installing all of SciPy from http://www.scipy.org.
+"""
+ raise ImportError(msg)
diff --git a/numpy/numarray/fft.py b/numpy/numarray/fft.py
new file mode 100644
index 000000000..c7ac6a27e
--- /dev/null
+++ b/numpy/numarray/fft.py
@@ -0,0 +1,7 @@
+
+from numpy.oldnumeric.fft import *
+import numpy.oldnumeric.fft as nof
+
+__all__ = nof.__all__
+
+del nof
diff --git a/numpy/numarray/functions.py b/numpy/numarray/functions.py
new file mode 100644
index 000000000..afb5ce875
--- /dev/null
+++ b/numpy/numarray/functions.py
@@ -0,0 +1,490 @@
+# missing Numarray defined names (in from numarray import *)
+##__all__ = ['ClassicUnpickler', 'Complex32_fromtype',
+## 'Complex64_fromtype', 'ComplexArray', 'Error',
+## 'MAX_ALIGN', 'MAX_INT_SIZE', 'MAX_LINE_WIDTH',
+## 'NDArray', 'NewArray', 'NumArray',
+## 'NumError', 'PRECISION', 'Py2NumType',
+## 'PyINT_TYPES', 'PyLevel2Type', 'PyNUMERIC_TYPES', 'PyREAL_TYPES',
+## 'SUPPRESS_SMALL',
+## 'SuitableBuffer', 'USING_BLAS',
+## 'UsesOpPriority',
+## 'codegenerator', 'generic', 'libnumarray', 'libnumeric',
+## 'make_ufuncs', 'memory',
+## 'numarrayall', 'numarraycore', 'numinclude', 'safethread',
+## 'typecode', 'typecodes', 'typeconv', 'ufunc', 'ufuncFactory',
+## 'ieeemask']
+
+__all__ = ['asarray', 'ones', 'zeros', 'array', 'where']
+__all__ += ['vdot', 'dot', 'matrixmultiply', 'ravel', 'indices',
+ 'arange', 'concatenate', 'all', 'allclose', 'alltrue', 'and_',
+ 'any', 'argmax', 'argmin', 'argsort', 'around', 'array_equal',
+ 'array_equiv', 'arrayrange', 'array_str', 'array_repr',
+ 'array2list', 'average', 'choose', 'CLIP', 'RAISE', 'WRAP',
+ 'clip', 'compress', 'concatenate', 'copy', 'copy_reg',
+ 'diagonal', 'divide_remainder', 'e', 'explicit_type', 'pi',
+ 'flush_caches', 'fromfile', 'os', 'sys', 'STRICT',
+ 'SLOPPY', 'WARN', 'EarlyEOFError', 'SizeMismatchError',
+ 'SizeMismatchWarning', 'FileSeekWarning', 'fromstring',
+ 'fromfunction', 'fromlist', 'getShape', 'getTypeObject',
+ 'identity', 'indices', 'info', 'innerproduct', 'inputarray',
+ 'isBigEndian', 'kroneckerproduct', 'lexsort', 'math',
+ 'operator', 'outerproduct', 'put', 'putmask', 'rank',
+ 'repeat', 'reshape', 'resize', 'round', 'searchsorted',
+ 'shape', 'size', 'sometrue', 'sort', 'swapaxes', 'take',
+ 'tcode', 'tname', 'tensormultiply', 'trace', 'transpose',
+ 'types', 'value', 'cumsum', 'cumproduct', 'nonzero', 'newobj',
+ 'togglebyteorder'
+ ]
+
+import copy, copy_reg, types
+import os, sys, math, operator
+
+from numpy import dot as matrixmultiply, dot, vdot, ravel, concatenate, all,\
+ allclose, any, around, argsort, array_equal, array_equiv,\
+ array_str, array_repr, CLIP, RAISE, WRAP, clip, concatenate, \
+ diagonal, e, pi, indices, inner as innerproduct, nonzero, \
+ outer as outerproduct, kron as kroneckerproduct, lexsort, putmask, rank, \
+ resize, searchsorted, shape, size, sort, swapaxes, trace, transpose
+import numpy as N
+
+from numerictypes import typefrom
+
+isBigEndian = sys.byteorder != 'little'
+value = tcode = 'f'
+tname = 'Float32'
+
+# If dtype is not None, then it is used
+# If type is not None, then it is used
+# If typecode is not None then it is used
+# If use_default is True, then the default
+# data-type is returned if all are None
+def type2dtype(typecode, type, dtype, use_default=True):
+ if dtype is None:
+ if type is None:
+ if use_default or typecode is not None:
+ dtype = N.dtype(typecode)
+ else:
+ dtype = N.dtype(type)
+ if use_default and dtype is None:
+ dtype = N.dtype('int')
+ return dtype
+
+def fromfunction(shape, dimensions, type=None, typecode=None, dtype=None):
+ dtype = type2dtype(typecode, type, dtype, 1)
+ return N.fromfunction(shape, dimensions, dtype=dtype)
+def ones(shape, type=None, typecode=None, dtype=None):
+ dtype = type2dtype(typecode, type, dtype, 1)
+ return N.ones(shape, dtype)
+
+def zeros(shape, type=None, typecode=None, dtype=None):
+ dtype = type2dtype(typecode, type, dtype, 1)
+ return N.zeros(shape, dtype)
+
+def where(condition, x=None, y=None, out=None):
+ if x is None and y is None:
+ arr = N.where(condition)
+ else:
+ arr = N.where(condition, x, y)
+ if out is not None:
+ out[...] = arr
+ return out
+ return arr
+
+def indices(shape, type=None):
+ return N.indices(shape, type)
+
+def arange(a1, a2=None, stride=1, type=None, shape=None,
+ typecode=None, dtype=None):
+ dtype = type2dtype(typecode, type, dtype, 0)
+ return N.arange(a1, a2, stride, dtype)
+
+arrayrange = arange
+
+def alltrue(x, axis=0):
+ return N.alltrue(x, axis)
+
+def and_(a, b):
+ """Same as a & b
+ """
+ return a & b
+
+def divide_remainder(a, b):
+ a, b = asarray(a), asarray(b)
+ return (a/b,a%b)
+
+def around(array, digits=0, output=None):
+ ret = N.around(array, digits, output)
+ if output is None:
+ return ret
+ return
+
+def array2list(arr):
+ return arr.tolist()
+
+
+def choose(selector, population, outarr=None, clipmode=RAISE):
+ a = N.asarray(selector)
+ ret = a.choose(population, out=outarr, mode=clipmode)
+ if outarr is None:
+ return ret
+ return
+
+def compress(condition, a, axis=0):
+ return N.compress(condition, a, axis)
+
+# only returns a view
+def explicit_type(a):
+ x = a.view()
+ return x
+
+# stub
+def flush_caches():
+ pass
+
+
+class EarlyEOFError(Exception):
+ "Raised in fromfile() if EOF unexpectedly occurs."
+ pass
+
+class SizeMismatchError(Exception):
+ "Raised in fromfile() if file size does not match shape."
+ pass
+
+class SizeMismatchWarning(Warning):
+ "Issued in fromfile() if file size does not match shape."
+ pass
+
+class FileSeekWarning(Warning):
+ "Issued in fromfile() if there is unused data and seek() fails"
+ pass
+
+
+STRICT, SLOPPY, WARN = range(3)
+
+_BLOCKSIZE=1024
+
+# taken and adapted directly from numarray
+def fromfile(infile, type=None, shape=None, sizing=STRICT,
+ typecode=None, dtype=None):
+ if isinstance(infile, (str, unicode)):
+ infile = open(infile, 'rb')
+ dtype = type2dtype(typecode, type, dtype, True)
+ if shape is None:
+ shape = (-1,)
+ if not isinstance(shape, tuple):
+ shape = (shape,)
+
+ if (list(shape).count(-1)>1):
+ raise ValueError("At most one unspecified dimension in shape")
+
+ if -1 not in shape:
+ if sizing != STRICT:
+ raise ValueError("sizing must be STRICT if size complete")
+ arr = N.empty(shape, dtype)
+ bytesleft=arr.nbytes
+ bytesread=0
+ while(bytesleft > _BLOCKSIZE):
+ data = infile.read(_BLOCKSIZE)
+ if len(data) != _BLOCKSIZE:
+ raise EarlyEOFError("Unexpected EOF reading data for size complete array")
+ arr.data[bytesread:bytesread+_BLOCKSIZE]=data
+ bytesread += _BLOCKSIZE
+ bytesleft -= _BLOCKSIZE
+ if bytesleft > 0:
+ data = infile.read(bytesleft)
+ if len(data) != bytesleft:
+ raise EarlyEOFError("Unexpected EOF reading data for size complete array")
+ arr.data[bytesread:bytesread+bytesleft]=data
+ return arr
+
+
+ ##shape is incompletely specified
+ ##read until EOF
+ ##implementation 1: naively use memory blocks
+ ##problematic because memory allocation can be double what is
+ ##necessary (!)
+
+ ##the most common case, namely reading in data from an unchanging
+ ##file whose size may be determined before allocation, should be
+ ##quick -- only one allocation will be needed.
+
+ recsize = dtype.itemsize * N.product([i for i in shape if i != -1])
+ blocksize = max(_BLOCKSIZE/recsize, 1)*recsize
+
+ ##try to estimate file size
+ try:
+ curpos=infile.tell()
+ infile.seek(0,2)
+ endpos=infile.tell()
+ infile.seek(curpos)
+ except (AttributeError, IOError):
+ initsize=blocksize
+ else:
+ initsize=max(1,(endpos-curpos)/recsize)*recsize
+
+ buf = N.newbuffer(initsize)
+
+ bytesread=0
+ while 1:
+ data=infile.read(blocksize)
+ if len(data) != blocksize: ##eof
+ break
+ ##do we have space?
+ if len(buf) < bytesread+blocksize:
+ buf=_resizebuf(buf,len(buf)+blocksize)
+ ## or rather a=resizebuf(a,2*len(a)) ?
+ assert len(buf) >= bytesread+blocksize
+ buf[bytesread:bytesread+blocksize]=data
+ bytesread += blocksize
+
+ if len(data) % recsize != 0:
+ if sizing == STRICT:
+ raise SizeMismatchError("Filesize does not match specified shape")
+ if sizing == WARN:
+ _warnings.warn("Filesize does not match specified shape",
+ SizeMismatchWarning)
+ try:
+ infile.seek(-(len(data) % recsize),1)
+ except AttributeError:
+ _warnings.warn("Could not rewind (no seek support)",
+ FileSeekWarning)
+ except IOError:
+ _warnings.warn("Could not rewind (IOError in seek)",
+ FileSeekWarning)
+ datasize = (len(data)/recsize) * recsize
+ if len(buf) != bytesread+datasize:
+ buf=_resizebuf(buf,bytesread+datasize)
+ buf[bytesread:bytesread+datasize]=data[:datasize]
+ ##deduce shape from len(buf)
+ shape = list(shape)
+ uidx = shape.index(-1)
+ shape[uidx]=len(buf) / recsize
+
+ a = N.ndarray(shape=shape, dtype=type, buffer=buf)
+ if a.dtype.char == '?':
+ N.not_equal(a, 0, a)
+ return a
+
+def fromstring(datastring, type=None, shape=None, typecode=None, dtype=None):
+ dtype = type2dtype(typecode, type, dtype, True)
+ if shape is None:
+ count = -1
+ else:
+ count = N.product(shape)
+ res = N.fromstring(datastring, dtype=dtype, count=count)
+ if shape is not None:
+ res.shape = shape
+ return res
+
+
+# check_overflow is ignored
+def fromlist(seq, type=None, shape=None, check_overflow=0, typecode=None, dtype=None):
+ dtype = type2dtype(typecode, type, dtype, False)
+ return N.array(seq, dtype)
+
+def array(sequence=None, typecode=None, copy=1, savespace=0,
+ type=None, shape=None, dtype=None):
+ dtype = type2dtype(typecode, type, dtype, 0)
+ if sequence is None:
+ if shape is None:
+ return None
+ if dtype is None:
+ dtype = 'l'
+ return N.empty(shape, dtype)
+ if isinstance(sequence, file):
+ return fromfile(sequence, dtype=dtype, shape=shape)
+ if isinstance(sequence, str):
+ return fromstring(sequence, dtype=dtype, shape=shape)
+ if isinstance(sequence, buffer):
+ arr = N.frombuffer(sequence, dtype=dtype)
+ else:
+ arr = N.array(sequence, dtype, copy=copy)
+ if shape is not None:
+ arr.shape = shape
+ return arr
+
+def asarray(seq, type=None, typecode=None, dtype=None):
+ if isinstance(seq, N.ndarray) and type is None and \
+ typecode is None and dtype is None:
+ return seq
+ return array(seq, type=type, typecode=typecode, copy=0, dtype=dtype)
+
+inputarray = asarray
+
+
+def getTypeObject(sequence, type):
+ if type is not None:
+ return type
+ try:
+ return typefrom(N.array(sequence))
+ except:
+ raise TypeError("Can't determine a reasonable type from sequence")
+
+def getShape(shape, *args):
+ try:
+ if shape is () and not args:
+ return ()
+ if len(args) > 0:
+ shape = (shape, ) + args
+ else:
+ shape = tuple(shape)
+ dummy = N.array(shape)
+ if not issubclass(dummy.dtype.type, N.integer):
+ raise TypeError
+ if len(dummy) > N.MAXDIMS:
+ raise TypeError
+ except:
+ raise TypeError("Shape must be a sequence of integers")
+ return shape
+
+
+def identity(n, type=None, typecode=None, dtype=None):
+ dtype = type2dtype(typecode, type, dtype, True)
+ return N.identity(n, dtype)
+
+def info(obj, output=sys.stdout, numpy=0):
+ if numpy:
+ bp = lambda x: x
+ else:
+ bp = lambda x: int(x)
+ cls = getattr(obj, '__class__', type(obj))
+ if numpy:
+ nm = getattr(cls, '__name__', cls)
+ else:
+ nm = cls
+ print >> output, "class: ", nm
+ print >> output, "shape: ", obj.shape
+ strides = obj.strides
+ print >> output, "strides: ", strides
+ if not numpy:
+ print >> output, "byteoffset: 0"
+ if len(strides) > 0:
+ bs = obj.strides[0]
+ else:
+ bs = obj.itemsize
+ print >> output, "bytestride: ", bs
+ print >> output, "itemsize: ", obj.itemsize
+ print >> output, "aligned: ", bp(obj.flags.aligned)
+ print >> output, "contiguous: ", bp(obj.flags.contiguous)
+ if numpy:
+ print >> output, "fortran: ", obj.flags.fortran
+ if not numpy:
+ print >> output, "buffer: ", repr(obj.data)
+ if not numpy:
+ extra = " (DEBUG ONLY)"
+ tic = "'"
+ else:
+ extra = ""
+ tic = ""
+ print >> output, "data pointer: %s%s" % (hex(obj.ctypes._as_parameter_), extra)
+ print >> output, "byteorder: ",
+ endian = obj.dtype.byteorder
+ if endian in ['|','=']:
+ print >> output, "%s%s%s" % (tic, sys.byteorder, tic)
+ byteswap = False
+ elif endian == '>':
+ print >> output, "%sbig%s" % (tic, tic)
+ byteswap = sys.byteorder != "big"
+ else:
+ print >> output, "%slittle%s" % (tic, tic)
+ byteswap = sys.byteorder != "little"
+ print >> output, "byteswap: ", bp(byteswap)
+ if not numpy:
+ print >> output, "type: ", typefrom(obj).name
+ else:
+ print >> output, "type: %s" % obj.dtype
+
+#clipmode is ignored if axis is not 0 and array is not 1d
+def put(array, indices, values, axis=0, clipmode=RAISE):
+ if not isinstance(array, N.ndarray):
+ raise TypeError("put only works on subclass of ndarray")
+ work = asarray(array)
+ if axis == 0:
+ if array.ndim == 1:
+ work.put(indices, values, clipmode)
+ else:
+ work[indices] = values
+ elif isinstance(axis, (int, long, N.integer)):
+ work = work.swapaxes(0, axis)
+ work[indices] = values
+ work = work.swapaxes(0, axis)
+ else:
+ def_axes = range(work.ndim)
+ for x in axis:
+ def_axes.remove(x)
+ axis = list(axis)+def_axes
+ work = work.transpose(axis)
+ work[indices] = values
+ work = work.transpose(axis)
+
+def repeat(array, repeats, axis=0):
+ return N.repeat(array, repeats, axis)
+
+
+def reshape(array, shape, *args):
+ if len(args) > 0:
+ shape = (shape,) + args
+ return N.reshape(array, shape)
+
+
+import warnings as _warnings
+def round(*args, **keys):
+ _warnings.warn("round() is deprecated. Switch to around()",
+ DeprecationWarning)
+ return around(*args, **keys)
+
+def sometrue(array, axis=0):
+ return N.sometrue(array, axis)
+
+#clipmode is ignored if axis is not an integer
+def take(array, indices, axis=0, outarr=None, clipmode=RAISE):
+ array = N.asarray(array)
+ if isinstance(axis, (int, long, N.integer)):
+ res = array.take(indices, axis, outarr, clipmode)
+ if outarr is None:
+ return res
+ return
+ else:
+ def_axes = range(array.ndim)
+ for x in axis:
+ def_axes.remove(x)
+ axis = list(axis) + def_axes
+ work = array.transpose(axis)
+ res = work[indices]
+ if outarr is None:
+ return res
+ out[...] = res
+ return
+
+def tensormultiply(a1, a2):
+ a1, a2 = N.asarray(a1), N.asarray(a2)
+ if (a1.shape[-1] != a2.shape[0]):
+ raise ValueError("Unmatched dimensions")
+ shape = a1.shape[:-1] + a2.shape[1:]
+ return N.reshape(dot(N.reshape(a1, (-1, a1.shape[-1])),
+ N.reshape(a2, (a2.shape[0],-1))),
+ shape)
+
+def cumsum(a1, axis=0, out=None, type=None, dim=0):
+ return N.asarray(a1).cumsum(axis,dtype=type,out=out)
+
+def cumproduct(a1, axis=0, out=None, type=None, dim=0):
+ return N.asarray(a1).cumprod(axis,dtype=type,out=out)
+
+def argmax(x, axis=-1):
+ return N.argmax(x, axis)
+
+def argmin(x, axis=-1):
+ return N.argmin(x, axis)
+
+def newobj(self, type):
+ if type is None:
+ return N.empty_like(self)
+ else:
+ return N.empty(self.shape, type)
+
+def togglebyteorder(self):
+ self.dtype=self.dtype.newbyteorder()
+
+def average(a, axis=0, weights=None, returned=0):
+ return N.average(a, axis, weights, returned)
diff --git a/numpy/numarray/image.py b/numpy/numarray/image.py
new file mode 100644
index 000000000..e24326f79
--- /dev/null
+++ b/numpy/numarray/image.py
@@ -0,0 +1,15 @@
+try:
+ from stsci.image import *
+except ImportError:
+ try:
+ from scipy.stsci.image import *
+ except ImportError:
+ msg = \
+"""The image package is not installed
+
+It can be downloaded by checking out the latest source from
+http://svn.scipy.org/svn/scipy/trunk/Lib/stsci or by downloading and
+installing all of SciPy from http://www.scipy.org.
+"""
+ raise ImportError(msg)
+
diff --git a/numpy/numarray/linear_algebra.py b/numpy/numarray/linear_algebra.py
new file mode 100644
index 000000000..238dff952
--- /dev/null
+++ b/numpy/numarray/linear_algebra.py
@@ -0,0 +1,15 @@
+
+from numpy.oldnumeric.linear_algebra import *
+
+import numpy.oldnumeric.linear_algebra as nol
+
+__all__ = list(nol.__all__)
+__all__ += ['qr_decomposition']
+
+from numpy.linalg import qr as _qr
+
+def qr_decomposition(a, mode='full'):
+ res = _qr(a, mode)
+ if mode == 'full':
+ return res
+ return (None, res)
diff --git a/numpy/numarray/ma.py b/numpy/numarray/ma.py
new file mode 100644
index 000000000..5c7a19cf2
--- /dev/null
+++ b/numpy/numarray/ma.py
@@ -0,0 +1,2 @@
+
+from numpy.oldnumeric.ma import *
diff --git a/numpy/numarray/matrix.py b/numpy/numarray/matrix.py
new file mode 100644
index 000000000..a39812e1f
--- /dev/null
+++ b/numpy/numarray/matrix.py
@@ -0,0 +1,8 @@
+
+__all__ = ['Matrix']
+
+from numpy import matrix as _matrix
+
+def Matrix(data, typecode=None, copy=1, savespace=0):
+ return _matrix(data, typecode, copy=copy)
+
diff --git a/numpy/numarray/mlab.py b/numpy/numarray/mlab.py
new file mode 100644
index 000000000..05f234d37
--- /dev/null
+++ b/numpy/numarray/mlab.py
@@ -0,0 +1,7 @@
+
+from numpy.oldnumeric.mlab import *
+import numpy.oldnumeric.mlab as nom
+
+__all__ = nom.__all__
+
+del nom
diff --git a/numpy/numarray/nd_image.py b/numpy/numarray/nd_image.py
new file mode 100644
index 000000000..dff7fa066
--- /dev/null
+++ b/numpy/numarray/nd_image.py
@@ -0,0 +1,14 @@
+try:
+ from ndimage import *
+except ImportError:
+ try:
+ from scipy.ndimage import *
+ except ImportError:
+ msg = \
+"""The nd_image package is not installed
+
+It can be downloaded by checking out the latest source from
+http://svn.scipy.org/svn/scipy/trunk/Lib/ndimage or by downloading and
+installing all of SciPy from http://www.scipy.org.
+"""
+ raise ImportError(msg)
diff --git a/numpy/numarray/numerictypes.py b/numpy/numarray/numerictypes.py
new file mode 100644
index 000000000..490ced970
--- /dev/null
+++ b/numpy/numarray/numerictypes.py
@@ -0,0 +1,551 @@
+"""numerictypes: Define the numeric type objects
+
+This module is designed so 'from numerictypes import *' is safe.
+Exported symbols include:
+
+ Dictionary with all registered number types (including aliases):
+ typeDict
+
+ Numeric type objects:
+ Bool
+ Int8 Int16 Int32 Int64
+ UInt8 UInt16 UInt32 UInt64
+ Float32 Double64
+ Complex32 Complex64
+
+ Numeric type classes:
+ NumericType
+ BooleanType
+ SignedType
+ UnsignedType
+ IntegralType
+ SignedIntegralType
+ UnsignedIntegralType
+ FloatingType
+ ComplexType
+
+$Id: numerictypes.py,v 1.55 2005/12/01 16:22:03 jaytmiller Exp $
+"""
+
+__all__ = ['NumericType','HasUInt64','typeDict','IsType',
+ 'BooleanType', 'SignedType', 'UnsignedType', 'IntegralType',
+ 'SignedIntegralType', 'UnsignedIntegralType', 'FloatingType',
+ 'ComplexType', 'AnyType', 'ObjectType', 'Any', 'Object',
+ 'Bool', 'Int8', 'Int16', 'Int32', 'Int64', 'Float32',
+ 'Float64', 'UInt8', 'UInt16', 'UInt32', 'UInt64',
+ 'Complex32', 'Complex64', 'Byte', 'Short', 'Int','Long',
+ 'Float', 'Complex', 'genericTypeRank', 'pythonTypeRank',
+ 'pythonTypeMap', 'scalarTypeMap', 'genericCoercions',
+ 'typecodes', 'genericPromotionExclusions','MaximumType',
+ 'getType','scalarTypes', 'typefrom']
+
+MAX_ALIGN = 8
+MAX_INT_SIZE = 8
+
+import numpy
+LP64 = numpy.intp(0).itemsize == 8
+
+HasUInt64 = 1
+try:
+ numpy.int64(0)
+except:
+ HasUInt64 = 0
+
+#from typeconv import typeConverters as _typeConverters
+#import numinclude
+#from _numerictype import _numerictype, typeDict
+import types as _types
+import copy as _copy
+import sys as _sys
+
+# Enumeration of numarray type codes
+typeDict = {}
+
+_tAny = 0
+_tBool = 1
+_tInt8 = 2
+_tUInt8 = 3
+_tInt16 = 4
+_tUInt16 = 5
+_tInt32 = 6
+_tUInt32 = 7
+_tInt64 = 8
+_tUInt64 = 9
+_tFloat32 = 10
+_tFloat64 = 11
+_tComplex32 = 12
+_tComplex64 = 13
+_tObject = 14
+
+def IsType(rep):
+ """Determines whether the given object or string, 'rep', represents
+ a numarray type."""
+ return isinstance(rep, NumericType) or typeDict.has_key(rep)
+
+def _register(name, type, force=0):
+ """Register the type object. Raise an exception if it is already registered
+ unless force is true.
+ """
+ if typeDict.has_key(name) and not force:
+ raise ValueError("Type %s has already been registered" % name)
+ typeDict[name] = type
+ return type
+
+
+class NumericType(object):
+ """Numeric type class
+
+ Used both as a type identification and the repository of
+ characteristics and conversion functions.
+ """
+ def __new__(type, name, bytes, default, typeno):
+ """__new__() implements a 'quasi-singleton pattern because attempts
+ to create duplicate types return the first created instance of that
+ particular type parameterization, i.e. the second time you try to
+ create "Int32", you get the original Int32, not a new one.
+ """
+ if typeDict.has_key(name):
+ self = typeDict[name]
+ if self.bytes != bytes or self.default != default or \
+ self.typeno != typeno:
+ raise ValueError("Redeclaration of existing NumericType "\
+ "with different parameters.")
+ return self
+ else:
+ self = object.__new__(type)
+ self.name = "no name"
+ self.bytes = None
+ self.default = None
+ self.typeno = -1
+ return self
+
+ def __init__(self, name, bytes, default, typeno):
+ if not isinstance(name, str):
+ raise TypeError("name must be a string")
+ self.name = name
+ self.bytes = bytes
+ self.default = default
+ self.typeno = typeno
+ self._conv = None
+ _register(self.name, self)
+
+ def __getnewargs__(self):
+ """support the pickling protocol."""
+ return (self.name, self.bytes, self.default, self.typeno)
+
+ def __getstate__(self):
+ """support pickling protocol... no __setstate__ required."""
+ False
+
+class BooleanType(NumericType):
+ pass
+
+class SignedType:
+ """Marker class used for signed type check"""
+ pass
+
+class UnsignedType:
+ """Marker class used for unsigned type check"""
+ pass
+
+class IntegralType(NumericType):
+ pass
+
+class SignedIntegralType(IntegralType, SignedType):
+ pass
+
+class UnsignedIntegralType(IntegralType, UnsignedType):
+ pass
+
+class FloatingType(NumericType):
+ pass
+
+class ComplexType(NumericType):
+ pass
+
+class AnyType(NumericType):
+ pass
+
+class ObjectType(NumericType):
+ pass
+
+# C-API Type Any
+
+Any = AnyType("Any", None, None, _tAny)
+
+Object = ObjectType("Object", None, None, _tObject)
+
+# Numeric Types:
+
+Bool = BooleanType("Bool", 1, 0, _tBool)
+Int8 = SignedIntegralType( "Int8", 1, 0, _tInt8)
+Int16 = SignedIntegralType("Int16", 2, 0, _tInt16)
+Int32 = SignedIntegralType("Int32", 4, 0, _tInt32)
+Int64 = SignedIntegralType("Int64", 8, 0, _tInt64)
+
+Float32 = FloatingType("Float32", 4, 0.0, _tFloat32)
+Float64 = FloatingType("Float64", 8, 0.0, _tFloat64)
+
+UInt8 = UnsignedIntegralType( "UInt8", 1, 0, _tUInt8)
+UInt16 = UnsignedIntegralType("UInt16", 2, 0, _tUInt16)
+UInt32 = UnsignedIntegralType("UInt32", 4, 0, _tUInt32)
+UInt64 = UnsignedIntegralType("UInt64", 8, 0, _tUInt64)
+
+Complex32 = ComplexType("Complex32", 8, complex(0.0), _tComplex32)
+Complex64 = ComplexType("Complex64", 16, complex(0.0), _tComplex64)
+
+Object.dtype = 'O'
+Bool.dtype = '?'
+Int8.dtype = 'i1'
+Int16.dtype = 'i2'
+Int32.dtype = 'i4'
+Int64.dtype = 'i8'
+
+UInt8.dtype = 'u1'
+UInt16.dtype = 'u2'
+UInt32.dtype = 'u4'
+UInt64.dtype = 'u8'
+
+Float32.dtype = 'f4'
+Float64.dtype = 'f8'
+
+Complex32.dtype = 'c8'
+Complex64.dtype = 'c16'
+
+# Aliases
+
+Byte = _register("Byte", Int8)
+Short = _register("Short", Int16)
+Int = _register("Int", Int32)
+if LP64:
+ Long = _register("Long", Int64)
+ if HasUInt64:
+ _register("ULong", UInt64)
+ MaybeLong = _register("MaybeLong", Int64)
+ __all__.append('MaybeLong')
+else:
+ Long = _register("Long", Int32)
+ _register("ULong", UInt32)
+ MaybeLong = _register("MaybeLong", Int32)
+ __all__.append('MaybeLong')
+
+
+_register("UByte", UInt8)
+_register("UShort", UInt16)
+_register("UInt", UInt32)
+Float = _register("Float", Float64)
+Complex = _register("Complex", Complex64)
+
+# short forms
+
+_register("b1", Bool)
+_register("u1", UInt8)
+_register("u2", UInt16)
+_register("u4", UInt32)
+_register("i1", Int8)
+_register("i2", Int16)
+_register("i4", Int32)
+
+_register("i8", Int64)
+if HasUInt64:
+ _register("u8", UInt64)
+
+_register("f4", Float32)
+_register("f8", Float64)
+_register("c8", Complex32)
+_register("c16", Complex64)
+
+# NumPy forms
+
+_register("1", Int8)
+_register("B", Bool)
+_register("c", Int8)
+_register("b", UInt8)
+_register("s", Int16)
+_register("w", UInt16)
+_register("i", Int32)
+_register("N", Int64)
+_register("u", UInt32)
+_register("U", UInt64)
+
+if LP64:
+ _register("l", Int64)
+else:
+ _register("l", Int32)
+
+_register("d", Float64)
+_register("f", Float32)
+_register("D", Complex64)
+_register("F", Complex32)
+
+# scipy.base forms
+
+def _scipy_alias(scipy_type, numarray_type):
+ _register(scipy_type, eval(numarray_type))
+ globals()[scipy_type] = globals()[numarray_type]
+
+_scipy_alias("bool_", "Bool")
+_scipy_alias("bool8", "Bool")
+_scipy_alias("int8", "Int8")
+_scipy_alias("uint8", "UInt8")
+_scipy_alias("int16", "Int16")
+_scipy_alias("uint16", "UInt16")
+_scipy_alias("int32", "Int32")
+_scipy_alias("uint32", "UInt32")
+_scipy_alias("int64", "Int64")
+_scipy_alias("uint64", "UInt64")
+
+_scipy_alias("float64", "Float64")
+_scipy_alias("float32", "Float32")
+_scipy_alias("complex128", "Complex64")
+_scipy_alias("complex64", "Complex32")
+
+# The rest is used by numeric modules to determine conversions
+
+# Ranking of types from lowest to highest (sorta)
+if not HasUInt64:
+ genericTypeRank = ['Bool','Int8','UInt8','Int16','UInt16',
+ 'Int32', 'UInt32', 'Int64',
+ 'Float32','Float64', 'Complex32', 'Complex64', 'Object']
+else:
+ genericTypeRank = ['Bool','Int8','UInt8','Int16','UInt16',
+ 'Int32', 'UInt32', 'Int64', 'UInt64',
+ 'Float32','Float64', 'Complex32', 'Complex64', 'Object']
+
+pythonTypeRank = [ bool, int, long, float, complex ]
+
+# The next line is not platform independent XXX Needs to be generalized
+if not LP64:
+ pythonTypeMap = {
+ int:("Int32","int"),
+ long:("Int64","int"),
+ float:("Float64","float"),
+ complex:("Complex64","complex")}
+
+ scalarTypeMap = {
+ int:"Int32",
+ long:"Int64",
+ float:"Float64",
+ complex:"Complex64"}
+else:
+ pythonTypeMap = {
+ int:("Int64","int"),
+ long:("Int64","int"),
+ float:("Float64","float"),
+ complex:("Complex64","complex")}
+
+ scalarTypeMap = {
+ int:"Int64",
+ long:"Int64",
+ float:"Float64",
+ complex:"Complex64"}
+
+pythonTypeMap.update({bool:("Bool","bool") })
+scalarTypeMap.update({bool:"Bool"})
+
+# Generate coercion matrix
+
+def _initGenericCoercions():
+ global genericCoercions
+ genericCoercions = {}
+
+ # vector with ...
+ for ntype1 in genericTypeRank:
+ nt1 = typeDict[ntype1]
+ rank1 = genericTypeRank.index(ntype1)
+ ntypesize1, inttype1, signedtype1 = nt1.bytes, \
+ isinstance(nt1, IntegralType), isinstance(nt1, SignedIntegralType)
+ for ntype2 in genericTypeRank:
+ # vector
+ nt2 = typeDict[ntype2]
+ ntypesize2, inttype2, signedtype2 = nt2.bytes, \
+ isinstance(nt2, IntegralType), isinstance(nt2, SignedIntegralType)
+ rank2 = genericTypeRank.index(ntype2)
+ if (signedtype1 != signedtype2) and inttype1 and inttype2:
+ # mixing of signed and unsigned ints is a special case
+ # If unsigned same size or larger, final size needs to be bigger
+ # if possible
+ if signedtype1:
+ if ntypesize2 >= ntypesize1:
+ size = min(2*ntypesize2, MAX_INT_SIZE)
+ else:
+ size = ntypesize1
+ else:
+ if ntypesize1 >= ntypesize2:
+ size = min(2*ntypesize1, MAX_INT_SIZE)
+ else:
+ size = ntypesize2
+ outtype = "Int"+str(8*size)
+ else:
+ if rank1 >= rank2:
+ outtype = ntype1
+ else:
+ outtype = ntype2
+ genericCoercions[(ntype1, ntype2)] = outtype
+
+ for ntype2 in pythonTypeRank:
+ # scalar
+ mapto, kind = pythonTypeMap[ntype2]
+ if ((inttype1 and kind=="int") or (not inttype1 and kind=="float")):
+ # both are of the same "kind" thus vector type dominates
+ outtype = ntype1
+ else:
+ rank2 = genericTypeRank.index(mapto)
+ if rank1 >= rank2:
+ outtype = ntype1
+ else:
+ outtype = mapto
+ genericCoercions[(ntype1, ntype2)] = outtype
+ genericCoercions[(ntype2, ntype1)] = outtype
+
+ # scalar-scalar
+ for ntype1 in pythonTypeRank:
+ maptype1 = scalarTypeMap[ntype1]
+ genericCoercions[(ntype1,)] = maptype1
+ for ntype2 in pythonTypeRank:
+ maptype2 = scalarTypeMap[ntype2]
+ genericCoercions[(ntype1, ntype2)] = genericCoercions[(maptype1, maptype2)]
+
+ # Special cases more easily dealt with outside of the loop
+ genericCoercions[("Complex32", "Float64")] = "Complex64"
+ genericCoercions[("Float64", "Complex32")] = "Complex64"
+ genericCoercions[("Complex32", "Int64")] = "Complex64"
+ genericCoercions[("Int64", "Complex32")] = "Complex64"
+ genericCoercions[("Complex32", "UInt64")] = "Complex64"
+ genericCoercions[("UInt64", "Complex32")] = "Complex64"
+
+ genericCoercions[("Int64","Float32")] = "Float64"
+ genericCoercions[("Float32", "Int64")] = "Float64"
+ genericCoercions[("UInt64","Float32")] = "Float64"
+ genericCoercions[("Float32", "UInt64")] = "Float64"
+
+ genericCoercions[(float, "Bool")] = "Float64"
+ genericCoercions[("Bool", float)] = "Float64"
+
+ genericCoercions[(float,float,float)] = "Float64" # for scipy.special
+ genericCoercions[(int,int,float)] = "Float64" # for scipy.special
+
+_initGenericCoercions()
+
+# If complex is subclassed, the following may not be necessary
+genericPromotionExclusions = {
+ 'Bool': (),
+ 'Int8': (),
+ 'Int16': (),
+ 'Int32': ('Float32','Complex32'),
+ 'UInt8': (),
+ 'UInt16': (),
+ 'UInt32': ('Float32','Complex32'),
+ 'Int64' : ('Float32','Complex32'),
+ 'UInt64' : ('Float32','Complex32'),
+ 'Float32': (),
+ 'Float64': ('Complex32',),
+ 'Complex32':(),
+ 'Complex64':()
+} # e.g., don't allow promotion from Float64 to Complex32 or Int64 to Float32
+
+# Numeric typecodes
+typecodes = {'Integer': '1silN',
+ 'UnsignedInteger': 'bBwuU',
+ 'Float': 'fd',
+ 'Character': 'c',
+ 'Complex': 'FD' }
+
+if HasUInt64:
+ _MaximumType = {
+ Bool : UInt64,
+
+ Int8 : Int64,
+ Int16 : Int64,
+ Int32 : Int64,
+ Int64 : Int64,
+
+ UInt8 : UInt64,
+ UInt16 : UInt64,
+ UInt32 : UInt64,
+ UInt8 : UInt64,
+
+ Float32 : Float64,
+ Float64 : Float64,
+
+ Complex32 : Complex64,
+ Complex64 : Complex64
+ }
+else:
+ _MaximumType = {
+ Bool : Int64,
+
+ Int8 : Int64,
+ Int16 : Int64,
+ Int32 : Int64,
+ Int64 : Int64,
+
+ UInt8 : Int64,
+ UInt16 : Int64,
+ UInt32 : Int64,
+ UInt8 : Int64,
+
+ Float32 : Float64,
+ Float64 : Float64,
+
+ Complex32 : Complex64,
+ Complex64 : Complex64
+ }
+
+def MaximumType(t):
+ """returns the type of highest precision of the same general kind as 't'"""
+ return _MaximumType[t]
+
+
+def getType(type):
+ """Return the numeric type object for type
+
+ type may be the name of a type object or the actual object
+ """
+ if isinstance(type, NumericType):
+ return type
+ try:
+ return typeDict[type]
+ except KeyError:
+ raise TypeError("Not a numeric type")
+
+scalarTypes = (bool,int,long,float,complex)
+
+_scipy_dtypechar = {
+ Int8 : 'b',
+ UInt8 : 'B',
+ Int16 : 'h',
+ UInt16 : 'H',
+ Int32 : 'i',
+ UInt32 : 'I',
+ Int64 : 'q',
+ UInt64 : 'Q',
+ Float32 : 'f',
+ Float64 : 'd',
+ Complex32 : 'F', # Note the switchup here:
+ Complex64 : 'D' # numarray.Complex32 == scipy.complex64, etc.
+ }
+
+_scipy_dtypechar_inverse = {}
+for key,value in _scipy_dtypechar.items():
+ _scipy_dtypechar_inverse[value] = key
+
+_val = numpy.int_(0).itemsize
+if _val == 8:
+ _scipy_dtypechar_inverse['l'] = Int64
+ _scipy_dtypechar_inverse['L'] = UInt64
+elif _val == 4:
+ _scipy_dtypechar_inverse['l'] = Int32
+ _scipy_dtypechar_inverse['L'] = UInt32
+
+del _val
+
+if LP64:
+ _scipy_dtypechar_inverse['p'] = Int64
+ _scipy_dtypechar_inverse['P'] = UInt64
+else:
+ _scipy_dtypechar_inverse['p'] = Int32
+ _scipy_dtypechar_inverse['P'] = UInt32
+
+def typefrom(obj):
+ return _scipy_dtypechar_inverse[obj.dtype.char]
diff --git a/numpy/numarray/numpy/arraybase.h b/numpy/numarray/numpy/arraybase.h
new file mode 100644
index 000000000..40d1394bf
--- /dev/null
+++ b/numpy/numarray/numpy/arraybase.h
@@ -0,0 +1,71 @@
+#if !defined(__arraybase_h)
+#define _arraybase_h 1
+
+#define SZ_BUF 79
+#define MAXDIM NPY_MAXDIMS
+#define MAXARGS 18
+
+typedef npy_intp maybelong;
+typedef npy_bool Bool;
+typedef npy_int8 Int8;
+typedef npy_uint8 UInt8;
+typedef npy_int16 Int16;
+typedef npy_uint16 UInt16;
+typedef npy_int32 Int32;
+typedef npy_uint32 UInt32;
+typedef npy_int64 Int64;
+typedef npy_int64 UInt64;
+typedef npy_float32 Float32;
+typedef npy_float64 Float64;
+
+typedef enum
+{
+ tAny=-1,
+ tBool=PyArray_BOOL,
+ tInt8=PyArray_INT8,
+ tUInt8=PyArray_UINT8,
+ tInt16=PyArray_INT16,
+ tUInt16=PyArray_UINT16,
+ tInt32=PyArray_INT32,
+ tUInt32=PyArray_UINT32,
+ tInt64=PyArray_INT64,
+ tUInt64=PyArray_UINT64,
+ tFloat32=PyArray_FLOAT32,
+ tFloat64=PyArray_FLOAT64,
+ tComplex32=PyArray_COMPLEX64,
+ tComplex64=PyArray_COMPLEX128,
+ tObject=PyArray_OBJECT, /* placeholder... does nothing */
+ tMaxType=PyArray_NTYPES,
+ tDefault = tFloat64,
+#if NPY_BITSOF_LONG == 64
+ tLong = tInt64,
+#else
+ tLong = tInt32,
+#endif
+} NumarrayType;
+
+#define nNumarrayType PyArray_NTYPES
+
+#define HAS_UINT64 1
+
+typedef enum
+{
+ NUM_LITTLE_ENDIAN=0,
+ NUM_BIG_ENDIAN = 1
+} NumarrayByteOrder;
+
+typedef struct { Float32 r, i; } Complex32;
+typedef struct { Float64 r, i; } Complex64;
+
+#define WRITABLE NPY_WRITEABLE
+#define CHECKOVERFLOW 0x800
+#define UPDATEDICT 0x1000
+#define FORTRAN_CONTIGUOUS NPY_FORTRAN
+#define IS_CARRAY (NPY_CONTIGUOUS | NPY_ALIGNED)
+
+#define PyArray(m) ((PyArrayObject *)(m))
+#define PyArray_ISFORTRAN_CONTIGUOUS(m) (((PyArray(m))->flags & FORTRAN_CONTIGUOUS) != 0)
+#define PyArray_ISWRITABLE PyArray_ISWRITEABLE
+
+
+#endif
diff --git a/numpy/numarray/numpy/cfunc.h b/numpy/numarray/numpy/cfunc.h
new file mode 100644
index 000000000..b581be08f
--- /dev/null
+++ b/numpy/numarray/numpy/cfunc.h
@@ -0,0 +1,78 @@
+#if !defined(__cfunc__)
+#define __cfunc__ 1
+
+typedef PyObject *(*CFUNCasPyValue)(void *);
+typedef int (*UFUNC)(long, long, long, void **, long*);
+/* typedef void (*CFUNC_2ARG)(long, void *, void *); */
+/* typedef void (*CFUNC_3ARG)(long, void *, void *, void *); */
+typedef int (*CFUNCfromPyValue)(PyObject *, void *);
+typedef int (*CFUNC_STRIDE_CONV_FUNC)(long, long, maybelong *,
+ void *, long, maybelong*, void *, long, maybelong *);
+
+typedef int (*CFUNC_STRIDED_FUNC)(PyObject *, long, PyArrayObject **,
+ char **data);
+
+#define MAXARRAYS 16
+
+typedef enum {
+ CFUNC_UFUNC,
+ CFUNC_STRIDING,
+ CFUNC_NSTRIDING,
+ CFUNC_AS_PY_VALUE,
+ CFUNC_FROM_PY_VALUE
+} eCfuncType;
+
+typedef struct {
+ char *name;
+ void *fptr; /* Pointer to "un-wrapped" c function */
+ eCfuncType type; /* UFUNC, STRIDING, AsPyValue, FromPyValue */
+ Bool chkself; /* CFUNC does own alignment/bounds checking */
+ Bool align; /* CFUNC requires aligned buffer pointers */
+ Int8 wantIn, wantOut; /* required input/output arg counts. */
+ Int8 sizes[MAXARRAYS]; /* array of align/itemsizes. */
+ Int8 iters[MAXARRAYS]; /* array of element counts. 0 --> niter. */
+} CfuncDescriptor;
+
+typedef struct {
+ PyObject_HEAD
+ CfuncDescriptor descr;
+} CfuncObject;
+
+#define SELF_CHECKED_CFUNC_DESCR(name, type) \
+ static CfuncDescriptor name##_descr = { #name, (void *) name, type, 1 }
+
+#define CHECK_ALIGN 1
+
+#define CFUNC_DESCR(name, type, align, iargs, oargs, s1, s2, s3, i1, i2, i3) \
+ static CfuncDescriptor name##_descr = \
+ { #name, (void *)name, type, 0, align, iargs, oargs, {s1, s2, s3}, {i1, i2, i3} }
+
+#define UFUNC_DESCR1(name, s1) \
+ CFUNC_DESCR(name, CFUNC_UFUNC, CHECK_ALIGN, 0, 1, s1, 0, 0, 0, 0, 0)
+
+#define UFUNC_DESCR2(name, s1, s2) \
+ CFUNC_DESCR(name, CFUNC_UFUNC, CHECK_ALIGN, 1, 1, s1, s2, 0, 0, 0, 0)
+
+#define UFUNC_DESCR3(name, s1, s2, s3) \
+ CFUNC_DESCR(name, CFUNC_UFUNC, CHECK_ALIGN, 2, 1, s1, s2, s3, 0, 0, 0)
+
+#define UFUNC_DESCR3sv(name, s1, s2, s3) \
+ CFUNC_DESCR(name, CFUNC_UFUNC, CHECK_ALIGN, 2, 1, s1, s2, s3, 1, 0, 0)
+
+#define UFUNC_DESCR3vs(name, s1, s2, s3) \
+ CFUNC_DESCR(name, CFUNC_UFUNC, CHECK_ALIGN, 2, 1, s1, s2, s3, 0, 1, 0)
+
+#define STRIDING_DESCR2(name, align, s1, s2) \
+ CFUNC_DESCR(name, CFUNC_STRIDING, align, 1, 1, s1, s2, 0, 0, 0, 0)
+
+#define NSTRIDING_DESCR1(name) \
+ CFUNC_DESCR(name, CFUNC_NSTRIDING, 0, 0, 1, 0, 0, 0, 0, 0, 0)
+
+#define NSTRIDING_DESCR2(name) \
+ CFUNC_DESCR(name, CFUNC_NSTRIDING, 0, 1, 1, 0, 0, 0, 0, 0, 0)
+
+#define NSTRIDING_DESCR3(name) \
+ CFUNC_DESCR(name, CFUNC_NSTRIDING, 0, 2, 1, 0, 0, 0, 0, 0, 0)
+
+#endif
+
diff --git a/numpy/numarray/numpy/ieeespecial.h b/numpy/numarray/numpy/ieeespecial.h
new file mode 100644
index 000000000..0f3fff2a9
--- /dev/null
+++ b/numpy/numarray/numpy/ieeespecial.h
@@ -0,0 +1,124 @@
+/* 32-bit special value ranges */
+
+#if defined(_MSC_VER)
+#define MKINT(x) (x##UL)
+#define MKINT64(x) (x##Ui64)
+#define BIT(x) (1Ui64 << (x))
+#else
+#define MKINT(x) (x##U)
+#define MKINT64(x) (x##ULL)
+#define BIT(x) (1ULL << (x))
+#endif
+
+
+#define NEG_QUIET_NAN_MIN32 MKINT(0xFFC00001)
+#define NEG_QUIET_NAN_MAX32 MKINT(0xFFFFFFFF)
+
+#define INDETERMINATE_MIN32 MKINT(0xFFC00000)
+#define INDETERMINATE_MAX32 MKINT(0xFFC00000)
+
+#define NEG_SIGNAL_NAN_MIN32 MKINT(0xFF800001)
+#define NEG_SIGNAL_NAN_MAX32 MKINT(0xFFBFFFFF)
+
+#define NEG_INFINITY_MIN32 MKINT(0xFF800000)
+
+#define NEG_NORMALIZED_MIN32 MKINT(0x80800000)
+#define NEG_NORMALIZED_MAX32 MKINT(0xFF7FFFFF)
+
+#define NEG_DENORMALIZED_MIN32 MKINT(0x80000001)
+#define NEG_DENORMALIZED_MAX32 MKINT(0x807FFFFF)
+
+#define NEG_ZERO_MIN32 MKINT(0x80000000)
+#define NEG_ZERO_MAX32 MKINT(0x80000000)
+
+#define POS_ZERO_MIN32 MKINT(0x00000000)
+#define POS_ZERO_MAX32 MKINT(0x00000000)
+
+#define POS_DENORMALIZED_MIN32 MKINT(0x00000001)
+#define POS_DENORMALIZED_MAX32 MKINT(0x007FFFFF)
+
+#define POS_NORMALIZED_MIN32 MKINT(0x00800000)
+#define POS_NORMALIZED_MAX32 MKINT(0x7F7FFFFF)
+
+#define POS_INFINITY_MIN32 MKINT(0x7F800000)
+#define POS_INFINITY_MAX32 MKINT(0x7F800000)
+
+#define POS_SIGNAL_NAN_MIN32 MKINT(0x7F800001)
+#define POS_SIGNAL_NAN_MAX32 MKINT(0x7FBFFFFF)
+
+#define POS_QUIET_NAN_MIN32 MKINT(0x7FC00000)
+#define POS_QUIET_NAN_MAX32 MKINT(0x7FFFFFFF)
+
+/* 64-bit special value ranges */
+
+#define NEG_QUIET_NAN_MIN64 MKINT64(0xFFF8000000000001)
+#define NEG_QUIET_NAN_MAX64 MKINT64(0xFFFFFFFFFFFFFFFF)
+
+#define INDETERMINATE_MIN64 MKINT64(0xFFF8000000000000)
+#define INDETERMINATE_MAX64 MKINT64(0xFFF8000000000000)
+
+#define NEG_SIGNAL_NAN_MIN64 MKINT64(0xFFF7FFFFFFFFFFFF)
+#define NEG_SIGNAL_NAN_MAX64 MKINT64(0xFFF0000000000001)
+
+#define NEG_INFINITY_MIN64 MKINT64(0xFFF0000000000000)
+
+#define NEG_NORMALIZED_MIN64 MKINT64(0xFFEFFFFFFFFFFFFF)
+#define NEG_NORMALIZED_MAX64 MKINT64(0x8010000000000000)
+
+#define NEG_DENORMALIZED_MIN64 MKINT64(0x800FFFFFFFFFFFFF)
+#define NEG_DENORMALIZED_MAX64 MKINT64(0x8000000000000001)
+
+#define NEG_ZERO_MIN64 MKINT64(0x8000000000000000)
+#define NEG_ZERO_MAX64 MKINT64(0x8000000000000000)
+
+#define POS_ZERO_MIN64 MKINT64(0x0000000000000000)
+#define POS_ZERO_MAX64 MKINT64(0x0000000000000000)
+
+#define POS_DENORMALIZED_MIN64 MKINT64(0x0000000000000001)
+#define POS_DENORMALIZED_MAX64 MKINT64(0x000FFFFFFFFFFFFF)
+
+#define POS_NORMALIZED_MIN64 MKINT64(0x0010000000000000)
+#define POS_NORMALIZED_MAX64 MKINT64(0x7FEFFFFFFFFFFFFF)
+
+#define POS_INFINITY_MIN64 MKINT64(0x7FF0000000000000)
+#define POS_INFINITY_MAX64 MKINT64(0x7FF0000000000000)
+
+#define POS_SIGNAL_NAN_MIN64 MKINT64(0x7FF0000000000001)
+#define POS_SIGNAL_NAN_MAX64 MKINT64(0x7FF7FFFFFFFFFFFF)
+
+#define POS_QUIET_NAN_MIN64 MKINT64(0x7FF8000000000000)
+#define POS_QUIET_NAN_MAX64 MKINT64(0x7FFFFFFFFFFFFFFF)
+
+typedef enum
+{
+ POS_QNAN_BIT,
+ NEG_QNAN_BIT,
+ POS_SNAN_BIT,
+ NEG_SNAN_BIT,
+ POS_INF_BIT,
+ NEG_INF_BIT,
+ POS_DEN_BIT,
+ NEG_DEN_BIT,
+ POS_NOR_BIT,
+ NEG_NOR_BIT,
+ POS_ZERO_BIT,
+ NEG_ZERO_BIT,
+ INDETERM_BIT,
+ BUG_BIT
+} ieee_selects;
+
+#define MSK_POS_QNAN BIT(POS_QNAN_BIT)
+#define MSK_POS_SNAN BIT(POS_SNAN_BIT)
+#define MSK_POS_INF BIT(POS_INF_BIT)
+#define MSK_POS_DEN BIT(POS_DEN_BIT)
+#define MSK_POS_NOR BIT(POS_NOR_BIT)
+#define MSK_POS_ZERO BIT(POS_ZERO_BIT)
+#define MSK_NEG_QNAN BIT(NEG_QNAN_BIT)
+#define MSK_NEG_SNAN BIT(NEG_SNAN_BIT)
+#define MSK_NEG_INF BIT(NEG_INF_BIT)
+#define MSK_NEG_DEN BIT(NEG_DEN_BIT)
+#define MSK_NEG_NOR BIT(NEG_NOR_BIT)
+#define MSK_NEG_ZERO BIT(NEG_ZERO_BIT)
+#define MSK_INDETERM BIT(INDETERM_BIT)
+#define MSK_BUG BIT(BUG_BIT)
+
diff --git a/numpy/numarray/numpy/libnumarray.h b/numpy/numarray/numpy/libnumarray.h
new file mode 100644
index 000000000..f23a07d7a
--- /dev/null
+++ b/numpy/numarray/numpy/libnumarray.h
@@ -0,0 +1,611 @@
+/* Compatibility with numarray. Do not use in new code.
+ */
+
+#ifndef NUMPY_LIBNUMARRAY_H
+#define NUMPY_LIBNUMARRAY_H
+
+#include "numpy/arrayobject.h"
+#include "arraybase.h"
+#include "nummacro.h"
+#include "numcomplex.h"
+#include "ieeespecial.h"
+#include "cfunc.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* Header file for libnumarray */
+
+#if !defined(_libnumarray_MODULE)
+
+/*
+Extensions constructed from seperate compilation units can access the
+C-API defined here by defining "libnumarray_UNIQUE_SYMBOL" to a global
+name unique to the extension. Doing this circumvents the requirement
+to import libnumarray into each compilation unit, but is nevertheless
+mildly discouraged as "outside the Python norm" and potentially
+leading to problems. Looking around at "existing Python art", most
+extension modules are monolithic C files, and likely for good reason.
+*/
+
+/* C API address pointer */
+#if defined(NO_IMPORT) || defined(NO_IMPORT_ARRAY)
+extern void **libnumarray_API;
+#else
+#if defined(libnumarray_UNIQUE_SYMBOL)
+void **libnumarray_API;
+#else
+static void **libnumarray_API;
+#endif
+#endif
+
+#define _import_libnumarray() \
+ { \
+ PyObject *module = PyImport_ImportModule("numpy.numarray._capi"); \
+ if (module != NULL) { \
+ PyObject *module_dict = PyModule_GetDict(module); \
+ PyObject *c_api_object = \
+ PyDict_GetItemString(module_dict, "_C_API"); \
+ if (c_api_object && PyCObject_Check(c_api_object)) { \
+ libnumarray_API = (void **)PyCObject_AsVoidPtr(c_api_object); \
+ } else { \
+ PyErr_Format(PyExc_ImportError, \
+ "Can't get API for module 'numpy.numarray._capi'"); \
+ } \
+ } \
+ }
+
+#define import_libnumarray() _import_libnumarray(); if (PyErr_Occurred()) { PyErr_Print(); PyErr_SetString(PyExc_ImportError, "numpy.numarray._capi failed to import.\n"); return; }
+
+#endif
+
+
+#define libnumarray_FatalApiError (Py_FatalError("Call to API function without first calling import_libnumarray() in " __FILE__), NULL)
+
+
+/* Macros defining components of function prototypes */
+
+#ifdef _libnumarray_MODULE
+ /* This section is used when compiling libnumarray */
+
+static PyObject *_Error;
+
+static PyObject* getBuffer (PyObject*o);
+
+static int isBuffer (PyObject*o);
+
+static int getWriteBufferDataPtr (PyObject*o,void**p);
+
+static int isBufferWriteable (PyObject*o);
+
+static int getReadBufferDataPtr (PyObject*o,void**p);
+
+static int getBufferSize (PyObject*o);
+
+static double num_log (double x);
+
+static double num_log10 (double x);
+
+static double num_pow (double x, double y);
+
+static double num_acosh (double x);
+
+static double num_asinh (double x);
+
+static double num_atanh (double x);
+
+static double num_round (double x);
+
+static int int_dividebyzero_error (long value, long unused);
+
+static int int_overflow_error (Float64 value);
+
+static int umult64_overflow (UInt64 a, UInt64 b);
+
+static int smult64_overflow (Int64 a0, Int64 b0);
+
+static void NA_Done (void);
+
+static PyArrayObject* NA_NewAll (int ndim, maybelong* shape, NumarrayType type, void* buffer, maybelong byteoffset, maybelong bytestride, int byteorder, int aligned, int writeable);
+
+static PyArrayObject* NA_NewAllStrides (int ndim, maybelong* shape, maybelong* strides, NumarrayType type, void* buffer, maybelong byteoffset, int byteorder, int aligned, int writeable);
+
+static PyArrayObject* NA_New (void* buffer, NumarrayType type, int ndim,...);
+
+static PyArrayObject* NA_Empty (int ndim, maybelong* shape, NumarrayType type);
+
+static PyArrayObject* NA_NewArray (void* buffer, NumarrayType type, int ndim, ...);
+
+static PyArrayObject* NA_vNewArray (void* buffer, NumarrayType type, int ndim, maybelong *shape);
+
+static PyObject* NA_ReturnOutput (PyObject*,PyArrayObject*);
+
+static long NA_getBufferPtrAndSize (PyObject*,int,void**);
+
+static int NA_checkIo (char*,int,int,int,int);
+
+static int NA_checkOneCBuffer (char*,long,void*,long,size_t);
+
+static int NA_checkNCBuffers (char*,int,long,void**,long*,Int8*,Int8*);
+
+static int NA_checkOneStriding (char*,long,maybelong*,long,maybelong*,long,long,int);
+
+static PyObject* NA_new_cfunc (CfuncDescriptor*);
+
+static int NA_add_cfunc (PyObject*,char*,CfuncDescriptor*);
+
+static PyArrayObject* NA_InputArray (PyObject*,NumarrayType,int);
+
+static PyArrayObject* NA_OutputArray (PyObject*,NumarrayType,int);
+
+static PyArrayObject* NA_IoArray (PyObject*,NumarrayType,int);
+
+static PyArrayObject* NA_OptionalOutputArray (PyObject*,NumarrayType,int,PyArrayObject*);
+
+static long NA_get_offset (PyArrayObject*,int,...);
+
+static Float64 NA_get_Float64 (PyArrayObject*,long);
+
+static void NA_set_Float64 (PyArrayObject*,long,Float64);
+
+static Complex64 NA_get_Complex64 (PyArrayObject*,long);
+
+static void NA_set_Complex64 (PyArrayObject*,long,Complex64);
+
+static Int64 NA_get_Int64 (PyArrayObject*,long);
+
+static void NA_set_Int64 (PyArrayObject*,long,Int64);
+
+static Float64 NA_get1_Float64 (PyArrayObject*,long);
+
+static Float64 NA_get2_Float64 (PyArrayObject*,long,long);
+
+static Float64 NA_get3_Float64 (PyArrayObject*,long,long,long);
+
+static void NA_set1_Float64 (PyArrayObject*,long,Float64);
+
+static void NA_set2_Float64 (PyArrayObject*,long,long,Float64);
+
+static void NA_set3_Float64 (PyArrayObject*,long,long,long,Float64);
+
+static Complex64 NA_get1_Complex64 (PyArrayObject*,long);
+
+static Complex64 NA_get2_Complex64 (PyArrayObject*,long,long);
+
+static Complex64 NA_get3_Complex64 (PyArrayObject*,long,long,long);
+
+static void NA_set1_Complex64 (PyArrayObject*,long,Complex64);
+
+static void NA_set2_Complex64 (PyArrayObject*,long,long,Complex64);
+
+static void NA_set3_Complex64 (PyArrayObject*,long,long,long,Complex64);
+
+static Int64 NA_get1_Int64 (PyArrayObject*,long);
+
+static Int64 NA_get2_Int64 (PyArrayObject*,long,long);
+
+static Int64 NA_get3_Int64 (PyArrayObject*,long,long,long);
+
+static void NA_set1_Int64 (PyArrayObject*,long,Int64);
+
+static void NA_set2_Int64 (PyArrayObject*,long,long,Int64);
+
+static void NA_set3_Int64 (PyArrayObject*,long,long,long,Int64);
+
+static int NA_get1D_Float64 (PyArrayObject*,long,int,Float64*);
+
+static int NA_set1D_Float64 (PyArrayObject*,long,int,Float64*);
+
+static int NA_get1D_Int64 (PyArrayObject*,long,int,Int64*);
+
+static int NA_set1D_Int64 (PyArrayObject*,long,int,Int64*);
+
+static int NA_get1D_Complex64 (PyArrayObject*,long,int,Complex64*);
+
+static int NA_set1D_Complex64 (PyArrayObject*,long,int,Complex64*);
+
+static int NA_ShapeEqual (PyArrayObject*,PyArrayObject*);
+
+static int NA_ShapeLessThan (PyArrayObject*,PyArrayObject*);
+
+static int NA_ByteOrder (void);
+
+static Bool NA_IeeeSpecial32 (Float32*,Int32*);
+
+static Bool NA_IeeeSpecial64 (Float64*,Int32*);
+
+static PyArrayObject* NA_updateDataPtr (PyArrayObject*);
+
+static char* NA_typeNoToName (int);
+
+static int NA_nameToTypeNo (char*);
+
+static PyObject* NA_typeNoToTypeObject (int);
+
+static PyObject* NA_intTupleFromMaybeLongs (int,maybelong*);
+
+static long NA_maybeLongsFromIntTuple (int,maybelong*,PyObject*);
+
+static int NA_intTupleProduct (PyObject *obj, long *product);
+
+static long NA_isIntegerSequence (PyObject*);
+
+static PyObject* NA_setArrayFromSequence (PyArrayObject*,PyObject*);
+
+static int NA_maxType (PyObject*);
+
+static int NA_isPythonScalar (PyObject *obj);
+
+static PyObject* NA_getPythonScalar (PyArrayObject*,long);
+
+static int NA_setFromPythonScalar (PyArrayObject*,long,PyObject*);
+
+static int NA_NDArrayCheck (PyObject*);
+
+static int NA_NumArrayCheck (PyObject*);
+
+static int NA_ComplexArrayCheck (PyObject*);
+
+static unsigned long NA_elements (PyArrayObject*);
+
+static int NA_typeObjectToTypeNo (PyObject*);
+
+static int NA_copyArray (PyArrayObject* to, const PyArrayObject* from);
+
+static PyArrayObject* NA_copy (PyArrayObject*);
+
+static PyObject* NA_getType (PyObject *typeobj_or_name);
+
+static PyObject * NA_callCUFuncCore (PyObject *cfunc, long niter, long ninargs, long noutargs, PyObject **BufferObj, long *offset);
+
+static PyObject * NA_callStrideConvCFuncCore (PyObject *cfunc, int nshape, maybelong *shape, PyObject *inbuffObj, long inboffset, int nstrides0, maybelong *inbstrides, PyObject *outbuffObj, long outboffset, int nstrides1, maybelong *outbstrides, long nbytes);
+
+static void NA_stridesFromShape (int nshape, maybelong *shape, maybelong bytestride, maybelong *strides);
+
+static int NA_OperatorCheck (PyObject *obj);
+
+static int NA_ConverterCheck (PyObject *obj);
+
+static int NA_UfuncCheck (PyObject *obj);
+
+static int NA_CfuncCheck (PyObject *obj);
+
+static int NA_getByteOffset (PyArrayObject *array, int nindices, maybelong *indices, long *offset);
+
+static int NA_swapAxes (PyArrayObject *array, int x, int y);
+
+static PyObject * NA_initModuleGlobal (char *module, char *global);
+
+static NumarrayType NA_NumarrayType (PyObject *seq);
+
+static PyArrayObject * NA_NewAllFromBuffer (int ndim, maybelong *shape, NumarrayType type, PyObject *bufferObject, maybelong byteoffset, maybelong bytestride, int byteorder, int aligned, int writeable);
+
+static Float64 * NA_alloc1D_Float64 (PyArrayObject *a, long offset, int cnt);
+
+static Int64 * NA_alloc1D_Int64 (PyArrayObject *a, long offset, int cnt);
+
+static void NA_updateAlignment (PyArrayObject *self);
+
+static void NA_updateContiguous (PyArrayObject *self);
+
+static void NA_updateStatus (PyArrayObject *self);
+
+static int NA_NumArrayCheckExact (PyObject *op);
+
+static int NA_NDArrayCheckExact (PyObject *op);
+
+static int NA_OperatorCheckExact (PyObject *op);
+
+static int NA_ConverterCheckExact (PyObject *op);
+
+static int NA_UfuncCheckExact (PyObject *op);
+
+static int NA_CfuncCheckExact (PyObject *op);
+
+static char * NA_getArrayData (PyArrayObject *ap);
+
+static void NA_updateByteswap (PyArrayObject *ap);
+
+static PyArray_Descr * NA_DescrFromType (int type);
+
+static PyObject * NA_Cast (PyArrayObject *a, int type);
+
+static int NA_checkFPErrors (void);
+
+static void NA_clearFPErrors (void);
+
+static int NA_checkAndReportFPErrors (char *name);
+
+static Bool NA_IeeeMask32 (Float32,Int32);
+
+static Bool NA_IeeeMask64 (Float64,Int32);
+
+static int _NA_callStridingHelper (PyObject *aux, long dim, long nnumarray, PyArrayObject *numarray[], char *data[], CFUNC_STRIDED_FUNC f);
+
+static PyArrayObject * NA_FromDimsStridesDescrAndData (int nd, maybelong *dims, maybelong *strides, PyArray_Descr *descr, char *data);
+
+static PyArrayObject * NA_FromDimsTypeAndData (int nd, maybelong *dims, int type, char *data);
+
+static PyArrayObject * NA_FromDimsStridesTypeAndData (int nd, maybelong *dims, maybelong *strides, int type, char *data);
+
+static int NA_scipy_typestr (NumarrayType t, int byteorder, char *typestr);
+
+static PyArrayObject * NA_FromArrayStruct (PyObject *a);
+
+
+#else
+ /* This section is used in modules that use libnumarray */
+
+#define getBuffer (libnumarray_API ? (*(PyObject* (*) (PyObject*o) ) libnumarray_API[ 0 ]) : (*(PyObject* (*) (PyObject*o) ) libnumarray_FatalApiError))
+
+#define isBuffer (libnumarray_API ? (*(int (*) (PyObject*o) ) libnumarray_API[ 1 ]) : (*(int (*) (PyObject*o) ) libnumarray_FatalApiError))
+
+#define getWriteBufferDataPtr (libnumarray_API ? (*(int (*) (PyObject*o,void**p) ) libnumarray_API[ 2 ]) : (*(int (*) (PyObject*o,void**p) ) libnumarray_FatalApiError))
+
+#define isBufferWriteable (libnumarray_API ? (*(int (*) (PyObject*o) ) libnumarray_API[ 3 ]) : (*(int (*) (PyObject*o) ) libnumarray_FatalApiError))
+
+#define getReadBufferDataPtr (libnumarray_API ? (*(int (*) (PyObject*o,void**p) ) libnumarray_API[ 4 ]) : (*(int (*) (PyObject*o,void**p) ) libnumarray_FatalApiError))
+
+#define getBufferSize (libnumarray_API ? (*(int (*) (PyObject*o) ) libnumarray_API[ 5 ]) : (*(int (*) (PyObject*o) ) libnumarray_FatalApiError))
+
+#define num_log (libnumarray_API ? (*(double (*) (double x) ) libnumarray_API[ 6 ]) : (*(double (*) (double x) ) libnumarray_FatalApiError))
+
+#define num_log10 (libnumarray_API ? (*(double (*) (double x) ) libnumarray_API[ 7 ]) : (*(double (*) (double x) ) libnumarray_FatalApiError))
+
+#define num_pow (libnumarray_API ? (*(double (*) (double x, double y) ) libnumarray_API[ 8 ]) : (*(double (*) (double x, double y) ) libnumarray_FatalApiError))
+
+#define num_acosh (libnumarray_API ? (*(double (*) (double x) ) libnumarray_API[ 9 ]) : (*(double (*) (double x) ) libnumarray_FatalApiError))
+
+#define num_asinh (libnumarray_API ? (*(double (*) (double x) ) libnumarray_API[ 10 ]) : (*(double (*) (double x) ) libnumarray_FatalApiError))
+
+#define num_atanh (libnumarray_API ? (*(double (*) (double x) ) libnumarray_API[ 11 ]) : (*(double (*) (double x) ) libnumarray_FatalApiError))
+
+#define num_round (libnumarray_API ? (*(double (*) (double x) ) libnumarray_API[ 12 ]) : (*(double (*) (double x) ) libnumarray_FatalApiError))
+
+#define int_dividebyzero_error (libnumarray_API ? (*(int (*) (long value, long unused) ) libnumarray_API[ 13 ]) : (*(int (*) (long value, long unused) ) libnumarray_FatalApiError))
+
+#define int_overflow_error (libnumarray_API ? (*(int (*) (Float64 value) ) libnumarray_API[ 14 ]) : (*(int (*) (Float64 value) ) libnumarray_FatalApiError))
+
+#define umult64_overflow (libnumarray_API ? (*(int (*) (UInt64 a, UInt64 b) ) libnumarray_API[ 15 ]) : (*(int (*) (UInt64 a, UInt64 b) ) libnumarray_FatalApiError))
+
+#define smult64_overflow (libnumarray_API ? (*(int (*) (Int64 a0, Int64 b0) ) libnumarray_API[ 16 ]) : (*(int (*) (Int64 a0, Int64 b0) ) libnumarray_FatalApiError))
+
+#define NA_Done (libnumarray_API ? (*(void (*) (void) ) libnumarray_API[ 17 ]) : (*(void (*) (void) ) libnumarray_FatalApiError))
+
+#define NA_NewAll (libnumarray_API ? (*(PyArrayObject* (*) (int ndim, maybelong* shape, NumarrayType type, void* buffer, maybelong byteoffset, maybelong bytestride, int byteorder, int aligned, int writeable) ) libnumarray_API[ 18 ]) : (*(PyArrayObject* (*) (int ndim, maybelong* shape, NumarrayType type, void* buffer, maybelong byteoffset, maybelong bytestride, int byteorder, int aligned, int writeable) ) libnumarray_FatalApiError))
+
+#define NA_NewAllStrides (libnumarray_API ? (*(PyArrayObject* (*) (int ndim, maybelong* shape, maybelong* strides, NumarrayType type, void* buffer, maybelong byteoffset, int byteorder, int aligned, int writeable) ) libnumarray_API[ 19 ]) : (*(PyArrayObject* (*) (int ndim, maybelong* shape, maybelong* strides, NumarrayType type, void* buffer, maybelong byteoffset, int byteorder, int aligned, int writeable) ) libnumarray_FatalApiError))
+
+#define NA_New (libnumarray_API ? (*(PyArrayObject* (*) (void* buffer, NumarrayType type, int ndim,...) ) libnumarray_API[ 20 ]) : (*(PyArrayObject* (*) (void* buffer, NumarrayType type, int ndim,...) ) libnumarray_FatalApiError))
+
+#define NA_Empty (libnumarray_API ? (*(PyArrayObject* (*) (int ndim, maybelong* shape, NumarrayType type) ) libnumarray_API[ 21 ]) : (*(PyArrayObject* (*) (int ndim, maybelong* shape, NumarrayType type) ) libnumarray_FatalApiError))
+
+#define NA_NewArray (libnumarray_API ? (*(PyArrayObject* (*) (void* buffer, NumarrayType type, int ndim, ...) ) libnumarray_API[ 22 ]) : (*(PyArrayObject* (*) (void* buffer, NumarrayType type, int ndim, ...) ) libnumarray_FatalApiError))
+
+#define NA_vNewArray (libnumarray_API ? (*(PyArrayObject* (*) (void* buffer, NumarrayType type, int ndim, maybelong *shape) ) libnumarray_API[ 23 ]) : (*(PyArrayObject* (*) (void* buffer, NumarrayType type, int ndim, maybelong *shape) ) libnumarray_FatalApiError))
+
+#define NA_ReturnOutput (libnumarray_API ? (*(PyObject* (*) (PyObject*,PyArrayObject*) ) libnumarray_API[ 24 ]) : (*(PyObject* (*) (PyObject*,PyArrayObject*) ) libnumarray_FatalApiError))
+
+#define NA_getBufferPtrAndSize (libnumarray_API ? (*(long (*) (PyObject*,int,void**) ) libnumarray_API[ 25 ]) : (*(long (*) (PyObject*,int,void**) ) libnumarray_FatalApiError))
+
+#define NA_checkIo (libnumarray_API ? (*(int (*) (char*,int,int,int,int) ) libnumarray_API[ 26 ]) : (*(int (*) (char*,int,int,int,int) ) libnumarray_FatalApiError))
+
+#define NA_checkOneCBuffer (libnumarray_API ? (*(int (*) (char*,long,void*,long,size_t) ) libnumarray_API[ 27 ]) : (*(int (*) (char*,long,void*,long,size_t) ) libnumarray_FatalApiError))
+
+#define NA_checkNCBuffers (libnumarray_API ? (*(int (*) (char*,int,long,void**,long*,Int8*,Int8*) ) libnumarray_API[ 28 ]) : (*(int (*) (char*,int,long,void**,long*,Int8*,Int8*) ) libnumarray_FatalApiError))
+
+#define NA_checkOneStriding (libnumarray_API ? (*(int (*) (char*,long,maybelong*,long,maybelong*,long,long,int) ) libnumarray_API[ 29 ]) : (*(int (*) (char*,long,maybelong*,long,maybelong*,long,long,int) ) libnumarray_FatalApiError))
+
+#define NA_new_cfunc (libnumarray_API ? (*(PyObject* (*) (CfuncDescriptor*) ) libnumarray_API[ 30 ]) : (*(PyObject* (*) (CfuncDescriptor*) ) libnumarray_FatalApiError))
+
+#define NA_add_cfunc (libnumarray_API ? (*(int (*) (PyObject*,char*,CfuncDescriptor*) ) libnumarray_API[ 31 ]) : (*(int (*) (PyObject*,char*,CfuncDescriptor*) ) libnumarray_FatalApiError))
+
+#define NA_InputArray (libnumarray_API ? (*(PyArrayObject* (*) (PyObject*,NumarrayType,int) ) libnumarray_API[ 32 ]) : (*(PyArrayObject* (*) (PyObject*,NumarrayType,int) ) libnumarray_FatalApiError))
+
+#define NA_OutputArray (libnumarray_API ? (*(PyArrayObject* (*) (PyObject*,NumarrayType,int) ) libnumarray_API[ 33 ]) : (*(PyArrayObject* (*) (PyObject*,NumarrayType,int) ) libnumarray_FatalApiError))
+
+#define NA_IoArray (libnumarray_API ? (*(PyArrayObject* (*) (PyObject*,NumarrayType,int) ) libnumarray_API[ 34 ]) : (*(PyArrayObject* (*) (PyObject*,NumarrayType,int) ) libnumarray_FatalApiError))
+
+#define NA_OptionalOutputArray (libnumarray_API ? (*(PyArrayObject* (*) (PyObject*,NumarrayType,int,PyArrayObject*) ) libnumarray_API[ 35 ]) : (*(PyArrayObject* (*) (PyObject*,NumarrayType,int,PyArrayObject*) ) libnumarray_FatalApiError))
+
+#define NA_get_offset (libnumarray_API ? (*(long (*) (PyArrayObject*,int,...) ) libnumarray_API[ 36 ]) : (*(long (*) (PyArrayObject*,int,...) ) libnumarray_FatalApiError))
+
+#define NA_get_Float64 (libnumarray_API ? (*(Float64 (*) (PyArrayObject*,long) ) libnumarray_API[ 37 ]) : (*(Float64 (*) (PyArrayObject*,long) ) libnumarray_FatalApiError))
+
+#define NA_set_Float64 (libnumarray_API ? (*(void (*) (PyArrayObject*,long,Float64) ) libnumarray_API[ 38 ]) : (*(void (*) (PyArrayObject*,long,Float64) ) libnumarray_FatalApiError))
+
+#define NA_get_Complex64 (libnumarray_API ? (*(Complex64 (*) (PyArrayObject*,long) ) libnumarray_API[ 39 ]) : (*(Complex64 (*) (PyArrayObject*,long) ) libnumarray_FatalApiError))
+
+#define NA_set_Complex64 (libnumarray_API ? (*(void (*) (PyArrayObject*,long,Complex64) ) libnumarray_API[ 40 ]) : (*(void (*) (PyArrayObject*,long,Complex64) ) libnumarray_FatalApiError))
+
+#define NA_get_Int64 (libnumarray_API ? (*(Int64 (*) (PyArrayObject*,long) ) libnumarray_API[ 41 ]) : (*(Int64 (*) (PyArrayObject*,long) ) libnumarray_FatalApiError))
+
+#define NA_set_Int64 (libnumarray_API ? (*(void (*) (PyArrayObject*,long,Int64) ) libnumarray_API[ 42 ]) : (*(void (*) (PyArrayObject*,long,Int64) ) libnumarray_FatalApiError))
+
+#define NA_get1_Float64 (libnumarray_API ? (*(Float64 (*) (PyArrayObject*,long) ) libnumarray_API[ 43 ]) : (*(Float64 (*) (PyArrayObject*,long) ) libnumarray_FatalApiError))
+
+#define NA_get2_Float64 (libnumarray_API ? (*(Float64 (*) (PyArrayObject*,long,long) ) libnumarray_API[ 44 ]) : (*(Float64 (*) (PyArrayObject*,long,long) ) libnumarray_FatalApiError))
+
+#define NA_get3_Float64 (libnumarray_API ? (*(Float64 (*) (PyArrayObject*,long,long,long) ) libnumarray_API[ 45 ]) : (*(Float64 (*) (PyArrayObject*,long,long,long) ) libnumarray_FatalApiError))
+
+#define NA_set1_Float64 (libnumarray_API ? (*(void (*) (PyArrayObject*,long,Float64) ) libnumarray_API[ 46 ]) : (*(void (*) (PyArrayObject*,long,Float64) ) libnumarray_FatalApiError))
+
+#define NA_set2_Float64 (libnumarray_API ? (*(void (*) (PyArrayObject*,long,long,Float64) ) libnumarray_API[ 47 ]) : (*(void (*) (PyArrayObject*,long,long,Float64) ) libnumarray_FatalApiError))
+
+#define NA_set3_Float64 (libnumarray_API ? (*(void (*) (PyArrayObject*,long,long,long,Float64) ) libnumarray_API[ 48 ]) : (*(void (*) (PyArrayObject*,long,long,long,Float64) ) libnumarray_FatalApiError))
+
+#define NA_get1_Complex64 (libnumarray_API ? (*(Complex64 (*) (PyArrayObject*,long) ) libnumarray_API[ 49 ]) : (*(Complex64 (*) (PyArrayObject*,long) ) libnumarray_FatalApiError))
+
+#define NA_get2_Complex64 (libnumarray_API ? (*(Complex64 (*) (PyArrayObject*,long,long) ) libnumarray_API[ 50 ]) : (*(Complex64 (*) (PyArrayObject*,long,long) ) libnumarray_FatalApiError))
+
+#define NA_get3_Complex64 (libnumarray_API ? (*(Complex64 (*) (PyArrayObject*,long,long,long) ) libnumarray_API[ 51 ]) : (*(Complex64 (*) (PyArrayObject*,long,long,long) ) libnumarray_FatalApiError))
+
+#define NA_set1_Complex64 (libnumarray_API ? (*(void (*) (PyArrayObject*,long,Complex64) ) libnumarray_API[ 52 ]) : (*(void (*) (PyArrayObject*,long,Complex64) ) libnumarray_FatalApiError))
+
+#define NA_set2_Complex64 (libnumarray_API ? (*(void (*) (PyArrayObject*,long,long,Complex64) ) libnumarray_API[ 53 ]) : (*(void (*) (PyArrayObject*,long,long,Complex64) ) libnumarray_FatalApiError))
+
+#define NA_set3_Complex64 (libnumarray_API ? (*(void (*) (PyArrayObject*,long,long,long,Complex64) ) libnumarray_API[ 54 ]) : (*(void (*) (PyArrayObject*,long,long,long,Complex64) ) libnumarray_FatalApiError))
+
+#define NA_get1_Int64 (libnumarray_API ? (*(Int64 (*) (PyArrayObject*,long) ) libnumarray_API[ 55 ]) : (*(Int64 (*) (PyArrayObject*,long) ) libnumarray_FatalApiError))
+
+#define NA_get2_Int64 (libnumarray_API ? (*(Int64 (*) (PyArrayObject*,long,long) ) libnumarray_API[ 56 ]) : (*(Int64 (*) (PyArrayObject*,long,long) ) libnumarray_FatalApiError))
+
+#define NA_get3_Int64 (libnumarray_API ? (*(Int64 (*) (PyArrayObject*,long,long,long) ) libnumarray_API[ 57 ]) : (*(Int64 (*) (PyArrayObject*,long,long,long) ) libnumarray_FatalApiError))
+
+#define NA_set1_Int64 (libnumarray_API ? (*(void (*) (PyArrayObject*,long,Int64) ) libnumarray_API[ 58 ]) : (*(void (*) (PyArrayObject*,long,Int64) ) libnumarray_FatalApiError))
+
+#define NA_set2_Int64 (libnumarray_API ? (*(void (*) (PyArrayObject*,long,long,Int64) ) libnumarray_API[ 59 ]) : (*(void (*) (PyArrayObject*,long,long,Int64) ) libnumarray_FatalApiError))
+
+#define NA_set3_Int64 (libnumarray_API ? (*(void (*) (PyArrayObject*,long,long,long,Int64) ) libnumarray_API[ 60 ]) : (*(void (*) (PyArrayObject*,long,long,long,Int64) ) libnumarray_FatalApiError))
+
+#define NA_get1D_Float64 (libnumarray_API ? (*(int (*) (PyArrayObject*,long,int,Float64*) ) libnumarray_API[ 61 ]) : (*(int (*) (PyArrayObject*,long,int,Float64*) ) libnumarray_FatalApiError))
+
+#define NA_set1D_Float64 (libnumarray_API ? (*(int (*) (PyArrayObject*,long,int,Float64*) ) libnumarray_API[ 62 ]) : (*(int (*) (PyArrayObject*,long,int,Float64*) ) libnumarray_FatalApiError))
+
+#define NA_get1D_Int64 (libnumarray_API ? (*(int (*) (PyArrayObject*,long,int,Int64*) ) libnumarray_API[ 63 ]) : (*(int (*) (PyArrayObject*,long,int,Int64*) ) libnumarray_FatalApiError))
+
+#define NA_set1D_Int64 (libnumarray_API ? (*(int (*) (PyArrayObject*,long,int,Int64*) ) libnumarray_API[ 64 ]) : (*(int (*) (PyArrayObject*,long,int,Int64*) ) libnumarray_FatalApiError))
+
+#define NA_get1D_Complex64 (libnumarray_API ? (*(int (*) (PyArrayObject*,long,int,Complex64*) ) libnumarray_API[ 65 ]) : (*(int (*) (PyArrayObject*,long,int,Complex64*) ) libnumarray_FatalApiError))
+
+#define NA_set1D_Complex64 (libnumarray_API ? (*(int (*) (PyArrayObject*,long,int,Complex64*) ) libnumarray_API[ 66 ]) : (*(int (*) (PyArrayObject*,long,int,Complex64*) ) libnumarray_FatalApiError))
+
+#define NA_ShapeEqual (libnumarray_API ? (*(int (*) (PyArrayObject*,PyArrayObject*) ) libnumarray_API[ 67 ]) : (*(int (*) (PyArrayObject*,PyArrayObject*) ) libnumarray_FatalApiError))
+
+#define NA_ShapeLessThan (libnumarray_API ? (*(int (*) (PyArrayObject*,PyArrayObject*) ) libnumarray_API[ 68 ]) : (*(int (*) (PyArrayObject*,PyArrayObject*) ) libnumarray_FatalApiError))
+
+#define NA_ByteOrder (libnumarray_API ? (*(int (*) (void) ) libnumarray_API[ 69 ]) : (*(int (*) (void) ) libnumarray_FatalApiError))
+
+#define NA_IeeeSpecial32 (libnumarray_API ? (*(Bool (*) (Float32*,Int32*) ) libnumarray_API[ 70 ]) : (*(Bool (*) (Float32*,Int32*) ) libnumarray_FatalApiError))
+
+#define NA_IeeeSpecial64 (libnumarray_API ? (*(Bool (*) (Float64*,Int32*) ) libnumarray_API[ 71 ]) : (*(Bool (*) (Float64*,Int32*) ) libnumarray_FatalApiError))
+
+#define NA_updateDataPtr (libnumarray_API ? (*(PyArrayObject* (*) (PyArrayObject*) ) libnumarray_API[ 72 ]) : (*(PyArrayObject* (*) (PyArrayObject*) ) libnumarray_FatalApiError))
+
+#define NA_typeNoToName (libnumarray_API ? (*(char* (*) (int) ) libnumarray_API[ 73 ]) : (*(char* (*) (int) ) libnumarray_FatalApiError))
+
+#define NA_nameToTypeNo (libnumarray_API ? (*(int (*) (char*) ) libnumarray_API[ 74 ]) : (*(int (*) (char*) ) libnumarray_FatalApiError))
+
+#define NA_typeNoToTypeObject (libnumarray_API ? (*(PyObject* (*) (int) ) libnumarray_API[ 75 ]) : (*(PyObject* (*) (int) ) libnumarray_FatalApiError))
+
+#define NA_intTupleFromMaybeLongs (libnumarray_API ? (*(PyObject* (*) (int,maybelong*) ) libnumarray_API[ 76 ]) : (*(PyObject* (*) (int,maybelong*) ) libnumarray_FatalApiError))
+
+#define NA_maybeLongsFromIntTuple (libnumarray_API ? (*(long (*) (int,maybelong*,PyObject*) ) libnumarray_API[ 77 ]) : (*(long (*) (int,maybelong*,PyObject*) ) libnumarray_FatalApiError))
+
+#define NA_intTupleProduct (libnumarray_API ? (*(int (*) (PyObject *obj, long *product) ) libnumarray_API[ 78 ]) : (*(int (*) (PyObject *obj, long *product) ) libnumarray_FatalApiError))
+
+#define NA_isIntegerSequence (libnumarray_API ? (*(long (*) (PyObject*) ) libnumarray_API[ 79 ]) : (*(long (*) (PyObject*) ) libnumarray_FatalApiError))
+
+#define NA_setArrayFromSequence (libnumarray_API ? (*(PyObject* (*) (PyArrayObject*,PyObject*) ) libnumarray_API[ 80 ]) : (*(PyObject* (*) (PyArrayObject*,PyObject*) ) libnumarray_FatalApiError))
+
+#define NA_maxType (libnumarray_API ? (*(int (*) (PyObject*) ) libnumarray_API[ 81 ]) : (*(int (*) (PyObject*) ) libnumarray_FatalApiError))
+
+#define NA_isPythonScalar (libnumarray_API ? (*(int (*) (PyObject *obj) ) libnumarray_API[ 82 ]) : (*(int (*) (PyObject *obj) ) libnumarray_FatalApiError))
+
+#define NA_getPythonScalar (libnumarray_API ? (*(PyObject* (*) (PyArrayObject*,long) ) libnumarray_API[ 83 ]) : (*(PyObject* (*) (PyArrayObject*,long) ) libnumarray_FatalApiError))
+
+#define NA_setFromPythonScalar (libnumarray_API ? (*(int (*) (PyArrayObject*,long,PyObject*) ) libnumarray_API[ 84 ]) : (*(int (*) (PyArrayObject*,long,PyObject*) ) libnumarray_FatalApiError))
+
+#define NA_NDArrayCheck (libnumarray_API ? (*(int (*) (PyObject*) ) libnumarray_API[ 85 ]) : (*(int (*) (PyObject*) ) libnumarray_FatalApiError))
+
+#define NA_NumArrayCheck (libnumarray_API ? (*(int (*) (PyObject*) ) libnumarray_API[ 86 ]) : (*(int (*) (PyObject*) ) libnumarray_FatalApiError))
+
+#define NA_ComplexArrayCheck (libnumarray_API ? (*(int (*) (PyObject*) ) libnumarray_API[ 87 ]) : (*(int (*) (PyObject*) ) libnumarray_FatalApiError))
+
+#define NA_elements (libnumarray_API ? (*(unsigned long (*) (PyArrayObject*) ) libnumarray_API[ 88 ]) : (*(unsigned long (*) (PyArrayObject*) ) libnumarray_FatalApiError))
+
+#define NA_typeObjectToTypeNo (libnumarray_API ? (*(int (*) (PyObject*) ) libnumarray_API[ 89 ]) : (*(int (*) (PyObject*) ) libnumarray_FatalApiError))
+
+#define NA_copyArray (libnumarray_API ? (*(int (*) (PyArrayObject* to, const PyArrayObject* from) ) libnumarray_API[ 90 ]) : (*(int (*) (PyArrayObject* to, const PyArrayObject* from) ) libnumarray_FatalApiError))
+
+#define NA_copy (libnumarray_API ? (*(PyArrayObject* (*) (PyArrayObject*) ) libnumarray_API[ 91 ]) : (*(PyArrayObject* (*) (PyArrayObject*) ) libnumarray_FatalApiError))
+
+#define NA_getType (libnumarray_API ? (*(PyObject* (*) (PyObject *typeobj_or_name) ) libnumarray_API[ 92 ]) : (*(PyObject* (*) (PyObject *typeobj_or_name) ) libnumarray_FatalApiError))
+
+#define NA_callCUFuncCore (libnumarray_API ? (*(PyObject * (*) (PyObject *cfunc, long niter, long ninargs, long noutargs, PyObject **BufferObj, long *offset) ) libnumarray_API[ 93 ]) : (*(PyObject * (*) (PyObject *cfunc, long niter, long ninargs, long noutargs, PyObject **BufferObj, long *offset) ) libnumarray_FatalApiError))
+
+#define NA_callStrideConvCFuncCore (libnumarray_API ? (*(PyObject * (*) (PyObject *cfunc, int nshape, maybelong *shape, PyObject *inbuffObj, long inboffset, int nstrides0, maybelong *inbstrides, PyObject *outbuffObj, long outboffset, int nstrides1, maybelong *outbstrides, long nbytes) ) libnumarray_API[ 94 ]) : (*(PyObject * (*) (PyObject *cfunc, int nshape, maybelong *shape, PyObject *inbuffObj, long inboffset, int nstrides0, maybelong *inbstrides, PyObject *outbuffObj, long outboffset, int nstrides1, maybelong *outbstrides, long nbytes) ) libnumarray_FatalApiError))
+
+#define NA_stridesFromShape (libnumarray_API ? (*(void (*) (int nshape, maybelong *shape, maybelong bytestride, maybelong *strides) ) libnumarray_API[ 95 ]) : (*(void (*) (int nshape, maybelong *shape, maybelong bytestride, maybelong *strides) ) libnumarray_FatalApiError))
+
+#define NA_OperatorCheck (libnumarray_API ? (*(int (*) (PyObject *obj) ) libnumarray_API[ 96 ]) : (*(int (*) (PyObject *obj) ) libnumarray_FatalApiError))
+
+#define NA_ConverterCheck (libnumarray_API ? (*(int (*) (PyObject *obj) ) libnumarray_API[ 97 ]) : (*(int (*) (PyObject *obj) ) libnumarray_FatalApiError))
+
+#define NA_UfuncCheck (libnumarray_API ? (*(int (*) (PyObject *obj) ) libnumarray_API[ 98 ]) : (*(int (*) (PyObject *obj) ) libnumarray_FatalApiError))
+
+#define NA_CfuncCheck (libnumarray_API ? (*(int (*) (PyObject *obj) ) libnumarray_API[ 99 ]) : (*(int (*) (PyObject *obj) ) libnumarray_FatalApiError))
+
+#define NA_getByteOffset (libnumarray_API ? (*(int (*) (PyArrayObject *array, int nindices, maybelong *indices, long *offset) ) libnumarray_API[ 100 ]) : (*(int (*) (PyArrayObject *array, int nindices, maybelong *indices, long *offset) ) libnumarray_FatalApiError))
+
+#define NA_swapAxes (libnumarray_API ? (*(int (*) (PyArrayObject *array, int x, int y) ) libnumarray_API[ 101 ]) : (*(int (*) (PyArrayObject *array, int x, int y) ) libnumarray_FatalApiError))
+
+#define NA_initModuleGlobal (libnumarray_API ? (*(PyObject * (*) (char *module, char *global) ) libnumarray_API[ 102 ]) : (*(PyObject * (*) (char *module, char *global) ) libnumarray_FatalApiError))
+
+#define NA_NumarrayType (libnumarray_API ? (*(NumarrayType (*) (PyObject *seq) ) libnumarray_API[ 103 ]) : (*(NumarrayType (*) (PyObject *seq) ) libnumarray_FatalApiError))
+
+#define NA_NewAllFromBuffer (libnumarray_API ? (*(PyArrayObject * (*) (int ndim, maybelong *shape, NumarrayType type, PyObject *bufferObject, maybelong byteoffset, maybelong bytestride, int byteorder, int aligned, int writeable) ) libnumarray_API[ 104 ]) : (*(PyArrayObject * (*) (int ndim, maybelong *shape, NumarrayType type, PyObject *bufferObject, maybelong byteoffset, maybelong bytestride, int byteorder, int aligned, int writeable) ) libnumarray_FatalApiError))
+
+#define NA_alloc1D_Float64 (libnumarray_API ? (*(Float64 * (*) (PyArrayObject *a, long offset, int cnt) ) libnumarray_API[ 105 ]) : (*(Float64 * (*) (PyArrayObject *a, long offset, int cnt) ) libnumarray_FatalApiError))
+
+#define NA_alloc1D_Int64 (libnumarray_API ? (*(Int64 * (*) (PyArrayObject *a, long offset, int cnt) ) libnumarray_API[ 106 ]) : (*(Int64 * (*) (PyArrayObject *a, long offset, int cnt) ) libnumarray_FatalApiError))
+
+#define NA_updateAlignment (libnumarray_API ? (*(void (*) (PyArrayObject *self) ) libnumarray_API[ 107 ]) : (*(void (*) (PyArrayObject *self) ) libnumarray_FatalApiError))
+
+#define NA_updateContiguous (libnumarray_API ? (*(void (*) (PyArrayObject *self) ) libnumarray_API[ 108 ]) : (*(void (*) (PyArrayObject *self) ) libnumarray_FatalApiError))
+
+#define NA_updateStatus (libnumarray_API ? (*(void (*) (PyArrayObject *self) ) libnumarray_API[ 109 ]) : (*(void (*) (PyArrayObject *self) ) libnumarray_FatalApiError))
+
+#define NA_NumArrayCheckExact (libnumarray_API ? (*(int (*) (PyObject *op) ) libnumarray_API[ 110 ]) : (*(int (*) (PyObject *op) ) libnumarray_FatalApiError))
+
+#define NA_NDArrayCheckExact (libnumarray_API ? (*(int (*) (PyObject *op) ) libnumarray_API[ 111 ]) : (*(int (*) (PyObject *op) ) libnumarray_FatalApiError))
+
+#define NA_OperatorCheckExact (libnumarray_API ? (*(int (*) (PyObject *op) ) libnumarray_API[ 112 ]) : (*(int (*) (PyObject *op) ) libnumarray_FatalApiError))
+
+#define NA_ConverterCheckExact (libnumarray_API ? (*(int (*) (PyObject *op) ) libnumarray_API[ 113 ]) : (*(int (*) (PyObject *op) ) libnumarray_FatalApiError))
+
+#define NA_UfuncCheckExact (libnumarray_API ? (*(int (*) (PyObject *op) ) libnumarray_API[ 114 ]) : (*(int (*) (PyObject *op) ) libnumarray_FatalApiError))
+
+#define NA_CfuncCheckExact (libnumarray_API ? (*(int (*) (PyObject *op) ) libnumarray_API[ 115 ]) : (*(int (*) (PyObject *op) ) libnumarray_FatalApiError))
+
+#define NA_getArrayData (libnumarray_API ? (*(char * (*) (PyArrayObject *ap) ) libnumarray_API[ 116 ]) : (*(char * (*) (PyArrayObject *ap) ) libnumarray_FatalApiError))
+
+#define NA_updateByteswap (libnumarray_API ? (*(void (*) (PyArrayObject *ap) ) libnumarray_API[ 117 ]) : (*(void (*) (PyArrayObject *ap) ) libnumarray_FatalApiError))
+
+#define NA_DescrFromType (libnumarray_API ? (*(PyArray_Descr * (*) (int type) ) libnumarray_API[ 118 ]) : (*(PyArray_Descr * (*) (int type) ) libnumarray_FatalApiError))
+
+#define NA_Cast (libnumarray_API ? (*(PyObject * (*) (PyArrayObject *a, int type) ) libnumarray_API[ 119 ]) : (*(PyObject * (*) (PyArrayObject *a, int type) ) libnumarray_FatalApiError))
+
+#define NA_checkFPErrors (libnumarray_API ? (*(int (*) (void) ) libnumarray_API[ 120 ]) : (*(int (*) (void) ) libnumarray_FatalApiError))
+
+#define NA_clearFPErrors (libnumarray_API ? (*(void (*) (void) ) libnumarray_API[ 121 ]) : (*(void (*) (void) ) libnumarray_FatalApiError))
+
+#define NA_checkAndReportFPErrors (libnumarray_API ? (*(int (*) (char *name) ) libnumarray_API[ 122 ]) : (*(int (*) (char *name) ) libnumarray_FatalApiError))
+
+#define NA_IeeeMask32 (libnumarray_API ? (*(Bool (*) (Float32,Int32) ) libnumarray_API[ 123 ]) : (*(Bool (*) (Float32,Int32) ) libnumarray_FatalApiError))
+
+#define NA_IeeeMask64 (libnumarray_API ? (*(Bool (*) (Float64,Int32) ) libnumarray_API[ 124 ]) : (*(Bool (*) (Float64,Int32) ) libnumarray_FatalApiError))
+
+#define _NA_callStridingHelper (libnumarray_API ? (*(int (*) (PyObject *aux, long dim, long nnumarray, PyArrayObject *numarray[], char *data[], CFUNC_STRIDED_FUNC f) ) libnumarray_API[ 125 ]) : (*(int (*) (PyObject *aux, long dim, long nnumarray, PyArrayObject *numarray[], char *data[], CFUNC_STRIDED_FUNC f) ) libnumarray_FatalApiError))
+
+#define NA_FromDimsStridesDescrAndData (libnumarray_API ? (*(PyArrayObject * (*) (int nd, maybelong *dims, maybelong *strides, PyArray_Descr *descr, char *data) ) libnumarray_API[ 126 ]) : (*(PyArrayObject * (*) (int nd, maybelong *dims, maybelong *strides, PyArray_Descr *descr, char *data) ) libnumarray_FatalApiError))
+
+#define NA_FromDimsTypeAndData (libnumarray_API ? (*(PyArrayObject * (*) (int nd, maybelong *dims, int type, char *data) ) libnumarray_API[ 127 ]) : (*(PyArrayObject * (*) (int nd, maybelong *dims, int type, char *data) ) libnumarray_FatalApiError))
+
+#define NA_FromDimsStridesTypeAndData (libnumarray_API ? (*(PyArrayObject * (*) (int nd, maybelong *dims, maybelong *strides, int type, char *data) ) libnumarray_API[ 128 ]) : (*(PyArrayObject * (*) (int nd, maybelong *dims, maybelong *strides, int type, char *data) ) libnumarray_FatalApiError))
+
+#define NA_scipy_typestr (libnumarray_API ? (*(int (*) (NumarrayType t, int byteorder, char *typestr) ) libnumarray_API[ 129 ]) : (*(int (*) (NumarrayType t, int byteorder, char *typestr) ) libnumarray_FatalApiError))
+
+#define NA_FromArrayStruct (libnumarray_API ? (*(PyArrayObject * (*) (PyObject *a) ) libnumarray_API[ 130 ]) : (*(PyArrayObject * (*) (PyObject *a) ) libnumarray_FatalApiError))
+
+#endif
+
+ /* Total number of C API pointers */
+#define libnumarray_API_pointers 131
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* NUMPY_LIBNUMARRAY_H */
diff --git a/numpy/numarray/numpy/numcomplex.h b/numpy/numarray/numpy/numcomplex.h
new file mode 100644
index 000000000..9ed4198c7
--- /dev/null
+++ b/numpy/numarray/numpy/numcomplex.h
@@ -0,0 +1,252 @@
+/* See numarray.h for Complex32, Complex64:
+
+typedef struct { Float32 r, i; } Complex32;
+typedef struct { Float64 r, i; } Complex64;
+
+*/
+typedef struct { Float32 a, theta; } PolarComplex32;
+typedef struct { Float64 a, theta; } PolarComplex64;
+
+#define NUM_SQ(x) ((x)*(x))
+
+#define NUM_CABSSQ(p) (NUM_SQ((p).r) + NUM_SQ((p).i))
+
+#define NUM_CABS(p) sqrt(NUM_CABSSQ(p))
+
+#define NUM_C_TO_P(c, p) (p).a = NUM_CABS(c); \
+ (p).theta = atan2((c).i, (c).r);
+
+#define NUM_P_TO_C(p, c) (c).r = (p).a*cos((p).theta); \
+ (c).i = (p).a*sin((p).theta);
+
+#define NUM_CASS(p, q) (q).r = (p).r, (q).i = (p).i
+
+#define NUM_CADD(p, q, s) (s).r = (p).r + (q).r, \
+ (s).i = (p).i + (q).i
+
+#define NUM_CSUB(p, q, s) (s).r = (p).r - (q).r, \
+ (s).i = (p).i - (q).i
+
+#define NUM_CMUL(p, q, s) \
+ { Float64 rp = (p).r; \
+ Float64 rq = (q).r; \
+ (s).r = rp*rq - (p).i*(q).i; \
+ (s).i = rp*(q).i + rq*(p).i; \
+ }
+
+#define NUM_CDIV(p, q, s) \
+ { \
+ Float64 rp = (p).r; \
+ Float64 ip = (p).i; \
+ Float64 rq = (q).r; \
+ if ((q).i != 0) { \
+ Float64 temp = NUM_CABSSQ(q); \
+ (s).r = (rp*rq+(p).i*(q).i)/temp; \
+ (s).i = (rq*(p).i-(q).i*rp)/temp; \
+ } else { \
+ (s).r = rp/rq; \
+ (s).i = ip/rq; \
+ } \
+ }
+
+#define NUM_CREM(p, q, s) \
+ { Complex64 r; \
+ NUM_CDIV(p, q, r); \
+ r.r = floor(r.r); \
+ r.i = 0; \
+ NUM_CMUL(r, q, r); \
+ NUM_CSUB(p, r, s); \
+ }
+
+#define NUM_CMINUS(p, s) (s).r = -(p).r; (s).i = -(p).i;
+#define NUM_CNEG NUM_CMINUS
+
+#define NUM_CEQ(p, q) (((p).r == (q).r) && ((p).i == (q).i))
+#define NUM_CNE(p, q) (((p).r != (q).r) || ((p).i != (q).i))
+#define NUM_CLT(p, q) ((p).r < (q).r)
+#define NUM_CGT(p, q) ((p).r > (q).r)
+#define NUM_CLE(p, q) ((p).r <= (q).r)
+#define NUM_CGE(p, q) ((p).r >= (q).r)
+
+/* e**z = e**x * (cos(y)+ i*sin(y)) where z = x + i*y
+ so e**z = e**x * cos(y) + i * e**x * sin(y)
+*/
+#define NUM_CEXP(p, s) \
+ { Float64 ex = exp((p).r); \
+ (s).r = ex * cos((p).i); \
+ (s).i = ex * sin((p).i); \
+ }
+
+/* e**w = z; w = u + i*v; z = r * e**(i*theta);
+
+e**u * e**(i*v) = r * e**(i*theta);
+
+log(z) = w; log(z) = log(r) + i*theta;
+ */
+#define NUM_CLOG(p, s) \
+ { PolarComplex64 temp; NUM_C_TO_P(p, temp); \
+ (s).r = num_log(temp.a); \
+ (s).i = temp.theta; \
+ }
+
+#define NUM_LOG10_E 0.43429448190325182
+
+#define NUM_CLOG10(p, s) \
+ { NUM_CLOG(p, s); \
+ (s).r *= NUM_LOG10_E; \
+ (s).i *= NUM_LOG10_E; \
+ }
+
+/* s = p ** q */
+#define NUM_CPOW(p, q, s) { if (NUM_CABSSQ(p) == 0) { \
+ if ((q).r == 0 && (q).i == 0) { \
+ (s).r = (s).i = 1; \
+ } else { \
+ (s).r = (s).i = 0; \
+ } \
+ } else { \
+ NUM_CLOG(p, s); \
+ NUM_CMUL(s, q, s); \
+ NUM_CEXP(s, s); \
+ } \
+ }
+
+#define NUM_CSQRT(p, s) { Complex64 temp; temp.r = 0.5; temp.i=0; \
+ NUM_CPOW(p, temp, s); \
+ }
+
+#define NUM_CSQR(p, s) { Complex64 temp; temp.r = 2.0; temp.i=0; \
+ NUM_CPOW(p, temp, s); \
+ }
+
+#define NUM_CSIN(p, s) { Float64 sp = sin((p).r); \
+ Float64 cp = cos((p).r); \
+ (s).r = cosh((p).i) * sp; \
+ (s).i = sinh((p).i) * cp; \
+ }
+
+#define NUM_CCOS(p, s) { Float64 sp = sin((p).r); \
+ Float64 cp = cos((p).r); \
+ (s).r = cosh((p).i) * cp; \
+ (s).i = -sinh((p).i) * sp; \
+ }
+
+#define NUM_CTAN(p, s) { Complex64 ss, cs; \
+ NUM_CSIN(p, ss); \
+ NUM_CCOS(p, cs); \
+ NUM_CDIV(ss, cs, s); \
+ }
+
+#define NUM_CSINH(p, s) { Float64 sp = sin((p).i); \
+ Float64 cp = cos((p).i); \
+ (s).r = sinh((p).r) * cp; \
+ (s).i = cosh((p).r) * sp; \
+ }
+
+#define NUM_CCOSH(p, s) { Float64 sp = sin((p).i); \
+ Float64 cp = cos((p).i); \
+ (s).r = cosh((p).r) * cp; \
+ (s).i = sinh((p).r) * sp; \
+ }
+
+#define NUM_CTANH(p, s) { Complex64 ss, cs; \
+ NUM_CSINH(p, ss); \
+ NUM_CCOSH(p, cs); \
+ NUM_CDIV(ss, cs, s); \
+ }
+
+#define NUM_CRPOW(p, v, s) { Complex64 cr; cr.r = v; cr.i = 0; \
+ NUM_CPOW(p,cr,s); \
+ }
+
+#define NUM_CRMUL(p, v, s) (s).r = (p).r * v; (s).i = (p).i * v;
+
+#define NUM_CIMUL(p, s) { Float64 temp = (s).r; \
+ (s).r = -(p).i; (s).i = temp; \
+ }
+
+/* asin(z) = -i * log(i*z + (1 - z**2)**0.5) */
+#define NUM_CASIN(p, s) { Complex64 p1; NUM_CASS(p, p1); \
+ NUM_CIMUL(p, p1); \
+ NUM_CMUL(p, p, s); \
+ NUM_CNEG(s, s); \
+ (s).r += 1; \
+ NUM_CRPOW(s, 0.5, s); \
+ NUM_CADD(p1, s, s); \
+ NUM_CLOG(s, s); \
+ NUM_CIMUL(s, s); \
+ NUM_CNEG(s, s); \
+ }
+
+/* acos(z) = -i * log(z + i*(1 - z**2)**0.5) */
+#define NUM_CACOS(p, s) { Complex64 p1; NUM_CASS(p, p1); \
+ NUM_CMUL(p, p, s); \
+ NUM_CNEG(s, s); \
+ (s).r += 1; \
+ NUM_CRPOW(s, 0.5, s); \
+ NUM_CIMUL(s, s); \
+ NUM_CADD(p1, s, s); \
+ NUM_CLOG(s, s); \
+ NUM_CIMUL(s, s); \
+ NUM_CNEG(s, s); \
+ }
+
+/* atan(z) = i/2 * log( (i+z) / (i - z) ) */
+#define NUM_CATAN(p, s) { Complex64 p1, p2; \
+ NUM_CASS(p, p1); NUM_CNEG(p, p2); \
+ p1.i += 1; \
+ p2.i += 1; \
+ NUM_CDIV(p1, p2, s); \
+ NUM_CLOG(s, s); \
+ NUM_CIMUL(s, s); \
+ NUM_CRMUL(s, 0.5, s); \
+ }
+
+/* asinh(z) = log( z + (z**2 + 1)**0.5 ) */
+#define NUM_CASINH(p, s) { Complex64 p1; NUM_CASS(p, p1); \
+ NUM_CMUL(p, p, s); \
+ (s).r += 1; \
+ NUM_CRPOW(s, 0.5, s); \
+ NUM_CADD(p1, s, s); \
+ NUM_CLOG(s, s); \
+ }
+
+/* acosh(z) = log( z + (z**2 - 1)**0.5 ) */
+#define NUM_CACOSH(p, s) { Complex64 p1; NUM_CASS(p, p1); \
+ NUM_CMUL(p, p, s); \
+ (s).r -= 1; \
+ NUM_CRPOW(s, 0.5, s); \
+ NUM_CADD(p1, s, s); \
+ NUM_CLOG(s, s); \
+ }
+
+/* atanh(z) = 1/2 * log( (1+z)/(1-z) ) */
+#define NUM_CATANH(p, s) { Complex64 p1, p2; \
+ NUM_CASS(p, p1); NUM_CNEG(p, p2); \
+ p1.r += 1; \
+ p2.r += 1; \
+ NUM_CDIV(p1, p2, s); \
+ NUM_CLOG(s, s); \
+ NUM_CRMUL(s, 0.5, s); \
+ }
+
+
+#define NUM_CMIN(p, q) (NUM_CLE(p, q) ? p : q)
+#define NUM_CMAX(p, q) (NUM_CGE(p, q) ? p : q)
+
+#define NUM_CNZ(p) (((p).r != 0) || ((p).i != 0))
+#define NUM_CLAND(p, q) (NUM_CNZ(p) & NUM_CNZ(q))
+#define NUM_CLOR(p, q) (NUM_CNZ(p) | NUM_CNZ(q))
+#define NUM_CLXOR(p, q) (NUM_CNZ(p) ^ NUM_CNZ(q))
+#define NUM_CLNOT(p) (!NUM_CNZ(p))
+
+#define NUM_CFLOOR(p, s) (s).r = floor((p).r); (s).i = floor((p).i);
+#define NUM_CCEIL(p, s) (s).r = ceil((p).r); (s).i = ceil((p).i);
+
+#define NUM_CFABS(p, s) (s).r = fabs((p).r); (s).i = fabs((p).i);
+#define NUM_CROUND(p, s) (s).r = num_round((p).r); (s).i = num_round((p).i);
+#define NUM_CHYPOT(p, q, s) { Complex64 t; \
+ NUM_CSQR(p, s); NUM_CSQR(q, t); \
+ NUM_CADD(s, t, s); \
+ NUM_CSQRT(s, s); \
+ }
diff --git a/numpy/numarray/numpy/nummacro.h b/numpy/numarray/numpy/nummacro.h
new file mode 100644
index 000000000..e9acd6e31
--- /dev/null
+++ b/numpy/numarray/numpy/nummacro.h
@@ -0,0 +1,447 @@
+/* Primarily for compatibility with numarray C-API */
+
+#if !defined(_ndarraymacro)
+#define _ndarraymacro
+
+/* The structs defined here are private implementation details of numarray
+which are subject to change w/o notice.
+*/
+
+#define PY_BOOL_CHAR "b"
+#define PY_INT8_CHAR "b"
+#define PY_INT16_CHAR "h"
+#define PY_INT32_CHAR "i"
+#define PY_FLOAT32_CHAR "f"
+#define PY_FLOAT64_CHAR "d"
+#define PY_UINT8_CHAR "h"
+#define PY_UINT16_CHAR "i"
+#define PY_UINT32_CHAR "i" /* Unless longer int available */
+#define PY_COMPLEX64_CHAR "D"
+#define PY_COMPLEX128_CHAR "D"
+
+#define PY_LONG_CHAR "l"
+#define PY_LONG_LONG_CHAR "L"
+
+#define pyFPE_DIVIDE_BY_ZERO 1
+#define pyFPE_OVERFLOW 2
+#define pyFPE_UNDERFLOW 4
+#define pyFPE_INVALID 8
+
+#define isNonZERO(x) (x != 0) /* to convert values to boolean 1's or 0's */
+
+typedef enum
+{
+ NUM_CONTIGUOUS=1,
+ NUM_NOTSWAPPED=0x0200,
+ NUM_ALIGNED=0x0100,
+ NUM_WRITABLE=0x0400,
+ NUM_COPY=0x0020,
+
+ NUM_C_ARRAY = (NUM_CONTIGUOUS | NUM_ALIGNED | NUM_NOTSWAPPED),
+ NUM_UNCONVERTED = 0
+} NumRequirements;
+
+#define UNCONVERTED 0
+#define C_ARRAY (NUM_CONTIGUOUS | NUM_NOTSWAPPED | NUM_ALIGNED)
+
+#define MUST_BE_COMPUTED 2
+
+#define NUM_FLOORDIVIDE(a,b,out) (out) = floor((a)/(b))
+
+#define NA_Begin() Py_Initialize(); import_libnumarray();
+#define NA_End() NA_Done(); Py_Finalize();
+
+#define NA_OFFSETDATA(num) ((void *) PyArray_DATA(num))
+
+/* unaligned NA_COPY functions */
+#define NA_COPY1(i, o) (*(o) = *(i))
+#define NA_COPY2(i, o) NA_COPY1(i, o), NA_COPY1(i+1, o+1)
+#define NA_COPY4(i, o) NA_COPY2(i, o), NA_COPY2(i+2, o+2)
+#define NA_COPY8(i, o) NA_COPY4(i, o), NA_COPY4(i+4, o+4)
+#define NA_COPY16(i, o) NA_COPY8(i, o), NA_COPY8(i+8, o+8)
+
+/* byteswapping macros: these fail if i==o */
+#define NA_SWAP1(i, o) NA_COPY1(i, o)
+#define NA_SWAP2(i, o) NA_SWAP1(i, o+1), NA_SWAP1(i+1, o)
+#define NA_SWAP4(i, o) NA_SWAP2(i, o+2), NA_SWAP2(i+2, o)
+#define NA_SWAP8(i, o) NA_SWAP4(i, o+4), NA_SWAP4(i+4, o)
+#define NA_SWAP16(i, o) NA_SWAP8(i, o+8), NA_SWAP8(i+8, o)
+
+/* complex byteswaps must swap each part (real, imag) independently */
+#define NA_COMPLEX_SWAP8(i, o) NA_SWAP4(i, o), NA_SWAP4(i+4, o+4)
+#define NA_COMPLEX_SWAP16(i, o) NA_SWAP8(i, o), NA_SWAP8(i+8, o+8)
+
+/* byteswapping macros: these work even if i == o */
+#define NA_TSWAP1(i, o, t) NA_COPY1(i, t), NA_SWAP1(t, o)
+#define NA_TSWAP2(i, o, t) NA_COPY2(i, t), NA_SWAP2(t, o)
+#define NA_TSWAP4(i, o, t) NA_COPY4(i, t), NA_SWAP4(t, o)
+#define NA_TSWAP8(i, o, t) NA_COPY8(i, t), NA_SWAP8(t, o)
+
+/* fast copy functions for %N aligned i and o */
+#define NA_ACOPY1(i, o) (((Int8 *)o)[0] = ((Int8 *)i)[0])
+#define NA_ACOPY2(i, o) (((Int16 *)o)[0] = ((Int16 *)i)[0])
+#define NA_ACOPY4(i, o) (((Int32 *)o)[0] = ((Int32 *)i)[0])
+#define NA_ACOPY8(i, o) (((Float64 *)o)[0] = ((Float64 *)i)[0])
+#define NA_ACOPY16(i, o) (((Complex64 *)o)[0] = ((Complex64 *)i)[0])
+
+/* from here down, type("ai") is NDInfo* */
+
+#define NA_PTR(ai) ((char *) NA_OFFSETDATA((ai)))
+#define NA_PTR1(ai, i) (NA_PTR(ai) + \
+ (i)*(ai)->strides[0])
+#define NA_PTR2(ai, i, j) (NA_PTR(ai) + \
+ (i)*(ai)->strides[0] + \
+ (j)*(ai)->strides[1])
+#define NA_PTR3(ai, i, j, k) (NA_PTR(ai) + \
+ (i)*(ai)->strides[0] + \
+ (j)*(ai)->strides[1] + \
+ (k)*(ai)->strides[2])
+
+#define NA_SET_TEMP(ai, type, v) (((type *) &__temp__)[0] = v)
+
+#define NA_SWAPComplex64 NA_COMPLEX_SWAP16
+#define NA_SWAPComplex32 NA_COMPLEX_SWAP8
+#define NA_SWAPFloat64 NA_SWAP8
+#define NA_SWAPFloat32 NA_SWAP4
+#define NA_SWAPInt64 NA_SWAP8
+#define NA_SWAPUInt64 NA_SWAP8
+#define NA_SWAPInt32 NA_SWAP4
+#define NA_SWAPUInt32 NA_SWAP4
+#define NA_SWAPInt16 NA_SWAP2
+#define NA_SWAPUInt16 NA_SWAP2
+#define NA_SWAPInt8 NA_SWAP1
+#define NA_SWAPUInt8 NA_SWAP1
+#define NA_SWAPBool NA_SWAP1
+
+#define NA_COPYComplex64 NA_COPY16
+#define NA_COPYComplex32 NA_COPY8
+#define NA_COPYFloat64 NA_COPY8
+#define NA_COPYFloat32 NA_COPY4
+#define NA_COPYInt64 NA_COPY8
+#define NA_COPYUInt64 NA_COPY8
+#define NA_COPYInt32 NA_COPY4
+#define NA_COPYUInt32 NA_COPY4
+#define NA_COPYInt16 NA_COPY2
+#define NA_COPYUInt16 NA_COPY2
+#define NA_COPYInt8 NA_COPY1
+#define NA_COPYUInt8 NA_COPY1
+#define NA_COPYBool NA_COPY1
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define _makeGetPb(type) \
+static type _NA_GETPb_##type(char *ptr) \
+{ \
+ type temp; \
+ NA_SWAP##type(ptr, (char *)&temp); \
+ return temp; \
+}
+
+#define _makeGetPa(type) \
+static type _NA_GETPa_##type(char *ptr) \
+{ \
+ type temp; \
+ NA_COPY##type(ptr, (char *)&temp); \
+ return temp; \
+}
+
+_makeGetPb(Complex64)
+_makeGetPb(Complex32)
+_makeGetPb(Float64)
+_makeGetPb(Float32)
+_makeGetPb(Int64)
+_makeGetPb(UInt64)
+_makeGetPb(Int32)
+_makeGetPb(UInt32)
+_makeGetPb(Int16)
+_makeGetPb(UInt16)
+_makeGetPb(Int8)
+_makeGetPb(UInt8)
+_makeGetPb(Bool)
+
+_makeGetPa(Complex64)
+_makeGetPa(Complex32)
+_makeGetPa(Float64)
+_makeGetPa(Float32)
+_makeGetPa(Int64)
+_makeGetPa(UInt64)
+_makeGetPa(Int32)
+_makeGetPa(UInt32)
+_makeGetPa(Int16)
+_makeGetPa(UInt16)
+_makeGetPa(Int8)
+_makeGetPa(UInt8)
+_makeGetPa(Bool)
+
+#undef _makeGetPb
+#undef _makeGetPa
+
+#define _makeSetPb(type) \
+static void _NA_SETPb_##type(char *ptr, type v) \
+{ \
+ NA_SWAP##type(((char *)&v), ptr); \
+ return; \
+}
+
+#define _makeSetPa(type) \
+static void _NA_SETPa_##type(char *ptr, type v) \
+{ \
+ NA_COPY##type(((char *)&v), ptr); \
+ return; \
+}
+
+_makeSetPb(Complex64)
+_makeSetPb(Complex32)
+_makeSetPb(Float64)
+_makeSetPb(Float32)
+_makeSetPb(Int64)
+_makeSetPb(UInt64)
+_makeSetPb(Int32)
+_makeSetPb(UInt32)
+_makeSetPb(Int16)
+_makeSetPb(UInt16)
+_makeSetPb(Int8)
+_makeSetPb(UInt8)
+_makeSetPb(Bool)
+
+_makeSetPa(Complex64)
+_makeSetPa(Complex32)
+_makeSetPa(Float64)
+_makeSetPa(Float32)
+_makeSetPa(Int64)
+_makeSetPa(UInt64)
+_makeSetPa(Int32)
+_makeSetPa(UInt32)
+_makeSetPa(Int16)
+_makeSetPa(UInt16)
+_makeSetPa(Int8)
+_makeSetPa(UInt8)
+_makeSetPa(Bool)
+
+#undef _makeSetPb
+#undef _makeSetPa
+
+#ifdef __cplusplus
+ }
+#endif
+
+/* ========================== ptr get/set ================================ */
+
+/* byteswapping */
+#define NA_GETPb(ai, type, ptr) _NA_GETPb_##type(ptr)
+
+/* aligning */
+#define NA_GETPa(ai, type, ptr) _NA_GETPa_##type(ptr)
+
+/* fast (aligned, !byteswapped) */
+#define NA_GETPf(ai, type, ptr) (*((type *) (ptr)))
+
+#define NA_GETP(ai, type, ptr) \
+ (PyArray_ISCARRAY(ai) ? NA_GETPf(ai, type, ptr) \
+ : (PyArray_ISBYTESWAPPED(ai) ? \
+ NA_GETPb(ai, type, ptr) \
+ : NA_GETPa(ai, type, ptr)))
+
+/* NOTE: NA_SET* macros cannot be used as values. */
+
+/* byteswapping */
+#define NA_SETPb(ai, type, ptr, v) _NA_SETPb_##type(ptr, v)
+
+/* aligning */
+#define NA_SETPa(ai, type, ptr, v) _NA_SETPa_##type(ptr, v)
+
+/* fast (aligned, !byteswapped) */
+#define NA_SETPf(ai, type, ptr, v) ((*((type *) ptr)) = (v))
+
+#define NA_SETP(ai, type, ptr, v) \
+ if (PyArray_ISCARRAY(ai)) { \
+ NA_SETPf((ai), type, (ptr), (v)); \
+ } else if (PyArray_ISBYTESWAPPED(ai)) { \
+ NA_SETPb((ai), type, (ptr), (v)); \
+ } else \
+ NA_SETPa((ai), type, (ptr), (v))
+
+/* ========================== 1 index get/set ============================ */
+
+/* byteswapping */
+#define NA_GET1b(ai, type, i) NA_GETPb(ai, type, NA_PTR1(ai, i))
+/* aligning */
+#define NA_GET1a(ai, type, i) NA_GETPa(ai, type, NA_PTR1(ai, i))
+/* fast (aligned, !byteswapped) */
+#define NA_GET1f(ai, type, i) NA_GETPf(ai, type, NA_PTR1(ai, i))
+/* testing */
+#define NA_GET1(ai, type, i) NA_GETP(ai, type, NA_PTR1(ai, i))
+
+/* byteswapping */
+#define NA_SET1b(ai, type, i, v) NA_SETPb(ai, type, NA_PTR1(ai, i), v)
+/* aligning */
+#define NA_SET1a(ai, type, i, v) NA_SETPa(ai, type, NA_PTR1(ai, i), v)
+/* fast (aligned, !byteswapped) */
+#define NA_SET1f(ai, type, i, v) NA_SETPf(ai, type, NA_PTR1(ai, i), v)
+/* testing */
+#define NA_SET1(ai, type, i, v) NA_SETP(ai, type, NA_PTR1(ai, i), v)
+
+/* ========================== 2 index get/set ============================= */
+
+/* byteswapping */
+#define NA_GET2b(ai, type, i, j) NA_GETPb(ai, type, NA_PTR2(ai, i, j))
+/* aligning */
+#define NA_GET2a(ai, type, i, j) NA_GETPa(ai, type, NA_PTR2(ai, i, j))
+/* fast (aligned, !byteswapped) */
+#define NA_GET2f(ai, type, i, j) NA_GETPf(ai, type, NA_PTR2(ai, i, j))
+/* testing */
+#define NA_GET2(ai, type, i, j) NA_GETP(ai, type, NA_PTR2(ai, i, j))
+
+/* byteswapping */
+#define NA_SET2b(ai, type, i, j, v) NA_SETPb(ai, type, NA_PTR2(ai, i, j), v)
+/* aligning */
+#define NA_SET2a(ai, type, i, j, v) NA_SETPa(ai, type, NA_PTR2(ai, i, j), v)
+/* fast (aligned, !byteswapped) */
+#define NA_SET2f(ai, type, i, j, v) NA_SETPf(ai, type, NA_PTR2(ai, i, j), v)
+
+#define NA_SET2(ai, type, i, j, v) NA_SETP(ai, type, NA_PTR2(ai, i, j), v)
+
+/* ========================== 3 index get/set ============================= */
+
+/* byteswapping */
+#define NA_GET3b(ai, type, i, j, k) NA_GETPb(ai, type, NA_PTR3(ai, i, j, k))
+/* aligning */
+#define NA_GET3a(ai, type, i, j, k) NA_GETPa(ai, type, NA_PTR3(ai, i, j, k))
+/* fast (aligned, !byteswapped) */
+#define NA_GET3f(ai, type, i, j, k) NA_GETPf(ai, type, NA_PTR3(ai, i, j, k))
+/* testing */
+#define NA_GET3(ai, type, i, j, k) NA_GETP(ai, type, NA_PTR3(ai, i, j, k))
+
+/* byteswapping */
+#define NA_SET3b(ai, type, i, j, k, v) \
+ NA_SETPb(ai, type, NA_PTR3(ai, i, j, k), v)
+/* aligning */
+#define NA_SET3a(ai, type, i, j, k, v) \
+ NA_SETPa(ai, type, NA_PTR3(ai, i, j, k), v)
+/* fast (aligned, !byteswapped) */
+#define NA_SET3f(ai, type, i, j, k, v) \
+ NA_SETPf(ai, type, NA_PTR3(ai, i, j, k), v)
+#define NA_SET3(ai, type, i, j, k, v) \
+ NA_SETP(ai, type, NA_PTR3(ai, i, j, k), v)
+
+/* ========================== 1D get/set ================================== */
+
+#define NA_GET1Db(ai, type, base, cnt, out) \
+ { int i, stride = ai->strides[ai->nd-1]; \
+ for(i=0; i<cnt; i++) { \
+ out[i] = NA_GETPb(ai, type, base); \
+ base += stride; \
+ } \
+ }
+
+#define NA_GET1Da(ai, type, base, cnt, out) \
+ { int i, stride = ai->strides[ai->nd-1]; \
+ for(i=0; i<cnt; i++) { \
+ out[i] = NA_GETPa(ai, type, base); \
+ base += stride; \
+ } \
+ }
+
+#define NA_GET1Df(ai, type, base, cnt, out) \
+ { int i, stride = ai->strides[ai->nd-1]; \
+ for(i=0; i<cnt; i++) { \
+ out[i] = NA_GETPf(ai, type, base); \
+ base += stride; \
+ } \
+ }
+
+#define NA_GET1D(ai, type, base, cnt, out) \
+ if (PyArray_ISCARRAY(ai)) { \
+ NA_GET1Df(ai, type, base, cnt, out); \
+ } else if (PyArray_ISBYTESWAPPED(ai)) { \
+ NA_GET1Db(ai, type, base, cnt, out); \
+ } else { \
+ NA_GET1Da(ai, type, base, cnt, out); \
+ }
+
+#define NA_SET1Db(ai, type, base, cnt, in) \
+ { int i, stride = ai->strides[ai->nd-1]; \
+ for(i=0; i<cnt; i++) { \
+ NA_SETPb(ai, type, base, in[i]); \
+ base += stride; \
+ } \
+ }
+
+#define NA_SET1Da(ai, type, base, cnt, in) \
+ { int i, stride = ai->strides[ai->nd-1]; \
+ for(i=0; i<cnt; i++) { \
+ NA_SETPa(ai, type, base, in[i]); \
+ base += stride; \
+ } \
+ }
+
+#define NA_SET1Df(ai, type, base, cnt, in) \
+ { int i, stride = ai->strides[ai->nd-1]; \
+ for(i=0; i<cnt; i++) { \
+ NA_SETPf(ai, type, base, in[i]); \
+ base += stride; \
+ } \
+ }
+
+#define NA_SET1D(ai, type, base, cnt, out) \
+ if (PyArray_ISCARRAY(ai)) { \
+ NA_SET1Df(ai, type, base, cnt, out); \
+ } else if (PyArray_ISBYTESWAPPED(ai)) { \
+ NA_SET1Db(ai, type, base, cnt, out); \
+ } else { \
+ NA_SET1Da(ai, type, base, cnt, out); \
+ }
+
+/* ========================== utilities ================================== */
+
+#if !defined(MIN)
+#define MIN(x,y) (((x)<=(y)) ? (x) : (y))
+#endif
+
+#if !defined(MAX)
+#define MAX(x,y) (((x)>=(y)) ? (x) : (y))
+#endif
+
+#if !defined(ABS)
+#define ABS(x) (((x) >= 0) ? (x) : -(x))
+#endif
+
+#define ELEM(x) (sizeof(x)/sizeof(x[0]))
+
+#define BOOLEAN_BITWISE_NOT(x) ((x) ^ 1)
+
+#define NA_NBYTES(a) (a->descr->elsize * NA_elements(a))
+
+#if defined(NA_SMP)
+#define BEGIN_THREADS Py_BEGIN_ALLOW_THREADS
+#define END_THREADS Py_END_ALLOW_THREADS
+#else
+#define BEGIN_THREADS
+#define END_THREADS
+#endif
+
+#if !defined(NA_isnan)
+
+#define U32(u) (* (Int32 *) &(u) )
+#define U64(u) (* (Int64 *) &(u) )
+
+#define NA_isnan32(u) \
+ ( (( U32(u) & 0x7f800000) == 0x7f800000) && ((U32(u) & 0x007fffff) != 0)) ? 1:0
+
+#if !defined(_MSC_VER)
+#define NA_isnan64(u) \
+ ( (( U64(u) & 0x7ff0000000000000LL) == 0x7ff0000000000000LL) && ((U64(u) & 0x000fffffffffffffLL) != 0)) ? 1:0
+#else
+#define NA_isnan64(u) \
+ ( (( U64(u) & 0x7ff0000000000000i64) == 0x7ff0000000000000i64) && ((U64(u) & 0x000fffffffffffffi64) != 0)) ? 1:0
+#endif
+
+#define NA_isnanC32(u) (NA_isnan32(((Complex32 *)&(u))->r) || NA_isnan32(((Complex32 *)&(u))->i))
+#define NA_isnanC64(u) (NA_isnan64(((Complex64 *)&(u))->r) || NA_isnan64(((Complex64 *)&(u))->i))
+
+#endif /* NA_isnan */
+
+
+#endif /* _ndarraymacro */
diff --git a/numpy/numarray/random_array.py b/numpy/numarray/random_array.py
new file mode 100644
index 000000000..d70e2694a
--- /dev/null
+++ b/numpy/numarray/random_array.py
@@ -0,0 +1,9 @@
+
+__all__ = ['ArgumentError', 'F', 'beta', 'binomial', 'chi_square',
+ 'exponential', 'gamma', 'get_seed', 'multinomial',
+ 'multivariate_normal', 'negative_binomial', 'noncentral_F',
+ 'noncentral_chi_square', 'normal', 'permutation', 'poisson',
+ 'randint', 'random', 'random_integers', 'standard_normal',
+ 'uniform', 'seed']
+
+from numpy.oldnumeric.random_array import *
diff --git a/numpy/numarray/session.py b/numpy/numarray/session.py
new file mode 100644
index 000000000..ee155f9dc
--- /dev/null
+++ b/numpy/numarray/session.py
@@ -0,0 +1,348 @@
+""" This module contains a "session saver" which saves the state of a
+NumPy session to a file. At a later time, a different Python
+process can be started and the saved session can be restored using
+load().
+
+The session saver relies on the Python pickle protocol to save and
+restore objects. Objects which are not themselves picklable (e.g.
+modules) can sometimes be saved by "proxy", particularly when they
+are global constants of some kind. If it's not known that proxying
+will work, a warning is issued at save time. If a proxy fails to
+reload properly (e.g. because it's not a global constant), a warning
+is issued at reload time and that name is bound to a _ProxyFailure
+instance which tries to identify what should have been restored.
+
+First, some unfortunate (probably unnecessary) concessions to doctest
+to keep the test run free of warnings.
+
+>>> del _PROXY_ALLOWED
+>>> del copy
+>>> del __builtins__
+
+By default, save() stores every variable in the caller's namespace:
+
+>>> import numpy as na
+>>> a = na.arange(10)
+>>> save()
+
+Alternately, save() can be passed a comma seperated string of variables:
+
+>>> save("a,na")
+
+Alternately, save() can be passed a dictionary, typically one you already
+have lying around somewhere rather than created inline as shown here:
+
+>>> save(dictionary={"a":a,"na":na})
+
+If both variables and a dictionary are specified, the variables to be
+saved are taken from the dictionary.
+
+>>> save(variables="a,na",dictionary={"a":a,"na":na})
+
+Remove names from the session namespace
+
+>>> del a, na
+
+By default, load() restores every variable/object in the session file
+to the caller's namespace.
+
+>>> load()
+
+load() can be passed a comma seperated string of variables to be
+restored from the session file to the caller's namespace:
+
+>>> load("a,na")
+
+load() can also be passed a dictionary to *restore to*:
+
+>>> d = {}
+>>> load(dictionary=d)
+
+load can be passed both a list variables of variables to restore and a
+dictionary to restore to:
+
+>>> load(variables="a,na", dictionary=d)
+
+>>> na.all(a == na.arange(10))
+1
+>>> na.__name__
+'numpy'
+
+NOTE: session saving is faked for modules using module proxy objects.
+Saved modules are re-imported at load time but any "state" in the module
+which is not restored by a simple import is lost.
+
+"""
+
+__all__ = ['load', 'save']
+
+import copy
+import sys
+import pickle
+
+SAVEFILE="session.dat"
+VERBOSE = False # global import-time override
+
+def _foo(): pass
+
+_PROXY_ALLOWED = (type(sys), # module
+ type(_foo), # function
+ type(None)) # None
+
+def _update_proxy_types():
+ """Suppress warnings for known un-picklables with working proxies."""
+ pass
+
+def _unknown(_type):
+ """returns True iff _type isn't known as OK to proxy"""
+ return (_type is not None) and (_type not in _PROXY_ALLOWED)
+
+# caller() from the following article with one extra f_back added.
+# from http://www.python.org/search/hypermail/python-1994q1/0506.html
+# SUBJECT: import ( how to put a symbol into caller's namespace )
+# SENDER: Steven D. Majewski (sdm7g@elvis.med.virginia.edu)
+# DATE: Thu, 24 Mar 1994 15:38:53 -0500
+
+def _caller():
+ """caller() returns the frame object of the function's caller."""
+ try:
+ 1 + '' # make an error happen
+ except: # and return the caller's caller's frame
+ return sys.exc_traceback.tb_frame.f_back.f_back.f_back
+
+def _callers_globals():
+ """callers_globals() returns the global dictionary of the caller."""
+ frame = _caller()
+ return frame.f_globals
+
+def _callers_modules():
+ """returns a list containing the names of all the modules in the caller's
+ global namespace."""
+ g = _callers_globals()
+ mods = []
+ for k,v in g.items():
+ if type(v) == type(sys):
+ mods.append(getattr(v,"__name__"))
+ return mods
+
+def _errout(*args):
+ for a in args:
+ print >>sys.stderr, a,
+ print >>sys.stderr
+
+def _verbose(*args):
+ if VERBOSE:
+ _errout(*args)
+
+class _ProxyingFailure:
+ """Object which is bound to a variable for a proxy pickle which failed to reload"""
+ def __init__(self, module, name, type=None):
+ self.module = module
+ self.name = name
+ self.type = type
+ def __repr__(self):
+ return "ProxyingFailure('%s','%s','%s')" % (self.module, self.name, self.type)
+
+class _ModuleProxy(object):
+ """Proxy object which fakes pickling a module"""
+ def __new__(_type, name, save=False):
+ if save:
+ _verbose("proxying module", name)
+ self = object.__new__(_type)
+ self.name = name
+ else:
+ _verbose("loading module proxy", name)
+ try:
+ self = _loadmodule(name)
+ except ImportError:
+ _errout("warning: module", name,"import failed.")
+ return self
+
+ def __getnewargs__(self):
+ return (self.name,)
+
+ def __getstate__(self):
+ return False
+
+def _loadmodule(module):
+ if not sys.modules.has_key(module):
+ modules = module.split(".")
+ s = ""
+ for i in range(len(modules)):
+ s = ".".join(modules[:i+1])
+ exec "import " + s
+ return sys.modules[module]
+
+class _ObjectProxy(object):
+ """Proxy object which fakes pickling an arbitrary object. Only global
+ constants can really be proxied."""
+ def __new__(_type, module, name, _type2, save=False):
+ if save:
+ if _unknown(_type2):
+ _errout("warning: proxying object", module + "." + name,
+ "of type", _type2, "because it wouldn't pickle...",
+ "it may not reload later.")
+ else:
+ _verbose("proxying object", module, name)
+ self = object.__new__(_type)
+ self.module, self.name, self.type = module, name, str(_type2)
+ else:
+ _verbose("loading object proxy", module, name)
+ try:
+ m = _loadmodule(module)
+ except (ImportError, KeyError):
+ _errout("warning: loading object proxy", module + "." + name,
+ "module import failed.")
+ return _ProxyingFailure(module,name,_type2)
+ try:
+ self = getattr(m, name)
+ except AttributeError:
+ _errout("warning: object proxy", module + "." + name,
+ "wouldn't reload from", m)
+ return _ProxyingFailure(module,name,_type2)
+ return self
+
+ def __getnewargs__(self):
+ return (self.module, self.name, self.type)
+
+ def __getstate__(self):
+ return False
+
+
+class _SaveSession(object):
+ """Tag object which marks the end of a save session and holds the
+ saved session variable names as a list of strings in the same
+ order as the session pickles."""
+ def __new__(_type, keys, save=False):
+ if save:
+ _verbose("saving session", keys)
+ else:
+ _verbose("loading session", keys)
+ self = object.__new__(_type)
+ self.keys = keys
+ return self
+
+ def __getnewargs__(self):
+ return (self.keys,)
+
+ def __getstate__(self):
+ return False
+
+class ObjectNotFound(RuntimeError):
+ pass
+
+def _locate(modules, object):
+ for mname in modules:
+ m = sys.modules[mname]
+ if m:
+ for k,v in m.__dict__.items():
+ if v is object:
+ return m.__name__, k
+ else:
+ raise ObjectNotFound(k)
+
+def save(variables=None, file=SAVEFILE, dictionary=None, verbose=False):
+
+ """saves variables from a numpy session to a file. Variables
+ which won't pickle are "proxied" if possible.
+
+ 'variables' a string of comma seperated variables: e.g. "a,b,c"
+ Defaults to dictionary.keys().
+
+ 'file' a filename or file object for the session file.
+
+ 'dictionary' the dictionary in which to look up the variables.
+ Defaults to the caller's globals()
+
+ 'verbose' print additional debug output when True.
+ """
+
+ global VERBOSE
+ VERBOSE = verbose
+
+ _update_proxy_types()
+
+ if isinstance(file, str):
+ file = open(file, "wb")
+
+ if dictionary is None:
+ dictionary = _callers_globals()
+
+ if variables is None:
+ keys = dictionary.keys()
+ else:
+ keys = variables.split(",")
+
+ source_modules = _callers_modules() + sys.modules.keys()
+
+ p = pickle.Pickler(file, protocol=2)
+
+ _verbose("variables:",keys)
+ for k in keys:
+ v = dictionary[k]
+ _verbose("saving", k, type(v))
+ try: # Try to write an ordinary pickle
+ p.dump(v)
+ _verbose("pickled", k)
+ except (pickle.PicklingError, TypeError, SystemError):
+ # Use proxies for stuff that won't pickle
+ if isinstance(v, type(sys)): # module
+ proxy = _ModuleProxy(v.__name__, save=True)
+ else:
+ try:
+ module, name = _locate(source_modules, v)
+ except ObjectNotFound:
+ _errout("warning: couldn't find object",k,
+ "in any module... skipping.")
+ continue
+ else:
+ proxy = _ObjectProxy(module, name, type(v), save=True)
+ p.dump(proxy)
+ o = _SaveSession(keys, save=True)
+ p.dump(o)
+ file.close()
+
+def load(variables=None, file=SAVEFILE, dictionary=None, verbose=False):
+
+ """load a numpy session from a file and store the specified
+ 'variables' into 'dictionary'.
+
+ 'variables' a string of comma seperated variables: e.g. "a,b,c"
+ Defaults to dictionary.keys().
+
+ 'file' a filename or file object for the session file.
+
+ 'dictionary' the dictionary in which to look up the variables.
+ Defaults to the caller's globals()
+
+ 'verbose' print additional debug output when True.
+ """
+
+ global VERBOSE
+ VERBOSE = verbose
+
+ if isinstance(file, str):
+ file = open(file, "rb")
+ if dictionary is None:
+ dictionary = _callers_globals()
+ values = []
+ p = pickle.Unpickler(file)
+ while 1:
+ o = p.load()
+ if isinstance(o, _SaveSession):
+ session = dict(zip(o.keys, values))
+ _verbose("updating dictionary with session variables.")
+ if variables is None:
+ keys = session.keys()
+ else:
+ keys = variables.split(",")
+ for k in keys:
+ dictionary[k] = session[k]
+ return None
+ else:
+ _verbose("unpickled object", str(o))
+ values.append(o)
+
+def test():
+ import doctest, numpy.numarray.session
+ return doctest.testmod(numpy.numarray.session)
diff --git a/numpy/numarray/setup.py b/numpy/numarray/setup.py
new file mode 100644
index 000000000..69cd6bea1
--- /dev/null
+++ b/numpy/numarray/setup.py
@@ -0,0 +1,17 @@
+from os.path import join
+
+def configuration(parent_package='',top_path=None):
+ from numpy.distutils.misc_util import Configuration
+ config = Configuration('numarray',parent_package,top_path)
+
+ config.add_data_files('numpy/')
+
+ config.add_extension('_capi',
+ sources=['_capi.c'],
+ )
+
+ return config
+
+if __name__ == '__main__':
+ from numpy.distutils.core import setup
+ setup(configuration=configuration)
diff --git a/numpy/numarray/ufuncs.py b/numpy/numarray/ufuncs.py
new file mode 100644
index 000000000..3fb5671ce
--- /dev/null
+++ b/numpy/numarray/ufuncs.py
@@ -0,0 +1,22 @@
+
+__all__ = ['abs', 'absolute', 'add', 'arccos', 'arccosh', 'arcsin', 'arcsinh',
+ 'arctan', 'arctan2', 'arctanh', 'bitwise_and', 'bitwise_not',
+ 'bitwise_or', 'bitwise_xor', 'ceil', 'cos', 'cosh', 'divide',
+ 'equal', 'exp', 'fabs', 'floor', 'floor_divide',
+ 'fmod', 'greater', 'greater_equal', 'hypot', 'isnan',
+ 'less', 'less_equal', 'log', 'log10', 'logical_and', 'logical_not',
+ 'logical_or', 'logical_xor', 'lshift', 'maximum', 'minimum',
+ 'minus', 'multiply', 'negative', 'not_equal',
+ 'power', 'product', 'remainder', 'rshift', 'sin', 'sinh', 'sqrt',
+ 'subtract', 'sum', 'tan', 'tanh', 'true_divide',
+ 'conjugate', 'sign']
+
+from numpy import absolute as abs, absolute, add, arccos, arccosh, arcsin, \
+ arcsinh, arctan, arctan2, arctanh, bitwise_and, invert as bitwise_not, \
+ bitwise_or, bitwise_xor, ceil, cos, cosh, divide, \
+ equal, exp, fabs, floor, floor_divide, fmod, greater, greater_equal, \
+ hypot, isnan, less, less_equal, log, log10, logical_and, \
+ logical_not, logical_or, logical_xor, left_shift as lshift, \
+ maximum, minimum, negative as minus, multiply, negative, \
+ not_equal, power, product, remainder, right_shift as rshift, sin, \
+ sinh, sqrt, subtract, sum, tan, tanh, true_divide, conjugate, sign
diff --git a/numpy/numarray/util.py b/numpy/numarray/util.py
new file mode 100644
index 000000000..2a7efb60d
--- /dev/null
+++ b/numpy/numarray/util.py
@@ -0,0 +1,40 @@
+from numpy import geterr
+
+__all__ = ['MathDomainError', 'UnderflowError', 'NumOverflowError', 'handleError',
+ 'get_numarray_include_dirs']
+
+class MathDomainError(ArithmeticError): pass
+class UnderflowError(ArithmeticError): pass
+class NumOverflowError(OverflowError, ArithmeticError): pass
+
+def handleError(errorStatus, sourcemsg):
+ """Take error status and use error mode to handle it."""
+ modes = geterr()
+ if errorStatus & FPE_INVALID:
+ if modes['invalid'] == "warn":
+ print "Warning: Encountered invalid numeric result(s)", sourcemsg
+ if modes['invalid'] == "raise":
+ raise MathDomainError(sourcemsg)
+ if errorStatus & FPE_DIVIDEBYZERO:
+ if modes['dividebyzero'] == "warn":
+ print "Warning: Encountered divide by zero(s)", sourcemsg
+ if modes['dividebyzero'] == "raise":
+ raise ZeroDivisionError(sourcemsg)
+ if errorStatus & FPE_OVERFLOW:
+ if modes['overflow'] == "warn":
+ print "Warning: Encountered overflow(s)", sourcemsg
+ if modes['overflow'] == "raise":
+ raise NumOverflowError(sourcemsg)
+ if errorStatus & FPE_UNDERFLOW:
+ if modes['underflow'] == "warn":
+ print "Warning: Encountered underflow(s)", sourcemsg
+ if modes['underflow'] == "raise":
+ raise UnderflowError(sourcemsg)
+
+
+import os
+import numpy
+def get_numarray_include_dirs():
+ base = os.path.dirname(numpy.__file__)
+ newdirs = [os.path.join(base, 'numarray')]
+ return newdirs
diff --git a/numpy/oldnumeric/__init__.py b/numpy/oldnumeric/__init__.py
new file mode 100644
index 000000000..83819ad04
--- /dev/null
+++ b/numpy/oldnumeric/__init__.py
@@ -0,0 +1,41 @@
+# Don't add these to the __all__ variable though
+from numpy import *
+
+def _move_axis_to_0(a, axis):
+ if axis == 0:
+ return a
+ n = len(a.shape)
+ if axis < 0:
+ axis += n
+ axes = range(1, axis+1) + [0,] + range(axis+1, n)
+ return transpose(a, axes)
+
+# Add these
+from compat import *
+from functions import *
+from precision import *
+from ufuncs import *
+from misc import *
+
+import compat
+import precision
+import functions
+import misc
+import ufuncs
+
+import numpy
+__version__ = numpy.__version__
+del numpy
+
+__all__ = ['__version__']
+__all__ += compat.__all__
+__all__ += precision.__all__
+__all__ += functions.__all__
+__all__ += ufuncs.__all__
+__all__ += misc.__all__
+
+del compat
+del functions
+del precision
+del ufuncs
+del misc
diff --git a/numpy/oldnumeric/alter_code1.py b/numpy/oldnumeric/alter_code1.py
new file mode 100644
index 000000000..87538a855
--- /dev/null
+++ b/numpy/oldnumeric/alter_code1.py
@@ -0,0 +1,240 @@
+"""
+This module converts code written for Numeric to run with numpy
+
+Makes the following changes:
+ * Changes import statements (warns of use of from Numeric import *)
+ * Changes import statements (using numerix) ...
+ * Makes search and replace changes to:
+ - .typecode()
+ - .iscontiguous()
+ - .byteswapped()
+ - .itemsize()
+ - .toscalar()
+ * Converts .flat to .ravel() except for .flat = xxx or .flat[xxx]
+ * Replace xxx.spacesaver() with True
+ * Convert xx.savespace(?) to pass + ## xx.savespace(?)
+
+ * Converts uses of 'b' to 'B' in the typecode-position of
+ functions:
+ eye, tri (in position 4)
+ ones, zeros, identity, empty, array, asarray, arange,
+ fromstring, indices, array_constructor (in position 2)
+
+ and methods:
+ astype --- only argument
+ -- converts uses of '1', 's', 'w', and 'u' to
+ -- 'b', 'h', 'H', and 'I'
+
+ * Converts uses of type(...) is <type>
+ isinstance(..., <type>)
+"""
+__all__ = ['convertfile', 'convertall', 'converttree', 'convertsrc']
+
+import sys
+import os
+import re
+import glob
+
+
+_func4 = ['eye', 'tri']
+_meth1 = ['astype']
+_func2 = ['ones', 'zeros', 'identity', 'fromstring', 'indices',
+ 'empty', 'array', 'asarray', 'arange', 'array_constructor']
+
+_chars = {'1':'b','s':'h','w':'H','u':'I'}
+
+func_re = {}
+meth_re = {}
+
+for name in _func2:
+ _astr = r"""(%s\s*[(][^,]*?[,][^'"]*?['"])b(['"][^)]*?[)])"""%name
+ func_re[name] = re.compile(_astr, re.DOTALL)
+
+for name in _func4:
+ _astr = r"""(%s\s*[(][^,]*?[,][^,]*?[,][^,]*?[,][^'"]*?['"])b(['"][^)]*?[)])"""%name
+ func_re[name] = re.compile(_astr, re.DOTALL)
+
+for name in _meth1:
+ _astr = r"""(.%s\s*[(][^'"]*?['"])b(['"][^)]*?[)])"""%name
+ func_re[name] = re.compile(_astr, re.DOTALL)
+
+for char in _chars.keys():
+ _astr = r"""(.astype\s*[(][^'"]*?['"])%s(['"][^)]*?[)])"""%char
+ meth_re[char] = re.compile(_astr, re.DOTALL)
+
+def fixtypechars(fstr):
+ for name in _func2 + _func4 + _meth1:
+ fstr = func_re[name].sub('\\1B\\2',fstr)
+ for char in _chars.keys():
+ fstr = meth_re[char].sub('\\1%s\\2'%_chars[char], fstr)
+ return fstr
+
+flatindex_re = re.compile('([.]flat(\s*?[[=]))')
+
+def changeimports(fstr, name, newname):
+ importstr = 'import %s' % name
+ importasstr = 'import %s as ' % name
+ fromstr = 'from %s import ' % name
+ fromall=0
+
+ fstr = re.sub(r'(import\s+[^,\n\r]+,\s*)(%s)' % name,
+ "\\1%s as %s" % (newname, name), fstr)
+ fstr = fstr.replace(importasstr, 'import %s as ' % newname)
+ fstr = fstr.replace(importstr, 'import %s as %s' % (newname,name))
+
+ ind = 0
+ Nlen = len(fromstr)
+ Nlen2 = len("from %s import " % newname)
+ while 1:
+ found = fstr.find(fromstr,ind)
+ if (found < 0):
+ break
+ ind = found + Nlen
+ if fstr[ind] == '*':
+ continue
+ fstr = "%sfrom %s import %s" % (fstr[:found], newname, fstr[ind:])
+ ind += Nlen2 - Nlen
+ return fstr, fromall
+
+istest_re = {}
+_types = ['float', 'int', 'complex', 'ArrayType', 'FloatType',
+ 'IntType', 'ComplexType']
+for name in _types:
+ _astr = r'type\s*[(]([^)]*)[)]\s+(?:is|==)\s+(.*?%s)'%name
+ istest_re[name] = re.compile(_astr)
+def fixistesting(astr):
+ for name in _types:
+ astr = istest_re[name].sub('isinstance(\\1, \\2)', astr)
+ return astr
+
+def replaceattr(astr):
+ astr = astr.replace(".typecode()",".dtype.char")
+ astr = astr.replace(".iscontiguous()",".flags.contiguous")
+ astr = astr.replace(".byteswapped()",".byteswap()")
+ astr = astr.replace(".toscalar()", ".item()")
+ astr = astr.replace(".itemsize()",".itemsize")
+ # preserve uses of flat that should be o.k.
+ tmpstr = flatindex_re.sub(r"@@@@\2",astr)
+ # replace other uses of flat
+ tmpstr = tmpstr.replace(".flat",".ravel()")
+ # put back .flat where it was valid
+ astr = tmpstr.replace("@@@@", ".flat")
+ return astr
+
+svspc2 = re.compile(r'([^,(\s]+[.]spacesaver[(][)])')
+svspc3 = re.compile(r'(\S+[.]savespace[(].*[)])')
+#shpe = re.compile(r'(\S+\s*)[.]shape\s*=[^=]\s*(.+)')
+def replaceother(astr):
+ astr = svspc2.sub('True',astr)
+ astr = svspc3.sub(r'pass ## \1', astr)
+ #astr = shpe.sub('\\1=\\1.reshape(\\2)', astr)
+ return astr
+
+import datetime
+def fromstr(filestr):
+ savestr = filestr[:]
+ filestr = fixtypechars(filestr)
+ filestr = fixistesting(filestr)
+ filestr, fromall1 = changeimports(filestr, 'Numeric', 'numpy.oldnumeric')
+ filestr, fromall1 = changeimports(filestr, 'multiarray','numpy.oldnumeric')
+ filestr, fromall1 = changeimports(filestr, 'umath', 'numpy.oldnumeric')
+ filestr, fromall1 = changeimports(filestr, 'Precision', 'numpy.oldnumeric.precision')
+ filestr, fromall1 = changeimports(filestr, 'UserArray', 'numpy.oldnumeric.user_array')
+ filestr, fromall1 = changeimports(filestr, 'ArrayPrinter', 'numpy.oldnumeric.array_printer')
+ filestr, fromall2 = changeimports(filestr, 'numerix', 'numpy.oldnumeric')
+ filestr, fromall3 = changeimports(filestr, 'scipy_base', 'numpy.oldnumeric')
+ filestr, fromall3 = changeimports(filestr, 'Matrix', 'numpy.oldnumeric.matrix')
+ filestr, fromall3 = changeimports(filestr, 'MLab', 'numpy.oldnumeric.mlab')
+ filestr, fromall3 = changeimports(filestr, 'LinearAlgebra', 'numpy.oldnumeric.linear_algebra')
+ filestr, fromall3 = changeimports(filestr, 'RNG', 'numpy.oldnumeric.rng')
+ filestr, fromall3 = changeimports(filestr, 'RNG.Statistics', 'numpy.oldnumeric.rng_stats')
+ filestr, fromall3 = changeimports(filestr, 'RandomArray', 'numpy.oldnumeric.random_array')
+ filestr, fromall3 = changeimports(filestr, 'FFT', 'numpy.oldnumeric.fft')
+ filestr, fromall3 = changeimports(filestr, 'MA', 'numpy.oldnumeric.ma')
+ fromall = fromall1 or fromall2 or fromall3
+ filestr = replaceattr(filestr)
+ filestr = replaceother(filestr)
+ if savestr != filestr:
+ today = datetime.date.today().strftime('%b %d, %Y')
+ name = os.path.split(sys.argv[0])[-1]
+ filestr = '## Automatically adapted for '\
+ 'numpy.oldnumeric %s by %s\n\n%s' % (today, name, filestr)
+ return filestr, 1
+ return filestr, 0
+
+def makenewfile(name, filestr):
+ fid = file(name, 'w')
+ fid.write(filestr)
+ fid.close()
+
+def convertfile(filename, orig=1):
+ """Convert the filename given from using Numeric to using NumPy
+
+ Copies the file to filename.orig and then over-writes the file
+ with the updated code
+ """
+ fid = open(filename)
+ filestr = fid.read()
+ fid.close()
+ filestr, changed = fromstr(filestr)
+ if changed:
+ if orig:
+ base, ext = os.path.splitext(filename)
+ os.rename(filename, base+".orig")
+ else:
+ os.remove(filename)
+ makenewfile(filename, filestr)
+
+def fromargs(args):
+ filename = args[1]
+ converttree(filename)
+
+def convertall(direc=os.path.curdir, orig=1):
+ """Convert all .py files to use numpy.oldnumeric (from Numeric) in the directory given
+
+ For each changed file, a backup of <usesnumeric>.py is made as
+ <usesnumeric>.py.orig. A new file named <usesnumeric>.py
+ is then written with the updated code.
+ """
+ files = glob.glob(os.path.join(direc,'*.py'))
+ for afile in files:
+ if afile[-8:] == 'setup.py': continue # skip these
+ convertfile(afile, orig)
+
+header_re = re.compile(r'(Numeric/arrayobject.h)')
+
+def convertsrc(direc=os.path.curdir, ext=None, orig=1):
+ """Replace Numeric/arrayobject.h with numpy/oldnumeric.h in all files in the
+ directory with extension give by list ext (if ext is None, then all files are
+ replaced)."""
+ if ext is None:
+ files = glob.glob(os.path.join(direc,'*'))
+ else:
+ files = []
+ for aext in ext:
+ files.extend(glob.glob(os.path.join(direc,"*.%s" % aext)))
+ for afile in files:
+ fid = open(afile)
+ fstr = fid.read()
+ fid.close()
+ fstr, n = header_re.subn(r'numpy/oldnumeric.h',fstr)
+ if n > 0:
+ if orig:
+ base, ext = os.path.splitext(afile)
+ os.rename(afile, base+".orig")
+ else:
+ os.remove(afile)
+ makenewfile(afile, fstr)
+
+def _func(arg, dirname, fnames):
+ convertall(dirname, orig=0)
+ convertsrc(dirname, ext=['h','c'], orig=0)
+
+def converttree(direc=os.path.curdir):
+ """Convert all .py files and source code files in the tree given
+ """
+ os.path.walk(direc, _func, None)
+
+
+if __name__ == '__main__':
+ fromargs(sys.argv)
diff --git a/numpy/oldnumeric/alter_code2.py b/numpy/oldnumeric/alter_code2.py
new file mode 100644
index 000000000..baa6b9d26
--- /dev/null
+++ b/numpy/oldnumeric/alter_code2.py
@@ -0,0 +1,146 @@
+"""
+This module converts code written for numpy.oldnumeric to work
+with numpy
+
+FIXME: Flesh this out.
+
+Makes the following changes:
+ * Converts typecharacters '1swu' to 'bhHI' respectively
+ when used as typecodes
+ * Changes import statements
+ * Change typecode= to dtype=
+ * Eliminates savespace=xxx keyword arguments
+ * Removes it when keyword is not given as well
+ * replaces matrixmultiply with dot
+ * converts functions that don't give axis= keyword that have changed
+ * converts functions that don't give typecode= keyword that have changed
+ * converts use of capitalized type-names
+ * converts old function names in oldnumeric.linear_algebra,
+ oldnumeric.random_array, and oldnumeric.fft
+
+"""
+#__all__ = ['convertfile', 'convertall', 'converttree']
+__all__ = []
+
+import warnings
+warnings.warn("numpy.oldnumeric.alter_code2 is not working yet.")
+
+import sys
+import os
+import re
+import glob
+
+# To convert typecharacters we need to
+# Not very safe. Disabled for now..
+def replacetypechars(astr):
+ astr = astr.replace("'s'","'h'")
+ astr = astr.replace("'b'","'B'")
+ astr = astr.replace("'1'","'b'")
+ astr = astr.replace("'w'","'H'")
+ astr = astr.replace("'u'","'I'")
+ return astr
+
+def changeimports(fstr, name, newname):
+ importstr = 'import %s' % name
+ importasstr = 'import %s as ' % name
+ fromstr = 'from %s import ' % name
+ fromall=0
+
+ fstr = fstr.replace(importasstr, 'import %s as ' % newname)
+ fstr = fstr.replace(importstr, 'import %s as %s' % (newname,name))
+
+ ind = 0
+ Nlen = len(fromstr)
+ Nlen2 = len("from %s import " % newname)
+ while 1:
+ found = fstr.find(fromstr,ind)
+ if (found < 0):
+ break
+ ind = found + Nlen
+ if fstr[ind] == '*':
+ continue
+ fstr = "%sfrom %s import %s" % (fstr[:found], newname, fstr[ind:])
+ ind += Nlen2 - Nlen
+ return fstr, fromall
+
+def replaceattr(astr):
+ astr = astr.replace("matrixmultiply","dot")
+ return astr
+
+def replaceother(astr):
+ astr = re.sub(r'typecode\s*=', 'dtype=', astr)
+ astr = astr.replace('ArrayType', 'ndarray')
+ astr = astr.replace('NewAxis', 'newaxis')
+ return astr
+
+import datetime
+def fromstr(filestr):
+ #filestr = replacetypechars(filestr)
+ filestr, fromall1 = changeimports(filestr, 'numpy.oldnumeric', 'numpy')
+ filestr, fromall1 = changeimports(filestr, 'numpy.core.multiarray', 'numpy')
+ filestr, fromall1 = changeimports(filestr, 'numpy.core.umath', 'numpy')
+ filestr, fromall3 = changeimports(filestr, 'LinearAlgebra',
+ 'numpy.linalg.old')
+ filestr, fromall3 = changeimports(filestr, 'RNG', 'numpy.random.oldrng')
+ filestr, fromall3 = changeimports(filestr, 'RNG.Statistics', 'numpy.random.oldrngstats')
+ filestr, fromall3 = changeimports(filestr, 'RandomArray', 'numpy.random.oldrandomarray')
+ filestr, fromall3 = changeimports(filestr, 'FFT', 'numpy.fft.old')
+ filestr, fromall3 = changeimports(filestr, 'MA', 'numpy.core.ma')
+ fromall = fromall1 or fromall2 or fromall3
+ filestr = replaceattr(filestr)
+ filestr = replaceother(filestr)
+ today = datetime.date.today().strftime('%b %d, %Y')
+ name = os.path.split(sys.argv[0])[-1]
+ filestr = '## Automatically adapted for '\
+ 'numpy %s by %s\n\n%s' % (today, name, filestr)
+ return filestr
+
+def makenewfile(name, filestr):
+ fid = file(name, 'w')
+ fid.write(filestr)
+ fid.close()
+
+def getandcopy(name):
+ fid = file(name)
+ filestr = fid.read()
+ fid.close()
+ base, ext = os.path.splitext(name)
+ makenewfile(base+'.orig', filestr)
+ return filestr
+
+def convertfile(filename):
+ """Convert the filename given from using Numeric to using NumPy
+
+ Copies the file to filename.orig and then over-writes the file
+ with the updated code
+ """
+ filestr = getandcopy(filename)
+ filestr = fromstr(filestr)
+ makenewfile(filename, filestr)
+
+def fromargs(args):
+ filename = args[1]
+ convertfile(filename)
+
+def convertall(direc=os.path.curdir):
+ """Convert all .py files to use NumPy (from Numeric) in the directory given
+
+ For each file, a backup of <usesnumeric>.py is made as
+ <usesnumeric>.py.orig. A new file named <usesnumeric>.py
+ is then written with the updated code.
+ """
+ files = glob.glob(os.path.join(direc,'*.py'))
+ for afile in files:
+ convertfile(afile)
+
+def _func(arg, dirname, fnames):
+ convertall(dirname)
+
+def converttree(direc=os.path.curdir):
+ """Convert all .py files in the tree given
+
+ """
+ os.path.walk(direc, _func, None)
+
+if __name__ == '__main__':
+ fromargs(sys.argv)
diff --git a/numpy/oldnumeric/array_printer.py b/numpy/oldnumeric/array_printer.py
new file mode 100644
index 000000000..95f3f42c7
--- /dev/null
+++ b/numpy/oldnumeric/array_printer.py
@@ -0,0 +1,16 @@
+
+__all__ = ['array2string']
+
+from numpy import array2string as _array2string
+
+def array2string(a, max_line_width=None, precision=None,
+ suppress_small=None, separator=' ',
+ array_output=0):
+ if array_output:
+ prefix="array("
+ style=repr
+ else:
+ prefix = ""
+ style=str
+ return _array2string(a, max_line_width, precision,
+ suppress_small, separator, prefix, style)
diff --git a/numpy/oldnumeric/arrayfns.py b/numpy/oldnumeric/arrayfns.py
new file mode 100644
index 000000000..e80246a57
--- /dev/null
+++ b/numpy/oldnumeric/arrayfns.py
@@ -0,0 +1,98 @@
+"""Backward compatible with arrayfns from Numeric
+"""
+
+__all__ = ['array_set', 'construct3', 'digitize', 'error', 'find_mask', 'histogram', 'index_sort',
+ 'interp', 'nz', 'reverse', 'span', 'to_corners', 'zmin_zmax']
+
+import numpy as nx
+from numpy import asarray
+
+class error(Exception):
+ pass
+
+def array_set(vals1, indices, vals2):
+ indices = asarray(indices)
+ if indices.ndim != 1:
+ raise ValueError, "index array must be 1-d"
+ if not isinstance(vals1, ndarray):
+ raise TypeError, "vals1 must be an ndarray"
+ vals1 = asarray(vals1)
+ vals2 = asarray(vals2)
+ if vals1.ndim != vals2.ndim or vals1.ndim < 1:
+ raise error, "vals1 and vals2 must have same number of dimensions (>=1)"
+ vals1[indices] = vals2
+
+from numpy import digitize
+from numpy import bincount as histogram
+
+def index_sort(arr):
+ return asarray(arr).argsort(kind='heap')
+
+def interp(y, x, z, typ=None):
+ """y(z) interpolated by treating y(x) as piecewise function
+ """
+ res = numpy.interp(z, x, y)
+ if typ is None or typ == 'd':
+ return res
+ if typ == 'f':
+ return res.astype('f')
+
+ raise error, "incompatible typecode"
+
+def nz(x):
+ x = asarray(x,dtype=nx.ubyte)
+ if x.ndim != 1:
+ raise TypeError, "intput must have 1 dimension."
+ indxs = nx.flatnonzero(x != 0)
+ return indxs[-1].item()+1
+
+def reverse(x, n):
+ x = asarray(x,dtype='d')
+ if x.ndim != 2:
+ raise ValueError, "input must be 2-d"
+ y = nx.empty_like(x)
+ if n == 0:
+ y[...] = x[::-1,:]
+ elif n == 1:
+ y[...] = x[:,::-1]
+ return y
+
+def span(lo, hi, num, d2=0):
+ x = linspace(lo, hi, num)
+ if d2 <= 0:
+ return x
+ else:
+ ret = empty((d2,num),x.dtype)
+ ret[...] = x
+ return ret
+
+def zmin_zmax(z, ireg):
+ z = asarray(z, dtype=float)
+ ireg = asarray(ireg, dtype=int)
+ if z.shape != ireg.shape or z.ndim != 2:
+ raise ValueError, "z and ireg must be the same shape and 2-d"
+ ix, iy = nx.nonzero(ireg)
+ # Now, add more indices
+ x1m = ix - 1
+ y1m = iy-1
+ i1 = x1m>=0
+ i2 = y1m>=0
+ i3 = i1 & i2
+ nix = nx.r_[ix, x1m[i1], x1m[i1], ix[i2] ]
+ niy = nx.r_[iy, iy[i1], y1m[i3], y1m[i2]]
+ # remove any negative indices
+ zres = z[nix,niy]
+ return zres.min().item(), zres.max().item()
+
+
+def find_mask(fs, node_edges):
+ raise NotImplementedError
+
+def to_corners(arr, nv, nvsum):
+ raise NotImplementedError
+
+
+def construct3(mask, itype):
+ raise NotImplementedError
+
+
diff --git a/numpy/oldnumeric/compat.py b/numpy/oldnumeric/compat.py
new file mode 100644
index 000000000..369fa5000
--- /dev/null
+++ b/numpy/oldnumeric/compat.py
@@ -0,0 +1,66 @@
+# Compatibility module containing deprecated names
+
+__all__ = ['NewAxis',
+ 'UFuncType', 'UfuncType', 'ArrayType', 'arraytype',
+ 'LittleEndian', 'arrayrange', 'matrixmultiply',
+ 'array_constructor', 'pickle_array',
+ 'DumpArray', 'LoadArray', 'multiarray',
+ # from cPickle
+ 'dump', 'dumps'
+ ]
+
+import numpy.core.multiarray as multiarray
+import numpy.core.umath as um
+from numpy.core.numeric import array, correlate
+import functions
+import sys
+
+from cPickle import dump, dumps
+
+mu = multiarray
+
+#Use this to add a new axis to an array
+#compatibility only
+NewAxis = None
+
+#deprecated
+UFuncType = type(um.sin)
+UfuncType = type(um.sin)
+ArrayType = mu.ndarray
+arraytype = mu.ndarray
+
+LittleEndian = (sys.byteorder == 'little')
+
+from numpy import deprecate
+
+# backward compatibility
+arrayrange = deprecate(functions.arange, 'arrayrange', 'arange')
+
+# deprecated names
+matrixmultiply = deprecate(mu.dot, 'matrixmultiply', 'dot')
+
+def DumpArray(m, fp):
+ m.dump(fp)
+
+def LoadArray(fp):
+ import cPickle
+ return cPickle.load(fp)
+
+def array_constructor(shape, typecode, thestr, Endian=LittleEndian):
+ if typecode == "O":
+ x = array(thestr, "O")
+ else:
+ x = mu.fromstring(thestr, typecode)
+ x.shape = shape
+ if LittleEndian != Endian:
+ return x.byteswap(True)
+ else:
+ return x
+
+def pickle_array(a):
+ if a.dtype.hasobject:
+ return (array_constructor,
+ a.shape, a.dtype.char, a.tolist(), LittleEndian)
+ else:
+ return (array_constructor,
+ (a.shape, a.dtype.char, a.tostring(), LittleEndian))
diff --git a/numpy/oldnumeric/fft.py b/numpy/oldnumeric/fft.py
new file mode 100644
index 000000000..67f30c750
--- /dev/null
+++ b/numpy/oldnumeric/fft.py
@@ -0,0 +1,21 @@
+
+__all__ = ['fft', 'fft2d', 'fftnd', 'hermite_fft', 'inverse_fft',
+ 'inverse_fft2d', 'inverse_fftnd',
+ 'inverse_hermite_fft', 'inverse_real_fft',
+ 'inverse_real_fft2d', 'inverse_real_fftnd',
+ 'real_fft', 'real_fft2d', 'real_fftnd']
+
+from numpy.fft import fft
+from numpy.fft import fft2 as fft2d
+from numpy.fft import fftn as fftnd
+from numpy.fft import hfft as hermite_fft
+from numpy.fft import ifft as inverse_fft
+from numpy.fft import ifft2 as inverse_fft2d
+from numpy.fft import ifftn as inverse_fftnd
+from numpy.fft import ihfft as inverse_hermite_fft
+from numpy.fft import irfft as inverse_real_fft
+from numpy.fft import irfft2 as inverse_real_fft2d
+from numpy.fft import irfftn as inverse_real_fftnd
+from numpy.fft import rfft as real_fft
+from numpy.fft import rfft2 as real_fft2d
+from numpy.fft import rfftn as real_fftnd
diff --git a/numpy/oldnumeric/fix_default_axis.py b/numpy/oldnumeric/fix_default_axis.py
new file mode 100644
index 000000000..8483de85e
--- /dev/null
+++ b/numpy/oldnumeric/fix_default_axis.py
@@ -0,0 +1,291 @@
+"""
+This module adds the default axis argument to code which did not specify it
+for the functions where the default was changed in NumPy.
+
+The functions changed are
+
+add -1 ( all second argument)
+======
+nansum
+nanmax
+nanmin
+nanargmax
+nanargmin
+argmax
+argmin
+compress 3
+
+
+add 0
+======
+take 3
+repeat 3
+sum # might cause problems with builtin.
+product
+sometrue
+alltrue
+cumsum
+cumproduct
+average
+ptp
+cumprod
+prod
+std
+mean
+"""
+__all__ = ['convertfile', 'convertall', 'converttree']
+
+import sys
+import os
+import re
+import glob
+
+
+_args3 = ['compress', 'take', 'repeat']
+_funcm1 = ['nansum', 'nanmax', 'nanmin', 'nanargmax', 'nanargmin',
+ 'argmax', 'argmin', 'compress']
+_func0 = ['take', 'repeat', 'sum', 'product', 'sometrue', 'alltrue',
+ 'cumsum', 'cumproduct', 'average', 'ptp', 'cumprod', 'prod',
+ 'std', 'mean']
+
+_all = _func0 + _funcm1
+func_re = {}
+
+for name in _all:
+ _astr = r"""%s\s*[(]"""%name
+ func_re[name] = re.compile(_astr)
+
+
+import string
+disallowed = '_' + string.uppercase + string.lowercase + string.digits
+
+def _add_axis(fstr, name, repl):
+ alter = 0
+ if name in _args3:
+ allowed_comma = 1
+ else:
+ allowed_comma = 0
+ newcode = ""
+ last = 0
+ for obj in func_re[name].finditer(fstr):
+ nochange = 0
+ start, end = obj.span()
+ if fstr[start-1] in disallowed:
+ continue
+ if fstr[start-1] == '.' \
+ and fstr[start-6:start-1] != 'numpy' \
+ and fstr[start-2:start-1] != 'N' \
+ and fstr[start-9:start-1] != 'numarray' \
+ and fstr[start-8:start-1] != 'numerix' \
+ and fstr[start-8:start-1] != 'Numeric':
+ continue
+ if fstr[start-1] in ['\t',' ']:
+ k = start-2
+ while fstr[k] in ['\t',' ']:
+ k -= 1
+ if fstr[k-2:k+1] == 'def' or \
+ fstr[k-4:k+1] == 'class':
+ continue
+ k = end
+ stack = 1
+ ncommas = 0
+ N = len(fstr)
+ while stack:
+ if k>=N:
+ nochange =1
+ break
+ if fstr[k] == ')':
+ stack -= 1
+ elif fstr[k] == '(':
+ stack += 1
+ elif stack == 1 and fstr[k] == ',':
+ ncommas += 1
+ if ncommas > allowed_comma:
+ nochange = 1
+ break
+ k += 1
+ if nochange:
+ continue
+ alter += 1
+ newcode = "%s%s,%s)" % (newcode, fstr[last:k-1], repl)
+ last = k
+ if not alter:
+ newcode = fstr
+ else:
+ newcode = "%s%s" % (newcode, fstr[last:])
+ return newcode, alter
+
+def _import_change(fstr, names):
+ # Four possibilities
+ # 1.) import numpy with subsequent use of numpy.<name>
+ # change this to import numpy.oldnumeric as numpy
+ # 2.) import numpy as XXXX with subsequent use of
+ # XXXX.<name> ==> import numpy.oldnumeric as XXXX
+ # 3.) from numpy import *
+ # with subsequent use of one of the names
+ # 4.) from numpy import ..., <name>, ... (could span multiple
+ # lines. ==> remove all names from list and
+ # add from numpy.oldnumeric import <name>
+
+ num = 0
+ # case 1
+ importstr = "import numpy"
+ ind = fstr.find(importstr)
+ if (ind > 0):
+ found = 0
+ for name in names:
+ ind2 = fstr.find("numpy.%s" % name, ind)
+ if (ind2 > 0):
+ found = 1
+ break
+ if found:
+ fstr = "%s%s%s" % (fstr[:ind], "import numpy.oldnumeric as numpy",
+ fstr[ind+len(importstr):])
+ num += 1
+
+ # case 2
+ importre = re.compile("""import numpy as ([A-Za-z0-9_]+)""")
+ modules = importre.findall(fstr)
+ if len(modules) > 0:
+ for module in modules:
+ found = 0
+ for name in names:
+ ind2 = fstr.find("%s.%s" % (module, name))
+ if (ind2 > 0):
+ found = 1
+ break
+ if found:
+ importstr = "import numpy as %s" % module
+ ind = fstr.find(importstr)
+ fstr = "%s%s%s" % (fstr[:ind],
+ "import numpy.oldnumeric as %s" % module,
+ fstr[ind+len(importstr):])
+ num += 1
+
+ # case 3
+ importstr = "from numpy import *"
+ ind = fstr.find(importstr)
+ if (ind > 0):
+ found = 0
+ for name in names:
+ ind2 = fstr.find(name, ind)
+ if (ind2 > 0) and fstr[ind2-1] not in disallowed:
+ found = 1
+ break
+ if found:
+ fstr = "%s%s%s" % (fstr[:ind],
+ "from numpy.oldnumeric import *",
+ fstr[ind+len(importstr):])
+ num += 1
+
+ # case 4
+ ind = 0
+ importstr = "from numpy import"
+ N = len(importstr)
+ while 1:
+ ind = fstr.find(importstr, ind)
+ if (ind < 0):
+ break
+ ind += N
+ ptr = ind+1
+ stack = 1
+ while stack:
+ if fstr[ptr] == '\\':
+ stack += 1
+ elif fstr[ptr] == '\n':
+ stack -= 1
+ ptr += 1
+ substr = fstr[ind:ptr]
+ found = 0
+ substr = substr.replace('\n',' ')
+ substr = substr.replace('\\','')
+ importnames = [x.strip() for x in substr.split(',')]
+ # determine if any of names are in importnames
+ addnames = []
+ for name in names:
+ if name in importnames:
+ importnames.remove(name)
+ addnames.append(name)
+ if len(addnames) > 0:
+ fstr = "%s%s\n%s\n%s" % \
+ (fstr[:ind],
+ "from numpy import %s" % \
+ ", ".join(importnames),
+ "from numpy.oldnumeric import %s" % \
+ ", ".join(addnames),
+ fstr[ptr:])
+ num += 1
+
+ return fstr, num
+
+def add_axis(fstr, import_change=False):
+ total = 0
+ if not import_change:
+ for name in _funcm1:
+ fstr, num = _add_axis(fstr, name, 'axis=-1')
+ total += num
+ for name in _func0:
+ fstr, num = _add_axis(fstr, name, 'axis=0')
+ total += num
+ return fstr, total
+ else:
+ fstr, num = _import_change(fstr, _funcm1+_func0)
+ return fstr, num
+
+
+def makenewfile(name, filestr):
+ fid = file(name, 'w')
+ fid.write(filestr)
+ fid.close()
+
+def getfile(name):
+ fid = file(name)
+ filestr = fid.read()
+ fid.close()
+ return filestr
+
+def copyfile(name, fstr):
+ base, ext = os.path.splitext(name)
+ makenewfile(base+'.orig', fstr)
+ return
+
+def convertfile(filename, import_change=False):
+ """Convert the filename given from using Numeric to using NumPy
+
+ Copies the file to filename.orig and then over-writes the file
+ with the updated code
+ """
+ filestr = getfile(filename)
+ newstr, total = add_axis(filestr, import_change)
+ if total > 0:
+ print "Changing ", filename
+ copyfile(filename, filestr)
+ makenewfile(filename, newstr)
+ sys.stdout.flush()
+
+def fromargs(args):
+ filename = args[1]
+ convertfile(filename)
+
+def convertall(direc=os.path.curdir, import_change=False):
+ """Convert all .py files in the directory given
+
+ For each file, a backup of <usesnumeric>.py is made as
+ <usesnumeric>.py.orig. A new file named <usesnumeric>.py
+ is then written with the updated code.
+ """
+ files = glob.glob(os.path.join(direc,'*.py'))
+ for afile in files:
+ convertfile(afile, import_change)
+
+def _func(arg, dirname, fnames):
+ convertall(dirname, import_change=arg)
+
+def converttree(direc=os.path.curdir, import_change=False):
+ """Convert all .py files in the tree given
+
+ """
+ os.path.walk(direc, _func, import_change)
+
+if __name__ == '__main__':
+ fromargs(sys.argv)
diff --git a/numpy/oldnumeric/functions.py b/numpy/oldnumeric/functions.py
new file mode 100644
index 000000000..1f09d8f84
--- /dev/null
+++ b/numpy/oldnumeric/functions.py
@@ -0,0 +1,124 @@
+# Functions that should behave the same as Numeric and need changing
+
+import numpy as N
+import numpy.core.multiarray as mu
+import numpy.core.numeric as nn
+from typeconv import convtypecode, convtypecode2
+
+__all__ = ['take', 'repeat', 'sum', 'product', 'sometrue', 'alltrue',
+ 'cumsum', 'cumproduct', 'compress', 'fromfunction',
+ 'ones', 'empty', 'identity', 'zeros', 'array', 'asarray',
+ 'nonzero', 'reshape', 'arange', 'fromstring', 'ravel', 'trace',
+ 'indices', 'where','sarray','cross_product', 'argmax', 'argmin',
+ 'average']
+
+def take(a, indicies, axis=0):
+ return N.take(a, indicies, axis)
+
+def repeat(a, repeats, axis=0):
+ return N.repeat(a, repeats, axis)
+
+def sum(x, axis=0):
+ return N.sum(x, axis)
+
+def product(x, axis=0):
+ return N.product(x, axis)
+
+def sometrue(x, axis=0):
+ return N.sometrue(x, axis)
+
+def alltrue(x, axis=0):
+ return N.alltrue(x, axis)
+
+def cumsum(x, axis=0):
+ return N.cumsum(x, axis)
+
+def cumproduct(x, axis=0):
+ return N.cumproduct(x, axis)
+
+def argmax(x, axis=-1):
+ return N.argmax(x, axis)
+
+def argmin(x, axis=-1):
+ return N.argmin(x, axis)
+
+def compress(condition, m, axis=-1):
+ return N.compress(condition, m, axis)
+
+def fromfunction(args, dimensions):
+ return N.fromfunction(args, dimensions, dtype=int)
+
+def ones(shape, typecode='l', savespace=0, dtype=None):
+ """ones(shape, dtype=int) returns an array of the given
+ dimensions which is initialized to all ones.
+ """
+ dtype = convtypecode(typecode,dtype)
+ a = mu.empty(shape, dtype)
+ a.fill(1)
+ return a
+
+def zeros(shape, typecode='l', savespace=0, dtype=None):
+ """zeros(shape, dtype=int) returns an array of the given
+ dimensions which is initialized to all zeros
+ """
+ dtype = convtypecode(typecode,dtype)
+ return mu.zeros(shape, dtype)
+
+def identity(n,typecode='l', dtype=None):
+ """identity(n) returns the identity 2-d array of shape n x n.
+ """
+ dtype = convtypecode(typecode, dtype)
+ return nn.identity(n, dtype)
+
+def empty(shape, typecode='l', dtype=None):
+ dtype = convtypecode(typecode, dtype)
+ return mu.empty(shape, dtype)
+
+def array(sequence, typecode=None, copy=1, savespace=0, dtype=None):
+ dtype = convtypecode2(typecode, dtype)
+ return mu.array(sequence, dtype, copy=copy)
+
+def sarray(a, typecode=None, copy=False, dtype=None):
+ dtype = convtypecode2(typecode, dtype)
+ return mu.array(a, dtype, copy)
+
+def asarray(a, typecode=None, dtype=None):
+ dtype = convtypecode2(typecode, dtype)
+ return mu.array(a, dtype, copy=0)
+
+def nonzero(a):
+ res = N.nonzero(a)
+ if len(res) == 1:
+ return res[0]
+ else:
+ raise ValueError, "Input argument must be 1d"
+
+def reshape(a, shape):
+ return N.reshape(a, shape)
+
+def arange(start, stop=None, step=1, typecode=None, dtype=None):
+ dtype = convtypecode2(typecode, dtype)
+ return mu.arange(start, stop, step, dtype)
+
+def fromstring(string, typecode='l', count=-1, dtype=None):
+ dtype = convtypecode(typecode, dtype)
+ return mu.fromstring(string, dtype, count=count)
+
+def ravel(m):
+ return N.ravel(m)
+
+def trace(a, offset=0, axis1=0, axis2=1):
+ return N.trace(a, offset=0, axis1=0, axis2=1)
+
+def indices(dimensions, typecode=None, dtype=None):
+ dtype = convtypecode(typecode, dtype)
+ return N.indices(dimensions, dtype)
+
+def where(condition, x, y):
+ return N.where(condition, x, y)
+
+def cross_product(a, b, axis1=-1, axis2=-1):
+ return N.cross(a, b, axis1, axis2)
+
+def average(a, axis=0, weights=None, returned=False):
+ return N.average(a, axis, weights, returned)
diff --git a/numpy/oldnumeric/linear_algebra.py b/numpy/oldnumeric/linear_algebra.py
new file mode 100644
index 000000000..2e7a264fe
--- /dev/null
+++ b/numpy/oldnumeric/linear_algebra.py
@@ -0,0 +1,83 @@
+"""Backward compatible with LinearAlgebra from Numeric
+"""
+# This module is a lite version of the linalg.py module in SciPy which contains
+# high-level Python interface to the LAPACK library. The lite version
+# only accesses the following LAPACK functions: dgesv, zgesv, dgeev,
+# zgeev, dgesdd, zgesdd, dgelsd, zgelsd, dsyevd, zheevd, dgetrf, dpotrf.
+
+
+__all__ = ['LinAlgError', 'solve_linear_equations',
+ 'inverse', 'cholesky_decomposition', 'eigenvalues',
+ 'Heigenvalues', 'generalized_inverse',
+ 'determinant', 'singular_value_decomposition',
+ 'eigenvectors', 'Heigenvectors',
+ 'linear_least_squares'
+ ]
+
+from numpy.core import transpose
+import numpy.linalg as linalg
+
+# Linear equations
+
+LinAlgError = linalg.LinAlgError
+
+def solve_linear_equations(a, b):
+ return linalg.solve(a,b)
+
+# Matrix inversion
+
+def inverse(a):
+ return linalg.inv(a)
+
+# Cholesky decomposition
+
+def cholesky_decomposition(a):
+ return linalg.cholesky(a)
+
+# Eigenvalues
+
+def eigenvalues(a):
+ return linalg.eigvals(a)
+
+def Heigenvalues(a, UPLO='L'):
+ return linalg.eigvalsh(a,UPLO)
+
+# Eigenvectors
+
+def eigenvectors(A):
+ w, v = linalg.eig(A)
+ return w, transpose(v)
+
+def Heigenvectors(A):
+ w, v = linalg.eigh(A)
+ return w, transpose(v)
+
+# Generalized inverse
+
+def generalized_inverse(a, rcond = 1.e-10):
+ return linalg.pinv(a, rcond)
+
+# Determinant
+
+def determinant(a):
+ return linalg.det(a)
+
+# Linear Least Squares
+
+def linear_least_squares(a, b, rcond=1.e-10):
+ """returns x,resids,rank,s
+where x minimizes 2-norm(|b - Ax|)
+ resids is the sum square residuals
+ rank is the rank of A
+ s is the rank of the singular values of A in descending order
+
+If b is a matrix then x is also a matrix with corresponding columns.
+If the rank of A is less than the number of columns of A or greater than
+the number of rows, then residuals will be returned as an empty array
+otherwise resids = sum((b-dot(A,x)**2).
+Singular values less than s[0]*rcond are treated as zero.
+"""
+ return linalg.lstsq(a,b,rcond)
+
+def singular_value_decomposition(A, full_matrices=0):
+ return linalg.svd(A, full_matrices)
diff --git a/numpy/oldnumeric/ma.py b/numpy/oldnumeric/ma.py
new file mode 100644
index 000000000..857c554ec
--- /dev/null
+++ b/numpy/oldnumeric/ma.py
@@ -0,0 +1,15 @@
+# Incompatibility in that getmask and a.mask returns nomask
+# instead of None
+
+from numpy.core.ma import *
+import numpy.core.ma as nca
+
+def repeat(a, repeats, axis=0):
+ return nca.repeat(a, repeats, axis)
+
+def average(a, axis=0, weights=None, returned=0):
+ return nca.average(a, axis, weights, returned)
+
+def take(a, indices, axis=0):
+ return nca.average(a, indices, axis=0)
+
diff --git a/numpy/oldnumeric/matrix.py b/numpy/oldnumeric/matrix.py
new file mode 100644
index 000000000..7c5b3700c
--- /dev/null
+++ b/numpy/oldnumeric/matrix.py
@@ -0,0 +1,68 @@
+# This module is for compatibility only.
+
+__all__ = ['UserArray', 'squeeze', 'Matrix', 'asarray', 'dot', 'k', 'Numeric', 'LinearAlgebra', 'identity', 'multiply', 'types', 'string']
+
+import string
+import types
+from user_array import UserArray, asarray
+import numpy.oldnumeric as Numeric
+from numpy.oldnumeric import dot, identity, multiply
+import numpy.oldnumeric.linear_algebra as LinearAlgebra
+from numpy import matrix as Matrix, squeeze
+
+# Hidden names that will be the same.
+
+_table = [None]*256
+for k in range(256):
+ _table[k] = chr(k)
+_table = ''.join(_table)
+
+_numchars = string.digits + ".-+jeEL"
+_todelete = []
+for k in _table:
+ if k not in _numchars:
+ _todelete.append(k)
+_todelete = ''.join(_todelete)
+
+
+def _eval(astr):
+ return eval(astr.translate(_table,_todelete))
+
+def _convert_from_string(data):
+ data.find
+ rows = data.split(';')
+ newdata = []
+ count = 0
+ for row in rows:
+ trow = row.split(',')
+ newrow = []
+ for col in trow:
+ temp = col.split()
+ newrow.extend(map(_eval,temp))
+ if count == 0:
+ Ncols = len(newrow)
+ elif len(newrow) != Ncols:
+ raise ValueError, "Rows not the same size."
+ count += 1
+ newdata.append(newrow)
+ return newdata
+
+
+_lkup = {'0':'000',
+ '1':'001',
+ '2':'010',
+ '3':'011',
+ '4':'100',
+ '5':'101',
+ '6':'110',
+ '7':'111'}
+
+def _binary(num):
+ ostr = oct(num)
+ bin = ''
+ for ch in ostr[1:]:
+ bin += _lkup[ch]
+ ind = 0
+ while bin[ind] == '0':
+ ind += 1
+ return bin[ind:]
diff --git a/numpy/oldnumeric/misc.py b/numpy/oldnumeric/misc.py
new file mode 100644
index 000000000..4b43f3985
--- /dev/null
+++ b/numpy/oldnumeric/misc.py
@@ -0,0 +1,42 @@
+# Functions that already have the correct syntax or miscellaneous functions
+
+
+__all__ = ['load', 'sort', 'copy_reg', 'clip', 'Unpickler', 'rank',
+ 'sign', 'shape', 'types', 'allclose', 'size',
+ 'choose', 'swapaxes', 'array_str',
+ 'pi', 'math', 'concatenate', 'putmask', 'put',
+ 'around', 'vdot', 'transpose', 'array2string', 'diagonal',
+ 'searchsorted', 'copy', 'resize',
+ 'array_repr', 'e', 'StringIO', 'pickle',
+ 'argsort', 'convolve', 'loads', 'cross_correlate',
+ 'Pickler', 'dot', 'outerproduct', 'innerproduct', 'insert']
+
+import types
+import StringIO
+import pickle
+import math
+import copy
+import copy_reg
+from pickle import load, loads
+
+from numpy import sort, clip, rank, sign, shape, putmask, allclose, size,\
+ choose, swapaxes, array_str, array_repr, e, pi, put, \
+ resize, around, concatenate, vdot, transpose, \
+ diagonal, searchsorted, argsort, convolve, dot, \
+ outer as outerproduct, inner as innerproduct, correlate as cross_correlate, \
+ place as insert
+
+from array_printer import array2string
+
+
+class Unpickler(pickle.Unpickler):
+ def __init__(self, *args, **kwds):
+ raise NotImplemented
+ def load_array(self):
+ raise NotImplemented
+
+class Pickler(pickle.Pickler):
+ def __init__(self, *args, **kwds):
+ raise NotImplemented
+ def save_array(self, object):
+ raise NotImplemented
diff --git a/numpy/oldnumeric/mlab.py b/numpy/oldnumeric/mlab.py
new file mode 100644
index 000000000..47be89e1b
--- /dev/null
+++ b/numpy/oldnumeric/mlab.py
@@ -0,0 +1,122 @@
+# This module is for compatibility only. All functions are defined elsewhere.
+
+__all__ = ['rand', 'tril', 'trapz', 'hanning', 'rot90', 'triu', 'diff', 'angle', 'roots', 'ptp', 'kaiser', 'randn', 'cumprod', 'diag', 'msort', 'LinearAlgebra', 'RandomArray', 'prod', 'std', 'hamming', 'flipud', 'max', 'blackman', 'corrcoef', 'bartlett', 'eye', 'squeeze', 'sinc', 'tri', 'cov', 'svd', 'min', 'median', 'fliplr', 'eig', 'mean']
+
+import numpy.oldnumeric.linear_algebra as LinearAlgebra
+import numpy.oldnumeric.random_array as RandomArray
+from numpy import tril, trapz as _Ntrapz, hanning, rot90, triu, diff, \
+ angle, roots, ptp as _Nptp, kaiser, cumprod as _Ncumprod, \
+ diag, msort, prod as _Nprod, std as _Nstd, hamming, flipud, \
+ amax as _Nmax, amin as _Nmin, blackman, bartlett, \
+ squeeze, sinc, median, fliplr, mean as _Nmean, transpose
+
+from numpy.linalg import eig, svd
+from numpy.random import rand, randn
+import numpy as nn
+
+from typeconv import convtypecode
+
+def eye(N, M=None, k=0, typecode=None, dtype=None):
+ """ eye returns a N-by-M 2-d array where the k-th diagonal is all ones,
+ and everything else is zeros.
+ """
+ dtype = convtypecode(typecode, dtype)
+ if M is None: M = N
+ m = nn.equal(nn.subtract.outer(nn.arange(N), nn.arange(M)),-k)
+ if m.dtype != dtype:
+ return m.astype(dtype)
+
+def tri(N, M=None, k=0, typecode=None, dtype=None):
+ """ returns a N-by-M array where all the diagonals starting from
+ lower left corner up to the k-th are all ones.
+ """
+ dtype = convtypecode(typecode, dtype)
+ if M is None: M = N
+ m = nn.greater_equal(nn.subtract.outer(nn.arange(N), nn.arange(M)),-k)
+ if m.dtype != dtype:
+ return m.astype(dtype)
+
+def trapz(y, x=None, axis=-1):
+ return _Ntrapz(y, x, axis=axis)
+
+def ptp(x, axis=0):
+ return _Nptp(x, axis)
+
+def cumprod(x, axis=0):
+ return _Ncumprod(x, axis)
+
+def max(x, axis=0):
+ return _Nmax(x, axis)
+
+def min(x, axis=0):
+ return _Nmin(x, axis)
+
+def prod(x, axis=0):
+ return _Nprod(x, axis)
+
+def std(x, axis=0):
+ N = asarray(x).shape[axis]
+ return _Nstd(x, axis)*sqrt(N/(N-1.))
+
+def mean(x, axis=0):
+ return _Nmean(x, axis)
+
+# This is exactly the same cov function as in MLab
+def cov(m, y=None, rowvar=0, bias=0):
+ if y is None:
+ y = m
+ else:
+ y = y
+ if rowvar:
+ m = transpose(m)
+ y = transpose(y)
+ if (m.shape[0] == 1):
+ m = transpose(m)
+ if (y.shape[0] == 1):
+ y = transpose(y)
+ N = m.shape[0]
+ if (y.shape[0] != N):
+ raise ValueError, "x and y must have the same number "\
+ "of observations"
+ m = m - _Nmean(m,axis=0)
+ y = y - _Nmean(y,axis=0)
+ if bias:
+ fact = N*1.0
+ else:
+ fact = N-1.0
+ return squeeze(dot(transpose(m), conjugate(y)) / fact)
+
+from numpy import sqrt, multiply
+def corrcoef(x, y=None):
+ c = cov(x,y)
+ d = diag(c)
+ return c/sqrt(multiply.outer(d,d))
+
+from compat import *
+from functions import *
+from precision import *
+from ufuncs import *
+from misc import *
+
+import compat
+import precision
+import functions
+import misc
+import ufuncs
+
+import numpy
+__version__ = numpy.__version__
+del numpy
+
+__all__ += ['__version__']
+__all__ += compat.__all__
+__all__ += precision.__all__
+__all__ += functions.__all__
+__all__ += ufuncs.__all__
+__all__ += misc.__all__
+
+del compat
+del functions
+del precision
+del ufuncs
+del misc
diff --git a/numpy/oldnumeric/precision.py b/numpy/oldnumeric/precision.py
new file mode 100644
index 000000000..f495992a8
--- /dev/null
+++ b/numpy/oldnumeric/precision.py
@@ -0,0 +1,169 @@
+# Lifted from Precision.py. This is for compatibility only.
+#
+# The character strings are still for "new" NumPy
+# which is the only Incompatibility with Numeric
+
+__all__ = ['Character', 'Complex', 'Float',
+ 'PrecisionError', 'PyObject', 'Int', 'UInt',
+ 'UnsignedInteger', 'string', 'typecodes', 'zeros']
+
+import string
+from functions import zeros
+
+typecodes = {'Character':'c', 'Integer':'bhil', 'UnsignedInteger':'BHI', 'Float':'fd', 'Complex':'FD'}
+
+def _get_precisions(typecodes):
+ lst = []
+ for t in typecodes:
+ lst.append( (zeros( (1,), t ).itemsize*8, t) )
+ return lst
+
+def _fill_table(typecodes, table={}):
+ for key, value in typecodes.items():
+ table[key] = _get_precisions(value)
+ return table
+
+_code_table = _fill_table(typecodes)
+
+class PrecisionError(Exception):
+ pass
+
+def _lookup(table, key, required_bits):
+ lst = table[key]
+ for bits, typecode in lst:
+ if bits >= required_bits:
+ return typecode
+ raise PrecisionError, key+" of "+str(required_bits)+" bits not available on this system"
+
+Character = 'c'
+
+try:
+ UnsignedInt8 = _lookup(_code_table, "UnsignedInteger", 8)
+ UInt8 = UnsignedInt8
+ __all__.extend(['UnsignedInt8', 'UInt8'])
+except(PrecisionError):
+ pass
+try:
+ UnsignedInt16 = _lookup(_code_table, "UnsignedInteger", 16)
+ UInt16 = UnsignedInt16
+ __all__.extend(['UnsignedInt16', 'UInt16'])
+except(PrecisionError):
+ pass
+try:
+ UnsignedInt32 = _lookup(_code_table, "UnsignedInteger", 32)
+ UInt32 = UnsignedInt32
+ __all__.extend(['UnsignedInt32', 'UInt32'])
+except(PrecisionError):
+ pass
+try:
+ UnsignedInt64 = _lookup(_code_table, "UnsignedInteger", 64)
+ UInt64 = UnsignedInt64
+ __all__.extend(['UnsignedInt64', 'UInt64'])
+except(PrecisionError):
+ pass
+try:
+ UnsignedInt128 = _lookup(_code_table, "UnsignedInteger", 128)
+ UInt128 = UnsignedInt128
+ __all__.extend(['UnsignedInt128', 'UInt128'])
+except(PrecisionError):
+ pass
+UnsignedInteger = 'u'
+UInt = UnsignedInteger
+
+try:
+ Int0 = _lookup(_code_table, 'Integer', 0)
+ __all__.append('Int0')
+except(PrecisionError):
+ pass
+try:
+ Int8 = _lookup(_code_table, 'Integer', 8)
+ __all__.append('Int8')
+except(PrecisionError):
+ pass
+try:
+ Int16 = _lookup(_code_table, 'Integer', 16)
+ __all__.append('Int16')
+except(PrecisionError):
+ pass
+try:
+ Int32 = _lookup(_code_table, 'Integer', 32)
+ __all__.append('Int32')
+except(PrecisionError):
+ pass
+try:
+ Int64 = _lookup(_code_table, 'Integer', 64)
+ __all__.append('Int64')
+except(PrecisionError):
+ pass
+try:
+ Int128 = _lookup(_code_table, 'Integer', 128)
+ __all__.append('Int128')
+except(PrecisionError):
+ pass
+Int = 'l'
+
+try:
+ Float0 = _lookup(_code_table, 'Float', 0)
+ __all__.append('Float0')
+except(PrecisionError):
+ pass
+try:
+ Float8 = _lookup(_code_table, 'Float', 8)
+ __all__.append('Float8')
+except(PrecisionError):
+ pass
+try:
+ Float16 = _lookup(_code_table, 'Float', 16)
+ __all__.append('Float16')
+except(PrecisionError):
+ pass
+try:
+ Float32 = _lookup(_code_table, 'Float', 32)
+ __all__.append('Float32')
+except(PrecisionError):
+ pass
+try:
+ Float64 = _lookup(_code_table, 'Float', 64)
+ __all__.append('Float64')
+except(PrecisionError):
+ pass
+try:
+ Float128 = _lookup(_code_table, 'Float', 128)
+ __all__.append('Float128')
+except(PrecisionError):
+ pass
+Float = 'd'
+
+try:
+ Complex0 = _lookup(_code_table, 'Complex', 0)
+ __all__.append('Complex0')
+except(PrecisionError):
+ pass
+try:
+ Complex8 = _lookup(_code_table, 'Complex', 16)
+ __all__.append('Complex8')
+except(PrecisionError):
+ pass
+try:
+ Complex16 = _lookup(_code_table, 'Complex', 32)
+ __all__.append('Complex16')
+except(PrecisionError):
+ pass
+try:
+ Complex32 = _lookup(_code_table, 'Complex', 64)
+ __all__.append('Complex32')
+except(PrecisionError):
+ pass
+try:
+ Complex64 = _lookup(_code_table, 'Complex', 128)
+ __all__.append('Complex64')
+except(PrecisionError):
+ pass
+try:
+ Complex128 = _lookup(_code_table, 'Complex', 256)
+ __all__.append('Complex128')
+except(PrecisionError):
+ pass
+Complex = 'D'
+
+PyObject = 'O'
diff --git a/numpy/oldnumeric/random_array.py b/numpy/oldnumeric/random_array.py
new file mode 100644
index 000000000..0b06ee959
--- /dev/null
+++ b/numpy/oldnumeric/random_array.py
@@ -0,0 +1,268 @@
+# Backward compatible module for RandomArray
+
+__all__ = ['ArgumentError','F','beta','binomial','chi_square', 'exponential',
+ 'gamma', 'get_seed', 'mean_var_test', 'multinomial',
+ 'multivariate_normal', 'negative_binomial', 'noncentral_F',
+ 'noncentral_chi_square', 'normal', 'permutation', 'poisson',
+ 'randint', 'random', 'random_integers', 'seed', 'standard_normal',
+ 'uniform']
+
+ArgumentError = ValueError
+
+import numpy.random.mtrand as mt
+import numpy as Numeric
+
+from types import IntType
+
+def seed(x=0, y=0):
+ if (x == 0 or y == 0):
+ mt.seed()
+ else:
+ mt.seed((x,y))
+
+def get_seed():
+ raise NotImplementedError, \
+ "If you want to save the state of the random number generator.\n"\
+ "Then you should use obj = numpy.random.get_state() followed by.\n"\
+ "numpy.random.set_state(obj)."
+
+def random(shape=[]):
+ "random(n) or random([n, m, ...]) returns array of random numbers"
+ if shape == []:
+ shape = None
+ return mt.random_sample(shape)
+
+def uniform(minimum, maximum, shape=[]):
+ """uniform(minimum, maximum, shape=[]) returns array of given shape of random reals
+ in given range"""
+ if shape == []:
+ shape = None
+ return mt.uniform(minimum, maximum, shape)
+
+def randint(minimum, maximum=None, shape=[]):
+ """randint(min, max, shape=[]) = random integers >=min, < max
+ If max not given, random integers >= 0, <min"""
+ if not isinstance(minimum, IntType):
+ raise ArgumentError, "randint requires first argument integer"
+ if maximum is None:
+ maximum = minimum
+ minimum = 0
+ if not isinstance(maximum, IntType):
+ raise ArgumentError, "randint requires second argument integer"
+ a = ((maximum-minimum)* random(shape))
+ if isinstance(a, Numeric.ArrayType):
+ return minimum + a.astype(Numeric.Int)
+ else:
+ return minimum + int(a)
+
+def random_integers(maximum, minimum=1, shape=[]):
+ """random_integers(max, min=1, shape=[]) = random integers in range min-max inclusive"""
+ return randint(minimum, maximum+1, shape)
+
+def permutation(n):
+ "permutation(n) = a permutation of indices range(n)"
+ return mt.permutation(n)
+
+def standard_normal(shape=[]):
+ """standard_normal(n) or standard_normal([n, m, ...]) returns array of
+ random numbers normally distributed with mean 0 and standard
+ deviation 1"""
+ if shape == []:
+ shape = None
+ return mt.standard_normal(shape)
+
+def normal(mean, std, shape=[]):
+ """normal(mean, std, n) or normal(mean, std, [n, m, ...]) returns
+ array of random numbers randomly distributed with specified mean and
+ standard deviation"""
+ if shape == []:
+ shape = None
+ return mt.normal(mean, std, shape)
+
+def multivariate_normal(mean, cov, shape=[]):
+ """multivariate_normal(mean, cov) or multivariate_normal(mean, cov, [m, n, ...])
+ returns an array containing multivariate normally distributed random numbers
+ with specified mean and covariance.
+
+ mean must be a 1 dimensional array. cov must be a square two dimensional
+ array with the same number of rows and columns as mean has elements.
+
+ The first form returns a single 1-D array containing a multivariate
+ normal.
+
+ The second form returns an array of shape (m, n, ..., cov.shape[0]).
+ In this case, output[i,j,...,:] is a 1-D array containing a multivariate
+ normal."""
+ if shape == []:
+ shape = None
+ return mt.multivariate_normal(mean, cov, shape)
+
+def exponential(mean, shape=[]):
+ """exponential(mean, n) or exponential(mean, [n, m, ...]) returns array
+ of random numbers exponentially distributed with specified mean"""
+ if shape == []:
+ shape = None
+ return mt.exponential(mean, shape)
+
+def beta(a, b, shape=[]):
+ """beta(a, b) or beta(a, b, [n, m, ...]) returns array of beta distributed random numbers."""
+ if shape == []:
+ shape = None
+ return mt.beta(a, b, shape)
+
+def gamma(a, r, shape=[]):
+ """gamma(a, r) or gamma(a, r, [n, m, ...]) returns array of gamma distributed random numbers."""
+ if shape == []:
+ shape = None
+ return mt.gamma(a, r, shape)
+
+def F(dfn, dfd, shape=[]):
+ """F(dfn, dfd) or F(dfn, dfd, [n, m, ...]) returns array of F distributed random numbers with dfn degrees of freedom in the numerator and dfd degrees of freedom in the denominator."""
+ if shape == []:
+ shape == None
+ return mt.f(dfn, dfd, shape)
+
+def noncentral_F(dfn, dfd, nconc, shape=[]):
+ """noncentral_F(dfn, dfd, nonc) or noncentral_F(dfn, dfd, nonc, [n, m, ...]) returns array of noncentral F distributed random numbers with dfn degrees of freedom in the numerator and dfd degrees of freedom in the denominator, and noncentrality parameter nconc."""
+ if shape == []:
+ shape = None
+ return mt.noncentral_f(dfn, dfd, nconc, shape)
+
+def chi_square(df, shape=[]):
+ """chi_square(df) or chi_square(df, [n, m, ...]) returns array of chi squared distributed random numbers with df degrees of freedom."""
+ if shape == []:
+ shape = None
+ return mt.chisquare(df, shape)
+
+def noncentral_chi_square(df, nconc, shape=[]):
+ """noncentral_chi_square(df, nconc) or chi_square(df, nconc, [n, m, ...]) returns array of noncentral chi squared distributed random numbers with df degrees of freedom and noncentrality parameter."""
+ if shape == []:
+ shape = None
+ return mt.noncentral_chisquare(df, nconc, shape)
+
+def binomial(trials, p, shape=[]):
+ """binomial(trials, p) or binomial(trials, p, [n, m, ...]) returns array of binomially distributed random integers.
+
+ trials is the number of trials in the binomial distribution.
+ p is the probability of an event in each trial of the binomial distribution."""
+ if shape == []:
+ shape = None
+ return mt.binomial(trials, p, shape)
+
+def negative_binomial(trials, p, shape=[]):
+ """negative_binomial(trials, p) or negative_binomial(trials, p, [n, m, ...]) returns
+ array of negative binomially distributed random integers.
+
+ trials is the number of trials in the negative binomial distribution.
+ p is the probability of an event in each trial of the negative binomial distribution."""
+ if shape == []:
+ shape = None
+ return mt.negative_binomial(trials, p, shape)
+
+def multinomial(trials, probs, shape=[]):
+ """multinomial(trials, probs) or multinomial(trials, probs, [n, m, ...]) returns
+ array of multinomial distributed integer vectors.
+
+ trials is the number of trials in each multinomial distribution.
+ probs is a one dimensional array. There are len(prob)+1 events.
+ prob[i] is the probability of the i-th event, 0<=i<len(prob).
+ The probability of event len(prob) is 1.-Numeric.sum(prob).
+
+ The first form returns a single 1-D array containing one multinomially
+ distributed vector.
+
+ The second form returns an array of shape (m, n, ..., len(probs)).
+ In this case, output[i,j,...,:] is a 1-D array containing a multinomially
+ distributed integer 1-D array."""
+ if shape == []:
+ shape = None
+ return mt.multinomial(trials, probs, shape)
+
+def poisson(mean, shape=[]):
+ """poisson(mean) or poisson(mean, [n, m, ...]) returns array of poisson
+ distributed random integers with specified mean."""
+ if shape == []:
+ shape = None
+ return mt.poisson(mean, shape)
+
+
+def mean_var_test(x, type, mean, var, skew=[]):
+ n = len(x) * 1.0
+ x_mean = Numeric.sum(x,axis=0)/n
+ x_minus_mean = x - x_mean
+ x_var = Numeric.sum(x_minus_mean*x_minus_mean,axis=0)/(n-1.0)
+ print "\nAverage of ", len(x), type
+ print "(should be about ", mean, "):", x_mean
+ print "Variance of those random numbers (should be about ", var, "):", x_var
+ if skew != []:
+ x_skew = (Numeric.sum(x_minus_mean*x_minus_mean*x_minus_mean,axis=0)/9998.)/x_var**(3./2.)
+ print "Skewness of those random numbers (should be about ", skew, "):", x_skew
+
+def test():
+ obj = mt.get_state()
+ mt.set_state(obj)
+ obj2 = mt.get_state()
+ if (obj2[1] - obj[1]).any():
+ raise SystemExit, "Failed seed test."
+ print "First random number is", random()
+ print "Average of 10000 random numbers is", Numeric.sum(random(10000),axis=0)/10000.
+ x = random([10,1000])
+ if len(x.shape) != 2 or x.shape[0] != 10 or x.shape[1] != 1000:
+ raise SystemExit, "random returned wrong shape"
+ x.shape = (10000,)
+ print "Average of 100 by 100 random numbers is", Numeric.sum(x,axis=0)/10000.
+ y = uniform(0.5,0.6, (1000,10))
+ if len(y.shape) !=2 or y.shape[0] != 1000 or y.shape[1] != 10:
+ raise SystemExit, "uniform returned wrong shape"
+ y.shape = (10000,)
+ if Numeric.minimum.reduce(y) <= 0.5 or Numeric.maximum.reduce(y) >= 0.6:
+ raise SystemExit, "uniform returned out of desired range"
+ print "randint(1, 10, shape=[50])"
+ print randint(1, 10, shape=[50])
+ print "permutation(10)", permutation(10)
+ print "randint(3,9)", randint(3,9)
+ print "random_integers(10, shape=[20])"
+ print random_integers(10, shape=[20])
+ s = 3.0
+ x = normal(2.0, s, [10, 1000])
+ if len(x.shape) != 2 or x.shape[0] != 10 or x.shape[1] != 1000:
+ raise SystemExit, "standard_normal returned wrong shape"
+ x.shape = (10000,)
+ mean_var_test(x, "normally distributed numbers with mean 2 and variance %f"%(s**2,), 2, s**2, 0)
+ x = exponential(3, 10000)
+ mean_var_test(x, "random numbers exponentially distributed with mean %f"%(s,), s, s**2, 2)
+ x = multivariate_normal(Numeric.array([10,20]), Numeric.array(([1,2],[2,4])))
+ print "\nA multivariate normal", x
+ if x.shape != (2,): raise SystemExit, "multivariate_normal returned wrong shape"
+ x = multivariate_normal(Numeric.array([10,20]), Numeric.array([[1,2],[2,4]]), [4,3])
+ print "A 4x3x2 array containing multivariate normals"
+ print x
+ if x.shape != (4,3,2): raise SystemExit, "multivariate_normal returned wrong shape"
+ x = multivariate_normal(Numeric.array([-100,0,100]), Numeric.array([[3,2,1],[2,2,1],[1,1,1]]), 10000)
+ x_mean = Numeric.sum(x,axis=0)/10000.
+ print "Average of 10000 multivariate normals with mean [-100,0,100]"
+ print x_mean
+ x_minus_mean = x - x_mean
+ print "Estimated covariance of 10000 multivariate normals with covariance [[3,2,1],[2,2,1],[1,1,1]]"
+ print Numeric.dot(Numeric.transpose(x_minus_mean),x_minus_mean)/9999.
+ x = beta(5.0, 10.0, 10000)
+ mean_var_test(x, "beta(5.,10.) random numbers", 0.333, 0.014)
+ x = gamma(.01, 2., 10000)
+ mean_var_test(x, "gamma(.01,2.) random numbers", 2*100, 2*100*100)
+ x = chi_square(11., 10000)
+ mean_var_test(x, "chi squared random numbers with 11 degrees of freedom", 11, 22, 2*Numeric.sqrt(2./11.))
+ x = F(5., 10., 10000)
+ mean_var_test(x, "F random numbers with 5 and 10 degrees of freedom", 1.25, 1.35)
+ x = poisson(50., 10000)
+ mean_var_test(x, "poisson random numbers with mean 50", 50, 50, 0.14)
+ print "\nEach element is the result of 16 binomial trials with probability 0.5:"
+ print binomial(16, 0.5, 16)
+ print "\nEach element is the result of 16 negative binomial trials with probability 0.5:"
+ print negative_binomial(16, 0.5, [16,])
+ print "\nEach row is the result of 16 multinomial trials with probabilities [0.1, 0.5, 0.1 0.3]:"
+ x = multinomial(16, [0.1, 0.5, 0.1], 8)
+ print x
+ print "Mean = ", Numeric.sum(x,axis=0)/8.
+
+if __name__ == '__main__':
+ test()
diff --git a/numpy/oldnumeric/rng.py b/numpy/oldnumeric/rng.py
new file mode 100644
index 000000000..fcf08bb37
--- /dev/null
+++ b/numpy/oldnumeric/rng.py
@@ -0,0 +1,135 @@
+# This module re-creates the RNG interface from Numeric
+# Replace import RNG with import numpy.oldnumeric.rng as RNG
+#
+# It is for backwards compatibility only.
+
+
+__all__ = ['CreateGenerator','ExponentialDistribution','LogNormalDistribution','NormalDistribution',
+ 'UniformDistribution', 'error', 'default_distribution', 'random_sample', 'ranf',
+ 'standard_generator']
+
+import numpy.random.mtrand as mt
+import math
+
+class error(Exception):
+ pass
+
+class Distribution(object):
+ def __init__(self, meth, *args):
+ self._meth = meth
+ self._args = args
+
+ def density(self,x):
+ raise NotImplementedError
+
+ def __call__(self, x):
+ return self.density(x)
+
+ def _onesample(self, rng):
+ return getattr(rng, self._meth)(*self._args)
+
+ def _sample(self, rng, n):
+ kwds = {'size' : n}
+ return getattr(rng, self._meth)(*self._args, **kwds)
+
+
+class ExponentialDistribution(Distribution):
+ def __init__(self, lambda_):
+ if (lambda_ <= 0):
+ raise error, "parameter must be positive"
+ Distribution.__init__(self, 'exponential', lambda_)
+
+ def density(x):
+ if x < 0:
+ return 0.0
+ else:
+ lambda_ = self._args[0]
+ return lambda_*exp(-lambda_*x)
+
+class LogNormalDistribution(Distribution):
+ def __init__(self, m, s):
+ m = float(m)
+ s = float(s)
+ if (s <= 0):
+ raise error, "standard deviation must be positive"
+ Distribution.__init__(self, 'lognormal', m, s)
+ sn = math.log(1.0+s*s/(m*m));
+ self._mn = math.log(m)-0.5*sn
+ self._sn = math.sqrt(sn)
+ self._fac = 1.0/math.sqrt(2*math.pi)/self._sn
+
+ def density(x):
+ m,s = self._args
+ y = (math.log(x)-self._mn)/self._sn
+ return self._fac*exp(-0.5*y*y)/x
+
+
+class NormalDistribution(Distribution):
+ def __init__(self, m, s):
+ m = float(m)
+ s = float(s)
+ if (s <= 0):
+ raise error, "standard deviation must be positive"
+ Distribution.__init__(self, 'normal', m, s)
+ self._fac = 1.0/math.sqrt(2*math.pi)/s
+
+ def density(x):
+ m,s = self._args
+ y = (x-m)/s
+ return self._fac*exp(-0.5*y*y)
+
+class UniformDistribution(Distribution):
+ def __init__(self, a, b):
+ a = float(a)
+ b = float(b)
+ width = b-a
+ if (width <=0):
+ raise error, "width of uniform distribution must be > 0"
+ Distribution.__init__(self, 'uniform', a, b)
+ self._fac = 1.0/width
+
+ def density(x):
+ a, b = self._args
+ if (x < a) or (x >= b):
+ return 0.0
+ else:
+ return self._fac
+
+default_distribution = UniformDistribution(0.0,1.0)
+
+class CreateGenerator(object):
+ def __init__(self, seed, dist=None):
+ if seed <= 0:
+ self._rng = mt.RandomState()
+ elif seed > 0:
+ self._rng = mt.RandomState(seed)
+ if dist is None:
+ dist = default_distribution
+ if not isinstance(dist, Distribution):
+ raise error, "Not a distribution object"
+ self._dist = dist
+
+ def ranf(self):
+ return self._dist._onesample(self._rng)
+
+ def sample(self, n):
+ return self._dist._sample(self._rng, n)
+
+
+standard_generator = CreateGenerator(-1)
+
+def ranf():
+ "ranf() = a random number from the standard generator."
+ return standard_generator.ranf()
+
+def random_sample(*n):
+ """random_sample(n) = array of n random numbers;
+
+ random_sample(n1, n2, ...)= random array of shape (n1, n2, ..)"""
+
+ if not n:
+ return standard_generator.ranf()
+ m = 1
+ for i in n:
+ m = m * i
+ return standard_generator.sample(m).reshape(*n)
diff --git a/numpy/oldnumeric/rng_stats.py b/numpy/oldnumeric/rng_stats.py
new file mode 100644
index 000000000..8c7fec433
--- /dev/null
+++ b/numpy/oldnumeric/rng_stats.py
@@ -0,0 +1,35 @@
+
+__all__ = ['average', 'histogram', 'standardDeviation', 'variance']
+
+import numpy.oldnumeric as Numeric
+
+def average(data):
+ data = Numeric.array(data)
+ return Numeric.add.reduce(data)/len(data)
+
+def variance(data):
+ data = Numeric.array(data)
+ return Numeric.add.reduce((data-average(data,axis=0))**2)/(len(data)-1)
+
+def standardDeviation(data):
+ data = Numeric.array(data)
+ return Numeric.sqrt(variance(data))
+
+def histogram(data, nbins, range = None):
+ data = Numeric.array(data, Numeric.Float)
+ if range is None:
+ min = Numeric.minimum.reduce(data)
+ max = Numeric.maximum.reduce(data)
+ else:
+ min, max = range
+ data = Numeric.repeat(data,
+ Numeric.logical_and(Numeric.less_equal(data, max),
+ Numeric.greater_equal(data,
+ min)),axis=0)
+ bin_width = (max-min)/nbins
+ data = Numeric.floor((data - min)/bin_width).astype(Numeric.Int)
+ histo = Numeric.add.reduce(Numeric.equal(
+ Numeric.arange(nbins)[:,Numeric.NewAxis], data), -1)
+ histo[-1] = histo[-1] + Numeric.add.reduce(Numeric.equal(nbins, data))
+ bins = min + bin_width*(Numeric.arange(nbins)+0.5)
+ return Numeric.transpose(Numeric.array([bins, histo]))
diff --git a/numpy/oldnumeric/setup.py b/numpy/oldnumeric/setup.py
new file mode 100644
index 000000000..82e8a6201
--- /dev/null
+++ b/numpy/oldnumeric/setup.py
@@ -0,0 +1,8 @@
+
+def configuration(parent_package='',top_path=None):
+ from numpy.distutils.misc_util import Configuration
+ return Configuration('oldnumeric',parent_package,top_path)
+
+if __name__ == '__main__':
+ from numpy.distutils.core import setup
+ setup(configuration=configuration)
diff --git a/numpy/oldnumeric/tests/test_oldnumeric.py b/numpy/oldnumeric/tests/test_oldnumeric.py
new file mode 100644
index 000000000..628ec231f
--- /dev/null
+++ b/numpy/oldnumeric/tests/test_oldnumeric.py
@@ -0,0 +1,86 @@
+from numpy.testing import *
+
+from numpy import array
+from numpy.oldnumeric import *
+from numpy.core.numeric import float32, float64, complex64, complex128, int8, \
+ int16, int32, int64, uint, uint8, uint16, uint32, uint64
+
+class test_oldtypes(NumPyTestCase):
+ def check_oldtypes(self, level=1):
+ a1 = array([0,1,0], Float)
+ a2 = array([0,1,0], float)
+ assert_array_equal(a1, a2)
+ a1 = array([0,1,0], Float8)
+ a2 = array([0,1,0], float)
+ assert_array_equal(a1, a2)
+ a1 = array([0,1,0], Float16)
+ a2 = array([0,1,0], float)
+ assert_array_equal(a1, a2)
+ a1 = array([0,1,0], Float32)
+ a2 = array([0,1,0], float32)
+ assert_array_equal(a1, a2)
+ a1 = array([0,1,0], Float64)
+ a2 = array([0,1,0], float64)
+ assert_array_equal(a1, a2)
+ a1 = array([0,1,0], Complex)
+ a2 = array([0,1,0], complex)
+ assert_array_equal(a1, a2)
+ a1 = array([0,1,0], Complex8)
+ a2 = array([0,1,0], complex)
+ assert_array_equal(a1, a2)
+ a1 = array([0,1,0], Complex16)
+ a2 = array([0,1,0], complex)
+ assert_array_equal(a1, a2)
+ a1 = array([0,1,0], Complex32)
+ a2 = array([0,1,0], complex64)
+ assert_array_equal(a1, a2)
+ a1 = array([0,1,0], Complex64)
+ a2 = array([0,1,0], complex128)
+ assert_array_equal(a1, a2)
+ a1 = array([0,1,0], Int)
+ a2 = array([0,1,0], int)
+ assert_array_equal(a1, a2)
+ a1 = array([0,1,0], Int8)
+ a2 = array([0,1,0], int8)
+ assert_array_equal(a1, a2)
+ a1 = array([0,1,0], Int16)
+ a2 = array([0,1,0], int16)
+ assert_array_equal(a1, a2)
+ a1 = array([0,1,0], Int32)
+ a2 = array([0,1,0], int32)
+ assert_array_equal(a1, a2)
+ a1 = array([0,1,0], Int64)
+ a2 = array([0,1,0], int64)
+ assert_array_equal(a1, a2)
+ a1 = array([0,1,0], UnsignedInt)
+ a2 = array([0,1,0], UnsignedInteger)
+ a3 = array([0,1,0], uint)
+ assert_array_equal(a1, a3)
+ assert_array_equal(a2, a3)
+ a1 = array([0,1,0], UInt8)
+ a2 = array([0,1,0], UnsignedInt8)
+ a3 = array([0,1,0], uint8)
+ assert_array_equal(a1, a3)
+ assert_array_equal(a2, a3)
+ a1 = array([0,1,0], UInt16)
+ a2 = array([0,1,0], UnsignedInt16)
+ a3 = array([0,1,0], uint16)
+ assert_array_equal(a1, a3)
+ assert_array_equal(a2, a3)
+ a1 = array([0,1,0], UInt32)
+ a2 = array([0,1,0], UnsignedInt32)
+ a3 = array([0,1,0], uint32)
+ assert_array_equal(a1, a3)
+ assert_array_equal(a2, a3)
+ a1 = array([0,1,0], UInt64)
+ a2 = array([0,1,0], UnsignedInt64)
+ a3 = array([0,1,0], uint64)
+ assert_array_equal(a1, a3)
+ assert_array_equal(a2, a3)
+ a1 = array([0,1,0], Bool)
+ a2 = array([0,1,0], bool)
+ assert_array_equal(a1, a2)
+
+
+if __name__ == "__main__":
+ NumPyTest().run()
diff --git a/numpy/oldnumeric/typeconv.py b/numpy/oldnumeric/typeconv.py
new file mode 100644
index 000000000..1fbf1e072
--- /dev/null
+++ b/numpy/oldnumeric/typeconv.py
@@ -0,0 +1,60 @@
+__all__ = ['oldtype2dtype', 'convtypecode', 'convtypecode2', 'oldtypecodes']
+
+import numpy as N
+
+oldtype2dtype = {'1': N.dtype(N.byte),
+ 's': N.dtype(N.short),
+# 'i': N.dtype(N.intc),
+# 'l': N.dtype(int),
+# 'b': N.dtype(N.ubyte),
+ 'w': N.dtype(N.ushort),
+ 'u': N.dtype(N.uintc),
+# 'f': N.dtype(N.single),
+# 'd': N.dtype(float),
+# 'F': N.dtype(N.csingle),
+# 'D': N.dtype(complex),
+# 'O': N.dtype(object),
+# 'c': N.dtype('c'),
+ None:N.dtype(int)
+ }
+
+# converts typecode=None to int
+def convtypecode(typecode, dtype=None):
+ if dtype is None:
+ try:
+ return oldtype2dtype[typecode]
+ except:
+ return N.dtype(typecode)
+ else:
+ return dtype
+
+#if both typecode and dtype are None
+# return None
+def convtypecode2(typecode, dtype=None):
+ if dtype is None:
+ if typecode is None:
+ return None
+ else:
+ try:
+ return oldtype2dtype[typecode]
+ except:
+ return N.dtype(typecode)
+ else:
+ return dtype
+
+_changedtypes = {'B': 'b',
+ 'b': '1',
+ 'h': 's',
+ 'H': 'w',
+ 'I': 'u'}
+
+class _oldtypecodes(dict):
+ def __getitem__(self, obj):
+ char = N.dtype(obj).char
+ try:
+ return _changedtypes[char]
+ except KeyError:
+ return char
+
+
+oldtypecodes = _oldtypecodes()
diff --git a/numpy/oldnumeric/ufuncs.py b/numpy/oldnumeric/ufuncs.py
new file mode 100644
index 000000000..c26050f55
--- /dev/null
+++ b/numpy/oldnumeric/ufuncs.py
@@ -0,0 +1,19 @@
+__all__ = ['less', 'cosh', 'arcsinh', 'add', 'ceil', 'arctan2', 'floor_divide',
+ 'fmod', 'hypot', 'logical_and', 'power', 'sinh', 'remainder', 'cos',
+ 'equal', 'arccos', 'less_equal', 'divide', 'bitwise_or',
+ 'bitwise_and', 'logical_xor', 'log', 'subtract', 'invert',
+ 'negative', 'log10', 'arcsin', 'arctanh', 'logical_not',
+ 'not_equal', 'tanh', 'true_divide', 'maximum', 'arccosh',
+ 'logical_or', 'minimum', 'conjugate', 'tan', 'greater',
+ 'bitwise_xor', 'fabs', 'floor', 'sqrt', 'arctan', 'right_shift',
+ 'absolute', 'sin', 'multiply', 'greater_equal', 'left_shift',
+ 'exp', 'divide_safe']
+
+from numpy import less, cosh, arcsinh, add, ceil, arctan2, floor_divide, \
+ fmod, hypot, logical_and, power, sinh, remainder, cos, \
+ equal, arccos, less_equal, divide, bitwise_or, bitwise_and, \
+ logical_xor, log, subtract, invert, negative, log10, arcsin, \
+ arctanh, logical_not, not_equal, tanh, true_divide, maximum, \
+ arccosh, logical_or, minimum, conjugate, tan, greater, bitwise_xor, \
+ fabs, floor, sqrt, arctan, right_shift, absolute, sin, \
+ multiply, greater_equal, left_shift, exp, divide as divide_safe
diff --git a/numpy/oldnumeric/user_array.py b/numpy/oldnumeric/user_array.py
new file mode 100644
index 000000000..375c4013b
--- /dev/null
+++ b/numpy/oldnumeric/user_array.py
@@ -0,0 +1,9 @@
+
+
+from numpy.oldnumeric import *
+from numpy.lib.user_array import container as UserArray
+
+import numpy.oldnumeric as nold
+__all__ = nold.__all__[:]
+__all__ += ['UserArray']
+del nold
diff --git a/numpy/random/__init__.py b/numpy/random/__init__.py
new file mode 100644
index 000000000..5a7423208
--- /dev/null
+++ b/numpy/random/__init__.py
@@ -0,0 +1,18 @@
+# To get sub-modules
+from info import __doc__, __all__
+from mtrand import *
+
+# Some aliases:
+ranf = random = sample = random_sample
+__all__.extend(['ranf','random','sample'])
+
+def __RandomState_ctor():
+ """Return a RandomState instance.
+
+ This function exists solely to assist (un)pickling.
+ """
+ return RandomState()
+
+def test(level=1, verbosity=1):
+ from numpy.testing import NumpyTest
+ return NumpyTest().test(level, verbosity)
diff --git a/numpy/random/info.py b/numpy/random/info.py
new file mode 100644
index 000000000..8c2cae44a
--- /dev/null
+++ b/numpy/random/info.py
@@ -0,0 +1,55 @@
+"""\
+Core Random Tools
+=================
+
+"""
+
+depends = ['core']
+
+__all__ = [
+ 'beta',
+ 'binomial',
+ 'bytes',
+ 'chisquare',
+ 'exponential',
+ 'f',
+ 'gamma',
+ 'geometric',
+ 'get_state',
+ 'gumbel',
+ 'hypergeometric',
+ 'laplace',
+ 'logistic',
+ 'lognormal',
+ 'logseries',
+ 'multinomial',
+ 'multivariate_normal',
+ 'negative_binomial',
+ 'noncentral_chisquare',
+ 'noncentral_f',
+ 'normal',
+ 'pareto',
+ 'permutation',
+ 'poisson',
+ 'power',
+ 'rand',
+ 'randint',
+ 'randn',
+ 'random_integers',
+ 'random_sample',
+ 'rayleigh',
+ 'seed',
+ 'set_state',
+ 'shuffle',
+ 'standard_cauchy',
+ 'standard_exponential',
+ 'standard_gamma',
+ 'standard_normal',
+ 'standard_t',
+ 'triangular',
+ 'uniform',
+ 'vonmises',
+ 'wald',
+ 'weibull',
+ 'zipf'
+]
diff --git a/numpy/random/mtrand/Python.pxi b/numpy/random/mtrand/Python.pxi
new file mode 100644
index 000000000..03018e960
--- /dev/null
+++ b/numpy/random/mtrand/Python.pxi
@@ -0,0 +1,54 @@
+# :Author: Robert Kern
+# :Copyright: 2004, Enthought, Inc.
+# :License: BSD Style
+
+
+cdef extern from "Python.h":
+ # Not part of the Python API, but we might as well define it here.
+ # Note that the exact type doesn't actually matter for Pyrex.
+ ctypedef int size_t
+
+ # String API
+ char* PyString_AsString(object string)
+ char* PyString_AS_STRING(object string)
+ object PyString_FromString(char* c_string)
+ object PyString_FromStringAndSize(char* c_string, int length)
+
+ # Float API
+ double PyFloat_AsDouble(object ob)
+ long PyInt_AsLong(object ob)
+
+ # Memory API
+ void* PyMem_Malloc(size_t n)
+ void* PyMem_Realloc(void* buf, size_t n)
+ void PyMem_Free(void* buf)
+
+ void Py_DECREF(object obj)
+ void Py_XDECREF(object obj)
+ void Py_INCREF(object obj)
+ void Py_XINCREF(object obj)
+
+ # CObject API
+ ctypedef void (*destructor1)(void* cobj)
+ ctypedef void (*destructor2)(void* cobj, void* desc)
+ int PyCObject_Check(object p)
+ object PyCObject_FromVoidPtr(void* cobj, destructor1 destr)
+ object PyCObject_FromVoidPtrAndDesc(void* cobj, void* desc,
+ destructor2 destr)
+ void* PyCObject_AsVoidPtr(object self)
+ void* PyCObject_GetDesc(object self)
+ int PyCObject_SetVoidPtr(object self, void* cobj)
+
+ # TypeCheck API
+ int PyFloat_Check(object obj)
+ int PyInt_Check(object obj)
+
+ # Error API
+ int PyErr_Occurred()
+ void PyErr_Clear()
+
+cdef extern from "string.h":
+ void *memcpy(void *s1, void *s2, int n)
+
+cdef extern from "math.h":
+ double fabs(double x)
diff --git a/numpy/random/mtrand/distributions.c b/numpy/random/mtrand/distributions.c
new file mode 100644
index 000000000..528d8f332
--- /dev/null
+++ b/numpy/random/mtrand/distributions.c
@@ -0,0 +1,852 @@
+/* Copyright 2005 Robert Kern (robert.kern@gmail.com)
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the
+ * "Software"), to deal in the Software without restriction, including
+ * without limitation the rights to use, copy, modify, merge, publish,
+ * distribute, sublicense, and/or sell copies of the Software, and to
+ * permit persons to whom the Software is furnished to do so, subject to
+ * the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included
+ * in all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+ * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+ * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+ * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+ * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+ * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ */
+
+/* The implementations of rk_hypergeometric_hyp(), rk_hypergeometric_hrua(),
+ * and rk_triangular() were adapted from Ivan Frohne's rv.py which has this
+ * license:
+ *
+ * Copyright 1998 by Ivan Frohne; Wasilla, Alaska, U.S.A.
+ * All Rights Reserved
+ *
+ * Permission to use, copy, modify and distribute this software and its
+ * documentation for any purpose, free of charge, is granted subject to the
+ * following conditions:
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the software.
+ *
+ * THE SOFTWARE AND DOCUMENTATION IS PROVIDED WITHOUT WARRANTY OF ANY KIND,
+ * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO MERCHANTABILITY, FITNESS
+ * FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHOR
+ * OR COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM OR DAMAGES IN A CONTRACT
+ * ACTION, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+ * SOFTWARE OR ITS DOCUMENTATION.
+ */
+
+#include <math.h>
+#include "distributions.h"
+#include <stdio.h>
+
+#ifndef min
+#define min(x,y) ((x<y)?x:y)
+#define max(x,y) ((x>y)?x:y)
+#endif
+
+#ifndef M_PI
+#define M_PI 3.14159265358979323846264338328
+#endif
+/* log-gamma function to support some of these distributions. The
+ * algorithm comes from SPECFUN by Shanjie Zhang and Jianming Jin and their
+ * book "Computation of Special Functions", 1996, John Wiley & Sons, Inc.
+ */
+extern double loggam(double x);
+double loggam(double x)
+{
+ double x0, x2, xp, gl, gl0;
+ long k, n;
+
+ static double a[10] = {8.333333333333333e-02,-2.777777777777778e-03,
+ 7.936507936507937e-04,-5.952380952380952e-04,
+ 8.417508417508418e-04,-1.917526917526918e-03,
+ 6.410256410256410e-03,-2.955065359477124e-02,
+ 1.796443723688307e-01,-1.39243221690590e+00};
+ x0 = x;
+ n = 0;
+ if ((x == 1.0) || (x == 2.0))
+ {
+ return 0.0;
+ }
+ else if (x <= 7.0)
+ {
+ n = (long)(7 - x);
+ x0 = x + n;
+ }
+ x2 = 1.0/(x0*x0);
+ xp = 2*M_PI;
+ gl0 = a[9];
+ for (k=8; k>=0; k--)
+ {
+ gl0 *= x2;
+ gl0 += a[k];
+ }
+ gl = gl0/x0 + 0.5*log(xp) + (x0-0.5)*log(x0) - x0;
+ if (x <= 7.0)
+ {
+ for (k=1; k<=n; k++)
+ {
+ gl -= log(x0-1.0);
+ x0 -= 1.0;
+ }
+ }
+ return gl;
+}
+
+double rk_normal(rk_state *state, double loc, double scale)
+{
+ return loc + scale*rk_gauss(state);
+}
+
+double rk_standard_exponential(rk_state *state)
+{
+ /* We use -log(1-U) since U is [0, 1) */
+ return -log(1.0 - rk_double(state));
+}
+
+double rk_exponential(rk_state *state, double scale)
+{
+ return scale * rk_standard_exponential(state);
+}
+
+double rk_uniform(rk_state *state, double loc, double scale)
+{
+ return loc + scale*rk_double(state);
+}
+
+double rk_standard_gamma(rk_state *state, double shape)
+{
+ double b, c;
+ double U, V, X, Y;
+
+ if (shape == 1.0)
+ {
+ return rk_standard_exponential(state);
+ }
+ else if (shape < 1.0)
+ {
+ for (;;)
+ {
+ U = rk_double(state);
+ V = rk_standard_exponential(state);
+ if (U <= 1.0 - shape)
+ {
+ X = pow(U, 1./shape);
+ if (X <= V)
+ {
+ return X;
+ }
+ }
+ else
+ {
+ Y = -log((1-U)/shape);
+ X = pow(1.0 - shape + shape*Y, 1./shape);
+ if (X <= (V + Y))
+ {
+ return X;
+ }
+ }
+ }
+ }
+ else
+ {
+ b = shape - 1./3.;
+ c = 1./sqrt(9*b);
+ for (;;)
+ {
+ do
+ {
+ X = rk_gauss(state);
+ V = 1.0 + c*X;
+ } while (V <= 0.0);
+
+ V = V*V*V;
+ U = rk_double(state);
+ if (U < 1.0 - 0.0331*(X*X)*(X*X)) return (b*V);
+ if (log(U) < 0.5*X*X + b*(1. - V + log(V))) return (b*V);
+ }
+ }
+}
+
+double rk_gamma(rk_state *state, double shape, double scale)
+{
+ return scale * rk_standard_gamma(state, shape);
+}
+
+double rk_beta(rk_state *state, double a, double b)
+{
+ double Ga, Gb;
+
+ if ((a <= 1.0) && (b <= 1.0))
+ {
+ double U, V, X, Y;
+ /* Use Jonk's algorithm */
+
+ while (1)
+ {
+ U = rk_double(state);
+ V = rk_double(state);
+ X = pow(U, 1.0/a);
+ Y = pow(V, 1.0/b);
+
+ if ((X + Y) <= 1.0)
+ {
+ return X / (X + Y);
+ }
+ }
+ }
+ else
+ {
+ Ga = rk_standard_gamma(state, a);
+ Gb = rk_standard_gamma(state, b);
+ return Ga/(Ga + Gb);
+ }
+}
+
+double rk_chisquare(rk_state *state, double df)
+{
+ return 2.0*rk_standard_gamma(state, df/2.0);
+}
+
+double rk_noncentral_chisquare(rk_state *state, double df, double nonc)
+{
+ double Chi2, N;
+
+ Chi2 = rk_chisquare(state, df-1);
+ N = rk_gauss(state) + sqrt(nonc);
+ return Chi2 + N*N;
+}
+
+double rk_f(rk_state *state, double dfnum, double dfden)
+{
+ return rk_chisquare(state, dfnum) / rk_chisquare(state, dfden);
+}
+
+double rk_noncentral_f(rk_state *state, double dfnum, double dfden, double nonc)
+{
+ return ((rk_noncentral_chisquare(state, dfnum, nonc)*dfden) /
+ (rk_chisquare(state, dfden)*dfnum));
+}
+
+long rk_binomial_btpe(rk_state *state, long n, double p)
+{
+ double r,q,fm,p1,xm,xl,xr,c,laml,lamr,p2,p3,p4;
+ double a,u,v,s,F,rho,t,A,nrq,x1,x2,f1,f2,z,z2,w,w2,x;
+ long m,y,k,i;
+
+ if (!(state->has_binomial) ||
+ (state->nsave != n) ||
+ (state->psave != p))
+ {
+ /* initialize */
+ state->nsave = n;
+ state->psave = p;
+ state->has_binomial = 1;
+ state->r = r = min(p, 1.0-p);
+ state->q = q = 1.0 - r;
+ state->fm = fm = n*r+r;
+ state->m = m = (long)floor(state->fm);
+ state->p1 = p1 = floor(2.195*sqrt(n*r*q)-4.6*q) + 0.5;
+ state->xm = xm = m + 0.5;
+ state->xl = xl = xm - p1;
+ state->xr = xr = xm + p1;
+ state->c = c = 0.134 + 20.5/(15.3 + m);
+ a = (fm - xl)/(fm-xl*r);
+ state->laml = laml = a*(1.0 + a/2.0);
+ a = (xr - fm)/(xr*q);
+ state->lamr = lamr = a*(1.0 + a/2.0);
+ state->p2 = p2 = p1*(1.0 + 2.0*c);
+ state->p3 = p3 = p2 + c/laml;
+ state->p4 = p4 = p3 + c/lamr;
+ }
+ else
+ {
+ r = state->r;
+ q = state->q;
+ fm = state->fm;
+ m = state->m;
+ p1 = state->p1;
+ xm = state->xm;
+ xl = state->xl;
+ xr = state->xr;
+ c = state->c;
+ laml = state->laml;
+ lamr = state->lamr;
+ p2 = state->p2;
+ p3 = state->p3;
+ p4 = state->p4;
+ }
+
+ /* sigh ... */
+ Step10:
+ nrq = n*r*q;
+ u = rk_double(state)*p4;
+ v = rk_double(state);
+ if (u > p1) goto Step20;
+ y = (long)floor(xm - p1*v + u);
+ goto Step60;
+
+ Step20:
+ if (u > p2) goto Step30;
+ x = xl + (u - p1)/c;
+ v = v*c + 1.0 - fabs(m - x + 0.5)/p1;
+ if (v > 1.0) goto Step10;
+ y = (long)floor(x);
+ goto Step50;
+
+ Step30:
+ if (u > p3) goto Step40;
+ y = (long)floor(xl + log(v)/laml);
+ if (y < 0) goto Step10;
+ v = v*(u-p2)*laml;
+ goto Step50;
+
+ Step40:
+ y = (int)floor(xr - log(v)/lamr);
+ if (y > n) goto Step10;
+ v = v*(u-p3)*lamr;
+
+ Step50:
+ k = fabs(y - m);
+ if ((k > 20) && (k < ((nrq)/2.0 - 1))) goto Step52;
+
+ s = r/q;
+ a = s*(n+1);
+ F = 1.0;
+ if (m < y)
+ {
+ for (i=m; i<=y; i++)
+ {
+ F *= (a/i - s);
+ }
+ }
+ else if (m > y)
+ {
+ for (i=y; i<=m; i++)
+ {
+ F /= (a/i - s);
+ }
+ }
+ else
+ {
+ if (v > F) goto Step10;
+ goto Step60;
+ }
+
+ Step52:
+ rho = (k/(nrq))*((k*(k/3.0 + 0.625) + 0.16666666666666666)/nrq + 0.5);
+ t = -k*k/(2*nrq);
+ A = log(v);
+ if (A < (t - rho)) goto Step60;
+ if (A > (t + rho)) goto Step10;
+
+ x1 = y+1;
+ f1 = m+1;
+ z = n+1-m;
+ w = n-y+1;
+ x2 = x1*x1;
+ f2 = f1*f1;
+ z2 = z*z;
+ w2 = w*w;
+ if (A > (xm*log(f1/x1)
+ + (n-m+0.5)*log(z/w)
+ + (y-m)*log(w*r/(x1*q))
+ + (13680.-(462.-(132.-(99.-140./f2)/f2)/f2)/f2)/f1/166320.
+ + (13680.-(462.-(132.-(99.-140./z2)/z2)/z2)/z2)/z/166320.
+ + (13680.-(462.-(132.-(99.-140./x2)/x2)/x2)/x2)/x1/166320.
+ + (13680.-(462.-(132.-(99.-140./w2)/w2)/w2)/w2)/w/166320.))
+ {
+ goto Step10;
+ }
+
+ Step60:
+ if (p > 0.5)
+ {
+ y = n - y;
+ }
+
+ return y;
+}
+
+long rk_binomial_inversion(rk_state *state, long n, double p)
+{
+ double q, qn, np, px, U;
+ long X, bound;
+
+ if (!(state->has_binomial) ||
+ (state->nsave != n) ||
+ (state->psave != p))
+ {
+ state->nsave = n;
+ state->psave = p;
+ state->has_binomial = 1;
+ state->q = q = 1.0 - p;
+ state->r = qn = exp(n * log(q));
+ state->c = np = n*p;
+ state->m = bound = min(n, np + 10.0*sqrt(np));
+ } else
+ {
+ q = state->q;
+ qn = state->r;
+ np = state->c;
+ bound = state->m;
+ }
+ X = 0;
+ px = qn;
+ U = rk_double(state);
+ while (U > px)
+ {
+ X++;
+ if (X > bound)
+ {
+ X = 0;
+ px = qn;
+ U = rk_double(state);
+ } else
+ {
+ U -= px;
+ px = ((n-X+1) * p * px)/(X*q);
+ }
+ }
+ return X;
+}
+
+long rk_binomial(rk_state *state, long n, double p)
+{
+ double q;
+
+ if (p <= 0.5)
+ {
+ if (p*n <= 30.0)
+ {
+ return rk_binomial_inversion(state, n, p);
+ }
+ else
+ {
+ return rk_binomial_btpe(state, n, p);
+ }
+ }
+ else
+ {
+ q = 1.0-p;
+ if (q*n <= 30.0)
+ {
+ return n - rk_binomial_inversion(state, n, q);
+ }
+ else
+ {
+ return n - rk_binomial_btpe(state, n, q);
+ }
+ }
+
+}
+
+long rk_negative_binomial(rk_state *state, long n, double p)
+{
+ double Y;
+
+ Y = rk_gamma(state, n, (1-p)/p);
+ return rk_poisson(state, Y);
+}
+
+long rk_poisson_mult(rk_state *state, double lam)
+{
+ long X;
+ double prod, U, enlam;
+
+ enlam = exp(-lam);
+ X = 0;
+ prod = 1.0;
+ while (1)
+ {
+ U = rk_double(state);
+ prod *= U;
+ if (prod > enlam)
+ {
+ X += 1;
+ }
+ else
+ {
+ return X;
+ }
+ }
+}
+
+#define LS2PI 0.91893853320467267
+#define TWELFTH 0.083333333333333333333333
+long rk_poisson_ptrs(rk_state *state, double lam)
+{
+ long k;
+ double U, V, slam, loglam, a, b, invalpha, vr, us;
+
+ slam = sqrt(lam);
+ loglam = log(lam);
+ b = 0.931 + 2.53*slam;
+ a = -0.059 + 0.02483*b;
+ invalpha = 1.1239 + 1.1328/(b-3.4);
+ vr = 0.9277 - 3.6224/(b-2);
+
+ while (1)
+ {
+ U = rk_double(state) - 0.5;
+ V = rk_double(state);
+ us = 0.5 - fabs(U);
+ k = (long)floor((2*a/us + b)*U + lam + 0.43);
+ if ((us >= 0.07) && (V <= vr))
+ {
+ return k;
+ }
+ if ((k < 0) ||
+ ((us < 0.013) && (V > us)))
+ {
+ continue;
+ }
+ if ((log(V) + log(invalpha) - log(a/(us*us)+b)) <=
+ (-lam + k*loglam - loggam(k+1)))
+ {
+ return k;
+ }
+
+
+ }
+
+}
+
+long rk_poisson(rk_state *state, double lam)
+{
+ if (lam >= 10)
+ {
+ return rk_poisson_ptrs(state, lam);
+ }
+ else if (lam == 0)
+ {
+ return 0;
+ }
+ else
+ {
+ return rk_poisson_mult(state, lam);
+ }
+}
+
+double rk_standard_cauchy(rk_state *state)
+{
+ return rk_gauss(state) / rk_gauss(state);
+}
+
+double rk_standard_t(rk_state *state, double df)
+{
+ double N, G, X;
+
+ N = rk_gauss(state);
+ G = rk_standard_gamma(state, df/2);
+ X = sqrt(df/2)*N/sqrt(G);
+ return X;
+}
+
+double rk_vonmises(rk_state *state, double mu, double kappa)
+{
+ double r, rho, s;
+ double U, V, W, Y, Z;
+ double result, mod;
+
+ if (kappa < 1e-8)
+ {
+ return M_PI * (2*rk_double(state)-1);
+ }
+ else
+ {
+ r = 1 + sqrt(1 + 4*kappa*kappa);
+ rho = (r - sqrt(2*r))/(2*kappa);
+ s = (1 + rho*rho)/(2*rho);
+
+ while (1)
+ {
+ U = 2*rk_double(state) - 1;
+ V = 2*rk_double(state) - 1;
+ Z = cos(M_PI*U);
+ W = (1 + s*Z)/(s + Z);
+ Y = kappa * (s - W);
+ if ((Y*(2-Y) - V >= 0) || (log(Y/V)+1 - Y >= 0))
+ {
+ break;
+ }
+ }
+
+ if (U < 0)
+ {
+ result = acos(W);
+ }
+ else
+ {
+ result = -acos(W);
+ }
+ result += mu + M_PI;
+ mod = fmod(result, 2*M_PI);
+ if (mod && (mod < 0))
+ {
+ mod += 2*M_PI;
+ }
+ return mod - M_PI;
+ }
+}
+
+double rk_pareto(rk_state *state, double a)
+{
+ return exp(rk_standard_exponential(state)/a) - 1;
+}
+
+double rk_weibull(rk_state *state, double a)
+{
+ return pow(rk_standard_exponential(state), 1./a);
+}
+
+double rk_power(rk_state *state, double a)
+{
+ return pow(1 - exp(-rk_standard_exponential(state)), 1./a);
+}
+
+double rk_laplace(rk_state *state, double loc, double scale)
+{
+ double U;
+
+ U = rk_double(state);
+ if (U < 0.5)
+ {
+ U = loc + scale * log(U + U);
+ } else
+ {
+ U = loc - scale * log(2.0 - U - U);
+ }
+ return U;
+}
+
+double rk_gumbel(rk_state *state, double loc, double scale)
+{
+ double U;
+
+ U = 1.0 - rk_double(state);
+ return loc - scale * log(-log(U));
+}
+
+double rk_logistic(rk_state *state, double loc, double scale)
+{
+ double U;
+
+ U = rk_double(state);
+ return loc + scale * log(U/(1.0 - U));
+}
+
+double rk_lognormal(rk_state *state, double mean, double sigma)
+{
+ return exp(rk_normal(state, mean, sigma));
+}
+
+double rk_rayleigh(rk_state *state, double mode)
+{
+ return mode*sqrt(-2.0 * log(1.0 - rk_double(state)));
+}
+
+double rk_wald(rk_state *state, double mean, double scale)
+{
+ double U, X, Y;
+ double mu_2l;
+
+ mu_2l = mean / (2*scale);
+ Y = rk_gauss(state);
+ Y = mean*Y*Y;
+ X = mean + mu_2l*(Y - sqrt(4*scale*Y + Y*Y));
+ U = rk_double(state);
+ if (U <= mean/(mean+X))
+ {
+ return X;
+ } else
+ {
+ return mean*mean/X;
+ }
+}
+
+long rk_zipf(rk_state *state, double a)
+{
+ double T, U, V;
+ long X;
+ double b;
+
+ b = pow(2.0, a-1.0);
+ do
+ {
+ U = rk_double(state);
+ V = rk_double(state);
+ X = (long)floor(pow(U, -1.0/(a-1.0)));
+ T = pow(1.0 + 1.0/X, a-1.0);
+ } while ((V *X*(T-1.0)/(b-1.0)) > (T/b));
+ return X;
+}
+
+long rk_geometric_search(rk_state *state, double p)
+{
+ double U;
+ long X;
+ double sum, prod, q;
+
+ X = 1;
+ sum = prod = p;
+ q = 1.0 - p;
+ U = rk_double(state);
+ while (U > sum)
+ {
+ prod *= q;
+ sum += prod;
+ X++;
+ }
+ return X;
+}
+
+long rk_geometric_inversion(rk_state *state, double p)
+{
+ return (long)ceil(log(1.0-rk_double(state))/log(1.0-p));
+}
+
+long rk_geometric(rk_state *state, double p)
+{
+ if (p >= 0.333333333333333333333333)
+ {
+ return rk_geometric_search(state, p);
+ } else
+ {
+ return rk_geometric_inversion(state, p);
+ }
+}
+
+long rk_hypergeometric_hyp(rk_state *state, long good, long bad, long sample)
+{
+ long d1, K, Z;
+ double d2, U, Y;
+
+ d1 = bad + good - sample;
+ d2 = (double)min(bad, good);
+
+ Y = d2;
+ K = sample;
+ while (Y > 0.0)
+ {
+ U = rk_double(state);
+ Y -= (long)floor(U + Y/(d1 + K));
+ K--;
+ if (K == 0) break;
+ }
+ Z = (long)(d2 - Y);
+ if (bad > good) Z = sample - Z;
+ return Z;
+}
+
+/* D1 = 2*sqrt(2/e) */
+/* D2 = 3 - 2*sqrt(3/e) */
+#define D1 1.7155277699214135
+#define D2 0.8989161620588988
+long rk_hypergeometric_hrua(rk_state *state, long good, long bad, long sample)
+{
+ long mingoodbad, maxgoodbad, popsize, m, d9;
+ double d4, d5, d6, d7, d8, d10, d11;
+ long Z;
+ double T, W, X, Y;
+
+ mingoodbad = min(good, bad);
+ popsize = good + bad;
+ maxgoodbad = max(good, bad);
+ m = min(sample, popsize - sample);
+ d4 = ((double)mingoodbad) / popsize;
+ d5 = 1.0 - d4;
+ d6 = m*d4 + 0.5;
+ d7 = sqrt((popsize - m) * sample * d4 *d5 / (popsize-1) + 0.5);
+ d8 = D1*d7 + D2;
+ d9 = (long)floor((double)((m+1)*(mingoodbad+1))/(popsize+2));
+ d10 = (loggam(d9+1) + loggam(mingoodbad-d9+1) + loggam(m-d9+1) +
+ loggam(maxgoodbad-m+d9+1));
+ d11 = min(min(m, mingoodbad)+1.0, floor(d6+16*d7));
+ /* 16 for 16-decimal-digit precision in D1 and D2 */
+
+ while (1)
+ {
+ X = rk_double(state);
+ Y = rk_double(state);
+ W = d6 + d8*(Y- 0.5)/X;
+
+ /* fast rejection: */
+ if ((W < 0.0) || (W >= d11)) continue;
+
+ Z = (long)floor(W);
+ T = d10 - (loggam(Z+1) + loggam(mingoodbad-Z+1) + loggam(m-Z+1) +
+ loggam(maxgoodbad-m+Z+1));
+
+ /* fast acceptance: */
+ if ((X*(4.0-X)-3.0) <= T) break;
+
+ /* fast rejection: */
+ if (X*(X-T) >= 1) continue;
+
+ if (2.0*log(X) <= T) break; /* acceptance */
+ }
+
+ /* this is a correction to HRUA* by Ivan Frohne in rv.py */
+ if (bad > good) Z = m - Z;
+
+ /* another fix from rv.py to allow sample to exceed popsize/2 */
+ if (m < sample) Z = bad - Z;
+
+ return Z;
+}
+#undef D1
+#undef D2
+
+long rk_hypergeometric(rk_state *state, long good, long bad, long sample)
+{
+ if (sample > 10)
+ {
+ return rk_hypergeometric_hrua(state, good, bad, sample);
+ } else
+ {
+ return rk_hypergeometric_hyp(state, good, bad, sample);
+ }
+}
+
+double rk_triangular(rk_state *state, double left, double mode, double right)
+{
+ double base, leftbase, ratio, leftprod, rightprod;
+ double U;
+
+ base = right - left;
+ leftbase = mode - left;
+ ratio = leftbase / base;
+ leftprod = leftbase*base;
+ rightprod = (right - mode)*base;
+
+ U = rk_double(state);
+ if (U <= ratio)
+ {
+ return left + sqrt(U*leftprod);
+ } else
+ {
+ return right - sqrt((1.0 - U) * rightprod);
+ }
+}
+
+long rk_logseries(rk_state *state, double p)
+{
+ double q, r, U, V;
+
+ r = log(1.0 - p);
+
+ V = rk_double(state);
+ if (V >= p) return 1;
+ U = rk_double(state);
+ q = 1.0 - exp(r*U);
+ if (V <= q*q) return (long)floor(1 + log(V)/log(q));
+ if (V <= q) return 1;
+ return 2;
+}
diff --git a/numpy/random/mtrand/distributions.h b/numpy/random/mtrand/distributions.h
new file mode 100644
index 000000000..0d6de639d
--- /dev/null
+++ b/numpy/random/mtrand/distributions.h
@@ -0,0 +1,185 @@
+/* Copyright 2005 Robert Kern (robert.kern@gmail.com)
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the
+ * "Software"), to deal in the Software without restriction, including
+ * without limitation the rights to use, copy, modify, merge, publish,
+ * distribute, sublicense, and/or sell copies of the Software, and to
+ * permit persons to whom the Software is furnished to do so, subject to
+ * the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included
+ * in all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+ * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+ * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+ * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+ * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+ * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ */
+
+#ifndef _RK_DISTR_
+#define _RK_DISTR_
+
+#include "randomkit.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* References:
+ *
+ * Devroye, Luc. _Non-Uniform Random Variate Generation_.
+ * Springer-Verlag, New York, 1986.
+ * http://cgm.cs.mcgill.ca/~luc/rnbookindex.html
+ *
+ * Kachitvichyanukul, V. and Schmeiser, B. W. Binomial Random Variate
+ * Generation. Communications of the ACM, 31, 2 (February, 1988) 216.
+ *
+ * Hoermann, W. The Transformed Rejection Method for Generating Poisson Random
+ * Variables. Insurance: Mathematics and Economics, (to appear)
+ * http://citeseer.csail.mit.edu/151115.html
+ *
+ * Marsaglia, G. and Tsang, W. W. A Simple Method for Generating Gamma
+ * Variables. ACM Transactions on Mathematical Software, Vol. 26, No. 3,
+ * September 2000, Pages 363–372.
+ */
+
+/* Normal distribution with mean=loc and standard deviation=scale. */
+extern double rk_normal(rk_state *state, double loc, double scale);
+
+/* Standard exponential distribution (mean=1) computed by inversion of the
+ * CDF. */
+extern double rk_standard_exponential(rk_state *state);
+
+/* Exponential distribution with mean=scale. */
+extern double rk_exponential(rk_state *state, double scale);
+
+/* Uniform distribution on interval [loc, loc+scale). */
+extern double rk_uniform(rk_state *state, double loc, double scale);
+
+/* Standard gamma distribution with shape parameter.
+ * When shape < 1, the algorithm given by (Devroye p. 304) is used.
+ * When shape == 1, a Exponential variate is generated.
+ * When shape > 1, the small and fast method of (Marsaglia and Tsang 2000)
+ * is used.
+ */
+extern double rk_standard_gamma(rk_state *state, double shape);
+
+/* Gamma distribution with shape and scale. */
+extern double rk_gamma(rk_state *state, double shape, double scale);
+
+/* Beta distribution computed by combining two gamma variates (Devroye p. 432).
+ */
+extern double rk_beta(rk_state *state, double a, double b);
+
+/* Chi^2 distribution computed by transforming a gamma variate (it being a
+ * special case Gamma(df/2, 2)). */
+extern double rk_chisquare(rk_state *state, double df);
+
+/* Noncentral Chi^2 distribution computed by modifying a Chi^2 variate. */
+extern double rk_noncentral_chisquare(rk_state *state, double df, double nonc);
+
+/* F distribution computed by taking the ratio of two Chi^2 variates. */
+extern double rk_f(rk_state *state, double dfnum, double dfden);
+
+/* Noncentral F distribution computed by taking the ratio of a noncentral Chi^2
+ * and a Chi^2 variate. */
+extern double rk_noncentral_f(rk_state *state, double dfnum, double dfden, double nonc);
+
+/* Binomial distribution with n Bernoulli trials with success probability p.
+ * When n*p <= 30, the "Second waiting time method" given by (Devroye p. 525) is
+ * used. Otherwise, the BTPE algorithm of (Kachitvichyanukul and Schmeiser 1988)
+ * is used. */
+extern long rk_binomial(rk_state *state, long n, double p);
+
+/* Binomial distribution using BTPE. */
+extern long rk_binomial_btpe(rk_state *state, long n, double p);
+
+/* Binomial distribution using inversion and chop-down */
+extern long rk_binomial_inversion(rk_state *state, long n, double p);
+
+/* Negative binomial distribution computed by generating a Gamma(n, (1-p)/p)
+ * variate Y and returning a Poisson(Y) variate (Devroye p. 543). */
+extern long rk_negative_binomial(rk_state *state, long n, double p);
+
+/* Poisson distribution with mean=lam.
+ * When lam < 10, a basic algorithm using repeated multiplications of uniform
+ * variates is used (Devroye p. 504).
+ * When lam >= 10, algorithm PTRS from (Hoermann 1992) is used.
+ */
+extern long rk_poisson(rk_state *state, double lam);
+
+/* Poisson distribution computed by repeated multiplication of uniform variates.
+ */
+extern long rk_poisson_mult(rk_state *state, double lam);
+
+/* Poisson distribution computer by the PTRS algorithm. */
+extern long rk_poisson_ptrs(rk_state *state, double lam);
+
+/* Standard Cauchy distribution computed by dividing standard gaussians
+ * (Devroye p. 451). */
+extern double rk_standard_cauchy(rk_state *state);
+
+/* Standard t-distribution with df degrees of freedom (Devroye p. 445 as
+ * corrected in the Errata). */
+extern double rk_standard_t(rk_state *state, double df);
+
+/* von Mises circular distribution with center mu and shape kappa on [-pi,pi]
+ * (Devroye p. 476 as corrected in the Errata). */
+extern double rk_vonmises(rk_state *state, double mu, double kappa);
+
+/* Pareto distribution via inversion (Devroye p. 262) */
+extern double rk_pareto(rk_state *state, double a);
+
+/* Weibull distribution via inversion (Devroye p. 262) */
+extern double rk_weibull(rk_state *state, double a);
+
+/* Power distribution via inversion (Devroye p. 262) */
+extern double rk_power(rk_state *state, double a);
+
+/* Laplace distribution */
+extern double rk_laplace(rk_state *state, double loc, double scale);
+
+/* Gumbel distribution */
+extern double rk_gumbel(rk_state *state, double loc, double scale);
+
+/* Logistic distribution */
+extern double rk_logistic(rk_state *state, double loc, double scale);
+
+/* Log-normal distribution */
+extern double rk_lognormal(rk_state *state, double mean, double sigma);
+
+/* Rayleigh distribution */
+extern double rk_rayleigh(rk_state *state, double mode);
+
+/* Wald distribution */
+extern double rk_wald(rk_state *state, double mean, double scale);
+
+/* Zipf distribution */
+extern long rk_zipf(rk_state *state, double a);
+
+/* Geometric distribution */
+extern long rk_geometric(rk_state *state, double p);
+extern long rk_geometric_search(rk_state *state, double p);
+extern long rk_geometric_inversion(rk_state *state, double p);
+
+/* Hypergeometric distribution */
+extern long rk_hypergeometric(rk_state *state, long good, long bad, long sample);
+extern long rk_hypergeometric_hyp(rk_state *state, long good, long bad, long sample);
+extern long rk_hypergeometric_hrua(rk_state *state, long good, long bad, long sample);
+
+/* Triangular distribution */
+extern double rk_triangular(rk_state *state, double left, double mode, double right);
+
+/* Logarithmic series distribution */
+extern long rk_logseries(rk_state *state, double p);
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#endif /* _RK_DISTR_ */
diff --git a/numpy/random/mtrand/generate_mtrand_c.py b/numpy/random/mtrand/generate_mtrand_c.py
new file mode 100644
index 000000000..8eb6254f2
--- /dev/null
+++ b/numpy/random/mtrand/generate_mtrand_c.py
@@ -0,0 +1,37 @@
+#!/usr/bin/env python
+import sys
+import re
+import os
+
+unused_internal_funcs = ['__Pyx_PrintItem',
+ '__Pyx_PrintNewline',
+ '__Pyx_ReRaise',
+ #'__Pyx_GetExcValue',
+ '__Pyx_ArgTypeTest',
+ '__Pyx_SetVtable',
+ '__Pyx_GetVtable',
+ '__Pyx_CreateClass']
+
+if __name__ == '__main__':
+ os.system('pyrexc mtrand.pyx')
+ mtrand_c = open('mtrand.c', 'r')
+ processed = open('mtrand_pp.c', 'w')
+ unused_funcs_str = '(' + '|'.join(unused_internal_funcs) + ')'
+ uifpat = re.compile(r'static \w+ \*?'+unused_funcs_str+r'.*/\*proto\*/')
+ for linenum, line in enumerate(mtrand_c):
+ m = re.match(r'^(\s+arrayObject\w*\s*=\s*[(])[(]PyObject\s*[*][)]',
+ line)
+ if m:
+ line = '%s(PyArrayObject *)%s' % (m.group(1), line[m.end():])
+ m = uifpat.match(line)
+ if m:
+ line = ''
+ m = re.search(unused_funcs_str, line)
+ if m:
+ print >>sys.stderr, \
+ "%s was declared unused, but is used at line %d" % (m.group(),
+ linenum+1)
+ processed.write(line)
+ mtrand_c.close()
+ processed.close()
+ os.rename('mtrand_pp.c', 'mtrand.c')
diff --git a/numpy/random/mtrand/initarray.c b/numpy/random/mtrand/initarray.c
new file mode 100644
index 000000000..07ad2cc4f
--- /dev/null
+++ b/numpy/random/mtrand/initarray.c
@@ -0,0 +1,136 @@
+/* These function have been adapted from Python 2.4.1's _randommodule.c
+
+ The following changes have been made to it in 2005 by Robert Kern:
+
+ * init_by_array has been declared extern, has a void return, and uses the
+ rk_state structure to hold its data.
+
+ The original file has the following verbatim comments:
+
+ ------------------------------------------------------------------
+ The code in this module was based on a download from:
+ http://www.math.keio.ac.jp/~matumoto/MT2002/emt19937ar.html
+
+ It was modified in 2002 by Raymond Hettinger as follows:
+
+ * the principal computational lines untouched except for tabbing.
+
+ * renamed genrand_res53() to random_random() and wrapped
+ in python calling/return code.
+
+ * genrand_int32() and the helper functions, init_genrand()
+ and init_by_array(), were declared static, wrapped in
+ Python calling/return code. also, their global data
+ references were replaced with structure references.
+
+ * unused functions from the original were deleted.
+ new, original C python code was added to implement the
+ Random() interface.
+
+ The following are the verbatim comments from the original code:
+
+ A C-program for MT19937, with initialization improved 2002/1/26.
+ Coded by Takuji Nishimura and Makoto Matsumoto.
+
+ Before using, initialize the state by using init_genrand(seed)
+ or init_by_array(init_key, key_length).
+
+ Copyright (C) 1997 - 2002, Makoto Matsumoto and Takuji Nishimura,
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ 2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+ 3. The names of its contributors may not be used to endorse or promote
+ products derived from this software without specific prior written
+ permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
+ CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+ Any feedback is very welcome.
+ http://www.math.keio.ac.jp/matumoto/emt.html
+ email: matumoto@math.keio.ac.jp
+*/
+
+#include "initarray.h"
+
+static void
+init_genrand(rk_state *self, unsigned long s);
+
+/* initializes mt[RK_STATE_LEN] with a seed */
+static void
+init_genrand(rk_state *self, unsigned long s)
+{
+ int mti;
+ unsigned long *mt;
+
+ mt = self->key;
+ mt[0]= s & 0xffffffffUL;
+ for (mti=1; mti<RK_STATE_LEN; mti++) {
+ mt[mti] =
+ (1812433253UL * (mt[mti-1] ^ (mt[mti-1] >> 30)) + mti);
+ /* See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. */
+ /* In the previous versions, MSBs of the seed affect */
+ /* only MSBs of the array mt[]. */
+ /* 2002/01/09 modified by Makoto Matsumoto */
+ mt[mti] &= 0xffffffffUL;
+ /* for >32 bit machines */
+ }
+ self->pos = mti;
+ return;
+}
+
+
+/* initialize by an array with array-length */
+/* init_key is the array for initializing keys */
+/* key_length is its length */
+extern void
+init_by_array(rk_state *self, unsigned long init_key[], unsigned long key_length)
+{
+ unsigned int i, j, k; /* was signed in the original code. RDH 12/16/2002 */
+ unsigned long *mt;
+
+ mt = self->key;
+ init_genrand(self, 19650218UL);
+ i=1; j=0;
+ k = (RK_STATE_LEN>key_length ? RK_STATE_LEN : key_length);
+ for (; k; k--) {
+ mt[i] = (mt[i] ^ ((mt[i-1] ^ (mt[i-1] >> 30)) * 1664525UL))
+ + init_key[j] + j; /* non linear */
+ mt[i] &= 0xffffffffUL; /* for WORDSIZE > 32 machines */
+ i++; j++;
+ if (i>=RK_STATE_LEN) { mt[0] = mt[RK_STATE_LEN-1]; i=1; }
+ if (j>=key_length) j=0;
+ }
+ for (k=RK_STATE_LEN-1; k; k--) {
+ mt[i] = (mt[i] ^ ((mt[i-1] ^ (mt[i-1] >> 30)) * 1566083941UL))
+ - i; /* non linear */
+ mt[i] &= 0xffffffffUL; /* for WORDSIZE > 32 machines */
+ i++;
+ if (i>=RK_STATE_LEN) { mt[0] = mt[RK_STATE_LEN-1]; i=1; }
+ }
+
+ mt[0] = 0x80000000UL; /* MSB is 1; assuring non-zero initial array */
+ self->has_gauss = 0;
+ self->has_binomial = 0;
+}
+
diff --git a/numpy/random/mtrand/initarray.h b/numpy/random/mtrand/initarray.h
new file mode 100644
index 000000000..a4ac210f4
--- /dev/null
+++ b/numpy/random/mtrand/initarray.h
@@ -0,0 +1,6 @@
+#include "randomkit.h"
+
+extern void
+init_by_array(rk_state *self, unsigned long init_key[],
+ unsigned long key_length);
+
diff --git a/numpy/random/mtrand/mtrand.c b/numpy/random/mtrand/mtrand.c
new file mode 100644
index 000000000..17aaeb4bf
--- /dev/null
+++ b/numpy/random/mtrand/mtrand.c
@@ -0,0 +1,10907 @@
+/* Generated by Pyrex 0.9.5.1a on Mon Apr 2 09:24:19 2007 */
+
+#include "Python.h"
+#include "structmember.h"
+#ifndef PY_LONG_LONG
+ #define PY_LONG_LONG LONG_LONG
+#endif
+#ifdef __cplusplus
+#define __PYX_EXTERN_C extern "C"
+#else
+#define __PYX_EXTERN_C extern
+#endif
+__PYX_EXTERN_C double pow(double, double);
+#include "string.h"
+#include "math.h"
+#include "numpy/arrayobject.h"
+#include "randomkit.h"
+#include "distributions.h"
+#include "initarray.h"
+
+
+typedef struct {PyObject **p; char *s;} __Pyx_InternTabEntry; /*proto*/
+typedef struct {PyObject **p; char *s; long n;} __Pyx_StringTabEntry; /*proto*/
+
+static PyObject *__pyx_m;
+static PyObject *__pyx_b;
+static int __pyx_lineno;
+static char *__pyx_filename;
+static char **__pyx_f;
+
+static int __Pyx_GetStarArgs(PyObject **args, PyObject **kwds, char *kwd_list[], int nargs, PyObject **args2, PyObject **kwds2); /*proto*/
+
+static PyObject *__Pyx_Import(PyObject *name, PyObject *from_list); /*proto*/
+
+static PyObject *__Pyx_GetName(PyObject *dict, PyObject *name); /*proto*/
+
+static void __Pyx_Raise(PyObject *type, PyObject *value, PyObject *tb); /*proto*/
+
+static PyObject *__Pyx_UnpackItem(PyObject *); /*proto*/
+static int __Pyx_EndUnpack(PyObject *); /*proto*/
+
+static PyObject *__Pyx_GetExcValue(void); /*proto*/
+
+static int __Pyx_TypeTest(PyObject *obj, PyTypeObject *type); /*proto*/
+
+static int __Pyx_InternStrings(__Pyx_InternTabEntry *t); /*proto*/
+
+static int __Pyx_InitStrings(__Pyx_StringTabEntry *t); /*proto*/
+
+static PyTypeObject *__Pyx_ImportType(char *module_name, char *class_name, long size); /*proto*/
+
+static void __Pyx_AddTraceback(char *funcname); /*proto*/
+
+/* Declarations from mtrand */
+
+
+struct __pyx_obj_6mtrand_RandomState {
+ PyObject_HEAD
+ rk_state (*internal_state);
+};
+
+static PyTypeObject *__pyx_ptype_6mtrand_dtype = 0;
+static PyTypeObject *__pyx_ptype_6mtrand_ndarray = 0;
+static PyTypeObject *__pyx_ptype_6mtrand_flatiter = 0;
+static PyTypeObject *__pyx_ptype_6mtrand_broadcast = 0;
+static PyTypeObject *__pyx_ptype_6mtrand_RandomState = 0;
+static PyObject *__pyx_k2;
+static PyObject *__pyx_k3;
+static PyObject *__pyx_k4;
+static PyObject *__pyx_k5;
+static PyObject *__pyx_k6;
+static PyObject *__pyx_k7;
+static PyObject *__pyx_k8;
+static PyObject *__pyx_k9;
+static PyObject *__pyx_k10;
+static PyObject *__pyx_k11;
+static PyObject *__pyx_k12;
+static PyObject *__pyx_k13;
+static PyObject *__pyx_k14;
+static PyObject *__pyx_k15;
+static PyObject *__pyx_k16;
+static PyObject *__pyx_k17;
+static PyObject *__pyx_k18;
+static PyObject *__pyx_k19;
+static PyObject *__pyx_k20;
+static PyObject *__pyx_k21;
+static PyObject *__pyx_k22;
+static PyObject *__pyx_k23;
+static PyObject *__pyx_k24;
+static PyObject *__pyx_k25;
+static PyObject *__pyx_k26;
+static PyObject *__pyx_k27;
+static PyObject *__pyx_k28;
+static PyObject *__pyx_k29;
+static PyObject *__pyx_k30;
+static PyObject *__pyx_k31;
+static PyObject *__pyx_k32;
+static PyObject *__pyx_k33;
+static PyObject *__pyx_k34;
+static PyObject *__pyx_k35;
+static PyObject *__pyx_k36;
+static PyObject *__pyx_k37;
+static PyObject *__pyx_k38;
+static PyObject *__pyx_k39;
+static PyObject *__pyx_k40;
+static PyObject *__pyx_k41;
+static PyObject *__pyx_k42;
+static PyObject *__pyx_k43;
+static PyObject *__pyx_k44;
+static PyObject *__pyx_k45;
+static PyObject *__pyx_k46;
+static PyObject *__pyx_k47;
+static PyObject *__pyx_k48;
+static PyObject *__pyx_k49;
+static PyObject *__pyx_k50;
+static PyObject *__pyx_k51;
+static PyObject *__pyx_k52;
+static PyObject *__pyx_k53;
+static PyObject *__pyx_k54;
+static PyObject *__pyx_k55;
+static PyObject *__pyx_k56;
+static PyObject *__pyx_k57;
+static PyObject *__pyx_k58;
+static PyObject *__pyx_k59;
+static PyObject *__pyx_k60;
+static PyObject *(__pyx_f_6mtrand_cont0_array(rk_state (*),double ((*)(rk_state (*))),PyObject *)); /*proto*/
+static PyObject *(__pyx_f_6mtrand_cont1_array_sc(rk_state (*),double ((*)(rk_state (*),double )),PyObject *,double )); /*proto*/
+static PyObject *(__pyx_f_6mtrand_cont1_array(rk_state (*),double ((*)(rk_state (*),double )),PyObject *,PyArrayObject *)); /*proto*/
+static PyObject *(__pyx_f_6mtrand_cont2_array_sc(rk_state (*),double ((*)(rk_state (*),double ,double )),PyObject *,double ,double )); /*proto*/
+static PyObject *(__pyx_f_6mtrand_cont2_array(rk_state (*),double ((*)(rk_state (*),double ,double )),PyObject *,PyArrayObject *,PyArrayObject *)); /*proto*/
+static PyObject *(__pyx_f_6mtrand_cont3_array_sc(rk_state (*),double ((*)(rk_state (*),double ,double ,double )),PyObject *,double ,double ,double )); /*proto*/
+static PyObject *(__pyx_f_6mtrand_cont3_array(rk_state (*),double ((*)(rk_state (*),double ,double ,double )),PyObject *,PyArrayObject *,PyArrayObject *,PyArrayObject *)); /*proto*/
+static PyObject *(__pyx_f_6mtrand_disc0_array(rk_state (*),long ((*)(rk_state (*))),PyObject *)); /*proto*/
+static PyObject *(__pyx_f_6mtrand_discnp_array_sc(rk_state (*),long ((*)(rk_state (*),long ,double )),PyObject *,long ,double )); /*proto*/
+static PyObject *(__pyx_f_6mtrand_discnp_array(rk_state (*),long ((*)(rk_state (*),long ,double )),PyObject *,PyArrayObject *,PyArrayObject *)); /*proto*/
+static PyObject *(__pyx_f_6mtrand_discnmN_array_sc(rk_state (*),long ((*)(rk_state (*),long ,long ,long )),PyObject *,long ,long ,long )); /*proto*/
+static PyObject *(__pyx_f_6mtrand_discnmN_array(rk_state (*),long ((*)(rk_state (*),long ,long ,long )),PyObject *,PyArrayObject *,PyArrayObject *,PyArrayObject *)); /*proto*/
+static PyObject *(__pyx_f_6mtrand_discd_array_sc(rk_state (*),long ((*)(rk_state (*),double )),PyObject *,double )); /*proto*/
+static PyObject *(__pyx_f_6mtrand_discd_array(rk_state (*),long ((*)(rk_state (*),double )),PyObject *,PyArrayObject *)); /*proto*/
+static double (__pyx_f_6mtrand_kahan_sum(double (*),long )); /*proto*/
+
+
+/* Implementation of mtrand */
+
+
+static PyObject *__pyx_n__sp;
+static PyObject *__pyx_n__rand;
+static PyObject *__pyx_n_seed;
+static PyObject *__pyx_n_get_state;
+static PyObject *__pyx_n_set_state;
+static PyObject *__pyx_n_random_sample;
+static PyObject *__pyx_n_randint;
+static PyObject *__pyx_n_bytes;
+static PyObject *__pyx_n_uniform;
+static PyObject *__pyx_n_rand;
+static PyObject *__pyx_n_randn;
+static PyObject *__pyx_n_random_integers;
+static PyObject *__pyx_n_standard_normal;
+static PyObject *__pyx_n_normal;
+static PyObject *__pyx_n_beta;
+static PyObject *__pyx_n_exponential;
+static PyObject *__pyx_n_standard_exponential;
+static PyObject *__pyx_n_standard_gamma;
+static PyObject *__pyx_n_gamma;
+static PyObject *__pyx_n_f;
+static PyObject *__pyx_n_noncentral_f;
+static PyObject *__pyx_n_chisquare;
+static PyObject *__pyx_n_noncentral_chisquare;
+static PyObject *__pyx_n_standard_cauchy;
+static PyObject *__pyx_n_standard_t;
+static PyObject *__pyx_n_vonmises;
+static PyObject *__pyx_n_pareto;
+static PyObject *__pyx_n_weibull;
+static PyObject *__pyx_n_power;
+static PyObject *__pyx_n_laplace;
+static PyObject *__pyx_n_gumbel;
+static PyObject *__pyx_n_logistic;
+static PyObject *__pyx_n_lognormal;
+static PyObject *__pyx_n_rayleigh;
+static PyObject *__pyx_n_wald;
+static PyObject *__pyx_n_triangular;
+static PyObject *__pyx_n_binomial;
+static PyObject *__pyx_n_negative_binomial;
+static PyObject *__pyx_n_poisson;
+static PyObject *__pyx_n_zipf;
+static PyObject *__pyx_n_geometric;
+static PyObject *__pyx_n_hypergeometric;
+static PyObject *__pyx_n_logseries;
+static PyObject *__pyx_n_multivariate_normal;
+static PyObject *__pyx_n_multinomial;
+static PyObject *__pyx_n_dirichlet;
+static PyObject *__pyx_n_shuffle;
+static PyObject *__pyx_n_permutation;
+static PyObject *__pyx_n_numpy;
+
+static PyObject *__pyx_n_empty;
+static PyObject *__pyx_n_float64;
+
+static PyObject *__pyx_f_6mtrand_cont0_array(rk_state (*__pyx_v_state),double ((*__pyx_v_func)(rk_state (*))),PyObject *__pyx_v_size) {
+ double (*__pyx_v_array_data);
+ PyArrayObject *arrayObject;
+ long __pyx_v_length;
+ long __pyx_v_i;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ Py_INCREF(__pyx_v_size);
+ arrayObject = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":129 */
+ __pyx_1 = __pyx_v_size == Py_None;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":130 */
+ __pyx_2 = PyFloat_FromDouble(__pyx_v_func(__pyx_v_state)); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 130; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":132 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 132; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_empty); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 132; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 132; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_2, __pyx_n_float64); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 132; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = PyTuple_New(2); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 132; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_2, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 132; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":133 */
+ __pyx_v_length = PyArray_SIZE(arrayObject);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":134 */
+ __pyx_v_array_data = ((double (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":135 */
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_v_length; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":136 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state);
+ }
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":137 */
+ Py_INCREF(((PyObject *)arrayObject));
+ __pyx_r = ((PyObject *)arrayObject);
+ goto __pyx_L0;
+ }
+ __pyx_L2:;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ __Pyx_AddTraceback("mtrand.cont0_array");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(arrayObject);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_f_6mtrand_cont1_array_sc(rk_state (*__pyx_v_state),double ((*__pyx_v_func)(rk_state (*),double )),PyObject *__pyx_v_size,double __pyx_v_a) {
+ double (*__pyx_v_array_data);
+ PyArrayObject *arrayObject;
+ long __pyx_v_length;
+ long __pyx_v_i;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ Py_INCREF(__pyx_v_size);
+ arrayObject = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":146 */
+ __pyx_1 = __pyx_v_size == Py_None;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":147 */
+ __pyx_2 = PyFloat_FromDouble(__pyx_v_func(__pyx_v_state,__pyx_v_a)); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 147; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":149 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 149; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_empty); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 149; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 149; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_2, __pyx_n_float64); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 149; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = PyTuple_New(2); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 149; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_2, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 149; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":150 */
+ __pyx_v_length = PyArray_SIZE(arrayObject);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":151 */
+ __pyx_v_array_data = ((double (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":152 */
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_v_length; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":153 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state,__pyx_v_a);
+ }
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":154 */
+ Py_INCREF(((PyObject *)arrayObject));
+ __pyx_r = ((PyObject *)arrayObject);
+ goto __pyx_L0;
+ }
+ __pyx_L2:;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ __Pyx_AddTraceback("mtrand.cont1_array_sc");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(arrayObject);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_n_ValueError;
+
+static PyObject *__pyx_k61p;
+
+static char (__pyx_k61[]) = "size is not compatible with inputs";
+
+static PyObject *__pyx_f_6mtrand_cont1_array(rk_state (*__pyx_v_state),double ((*__pyx_v_func)(rk_state (*),double )),PyObject *__pyx_v_size,PyArrayObject *__pyx_v_oa) {
+ double (*__pyx_v_array_data);
+ double (*__pyx_v_oa_data);
+ PyArrayObject *arrayObject;
+ npy_intp __pyx_v_length;
+ npy_intp __pyx_v_i;
+ PyArrayIterObject *__pyx_v_itera;
+ PyArrayMultiIterObject *__pyx_v_multi;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ npy_intp __pyx_5;
+ Py_INCREF(__pyx_v_size);
+ Py_INCREF(__pyx_v_oa);
+ arrayObject = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_itera = ((PyArrayIterObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_multi = ((PyArrayMultiIterObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":165 */
+ __pyx_1 = __pyx_v_size == Py_None;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":166 */
+ __pyx_2 = PyArray_SimpleNew(__pyx_v_oa->nd,__pyx_v_oa->dimensions,NPY_DOUBLE); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 166; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":167 */
+ __pyx_v_length = PyArray_SIZE(arrayObject);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":168 */
+ __pyx_v_array_data = ((double (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":169 */
+ __pyx_2 = PyArray_IterNew(((PyObject *)__pyx_v_oa)); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 169; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayIterObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)__pyx_v_itera));
+ __pyx_v_itera = ((PyArrayIterObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":170 */
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_v_length; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":171 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state,(((double (*))__pyx_v_itera->dataptr)[0]));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":172 */
+ PyArray_ITER_NEXT(__pyx_v_itera);
+ }
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":174 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 174; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_empty); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 174; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 174; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_2, __pyx_n_float64); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 174; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = PyTuple_New(2); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 174; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_2, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 174; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":175 */
+ __pyx_v_array_data = ((double (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":176 */
+ __pyx_3 = PyArray_MultiIterNew(2,((void (*))arrayObject),((void (*))__pyx_v_oa)); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 176; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayMultiIterObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_multi));
+ __pyx_v_multi = ((PyArrayMultiIterObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":178 */
+ __pyx_1 = (__pyx_v_multi->size != PyArray_SIZE(arrayObject));
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":179 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 179; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 179; goto __pyx_L1;}
+ Py_INCREF(__pyx_k61p);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_k61p);
+ __pyx_3 = PyObject_CallObject(__pyx_2, __pyx_4); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 179; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __Pyx_Raise(__pyx_3, 0, 0);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 179; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":180 */
+ __pyx_5 = __pyx_v_multi->size;
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_5; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":181 */
+ __pyx_v_oa_data = ((double (*))PyArray_MultiIter_DATA(__pyx_v_multi,1));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":182 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state,(__pyx_v_oa_data[0]));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":183 */
+ PyArray_MultiIter_NEXTi(__pyx_v_multi,1);
+ }
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":184 */
+ Py_INCREF(((PyObject *)arrayObject));
+ __pyx_r = ((PyObject *)arrayObject);
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ __Pyx_AddTraceback("mtrand.cont1_array");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(arrayObject);
+ Py_DECREF(__pyx_v_itera);
+ Py_DECREF(__pyx_v_multi);
+ Py_DECREF(__pyx_v_size);
+ Py_DECREF(__pyx_v_oa);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_f_6mtrand_cont2_array_sc(rk_state (*__pyx_v_state),double ((*__pyx_v_func)(rk_state (*),double ,double )),PyObject *__pyx_v_size,double __pyx_v_a,double __pyx_v_b) {
+ double (*__pyx_v_array_data);
+ PyArrayObject *arrayObject;
+ long __pyx_v_length;
+ long __pyx_v_i;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ Py_INCREF(__pyx_v_size);
+ arrayObject = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":193 */
+ __pyx_1 = __pyx_v_size == Py_None;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":194 */
+ __pyx_2 = PyFloat_FromDouble(__pyx_v_func(__pyx_v_state,__pyx_v_a,__pyx_v_b)); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 194; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":196 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 196; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_empty); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 196; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 196; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_2, __pyx_n_float64); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 196; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = PyTuple_New(2); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 196; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_2, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 196; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":197 */
+ __pyx_v_length = PyArray_SIZE(arrayObject);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":198 */
+ __pyx_v_array_data = ((double (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":199 */
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_v_length; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":200 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state,__pyx_v_a,__pyx_v_b);
+ }
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":201 */
+ Py_INCREF(((PyObject *)arrayObject));
+ __pyx_r = ((PyObject *)arrayObject);
+ goto __pyx_L0;
+ }
+ __pyx_L2:;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ __Pyx_AddTraceback("mtrand.cont2_array_sc");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(arrayObject);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k62p;
+
+static char (__pyx_k62[]) = "size is not compatible with inputs";
+
+static PyObject *__pyx_f_6mtrand_cont2_array(rk_state (*__pyx_v_state),double ((*__pyx_v_func)(rk_state (*),double ,double )),PyObject *__pyx_v_size,PyArrayObject *__pyx_v_oa,PyArrayObject *__pyx_v_ob) {
+ double (*__pyx_v_array_data);
+ double (*__pyx_v_oa_data);
+ double (*__pyx_v_ob_data);
+ PyArrayObject *arrayObject;
+ npy_intp __pyx_v_i;
+ PyArrayMultiIterObject *__pyx_v_multi;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ npy_intp __pyx_3;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ Py_INCREF(__pyx_v_size);
+ Py_INCREF(__pyx_v_oa);
+ Py_INCREF(__pyx_v_ob);
+ arrayObject = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_multi = ((PyArrayMultiIterObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":214 */
+ __pyx_1 = __pyx_v_size == Py_None;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":215 */
+ __pyx_2 = PyArray_MultiIterNew(2,((void (*))__pyx_v_oa),((void (*))__pyx_v_ob)); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 215; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayMultiIterObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)__pyx_v_multi));
+ __pyx_v_multi = ((PyArrayMultiIterObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":216 */
+ __pyx_2 = PyArray_SimpleNew(__pyx_v_multi->nd,__pyx_v_multi->dimensions,NPY_DOUBLE); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 216; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":217 */
+ __pyx_v_array_data = ((double (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":218 */
+ __pyx_3 = __pyx_v_multi->size;
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_3; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":219 */
+ __pyx_v_oa_data = ((double (*))PyArray_MultiIter_DATA(__pyx_v_multi,0));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":220 */
+ __pyx_v_ob_data = ((double (*))PyArray_MultiIter_DATA(__pyx_v_multi,1));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":221 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state,(__pyx_v_oa_data[0]),(__pyx_v_ob_data[0]));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":222 */
+ PyArray_MultiIter_NEXT(__pyx_v_multi);
+ }
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":224 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 224; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_2, __pyx_n_empty); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 224; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 224; goto __pyx_L1;}
+ __pyx_5 = PyObject_GetAttr(__pyx_2, __pyx_n_float64); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 224; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = PyTuple_New(2); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 224; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_2, 1, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_4, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 224; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_5)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_5);
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":225 */
+ __pyx_v_array_data = ((double (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":226 */
+ __pyx_4 = PyArray_MultiIterNew(3,((void (*))arrayObject),((void (*))__pyx_v_oa),((void (*))__pyx_v_ob)); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 226; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayMultiIterObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)__pyx_v_multi));
+ __pyx_v_multi = ((PyArrayMultiIterObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":227 */
+ __pyx_1 = (__pyx_v_multi->size != PyArray_SIZE(arrayObject));
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":228 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 228; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(1); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 228; goto __pyx_L1;}
+ Py_INCREF(__pyx_k62p);
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_k62p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_5); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 228; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 228; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":229 */
+ __pyx_3 = __pyx_v_multi->size;
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_3; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":230 */
+ __pyx_v_oa_data = ((double (*))PyArray_MultiIter_DATA(__pyx_v_multi,1));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":231 */
+ __pyx_v_ob_data = ((double (*))PyArray_MultiIter_DATA(__pyx_v_multi,2));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":232 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state,(__pyx_v_oa_data[0]),(__pyx_v_ob_data[0]));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":233 */
+ PyArray_MultiIter_NEXTi(__pyx_v_multi,1);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":234 */
+ PyArray_MultiIter_NEXTi(__pyx_v_multi,2);
+ }
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":235 */
+ Py_INCREF(((PyObject *)arrayObject));
+ __pyx_r = ((PyObject *)arrayObject);
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.cont2_array");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(arrayObject);
+ Py_DECREF(__pyx_v_multi);
+ Py_DECREF(__pyx_v_size);
+ Py_DECREF(__pyx_v_oa);
+ Py_DECREF(__pyx_v_ob);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_f_6mtrand_cont3_array_sc(rk_state (*__pyx_v_state),double ((*__pyx_v_func)(rk_state (*),double ,double ,double )),PyObject *__pyx_v_size,double __pyx_v_a,double __pyx_v_b,double __pyx_v_c) {
+ double (*__pyx_v_array_data);
+ PyArrayObject *arrayObject;
+ long __pyx_v_length;
+ long __pyx_v_i;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ Py_INCREF(__pyx_v_size);
+ arrayObject = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":245 */
+ __pyx_1 = __pyx_v_size == Py_None;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":246 */
+ __pyx_2 = PyFloat_FromDouble(__pyx_v_func(__pyx_v_state,__pyx_v_a,__pyx_v_b,__pyx_v_c)); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 246; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":248 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 248; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_empty); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 248; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 248; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_2, __pyx_n_float64); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 248; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = PyTuple_New(2); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 248; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_2, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 248; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":249 */
+ __pyx_v_length = PyArray_SIZE(arrayObject);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":250 */
+ __pyx_v_array_data = ((double (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":251 */
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_v_length; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":252 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state,__pyx_v_a,__pyx_v_b,__pyx_v_c);
+ }
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":253 */
+ Py_INCREF(((PyObject *)arrayObject));
+ __pyx_r = ((PyObject *)arrayObject);
+ goto __pyx_L0;
+ }
+ __pyx_L2:;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ __Pyx_AddTraceback("mtrand.cont3_array_sc");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(arrayObject);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k63p;
+
+static char (__pyx_k63[]) = "size is not compatible with inputs";
+
+static PyObject *__pyx_f_6mtrand_cont3_array(rk_state (*__pyx_v_state),double ((*__pyx_v_func)(rk_state (*),double ,double ,double )),PyObject *__pyx_v_size,PyArrayObject *__pyx_v_oa,PyArrayObject *__pyx_v_ob,PyArrayObject *__pyx_v_oc) {
+ double (*__pyx_v_array_data);
+ double (*__pyx_v_oa_data);
+ double (*__pyx_v_ob_data);
+ double (*__pyx_v_oc_data);
+ PyArrayObject *arrayObject;
+ npy_intp __pyx_v_i;
+ PyArrayMultiIterObject *__pyx_v_multi;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ npy_intp __pyx_3;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ Py_INCREF(__pyx_v_size);
+ Py_INCREF(__pyx_v_oa);
+ Py_INCREF(__pyx_v_ob);
+ Py_INCREF(__pyx_v_oc);
+ arrayObject = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_multi = ((PyArrayMultiIterObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":267 */
+ __pyx_1 = __pyx_v_size == Py_None;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":268 */
+ __pyx_2 = PyArray_MultiIterNew(3,((void (*))__pyx_v_oa),((void (*))__pyx_v_ob),((void (*))__pyx_v_oc)); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 268; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayMultiIterObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)__pyx_v_multi));
+ __pyx_v_multi = ((PyArrayMultiIterObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":269 */
+ __pyx_2 = PyArray_SimpleNew(__pyx_v_multi->nd,__pyx_v_multi->dimensions,NPY_DOUBLE); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 269; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":270 */
+ __pyx_v_array_data = ((double (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":271 */
+ __pyx_3 = __pyx_v_multi->size;
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_3; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":272 */
+ __pyx_v_oa_data = ((double (*))PyArray_MultiIter_DATA(__pyx_v_multi,0));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":273 */
+ __pyx_v_ob_data = ((double (*))PyArray_MultiIter_DATA(__pyx_v_multi,1));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":274 */
+ __pyx_v_oc_data = ((double (*))PyArray_MultiIter_DATA(__pyx_v_multi,2));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":275 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state,(__pyx_v_oa_data[0]),(__pyx_v_ob_data[0]),(__pyx_v_oc_data[0]));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":276 */
+ PyArray_MultiIter_NEXT(__pyx_v_multi);
+ }
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":278 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 278; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_2, __pyx_n_empty); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 278; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 278; goto __pyx_L1;}
+ __pyx_5 = PyObject_GetAttr(__pyx_2, __pyx_n_float64); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 278; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = PyTuple_New(2); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 278; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_2, 1, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_4, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 278; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_5)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_5);
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":279 */
+ __pyx_v_array_data = ((double (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":280 */
+ __pyx_4 = PyArray_MultiIterNew(4,((void (*))arrayObject),((void (*))__pyx_v_oa),((void (*))__pyx_v_ob),((void (*))__pyx_v_oc)); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 280; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayMultiIterObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)__pyx_v_multi));
+ __pyx_v_multi = ((PyArrayMultiIterObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":282 */
+ __pyx_1 = (__pyx_v_multi->size != PyArray_SIZE(arrayObject));
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":283 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 283; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(1); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 283; goto __pyx_L1;}
+ Py_INCREF(__pyx_k63p);
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_k63p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_5); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 283; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 283; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":284 */
+ __pyx_3 = __pyx_v_multi->size;
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_3; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":285 */
+ __pyx_v_oa_data = ((double (*))PyArray_MultiIter_DATA(__pyx_v_multi,1));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":286 */
+ __pyx_v_ob_data = ((double (*))PyArray_MultiIter_DATA(__pyx_v_multi,2));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":287 */
+ __pyx_v_oc_data = ((double (*))PyArray_MultiIter_DATA(__pyx_v_multi,3));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":288 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state,(__pyx_v_oa_data[0]),(__pyx_v_ob_data[0]),(__pyx_v_oc_data[0]));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":289 */
+ PyArray_MultiIter_NEXT(__pyx_v_multi);
+ }
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":290 */
+ Py_INCREF(((PyObject *)arrayObject));
+ __pyx_r = ((PyObject *)arrayObject);
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.cont3_array");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(arrayObject);
+ Py_DECREF(__pyx_v_multi);
+ Py_DECREF(__pyx_v_size);
+ Py_DECREF(__pyx_v_oa);
+ Py_DECREF(__pyx_v_ob);
+ Py_DECREF(__pyx_v_oc);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_n_int;
+
+static PyObject *__pyx_f_6mtrand_disc0_array(rk_state (*__pyx_v_state),long ((*__pyx_v_func)(rk_state (*))),PyObject *__pyx_v_size) {
+ long (*__pyx_v_array_data);
+ PyArrayObject *arrayObject;
+ long __pyx_v_length;
+ long __pyx_v_i;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ Py_INCREF(__pyx_v_size);
+ arrayObject = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":298 */
+ __pyx_1 = __pyx_v_size == Py_None;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":299 */
+ __pyx_2 = PyInt_FromLong(__pyx_v_func(__pyx_v_state)); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 299; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":301 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 301; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_empty); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 301; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_int); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 301; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 301; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_4, 1, __pyx_2);
+ __pyx_2 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_3, __pyx_4); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 301; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":302 */
+ __pyx_v_length = PyArray_SIZE(arrayObject);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":303 */
+ __pyx_v_array_data = ((long (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":304 */
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_v_length; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":305 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state);
+ }
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":306 */
+ Py_INCREF(((PyObject *)arrayObject));
+ __pyx_r = ((PyObject *)arrayObject);
+ goto __pyx_L0;
+ }
+ __pyx_L2:;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ __Pyx_AddTraceback("mtrand.disc0_array");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(arrayObject);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_f_6mtrand_discnp_array_sc(rk_state (*__pyx_v_state),long ((*__pyx_v_func)(rk_state (*),long ,double )),PyObject *__pyx_v_size,long __pyx_v_n,double __pyx_v_p) {
+ long (*__pyx_v_array_data);
+ PyArrayObject *arrayObject;
+ long __pyx_v_length;
+ long __pyx_v_i;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ Py_INCREF(__pyx_v_size);
+ arrayObject = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":314 */
+ __pyx_1 = __pyx_v_size == Py_None;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":315 */
+ __pyx_2 = PyInt_FromLong(__pyx_v_func(__pyx_v_state,__pyx_v_n,__pyx_v_p)); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 315; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":317 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 317; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_empty); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 317; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_int); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 317; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 317; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_4, 1, __pyx_2);
+ __pyx_2 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_3, __pyx_4); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 317; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":318 */
+ __pyx_v_length = PyArray_SIZE(arrayObject);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":319 */
+ __pyx_v_array_data = ((long (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":320 */
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_v_length; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":321 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state,__pyx_v_n,__pyx_v_p);
+ }
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":322 */
+ Py_INCREF(((PyObject *)arrayObject));
+ __pyx_r = ((PyObject *)arrayObject);
+ goto __pyx_L0;
+ }
+ __pyx_L2:;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ __Pyx_AddTraceback("mtrand.discnp_array_sc");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(arrayObject);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k64p;
+
+static char (__pyx_k64[]) = "size is not compatible with inputs";
+
+static PyObject *__pyx_f_6mtrand_discnp_array(rk_state (*__pyx_v_state),long ((*__pyx_v_func)(rk_state (*),long ,double )),PyObject *__pyx_v_size,PyArrayObject *__pyx_v_on,PyArrayObject *__pyx_v_op) {
+ long (*__pyx_v_array_data);
+ PyArrayObject *arrayObject;
+ npy_intp __pyx_v_i;
+ double (*__pyx_v_op_data);
+ long (*__pyx_v_on_data);
+ PyArrayMultiIterObject *__pyx_v_multi;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ npy_intp __pyx_3;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ Py_INCREF(__pyx_v_size);
+ Py_INCREF(__pyx_v_on);
+ Py_INCREF(__pyx_v_op);
+ arrayObject = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_multi = ((PyArrayMultiIterObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":333 */
+ __pyx_1 = __pyx_v_size == Py_None;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":334 */
+ __pyx_2 = PyArray_MultiIterNew(2,((void (*))__pyx_v_on),((void (*))__pyx_v_op)); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 334; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayMultiIterObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)__pyx_v_multi));
+ __pyx_v_multi = ((PyArrayMultiIterObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":335 */
+ __pyx_2 = PyArray_SimpleNew(__pyx_v_multi->nd,__pyx_v_multi->dimensions,NPY_LONG); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 335; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":336 */
+ __pyx_v_array_data = ((long (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":337 */
+ __pyx_3 = __pyx_v_multi->size;
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_3; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":338 */
+ __pyx_v_on_data = ((long (*))PyArray_MultiIter_DATA(__pyx_v_multi,0));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":339 */
+ __pyx_v_op_data = ((double (*))PyArray_MultiIter_DATA(__pyx_v_multi,1));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":340 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state,(__pyx_v_on_data[0]),(__pyx_v_op_data[0]));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":341 */
+ PyArray_MultiIter_NEXT(__pyx_v_multi);
+ }
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":343 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 343; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_2, __pyx_n_empty); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 343; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_int); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 343; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 343; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_2);
+ __pyx_2 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_5); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 343; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":344 */
+ __pyx_v_array_data = ((long (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":345 */
+ __pyx_4 = PyArray_MultiIterNew(3,((void (*))arrayObject),((void (*))__pyx_v_on),((void (*))__pyx_v_op)); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 345; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayMultiIterObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)__pyx_v_multi));
+ __pyx_v_multi = ((PyArrayMultiIterObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":346 */
+ __pyx_1 = (__pyx_v_multi->size != PyArray_SIZE(arrayObject));
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":347 */
+ __pyx_5 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 347; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 347; goto __pyx_L1;}
+ Py_INCREF(__pyx_k64p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k64p);
+ __pyx_4 = PyObject_CallObject(__pyx_5, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 347; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 347; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":348 */
+ __pyx_3 = __pyx_v_multi->size;
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_3; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":349 */
+ __pyx_v_on_data = ((long (*))PyArray_MultiIter_DATA(__pyx_v_multi,1));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":350 */
+ __pyx_v_op_data = ((double (*))PyArray_MultiIter_DATA(__pyx_v_multi,2));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":351 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state,(__pyx_v_on_data[0]),(__pyx_v_op_data[0]));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":352 */
+ PyArray_MultiIter_NEXTi(__pyx_v_multi,1);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":353 */
+ PyArray_MultiIter_NEXTi(__pyx_v_multi,2);
+ }
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":355 */
+ Py_INCREF(((PyObject *)arrayObject));
+ __pyx_r = ((PyObject *)arrayObject);
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.discnp_array");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(arrayObject);
+ Py_DECREF(__pyx_v_multi);
+ Py_DECREF(__pyx_v_size);
+ Py_DECREF(__pyx_v_on);
+ Py_DECREF(__pyx_v_op);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_f_6mtrand_discnmN_array_sc(rk_state (*__pyx_v_state),long ((*__pyx_v_func)(rk_state (*),long ,long ,long )),PyObject *__pyx_v_size,long __pyx_v_n,long __pyx_v_m,long __pyx_v_N) {
+ long (*__pyx_v_array_data);
+ PyArrayObject *arrayObject;
+ long __pyx_v_length;
+ long __pyx_v_i;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ Py_INCREF(__pyx_v_size);
+ arrayObject = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":364 */
+ __pyx_1 = __pyx_v_size == Py_None;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":365 */
+ __pyx_2 = PyInt_FromLong(__pyx_v_func(__pyx_v_state,__pyx_v_n,__pyx_v_m,__pyx_v_N)); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 365; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":367 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 367; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_empty); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 367; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_int); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 367; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 367; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_4, 1, __pyx_2);
+ __pyx_2 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_3, __pyx_4); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 367; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":368 */
+ __pyx_v_length = PyArray_SIZE(arrayObject);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":369 */
+ __pyx_v_array_data = ((long (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":370 */
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_v_length; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":371 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state,__pyx_v_n,__pyx_v_m,__pyx_v_N);
+ }
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":372 */
+ Py_INCREF(((PyObject *)arrayObject));
+ __pyx_r = ((PyObject *)arrayObject);
+ goto __pyx_L0;
+ }
+ __pyx_L2:;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ __Pyx_AddTraceback("mtrand.discnmN_array_sc");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(arrayObject);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k65p;
+
+static char (__pyx_k65[]) = "size is not compatible with inputs";
+
+static PyObject *__pyx_f_6mtrand_discnmN_array(rk_state (*__pyx_v_state),long ((*__pyx_v_func)(rk_state (*),long ,long ,long )),PyObject *__pyx_v_size,PyArrayObject *__pyx_v_on,PyArrayObject *__pyx_v_om,PyArrayObject *__pyx_v_oN) {
+ long (*__pyx_v_array_data);
+ long (*__pyx_v_on_data);
+ long (*__pyx_v_om_data);
+ long (*__pyx_v_oN_data);
+ PyArrayObject *arrayObject;
+ npy_intp __pyx_v_i;
+ PyArrayMultiIterObject *__pyx_v_multi;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ npy_intp __pyx_3;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ Py_INCREF(__pyx_v_size);
+ Py_INCREF(__pyx_v_on);
+ Py_INCREF(__pyx_v_om);
+ Py_INCREF(__pyx_v_oN);
+ arrayObject = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_multi = ((PyArrayMultiIterObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":385 */
+ __pyx_1 = __pyx_v_size == Py_None;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":386 */
+ __pyx_2 = PyArray_MultiIterNew(3,((void (*))__pyx_v_on),((void (*))__pyx_v_om),((void (*))__pyx_v_oN)); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 386; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayMultiIterObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)__pyx_v_multi));
+ __pyx_v_multi = ((PyArrayMultiIterObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":387 */
+ __pyx_2 = PyArray_SimpleNew(__pyx_v_multi->nd,__pyx_v_multi->dimensions,NPY_LONG); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 387; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":388 */
+ __pyx_v_array_data = ((long (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":389 */
+ __pyx_3 = __pyx_v_multi->size;
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_3; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":390 */
+ __pyx_v_on_data = ((long (*))PyArray_MultiIter_DATA(__pyx_v_multi,0));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":391 */
+ __pyx_v_om_data = ((long (*))PyArray_MultiIter_DATA(__pyx_v_multi,1));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":392 */
+ __pyx_v_oN_data = ((long (*))PyArray_MultiIter_DATA(__pyx_v_multi,2));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":393 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state,(__pyx_v_on_data[0]),(__pyx_v_om_data[0]),(__pyx_v_oN_data[0]));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":394 */
+ PyArray_MultiIter_NEXT(__pyx_v_multi);
+ }
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":396 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 396; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_2, __pyx_n_empty); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 396; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_int); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 396; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 396; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_2);
+ __pyx_2 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_5); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 396; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":397 */
+ __pyx_v_array_data = ((long (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":398 */
+ __pyx_4 = PyArray_MultiIterNew(4,((void (*))arrayObject),((void (*))__pyx_v_on),((void (*))__pyx_v_om),((void (*))__pyx_v_oN)); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 398; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayMultiIterObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)__pyx_v_multi));
+ __pyx_v_multi = ((PyArrayMultiIterObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":400 */
+ __pyx_1 = (__pyx_v_multi->size != PyArray_SIZE(arrayObject));
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":401 */
+ __pyx_5 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 401; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 401; goto __pyx_L1;}
+ Py_INCREF(__pyx_k65p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k65p);
+ __pyx_4 = PyObject_CallObject(__pyx_5, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 401; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 401; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":402 */
+ __pyx_3 = __pyx_v_multi->size;
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_3; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":403 */
+ __pyx_v_on_data = ((long (*))PyArray_MultiIter_DATA(__pyx_v_multi,1));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":404 */
+ __pyx_v_om_data = ((long (*))PyArray_MultiIter_DATA(__pyx_v_multi,2));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":405 */
+ __pyx_v_oN_data = ((long (*))PyArray_MultiIter_DATA(__pyx_v_multi,3));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":406 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state,(__pyx_v_on_data[0]),(__pyx_v_om_data[0]),(__pyx_v_oN_data[0]));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":407 */
+ PyArray_MultiIter_NEXT(__pyx_v_multi);
+ }
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":409 */
+ Py_INCREF(((PyObject *)arrayObject));
+ __pyx_r = ((PyObject *)arrayObject);
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.discnmN_array");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(arrayObject);
+ Py_DECREF(__pyx_v_multi);
+ Py_DECREF(__pyx_v_size);
+ Py_DECREF(__pyx_v_on);
+ Py_DECREF(__pyx_v_om);
+ Py_DECREF(__pyx_v_oN);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_f_6mtrand_discd_array_sc(rk_state (*__pyx_v_state),long ((*__pyx_v_func)(rk_state (*),double )),PyObject *__pyx_v_size,double __pyx_v_a) {
+ long (*__pyx_v_array_data);
+ PyArrayObject *arrayObject;
+ long __pyx_v_length;
+ long __pyx_v_i;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ Py_INCREF(__pyx_v_size);
+ arrayObject = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":417 */
+ __pyx_1 = __pyx_v_size == Py_None;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":418 */
+ __pyx_2 = PyInt_FromLong(__pyx_v_func(__pyx_v_state,__pyx_v_a)); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 418; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":420 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 420; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_empty); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 420; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_int); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 420; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 420; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_4, 1, __pyx_2);
+ __pyx_2 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_3, __pyx_4); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 420; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":421 */
+ __pyx_v_length = PyArray_SIZE(arrayObject);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":422 */
+ __pyx_v_array_data = ((long (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":423 */
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_v_length; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":424 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state,__pyx_v_a);
+ }
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":425 */
+ Py_INCREF(((PyObject *)arrayObject));
+ __pyx_r = ((PyObject *)arrayObject);
+ goto __pyx_L0;
+ }
+ __pyx_L2:;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ __Pyx_AddTraceback("mtrand.discd_array_sc");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(arrayObject);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k66p;
+
+static char (__pyx_k66[]) = "size is not compatible with inputs";
+
+static PyObject *__pyx_f_6mtrand_discd_array(rk_state (*__pyx_v_state),long ((*__pyx_v_func)(rk_state (*),double )),PyObject *__pyx_v_size,PyArrayObject *__pyx_v_oa) {
+ long (*__pyx_v_array_data);
+ double (*__pyx_v_oa_data);
+ PyArrayObject *arrayObject;
+ npy_intp __pyx_v_length;
+ npy_intp __pyx_v_i;
+ PyArrayMultiIterObject *__pyx_v_multi;
+ PyArrayIterObject *__pyx_v_itera;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ npy_intp __pyx_5;
+ Py_INCREF(__pyx_v_size);
+ Py_INCREF(__pyx_v_oa);
+ arrayObject = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_multi = ((PyArrayMultiIterObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_itera = ((PyArrayIterObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":436 */
+ __pyx_1 = __pyx_v_size == Py_None;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":437 */
+ __pyx_2 = PyArray_SimpleNew(__pyx_v_oa->nd,__pyx_v_oa->dimensions,NPY_LONG); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 437; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":438 */
+ __pyx_v_length = PyArray_SIZE(arrayObject);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":439 */
+ __pyx_v_array_data = ((long (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":440 */
+ __pyx_2 = PyArray_IterNew(((PyObject *)__pyx_v_oa)); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 440; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayIterObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)__pyx_v_itera));
+ __pyx_v_itera = ((PyArrayIterObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":441 */
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_v_length; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":442 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state,(((double (*))__pyx_v_itera->dataptr)[0]));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":443 */
+ PyArray_ITER_NEXT(__pyx_v_itera);
+ }
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":445 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 445; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_empty); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 445; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_int); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 445; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 445; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_4, 1, __pyx_2);
+ __pyx_2 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_3, __pyx_4); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 445; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":446 */
+ __pyx_v_array_data = ((long (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":447 */
+ __pyx_3 = PyArray_MultiIterNew(2,((void (*))arrayObject),((void (*))__pyx_v_oa)); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 447; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayMultiIterObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_multi));
+ __pyx_v_multi = ((PyArrayMultiIterObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":448 */
+ __pyx_1 = (__pyx_v_multi->size != PyArray_SIZE(arrayObject));
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":449 */
+ __pyx_4 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 449; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 449; goto __pyx_L1;}
+ Py_INCREF(__pyx_k66p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k66p);
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 449; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_3, 0, 0);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 449; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":450 */
+ __pyx_5 = __pyx_v_multi->size;
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_5; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":451 */
+ __pyx_v_oa_data = ((double (*))PyArray_MultiIter_DATA(__pyx_v_multi,1));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":452 */
+ (__pyx_v_array_data[__pyx_v_i]) = __pyx_v_func(__pyx_v_state,(__pyx_v_oa_data[0]));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":453 */
+ PyArray_MultiIter_NEXTi(__pyx_v_multi,1);
+ }
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":454 */
+ Py_INCREF(((PyObject *)arrayObject));
+ __pyx_r = ((PyObject *)arrayObject);
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ __Pyx_AddTraceback("mtrand.discd_array");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(arrayObject);
+ Py_DECREF(__pyx_v_multi);
+ Py_DECREF(__pyx_v_itera);
+ Py_DECREF(__pyx_v_size);
+ Py_DECREF(__pyx_v_oa);
+ return __pyx_r;
+}
+
+static double __pyx_f_6mtrand_kahan_sum(double (*__pyx_v_darr),long __pyx_v_n) {
+ double __pyx_v_c;
+ double __pyx_v_y;
+ double __pyx_v_t;
+ double __pyx_v_sum;
+ long __pyx_v_i;
+ double __pyx_r;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":459 */
+ __pyx_v_sum = (__pyx_v_darr[0]);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":460 */
+ __pyx_v_c = 0.0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":461 */
+ for (__pyx_v_i = 1; __pyx_v_i < __pyx_v_n; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":462 */
+ __pyx_v_y = ((__pyx_v_darr[__pyx_v_i]) - __pyx_v_c);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":463 */
+ __pyx_v_t = (__pyx_v_sum + __pyx_v_y);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":464 */
+ __pyx_v_c = ((__pyx_v_t - __pyx_v_sum) - __pyx_v_y);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":465 */
+ __pyx_v_sum = __pyx_v_t;
+ }
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":466 */
+ __pyx_r = __pyx_v_sum;
+ goto __pyx_L0;
+
+ __pyx_r = 0;
+ __pyx_L0:;
+ return __pyx_r;
+}
+
+static int __pyx_f_6mtrand_11RandomState___init__(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static int __pyx_f_6mtrand_11RandomState___init__(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_seed = 0;
+ int __pyx_r;
+ PyObject *__pyx_1 = 0;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ static char *__pyx_argnames[] = {"seed",0};
+ __pyx_v_seed = __pyx_k2;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "|O", __pyx_argnames, &__pyx_v_seed)) return -1;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_seed);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":489 */
+ ((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state = ((rk_state (*))PyMem_Malloc((sizeof(rk_state ))));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":491 */
+ __pyx_1 = PyObject_GetAttr(__pyx_v_self, __pyx_n_seed); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 491; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 491; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_seed);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_seed);
+ __pyx_3 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 491; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ __pyx_r = 0;
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ __Pyx_AddTraceback("mtrand.RandomState.__init__");
+ __pyx_r = -1;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_seed);
+ return __pyx_r;
+}
+
+static void __pyx_f_6mtrand_11RandomState___dealloc__(PyObject *__pyx_v_self); /*proto*/
+static void __pyx_f_6mtrand_11RandomState___dealloc__(PyObject *__pyx_v_self) {
+ int __pyx_1;
+ Py_INCREF(__pyx_v_self);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":494 */
+ __pyx_1 = (((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state != NULL);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":495 */
+ PyMem_Free(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":496 */
+ ((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state = NULL;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ Py_DECREF(__pyx_v_self);
+}
+
+static PyObject *__pyx_n_type;
+
+static PyObject *__pyx_f_6mtrand_11RandomState_seed(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_seed[] = "Seed the generator.\n\n seed(seed=None)\n\n seed can be an integer, an array (or other sequence) of integers of any\n length, or None. If seed is None, then RandomState will try to read data\n from /dev/urandom (or the Windows analogue) if available or seed from\n the clock otherwise.\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_seed(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_seed = 0;
+ rk_error __pyx_v_errcode;
+ PyArrayObject *arrayObject_obj;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ unsigned long __pyx_5;
+ static char *__pyx_argnames[] = {"seed",0};
+ __pyx_v_seed = __pyx_k3;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "|O", __pyx_argnames, &__pyx_v_seed)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_seed);
+ arrayObject_obj = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":510 */
+ __pyx_1 = __pyx_v_seed == Py_None;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":511 */
+ __pyx_v_errcode = rk_randomseed(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state);
+ goto __pyx_L2;
+ }
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_type); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 512; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 512; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_seed);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_v_seed);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 512; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_int); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 512; goto __pyx_L1;}
+ __pyx_1 = __pyx_4 == __pyx_2;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":513 */
+ __pyx_5 = PyInt_AsUnsignedLongMask(__pyx_v_seed); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 513; goto __pyx_L1;}
+ rk_seed(__pyx_5,((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state);
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":515 */
+ __pyx_3 = PyArray_ContiguousFromObject(__pyx_v_seed,NPY_LONG,1,1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 515; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)arrayObject_obj));
+ arrayObject_obj = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":516 */
+ init_by_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,((unsigned long (*))arrayObject_obj->data),(arrayObject_obj->dimensions[0]));
+ }
+ __pyx_L2:;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ __Pyx_AddTraceback("mtrand.RandomState.seed");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(arrayObject_obj);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_seed);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_n_uint;
+static PyObject *__pyx_n_asarray;
+static PyObject *__pyx_n_uint32;
+static PyObject *__pyx_n_MT19937;
+
+
+static PyObject *__pyx_f_6mtrand_11RandomState_get_state(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_get_state[] = "Return a tuple representing the internal state of the generator.\n\n get_state() -> (\'MT19937\', int key[624], int pos)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_get_state(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyArrayObject *arrayObject_state;
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ static char *__pyx_argnames[] = {0};
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "", __pyx_argnames)) return 0;
+ Py_INCREF(__pyx_v_self);
+ arrayObject_state = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":525 */
+ __pyx_1 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 525; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_1, __pyx_n_empty); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 525; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_1 = PyInt_FromLong(624); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 525; goto __pyx_L1;}
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 525; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_3, __pyx_n_uint); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 525; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyTuple_New(2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 525; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_1);
+ PyTuple_SET_ITEM(__pyx_3, 1, __pyx_4);
+ __pyx_1 = 0;
+ __pyx_4 = 0;
+ __pyx_1 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 525; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_1)));
+ Py_DECREF(((PyObject *)arrayObject_state));
+ arrayObject_state = ((PyArrayObject *)__pyx_1);
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":526 */
+ memcpy(((void (*))arrayObject_state->data),((void (*))((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state->key),(624 * (sizeof(long ))));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":527 */
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 527; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_asarray); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 527; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 527; goto __pyx_L1;}
+ __pyx_1 = PyObject_GetAttr(__pyx_3, __pyx_n_uint32); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 527; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_4 = PyTuple_New(2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 527; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)arrayObject_state));
+ PyTuple_SET_ITEM(__pyx_4, 0, ((PyObject *)arrayObject_state));
+ PyTuple_SET_ITEM(__pyx_4, 1, __pyx_1);
+ __pyx_1 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_2, __pyx_4); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 527; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)arrayObject_state));
+ arrayObject_state = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":528 */
+ __pyx_1 = PyInt_FromLong(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state->pos); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 528; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 528; goto __pyx_L1;}
+ Py_INCREF(__pyx_n_MT19937);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_n_MT19937);
+ Py_INCREF(((PyObject *)arrayObject_state));
+ PyTuple_SET_ITEM(__pyx_2, 1, ((PyObject *)arrayObject_state));
+ PyTuple_SET_ITEM(__pyx_2, 2, __pyx_1);
+ __pyx_1 = 0;
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ __Pyx_AddTraceback("mtrand.RandomState.get_state");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(arrayObject_state);
+ Py_DECREF(__pyx_v_self);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_n_TypeError;
+
+static PyObject *__pyx_k69p;
+static PyObject *__pyx_k70p;
+
+static char (__pyx_k69[]) = "algorithm must be 'MT19937'";
+static char (__pyx_k70[]) = "state must be 624 longs";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_set_state(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_set_state[] = "Set the state from a tuple.\n\n state = (\'MT19937\', int key[624], int pos)\n\n set_state(state)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_set_state(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_state = 0;
+ PyArrayObject *arrayObject_obj;
+ int __pyx_v_pos;
+ PyObject *__pyx_v_algorithm_name;
+ PyObject *__pyx_v_key;
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ PyObject *__pyx_2 = 0;
+ int __pyx_3;
+ PyObject *__pyx_4 = 0;
+ static char *__pyx_argnames[] = {"state",0};
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O", __pyx_argnames, &__pyx_v_state)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_state);
+ arrayObject_obj = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_algorithm_name = Py_None; Py_INCREF(Py_None);
+ __pyx_v_key = Py_None; Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":539 */
+ __pyx_1 = PyInt_FromLong(0); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 539; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetItem(__pyx_v_state, __pyx_1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 539; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_v_algorithm_name);
+ __pyx_v_algorithm_name = __pyx_2;
+ __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":540 */
+ if (PyObject_Cmp(__pyx_v_algorithm_name, __pyx_n_MT19937, &__pyx_3) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 540; goto __pyx_L1;}
+ __pyx_3 = __pyx_3 != 0;
+ if (__pyx_3) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":541 */
+ __pyx_1 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 541; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 541; goto __pyx_L1;}
+ Py_INCREF(__pyx_k69p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k69p);
+ __pyx_4 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 541; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 541; goto __pyx_L1;}
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":542 */
+ __pyx_1 = PySequence_GetSlice(__pyx_v_state, 1, 0x7fffffff); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 542; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetIter(__pyx_1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 542; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_4 = __Pyx_UnpackItem(__pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 542; goto __pyx_L1;}
+ Py_DECREF(__pyx_v_key);
+ __pyx_v_key = __pyx_4;
+ __pyx_4 = 0;
+ __pyx_1 = __Pyx_UnpackItem(__pyx_2); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 542; goto __pyx_L1;}
+ __pyx_3 = PyInt_AsLong(__pyx_1); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 542; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_v_pos = __pyx_3;
+ if (__Pyx_EndUnpack(__pyx_2) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 542; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":543 */
+ /*try:*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":544 */
+ __pyx_4 = PyArray_ContiguousFromObject(__pyx_v_key,NPY_ULONG,1,1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 544; goto __pyx_L3;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)arrayObject_obj));
+ arrayObject_obj = ((PyArrayObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ }
+ goto __pyx_L4;
+ __pyx_L3:;
+ Py_XDECREF(__pyx_1); __pyx_1 = 0;
+ Py_XDECREF(__pyx_2); __pyx_2 = 0;
+ Py_XDECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":545 */
+ __pyx_1 = __Pyx_GetName(__pyx_b, __pyx_n_TypeError); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 545; goto __pyx_L1;}
+ __pyx_3 = PyErr_ExceptionMatches(__pyx_1);
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ if (__pyx_3) {
+ __Pyx_AddTraceback("mtrand.set_state");
+ __pyx_2 = __Pyx_GetExcValue(); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 545; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":547 */
+ __pyx_4 = PyArray_ContiguousFromObject(__pyx_v_key,NPY_LONG,1,1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 547; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)arrayObject_obj));
+ arrayObject_obj = ((PyArrayObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ goto __pyx_L4;
+ }
+ goto __pyx_L1;
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":548 */
+ __pyx_3 = ((arrayObject_obj->dimensions[0]) != 624);
+ if (__pyx_3) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":549 */
+ __pyx_1 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 549; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 549; goto __pyx_L1;}
+ Py_INCREF(__pyx_k70p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k70p);
+ __pyx_4 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 549; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 549; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":550 */
+ memcpy(((void (*))((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state->key),((void (*))arrayObject_obj->data),(624 * (sizeof(long ))));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":551 */
+ ((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state->pos = __pyx_v_pos;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_4);
+ __Pyx_AddTraceback("mtrand.RandomState.set_state");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(arrayObject_obj);
+ Py_DECREF(__pyx_v_algorithm_name);
+ Py_DECREF(__pyx_v_key);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_state);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_f_6mtrand_11RandomState___getstate__(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static PyObject *__pyx_f_6mtrand_11RandomState___getstate__(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ PyObject *__pyx_2 = 0;
+ static char *__pyx_argnames[] = {0};
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "", __pyx_argnames)) return 0;
+ Py_INCREF(__pyx_v_self);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":555 */
+ __pyx_1 = PyObject_GetAttr(__pyx_v_self, __pyx_n_get_state); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 555; goto __pyx_L1;}
+ __pyx_2 = PyObject_CallObject(__pyx_1, 0); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 555; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ Py_XDECREF(__pyx_2);
+ __Pyx_AddTraceback("mtrand.RandomState.__getstate__");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_self);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_f_6mtrand_11RandomState___setstate__(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static PyObject *__pyx_f_6mtrand_11RandomState___setstate__(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_state = 0;
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ static char *__pyx_argnames[] = {"state",0};
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O", __pyx_argnames, &__pyx_v_state)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_state);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":558 */
+ __pyx_1 = PyObject_GetAttr(__pyx_v_self, __pyx_n_set_state); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 558; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 558; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_state);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_state);
+ __pyx_3 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 558; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ __Pyx_AddTraceback("mtrand.RandomState.__setstate__");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_state);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_n_random;
+static PyObject *__pyx_n___RandomState_ctor;
+
+static PyObject *__pyx_f_6mtrand_11RandomState___reduce__(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static PyObject *__pyx_f_6mtrand_11RandomState___reduce__(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ static char *__pyx_argnames[] = {0};
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "", __pyx_argnames)) return 0;
+ Py_INCREF(__pyx_v_self);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":561 */
+ __pyx_1 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 561; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_1, __pyx_n_random); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 561; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_1 = PyObject_GetAttr(__pyx_2, __pyx_n___RandomState_ctor); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 561; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = PyTuple_New(0); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 561; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_v_self, __pyx_n_get_state); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 561; goto __pyx_L1;}
+ __pyx_4 = PyObject_CallObject(__pyx_3, 0); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 561; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyTuple_New(3); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 561; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_1);
+ PyTuple_SET_ITEM(__pyx_3, 1, __pyx_2);
+ PyTuple_SET_ITEM(__pyx_3, 2, __pyx_4);
+ __pyx_1 = 0;
+ __pyx_2 = 0;
+ __pyx_4 = 0;
+ __pyx_r = __pyx_3;
+ __pyx_3 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ __Pyx_AddTraceback("mtrand.RandomState.__reduce__");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_self);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_f_6mtrand_11RandomState_random_sample(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_random_sample[] = "Return random floats in the half-open interval [0.0, 1.0).\n\n random_sample(size=None) -> random values\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_random_sample(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_size = 0;
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ static char *__pyx_argnames[] = {"size",0};
+ __pyx_v_size = __pyx_k4;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "|O", __pyx_argnames, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_size);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":569 */
+ __pyx_1 = __pyx_f_6mtrand_cont0_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_double,__pyx_v_size); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 569; goto __pyx_L1;}
+ __pyx_r = __pyx_1;
+ __pyx_1 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ __Pyx_AddTraceback("mtrand.RandomState.random_sample");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_f_6mtrand_11RandomState_tomaxint(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_tomaxint[] = "Returns random integers x such that 0 <= x <= sys.maxint.\n\n tomaxint(size=None) -> random values\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_tomaxint(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_size = 0;
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ static char *__pyx_argnames[] = {"size",0};
+ __pyx_v_size = __pyx_k5;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "|O", __pyx_argnames, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_size);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":576 */
+ __pyx_1 = __pyx_f_6mtrand_disc0_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_long,__pyx_v_size); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 576; goto __pyx_L1;}
+ __pyx_r = __pyx_1;
+ __pyx_1 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ __Pyx_AddTraceback("mtrand.RandomState.tomaxint");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k71p;
+
+static char (__pyx_k71[]) = "low >= high";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_randint(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_randint[] = "Return random integers x such that low <= x < high.\n\n randint(low, high=None, size=None) -> random values\n\n If high is None, then 0 <= x < low.\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_randint(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_low = 0;
+ PyObject *__pyx_v_high = 0;
+ PyObject *__pyx_v_size = 0;
+ long __pyx_v_lo;
+ long __pyx_v_hi;
+ long __pyx_v_diff;
+ long (*__pyx_v_array_data);
+ PyArrayObject *arrayObject;
+ long __pyx_v_length;
+ long __pyx_v_i;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ long __pyx_2;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"low","high","size",0};
+ __pyx_v_high = __pyx_k6;
+ __pyx_v_size = __pyx_k7;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O|OO", __pyx_argnames, &__pyx_v_low, &__pyx_v_high, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_low);
+ Py_INCREF(__pyx_v_high);
+ Py_INCREF(__pyx_v_size);
+ arrayObject = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":591 */
+ __pyx_1 = __pyx_v_high == Py_None;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":592 */
+ __pyx_v_lo = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":593 */
+ __pyx_2 = PyInt_AsLong(__pyx_v_low); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 593; goto __pyx_L1;}
+ __pyx_v_hi = __pyx_2;
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":595 */
+ __pyx_2 = PyInt_AsLong(__pyx_v_low); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 595; goto __pyx_L1;}
+ __pyx_v_lo = __pyx_2;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":596 */
+ __pyx_2 = PyInt_AsLong(__pyx_v_high); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 596; goto __pyx_L1;}
+ __pyx_v_hi = __pyx_2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":598 */
+ __pyx_v_diff = ((__pyx_v_hi - __pyx_v_lo) - 1);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":599 */
+ __pyx_1 = (__pyx_v_diff < 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":600 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 600; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 600; goto __pyx_L1;}
+ Py_INCREF(__pyx_k71p);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_k71p);
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_4); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 600; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __Pyx_Raise(__pyx_5, 0, 0);
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 600; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":602 */
+ __pyx_1 = __pyx_v_size == Py_None;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":603 */
+ __pyx_3 = PyLong_FromUnsignedLong((rk_interval(__pyx_v_diff,((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state) + __pyx_v_lo)); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 603; goto __pyx_L1;}
+ __pyx_r = __pyx_3;
+ __pyx_3 = 0;
+ goto __pyx_L0;
+ goto __pyx_L4;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":605 */
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 605; goto __pyx_L1;}
+ __pyx_5 = PyObject_GetAttr(__pyx_4, __pyx_n_empty); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 605; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_int); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 605; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 605; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_4, 1, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_5, __pyx_4); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 605; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)arrayObject));
+ arrayObject = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":606 */
+ __pyx_v_length = PyArray_SIZE(arrayObject);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":607 */
+ __pyx_v_array_data = ((long (*))arrayObject->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":608 */
+ for (__pyx_v_i = 0; __pyx_v_i < __pyx_v_length; ++__pyx_v_i) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":609 */
+ (__pyx_v_array_data[__pyx_v_i]) = (__pyx_v_lo + ((long )rk_interval(__pyx_v_diff,((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state)));
+ }
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":610 */
+ Py_INCREF(((PyObject *)arrayObject));
+ __pyx_r = ((PyObject *)arrayObject);
+ goto __pyx_L0;
+ }
+ __pyx_L4:;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.randint");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(arrayObject);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_low);
+ Py_DECREF(__pyx_v_high);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_f_6mtrand_11RandomState_bytes(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_bytes[] = "Return random bytes.\n\n bytes(length) -> str\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_bytes(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ unsigned int __pyx_v_length;
+ void (*__pyx_v_bytes);
+ PyObject *__pyx_v_bytestring;
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ static char *__pyx_argnames[] = {"length",0};
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "I", __pyx_argnames, &__pyx_v_length)) return 0;
+ Py_INCREF(__pyx_v_self);
+ __pyx_v_bytestring = Py_None; Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":618 */
+ __pyx_1 = PyString_FromStringAndSize(NULL,__pyx_v_length); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 618; goto __pyx_L1;}
+ Py_DECREF(__pyx_v_bytestring);
+ __pyx_v_bytestring = __pyx_1;
+ __pyx_1 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":619 */
+ __pyx_v_bytes = PyString_AS_STRING(__pyx_v_bytestring);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":620 */
+ rk_fill(__pyx_v_bytes,__pyx_v_length,((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":621 */
+ Py_INCREF(__pyx_v_bytestring);
+ __pyx_r = __pyx_v_bytestring;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ __Pyx_AddTraceback("mtrand.RandomState.bytes");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_bytestring);
+ Py_DECREF(__pyx_v_self);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_n_subtract;
+
+static PyObject *__pyx_f_6mtrand_11RandomState_uniform(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_uniform[] = "Uniform distribution over [low, high).\n\n uniform(low=0.0, high=1.0, size=None) -> random values\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_uniform(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_low = 0;
+ PyObject *__pyx_v_high = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_olow;
+ PyArrayObject *__pyx_v_ohigh;
+ PyArrayObject *__pyx_v_odiff;
+ double __pyx_v_flow;
+ double __pyx_v_fhigh;
+ PyObject *__pyx_v_temp;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ static char *__pyx_argnames[] = {"low","high","size",0};
+ __pyx_v_low = __pyx_k8;
+ __pyx_v_high = __pyx_k9;
+ __pyx_v_size = __pyx_k10;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "|OOO", __pyx_argnames, &__pyx_v_low, &__pyx_v_high, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_low);
+ Py_INCREF(__pyx_v_high);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_olow = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_ohigh = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_odiff = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_temp = Py_None; Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":632 */
+ __pyx_v_flow = PyFloat_AsDouble(__pyx_v_low);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":633 */
+ __pyx_v_fhigh = PyFloat_AsDouble(__pyx_v_high);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":634 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":635 */
+ __pyx_2 = __pyx_f_6mtrand_cont2_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_uniform,__pyx_v_size,__pyx_v_flow,(__pyx_v_fhigh - __pyx_v_flow)); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 635; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":636 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":637 */
+ __pyx_2 = PyArray_FROM_OTF(__pyx_v_low,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 637; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)__pyx_v_olow));
+ __pyx_v_olow = ((PyArrayObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":638 */
+ __pyx_2 = PyArray_FROM_OTF(__pyx_v_high,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 638; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)__pyx_v_ohigh));
+ __pyx_v_ohigh = ((PyArrayObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":639 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 639; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_subtract); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 639; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = PyTuple_New(2); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 639; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_ohigh));
+ PyTuple_SET_ITEM(__pyx_2, 0, ((PyObject *)__pyx_v_ohigh));
+ Py_INCREF(((PyObject *)__pyx_v_olow));
+ PyTuple_SET_ITEM(__pyx_2, 1, ((PyObject *)__pyx_v_olow));
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 639; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_v_temp);
+ __pyx_v_temp = __pyx_4;
+ __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":640 */
+ Py_INCREF(__pyx_v_temp);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":642 */
+ __pyx_3 = PyArray_EnsureArray(__pyx_v_temp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 642; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_odiff));
+ __pyx_v_odiff = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":643 */
+ __pyx_2 = __pyx_f_6mtrand_cont2_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_uniform,__pyx_v_size,__pyx_v_olow,__pyx_v_odiff); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 643; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ __Pyx_AddTraceback("mtrand.RandomState.uniform");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_olow);
+ Py_DECREF(__pyx_v_ohigh);
+ Py_DECREF(__pyx_v_odiff);
+ Py_DECREF(__pyx_v_temp);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_low);
+ Py_DECREF(__pyx_v_high);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_n_len;
+static PyObject *__pyx_n_size;
+
+
+static PyObject *__pyx_f_6mtrand_11RandomState_rand(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_rand[] = "Return an array of the given dimensions which is initialized to \n random numbers from a uniform distribution in the range [0,1).\n\n rand(d0, d1, ..., dn) -> random values\n\n Note: This is a convenience function. If you want an\n interface that takes a tuple as the first argument\n use numpy.random.random_sample(shape_tuple).\n \n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_rand(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_args = 0;
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ int __pyx_4;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {0};
+ if (__Pyx_GetStarArgs(&__pyx_args, &__pyx_kwds, __pyx_argnames, 0, &__pyx_v_args, 0) < 0) return 0;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "", __pyx_argnames)) {
+ Py_XDECREF(__pyx_args);
+ Py_XDECREF(__pyx_kwds);
+ Py_XDECREF(__pyx_v_args);
+ return 0;
+ }
+ Py_INCREF(__pyx_v_self);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":656 */
+ __pyx_1 = __Pyx_GetName(__pyx_b, __pyx_n_len); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 656; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 656; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_args);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_args);
+ __pyx_3 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 656; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyInt_FromLong(0); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 656; goto __pyx_L1;}
+ if (PyObject_Cmp(__pyx_3, __pyx_1, &__pyx_4) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 656; goto __pyx_L1;}
+ __pyx_4 = __pyx_4 == 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ if (__pyx_4) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":657 */
+ __pyx_2 = PyObject_GetAttr(__pyx_v_self, __pyx_n_random_sample); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 657; goto __pyx_L1;}
+ __pyx_3 = PyObject_CallObject(__pyx_2, 0); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 657; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_r = __pyx_3;
+ __pyx_3 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":659 */
+ __pyx_1 = PyObject_GetAttr(__pyx_v_self, __pyx_n_random_sample); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 659; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(0); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 659; goto __pyx_L1;}
+ __pyx_3 = PyDict_New(); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 659; goto __pyx_L1;}
+ if (PyDict_SetItem(__pyx_3, __pyx_n_size, __pyx_v_args) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 659; goto __pyx_L1;}
+ __pyx_5 = PyEval_CallObjectWithKeywords(__pyx_1, __pyx_2, __pyx_3); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 659; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_r = __pyx_5;
+ __pyx_5 = 0;
+ goto __pyx_L0;
+ }
+ __pyx_L2:;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.rand");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_XDECREF(__pyx_v_args);
+ Py_DECREF(__pyx_v_self);
+ Py_XDECREF(__pyx_args);
+ Py_XDECREF(__pyx_kwds);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_f_6mtrand_11RandomState_randn(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_randn[] = "Returns zero-mean, unit-variance Gaussian random numbers in an \n array of shape (d0, d1, ..., dn).\n\n randn(d0, d1, ..., dn) -> random values\n\n Note: This is a convenience function. If you want an\n interface that takes a tuple as the first argument\n use numpy.random.standard_normal(shape_tuple).\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_randn(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_args = 0;
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ int __pyx_4;
+ static char *__pyx_argnames[] = {0};
+ if (__Pyx_GetStarArgs(&__pyx_args, &__pyx_kwds, __pyx_argnames, 0, &__pyx_v_args, 0) < 0) return 0;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "", __pyx_argnames)) {
+ Py_XDECREF(__pyx_args);
+ Py_XDECREF(__pyx_kwds);
+ Py_XDECREF(__pyx_v_args);
+ return 0;
+ }
+ Py_INCREF(__pyx_v_self);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":671 */
+ __pyx_1 = __Pyx_GetName(__pyx_b, __pyx_n_len); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 671; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 671; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_args);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_args);
+ __pyx_3 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 671; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyInt_FromLong(0); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 671; goto __pyx_L1;}
+ if (PyObject_Cmp(__pyx_3, __pyx_1, &__pyx_4) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 671; goto __pyx_L1;}
+ __pyx_4 = __pyx_4 == 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ if (__pyx_4) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":672 */
+ __pyx_2 = PyObject_GetAttr(__pyx_v_self, __pyx_n_standard_normal); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 672; goto __pyx_L1;}
+ __pyx_3 = PyObject_CallObject(__pyx_2, 0); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 672; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_r = __pyx_3;
+ __pyx_3 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":674 */
+ __pyx_1 = PyObject_GetAttr(__pyx_v_self, __pyx_n_standard_normal); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 674; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 674; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_args);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_args);
+ __pyx_3 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 674; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_r = __pyx_3;
+ __pyx_3 = 0;
+ goto __pyx_L0;
+ }
+ __pyx_L2:;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ __Pyx_AddTraceback("mtrand.RandomState.randn");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_XDECREF(__pyx_v_args);
+ Py_DECREF(__pyx_v_self);
+ Py_XDECREF(__pyx_args);
+ Py_XDECREF(__pyx_kwds);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_f_6mtrand_11RandomState_random_integers(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_random_integers[] = "Return random integers x such that low <= x <= high.\n\n random_integers(low, high=None, size=None) -> random values.\n\n If high is None, then 1 <= x <= low.\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_random_integers(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_low = 0;
+ PyObject *__pyx_v_high = 0;
+ PyObject *__pyx_v_size = 0;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ static char *__pyx_argnames[] = {"low","high","size",0};
+ __pyx_v_high = __pyx_k11;
+ __pyx_v_size = __pyx_k12;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O|OO", __pyx_argnames, &__pyx_v_low, &__pyx_v_high, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_low);
+ Py_INCREF(__pyx_v_high);
+ Py_INCREF(__pyx_v_size);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":683 */
+ __pyx_1 = __pyx_v_high == Py_None;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":684 */
+ Py_INCREF(__pyx_v_low);
+ Py_DECREF(__pyx_v_high);
+ __pyx_v_high = __pyx_v_low;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":685 */
+ __pyx_2 = PyInt_FromLong(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 685; goto __pyx_L1;}
+ Py_DECREF(__pyx_v_low);
+ __pyx_v_low = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":686 */
+ __pyx_2 = PyObject_GetAttr(__pyx_v_self, __pyx_n_randint); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 686; goto __pyx_L1;}
+ __pyx_3 = PyInt_FromLong(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 686; goto __pyx_L1;}
+ __pyx_4 = PyNumber_Add(__pyx_v_high, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 686; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyTuple_New(3); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 686; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_low);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_v_low);
+ PyTuple_SET_ITEM(__pyx_3, 1, __pyx_4);
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_3, 2, __pyx_v_size);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 686; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_r = __pyx_4;
+ __pyx_4 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ __Pyx_AddTraceback("mtrand.RandomState.random_integers");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_low);
+ Py_DECREF(__pyx_v_high);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_f_6mtrand_11RandomState_standard_normal(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_standard_normal[] = "Standard Normal distribution (mean=0, stdev=1).\n\n standard_normal(size=None) -> random values\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_standard_normal(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_size = 0;
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ static char *__pyx_argnames[] = {"size",0};
+ __pyx_v_size = __pyx_k13;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "|O", __pyx_argnames, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_size);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":694 */
+ __pyx_1 = __pyx_f_6mtrand_cont0_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_gauss,__pyx_v_size); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 694; goto __pyx_L1;}
+ __pyx_r = __pyx_1;
+ __pyx_1 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ __Pyx_AddTraceback("mtrand.RandomState.standard_normal");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_n_any;
+static PyObject *__pyx_n_less_equal;
+
+static PyObject *__pyx_k73p;
+static PyObject *__pyx_k74p;
+
+static char (__pyx_k73[]) = "scale <= 0";
+static char (__pyx_k74[]) = "scale <= 0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_normal(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_normal[] = "Normal distribution (mean=loc, stdev=scale).\n\n normal(loc=0.0, scale=1.0, size=None) -> random values\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_normal(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_loc = 0;
+ PyObject *__pyx_v_scale = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_oloc;
+ PyArrayObject *__pyx_v_oscale;
+ double __pyx_v_floc;
+ double __pyx_v_fscale;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"loc","scale","size",0};
+ __pyx_v_loc = __pyx_k14;
+ __pyx_v_scale = __pyx_k15;
+ __pyx_v_size = __pyx_k16;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "|OOO", __pyx_argnames, &__pyx_v_loc, &__pyx_v_scale, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_loc);
+ Py_INCREF(__pyx_v_scale);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_oloc = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_oscale = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":704 */
+ __pyx_v_floc = PyFloat_AsDouble(__pyx_v_loc);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":705 */
+ __pyx_v_fscale = PyFloat_AsDouble(__pyx_v_scale);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":706 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":707 */
+ __pyx_1 = (__pyx_v_fscale <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":708 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 708; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 708; goto __pyx_L1;}
+ Py_INCREF(__pyx_k73p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k73p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 708; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 708; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":709 */
+ __pyx_2 = __pyx_f_6mtrand_cont2_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_normal,__pyx_v_size,__pyx_v_floc,__pyx_v_fscale); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 709; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":711 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":713 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_loc,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 713; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_oloc));
+ __pyx_v_oloc = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":714 */
+ __pyx_4 = PyArray_FROM_OTF(__pyx_v_scale,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 714; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)__pyx_v_oscale));
+ __pyx_v_oscale = ((PyArrayObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":715 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 715; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_any); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 715; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 715; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_less_equal); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 715; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_4 = PyInt_FromLong(0); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 715; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 715; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_oscale));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_oscale));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_5); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 715; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 715; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 715; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 715; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":716 */
+ __pyx_4 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 716; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 716; goto __pyx_L1;}
+ Py_INCREF(__pyx_k74p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k74p);
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 716; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 716; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":717 */
+ __pyx_5 = __pyx_f_6mtrand_cont2_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_normal,__pyx_v_size,__pyx_v_oloc,__pyx_v_oscale); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 717; goto __pyx_L1;}
+ __pyx_r = __pyx_5;
+ __pyx_5 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.normal");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_oloc);
+ Py_DECREF(__pyx_v_oscale);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_loc);
+ Py_DECREF(__pyx_v_scale);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k75p;
+static PyObject *__pyx_k76p;
+static PyObject *__pyx_k77p;
+static PyObject *__pyx_k78p;
+
+static char (__pyx_k75[]) = "a <= 0";
+static char (__pyx_k76[]) = "b <= 0";
+static char (__pyx_k77[]) = "a <= 0";
+static char (__pyx_k78[]) = "b <= 0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_beta(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_beta[] = "Beta distribution over [0, 1].\n\n beta(a, b, size=None) -> random values\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_beta(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_a = 0;
+ PyObject *__pyx_v_b = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_oa;
+ PyArrayObject *__pyx_v_ob;
+ double __pyx_v_fa;
+ double __pyx_v_fb;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"a","b","size",0};
+ __pyx_v_size = __pyx_k17;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "OO|O", __pyx_argnames, &__pyx_v_a, &__pyx_v_b, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_a);
+ Py_INCREF(__pyx_v_b);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_oa = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_ob = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":727 */
+ __pyx_v_fa = PyFloat_AsDouble(__pyx_v_a);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":728 */
+ __pyx_v_fb = PyFloat_AsDouble(__pyx_v_b);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":729 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":730 */
+ __pyx_1 = (__pyx_v_fa <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":731 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 731; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 731; goto __pyx_L1;}
+ Py_INCREF(__pyx_k75p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k75p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 731; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 731; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":732 */
+ __pyx_1 = (__pyx_v_fb <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":733 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 733; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 733; goto __pyx_L1;}
+ Py_INCREF(__pyx_k76p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k76p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 733; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 733; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":734 */
+ __pyx_2 = __pyx_f_6mtrand_cont2_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_beta,__pyx_v_size,__pyx_v_fa,__pyx_v_fb); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 734; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":736 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":738 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_a,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 738; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_oa));
+ __pyx_v_oa = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":739 */
+ __pyx_4 = PyArray_FROM_OTF(__pyx_v_b,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 739; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)__pyx_v_ob));
+ __pyx_v_ob = ((PyArrayObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":740 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 740; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_any); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 740; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 740; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_less_equal); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 740; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_4 = PyInt_FromLong(0); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 740; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 740; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_oa));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_oa));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_5); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 740; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 740; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 740; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 740; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":741 */
+ __pyx_4 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 741; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 741; goto __pyx_L1;}
+ Py_INCREF(__pyx_k77p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k77p);
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 741; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 741; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":742 */
+ __pyx_5 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 742; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_5, __pyx_n_any); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 742; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 742; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_3, __pyx_n_less_equal); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 742; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_5 = PyInt_FromLong(0); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 742; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 742; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_ob));
+ PyTuple_SET_ITEM(__pyx_3, 0, ((PyObject *)__pyx_v_ob));
+ PyTuple_SET_ITEM(__pyx_3, 1, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 742; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 742; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 742; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_3); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 742; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":743 */
+ __pyx_5 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 743; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 743; goto __pyx_L1;}
+ Py_INCREF(__pyx_k78p);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_k78p);
+ __pyx_2 = PyObject_CallObject(__pyx_5, __pyx_4); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 743; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 743; goto __pyx_L1;}
+ goto __pyx_L6;
+ }
+ __pyx_L6:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":744 */
+ __pyx_3 = __pyx_f_6mtrand_cont2_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_beta,__pyx_v_size,__pyx_v_oa,__pyx_v_ob); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 744; goto __pyx_L1;}
+ __pyx_r = __pyx_3;
+ __pyx_3 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.beta");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_oa);
+ Py_DECREF(__pyx_v_ob);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_a);
+ Py_DECREF(__pyx_v_b);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k79p;
+static PyObject *__pyx_k80p;
+
+static char (__pyx_k79[]) = "scale <= 0";
+static char (__pyx_k80[]) = "scale <= 0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_exponential(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_exponential[] = "Exponential distribution.\n\n exponential(scale=1.0, size=None) -> random values\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_exponential(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_scale = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_oscale;
+ double __pyx_v_fscale;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"scale","size",0};
+ __pyx_v_scale = __pyx_k18;
+ __pyx_v_size = __pyx_k19;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "|OO", __pyx_argnames, &__pyx_v_scale, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_scale);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_oscale = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":754 */
+ __pyx_v_fscale = PyFloat_AsDouble(__pyx_v_scale);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":755 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":756 */
+ __pyx_1 = (__pyx_v_fscale <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":757 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 757; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 757; goto __pyx_L1;}
+ Py_INCREF(__pyx_k79p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k79p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 757; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 757; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":758 */
+ __pyx_2 = __pyx_f_6mtrand_cont1_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_exponential,__pyx_v_size,__pyx_v_fscale); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 758; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":760 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":762 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_scale,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 762; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_oscale));
+ __pyx_v_oscale = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":763 */
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 763; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_any); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 763; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 763; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_3, __pyx_n_less_equal); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 763; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyFloat_FromDouble(0.0); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 763; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 763; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_oscale));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_oscale));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 763; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 763; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_2, __pyx_4); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 763; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 763; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":764 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 764; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 764; goto __pyx_L1;}
+ Py_INCREF(__pyx_k80p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k80p);
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 764; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 764; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":765 */
+ __pyx_5 = __pyx_f_6mtrand_cont1_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_exponential,__pyx_v_size,__pyx_v_oscale); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 765; goto __pyx_L1;}
+ __pyx_r = __pyx_5;
+ __pyx_5 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.exponential");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_oscale);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_scale);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_f_6mtrand_11RandomState_standard_exponential(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_standard_exponential[] = "Standard exponential distribution (scale=1).\n\n standard_exponential(size=None) -> random values\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_standard_exponential(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_size = 0;
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ static char *__pyx_argnames[] = {"size",0};
+ __pyx_v_size = __pyx_k20;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "|O", __pyx_argnames, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_size);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":772 */
+ __pyx_1 = __pyx_f_6mtrand_cont0_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_standard_exponential,__pyx_v_size); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 772; goto __pyx_L1;}
+ __pyx_r = __pyx_1;
+ __pyx_1 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ __Pyx_AddTraceback("mtrand.RandomState.standard_exponential");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k81p;
+static PyObject *__pyx_k82p;
+
+static char (__pyx_k81[]) = "shape <= 0";
+static char (__pyx_k82[]) = "shape <= 0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_standard_gamma(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_standard_gamma[] = "Standard Gamma distribution.\n\n standard_gamma(shape, size=None) -> random values\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_standard_gamma(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_shape = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_oshape;
+ double __pyx_v_fshape;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"shape","size",0};
+ __pyx_v_size = __pyx_k21;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O|O", __pyx_argnames, &__pyx_v_shape, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_shape);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_oshape = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":782 */
+ __pyx_v_fshape = PyFloat_AsDouble(__pyx_v_shape);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":783 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":784 */
+ __pyx_1 = (__pyx_v_fshape <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":785 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 785; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 785; goto __pyx_L1;}
+ Py_INCREF(__pyx_k81p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k81p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 785; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 785; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":786 */
+ __pyx_2 = __pyx_f_6mtrand_cont1_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_standard_gamma,__pyx_v_size,__pyx_v_fshape); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 786; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":788 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":789 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_shape,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 789; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_oshape));
+ __pyx_v_oshape = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":790 */
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 790; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_any); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 790; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 790; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_3, __pyx_n_less_equal); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 790; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyFloat_FromDouble(0.0); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 790; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 790; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_oshape));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_oshape));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 790; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 790; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_2, __pyx_4); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 790; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 790; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":791 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 791; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 791; goto __pyx_L1;}
+ Py_INCREF(__pyx_k82p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k82p);
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 791; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 791; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":792 */
+ __pyx_5 = __pyx_f_6mtrand_cont1_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_standard_gamma,__pyx_v_size,__pyx_v_oshape); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 792; goto __pyx_L1;}
+ __pyx_r = __pyx_5;
+ __pyx_5 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.standard_gamma");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_oshape);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_shape);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k83p;
+static PyObject *__pyx_k84p;
+static PyObject *__pyx_k85p;
+static PyObject *__pyx_k86p;
+
+static char (__pyx_k83[]) = "shape <= 0";
+static char (__pyx_k84[]) = "scale <= 0";
+static char (__pyx_k85[]) = "shape <= 0";
+static char (__pyx_k86[]) = "scale <= 0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_gamma(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_gamma[] = "Gamma distribution.\n\n gamma(shape, scale=1.0, size=None) -> random values\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_gamma(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_shape = 0;
+ PyObject *__pyx_v_scale = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_oshape;
+ PyArrayObject *__pyx_v_oscale;
+ double __pyx_v_fshape;
+ double __pyx_v_fscale;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"shape","scale","size",0};
+ __pyx_v_scale = __pyx_k22;
+ __pyx_v_size = __pyx_k23;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O|OO", __pyx_argnames, &__pyx_v_shape, &__pyx_v_scale, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_shape);
+ Py_INCREF(__pyx_v_scale);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_oshape = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_oscale = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":802 */
+ __pyx_v_fshape = PyFloat_AsDouble(__pyx_v_shape);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":803 */
+ __pyx_v_fscale = PyFloat_AsDouble(__pyx_v_scale);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":804 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":805 */
+ __pyx_1 = (__pyx_v_fshape <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":806 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 806; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 806; goto __pyx_L1;}
+ Py_INCREF(__pyx_k83p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k83p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 806; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 806; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":807 */
+ __pyx_1 = (__pyx_v_fscale <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":808 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 808; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 808; goto __pyx_L1;}
+ Py_INCREF(__pyx_k84p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k84p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 808; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 808; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":809 */
+ __pyx_2 = __pyx_f_6mtrand_cont2_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_gamma,__pyx_v_size,__pyx_v_fshape,__pyx_v_fscale); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 809; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":811 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":812 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_shape,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 812; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_oshape));
+ __pyx_v_oshape = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":813 */
+ __pyx_4 = PyArray_FROM_OTF(__pyx_v_scale,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 813; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)__pyx_v_oscale));
+ __pyx_v_oscale = ((PyArrayObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":814 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 814; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_any); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 814; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 814; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_less_equal); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 814; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_4 = PyFloat_FromDouble(0.0); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 814; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 814; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_oshape));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_oshape));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_5); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 814; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 814; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 814; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 814; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":815 */
+ __pyx_4 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 815; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 815; goto __pyx_L1;}
+ Py_INCREF(__pyx_k85p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k85p);
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 815; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 815; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":816 */
+ __pyx_5 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 816; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_5, __pyx_n_any); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 816; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 816; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_3, __pyx_n_less_equal); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 816; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_5 = PyFloat_FromDouble(0.0); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 816; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 816; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_oscale));
+ PyTuple_SET_ITEM(__pyx_3, 0, ((PyObject *)__pyx_v_oscale));
+ PyTuple_SET_ITEM(__pyx_3, 1, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 816; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 816; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 816; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_3); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 816; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":817 */
+ __pyx_5 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 817; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 817; goto __pyx_L1;}
+ Py_INCREF(__pyx_k86p);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_k86p);
+ __pyx_2 = PyObject_CallObject(__pyx_5, __pyx_4); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 817; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 817; goto __pyx_L1;}
+ goto __pyx_L6;
+ }
+ __pyx_L6:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":818 */
+ __pyx_3 = __pyx_f_6mtrand_cont2_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_gamma,__pyx_v_size,__pyx_v_oshape,__pyx_v_oscale); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 818; goto __pyx_L1;}
+ __pyx_r = __pyx_3;
+ __pyx_3 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.gamma");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_oshape);
+ Py_DECREF(__pyx_v_oscale);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_shape);
+ Py_DECREF(__pyx_v_scale);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k87p;
+static PyObject *__pyx_k88p;
+static PyObject *__pyx_k89p;
+static PyObject *__pyx_k90p;
+
+static char (__pyx_k87[]) = "shape <= 0";
+static char (__pyx_k88[]) = "scale <= 0";
+static char (__pyx_k89[]) = "dfnum <= 0";
+static char (__pyx_k90[]) = "dfden <= 0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_f(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_f[] = "F distribution.\n\n f(dfnum, dfden, size=None) -> random values\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_f(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_dfnum = 0;
+ PyObject *__pyx_v_dfden = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_odfnum;
+ PyArrayObject *__pyx_v_odfden;
+ double __pyx_v_fdfnum;
+ double __pyx_v_fdfden;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"dfnum","dfden","size",0};
+ __pyx_v_size = __pyx_k24;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "OO|O", __pyx_argnames, &__pyx_v_dfnum, &__pyx_v_dfden, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_dfnum);
+ Py_INCREF(__pyx_v_dfden);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_odfnum = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_odfden = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":828 */
+ __pyx_v_fdfnum = PyFloat_AsDouble(__pyx_v_dfnum);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":829 */
+ __pyx_v_fdfden = PyFloat_AsDouble(__pyx_v_dfden);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":830 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":831 */
+ __pyx_1 = (__pyx_v_fdfnum <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":832 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 832; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 832; goto __pyx_L1;}
+ Py_INCREF(__pyx_k87p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k87p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 832; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 832; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":833 */
+ __pyx_1 = (__pyx_v_fdfden <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":834 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 834; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 834; goto __pyx_L1;}
+ Py_INCREF(__pyx_k88p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k88p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 834; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 834; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":835 */
+ __pyx_2 = __pyx_f_6mtrand_cont2_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_f,__pyx_v_size,__pyx_v_fdfnum,__pyx_v_fdfden); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 835; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":837 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":839 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_dfnum,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 839; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_odfnum));
+ __pyx_v_odfnum = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":840 */
+ __pyx_4 = PyArray_FROM_OTF(__pyx_v_dfden,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 840; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)__pyx_v_odfden));
+ __pyx_v_odfden = ((PyArrayObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":841 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 841; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_any); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 841; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 841; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_less_equal); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 841; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_4 = PyFloat_FromDouble(0.0); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 841; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 841; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_odfnum));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_odfnum));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_5); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 841; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 841; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 841; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 841; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":842 */
+ __pyx_4 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 842; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 842; goto __pyx_L1;}
+ Py_INCREF(__pyx_k89p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k89p);
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 842; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 842; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":843 */
+ __pyx_5 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 843; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_5, __pyx_n_any); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 843; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 843; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_3, __pyx_n_less_equal); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 843; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_5 = PyFloat_FromDouble(0.0); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 843; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 843; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_odfden));
+ PyTuple_SET_ITEM(__pyx_3, 0, ((PyObject *)__pyx_v_odfden));
+ PyTuple_SET_ITEM(__pyx_3, 1, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 843; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 843; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 843; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_3); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 843; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":844 */
+ __pyx_5 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 844; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 844; goto __pyx_L1;}
+ Py_INCREF(__pyx_k90p);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_k90p);
+ __pyx_2 = PyObject_CallObject(__pyx_5, __pyx_4); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 844; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 844; goto __pyx_L1;}
+ goto __pyx_L6;
+ }
+ __pyx_L6:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":845 */
+ __pyx_3 = __pyx_f_6mtrand_cont2_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_f,__pyx_v_size,__pyx_v_odfnum,__pyx_v_odfden); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 845; goto __pyx_L1;}
+ __pyx_r = __pyx_3;
+ __pyx_3 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.f");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_odfnum);
+ Py_DECREF(__pyx_v_odfden);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_dfnum);
+ Py_DECREF(__pyx_v_dfden);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_n_less;
+
+static PyObject *__pyx_k91p;
+static PyObject *__pyx_k92p;
+static PyObject *__pyx_k93p;
+static PyObject *__pyx_k94p;
+static PyObject *__pyx_k95p;
+static PyObject *__pyx_k96p;
+
+static char (__pyx_k91[]) = "dfnum <= 1";
+static char (__pyx_k92[]) = "dfden <= 0";
+static char (__pyx_k93[]) = "nonc < 0";
+static char (__pyx_k94[]) = "dfnum <= 1";
+static char (__pyx_k95[]) = "dfden <= 0";
+static char (__pyx_k96[]) = "nonc < 0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_noncentral_f(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_noncentral_f[] = "Noncentral F distribution.\n\n noncentral_f(dfnum, dfden, nonc, size=None) -> random values\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_noncentral_f(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_dfnum = 0;
+ PyObject *__pyx_v_dfden = 0;
+ PyObject *__pyx_v_nonc = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_odfnum;
+ PyArrayObject *__pyx_v_odfden;
+ PyArrayObject *__pyx_v_ononc;
+ double __pyx_v_fdfnum;
+ double __pyx_v_fdfden;
+ double __pyx_v_fnonc;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"dfnum","dfden","nonc","size",0};
+ __pyx_v_size = __pyx_k25;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "OOO|O", __pyx_argnames, &__pyx_v_dfnum, &__pyx_v_dfden, &__pyx_v_nonc, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_dfnum);
+ Py_INCREF(__pyx_v_dfden);
+ Py_INCREF(__pyx_v_nonc);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_odfnum = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_odfden = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_ononc = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":855 */
+ __pyx_v_fdfnum = PyFloat_AsDouble(__pyx_v_dfnum);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":856 */
+ __pyx_v_fdfden = PyFloat_AsDouble(__pyx_v_dfden);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":857 */
+ __pyx_v_fnonc = PyFloat_AsDouble(__pyx_v_nonc);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":858 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":859 */
+ __pyx_1 = (__pyx_v_fdfnum <= 1);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":860 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 860; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 860; goto __pyx_L1;}
+ Py_INCREF(__pyx_k91p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k91p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 860; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 860; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":861 */
+ __pyx_1 = (__pyx_v_fdfden <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":862 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 862; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 862; goto __pyx_L1;}
+ Py_INCREF(__pyx_k92p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k92p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 862; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 862; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":863 */
+ __pyx_1 = (__pyx_v_fnonc < 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":864 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 864; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 864; goto __pyx_L1;}
+ Py_INCREF(__pyx_k93p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k93p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 864; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 864; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":865 */
+ __pyx_2 = __pyx_f_6mtrand_cont3_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_noncentral_f,__pyx_v_size,__pyx_v_fdfnum,__pyx_v_fdfden,__pyx_v_fnonc); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 865; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":868 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":870 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_dfnum,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 870; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_odfnum));
+ __pyx_v_odfnum = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":871 */
+ __pyx_4 = PyArray_FROM_OTF(__pyx_v_dfden,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 871; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)__pyx_v_odfden));
+ __pyx_v_odfden = ((PyArrayObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":872 */
+ __pyx_2 = PyArray_FROM_OTF(__pyx_v_nonc,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 872; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)__pyx_v_ononc));
+ __pyx_v_ononc = ((PyArrayObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":874 */
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 874; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_3, __pyx_n_any); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 874; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 874; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_less_equal); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 874; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = PyFloat_FromDouble(1.0); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 874; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 874; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_odfnum));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_odfnum));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_2);
+ __pyx_2 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_3, __pyx_5); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 874; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 874; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_2);
+ __pyx_2 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_4, __pyx_3); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 874; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 874; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":875 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 875; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 875; goto __pyx_L1;}
+ Py_INCREF(__pyx_k94p);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_k94p);
+ __pyx_3 = PyObject_CallObject(__pyx_2, __pyx_4); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 875; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __Pyx_Raise(__pyx_3, 0, 0);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 875; goto __pyx_L1;}
+ goto __pyx_L6;
+ }
+ __pyx_L6:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":876 */
+ __pyx_5 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 876; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_5, __pyx_n_any); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 876; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 876; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_4, __pyx_n_less_equal); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 876; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_5 = PyFloat_FromDouble(0.0); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 876; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 876; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_odfden));
+ PyTuple_SET_ITEM(__pyx_4, 0, ((PyObject *)__pyx_v_odfden));
+ PyTuple_SET_ITEM(__pyx_4, 1, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_4); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 876; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 876; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 876; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_4); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 876; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":877 */
+ __pyx_5 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 877; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 877; goto __pyx_L1;}
+ Py_INCREF(__pyx_k95p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k95p);
+ __pyx_3 = PyObject_CallObject(__pyx_5, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 877; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_3, 0, 0);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 877; goto __pyx_L1;}
+ goto __pyx_L7;
+ }
+ __pyx_L7:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":878 */
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 878; goto __pyx_L1;}
+ __pyx_5 = PyObject_GetAttr(__pyx_4, __pyx_n_any); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 878; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 878; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_less); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 878; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = PyFloat_FromDouble(0.0); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 878; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(2); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 878; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_ononc));
+ PyTuple_SET_ITEM(__pyx_2, 0, ((PyObject *)__pyx_v_ononc));
+ PyTuple_SET_ITEM(__pyx_2, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 878; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 878; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_5, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 878; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_2); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 878; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":879 */
+ __pyx_4 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 879; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(1); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 879; goto __pyx_L1;}
+ Py_INCREF(__pyx_k96p);
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_k96p);
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 879; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __Pyx_Raise(__pyx_3, 0, 0);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 879; goto __pyx_L1;}
+ goto __pyx_L8;
+ }
+ __pyx_L8:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":880 */
+ __pyx_2 = __pyx_f_6mtrand_cont3_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_noncentral_f,__pyx_v_size,__pyx_v_odfnum,__pyx_v_odfden,__pyx_v_ononc); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 880; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.noncentral_f");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_odfnum);
+ Py_DECREF(__pyx_v_odfden);
+ Py_DECREF(__pyx_v_ononc);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_dfnum);
+ Py_DECREF(__pyx_v_dfden);
+ Py_DECREF(__pyx_v_nonc);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k97p;
+static PyObject *__pyx_k98p;
+
+static char (__pyx_k97[]) = "df <= 0";
+static char (__pyx_k98[]) = "df <= 0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_chisquare(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_chisquare[] = "Chi^2 distribution.\n\n chisquare(df, size=None) -> random values\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_chisquare(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_df = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_odf;
+ double __pyx_v_fdf;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"df","size",0};
+ __pyx_v_size = __pyx_k26;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O|O", __pyx_argnames, &__pyx_v_df, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_df);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_odf = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":891 */
+ __pyx_v_fdf = PyFloat_AsDouble(__pyx_v_df);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":892 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":893 */
+ __pyx_1 = (__pyx_v_fdf <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":894 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 894; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 894; goto __pyx_L1;}
+ Py_INCREF(__pyx_k97p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k97p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 894; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 894; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":895 */
+ __pyx_2 = __pyx_f_6mtrand_cont1_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_chisquare,__pyx_v_size,__pyx_v_fdf); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 895; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":897 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":899 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_df,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 899; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_odf));
+ __pyx_v_odf = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":900 */
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 900; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_any); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 900; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 900; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_3, __pyx_n_less_equal); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 900; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyFloat_FromDouble(0.0); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 900; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 900; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_odf));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_odf));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 900; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 900; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_2, __pyx_4); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 900; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 900; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":901 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 901; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 901; goto __pyx_L1;}
+ Py_INCREF(__pyx_k98p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k98p);
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 901; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 901; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":902 */
+ __pyx_5 = __pyx_f_6mtrand_cont1_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_chisquare,__pyx_v_size,__pyx_v_odf); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 902; goto __pyx_L1;}
+ __pyx_r = __pyx_5;
+ __pyx_5 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.chisquare");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_odf);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_df);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k99p;
+static PyObject *__pyx_k100p;
+static PyObject *__pyx_k101p;
+static PyObject *__pyx_k102p;
+
+static char (__pyx_k99[]) = "df <= 0";
+static char (__pyx_k100[]) = "nonc <= 0";
+static char (__pyx_k101[]) = "df <= 1";
+static char (__pyx_k102[]) = "nonc < 0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_noncentral_chisquare(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_noncentral_chisquare[] = "Noncentral Chi^2 distribution.\n\n noncentral_chisquare(df, nonc, size=None) -> random values\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_noncentral_chisquare(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_df = 0;
+ PyObject *__pyx_v_nonc = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_odf;
+ PyArrayObject *__pyx_v_ononc;
+ double __pyx_v_fdf;
+ double __pyx_v_fnonc;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"df","nonc","size",0};
+ __pyx_v_size = __pyx_k27;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "OO|O", __pyx_argnames, &__pyx_v_df, &__pyx_v_nonc, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_df);
+ Py_INCREF(__pyx_v_nonc);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_odf = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_ononc = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":911 */
+ __pyx_v_fdf = PyFloat_AsDouble(__pyx_v_df);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":912 */
+ __pyx_v_fnonc = PyFloat_AsDouble(__pyx_v_nonc);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":913 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":914 */
+ __pyx_1 = (__pyx_v_fdf <= 1);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":915 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 915; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 915; goto __pyx_L1;}
+ Py_INCREF(__pyx_k99p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k99p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 915; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 915; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":916 */
+ __pyx_1 = (__pyx_v_fnonc <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":917 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 917; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 917; goto __pyx_L1;}
+ Py_INCREF(__pyx_k100p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k100p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 917; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 917; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":918 */
+ __pyx_2 = __pyx_f_6mtrand_cont2_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_noncentral_chisquare,__pyx_v_size,__pyx_v_fdf,__pyx_v_fnonc); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 918; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":921 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":923 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_df,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 923; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_odf));
+ __pyx_v_odf = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":924 */
+ __pyx_4 = PyArray_FROM_OTF(__pyx_v_nonc,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 924; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)__pyx_v_ononc));
+ __pyx_v_ononc = ((PyArrayObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":925 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 925; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_any); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 925; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 925; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_less_equal); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 925; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_4 = PyFloat_FromDouble(0.0); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 925; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 925; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_odf));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_odf));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_5); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 925; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 925; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 925; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 925; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":926 */
+ __pyx_4 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 926; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 926; goto __pyx_L1;}
+ Py_INCREF(__pyx_k101p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k101p);
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 926; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 926; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":927 */
+ __pyx_5 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 927; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_5, __pyx_n_any); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 927; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 927; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_3, __pyx_n_less_equal); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 927; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_5 = PyFloat_FromDouble(0.0); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 927; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 927; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_ononc));
+ PyTuple_SET_ITEM(__pyx_3, 0, ((PyObject *)__pyx_v_ononc));
+ PyTuple_SET_ITEM(__pyx_3, 1, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 927; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 927; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 927; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_3); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 927; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":928 */
+ __pyx_5 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 928; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 928; goto __pyx_L1;}
+ Py_INCREF(__pyx_k102p);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_k102p);
+ __pyx_2 = PyObject_CallObject(__pyx_5, __pyx_4); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 928; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 928; goto __pyx_L1;}
+ goto __pyx_L6;
+ }
+ __pyx_L6:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":929 */
+ __pyx_3 = __pyx_f_6mtrand_cont2_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_noncentral_chisquare,__pyx_v_size,__pyx_v_odf,__pyx_v_ononc); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 929; goto __pyx_L1;}
+ __pyx_r = __pyx_3;
+ __pyx_3 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.noncentral_chisquare");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_odf);
+ Py_DECREF(__pyx_v_ononc);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_df);
+ Py_DECREF(__pyx_v_nonc);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_f_6mtrand_11RandomState_standard_cauchy(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_standard_cauchy[] = "Standard Cauchy with mode=0.\n\n standard_cauchy(size=None)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_standard_cauchy(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_size = 0;
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ static char *__pyx_argnames[] = {"size",0};
+ __pyx_v_size = __pyx_k28;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "|O", __pyx_argnames, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_size);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":937 */
+ __pyx_1 = __pyx_f_6mtrand_cont0_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_standard_cauchy,__pyx_v_size); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 937; goto __pyx_L1;}
+ __pyx_r = __pyx_1;
+ __pyx_1 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ __Pyx_AddTraceback("mtrand.RandomState.standard_cauchy");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k103p;
+static PyObject *__pyx_k104p;
+
+static char (__pyx_k103[]) = "df <= 0";
+static char (__pyx_k104[]) = "df <= 0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_standard_t(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_standard_t[] = "Standard Student\'s t distribution with df degrees of freedom.\n\n standard_t(df, size=None)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_standard_t(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_df = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_odf;
+ double __pyx_v_fdf;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"df","size",0};
+ __pyx_v_size = __pyx_k29;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O|O", __pyx_argnames, &__pyx_v_df, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_df);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_odf = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":947 */
+ __pyx_v_fdf = PyFloat_AsDouble(__pyx_v_df);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":948 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":949 */
+ __pyx_1 = (__pyx_v_fdf <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":950 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 950; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 950; goto __pyx_L1;}
+ Py_INCREF(__pyx_k103p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k103p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 950; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 950; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":951 */
+ __pyx_2 = __pyx_f_6mtrand_cont1_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_standard_t,__pyx_v_size,__pyx_v_fdf); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 951; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":953 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":955 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_df,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 955; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_odf));
+ __pyx_v_odf = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":956 */
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 956; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_any); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 956; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 956; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_3, __pyx_n_less_equal); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 956; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyFloat_FromDouble(0.0); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 956; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 956; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_odf));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_odf));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 956; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 956; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_2, __pyx_4); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 956; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 956; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":957 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 957; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 957; goto __pyx_L1;}
+ Py_INCREF(__pyx_k104p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k104p);
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 957; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 957; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":958 */
+ __pyx_5 = __pyx_f_6mtrand_cont1_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_standard_t,__pyx_v_size,__pyx_v_odf); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 958; goto __pyx_L1;}
+ __pyx_r = __pyx_5;
+ __pyx_5 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.standard_t");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_odf);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_df);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k105p;
+static PyObject *__pyx_k106p;
+
+static char (__pyx_k105[]) = "kappa < 0";
+static char (__pyx_k106[]) = "kappa < 0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_vonmises(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_vonmises[] = "von Mises circular distribution with mode mu and dispersion parameter\n kappa on [-pi, pi].\n\n vonmises(mu, kappa, size=None)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_vonmises(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_mu = 0;
+ PyObject *__pyx_v_kappa = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_omu;
+ PyArrayObject *__pyx_v_okappa;
+ double __pyx_v_fmu;
+ double __pyx_v_fkappa;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"mu","kappa","size",0};
+ __pyx_v_size = __pyx_k30;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "OO|O", __pyx_argnames, &__pyx_v_mu, &__pyx_v_kappa, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_mu);
+ Py_INCREF(__pyx_v_kappa);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_omu = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_okappa = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":969 */
+ __pyx_v_fmu = PyFloat_AsDouble(__pyx_v_mu);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":970 */
+ __pyx_v_fkappa = PyFloat_AsDouble(__pyx_v_kappa);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":971 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":972 */
+ __pyx_1 = (__pyx_v_fkappa < 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":973 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 973; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 973; goto __pyx_L1;}
+ Py_INCREF(__pyx_k105p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k105p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 973; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 973; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":974 */
+ __pyx_2 = __pyx_f_6mtrand_cont2_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_vonmises,__pyx_v_size,__pyx_v_fmu,__pyx_v_fkappa); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 974; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":976 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":978 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_mu,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 978; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_omu));
+ __pyx_v_omu = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":979 */
+ __pyx_4 = PyArray_FROM_OTF(__pyx_v_kappa,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 979; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)__pyx_v_okappa));
+ __pyx_v_okappa = ((PyArrayObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":980 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 980; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_any); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 980; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 980; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_less); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 980; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_4 = PyFloat_FromDouble(0.0); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 980; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 980; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_okappa));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_okappa));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_5); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 980; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 980; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 980; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 980; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":981 */
+ __pyx_4 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 981; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 981; goto __pyx_L1;}
+ Py_INCREF(__pyx_k106p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k106p);
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 981; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 981; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":982 */
+ __pyx_5 = __pyx_f_6mtrand_cont2_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_vonmises,__pyx_v_size,__pyx_v_omu,__pyx_v_okappa); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 982; goto __pyx_L1;}
+ __pyx_r = __pyx_5;
+ __pyx_5 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.vonmises");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_omu);
+ Py_DECREF(__pyx_v_okappa);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_mu);
+ Py_DECREF(__pyx_v_kappa);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k107p;
+static PyObject *__pyx_k108p;
+
+static char (__pyx_k107[]) = "a <= 0";
+static char (__pyx_k108[]) = "a <= 0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_pareto(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_pareto[] = "Pareto distribution.\n\n pareto(a, size=None)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_pareto(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_a = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_oa;
+ double __pyx_v_fa;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"a","size",0};
+ __pyx_v_size = __pyx_k31;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O|O", __pyx_argnames, &__pyx_v_a, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_a);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_oa = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":992 */
+ __pyx_v_fa = PyFloat_AsDouble(__pyx_v_a);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":993 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":994 */
+ __pyx_1 = (__pyx_v_fa <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":995 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 995; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 995; goto __pyx_L1;}
+ Py_INCREF(__pyx_k107p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k107p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 995; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 995; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":996 */
+ __pyx_2 = __pyx_f_6mtrand_cont1_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_pareto,__pyx_v_size,__pyx_v_fa); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 996; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":998 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1000 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_a,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1000; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_oa));
+ __pyx_v_oa = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1001 */
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1001; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_any); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1001; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1001; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_3, __pyx_n_less_equal); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1001; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyFloat_FromDouble(0.0); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1001; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1001; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_oa));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_oa));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1001; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1001; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_2, __pyx_4); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1001; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1001; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1002 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1002; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1002; goto __pyx_L1;}
+ Py_INCREF(__pyx_k108p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k108p);
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1002; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1002; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1003 */
+ __pyx_5 = __pyx_f_6mtrand_cont1_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_pareto,__pyx_v_size,__pyx_v_oa); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1003; goto __pyx_L1;}
+ __pyx_r = __pyx_5;
+ __pyx_5 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.pareto");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_oa);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_a);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k109p;
+static PyObject *__pyx_k110p;
+
+static char (__pyx_k109[]) = "a <= 0";
+static char (__pyx_k110[]) = "a <= 0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_weibull(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_weibull[] = "Weibull distribution.\n\n weibull(a, size=None)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_weibull(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_a = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_oa;
+ double __pyx_v_fa;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"a","size",0};
+ __pyx_v_size = __pyx_k32;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O|O", __pyx_argnames, &__pyx_v_a, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_a);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_oa = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1013 */
+ __pyx_v_fa = PyFloat_AsDouble(__pyx_v_a);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1014 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1015 */
+ __pyx_1 = (__pyx_v_fa <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1016 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1016; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1016; goto __pyx_L1;}
+ Py_INCREF(__pyx_k109p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k109p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1016; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1016; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1017 */
+ __pyx_2 = __pyx_f_6mtrand_cont1_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_weibull,__pyx_v_size,__pyx_v_fa); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1017; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1019 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1021 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_a,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1021; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_oa));
+ __pyx_v_oa = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1022 */
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1022; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_any); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1022; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1022; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_3, __pyx_n_less_equal); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1022; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyFloat_FromDouble(0.0); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1022; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1022; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_oa));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_oa));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1022; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1022; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_2, __pyx_4); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1022; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1022; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1023 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1023; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1023; goto __pyx_L1;}
+ Py_INCREF(__pyx_k110p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k110p);
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1023; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1023; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1024 */
+ __pyx_5 = __pyx_f_6mtrand_cont1_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_weibull,__pyx_v_size,__pyx_v_oa); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1024; goto __pyx_L1;}
+ __pyx_r = __pyx_5;
+ __pyx_5 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.weibull");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_oa);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_a);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k111p;
+static PyObject *__pyx_k112p;
+
+static char (__pyx_k111[]) = "a <= 0";
+static char (__pyx_k112[]) = "a <= 0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_power(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_power[] = "Power distribution.\n\n power(a, size=None)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_power(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_a = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_oa;
+ double __pyx_v_fa;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"a","size",0};
+ __pyx_v_size = __pyx_k33;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O|O", __pyx_argnames, &__pyx_v_a, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_a);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_oa = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1034 */
+ __pyx_v_fa = PyFloat_AsDouble(__pyx_v_a);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1035 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1036 */
+ __pyx_1 = (__pyx_v_fa <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1037 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1037; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1037; goto __pyx_L1;}
+ Py_INCREF(__pyx_k111p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k111p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1037; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1037; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1038 */
+ __pyx_2 = __pyx_f_6mtrand_cont1_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_power,__pyx_v_size,__pyx_v_fa); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1038; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1040 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1042 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_a,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1042; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_oa));
+ __pyx_v_oa = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1043 */
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1043; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_any); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1043; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1043; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_3, __pyx_n_less_equal); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1043; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyFloat_FromDouble(0.0); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1043; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1043; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_oa));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_oa));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1043; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1043; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_2, __pyx_4); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1043; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1043; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1044 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1044; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1044; goto __pyx_L1;}
+ Py_INCREF(__pyx_k112p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k112p);
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1044; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1044; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1045 */
+ __pyx_5 = __pyx_f_6mtrand_cont1_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_power,__pyx_v_size,__pyx_v_oa); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1045; goto __pyx_L1;}
+ __pyx_r = __pyx_5;
+ __pyx_5 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.power");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_oa);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_a);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k113p;
+static PyObject *__pyx_k114p;
+
+static char (__pyx_k113[]) = "scale <= 0";
+static char (__pyx_k114[]) = "scale <= 0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_laplace(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_laplace[] = "Laplace distribution.\n \n laplace(loc=0.0, scale=1.0, size=None)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_laplace(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_loc = 0;
+ PyObject *__pyx_v_scale = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_oloc;
+ PyArrayObject *__pyx_v_oscale;
+ double __pyx_v_floc;
+ double __pyx_v_fscale;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"loc","scale","size",0};
+ __pyx_v_loc = __pyx_k34;
+ __pyx_v_scale = __pyx_k35;
+ __pyx_v_size = __pyx_k36;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "|OOO", __pyx_argnames, &__pyx_v_loc, &__pyx_v_scale, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_loc);
+ Py_INCREF(__pyx_v_scale);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_oloc = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_oscale = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1055 */
+ __pyx_v_floc = PyFloat_AsDouble(__pyx_v_loc);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1056 */
+ __pyx_v_fscale = PyFloat_AsDouble(__pyx_v_scale);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1057 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1058 */
+ __pyx_1 = (__pyx_v_fscale <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1059 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1059; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1059; goto __pyx_L1;}
+ Py_INCREF(__pyx_k113p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k113p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1059; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1059; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1060 */
+ __pyx_2 = __pyx_f_6mtrand_cont2_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_laplace,__pyx_v_size,__pyx_v_floc,__pyx_v_fscale); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1060; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1062 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1063 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_loc,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1063; goto __pyx_L1;}
+ if (!__Pyx_TypeTest(__pyx_3, __pyx_ptype_6mtrand_ndarray)) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1063; goto __pyx_L1;}
+ Py_DECREF(((PyObject *)__pyx_v_oloc));
+ __pyx_v_oloc = ((PyArrayObject *)__pyx_3);
+ __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1064 */
+ __pyx_4 = PyArray_FROM_OTF(__pyx_v_scale,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1064; goto __pyx_L1;}
+ if (!__Pyx_TypeTest(__pyx_4, __pyx_ptype_6mtrand_ndarray)) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1064; goto __pyx_L1;}
+ Py_DECREF(((PyObject *)__pyx_v_oscale));
+ __pyx_v_oscale = ((PyArrayObject *)__pyx_4);
+ __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1065 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1065; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_any); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1065; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1065; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_less_equal); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1065; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_4 = PyFloat_FromDouble(0.0); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1065; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1065; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_oscale));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_oscale));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_5); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1065; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1065; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1065; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1065; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1066 */
+ __pyx_4 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1066; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1066; goto __pyx_L1;}
+ Py_INCREF(__pyx_k114p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k114p);
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1066; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1066; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1067 */
+ __pyx_5 = __pyx_f_6mtrand_cont2_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_laplace,__pyx_v_size,__pyx_v_oloc,__pyx_v_oscale); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1067; goto __pyx_L1;}
+ __pyx_r = __pyx_5;
+ __pyx_5 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.laplace");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_oloc);
+ Py_DECREF(__pyx_v_oscale);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_loc);
+ Py_DECREF(__pyx_v_scale);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k115p;
+static PyObject *__pyx_k116p;
+
+static char (__pyx_k115[]) = "scale <= 0";
+static char (__pyx_k116[]) = "scale <= 0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_gumbel(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_gumbel[] = "Gumbel distribution.\n \n gumbel(loc=0.0, scale=1.0, size=None)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_gumbel(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_loc = 0;
+ PyObject *__pyx_v_scale = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_oloc;
+ PyArrayObject *__pyx_v_oscale;
+ double __pyx_v_floc;
+ double __pyx_v_fscale;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"loc","scale","size",0};
+ __pyx_v_loc = __pyx_k37;
+ __pyx_v_scale = __pyx_k38;
+ __pyx_v_size = __pyx_k39;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "|OOO", __pyx_argnames, &__pyx_v_loc, &__pyx_v_scale, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_loc);
+ Py_INCREF(__pyx_v_scale);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_oloc = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_oscale = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1077 */
+ __pyx_v_floc = PyFloat_AsDouble(__pyx_v_loc);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1078 */
+ __pyx_v_fscale = PyFloat_AsDouble(__pyx_v_scale);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1079 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1080 */
+ __pyx_1 = (__pyx_v_fscale <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1081 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1081; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1081; goto __pyx_L1;}
+ Py_INCREF(__pyx_k115p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k115p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1081; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1081; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1082 */
+ __pyx_2 = __pyx_f_6mtrand_cont2_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_gumbel,__pyx_v_size,__pyx_v_floc,__pyx_v_fscale); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1082; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1084 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1085 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_loc,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1085; goto __pyx_L1;}
+ if (!__Pyx_TypeTest(__pyx_3, __pyx_ptype_6mtrand_ndarray)) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1085; goto __pyx_L1;}
+ Py_DECREF(((PyObject *)__pyx_v_oloc));
+ __pyx_v_oloc = ((PyArrayObject *)__pyx_3);
+ __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1086 */
+ __pyx_4 = PyArray_FROM_OTF(__pyx_v_scale,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1086; goto __pyx_L1;}
+ if (!__Pyx_TypeTest(__pyx_4, __pyx_ptype_6mtrand_ndarray)) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1086; goto __pyx_L1;}
+ Py_DECREF(((PyObject *)__pyx_v_oscale));
+ __pyx_v_oscale = ((PyArrayObject *)__pyx_4);
+ __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1087 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1087; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_any); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1087; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1087; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_less_equal); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1087; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_4 = PyFloat_FromDouble(0.0); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1087; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1087; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_oscale));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_oscale));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_5); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1087; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1087; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1087; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1087; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1088 */
+ __pyx_4 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1088; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1088; goto __pyx_L1;}
+ Py_INCREF(__pyx_k116p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k116p);
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1088; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1088; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1089 */
+ __pyx_5 = __pyx_f_6mtrand_cont2_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_gumbel,__pyx_v_size,__pyx_v_oloc,__pyx_v_oscale); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1089; goto __pyx_L1;}
+ __pyx_r = __pyx_5;
+ __pyx_5 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.gumbel");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_oloc);
+ Py_DECREF(__pyx_v_oscale);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_loc);
+ Py_DECREF(__pyx_v_scale);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k117p;
+static PyObject *__pyx_k118p;
+
+static char (__pyx_k117[]) = "scale <= 0";
+static char (__pyx_k118[]) = "scale <= 0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_logistic(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_logistic[] = "Logistic distribution.\n \n logistic(loc=0.0, scale=1.0, size=None)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_logistic(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_loc = 0;
+ PyObject *__pyx_v_scale = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_oloc;
+ PyArrayObject *__pyx_v_oscale;
+ double __pyx_v_floc;
+ double __pyx_v_fscale;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"loc","scale","size",0};
+ __pyx_v_loc = __pyx_k40;
+ __pyx_v_scale = __pyx_k41;
+ __pyx_v_size = __pyx_k42;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "|OOO", __pyx_argnames, &__pyx_v_loc, &__pyx_v_scale, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_loc);
+ Py_INCREF(__pyx_v_scale);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_oloc = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_oscale = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1099 */
+ __pyx_v_floc = PyFloat_AsDouble(__pyx_v_loc);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1100 */
+ __pyx_v_fscale = PyFloat_AsDouble(__pyx_v_scale);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1101 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1102 */
+ __pyx_1 = (__pyx_v_fscale <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1103 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1103; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1103; goto __pyx_L1;}
+ Py_INCREF(__pyx_k117p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k117p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1103; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1103; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1104 */
+ __pyx_2 = __pyx_f_6mtrand_cont2_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_logistic,__pyx_v_size,__pyx_v_floc,__pyx_v_fscale); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1104; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1106 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1107 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_loc,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1107; goto __pyx_L1;}
+ if (!__Pyx_TypeTest(__pyx_3, __pyx_ptype_6mtrand_ndarray)) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1107; goto __pyx_L1;}
+ Py_DECREF(((PyObject *)__pyx_v_oloc));
+ __pyx_v_oloc = ((PyArrayObject *)__pyx_3);
+ __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1108 */
+ __pyx_4 = PyArray_FROM_OTF(__pyx_v_scale,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1108; goto __pyx_L1;}
+ if (!__Pyx_TypeTest(__pyx_4, __pyx_ptype_6mtrand_ndarray)) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1108; goto __pyx_L1;}
+ Py_DECREF(((PyObject *)__pyx_v_oscale));
+ __pyx_v_oscale = ((PyArrayObject *)__pyx_4);
+ __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1109 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1109; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_any); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1109; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1109; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_less_equal); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1109; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_4 = PyFloat_FromDouble(0.0); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1109; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1109; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_oscale));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_oscale));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_5); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1109; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1109; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1109; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1109; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1110 */
+ __pyx_4 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1110; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1110; goto __pyx_L1;}
+ Py_INCREF(__pyx_k118p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k118p);
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1110; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1110; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1111 */
+ __pyx_5 = __pyx_f_6mtrand_cont2_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_logistic,__pyx_v_size,__pyx_v_oloc,__pyx_v_oscale); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1111; goto __pyx_L1;}
+ __pyx_r = __pyx_5;
+ __pyx_5 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.logistic");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_oloc);
+ Py_DECREF(__pyx_v_oscale);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_loc);
+ Py_DECREF(__pyx_v_scale);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k119p;
+static PyObject *__pyx_k120p;
+
+static char (__pyx_k119[]) = "sigma <= 0";
+static char (__pyx_k120[]) = "sigma <= 0.0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_lognormal(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_lognormal[] = "Log-normal distribution.\n \n Note that the mean parameter is not the mean of this distribution, but \n the underlying normal distribution.\n \n lognormal(mean, sigma) <=> exp(normal(mean, sigma))\n \n lognormal(mean=0.0, sigma=1.0, size=None)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_lognormal(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_mean = 0;
+ PyObject *__pyx_v_sigma = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_omean;
+ PyArrayObject *__pyx_v_osigma;
+ double __pyx_v_fmean;
+ double __pyx_v_fsigma;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"mean","sigma","size",0};
+ __pyx_v_mean = __pyx_k43;
+ __pyx_v_sigma = __pyx_k44;
+ __pyx_v_size = __pyx_k45;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "|OOO", __pyx_argnames, &__pyx_v_mean, &__pyx_v_sigma, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_mean);
+ Py_INCREF(__pyx_v_sigma);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_omean = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_osigma = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1126 */
+ __pyx_v_fmean = PyFloat_AsDouble(__pyx_v_mean);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1127 */
+ __pyx_v_fsigma = PyFloat_AsDouble(__pyx_v_sigma);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1129 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1130 */
+ __pyx_1 = (__pyx_v_fsigma <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1131 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1131; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1131; goto __pyx_L1;}
+ Py_INCREF(__pyx_k119p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k119p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1131; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1131; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1132 */
+ __pyx_2 = __pyx_f_6mtrand_cont2_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_lognormal,__pyx_v_size,__pyx_v_fmean,__pyx_v_fsigma); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1132; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1134 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1136 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_mean,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1136; goto __pyx_L1;}
+ if (!__Pyx_TypeTest(__pyx_3, __pyx_ptype_6mtrand_ndarray)) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1136; goto __pyx_L1;}
+ Py_DECREF(((PyObject *)__pyx_v_omean));
+ __pyx_v_omean = ((PyArrayObject *)__pyx_3);
+ __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1137 */
+ __pyx_4 = PyArray_FROM_OTF(__pyx_v_sigma,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1137; goto __pyx_L1;}
+ if (!__Pyx_TypeTest(__pyx_4, __pyx_ptype_6mtrand_ndarray)) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1137; goto __pyx_L1;}
+ Py_DECREF(((PyObject *)__pyx_v_osigma));
+ __pyx_v_osigma = ((PyArrayObject *)__pyx_4);
+ __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1138 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1138; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_any); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1138; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1138; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_less_equal); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1138; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_4 = PyFloat_FromDouble(0.0); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1138; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1138; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_osigma));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_osigma));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_5); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1138; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1138; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1138; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1138; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1139 */
+ __pyx_4 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1139; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1139; goto __pyx_L1;}
+ Py_INCREF(__pyx_k120p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k120p);
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1139; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1139; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1140 */
+ __pyx_5 = __pyx_f_6mtrand_cont2_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_lognormal,__pyx_v_size,__pyx_v_omean,__pyx_v_osigma); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1140; goto __pyx_L1;}
+ __pyx_r = __pyx_5;
+ __pyx_5 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.lognormal");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_omean);
+ Py_DECREF(__pyx_v_osigma);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_mean);
+ Py_DECREF(__pyx_v_sigma);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k121p;
+static PyObject *__pyx_k122p;
+
+static char (__pyx_k121[]) = "scale <= 0";
+static char (__pyx_k122[]) = "scale <= 0.0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_rayleigh(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_rayleigh[] = "Rayleigh distribution.\n \n rayleigh(scale=1.0, size=None)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_rayleigh(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_scale = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_oscale;
+ double __pyx_v_fscale;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"scale","size",0};
+ __pyx_v_scale = __pyx_k46;
+ __pyx_v_size = __pyx_k47;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "|OO", __pyx_argnames, &__pyx_v_scale, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_scale);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_oscale = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1150 */
+ __pyx_v_fscale = PyFloat_AsDouble(__pyx_v_scale);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1152 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1153 */
+ __pyx_1 = (__pyx_v_fscale <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1154 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1154; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1154; goto __pyx_L1;}
+ Py_INCREF(__pyx_k121p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k121p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1154; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1154; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1155 */
+ __pyx_2 = __pyx_f_6mtrand_cont1_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_rayleigh,__pyx_v_size,__pyx_v_fscale); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1155; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1157 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1159 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_scale,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1159; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_oscale));
+ __pyx_v_oscale = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1160 */
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1160; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_any); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1160; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1160; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_3, __pyx_n_less_equal); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1160; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyFloat_FromDouble(0.0); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1160; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1160; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_oscale));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_oscale));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1160; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1160; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_2, __pyx_4); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1160; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1160; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1161 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1161; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1161; goto __pyx_L1;}
+ Py_INCREF(__pyx_k122p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k122p);
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1161; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1161; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1162 */
+ __pyx_5 = __pyx_f_6mtrand_cont1_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_rayleigh,__pyx_v_size,__pyx_v_oscale); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1162; goto __pyx_L1;}
+ __pyx_r = __pyx_5;
+ __pyx_5 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.rayleigh");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_oscale);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_scale);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k123p;
+static PyObject *__pyx_k124p;
+static PyObject *__pyx_k125p;
+static PyObject *__pyx_k126p;
+
+static char (__pyx_k123[]) = "mean <= 0";
+static char (__pyx_k124[]) = "scale <= 0";
+static char (__pyx_k125[]) = "mean <= 0.0";
+static char (__pyx_k126[]) = "scale <= 0.0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_wald(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_wald[] = "Wald (inverse Gaussian) distribution.\n \n wald(mean, scale, size=None)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_wald(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_mean = 0;
+ PyObject *__pyx_v_scale = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_omean;
+ PyArrayObject *__pyx_v_oscale;
+ double __pyx_v_fmean;
+ double __pyx_v_fscale;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"mean","scale","size",0};
+ __pyx_v_size = __pyx_k48;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "OO|O", __pyx_argnames, &__pyx_v_mean, &__pyx_v_scale, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_mean);
+ Py_INCREF(__pyx_v_scale);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_omean = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_oscale = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1172 */
+ __pyx_v_fmean = PyFloat_AsDouble(__pyx_v_mean);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1173 */
+ __pyx_v_fscale = PyFloat_AsDouble(__pyx_v_scale);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1174 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1175 */
+ __pyx_1 = (__pyx_v_fmean <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1176 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1176; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1176; goto __pyx_L1;}
+ Py_INCREF(__pyx_k123p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k123p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1176; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1176; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1177 */
+ __pyx_1 = (__pyx_v_fscale <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1178 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1178; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1178; goto __pyx_L1;}
+ Py_INCREF(__pyx_k124p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k124p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1178; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1178; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1179 */
+ __pyx_2 = __pyx_f_6mtrand_cont2_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_wald,__pyx_v_size,__pyx_v_fmean,__pyx_v_fscale); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1179; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1181 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1182 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_mean,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1182; goto __pyx_L1;}
+ if (!__Pyx_TypeTest(__pyx_3, __pyx_ptype_6mtrand_ndarray)) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1182; goto __pyx_L1;}
+ Py_DECREF(((PyObject *)__pyx_v_omean));
+ __pyx_v_omean = ((PyArrayObject *)__pyx_3);
+ __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1183 */
+ __pyx_4 = PyArray_FROM_OTF(__pyx_v_scale,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1183; goto __pyx_L1;}
+ if (!__Pyx_TypeTest(__pyx_4, __pyx_ptype_6mtrand_ndarray)) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1183; goto __pyx_L1;}
+ Py_DECREF(((PyObject *)__pyx_v_oscale));
+ __pyx_v_oscale = ((PyArrayObject *)__pyx_4);
+ __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1184 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1184; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_any); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1184; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1184; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_less_equal); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1184; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_4 = PyFloat_FromDouble(0.0); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1184; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1184; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_omean));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_omean));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_5); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1184; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1184; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1184; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1184; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1185 */
+ __pyx_4 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1185; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1185; goto __pyx_L1;}
+ Py_INCREF(__pyx_k125p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k125p);
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1185; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1185; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_5 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1186; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_5, __pyx_n_any); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1186; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1186; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_3, __pyx_n_less_equal); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1186; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_5 = PyFloat_FromDouble(0.0); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1186; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1186; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_oscale));
+ PyTuple_SET_ITEM(__pyx_3, 0, ((PyObject *)__pyx_v_oscale));
+ PyTuple_SET_ITEM(__pyx_3, 1, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1186; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1186; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1186; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_3); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1186; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1187 */
+ __pyx_5 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1187; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1187; goto __pyx_L1;}
+ Py_INCREF(__pyx_k126p);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_k126p);
+ __pyx_2 = PyObject_CallObject(__pyx_5, __pyx_4); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1187; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1187; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1188 */
+ __pyx_3 = __pyx_f_6mtrand_cont2_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_wald,__pyx_v_size,__pyx_v_omean,__pyx_v_oscale); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1188; goto __pyx_L1;}
+ __pyx_r = __pyx_3;
+ __pyx_3 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.wald");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_omean);
+ Py_DECREF(__pyx_v_oscale);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_mean);
+ Py_DECREF(__pyx_v_scale);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_n_greater;
+static PyObject *__pyx_n_equal;
+
+static PyObject *__pyx_k127p;
+static PyObject *__pyx_k128p;
+static PyObject *__pyx_k129p;
+static PyObject *__pyx_k130p;
+static PyObject *__pyx_k131p;
+static PyObject *__pyx_k132p;
+
+static char (__pyx_k127[]) = "left > mode";
+static char (__pyx_k128[]) = "mode > right";
+static char (__pyx_k129[]) = "left == right";
+static char (__pyx_k130[]) = "left > mode";
+static char (__pyx_k131[]) = "mode > right";
+static char (__pyx_k132[]) = "left == right";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_triangular(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_triangular[] = "Triangular distribution starting at left, peaking at mode, and \n ending at right (left <= mode <= right).\n \n triangular(left, mode, right, size=None)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_triangular(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_left = 0;
+ PyObject *__pyx_v_mode = 0;
+ PyObject *__pyx_v_right = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_oleft;
+ PyArrayObject *__pyx_v_omode;
+ PyArrayObject *__pyx_v_oright;
+ double __pyx_v_fleft;
+ double __pyx_v_fmode;
+ double __pyx_v_fright;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"left","mode","right","size",0};
+ __pyx_v_size = __pyx_k49;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "OOO|O", __pyx_argnames, &__pyx_v_left, &__pyx_v_mode, &__pyx_v_right, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_left);
+ Py_INCREF(__pyx_v_mode);
+ Py_INCREF(__pyx_v_right);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_oleft = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_omode = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_oright = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1201 */
+ __pyx_v_fleft = PyFloat_AsDouble(__pyx_v_left);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1202 */
+ __pyx_v_fright = PyFloat_AsDouble(__pyx_v_right);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1203 */
+ __pyx_v_fmode = PyFloat_AsDouble(__pyx_v_mode);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1204 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1205 */
+ __pyx_1 = (__pyx_v_fleft > __pyx_v_fmode);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1206 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1206; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1206; goto __pyx_L1;}
+ Py_INCREF(__pyx_k127p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k127p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1206; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1206; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1207 */
+ __pyx_1 = (__pyx_v_fmode > __pyx_v_fright);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1208 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1208; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1208; goto __pyx_L1;}
+ Py_INCREF(__pyx_k128p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k128p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1208; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1208; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1209 */
+ __pyx_1 = (__pyx_v_fleft == __pyx_v_fright);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1210 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1210; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1210; goto __pyx_L1;}
+ Py_INCREF(__pyx_k129p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k129p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1210; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1210; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1211 */
+ __pyx_2 = __pyx_f_6mtrand_cont3_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_triangular,__pyx_v_size,__pyx_v_fleft,__pyx_v_fmode,__pyx_v_fright); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1211; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1214 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1215 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_left,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1215; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_oleft));
+ __pyx_v_oleft = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1216 */
+ __pyx_4 = PyArray_FROM_OTF(__pyx_v_mode,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1216; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)__pyx_v_omode));
+ __pyx_v_omode = ((PyArrayObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1217 */
+ __pyx_2 = PyArray_FROM_OTF(__pyx_v_right,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1217; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)__pyx_v_oright));
+ __pyx_v_oright = ((PyArrayObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1219 */
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1219; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_3, __pyx_n_any); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1219; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1219; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_greater); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1219; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = PyTuple_New(2); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1219; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_oleft));
+ PyTuple_SET_ITEM(__pyx_2, 0, ((PyObject *)__pyx_v_oleft));
+ Py_INCREF(((PyObject *)__pyx_v_omode));
+ PyTuple_SET_ITEM(__pyx_2, 1, ((PyObject *)__pyx_v_omode));
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1219; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1219; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1219; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_2); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1219; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1220 */
+ __pyx_5 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1220; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1220; goto __pyx_L1;}
+ Py_INCREF(__pyx_k130p);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_k130p);
+ __pyx_3 = PyObject_CallObject(__pyx_5, __pyx_4); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1220; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __Pyx_Raise(__pyx_3, 0, 0);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1220; goto __pyx_L1;}
+ goto __pyx_L6;
+ }
+ __pyx_L6:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1221 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1221; goto __pyx_L1;}
+ __pyx_5 = PyObject_GetAttr(__pyx_2, __pyx_n_any); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1221; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1221; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_4, __pyx_n_greater); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1221; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_2 = PyTuple_New(2); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1221; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_omode));
+ PyTuple_SET_ITEM(__pyx_2, 0, ((PyObject *)__pyx_v_omode));
+ Py_INCREF(((PyObject *)__pyx_v_oright));
+ PyTuple_SET_ITEM(__pyx_2, 1, ((PyObject *)__pyx_v_oright));
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1221; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1221; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_5, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1221; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_2); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1221; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1222 */
+ __pyx_4 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1222; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(1); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1222; goto __pyx_L1;}
+ Py_INCREF(__pyx_k131p);
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_k131p);
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1222; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __Pyx_Raise(__pyx_3, 0, 0);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1222; goto __pyx_L1;}
+ goto __pyx_L7;
+ }
+ __pyx_L7:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1223 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1223; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_2, __pyx_n_any); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1223; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_5 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1223; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_5, __pyx_n_equal); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1223; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = PyTuple_New(2); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1223; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_oleft));
+ PyTuple_SET_ITEM(__pyx_2, 0, ((PyObject *)__pyx_v_oleft));
+ Py_INCREF(((PyObject *)__pyx_v_oright));
+ PyTuple_SET_ITEM(__pyx_2, 1, ((PyObject *)__pyx_v_oright));
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1223; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1223; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1223; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_2); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1223; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1224 */
+ __pyx_5 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1224; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1224; goto __pyx_L1;}
+ Py_INCREF(__pyx_k132p);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_k132p);
+ __pyx_3 = PyObject_CallObject(__pyx_5, __pyx_4); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1224; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __Pyx_Raise(__pyx_3, 0, 0);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1224; goto __pyx_L1;}
+ goto __pyx_L8;
+ }
+ __pyx_L8:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1225 */
+ __pyx_2 = __pyx_f_6mtrand_cont3_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_triangular,__pyx_v_size,__pyx_v_oleft,__pyx_v_omode,__pyx_v_oright); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1225; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.triangular");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_oleft);
+ Py_DECREF(__pyx_v_omode);
+ Py_DECREF(__pyx_v_oright);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_left);
+ Py_DECREF(__pyx_v_mode);
+ Py_DECREF(__pyx_v_right);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k133p;
+static PyObject *__pyx_k134p;
+static PyObject *__pyx_k135p;
+static PyObject *__pyx_k136p;
+static PyObject *__pyx_k137p;
+static PyObject *__pyx_k138p;
+
+static char (__pyx_k133[]) = "n <= 0";
+static char (__pyx_k134[]) = "p < 0";
+static char (__pyx_k135[]) = "p > 1";
+static char (__pyx_k136[]) = "n <= 0";
+static char (__pyx_k137[]) = "p < 0";
+static char (__pyx_k138[]) = "p > 1";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_binomial(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_binomial[] = "Binomial distribution of n trials and p probability of success.\n\n binomial(n, p, size=None) -> random values\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_binomial(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_n = 0;
+ PyObject *__pyx_v_p = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_on;
+ PyArrayObject *__pyx_v_op;
+ long __pyx_v_ln;
+ double __pyx_v_fp;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"n","p","size",0};
+ __pyx_v_size = __pyx_k50;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "OO|O", __pyx_argnames, &__pyx_v_n, &__pyx_v_p, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_n);
+ Py_INCREF(__pyx_v_p);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_on = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_op = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1238 */
+ __pyx_v_fp = PyFloat_AsDouble(__pyx_v_p);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1239 */
+ __pyx_v_ln = PyInt_AsLong(__pyx_v_n);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1240 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1241 */
+ __pyx_1 = (__pyx_v_ln <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1242 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1242; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1242; goto __pyx_L1;}
+ Py_INCREF(__pyx_k133p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k133p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1242; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1242; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1243 */
+ __pyx_1 = (__pyx_v_fp < 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1244 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1244; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1244; goto __pyx_L1;}
+ Py_INCREF(__pyx_k134p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k134p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1244; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1244; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_1 = (__pyx_v_fp > 1);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1246 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1246; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1246; goto __pyx_L1;}
+ Py_INCREF(__pyx_k135p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k135p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1246; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1246; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1247 */
+ __pyx_2 = __pyx_f_6mtrand_discnp_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_binomial,__pyx_v_size,__pyx_v_ln,__pyx_v_fp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1247; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1249 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1251 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_n,NPY_LONG,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1251; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_on));
+ __pyx_v_on = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1252 */
+ __pyx_4 = PyArray_FROM_OTF(__pyx_v_p,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1252; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)__pyx_v_op));
+ __pyx_v_op = ((PyArrayObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1253 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1253; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_any); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1253; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1253; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_less_equal); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1253; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_4 = PyInt_FromLong(0); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1253; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1253; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_n);
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_v_n);
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_5); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1253; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1253; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1253; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1253; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1254 */
+ __pyx_4 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1254; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1254; goto __pyx_L1;}
+ Py_INCREF(__pyx_k136p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k136p);
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1254; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1254; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1255 */
+ __pyx_5 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1255; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_5, __pyx_n_any); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1255; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1255; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_3, __pyx_n_less); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1255; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_5 = PyInt_FromLong(0); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1255; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1255; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_v_p);
+ PyTuple_SET_ITEM(__pyx_3, 1, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1255; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1255; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1255; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_3); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1255; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1256 */
+ __pyx_5 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1256; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1256; goto __pyx_L1;}
+ Py_INCREF(__pyx_k137p);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_k137p);
+ __pyx_2 = PyObject_CallObject(__pyx_5, __pyx_4); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1256; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1256; goto __pyx_L1;}
+ goto __pyx_L6;
+ }
+ __pyx_L6:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1257 */
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1257; goto __pyx_L1;}
+ __pyx_5 = PyObject_GetAttr(__pyx_3, __pyx_n_any); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1257; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1257; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_greater); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1257; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_3 = PyInt_FromLong(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1257; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1257; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_p);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_v_p);
+ PyTuple_SET_ITEM(__pyx_4, 1, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_2, __pyx_4); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1257; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1257; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_5, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1257; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_4); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1257; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1258 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1258; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(1); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1258; goto __pyx_L1;}
+ Py_INCREF(__pyx_k138p);
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_k138p);
+ __pyx_2 = PyObject_CallObject(__pyx_3, __pyx_5); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1258; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1258; goto __pyx_L1;}
+ goto __pyx_L7;
+ }
+ __pyx_L7:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1259 */
+ __pyx_4 = __pyx_f_6mtrand_discnp_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_binomial,__pyx_v_size,__pyx_v_on,__pyx_v_op); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1259; goto __pyx_L1;}
+ __pyx_r = __pyx_4;
+ __pyx_4 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.binomial");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_on);
+ Py_DECREF(__pyx_v_op);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_n);
+ Py_DECREF(__pyx_v_p);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k139p;
+static PyObject *__pyx_k140p;
+static PyObject *__pyx_k141p;
+static PyObject *__pyx_k142p;
+static PyObject *__pyx_k143p;
+static PyObject *__pyx_k144p;
+
+static char (__pyx_k139[]) = "n <= 0";
+static char (__pyx_k140[]) = "p < 0";
+static char (__pyx_k141[]) = "p > 1";
+static char (__pyx_k142[]) = "n <= 0";
+static char (__pyx_k143[]) = "p < 0";
+static char (__pyx_k144[]) = "p > 1";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_negative_binomial(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_negative_binomial[] = "Negative Binomial distribution.\n\n negative_binomial(n, p, size=None) -> random values\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_negative_binomial(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_n = 0;
+ PyObject *__pyx_v_p = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_on;
+ PyArrayObject *__pyx_v_op;
+ long __pyx_v_ln;
+ double __pyx_v_fp;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"n","p","size",0};
+ __pyx_v_size = __pyx_k51;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "OO|O", __pyx_argnames, &__pyx_v_n, &__pyx_v_p, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_n);
+ Py_INCREF(__pyx_v_p);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_on = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_op = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1271 */
+ __pyx_v_fp = PyFloat_AsDouble(__pyx_v_p);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1272 */
+ __pyx_v_ln = PyInt_AsLong(__pyx_v_n);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1273 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1274 */
+ __pyx_1 = (__pyx_v_ln <= 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1275 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1275; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1275; goto __pyx_L1;}
+ Py_INCREF(__pyx_k139p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k139p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1275; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1275; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1276 */
+ __pyx_1 = (__pyx_v_fp < 0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1277 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1277; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1277; goto __pyx_L1;}
+ Py_INCREF(__pyx_k140p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k140p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1277; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1277; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_1 = (__pyx_v_fp > 1);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1279 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1279; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1279; goto __pyx_L1;}
+ Py_INCREF(__pyx_k141p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k141p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1279; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1279; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1280 */
+ __pyx_2 = __pyx_f_6mtrand_discnp_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_negative_binomial,__pyx_v_size,__pyx_v_ln,__pyx_v_fp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1280; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1283 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1285 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_n,NPY_LONG,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1285; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_on));
+ __pyx_v_on = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1286 */
+ __pyx_4 = PyArray_FROM_OTF(__pyx_v_p,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1286; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)__pyx_v_op));
+ __pyx_v_op = ((PyArrayObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1287 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1287; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_any); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1287; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1287; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_less_equal); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1287; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_4 = PyInt_FromLong(0); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1287; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1287; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_n);
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_v_n);
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_5); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1287; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1287; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1287; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1287; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1288 */
+ __pyx_4 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1288; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1288; goto __pyx_L1;}
+ Py_INCREF(__pyx_k142p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k142p);
+ __pyx_2 = PyObject_CallObject(__pyx_4, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1288; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1288; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1289 */
+ __pyx_5 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1289; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_5, __pyx_n_any); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1289; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1289; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_3, __pyx_n_less); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1289; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_5 = PyInt_FromLong(0); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1289; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1289; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_v_p);
+ PyTuple_SET_ITEM(__pyx_3, 1, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1289; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1289; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1289; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_3); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1289; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1290 */
+ __pyx_5 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1290; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1290; goto __pyx_L1;}
+ Py_INCREF(__pyx_k143p);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_k143p);
+ __pyx_2 = PyObject_CallObject(__pyx_5, __pyx_4); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1290; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1290; goto __pyx_L1;}
+ goto __pyx_L6;
+ }
+ __pyx_L6:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1291 */
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1291; goto __pyx_L1;}
+ __pyx_5 = PyObject_GetAttr(__pyx_3, __pyx_n_any); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1291; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1291; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_greater); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1291; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_3 = PyInt_FromLong(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1291; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1291; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_p);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_v_p);
+ PyTuple_SET_ITEM(__pyx_4, 1, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_2, __pyx_4); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1291; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1291; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_5, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1291; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_4); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1291; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1292 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1292; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(1); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1292; goto __pyx_L1;}
+ Py_INCREF(__pyx_k144p);
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_k144p);
+ __pyx_2 = PyObject_CallObject(__pyx_3, __pyx_5); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1292; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1292; goto __pyx_L1;}
+ goto __pyx_L7;
+ }
+ __pyx_L7:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1293 */
+ __pyx_4 = __pyx_f_6mtrand_discnp_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_negative_binomial,__pyx_v_size,__pyx_v_on,__pyx_v_op); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1293; goto __pyx_L1;}
+ __pyx_r = __pyx_4;
+ __pyx_4 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.negative_binomial");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_on);
+ Py_DECREF(__pyx_v_op);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_n);
+ Py_DECREF(__pyx_v_p);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k145p;
+static PyObject *__pyx_k146p;
+
+static char (__pyx_k145[]) = "lam < 0";
+static char (__pyx_k146[]) = "lam < 0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_poisson(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_poisson[] = "Poisson distribution.\n\n poisson(lam=1.0, size=None) -> random values\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_poisson(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_lam = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_olam;
+ double __pyx_v_flam;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"lam","size",0};
+ __pyx_v_lam = __pyx_k52;
+ __pyx_v_size = __pyx_k53;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "|OO", __pyx_argnames, &__pyx_v_lam, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_lam);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_olam = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1303 */
+ __pyx_v_flam = PyFloat_AsDouble(__pyx_v_lam);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1304 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1305 */
+ __pyx_2 = PyInt_FromLong(0); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1305; goto __pyx_L1;}
+ if (PyObject_Cmp(__pyx_v_lam, __pyx_2, &__pyx_1) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1305; goto __pyx_L1;}
+ __pyx_1 = __pyx_1 < 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1306 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1306; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1306; goto __pyx_L1;}
+ Py_INCREF(__pyx_k145p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k145p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1306; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1306; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1307 */
+ __pyx_2 = __pyx_f_6mtrand_discd_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_poisson,__pyx_v_size,__pyx_v_flam); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1307; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1309 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1311 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_lam,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1311; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_olam));
+ __pyx_v_olam = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1312 */
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1312; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_any); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1312; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1312; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_3, __pyx_n_less); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1312; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyInt_FromLong(0); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1312; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1312; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_olam));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_olam));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1312; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1312; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_2, __pyx_4); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1312; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1312; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1313 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1313; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1313; goto __pyx_L1;}
+ Py_INCREF(__pyx_k146p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k146p);
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1313; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1313; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1314 */
+ __pyx_5 = __pyx_f_6mtrand_discd_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_poisson,__pyx_v_size,__pyx_v_olam); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1314; goto __pyx_L1;}
+ __pyx_r = __pyx_5;
+ __pyx_5 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.poisson");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_olam);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_lam);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k147p;
+static PyObject *__pyx_k148p;
+
+static char (__pyx_k147[]) = "a <= 1.0";
+static char (__pyx_k148[]) = "a <= 1.0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_zipf(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_zipf[] = "Zipf distribution.\n \n zipf(a, size=None)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_zipf(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_a = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_oa;
+ double __pyx_v_fa;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"a","size",0};
+ __pyx_v_size = __pyx_k54;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O|O", __pyx_argnames, &__pyx_v_a, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_a);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_oa = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1324 */
+ __pyx_v_fa = PyFloat_AsDouble(__pyx_v_a);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1325 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1326 */
+ __pyx_1 = (__pyx_v_fa <= 1.0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1327 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1327; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1327; goto __pyx_L1;}
+ Py_INCREF(__pyx_k147p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k147p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1327; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1327; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1328 */
+ __pyx_2 = __pyx_f_6mtrand_discd_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_zipf,__pyx_v_size,__pyx_v_fa); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1328; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1330 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1332 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_a,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1332; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_oa));
+ __pyx_v_oa = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1333 */
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1333; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_any); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1333; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1333; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_3, __pyx_n_less_equal); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1333; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyFloat_FromDouble(1.0); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1333; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1333; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_oa));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_oa));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1333; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1333; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_2, __pyx_4); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1333; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1333; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1334 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1334; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1334; goto __pyx_L1;}
+ Py_INCREF(__pyx_k148p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k148p);
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1334; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1334; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1335 */
+ __pyx_5 = __pyx_f_6mtrand_discd_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_zipf,__pyx_v_size,__pyx_v_oa); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1335; goto __pyx_L1;}
+ __pyx_r = __pyx_5;
+ __pyx_5 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.zipf");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_oa);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_a);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k149p;
+static PyObject *__pyx_k150p;
+static PyObject *__pyx_k151p;
+static PyObject *__pyx_k152p;
+
+static char (__pyx_k149[]) = "p < 0.0";
+static char (__pyx_k150[]) = "p > 1.0";
+static char (__pyx_k151[]) = "p < 0.0";
+static char (__pyx_k152[]) = "p > 1.0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_geometric(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_geometric[] = "Geometric distribution with p being the probability of \"success\" on\n an individual trial.\n \n geometric(p, size=None)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_geometric(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_p = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_op;
+ double __pyx_v_fp;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"p","size",0};
+ __pyx_v_size = __pyx_k55;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O|O", __pyx_argnames, &__pyx_v_p, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_p);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_op = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1346 */
+ __pyx_v_fp = PyFloat_AsDouble(__pyx_v_p);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1347 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1348 */
+ __pyx_1 = (__pyx_v_fp < 0.0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1349 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1349; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1349; goto __pyx_L1;}
+ Py_INCREF(__pyx_k149p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k149p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1349; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1349; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1350 */
+ __pyx_1 = (__pyx_v_fp > 1.0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1351 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1351; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1351; goto __pyx_L1;}
+ Py_INCREF(__pyx_k150p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k150p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1351; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1351; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1352 */
+ __pyx_2 = __pyx_f_6mtrand_discd_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_geometric,__pyx_v_size,__pyx_v_fp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1352; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1354 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1357 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_p,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1357; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_op));
+ __pyx_v_op = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1358 */
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1358; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_any); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1358; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1358; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_3, __pyx_n_less); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1358; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyFloat_FromDouble(0.0); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1358; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1358; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_op));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_op));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1358; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1358; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_2, __pyx_4); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1358; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1358; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1359 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1359; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1359; goto __pyx_L1;}
+ Py_INCREF(__pyx_k151p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k151p);
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1359; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1359; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1360 */
+ __pyx_5 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1360; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_5, __pyx_n_any); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1360; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1360; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_2, __pyx_n_greater); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1360; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_5 = PyFloat_FromDouble(1.0); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1360; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(2); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1360; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_op));
+ PyTuple_SET_ITEM(__pyx_2, 0, ((PyObject *)__pyx_v_op));
+ PyTuple_SET_ITEM(__pyx_2, 1, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_4, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1360; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1360; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_3, __pyx_4); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1360; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_2); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1360; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1361 */
+ __pyx_5 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1361; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1361; goto __pyx_L1;}
+ Py_INCREF(__pyx_k152p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k152p);
+ __pyx_4 = PyObject_CallObject(__pyx_5, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1361; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1361; goto __pyx_L1;}
+ goto __pyx_L6;
+ }
+ __pyx_L6:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1362 */
+ __pyx_2 = __pyx_f_6mtrand_discd_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_geometric,__pyx_v_size,__pyx_v_op); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1362; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.geometric");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_op);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_p);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_n_add;
+
+static PyObject *__pyx_k153p;
+static PyObject *__pyx_k154p;
+static PyObject *__pyx_k155p;
+static PyObject *__pyx_k156p;
+static PyObject *__pyx_k157p;
+static PyObject *__pyx_k158p;
+static PyObject *__pyx_k159p;
+static PyObject *__pyx_k160p;
+
+static char (__pyx_k153[]) = "ngood < 1";
+static char (__pyx_k154[]) = "nbad < 1";
+static char (__pyx_k155[]) = "nsample < 1";
+static char (__pyx_k156[]) = "ngood + nbad < nsample";
+static char (__pyx_k157[]) = "ngood < 1";
+static char (__pyx_k158[]) = "nbad < 1";
+static char (__pyx_k159[]) = "nsample < 1";
+static char (__pyx_k160[]) = "ngood + nbad < nsample";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_hypergeometric(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_hypergeometric[] = "Hypergeometric distribution.\n \n Consider an urn with ngood \"good\" balls and nbad \"bad\" balls. If one \n were to draw nsample balls from the urn without replacement, then \n the hypergeometric distribution describes the distribution of \"good\" \n balls in the sample.\n \n hypergeometric(ngood, nbad, nsample, size=None) \n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_hypergeometric(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_ngood = 0;
+ PyObject *__pyx_v_nbad = 0;
+ PyObject *__pyx_v_nsample = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_ongood;
+ PyArrayObject *__pyx_v_onbad;
+ PyArrayObject *__pyx_v_onsample;
+ long __pyx_v_lngood;
+ long __pyx_v_lnbad;
+ long __pyx_v_lnsample;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ PyObject *__pyx_6 = 0;
+ static char *__pyx_argnames[] = {"ngood","nbad","nsample","size",0};
+ __pyx_v_size = __pyx_k56;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "OOO|O", __pyx_argnames, &__pyx_v_ngood, &__pyx_v_nbad, &__pyx_v_nsample, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_ngood);
+ Py_INCREF(__pyx_v_nbad);
+ Py_INCREF(__pyx_v_nsample);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_ongood = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_onbad = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_onsample = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1377 */
+ __pyx_v_lngood = PyInt_AsLong(__pyx_v_ngood);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1378 */
+ __pyx_v_lnbad = PyInt_AsLong(__pyx_v_nbad);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1379 */
+ __pyx_v_lnsample = PyInt_AsLong(__pyx_v_nsample);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1380 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1381 */
+ __pyx_2 = PyInt_FromLong(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1381; goto __pyx_L1;}
+ if (PyObject_Cmp(__pyx_v_ngood, __pyx_2, &__pyx_1) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1381; goto __pyx_L1;}
+ __pyx_1 = __pyx_1 < 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1382 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1382; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1382; goto __pyx_L1;}
+ Py_INCREF(__pyx_k153p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k153p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1382; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1382; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1383 */
+ __pyx_2 = PyInt_FromLong(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1383; goto __pyx_L1;}
+ if (PyObject_Cmp(__pyx_v_nbad, __pyx_2, &__pyx_1) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1383; goto __pyx_L1;}
+ __pyx_1 = __pyx_1 < 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1384 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1384; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1384; goto __pyx_L1;}
+ Py_INCREF(__pyx_k154p);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_k154p);
+ __pyx_2 = PyObject_CallObject(__pyx_3, __pyx_4); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1384; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1384; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1385 */
+ __pyx_3 = PyInt_FromLong(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1385; goto __pyx_L1;}
+ if (PyObject_Cmp(__pyx_v_nsample, __pyx_3, &__pyx_1) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1385; goto __pyx_L1;}
+ __pyx_1 = __pyx_1 < 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1386 */
+ __pyx_4 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1386; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1386; goto __pyx_L1;}
+ Py_INCREF(__pyx_k155p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k155p);
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1386; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_3, 0, 0);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1386; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1387 */
+ __pyx_4 = PyNumber_Add(__pyx_v_ngood, __pyx_v_nbad); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1387; goto __pyx_L1;}
+ if (PyObject_Cmp(__pyx_4, __pyx_v_nsample, &__pyx_1) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1387; goto __pyx_L1;}
+ __pyx_1 = __pyx_1 < 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1388 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1388; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1388; goto __pyx_L1;}
+ Py_INCREF(__pyx_k156p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k156p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1388; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1388; goto __pyx_L1;}
+ goto __pyx_L6;
+ }
+ __pyx_L6:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1389 */
+ __pyx_2 = __pyx_f_6mtrand_discnmN_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_hypergeometric,__pyx_v_size,__pyx_v_lngood,__pyx_v_lnbad,__pyx_v_lnsample); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1389; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1393 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1395 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_ngood,NPY_LONG,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1395; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_ongood));
+ __pyx_v_ongood = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1396 */
+ __pyx_4 = PyArray_FROM_OTF(__pyx_v_nbad,NPY_LONG,NPY_ALIGNED); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1396; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_4)));
+ Py_DECREF(((PyObject *)__pyx_v_onbad));
+ __pyx_v_onbad = ((PyArrayObject *)__pyx_4);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1397 */
+ __pyx_2 = PyArray_FROM_OTF(__pyx_v_nsample,NPY_LONG,NPY_ALIGNED); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1397; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_2)));
+ Py_DECREF(((PyObject *)__pyx_v_onsample));
+ __pyx_v_onsample = ((PyArrayObject *)__pyx_2);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1398 */
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1398; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_3, __pyx_n_any); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1398; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1398; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_less); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1398; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = PyInt_FromLong(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1398; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1398; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_ongood));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_ongood));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_2);
+ __pyx_2 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_3, __pyx_5); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1398; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1398; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_2);
+ __pyx_2 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_4, __pyx_3); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1398; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1398; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1399 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1399; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1399; goto __pyx_L1;}
+ Py_INCREF(__pyx_k157p);
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_k157p);
+ __pyx_3 = PyObject_CallObject(__pyx_2, __pyx_4); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1399; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __Pyx_Raise(__pyx_3, 0, 0);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1399; goto __pyx_L1;}
+ goto __pyx_L7;
+ }
+ __pyx_L7:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1400 */
+ __pyx_5 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1400; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_5, __pyx_n_any); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1400; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1400; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_4, __pyx_n_less); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1400; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_5 = PyInt_FromLong(1); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1400; goto __pyx_L1;}
+ __pyx_4 = PyTuple_New(2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1400; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_onbad));
+ PyTuple_SET_ITEM(__pyx_4, 0, ((PyObject *)__pyx_v_onbad));
+ PyTuple_SET_ITEM(__pyx_4, 1, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_4); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1400; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1400; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1400; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_4); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1400; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1401 */
+ __pyx_5 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1401; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1401; goto __pyx_L1;}
+ Py_INCREF(__pyx_k158p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k158p);
+ __pyx_3 = PyObject_CallObject(__pyx_5, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1401; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_3, 0, 0);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1401; goto __pyx_L1;}
+ goto __pyx_L8;
+ }
+ __pyx_L8:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1402 */
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1402; goto __pyx_L1;}
+ __pyx_5 = PyObject_GetAttr(__pyx_4, __pyx_n_any); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1402; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1402; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_less); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1402; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = PyInt_FromLong(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1402; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(2); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1402; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_onsample));
+ PyTuple_SET_ITEM(__pyx_2, 0, ((PyObject *)__pyx_v_onsample));
+ PyTuple_SET_ITEM(__pyx_2, 1, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1402; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1402; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_4);
+ __pyx_4 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_5, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1402; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_2); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1402; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1403 */
+ __pyx_4 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1403; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(1); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1403; goto __pyx_L1;}
+ Py_INCREF(__pyx_k159p);
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_k159p);
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1403; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __Pyx_Raise(__pyx_3, 0, 0);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1403; goto __pyx_L1;}
+ goto __pyx_L9;
+ }
+ __pyx_L9:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1404 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1404; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_2, __pyx_n_any); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1404; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_5 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1404; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_5, __pyx_n_less); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1404; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1404; goto __pyx_L1;}
+ __pyx_5 = PyObject_GetAttr(__pyx_2, __pyx_n_add); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1404; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = PyTuple_New(2); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1404; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_ongood));
+ PyTuple_SET_ITEM(__pyx_2, 0, ((PyObject *)__pyx_v_ongood));
+ Py_INCREF(((PyObject *)__pyx_v_onbad));
+ PyTuple_SET_ITEM(__pyx_2, 1, ((PyObject *)__pyx_v_onbad));
+ __pyx_6 = PyObject_CallObject(__pyx_5, __pyx_2); if (!__pyx_6) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1404; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1404; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_6);
+ Py_INCREF(((PyObject *)__pyx_v_onsample));
+ PyTuple_SET_ITEM(__pyx_5, 1, ((PyObject *)__pyx_v_onsample));
+ __pyx_6 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_3, __pyx_5); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1404; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_6 = PyTuple_New(1); if (!__pyx_6) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1404; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_6, 0, __pyx_2);
+ __pyx_2 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_6); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1404; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_6); __pyx_6 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_3); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1404; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1405 */
+ __pyx_5 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1405; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1405; goto __pyx_L1;}
+ Py_INCREF(__pyx_k160p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k160p);
+ __pyx_4 = PyObject_CallObject(__pyx_5, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1405; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1405; goto __pyx_L1;}
+ goto __pyx_L10;
+ }
+ __pyx_L10:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1406 */
+ __pyx_6 = __pyx_f_6mtrand_discnmN_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_hypergeometric,__pyx_v_size,__pyx_v_ongood,__pyx_v_onbad,__pyx_v_onsample); if (!__pyx_6) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1406; goto __pyx_L1;}
+ __pyx_r = __pyx_6;
+ __pyx_6 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ Py_XDECREF(__pyx_6);
+ __Pyx_AddTraceback("mtrand.RandomState.hypergeometric");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_ongood);
+ Py_DECREF(__pyx_v_onbad);
+ Py_DECREF(__pyx_v_onsample);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_ngood);
+ Py_DECREF(__pyx_v_nbad);
+ Py_DECREF(__pyx_v_nsample);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_k161p;
+static PyObject *__pyx_k162p;
+static PyObject *__pyx_k163p;
+static PyObject *__pyx_k164p;
+
+static char (__pyx_k161[]) = "p < 0.0";
+static char (__pyx_k162[]) = "p > 1.0";
+static char (__pyx_k163[]) = "p < 0.0";
+static char (__pyx_k164[]) = "p > 1.0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_logseries(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_logseries[] = "Logarithmic series distribution.\n \n logseries(p, size=None)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_logseries(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_p = 0;
+ PyObject *__pyx_v_size = 0;
+ PyArrayObject *__pyx_v_op;
+ double __pyx_v_fp;
+ PyObject *__pyx_r;
+ int __pyx_1;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"p","size",0};
+ __pyx_v_size = __pyx_k57;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O|O", __pyx_argnames, &__pyx_v_p, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_p);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_op = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1417 */
+ __pyx_v_fp = PyFloat_AsDouble(__pyx_v_p);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1418 */
+ __pyx_1 = (!PyErr_Occurred());
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1419 */
+ __pyx_1 = (__pyx_v_fp < 0.0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1420 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1420; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1420; goto __pyx_L1;}
+ Py_INCREF(__pyx_k161p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k161p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1420; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1420; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1421 */
+ __pyx_1 = (__pyx_v_fp > 1.0);
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1422 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1422; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1422; goto __pyx_L1;}
+ Py_INCREF(__pyx_k162p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k162p);
+ __pyx_4 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1422; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1422; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1423 */
+ __pyx_2 = __pyx_f_6mtrand_discd_array_sc(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_logseries,__pyx_v_size,__pyx_v_fp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1423; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1425 */
+ PyErr_Clear();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1427 */
+ __pyx_3 = PyArray_FROM_OTF(__pyx_v_p,NPY_DOUBLE,NPY_ALIGNED); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1427; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_3)));
+ Py_DECREF(((PyObject *)__pyx_v_op));
+ __pyx_v_op = ((PyArrayObject *)__pyx_3);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1428 */
+ __pyx_4 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1428; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_4, __pyx_n_any); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1428; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1428; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_3, __pyx_n_less); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1428; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyFloat_FromDouble(0.0); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1428; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1428; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_op));
+ PyTuple_SET_ITEM(__pyx_5, 0, ((PyObject *)__pyx_v_op));
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_4, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1428; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1428; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_2, __pyx_4); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1428; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_5); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1428; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1429 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1429; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1429; goto __pyx_L1;}
+ Py_INCREF(__pyx_k163p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k163p);
+ __pyx_4 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1429; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1429; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1430 */
+ __pyx_5 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1430; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_5, __pyx_n_any); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1430; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1430; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_2, __pyx_n_greater); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1430; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_5 = PyFloat_FromDouble(1.0); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1430; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(2); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1430; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)__pyx_v_op));
+ PyTuple_SET_ITEM(__pyx_2, 0, ((PyObject *)__pyx_v_op));
+ PyTuple_SET_ITEM(__pyx_2, 1, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_4, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1430; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = PyTuple_New(1); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1430; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_4, 0, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_3, __pyx_4); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1430; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ __pyx_1 = PyObject_IsTrue(__pyx_2); if (__pyx_1 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1430; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__pyx_1) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1431 */
+ __pyx_5 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1431; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1431; goto __pyx_L1;}
+ Py_INCREF(__pyx_k164p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k164p);
+ __pyx_4 = PyObject_CallObject(__pyx_5, __pyx_3); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1431; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_4, 0, 0);
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1431; goto __pyx_L1;}
+ goto __pyx_L6;
+ }
+ __pyx_L6:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1432 */
+ __pyx_2 = __pyx_f_6mtrand_discd_array(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,rk_logseries,__pyx_v_size,__pyx_v_op); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1432; goto __pyx_L1;}
+ __pyx_r = __pyx_2;
+ __pyx_2 = 0;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.logseries");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_op);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_p);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_n_array;
+static PyObject *__pyx_n_shape;
+static PyObject *__pyx_n_isinstance;
+static PyObject *__pyx_n_list;
+static PyObject *__pyx_n_append;
+static PyObject *__pyx_n_multiply;
+static PyObject *__pyx_n_reduce;
+static PyObject *__pyx_n_svd;
+static PyObject *__pyx_n_dot;
+static PyObject *__pyx_n_sqrt;
+static PyObject *__pyx_n_tuple;
+
+static PyObject *__pyx_k165p;
+static PyObject *__pyx_k166p;
+static PyObject *__pyx_k167p;
+static PyObject *__pyx_k168p;
+
+static char (__pyx_k165[]) = "mean must be 1 dimensional";
+static char (__pyx_k166[]) = "cov must be 2 dimensional and square";
+static char (__pyx_k167[]) = "mean and cov must have same length";
+static char (__pyx_k168[]) = "numpy.dual";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_multivariate_normal(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_multivariate_normal[] = "Return an array containing multivariate normally distributed random numbers\n with specified mean and covariance.\n\n multivariate_normal(mean, cov) -> random values\n multivariate_normal(mean, cov, [m, n, ...]) -> random values\n\n mean must be a 1 dimensional array. cov must be a square two dimensional\n array with the same number of rows and columns as mean has elements.\n\n The first form returns a single 1-D array containing a multivariate\n normal.\n\n The second form returns an array of shape (m, n, ..., cov.shape[0]).\n In this case, output[i,j,...,:] is a 1-D array containing a multivariate\n normal.\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_multivariate_normal(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_mean = 0;
+ PyObject *__pyx_v_cov = 0;
+ PyObject *__pyx_v_size = 0;
+ PyObject *__pyx_v_shape;
+ PyObject *__pyx_v_final_shape;
+ PyObject *__pyx_v_x;
+ PyObject *__pyx_v_svd;
+ PyObject *__pyx_v_u;
+ PyObject *__pyx_v_s;
+ PyObject *__pyx_v_v;
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ int __pyx_4;
+ PyObject *__pyx_5 = 0;
+ static char *__pyx_argnames[] = {"mean","cov","size",0};
+ __pyx_v_size = __pyx_k58;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "OO|O", __pyx_argnames, &__pyx_v_mean, &__pyx_v_cov, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_mean);
+ Py_INCREF(__pyx_v_cov);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_shape = Py_None; Py_INCREF(Py_None);
+ __pyx_v_final_shape = Py_None; Py_INCREF(Py_None);
+ __pyx_v_x = Py_None; Py_INCREF(Py_None);
+ __pyx_v_svd = Py_None; Py_INCREF(Py_None);
+ __pyx_v_u = Py_None; Py_INCREF(Py_None);
+ __pyx_v_s = Py_None; Py_INCREF(Py_None);
+ __pyx_v_v = Py_None; Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1453 */
+ __pyx_1 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1453; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_1, __pyx_n_array); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1453; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_1 = PyTuple_New(1); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1453; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_mean);
+ PyTuple_SET_ITEM(__pyx_1, 0, __pyx_v_mean);
+ __pyx_3 = PyObject_CallObject(__pyx_2, __pyx_1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1453; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_v_mean);
+ __pyx_v_mean = __pyx_3;
+ __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1454 */
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1454; goto __pyx_L1;}
+ __pyx_1 = PyObject_GetAttr(__pyx_2, __pyx_n_array); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1454; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1454; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_cov);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_v_cov);
+ __pyx_2 = PyObject_CallObject(__pyx_1, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1454; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_v_cov);
+ __pyx_v_cov = __pyx_2;
+ __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1455 */
+ __pyx_4 = __pyx_v_size == Py_None;
+ if (__pyx_4) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1456 */
+ __pyx_1 = PyList_New(0); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1456; goto __pyx_L1;}
+ Py_DECREF(__pyx_v_shape);
+ __pyx_v_shape = __pyx_1;
+ __pyx_1 = 0;
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1458 */
+ Py_INCREF(__pyx_v_size);
+ Py_DECREF(__pyx_v_shape);
+ __pyx_v_shape = __pyx_v_size;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1459 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_len); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1459; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_v_mean, __pyx_n_shape); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1459; goto __pyx_L1;}
+ __pyx_1 = PyTuple_New(1); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1459; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_1, 0, __pyx_2);
+ __pyx_2 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_3, __pyx_1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1459; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_3 = PyInt_FromLong(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1459; goto __pyx_L1;}
+ if (PyObject_Cmp(__pyx_2, __pyx_3, &__pyx_4) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1459; goto __pyx_L1;}
+ __pyx_4 = __pyx_4 != 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ if (__pyx_4) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1460 */
+ __pyx_1 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1460; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1460; goto __pyx_L1;}
+ Py_INCREF(__pyx_k165p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k165p);
+ __pyx_3 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1460; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_3, 0, 0);
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1460; goto __pyx_L1;}
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1461 */
+ __pyx_1 = __Pyx_GetName(__pyx_b, __pyx_n_len); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1461; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_v_cov, __pyx_n_shape); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1461; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1461; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_2);
+ __pyx_2 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_1, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1461; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_1 = PyInt_FromLong(2); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1461; goto __pyx_L1;}
+ if (PyObject_Cmp(__pyx_2, __pyx_1, &__pyx_4) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1461; goto __pyx_L1;}
+ __pyx_4 = __pyx_4 != 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ if (!__pyx_4) {
+ __pyx_3 = PyObject_GetAttr(__pyx_v_cov, __pyx_n_shape); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1461; goto __pyx_L1;}
+ __pyx_2 = PyInt_FromLong(0); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1461; goto __pyx_L1;}
+ __pyx_1 = PyObject_GetItem(__pyx_3, __pyx_2); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1461; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_3 = PyObject_GetAttr(__pyx_v_cov, __pyx_n_shape); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1461; goto __pyx_L1;}
+ __pyx_2 = PyInt_FromLong(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1461; goto __pyx_L1;}
+ __pyx_5 = PyObject_GetItem(__pyx_3, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1461; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (PyObject_Cmp(__pyx_1, __pyx_5, &__pyx_4) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1461; goto __pyx_L1;}
+ __pyx_4 = __pyx_4 != 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ }
+ if (__pyx_4) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1462 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1462; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1462; goto __pyx_L1;}
+ Py_INCREF(__pyx_k166p);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_k166p);
+ __pyx_1 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1462; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __Pyx_Raise(__pyx_1, 0, 0);
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1462; goto __pyx_L1;}
+ goto __pyx_L4;
+ }
+ __pyx_L4:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1463 */
+ __pyx_5 = PyObject_GetAttr(__pyx_v_mean, __pyx_n_shape); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1463; goto __pyx_L1;}
+ __pyx_3 = PyInt_FromLong(0); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1463; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetItem(__pyx_5, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1463; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_1 = PyObject_GetAttr(__pyx_v_cov, __pyx_n_shape); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1463; goto __pyx_L1;}
+ __pyx_5 = PyInt_FromLong(0); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1463; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetItem(__pyx_1, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1463; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ if (PyObject_Cmp(__pyx_2, __pyx_3, &__pyx_4) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1463; goto __pyx_L1;}
+ __pyx_4 = __pyx_4 != 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ if (__pyx_4) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1464 */
+ __pyx_1 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1464; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(1); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1464; goto __pyx_L1;}
+ Py_INCREF(__pyx_k167p);
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_k167p);
+ __pyx_2 = PyObject_CallObject(__pyx_1, __pyx_5); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1464; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __Pyx_Raise(__pyx_2, 0, 0);
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1464; goto __pyx_L1;}
+ goto __pyx_L5;
+ }
+ __pyx_L5:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1466 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_isinstance); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1466; goto __pyx_L1;}
+ __pyx_1 = __Pyx_GetName(__pyx_b, __pyx_n_int); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1466; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1466; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_shape);
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_v_shape);
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_1);
+ __pyx_1 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_3, __pyx_5); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1466; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_4 = PyObject_IsTrue(__pyx_2); if (__pyx_4 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1466; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ if (__pyx_4) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1467 */
+ __pyx_1 = PyList_New(1); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1467; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_shape);
+ PyList_SET_ITEM(__pyx_1, 0, __pyx_v_shape);
+ Py_DECREF(__pyx_v_shape);
+ __pyx_v_shape = __pyx_1;
+ __pyx_1 = 0;
+ goto __pyx_L6;
+ }
+ __pyx_L6:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1468 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_list); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1468; goto __pyx_L1;}
+ __pyx_5 = PySequence_GetSlice(__pyx_v_shape, 0, 0x7fffffff); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1468; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1468; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_5);
+ __pyx_5 = 0;
+ __pyx_1 = PyObject_CallObject(__pyx_3, __pyx_2); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1468; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_v_final_shape);
+ __pyx_v_final_shape = __pyx_1;
+ __pyx_1 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1469 */
+ __pyx_5 = PyObject_GetAttr(__pyx_v_final_shape, __pyx_n_append); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1469; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_v_mean, __pyx_n_shape); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1469; goto __pyx_L1;}
+ __pyx_2 = PyInt_FromLong(0); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1469; goto __pyx_L1;}
+ __pyx_1 = PyObject_GetItem(__pyx_3, __pyx_2); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1469; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1469; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_1);
+ __pyx_1 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_5, __pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1469; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1473 */
+ __pyx_1 = __Pyx_GetName(__pyx_m, __pyx_n_standard_normal); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1473; goto __pyx_L1;}
+ __pyx_5 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1473; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_5, __pyx_n_multiply); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1473; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = PyObject_GetAttr(__pyx_3, __pyx_n_reduce); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1473; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_5 = PyTuple_New(1); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1473; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_final_shape);
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_v_final_shape);
+ __pyx_3 = PyObject_CallObject(__pyx_2, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1473; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1473; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_5 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1473; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_v_x);
+ __pyx_v_x = __pyx_5;
+ __pyx_5 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1474 */
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1474; goto __pyx_L1;}
+ __pyx_1 = PyObject_GetAttr(__pyx_3, __pyx_n_multiply); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1474; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_2 = PyObject_GetAttr(__pyx_1, __pyx_n_reduce); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1474; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_5 = __Pyx_GetName(__pyx_b, __pyx_n_len); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1474; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1474; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_final_shape);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_v_final_shape);
+ __pyx_1 = PyObject_CallObject(__pyx_5, __pyx_3); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1474; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_5 = PyInt_FromLong(1); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1474; goto __pyx_L1;}
+ __pyx_3 = PyNumber_Subtract(__pyx_1, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1474; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_4 = PyInt_AsLong(__pyx_3); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1474; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_1 = PySequence_GetSlice(__pyx_v_final_shape, 0, __pyx_4); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1474; goto __pyx_L1;}
+ __pyx_5 = PyTuple_New(1); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1474; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_1);
+ __pyx_1 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_2, __pyx_5); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1474; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_1 = PyObject_GetAttr(__pyx_v_mean, __pyx_n_shape); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1475; goto __pyx_L1;}
+ __pyx_2 = PyInt_FromLong(0); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1475; goto __pyx_L1;}
+ __pyx_5 = PyObject_GetItem(__pyx_1, __pyx_2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1475; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyTuple_New(2); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1474; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_1, 0, __pyx_3);
+ PyTuple_SET_ITEM(__pyx_1, 1, __pyx_5);
+ __pyx_3 = 0;
+ __pyx_5 = 0;
+ if (PyObject_SetAttr(__pyx_v_x, __pyx_n_shape, __pyx_1) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1474; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1483 */
+ __pyx_2 = PyList_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1483; goto __pyx_L1;}
+ Py_INCREF(__pyx_n_svd);
+ PyList_SET_ITEM(__pyx_2, 0, __pyx_n_svd);
+ __pyx_3 = __Pyx_Import(__pyx_k168p, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1483; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_5 = PyObject_GetAttr(__pyx_3, __pyx_n_svd); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1483; goto __pyx_L1;}
+ Py_DECREF(__pyx_v_svd);
+ __pyx_v_svd = __pyx_5;
+ __pyx_5 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1485 */
+ __pyx_1 = PyTuple_New(1); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1485; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_cov);
+ PyTuple_SET_ITEM(__pyx_1, 0, __pyx_v_cov);
+ __pyx_2 = PyObject_CallObject(__pyx_v_svd, __pyx_1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1485; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_3 = PyObject_GetIter(__pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1485; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_5 = __Pyx_UnpackItem(__pyx_3); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1485; goto __pyx_L1;}
+ Py_DECREF(__pyx_v_u);
+ __pyx_v_u = __pyx_5;
+ __pyx_5 = 0;
+ __pyx_1 = __Pyx_UnpackItem(__pyx_3); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1485; goto __pyx_L1;}
+ Py_DECREF(__pyx_v_s);
+ __pyx_v_s = __pyx_1;
+ __pyx_1 = 0;
+ __pyx_2 = __Pyx_UnpackItem(__pyx_3); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1485; goto __pyx_L1;}
+ Py_DECREF(__pyx_v_v);
+ __pyx_v_v = __pyx_2;
+ __pyx_2 = 0;
+ if (__Pyx_EndUnpack(__pyx_3) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1485; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1486 */
+ __pyx_5 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1486; goto __pyx_L1;}
+ __pyx_1 = PyObject_GetAttr(__pyx_5, __pyx_n_dot); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1486; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_2 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1486; goto __pyx_L1;}
+ __pyx_3 = PyObject_GetAttr(__pyx_2, __pyx_n_sqrt); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1486; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_5 = PyTuple_New(1); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1486; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_s);
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_v_s);
+ __pyx_2 = PyObject_CallObject(__pyx_3, __pyx_5); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1486; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ __pyx_3 = PyNumber_Multiply(__pyx_v_x, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1486; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_5 = PyTuple_New(2); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1486; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_3);
+ Py_INCREF(__pyx_v_v);
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_v_v);
+ __pyx_3 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_1, __pyx_5); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1486; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_v_x);
+ __pyx_v_x = __pyx_2;
+ __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1489 */
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1489; goto __pyx_L1;}
+ __pyx_1 = PyObject_GetAttr(__pyx_3, __pyx_n_add); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1489; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_5 = PyTuple_New(3); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1489; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_mean);
+ PyTuple_SET_ITEM(__pyx_5, 0, __pyx_v_mean);
+ Py_INCREF(__pyx_v_x);
+ PyTuple_SET_ITEM(__pyx_5, 1, __pyx_v_x);
+ Py_INCREF(__pyx_v_x);
+ PyTuple_SET_ITEM(__pyx_5, 2, __pyx_v_x);
+ __pyx_2 = PyObject_CallObject(__pyx_1, __pyx_5); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1489; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1490 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_tuple); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1490; goto __pyx_L1;}
+ __pyx_1 = PyTuple_New(1); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1490; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_final_shape);
+ PyTuple_SET_ITEM(__pyx_1, 0, __pyx_v_final_shape);
+ __pyx_5 = PyObject_CallObject(__pyx_3, __pyx_1); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1490; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ if (PyObject_SetAttr(__pyx_v_x, __pyx_n_shape, __pyx_5) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1490; goto __pyx_L1;}
+ Py_DECREF(__pyx_5); __pyx_5 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1491 */
+ Py_INCREF(__pyx_v_x);
+ __pyx_r = __pyx_v_x;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_5);
+ __Pyx_AddTraceback("mtrand.RandomState.multivariate_normal");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_shape);
+ Py_DECREF(__pyx_v_final_shape);
+ Py_DECREF(__pyx_v_x);
+ Py_DECREF(__pyx_v_svd);
+ Py_DECREF(__pyx_v_u);
+ Py_DECREF(__pyx_v_s);
+ Py_DECREF(__pyx_v_v);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_mean);
+ Py_DECREF(__pyx_v_cov);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_n_zeros;
+
+static PyObject *__pyx_k170p;
+
+static char (__pyx_k170[]) = "sum(pvals) > 1.0";
+
+static PyObject *__pyx_f_6mtrand_11RandomState_multinomial(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_multinomial[] = "Multinomial distribution.\n \n multinomial(n, pvals, size=None) -> random values\n\n pvals is a sequence of probabilities that should sum to 1 (however, the\n last element is always assumed to account for the remaining probability\n as long as sum(pvals[:-1]) <= 1).\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_multinomial(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ long __pyx_v_n;
+ PyObject *__pyx_v_pvals = 0;
+ PyObject *__pyx_v_size = 0;
+ long __pyx_v_d;
+ PyArrayObject *arrayObject_parr;
+ PyArrayObject *arrayObject_mnarr;
+ double (*__pyx_v_pix);
+ long (*__pyx_v_mnix);
+ long __pyx_v_i;
+ long __pyx_v_j;
+ long __pyx_v_dn;
+ double __pyx_v_Sum;
+ PyObject *__pyx_v_shape;
+ PyObject *__pyx_v_multin;
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ long __pyx_4;
+ int __pyx_5;
+ static char *__pyx_argnames[] = {"n","pvals","size",0};
+ __pyx_v_size = __pyx_k59;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "lO|O", __pyx_argnames, &__pyx_v_n, &__pyx_v_pvals, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_pvals);
+ Py_INCREF(__pyx_v_size);
+ arrayObject_parr = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ arrayObject_mnarr = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_shape = Py_None; Py_INCREF(Py_None);
+ __pyx_v_multin = Py_None; Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1509 */
+ __pyx_1 = __Pyx_GetName(__pyx_b, __pyx_n_len); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1509; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1509; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_pvals);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_pvals);
+ __pyx_3 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1509; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = PyInt_AsLong(__pyx_3); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1509; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_v_d = __pyx_4;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1510 */
+ __pyx_1 = PyArray_ContiguousFromObject(__pyx_v_pvals,NPY_DOUBLE,1,1); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1510; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_1)));
+ Py_DECREF(((PyObject *)arrayObject_parr));
+ arrayObject_parr = ((PyArrayObject *)__pyx_1);
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1511 */
+ __pyx_v_pix = ((double (*))arrayObject_parr->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1513 */
+ __pyx_5 = (__pyx_f_6mtrand_kahan_sum(__pyx_v_pix,(__pyx_v_d - 1)) > 1.0);
+ if (__pyx_5) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1514 */
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_ValueError); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1514; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1514; goto __pyx_L1;}
+ Py_INCREF(__pyx_k170p);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_k170p);
+ __pyx_1 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1514; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __Pyx_Raise(__pyx_1, 0, 0);
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1514; goto __pyx_L1;}
+ goto __pyx_L2;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1516 */
+ __pyx_5 = __pyx_v_size == Py_None;
+ if (__pyx_5) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1517 */
+ __pyx_2 = PyInt_FromLong(__pyx_v_d); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1517; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1517; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_2);
+ __pyx_2 = 0;
+ Py_DECREF(__pyx_v_shape);
+ __pyx_v_shape = __pyx_3;
+ __pyx_3 = 0;
+ goto __pyx_L3;
+ }
+ __pyx_1 = __Pyx_GetName(__pyx_b, __pyx_n_type); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1518; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1518; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_size);
+ __pyx_3 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1518; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = __Pyx_GetName(__pyx_b, __pyx_n_int); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1518; goto __pyx_L1;}
+ __pyx_5 = __pyx_3 == __pyx_1;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ if (__pyx_5) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1519 */
+ __pyx_2 = PyInt_FromLong(__pyx_v_d); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1519; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1519; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_3, 1, __pyx_2);
+ __pyx_2 = 0;
+ Py_DECREF(__pyx_v_shape);
+ __pyx_v_shape = __pyx_3;
+ __pyx_3 = 0;
+ goto __pyx_L3;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1521 */
+ __pyx_1 = PyInt_FromLong(__pyx_v_d); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1521; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1521; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_1);
+ __pyx_1 = 0;
+ __pyx_3 = PyNumber_Add(__pyx_v_size, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1521; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_v_shape);
+ __pyx_v_shape = __pyx_3;
+ __pyx_3 = 0;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1523 */
+ __pyx_1 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1523; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_1, __pyx_n_zeros); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1523; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_int); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1523; goto __pyx_L1;}
+ __pyx_1 = PyTuple_New(2); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1523; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_shape);
+ PyTuple_SET_ITEM(__pyx_1, 0, __pyx_v_shape);
+ PyTuple_SET_ITEM(__pyx_1, 1, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_2, __pyx_1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1523; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_v_multin);
+ __pyx_v_multin = __pyx_3;
+ __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1524 */
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_v_multin)));
+ Py_DECREF(((PyObject *)arrayObject_mnarr));
+ arrayObject_mnarr = ((PyArrayObject *)__pyx_v_multin);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1525 */
+ __pyx_v_mnix = ((long (*))arrayObject_mnarr->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1526 */
+ __pyx_v_i = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1527 */
+ while (1) {
+ __pyx_5 = (__pyx_v_i < PyArray_SIZE(arrayObject_mnarr));
+ if (!__pyx_5) break;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1528 */
+ __pyx_v_Sum = 1.0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1529 */
+ __pyx_v_dn = __pyx_v_n;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1530 */
+ __pyx_4 = (__pyx_v_d - 1);
+ for (__pyx_v_j = 0; __pyx_v_j < __pyx_4; ++__pyx_v_j) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1531 */
+ (__pyx_v_mnix[(__pyx_v_i + __pyx_v_j)]) = rk_binomial(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,__pyx_v_dn,((__pyx_v_pix[__pyx_v_j]) / __pyx_v_Sum));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1532 */
+ __pyx_v_dn = (__pyx_v_dn - (__pyx_v_mnix[(__pyx_v_i + __pyx_v_j)]));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1533 */
+ __pyx_5 = (__pyx_v_dn <= 0);
+ if (__pyx_5) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1534 */
+ goto __pyx_L7;
+ goto __pyx_L8;
+ }
+ __pyx_L8:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1535 */
+ __pyx_v_Sum = (__pyx_v_Sum - (__pyx_v_pix[__pyx_v_j]));
+ }
+ __pyx_L7:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1536 */
+ __pyx_5 = (__pyx_v_dn > 0);
+ if (__pyx_5) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1537 */
+ (__pyx_v_mnix[((__pyx_v_i + __pyx_v_d) - 1)]) = __pyx_v_dn;
+ goto __pyx_L9;
+ }
+ __pyx_L9:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1539 */
+ __pyx_v_i = (__pyx_v_i + __pyx_v_d);
+ }
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1541 */
+ Py_INCREF(__pyx_v_multin);
+ __pyx_r = __pyx_v_multin;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ __Pyx_AddTraceback("mtrand.RandomState.multinomial");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(arrayObject_parr);
+ Py_DECREF(arrayObject_mnarr);
+ Py_DECREF(__pyx_v_shape);
+ Py_DECREF(__pyx_v_multin);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_pvals);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_f_6mtrand_11RandomState_dirichlet(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_dirichlet[] = "dirichlet(alpha, size=None)\n \n Draw `size` samples of dimension k from a Dirichlet distribution. A \n Dirichlet-distributed random variable can be seen as a multivariate \n generalization of a Beta distribution. Dirichlet pdf is the conjugate\n prior of a multinomial in Bayesian inference.\n \n :Parameters:\n alpha : array\n parameter of the distribution (k dimension\n for sample of dimension k).\n size : array\n number of samples to draw.\n\n $X \approx \\prod_{i=1}^{k}{x^{\alpha_i-1}_i}$\n \n Uses the following property for computation: for each dimension,\n draw a random sample y_i from a standard gamma generator of shape \n alpha_i, then X = \frac{1}{\\sum_{i=1}^k{y_i}} (y_1, ..., y_n) is \n Dirichlet distributed. \n \n Reference:\n - David Mc Kay : Information Theory, inference and Learning \n algorithms, chapter 23. the book is available for free at \n http://www.inference.phy.cam.ac.uk/mackay/\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_dirichlet(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_alpha = 0;
+ PyObject *__pyx_v_size = 0;
+ long __pyx_v_k;
+ long __pyx_v_totsize;
+ PyArrayObject *__pyx_v_alpha_arr;
+ PyArrayObject *__pyx_v_val_arr;
+ double (*__pyx_v_alpha_data);
+ double (*__pyx_v_val_data);
+ long __pyx_v_i;
+ long __pyx_v_j;
+ double __pyx_v_acc;
+ double __pyx_v_invacc;
+ PyObject *__pyx_v_shape;
+ PyObject *__pyx_v_diric;
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ long __pyx_4;
+ int __pyx_5;
+ static char *__pyx_argnames[] = {"alpha","size",0};
+ __pyx_v_size = __pyx_k60;
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O|O", __pyx_argnames, &__pyx_v_alpha, &__pyx_v_size)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_alpha);
+ Py_INCREF(__pyx_v_size);
+ __pyx_v_alpha_arr = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_val_arr = ((PyArrayObject *)Py_None); Py_INCREF(Py_None);
+ __pyx_v_shape = Py_None; Py_INCREF(Py_None);
+ __pyx_v_diric = Py_None; Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1598 */
+ __pyx_1 = __Pyx_GetName(__pyx_b, __pyx_n_len); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1598; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1598; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_alpha);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_alpha);
+ __pyx_3 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1598; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_4 = PyInt_AsLong(__pyx_3); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1598; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_v_k = __pyx_4;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1599 */
+ __pyx_1 = PyArray_ContiguousFromObject(__pyx_v_alpha,NPY_DOUBLE,1,1); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1599; goto __pyx_L1;}
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_1)));
+ Py_DECREF(((PyObject *)__pyx_v_alpha_arr));
+ __pyx_v_alpha_arr = ((PyArrayObject *)__pyx_1);
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1600 */
+ __pyx_v_alpha_data = ((double (*))__pyx_v_alpha_arr->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1602 */
+ __pyx_5 = __pyx_v_size == Py_None;
+ if (__pyx_5) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1603 */
+ __pyx_2 = PyInt_FromLong(__pyx_v_k); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1603; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(1); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1603; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_2);
+ __pyx_2 = 0;
+ Py_DECREF(__pyx_v_shape);
+ __pyx_v_shape = __pyx_3;
+ __pyx_3 = 0;
+ goto __pyx_L2;
+ }
+ __pyx_1 = __Pyx_GetName(__pyx_b, __pyx_n_type); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1604; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1604; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_size);
+ __pyx_3 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1604; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = __Pyx_GetName(__pyx_b, __pyx_n_int); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1604; goto __pyx_L1;}
+ __pyx_5 = __pyx_3 == __pyx_1;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ if (__pyx_5) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1605 */
+ __pyx_2 = PyInt_FromLong(__pyx_v_k); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1605; goto __pyx_L1;}
+ __pyx_3 = PyTuple_New(2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1605; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_v_size);
+ PyTuple_SET_ITEM(__pyx_3, 1, __pyx_2);
+ __pyx_2 = 0;
+ Py_DECREF(__pyx_v_shape);
+ __pyx_v_shape = __pyx_3;
+ __pyx_3 = 0;
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1607 */
+ __pyx_1 = PyInt_FromLong(__pyx_v_k); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1607; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1607; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_1);
+ __pyx_1 = 0;
+ __pyx_3 = PyNumber_Add(__pyx_v_size, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1607; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_v_shape);
+ __pyx_v_shape = __pyx_3;
+ __pyx_3 = 0;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1609 */
+ __pyx_1 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1609; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetAttr(__pyx_1, __pyx_n_zeros); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1609; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1609; goto __pyx_L1;}
+ __pyx_1 = PyObject_GetAttr(__pyx_3, __pyx_n_float64); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1609; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyTuple_New(2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1609; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_shape);
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_v_shape);
+ PyTuple_SET_ITEM(__pyx_3, 1, __pyx_1);
+ __pyx_1 = 0;
+ __pyx_1 = PyObject_CallObject(__pyx_2, __pyx_3); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1609; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_v_diric);
+ __pyx_v_diric = __pyx_1;
+ __pyx_1 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1610 */
+ Py_INCREF(((PyObject *)((PyArrayObject *)__pyx_v_diric)));
+ Py_DECREF(((PyObject *)__pyx_v_val_arr));
+ __pyx_v_val_arr = ((PyArrayObject *)__pyx_v_diric);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1611 */
+ __pyx_v_val_data = ((double (*))__pyx_v_val_arr->data);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1613 */
+ __pyx_v_i = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1614 */
+ __pyx_v_totsize = PyArray_SIZE(__pyx_v_val_arr);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1615 */
+ while (1) {
+ __pyx_5 = (__pyx_v_i < __pyx_v_totsize);
+ if (!__pyx_5) break;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1616 */
+ __pyx_v_acc = 0.0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1617 */
+ for (__pyx_v_j = 0; __pyx_v_j < __pyx_v_k; ++__pyx_v_j) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1618 */
+ (__pyx_v_val_data[(__pyx_v_i + __pyx_v_j)]) = rk_standard_gamma(((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state,(__pyx_v_alpha_data[__pyx_v_j]));
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1619 */
+ __pyx_v_acc = (__pyx_v_acc + (__pyx_v_val_data[(__pyx_v_i + __pyx_v_j)]));
+ }
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1620 */
+ __pyx_v_invacc = (1 / __pyx_v_acc);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1621 */
+ for (__pyx_v_j = 0; __pyx_v_j < __pyx_v_k; ++__pyx_v_j) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1622 */
+ (__pyx_v_val_data[(__pyx_v_i + __pyx_v_j)]) = ((__pyx_v_val_data[(__pyx_v_i + __pyx_v_j)]) * __pyx_v_invacc);
+ }
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1623 */
+ __pyx_v_i = (__pyx_v_i + __pyx_v_k);
+ }
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1625 */
+ Py_INCREF(__pyx_v_diric);
+ __pyx_r = __pyx_v_diric;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ __Pyx_AddTraceback("mtrand.RandomState.dirichlet");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_alpha_arr);
+ Py_DECREF(__pyx_v_val_arr);
+ Py_DECREF(__pyx_v_shape);
+ Py_DECREF(__pyx_v_diric);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_alpha);
+ Py_DECREF(__pyx_v_size);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_n_hasattr;
+static PyObject *__pyx_n_copy;
+
+
+static PyObject *__pyx_f_6mtrand_11RandomState_shuffle(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_shuffle[] = "Modify a sequence in-place by shuffling its contents.\n \n shuffle(x)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_shuffle(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_x = 0;
+ long __pyx_v_i;
+ long __pyx_v_j;
+ int __pyx_v_copy;
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ long __pyx_4;
+ int __pyx_5;
+ static char *__pyx_argnames[] = {"x",0};
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O", __pyx_argnames, &__pyx_v_x)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_x);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1636 */
+ __pyx_1 = __Pyx_GetName(__pyx_b, __pyx_n_len); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1636; goto __pyx_L1;}
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1636; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_x);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_x);
+ __pyx_3 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1636; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyInt_FromLong(1); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1636; goto __pyx_L1;}
+ __pyx_2 = PyNumber_Subtract(__pyx_3, __pyx_1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1636; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_4 = PyInt_AsLong(__pyx_2); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1636; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_v_i = __pyx_4;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1637 */
+ /*try:*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1638 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_len); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1638; goto __pyx_L2;}
+ __pyx_1 = PyInt_FromLong(0); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1638; goto __pyx_L2;}
+ __pyx_2 = PyObject_GetItem(__pyx_v_x, __pyx_1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1638; goto __pyx_L2;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_1 = PyTuple_New(1); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1638; goto __pyx_L2;}
+ PyTuple_SET_ITEM(__pyx_1, 0, __pyx_2);
+ __pyx_2 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_3, __pyx_1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1638; goto __pyx_L2;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_4 = PyInt_AsLong(__pyx_2); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1638; goto __pyx_L2;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_v_j = __pyx_4;
+ }
+ goto __pyx_L3;
+ __pyx_L2:;
+ Py_XDECREF(__pyx_3); __pyx_3 = 0;
+ Py_XDECREF(__pyx_1); __pyx_1 = 0;
+ Py_XDECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1639 */
+ /*except:*/ {
+ __Pyx_AddTraceback("mtrand.shuffle");
+ __pyx_3 = __Pyx_GetExcValue(); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1639; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1640 */
+ __pyx_v_j = 0;
+ goto __pyx_L3;
+ }
+ __pyx_L3:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1642 */
+ __pyx_5 = (__pyx_v_j == 0);
+ if (__pyx_5) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1644 */
+ while (1) {
+ __pyx_5 = (__pyx_v_i > 0);
+ if (!__pyx_5) break;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1645 */
+ __pyx_v_j = rk_interval(__pyx_v_i,((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1646 */
+ __pyx_1 = PyInt_FromLong(__pyx_v_j); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1646; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetItem(__pyx_v_x, __pyx_1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1646; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_3 = PyInt_FromLong(__pyx_v_i); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1646; goto __pyx_L1;}
+ __pyx_1 = PyObject_GetItem(__pyx_v_x, __pyx_3); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1646; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyInt_FromLong(__pyx_v_i); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1646; goto __pyx_L1;}
+ if (PyObject_SetItem(__pyx_v_x, __pyx_3, __pyx_2) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1646; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = PyInt_FromLong(__pyx_v_j); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1646; goto __pyx_L1;}
+ if (PyObject_SetItem(__pyx_v_x, __pyx_2, __pyx_1) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1646; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1647 */
+ __pyx_v_i = (__pyx_v_i - 1);
+ }
+ goto __pyx_L4;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1650 */
+ __pyx_3 = __Pyx_GetName(__pyx_b, __pyx_n_hasattr); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1650; goto __pyx_L1;}
+ __pyx_1 = PyInt_FromLong(0); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1650; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetItem(__pyx_v_x, __pyx_1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1650; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_1 = PyTuple_New(2); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1650; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_1, 0, __pyx_2);
+ Py_INCREF(__pyx_n_copy);
+ PyTuple_SET_ITEM(__pyx_1, 1, __pyx_n_copy);
+ __pyx_2 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_3, __pyx_1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1650; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_5 = PyInt_AsLong(__pyx_2); if (PyErr_Occurred()) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1650; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_v_copy = __pyx_5;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1651 */
+ __pyx_5 = __pyx_v_copy;
+ if (__pyx_5) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1652 */
+ while (1) {
+ __pyx_5 = (__pyx_v_i > 0);
+ if (!__pyx_5) break;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1653 */
+ __pyx_v_j = rk_interval(__pyx_v_i,((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1654 */
+ __pyx_3 = PyInt_FromLong(__pyx_v_j); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1654; goto __pyx_L1;}
+ __pyx_1 = PyObject_GetItem(__pyx_v_x, __pyx_3); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1654; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_2 = PyObject_GetAttr(__pyx_1, __pyx_n_copy); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1654; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_3 = PyObject_CallObject(__pyx_2, 0); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1654; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyInt_FromLong(__pyx_v_i); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1654; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetItem(__pyx_v_x, __pyx_1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1654; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_1 = PyObject_GetAttr(__pyx_2, __pyx_n_copy); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1654; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = PyObject_CallObject(__pyx_1, 0); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1654; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_1 = PyInt_FromLong(__pyx_v_i); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1654; goto __pyx_L1;}
+ if (PyObject_SetItem(__pyx_v_x, __pyx_1, __pyx_3) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1654; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyInt_FromLong(__pyx_v_j); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1654; goto __pyx_L1;}
+ if (PyObject_SetItem(__pyx_v_x, __pyx_3, __pyx_2) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1654; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1655 */
+ __pyx_v_i = (__pyx_v_i - 1);
+ }
+ goto __pyx_L7;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1657 */
+ while (1) {
+ __pyx_5 = (__pyx_v_i > 0);
+ if (!__pyx_5) break;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1658 */
+ __pyx_v_j = rk_interval(__pyx_v_i,((struct __pyx_obj_6mtrand_RandomState *)__pyx_v_self)->internal_state);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1659 */
+ __pyx_1 = PyInt_FromLong(__pyx_v_j); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1659; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetItem(__pyx_v_x, __pyx_1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1659; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_3 = PySequence_GetSlice(__pyx_2, 0, 0x7fffffff); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1659; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_1 = PyInt_FromLong(__pyx_v_i); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1659; goto __pyx_L1;}
+ __pyx_2 = PyObject_GetItem(__pyx_v_x, __pyx_1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1659; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ __pyx_1 = PySequence_GetSlice(__pyx_2, 0, 0x7fffffff); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1659; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_2 = PyInt_FromLong(__pyx_v_i); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1659; goto __pyx_L1;}
+ if (PyObject_SetItem(__pyx_v_x, __pyx_2, __pyx_3) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1659; goto __pyx_L1;}
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyInt_FromLong(__pyx_v_j); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1659; goto __pyx_L1;}
+ if (PyObject_SetItem(__pyx_v_x, __pyx_3, __pyx_1) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1659; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1660 */
+ __pyx_v_i = (__pyx_v_i - 1);
+ }
+ }
+ __pyx_L7:;
+ }
+ __pyx_L4:;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ __Pyx_AddTraceback("mtrand.RandomState.shuffle");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_x);
+ return __pyx_r;
+}
+
+static PyObject *__pyx_n_integer;
+static PyObject *__pyx_n_arange;
+
+static PyObject *__pyx_f_6mtrand_11RandomState_permutation(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds); /*proto*/
+static char __pyx_doc_6mtrand_11RandomState_permutation[] = "Given an integer, return a shuffled sequence of integers >= 0 and \n < x; given a sequence, return a shuffled array copy.\n\n permutation(x)\n ";
+static PyObject *__pyx_f_6mtrand_11RandomState_permutation(PyObject *__pyx_v_self, PyObject *__pyx_args, PyObject *__pyx_kwds) {
+ PyObject *__pyx_v_x = 0;
+ PyObject *__pyx_v_arr;
+ PyObject *__pyx_r;
+ PyObject *__pyx_1 = 0;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ int __pyx_5;
+ static char *__pyx_argnames[] = {"x",0};
+ if (!PyArg_ParseTupleAndKeywords(__pyx_args, __pyx_kwds, "O", __pyx_argnames, &__pyx_v_x)) return 0;
+ Py_INCREF(__pyx_v_self);
+ Py_INCREF(__pyx_v_x);
+ __pyx_v_arr = Py_None; Py_INCREF(Py_None);
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1668 */
+ __pyx_1 = __Pyx_GetName(__pyx_b, __pyx_n_isinstance); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1668; goto __pyx_L1;}
+ __pyx_2 = __Pyx_GetName(__pyx_b, __pyx_n_int); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1668; goto __pyx_L1;}
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1668; goto __pyx_L1;}
+ __pyx_4 = PyObject_GetAttr(__pyx_3, __pyx_n_integer); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1668; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_3 = PyTuple_New(2); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1668; goto __pyx_L1;}
+ PyTuple_SET_ITEM(__pyx_3, 0, __pyx_2);
+ PyTuple_SET_ITEM(__pyx_3, 1, __pyx_4);
+ __pyx_2 = 0;
+ __pyx_4 = 0;
+ __pyx_2 = PyTuple_New(2); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1668; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_x);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_x);
+ PyTuple_SET_ITEM(__pyx_2, 1, __pyx_3);
+ __pyx_3 = 0;
+ __pyx_4 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1668; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ __pyx_5 = PyObject_IsTrue(__pyx_4); if (__pyx_5 < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1668; goto __pyx_L1;}
+ Py_DECREF(__pyx_4); __pyx_4 = 0;
+ if (__pyx_5) {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1669 */
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1669; goto __pyx_L1;}
+ __pyx_1 = PyObject_GetAttr(__pyx_3, __pyx_n_arange); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1669; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1669; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_x);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_x);
+ __pyx_4 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1669; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_v_arr);
+ __pyx_v_arr = __pyx_4;
+ __pyx_4 = 0;
+ goto __pyx_L2;
+ }
+ /*else*/ {
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1671 */
+ __pyx_3 = __Pyx_GetName(__pyx_m, __pyx_n__sp); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1671; goto __pyx_L1;}
+ __pyx_1 = PyObject_GetAttr(__pyx_3, __pyx_n_array); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1671; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ __pyx_2 = PyTuple_New(1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1671; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_x);
+ PyTuple_SET_ITEM(__pyx_2, 0, __pyx_v_x);
+ __pyx_4 = PyObject_CallObject(__pyx_1, __pyx_2); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1671; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+ Py_DECREF(__pyx_v_arr);
+ __pyx_v_arr = __pyx_4;
+ __pyx_4 = 0;
+ }
+ __pyx_L2:;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1672 */
+ __pyx_3 = PyObject_GetAttr(__pyx_v_self, __pyx_n_shuffle); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1672; goto __pyx_L1;}
+ __pyx_1 = PyTuple_New(1); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1672; goto __pyx_L1;}
+ Py_INCREF(__pyx_v_arr);
+ PyTuple_SET_ITEM(__pyx_1, 0, __pyx_v_arr);
+ __pyx_2 = PyObject_CallObject(__pyx_3, __pyx_1); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1672; goto __pyx_L1;}
+ Py_DECREF(__pyx_3); __pyx_3 = 0;
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+ Py_DECREF(__pyx_2); __pyx_2 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1673 */
+ Py_INCREF(__pyx_v_arr);
+ __pyx_r = __pyx_v_arr;
+ goto __pyx_L0;
+
+ __pyx_r = Py_None; Py_INCREF(Py_None);
+ goto __pyx_L0;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ __Pyx_AddTraceback("mtrand.RandomState.permutation");
+ __pyx_r = 0;
+ __pyx_L0:;
+ Py_DECREF(__pyx_v_arr);
+ Py_DECREF(__pyx_v_self);
+ Py_DECREF(__pyx_v_x);
+ return __pyx_r;
+}
+
+static __Pyx_InternTabEntry __pyx_intern_tab[] = {
+ {&__pyx_n_MT19937, "MT19937"},
+ {&__pyx_n_TypeError, "TypeError"},
+ {&__pyx_n_ValueError, "ValueError"},
+ {&__pyx_n___RandomState_ctor, "__RandomState_ctor"},
+ {&__pyx_n__rand, "_rand"},
+ {&__pyx_n__sp, "_sp"},
+ {&__pyx_n_add, "add"},
+ {&__pyx_n_any, "any"},
+ {&__pyx_n_append, "append"},
+ {&__pyx_n_arange, "arange"},
+ {&__pyx_n_array, "array"},
+ {&__pyx_n_asarray, "asarray"},
+ {&__pyx_n_beta, "beta"},
+ {&__pyx_n_binomial, "binomial"},
+ {&__pyx_n_bytes, "bytes"},
+ {&__pyx_n_chisquare, "chisquare"},
+ {&__pyx_n_copy, "copy"},
+ {&__pyx_n_dirichlet, "dirichlet"},
+ {&__pyx_n_dot, "dot"},
+ {&__pyx_n_empty, "empty"},
+ {&__pyx_n_equal, "equal"},
+ {&__pyx_n_exponential, "exponential"},
+ {&__pyx_n_f, "f"},
+ {&__pyx_n_float64, "float64"},
+ {&__pyx_n_gamma, "gamma"},
+ {&__pyx_n_geometric, "geometric"},
+ {&__pyx_n_get_state, "get_state"},
+ {&__pyx_n_greater, "greater"},
+ {&__pyx_n_gumbel, "gumbel"},
+ {&__pyx_n_hasattr, "hasattr"},
+ {&__pyx_n_hypergeometric, "hypergeometric"},
+ {&__pyx_n_int, "int"},
+ {&__pyx_n_integer, "integer"},
+ {&__pyx_n_isinstance, "isinstance"},
+ {&__pyx_n_laplace, "laplace"},
+ {&__pyx_n_len, "len"},
+ {&__pyx_n_less, "less"},
+ {&__pyx_n_less_equal, "less_equal"},
+ {&__pyx_n_list, "list"},
+ {&__pyx_n_logistic, "logistic"},
+ {&__pyx_n_lognormal, "lognormal"},
+ {&__pyx_n_logseries, "logseries"},
+ {&__pyx_n_multinomial, "multinomial"},
+ {&__pyx_n_multiply, "multiply"},
+ {&__pyx_n_multivariate_normal, "multivariate_normal"},
+ {&__pyx_n_negative_binomial, "negative_binomial"},
+ {&__pyx_n_noncentral_chisquare, "noncentral_chisquare"},
+ {&__pyx_n_noncentral_f, "noncentral_f"},
+ {&__pyx_n_normal, "normal"},
+ {&__pyx_n_numpy, "numpy"},
+ {&__pyx_n_pareto, "pareto"},
+ {&__pyx_n_permutation, "permutation"},
+ {&__pyx_n_poisson, "poisson"},
+ {&__pyx_n_power, "power"},
+ {&__pyx_n_rand, "rand"},
+ {&__pyx_n_randint, "randint"},
+ {&__pyx_n_randn, "randn"},
+ {&__pyx_n_random, "random"},
+ {&__pyx_n_random_integers, "random_integers"},
+ {&__pyx_n_random_sample, "random_sample"},
+ {&__pyx_n_rayleigh, "rayleigh"},
+ {&__pyx_n_reduce, "reduce"},
+ {&__pyx_n_seed, "seed"},
+ {&__pyx_n_set_state, "set_state"},
+ {&__pyx_n_shape, "shape"},
+ {&__pyx_n_shuffle, "shuffle"},
+ {&__pyx_n_size, "size"},
+ {&__pyx_n_sqrt, "sqrt"},
+ {&__pyx_n_standard_cauchy, "standard_cauchy"},
+ {&__pyx_n_standard_exponential, "standard_exponential"},
+ {&__pyx_n_standard_gamma, "standard_gamma"},
+ {&__pyx_n_standard_normal, "standard_normal"},
+ {&__pyx_n_standard_t, "standard_t"},
+ {&__pyx_n_subtract, "subtract"},
+ {&__pyx_n_svd, "svd"},
+ {&__pyx_n_triangular, "triangular"},
+ {&__pyx_n_tuple, "tuple"},
+ {&__pyx_n_type, "type"},
+ {&__pyx_n_uint, "uint"},
+ {&__pyx_n_uint32, "uint32"},
+ {&__pyx_n_uniform, "uniform"},
+ {&__pyx_n_vonmises, "vonmises"},
+ {&__pyx_n_wald, "wald"},
+ {&__pyx_n_weibull, "weibull"},
+ {&__pyx_n_zeros, "zeros"},
+ {&__pyx_n_zipf, "zipf"},
+ {0, 0}
+};
+
+static __Pyx_StringTabEntry __pyx_string_tab[] = {
+ {&__pyx_k61p, __pyx_k61, sizeof(__pyx_k61)},
+ {&__pyx_k62p, __pyx_k62, sizeof(__pyx_k62)},
+ {&__pyx_k63p, __pyx_k63, sizeof(__pyx_k63)},
+ {&__pyx_k64p, __pyx_k64, sizeof(__pyx_k64)},
+ {&__pyx_k65p, __pyx_k65, sizeof(__pyx_k65)},
+ {&__pyx_k66p, __pyx_k66, sizeof(__pyx_k66)},
+ {&__pyx_k69p, __pyx_k69, sizeof(__pyx_k69)},
+ {&__pyx_k70p, __pyx_k70, sizeof(__pyx_k70)},
+ {&__pyx_k71p, __pyx_k71, sizeof(__pyx_k71)},
+ {&__pyx_k73p, __pyx_k73, sizeof(__pyx_k73)},
+ {&__pyx_k74p, __pyx_k74, sizeof(__pyx_k74)},
+ {&__pyx_k75p, __pyx_k75, sizeof(__pyx_k75)},
+ {&__pyx_k76p, __pyx_k76, sizeof(__pyx_k76)},
+ {&__pyx_k77p, __pyx_k77, sizeof(__pyx_k77)},
+ {&__pyx_k78p, __pyx_k78, sizeof(__pyx_k78)},
+ {&__pyx_k79p, __pyx_k79, sizeof(__pyx_k79)},
+ {&__pyx_k80p, __pyx_k80, sizeof(__pyx_k80)},
+ {&__pyx_k81p, __pyx_k81, sizeof(__pyx_k81)},
+ {&__pyx_k82p, __pyx_k82, sizeof(__pyx_k82)},
+ {&__pyx_k83p, __pyx_k83, sizeof(__pyx_k83)},
+ {&__pyx_k84p, __pyx_k84, sizeof(__pyx_k84)},
+ {&__pyx_k85p, __pyx_k85, sizeof(__pyx_k85)},
+ {&__pyx_k86p, __pyx_k86, sizeof(__pyx_k86)},
+ {&__pyx_k87p, __pyx_k87, sizeof(__pyx_k87)},
+ {&__pyx_k88p, __pyx_k88, sizeof(__pyx_k88)},
+ {&__pyx_k89p, __pyx_k89, sizeof(__pyx_k89)},
+ {&__pyx_k90p, __pyx_k90, sizeof(__pyx_k90)},
+ {&__pyx_k91p, __pyx_k91, sizeof(__pyx_k91)},
+ {&__pyx_k92p, __pyx_k92, sizeof(__pyx_k92)},
+ {&__pyx_k93p, __pyx_k93, sizeof(__pyx_k93)},
+ {&__pyx_k94p, __pyx_k94, sizeof(__pyx_k94)},
+ {&__pyx_k95p, __pyx_k95, sizeof(__pyx_k95)},
+ {&__pyx_k96p, __pyx_k96, sizeof(__pyx_k96)},
+ {&__pyx_k97p, __pyx_k97, sizeof(__pyx_k97)},
+ {&__pyx_k98p, __pyx_k98, sizeof(__pyx_k98)},
+ {&__pyx_k99p, __pyx_k99, sizeof(__pyx_k99)},
+ {&__pyx_k100p, __pyx_k100, sizeof(__pyx_k100)},
+ {&__pyx_k101p, __pyx_k101, sizeof(__pyx_k101)},
+ {&__pyx_k102p, __pyx_k102, sizeof(__pyx_k102)},
+ {&__pyx_k103p, __pyx_k103, sizeof(__pyx_k103)},
+ {&__pyx_k104p, __pyx_k104, sizeof(__pyx_k104)},
+ {&__pyx_k105p, __pyx_k105, sizeof(__pyx_k105)},
+ {&__pyx_k106p, __pyx_k106, sizeof(__pyx_k106)},
+ {&__pyx_k107p, __pyx_k107, sizeof(__pyx_k107)},
+ {&__pyx_k108p, __pyx_k108, sizeof(__pyx_k108)},
+ {&__pyx_k109p, __pyx_k109, sizeof(__pyx_k109)},
+ {&__pyx_k110p, __pyx_k110, sizeof(__pyx_k110)},
+ {&__pyx_k111p, __pyx_k111, sizeof(__pyx_k111)},
+ {&__pyx_k112p, __pyx_k112, sizeof(__pyx_k112)},
+ {&__pyx_k113p, __pyx_k113, sizeof(__pyx_k113)},
+ {&__pyx_k114p, __pyx_k114, sizeof(__pyx_k114)},
+ {&__pyx_k115p, __pyx_k115, sizeof(__pyx_k115)},
+ {&__pyx_k116p, __pyx_k116, sizeof(__pyx_k116)},
+ {&__pyx_k117p, __pyx_k117, sizeof(__pyx_k117)},
+ {&__pyx_k118p, __pyx_k118, sizeof(__pyx_k118)},
+ {&__pyx_k119p, __pyx_k119, sizeof(__pyx_k119)},
+ {&__pyx_k120p, __pyx_k120, sizeof(__pyx_k120)},
+ {&__pyx_k121p, __pyx_k121, sizeof(__pyx_k121)},
+ {&__pyx_k122p, __pyx_k122, sizeof(__pyx_k122)},
+ {&__pyx_k123p, __pyx_k123, sizeof(__pyx_k123)},
+ {&__pyx_k124p, __pyx_k124, sizeof(__pyx_k124)},
+ {&__pyx_k125p, __pyx_k125, sizeof(__pyx_k125)},
+ {&__pyx_k126p, __pyx_k126, sizeof(__pyx_k126)},
+ {&__pyx_k127p, __pyx_k127, sizeof(__pyx_k127)},
+ {&__pyx_k128p, __pyx_k128, sizeof(__pyx_k128)},
+ {&__pyx_k129p, __pyx_k129, sizeof(__pyx_k129)},
+ {&__pyx_k130p, __pyx_k130, sizeof(__pyx_k130)},
+ {&__pyx_k131p, __pyx_k131, sizeof(__pyx_k131)},
+ {&__pyx_k132p, __pyx_k132, sizeof(__pyx_k132)},
+ {&__pyx_k133p, __pyx_k133, sizeof(__pyx_k133)},
+ {&__pyx_k134p, __pyx_k134, sizeof(__pyx_k134)},
+ {&__pyx_k135p, __pyx_k135, sizeof(__pyx_k135)},
+ {&__pyx_k136p, __pyx_k136, sizeof(__pyx_k136)},
+ {&__pyx_k137p, __pyx_k137, sizeof(__pyx_k137)},
+ {&__pyx_k138p, __pyx_k138, sizeof(__pyx_k138)},
+ {&__pyx_k139p, __pyx_k139, sizeof(__pyx_k139)},
+ {&__pyx_k140p, __pyx_k140, sizeof(__pyx_k140)},
+ {&__pyx_k141p, __pyx_k141, sizeof(__pyx_k141)},
+ {&__pyx_k142p, __pyx_k142, sizeof(__pyx_k142)},
+ {&__pyx_k143p, __pyx_k143, sizeof(__pyx_k143)},
+ {&__pyx_k144p, __pyx_k144, sizeof(__pyx_k144)},
+ {&__pyx_k145p, __pyx_k145, sizeof(__pyx_k145)},
+ {&__pyx_k146p, __pyx_k146, sizeof(__pyx_k146)},
+ {&__pyx_k147p, __pyx_k147, sizeof(__pyx_k147)},
+ {&__pyx_k148p, __pyx_k148, sizeof(__pyx_k148)},
+ {&__pyx_k149p, __pyx_k149, sizeof(__pyx_k149)},
+ {&__pyx_k150p, __pyx_k150, sizeof(__pyx_k150)},
+ {&__pyx_k151p, __pyx_k151, sizeof(__pyx_k151)},
+ {&__pyx_k152p, __pyx_k152, sizeof(__pyx_k152)},
+ {&__pyx_k153p, __pyx_k153, sizeof(__pyx_k153)},
+ {&__pyx_k154p, __pyx_k154, sizeof(__pyx_k154)},
+ {&__pyx_k155p, __pyx_k155, sizeof(__pyx_k155)},
+ {&__pyx_k156p, __pyx_k156, sizeof(__pyx_k156)},
+ {&__pyx_k157p, __pyx_k157, sizeof(__pyx_k157)},
+ {&__pyx_k158p, __pyx_k158, sizeof(__pyx_k158)},
+ {&__pyx_k159p, __pyx_k159, sizeof(__pyx_k159)},
+ {&__pyx_k160p, __pyx_k160, sizeof(__pyx_k160)},
+ {&__pyx_k161p, __pyx_k161, sizeof(__pyx_k161)},
+ {&__pyx_k162p, __pyx_k162, sizeof(__pyx_k162)},
+ {&__pyx_k163p, __pyx_k163, sizeof(__pyx_k163)},
+ {&__pyx_k164p, __pyx_k164, sizeof(__pyx_k164)},
+ {&__pyx_k165p, __pyx_k165, sizeof(__pyx_k165)},
+ {&__pyx_k166p, __pyx_k166, sizeof(__pyx_k166)},
+ {&__pyx_k167p, __pyx_k167, sizeof(__pyx_k167)},
+ {&__pyx_k168p, __pyx_k168, sizeof(__pyx_k168)},
+ {&__pyx_k170p, __pyx_k170, sizeof(__pyx_k170)},
+ {0, 0, 0}
+};
+
+static PyObject *__pyx_tp_new_6mtrand_RandomState(PyTypeObject *t, PyObject *a, PyObject *k) {
+ PyObject *o = (*t->tp_alloc)(t, 0);
+ return o;
+}
+
+static void __pyx_tp_dealloc_6mtrand_RandomState(PyObject *o) {
+ {
+ PyObject *etype, *eval, *etb;
+ PyErr_Fetch(&etype, &eval, &etb);
+ ++o->ob_refcnt;
+ __pyx_f_6mtrand_11RandomState___dealloc__(o);
+ if (PyErr_Occurred()) PyErr_WriteUnraisable(o);
+ --o->ob_refcnt;
+ PyErr_Restore(etype, eval, etb);
+ }
+ (*o->ob_type->tp_free)(o);
+}
+
+static int __pyx_tp_traverse_6mtrand_RandomState(PyObject *o, visitproc v, void *a) {
+ return 0;
+}
+
+static int __pyx_tp_clear_6mtrand_RandomState(PyObject *o) {
+ return 0;
+}
+
+static struct PyMethodDef __pyx_methods_6mtrand_RandomState[] = {
+ {"seed", (PyCFunction)__pyx_f_6mtrand_11RandomState_seed, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_seed},
+ {"get_state", (PyCFunction)__pyx_f_6mtrand_11RandomState_get_state, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_get_state},
+ {"set_state", (PyCFunction)__pyx_f_6mtrand_11RandomState_set_state, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_set_state},
+ {"__getstate__", (PyCFunction)__pyx_f_6mtrand_11RandomState___getstate__, METH_VARARGS|METH_KEYWORDS, 0},
+ {"__setstate__", (PyCFunction)__pyx_f_6mtrand_11RandomState___setstate__, METH_VARARGS|METH_KEYWORDS, 0},
+ {"__reduce__", (PyCFunction)__pyx_f_6mtrand_11RandomState___reduce__, METH_VARARGS|METH_KEYWORDS, 0},
+ {"random_sample", (PyCFunction)__pyx_f_6mtrand_11RandomState_random_sample, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_random_sample},
+ {"tomaxint", (PyCFunction)__pyx_f_6mtrand_11RandomState_tomaxint, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_tomaxint},
+ {"randint", (PyCFunction)__pyx_f_6mtrand_11RandomState_randint, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_randint},
+ {"bytes", (PyCFunction)__pyx_f_6mtrand_11RandomState_bytes, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_bytes},
+ {"uniform", (PyCFunction)__pyx_f_6mtrand_11RandomState_uniform, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_uniform},
+ {"rand", (PyCFunction)__pyx_f_6mtrand_11RandomState_rand, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_rand},
+ {"randn", (PyCFunction)__pyx_f_6mtrand_11RandomState_randn, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_randn},
+ {"random_integers", (PyCFunction)__pyx_f_6mtrand_11RandomState_random_integers, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_random_integers},
+ {"standard_normal", (PyCFunction)__pyx_f_6mtrand_11RandomState_standard_normal, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_standard_normal},
+ {"normal", (PyCFunction)__pyx_f_6mtrand_11RandomState_normal, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_normal},
+ {"beta", (PyCFunction)__pyx_f_6mtrand_11RandomState_beta, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_beta},
+ {"exponential", (PyCFunction)__pyx_f_6mtrand_11RandomState_exponential, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_exponential},
+ {"standard_exponential", (PyCFunction)__pyx_f_6mtrand_11RandomState_standard_exponential, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_standard_exponential},
+ {"standard_gamma", (PyCFunction)__pyx_f_6mtrand_11RandomState_standard_gamma, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_standard_gamma},
+ {"gamma", (PyCFunction)__pyx_f_6mtrand_11RandomState_gamma, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_gamma},
+ {"f", (PyCFunction)__pyx_f_6mtrand_11RandomState_f, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_f},
+ {"noncentral_f", (PyCFunction)__pyx_f_6mtrand_11RandomState_noncentral_f, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_noncentral_f},
+ {"chisquare", (PyCFunction)__pyx_f_6mtrand_11RandomState_chisquare, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_chisquare},
+ {"noncentral_chisquare", (PyCFunction)__pyx_f_6mtrand_11RandomState_noncentral_chisquare, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_noncentral_chisquare},
+ {"standard_cauchy", (PyCFunction)__pyx_f_6mtrand_11RandomState_standard_cauchy, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_standard_cauchy},
+ {"standard_t", (PyCFunction)__pyx_f_6mtrand_11RandomState_standard_t, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_standard_t},
+ {"vonmises", (PyCFunction)__pyx_f_6mtrand_11RandomState_vonmises, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_vonmises},
+ {"pareto", (PyCFunction)__pyx_f_6mtrand_11RandomState_pareto, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_pareto},
+ {"weibull", (PyCFunction)__pyx_f_6mtrand_11RandomState_weibull, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_weibull},
+ {"power", (PyCFunction)__pyx_f_6mtrand_11RandomState_power, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_power},
+ {"laplace", (PyCFunction)__pyx_f_6mtrand_11RandomState_laplace, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_laplace},
+ {"gumbel", (PyCFunction)__pyx_f_6mtrand_11RandomState_gumbel, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_gumbel},
+ {"logistic", (PyCFunction)__pyx_f_6mtrand_11RandomState_logistic, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_logistic},
+ {"lognormal", (PyCFunction)__pyx_f_6mtrand_11RandomState_lognormal, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_lognormal},
+ {"rayleigh", (PyCFunction)__pyx_f_6mtrand_11RandomState_rayleigh, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_rayleigh},
+ {"wald", (PyCFunction)__pyx_f_6mtrand_11RandomState_wald, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_wald},
+ {"triangular", (PyCFunction)__pyx_f_6mtrand_11RandomState_triangular, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_triangular},
+ {"binomial", (PyCFunction)__pyx_f_6mtrand_11RandomState_binomial, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_binomial},
+ {"negative_binomial", (PyCFunction)__pyx_f_6mtrand_11RandomState_negative_binomial, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_negative_binomial},
+ {"poisson", (PyCFunction)__pyx_f_6mtrand_11RandomState_poisson, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_poisson},
+ {"zipf", (PyCFunction)__pyx_f_6mtrand_11RandomState_zipf, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_zipf},
+ {"geometric", (PyCFunction)__pyx_f_6mtrand_11RandomState_geometric, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_geometric},
+ {"hypergeometric", (PyCFunction)__pyx_f_6mtrand_11RandomState_hypergeometric, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_hypergeometric},
+ {"logseries", (PyCFunction)__pyx_f_6mtrand_11RandomState_logseries, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_logseries},
+ {"multivariate_normal", (PyCFunction)__pyx_f_6mtrand_11RandomState_multivariate_normal, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_multivariate_normal},
+ {"multinomial", (PyCFunction)__pyx_f_6mtrand_11RandomState_multinomial, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_multinomial},
+ {"dirichlet", (PyCFunction)__pyx_f_6mtrand_11RandomState_dirichlet, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_dirichlet},
+ {"shuffle", (PyCFunction)__pyx_f_6mtrand_11RandomState_shuffle, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_shuffle},
+ {"permutation", (PyCFunction)__pyx_f_6mtrand_11RandomState_permutation, METH_VARARGS|METH_KEYWORDS, __pyx_doc_6mtrand_11RandomState_permutation},
+ {0, 0, 0, 0}
+};
+
+static PyNumberMethods __pyx_tp_as_number_RandomState = {
+ 0, /*nb_add*/
+ 0, /*nb_subtract*/
+ 0, /*nb_multiply*/
+ 0, /*nb_divide*/
+ 0, /*nb_remainder*/
+ 0, /*nb_divmod*/
+ 0, /*nb_power*/
+ 0, /*nb_negative*/
+ 0, /*nb_positive*/
+ 0, /*nb_absolute*/
+ 0, /*nb_nonzero*/
+ 0, /*nb_invert*/
+ 0, /*nb_lshift*/
+ 0, /*nb_rshift*/
+ 0, /*nb_and*/
+ 0, /*nb_xor*/
+ 0, /*nb_or*/
+ 0, /*nb_coerce*/
+ 0, /*nb_int*/
+ 0, /*nb_long*/
+ 0, /*nb_float*/
+ 0, /*nb_oct*/
+ 0, /*nb_hex*/
+ 0, /*nb_inplace_add*/
+ 0, /*nb_inplace_subtract*/
+ 0, /*nb_inplace_multiply*/
+ 0, /*nb_inplace_divide*/
+ 0, /*nb_inplace_remainder*/
+ 0, /*nb_inplace_power*/
+ 0, /*nb_inplace_lshift*/
+ 0, /*nb_inplace_rshift*/
+ 0, /*nb_inplace_and*/
+ 0, /*nb_inplace_xor*/
+ 0, /*nb_inplace_or*/
+ 0, /*nb_floor_divide*/
+ 0, /*nb_true_divide*/
+ 0, /*nb_inplace_floor_divide*/
+ 0, /*nb_inplace_true_divide*/
+};
+
+static PySequenceMethods __pyx_tp_as_sequence_RandomState = {
+ 0, /*sq_length*/
+ 0, /*sq_concat*/
+ 0, /*sq_repeat*/
+ 0, /*sq_item*/
+ 0, /*sq_slice*/
+ 0, /*sq_ass_item*/
+ 0, /*sq_ass_slice*/
+ 0, /*sq_contains*/
+ 0, /*sq_inplace_concat*/
+ 0, /*sq_inplace_repeat*/
+};
+
+static PyMappingMethods __pyx_tp_as_mapping_RandomState = {
+ 0, /*mp_length*/
+ 0, /*mp_subscript*/
+ 0, /*mp_ass_subscript*/
+};
+
+static PyBufferProcs __pyx_tp_as_buffer_RandomState = {
+ 0, /*bf_getreadbuffer*/
+ 0, /*bf_getwritebuffer*/
+ 0, /*bf_getsegcount*/
+ 0, /*bf_getcharbuffer*/
+};
+
+PyTypeObject __pyx_type_6mtrand_RandomState = {
+ PyObject_HEAD_INIT(0)
+ 0, /*ob_size*/
+ "mtrand.RandomState", /*tp_name*/
+ sizeof(struct __pyx_obj_6mtrand_RandomState), /*tp_basicsize*/
+ 0, /*tp_itemsize*/
+ __pyx_tp_dealloc_6mtrand_RandomState, /*tp_dealloc*/
+ 0, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+ &__pyx_tp_as_number_RandomState, /*tp_as_number*/
+ &__pyx_tp_as_sequence_RandomState, /*tp_as_sequence*/
+ &__pyx_tp_as_mapping_RandomState, /*tp_as_mapping*/
+ 0, /*tp_hash*/
+ 0, /*tp_call*/
+ 0, /*tp_str*/
+ 0, /*tp_getattro*/
+ 0, /*tp_setattro*/
+ &__pyx_tp_as_buffer_RandomState, /*tp_as_buffer*/
+ Py_TPFLAGS_DEFAULT|Py_TPFLAGS_CHECKTYPES|Py_TPFLAGS_BASETYPE|Py_TPFLAGS_HAVE_GC, /*tp_flags*/
+ "Container for the Mersenne Twister PRNG.\n\n Constructor\n -----------\n RandomState(seed=None): initializes the PRNG with the given seed. See the\n seed() method for details.\n\n Distribution Methods\n -----------------\n RandomState exposes a number of methods for generating random numbers drawn\n from a variety of probability distributions. In addition to the\n distribution-specific arguments, each method takes a keyword argument\n size=None. If size is None, then a single value is generated and returned.\n If size is an integer, then a 1-D numpy array filled with generated values\n is returned. If size is a tuple, then a numpy array with that shape is\n filled and returned.\n ", /*tp_doc*/
+ __pyx_tp_traverse_6mtrand_RandomState, /*tp_traverse*/
+ __pyx_tp_clear_6mtrand_RandomState, /*tp_clear*/
+ 0, /*tp_richcompare*/
+ 0, /*tp_weaklistoffset*/
+ 0, /*tp_iter*/
+ 0, /*tp_iternext*/
+ __pyx_methods_6mtrand_RandomState, /*tp_methods*/
+ 0, /*tp_members*/
+ 0, /*tp_getset*/
+ 0, /*tp_base*/
+ 0, /*tp_dict*/
+ 0, /*tp_descr_get*/
+ 0, /*tp_descr_set*/
+ 0, /*tp_dictoffset*/
+ __pyx_f_6mtrand_11RandomState___init__, /*tp_init*/
+ 0, /*tp_alloc*/
+ __pyx_tp_new_6mtrand_RandomState, /*tp_new*/
+ 0, /*tp_free*/
+ 0, /*tp_is_gc*/
+ 0, /*tp_bases*/
+ 0, /*tp_mro*/
+ 0, /*tp_cache*/
+ 0, /*tp_subclasses*/
+ 0, /*tp_weaklist*/
+};
+
+static struct PyMethodDef __pyx_methods[] = {
+ {0, 0, 0, 0}
+};
+
+static void __pyx_init_filenames(void); /*proto*/
+
+PyMODINIT_FUNC initmtrand(void); /*proto*/
+PyMODINIT_FUNC initmtrand(void) {
+ PyObject *__pyx_1 = 0;
+ PyObject *__pyx_2 = 0;
+ PyObject *__pyx_3 = 0;
+ PyObject *__pyx_4 = 0;
+ PyObject *__pyx_5 = 0;
+ PyObject *__pyx_6 = 0;
+ PyObject *__pyx_7 = 0;
+ PyObject *__pyx_8 = 0;
+ PyObject *__pyx_9 = 0;
+ PyObject *__pyx_10 = 0;
+ PyObject *__pyx_11 = 0;
+ PyObject *__pyx_12 = 0;
+ PyObject *__pyx_13 = 0;
+ PyObject *__pyx_14 = 0;
+ PyObject *__pyx_15 = 0;
+ PyObject *__pyx_16 = 0;
+ PyObject *__pyx_17 = 0;
+ PyObject *__pyx_18 = 0;
+ __pyx_init_filenames();
+ __pyx_m = Py_InitModule4("mtrand", __pyx_methods, 0, 0, PYTHON_API_VERSION);
+ if (!__pyx_m) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 25; goto __pyx_L1;};
+ __pyx_b = PyImport_AddModule("__builtin__");
+ if (!__pyx_b) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 25; goto __pyx_L1;};
+ if (PyObject_SetAttrString(__pyx_m, "__builtins__", __pyx_b) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 25; goto __pyx_L1;};
+ if (__Pyx_InternStrings(__pyx_intern_tab) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 25; goto __pyx_L1;};
+ if (__Pyx_InitStrings(__pyx_string_tab) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 25; goto __pyx_L1;};
+ __pyx_ptype_6mtrand_dtype = __Pyx_ImportType("numpy", "dtype", sizeof(PyArray_Descr)); if (!__pyx_ptype_6mtrand_dtype) {__pyx_filename = __pyx_f[1]; __pyx_lineno = 74; goto __pyx_L1;}
+ __pyx_ptype_6mtrand_ndarray = __Pyx_ImportType("numpy", "ndarray", sizeof(PyArrayObject)); if (!__pyx_ptype_6mtrand_ndarray) {__pyx_filename = __pyx_f[1]; __pyx_lineno = 79; goto __pyx_L1;}
+ __pyx_ptype_6mtrand_flatiter = __Pyx_ImportType("numpy", "flatiter", sizeof(PyArrayIterObject)); if (!__pyx_ptype_6mtrand_flatiter) {__pyx_filename = __pyx_f[1]; __pyx_lineno = 88; goto __pyx_L1;}
+ __pyx_ptype_6mtrand_broadcast = __Pyx_ImportType("numpy", "broadcast", sizeof(PyArrayMultiIterObject)); if (!__pyx_ptype_6mtrand_broadcast) {__pyx_filename = __pyx_f[1]; __pyx_lineno = 94; goto __pyx_L1;}
+ if (PyType_Ready(&__pyx_type_6mtrand_RandomState) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 468; goto __pyx_L1;}
+ if (PyObject_SetAttrString(__pyx_m, "RandomState", (PyObject *)&__pyx_type_6mtrand_RandomState) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 468; goto __pyx_L1;}
+ __pyx_ptype_6mtrand_RandomState = &__pyx_type_6mtrand_RandomState;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":119 */
+ import_array();
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":121 */
+ __pyx_1 = __Pyx_Import(__pyx_n_numpy, 0); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 121; goto __pyx_L1;}
+ if (PyObject_SetAttr(__pyx_m, __pyx_n__sp, __pyx_1) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 121; goto __pyx_L1;}
+ Py_DECREF(__pyx_1); __pyx_1 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":488 */
+ Py_INCREF(Py_None);
+ __pyx_k2 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":498 */
+ Py_INCREF(Py_None);
+ __pyx_k3 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":564 */
+ Py_INCREF(Py_None);
+ __pyx_k4 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":571 */
+ Py_INCREF(Py_None);
+ __pyx_k5 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":578 */
+ Py_INCREF(Py_None);
+ __pyx_k6 = Py_None;
+ Py_INCREF(Py_None);
+ __pyx_k7 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":623 */
+ __pyx_1 = PyFloat_FromDouble(0.0); if (!__pyx_1) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 623; goto __pyx_L1;}
+ __pyx_k8 = __pyx_1;
+ __pyx_1 = 0;
+ __pyx_2 = PyFloat_FromDouble(1.0); if (!__pyx_2) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 623; goto __pyx_L1;}
+ __pyx_k9 = __pyx_2;
+ __pyx_2 = 0;
+ Py_INCREF(Py_None);
+ __pyx_k10 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":676 */
+ Py_INCREF(Py_None);
+ __pyx_k11 = Py_None;
+ Py_INCREF(Py_None);
+ __pyx_k12 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":689 */
+ Py_INCREF(Py_None);
+ __pyx_k13 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":696 */
+ __pyx_3 = PyFloat_FromDouble(0.0); if (!__pyx_3) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 696; goto __pyx_L1;}
+ __pyx_k14 = __pyx_3;
+ __pyx_3 = 0;
+ __pyx_4 = PyFloat_FromDouble(1.0); if (!__pyx_4) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 696; goto __pyx_L1;}
+ __pyx_k15 = __pyx_4;
+ __pyx_4 = 0;
+ Py_INCREF(Py_None);
+ __pyx_k16 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":719 */
+ Py_INCREF(Py_None);
+ __pyx_k17 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":746 */
+ __pyx_5 = PyFloat_FromDouble(1.0); if (!__pyx_5) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 746; goto __pyx_L1;}
+ __pyx_k18 = __pyx_5;
+ __pyx_5 = 0;
+ Py_INCREF(Py_None);
+ __pyx_k19 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":767 */
+ Py_INCREF(Py_None);
+ __pyx_k20 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":774 */
+ Py_INCREF(Py_None);
+ __pyx_k21 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":794 */
+ __pyx_6 = PyFloat_FromDouble(1.0); if (!__pyx_6) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 794; goto __pyx_L1;}
+ __pyx_k22 = __pyx_6;
+ __pyx_6 = 0;
+ Py_INCREF(Py_None);
+ __pyx_k23 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":820 */
+ Py_INCREF(Py_None);
+ __pyx_k24 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":847 */
+ Py_INCREF(Py_None);
+ __pyx_k25 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":883 */
+ Py_INCREF(Py_None);
+ __pyx_k26 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":904 */
+ Py_INCREF(Py_None);
+ __pyx_k27 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":932 */
+ Py_INCREF(Py_None);
+ __pyx_k28 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":939 */
+ Py_INCREF(Py_None);
+ __pyx_k29 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":960 */
+ Py_INCREF(Py_None);
+ __pyx_k30 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":984 */
+ Py_INCREF(Py_None);
+ __pyx_k31 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1005 */
+ Py_INCREF(Py_None);
+ __pyx_k32 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1026 */
+ Py_INCREF(Py_None);
+ __pyx_k33 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1047 */
+ __pyx_7 = PyFloat_FromDouble(0.0); if (!__pyx_7) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1047; goto __pyx_L1;}
+ __pyx_k34 = __pyx_7;
+ __pyx_7 = 0;
+ __pyx_8 = PyFloat_FromDouble(1.0); if (!__pyx_8) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1047; goto __pyx_L1;}
+ __pyx_k35 = __pyx_8;
+ __pyx_8 = 0;
+ Py_INCREF(Py_None);
+ __pyx_k36 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1069 */
+ __pyx_9 = PyFloat_FromDouble(0.0); if (!__pyx_9) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1069; goto __pyx_L1;}
+ __pyx_k37 = __pyx_9;
+ __pyx_9 = 0;
+ __pyx_10 = PyFloat_FromDouble(1.0); if (!__pyx_10) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1069; goto __pyx_L1;}
+ __pyx_k38 = __pyx_10;
+ __pyx_10 = 0;
+ Py_INCREF(Py_None);
+ __pyx_k39 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1091 */
+ __pyx_11 = PyFloat_FromDouble(0.0); if (!__pyx_11) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1091; goto __pyx_L1;}
+ __pyx_k40 = __pyx_11;
+ __pyx_11 = 0;
+ __pyx_12 = PyFloat_FromDouble(1.0); if (!__pyx_12) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1091; goto __pyx_L1;}
+ __pyx_k41 = __pyx_12;
+ __pyx_12 = 0;
+ Py_INCREF(Py_None);
+ __pyx_k42 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1113 */
+ __pyx_13 = PyFloat_FromDouble(0.0); if (!__pyx_13) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1113; goto __pyx_L1;}
+ __pyx_k43 = __pyx_13;
+ __pyx_13 = 0;
+ __pyx_14 = PyFloat_FromDouble(1.0); if (!__pyx_14) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1113; goto __pyx_L1;}
+ __pyx_k44 = __pyx_14;
+ __pyx_14 = 0;
+ Py_INCREF(Py_None);
+ __pyx_k45 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1142 */
+ __pyx_15 = PyFloat_FromDouble(1.0); if (!__pyx_15) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1142; goto __pyx_L1;}
+ __pyx_k46 = __pyx_15;
+ __pyx_15 = 0;
+ Py_INCREF(Py_None);
+ __pyx_k47 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1164 */
+ Py_INCREF(Py_None);
+ __pyx_k48 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1192 */
+ Py_INCREF(Py_None);
+ __pyx_k49 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1229 */
+ Py_INCREF(Py_None);
+ __pyx_k50 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1261 */
+ Py_INCREF(Py_None);
+ __pyx_k51 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1296 */
+ __pyx_16 = PyFloat_FromDouble(1.0); if (!__pyx_16) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1296; goto __pyx_L1;}
+ __pyx_k52 = __pyx_16;
+ __pyx_16 = 0;
+ Py_INCREF(Py_None);
+ __pyx_k53 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1316 */
+ Py_INCREF(Py_None);
+ __pyx_k54 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1337 */
+ Py_INCREF(Py_None);
+ __pyx_k55 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1364 */
+ Py_INCREF(Py_None);
+ __pyx_k56 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1409 */
+ Py_INCREF(Py_None);
+ __pyx_k57 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1435 */
+ Py_INCREF(Py_None);
+ __pyx_k58 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1493 */
+ Py_INCREF(Py_None);
+ __pyx_k59 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1543 */
+ Py_INCREF(Py_None);
+ __pyx_k60 = Py_None;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1675 */
+ __pyx_17 = PyObject_CallObject(((PyObject*)__pyx_ptype_6mtrand_RandomState), 0); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1675; goto __pyx_L1;}
+ if (PyObject_SetAttr(__pyx_m, __pyx_n__rand, __pyx_17) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1675; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1676 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1676; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_seed); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1676; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_seed, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1676; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1677 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1677; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_get_state); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1677; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_get_state, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1677; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1678 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1678; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_set_state); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1678; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_set_state, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1678; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1679 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1679; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_random_sample); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1679; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_random_sample, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1679; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1680 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1680; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_randint); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1680; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_randint, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1680; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1681 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1681; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_bytes); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1681; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_bytes, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1681; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1682 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1682; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_uniform); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1682; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_uniform, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1682; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1683 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1683; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_rand); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1683; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_rand, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1683; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1684 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1684; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_randn); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1684; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_randn, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1684; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1685 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1685; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_random_integers); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1685; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_random_integers, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1685; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1686 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1686; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_standard_normal); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1686; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_standard_normal, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1686; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1687 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1687; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_normal); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1687; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_normal, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1687; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1688 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1688; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_beta); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1688; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_beta, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1688; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1689 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1689; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_exponential); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1689; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_exponential, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1689; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1690 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1690; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_standard_exponential); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1690; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_standard_exponential, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1690; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1691 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1691; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_standard_gamma); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1691; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_standard_gamma, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1691; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1692 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1692; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_gamma); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1692; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_gamma, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1692; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1693 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1693; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_f); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1693; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_f, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1693; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1694 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1694; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_noncentral_f); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1694; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_noncentral_f, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1694; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1695 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1695; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_chisquare); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1695; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_chisquare, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1695; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1696 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1696; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_noncentral_chisquare); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1696; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_noncentral_chisquare, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1696; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1697 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1697; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_standard_cauchy); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1697; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_standard_cauchy, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1697; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1698 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1698; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_standard_t); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1698; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_standard_t, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1698; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1699 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1699; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_vonmises); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1699; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_vonmises, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1699; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1700 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1700; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_pareto); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1700; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_pareto, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1700; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1701 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1701; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_weibull); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1701; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_weibull, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1701; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1702 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1702; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_power); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1702; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_power, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1702; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1703 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1703; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_laplace); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1703; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_laplace, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1703; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1704 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1704; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_gumbel); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1704; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_gumbel, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1704; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1705 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1705; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_logistic); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1705; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_logistic, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1705; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1706 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1706; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_lognormal); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1706; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_lognormal, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1706; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1707 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1707; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_rayleigh); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1707; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_rayleigh, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1707; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1708 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1708; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_wald); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1708; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_wald, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1708; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1709 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1709; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_triangular); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1709; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_triangular, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1709; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1711 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1711; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_binomial); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1711; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_binomial, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1711; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1712 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1712; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_negative_binomial); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1712; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_negative_binomial, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1712; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1713 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1713; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_poisson); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1713; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_poisson, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1713; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1714 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1714; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_zipf); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1714; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_zipf, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1714; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1715 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1715; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_geometric); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1715; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_geometric, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1715; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1716 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1716; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_hypergeometric); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1716; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_hypergeometric, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1716; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1717 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1717; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_logseries); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1717; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_logseries, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1717; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1719 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1719; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_multivariate_normal); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1719; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_multivariate_normal, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1719; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1720 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1720; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_multinomial); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1720; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_multinomial, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1720; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1721 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1721; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_dirichlet); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1721; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_dirichlet, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1721; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1723 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1723; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_shuffle); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1723; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_shuffle, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1723; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+
+ /* "/Users/dave/Stuff/Projects/numpy/trunk/numpy/random/mtrand/mtrand.pyx":1724 */
+ __pyx_17 = __Pyx_GetName(__pyx_m, __pyx_n__rand); if (!__pyx_17) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1724; goto __pyx_L1;}
+ __pyx_18 = PyObject_GetAttr(__pyx_17, __pyx_n_permutation); if (!__pyx_18) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1724; goto __pyx_L1;}
+ Py_DECREF(__pyx_17); __pyx_17 = 0;
+ if (PyObject_SetAttr(__pyx_m, __pyx_n_permutation, __pyx_18) < 0) {__pyx_filename = __pyx_f[0]; __pyx_lineno = 1724; goto __pyx_L1;}
+ Py_DECREF(__pyx_18); __pyx_18 = 0;
+ return;
+ __pyx_L1:;
+ Py_XDECREF(__pyx_1);
+ Py_XDECREF(__pyx_2);
+ Py_XDECREF(__pyx_3);
+ Py_XDECREF(__pyx_4);
+ Py_XDECREF(__pyx_5);
+ Py_XDECREF(__pyx_6);
+ Py_XDECREF(__pyx_7);
+ Py_XDECREF(__pyx_8);
+ Py_XDECREF(__pyx_9);
+ Py_XDECREF(__pyx_10);
+ Py_XDECREF(__pyx_11);
+ Py_XDECREF(__pyx_12);
+ Py_XDECREF(__pyx_13);
+ Py_XDECREF(__pyx_14);
+ Py_XDECREF(__pyx_15);
+ Py_XDECREF(__pyx_16);
+ Py_XDECREF(__pyx_17);
+ Py_XDECREF(__pyx_18);
+ __Pyx_AddTraceback("mtrand");
+}
+
+static char *__pyx_filenames[] = {
+ "mtrand.pyx",
+ "numpy.pxi",
+};
+
+/* Runtime support code */
+
+static void __pyx_init_filenames(void) {
+ __pyx_f = __pyx_filenames;
+}
+
+static int __Pyx_GetStarArgs(
+ PyObject **args,
+ PyObject **kwds,
+ char *kwd_list[],
+ int nargs,
+ PyObject **args2,
+ PyObject **kwds2)
+{
+ PyObject *x = 0, *args1 = 0, *kwds1 = 0;
+
+ if (args2)
+ *args2 = 0;
+ if (kwds2)
+ *kwds2 = 0;
+
+ if (args2) {
+ args1 = PyTuple_GetSlice(*args, 0, nargs);
+ if (!args1)
+ goto bad;
+ *args2 = PyTuple_GetSlice(*args, nargs, PyTuple_Size(*args));
+ if (!*args2)
+ goto bad;
+ }
+ else {
+ args1 = *args;
+ Py_INCREF(args1);
+ }
+
+ if (kwds2) {
+ if (*kwds) {
+ char **p;
+ kwds1 = PyDict_New();
+ if (!kwds)
+ goto bad;
+ *kwds2 = PyDict_Copy(*kwds);
+ if (!*kwds2)
+ goto bad;
+ for (p = kwd_list; *p; p++) {
+ x = PyDict_GetItemString(*kwds, *p);
+ if (x) {
+ if (PyDict_SetItemString(kwds1, *p, x) < 0)
+ goto bad;
+ if (PyDict_DelItemString(*kwds2, *p) < 0)
+ goto bad;
+ }
+ }
+ }
+ else {
+ *kwds2 = PyDict_New();
+ if (!*kwds2)
+ goto bad;
+ }
+ }
+ else {
+ kwds1 = *kwds;
+ Py_XINCREF(kwds1);
+ }
+
+ *args = args1;
+ *kwds = kwds1;
+ return 0;
+bad:
+ Py_XDECREF(args1);
+ Py_XDECREF(kwds1);
+ if (*args2) {
+ Py_XDECREF(*args2);
+ }
+ if (*kwds2) {
+ Py_XDECREF(*kwds2);
+ }
+ return -1;
+}
+
+static PyObject *__Pyx_Import(PyObject *name, PyObject *from_list) {
+ PyObject *__import__ = 0;
+ PyObject *empty_list = 0;
+ PyObject *module = 0;
+ PyObject *global_dict = 0;
+ PyObject *empty_dict = 0;
+ PyObject *list;
+ __import__ = PyObject_GetAttrString(__pyx_b, "__import__");
+ if (!__import__)
+ goto bad;
+ if (from_list)
+ list = from_list;
+ else {
+ empty_list = PyList_New(0);
+ if (!empty_list)
+ goto bad;
+ list = empty_list;
+ }
+ global_dict = PyModule_GetDict(__pyx_m);
+ if (!global_dict)
+ goto bad;
+ empty_dict = PyDict_New();
+ if (!empty_dict)
+ goto bad;
+ module = PyObject_CallFunction(__import__, "OOOO",
+ name, global_dict, empty_dict, list);
+bad:
+ Py_XDECREF(empty_list);
+ Py_XDECREF(__import__);
+ Py_XDECREF(empty_dict);
+ return module;
+}
+
+static PyObject *__Pyx_GetName(PyObject *dict, PyObject *name) {
+ PyObject *result;
+ result = PyObject_GetAttr(dict, name);
+ if (!result)
+ PyErr_SetObject(PyExc_NameError, name);
+ return result;
+}
+
+static void __Pyx_Raise(PyObject *type, PyObject *value, PyObject *tb) {
+ Py_XINCREF(type);
+ Py_XINCREF(value);
+ Py_XINCREF(tb);
+ /* First, check the traceback argument, replacing None with NULL. */
+ if (tb == Py_None) {
+ Py_DECREF(tb);
+ tb = 0;
+ }
+ else if (tb != NULL && !PyTraceBack_Check(tb)) {
+ PyErr_SetString(PyExc_TypeError,
+ "raise: arg 3 must be a traceback or None");
+ goto raise_error;
+ }
+ /* Next, replace a missing value with None */
+ if (value == NULL) {
+ value = Py_None;
+ Py_INCREF(value);
+ }
+ /* Next, repeatedly, replace a tuple exception with its first item */
+ while (PyTuple_Check(type) && PyTuple_Size(type) > 0) {
+ PyObject *tmp = type;
+ type = PyTuple_GET_ITEM(type, 0);
+ Py_INCREF(type);
+ Py_DECREF(tmp);
+ }
+ if (PyString_Check(type)) {
+ if (PyErr_Warn(PyExc_DeprecationWarning,
+ "raising a string exception is deprecated"))
+ goto raise_error;
+ }
+ else if (PyType_Check(type) || PyClass_Check(type))
+ ; /*PyErr_NormalizeException(&type, &value, &tb);*/
+ else {
+ /* Raising an instance. The value should be a dummy. */
+ if (value != Py_None) {
+ PyErr_SetString(PyExc_TypeError,
+ "instance exception may not have a separate value");
+ goto raise_error;
+ }
+ /* Normalize to raise <class>, <instance> */
+ Py_DECREF(value);
+ value = type;
+ if (PyInstance_Check(type))
+ type = (PyObject*) ((PyInstanceObject*)type)->in_class;
+ else
+ type = (PyObject*) type->ob_type;
+ Py_INCREF(type);
+ }
+ PyErr_Restore(type, value, tb);
+ return;
+raise_error:
+ Py_XDECREF(value);
+ Py_XDECREF(type);
+ Py_XDECREF(tb);
+ return;
+}
+
+static void __Pyx_UnpackError(void) {
+ PyErr_SetString(PyExc_ValueError, "unpack sequence of wrong size");
+}
+
+static PyObject *__Pyx_UnpackItem(PyObject *iter) {
+ PyObject *item;
+ if (!(item = PyIter_Next(iter))) {
+ if (!PyErr_Occurred())
+ __Pyx_UnpackError();
+ }
+ return item;
+}
+
+static int __Pyx_EndUnpack(PyObject *iter) {
+ PyObject *item;
+ if ((item = PyIter_Next(iter))) {
+ Py_DECREF(item);
+ __Pyx_UnpackError();
+ return -1;
+ }
+ else if (!PyErr_Occurred())
+ return 0;
+ else
+ return -1;
+}
+
+static PyObject *__Pyx_GetExcValue(void) {
+ PyObject *type = 0, *value = 0, *tb = 0;
+ PyObject *result = 0;
+ PyThreadState *tstate = PyThreadState_Get();
+ PyErr_Fetch(&type, &value, &tb);
+ PyErr_NormalizeException(&type, &value, &tb);
+ if (PyErr_Occurred())
+ goto bad;
+ if (!value) {
+ value = Py_None;
+ Py_INCREF(value);
+ }
+ Py_XDECREF(tstate->exc_type);
+ Py_XDECREF(tstate->exc_value);
+ Py_XDECREF(tstate->exc_traceback);
+ tstate->exc_type = type;
+ tstate->exc_value = value;
+ tstate->exc_traceback = tb;
+ result = value;
+ Py_XINCREF(result);
+ type = 0;
+ value = 0;
+ tb = 0;
+bad:
+ Py_XDECREF(type);
+ Py_XDECREF(value);
+ Py_XDECREF(tb);
+ return result;
+}
+
+static int __Pyx_TypeTest(PyObject *obj, PyTypeObject *type) {
+ if (!type) {
+ PyErr_Format(PyExc_SystemError, "Missing type object");
+ return 0;
+ }
+ if (obj == Py_None || PyObject_TypeCheck(obj, type))
+ return 1;
+ PyErr_Format(PyExc_TypeError, "Cannot convert %s to %s",
+ obj->ob_type->tp_name, type->tp_name);
+ return 0;
+}
+
+static int __Pyx_InternStrings(__Pyx_InternTabEntry *t) {
+ while (t->p) {
+ *t->p = PyString_InternFromString(t->s);
+ if (!*t->p)
+ return -1;
+ ++t;
+ }
+ return 0;
+}
+
+static int __Pyx_InitStrings(__Pyx_StringTabEntry *t) {
+ while (t->p) {
+ *t->p = PyString_FromStringAndSize(t->s, t->n - 1);
+ if (!*t->p)
+ return -1;
+ ++t;
+ }
+ return 0;
+}
+
+static PyTypeObject *__Pyx_ImportType(char *module_name, char *class_name,
+ long size)
+{
+ PyObject *py_module_name = 0;
+ PyObject *py_class_name = 0;
+ PyObject *py_name_list = 0;
+ PyObject *py_module = 0;
+ PyObject *result = 0;
+
+ py_module_name = PyString_FromString(module_name);
+ if (!py_module_name)
+ goto bad;
+ py_class_name = PyString_FromString(class_name);
+ if (!py_class_name)
+ goto bad;
+ py_name_list = PyList_New(1);
+ if (!py_name_list)
+ goto bad;
+ Py_INCREF(py_class_name);
+ if (PyList_SetItem(py_name_list, 0, py_class_name) < 0)
+ goto bad;
+ py_module = __Pyx_Import(py_module_name, py_name_list);
+ if (!py_module)
+ goto bad;
+ result = PyObject_GetAttr(py_module, py_class_name);
+ if (!result)
+ goto bad;
+ if (!PyType_Check(result)) {
+ PyErr_Format(PyExc_TypeError,
+ "%s.%s is not a type object",
+ module_name, class_name);
+ goto bad;
+ }
+ if (((PyTypeObject *)result)->tp_basicsize != size) {
+ PyErr_Format(PyExc_ValueError,
+ "%s.%s does not appear to be the correct type object",
+ module_name, class_name);
+ goto bad;
+ }
+ goto done;
+bad:
+ Py_XDECREF(result);
+ result = 0;
+done:
+ Py_XDECREF(py_module_name);
+ Py_XDECREF(py_class_name);
+ Py_XDECREF(py_name_list);
+ return (PyTypeObject *)result;
+}
+
+#include "compile.h"
+#include "frameobject.h"
+#include "traceback.h"
+
+static void __Pyx_AddTraceback(char *funcname) {
+ PyObject *py_srcfile = 0;
+ PyObject *py_funcname = 0;
+ PyObject *py_globals = 0;
+ PyObject *empty_tuple = 0;
+ PyObject *empty_string = 0;
+ PyCodeObject *py_code = 0;
+ PyFrameObject *py_frame = 0;
+
+ py_srcfile = PyString_FromString(__pyx_filename);
+ if (!py_srcfile) goto bad;
+ py_funcname = PyString_FromString(funcname);
+ if (!py_funcname) goto bad;
+ py_globals = PyModule_GetDict(__pyx_m);
+ if (!py_globals) goto bad;
+ empty_tuple = PyTuple_New(0);
+ if (!empty_tuple) goto bad;
+ empty_string = PyString_FromString("");
+ if (!empty_string) goto bad;
+ py_code = PyCode_New(
+ 0, /*int argcount,*/
+ 0, /*int nlocals,*/
+ 0, /*int stacksize,*/
+ 0, /*int flags,*/
+ empty_string, /*PyObject *code,*/
+ empty_tuple, /*PyObject *consts,*/
+ empty_tuple, /*PyObject *names,*/
+ empty_tuple, /*PyObject *varnames,*/
+ empty_tuple, /*PyObject *freevars,*/
+ empty_tuple, /*PyObject *cellvars,*/
+ py_srcfile, /*PyObject *filename,*/
+ py_funcname, /*PyObject *name,*/
+ __pyx_lineno, /*int firstlineno,*/
+ empty_string /*PyObject *lnotab*/
+ );
+ if (!py_code) goto bad;
+ py_frame = PyFrame_New(
+ PyThreadState_Get(), /*PyThreadState *tstate,*/
+ py_code, /*PyCodeObject *code,*/
+ py_globals, /*PyObject *globals,*/
+ 0 /*PyObject *locals*/
+ );
+ if (!py_frame) goto bad;
+ py_frame->f_lineno = __pyx_lineno;
+ PyTraceBack_Here(py_frame);
+bad:
+ Py_XDECREF(py_srcfile);
+ Py_XDECREF(py_funcname);
+ Py_XDECREF(empty_tuple);
+ Py_XDECREF(empty_string);
+ Py_XDECREF(py_code);
+ Py_XDECREF(py_frame);
+}
diff --git a/numpy/random/mtrand/mtrand.pyx b/numpy/random/mtrand/mtrand.pyx
new file mode 100644
index 000000000..f27bc3c94
--- /dev/null
+++ b/numpy/random/mtrand/mtrand.pyx
@@ -0,0 +1,1724 @@
+
+# mtrand.pyx -- A Pyrex wrapper of Jean-Sebastien Roy's RandomKit
+#
+# Copyright 2005 Robert Kern (robert.kern@gmail.com)
+#
+# Permission is hereby granted, free of charge, to any person obtaining a
+# copy of this software and associated documentation files (the
+# "Software"), to deal in the Software without restriction, including
+# without limitation the rights to use, copy, modify, merge, publish,
+# distribute, sublicense, and/or sell copies of the Software, and to
+# permit persons to whom the Software is furnished to do so, subject to
+# the following conditions:
+#
+# The above copyright notice and this permission notice shall be included
+# in all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+# IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+# CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+# TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+# SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+include "Python.pxi"
+include "numpy.pxi"
+
+cdef extern from "math.h":
+ double exp(double x)
+ double log(double x)
+ double floor(double x)
+ double sin(double x)
+ double cos(double x)
+
+cdef extern from "randomkit.h":
+
+ ctypedef struct rk_state:
+ unsigned long key[624]
+ int pos
+
+ ctypedef enum rk_error:
+ RK_NOERR = 0
+ RK_ENODEV = 1
+ RK_ERR_MAX = 2
+
+ char *rk_strerror[2]
+
+ # 0xFFFFFFFFUL
+ unsigned long RK_MAX
+
+ void rk_seed(unsigned long seed, rk_state *state)
+ rk_error rk_randomseed(rk_state *state)
+ unsigned long rk_random(rk_state *state)
+ long rk_long(rk_state *state)
+ unsigned long rk_ulong(rk_state *state)
+ unsigned long rk_interval(unsigned long max, rk_state *state)
+ double rk_double(rk_state *state)
+ void rk_fill(void *buffer, size_t size, rk_state *state)
+ rk_error rk_devfill(void *buffer, size_t size, int strong)
+ rk_error rk_altfill(void *buffer, size_t size, int strong,
+ rk_state *state)
+ double rk_gauss(rk_state *state)
+
+cdef extern from "distributions.h":
+
+ double rk_normal(rk_state *state, double loc, double scale)
+ double rk_standard_exponential(rk_state *state)
+ double rk_exponential(rk_state *state, double scale)
+ double rk_uniform(rk_state *state, double loc, double scale)
+ double rk_standard_gamma(rk_state *state, double shape)
+ double rk_gamma(rk_state *state, double shape, double scale)
+ double rk_beta(rk_state *state, double a, double b)
+ double rk_chisquare(rk_state *state, double df)
+ double rk_noncentral_chisquare(rk_state *state, double df, double nonc)
+ double rk_f(rk_state *state, double dfnum, double dfden)
+ double rk_noncentral_f(rk_state *state, double dfnum, double dfden, double nonc)
+ double rk_standard_cauchy(rk_state *state)
+ double rk_standard_t(rk_state *state, double df)
+ double rk_vonmises(rk_state *state, double mu, double kappa)
+ double rk_pareto(rk_state *state, double a)
+ double rk_weibull(rk_state *state, double a)
+ double rk_power(rk_state *state, double a)
+ double rk_laplace(rk_state *state, double loc, double scale)
+ double rk_gumbel(rk_state *state, double loc, double scale)
+ double rk_logistic(rk_state *state, double loc, double scale)
+ double rk_lognormal(rk_state *state, double mode, double sigma)
+ double rk_rayleigh(rk_state *state, double mode)
+ double rk_wald(rk_state *state, double mean, double scale)
+ double rk_triangular(rk_state *state, double left, double mode, double right)
+
+ long rk_binomial(rk_state *state, long n, double p)
+ long rk_binomial_btpe(rk_state *state, long n, double p)
+ long rk_binomial_inversion(rk_state *state, long n, double p)
+ long rk_negative_binomial(rk_state *state, long n, double p)
+ long rk_poisson(rk_state *state, double lam)
+ long rk_poisson_mult(rk_state *state, double lam)
+ long rk_poisson_ptrs(rk_state *state, double lam)
+ long rk_zipf(rk_state *state, double a)
+ long rk_geometric(rk_state *state, double p)
+ long rk_hypergeometric(rk_state *state, long good, long bad, long sample)
+ long rk_logseries(rk_state *state, double p)
+
+ctypedef double (* rk_cont0)(rk_state *state)
+ctypedef double (* rk_cont1)(rk_state *state, double a)
+ctypedef double (* rk_cont2)(rk_state *state, double a, double b)
+ctypedef double (* rk_cont3)(rk_state *state, double a, double b, double c)
+
+ctypedef long (* rk_disc0)(rk_state *state)
+ctypedef long (* rk_discnp)(rk_state *state, long n, double p)
+ctypedef long (* rk_discnmN)(rk_state *state, long n, long m, long N)
+ctypedef long (* rk_discd)(rk_state *state, double a)
+
+
+cdef extern from "initarray.h":
+ void init_by_array(rk_state *self, unsigned long *init_key,
+ unsigned long key_length)
+
+# Initialize numpy
+import_array()
+
+import numpy as _sp
+
+cdef object cont0_array(rk_state *state, rk_cont0 func, object size):
+ cdef double *array_data
+ cdef ndarray array "arrayObject"
+ cdef long length
+ cdef long i
+
+ if size is None:
+ return func(state)
+ else:
+ array = <ndarray>_sp.empty(size, _sp.float64)
+ length = PyArray_SIZE(array)
+ array_data = <double *>array.data
+ for i from 0 <= i < length:
+ array_data[i] = func(state)
+ return array
+
+
+cdef object cont1_array_sc(rk_state *state, rk_cont1 func, object size, double a):
+ cdef double *array_data
+ cdef ndarray array "arrayObject"
+ cdef long length
+ cdef long i
+
+ if size is None:
+ return func(state, a)
+ else:
+ array = <ndarray>_sp.empty(size, _sp.float64)
+ length = PyArray_SIZE(array)
+ array_data = <double *>array.data
+ for i from 0 <= i < length:
+ array_data[i] = func(state, a)
+ return array
+
+cdef object cont1_array(rk_state *state, rk_cont1 func, object size, ndarray oa):
+ cdef double *array_data
+ cdef double *oa_data
+ cdef ndarray array "arrayObject"
+ cdef npy_intp length
+ cdef npy_intp i
+ cdef flatiter itera
+ cdef broadcast multi
+
+ if size is None:
+ array = <ndarray>PyArray_SimpleNew(oa.nd, oa.dimensions, NPY_DOUBLE)
+ length = PyArray_SIZE(array)
+ array_data = <double *>array.data
+ itera = <flatiter>PyArray_IterNew(<object>oa)
+ for i from 0 <= i < length:
+ array_data[i] = func(state, (<double *>(itera.dataptr))[0])
+ PyArray_ITER_NEXT(itera)
+ else:
+ array = <ndarray>_sp.empty(size, _sp.float64)
+ array_data = <double *>array.data
+ multi = <broadcast>PyArray_MultiIterNew(2, <void *>array,
+ <void *>oa)
+ if (multi.size != PyArray_SIZE(array)):
+ raise ValueError("size is not compatible with inputs")
+ for i from 0 <= i < multi.size:
+ oa_data = <double *>PyArray_MultiIter_DATA(multi, 1)
+ array_data[i] = func(state, oa_data[0])
+ PyArray_MultiIter_NEXTi(multi, 1)
+ return array
+
+cdef object cont2_array_sc(rk_state *state, rk_cont2 func, object size, double a,
+ double b):
+ cdef double *array_data
+ cdef ndarray array "arrayObject"
+ cdef long length
+ cdef long i
+
+ if size is None:
+ return func(state, a, b)
+ else:
+ array = <ndarray>_sp.empty(size, _sp.float64)
+ length = PyArray_SIZE(array)
+ array_data = <double *>array.data
+ for i from 0 <= i < length:
+ array_data[i] = func(state, a, b)
+ return array
+
+
+cdef object cont2_array(rk_state *state, rk_cont2 func, object size,
+ ndarray oa, ndarray ob):
+ cdef double *array_data
+ cdef double *oa_data
+ cdef double *ob_data
+ cdef ndarray array "arrayObject"
+ cdef npy_intp length
+ cdef npy_intp i
+ cdef broadcast multi
+
+ if size is None:
+ multi = <broadcast> PyArray_MultiIterNew(2, <void *>oa, <void *>ob)
+ array = <ndarray> PyArray_SimpleNew(multi.nd, multi.dimensions, NPY_DOUBLE)
+ array_data = <double *>array.data
+ for i from 0 <= i < multi.size:
+ oa_data = <double *>PyArray_MultiIter_DATA(multi, 0)
+ ob_data = <double *>PyArray_MultiIter_DATA(multi, 1)
+ array_data[i] = func(state, oa_data[0], ob_data[0])
+ PyArray_MultiIter_NEXT(multi)
+ else:
+ array = <ndarray>_sp.empty(size, _sp.float64)
+ array_data = <double *>array.data
+ multi = <broadcast>PyArray_MultiIterNew(3, <void*>array, <void *>oa, <void *>ob)
+ if (multi.size != PyArray_SIZE(array)):
+ raise ValueError("size is not compatible with inputs")
+ for i from 0 <= i < multi.size:
+ oa_data = <double *>PyArray_MultiIter_DATA(multi, 1)
+ ob_data = <double *>PyArray_MultiIter_DATA(multi, 2)
+ array_data[i] = func(state, oa_data[0], ob_data[0])
+ PyArray_MultiIter_NEXTi(multi, 1)
+ PyArray_MultiIter_NEXTi(multi, 2)
+ return array
+
+cdef object cont3_array_sc(rk_state *state, rk_cont3 func, object size, double a,
+ double b, double c):
+
+ cdef double *array_data
+ cdef ndarray array "arrayObject"
+ cdef long length
+ cdef long i
+
+ if size is None:
+ return func(state, a, b, c)
+ else:
+ array = <ndarray>_sp.empty(size, _sp.float64)
+ length = PyArray_SIZE(array)
+ array_data = <double *>array.data
+ for i from 0 <= i < length:
+ array_data[i] = func(state, a, b, c)
+ return array
+
+cdef object cont3_array(rk_state *state, rk_cont3 func, object size, ndarray oa,
+ ndarray ob, ndarray oc):
+
+ cdef double *array_data
+ cdef double *oa_data
+ cdef double *ob_data
+ cdef double *oc_data
+ cdef ndarray array "arrayObject"
+ cdef npy_intp length
+ cdef npy_intp i
+ cdef broadcast multi
+
+ if size is None:
+ multi = <broadcast> PyArray_MultiIterNew(3, <void *>oa, <void *>ob, <void *>oc)
+ array = <ndarray> PyArray_SimpleNew(multi.nd, multi.dimensions, NPY_DOUBLE)
+ array_data = <double *>array.data
+ for i from 0 <= i < multi.size:
+ oa_data = <double *>PyArray_MultiIter_DATA(multi, 0)
+ ob_data = <double *>PyArray_MultiIter_DATA(multi, 1)
+ oc_data = <double *>PyArray_MultiIter_DATA(multi, 2)
+ array_data[i] = func(state, oa_data[0], ob_data[0], oc_data[0])
+ PyArray_MultiIter_NEXT(multi)
+ else:
+ array = <ndarray>_sp.empty(size, _sp.float64)
+ array_data = <double *>array.data
+ multi = <broadcast>PyArray_MultiIterNew(4, <void*>array, <void *>oa,
+ <void *>ob, <void *>oc)
+ if (multi.size != PyArray_SIZE(array)):
+ raise ValueError("size is not compatible with inputs")
+ for i from 0 <= i < multi.size:
+ oa_data = <double *>PyArray_MultiIter_DATA(multi, 1)
+ ob_data = <double *>PyArray_MultiIter_DATA(multi, 2)
+ oc_data = <double *>PyArray_MultiIter_DATA(multi, 3)
+ array_data[i] = func(state, oa_data[0], ob_data[0], oc_data[0])
+ PyArray_MultiIter_NEXT(multi)
+ return array
+
+cdef object disc0_array(rk_state *state, rk_disc0 func, object size):
+ cdef long *array_data
+ cdef ndarray array "arrayObject"
+ cdef long length
+ cdef long i
+
+ if size is None:
+ return func(state)
+ else:
+ array = <ndarray>_sp.empty(size, int)
+ length = PyArray_SIZE(array)
+ array_data = <long *>array.data
+ for i from 0 <= i < length:
+ array_data[i] = func(state)
+ return array
+
+cdef object discnp_array_sc(rk_state *state, rk_discnp func, object size, long n, double p):
+ cdef long *array_data
+ cdef ndarray array "arrayObject"
+ cdef long length
+ cdef long i
+
+ if size is None:
+ return func(state, n, p)
+ else:
+ array = <ndarray>_sp.empty(size, int)
+ length = PyArray_SIZE(array)
+ array_data = <long *>array.data
+ for i from 0 <= i < length:
+ array_data[i] = func(state, n, p)
+ return array
+
+cdef object discnp_array(rk_state *state, rk_discnp func, object size, ndarray on, ndarray op):
+ cdef long *array_data
+ cdef ndarray array "arrayObject"
+ cdef npy_intp length
+ cdef npy_intp i
+ cdef double *op_data
+ cdef long *on_data
+ cdef broadcast multi
+
+ if size is None:
+ multi = <broadcast> PyArray_MultiIterNew(2, <void *>on, <void *>op)
+ array = <ndarray> PyArray_SimpleNew(multi.nd, multi.dimensions, NPY_LONG)
+ array_data = <long *>array.data
+ for i from 0 <= i < multi.size:
+ on_data = <long *>PyArray_MultiIter_DATA(multi, 0)
+ op_data = <double *>PyArray_MultiIter_DATA(multi, 1)
+ array_data[i] = func(state, on_data[0], op_data[0])
+ PyArray_MultiIter_NEXT(multi)
+ else:
+ array = <ndarray>_sp.empty(size, int)
+ array_data = <long *>array.data
+ multi = <broadcast>PyArray_MultiIterNew(3, <void*>array, <void *>on, <void *>op)
+ if (multi.size != PyArray_SIZE(array)):
+ raise ValueError("size is not compatible with inputs")
+ for i from 0 <= i < multi.size:
+ on_data = <long *>PyArray_MultiIter_DATA(multi, 1)
+ op_data = <double *>PyArray_MultiIter_DATA(multi, 2)
+ array_data[i] = func(state, on_data[0], op_data[0])
+ PyArray_MultiIter_NEXTi(multi, 1)
+ PyArray_MultiIter_NEXTi(multi, 2)
+
+ return array
+
+cdef object discnmN_array_sc(rk_state *state, rk_discnmN func, object size,
+ long n, long m, long N):
+ cdef long *array_data
+ cdef ndarray array "arrayObject"
+ cdef long length
+ cdef long i
+
+ if size is None:
+ return func(state, n, m, N)
+ else:
+ array = <ndarray>_sp.empty(size, int)
+ length = PyArray_SIZE(array)
+ array_data = <long *>array.data
+ for i from 0 <= i < length:
+ array_data[i] = func(state, n, m, N)
+ return array
+
+cdef object discnmN_array(rk_state *state, rk_discnmN func, object size,
+ ndarray on, ndarray om, ndarray oN):
+ cdef long *array_data
+ cdef long *on_data
+ cdef long *om_data
+ cdef long *oN_data
+ cdef ndarray array "arrayObject"
+ cdef npy_intp length
+ cdef npy_intp i
+ cdef broadcast multi
+
+ if size is None:
+ multi = <broadcast> PyArray_MultiIterNew(3, <void *>on, <void *>om, <void *>oN)
+ array = <ndarray> PyArray_SimpleNew(multi.nd, multi.dimensions, NPY_LONG)
+ array_data = <long *>array.data
+ for i from 0 <= i < multi.size:
+ on_data = <long *>PyArray_MultiIter_DATA(multi, 0)
+ om_data = <long *>PyArray_MultiIter_DATA(multi, 1)
+ oN_data = <long *>PyArray_MultiIter_DATA(multi, 2)
+ array_data[i] = func(state, on_data[0], om_data[0], oN_data[0])
+ PyArray_MultiIter_NEXT(multi)
+ else:
+ array = <ndarray>_sp.empty(size, int)
+ array_data = <long *>array.data
+ multi = <broadcast>PyArray_MultiIterNew(4, <void*>array, <void *>on, <void *>om,
+ <void *>oN)
+ if (multi.size != PyArray_SIZE(array)):
+ raise ValueError("size is not compatible with inputs")
+ for i from 0 <= i < multi.size:
+ on_data = <long *>PyArray_MultiIter_DATA(multi, 1)
+ om_data = <long *>PyArray_MultiIter_DATA(multi, 2)
+ oN_data = <long *>PyArray_MultiIter_DATA(multi, 3)
+ array_data[i] = func(state, on_data[0], om_data[0], oN_data[0])
+ PyArray_MultiIter_NEXT(multi)
+
+ return array
+
+cdef object discd_array_sc(rk_state *state, rk_discd func, object size, double a):
+ cdef long *array_data
+ cdef ndarray array "arrayObject"
+ cdef long length
+ cdef long i
+
+ if size is None:
+ return func(state, a)
+ else:
+ array = <ndarray>_sp.empty(size, int)
+ length = PyArray_SIZE(array)
+ array_data = <long *>array.data
+ for i from 0 <= i < length:
+ array_data[i] = func(state, a)
+ return array
+
+cdef object discd_array(rk_state *state, rk_discd func, object size, ndarray oa):
+ cdef long *array_data
+ cdef double *oa_data
+ cdef ndarray array "arrayObject"
+ cdef npy_intp length
+ cdef npy_intp i
+ cdef broadcast multi
+ cdef flatiter itera
+
+ if size is None:
+ array = <ndarray>PyArray_SimpleNew(oa.nd, oa.dimensions, NPY_LONG)
+ length = PyArray_SIZE(array)
+ array_data = <long *>array.data
+ itera = <flatiter>PyArray_IterNew(<object>oa)
+ for i from 0 <= i < length:
+ array_data[i] = func(state, (<double *>(itera.dataptr))[0])
+ PyArray_ITER_NEXT(itera)
+ else:
+ array = <ndarray>_sp.empty(size, int)
+ array_data = <long *>array.data
+ multi = <broadcast>PyArray_MultiIterNew(2, <void *>array, <void *>oa)
+ if (multi.size != PyArray_SIZE(array)):
+ raise ValueError("size is not compatible with inputs")
+ for i from 0 <= i < multi.size:
+ oa_data = <double *>PyArray_MultiIter_DATA(multi, 1)
+ array_data[i] = func(state, oa_data[0])
+ PyArray_MultiIter_NEXTi(multi, 1)
+ return array
+
+cdef double kahan_sum(double *darr, long n):
+ cdef double c, y, t, sum
+ cdef long i
+ sum = darr[0]
+ c = 0.0
+ for i from 1 <= i < n:
+ y = darr[i] - c
+ t = sum + y
+ c = (t-sum) - y
+ sum = t
+ return sum
+
+cdef class RandomState:
+ """Container for the Mersenne Twister PRNG.
+
+ Constructor
+ -----------
+ RandomState(seed=None): initializes the PRNG with the given seed. See the
+ seed() method for details.
+
+ Distribution Methods
+ -----------------
+ RandomState exposes a number of methods for generating random numbers drawn
+ from a variety of probability distributions. In addition to the
+ distribution-specific arguments, each method takes a keyword argument
+ size=None. If size is None, then a single value is generated and returned.
+ If size is an integer, then a 1-D numpy array filled with generated values
+ is returned. If size is a tuple, then a numpy array with that shape is
+ filled and returned.
+ """
+ cdef rk_state *internal_state
+
+ def __init__(self, seed=None):
+ self.internal_state = <rk_state*>PyMem_Malloc(sizeof(rk_state))
+
+ self.seed(seed)
+
+ def __dealloc__(self):
+ if self.internal_state != NULL:
+ PyMem_Free(self.internal_state)
+ self.internal_state = NULL
+
+ def seed(self, seed=None):
+ """Seed the generator.
+
+ seed(seed=None)
+
+ seed can be an integer, an array (or other sequence) of integers of any
+ length, or None. If seed is None, then RandomState will try to read data
+ from /dev/urandom (or the Windows analogue) if available or seed from
+ the clock otherwise.
+ """
+ cdef rk_error errcode
+ cdef ndarray obj "arrayObject_obj"
+ if seed is None:
+ errcode = rk_randomseed(self.internal_state)
+ elif type(seed) is int:
+ rk_seed(seed, self.internal_state)
+ else:
+ obj = <ndarray>PyArray_ContiguousFromObject(seed, NPY_LONG, 1, 1)
+ init_by_array(self.internal_state, <unsigned long *>(obj.data),
+ obj.dimensions[0])
+
+ def get_state(self):
+ """Return a tuple representing the internal state of the generator.
+
+ get_state() -> ('MT19937', int key[624], int pos)
+ """
+ cdef ndarray state "arrayObject_state"
+ state = <ndarray>_sp.empty(624, _sp.uint)
+ memcpy(<void*>(state.data), <void*>(self.internal_state.key), 624*sizeof(long))
+ state = <ndarray>_sp.asarray(state, _sp.uint32)
+ return ('MT19937', state, self.internal_state.pos)
+
+ def set_state(self, state):
+ """Set the state from a tuple.
+
+ state = ('MT19937', int key[624], int pos)
+
+ set_state(state)
+ """
+ cdef ndarray obj "arrayObject_obj"
+ cdef int pos
+ algorithm_name = state[0]
+ if algorithm_name != 'MT19937':
+ raise ValueError("algorithm must be 'MT19937'")
+ key, pos = state[1:]
+ try:
+ obj = <ndarray>PyArray_ContiguousFromObject(key, NPY_ULONG, 1, 1)
+ except TypeError:
+ # compatibility -- could be an older pickle
+ obj = <ndarray>PyArray_ContiguousFromObject(key, NPY_LONG, 1, 1)
+ if obj.dimensions[0] != 624:
+ raise ValueError("state must be 624 longs")
+ memcpy(<void*>(self.internal_state.key), <void*>(obj.data), 624*sizeof(long))
+ self.internal_state.pos = pos
+
+ # Pickling support:
+ def __getstate__(self):
+ return self.get_state()
+
+ def __setstate__(self, state):
+ self.set_state(state)
+
+ def __reduce__(self):
+ return (_sp.random.__RandomState_ctor, (), self.get_state())
+
+ # Basic distributions:
+ def random_sample(self, size=None):
+ """Return random floats in the half-open interval [0.0, 1.0).
+
+ random_sample(size=None) -> random values
+ """
+ return cont0_array(self.internal_state, rk_double, size)
+
+ def tomaxint(self, size=None):
+ """Returns random integers x such that 0 <= x <= sys.maxint.
+
+ tomaxint(size=None) -> random values
+ """
+ return disc0_array(self.internal_state, rk_long, size)
+
+ def randint(self, low, high=None, size=None):
+ """Return random integers x such that low <= x < high.
+
+ randint(low, high=None, size=None) -> random values
+
+ If high is None, then 0 <= x < low.
+ """
+ cdef long lo, hi, diff
+ cdef long *array_data
+ cdef ndarray array "arrayObject"
+ cdef long length
+ cdef long i
+
+ if high is None:
+ lo = 0
+ hi = low
+ else:
+ lo = low
+ hi = high
+
+ diff = hi - lo - 1
+ if diff < 0:
+ raise ValueError("low >= high")
+
+ if size is None:
+ return rk_interval(diff, self.internal_state) + lo
+ else:
+ array = <ndarray>_sp.empty(size, int)
+ length = PyArray_SIZE(array)
+ array_data = <long *>array.data
+ for i from 0 <= i < length:
+ array_data[i] = lo + <long>rk_interval(diff, self.internal_state)
+ return array
+
+ def bytes(self, unsigned int length):
+ """Return random bytes.
+
+ bytes(length) -> str
+ """
+ cdef void *bytes
+ bytestring = PyString_FromStringAndSize(NULL, length)
+ bytes = PyString_AS_STRING(bytestring)
+ rk_fill(bytes, length, self.internal_state)
+ return bytestring
+
+ def uniform(self, low=0.0, high=1.0, size=None):
+ """Uniform distribution over [low, high).
+
+ uniform(low=0.0, high=1.0, size=None) -> random values
+ """
+ cdef ndarray olow, ohigh, odiff
+ cdef double flow, fhigh
+ cdef object temp
+
+ flow = PyFloat_AsDouble(low)
+ fhigh = PyFloat_AsDouble(high)
+ if not PyErr_Occurred():
+ return cont2_array_sc(self.internal_state, rk_uniform, size, flow, fhigh-flow)
+ PyErr_Clear()
+ olow = <ndarray>PyArray_FROM_OTF(low, NPY_DOUBLE, NPY_ALIGNED)
+ ohigh = <ndarray>PyArray_FROM_OTF(high, NPY_DOUBLE, NPY_ALIGNED)
+ temp = _sp.subtract(ohigh, olow)
+ Py_INCREF(temp) # needed to get around Pyrex's automatic reference-counting
+ # rules because EnsureArray steals a reference
+ odiff = <ndarray>PyArray_EnsureArray(temp)
+ return cont2_array(self.internal_state, rk_uniform, size, olow, odiff)
+
+ def rand(self, *args):
+ """Return an array of the given dimensions which is initialized to
+ random numbers from a uniform distribution in the range [0,1).
+
+ rand(d0, d1, ..., dn) -> random values
+
+ Note: This is a convenience function. If you want an
+ interface that takes a tuple as the first argument
+ use numpy.random.random_sample(shape_tuple).
+
+ """
+ if len(args) == 0:
+ return self.random_sample()
+ else:
+ return self.random_sample(size=args)
+
+ def randn(self, *args):
+ """Returns zero-mean, unit-variance Gaussian random numbers in an
+ array of shape (d0, d1, ..., dn).
+
+ randn(d0, d1, ..., dn) -> random values
+
+ Note: This is a convenience function. If you want an
+ interface that takes a tuple as the first argument
+ use numpy.random.standard_normal(shape_tuple).
+ """
+ if len(args) == 0:
+ return self.standard_normal()
+ else:
+ return self.standard_normal(args)
+
+ def random_integers(self, low, high=None, size=None):
+ """Return random integers x such that low <= x <= high.
+
+ random_integers(low, high=None, size=None) -> random values.
+
+ If high is None, then 1 <= x <= low.
+ """
+ if high is None:
+ high = low
+ low = 1
+ return self.randint(low, high+1, size)
+
+ # Complicated, continuous distributions:
+ def standard_normal(self, size=None):
+ """Standard Normal distribution (mean=0, stdev=1).
+
+ standard_normal(size=None) -> random values
+ """
+ return cont0_array(self.internal_state, rk_gauss, size)
+
+ def normal(self, loc=0.0, scale=1.0, size=None):
+ """Normal distribution (mean=loc, stdev=scale).
+
+ normal(loc=0.0, scale=1.0, size=None) -> random values
+ """
+ cdef ndarray oloc, oscale
+ cdef double floc, fscale
+
+ floc = PyFloat_AsDouble(loc)
+ fscale = PyFloat_AsDouble(scale)
+ if not PyErr_Occurred():
+ if fscale <= 0:
+ raise ValueError("scale <= 0")
+ return cont2_array_sc(self.internal_state, rk_normal, size, floc, fscale)
+
+ PyErr_Clear()
+
+ oloc = <ndarray>PyArray_FROM_OTF(loc, NPY_DOUBLE, NPY_ALIGNED)
+ oscale = <ndarray>PyArray_FROM_OTF(scale, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(oscale, 0)):
+ raise ValueError("scale <= 0")
+ return cont2_array(self.internal_state, rk_normal, size, oloc, oscale)
+
+ def beta(self, a, b, size=None):
+ """Beta distribution over [0, 1].
+
+ beta(a, b, size=None) -> random values
+ """
+ cdef ndarray oa, ob
+ cdef double fa, fb
+
+ fa = PyFloat_AsDouble(a)
+ fb = PyFloat_AsDouble(b)
+ if not PyErr_Occurred():
+ if fa <= 0:
+ raise ValueError("a <= 0")
+ if fb <= 0:
+ raise ValueError("b <= 0")
+ return cont2_array_sc(self.internal_state, rk_beta, size, fa, fb)
+
+ PyErr_Clear()
+
+ oa = <ndarray>PyArray_FROM_OTF(a, NPY_DOUBLE, NPY_ALIGNED)
+ ob = <ndarray>PyArray_FROM_OTF(b, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(oa, 0)):
+ raise ValueError("a <= 0")
+ if _sp.any(_sp.less_equal(ob, 0)):
+ raise ValueError("b <= 0")
+ return cont2_array(self.internal_state, rk_beta, size, oa, ob)
+
+ def exponential(self, scale=1.0, size=None):
+ """Exponential distribution.
+
+ exponential(scale=1.0, size=None) -> random values
+ """
+ cdef ndarray oscale
+ cdef double fscale
+
+ fscale = PyFloat_AsDouble(scale)
+ if not PyErr_Occurred():
+ if fscale <= 0:
+ raise ValueError("scale <= 0")
+ return cont1_array_sc(self.internal_state, rk_exponential, size, fscale)
+
+ PyErr_Clear()
+
+ oscale = <ndarray> PyArray_FROM_OTF(scale, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(oscale, 0.0)):
+ raise ValueError("scale <= 0")
+ return cont1_array(self.internal_state, rk_exponential, size, oscale)
+
+ def standard_exponential(self, size=None):
+ """Standard exponential distribution (scale=1).
+
+ standard_exponential(size=None) -> random values
+ """
+ return cont0_array(self.internal_state, rk_standard_exponential, size)
+
+ def standard_gamma(self, shape, size=None):
+ """Standard Gamma distribution.
+
+ standard_gamma(shape, size=None) -> random values
+ """
+ cdef ndarray oshape
+ cdef double fshape
+
+ fshape = PyFloat_AsDouble(shape)
+ if not PyErr_Occurred():
+ if fshape <= 0:
+ raise ValueError("shape <= 0")
+ return cont1_array_sc(self.internal_state, rk_standard_gamma, size, fshape)
+
+ PyErr_Clear()
+ oshape = <ndarray> PyArray_FROM_OTF(shape, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(oshape, 0.0)):
+ raise ValueError("shape <= 0")
+ return cont1_array(self.internal_state, rk_standard_gamma, size, oshape)
+
+ def gamma(self, shape, scale=1.0, size=None):
+ """Gamma distribution.
+
+ gamma(shape, scale=1.0, size=None) -> random values
+ """
+ cdef ndarray oshape, oscale
+ cdef double fshape, fscale
+
+ fshape = PyFloat_AsDouble(shape)
+ fscale = PyFloat_AsDouble(scale)
+ if not PyErr_Occurred():
+ if fshape <= 0:
+ raise ValueError("shape <= 0")
+ if fscale <= 0:
+ raise ValueError("scale <= 0")
+ return cont2_array_sc(self.internal_state, rk_gamma, size, fshape, fscale)
+
+ PyErr_Clear()
+ oshape = <ndarray>PyArray_FROM_OTF(shape, NPY_DOUBLE, NPY_ALIGNED)
+ oscale = <ndarray>PyArray_FROM_OTF(scale, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(oshape, 0.0)):
+ raise ValueError("shape <= 0")
+ if _sp.any(_sp.less_equal(oscale, 0.0)):
+ raise ValueError("scale <= 0")
+ return cont2_array(self.internal_state, rk_gamma, size, oshape, oscale)
+
+ def f(self, dfnum, dfden, size=None):
+ """F distribution.
+
+ f(dfnum, dfden, size=None) -> random values
+ """
+ cdef ndarray odfnum, odfden
+ cdef double fdfnum, fdfden
+
+ fdfnum = PyFloat_AsDouble(dfnum)
+ fdfden = PyFloat_AsDouble(dfden)
+ if not PyErr_Occurred():
+ if fdfnum <= 0:
+ raise ValueError("shape <= 0")
+ if fdfden <= 0:
+ raise ValueError("scale <= 0")
+ return cont2_array_sc(self.internal_state, rk_f, size, fdfnum, fdfden)
+
+ PyErr_Clear()
+
+ odfnum = <ndarray>PyArray_FROM_OTF(dfnum, NPY_DOUBLE, NPY_ALIGNED)
+ odfden = <ndarray>PyArray_FROM_OTF(dfden, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(odfnum, 0.0)):
+ raise ValueError("dfnum <= 0")
+ if _sp.any(_sp.less_equal(odfden, 0.0)):
+ raise ValueError("dfden <= 0")
+ return cont2_array(self.internal_state, rk_f, size, odfnum, odfden)
+
+ def noncentral_f(self, dfnum, dfden, nonc, size=None):
+ """Noncentral F distribution.
+
+ noncentral_f(dfnum, dfden, nonc, size=None) -> random values
+ """
+ cdef ndarray odfnum, odfden, ononc
+ cdef double fdfnum, fdfden, fnonc
+
+ fdfnum = PyFloat_AsDouble(dfnum)
+ fdfden = PyFloat_AsDouble(dfden)
+ fnonc = PyFloat_AsDouble(nonc)
+ if not PyErr_Occurred():
+ if fdfnum <= 1:
+ raise ValueError("dfnum <= 1")
+ if fdfden <= 0:
+ raise ValueError("dfden <= 0")
+ if fnonc < 0:
+ raise ValueError("nonc < 0")
+ return cont3_array_sc(self.internal_state, rk_noncentral_f, size,
+ fdfnum, fdfden, fnonc)
+
+ PyErr_Clear()
+
+ odfnum = <ndarray>PyArray_FROM_OTF(dfnum, NPY_DOUBLE, NPY_ALIGNED)
+ odfden = <ndarray>PyArray_FROM_OTF(dfden, NPY_DOUBLE, NPY_ALIGNED)
+ ononc = <ndarray>PyArray_FROM_OTF(nonc, NPY_DOUBLE, NPY_ALIGNED)
+
+ if _sp.any(_sp.less_equal(odfnum, 1.0)):
+ raise ValueError("dfnum <= 1")
+ if _sp.any(_sp.less_equal(odfden, 0.0)):
+ raise ValueError("dfden <= 0")
+ if _sp.any(_sp.less(ononc, 0.0)):
+ raise ValueError("nonc < 0")
+ return cont3_array(self.internal_state, rk_noncentral_f, size, odfnum,
+ odfden, ononc)
+
+ def chisquare(self, df, size=None):
+ """Chi^2 distribution.
+
+ chisquare(df, size=None) -> random values
+ """
+ cdef ndarray odf
+ cdef double fdf
+
+ fdf = PyFloat_AsDouble(df)
+ if not PyErr_Occurred():
+ if fdf <= 0:
+ raise ValueError("df <= 0")
+ return cont1_array_sc(self.internal_state, rk_chisquare, size, fdf)
+
+ PyErr_Clear()
+
+ odf = <ndarray>PyArray_FROM_OTF(df, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(odf, 0.0)):
+ raise ValueError("df <= 0")
+ return cont1_array(self.internal_state, rk_chisquare, size, odf)
+
+ def noncentral_chisquare(self, df, nonc, size=None):
+ """Noncentral Chi^2 distribution.
+
+ noncentral_chisquare(df, nonc, size=None) -> random values
+ """
+ cdef ndarray odf, ononc
+ cdef double fdf, fnonc
+ fdf = PyFloat_AsDouble(df)
+ fnonc = PyFloat_AsDouble(nonc)
+ if not PyErr_Occurred():
+ if fdf <= 1:
+ raise ValueError("df <= 0")
+ if fnonc <= 0:
+ raise ValueError("nonc <= 0")
+ return cont2_array_sc(self.internal_state, rk_noncentral_chisquare,
+ size, fdf, fnonc)
+
+ PyErr_Clear()
+
+ odf = <ndarray>PyArray_FROM_OTF(df, NPY_DOUBLE, NPY_ALIGNED)
+ ononc = <ndarray>PyArray_FROM_OTF(nonc, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(odf, 0.0)):
+ raise ValueError("df <= 1")
+ if _sp.any(_sp.less_equal(ononc, 0.0)):
+ raise ValueError("nonc < 0")
+ return cont2_array(self.internal_state, rk_noncentral_chisquare, size,
+ odf, ononc)
+
+ def standard_cauchy(self, size=None):
+ """Standard Cauchy with mode=0.
+
+ standard_cauchy(size=None)
+ """
+ return cont0_array(self.internal_state, rk_standard_cauchy, size)
+
+ def standard_t(self, df, size=None):
+ """Standard Student's t distribution with df degrees of freedom.
+
+ standard_t(df, size=None)
+ """
+ cdef ndarray odf
+ cdef double fdf
+
+ fdf = PyFloat_AsDouble(df)
+ if not PyErr_Occurred():
+ if fdf <= 0:
+ raise ValueError("df <= 0")
+ return cont1_array_sc(self.internal_state, rk_standard_t, size, fdf)
+
+ PyErr_Clear()
+
+ odf = <ndarray> PyArray_FROM_OTF(df, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(odf, 0.0)):
+ raise ValueError("df <= 0")
+ return cont1_array(self.internal_state, rk_standard_t, size, odf)
+
+ def vonmises(self, mu, kappa, size=None):
+ """von Mises circular distribution with mode mu and dispersion parameter
+ kappa on [-pi, pi].
+
+ vonmises(mu, kappa, size=None)
+ """
+ cdef ndarray omu, okappa
+ cdef double fmu, fkappa
+
+ fmu = PyFloat_AsDouble(mu)
+ fkappa = PyFloat_AsDouble(kappa)
+ if not PyErr_Occurred():
+ if fkappa < 0:
+ raise ValueError("kappa < 0")
+ return cont2_array_sc(self.internal_state, rk_vonmises, size, fmu, fkappa)
+
+ PyErr_Clear()
+
+ omu = <ndarray> PyArray_FROM_OTF(mu, NPY_DOUBLE, NPY_ALIGNED)
+ okappa = <ndarray> PyArray_FROM_OTF(kappa, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less(okappa, 0.0)):
+ raise ValueError("kappa < 0")
+ return cont2_array(self.internal_state, rk_vonmises, size, omu, okappa)
+
+ def pareto(self, a, size=None):
+ """Pareto distribution.
+
+ pareto(a, size=None)
+ """
+ cdef ndarray oa
+ cdef double fa
+
+ fa = PyFloat_AsDouble(a)
+ if not PyErr_Occurred():
+ if fa <= 0:
+ raise ValueError("a <= 0")
+ return cont1_array_sc(self.internal_state, rk_pareto, size, fa)
+
+ PyErr_Clear()
+
+ oa = <ndarray>PyArray_FROM_OTF(a, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(oa, 0.0)):
+ raise ValueError("a <= 0")
+ return cont1_array(self.internal_state, rk_pareto, size, oa)
+
+ def weibull(self, a, size=None):
+ """Weibull distribution.
+
+ weibull(a, size=None)
+ """
+ cdef ndarray oa
+ cdef double fa
+
+ fa = PyFloat_AsDouble(a)
+ if not PyErr_Occurred():
+ if fa <= 0:
+ raise ValueError("a <= 0")
+ return cont1_array_sc(self.internal_state, rk_weibull, size, fa)
+
+ PyErr_Clear()
+
+ oa = <ndarray>PyArray_FROM_OTF(a, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(oa, 0.0)):
+ raise ValueError("a <= 0")
+ return cont1_array(self.internal_state, rk_weibull, size, oa)
+
+ def power(self, a, size=None):
+ """Power distribution.
+
+ power(a, size=None)
+ """
+ cdef ndarray oa
+ cdef double fa
+
+ fa = PyFloat_AsDouble(a)
+ if not PyErr_Occurred():
+ if fa <= 0:
+ raise ValueError("a <= 0")
+ return cont1_array_sc(self.internal_state, rk_power, size, fa)
+
+ PyErr_Clear()
+
+ oa = <ndarray>PyArray_FROM_OTF(a, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(oa, 0.0)):
+ raise ValueError("a <= 0")
+ return cont1_array(self.internal_state, rk_power, size, oa)
+
+ def laplace(self, loc=0.0, scale=1.0, size=None):
+ """Laplace distribution.
+
+ laplace(loc=0.0, scale=1.0, size=None)
+ """
+ cdef ndarray oloc, oscale
+ cdef double floc, fscale
+
+ floc = PyFloat_AsDouble(loc)
+ fscale = PyFloat_AsDouble(scale)
+ if not PyErr_Occurred():
+ if fscale <= 0:
+ raise ValueError("scale <= 0")
+ return cont2_array_sc(self.internal_state, rk_laplace, size, floc, fscale)
+
+ PyErr_Clear()
+ oloc = PyArray_FROM_OTF(loc, NPY_DOUBLE, NPY_ALIGNED)
+ oscale = PyArray_FROM_OTF(scale, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(oscale, 0.0)):
+ raise ValueError("scale <= 0")
+ return cont2_array(self.internal_state, rk_laplace, size, oloc, oscale)
+
+ def gumbel(self, loc=0.0, scale=1.0, size=None):
+ """Gumbel distribution.
+
+ gumbel(loc=0.0, scale=1.0, size=None)
+ """
+ cdef ndarray oloc, oscale
+ cdef double floc, fscale
+
+ floc = PyFloat_AsDouble(loc)
+ fscale = PyFloat_AsDouble(scale)
+ if not PyErr_Occurred():
+ if fscale <= 0:
+ raise ValueError("scale <= 0")
+ return cont2_array_sc(self.internal_state, rk_gumbel, size, floc, fscale)
+
+ PyErr_Clear()
+ oloc = PyArray_FROM_OTF(loc, NPY_DOUBLE, NPY_ALIGNED)
+ oscale = PyArray_FROM_OTF(scale, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(oscale, 0.0)):
+ raise ValueError("scale <= 0")
+ return cont2_array(self.internal_state, rk_gumbel, size, oloc, oscale)
+
+ def logistic(self, loc=0.0, scale=1.0, size=None):
+ """Logistic distribution.
+
+ logistic(loc=0.0, scale=1.0, size=None)
+ """
+ cdef ndarray oloc, oscale
+ cdef double floc, fscale
+
+ floc = PyFloat_AsDouble(loc)
+ fscale = PyFloat_AsDouble(scale)
+ if not PyErr_Occurred():
+ if fscale <= 0:
+ raise ValueError("scale <= 0")
+ return cont2_array_sc(self.internal_state, rk_logistic, size, floc, fscale)
+
+ PyErr_Clear()
+ oloc = PyArray_FROM_OTF(loc, NPY_DOUBLE, NPY_ALIGNED)
+ oscale = PyArray_FROM_OTF(scale, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(oscale, 0.0)):
+ raise ValueError("scale <= 0")
+ return cont2_array(self.internal_state, rk_logistic, size, oloc, oscale)
+
+ def lognormal(self, mean=0.0, sigma=1.0, size=None):
+ """Log-normal distribution.
+
+ Note that the mean parameter is not the mean of this distribution, but
+ the underlying normal distribution.
+
+ lognormal(mean, sigma) <=> exp(normal(mean, sigma))
+
+ lognormal(mean=0.0, sigma=1.0, size=None)
+ """
+ cdef ndarray omean, osigma
+ cdef double fmean, fsigma
+
+ fmean = PyFloat_AsDouble(mean)
+ fsigma = PyFloat_AsDouble(sigma)
+
+ if not PyErr_Occurred():
+ if fsigma <= 0:
+ raise ValueError("sigma <= 0")
+ return cont2_array_sc(self.internal_state, rk_lognormal, size, fmean, fsigma)
+
+ PyErr_Clear()
+
+ omean = PyArray_FROM_OTF(mean, NPY_DOUBLE, NPY_ALIGNED)
+ osigma = PyArray_FROM_OTF(sigma, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(osigma, 0.0)):
+ raise ValueError("sigma <= 0.0")
+ return cont2_array(self.internal_state, rk_lognormal, size, omean, osigma)
+
+ def rayleigh(self, scale=1.0, size=None):
+ """Rayleigh distribution.
+
+ rayleigh(scale=1.0, size=None)
+ """
+ cdef ndarray oscale
+ cdef double fscale
+
+ fscale = PyFloat_AsDouble(scale)
+
+ if not PyErr_Occurred():
+ if fscale <= 0:
+ raise ValueError("scale <= 0")
+ return cont1_array_sc(self.internal_state, rk_rayleigh, size, fscale)
+
+ PyErr_Clear()
+
+ oscale = <ndarray>PyArray_FROM_OTF(scale, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(oscale, 0.0)):
+ raise ValueError("scale <= 0.0")
+ return cont1_array(self.internal_state, rk_rayleigh, size, oscale)
+
+ def wald(self, mean, scale, size=None):
+ """Wald (inverse Gaussian) distribution.
+
+ wald(mean, scale, size=None)
+ """
+ cdef ndarray omean, oscale
+ cdef double fmean, fscale
+
+ fmean = PyFloat_AsDouble(mean)
+ fscale = PyFloat_AsDouble(scale)
+ if not PyErr_Occurred():
+ if fmean <= 0:
+ raise ValueError("mean <= 0")
+ if fscale <= 0:
+ raise ValueError("scale <= 0")
+ return cont2_array_sc(self.internal_state, rk_wald, size, fmean, fscale)
+
+ PyErr_Clear()
+ omean = PyArray_FROM_OTF(mean, NPY_DOUBLE, NPY_ALIGNED)
+ oscale = PyArray_FROM_OTF(scale, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(omean,0.0)):
+ raise ValueError("mean <= 0.0")
+ elif _sp.any(_sp.less_equal(oscale,0.0)):
+ raise ValueError("scale <= 0.0")
+ return cont2_array(self.internal_state, rk_wald, size, omean, oscale)
+
+
+
+ def triangular(self, left, mode, right, size=None):
+ """Triangular distribution starting at left, peaking at mode, and
+ ending at right (left <= mode <= right).
+
+ triangular(left, mode, right, size=None)
+ """
+ cdef ndarray oleft, omode, oright
+ cdef double fleft, fmode, fright
+
+ fleft = PyFloat_AsDouble(left)
+ fright = PyFloat_AsDouble(right)
+ fmode = PyFloat_AsDouble(mode)
+ if not PyErr_Occurred():
+ if fleft > fmode:
+ raise ValueError("left > mode")
+ if fmode > fright:
+ raise ValueError("mode > right")
+ if fleft == fright:
+ raise ValueError("left == right")
+ return cont3_array_sc(self.internal_state, rk_triangular, size, fleft,
+ fmode, fright)
+
+ PyErr_Clear()
+ oleft = <ndarray>PyArray_FROM_OTF(left, NPY_DOUBLE, NPY_ALIGNED)
+ omode = <ndarray>PyArray_FROM_OTF(mode, NPY_DOUBLE, NPY_ALIGNED)
+ oright = <ndarray>PyArray_FROM_OTF(right, NPY_DOUBLE, NPY_ALIGNED)
+
+ if _sp.any(_sp.greater(oleft, omode)):
+ raise ValueError("left > mode")
+ if _sp.any(_sp.greater(omode, oright)):
+ raise ValueError("mode > right")
+ if _sp.any(_sp.equal(oleft, oright)):
+ raise ValueError("left == right")
+ return cont3_array(self.internal_state, rk_triangular, size, oleft,
+ omode, oright)
+
+ # Complicated, discrete distributions:
+ def binomial(self, n, p, size=None):
+ """Binomial distribution of n trials and p probability of success.
+
+ binomial(n, p, size=None) -> random values
+ """
+ cdef ndarray on, op
+ cdef long ln
+ cdef double fp
+
+ fp = PyFloat_AsDouble(p)
+ ln = PyInt_AsLong(n)
+ if not PyErr_Occurred():
+ if ln <= 0:
+ raise ValueError("n <= 0")
+ if fp < 0:
+ raise ValueError("p < 0")
+ elif fp > 1:
+ raise ValueError("p > 1")
+ return discnp_array_sc(self.internal_state, rk_binomial, size, ln, fp)
+
+ PyErr_Clear()
+
+ on = <ndarray>PyArray_FROM_OTF(n, NPY_LONG, NPY_ALIGNED)
+ op = <ndarray>PyArray_FROM_OTF(p, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(n, 0)):
+ raise ValueError("n <= 0")
+ if _sp.any(_sp.less(p, 0)):
+ raise ValueError("p < 0")
+ if _sp.any(_sp.greater(p, 1)):
+ raise ValueError("p > 1")
+ return discnp_array(self.internal_state, rk_binomial, size, on, op)
+
+ def negative_binomial(self, n, p, size=None):
+ """Negative Binomial distribution.
+
+ negative_binomial(n, p, size=None) -> random values
+ """
+ cdef ndarray on
+ cdef ndarray op
+ cdef long ln
+ cdef double fp
+
+ fp = PyFloat_AsDouble(p)
+ ln = PyInt_AsLong(n)
+ if not PyErr_Occurred():
+ if ln <= 0:
+ raise ValueError("n <= 0")
+ if fp < 0:
+ raise ValueError("p < 0")
+ elif fp > 1:
+ raise ValueError("p > 1")
+ return discnp_array_sc(self.internal_state, rk_negative_binomial,
+ size, ln, fp)
+
+ PyErr_Clear()
+
+ on = <ndarray>PyArray_FROM_OTF(n, NPY_LONG, NPY_ALIGNED)
+ op = <ndarray>PyArray_FROM_OTF(p, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(n, 0)):
+ raise ValueError("n <= 0")
+ if _sp.any(_sp.less(p, 0)):
+ raise ValueError("p < 0")
+ if _sp.any(_sp.greater(p, 1)):
+ raise ValueError("p > 1")
+ return discnp_array(self.internal_state, rk_negative_binomial, size,
+ on, op)
+
+ def poisson(self, lam=1.0, size=None):
+ """Poisson distribution.
+
+ poisson(lam=1.0, size=None) -> random values
+ """
+ cdef ndarray olam
+ cdef double flam
+ flam = PyFloat_AsDouble(lam)
+ if not PyErr_Occurred():
+ if lam < 0:
+ raise ValueError("lam < 0")
+ return discd_array_sc(self.internal_state, rk_poisson, size, flam)
+
+ PyErr_Clear()
+
+ olam = <ndarray>PyArray_FROM_OTF(lam, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less(olam, 0)):
+ raise ValueError("lam < 0")
+ return discd_array(self.internal_state, rk_poisson, size, olam)
+
+ def zipf(self, a, size=None):
+ """Zipf distribution.
+
+ zipf(a, size=None)
+ """
+ cdef ndarray oa
+ cdef double fa
+
+ fa = PyFloat_AsDouble(a)
+ if not PyErr_Occurred():
+ if fa <= 1.0:
+ raise ValueError("a <= 1.0")
+ return discd_array_sc(self.internal_state, rk_zipf, size, fa)
+
+ PyErr_Clear()
+
+ oa = <ndarray>PyArray_FROM_OTF(a, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less_equal(oa, 1.0)):
+ raise ValueError("a <= 1.0")
+ return discd_array(self.internal_state, rk_zipf, size, oa)
+
+ def geometric(self, p, size=None):
+ """Geometric distribution with p being the probability of "success" on
+ an individual trial.
+
+ geometric(p, size=None)
+ """
+ cdef ndarray op
+ cdef double fp
+
+ fp = PyFloat_AsDouble(p)
+ if not PyErr_Occurred():
+ if fp < 0.0:
+ raise ValueError("p < 0.0")
+ if fp > 1.0:
+ raise ValueError("p > 1.0")
+ return discd_array_sc(self.internal_state, rk_geometric, size, fp)
+
+ PyErr_Clear()
+
+
+ op = <ndarray>PyArray_FROM_OTF(p, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less(op, 0.0)):
+ raise ValueError("p < 0.0")
+ if _sp.any(_sp.greater(op, 1.0)):
+ raise ValueError("p > 1.0")
+ return discd_array(self.internal_state, rk_geometric, size, op)
+
+ def hypergeometric(self, ngood, nbad, nsample, size=None):
+ """Hypergeometric distribution.
+
+ Consider an urn with ngood "good" balls and nbad "bad" balls. If one
+ were to draw nsample balls from the urn without replacement, then
+ the hypergeometric distribution describes the distribution of "good"
+ balls in the sample.
+
+ hypergeometric(ngood, nbad, nsample, size=None)
+ """
+ cdef ndarray ongood, onbad, onsample
+ cdef long lngood, lnbad, lnsample
+
+ lngood = PyInt_AsLong(ngood)
+ lnbad = PyInt_AsLong(nbad)
+ lnsample = PyInt_AsLong(nsample)
+ if not PyErr_Occurred():
+ if ngood < 1:
+ raise ValueError("ngood < 1")
+ if nbad < 1:
+ raise ValueError("nbad < 1")
+ if nsample < 1:
+ raise ValueError("nsample < 1")
+ if ngood + nbad < nsample:
+ raise ValueError("ngood + nbad < nsample")
+ return discnmN_array_sc(self.internal_state, rk_hypergeometric, size,
+ lngood, lnbad, lnsample)
+
+
+ PyErr_Clear()
+
+ ongood = <ndarray>PyArray_FROM_OTF(ngood, NPY_LONG, NPY_ALIGNED)
+ onbad = <ndarray>PyArray_FROM_OTF(nbad, NPY_LONG, NPY_ALIGNED)
+ onsample = <ndarray>PyArray_FROM_OTF(nsample, NPY_LONG, NPY_ALIGNED)
+ if _sp.any(_sp.less(ongood, 1)):
+ raise ValueError("ngood < 1")
+ if _sp.any(_sp.less(onbad, 1)):
+ raise ValueError("nbad < 1")
+ if _sp.any(_sp.less(onsample, 1)):
+ raise ValueError("nsample < 1")
+ if _sp.any(_sp.less(_sp.add(ongood, onbad),onsample)):
+ raise ValueError("ngood + nbad < nsample")
+ return discnmN_array(self.internal_state, rk_hypergeometric, size,
+ ongood, onbad, onsample)
+
+ def logseries(self, p, size=None):
+ """Logarithmic series distribution.
+
+ logseries(p, size=None)
+ """
+ cdef ndarray op
+ cdef double fp
+
+ fp = PyFloat_AsDouble(p)
+ if not PyErr_Occurred():
+ if fp < 0.0:
+ raise ValueError("p < 0.0")
+ if fp > 1.0:
+ raise ValueError("p > 1.0")
+ return discd_array_sc(self.internal_state, rk_logseries, size, fp)
+
+ PyErr_Clear()
+
+ op = <ndarray>PyArray_FROM_OTF(p, NPY_DOUBLE, NPY_ALIGNED)
+ if _sp.any(_sp.less(op, 0.0)):
+ raise ValueError("p < 0.0")
+ if _sp.any(_sp.greater(op, 1.0)):
+ raise ValueError("p > 1.0")
+ return discd_array(self.internal_state, rk_logseries, size, op)
+
+ # Multivariate distributions:
+ def multivariate_normal(self, mean, cov, size=None):
+ """Return an array containing multivariate normally distributed random numbers
+ with specified mean and covariance.
+
+ multivariate_normal(mean, cov) -> random values
+ multivariate_normal(mean, cov, [m, n, ...]) -> random values
+
+ mean must be a 1 dimensional array. cov must be a square two dimensional
+ array with the same number of rows and columns as mean has elements.
+
+ The first form returns a single 1-D array containing a multivariate
+ normal.
+
+ The second form returns an array of shape (m, n, ..., cov.shape[0]).
+ In this case, output[i,j,...,:] is a 1-D array containing a multivariate
+ normal.
+ """
+ # Check preconditions on arguments
+ mean = _sp.array(mean)
+ cov = _sp.array(cov)
+ if size is None:
+ shape = []
+ else:
+ shape = size
+ if len(mean.shape) != 1:
+ raise ValueError("mean must be 1 dimensional")
+ if (len(cov.shape) != 2) or (cov.shape[0] != cov.shape[1]):
+ raise ValueError("cov must be 2 dimensional and square")
+ if mean.shape[0] != cov.shape[0]:
+ raise ValueError("mean and cov must have same length")
+ # Compute shape of output
+ if isinstance(shape, int):
+ shape = [shape]
+ final_shape = list(shape[:])
+ final_shape.append(mean.shape[0])
+ # Create a matrix of independent standard normally distributed random
+ # numbers. The matrix has rows with the same length as mean and as
+ # many rows are necessary to form a matrix of shape final_shape.
+ x = standard_normal(_sp.multiply.reduce(final_shape))
+ x.shape = (_sp.multiply.reduce(final_shape[0:len(final_shape)-1]),
+ mean.shape[0])
+ # Transform matrix of standard normals into matrix where each row
+ # contains multivariate normals with the desired covariance.
+ # Compute A such that dot(transpose(A),A) == cov.
+ # Then the matrix products of the rows of x and A has the desired
+ # covariance. Note that sqrt(s)*v where (u,s,v) is the singular value
+ # decomposition of cov is such an A.
+
+ from numpy.dual import svd
+ # XXX: we really should be doing this by Cholesky decomposition
+ (u,s,v) = svd(cov)
+ x = _sp.dot(x*_sp.sqrt(s),v)
+ # The rows of x now have the correct covariance but mean 0. Add
+ # mean to each row. Then each row will have mean mean.
+ _sp.add(mean,x,x)
+ x.shape = tuple(final_shape)
+ return x
+
+ def multinomial(self, long n, object pvals, size=None):
+ """Multinomial distribution.
+
+ multinomial(n, pvals, size=None) -> random values
+
+ pvals is a sequence of probabilities that should sum to 1 (however, the
+ last element is always assumed to account for the remaining probability
+ as long as sum(pvals[:-1]) <= 1).
+ """
+ cdef long d
+ cdef ndarray parr "arrayObject_parr", mnarr "arrayObject_mnarr"
+ cdef double *pix
+ cdef long *mnix
+ cdef long i, j, dn
+ cdef double Sum
+
+ d = len(pvals)
+ parr = <ndarray>PyArray_ContiguousFromObject(pvals, NPY_DOUBLE, 1, 1)
+ pix = <double*>parr.data
+
+ if kahan_sum(pix, d-1) > 1.0:
+ raise ValueError("sum(pvals) > 1.0")
+
+ if size is None:
+ shape = (d,)
+ elif type(size) is int:
+ shape = (size, d)
+ else:
+ shape = size + (d,)
+
+ multin = _sp.zeros(shape, int)
+ mnarr = <ndarray>multin
+ mnix = <long*>mnarr.data
+ i = 0
+ while i < PyArray_SIZE(mnarr):
+ Sum = 1.0
+ dn = n
+ for j from 0 <= j < d-1:
+ mnix[i+j] = rk_binomial(self.internal_state, dn, pix[j]/Sum)
+ dn = dn - mnix[i+j]
+ if dn <= 0:
+ break
+ Sum = Sum - pix[j]
+ if dn > 0:
+ mnix[i+d-1] = dn
+
+ i = i + d
+
+ return multin
+
+ def dirichlet(self, object alpha, size=None):
+ """dirichlet(alpha, size=None)
+
+ Draw `size` samples of dimension k from a Dirichlet distribution. A
+ Dirichlet-distributed random variable can be seen as a multivariate
+ generalization of a Beta distribution. Dirichlet pdf is the conjugate
+ prior of a multinomial in Bayesian inference.
+
+ :Parameters:
+ alpha : array
+ parameter of the distribution (k dimension
+ for sample of dimension k).
+ size : array
+ number of samples to draw.
+
+ $X \approx \prod_{i=1}^{k}{x^{\alpha_i-1}_i}$
+
+ Uses the following property for computation: for each dimension,
+ draw a random sample y_i from a standard gamma generator of shape
+ alpha_i, then X = \frac{1}{\sum_{i=1}^k{y_i}} (y_1, ..., y_n) is
+ Dirichlet distributed.
+
+ Reference:
+ - David Mc Kay : Information Theory, inference and Learning
+ algorithms, chapter 23. the book is available for free at
+ http://www.inference.phy.cam.ac.uk/mackay/
+ """
+
+ #=================
+ # Pure python algo
+ #=================
+ #alpha = N.atleast_1d(alpha)
+ #k = alpha.size
+
+ #if n == 1:
+ # val = N.zeros(k)
+ # for i in range(k):
+ # val[i] = sgamma(alpha[i], n)
+ # val /= N.sum(val)
+ #else:
+ # val = N.zeros((k, n))
+ # for i in range(k):
+ # val[i] = sgamma(alpha[i], n)
+ # val /= N.sum(val, axis = 0)
+ # val = val.T
+
+ #return val
+
+ cdef long k
+ cdef long totsize
+ cdef ndarray alpha_arr, val_arr
+ cdef double *alpha_data, *val_data
+ cdef long i, j
+ cdef double acc, invacc
+
+ k = len(alpha)
+ alpha_arr = <ndarray>PyArray_ContiguousFromObject(alpha, NPY_DOUBLE, 1, 1)
+ alpha_data = <double*>alpha_arr.data
+
+ if size is None:
+ shape = (k,)
+ elif type(size) is int:
+ shape = (size, k)
+ else:
+ shape = size + (k,)
+
+ diric = _sp.zeros(shape, _sp.float64)
+ val_arr = <ndarray>diric
+ val_data= <double*>val_arr.data
+
+ i = 0
+ totsize = PyArray_SIZE(val_arr)
+ while i < totsize:
+ acc = 0.0
+ for j from 0 <= j < k:
+ val_data[i+j] = rk_standard_gamma(self.internal_state, alpha_data[j])
+ acc = acc + val_data[i+j]
+ invacc = 1/acc
+ for j from 0 <= j < k:
+ val_data[i+j] = val_data[i+j] * invacc
+ i = i + k
+
+ return diric
+
+ # Shuffling and permutations:
+ def shuffle(self, object x):
+ """Modify a sequence in-place by shuffling its contents.
+
+ shuffle(x)
+ """
+ cdef long i, j
+ cdef int copy
+
+ i = len(x) - 1
+ try:
+ j = len(x[0])
+ except:
+ j = 0
+
+ if (j == 0):
+ # adaptation of random.shuffle()
+ while i > 0:
+ j = rk_interval(i, self.internal_state)
+ x[i], x[j] = x[j], x[i]
+ i = i - 1
+ else:
+ # make copies
+ copy = hasattr(x[0], 'copy')
+ if copy:
+ while(i > 0):
+ j = rk_interval(i, self.internal_state)
+ x[i], x[j] = x[j].copy(), x[i].copy()
+ i = i - 1
+ else:
+ while(i > 0):
+ j = rk_interval(i, self.internal_state)
+ x[i], x[j] = x[j][:], x[i][:]
+ i = i - 1
+
+ def permutation(self, object x):
+ """Given an integer, return a shuffled sequence of integers >= 0 and
+ < x; given a sequence, return a shuffled array copy.
+
+ permutation(x)
+ """
+ if isinstance(x, (int, _sp.integer)):
+ arr = _sp.arange(x)
+ else:
+ arr = _sp.array(x)
+ self.shuffle(arr)
+ return arr
+
+_rand = RandomState()
+seed = _rand.seed
+get_state = _rand.get_state
+set_state = _rand.set_state
+random_sample = _rand.random_sample
+randint = _rand.randint
+bytes = _rand.bytes
+uniform = _rand.uniform
+rand = _rand.rand
+randn = _rand.randn
+random_integers = _rand.random_integers
+standard_normal = _rand.standard_normal
+normal = _rand.normal
+beta = _rand.beta
+exponential = _rand.exponential
+standard_exponential = _rand.standard_exponential
+standard_gamma = _rand.standard_gamma
+gamma = _rand.gamma
+f = _rand.f
+noncentral_f = _rand.noncentral_f
+chisquare = _rand.chisquare
+noncentral_chisquare = _rand.noncentral_chisquare
+standard_cauchy = _rand.standard_cauchy
+standard_t = _rand.standard_t
+vonmises = _rand.vonmises
+pareto = _rand.pareto
+weibull = _rand.weibull
+power = _rand.power
+laplace = _rand.laplace
+gumbel = _rand.gumbel
+logistic = _rand.logistic
+lognormal = _rand.lognormal
+rayleigh = _rand.rayleigh
+wald = _rand.wald
+triangular = _rand.triangular
+
+binomial = _rand.binomial
+negative_binomial = _rand.negative_binomial
+poisson = _rand.poisson
+zipf = _rand.zipf
+geometric = _rand.geometric
+hypergeometric = _rand.hypergeometric
+logseries = _rand.logseries
+
+multivariate_normal = _rand.multivariate_normal
+multinomial = _rand.multinomial
+dirichlet = _rand.dirichlet
+
+shuffle = _rand.shuffle
+permutation = _rand.permutation
diff --git a/numpy/random/mtrand/numpy.pxi b/numpy/random/mtrand/numpy.pxi
new file mode 100644
index 000000000..11cb8fac9
--- /dev/null
+++ b/numpy/random/mtrand/numpy.pxi
@@ -0,0 +1,133 @@
+# :Author: Travis Oliphant
+
+cdef extern from "numpy/arrayobject.h":
+
+ cdef enum NPY_TYPES:
+ NPY_BOOL
+ NPY_BYTE
+ NPY_UBYTE
+ NPY_SHORT
+ NPY_USHORT
+ NPY_INT
+ NPY_UINT
+ NPY_LONG
+ NPY_ULONG
+ NPY_LONGLONG
+ NPY_ULONGLONG
+ NPY_FLOAT
+ NPY_DOUBLE
+ NPY_LONGDOUBLE
+ NPY_CFLOAT
+ NPY_CDOUBLE
+ NPY_CLONGDOUBLE
+ NPY_OBJECT
+ NPY_STRING
+ NPY_UNICODE
+ NPY_VOID
+ NPY_NTYPES
+ NPY_NOTYPE
+
+ cdef enum requirements:
+ NPY_CONTIGUOUS
+ NPY_FORTRAN
+ NPY_OWNDATA
+ NPY_FORCECAST
+ NPY_ENSURECOPY
+ NPY_ENSUREARRAY
+ NPY_ELEMENTSTRIDES
+ NPY_ALIGNED
+ NPY_NOTSWAPPED
+ NPY_WRITEABLE
+ NPY_UPDATEIFCOPY
+ NPY_ARR_HAS_DESCR
+
+ NPY_BEHAVED
+ NPY_BEHAVED_NS
+ NPY_CARRAY
+ NPY_CARRAY_RO
+ NPY_FARRAY
+ NPY_FARRAY_RO
+ NPY_DEFAULT
+
+ NPY_IN_ARRAY
+ NPY_OUT_ARRAY
+ NPY_INOUT_ARRAY
+ NPY_IN_FARRAY
+ NPY_OUT_FARRAY
+ NPY_INOUT_FARRAY
+
+ NPY_UPDATE_ALL
+
+ cdef enum defines:
+ NPY_MAXDIMS
+
+ ctypedef struct npy_cdouble:
+ double real
+ double imag
+
+ ctypedef struct npy_cfloat:
+ double real
+ double imag
+
+ ctypedef int npy_intp
+
+ ctypedef extern class numpy.dtype [object PyArray_Descr]:
+ cdef int type_num, elsize, alignment
+ cdef char type, kind, byteorder, hasobject
+ cdef object fields, typeobj
+
+ ctypedef extern class numpy.ndarray [object PyArrayObject]:
+ cdef char *data
+ cdef int nd
+ cdef npy_intp *dimensions
+ cdef npy_intp *strides
+ cdef object base
+ cdef dtype descr
+ cdef int flags
+
+ ctypedef extern class numpy.flatiter [object PyArrayIterObject]:
+ cdef int nd_m1
+ cdef npy_intp index, size
+ cdef ndarray ao
+ cdef char *dataptr
+
+ ctypedef extern class numpy.broadcast [object PyArrayMultiIterObject]:
+ cdef int numiter
+ cdef npy_intp size, index
+ cdef int nd
+ cdef npy_intp *dimensions
+ cdef void **iters
+
+ object PyArray_ZEROS(int ndims, npy_intp* dims, NPY_TYPES type_num, int fortran)
+ object PyArray_EMPTY(int ndims, npy_intp* dims, NPY_TYPES type_num, int fortran)
+ dtype PyArray_DescrFromTypeNum(NPY_TYPES type_num)
+ object PyArray_SimpleNew(int ndims, npy_intp* dims, NPY_TYPES type_num)
+ int PyArray_Check(object obj)
+ object PyArray_ContiguousFromAny(object obj, NPY_TYPES type,
+ int mindim, int maxdim)
+ object PyArray_ContiguousFromObject(object obj, NPY_TYPES type,
+ int mindim, int maxdim)
+ npy_intp PyArray_SIZE(ndarray arr)
+ npy_intp PyArray_NBYTES(ndarray arr)
+ void *PyArray_DATA(ndarray arr)
+ object PyArray_FromAny(object obj, dtype newtype, int mindim, int maxdim,
+ int requirements, object context)
+ object PyArray_FROMANY(object obj, NPY_TYPES type_num, int min,
+ int max, int requirements)
+ object PyArray_NewFromDescr(object subtype, dtype newtype, int nd,
+ npy_intp* dims, npy_intp* strides, void* data,
+ int flags, object parent)
+
+ object PyArray_FROM_OTF(object obj, NPY_TYPES type, int flags)
+ object PyArray_EnsureArray(object)
+
+ object PyArray_MultiIterNew(int n, ...)
+
+ char *PyArray_MultiIter_DATA(broadcast multi, int i)
+ void PyArray_MultiIter_NEXTi(broadcast multi, int i)
+ void PyArray_MultiIter_NEXT(broadcast multi)
+
+ object PyArray_IterNew(object arr)
+ void PyArray_ITER_NEXT(flatiter it)
+
+ void import_array()
diff --git a/numpy/random/mtrand/randomkit.c b/numpy/random/mtrand/randomkit.c
new file mode 100644
index 000000000..56f52c0b4
--- /dev/null
+++ b/numpy/random/mtrand/randomkit.c
@@ -0,0 +1,365 @@
+/* Random kit 1.3 */
+
+/*
+ * Copyright (c) 2003-2005, Jean-Sebastien Roy (js@jeannot.org)
+ *
+ * The rk_random and rk_seed functions algorithms and the original design of
+ * the Mersenne Twister RNG:
+ *
+ * Copyright (C) 1997 - 2002, Makoto Matsumoto and Takuji Nishimura,
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of its contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
+ * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * Original algorithm for the implementation of rk_interval function from
+ * Richard J. Wagner's implementation of the Mersenne Twister RNG, optimised by
+ * Magnus Jonsson.
+ *
+ * Constants used in the rk_double implementation by Isaku Wada.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the
+ * "Software"), to deal in the Software without restriction, including
+ * without limitation the rights to use, copy, modify, merge, publish,
+ * distribute, sublicense, and/or sell copies of the Software, and to
+ * permit persons to whom the Software is furnished to do so, subject to
+ * the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included
+ * in all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+ * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+ * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+ * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+ * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+ * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ */
+
+/* static char const rcsid[] =
+ "@(#) $Jeannot: randomkit.c,v 1.28 2005/07/21 22:14:09 js Exp $"; */
+
+#include <stddef.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <errno.h>
+#include <time.h>
+#include <limits.h>
+#include <math.h>
+
+#ifdef _WIN32
+/* Windows */
+#include <sys/timeb.h>
+#ifndef RK_NO_WINCRYPT
+/* Windows crypto */
+#ifndef _WIN32_WINNT
+#define _WIN32_WINNT 0x0400
+#endif
+#include <windows.h>
+#include <wincrypt.h>
+#endif
+#else
+/* Unix */
+#include <sys/time.h>
+#include <unistd.h>
+#endif
+
+#include "randomkit.h"
+
+#ifndef RK_DEV_URANDOM
+#define RK_DEV_URANDOM "/dev/urandom"
+#endif
+
+#ifndef RK_DEV_RANDOM
+#define RK_DEV_RANDOM "/dev/random"
+#endif
+
+char *rk_strerror[RK_ERR_MAX] =
+{
+ "no error",
+ "random device unvavailable"
+};
+
+/* static functions */
+static unsigned long rk_hash(unsigned long key);
+
+void rk_seed(unsigned long seed, rk_state *state)
+{
+ int pos;
+ seed &= 0xffffffffUL;
+
+ /* Knuth's PRNG as used in the Mersenne Twister reference implementation */
+ for (pos=0; pos<RK_STATE_LEN; pos++)
+ {
+ state->key[pos] = seed;
+ seed = (1812433253UL * (seed ^ (seed >> 30)) + pos + 1) & 0xffffffffUL;
+ }
+
+ state->pos = RK_STATE_LEN;
+ state->has_gauss = 0;
+ state->has_binomial = 0;
+}
+
+/* Thomas Wang 32 bits integer hash function */
+unsigned long rk_hash(unsigned long key)
+{
+ key += ~(key << 15);
+ key ^= (key >> 10);
+ key += (key << 3);
+ key ^= (key >> 6);
+ key += ~(key << 11);
+ key ^= (key >> 16);
+ return key;
+}
+
+rk_error rk_randomseed(rk_state *state)
+{
+#ifndef _WIN32
+ struct timeval tv;
+#else
+ struct _timeb tv;
+#endif
+ int i;
+
+ if(rk_devfill(state->key, sizeof(state->key), 0) == RK_NOERR)
+ {
+ state->key[0] |= 0x80000000UL; /* ensures non-zero key */
+ state->pos = RK_STATE_LEN;
+ state->has_gauss = 0;
+ state->has_binomial = 0;
+
+ for (i=0; i<624; i++)
+ {
+ state->key[i] &= 0xffffffffUL;
+ }
+
+ return RK_NOERR;
+ }
+
+#ifndef _WIN32
+ gettimeofday(&tv, NULL);
+ rk_seed(rk_hash(getpid()) ^ rk_hash(tv.tv_sec) ^ rk_hash(tv.tv_usec)
+ ^ rk_hash(clock()), state);
+#else
+ _ftime(&tv);
+ rk_seed(rk_hash(tv.time) ^ rk_hash(tv.millitm) ^ rk_hash(clock()), state);
+#endif
+
+ return RK_ENODEV;
+}
+
+/* Magic Mersenne Twister constants */
+#define N 624
+#define M 397
+#define MATRIX_A 0x9908b0dfUL
+#define UPPER_MASK 0x80000000UL
+#define LOWER_MASK 0x7fffffffUL
+
+/* Slightly optimised reference implementation of the Mersenne Twister */
+unsigned long rk_random(rk_state *state)
+{
+ unsigned long y;
+
+ if (state->pos == RK_STATE_LEN)
+ {
+ int i;
+
+ for (i=0;i<N-M;i++)
+ {
+ y = (state->key[i] & UPPER_MASK) | (state->key[i+1] & LOWER_MASK);
+ state->key[i] = state->key[i+M] ^ (y>>1) ^ (-(y & 1) & MATRIX_A);
+ }
+ for (;i<N-1;i++)
+ {
+ y = (state->key[i] & UPPER_MASK) | (state->key[i+1] & LOWER_MASK);
+ state->key[i] = state->key[i+(M-N)] ^ (y>>1) ^ (-(y & 1) & MATRIX_A);
+ }
+ y = (state->key[N-1] & UPPER_MASK) | (state->key[0] & LOWER_MASK);
+ state->key[N-1] = state->key[M-1] ^ (y>>1) ^ (-(y & 1) & MATRIX_A);
+
+ state->pos = 0;
+ }
+
+ y = state->key[state->pos++];
+
+ /* Tempering */
+ y ^= (y >> 11);
+ y ^= (y << 7) & 0x9d2c5680UL;
+ y ^= (y << 15) & 0xefc60000UL;
+ y ^= (y >> 18);
+
+ return y;
+}
+
+long rk_long(rk_state *state)
+{
+ return rk_ulong(state) >> 1;
+}
+
+unsigned long rk_ulong(rk_state *state)
+{
+#if ULONG_MAX <= 0xffffffffUL
+ return rk_random(state);
+#else
+ return (rk_random(state) << 32) | (rk_random(state));
+#endif
+}
+
+unsigned long rk_interval(unsigned long max, rk_state *state)
+{
+ unsigned long mask = max, value;
+
+ if (max == 0) return 0;
+
+ /* Smallest bit mask >= max */
+ mask |= mask >> 1;
+ mask |= mask >> 2;
+ mask |= mask >> 4;
+ mask |= mask >> 8;
+ mask |= mask >> 16;
+#if ULONG_MAX > 0xffffffffUL
+ mask |= mask >> 32;
+#endif
+
+ /* Search a random value in [0..mask] <= max */
+#if ULONG_MAX > 0xffffffffUL
+ if (max <= 0xffffffffUL) {
+ while ((value = (rk_random(state) & mask)) > max);
+ } else {
+ while ((value = (rk_ulong(state) & mask)) > max);
+ }
+#else
+ while ((value = (rk_ulong(state) & mask)) > max);
+#endif
+
+ return value;
+}
+
+double rk_double(rk_state *state)
+{
+ /* shifts : 67108864 = 0x4000000, 9007199254740992 = 0x20000000000000 */
+ long a = rk_random(state) >> 5, b = rk_random(state) >> 6;
+ return (a * 67108864.0 + b) / 9007199254740992.0;
+}
+
+void rk_fill(void *buffer, size_t size, rk_state *state)
+{
+ unsigned long r;
+ unsigned char *buf = buffer;
+
+ for (; size >= 4; size -= 4)
+ {
+ r = rk_random(state);
+ *(buf++) = r & 0xFF;
+ *(buf++) = (r >> 8) & 0xFF;
+ *(buf++) = (r >> 16) & 0xFF;
+ *(buf++) = (r >> 24) & 0xFF;
+ }
+
+ if (!size) return;
+
+ r = rk_random(state);
+
+ for (; size; r >>= 8, size --)
+ *(buf++) = (unsigned char)(r & 0xFF);
+}
+
+rk_error rk_devfill(void *buffer, size_t size, int strong)
+{
+#ifndef _WIN32
+ FILE *rfile;
+ int done;
+
+ if (strong)
+ rfile = fopen(RK_DEV_RANDOM, "rb");
+ else
+ rfile = fopen(RK_DEV_URANDOM, "rb");
+ if (rfile == NULL)
+ return RK_ENODEV;
+ done = fread(buffer, size, 1, rfile);
+ fclose(rfile);
+ if (done)
+ return RK_NOERR;
+#else
+
+#ifndef RK_NO_WINCRYPT
+ HCRYPTPROV hCryptProv;
+ BOOL done;
+
+ if (!CryptAcquireContext(&hCryptProv, NULL, NULL, PROV_RSA_FULL,
+ CRYPT_VERIFYCONTEXT) || !hCryptProv)
+ return RK_ENODEV;
+ done = CryptGenRandom(hCryptProv, size, (unsigned char *)buffer);
+ CryptReleaseContext(hCryptProv, 0);
+ if (done)
+ return RK_NOERR;
+#endif
+
+#endif
+
+ return RK_ENODEV;
+}
+
+rk_error rk_altfill(void *buffer, size_t size, int strong, rk_state *state)
+{
+ rk_error err;
+
+ err = rk_devfill(buffer, size, strong);
+ if (err)
+ rk_fill(buffer, size, state);
+
+ return err;
+}
+
+double rk_gauss(rk_state *state)
+{
+ if (state->has_gauss)
+ {
+ state->has_gauss = 0;
+ return state->gauss;
+ }
+ else
+ {
+ double f, x1, x2, r2;
+ do
+ {
+ x1 = 2.0*rk_double(state) - 1.0;
+ x2 = 2.0*rk_double(state) - 1.0;
+ r2 = x1*x1 + x2*x2;
+ }
+ while (r2 >= 1.0 || r2 == 0.0);
+
+ f = sqrt(-2.0*log(r2)/r2); /* Box-Muller transform */
+ state->has_gauss = 1;
+ state->gauss = f*x1; /* Keep for next call */
+ return f*x2;
+ }
+}
+
+
diff --git a/numpy/random/mtrand/randomkit.h b/numpy/random/mtrand/randomkit.h
new file mode 100644
index 000000000..389666854
--- /dev/null
+++ b/numpy/random/mtrand/randomkit.h
@@ -0,0 +1,189 @@
+/* Random kit 1.3 */
+
+/*
+ * Copyright (c) 2003-2005, Jean-Sebastien Roy (js@jeannot.org)
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the
+ * "Software"), to deal in the Software without restriction, including
+ * without limitation the rights to use, copy, modify, merge, publish,
+ * distribute, sublicense, and/or sell copies of the Software, and to
+ * permit persons to whom the Software is furnished to do so, subject to
+ * the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included
+ * in all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+ * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+ * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+ * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+ * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+ * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ */
+
+/* @(#) $Jeannot: randomkit.h,v 1.24 2005/07/21 22:14:09 js Exp $ */
+
+/*
+ * Typical use:
+ *
+ * {
+ * rk_state state;
+ * unsigned long seed = 1, random_value;
+ *
+ * rk_seed(seed, &state); // Initialize the RNG
+ * ...
+ * random_value = rk_random(&state); // Generate random values in [0..RK_MAX]
+ * }
+ *
+ * Instead of rk_seed, you can use rk_randomseed which will get a random seed
+ * from /dev/urandom (or the clock, if /dev/urandom is unavailable):
+ *
+ * {
+ * rk_state state;
+ * unsigned long random_value;
+ *
+ * rk_randomseed(&state); // Initialize the RNG with a random seed
+ * ...
+ * random_value = rk_random(&state); // Generate random values in [0..RK_MAX]
+ * }
+ */
+
+/*
+ * Useful macro:
+ * RK_DEV_RANDOM: the device used for random seeding.
+ * defaults to "/dev/urandom"
+ */
+
+#include <stddef.h>
+
+#ifndef _RANDOMKIT_
+#define _RANDOMKIT_
+
+#define RK_STATE_LEN 624
+
+typedef struct rk_state_
+{
+ unsigned long key[RK_STATE_LEN];
+ int pos;
+ int has_gauss; /* !=0: gauss contains a gaussian deviate */
+ double gauss;
+
+ /* The rk_state structure has been extended to store the following
+ * information for the binomial generator. If the input values of n or p
+ * are different than nsave and psave, then the other parameters will be
+ * recomputed. RTK 2005-09-02 */
+
+ int has_binomial; /* !=0: following parameters initialized for
+ binomial */
+ double psave;
+ long nsave;
+ double r;
+ double q;
+ double fm;
+ long m;
+ double p1;
+ double xm;
+ double xl;
+ double xr;
+ double c;
+ double laml;
+ double lamr;
+ double p2;
+ double p3;
+ double p4;
+
+}
+rk_state;
+
+typedef enum {
+ RK_NOERR = 0, /* no error */
+ RK_ENODEV = 1, /* no RK_DEV_RANDOM device */
+ RK_ERR_MAX = 2
+} rk_error;
+
+/* error strings */
+extern char *rk_strerror[RK_ERR_MAX];
+
+/* Maximum generated random value */
+#define RK_MAX 0xFFFFFFFFUL
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * Initialize the RNG state using the given seed.
+ */
+extern void rk_seed(unsigned long seed, rk_state *state);
+
+/*
+ * Initialize the RNG state using a random seed.
+ * Uses /dev/random or, when unavailable, the clock (see randomkit.c).
+ * Returns RK_NOERR when no errors occurs.
+ * Returns RK_ENODEV when the use of RK_DEV_RANDOM failed (for example because
+ * there is no such device). In this case, the RNG was initialized using the
+ * clock.
+ */
+extern rk_error rk_randomseed(rk_state *state);
+
+/*
+ * Returns a random unsigned long between 0 and RK_MAX inclusive
+ */
+extern unsigned long rk_random(rk_state *state);
+
+/*
+ * Returns a random long between 0 and LONG_MAX inclusive
+ */
+extern long rk_long(rk_state *state);
+
+/*
+ * Returns a random unsigned long between 0 and ULONG_MAX inclusive
+ */
+extern unsigned long rk_ulong(rk_state *state);
+
+/*
+ * Returns a random unsigned long between 0 and max inclusive.
+ */
+extern unsigned long rk_interval(unsigned long max, rk_state *state);
+
+/*
+ * Returns a random double between 0.0 and 1.0, 1.0 excluded.
+ */
+extern double rk_double(rk_state *state);
+
+/*
+ * fill the buffer with size random bytes
+ */
+extern void rk_fill(void *buffer, size_t size, rk_state *state);
+
+/*
+ * fill the buffer with randombytes from the random device
+ * Returns RK_ENODEV if the device is unavailable, or RK_NOERR if it is
+ * On Unix, if strong is defined, RK_DEV_RANDOM is used. If not, RK_DEV_URANDOM
+ * is used instead. This parameter has no effect on Windows.
+ * Warning: on most unixes RK_DEV_RANDOM will wait for enough entropy to answer
+ * which can take a very long time on quiet systems.
+ */
+extern rk_error rk_devfill(void *buffer, size_t size, int strong);
+
+/*
+ * fill the buffer using rk_devfill if the random device is available and using
+ * rk_fill if is is not
+ * parameters have the same meaning as rk_fill and rk_devfill
+ * Returns RK_ENODEV if the device is unavailable, or RK_NOERR if it is
+ */
+extern rk_error rk_altfill(void *buffer, size_t size, int strong,
+ rk_state *state);
+
+/*
+ * return a random gaussian deviate with variance unity and zero mean.
+ */
+extern double rk_gauss(rk_state *state);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _RANDOMKIT_ */
diff --git a/numpy/random/setup.py b/numpy/random/setup.py
new file mode 100644
index 000000000..6525034a8
--- /dev/null
+++ b/numpy/random/setup.py
@@ -0,0 +1,53 @@
+from os.path import join, split
+
+def configuration(parent_package='',top_path=None):
+ from numpy.distutils.misc_util import Configuration, get_mathlibs
+ config = Configuration('random',parent_package,top_path)
+
+ def generate_libraries(ext, build_dir):
+ config_cmd = config.get_config_cmd()
+ if top_path is None:
+ libs = get_mathlibs()
+ else:
+ path = join(split(build_dir)[0],'core')
+ libs = get_mathlibs(path)
+ tc = testcode_wincrypt()
+ if config_cmd.try_run(tc):
+ libs.append('Advapi32')
+ ext.libraries.extend(libs)
+ return None
+
+ libs = []
+ # Configure mtrand
+ config.add_extension('mtrand',
+ sources=[join('mtrand', x) for x in
+ ['mtrand.c', 'randomkit.c', 'initarray.c',
+ 'distributions.c']]+[generate_libraries],
+ libraries=libs,
+ depends = [join('mtrand','*.h'),
+ join('mtrand','*.pyx'),
+ join('mtrand','*.pxi'),
+ ]
+ )
+
+ config.add_data_files(('.', join('mtrand', 'randomkit.h')))
+
+ return config
+
+def testcode_wincrypt():
+ return """\
+/* check to see if _WIN32 is defined */
+int main(int argc, char *argv[])
+{
+#ifdef _WIN32
+ return 0;
+#else
+#error No _WIN32
+#endif
+ return -1;
+}
+"""
+
+if __name__ == '__main__':
+ from numpy.distutils.core import setup
+ setup(configuration=configuration)
diff --git a/numpy/setup.py b/numpy/setup.py
new file mode 100644
index 000000000..8312bb7ad
--- /dev/null
+++ b/numpy/setup.py
@@ -0,0 +1,29 @@
+#!/usr/bin/env python
+
+def configuration(parent_package='',top_path=None):
+ from numpy.distutils.misc_util import Configuration
+ config = Configuration('numpy',parent_package,top_path)
+ config.add_subpackage('distutils')
+ config.add_subpackage('testing')
+ config.add_subpackage('f2py')
+ config.add_subpackage('core')
+ config.add_subpackage('lib')
+ config.add_subpackage('oldnumeric')
+ config.add_subpackage('numarray')
+ config.add_subpackage('fft')
+ config.add_subpackage('linalg')
+ config.add_subpackage('random')
+ config.add_data_dir('doc')
+ config.add_data_dir('tests')
+ config.make_config_py() # installs __config__.py
+ return config
+
+if __name__ == '__main__':
+ # Remove current working directory from sys.path
+ # to avoid importing numpy.distutils as Python std. distutils:
+ import os, sys
+ for cwd in ['','.',os.getcwd()]:
+ while cwd in sys.path: sys.path.remove(cwd)
+
+ from numpy.distutils.core import setup
+ setup(configuration=configuration)
diff --git a/numpy/testing/__init__.py b/numpy/testing/__init__.py
new file mode 100644
index 000000000..028890a49
--- /dev/null
+++ b/numpy/testing/__init__.py
@@ -0,0 +1,4 @@
+
+from info import __doc__
+from numpytest import *
+from utils import *
diff --git a/numpy/testing/info.py b/numpy/testing/info.py
new file mode 100644
index 000000000..8b09d8ed3
--- /dev/null
+++ b/numpy/testing/info.py
@@ -0,0 +1,30 @@
+"""
+Numpy testing tools
+===================
+
+Numpy-style unit-testing
+------------------------
+
+ NumpyTest -- Numpy tests site manager
+ NumpyTestCase -- unittest.TestCase with measure method
+ IgnoreException -- raise when checking disabled feature, it'll be ignored
+ set_package_path -- prepend package build directory to path
+ set_local_path -- prepend local directory (to tests files) to path
+ restore_path -- restore path after set_package_path
+
+Utility functions
+-----------------
+
+ jiffies -- return 1/100ths of a second that the current process has used
+ memusage -- virtual memory size in bytes of the running python [linux]
+ rand -- array of random numbers from given shape
+ assert_equal -- assert equality
+ assert_almost_equal -- assert equality with decimal tolerance
+ assert_approx_equal -- assert equality with significant digits tolerance
+ assert_array_equal -- assert arrays equality
+ assert_array_almost_equal -- assert arrays equality with decimal tolerance
+ assert_array_less -- assert arrays less-ordering
+
+"""
+
+global_symbols = ['ScipyTest','NumpyTest']
diff --git a/numpy/testing/numpytest.py b/numpy/testing/numpytest.py
new file mode 100644
index 000000000..da09a830d
--- /dev/null
+++ b/numpy/testing/numpytest.py
@@ -0,0 +1,661 @@
+import os
+import re
+import sys
+import imp
+import glob
+import types
+import unittest
+import traceback
+import warnings
+
+__all__ = ['set_package_path', 'set_local_path', 'restore_path',
+ 'IgnoreException', 'NumpyTestCase', 'NumpyTest',
+ 'ScipyTestCase', 'ScipyTest', # for backward compatibility
+ 'importall',
+ ]
+
+DEBUG=0
+from numpy.testing.utils import jiffies
+get_frame = sys._getframe
+
+class IgnoreException(Exception):
+ "Ignoring this exception due to disabled feature"
+
+
+def set_package_path(level=1):
+ """ Prepend package directory to sys.path.
+
+ set_package_path should be called from a test_file.py that
+ satisfies the following tree structure:
+
+ <somepath>/<somedir>/test_file.py
+
+ Then the first existing path name from the following list
+
+ <somepath>/build/lib.<platform>-<version>
+ <somepath>/..
+
+ is prepended to sys.path.
+ The caller is responsible for removing this path by using
+
+ restore_path()
+ """
+ from distutils.util import get_platform
+ f = get_frame(level)
+ if f.f_locals['__name__']=='__main__':
+ testfile = sys.argv[0]
+ else:
+ testfile = f.f_locals['__file__']
+ d = os.path.dirname(os.path.dirname(os.path.abspath(testfile)))
+ d1 = os.path.join(d,'build','lib.%s-%s'%(get_platform(),sys.version[:3]))
+ if not os.path.isdir(d1):
+ d1 = os.path.dirname(d)
+ if DEBUG:
+ print 'Inserting %r to sys.path for test_file %r' % (d1, testfile)
+ sys.path.insert(0,d1)
+ return
+
+
+def set_local_path(reldir='', level=1):
+ """ Prepend local directory to sys.path.
+
+ The caller is responsible for removing this path by using
+
+ restore_path()
+ """
+ f = get_frame(level)
+ if f.f_locals['__name__']=='__main__':
+ testfile = sys.argv[0]
+ else:
+ testfile = f.f_locals['__file__']
+ local_path = os.path.normpath(os.path.join(os.path.dirname(os.path.abspath(testfile)),reldir))
+ if DEBUG:
+ print 'Inserting %r to sys.path' % (local_path)
+ sys.path.insert(0,local_path)
+ return
+
+
+def restore_path():
+ if DEBUG:
+ print 'Removing %r from sys.path' % (sys.path[0])
+ del sys.path[0]
+ return
+
+
+def output_exception(printstream = sys.stdout):
+ try:
+ type, value, tb = sys.exc_info()
+ info = traceback.extract_tb(tb)
+ #this is more verbose
+ #traceback.print_exc()
+ filename, lineno, function, text = info[-1] # last line only
+ print>>printstream, "%s:%d: %s: %s (in %s)" %\
+ (filename, lineno, type.__name__, str(value), function)
+ finally:
+ type = value = tb = None # clean up
+ return
+
+
+class _dummy_stream:
+ def __init__(self,stream):
+ self.data = []
+ self.stream = stream
+ def write(self,message):
+ if not self.data and not message.startswith('E'):
+ self.stream.write(message)
+ self.stream.flush()
+ message = ''
+ self.data.append(message)
+ def writeln(self,message):
+ self.write(message+'\n')
+
+
+class NumpyTestCase (unittest.TestCase):
+
+ def measure(self,code_str,times=1):
+ """ Return elapsed time for executing code_str in the
+ namespace of the caller for given times.
+ """
+ frame = get_frame(1)
+ locs,globs = frame.f_locals,frame.f_globals
+ code = compile(code_str,
+ 'NumpyTestCase runner for '+self.__class__.__name__,
+ 'exec')
+ i = 0
+ elapsed = jiffies()
+ while i<times:
+ i += 1
+ exec code in globs,locs
+ elapsed = jiffies() - elapsed
+ return 0.01*elapsed
+
+ def __call__(self, result=None):
+ if result is None:
+ return unittest.TestCase.__call__(self, result)
+
+ nof_errors = len(result.errors)
+ save_stream = result.stream
+ result.stream = _dummy_stream(save_stream)
+ unittest.TestCase.__call__(self, result)
+ if nof_errors != len(result.errors):
+ test, errstr = result.errors[-1][:2]
+ if isinstance(errstr, tuple):
+ errstr = str(errstr[0])
+ elif isinstance(errstr, str):
+ errstr = errstr.split('\n')[-2]
+ else:
+ # allow for proxy classes
+ errstr = str(errstr).split('\n')[-2]
+ l = len(result.stream.data)
+ if errstr.startswith('IgnoreException:'):
+ if l==1:
+ assert result.stream.data[-1]=='E', \
+ repr(result.stream.data)
+ result.stream.data[-1] = 'i'
+ else:
+ assert result.stream.data[-1]=='ERROR\n', \
+ repr(result.stream.data)
+ result.stream.data[-1] = 'ignoring\n'
+ del result.errors[-1]
+ map(save_stream.write, result.stream.data)
+ save_stream.flush()
+ result.stream = save_stream
+
+ def warn(self, message):
+ from numpy.distutils.misc_util import yellow_text
+ print>>sys.stderr,yellow_text('Warning: %s' % (message))
+ sys.stderr.flush()
+ def info(self, message):
+ print>>sys.stdout, message
+ sys.stdout.flush()
+
+ def rundocs(self, filename=None):
+ """ Run doc string tests found in filename.
+ """
+ import doctest
+ if filename is None:
+ f = get_frame(1)
+ filename = f.f_globals['__file__']
+ name = os.path.splitext(os.path.basename(filename))[0]
+ path = [os.path.dirname(filename)]
+ file, pathname, description = imp.find_module(name, path)
+ try:
+ m = imp.load_module(name, file, pathname, description)
+ finally:
+ file.close()
+ if sys.version[:3]<'2.4':
+ doctest.testmod(m, verbose=False)
+ else:
+ tests = doctest.DocTestFinder().find(m)
+ runner = doctest.DocTestRunner(verbose=False)
+ for test in tests:
+ runner.run(test)
+ return
+
+class ScipyTestCase(NumpyTestCase):
+ def __init__(self, package=None):
+ warnings.warn("ScipyTestCase is now called NumpyTestCase; please update your code",
+ DeprecationWarning, stacklevel=2)
+ NumpyTestCase.__init__(self, package)
+
+
+def _get_all_method_names(cls):
+ names = dir(cls)
+ if sys.version[:3]<='2.1':
+ for b in cls.__bases__:
+ for n in dir(b)+_get_all_method_names(b):
+ if n not in names:
+ names.append(n)
+ return names
+
+
+# for debug build--check for memory leaks during the test.
+class _NumPyTextTestResult(unittest._TextTestResult):
+ def startTest(self, test):
+ unittest._TextTestResult.startTest(self, test)
+ if self.showAll:
+ N = len(sys.getobjects(0))
+ self._totnumobj = N
+ self._totrefcnt = sys.gettotalrefcount()
+ return
+
+ def stopTest(self, test):
+ if self.showAll:
+ N = len(sys.getobjects(0))
+ self.stream.write("objects: %d ===> %d; " % (self._totnumobj, N))
+ self.stream.write("refcnts: %d ===> %d\n" % (self._totrefcnt,
+ sys.gettotalrefcount()))
+ return
+
+class NumPyTextTestRunner(unittest.TextTestRunner):
+ def _makeResult(self):
+ return _NumPyTextTestResult(self.stream, self.descriptions, self.verbosity)
+
+
+class NumpyTest:
+ """ Numpy tests site manager.
+
+ Usage: NumpyTest(<package>).test(level=1,verbosity=1)
+
+ <package> is package name or its module object.
+
+ Package is supposed to contain a directory tests/ with test_*.py
+ files where * refers to the names of submodules. See .rename()
+ method to redefine name mapping between test_*.py files and names of
+ submodules. Pattern test_*.py can be overwritten by redefining
+ .get_testfile() method.
+
+ test_*.py files are supposed to define a classes, derived from
+ NumpyTestCase or unittest.TestCase, with methods having names
+ starting with test or bench or check. The names of TestCase classes
+ must have a prefix test. This can be overwritten by redefining
+ .check_testcase_name() method.
+
+ And that is it! No need to implement test or test_suite functions
+ in each .py file.
+
+ Old-style test_suite(level=1) hooks are also supported.
+ """
+ _check_testcase_name = re.compile(r'test.*').match
+ def check_testcase_name(self, name):
+ """ Return True if name matches TestCase class.
+ """
+ return not not self._check_testcase_name(name)
+
+ testfile_patterns = ['test_%(modulename)s.py']
+ def get_testfile(self, module, verbosity = 0):
+ """ Return path to module test file.
+ """
+ mstr = self._module_str
+ short_module_name = self._get_short_module_name(module)
+ d = os.path.split(module.__file__)[0]
+ test_dir = os.path.join(d,'tests')
+ local_test_dir = os.path.join(os.getcwd(),'tests')
+ if os.path.basename(os.path.dirname(local_test_dir)) \
+ == os.path.basename(os.path.dirname(test_dir)):
+ test_dir = local_test_dir
+ for pat in self.testfile_patterns:
+ fn = os.path.join(test_dir, pat % {'modulename':short_module_name})
+ if os.path.isfile(fn):
+ return fn
+ if verbosity>1:
+ self.warn('No test file found in %s for module %s' \
+ % (test_dir, mstr(module)))
+ return
+
+ def __init__(self, package=None):
+ if package is None:
+ from numpy.distutils.misc_util import get_frame
+ f = get_frame(1)
+ package = f.f_locals.get('__name__',f.f_globals.get('__name__',None))
+ assert package is not None
+ self.package = package
+ self._rename_map = {}
+
+ def rename(self, **kws):
+ """Apply renaming submodule test file test_<name>.py to
+ test_<newname>.py.
+
+ Usage: self.rename(name='newname') before calling the
+ self.test() method.
+
+ If 'newname' is None, then no tests will be executed for a given
+ module.
+ """
+ for k,v in kws.items():
+ self._rename_map[k] = v
+ return
+
+ def _module_str(self, module):
+ filename = module.__file__[-30:]
+ if filename!=module.__file__:
+ filename = '...'+filename
+ return '<module %r from %r>' % (module.__name__, filename)
+
+ def _get_method_names(self,clsobj,level):
+ names = []
+ for mthname in _get_all_method_names(clsobj):
+ if mthname[:5] not in ['bench','check'] \
+ and mthname[:4] not in ['test']:
+ continue
+ mth = getattr(clsobj, mthname)
+ if type(mth) is not types.MethodType:
+ continue
+ d = mth.im_func.func_defaults
+ if d is not None:
+ mthlevel = d[0]
+ else:
+ mthlevel = 1
+ if level>=mthlevel:
+ if mthname not in names:
+ names.append(mthname)
+ for base in clsobj.__bases__:
+ for n in self._get_method_names(base,level):
+ if n not in names:
+ names.append(n)
+ return names
+
+ def _get_short_module_name(self, module):
+ d,f = os.path.split(module.__file__)
+ short_module_name = os.path.splitext(os.path.basename(f))[0]
+ if short_module_name=='__init__':
+ short_module_name = module.__name__.split('.')[-1]
+ short_module_name = self._rename_map.get(short_module_name,short_module_name)
+ return short_module_name
+
+ def _get_module_tests(self, module, level, verbosity):
+ mstr = self._module_str
+
+ short_module_name = self._get_short_module_name(module)
+ if short_module_name is None:
+ return []
+
+ test_file = self.get_testfile(module, verbosity)
+
+ if test_file is None:
+ return []
+
+ if not os.path.isfile(test_file):
+ if short_module_name[:5]=='info_' \
+ and short_module_name[5:]==module.__name__.split('.')[-2]:
+ return []
+ if short_module_name in ['__cvs_version__','__svn_version__']:
+ return []
+ if short_module_name[-8:]=='_version' \
+ and short_module_name[:-8]==module.__name__.split('.')[-2]:
+ return []
+ if verbosity>1:
+ self.warn(test_file)
+ self.warn(' !! No test file %r found for %s' \
+ % (os.path.basename(test_file), mstr(module)))
+ return []
+
+ if test_file in self.test_files:
+ return []
+
+ parent_module_name = '.'.join(module.__name__.split('.')[:-1])
+ test_module_name,ext = os.path.splitext(os.path.basename(test_file))
+ test_dir_module = parent_module_name+'.tests'
+ test_module_name = test_dir_module+'.'+test_module_name
+
+ if not sys.modules.has_key(test_dir_module):
+ sys.modules[test_dir_module] = imp.new_module(test_dir_module)
+
+ old_sys_path = sys.path[:]
+ try:
+ f = open(test_file,'r')
+ test_module = imp.load_module(test_module_name, f,
+ test_file, ('.py', 'r', 1))
+ f.close()
+ except:
+ sys.path[:] = old_sys_path
+ self.warn('FAILURE importing tests for %s' % (mstr(module)))
+ output_exception(sys.stderr)
+ return []
+ sys.path[:] = old_sys_path
+
+ self.test_files.append(test_file)
+
+ return self._get_suite_list(test_module, level, module.__name__)
+
+ def _get_suite_list(self, test_module, level, module_name='__main__',
+ verbosity=1):
+ suite_list = []
+ if hasattr(test_module, 'test_suite'):
+ suite_list.extend(test_module.test_suite(level)._tests)
+ for name in dir(test_module):
+ obj = getattr(test_module, name)
+ if type(obj) is not type(unittest.TestCase) \
+ or not issubclass(obj, unittest.TestCase) \
+ or not self.check_testcase_name(obj.__name__):
+ continue
+ for mthname in self._get_method_names(obj,level):
+ suite = obj(mthname)
+ if getattr(suite,'isrunnable',lambda mthname:1)(mthname):
+ suite_list.append(suite)
+ if verbosity>=0:
+ self.info(' Found %s tests for %s' % (len(suite_list), module_name))
+ return suite_list
+
+ def _test_suite_from_modules(self, this_package, level, verbosity):
+ package_name = this_package.__name__
+ modules = []
+ for name, module in sys.modules.items():
+ if not name.startswith(package_name) or module is None:
+ continue
+ if not hasattr(module,'__file__'):
+ continue
+ if os.path.basename(os.path.dirname(module.__file__))=='tests':
+ continue
+ modules.append((name, module))
+
+ modules.sort()
+ modules = [m[1] for m in modules]
+
+ self.test_files = []
+ suites = []
+ for module in modules:
+ suites.extend(self._get_module_tests(module, abs(level), verbosity))
+
+ suites.extend(self._get_suite_list(sys.modules[package_name],
+ abs(level), verbosity=verbosity))
+ return unittest.TestSuite(suites)
+
+ def _test_suite_from_all_tests(self, this_package, level, verbosity):
+ importall(this_package)
+ package_name = this_package.__name__
+
+ # Find all tests/ directories under the package
+ test_dirs_names = {}
+ for name, module in sys.modules.items():
+ if not name.startswith(package_name) or module is None:
+ continue
+ if not hasattr(module, '__file__'):
+ continue
+ d = os.path.dirname(module.__file__)
+ if os.path.basename(d)=='tests':
+ continue
+ d = os.path.join(d, 'tests')
+ if not os.path.isdir(d):
+ continue
+ if test_dirs_names.has_key(d): continue
+ test_dir_module = '.'.join(name.split('.')[:-1]+['tests'])
+ test_dirs_names[d] = test_dir_module
+
+ test_dirs = test_dirs_names.keys()
+ test_dirs.sort()
+
+ # For each file in each tests/ directory with a test case in it,
+ # import the file, and add the test cases to our list
+ suite_list = []
+ testcase_match = re.compile(r'\s*class\s+\w+\s*\(.*TestCase').match
+ for test_dir in test_dirs:
+ test_dir_module = test_dirs_names[test_dir]
+
+ if not sys.modules.has_key(test_dir_module):
+ sys.modules[test_dir_module] = imp.new_module(test_dir_module)
+
+ for fn in os.listdir(test_dir):
+ base, ext = os.path.splitext(fn)
+ if ext != '.py':
+ continue
+ f = os.path.join(test_dir, fn)
+
+ # check that file contains TestCase class definitions:
+ fid = open(f, 'r')
+ skip = True
+ for line in fid:
+ if testcase_match(line):
+ skip = False
+ break
+ fid.close()
+ if skip:
+ continue
+
+ # import the test file
+ n = test_dir_module + '.' + base
+ # in case test files import local modules
+ sys.path.insert(0, test_dir)
+ fo = None
+ try:
+ try:
+ fo = open(f)
+ test_module = imp.load_module(n, fo, f,
+ ('.py', 'U', 1))
+ except Exception, msg:
+ print 'Failed importing %s: %s' % (f,msg)
+ continue
+ finally:
+ if fo:
+ fo.close()
+ del sys.path[0]
+
+ suites = self._get_suite_list(test_module, level,
+ module_name=n,
+ verbosity=verbosity)
+ suite_list.extend(suites)
+
+ all_tests = unittest.TestSuite(suite_list)
+ return all_tests
+
+ def test(self, level=1, verbosity=1, all=False):
+ """Run Numpy module test suite with level and verbosity.
+
+ level:
+ None --- do nothing, return None
+ < 0 --- scan for tests of level=abs(level),
+ don't run them, return TestSuite-list
+ > 0 --- scan for tests of level, run them,
+ return TestRunner
+ > 10 --- run all tests (same as specifying all=True).
+ (backward compatibility).
+
+ verbosity:
+ >= 0 --- show information messages
+ > 1 --- show warnings on missing tests
+
+ all:
+ True --- run all test files (like self.testall())
+ False (default) --- only run test files associated with a module
+
+ It is assumed (when all=False) that package tests suite follows
+ the following convention: for each package module, there exists
+ file <packagepath>/tests/test_<modulename>.py that defines
+ TestCase classes (with names having prefix 'test_') with methods
+ (with names having prefixes 'check_' or 'bench_'); each of these
+ methods are called when running unit tests.
+ """
+ if level is None: # Do nothing.
+ return
+
+ if isinstance(self.package, str):
+ exec 'import %s as this_package' % (self.package)
+ else:
+ this_package = self.package
+
+ if all:
+ all_tests = self._test_suite_from_all_tests(this_package,
+ level, verbosity)
+ else:
+ all_tests = self._test_suite_from_modules(this_package,
+ level, verbosity)
+
+ if level < 0:
+ return all_tests
+
+ runner = unittest.TextTestRunner(verbosity=verbosity)
+ # Use the builtin displayhook. If the tests are being run
+ # under IPython (for instance), any doctest test suites will
+ # fail otherwise.
+ old_displayhook = sys.displayhook
+ sys.displayhook = sys.__displayhook__
+ try:
+ runner.run(all_tests)
+ finally:
+ sys.displayhook = old_displayhook
+ return runner
+
+ def testall(self, level=1,verbosity=1):
+ """ Run Numpy module test suite with level and verbosity.
+
+ level:
+ None --- do nothing, return None
+ < 0 --- scan for tests of level=abs(level),
+ don't run them, return TestSuite-list
+ > 0 --- scan for tests of level, run them,
+ return TestRunner
+
+ verbosity:
+ >= 0 --- show information messages
+ > 1 --- show warnings on missing tests
+
+ Different from .test(..) method, this method looks for
+ TestCase classes from all files in <packagedir>/tests/
+ directory and no assumptions are made for naming the
+ TestCase classes or their methods.
+ """
+ return self.test(level=level, verbosity=verbosity, all=True)
+
+ def run(self):
+ """ Run Numpy module test suite with level and verbosity
+ taken from sys.argv. Requires optparse module.
+ """
+ try:
+ from optparse import OptionParser
+ except ImportError:
+ self.warn('Failed to import optparse module, ignoring.')
+ return self.test()
+ usage = r'usage: %prog [-v <verbosity>] [-l <level>]'
+ parser = OptionParser(usage)
+ parser.add_option("-v", "--verbosity",
+ action="store",
+ dest="verbosity",
+ default=1,
+ type='int')
+ parser.add_option("-l", "--level",
+ action="store",
+ dest="level",
+ default=1,
+ type='int')
+ (options, args) = parser.parse_args()
+ self.test(options.level,options.verbosity)
+ return
+
+ def warn(self, message):
+ from numpy.distutils.misc_util import yellow_text
+ print>>sys.stderr,yellow_text('Warning: %s' % (message))
+ sys.stderr.flush()
+ def info(self, message):
+ print>>sys.stdout, message
+ sys.stdout.flush()
+
+class ScipyTest(NumpyTest):
+ def __init__(self, package=None):
+ warnings.warn("ScipyTest is now called NumpyTest; please update your code",
+ DeprecationWarning, stacklevel=2)
+ NumpyTest.__init__(self, package)
+
+
+def importall(package):
+ """
+ Try recursively to import all subpackages under package.
+ """
+ if isinstance(package,str):
+ package = __import__(package)
+
+ package_name = package.__name__
+ package_dir = os.path.dirname(package.__file__)
+ for subpackage_name in os.listdir(package_dir):
+ subdir = os.path.join(package_dir, subpackage_name)
+ if not os.path.isdir(subdir):
+ continue
+ if not os.path.isfile(os.path.join(subdir,'__init__.py')):
+ continue
+ name = package_name+'.'+subpackage_name
+ try:
+ exec 'import %s as m' % (name)
+ except Exception, msg:
+ print 'Failed importing %s: %s' %(name, msg)
+ continue
+ importall(m)
+ return
diff --git a/numpy/testing/setup.py b/numpy/testing/setup.py
new file mode 100755
index 000000000..ad248d27f
--- /dev/null
+++ b/numpy/testing/setup.py
@@ -0,0 +1,16 @@
+#!/usr/bin/env python
+
+def configuration(parent_package='',top_path=None):
+ from numpy.distutils.misc_util import Configuration
+ config = Configuration('testing',parent_package,top_path)
+ return config
+
+if __name__ == '__main__':
+ from numpy.distutils.core import setup
+ setup(maintainer = "NumPy Developers",
+ maintainer_email = "numpy-dev@numpy.org",
+ description = "NumPy test module",
+ url = "http://www.numpy.org",
+ license = "NumPy License (BSD Style)",
+ configuration = configuration,
+ )
diff --git a/numpy/testing/utils.py b/numpy/testing/utils.py
new file mode 100644
index 000000000..8e01afb56
--- /dev/null
+++ b/numpy/testing/utils.py
@@ -0,0 +1,238 @@
+"""
+Utility function to facilitate testing.
+"""
+
+import os
+import sys
+import operator
+
+__all__ = ['assert_equal', 'assert_almost_equal','assert_approx_equal',
+ 'assert_array_equal', 'assert_array_less',
+ 'assert_array_almost_equal', 'jiffies', 'memusage', 'rand',
+ 'runstring']
+
+def rand(*args):
+ """Returns an array of random numbers with the given shape.
+
+ This only uses the standard library, so it is useful for testing purposes.
+ """
+ import random
+ from numpy.core import zeros, float64
+ results = zeros(args, float64)
+ f = results.flat
+ for i in range(len(f)):
+ f[i] = random.random()
+ return results
+
+if sys.platform[:5]=='linux':
+ def jiffies(_proc_pid_stat = '/proc/%s/stat'%(os.getpid()),
+ _load_time=[]):
+ """ Return number of jiffies (1/100ths of a second) that this
+ process has been scheduled in user mode. See man 5 proc. """
+ import time
+ if not _load_time:
+ _load_time.append(time.time())
+ try:
+ f=open(_proc_pid_stat,'r')
+ l = f.readline().split(' ')
+ f.close()
+ return int(l[13])
+ except:
+ return int(100*(time.time()-_load_time[0]))
+
+ def memusage(_proc_pid_stat = '/proc/%s/stat'%(os.getpid())):
+ """ Return virtual memory size in bytes of the running python.
+ """
+ try:
+ f=open(_proc_pid_stat,'r')
+ l = f.readline().split(' ')
+ f.close()
+ return int(l[22])
+ except:
+ return
+else:
+ # os.getpid is not in all platforms available.
+ # Using time is safe but inaccurate, especially when process
+ # was suspended or sleeping.
+ def jiffies(_load_time=[]):
+ """ Return number of jiffies (1/100ths of a second) that this
+ process has been scheduled in user mode. [Emulation with time.time]. """
+ import time
+ if not _load_time:
+ _load_time.append(time.time())
+ return int(100*(time.time()-_load_time[0]))
+ def memusage():
+ """ Return memory usage of running python. [Not implemented]"""
+ raise NotImplementedError
+
+if os.name=='nt' and sys.version[:3] > '2.3':
+ # Code "stolen" from enthought/debug/memusage.py
+ def GetPerformanceAttributes(object, counter, instance = None,
+ inum=-1, format = None, machine=None):
+ # NOTE: Many counters require 2 samples to give accurate results,
+ # including "% Processor Time" (as by definition, at any instant, a
+ # thread's CPU usage is either 0 or 100). To read counters like this,
+ # you should copy this function, but keep the counter open, and call
+ # CollectQueryData() each time you need to know.
+ # See http://msdn.microsoft.com/library/en-us/dnperfmo/html/perfmonpt2.asp
+ # My older explanation for this was that the "AddCounter" process forced
+ # the CPU to 100%, but the above makes more sense :)
+ import win32pdh
+ if format is None: format = win32pdh.PDH_FMT_LONG
+ path = win32pdh.MakeCounterPath( (machine,object,instance, None, inum,counter) )
+ hq = win32pdh.OpenQuery()
+ try:
+ hc = win32pdh.AddCounter(hq, path)
+ try:
+ win32pdh.CollectQueryData(hq)
+ type, val = win32pdh.GetFormattedCounterValue(hc, format)
+ return val
+ finally:
+ win32pdh.RemoveCounter(hc)
+ finally:
+ win32pdh.CloseQuery(hq)
+
+ def memusage(processName="python", instance=0):
+ # from win32pdhutil, part of the win32all package
+ import win32pdh
+ return GetPerformanceAttributes("Process", "Virtual Bytes",
+ processName, instance,
+ win32pdh.PDH_FMT_LONG, None)
+
+def build_err_msg(arrays, err_msg, header='Items are not equal:',
+ verbose=True,
+ names=('ACTUAL', 'DESIRED')):
+ msg = ['\n' + header]
+ if err_msg:
+ if err_msg.find('\n') == -1 and len(err_msg) < 79-len(header):
+ msg = [msg[0] + ' ' + err_msg]
+ else:
+ msg.append(err_msg)
+ if verbose:
+ for i, a in enumerate(arrays):
+ try:
+ r = repr(a)
+ except:
+ r = '[repr failed]'
+ if r.count('\n') > 3:
+ r = '\n'.join(r.splitlines()[:3])
+ r += '...'
+ msg.append(' %s: %s' % (names[i], r))
+ return '\n'.join(msg)
+
+def assert_equal(actual,desired,err_msg='',verbose=True):
+ """ Raise an assertion if two items are not
+ equal. I think this should be part of unittest.py
+ """
+ if isinstance(desired, dict):
+ assert isinstance(actual, dict), repr(type(actual))
+ assert_equal(len(actual),len(desired),err_msg,verbose)
+ for k,i in desired.items():
+ assert actual.has_key(k), repr(k)
+ assert_equal(actual[k], desired[k], 'key=%r\n%s' % (k,err_msg), verbose)
+ return
+ if isinstance(desired, (list,tuple)) and isinstance(actual, (list,tuple)):
+ assert_equal(len(actual),len(desired),err_msg,verbose)
+ for k in range(len(desired)):
+ assert_equal(actual[k], desired[k], 'item=%r\n%s' % (k,err_msg), verbose)
+ return
+ from numpy.core import ndarray
+ if isinstance(actual, ndarray) or isinstance(desired, ndarray):
+ return assert_array_equal(actual, desired, err_msg)
+ msg = build_err_msg([actual, desired], err_msg, verbose=verbose)
+ assert desired == actual, msg
+
+def assert_almost_equal(actual,desired,decimal=7,err_msg='',verbose=True):
+ """ Raise an assertion if two items are not equal.
+
+ I think this should be part of unittest.py
+
+ The test is equivalent to abs(desired-actual) < 0.5 * 10**(-decimal)
+ """
+ from numpy.core import ndarray
+ if isinstance(actual, ndarray) or isinstance(desired, ndarray):
+ return assert_array_almost_equal(actual, desired, decimal, err_msg)
+ msg = build_err_msg([actual, desired], err_msg, verbose=verbose)
+ assert round(abs(desired - actual),decimal) == 0, msg
+
+
+def assert_approx_equal(actual,desired,significant=7,err_msg='',verbose=True):
+ """ Raise an assertion if two items are not
+ equal. I think this should be part of unittest.py
+ Approximately equal is defined as the number of significant digits
+ correct
+ """
+ import math
+ actual, desired = map(float, (actual, desired))
+ if desired==actual:
+ return
+ # Normalized the numbers to be in range (-10.0,10.0)
+ scale = float(pow(10,math.floor(math.log10(0.5*(abs(desired)+abs(actual))))))
+ try:
+ sc_desired = desired/scale
+ except ZeroDivisionError:
+ sc_desired = 0.0
+ try:
+ sc_actual = actual/scale
+ except ZeroDivisionError:
+ sc_actual = 0.0
+ msg = build_err_msg([actual, desired], err_msg,
+ header='Items are not equal to %d significant digits:' %
+ significant,
+ verbose=verbose)
+ assert math.fabs(sc_desired - sc_actual) < pow(10.,-(significant-1)), msg
+
+def assert_array_compare(comparison, x, y, err_msg='', verbose=True,
+ header=''):
+ from numpy.core import asarray
+ x = asarray(x)
+ y = asarray(y)
+ try:
+ cond = (x.shape==() or y.shape==()) or x.shape == y.shape
+ if not cond:
+ msg = build_err_msg([x, y],
+ err_msg
+ + '\n(shapes %s, %s mismatch)' % (x.shape,
+ y.shape),
+ verbose=verbose, header=header,
+ names=('x', 'y'))
+ assert cond, msg
+ val = comparison(x,y)
+ if isinstance(val, bool):
+ cond = val
+ reduced = [0]
+ else:
+ reduced = val.ravel()
+ cond = reduced.all()
+ reduced = reduced.tolist()
+ if not cond:
+ match = 100-100.0*reduced.count(1)/len(reduced)
+ msg = build_err_msg([x, y],
+ err_msg
+ + '\n(mismatch %s%%)' % (match,),
+ verbose=verbose, header=header,
+ names=('x', 'y'))
+ assert cond, msg
+ except ValueError:
+ msg = build_err_msg([x, y], err_msg, verbose=verbose, header=header,
+ names=('x', 'y'))
+ raise ValueError(msg)
+
+def assert_array_equal(x, y, err_msg='', verbose=True):
+ assert_array_compare(operator.__eq__, x, y, err_msg=err_msg,
+ verbose=verbose, header='Arrays are not equal')
+
+def assert_array_almost_equal(x, y, decimal=6, err_msg='', verbose=True):
+ from numpy.core import around
+ def compare(x, y):
+ return around(abs(x-y),decimal) <= 10.0**(-decimal)
+ assert_array_compare(compare, x, y, err_msg=err_msg, verbose=verbose,
+ header='Arrays are not almost equal')
+
+def assert_array_less(x, y, err_msg='', verbose=True):
+ assert_array_compare(operator.__lt__, x, y, err_msg=err_msg,
+ verbose=verbose,
+ header='Arrays are not less-ordered')
+
+def runstring(astr, dict):
+ exec astr in dict
diff --git a/numpy/tests/test_ctypeslib.py b/numpy/tests/test_ctypeslib.py
new file mode 100644
index 000000000..6ee75271d
--- /dev/null
+++ b/numpy/tests/test_ctypeslib.py
@@ -0,0 +1,63 @@
+from numpy.testing import *
+set_package_path()
+import numpy as N
+from numpy.ctypeslib import ndpointer
+restore_path()
+
+class test_ndpointer(NumpyTestCase):
+ def check_dtype(self):
+ dt = N.intc
+ p = ndpointer(dtype=dt)
+ self.assert_(p.from_param(N.array([1], dt)))
+ dt = '<i4'
+ p = ndpointer(dtype=dt)
+ self.assert_(p.from_param(N.array([1], dt)))
+ dt = N.dtype('>i4')
+ p = ndpointer(dtype=dt)
+ p.from_param(N.array([1], dt))
+ self.assertRaises(TypeError, p.from_param,
+ N.array([1], dt.newbyteorder('swap')))
+ dtnames = ['x', 'y']
+ dtformats = [N.intc, N.float64]
+ dtdescr = {'names' : dtnames, 'formats' : dtformats}
+ dt = N.dtype(dtdescr)
+ p = ndpointer(dtype=dt)
+ self.assert_(p.from_param(N.zeros((10,), dt)))
+ samedt = N.dtype(dtdescr)
+ p = ndpointer(dtype=samedt)
+ self.assert_(p.from_param(N.zeros((10,), dt)))
+ dt2 = N.dtype(dtdescr, align=True)
+ if dt.itemsize != dt2.itemsize:
+ self.assertRaises(TypeError, p.from_param, N.zeros((10,), dt2))
+ else:
+ self.assert_(p.from_param(N.zeros((10,), dt2)))
+
+ def check_ndim(self):
+ p = ndpointer(ndim=0)
+ self.assert_(p.from_param(N.array(1)))
+ self.assertRaises(TypeError, p.from_param, N.array([1]))
+ p = ndpointer(ndim=1)
+ self.assertRaises(TypeError, p.from_param, N.array(1))
+ self.assert_(p.from_param(N.array([1])))
+ p = ndpointer(ndim=2)
+ self.assert_(p.from_param(N.array([[1]])))
+
+ def check_shape(self):
+ p = ndpointer(shape=(1,2))
+ self.assert_(p.from_param(N.array([[1,2]])))
+ self.assertRaises(TypeError, p.from_param, N.array([[1],[2]]))
+ p = ndpointer(shape=())
+ self.assert_(p.from_param(N.array(1)))
+
+ def check_flags(self):
+ x = N.array([[1,2,3]], order='F')
+ p = ndpointer(flags='FORTRAN')
+ self.assert_(p.from_param(x))
+ p = ndpointer(flags='CONTIGUOUS')
+ self.assertRaises(TypeError, p.from_param, x)
+ p = ndpointer(flags=x.flags.num)
+ self.assert_(p.from_param(x))
+ self.assertRaises(TypeError, p.from_param, N.array([[1,2,3]]))
+
+if __name__ == "__main__":
+ NumpyTest().run()
diff --git a/numpy/version.py b/numpy/version.py
new file mode 100644
index 000000000..04eb6f55d
--- /dev/null
+++ b/numpy/version.py
@@ -0,0 +1,15 @@
+version='1.0.4'
+release=False
+
+if not release:
+ version += '.dev'
+ import os
+ svn_version_file = os.path.join(os.path.dirname(__file__),
+ 'core','__svn_version__.py')
+ if os.path.isfile(svn_version_file):
+ import imp
+ svn = imp.load_module('numpy.core.__svn_version__',
+ open(svn_version_file),
+ svn_version_file,
+ ('.py','U',1))
+ version += svn.version