Come allocare un array all'interno di Fortran Routine "chiamato" da c

Question

Penso che il titolo dice cosa ho bisogno.So che possiamo usare la funzione "asd" per farlo, ma per alcuni motivi ho bisogno di fare l'assegnazione in fortran (cioè in subroutine "asd_").Ecco il codice 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;
}

.

Ed Ecco il codice Fortran:

  subroutine asd(c)

  implicit none

  real, pointer, allocatable ::c(:)

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

  end subroutine 

.

Questo dà casualmente il guasto di segmentazione.Qualsiasi aiuto sarebbe apprezzato.

Answer 1

Ecco anche un'altra soluzione, se si desidera utilizzare i tipi intrinseci fortrani.Questo è stato il mio caso, dal momento che avevo bisogno di chiamare le routine da una biblioteca esterna, utilizzando i tipi di dati pre-specificati.Questo è fondamentalmente fatto con una subroutine fortran wrapper.Ecco il codice C:

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

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

.

Ed ecco l'involucro:

  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

.

e i codici 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

.

E il file di intestazione "H.H":

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

.

Nota, in questo modo tutti gli oggetti sono opachi nel c.

Answer 2

Il legame ISO C Fortran 2003 fornisce un modo portatile per farlo.È implementato in molti compilatori.Ecco il codice di esempio.

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

.

e

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

Se è necessario una soluzione di sicurezza e / o la possibilità di deallocare lo spazio da C di nuovo, l'esempio seguente farebbe il lavoro:

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

.

Sul lato Fortran, si dispone di un tipo General Wrapper CWrapper, che può trasportare qualsiasi tipo di tipo derivato.Quest'ultimo contiene i dati che vorresti passare.Il tipo CWrapper accetta il carico utile arbitrario e invocare sempre la routine free_wrapper() da C per rilasciare la memoria.

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

.