Interfacing C routine with CVF routine called from VB 
Author Message
 Interfacing C routine with CVF routine called from VB

G'day everyone,

I have a knapsack packing algorithm in C. I've got it working within
itself okay. I have figured out how to get the data from VB to fortran
and from Fortran into C. What I can't seem to work out is how to get
the data back from C to Fortran. It's probably something profoundly
simple ...

BTW, the change in argument order (p, w v/v w, p) is deliberate.

The code:
Fortran:
subroutine KnapsackA43( n, p, w, solution, mass, optimal )
        !dec$ attributes dllexport, stdcall, alias : "KnapsackA43" ::
KnapsackA43
        !dec$ attributes reference :: n, p, w, solution, mass, optimal

        INTEGER N
        REAL*8 P(N)
        REAL*8 W(N)
        REAL*8 SOLUTION(N)
        REAL*8 MASS
        REAL*8 OPTIMAL

        interface

solution, mass, optimal)
                ! dec$ attributes reference :: n, w, p, solution, mass, optimal
                        INTEGER n
                        REAL*8 w(n)
                        REAL*8 p(n)
                        REAL*8 solution(n)
                        REAL*8 mass
                        REAL*8 optimal
                end subroutine knapsack_A43
        end interface
        call knapsack_A43( n, w, p, solution, mass, optimal )
        return
end subroutine KnapsackA43

C:
/*
** knaps2.c
*/
/*
**  September 26, 1997
**  this program implements Algorithm 4.3
**  for solving Problem 4.1  (0,1)-Knapsack
**  with simple pruning.
*/
/*
**  Compile with:
**      gcc knaps2.c -o knaps2
**
**  Run with:
**      knaps2 fname
**    or
**      knaps2
*/

#include <stdlib.h>

void __stdcall knapsack_A43( int, double*, double*, double*, double,
double );

void Knapsack2( int, double );
double DotProd( int, double*, double* );

int igNodes;
int igNumber;
double * dgProfits;
double * dgWeights;
double * dgSolution;
double dgCapacity;
double dgOptimal;

void __stdcall knapsack_A43( int iNumber, double *dWeights, double
*dProfits, double *dSolution, double dCapacity, double dOptimal )
{

        igNodes = 0;
        igNumber = iNumber;
        dgProfits = dProfits;
        dgWeights = dWeights;
        dgSolution = dSolution;
        dgCapacity = dCapacity;

        Knapsack2( 0, 0.0 );

        dOptimal = dgOptimal;
        //dWeights = dgWeights;
        //dProfits = dgProfits;
        //dSolution = dgSolution;
        return;

Quote:
}

double DotProd( int n, double* A,double* B)
{
        int i;
        double ans;
        ans=0.0;
        for( i=0; i < n;i++ ) {
                ans += ( A[ i ] * B[ i ] );
        }
        return( ans );

Quote:
}

void Knapsack2( int ell, double curW )
/*
**  Algorithm 4.3
*/
{
        int i;
        igNodes = igNodes + 1;
        if ( ell == igNumber ) {
                if ( DotProd( igNumber, dgProfits, dgSolution ) > dgOptimal ) {
                        dgOptimal = DotProd( igNumber, dgProfits, dgSolution );
                        for( i = 0; i < igNumber; i++ ) {
                                dgSolution[ i ] = dgSolution[ i ];
                        }
                }
        }
        else {
                if( curW + dgWeights[ ell ] <= dgCapacity ) {
                        dgSolution[ ell ] = 1.0;
                        Knapsack2( ell + 1, curW + dgWeights[ ell ] );
                }
                dgSolution[ ell ] = 0.0;
                Knapsack2( ell + 1, curW );
        }

Quote:
}

VB6 (more for completeness than anything else as I don't have any
problems getting the data out of VB into Fortran):
Declare Sub KnapsackA43 Lib "debug\boal0.dll" (n As Integer, p As
Double, w As Double, x As Double, mass As Double, profit As Double)

...

    Dim i As Integer
    Dim mass As Double
    Dim profit As Double
    Const mass_limit As Double = 26#
    Dim p(4) As Double
    Dim w(4) As Double
    Dim x(4) As Double
    Const n As Integer = 4

    p(0) = 24#
    p(1) = 13#
    p(2) = 23#
    p(3) = 15#
    p(4) = 16#

    w(0) = 12#
    w(1) = 7#
    w(2) = 11#
    w(3) = 8#
    w(4) = 9#

    Debug.Print " "

    Debug.Print " "
    Debug.Print "Object", "Profit", "Mass", "Profit Density",
"Solution"
    Debug.Print " "
    For i = 0 To n
    Debug.Print i, p(i), w(i), p(i) / w(i), x(i)
    Next

    KnapsackA43 n, p(0), w(0), x(0), mass_limit, profit

    Debug.Print " "

    Debug.Print " "
    Debug.Print "Object", "Profit", "Weight", "Profit Density",
"Solution"
    Debug.Print " "
    For i = 0 To n
    Debug.Print i, p(i), w(i), p(i) / w(i), x(i)
    Next

    Debug.Print " "
    Debug.Print " Mass Limit " & mass_limit
    Debug.Print " Profit " & profit

Kind regards,
Bruce.



Mon, 12 Jul 2010 12:23:55 GMT  
 Interfacing C routine with CVF routine called from VB
Hmm ... bugs abounding.


Mon, 12 Jul 2010 14:13:38 GMT  
 Interfacing C routine with CVF routine called from VB
G'day everyone

Okay, it seems there never was a problem. What WAS the problem was all
the typos that had crept into the C code and had been buried under a
pile of s///g.

Here's the revised code for your entertainment. And yes, in my pursuit
for a solution I turned a subroutine into a function. Yes, it does
work, but i could have left it alone without any loss of
functionality. Do the INTENTs mean anything?

Kind regards,
Bruce.

REAL*8 function KnapsackA43( N, P, W, SOLUTION, MASSLIMIT )
RESULT(OPTIMAL)
        !dec$ attributes dllexport, stdcall, alias : "KnapsackA43" ::
KnapsackA43
        !dec$ attributes reference :: N, P, W, SOLUTION, MASSLIMIT

        INTEGER, INTENT(inout) :: N
        REAL*8, INTENT(inout) ::  P(N)
        REAL*8, INTENT(inout) ::  W(N)
        REAL*8, INTENT(inout) ::  SOLUTION(N)
        REAL*8, INTENT(inout) ::  MASSLIMIT

        interface

pc, solutionc, massc) result(optimalc)
                ! dec$ attributes reference :: nc, wc, pc, solutionc, massc
                        INTEGER, INTENT(inout) ::  nc
                        REAL*8, INTENT(inout) ::  wc(nc)
                        REAL*8, INTENT(inout) ::  pc(nc)
                        REAL*8, INTENT(inout) ::  solutionc(nc)
                        REAL*8, INTENT(inout) ::  massc
                end function knapsack_A43
        end interface
        OPTIMAL = knapsack_A43( N, P, W, SOLUTION, MASSLIMIT)
        return
end function KnapsackA43

/*
** knaps2.c
*/
/*
**  September 26, 1997
**  this program implements Algorithm 4.3
**  for solving Problem 4.1  (0,1)-Knapsack
**  with simple pruning.
*/
/*
**  Compile with:
**      gcc knaps2.c -o knaps2
**
**  Run with:
**      knaps2 fname
**    or
**      knaps2
*/

#include <stdlib.h>

double __stdcall knapsack_A43( int, double*, double*, double*,
double );

void Knapsack2( int, double );
double DotProd( int, double*, double* );

int igNodes;

int igNumber;
double * dgWeights;
double * dgProfits;
double * dgBestSolution;
double dgCapacity;

double dgOptimal;

double * dgCurrentSolution;

double __stdcall knapsack_A43( int iNumber, double *dWeights, double
*dProfits, double *dBestSolution, double dCapacity )
{

        igNodes = 0;

        igNumber = iNumber;
        dgWeights = dWeights;
        dgProfits = dProfits;
        dgBestSolution = dBestSolution;
        dgCapacity = dCapacity;

        dgCurrentSolution = (double *)calloc( igNumber, sizeof( double ) );

        Knapsack2( 0, 0.0 );

        free(dgCurrentSolution);

        return (dgOptimal);

Quote:
}

double DotProd( int n, double* A,double* B)
{
        int i;
        double ans;
        ans=0.0;
        for( i=0; i < n;i++ ) {
                ans += ( A[ i ] * B[ i ] );
        }
        return( ans );

Quote:
}

void Knapsack2( int ell, double curW )
/*
**  Algorithm 4.3
*/
{
        int i;
        igNodes = igNodes + 1;
        if ( ell == igNumber ) {
                if ( DotProd( igNumber, dgProfits, dgCurrentSolution ) > dgOptimal )
{
                        dgOptimal = DotProd( igNumber, dgProfits, dgCurrentSolution );
                        for( i = 0; i < igNumber; i++ ) {
                                dgBestSolution[ i ] = dgCurrentSolution[ i ];
                        }
                }
        }
        else {
                if( curW + dgWeights[ ell ] <= dgCapacity ) {
                        dgCurrentSolution[ ell ] = 1.0;
                        Knapsack2( ell + 1, curW + dgWeights[ ell ] );
                }
                dgCurrentSolution[ ell ] = 0.0;
                Knapsack2( ell + 1, curW );
        }

Quote:
}

Declare Function KnapsackA43 Lib "debug\boal0.dll" (n As Integer, p As
Double, w As Double, x As Double, mass_limit As Double) As Double
    Dim pP(1 To 5) As Double
    Dim wW(1 To 5) As Double
    Dim xX(1 To 5) As Double

    pP(1) = 24#
    pP(2) = 13#
    pP(3) = 23#
    pP(4) = 15#
    pP(5) = 16#

    wW(1) = 12#
    wW(2) = 7#
    wW(3) = 11#
    wW(4) = 8#
    wW(5) = 9#

    Debug.Print " "

    Debug.Print " "
    Debug.Print "Object", "Profit", "Mass", "Profit Density",
"Solution"
    Debug.Print " "
    For i = 1 To 5
    Debug.Print i, pP(i), wW(i), pP(i) / wW(i), xX(i)
    Next

    profit = KnapsackA43(5, pP(1), wW(1), xX(1), mass_limit)

    Debug.Print " "

    Debug.Print " "
    Debug.Print "Object", "Profit", "Weight", "Profit Density",
"Solution"
    Debug.Print " "
    For i = 1 To 5
    Debug.Print i, pP(i), wW(i), pP(i) / wW(i), xX(i)
    Next

    Debug.Print " "
    Debug.Print " Mass Limit " & mass_limit
    Debug.Print " Profit " & profit



Mon, 12 Jul 2010 14:33:27 GMT  
 
 [ 3 post ] 

 Relevant Pages 

1. help: how to call fortran95 routine of Intel Math Kernel Library in CVF

2. calling Microsoft PlaySound routine from CVF

3. Routine call in Routine

4. VB or VF to call imsl fortran routines

5. Calling C routines and ODBC interface

6. porting variable argument list routines from VMS to CVF

7. generic routines / templates / fpp / cvf

8. CVF serial port routines under Win NT/2K

9. One routine-global variables, no globals lots of routines

10. Double Word Rectangle Routine and Circle Routine

11. graphics routines, keyboard routines,e tc.

12. Utility to extract all routines under a routine?

 

 
Powered by phpBB® Forum Software