Wrapper fortran

View: New views

2 Messages — Rating Filter: Alert me

Wrapper fortran

by R.C. :: Rate this Message:

Reply to Author | View Threaded | Show Only this Message

Hello,

I followed example from http://wiki.octave.org/wiki.pl?OctaveFortran but I have some trouble with my fortran subroutine.
Compilation works but when i call my function it gives ;

[f, xb] = wrapper (2, 4, rand(4,1), 1)
*** glibc detected *** octave: free(): invalid next size (fast): 0x09c20450 ***
======= Backtrace: =========
/lib/tls/i686/cmov/libc.so.6[0xb5d31604]
/lib/tls/i686/cmov/libc.so.6(cfree+0x96)[0xb5d335b6]
/usr/lib/libstdc++.so.6(_ZdlPv+0x21)[0xb5eed231]
/usr/lib/libstdc++.so.6(_ZdaPv+0x1d)[0xb5eed28d]
/usr/lib/octave-3.0.1/liboctinterp.so(_ZN5ArrayIdED2Ev+0xc6)[0xb7a30c66]
etc...

My wrapper
***********************************************************************************
#include <octave/oct.h>
#include "f77-fcn.h"
extern "C"
{
int F77_FUNC (rosenf_b, ROSENF_b) (const int& ind, const int& n,
const double* x,
double* xb, double& f,
const double& fb,
double& g, double& ti, double& tr, double& td );
}
DEFUN_DLD (wrapper, args, ,
"- Loadable Function: [f, xb] = wrapper (ind, n, x, fb)\n\
\n\
Returns the f,xb.")
{
octave_value_list retval;
Matrix X;

const int IND = args(0).int_value(), N = args(1).int_value();
const double FB;
double G;
NDArray XB;
double F,TI,TR,TD;
double *av;

FB = args(3).double_value();
X = args(2).matrix_value();
av = XB.fortran_vec();

F77_XFCN (rosenf_b, ROSENF_B,
(IND, N,
X.fortran_vec(),
av,
F,
FB,
G,
TI, TR, TD) );
if (f77_exception_encountered)
{
error ("unrecoverable error in rosenf_b");
return retval;
}
retval(0) = octave_value (F);
retval(1) = octave_value(XB);

return retval;
}
*************************************************************************

Fortran function
************************************************************************
SUBROUTINE ROSENF_B(ind, n, x, xb, f, fb, g, ti, tr, td)
IMPLICIT NONE
INTEGER ind, n, ti(*)
DOUBLE PRECISION x(n), f, g(n), td(*)
DOUBLE PRECISION xb(n), fb
REAL tr(*)
C
DOUBLE PRECISION y, p
INTEGER i
DOUBLE PRECISION tempb
INTEGER ii1
p = 100.0d0
IF (ind .EQ. 2 .OR. ind .EQ. 4) THEN
DO ii1=1,n
xb(ii1) = 0.D0
ENDDO
DO i=n,2,-1
tempb = p*2*(x(i)-x(i-1)**2)*fb
xb(i) = xb(i) + tempb - 2*(1.0d0-x(i))*fb
xb(i-1) = xb(i-1) - 2*x(i-1)*tempb
ENDDO
fb = 0.D0
ELSE
DO ii1=1,n
xb(ii1) = 0.D0
ENDDO
END IF
END
**********************************************************************

What do you suggest ?
Thanks

Re: Wrapper fortran

by Jaroslav Hajek-2 :: Rate this Message:

Reply to Author | View Threaded | Show Only this Message

On Fri, Sep 11, 2009 at 11:07 PM, R.C. <romain.cotte@...> wrote:

>
> Hello,
>
>
> I followed example from http://wiki.octave.org/wiki.pl?OctaveFortran but I
> have some trouble with my fortran subroutine.
> Compilation works but when i call my function it gives ;
>
> [f, xb] = wrapper (2, 4, rand(4,1), 1)
> *** glibc detected *** octave: free(): invalid next size (fast): 0x09c20450
> ***
> ======= Backtrace: =========
> /lib/tls/i686/cmov/libc.so.6[0xb5d31604]
> /lib/tls/i686/cmov/libc.so.6(cfree+0x96)[0xb5d335b6]
> /usr/lib/libstdc++.so.6(_ZdlPv+0x21)[0xb5eed231]
> /usr/lib/libstdc++.so.6(_ZdaPv+0x1d)[0xb5eed28d]
> /usr/lib/octave-3.0.1/liboctinterp.so(_ZN5ArrayIdED2Ev+0xc6)[0xb7a30c66]
> etc...
>
>
> My wrapper
> ***********************************************************************************
> #include <octave/oct.h>
> #include "f77-fcn.h"
> extern "C"
> {
> int F77_FUNC (rosenf_b, ROSENF_b) (const int& ind, const int& n,
> const double* x,
> double* xb, double& f,
> const double& fb,
> double& g, double& ti, double& tr, double& td );
> }
> DEFUN_DLD (wrapper, args, ,
> "- Loadable Function: [f, xb] = wrapper (ind, n, x, fb)\n\
> \n\
> Returns the f,xb.")
> {
> octave_value_list retval;
> Matrix X;
>
> const int IND = args(0).int_value(), N = args(1).int_value();
> const double FB;
> double G;
> NDArray XB;
> double F,TI,TR,TD;
> double *av;
>
> FB = args(3).double_value();
> X = args(2).matrix_value();
> av = XB.fortran_vec();
>
>
> F77_XFCN (rosenf_b, ROSENF_B,
> (IND, N,
> X.fortran_vec(),
> av,
> F,
> FB,
> G,
> TI, TR, TD) );
> if (f77_exception_encountered)
> {
> error ("unrecoverable error in rosenf_b");
> return retval;
> }
> retval(0) = octave_value (F);
> retval(1) = octave_value(XB);
>
> return retval;
> }
> *************************************************************************
>
>
>
>
> Fortran function
> ************************************************************************
> SUBROUTINE ROSENF_B(ind, n, x, xb, f, fb, g, ti, tr, td)
> IMPLICIT NONE
> INTEGER ind, n, ti(*)
> DOUBLE PRECISION x(n), f, g(n), td(*)
> DOUBLE PRECISION xb(n), fb
> REAL tr(*)
> C
> DOUBLE PRECISION y, p
> INTEGER i
> DOUBLE PRECISION tempb
> INTEGER ii1
> p = 100.0d0
> IF (ind .EQ. 2 .OR. ind .EQ. 4) THEN
> DO ii1=1,n
> xb(ii1) = 0.D0
> ENDDO
> DO i=n,2,-1
> tempb = p*2*(x(i)-x(i-1)**2)*fb
> xb(i) = xb(i) + tempb - 2*(1.0d0-x(i))*fb
> xb(i-1) = xb(i-1) - 2*x(i-1)*tempb
> ENDDO
> fb = 0.D0
> ELSE
> DO ii1=1,n
> xb(ii1) = 0.D0
> ENDDO
> END IF
> END
> **********************************************************************
>
>
>
> What do you suggest ?
> Thanks
>

To fix your code. XB needs to be allocated (av points to buffer of
size 0 in your example).
Btw., it makes little sense to pass n to the function, when it can be
inferred from x.

hth

--
RNDr. Jaroslav Hajek
computing expert & GNU Octave developer
Aeronautical Research and Test Institute (VZLU)
Prague, Czech Republic
url: www.highegg.matfyz.cz

_______________________________________________
Help-octave mailing list
Help-octave@...
https://www-old.cae.wisc.edu/mailman/listinfo/help-octave