Re: Wrapper fortran

[Jaroslav Hajek]

On Fri, Sep 11, 2009 at 11:07 PM, R.C. <address@hidden> 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