Fortran调用C++动态链接库实践篇

1.初来乍到

问题：（1）C++子程序实现两个实数的加法，并生成DLL应用程序；（2）Fortran主程序读入两个实数，调用DLL应用程序完成求和运算。

下面是C++子程序代码，编译运行生成add.lib和add.dll文件。

// dllmain.cpp : 定义 DLL 应用程序的入口点。
#include "pch.h"
#include <iostream>
​
extern "C" __declspec(dllexport) double add(double a, double b) 
{
    return a + b;
}

Fortran主程序代码：

program main
    !使用内置与C的交互接口
    use, intrinsic :: iso_c_binding
    implicit none
    !扩展变量类型至C
    real(c_double) :: a, b, result
    !定义函数接口
    interface
        function add(a, b) bind(c, name="add")
            use, intrinsic :: iso_c_binding
            implicit none
            real(c_double), value :: a, b
            real(c_double) :: add
        end function add
    end interface
    !读入两个实数
    write(*,*) "请输入两个实数："
    read(*,*) a,b
    !执行求和运算
    result = add(a, b)
    !输出计算结果
    write(*,*) "The result is ", result
end program main

在项目->属性->配置属性->Linker->General->Additional Libaray Directories栏目下指定C++代码编译生成的add.lib所在的文件夹路径，在项目->属性->配置属性->Linker->General->Input->Additional Dependencies栏目下指定库名称（即：add.lib），并将add.dll拷贝至Fortran项目生成可执行文件的同级目录下，编译运行即可完成调用过程。

2.小试牛刀

问题：（1）上文完成了Fortran调用C++的流程，并实现了两个变量的传入和计算结果的回传；（2）在上述问题的基础上如何实现自定义变量的传入和回传是接下来要解决的问题。

在Fortran主程序开始定义一个module，其中定义一个自定义类型。

module my_module
    use, intrinsic :: iso_c_binding
    implicit none
    type, bind(c) :: CustomType
        integer(c_int), dimension(5) :: array
        character(c_char), dimension(5) :: str
        real(c_double) :: re
    end type CustomType
end module my_module

紧接着建立C++动态链接库项目，定义一个赋值函数，对该自定义类型的数组进行赋值操作。

// dllmain.cpp : 定义 DLL 应用程序的入口点。
#include "pch.h"
#include <string>

extern "C" {
	struct CustomType {
		int array[5];
		char str[5];
		double re;
	};

	__declspec(dllexport) void allocate_and_assign(CustomType* ct, int size) 
    {
		for (int i = 0; i < size; i++) {
			for (int j = 0; j < 5; j++) {
				ct[i].array[j] = j;
				ct[i].str[j] = 'a' + j;
			}
			ct[i].re = i * 1.0;
		}
	}
}

最后编写Fortran主程序，调用该Dll应用程序。

program main
    use, intrinsic :: iso_c_binding
    use :: my_module
    implicit none
    type(CustomType), allocatable :: ct(:)
    integer i
    interface
        subroutine allocate_and_assign(ct, size) bind(c, name="allocate_and_assign")
            use, intrinsic :: iso_c_binding
            use :: my_module
            implicit none
            type(CustomType), dimension(:) :: ct
            integer(c_int), value :: size
        end subroutine allocate_and_assign
    end interface
    allocate(ct(5))
    call allocate_and_assign(ct, 5)
    do i = 1, 5
        write(*,*) "The array of ", i, " is ", ct(i)%array
        write(*,*) "The string of ", i, " is ", ct(i)%str
        write(*,*) "The real number of ", i, " is ", ct(i)%re
    end do
end program main

项目配置同1，编译运行即可完成自定义类型的数组在两语言之间传递。

除了这一种方式之外，自定义类型还以定义成指针形式，以便实现动态分配。C++子程序代码如下：

// dllmain.cpp : 定义 DLL 应用程序的入口点。
#include "pch.h"
#include <string>
​
extern "C" {
    struct CustomType {
        int* array;
        char* str;
        double real;
    };
​
    __declspec(dllexport) void allocate_and_assign(CustomType* ct, int size) 
    {
        for (int i = 0; i < size; i++) {
            ct[i].array = new int[5];  // Assuming the array size is 5
            ct[i].str = new char[5];   // Assuming the string length is 5
            ct[i].real = i * 1.0;
            for (int j = 0; j < 5; j++) {
                ct[i].array[j] = j;
                ct[i].str[j] = 'a' + j;
            }
            ct[i].str[4] = '\0';  // Null-terminate the string
        }
    }
}

Fortran主程序代码如下：

program main
    use, intrinsic :: iso_c_binding
    implicit none
    type, bind(c) :: CustomType
        type(c_ptr) :: array
        type(c_ptr) :: str
        real(c_double) :: real
    end type CustomType
    type(CustomType), allocatable :: ct(:)
    integer, dimension(:), pointer :: array_ptr
    character, dimension(:), pointer :: str_ptr
    integer i
    interface
        subroutine allocate_and_assign(ct, size) bind(c, name="allocate_and_assign")
            use, intrinsic :: iso_c_binding
            implicit none
            type(c_ptr), value :: ct
            integer(c_int), value :: size
        end subroutine allocate_and_assign
    end interface
    allocate(ct(5))
    call allocate_and_assign(c_loc(ct), 5)
    do i = 1, 5
        call c_f_pointer(ct(i)%array, array_ptr, [5])
        call c_f_pointer(ct(i)%str, str_ptr, [5])
        write(*,*) "The array of ", i, " is ", array_ptr
        write(*,*) "The string of ", i, " is ", str_ptr
        write(*,*) "The real number of ", i, " is ", ct(i)%real
    end do
end program main

3.渐入佳境

在“初来乍到”一节中测试了Fortran调用C++中定义的函数实现了参数的互传，而在“小试牛刀”一节则进一步丰富了使用场景，使得Fortran调用C++中定义的函数实现了自定义类型数组的互传与赋值操作。上述Fortran/C++使用场景在混合编程中经常会遇到，但显然还不能满足要求。我们常遇到的场景常常是这样的，在C++中定义了一个或多个类（类中既有状态描述也有方法描述），如何利用Fortran实现对C++中类的操作才是真正的混合编程遇到的难题。

对此问题，本节设计一个使用Fortran/C++混合编写程序求学生平均成绩的使用场景，该场景要求：（1）利用C++定义一个学生类必须有姓名、学号和5门功课的成绩，除此之外，该类还能够创建新学生、打印学生信息、删除学生信息的功能；（2）利用Fortran编写主程序，调用C++学生类的方法展示其创建学生、求平均成绩、展示成绩并删除学生信息的功能。程序设计的思路是：

首先，我们需要创建一个 C++ 类 Student。这个类需要有一个构造函数，用于接收名字、ID 和分数，以及一个计算平均分的方法。我们还需要一个 show 方法来显示学生信息。

#include <vector>
#include <string>
​
#ifdef STUDENT_EXPORTS
#define STUDENT_API __declspec(dllexport)
#else
#define STUDENT_API __declspec(dllimport)
#endif
​
class STUDENT_API Student {
public:
    Student(const char* name, int id, double* scores, int num_scores);
    ~Student();
​
    double average_score();
    void show();
​
private:
    std::string name;
    int id;
    std::vector<double> scores;
};

然后，我们需要实现这个类：

#include "pch.h"
#include "Student.h"
#include <iostream>
#include <numeric>
​
Student::Student(const char* name, int id, double* scores, int num_scores)
    : name(name), id(id), scores(scores, scores + num_scores) 
{
    std::cout << "Name: " << name << std::endl;
    std::cout << "ID: " << id << std::endl;
    std::cout << "Scores: ";
    //for (std::vector<double*>::iterator it = scores.begin();it!=scores.end();it++) 
    //{
    //  std::cout << it << " ";
    //}
    std::cout << std::endl;
}
​
Student::~Student() {}
​
double Student::average_score() {
    double sum = std::accumulate(scores.begin(), scores.end(), 0.0);
    return sum / scores.size();
}
​
void Student::show() {
    std::cout << "Name: " << this->name << std::endl;
    std::cout << "ID: " << this->id << std::endl;
    std::cout << "Scores: ";
    for (double score : scores) {
        std::cout << score << " ";
    }
    std::cout << std::endl;
}

接下来，我们需要创建一些 C 风格的函数，以便 Fortran 程序能够调用这个类。这些函数需要使用 extern "C" 来声明，以关闭 C++ 的名称修饰。

#include "pch.h"
#include "Student.h"
#include <map>
​
std::map<int, Student*> students;
int next_id = 1;
​
extern "C" {
    STUDENT_API int create_student(const char* name, int id, double* scores, int num_scores) {
        Student* s = new Student(name, id, scores, num_scores);
        students[next_id] = s;
        return next_id++;
    }
​
    STUDENT_API void delete_student(int id) {
        delete students[id];
        students.erase(id);
    }
​
    STUDENT_API double average_score(int id) {
        return students[id]->average_score();
    }
​
    STUDENT_API void show_student(int id) {
        students[id]->show();
    }
}

最后，我们需要在 Visual Studio 中创建一个 DLL 项目，并将上述代码添加到这个项目中。然后，我们可以编译这个项目，生成 DLL 文件。

在 Fortran 程序中，我们可以使用 bind(C, name="...") 来调用这个 DLL 中的函数。例如：

program main
    use, intrinsic :: iso_c_binding
    implicit none
​
    type(c_ptr) :: students(3)
    character(kind=c_char,len=20) :: names(3)
    integer(c_int) :: ids(3)
    real(c_double), dimension(5) :: scores(3,5)
    real(c_double) :: average_scores(3)
    integer :: i     
​
    interface
        function create_student(name, id, scores, num_scores) bind(c, name="create_student")
            use, intrinsic :: iso_c_binding
            implicit none
            type(c_ptr) :: create_student
            character(kind=c_char), dimension(*), intent(in) :: name
            integer(c_int), value, intent(in) :: id
            real(c_double), dimension(*), intent(in) :: scores
            integer(c_int), value, intent(in) :: num_scores
        end function create_student
​
        subroutine delete_student(id) bind(c, name="delete_student")
            use, intrinsic :: iso_c_binding
            implicit none
            integer(c_int),value, intent(in) :: id
            !type(c_ptr), intent(inout) :: s
        end subroutine delete_student
​
        function average_score(id) bind(c, name="average_score")
            use, intrinsic :: iso_c_binding
            implicit none
            real(c_double) :: average_score
            integer(c_int),value, intent(in) :: id
            !type(c_ptr), intent(in) :: s
        end function average_score
        
        subroutine show_student(id) bind(c, name="show_student")
            use, intrinsic :: iso_c_binding
            implicit none
            integer(c_int),value, intent(in) :: id
            !type(c_ptr), intent(inout) :: s
        end subroutine show_student
    end interface
​
    names = ['Alice', 'Bob', 'Charlie']
    ids = [1, 2, 3]
    scores = reshape([90, 80, 70, 85, 95, &
                     75, 65, 80, 90, 85, &
                     95, 90, 80, 70, 75], [3, 5])
​
    ! Initialize students
    do i = 1, 3
        students(i) = create_student(names(i)(1:len_trim(names(i)))//C_NULL_CHAR, ids(i), scores(i, :), 5)
        if (.not. c_associated(students(i))) then
            print *, 'Failed to create student ', i
        else
            print *, 'Successfully created student ', i
        end if
        call show_student(ids(i))
    end do
​
    ! Calculate average scores
    do i = 1, 3
        average_scores(i) = average_score(ids(i))
    end do
​
    ! Print student information
    do i = 1, 3
        print *, 'Name: ', names(i)
        print *, 'ID: ', ids(i)
        print *, 'Scores: ', scores(i, :)
        print *, 'Average score: ', average_scores(i)
    end do
​
    ! Delete students
    do i = 1, 3
        call delete_student(ids(i))
        !if(i+1.LE.3)call show_student(ids(i+1))
    end do
    
end program main

至此，代码编辑全部完成，按照上文提供的调用方法即可实现该场景目标。