Fortranルーチン内で配列を割り当てる方法 "called" from C

Question

私はタイトルが私に必要と言うと思う。私はこれを行うために "asd"関数を使うことができると知っていますが、何らかの理由でFortranで割り付けを行う必要があります（つまり、サブルーチン "asd_"）。ここではCのコードは次のとおりです。

#include <stdio.h> 

void asd(float **c) { 
    *c = (float *) malloc (2*sizeof(float)); 
    **c =123; 
    *(*c+1)=1234; 
} 

void asd_(float **c); 

main() { 
    float *c; 
    asd_(&c); 
// asd(&c); would do the job perfectly 
    printf("%f %f \n",c[0],c[1]); 
    return 0; 
} 

そしてここでは、Fortranコードは次のとおりです。

subroutine asd(c) 

    implicit none 

    real, pointer, allocatable ::c(:) 

    print *, associated(c) 
    if(.not. associated(c)) allocate(c(2)) 

    end subroutine 

これは、ランダムにセグメンテーションフォールトを与えます。どんな助けもありがとう。

Answer 1

は、また別の解決策です。あらかじめ指定されたデータ型を使用して、外部ライブラリからルーチンを呼び出す必要があったので、これは私のケースでした。これは、基本的に、ラッパーFortranサブルーチンで行われます。ここではCのコードは次のとおりです。

void mywrap_(void **); 
void myprint_(void *); 

main() { 
    void *d; 
    mywrap_(&d); 
    myprint_(d); 
    return 0; 
} 

そして、ここではラッパーです：

subroutine mywrap(b) 
    implicit none 
    include "h.h"  
    type(st), target, save :: a 
    integer, pointer :: b 
    interface 
    subroutine alloc(a) 
     include "h.h" 
     type(st) a 
    end subroutine alloc 
    end interface 

    call alloc(a) 
    b => a%i 
    end 

およびFortranコード：

subroutine alloc(a) 
    implicit none 
    include "h.h" 
    type(st) a 

    a%i = 2 
    a%r = 1.5 
    if (allocated(a%s)) deallocate(a%s) 
    allocate(a%s(2)) 
    a%s(1) = 1.23 
    a%s(2) = 1234 
    end 
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    subroutine myprint(a) 
    implicit none 
    include "h.h"  
    type(st) a 

    print *,"INT: ", a%i 
    print *,"REAL: ", a%r 
    print *,"ALLOC: ", a%s 
    end 

とヘッダーファイル "HH"：

type st 
    sequence 
    integer i 
    real r 
    real, allocatable :: s(:) 
    end type 

このように、すべてのオブジェクトar C.

Answer 2

Fortran 2003 ISO Cバインディングは、これを実行するポータブルな方法を提供します。これは多くのコンパイラで実装されています。ここにコードの例を示します。あなたはFortran組み込み型を使用したい場合はここで

#include <stdio.h> 

void test_mem_alloc (float ** array); 

int main (void) { 

    float * array; 
    test_mem_alloc (&array); 

    printf ("Values are: %f %f\n", array [0], array [1]); 

    return 0; 
} 

と

subroutine test_mem_alloc (c_array_ptr) bind (C, name="test_mem_alloc") 

    use, intrinsic :: iso_c_binding 
    implicit none 

    type (c_ptr), intent (out) :: c_array_ptr 
    real (c_float), allocatable, dimension (:), target, save :: FortArray 

    allocate (FortArray (1:2)) 
    FortArray = [ 2.5_c_float, 4.4_c_float ] 

    c_array_ptr = c_loc (FortArray) 

end subroutine test_mem_alloc 

Answer 3

における電子の不透明あなたがスレッドセーフ液および/または再びCからスペースの割り当てを解除する可能性が必要な場合は、以下の例では、仕事をするだろう：Fortranの側では

#include <stdio.h> 

void test_mem_alloc(float ** array, void **wrapper); 
void free_wrapper(void **wrapper); 

int main() 
{ 

    float *array; 
    void *wrapper; 

    /* Allocates space in Fortran. */ 
    test_mem_alloc(&array, &wrapper); 
    printf("Values are: %f %f\n", array [0], array [1]); 
    /* Deallocates space allocated in Fortran */ 
    free_wrapper(&wrapper); 

    return 0; 
} 

、任意のタイプの派生型を保持できる一般的なラッパータイプCWrapperがあります。 Latterには、渡したいデータが含まれています。 CWrapperのタイプは任意のペイロードを受け入れ、常にCからのfree_wrapper()ルーチンを呼び出してメモリを解放します。

module memalloc 
    use, intrinsic :: iso_c_binding 
    implicit none 

    type :: CWrapper 
    class(*), allocatable :: data 
    end type CWrapper 

    type :: CfloatArray 
    real(c_float), allocatable :: array(:) 
    end type CfloatArray 

contains 

    subroutine test_mem_alloc(c_array_ptr, wrapper_ptr)& 
     & bind(C, name="test_mem_alloc") 
    type (c_ptr), intent (out) :: c_array_ptr 
    type(c_ptr), intent(out) :: wrapper_ptr 

    type(CWrapper), pointer :: wrapper 

    allocate(wrapper) 
    allocate(CfloatArray :: wrapper%data) 
    select type (data => wrapper%data) 
    type is (CfloatArray) 
     allocate(data%array(2)) 
     data%array(:) = [2.5_c_float, 4.4_c_float] 
     c_array_ptr = c_loc(data%array) 
    end select 
    wrapper_ptr = c_loc(wrapper) 

    end subroutine test_mem_alloc 


    subroutine free_cwrapper(wrapper_ptr) bind(C, name='free_wrapper') 
    type(c_ptr), intent(inout) :: wrapper_ptr 

    type(CWrapper), pointer :: wrapper 

    call c_f_pointer(wrapper_ptr, wrapper) 
    deallocate(wrapper) 

    end subroutine free_cwrapper 

end module memalloc