F2018で導入されたC互換機能を使いfortranのclassをpythonから呼び出す

# 概要
fortranとCを相互に利用するための規格がf2003で導入されましたが、基本的な型や関数のみが対象であり、fortranの `allocatable` なデータや `class`などを扱うことはできませんでした。その後f2018規格では `CFI_cdesc_t` などの新たなC相互運用機能が導入され、`allocatable`なデータや、`integer,intent(inout) :: iarray(:,:)`といったfortran特有の形状無指定配列などをC言語で扱うことが可能となりました。また、fortranの`class`を指すポインタを返り値とする関数を定義すれば、C言語側からfortranクラスのメモリ管理が可能となります。

本稿では、fortranのクラスや形状無指定配列をCやPythonから利用する方法を例示します。
実際に動かす場合は[GitHub](https://github.com/sakamoti/Cython_ISO_Fortran_binding)からコードをクローンできます。

# 取り組み背景
fortran2003以降の機能を多数利用したFortranライブラリを既に所有しており、これらをPythonなどから呼び出して活用できれば便利だと思っていました。そのようななか、偶然Cythonを扱う機会があり、PythonからC/C++を自在に操ることができることが分かりました。

そこで、fortran2018の新機能である`CFI_`で始まる定数や関数を試したところ、従来はPython側から利用することが難しかったFortran機能の幾つかがCythonを経由して利用可能になることがわかりました。なお、Cython(https://cython.readthedocs.io/en/latest/index.html) の使い方は公式ページを見てください。

# f2003のC互換機能のみを使う場合
「構造体の中に`contains`によるメソッドがなく、データにallocatableなど要素もない」という、下記のような構造体定義の場合には簡単にPython [(Cython)](https://cython.readthedocs.io/en/latest/index.html) と相互運用可能です。CythonはCを経由するので、C言語のヘッダファイルを用意しておく必要がある点が面倒ですが、`allocatable`な配列等をCから扱う場面に比べれば簡単な記述で事足ります。
Cyton

## 型の定義
まずFortran側の定義です。
```fortran:C互換構造体(fortran側の定義)
use iso_c_binding
type, bind(c) :: interoperable_t
    integer(c_int16_t) :: i16 = 16 
    integer(c_int32_t) :: i32 = 32
    integer(c_int64_t) :: i64 = 64
    real(c_float) :: f32 = 32.0_c_float
    real(c_double) :: d64 = 64.0_c_double
    integer(c_int64_t) :: i64array(5) = 1_c_int64_t
    real(c_double) :: d64array(5) = 1.0_c_double
    character(len=1,kind=c_char) :: txt(10) = ""//c_null_char
end type
subroutine init_interoperable_t(self) bind(c)
    type(interoperable_t), intent(inout) :: self
    self = interoperable_t()
end subroutine
subroutine show_interoperable_t(self) bind(c)
    type(interoperable_t), intent(in) :: self
    character(len=:),allocatable :: fmt
end subroutine
subroutine bai_interoperable_t(self) bind(c)
    type(interoperable_t), intent(inout) :: self
    !... 略 ...
end subroutine
```

CythonはPythonコードをC言語に翻訳するツールなので、上記のFortran定義をCで利用するためのヘッダを下記のように自作します。
```C:Cの定義 "f_function.h"
typedef struct
{
    int16_t i16;
    int32_t i32;
    int64_t i64;
    float f32;
    double d64;
    int64_t i64array[5];
    double d64array[5];
    char txt[10];
}interoperable_t;
/* 以下、Fortranのbind(c)されたサブルーチン */
void init_interoperable_t(interoperable_t* ptr);
void bai_interoperable_t(interoperable_t* ptr);
void show_interoperable_t(interoperable_t* ptr);
```
上記の準備ができたら、構造体をPythonから使いやすいようにラッピングコードを作ります。
まずは、`f_functions.h`を利用するためのヘッダファイル相当のpxdファイルを作ります。
```cython:cythonでの定義 "fwrap.pxd"
cdef extern from "f_functions.h":
    ctypedef struct interoperable_t:
        int16_t i16
        int32_t i32
        int64_t i64
        float f32
        double d64
        int64_t i64array[5]
        double d64array[5]
        char txt[10]
    void init_interoperable_t(interoperable_t* ptr)
    void bai_interoperable_t(interoperable_t* ptr)
    void show_interoperable_t(interoperable_t* ptr)
```


## PytonでFortranの型をヒープに割付けて使う
Python, C, Fortranで扱うことのできるデータ実体をメモリ上のどこかに確保する必要があります。本稿では、指し示すメモリ実体がただ一つになるように実装します。(Pythonで割り付けたメモリをfortranに渡す際にコピーが生じないということです）
ここでは、`interoperable_t`の型をCの`malloc`関数を使って割り付け、これをクラス内部の`_thisptr`という要素として保持します。これはfortranと互換なのでそのままfortranルーチン（`show_interoperable_t`など）の引数として関数の実引数に渡すことができます。割り付けたメモリ領域は、Pythonオブジェクトが破棄される時に自動で解放する必要があるため、`__dealloc__`も定義しておきます。

必須ではないですが、`interoperable_t`を引数に取る関数は、Pythonのクラスメソッドとして追加しておくとPythonからはクラスのように振る舞わせることができ、`ipython`でタブ補完が効くので便利です。

なお、こんな面倒なことをしなくても、numpyでアライメントに注意しながらユーザ定義構造体を作れば`ctypes`や`numpy`の関数を使ってFortranルーチンに構造体を渡すこともできます。ここであえてこのような記述方法を紹介したのは、fortranの`class`をうまくラッピングする方法としてこの記述方法が便利だからです。

蛇足ですが、C++をPythonからCython経由でラッピングする方法も似た感じになります。
```cython:C風にFortranコードをラップしたCythonコード "fwrap.pyx"
cdef class f_interoperable_t:
    cdef interoperable_t *_thisptr
    def __cinit__(self):
        self._thisptr = <interoperable_t*> malloc(sizeof(interoperable_t))

    def __dealloc__(self):
        if self._thisptr != NULL:
            free(self._thisptr)

    cpdef init_interoperable_t(self):
        init_interoperable_t(self._thisptr)

    cpdef bai_interoperable_t(self):
        bai_interoperable_t(self._thisptr)

    cpdef show_interoperable_t(self):
        show_interoperable_t(self._thisptr)
```
以上で、Fortranの構造体(C互換のもの)をPythonから利用できるようになりました。
下記のようにインポートした後のプロンプト例を示します。
```python
import fwrap
fobj = fwrap.f_interoperable_t()
fobj.init_interoperable_t()
```
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/275690/075b11f9-c811-1646-d552-1afd52c7ea06.png)

Fortranコードの呼び出しも正常にできており、pythonクラスの補完も効いていることが分かります。

# f2018のC互換機能を使う場合
まず、利用したいFortranコード(ここではlibfort.f90)があるとします。

<details><summary>コード詳細(libfort.f90)</summary>

```fortran
module ISO_Fortran_binding_test
    use iso_c_binding
    use iso_fortran_env
    implicit none
    public
    type :: base_t
        integer :: i32 = 32
        real(real64) :: d64 = 64.0_real64
    end type
    type, extends(base_t) :: uninteroperable_t
        real(real64),allocatable :: r64_1d(:), r64_2d(:,:)
        real(real64),pointer :: r64_1d_p(:) => null(), r64_2d_p(:,:) => null()
        contains
          final :: final_uniteroperable_t
          procedure :: show_uninteroperable_t
    end type
    interface uninteroperable_t
        module procedure :: uninteroperable_t__init__
    end interface
    contains
        impure elemental subroutine final_uniteroperable_t(self)
            type(uninteroperable_t),intent(inout) :: self
            if(associated(self%r64_1d_p))then
                deallocate(self%r64_1d_p)
            endif
            if(associated(self%r64_2d_p))then
                deallocate(self%r64_2d_p)
            endif
            print*, "__final__uniteroperable_t"
        end subroutine
        impure elemental function uninteroperable_t__init__(n,m) result(res)
            integer, intent(in) :: n,m
            type(uninteroperable_t) :: res
            print*, "__init__uniteroperable_t"
            if(.not.allocated(res%r64_1d))then
                res%r64_1d = arange_r64_allocatable(n) 
            end if
            if(.not.allocated(res%r64_2d))then
                res%r64_2d = reshape(arange_r64_allocatable(n*m),[n,m])
            end if
            if(.not.associated(res%r64_1d_p))then
                !allocate(res%r64_1d_p(n),source=1d0)
                res%r64_1d_p => arange_r64_pointer(n) 
            end if
            if(.not.associated(res%r64_2d_p))then
                !allocate(res%r64_2d_p(n,m),source=1d0)
                res%r64_2d_p => reshape_pointer_1dto2d(n,m,arange_r64_pointer(n*m)) 
            end if
        end function
        impure elemental subroutine show_uninteroperable_t(self)
            class(uninteroperable_t),intent(in) :: self
            integer,allocatable :: array_shape(:)
            write(output_unit,'(1x,a)') "!--show_uninteoperable_t fromFortran----"
            write(output_unit,'("i32=",i3)') self%i32
            write(output_unit,'("d64=",f5.1)') self%d64
            array_shape = shape(self%r64_1d)
            write(output_unit,'("r64_1d:shape=(",i0,")")') array_shape
            call showarray1d(array_shape,self%r64_1d)
            array_shape = shape(self%r64_2d)
            write(output_unit,'("r64_2d:shape=(",i0,",",i0,")")') array_shape
            call showarray2d(array_shape,self%r64_2d)
            array_shape = shape(self%r64_1d_p)
            write(output_unit,'("r64_1d_p:shape=(",i0,")")') array_shape
            call showarray1d(array_shape,self%r64_1d_p)
            array_shape = shape(self%r64_2d_p)
            write(output_unit,'("r64_2d_p:shape=(",i0,",",i0,")")') array_shape
            call showarray2d(array_shape,self%r64_2d_p)
            write(output_unit,'(1x,a)') "!--end show_uninteoperable_t fromFortran----"
            contains
            subroutine showarray1d(ashape,array)
              integer :: ashape(:)
              real(real64) :: array(:)
              integer :: i
              do i = 1,ashape(1)
                write(output_unit,'(g10.3)',advance="no")array(i)
              end do
              write(output_unit,'(1x)',advance="yes")
            end subroutine
            subroutine showarray2d(ashape,array)
              integer :: ashape(:)
              real(real64) :: array(:,:)
              integer :: i,j
              do j = 1,ashape(1)
                do i = 1,ashape(2)
                    write(output_unit,'(g10.3)',advance="no")array(j,i)
                end do
                write(output_unit,'(1x)',advance="yes")
              end do
            end subroutine
        end subroutine
        !------------------------------------------------------------
        function arange_r64_allocatable(n) result(res)
            integer,intent(in) :: n
            real(real64),allocatable :: res(:)
            integer :: i
            allocate(res(n))
            do i = 1,n
                res(i) = i
            end do
        end function
        function arange_r64_pointer(n) result(res)
            integer,intent(in) :: n
            real(real64),pointer :: res(:)
            integer :: i
            allocate(res(n))
            do i = 1,n
                res(i) = i
            end do
        end function
        function reshape_pointer_1dto2d(n,m,pp) result(res)
            integer,intent(in) :: n,m
            real(real64),pointer :: pp(:)
            real(real64),pointer :: res(:,:)
            res(1:n,1:m) => pp(1:n*m)
        end function
end module
```
</details>

これをPythonから呼び出して使用する場合、やることは多数あります。

1. 使いたいfortranライブラリ(libfort.f90)を`-fPIC`をつけてビルドしておく。
1. Cythonから`ISO_Fortran_binding.h`を使えるようにする(ISO_Fortran_binding.pxdを作成)。
1. `CFI_CDESC_T(r)`のように引数をとるCマクロをCythonで使えるようにするハック（cy_futils.c,cy_futils.h, cy_futils.pxdを作成)
1. Fortran側で、C言語向けインターフェースを作る(libfort_cinterface.f90)。
1. libfort_cinterface.f90をcythonから使うためのコード(fwrap.pxd)
1. libfort.f90のクラスに対応したPythonクラスの定義(fwrap.pyx)


## インターフェースの作成

<details><summary>ISO_Fortran_bindingをcythonから利用可能にするコード(ISO_Fortran_binding.pxd)</summary>

```cython:ISO_Fortran_binding.pxd

from libc.stdint cimport *
from libc.stddef cimport *

cdef extern from "<ISO_Fortran_binding.h>" nogil:
    #/* Constants, defined as macros. */
    int CFI_VERSION
    int CFI_MAX_RANK

    #/* Attributes. */
    int CFI_attribute_pointer
    int CFI_attribute_allocatable
    int CFI_attribute_other

    #/* Error codes.
    #CFI_INVALID_STRIDE should be defined in the standard because they are useful to the implementation of the functions.
    #*/
    int CFI_SUCCESS
    int CFI_FAILURE
    int CFI_ERROR_BASE_ADDR_NULL
    int CFI_ERROR_BASE_ADDR_NOT_NULL
    int CFI_INVALID_ELEM_LEN
    int CFI_INVALID_RANK
    int CFI_INVALID_TYPE
    int CFI_INVALID_ATTRIBUTE
    int CFI_INVALID_EXTENT
    int CFI_INVALID_STRIDE
    int CFI_INVALID_DESCRIPTOR
    int CFI_ERROR_MEM_ALLOCATION
    int CFI_ERROR_OUT_OF_BOUNDS

    #/* CFI type definitions. */
    ctypedef ptrdiff_t CFI_index_t
    ctypedef int8_t CFI_rank_t
    ctypedef int8_t CFI_attribute_t
    ctypedef int16_t CFI_type_t

    #/* CFI_dim_t. */
    ctypedef struct CFI_dim_t:
        CFI_index_t lower_bound
        CFI_index_t extent
        CFI_index_t sm

    ctypedef struct CFI_cdesc_t:
        void *base_addr
        size_t elem_len
        int version
        CFI_rank_t rank
        CFI_attribute_t attribute
        CFI_type_t type
        CFI_dim_t dim[]

    #CFI_cdesc_t* CFI_CDESC_T_cwrap(int r)

    #/* CFI function declarations. */
    void *CFI_address (const CFI_cdesc_t *, const CFI_index_t [])
    int CFI_allocate (CFI_cdesc_t *, const CFI_index_t [], const CFI_index_t [],
         size_t)
    int CFI_deallocate (CFI_cdesc_t *)
    int CFI_establish (CFI_cdesc_t *, void *, CFI_attribute_t, CFI_type_t, size_t,
         CFI_rank_t, const CFI_index_t [])
    int CFI_is_contiguous (const CFI_cdesc_t *)
    int CFI_section (CFI_cdesc_t *, const CFI_cdesc_t *, const CFI_index_t [],
         const CFI_index_t [], const CFI_index_t [])
    int CFI_select_part (CFI_cdesc_t *, const CFI_cdesc_t *, size_t, size_t)
    int CFI_setpointer (CFI_cdesc_t *, CFI_cdesc_t *, const CFI_index_t [])

    #define CFI_type_mask 0xFF
    int CFI_type_kind_shift

    #/* intrinsic types. Their kind number defines their storage size. */
    int CFI_type_Integer
    int CFI_type_Logical
    int CFI_type_Real
    int CFI_type_Complex
    int CFI_type_Character

    #/* Types with no kind. */
    int CFI_type_struct
    int CFI_type_cptr
    int CFI_type_cfunptr
    int CFI_type_other

    int CFI_type_signed_char
    int CFI_type_short
    int CFI_type_int
    int CFI_type_long
    int CFI_type_long_long
    int CFI_type_size_t
    int CFI_type_int8_t
    int CFI_type_int16_t
    int CFI_type_int32_t
    int CFI_type_int64_t
    int CFI_type_int_least8_t
    int CFI_type_int_least16_t
    int CFI_type_int_least32_t
    int CFI_type_int_least64_t
    int CFI_type_int_fast8_t
    int CFI_type_int_fast16_t
    int CFI_type_int_fast32_t
    int CFI_type_int_fast64_t
    int CFI_type_intmax_t
    int CFI_type_intptr_t
    int CFI_type_ptrdiff_t
    int CFI_type_int128_t
    int CFI_type_int_least128_t
    int CFI_type_int_fast128_t
    int CFI_type_Bool
    int CFI_type_float
    int CFI_type_double
    int CFI_type_long_double
    int CFI_type_float128
    int CFI_type_float_Complex
    int CFI_type_double_Complex
    int CFI_type_long_double_Complex
    int CFI_type_float128_Complex
```
</details>

<details><summary>cythonユーティリティ関数(cy_futils.c)</summary>

```c:cy_futils.c
#include <ISO_Fortran_binding.h>
#include <stdlib.h>

CFI_cdesc_t* CFI_CDESC_T_cwrap(int r)
{
    typedef CFI_CDESC_T(1) CFI_CDESC_T0;
    typedef CFI_CDESC_T(1) CFI_CDESC_T1;
    typedef CFI_CDESC_T(2) CFI_CDESC_T2;
    typedef CFI_CDESC_T(3) CFI_CDESC_T3;
    typedef CFI_CDESC_T(4) CFI_CDESC_T4;
    typedef CFI_CDESC_T(5) CFI_CDESC_T5;
    typedef CFI_CDESC_T(6) CFI_CDESC_T6;
    typedef CFI_CDESC_T(7) CFI_CDESC_T7;
    CFI_cdesc_t *array = NULL; 

    switch(r){
        case 0:
            CFI_CDESC_T0 *Fobject0;
            Fobject0 = (CFI_CDESC_T0*) malloc(sizeof(CFI_CDESC_T0));
            array = (CFI_cdesc_t*) Fobject0;
            break;
        case 1:
            CFI_CDESC_T1 *Fobject1;
            Fobject1 = (CFI_CDESC_T1*) malloc(sizeof(CFI_CDESC_T1));
            array = (CFI_cdesc_t*) Fobject1;
            break;
        case 2:
            CFI_CDESC_T2 *Fobject2;
            Fobject2 = (CFI_CDESC_T2*) malloc(sizeof(CFI_CDESC_T2));
            array = (CFI_cdesc_t*) Fobject2;
            break;
        case 3:
            CFI_CDESC_T3 *Fobject3;
            Fobject3 = (CFI_CDESC_T3*) malloc(sizeof(CFI_CDESC_T3));
            array = (CFI_cdesc_t*) Fobject3;
            break;
        case 4:
            CFI_CDESC_T4 *Fobject4;
            Fobject4 = (CFI_CDESC_T4*) malloc(sizeof(CFI_CDESC_T4));
            array = (CFI_cdesc_t*) Fobject4;
            break;
        case 5:
            CFI_CDESC_T5 *Fobject5;
            Fobject5 = (CFI_CDESC_T5*) malloc(sizeof(CFI_CDESC_T5));
            array = (CFI_cdesc_t*) Fobject5;
            break;
        case 6:
            CFI_CDESC_T6 *Fobject6;
            Fobject6 = (CFI_CDESC_T6*) malloc(sizeof(CFI_CDESC_T6));
            array = (CFI_cdesc_t*) Fobject6;
            break;
        case 7:
            CFI_CDESC_T7 *Fobject7;
            Fobject7 = (CFI_CDESC_T7*) malloc(sizeof(CFI_CDESC_T7));
            array = (CFI_cdesc_t*) Fobject7;
            break;
    }
    return array;
}
```
</details>


<details><summary>cythonユーティリティ関数(cy_futils.h)</summary>

```c:cy_futils.h
#include <ISO_Fortran_binding.h>
CFI_cdesc_t* CFI_CDESC_T_cwrap(int r);
```
</details>

<details><summary>cythonユーティリティ関数(cy_futils.pxd)</summary>

```cython:cy_futils.pxd
from ISO_Fortran_binding cimport *
cdef extern from "cy_futils.h" nogil:
    CFI_cdesc_t* CFI_CDESC_T_cwrap(int r)
```
</details>

<details><summary>fortranとCのインターフェースモジュール(libfort_cinterfaces.f90)</summary>

```fortran:libfort_cinterfaces.f90
module ISO_Fortran_binding_test_cinterface
    use ISO_Fortran_binding_test
    implicit none
    public
    contains
        function generate_uninteroperable_t_pointer(n,m) bind(c) result(ptr)
            use iso_fortran_env
            integer(c_int) :: n,m
            type(c_ptr) :: ptr
            type(uninteroperable_t),pointer :: fobj
            allocate(fobj, source=uninteroperable_t(n,m))
            ptr = c_loc(fobj)
            print*,"fortran uninteroperable_t pointer"
            print '(1x,A,Z12,",",I15,A)',"c_ptr address is 0x",transfer(c_loc(fobj),0_int64), &
                   transfer(c_loc(fobj),0_int64),"(from fortran)"
        end function
        function generate_uninteroperable_t_array_pointer(narray,n,m) bind(c) result(ptr)
            use iso_fortran_env
            integer(c_int) :: narray,n,m
            type(c_ptr) :: ptr
            type(uninteroperable_t),pointer :: fobj(:)
            integer :: i
            allocate(fobj(narray))
            do i = 1,narray
                fobj(i) = uninteroperable_t(n,m)
            end do
            ptr = c_loc(fobj)
            print*,"fortran uninteroperable_t pointer (array version)"
            print '(1x,A,Z12,",",I15,A)',"c_ptr address is 0x",transfer(c_loc(fobj),0_int64), &
                   transfer(c_loc(fobj),0_int64),"(from fortran)"
        end function
        subroutine dealloc_uninteroperable_t(cptr) bind(c)
            type(c_ptr),intent(in),value :: cptr
            type(uninteroperable_t),pointer :: fptr => null()
            call c_f_pointer(cptr, fptr)
            if(associated(fptr))then
                deallocate(fptr)
                print*,"dealloc_uninteroperable_t from fortran"
            end if
        end subroutine
        subroutine dealloc_uninteroperable_t_array(cptr, r) bind(c)
            type(c_ptr),intent(in),value :: cptr
            type(uninteroperable_t),pointer :: fptr(:) => null()
            integer :: r(1)
            call c_f_pointer(cptr, fptr, r)
            if(associated(fptr))then
                deallocate(fptr)
                print*,"dealloc_uninteroperable_t from fortran"
            end if
        end subroutine

        subroutine c_show_uninteroperable_t(cptr) bind(c)
            type(c_ptr),intent(in),value :: cptr
            type(uninteroperable_t),pointer :: fptr => null()
            call c_f_pointer(cptr, fptr)
            call fptr%show_uninteroperable_t()
        end subroutine

        subroutine c_uninteroperable_t_memoryview(cptr, &
            & i32, d64, r64_1d, r64_2d, r64_1d_p, r64_2d_p) bind(c)
            type(c_ptr),intent(in),value :: cptr
            type(uninteroperable_t),pointer :: fptr => null()
            integer(int32) :: i32
            real(real64) :: d64
            real(real64),pointer :: r64_1d(:), r64_2d(:,:)
            real(real64),pointer :: r64_1d_p(:), r64_2d_p(:,:)
            call c_f_pointer(cptr, fptr)
            i32 = fptr%i32
            d64 = fptr%d64
            r64_1d => fptr%r64_1d
            r64_2d => fptr%r64_2d
            r64_1d_p => fptr%r64_1d_p
            r64_2d_p => fptr%r64_2d_p
        end subroutine
end module
```
</details>


<details><summary>libfort_cinterfaces.f90のcythonインターフェース(fwrap.pxd)</summary>

```cython:libfort_cinterfaces.f90のcythonインターフェース(fwrap.pxd)
cimport numpy as np
from ISO_Fortran_binding cimport CFI_cdesc_t
from libc.stdlib cimport *
from libc.stdint cimport (
    int16_t,
    int32_t,
    int64_t,
)

cdef extern from "f_functions.h":
    ctypedef struct interoperable_t:
        int16_t i16
        int32_t i32
        int64_t i64
        float f32
        double d64
        int64_t i64array[5]
        double d64array[5]
        char txt[10]
    void init_interoperable_t(interoperable_t* ptr)
    void bai_interoperable_t(interoperable_t* ptr)
    void show_interoperable_t(interoperable_t* ptr)

    void* generate_uninteroperable_t_pointer(int* n, int* m)
    void* generate_uninteroperable_t_array_pointer(int* n_array, int* n, int* m)
    void dealloc_uninteroperable_t(void* ptr)
    void dealloc_uninteroperable_t_array(void* ptr, int* r)
    void c_show_uninteroperable_t(void* ptr)
    void c_uninteroperable_t_memoryview(void* ptr,
        int32_t* i32, double* d64, 
        CFI_cdesc_t* r64_1d, CFI_cdesc_t* r64_2d,
        CFI_cdesc_t* r64_1d_p, CFI_cdesc_t* r64_2d_p)
cimport numpy as np
from ISO_Fortran_binding cimport CFI_cdesc_t
from libc.stdlib cimport *
from libc.stdint cimport (
    int16_t,
    int32_t,
    int64_t,
)

cdef extern from "f_functions.h":
    ctypedef struct interoperable_t:
        int16_t i16
        int32_t i32
        int64_t i64
        float f32
        double d64
        int64_t i64array[5]
        double d64array[5]
        char txt[10]
    void init_interoperable_t(interoperable_t* ptr)
    void bai_interoperable_t(interoperable_t* ptr)
    void show_interoperable_t(interoperable_t* ptr)

    void* generate_uninteroperable_t_pointer(int* n, int* m)
    void* generate_uninteroperable_t_array_pointer(int* n_array, int* n, int* m)
    void dealloc_uninteroperable_t(void* ptr)
    void dealloc_uninteroperable_t_array(void* ptr, int* r)
    void c_show_uninteroperable_t(void* ptr)
    void c_uninteroperable_t_memoryview(void* ptr,
        int32_t* i32, double* d64, 
        CFI_cdesc_t* r64_1d, CFI_cdesc_t* r64_2d,
        CFI_cdesc_t* r64_1d_p, CFI_cdesc_t* r64_2d_p)
```
</details>


<details><summary>libfort.f90に対応するpythonクラス(fwrap.pyx)</summary>

```cython:
import numpy as np
from cy_futils cimport CFI_CDESC_T_cwrap
from ISO_Fortran_binding cimport (
    CFI_attribute_allocatable,
    CFI_attribute_pointer,
    CFI_establish,
    CFI_type_double,
)

cdef class f_interoperable_t:
    cdef interoperable_t *_thisptr
    def __cinit__(self):
        self._thisptr = <interoperable_t*> malloc(sizeof(interoperable_t))

    def __dealloc__(self):
        if self._thisptr != NULL:
            free(self._thisptr)

    cpdef init_interoperable_t(self):
        init_interoperable_t(self._thisptr)

    cpdef bai_interoperable_t(self):
        bai_interoperable_t(self._thisptr)

    cpdef show_interoperable_t(self):
        show_interoperable_t(self._thisptr)

cdef class f_uninteroperable_t:
    cdef void *_thisptr
    cdef public int32_t i32
    cdef public double d64
    cdef public double[:] r64_1d
    cdef public double[::1,:] r64_2d
    cdef public double[:] r64_1d_p
    cdef public double[::1,:] r64_2d_p

    def __cinit__(self, int n, int m):
        self._thisptr = <void*> generate_uninteroperable_t_pointer(&n, &m)
        cdef CFI_cdesc_t* c_r64_1d = CFI_CDESC_T_cwrap(1)
        cdef CFI_cdesc_t* c_r64_2d = CFI_CDESC_T_cwrap(2)
        cdef CFI_cdesc_t* c_r64_1d_p = CFI_CDESC_T_cwrap(1)
        cdef CFI_cdesc_t* c_r64_2d_p = CFI_CDESC_T_cwrap(2)
        CFI_establish(c_r64_1d, NULL, CFI_attribute_pointer,CFI_type_double,8,1,NULL)
        CFI_establish(c_r64_2d, NULL, CFI_attribute_pointer,CFI_type_double,8,2,NULL)
        CFI_establish(c_r64_1d_p, NULL, CFI_attribute_pointer,CFI_type_double,8,1,NULL)
        CFI_establish(c_r64_2d_p, NULL, CFI_attribute_pointer,CFI_type_double,8,2,NULL)
        c_uninteroperable_t_memoryview(self._thisptr,&self.i32,&self.d64,c_r64_1d,c_r64_2d,c_r64_1d_p,c_r64_2d_p)
        self.r64_1d = <double[:c_r64_1d.dim[0].extent]> c_r64_1d.base_addr
        self.r64_2d = (<double[:c_r64_2d.dim[1].extent,:c_r64_2d.dim[0].extent]> c_r64_2d.base_addr).T
        self.r64_1d_p = <double[:c_r64_1d_p.dim[0].extent]> c_r64_1d_p.base_addr
        self.r64_2d_p = (<double[:c_r64_2d_p.dim[1].extent,:c_r64_2d.dim[0].extent]> c_r64_2d_p.base_addr).T

    def __dealloc__(self):
        if self._thisptr != NULL:
            dealloc_uninteroperable_t(self._thisptr)

    cpdef show(self):
        c_show_uninteroperable_t(self._thisptr)
```
</details>

## Pytonからの利用例
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/275690/c2104b78-aa68-d60e-30b3-318360b44d10.png)

# 終わりに
頑張ってFortranのクラスをPythonから使えるようにできたものの、かなり面倒でした。
ただ、Fortran内部の配列をnumpy配列としてコピーレスで利用できるので、性能面ではかなり良いのではないかと思います。

もっと詳しく説明したかったのですが、時間もないのでここまで。「コピーレスかつFortranクラスの利用」を簡単にできる方法があれば教えていただけるとありがたいです。
次は[f90wrap](https://github.com/jameskermode/f90wrap) を調べてみたいです。