Mercurial > octave-nkf
changeset 4552:6f3382e08a52
[project @ 2003-10-27 20:38:02 by jwe]
line wrap: on
line diff
--- a/configure.in Mon Oct 27 17:04:38 2003 +0000 +++ b/configure.in Mon Oct 27 20:38:03 2003 +0000 @@ -22,7 +22,7 @@ ### 02111-1307, USA. AC_INIT -AC_REVISION($Revision: 1.434 $) +AC_REVISION($Revision: 1.435 $) AC_PREREQ(2.57) AC_CONFIG_SRCDIR([src/octave.cc]) AC_CONFIG_HEADER(config.h) @@ -1412,6 +1412,14 @@ #if defined (__DECCXX) #define __USE_STD_IOSTREAM #endif + +#if defined (_UNICOS) +#define F77_USES_CRAY_CALLING_CONVENTION +#endif + +#if 0 +#define F77_USES_VISUAL_FORTRAN_CALLING_CONVENTION +#endif ]) ### Do the substitutions in all the Makefiles.
--- a/libcruft/ChangeLog Mon Oct 27 17:04:38 2003 +0000 +++ b/libcruft/ChangeLog Mon Oct 27 20:38:03 2003 +0000 @@ -1,5 +1,15 @@ 2003-10-27 John W. Eaton <jwe@bevo.che.wisc.edu> + * misc/f77-fcn.c (xstopx): Return type is now F77_RET_T. + Use F77_RETURN. + * misc/machar.c (machar): Likewise. + + * misc/f77-fcn.h (F77_CHAR_ARG, F77_CONST_CHAR_ARG, F77_CHAR_ARG2, + F77_CONST_CHAR_ARG2, F77_CXX_STRING_ARG, F77_CHAR_ARG_LEN, + F77_CHAR_ARG_DECL, F77_CONST_CHAR_ARG_DECL, F77_CHAR_ARG_LEN_DECL, + F77_RET_T, F77_RETURN): New macros. + [F77_USES_CRAY_CALLING_CONVENTION]: New data conversion functions. + * misc/quit.h (octave_interrupt_hook, octave_bad_alloc_hook): Move function pointer declarations inside __cplusplus section.
--- a/libcruft/misc/f77-fcn.c Mon Oct 27 17:04:38 2003 +0000 +++ b/libcruft/misc/f77-fcn.c Mon Oct 27 20:38:03 2003 +0000 @@ -38,7 +38,7 @@ called us. Then the calling function should do whatever cleanup is necessary. */ -void +F77_RET_T F77_FUNC (xstopx, XSTOPX) (const char *s, long int slen) { f77_exception_encountered = 1; @@ -48,6 +48,8 @@ (*current_liboctave_error_handler) ("%.*s", slen, s); octave_jump_to_enclosing_context (); + + F77_RETURN (0) } /*
--- a/libcruft/misc/f77-fcn.h Mon Oct 27 17:04:38 2003 +0000 +++ b/libcruft/misc/f77-fcn.h Mon Oct 27 20:38:03 2003 +0000 @@ -77,13 +77,100 @@ /* So we can check to see if an exception has occurred. */ extern int f77_exception_encountered; -extern void -F77_FUNC (xstopx, XSTOPX) (const char *s, long int slen) GCC_ATTR_NORETURN; - #if !defined (F77_FCN) #define F77_FCN(f, F) F77_FUNC (f, F) #endif +#if defined (F77_USES_CRAY_CALLING_CONVENTION) + +#include <fortran.h> +#define F77_CHAR_ARG(x) octave_make_cray_ftn_ch_dsc (x, strlen (x)) +#define F77_CONST_CHAR_ARG(x) \ + octave_make_cray_const_ftn_ch_dsc (x, strlen (x)) +#define F77_CHAR_ARG2(x, l) octave_make_cray_fcd (x, l) +#define F77_CONST_CHAR_ARG2(x, l) octave_make_cray_const_fcd (x, l) +#define F77_CXX_STRING_ARG(x) \ + octave_make_cray_const_ftn_ch_dsc (x.c_str (), x.length ()) +#define F77_CHAR_ARG_LEN(l) +#define F77_CHAR_ARG_DECL octave_cray_fcd +#define F77_CONST_CHAR_ARG_DECL octave_cray_fcd +#define F77_CHAR_ARG_LEN_DECL +#define F77_RET_T int +#define F77_RETURN(retval) return retval; + +// XXX FIXME XXX -- these should work for SV1 or Y-MP systems but will +// need to be changed for others. + +union octave_cray_descriptor +{ + union + { + const char *const_ptr; + const char *ptr; + }; + struct + { + unsigned off : 6; + unsigned len : 26; + unsigned add : 32; + } mask; +}; + +typedef void *octave_cray_ftn_ch_dsc; + +static inline octave_cray_ftn_ch_dsc +octave_make_cray_ftn_ch_dsc (char *ptr_arg, unsigned long len_arg) +{ + octave_cray_descriptor desc; + desc.ptr = ptr_arg; + desc.mask.len = len_arg << 3; + return *((octave_cray_fortran_character_descriptor *) &f); +} + +static inline octave_cray_ftn_ch_dsc +octave_make_cray_const_ftn_ch_dsc (const char *ptr_arg, unsigned long len_arg) +{ + octave_cray_descriptor desc; + desc.const_ptr = ptr_arg; + desc.mask.len = len_arg << 3; + return *((octave_cray_fcd *) &f); +} + +#elif defined (F77_USES_VISUAL_FORTRAN_CALLING_CONVENTION) + +#define F77_CHAR_ARG(x) x, strlen (x) +#define F77_CONST_CHAR_ARG(x) F77_CHAR_ARG (x) +#define F77_CHAR_ARG2(x, l) x, l +#define F77_CONST_CHAR_ARG2(x, l) F77_CHAR_ARG2 (x, l) +#define F77_CXX_STRING_ARG(x) F77_CONST_CHAR_ARG2 (x.c_str (), x.length ()) +#define F77_CHAR_ARG_LEN(l) +#define F77_CHAR_ARG_DECL char *, int +#define F77_CONST_CHAR_ARG_DECL const char *, int +#define F77_CHAR_ARG_LEN_DECL +#define F77_RET_T void +#define F77_RETURN(retval) + +#else + +// Assume f2c-compatible calling convention + +#define F77_CHAR_ARG(x) x +#define F77_CONST_CHAR_ARG(x) F77_CHAR_ARG (x) +#define F77_CHAR_ARG2(x, l) x +#define F77_CONST_CHAR_ARG2(x, l) F77_CHAR_ARG2 (x, l) +#define F77_CXX_STRING_ARG(x) F77_CONST_CHAR_ARG2 (x.c_str (), x.length ()) +#define F77_CHAR_ARG_LEN(l) , (long) l +#define F77_CHAR_ARG_DECL char * +#define F77_CONST_CHAR_ARG_DECL const char * +#define F77_CHAR_ARG_LEN_DECL , long +#define F77_RET_T int +#define F77_RETURN(retval) return retval; + +#endif + +extern F77_RET_T +F77_FUNC (xstopx, XSTOPX) (const char *s, long int slen) GCC_ATTR_NORETURN; + #ifdef __cplusplus } #endif
--- a/libcruft/misc/machar.c Mon Oct 27 17:04:38 2003 +0000 +++ b/libcruft/misc/machar.c Mon Oct 27 20:38:03 2003 +0000 @@ -364,8 +364,9 @@ } -void -F77_FUNC(machar,MACHAR) (REAL *xmin, REAL *xmax, REAL *epsneg, REAL *eps, REAL *log10_ibeta) +F77_RET_T +F77_FUNC (machar, MACHAR) (REAL *xmin, REAL *xmax, REAL *epsneg, + REAL *eps, REAL *log10_ibeta) { int ibeta, iexp, irnd, it, machep, maxexp, minexp, negep, ngrd; @@ -373,4 +374,6 @@ &maxexp, eps, epsneg, xmin, xmax); *log10_ibeta = log10 ((REAL) ibeta); + + F77_RETURN (0) }
--- a/liboctave/CColVector.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/CColVector.cc Mon Oct 27 20:38:03 2003 +0000 @@ -41,11 +41,12 @@ extern "C" { - int F77_FUNC (zgemv, ZGEMV) (const char*, const int&, const int&, - const Complex&, const Complex*, - const int&, const Complex*, const int&, - const Complex&, Complex*, const int&, - long); + F77_RET_T + F77_FUNC (zgemv, ZGEMV) (F77_CONST_CHAR_ARG_DECL, + const int&, const int&, const Complex&, + const Complex*, const int&, const Complex*, + const int&, const Complex&, Complex*, const int& + F77_CHAR_ARG_LEN_DECL); } // Complex Column Vector class @@ -350,8 +351,10 @@ retval.resize (nr); Complex *y = retval.fortran_vec (); - F77_XFCN (zgemv, ZGEMV, ("N", nr, nc, 1.0, m.data (), ld, - a.data (), 1, 0.0, y, 1, 1L)); + F77_XFCN (zgemv, ZGEMV, (F77_CONST_CHAR_ARG2 ("N", 1), + nr, nc, 1.0, m.data (), ld, + a.data (), 1, 0.0, y, 1 + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler)
--- a/liboctave/CMatrix.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/CMatrix.cc Mon Oct 27 20:38:03 2003 +0000 @@ -63,65 +63,90 @@ extern "C" { - int F77_FUNC (zgebal, ZGEBAL) (const char*, const int&, Complex*, - const int&, int&, int&, double*, int&, - long, long); - - int F77_FUNC (dgebak, DGEBAK) (const char*, const char*, const int&, - const int&, const int&, double*, - const int&, double*, const int&, - int&, long, long); - - int F77_FUNC (zgemm, ZGEMM) (const char*, const char*, const int&, - const int&, const int&, const Complex&, - const Complex*, const int&, - const Complex*, const int&, - const Complex&, Complex*, const int&, - long, long); - - int F77_FUNC (zgetrf, ZGETRF) (const int&, const int&, Complex*, const int&, - int*, int&); - - int F77_FUNC (zgetrs, ZGETRS) (const char*, const int&, const int&, - Complex*, const int&, - const int*, Complex*, const int&, int&); - - int F77_FUNC (zgetri, ZGETRI) (const int&, Complex*, const int&, const int*, - Complex*, const int&, int&); - - int F77_FUNC (zgecon, ZGECON) (const char*, const int&, Complex*, - const int&, const double&, double&, - Complex*, double*, int&); - - int F77_FUNC (zgelss, ZGELSS) (const int&, const int&, const int&, - Complex*, const int&, Complex*, - const int&, double*, double&, int&, - Complex*, const int&, double*, int&); + F77_RET_T + F77_FUNC (zgebal, ZGEBAL) (F77_CONST_CHAR_ARG_DECL, + const int&, Complex*, const int&, int&, + int&, double*, int& + F77_CHAR_ARG_LEN_DECL); + + F77_RET_T + F77_FUNC (dgebak, DGEBAK) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int&, const int&, const int&, double*, + const int&, double*, const int&, int& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); + + F77_RET_T + F77_FUNC (zgemm, ZGEMM) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int&, const int&, const int&, + const Complex&, const Complex*, const int&, + const Complex*, const int&, const Complex&, + Complex*, const int& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); + + F77_RET_T + F77_FUNC (zgetrf, ZGETRF) (const int&, const int&, Complex*, const int&, + int*, int&); + + F77_RET_T + F77_FUNC (zgetrs, ZGETRS) (F77_CONST_CHAR_ARG_DECL, + const int&, const int&, Complex*, const int&, + const int*, Complex*, const int&, int& + F77_CHAR_ARG_LEN_DECL); + + F77_RET_T + F77_FUNC (zgetri, ZGETRI) (const int&, Complex*, const int&, const int*, + Complex*, const int&, int&); + + F77_RET_T + F77_FUNC (zgecon, ZGECON) (F77_CONST_CHAR_ARG_DECL, + const int&, Complex*, + const int&, const double&, double&, + Complex*, double*, int& + F77_CHAR_ARG_LEN_DECL); + + F77_RET_T + F77_FUNC (zgelss, ZGELSS) (const int&, const int&, const int&, + Complex*, const int&, Complex*, + const int&, double*, double&, int&, + Complex*, const int&, double*, int&); // Note that the original complex fft routines were not written for // double complex arguments. They have been modified by adding an // implicit double precision (a-h,o-z) statement at the beginning of // each subroutine. - int F77_FUNC (cffti, CFFTI) (const int&, Complex*); - - int F77_FUNC (cfftf, CFFTF) (const int&, Complex*, Complex*); - - int F77_FUNC (cfftb, CFFTB) (const int&, Complex*, Complex*); - - int F77_FUNC (zlartg, ZLARTG) (const Complex&, const Complex&, - double&, Complex&, Complex&); - - int F77_FUNC (ztrsyl, ZTRSYL) (const char*, const char*, const int&, - const int&, const int&, - const Complex*, const int&, - const Complex*, const int&, - const Complex*, const int&, double&, - int&, long, long); - - int F77_FUNC (xzlange, XZLANGE) (const char*, const int&, - const int&, const Complex*, - const int&, double*, double&); + F77_RET_T + F77_FUNC (cffti, CFFTI) (const int&, Complex*); + + F77_RET_T + F77_FUNC (cfftf, CFFTF) (const int&, Complex*, Complex*); + + F77_RET_T + F77_FUNC (cfftb, CFFTB) (const int&, Complex*, Complex*); + + F77_RET_T + F77_FUNC (zlartg, ZLARTG) (const Complex&, const Complex&, + double&, Complex&, Complex&); + + F77_RET_T + F77_FUNC (ztrsyl, ZTRSYL) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int&, const int&, const int&, + const Complex*, const int&, + const Complex*, const int&, + const Complex*, const int&, double&, int& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); + + F77_RET_T + F77_FUNC (xzlange, XZLANGE) (F77_CONST_CHAR_ARG_DECL, + const int&, const int&, const Complex*, + const int&, double*, double& + F77_CHAR_ARG_LEN_DECL); } static const Complex Complex_NaN_result (octave_NaN, octave_NaN); @@ -1002,8 +1027,10 @@ char job = '1'; Array<double> rz (2 * nc); double *prz = rz.fortran_vec (); - F77_XFCN (zgecon, ZGECON, (&job, nc, tmp_data, nr, anorm, - rcond, pz, prz, info)); + F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, tmp_data, nr, anorm, + rcond, pz, prz, info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) @@ -1018,7 +1045,7 @@ else { F77_XFCN (zgetri, ZGETRI, (nc, tmp_data, nr, pipvt, - pz, lwork, info)); + pz, lwork, info)); if (f77_exception_encountered) (*current_liboctave_error_handler) @@ -1465,8 +1492,10 @@ Array<double> rz (2*nr); double *prz = rz.fortran_vec (); - F77_XFCN (zgecon, ZGECON, (&job, nc, tmp_data, nr, anorm, - rcond, pz, prz, info)); + F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, tmp_data, nr, anorm, + rcond, pz, prz, info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) @@ -1609,8 +1638,10 @@ { // Now calculate the condition number for non-singular matrix. char job = '1'; - F77_XFCN (zgecon, ZGECON, (&job, nc, tmp_data, nr, anorm, - rcond, pz, prz, info)); + F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, tmp_data, nr, anorm, + rcond, pz, prz, info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) @@ -1640,8 +1671,10 @@ int b_nc = b.cols (); char job = 'N'; - F77_XFCN (zgetrs, ZGETRS, (&job, nr, b_nc, tmp_data, nr, - pipvt, result, b.rows(), info)); + F77_XFCN (zgetrs, ZGETRS, (F77_CONST_CHAR_ARG2 (&job, 1), + nr, b_nc, tmp_data, nr, + pipvt, result, b.rows(), info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) @@ -1758,8 +1791,10 @@ { // Now calculate the condition number for non-singular matrix. char job = '1'; - F77_XFCN (zgecon, ZGECON, (&job, nc, tmp_data, nr, anorm, - rcond, pz, prz, info)); + F77_XFCN (zgecon, ZGECON, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, tmp_data, nr, anorm, + rcond, pz, prz, info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) @@ -1787,8 +1822,10 @@ Complex *result = retval.fortran_vec (); char job = 'N'; - F77_XFCN (zgetrs, ZGETRS, (&job, nr, 1, tmp_data, nr, pipvt, - result, b.length(), info)); + F77_XFCN (zgetrs, ZGETRS, (F77_CONST_CHAR_ARG2 (&job, 1), + nr, 1, tmp_data, nr, pipvt, + result, b.length(), info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) @@ -2079,8 +2116,10 @@ // Permute first char job = 'P'; - F77_XFCN (zgebal, ZGEBAL, (&job, nc, mp, nc, ilo, ihi, - dpermute.fortran_vec (), info, 1L, 1L)); + F77_XFCN (zgebal, ZGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, mp, nc, ilo, ihi, + dpermute.fortran_vec (), info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) { @@ -2090,8 +2129,10 @@ // then scale job = 'S'; - F77_XFCN (zgebal, ZGEBAL, (&job, nc, mp, nc, ilos, ihis, - dscale.fortran_vec (), info, 1L, 1L)); + F77_XFCN (zgebal, ZGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, mp, nc, ilos, ihis, + dscale.fortran_vec (), info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) { @@ -2104,8 +2145,10 @@ ColumnVector work (nc); double inf_norm; - F77_XFCN (xzlange, XZLANGE, ("I", nc, nc, m.fortran_vec (), nc, - work.fortran_vec (), inf_norm)); + F77_XFCN (xzlange, XZLANGE, (F77_CONST_CHAR_ARG2 ("I", 1), + nc, nc, m.fortran_vec (), nc, + work.fortran_vec (), inf_norm + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) { @@ -2246,9 +2289,12 @@ retval.resize (len, a_len); Complex *c = retval.fortran_vec (); - F77_XFCN (zgemm, ZGEMM, ("N", "N", len, a_len, 1, 1.0, - v.data (), len, a.data (), 1, 0.0, - c, len, 1L, 1L)); + F77_XFCN (zgemm, ZGEMM, (F77_CONST_CHAR_ARG2 ("N", 1), + F77_CONST_CHAR_ARG2 ("N", 1), + len, a_len, 1, 1.0, v.data (), len, + a.data (), 1, 0.0, c, len + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) @@ -3130,9 +3176,12 @@ Complex *pb = sch_b.fortran_vec (); Complex *px = cx.fortran_vec (); - F77_XFCN (ztrsyl, ZTRSYL, ("N", "N", 1, a_nr, b_nr, pa, a_nr, pb, - b_nr, px, a_nr, scale, - info, 1L, 1L)); + F77_XFCN (ztrsyl, ZTRSYL, (F77_CONST_CHAR_ARG2 ("N", 1), + F77_CONST_CHAR_ARG2 ("N", 1), + 1, a_nr, b_nr, pa, a_nr, pb, + b_nr, px, a_nr, scale, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) ("unrecoverable error in ztrsyl"); @@ -3185,9 +3234,12 @@ retval.resize (nr, a_nc); Complex *c = retval.fortran_vec (); - F77_XFCN (zgemm, ZGEMM, ("N", "N", nr, a_nc, nc, 1.0, - m.data (), ld, a.data (), lda, 0.0, - c, nr, 1L, 1L)); + F77_XFCN (zgemm, ZGEMM, (F77_CONST_CHAR_ARG2 ("N", 1), + F77_CONST_CHAR_ARG2 ("N", 1), + nr, a_nc, nc, 1.0, m.data (), + ld, a.data (), lda, 0.0, c, nr + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler)
--- a/liboctave/CRowVector.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/CRowVector.cc Mon Oct 27 20:38:03 2003 +0000 @@ -41,11 +41,12 @@ extern "C" { - int F77_FUNC (zgemv, ZGEMV) (const char*, const int&, const int&, - const Complex&, const Complex*, - const int&, const Complex*, const int&, - const Complex&, Complex*, const int&, - long); + F77_RET_T + F77_FUNC (zgemv, ZGEMV) (F77_CONST_CHAR_ARG_DECL, + const int&, const int&, const Complex&, + const Complex*, const int&, const Complex*, + const int&, const Complex&, Complex*, const int& + F77_CHAR_ARG_LEN_DECL); } // Complex Row Vector class @@ -347,8 +348,10 @@ retval.resize (a_nc); Complex *y = retval.fortran_vec (); - F77_XFCN (zgemv, ZGEMV, ("T", a_nr, a_nc, 1.0, a.data (), - ld, v.data (), 1, 0.0, y, 1, 1L)); + F77_XFCN (zgemv, ZGEMV, (F77_CONST_CHAR_ARG2 ("T", 1), + a_nr, a_nc, 1.0, a.data (), + ld, v.data (), 1, 0.0, y, 1 + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler)
--- a/liboctave/ChangeLog Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/ChangeLog Mon Oct 27 20:38:03 2003 +0000 @@ -1,3 +1,15 @@ +2003-10-27 John W. Eaton <jwe@bevo.che.wisc.edu> + + * oct-rand.cc, CColVector.cc, CMatrix.cc, CRowVector.cc, + CmplxAEPBAL.cc CmplxCHOL.cc, CmplxHESS.cc, CmplxLU.cc, CmplxQR.cc, + CmplxQRP.cc, CmplxSCHUR.cc, CmplxSVD.cc, CollocWt.cc, DASPK.cc, + DASRT.cc, DASSL.cc, EIG.cc, LSODE.cc, NLEqn.cc, ODESSA.cc, + Quad.cc, dColVector.cc, dMatrix.cc, dRowVector.cc, dbleAEPBAL.cc, + dbleCHOL.cc, dbleHESS.cc, dbleLU.cc, dbleQR.cc, dbleQRP.cc, + dbleSCHUR.cc, dbleSVD.cc, lo-specfun.cc: + Use new F77 arg macros in declarations of external Fortran + subroutines and for calling them. + 2003-10-25 John W. Eaton <jwe@bevo.che.wisc.edu> * Array.cc (Array<T>::resize_no_fill (const dim_vector&)):
--- a/liboctave/CmplxAEPBAL.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/CmplxAEPBAL.cc Mon Oct 27 20:38:03 2003 +0000 @@ -36,14 +36,19 @@ extern "C" { - int F77_FUNC (zgebal, ZGEBAL) (const char*, const int&, Complex*, - const int&, int&, int&, double*, int&, - long, long); + F77_RET_T + F77_FUNC (zgebal, ZGEBAL) (F77_CONST_CHAR_ARG_DECL, + const int&, Complex*, const int&, int&, + int&, double*, int& + F77_CHAR_ARG_LEN_DECL); - int F77_FUNC (zgebak, ZGEBAK) (const char*, const char*, const int&, - const int&, const int&, double*, const - int&, Complex*, const int&, int&, - long, long); + F77_RET_T + F77_FUNC (zgebak, ZGEBAK) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int&, const int&, const int&, double*, + const int&, Complex*, const int&, int& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } int @@ -70,8 +75,10 @@ char job = balance_job[0]; - F77_XFCN (zgebal, ZGEBAL, (&job, n, p_balanced_mat, n, ilo, ihi, - pscale, info, 1L, 1L)); + F77_XFCN (zgebal, ZGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), + n, p_balanced_mat, n, ilo, ihi, + pscale, info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) ("unrecoverable error in zgebal"); @@ -85,8 +92,12 @@ char side = 'R'; - F77_XFCN (zgebak, ZGEBAK, (&job, &side, n, ilo, ihi, pscale, n, - p_balancing_mat, n, info, 1L, 1L)); + F77_XFCN (zgebak, ZGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 (&side, 1), + n, ilo, ihi, pscale, n, + p_balancing_mat, n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) ("unrecoverable error in zgebak");
--- a/liboctave/CmplxCHOL.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/CmplxCHOL.cc Mon Oct 27 20:38:03 2003 +0000 @@ -34,8 +34,10 @@ extern "C" { - int F77_FUNC (zpotrf, ZPOTRF) (const char*, const int&, Complex*, - const int&, int&, long); + F77_RET_T + F77_FUNC (zpotrf, ZPOTRF) (F77_CONST_CHAR_ARG_DECL, + const int&, Complex*, const int&, int& + F77_CHAR_ARG_LEN_DECL); } int @@ -57,7 +59,8 @@ chol_mat = a; Complex *h = chol_mat.fortran_vec (); - F77_XFCN (zpotrf, ZPOTRF, ("U", n, h, n, info, 1L)); + F77_XFCN (zpotrf, ZPOTRF, (F77_CONST_CHAR_ARG2 ("U", 1), n, h, n, info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) ("unrecoverable error in zpotrf");
--- a/liboctave/CmplxHESS.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/CmplxHESS.cc Mon Oct 27 20:38:03 2003 +0000 @@ -34,23 +34,29 @@ extern "C" { - int F77_FUNC (zgebal, ZGEBAL) (const char*, const int&, Complex*, - const int&, int&, int&, double*, int&, - long, long); + F77_RET_T + F77_FUNC (zgebal, ZGEBAL) (F77_CONST_CHAR_ARG_DECL, + const int&, Complex*, const int&, + int&, int&, double*, int& + F77_CHAR_ARG_LEN_DECL); - int F77_FUNC (zgehrd, ZGEHRD) (const int&, const int&, const int&, - Complex*, const int&, Complex*, - Complex*, const int&, int&, long, - long); + F77_RET_T + F77_FUNC (zgehrd, ZGEHRD) (const int&, const int&, const int&, + Complex*, const int&, Complex*, + Complex*, const int&, int&); - int F77_FUNC (zunghr, ZUNGHR) (const int&, const int&, const int&, - Complex*, const int&, Complex*, - Complex*, const int&, int&, long, long); + F77_RET_T + F77_FUNC (zunghr, ZUNGHR) (const int&, const int&, const int&, + Complex*, const int&, Complex*, + Complex*, const int&, int&); - int F77_FUNC (zgebak, ZGEBAK) (const char*, const char*, const int&, - const int&, const int&, double*, - const int&, Complex*, const int&, - int&, long, long); + F77_RET_T + F77_FUNC (zgebak, ZGEBAK) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int&, const int&, const int&, double*, + const int&, Complex*, const int&, int& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } int @@ -81,8 +87,9 @@ Array<double> scale (n); double *pscale = scale.fortran_vec (); - F77_XFCN (zgebal, ZGEBAL, (&job, n, h, n, ilo, ihi, pscale, info, - 1L, 1L)); + F77_XFCN (zgebal, ZGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), + n, h, n, ilo, ihi, pscale, info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) ("unrecoverable error in zgebal"); @@ -94,8 +101,7 @@ Array<Complex> work (lwork); Complex *pwork = work.fortran_vec (); - F77_XFCN (zgehrd, ZGEHRD, (n, ilo, ihi, h, n, ptau, pwork, lwork, - info, 1L, 1L)); + F77_XFCN (zgehrd, ZGEHRD, (n, ilo, ihi, h, n, ptau, pwork, lwork, info)); if (f77_exception_encountered) (*current_liboctave_error_handler) ("unrecoverable error in zgehrd"); @@ -105,15 +111,18 @@ Complex *z = unitary_hess_mat.fortran_vec (); F77_XFCN (zunghr, ZUNGHR, (n, ilo, ihi, z, n, ptau, pwork, - lwork, info, 1L, 1L)); + lwork, info)); if (f77_exception_encountered) (*current_liboctave_error_handler) ("unrecoverable error in zunghr"); else { - F77_XFCN (zgebak, ZGEBAK, (&job, &side, n, ilo, ihi, - pscale, n, z, n, info, 1L, 1L)); + F77_XFCN (zgebak, ZGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 (&side, 1), + n, ilo, ihi, pscale, n, z, n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler)
--- a/liboctave/CmplxLU.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/CmplxLU.cc Mon Oct 27 20:38:03 2003 +0000 @@ -43,8 +43,9 @@ extern "C" { - int F77_FUNC (zgetrf, ZGETRF) (const int&, const int&, Complex*, - const int&, int*, int&); + F77_RET_T + F77_FUNC (zgetrf, ZGETRF) (const int&, const int&, Complex*, + const int&, int*, int&); } ComplexLU::ComplexLU (const ComplexMatrix& a)
--- a/liboctave/CmplxQR.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/CmplxQR.cc Mon Oct 27 20:38:03 2003 +0000 @@ -34,13 +34,15 @@ extern "C" { - int F77_FUNC (zgeqrf, ZGEQRF) (const int&, const int&, Complex*, - const int&, Complex*, Complex*, - const int&, int&); + F77_RET_T + F77_FUNC (zgeqrf, ZGEQRF) (const int&, const int&, Complex*, + const int&, Complex*, Complex*, + const int&, int&); - int F77_FUNC (zungqr, ZUNGQR) (const int&, const int&, const int&, - Complex*, const int&, Complex*, - Complex*, const int&, int&); + F77_RET_T + F77_FUNC (zungqr, ZUNGQR) (const int&, const int&, const int&, + Complex*, const int&, Complex*, + Complex*, const int&, int&); } ComplexQR::ComplexQR (const ComplexMatrix& a, QR::type qr_type)
--- a/liboctave/CmplxQRP.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/CmplxQRP.cc Mon Oct 27 20:38:03 2003 +0000 @@ -36,13 +36,15 @@ extern "C" { - int F77_FUNC (zgeqpf, ZGEQPF) (const int&, const int&, Complex*, - const int&, int*, Complex*, Complex*, - double*, int&); + F77_RET_T + F77_FUNC (zgeqpf, ZGEQPF) (const int&, const int&, Complex*, + const int&, int*, Complex*, Complex*, + double*, int&); - int F77_FUNC (zungqr, ZUNGQR) (const int&, const int&, const int&, - Complex*, const int&, Complex*, - Complex*, const int&, int&); + F77_RET_T + F77_FUNC (zungqr, ZUNGQR) (const int&, const int&, const int&, + Complex*, const int&, Complex*, + Complex*, const int&, int&); } // It would be best to share some of this code with ComplexQR class...
--- a/liboctave/CmplxSCHUR.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/CmplxSCHUR.cc Mon Oct 27 20:38:03 2003 +0000 @@ -34,13 +34,18 @@ extern "C" { - int F77_FUNC (zgeesx, ZGEESX) (const char*, const char*, - ComplexSCHUR::select_function, - const char*, const int&, Complex*, - const int&, int&, Complex*, Complex*, - const int&, double&, double&, - Complex*, const int&, double*, int*, - int&, long, long, long); + F77_RET_T + F77_FUNC (zgeesx, ZGEESX) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + ComplexSCHUR::select_function, + F77_CONST_CHAR_ARG_DECL, + const int&, Complex*, const int&, int&, + Complex*, Complex*, const int&, double&, + double&, Complex*, const int&, double*, int*, + int& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } static int @@ -113,9 +118,15 @@ Array<int> bwork ((ord_char == 'N' || ord_char == 'n') ? 0 : n); int *pbwork = bwork.fortran_vec (); - F77_XFCN (zgeesx, ZGEESX, (&jobvs, &sort, selector, &sense, n, s, n, - sdim, pw, q, n, rconde, rcondv, pwork, - lwork, prwork, pbwork, info, 1L, 1L, 1L)); + F77_XFCN (zgeesx, ZGEESX, (F77_CONST_CHAR_ARG2 (&jobvs, 1), + F77_CONST_CHAR_ARG2 (&sort, 1), + selector, + F77_CONST_CHAR_ARG2 (&sense, 1), + n, s, n, sdim, pw, q, n, rconde, rcondv, + pwork, lwork, prwork, pbwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) ("unrecoverable error in zgeesx");
--- a/liboctave/CmplxSVD.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/CmplxSVD.cc Mon Oct 27 20:38:03 2003 +0000 @@ -34,12 +34,15 @@ extern "C" { - int F77_FUNC (zgesvd, ZGESVD) (const char*, const char*, const int&, - const int&, Complex*, const int&, - double*, Complex*, const int&, - Complex*, const int&, Complex*, - const int&, double*, int&, long, - long); + F77_RET_T + F77_FUNC (zgesvd, ZGESVD) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int&, const int&, Complex*, + const int&, double*, Complex*, const int&, + Complex*, const int&, Complex*, const int&, + double*, int& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } ComplexMatrix @@ -141,10 +144,13 @@ Array<Complex> work (1); - F77_XFCN (zgesvd, ZGESVD, (&jobu, &jobv, m, n, tmp_data, m, s_vec, - u, m, vt, nrow_vt, work.fortran_vec (), - lwork, rwork.fortran_vec (), info, 1L, - 1L)); + F77_XFCN (zgesvd, ZGESVD, (F77_CONST_CHAR_ARG2 (&jobu, 1), + F77_CONST_CHAR_ARG2 (&jobv, 1), + m, n, tmp_data, m, s_vec, u, m, vt, + nrow_vt, work.fortran_vec (), lwork, + rwork.fortran_vec (), info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) ("unrecoverable error in zgesvd"); @@ -153,11 +159,13 @@ lwork = static_cast<int> (work(0).real ()); work.resize (lwork); - F77_XFCN (zgesvd, ZGESVD, (&jobu, &jobv, m, n, tmp_data, m, - s_vec, u, m, vt, nrow_vt, - work.fortran_vec (), lwork, - rwork.fortran_vec (), - info, 1L, 1L)); + F77_XFCN (zgesvd, ZGESVD, (F77_CONST_CHAR_ARG2 (&jobu, 1), + F77_CONST_CHAR_ARG2 (&jobv, 1), + m, n, tmp_data, m, s_vec, u, m, vt, + nrow_vt, work.fortran_vec (), lwork, + rwork.fortran_vec (), info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) ("unrecoverable error in zgesvd");
--- a/liboctave/CollocWt.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/CollocWt.cc Mon Oct 27 20:38:03 2003 +0000 @@ -36,13 +36,15 @@ extern "C" { - int F77_FUNC (jcobi, JCOBI) (int&, int&, int&, int&, double&, - double&, double*, double*, double*, - double*); + F77_RET_T + F77_FUNC (jcobi, JCOBI) (int&, int&, int&, int&, double&, + double&, double*, double*, double*, + double*); - int F77_FUNC (dfopr, DFOPR) (int&, int&, int&, int&, int&, int&, - double*, double*, double*, double*, - double*); + F77_RET_T + F77_FUNC (dfopr, DFOPR) (int&, int&, int&, int&, int&, int&, + double*, double*, double*, double*, + double*); } // Error handling.
--- a/liboctave/DASPK.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/DASPK.cc Mon Oct 27 20:38:03 2003 +0000 @@ -53,12 +53,15 @@ double*, int*); extern "C" -int F77_FUNC (ddaspk, DDASPK) (daspk_fcn_ptr, const int&, double&, - double*, double*, double&, const int*, - const double*, const double*, int&, - double*, const int&, int*, const int&, - const double*, const int*, - daspk_jac_ptr, daspk_psol_ptr); +{ + F77_RET_T + F77_FUNC (ddaspk, DDASPK) (daspk_fcn_ptr, const int&, double&, + double*, double*, double&, const int*, + const double*, const double*, int&, + double*, const int&, int*, const int&, + const double*, const int*, + daspk_jac_ptr, daspk_psol_ptr); +} static DAEFunc::DAERHSFunc user_fun; static DAEFunc::DAEJacFunc user_jac;
--- a/liboctave/DASRT.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/DASRT.cc Mon Oct 27 20:38:03 2003 +0000 @@ -47,12 +47,15 @@ const int&, double*, double*, int*); extern "C" -int F77_FUNC (ddasrt, DASRT) (dasrt_fcn_ptr, const int&, double&, - double*, double*, const double&, int*, - const double*, const double*, int&, double*, - const int&, int*, const int&, double*, - int*, dasrt_jac_ptr, dasrt_constr_ptr, - const int&, int*); +{ + F77_RET_T + F77_FUNC (ddasrt, DASRT) (dasrt_fcn_ptr, const int&, double&, + double*, double*, const double&, int*, + const double*, const double*, int&, double*, + const int&, int*, const int&, double*, + int*, dasrt_jac_ptr, dasrt_constr_ptr, + const int&, int*); +} static DAEFunc::DAERHSFunc user_fsub; static DAEFunc::DAEJacFunc user_jsub;
--- a/liboctave/DASSL.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/DASSL.cc Mon Oct 27 20:38:03 2003 +0000 @@ -44,12 +44,15 @@ double*, const double&, double*, int*); extern "C" -int F77_FUNC (ddassl, DDASSL) (dassl_fcn_ptr, const int&, double&, - double*, double*, double&, const int*, - const double*, const double*, int&, - double*, const int&, int*, const int&, - const double*, const int*, - dassl_jac_ptr); +{ + F77_RET_T + F77_FUNC (ddassl, DDASSL) (dassl_fcn_ptr, const int&, double&, + double*, double*, double&, const int*, + const double*, const double*, int&, + double*, const int&, int*, const int&, + const double*, const int*, + dassl_jac_ptr); +} static DAEFunc::DAERHSFunc user_fun; static DAEFunc::DAEJacFunc user_jac;
--- a/liboctave/EIG.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/EIG.cc Mon Oct 27 20:38:03 2003 +0000 @@ -35,25 +35,39 @@ extern "C" { - int F77_FUNC (dgeev, DGEEV) (const char*, const char*, const int&, - double*, const int&, double*, double*, - double*, const int&, double*, - const int&, double*, const int&, int&, - long, long); + F77_RET_T + F77_FUNC (dgeev, DGEEV) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int&, double*, const int&, double*, + double*, double*, const int&, double*, + const int&, double*, const int&, int& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); - int F77_FUNC (zgeev, ZGEEV) (const char*, const char*, const int&, - Complex*, const int&, Complex*, - Complex*, const int&, Complex*, - const int&, Complex*, const int&, - double*, int&, long, long); + F77_RET_T + F77_FUNC (zgeev, ZGEEV) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int&, Complex*, const int&, Complex*, + Complex*, const int&, Complex*, const int&, + Complex*, const int&, double*, int& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); - int F77_FUNC (dsyev, DSYEV) (const char*, const char*, const int&, - double*, const int&, double*, double*, - const int&, int&, long, long); + F77_RET_T + F77_FUNC (dsyev, DSYEV) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int&, double*, const int&, double*, + double*, const int&, int& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); - int F77_FUNC (zheev, ZHEEV) (const char*, const char*, const int&, - Complex*, const int&, double*, Complex*, - const int&, double*, int&, long, long); + F77_RET_T + F77_FUNC (zheev, ZHEEV) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int&, Complex*, const int&, double*, + Complex*, const int&, double*, int& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } int @@ -94,8 +108,12 @@ double *dummy = 0; int idummy = 1; - F77_XFCN (dgeev, DGEEV, ("N", "V", n, tmp_data, n, pwr, pwi, dummy, - idummy, pvr, n, pwork, lwork, info, 1L, 1L)); + F77_XFCN (dgeev, DGEEV, (F77_CONST_CHAR_ARG2 ("N", 1), + F77_CONST_CHAR_ARG2 ("V", 1), + n, tmp_data, n, pwr, pwi, dummy, + idummy, pvr, n, pwork, lwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered || info < 0) (*current_liboctave_error_handler) ("unrecoverable error in dgeev"); @@ -170,8 +188,11 @@ Array<double> work (lwork); double *pwork = work.fortran_vec (); - F77_XFCN (dsyev, DSYEV, ("V", "U", n, tmp_data, n, pwr, pwork, - lwork, info, 1L, 1L)); + F77_XFCN (dsyev, DSYEV, (F77_CONST_CHAR_ARG2 ("V", 1), + F77_CONST_CHAR_ARG2 ("U", 1), + n, tmp_data, n, pwr, pwork, lwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered || info < 0) (*current_liboctave_error_handler) ("unrecoverable error in dsyev"); @@ -225,8 +246,12 @@ Complex *dummy = 0; int idummy = 1; - F77_XFCN (zgeev, ZGEEV, ("N", "V", n, tmp_data, n, pw, dummy, idummy, - pv, n, pwork, lwork, prwork, info, 1L, 1L)); + F77_XFCN (zgeev, ZGEEV, (F77_CONST_CHAR_ARG2 ("N", 1), + F77_CONST_CHAR_ARG2 ("V", 1), + n, tmp_data, n, pw, dummy, idummy, + pv, n, pwork, lwork, prwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered || info < 0) (*current_liboctave_error_handler) ("unrecoverable error in zgeev"); @@ -271,8 +296,11 @@ Array<double> rwork (lrwork); double *prwork = rwork.fortran_vec (); - F77_XFCN (zheev, ZHEEV, ("V", "U", n, tmp_data, n, pwr, pwork, - lwork, prwork, info, 1L, 1L)); + F77_XFCN (zheev, ZHEEV, (F77_CONST_CHAR_ARG2 ("V", 1), + F77_CONST_CHAR_ARG2 ("U", 1), + n, tmp_data, n, pwr, pwork, lwork, prwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered || info < 0) (*current_liboctave_error_handler) ("unrecoverable error in zheev");
--- a/liboctave/LSODE.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/LSODE.cc Mon Oct 27 20:38:03 2003 +0000 @@ -45,10 +45,13 @@ int&); extern "C" -int F77_FUNC (lsode, LSODE) (lsode_fcn_ptr, int&, double*, double&, - double&, int&, double&, const double*, int&, - int&, int&, double*, int&, int*, int&, - lsode_jac_ptr, int&); +{ + F77_RET_T + F77_FUNC (lsode, LSODE) (lsode_fcn_ptr, int&, double*, double&, + double&, int&, double&, const double*, int&, + int&, int&, double*, int&, int*, int&, + lsode_jac_ptr, int&); +} static ODEFunc::ODERHSFunc user_fun; static ODEFunc::ODEJacFunc user_jac;
--- a/liboctave/NLEqn.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/NLEqn.cc Mon Oct 27 20:38:03 2003 +0000 @@ -36,17 +36,21 @@ typedef int (*hybrd1_fcn_ptr) (int*, double*, double*, int*); -extern "C" -int F77_FUNC (hybrd1, HYBRD1) (hybrd1_fcn_ptr, const int&, double*, - double*, const double&, int&, double*, - const int&); - typedef int (*hybrj1_fcn_ptr) (int*, double*, double*, double*, int*, int*); extern "C" -int F77_FUNC (hybrj1, HYBRJ1) (hybrj1_fcn_ptr, const int&, double*, - double*, double*, const int&, const - double&, int&, double*, const int&); +{ + F77_RET_T + F77_FUNC (hybrd1, HYBRD1) (hybrd1_fcn_ptr, const int&, double*, + double*, const double&, int&, double*, + const int&); + + + F77_RET_T + F77_FUNC (hybrj1, HYBRJ1) (hybrj1_fcn_ptr, const int&, double*, + double*, double*, const int&, const + double&, int&, double*, const int&); +} static NLFunc::nonlinear_fcn user_fun; static NLFunc::jacobian_fcn user_jac;
--- a/liboctave/ODESSA.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/ODESSA.cc Mon Oct 27 20:38:03 2003 +0000 @@ -53,11 +53,14 @@ extern "C" -int F77_FUNC (odessa, ODESSA) (odessa_fcn_ptr, odessa_dfdp_ptr, int*, - double*, double*, double&, double&, - int&, double&, const double*, int&, - int&, int*, double*, int&, int*, int&, - odessa_jac_ptr, int&); +{ + F77_RET_T + F77_FUNC (odessa, ODESSA) (odessa_fcn_ptr, odessa_dfdp_ptr, int*, + double*, double*, double&, double&, + int&, double&, const double*, int&, + int&, int*, double*, int&, int*, int&, + odessa_jac_ptr, int&); +} template class Array<Matrix>;
--- a/liboctave/Quad.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/Quad.cc Mon Oct 27 20:38:03 2003 +0000 @@ -45,17 +45,20 @@ typedef int (*quad_fcn_ptr) (double*, int&, double*); extern "C" -int F77_FUNC (dqagp, DQAGP) (quad_fcn_ptr, const double&, const double&, - const int&, const double*, const double&, - const double&, double&, double&, int&, - int&, const int&, const int&, int&, int*, - double*); +{ + F77_RET_T + F77_FUNC (dqagp, DQAGP) (quad_fcn_ptr, const double&, const double&, + const int&, const double*, const double&, + const double&, double&, double&, int&, + int&, const int&, const int&, int&, int*, + double*); -extern "C" -int F77_FUNC (dqagi, DQAGI) (quad_fcn_ptr, const double&, const int&, - const double&, const double&, double&, - double&, int&, int&, const int&, - const int&, int&, int*, double*); + F77_RET_T + F77_FUNC (dqagi, DQAGI) (quad_fcn_ptr, const double&, const int&, + const double&, const double&, double&, + double&, int&, int&, const int&, + const int&, int&, int*, double*); +} static int user_function (double *x, int& ierr, double *result)
--- a/liboctave/dColVector.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/dColVector.cc Mon Oct 27 20:38:03 2003 +0000 @@ -41,11 +41,13 @@ extern "C" { - int F77_FUNC (dgemv, DGEMV) (const char*, const int&, const int&, - const double&, const double*, - const int&, const double*, const int&, - const double&, double*, const int&, - long); + F77_RET_T + F77_FUNC (dgemv, DGEMV) (F77_CONST_CHAR_ARG_DECL, + const int&, const int&, const double&, + const double*, const int&, const double*, + const int&, const double&, double*, + const int& + F77_CHAR_ARG_LEN_DECL); } // Column Vector class. @@ -217,8 +219,10 @@ retval.resize (nr); double *y = retval.fortran_vec (); - F77_XFCN (dgemv, DGEMV, ("N", nr, nc, 1.0, m.data (), ld, - a.data (), 1, 0.0, y, 1, 1L)); + F77_XFCN (dgemv, DGEMV, (F77_CONST_CHAR_ARG2 ("N", 1), + nr, nc, 1.0, m.data (), ld, + a.data (), 1, 0.0, y, 1 + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler)
--- a/liboctave/dMatrix.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/dMatrix.cc Mon Oct 27 20:38:03 2003 +0000 @@ -59,64 +59,90 @@ extern "C" { - int F77_FUNC (dgebal, DGEBAL) (const char*, const int&, double*, - const int&, int&, int&, double*, - int&, long, long); - - int F77_FUNC (dgebak, DGEBAK) (const char*, const char*, const int&, - const int&, const int&, double*, - const int&, double*, const int&, - int&, long, long); - - int F77_FUNC (dgemm, DGEMM) (const char*, const char*, const int&, - const int&, const int&, const double&, - const double*, const int&, - const double*, const int&, - const double&, double*, const int&, - long, long); - - int F77_FUNC (dgetrf, DGETRF) (const int&, const int&, double*, const int&, + F77_RET_T + F77_FUNC (dgebal, DGEBAL) (F77_CONST_CHAR_ARG_DECL, + const int&, double*, const int&, int&, + int&, double*, int& + F77_CHAR_ARG_LEN_DECL); + + F77_RET_T + F77_FUNC (dgebak, DGEBAK) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int&, const int&, const int&, double*, + const int&, double*, const int&, int& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); + + + F77_RET_T + F77_FUNC (dgemm, DGEMM) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int&, const int&, const int&, + const double&, const double*, const int&, + const double*, const int&, const double&, + double*, const int& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); + + F77_RET_T + F77_FUNC (dgetrf, DGETRF) (const int&, const int&, double*, const int&, int*, int&); - int F77_FUNC (dgetrs, DGETRS) (const char*, const int&, const int&, - const double*, const int&, - const int*, double*, const int&, int&); - - int F77_FUNC (dgetri, DGETRI) (const int&, double*, const int&, const int*, - double*, const int&, int&); - - int F77_FUNC (dgecon, DGECON) (const char*, const int&, double*, - const int&, const double&, double&, - double*, int*, int&); - - int F77_FUNC (dgelss, DGELSS) (const int&, const int&, const int&, - double*, const int&, double*, - const int&, double*, double&, int&, - double*, const int&, int&); + F77_RET_T + F77_FUNC (dgetrs, DGETRS) (F77_CONST_CHAR_ARG_DECL, const int&, const int&, + const double*, const int&, + const int*, double*, const int&, int& + F77_CHAR_ARG_LEN_DECL); + + F77_RET_T + F77_FUNC (dgetri, DGETRI) (const int&, double*, const int&, const int*, + double*, const int&, int&); + + F77_RET_T + F77_FUNC (dgecon, DGECON) (F77_CONST_CHAR_ARG_DECL, const int&, double*, + const int&, const double&, double&, + double*, int*, int& + F77_CHAR_ARG_LEN_DECL); + + F77_RET_T + F77_FUNC (dgelss, DGELSS) (const int&, const int&, const int&, + double*, const int&, double*, + const int&, double*, double&, int&, + double*, const int&, int&); // Note that the original complex fft routines were not written for // double complex arguments. They have been modified by adding an // implicit double precision (a-h,o-z) statement at the beginning of // each subroutine. - int F77_FUNC (cffti, CFFTI) (const int&, Complex*); - - int F77_FUNC (cfftf, CFFTF) (const int&, Complex*, Complex*); - - int F77_FUNC (cfftb, CFFTB) (const int&, Complex*, Complex*); - - int F77_FUNC (dlartg, DLARTG) (const double&, const double&, double&, - double&, double&); - - int F77_FUNC (dtrsyl, DTRSYL) (const char*, const char*, const int&, - const int&, const int&, const double*, - const int&, const double*, const int&, - const double*, const int&, double&, - int&, long, long); - - int F77_FUNC (xdlange, XDLANGE) (const char*, const int&, - const int&, const double*, - const int&, double*, double&); + F77_RET_T + F77_FUNC (cffti, CFFTI) (const int&, Complex*); + + F77_RET_T + F77_FUNC (cfftf, CFFTF) (const int&, Complex*, Complex*); + + F77_RET_T + F77_FUNC (cfftb, CFFTB) (const int&, Complex*, Complex*); + + F77_RET_T + F77_FUNC (dlartg, DLARTG) (const double&, const double&, double&, + double&, double&); + + F77_RET_T + F77_FUNC (dtrsyl, DTRSYL) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int&, const int&, const int&, + const double*, const int&, const double*, + const int&, const double*, const int&, + double&, int& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); + + F77_RET_T + F77_FUNC (xdlange, XDLANGE) (F77_CONST_CHAR_ARG_DECL, const int&, + const int&, const double*, + const int&, double*, double& + F77_CHAR_ARG_LEN_DECL); } // Matrix class. @@ -669,8 +695,10 @@ char job = '1'; Array<int> iz (nc); int *piz = iz.fortran_vec (); - F77_XFCN (dgecon, DGECON, (&job, nc, tmp_data, nr, anorm, - rcond, pz, piz, info)); + F77_XFCN (dgecon, DGECON, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, tmp_data, nr, anorm, + rcond, pz, piz, info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) @@ -685,7 +713,7 @@ else { F77_XFCN (dgetri, DGETRI, (nc, tmp_data, nr, pipvt, - pz, lwork, info)); + pz, lwork, info)); if (f77_exception_encountered) (*current_liboctave_error_handler) @@ -1130,8 +1158,10 @@ Array<int> iz (nc); int *piz = iz.fortran_vec (); - F77_XFCN (dgecon, DGECON, (&job, nc, tmp_data, nr, anorm, - rcond, pz, piz, info)); + F77_XFCN (dgecon, DGECON, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, tmp_data, nr, anorm, + rcond, pz, piz, info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) @@ -1245,8 +1275,10 @@ { // Now calculate the condition number for non-singular matrix. char job = '1'; - F77_XFCN (dgecon, DGECON, (&job, nc, tmp_data, nr, anorm, - rcond, pz, piz, info)); + F77_XFCN (dgecon, DGECON, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, tmp_data, nr, anorm, + rcond, pz, piz, info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) @@ -1276,8 +1308,10 @@ int b_nc = b.cols (); char job = 'N'; - F77_XFCN (dgetrs, DGETRS, (&job, nr, b_nc, tmp_data, nr, - pipvt, result, b.rows(), info)); + F77_XFCN (dgetrs, DGETRS, (F77_CONST_CHAR_ARG2 (&job, 1), + nr, b_nc, tmp_data, nr, + pipvt, result, b.rows(), info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) @@ -1392,8 +1426,10 @@ { // Now calculate the condition number for non-singular matrix. char job = '1'; - F77_XFCN (dgecon, DGECON, (&job, nc, tmp_data, nr, anorm, - rcond, pz, piz, info)); + F77_XFCN (dgecon, DGECON, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, tmp_data, nr, anorm, + rcond, pz, piz, info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) @@ -1421,8 +1457,10 @@ double *result = retval.fortran_vec (); char job = 'N'; - F77_XFCN (dgetrs, DGETRS, (&job, nr, 1, tmp_data, nr, pipvt, - result, b.length(), info)); + F77_XFCN (dgetrs, DGETRS, (F77_CONST_CHAR_ARG2 (&job, 1), + nr, 1, tmp_data, nr, pipvt, + result, b.length(), info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) @@ -1728,13 +1766,17 @@ // permutation first char job = 'P'; - F77_XFCN (dgebal, DGEBAL, (&job, nc, p_m, nc, ilo, ihi, - dpermute.fortran_vec (), info, 1L, 1L)); + F77_XFCN (dgebal, DGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, p_m, nc, ilo, ihi, + dpermute.fortran_vec (), info + F77_CHAR_ARG_LEN (1))); // then scaling job = 'S'; - F77_XFCN (dgebal, DGEBAL, (&job, nc, p_m, nc, ilos, ihis, - dscale.fortran_vec (), info, 1L, 1L)); + F77_XFCN (dgebal, DGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), + nc, p_m, nc, ilos, ihis, + dscale.fortran_vec (), info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) { @@ -1747,8 +1789,10 @@ ColumnVector work(nc); double inf_norm; - F77_XFCN (xdlange, XDLANGE, ("I", nc, nc, m.fortran_vec (), nc, - work.fortran_vec (), inf_norm)); + F77_XFCN (xdlange, XDLANGE, (F77_CONST_CHAR_ARG2 ("I", 1), + nc, nc, m.fortran_vec (), nc, + work.fortran_vec (), inf_norm + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) { @@ -1936,9 +1980,12 @@ retval.resize (len, a_len); double *c = retval.fortran_vec (); - F77_XFCN (dgemm, DGEMM, ("N", "N", len, a_len, 1, 1.0, - v.data (), len, a.data (), 1, 0.0, - c, len, 1L, 1L)); + F77_XFCN (dgemm, DGEMM, (F77_CONST_CHAR_ARG2 ("N", 1), + F77_CONST_CHAR_ARG2 ("N", 1), + len, a_len, 1, 1.0, v.data (), len, + a.data (), 1, 0.0, c, len + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) @@ -3020,8 +3067,12 @@ double *pb = sch_b.fortran_vec (); double *px = cx.fortran_vec (); - F77_XFCN (dtrsyl, DTRSYL, ("N", "N", 1, a_nr, b_nr, pa, a_nr, pb, - b_nr, px, a_nr, scale, info, 1L, 1L)); + F77_XFCN (dtrsyl, DTRSYL, (F77_CONST_CHAR_ARG2 ("N", 1), + F77_CONST_CHAR_ARG2 ("N", 1), + 1, a_nr, b_nr, pa, a_nr, pb, + b_nr, px, a_nr, scale, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) @@ -3063,9 +3114,12 @@ retval.resize (nr, a_nc); double *c = retval.fortran_vec (); - F77_XFCN (dgemm, DGEMM, ("N", "N", nr, a_nc, nc, 1.0, - m.data (), ld, a.data (), lda, 0.0, - c, nr, 1L, 1L)); + F77_XFCN (dgemm, DGEMM, (F77_CONST_CHAR_ARG2 ("N", 1), + F77_CONST_CHAR_ARG2 ("N", 1), + nr, a_nc, nc, 1.0, m.data (), + ld, a.data (), lda, 0.0, c, nr + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler)
--- a/liboctave/dRowVector.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/dRowVector.cc Mon Oct 27 20:38:03 2003 +0000 @@ -41,14 +41,15 @@ extern "C" { - int F77_FUNC (dgemv, DGEMV) (const char*, const int&, const int&, - const double&, const double*, - const int&, const double*, const int&, - const double&, double*, const int&, - long); + F77_RET_T + F77_FUNC (dgemv, DGEMV) (F77_CONST_CHAR_ARG_DECL, + const int&, const int&, const double&, + const double*, const int&, const double*, + const int&, const double&, double*, const int& + F77_CHAR_ARG_LEN_DECL); double F77_FUNC (ddot, DDOT) (const int&, const double*, const int&, - const double*, const int&); + const double*, const int&); } // Row Vector class. @@ -223,8 +224,10 @@ retval.resize (a_nc); double *y = retval.fortran_vec (); - F77_XFCN (dgemv, DGEMV, ("T", a_nr, a_nc, 1.0, a.data (), - ld, v.data (), 1, 0.0, y, 1, 1L)); + F77_XFCN (dgemv, DGEMV, (F77_CONST_CHAR_ARG2 ("T", 1), + a_nr, a_nc, 1.0, a.data (), + ld, v.data (), 1, 0.0, y, 1 + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler)
--- a/liboctave/dbleAEPBAL.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/dbleAEPBAL.cc Mon Oct 27 20:38:03 2003 +0000 @@ -35,14 +35,19 @@ extern "C" { - int F77_FUNC (dgebal, DGEBAL) (const char*, const int&, double*, - const int&, int&, int&, double*, - int&, long, long); + F77_RET_T + F77_FUNC (dgebal, DGEBAL) (F77_CONST_CHAR_ARG_DECL, + const int&, double*, const int&, int&, + int&, double*, int& + F77_CHAR_ARG_LEN_DECL); - int F77_FUNC (dgebak, DGEBAK) (const char*, const char*, const int&, - const int&, const int&, double*, - const int&, double*, const int&, - int&, long, long); + F77_RET_T + F77_FUNC (dgebak, DGEBAK) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int&, const int&, const int&, double*, + const int&, double*, const int&, int& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } int @@ -68,8 +73,9 @@ char job = balance_job[0]; - F77_XFCN (dgebal, DGEBAL, (&job, n, p_balanced_mat, n, ilo, ihi, - pscale, info, 1L, 1L)); + F77_XFCN (dgebal, DGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), + n, p_balanced_mat, n, ilo, ihi, pscale, info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) ("unrecoverable error in dgebal"); @@ -83,8 +89,12 @@ char side = 'R'; - F77_XFCN (dgebak, DGEBAK, (&job, &side, n, ilo, ihi, pscale, n, - p_balancing_mat, n, info, 1L, 1L)); + F77_XFCN (dgebak, DGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 (&side, 1), + n, ilo, ihi, pscale, n, + p_balancing_mat, n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) ("unrecoverable error in dgebak");
--- a/liboctave/dbleCHOL.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/dbleCHOL.cc Mon Oct 27 20:38:03 2003 +0000 @@ -34,8 +34,10 @@ extern "C" { - int F77_FUNC (dpotrf, DPOTRF) (const char*, const int&, double*, - const int&, int&, long); + F77_RET_T + F77_FUNC (dpotrf, DPOTRF) (F77_CONST_CHAR_ARG_DECL, const int&, + double*, const int&, int& + F77_CHAR_ARG_LEN_DECL); } int @@ -56,7 +58,9 @@ chol_mat = a; double *h = chol_mat.fortran_vec (); - F77_XFCN (dpotrf, DPOTRF, ("U", n, h, n, info, 1L)); + F77_XFCN (dpotrf, DPOTRF, (F77_CONST_CHAR_ARG2 ("U", 1), + n, h, n, info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) ("unrecoverable error in dpotrf");
--- a/liboctave/dbleHESS.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/dbleHESS.cc Mon Oct 27 20:38:03 2003 +0000 @@ -34,22 +34,29 @@ extern "C" { - int F77_FUNC (dgebal, DGEBAL) (const char*, const int&, double*, - const int&, int&, int&, double*, - int&, long, long); + F77_RET_T + F77_FUNC (dgebal, DGEBAL) (F77_CONST_CHAR_ARG_DECL, + const int&, double*, const int&, int&, + int&, double*, int& + F77_CHAR_ARG_LEN_DECL); - int F77_FUNC (dgehrd, DGEHRD) (const int&, const int&, const int&, - double*, const int&, double*, double*, - const int&, int&, long, long); + F77_RET_T + F77_FUNC (dgehrd, DGEHRD) (const int&, const int&, const int&, + double*, const int&, double*, double*, + const int&, int&); - int F77_FUNC (dorghr, DORGHR) (const int&, const int&, const int&, - double*, const int&, double*, double*, - const int&, int&, long, long); + F77_RET_T + F77_FUNC (dorghr, DORGHR) (const int&, const int&, const int&, + double*, const int&, double*, double*, + const int&, int&); - int F77_FUNC (dgebak, DGEBAK) (const char*, const char*, const int&, - const int&, const int&, double*, - const int&, double*, const int&, int&, - long, long); + F77_RET_T + F77_FUNC (dgebak, DGEBAK) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int&, const int&, const int&, double*, + const int&, double*, const int&, int& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } int @@ -79,8 +86,9 @@ Array<double> scale (n); double *pscale = scale.fortran_vec (); - F77_XFCN (dgebal, DGEBAL, (&job, n, h, n, ilo, ihi, pscale, info, - 1L, 1L)); + F77_XFCN (dgebal, DGEBAL, (F77_CONST_CHAR_ARG2 (&job, 1), + n, h, n, ilo, ihi, pscale, info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) ("unrecoverable error in dgebal"); @@ -93,7 +101,7 @@ double *pwork = work.fortran_vec (); F77_XFCN (dgehrd, DGEHRD, (n, ilo, ihi, h, n, ptau, pwork, - lwork, info, 1L, 1L)); + lwork, info)); if (f77_exception_encountered) (*current_liboctave_error_handler) ("unrecoverable error in dgehrd"); @@ -103,15 +111,19 @@ double *z = unitary_hess_mat.fortran_vec (); F77_XFCN (dorghr, DORGHR, (n, ilo, ihi, z, n, ptau, pwork, - lwork, info, 1L, 1L)); + lwork, info)); if (f77_exception_encountered) (*current_liboctave_error_handler) ("unrecoverable error in dorghr"); else { - F77_XFCN (dgebak, DGEBAK, (&job, &side, n, ilo, ihi, - pscale, n, z, n, info, 1L, 1L)); + F77_XFCN (dgebak, DGEBAK, (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 (&side, 1), + n, ilo, ihi, pscale, n, z, + n, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler)
--- a/liboctave/dbleLU.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/dbleLU.cc Mon Oct 27 20:38:03 2003 +0000 @@ -43,8 +43,9 @@ extern "C" { - int F77_FUNC (dgetrf, DGETRF) (const int&, const int&, double*, - const int&, int*, int&); + F77_RET_T + F77_FUNC (dgetrf, DGETRF) (const int&, const int&, double*, + const int&, int*, int&); } LU::LU (const Matrix& a)
--- a/liboctave/dbleQR.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/dbleQR.cc Mon Oct 27 20:38:03 2003 +0000 @@ -34,13 +34,13 @@ extern "C" { - int F77_FUNC (dgeqrf, DGEQRF) (const int&, const int&, double*, - const int&, double*, double*, - const int&, int&); + F77_RET_T + F77_FUNC (dgeqrf, DGEQRF) (const int&, const int&, double*, const int&, + double*, double*, const int&, int&); - int F77_FUNC (dorgqr, DORGQR) (const int&, const int&, const int&, - double*, const int&, double*, double*, - const int&, int&); + F77_RET_T + F77_FUNC (dorgqr, DORGQR) (const int&, const int&, const int&, double*, + const int&, double*, double*, const int&, int&); } QR::QR (const Matrix& a, QR::type qr_type)
--- a/liboctave/dbleQRP.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/dbleQRP.cc Mon Oct 27 20:38:03 2003 +0000 @@ -36,13 +36,14 @@ extern "C" { - int F77_FUNC (dgeqpf, DGEQPF) (const int&, const int&, double*, - const int&, int*, double*, double*, - int&); + F77_RET_T + F77_FUNC (dgeqpf, DGEQPF) (const int&, const int&, double*, + const int&, int*, double*, double*, int&); - int F77_FUNC (dorgqr, DORGQR) (const int&, const int&, const int&, - double*, const int&, double*, double*, - const int&, int&); + F77_RET_T + F77_FUNC (dorgqr, DORGQR) (const int&, const int&, const int&, + double*, const int&, double*, double*, + const int&, int&); } // It would be best to share some of this code with QR class...
--- a/liboctave/dbleSCHUR.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/dbleSCHUR.cc Mon Oct 27 20:38:03 2003 +0000 @@ -36,13 +36,18 @@ extern "C" { - int F77_FUNC (dgeesx, DGEESX) (const char*, const char*, - SCHUR::select_function, const char*, - const int&, double*, const int&, - int&, double*, double*, double*, - const int&, double&, double&, double*, - const int&, int*, const int&, int*, - int&, long, long, long); + F77_RET_T + F77_FUNC (dgeesx, DGEESX) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + SCHUR::select_function, + F77_CONST_CHAR_ARG_DECL, + const int&, double*, const int&, int&, + double*, double*, double*, const int&, + double&, double&, double*, const int&, + int*, const int&, int*, int& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } static int @@ -118,10 +123,15 @@ Array<int> iwork (liwork); int *piwork = iwork.fortran_vec (); - F77_XFCN (dgeesx, DGEESX, (&jobvs, &sort, selector, &sense, n, s, - n, sdim, pwr, pwi, q, n, rconde, rcondv, - pwork, lwork, piwork, liwork, pbwork, - info, 1L, 1L, 1L)); + F77_XFCN (dgeesx, DGEESX, (F77_CONST_CHAR_ARG2 (&jobvs, 1), + F77_CONST_CHAR_ARG2 (&sort, 1), + selector, + F77_CONST_CHAR_ARG2 (&sense, 1), + n, s, n, sdim, pwr, pwi, q, n, rconde, rcondv, + pwork, lwork, piwork, liwork, pbwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) ("unrecoverable error in dgeesx");
--- a/liboctave/dbleSVD.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/dbleSVD.cc Mon Oct 27 20:38:03 2003 +0000 @@ -35,11 +35,15 @@ extern "C" { - int F77_FUNC (dgesvd, DGESVD) (const char*, const char*, const int&, - const int&, double*, const int&, - double*, double*, const int&, double*, - const int&, double*, const int&, int&, - long, long); + F77_RET_T + F77_FUNC (dgesvd, DGESVD) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int&, const int&, double*, + const int&, double*, double*, + const int&, double*, const int&, + double*, const int&, int& + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); } Matrix @@ -136,9 +140,12 @@ Array<double> work (1); - F77_XFCN (dgesvd, DGESVD, (&jobu, &jobv, m, n, tmp_data, m, s_vec, - u, m, vt, nrow_vt, work.fortran_vec (), - lwork, info, 1L, 1L)); + F77_XFCN (dgesvd, DGESVD, (F77_CONST_CHAR_ARG2 (&jobu, 1), + F77_CONST_CHAR_ARG2 (&jobv, 1), + m, n, tmp_data, m, s_vec, u, m, vt, + nrow_vt, work.fortran_vec (), lwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) ("unrecoverable error in dgesvd"); @@ -147,10 +154,12 @@ lwork = static_cast<int> (work(0)); work.resize (lwork); - F77_XFCN (dgesvd, DGESVD, (&jobu, &jobv, m, n, tmp_data, m, - s_vec, u, m, vt, nrow_vt, - work.fortran_vec (), lwork, info, 1L, - 1L)); + F77_XFCN (dgesvd, DGESVD, (F77_CONST_CHAR_ARG2 (&jobu, 1), + F77_CONST_CHAR_ARG2 (&jobv, 1), + m, n, tmp_data, m, s_vec, u, m, vt, + nrow_vt, work.fortran_vec (), lwork, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) (*current_liboctave_error_handler) ("unrecoverable error in dgesvd");
--- a/liboctave/lo-specfun.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/lo-specfun.cc Mon Oct 27 20:38:03 2003 +0000 @@ -41,53 +41,66 @@ extern "C" { - int F77_FUNC (zbesj, ZBESJ) (const double&, const double&, - const double&, const int&, const int&, - double*, double*, int&, int&); + F77_RET_T + F77_FUNC (zbesj, ZBESJ) (const double&, const double&, const double&, + const int&, const int&, double*, double*, + int&, int&); - int F77_FUNC (zbesy, ZBESY) (const double&, const double&, - const double&, const int&, const int&, - double*, double*, int&, - double*, double*, int&); + F77_RET_T + F77_FUNC (zbesy, ZBESY) (const double&, const double&, const double&, + const int&, const int&, double*, double*, + int&, double*, double*, int&); - int F77_FUNC (zbesi, ZBESI) (const double&, const double&, - const double&, const int&, const int&, - double*, double*, int&, int&); + F77_RET_T + F77_FUNC (zbesi, ZBESI) (const double&, const double&, const double&, + const int&, const int&, double*, double*, + int&, int&); - int F77_FUNC (zbesk, ZBESK) (const double&, const double&, - const double&, const int&, const int&, - double*, double*, int&, int&); + F77_RET_T + F77_FUNC (zbesk, ZBESK) (const double&, const double&, const double&, + const int&, const int&, double*, double*, + int&, int&); - int F77_FUNC (zbesh, ZBESH) (const double&, const double&, - const double&, const int&, const int&, - const int&, double*, double*, int&, int&); + F77_RET_T + F77_FUNC (zbesh, ZBESH) (const double&, const double&, const double&, + const int&, const int&, const int&, double*, + double*, int&, int&); + + F77_RET_T + F77_FUNC (zairy, ZAIRY) (const double&, const double&, const int&, + const int&, double&, double&, int&, int&); - int F77_FUNC (zairy, ZAIRY) (const double&, const double&, - const int&, const int&, - double&, double&, int&, int&); + F77_RET_T + F77_FUNC (zbiry, ZBIRY) (const double&, const double&, const int&, + const int&, double&, double&, int&); + + F77_RET_T + F77_FUNC (xdacosh, XDACOSH) (const double&, double&); - int F77_FUNC (zbiry, ZBIRY) (const double&, const double&, - const int&, const int&, - double&, double&, int&); + F77_RET_T + F77_FUNC (xdasinh, XDASINH) (const double&, double&); - int F77_FUNC (xdacosh, XDACOSH) (const double&, double&); + F77_RET_T + F77_FUNC (xdatanh, XDATANH) (const double&, double&); - int F77_FUNC (xdasinh, XDASINH) (const double&, double&); + F77_RET_T + F77_FUNC (xderf, XDERF) (const double&, double&); - int F77_FUNC (xdatanh, XDATANH) (const double&, double&); + F77_RET_T + F77_FUNC (xderfc, XDERFC) (const double&, double&); - int F77_FUNC (xderf, XDERF) (const double&, double&); - - int F77_FUNC (xderfc, XDERFC) (const double&, double&); + F77_RET_T + F77_FUNC (xdbetai, XDBETAI) (const double&, const double&, + const double&, double&); - int F77_FUNC (xdbetai, XDBETAI) (const double&, const double&, - const double&, double&); + F77_RET_T + F77_FUNC (xdgamma, XDGAMMA) (const double&, double&); - int F77_FUNC (xdgamma, XDGAMMA) (const double&, double&); + F77_RET_T + F77_FUNC (xgammainc, XGAMMAINC) (const double&, const double&, double&); - int F77_FUNC (xgammainc, XGAMMAINC) (const double&, const double&, double&); - - int F77_FUNC (dlgams, DLGAMS) (const double&, double&, double&); + F77_RET_T + F77_FUNC (dlgams, DLGAMS) (const double&, double&, double&); } #if !defined (HAVE_ACOSH)
--- a/liboctave/oct-rand.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/liboctave/oct-rand.cc Mon Oct 27 20:38:03 2003 +0000 @@ -42,19 +42,23 @@ extern "C" { - int F77_FUNC (dgennor, DGENNOR) (const double&, const double&, - double&); + F77_RET_T + F77_FUNC (dgennor, DGENNOR) (const double&, const double&, double&); - int F77_FUNC (dgenunf, DGENUNF) (const double&, const double&, - double&); + F77_RET_T + F77_FUNC (dgenunf, DGENUNF) (const double&, const double&, double&); + + F77_RET_T + F77_FUNC (setall, SETALL) (const int&, const int&); - int F77_FUNC (setall, SETALL) (const int&, const int&); - - int F77_FUNC (getsd, GETSD) (int&, int&); + F77_RET_T + F77_FUNC (getsd, GETSD) (int&, int&); - int F77_FUNC (setsd, SETSD) (const int&, const int&); + F77_RET_T + F77_FUNC (setsd, SETSD) (const int&, const int&); - int F77_FUNC (setcgn, SETCGN) (const int&); + F77_RET_T + F77_FUNC (setcgn, SETCGN) (const int&); } static int
--- a/src/ChangeLog Mon Oct 27 17:04:38 2003 +0000 +++ b/src/ChangeLog Mon Oct 27 20:38:03 2003 +0000 @@ -1,5 +1,9 @@ 2003-10-27 John W. Eaton <jwe@bevo.che.wisc.edu> + * DLD-FUNCTIONS/balance.cc, DLD-FUNCTIONS/qz.cc: + Use new F77 arg macros in declarations of external Fortran + subroutines and for calling them. + * ops.h (DEFNDUNOP_OP, DEFNDUNOP_FN): New arg e, to name value extractor function prefix. * OPERATORS/op-bm-bm.cc, OPERATORS/op-cm-cm.cc, OPERATORS/op-m-m.cc:
--- a/src/DLD-FUNCTIONS/balance.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/src/DLD-FUNCTIONS/balance.cc Mon Oct 27 20:38:03 2003 +0000 @@ -43,23 +43,31 @@ extern "C" { - int F77_FUNC (dggbal, DGGBAL) (const char* JOB, const int& N, - double* A, const int& LDA, double* B, - const int& LDB, int& ILO, int& IHI, - double* LSCALE, double* RSCALE, - double* WORK, int& INFO, long); + F77_RET_T + F77_FUNC (dggbal, DGGBAL) (F77_CONST_CHAR_ARG_DECL, const int& N, + double* A, const int& LDA, double* B, + const int& LDB, int& ILO, int& IHI, + double* LSCALE, double* RSCALE, + double* WORK, int& INFO + F77_CHAR_ARG_LEN_DECL); - int F77_FUNC (dggbak, DGGBAK) (const char* JOB, const char* SIDE, - const int& N, const int& ILO, - const int& IHI, double* LSCALE, - double* RSCALE, int& M, double* V, - const int& LDV, int& INFO, long, long); + F77_RET_T + F77_FUNC (dggbak, DGGBAK) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int& N, const int& ILO, + const int& IHI, double* LSCALE, + double* RSCALE, int& M, double* V, + const int& LDV, int& INFO + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); - int F77_FUNC (zggbal, ZGGBAL) (const char* JOB, const int& N, - Complex* A, const int& LDA, Complex* B, - const int& LDB, int& ILO, int& IHI, - double* LSCALE, double* RSCALE, - double* WORK, int& INFO, long); + F77_RET_T + F77_FUNC (zggbal, ZGGBAL) (F77_CONST_CHAR_ARG_DECL, const int& N, + Complex* A, const int& LDA, Complex* B, + const int& LDB, int& ILO, int& IHI, + double* LSCALE, double* RSCALE, + double* WORK, int& INFO + F77_CHAR_ARG_LEN_DECL); } DEFUN_DLD (balance, args, nargout, @@ -239,10 +247,11 @@ cbb = ComplexMatrix (bb); F77_XFCN (zggbal, ZGGBAL, - (&job, nn, caa.fortran_vec(), nn, - cbb.fortran_vec(), nn, ilo, ihi, - lscale.fortran_vec(), rscale.fortran_vec(), - work.fortran_vec(), info, 1L)); + (F77_CONST_CHAR_ARG2 (&job, 1), + nn, caa.fortran_vec (), nn, cbb.fortran_vec (), + nn, ilo, ihi, lscale.fortran_vec (), + rscale.fortran_vec (), work.fortran_vec (), info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) { @@ -255,9 +264,11 @@ // real matrices case F77_XFCN (dggbal, DGGBAL, - (&job, nn, aa.fortran_vec(), nn, bb.fortran_vec(), - nn, ilo, ihi, lscale.fortran_vec(), - rscale.fortran_vec(), work.fortran_vec(), info, 1L)); + (F77_CONST_CHAR_ARG2 (&job, 1), + nn, aa.fortran_vec (), nn, bb.fortran_vec (), + nn, ilo, ihi, lscale.fortran_vec (), + rscale.fortran_vec (), work.fortran_vec (), info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) { @@ -281,9 +292,12 @@ // left first F77_XFCN (dggbak, DGGBAK, - (&job, "L", nn, ilo, ihi, lscale.fortran_vec(), - rscale.fortran_vec(), nn, Pl.fortran_vec(), - nn, info, 1L, 1L)); + (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 ("L", 1), + nn, ilo, ihi, lscale.fortran_vec (), + rscale.fortran_vec(), nn, Pl.fortran_vec (), nn, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) { @@ -293,9 +307,12 @@ // then right F77_XFCN (dggbak, DGGBAK, - (&job, "R", nn, ilo, ihi, lscale.fortran_vec(), - rscale.fortran_vec(), nn, Pr.fortran_vec(), - nn, info, 1L, 1L)); + (F77_CONST_CHAR_ARG2 (&job, 1), + F77_CONST_CHAR_ARG2 ("R", 1), + nn, ilo, ihi, lscale.fortran_vec (), + rscale.fortran_vec (), nn, Pr.fortran_vec (), nn, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) {
--- a/src/DLD-FUNCTIONS/qz.cc Mon Oct 27 17:04:38 2003 +0000 +++ b/src/DLD-FUNCTIONS/qz.cc Mon Oct 27 20:38:03 2003 +0000 @@ -61,66 +61,90 @@ extern "C" { - int F77_FUNC (dggbal, DGGBAL) (const char* JOB, const int& N, - double* A, const int& LDA, double* B, - const int& LDB, int& ILO, int& IHI, - double* LSCALE, double* RSCALE, - double* WORK, int& INFO, long); + F77_RET_T + F77_FUNC (dggbal, DGGBAL) (F77_CONST_CHAR_ARG_DECL, + const int& N, double* A, const int& LDA, + double* B, const int& LDB, int& ILO, + int& IHI, double* LSCALE, double* RSCALE, + double* WORK, int& INFO + F77_CHAR_ARG_LEN_DECL); - int F77_FUNC (dggbak, DGGBAK) (const char* JOB, const char* SIDE, - const int& N, const int& ILO, - const int& IHI, double* LSCALE, - double* RSCALE, int& M, double* V, - const int& LDV, int& INFO, long, long); + F77_RET_T + F77_FUNC (dggbak, DGGBAK) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int& N, const int& ILO, + const int& IHI, double* LSCALE, + double* RSCALE, int& M, double* V, + const int& LDV, int& INFO + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); - int F77_FUNC (dgghrd, DGGHRD) (const char* COMPQ, const char* COMPZ, - const int& N, const int& ILO, - const int& IHI, double* A, - const int& LDA, double* B, - const int& LDB, double* Q, - const int& LDQ, double* Z, - const int& LDZ, int& INFO, long, long); + F77_RET_T + F77_FUNC (dgghrd, DGGHRD) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int& N, const int& ILO, + const int& IHI, double* A, + const int& LDA, double* B, + const int& LDB, double* Q, + const int& LDQ, double* Z, + const int& LDZ, int& INFO + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); - int F77_FUNC (dhgeqz, DHGEQZ) (const char* JOB, const char* COMPQ, - const char* COMPZ, const int& N, - const int& ILO, const int& IHI, - double* A, const int& LDA, double* B, - const int& LDB, double* ALPHAR, - double* ALPHAI, double* BETA, double* Q, - const int& LDQ, double* Z, - const int& LDZ, double* WORK, - const int& LWORK, int& INFO, - long, long, long); + F77_RET_T + F77_FUNC (dhgeqz, DHGEQZ) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + const int& N, const int& ILO, const int& IHI, + double* A, const int& LDA, double* B, + const int& LDB, double* ALPHAR, + double* ALPHAI, double* BETA, double* Q, + const int& LDQ, double* Z, + const int& LDZ, double* WORK, + const int& LWORK, int& INFO + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); - int F77_FUNC (dlag2, DLAG2) (double* A, const int& LDA, double* B, - const int& LDB, const double& SAFMIN, - double& SCALE1, double& SCALE2, - double& WR1, double& WR2, double& WI); + F77_RET_T + F77_FUNC (dlag2, DLAG2) (double* A, const int& LDA, double* B, + const int& LDB, const double& SAFMIN, + double& SCALE1, double& SCALE2, + double& WR1, double& WR2, double& WI); // Van Dooren's code (netlib.org: toms/590) for reordering // GEP. Only processes Z, not Q. - int F77_FUNC (dsubsp, DSUBSP) (const int& NMAX, const int& N, double* A, - double* B, double* Z, sort_function, - const double& EPS, int& NDIM, int& FAIL, - int* IND); + F77_RET_T + F77_FUNC (dsubsp, DSUBSP) (const int& NMAX, const int& N, double* A, + double* B, double* Z, sort_function, + const double& EPS, int& NDIM, int& FAIL, + int* IND); // documentation for DTGEVC incorrectly states that VR, VL are // complex*16; they are declared in DTGEVC as double precision // (probably a cut and paste problem fro ZTGEVC) - int F77_FUNC (dtgevc, DTGEVC) (const char* SIDE, const char* HOWMNY, - int* SELECT, const int& N, double* A, - const int& LDA, double* B, - const int& LDB, double* VL, - const int& LDVL, double* VR, - const int& LDVR, const int& MM, - int& M, double* WORK, int& INFO, - long, long); + F77_RET_T + F77_FUNC (dtgevc, DTGEVC) (F77_CONST_CHAR_ARG_DECL, + F77_CONST_CHAR_ARG_DECL, + int* SELECT, const int& N, double* A, + const int& LDA, double* B, + const int& LDB, double* VL, + const int& LDVL, double* VR, + const int& LDVR, const int& MM, + int& M, double* WORK, int& INFO + F77_CHAR_ARG_LEN_DECL + F77_CHAR_ARG_LEN_DECL); - int F77_FUNC (xdlamch, XDLAMCH) (const char* cmach, double& retval, long); + F77_RET_T + F77_FUNC (xdlamch, XDLAMCH) (F77_CONST_CHAR_ARG_DECL, + double& retval + F77_CHAR_ARG_LEN_DECL); - int F77_FUNC (xdlange, XDLANGE) (const char*, const int&, - const int&, const double*, - const int&, double*, double&); + F77_RET_T + F77_FUNC (xdlange, XDLANGE) (F77_CONST_CHAR_ARG_DECL, + const int&, const int&, const double*, + const int&, double*, double& + F77_CHAR_ARG_LEN_DECL); } // fcrhp, fin, fout, folhp: @@ -286,7 +310,9 @@ } // overflow constant required by dlag2 - F77_FUNC (xdlamch, XDLAMCH) ("S", safmin, 1L); + F77_FUNC (xdlamch, XDLAMCH) (F77_CONST_CHAR_ARG2 ("S", 1), + safmin + F77_CHAR_ARG_LEN (1)); #ifdef DEBUG_EIG std::cout << "qz: initial value of safmin=" << setiosflags (std::ios::scientific) @@ -301,7 +327,9 @@ std::cout << "qz: DANGER WILL ROBINSON: safmin is 0!" << std::endl; #endif - F77_FUNC (xdlamch, XDLAMCH) ("E", safmin, 1L); + F77_FUNC (xdlamch, XDLAMCH) (F77_CONST_CHAR_ARG2 ("E", 1), + safmin + F77_CHAR_ARG_LEN (1)); #ifdef DEBUG_EIG std::cout << "qz: safmin set to " << setiosflags (std::ios::scientific) @@ -405,7 +433,7 @@ } // always perform permutation balancing - char bal_job = 'P'; + const char bal_job = 'P'; RowVector lscale(nn), rscale(nn), work(6*nn); if (complex_case) @@ -421,9 +449,11 @@ #endif F77_XFCN (dggbal, DGGBAL, - (&bal_job, nn, aa.fortran_vec(), nn, bb.fortran_vec(), - nn, ilo, ihi, lscale.fortran_vec(), - rscale.fortran_vec(), work.fortran_vec(), info, 1L)); + (F77_CONST_CHAR_ARG2 (&bal_job, 1), + nn, aa.fortran_vec (), nn, bb.fortran_vec (), + nn, ilo, ihi, lscale.fortran_vec (), + rscale.fortran_vec (), work.fortran_vec (), info + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) { @@ -439,9 +469,13 @@ if (compq == 'V') { F77_XFCN (dggbak, DGGBAK, - (&bal_job, "L", nn, ilo, ihi, lscale.fortran_vec(), - rscale.fortran_vec(), nn, QQ.fortran_vec(), - nn, info, 1L, 1L)); + (F77_CONST_CHAR_ARG2 (&bal_job, 1), + F77_CONST_CHAR_ARG2 ("L", 1), + nn, ilo, ihi, lscale.fortran_vec (), + rscale.fortran_vec (), nn, QQ.fortran_vec (), + nn, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); #ifdef DEBUG if (compq == 'V') @@ -458,10 +492,14 @@ // then right if (compz == 'V') { - F77_XFCN (dggbak, DGGBAK, (&bal_job, "R", - nn, ilo, ihi, lscale.fortran_vec(), - rscale.fortran_vec(), nn, ZZ.fortran_vec(), - nn, info, 1L, 1L)); + F77_XFCN (dggbak, DGGBAK, + (F77_CONST_CHAR_ARG2 (&bal_job, 1), + F77_CONST_CHAR_ARG2 ("R", 1), + nn, ilo, ihi, lscale.fortran_vec (), + rscale.fortran_vec (), nn, ZZ.fortran_vec (), + nn, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); #ifdef DEBUG if (compz == 'V') @@ -538,9 +576,13 @@ // reduce to generalized hessenberg form F77_XFCN (dgghrd, DGGHRD, - (&compq, &compz, nn, ilo, ihi, aa.fortran_vec(), - nn, bb.fortran_vec(), nn, QQ.fortran_vec(), nn, - ZZ.fortran_vec(), nn, info, 1L, 1L)); + (F77_CONST_CHAR_ARG2 (&compq, 1), + F77_CONST_CHAR_ARG2 (&compz, 1), + nn, ilo, ihi, aa.fortran_vec (), + nn, bb.fortran_vec (), nn, QQ.fortran_vec (), nn, + ZZ.fortran_vec (), nn, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) { @@ -553,12 +595,16 @@ // reduce to generalized Schur form F77_XFCN (dhgeqz, DHGEQZ, - (&qz_job, &compq, &compz, nn, ilo, ihi, - aa.fortran_vec(), nn, bb.fortran_vec(), nn, - alphar.fortran_vec(), alphai.fortran_vec(), - betar.fortran_vec(), QQ.fortran_vec(), nn, - ZZ.fortran_vec(), nn, work.fortran_vec(), nn, info, - 1L, 1L, 1L)); + (F77_CONST_CHAR_ARG2 (&qz_job, 1), + F77_CONST_CHAR_ARG2 (&compq, 1), + F77_CONST_CHAR_ARG2 (&compz, 1), + nn, ilo, ihi, aa.fortran_vec (), nn, bb.fortran_vec (), + nn, alphar.fortran_vec (), alphai.fortran_vec (), + betar.fortran_vec (), QQ.fortran_vec (), nn, + ZZ.fortran_vec (), nn, work.fortran_vec (), nn, info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) { @@ -615,8 +661,10 @@ double inf_norm; F77_XFCN (xdlange, XDLANGE, - ("I", nn, nn, aa.fortran_vec (), nn, - work.fortran_vec (), inf_norm)); + (F77_CONST_CHAR_ARG2 ("I", 1), + nn, nn, aa.fortran_vec (), nn, + work.fortran_vec (), inf_norm + F77_CHAR_ARG_LEN (1))); double eps = DBL_EPSILON*inf_norm*nn; @@ -643,8 +691,8 @@ Array<int> ind (nn); F77_XFCN (dsubsp, DSUBSP, - (nn, nn, aa.fortran_vec(), bb.fortran_vec(), - ZZ.fortran_vec(), sort_test, eps, ndim, fail, + (nn, nn, aa.fortran_vec (), bb.fortran_vec (), + ZZ.fortran_vec (), sort_test, eps, ndim, fail, ind.fortran_vec ())); #ifdef DEBUG @@ -825,10 +873,13 @@ VR = ZZ; F77_XFCN (dtgevc, DTGEVC, - (&side, &howmny, select, nn, aa.fortran_vec(), - nn, bb.fortran_vec(), nn, VL.fortran_vec(), nn, - VR.fortran_vec(), nn, nn, m, work.fortran_vec(), - info, 1L, 1L)); + (F77_CONST_CHAR_ARG2 (&side, 1), + F77_CONST_CHAR_ARG2 (&howmny, 1), + select, nn, aa.fortran_vec (), nn, bb.fortran_vec (), + nn, VL.fortran_vec (), nn, VR.fortran_vec (), nn, nn, + m, work.fortran_vec (), info + F77_CHAR_ARG_LEN (1) + F77_CHAR_ARG_LEN (1))); if (f77_exception_encountered) {