论坛 › 编程工具交流 › C函式当参数回传到Fortran Dll

Radiosan 发表于 2016-12-5 23:43:41

C函式当参数回传到Fortran Dll

各位好! 小弟我想在C++下使用Fortran套件 ODRPACK95。我的作业环境为 Win10，使用VS2013，Fortran编译器为Intel Visual Fortran。
首先下面是我的Fortran程序，用来将C++下的变量值传递到ODRPACK做运算。
subroutine wrapper_ODR(FCN,N,M,NP,NQ,BETA,Y,X,&
      DELTA,WE,WD,IFIXB,IFIXX,JOB,NDIGIT,TAUFAC,&
      SSTOL,PARTOL,MAXIT,IPRINT,LUNERR,LUNRPT,&
   STPB,STPD,SCLB,SCLD,WORK,IWORK,INFO,LOWER,UPPER) bind(C, name='wrapper_ODR')
!DEC$ ATTRIBUTES DLLEXPORT :: wrapper_ODR   
    use iso_c_binding
    use ODRPACK95
    implicit none
   
!自訂意凾式介面宣告   
    interface
      subroutine FCN(N,M,NP,NQ,LDN,LDM,LDNP,BETA,XPLUSD,IFIXB,IFIXX,LDIFX,&
      IDEVAL,F,FJACB,FJACD,ISTOP) bind(C)
      
      use, intrinsic :: iso_c_binding
      implicit none
      
      integer(c_int) :: IDEVAL,ISTOP,LDIFX,LDM,LDN,LDNP,M,N,NP,NQ
      
      real (c_double) :: BETA(1:NP),F(1:LDN,1:NQ),FJACB(1:LDN,1:LDNP,1:NQ), &
      FJACD(1:LDN,1:LDM,1:NQ),XPLUSD(1:LDN,1:M)
      
      integer(c_int) :: IFIXB(1:NP),IFIXX(1:LDIFX,1:M)
   
      end subroutine
    end interface

   
    integer(c_int),value :: N,M,NP,NQ
    real(c_double) :: BETA(1:NP),Y(1:N,1:NQ),X(1:N,1:M)
   
!!!!!Optional variable
   
    integer(c_int), intent(in), optional :: IFIXB(:),IFIXX(:,:),JOB,NDIGIT,MAXIT&
    ,IPRINT,LUNERR,LUNRPT,IWORK(:),INFO
   
    real(c_double), intent(in), optional :: DELTA(:,:),&
      WE(:,:,:),WD(:,:,:),TAUFAC,SSTOL,PARTOL,&
      STPB(:),STPD(:,:),SCLB(:),SCLD(:,:),&
         WORK(:),LOWER(:),UPPER(:)
   
!!!!!Call ODR   
    call ODR(inter_func,N,M,NP,NQ,BETA,Y,X)
   
contains

!!!!!Local subroutine
subroutine inter_func(N,M,NP,NQ,LDN,LDM,LDNP,BETA,XPLUSD,IFIXB,IFIXX,LDIFX,&
   IDEVAL,F,FJACB,FJACD,ISTOP)
   
      use REAL_PRECISION

      integer :: IDEVAL,ISTOP,LDIFX,LDM,LDN,LDNP,M,N,NP,NQ
      
      real (kind=R8) :: BETA(1:NP),F(1:LDN,1:NQ),FJACB(1:LDN,1:LDNP,1:NQ), &
      FJACD(1:LDN,1:LDM,1:NQ),XPLUSD(1:LDN,1:M)
      
      integer :: IFIXB(1:NP),IFIXX(1:LDIFX,1:M)
      
      integer(c_int) :: inter_IDEVAL,inter_ISTOP,inter_LDIFX,inter_LDM,&
      inter_LDN,inter_LDNP,inter_M,inter_N,inter_NP,inter_NQ
      
      real (c_double) :: inter_BETA(1:NP),inter_F(1:LDN,1:NQ),&
      inter_FJACB(1:LDN,1:LDNP,1:NQ),&
      inter_FJACD(1:LDN,1:LDM,1:NQ),inter_XPLUSD(1:LDN,1:M)
      
      integer(c_int) :: inter_IFIXB(1:NP),inter_IFIXX(1:LDIFX,1:M)
   
      inter_IDEVAL =IDEVAL
      inter_ISTOP = ISTOP
      inter_LDIFX = LDIFX
      inter_LDM = LDM
      inter_LDN = LDN
      inter_LDNP = LDNP
      inter_M = M
      inter_N = N
      inter_NP = NP
      inter_NQ = NQ
      
      !!!!REAL array
      inter_BETA = BETA
      inter_F = F
      inter_FJACB = FJACB
      inter_FJACD = FJACD
      inter_XPLUSD = XPLUSD
      !!!!INTEGER array
      inter_IFIXB = IFIXB
      inter_IFIXX = IFIXX
         
   end subroutine inter_func
end subroutine wrapper_ODR
其中subroutine inter_func是将上面函式subroutine FCN里，将使用iso_cbinding的变量值指派给inter_func里的变量用
C++程序代码如下:
#include "stdafx.h"
#include <iostream>
#include <stdio.h>
#include <math.h>
using namespace std;
//宣告ODR呼叫接口
extern "C" {

      void wrapper_ODR(void(*)(int*, int*, int*, int*, int*, int*, int*, \
                double ,double ,int , int ,int* ,\
                int*, double ,double ,double ,int* ),\

                int N,int M,int NP,int NQ,double BETA[],double Y[],double X[],\
                double DELTA[],double WE[],double WD[],int IFIXB[],int IFIXX[],\
                int *JOB,int *NDIGIT,double *TAUFAC,double *SSTOL, double *PARTOL,\
                int *MAXIT, int *IPRINT, int *LUNERR, int *LUNRPT,double STPB[],\
                double STPD[], double SCLB[], double SCLD[], double WORK[], double IWORK[],\
                int *INFO, double LOWER[], double UPPER[]);

}
//自定义函数
void FCN(int *N, int *M, int *NP, int *NQ, int *LDN, int *LDM, int *LDNP,\
      double BETA, double XPLUSD, int IXIFB[], int IFIXX,int *LDIFX,\
      int *IDEVAL, double F, double FJACB, double FJACD,int *ISTOP){

         *ISTOP = 2;
      
      if (fmod(*IDEVAL,10)!=0) {
                for (int i = 0; i < 4; i++) {
                        F = BETA * XPLUSD + BETA; //Fitting model BETA*x+BETA
                }

      }

}


int main(){

      int NP = 2, N = 4, M = 1, NQ = 1;
      double BETA = { 2.0, 0.5 };
      double X = { 0.0, 1.0, 2.0, 3.0 };
      double Y = { 2.0, 5.0, 8.0, 11.0 };

      wrapper_ODR(FCN, N, M, NP, NQ, BETA, Y, X, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, \
                NULL, NULL, NULL, NULL, NULL, NULL, NULL,NULL, NULL, NULL, NULL, NULL, NULL, \
                NULL, NULL);

      system("pause");
      return 0;

}
根据ODRPACK文件定义数组大小如下:

BETA,XPLUSD, IXIFB, IFIXX, F,FJACB, FJACD
NP = 2, N = 4,M = 1, NQ = 1, LDN = 4, LDM = 1, LDNP = 2,LDIFX = 4

执行结果

NP, N, M, NQ, BETA, X, Y皆成功传到ODRPACK去，但它并没有算出正确的BETA值，应该说它好像没有执行，且红线部分，
结果显示ISTOP值却是0，但我在C下定义ISTOP值应为2，似乎我在C下面的自定义义函数的变量值没有传到Fortran去。
不知该怎么解决这问题?需要各位帮忙指正一下，谢谢!

pasuka 发表于 2016-12-6 08:32:05

为啥不考虑Python，直接吃现成饭
Orthogonal distance regression (scipy.odr) — SciPy v0.18.1 Reference Guide
https://docs.scipy.org/doc/scipy/reference/odr.html

Radiosan 发表于 2016-12-6 12:37:00

pasuka 发表于 2016-12-6 08:32
为啥不考虑Python，直接吃现成饭
Orthogonal distance regression (scipy.odr) — SciPy v0.18.1 Reference ...

您好! 在一年前我老师丢给我ODR要我能让他在VC++下可以用，在这期间我发现可以用Python，我也进入Python的大世界，用的很愉快，但是我却把给当初给老师交代的是丢在后头了。到了最近，发觉自己几乎都是自己搞自己的事，说来也惭愧，老师交代的事没一件事完成的。所以希望能把ODR这事情给完成，当然，虽然有ISO_C_BINDING，但是做接口这事情，仍然很复杂。从一个月前开始摸Fortran到会ISO_C_BINDING让C去呼叫，一路上跌跌撞撞，几乎都是上网发问，慢慢查资料，一步一步整理出头绪来。但到现在已经想不到该怎么办了?偶然之下，发现这个论坛，因此在这发文希望有人能给个指点。

fcode 发表于 2016-12-6 17:55:08

你的代码我根本没法通过编译。
你真的确定你那边可以？？
subroutine wrapper_ODR(FCN,N,M,NP,NQ,BETA,Y,X,&
      DELTA,WE,WD,IFIXB,IFIXX,JOB,NDIGIT,TAUFAC,&
      SSTOL,PARTOL,MAXIT,IPRINT,LUNERR,LUNRPT,&
   STPB,STPD,SCLB,SCLD,WORK,IWORK,INFO,LOWER,UPPER) bind(C, name='wrapper_ODR')

这里 Delta 是 ODR 的参数，而 ODR 被 bind(C 了，而 Bind C 的函数，不允许有假定形状的参数。（因为 C 语言并不支持这套东西）

除了这方面的限定之外，还不能使用 optional 可选参数。

fcode 发表于 2016-12-6 23:04:35

我测试了以下代码，获得了预想的结果，供您参考



#include "stdafx.h"
#include <iostream>
#include <stdio.h>
#include <math.h>
using namespace std;
//宣告ODR呼叫接口
extern "C" {
void wrapper_ODR( void f(int*,int*,double*) , int , int ,double * ,double * );
}
//自定义函数
void FCN( int *N , int *M , double *delta ){
for (int i = 0; i < *M; i++) {
    for (int j = 0; j < *N; j++) {
      *((double*)delta + *N*i + j) = 12.0;
    }
}
}

int main(){
const int N=4 ;
const int M=3;
double delta , arr;
for (int i = 0; i < N; i++) {
    for (int j = 0; j < M; j++) {
      delta = 0.0;
      arr   = 0.0;
    }
}
wrapper_ODR( FCN , N , M , &delta , &arr );
for (int i = 0; i < N; i++) {
    for (int j = 0; j < M; j++) {
      cout << delta << endl ;
      cout << arr << endl;
    }
}
system("pause");
return 0;
}
subroutine wrapper_ODR(FCN,N,M,Delta,Arr) bind(C, name='wrapper_ODR')
!DEC$ ATTRIBUTES DLLEXPORT :: wrapper_ODR   
    use , intrinsic :: iso_c_binding
    implicit none
    integer(c_int),value :: N,M
    type(C_PTR) , value :: arr
    real(c_double) , pointer :: fp(:,:) !//传递数组可以用 C_PTR 转成fortran指针
    real(c_double) :: Delta(N,M) !//也可以用自动数组
!如果 fcn 是 C 语言提供的，则需要写以下interface，否则不需要
    interface
      subroutine FCN(N,M,delta) bind(C)
      import
      integer(c_int) :: n,m
      real (c_double) :: delta(n,m)
      end subroutine
    end interface   

    call c_f_pointer( arr , fp , shape=) !//c指针转成fortran指针
    call ODR(fcn,delta,fp)
    fp = 100.0d0;
contains

Subroutine ODR( f , d , a )
   Procedure(FCN) :: f
   real(kind=8) :: d(:,:) , a(:,:)
   call f( size(d,dim=1) , size(d,dim=2) , d )
end subroutine ODR

end subroutine wrapper_ODR

pasuka 发表于 2016-12-7 10:38:48

Radiosan 发表于 2016-12-6 12:37
您好! 在一年前我老师丢给我ODR要我能让他在VC++下可以用，在这期间我发现可以用Python，我也进入Python ...

首先，导师在这件事情上面相当不负责任，尸位素餐，一年时间居然不闻不问，遑论提供指导；
其次，lz玩Python+SciPy时间也不短了，Python是基于C，自带的帮助文档有详细的C和C++如何扩展和调用Python的说明，最偷懒的方法C++调用Python+scipy呗！若是有专研精神，第三方的scipy也是混编调用odr的Fortran代码，为啥不能花点心思看看scipy下面odr的头文件如何定义呢？
师傅领进门，修行在自身，没有扎实的C语言基础，Fortran与C++都是空中楼阁

查看完整版本: C函式当参数回传到Fortran Dll