C函式当参数回传到Fortran Dll

fcode

你的代码我根本没法通过编译。
你真的确定你那边可以？？
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

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

[C++] 纯文本查看 复制代码

#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[M][N] , arr[N][M];
  for (int i = 0; i < N; i++) {
    for (int j = 0; j < M; j++) {
      delta[j][i] = 0.0;
      arr[i][j]   = 0.0;
    }
  }
  wrapper_ODR( FCN , N , M , &delta[0][0] , &arr[0][0] );
  for (int i = 0; i < N; i++) {
    for (int j = 0; j < M; j++) {
      cout << delta[j][i] << endl ;
      cout << arr[i][j] << endl;
    }
  }
  system("pause");
  return 0;
}

[Fortran] 纯文本查看 复制代码

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=[m,n]) !//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