Fortran Coder

C函式当参数回传到Fortran Dll

查看数: 8647 | 评论数: 5 | 收藏 0
关灯 | 提示:支持键盘翻页<-左 右->
    组图打开中,请稍候......
发布时间: 2016-12-5 23:43

正文摘要:

各位好! 小弟我想在C++下使用Fortran套件 ODRPACK95。我的作业环境为 Win10,使用VS2013,Fortran编译器为Intel Visual Fortran。 首先下面是我的Fortran程序,用来将C++下的变量值传递到ODRPACK做运算。 [Fortran] ...

回复

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++都是空中楼阁
fcode 发表于 2016-12-6 23:04:35
我测试了以下代码,获得了预想的结果,供您参考



[C++] 纯文本查看 复制代码
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 

[Fortran] 纯文本查看 复制代码
#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 [2] ,double [1][4],int [2], int [1][4],int* ,\
                int*, double [1][4],double [1][2][4],double [1][1][4] ,int* ),\

                int N,int M,int NP,int NQ,double BETA[],double Y[][4],double X[][4],\
                double DELTA[][4],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[2], double XPLUSD[1][4], int IXIFB[], int IFIXX[1][4],int *LDIFX,\
        int *IDEVAL, double F[1][4], double FJACB[1][2][4], double FJACD[1][1][4],int *ISTOP){

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

        }

}


int main(){

        int NP = 2, N = 4, M = 1, NQ = 1;
        double BETA[2] = { 2.0, 0.5 };
        double X[1][4] = { 0.0, 1.0, 2.0, 3.0 };
        double Y[1][4] = { 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;

}
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 可选参数。
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去呼叫,一路上跌跌撞撞,几乎都是上网发问,慢慢查资料,一步一步整理出头绪来。但到现在已经想不到该怎么办了?偶然之下,发现这个论坛,因此在这发文希望有人能给个指点。
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

捐赠本站|Archiver|关于我们 About Us|小黑屋|Fcode ( 京ICP备18005632-2号 )

GMT+8, 2024-5-3 19:03

Powered by Tencent X3.4

© 2013-2024 Tencent

快速回复 返回顶部 返回列表