Fortran 루틴 내부의 배열을 할당하는 방법 "호출"

Question

제목이 내가 필요한 것을 말한다고 생각합니다.우리가 "ASD"기능을 사용할 수 있지만 Fortran에서 할당을 수행 해야하는 "ASD"기능을 사용할 수 있습니다 (즉, 서브 루틴 "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 Intrinsic 유형을 사용하려면 여기에 또 다른 해결책이 있습니다.사전 지정된 데이터 유형을 사용하여 외부 라이브러리에서 루틴을 호출 할 필요가 있으므로이 사례였습니다.이것은 기본적으로 래퍼 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

.

및 헤더 파일 "h.h":

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

.

주,이 방법은 모든 객체가 c에서 불투명합니다

Answer 2

FORTRAN 2003 ISO C 바인딩은이를 수행하는 휴대용 방법을 제공합니다.그것은 많은 컴파일러에서 구현됩니다.다음은 예제 코드입니다.

#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에서 공간을 다시 할당 할 수있는 가능성이있는 경우 아래 예제는 작업을 수행합니다.

#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;
}

.

Fortran 측면에서는 모든 유형의 파생 유형을 수행 할 수있는 일반적인 래퍼 유형 CWrapper가 있습니다.후자는 주변을 통과하려는 데이터를 포함합니다.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

.