Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.
28381 Discussions

Passing strings and allocatable arrays in a structure between C++ and Fortran

ferrad1
New Contributor I
1,929 Views

I have a situation where I want to pass a struct from C++ to Fortran. Every test type (double, int, bool, defined size arrays) works except allocatable arrays. But it is strange that they only don't work when there is a string member of the structure. When I remove the string member, it works. Here is my code:

C++:

#include <iostream>
#include <cstddef>
#include <vector>

using namespace std;
struct t_nwork {
        double  treal;
        int     tint;
        bool    tlog;
        double  trealarr[10];
        string  tchar;
        double *trealalloc;
};

//Fortran subroutine definition
extern "C" {
    void nf90(t_nwork *net);
}
    
int main()
{
    t_nwork net;
    net.tchar = "**bleep**";
    net.trealalloc = new double[5];
    for (int i = 0; i < 5; i++ ){
       net.trealalloc[i] = (double) i * 3;
    }
    nf90(&net);
}

Fortran:

module netf90_mod

implicit none

  type :: t_nwork
    real(8)      :: treal
    integer      :: tint
    logical      :: tlog
    real(8)      :: trealarr(10)
    character(4) :: tchar
    real(8), allocatable :: trealalloc(:)
  end type

contains
  subroutine nf90(net) bind(c)
    use iso_c_binding

    type(t_nwork), intent(inout) :: net
    write(6,*) net%tchar
    write(6,*) size(net%trealalloc)
    write(6,*) net%trealalloc(0)
    write(6,*) net%trealalloc(1)
    write(6,*) net%trealalloc(2)
    write(6,*) net%trealalloc(3)
    write(6,*) net%trealalloc(4)
  end subroutine

end module

If I comment out the string (tchar) member in all occurrences then the allocatable array gets passed through ok (well the length is 0 but the 5 values come through). But with it in there, it does not work.

I compile and link under Intel:

icx -c testc.cpp
ifort testc.obj testf.f90 

I'm no CPP expert, so maybe I haven't got the syntax quite correct.

0 Kudos
15 Replies
Arjen_Markus
Honored Contributor I
1,922 Views

You cannot pass allocatable arrays in this way - on the C++ side it is a "raw" pointer (memory address), whereas Fortran expects it to be an array descriptor. The fact that you are able to get anything out of it, is not relevant - that is a mere coincidence. You should use a type(c_ptr) instead of an allocatable array and use the routine c_f_pointer to reliably access the C++ data. I guess it works because your array is the last in the structure.

A similar problem occurs with the C++ string component. I have no idea what its implementation is, but it would be much safer to use a plain C (!) array of characters. I suspect that a C++ string type has some built-in data to deal with the length, something a C array does not have. But if that is the case, the way that sort of information would be accessible from Fortran would heavily depend on the actual C++ implementation, so avoid that!

0 Kudos
ferrad1
New Contributor I
1,778 Views

I managed to get strings and allocatables working by using 2 similar structures on the Fortran side, the first to map to the C++ structure, and the second to map to the Fortran code.  The structure members need to be copied between the two structures, the direction depending on whether they are in or out.

C++ code:

#include <iostream>
#include <cstddef>
#include <vector>

using namespace std;

struct t_nwork {
        char      tchar[5];
        double   *trealalloc;
        int       l_trealalloc;
};

//Fortran subroutine definition
extern "C" {
    void nf90(t_nwork *net);
}

int main()
{
    t_nwork net;

    strcpy_s(net.tchar, sizeof(net.tchar), "Fred");

    net.l_trealalloc = 5;
    net.trealalloc = new double[net.l_trealalloc];
    for (int i = 0; i < 5; i++ ){
      net.trealalloc[i] = (double) i * 3;
    }

// call the Fortran function
    nf90(&net);
}

Fortran code:

module netf90_mod

    implicit none

!-----external structure, same as C
type :: t_nwork_ext
        character ::      tchar(5)
        real(8), pointer :: p_trealalloc
        integer ::       l_trealalloc
end type

!-----internal structure, to be be populated from the interface structore above
type :: t_nwork
        character ::      tchar(5)
        real(8), allocatable :: trealalloc(:)
end type

    contains
      subroutine nf90(net_ext) bind(c)
        use iso_c_binding

        type(t_nwork_ext), intent(inout) :: net_ext

        type(t_nwork) :: net
        integer :: i
        real(8) :: k
        pointer (p_k,k)

!-------copy data from external to internal structure

!-------these types copy across easily
        net%tchar = net_ext%tchar

!-------allocatable array a bit more tricky
        p_k = loc(net_ext%p_trealalloc)
        allocate(net%trealalloc(net_ext%l_trealalloc))
        do i = 1, net_ext%l_trealalloc
          net%trealalloc(i) = k
          p_k = p_k + sizeof(k)
        enddo
        
        write(6,*) net%trealalloc(1)
        write(6,*) net%trealalloc(2)
        write(6,*) net%trealalloc(3)
        write(6,*) net%trealalloc(4)
        write(6,*) net%trealalloc(5)

      end subroutine

end module

I'm not sure how safe the array handling is, but it does work.

 

0 Kudos
jimdempseyatthecove
Honored Contributor III
1,733 Views

Here is a rework of your "working" program.

*** pay particular note that the changes permit in situ modification of the C++ data object as opposed to your copying of the data into a Fortran UDT (and omission of copying back should modification occur). IOW the modification to your program illustrates a better method of performing your task.

Secondary note/caution: allocation/deallocation (new/delete) should only occur on one side of the interoperable application IOW only in C++ .OR. only in Fortran (for any specific allocatable object).

#include <iostream>
#include <cstddef>
#include <vector>

using namespace std;

struct t_nwork {
    char      tchar[5];
    double* trealalloc;
    int       l_trealalloc;
};

//Fortran subroutine definition
extern "C" {
    void nf90(t_nwork* net);
}

int main()
{
    t_nwork net;

    strcpy_s(net.tchar, sizeof(net.tchar), "Fred");

    net.l_trealalloc = 5;
    net.trealalloc = new double[net.l_trealalloc];
    std::cout << "In main" << std::endl;
    for (int i = 0; i < 5; i++) {
        net.trealalloc[i] = (double)i * 3;
        std::cout << net.trealalloc[i] << std::endl;
    }

    // call the Fortran function
    nf90(&net);
    std::cout << "In main" << std::endl;
    for (int i = 0; i < 5; i++) {
        std::cout << net.trealalloc[i] << std::endl;
    }
}
module netf90_mod
    use iso_c_binding

    implicit none

!-----external structure, same as C
type t_nwork_ext
        character ::      tchar(5)
        type(C_PTR) :: p_trealalloc
        integer ::       l_trealalloc
end type

!-----internal structure, to be be populated from the interface structore above
type t_nwork
        character, pointer ::      tchar(:)
        real(8), pointer :: trealalloc(:)
        integer, pointer :: l_trealalloc
end type

    contains
      subroutine nf90(net_ext) bind(c)
        use iso_c_binding
!DIR$ OBJCOMMENT LIB:"ifconsol.lib"
!DIR$ OBJCOMMENT LIB:"libifcoremd.lib"
!DIR$ OBJCOMMENT LIB:"libifportmd.lib"
!DIR$ OBJCOMMENT LIB:"libmmd.lib"
!DIR$ OBJCOMMENT LIB:"ifmodintr.lib"
        type(t_nwork_ext), target, intent(inout) :: net_ext

        type(t_nwork) :: net
        integer :: i
        
        net%tchar => net_ext%tchar
        call c_f_pointer(net_ext%p_trealalloc, net%trealalloc, [net_ext%l_trealalloc])
        net%l_trealalloc => net_ext%l_trealalloc
        
        write(6,*) "In nf90"
        do i=1,net%l_trealalloc
            write(6,*) net%trealalloc(i)
        end do        
        ! now modify callers data (IOW perform output)
        
        do i=1,net%l_trealalloc
            net%trealalloc(i) = net%trealalloc(i) * 2
        end do
      end subroutine

end module
In main
0
3
6
9
12
 In nf90
  0.000000000000000E+000
   3.00000000000000
   6.00000000000000
   9.00000000000000
   12.0000000000000
In main
0
6
12
18
24

Jim Dempsey

 

0 Kudos
ferrad1
New Contributor I
1,700 Views

Thank you Jim.

I have a question about the string. On the F90 side, I can't use trim() on the character variable net%tchar, although

 

write(6,*) net%tchar

 

does print it out.  But if I try to change it using:

 

net%tchar = 'John'

 

then garbage get printed out on the C++ side, well actually 5 "J" chars.

0 Kudos
ferrad1
New Contributor I
1,919 Views

Thanks.  I am trying to use char instead of string.  However it gets lost in the strcpy_s function:

 

#include <iostream>
#include <cstddef>
#include <vector>

using namespace std;
struct t_nwork {
double treal;
int tint;
bool tlog;
double trealarr[10];
char tchar[4];
};

int main()
{
t_nwork net;
cout << "Hello World1\n";
strcpy_s(net.tchar, sizeof(net.tchar), "**bleep**");
cout << "Hello World2\n";
cout << net.tchar << "\n";
cout << "Hello World3\n";
}

 

It never prints out Hello World2.  I'm no C programmer but that's what the docs for strcpy_s show as the correct syntax.

 

0 Kudos
Arjen_Markus
Honored Contributor I
1,914 Views

Well, that ought to do the trick, but the string is 6 characters long and then you have C's guard character, a NUL byte. So you can store strings of 3 characters only with that declaration. Do you get "**b"?

0 Kudos
ferrad1
New Contributor I
1,910 Views

No it just didn't do anything, but I saw the size issue.  Incidentally my string was the 4 letter shortening of Richard which the forum police translated to **bleep** !

0 Kudos
Steve_Lionel
Honored Contributor III
1,768 Views

I'll mention that Fortran 2018 dramatically extended interoperability for strings and allocatable/pointer objects, with things passed by "C Descriptor".  I talk about that in the overall presentation attached.

0 Kudos
jimdempseyatthecove
Honored Contributor III
1,682 Views

In nf90, if you examine the contents of the Fortran tchar, a 5 byte/character string, you will find that it is exactly what you placed into the C++ tchar[5] buffer. This includes the trailing NULL. While you can call this a quirk, it is not an error (other than programming oversight should you not want a null in the buffer). As your needs may require, it is up to the programmer to address this issue. This includes padding the tchar[5] buffer .or. NULL terminating the buffer, either on C++ side or Fortran side depending on which direction the data moves.

 

>>net%tchar = 'John' ... then garbage get printed out on the C++ side

It is your responsibility to insert the trailing NULL

See: C Strings in Character Constants (intel.com)

Also note

net%tchar = 'JohnWasHere'C

Would insert 'JohnW' into the buffer without NULL as the buffer only could hold 5 characters.

You must be mindful that in C/C++/... the NULL is an end-of-string indicator to a non-length defined list of char's.

 

Jim Dempsey

0 Kudos
ferrad1
New Contributor I
1,681 Views

In a later experiment, I had already added the \0 when assigning tchar  to 'John', but when passed back to C I still get 5 "J' chars: JJJJJ╠╠╠É¢╠╓;☻

Code:

 

module netf90_mod
    use iso_c_binding

    implicit none

!-----external structure, same as C
type :: t_newtype
        real(8) ::    newreal
end type

type t_nwork_ext
        real(8) ::    treal
        integer ::       tint
        logical ::      tlog
        real(8) ::    trealarr(10)
        character ::      tchar(5)
        type(C_PTR) :: p_trealalloc
        integer ::       l_trealalloc
        type(t_newtype) :: atype
end type

!-----internal structure, to be be populated from the interface structore above
type t_nwork
        real(8), pointer ::       treal
        integer, pointer ::       tint
        logical, pointer ::      tlog
        real(8), pointer ::    trealarr(:)
        character, pointer ::      tchar(:)
        real(8), pointer :: trealalloc(:)
        integer, pointer :: l_trealalloc
        type(t_newtype), pointer :: atype
end type

    contains
      subroutine nf90(net_ext) bind(c)
      !DEC$ATTRIBUTES DLLEXPORT :: nf90
        use iso_c_binding
!DIR$ OBJCOMMENT LIB:"ifconsol.lib"
!DIR$ OBJCOMMENT LIB:"libifcoremd.lib"
!DIR$ OBJCOMMENT LIB:"libifportmd.lib"
!DIR$ OBJCOMMENT LIB:"libmmd.lib"
!DIR$ OBJCOMMENT LIB:"ifmodintr.lib"
        type(t_nwork_ext), target, intent(inout) :: net_ext

        type(t_nwork) :: net
        integer :: i
        
        net%treal => net_ext%treal
        net%tint => net_ext%tint
        net%tlog => net_ext%tlog
        net%trealarr => net_ext%trealarr
        net%atype => net_ext%atype
        net%tchar => net_ext%tchar
        call c_f_pointer(net_ext%p_trealalloc, net%trealalloc, [net_ext%l_trealalloc])
        net%l_trealalloc => net_ext%l_trealalloc
        
        write(6,*) "In nf90"
        write(6,*) net%treal
        write(6,*) net%tint
        write(6,*) net%tlog
        write(6,*) net%tchar
        write(6,*) net%atype%newreal
        do i=1,net%l_trealalloc
            write(6,*) net%trealalloc(i)
        end do        
        ! now modify callers data (IOW perform output)
        
        net%treal = 4321.765
        net%tint = 456789
        net%tlog = 0
        net%tchar = 'John'C
        net%atype%newreal = 2.71828
        do i=1,size(net_ext%trealarr)
            net%trealarr(i) = net%trealarr(i) * 2
        end do
        do i=1,net%l_trealalloc
            net%trealalloc(i) = net%trealalloc(i) * 2
        end do
      end subroutine

end module

 

C code:

 

#include <iostream>
#include <cstddef>
#include <vector>

using namespace std;

struct t_newtype {
    double    newreal;
};

struct t_nwork {
    double    treal;
    int       tint;
    bool      tlog;
    double    trealarr[10];
    char      tchar[5];
    double*   trealalloc;
    int       l_trealalloc;
    t_newtype atype;
};

//Fortran subroutine definition
extern "C" {
    void nf90(t_nwork* net);
}

int main()
{
    t_nwork net;

    net.treal = 1234.567;
    net.tint  = 987654;
    net.tlog  = 1;
    net.atype.newreal = 3.14159;
    for (int i = 0; i < 10; i++ ){
      net.trealarr[i] = (double) i;
    }

    strcpy_s(net.tchar, sizeof(net.tchar), "Fred");

    net.l_trealalloc = 5;
    net.trealalloc = new double[net.l_trealalloc];
    std::cout << "In main" << std::endl;
    std::cout << net.tchar << std::endl;
    for (int i = 0; i < 5; i++) {
        net.trealalloc[i] = (double)i * 3;
        std::cout << net.trealalloc[i] << std::endl;
    }

    // call the Fortran function
    nf90(&net);
    std::cout << "In main" << std::endl;
    std::cout << net.treal << std::endl;
    std::cout << net.tint << std::endl;
    std::cout << net.tlog << std::endl;
    std::cout << net.atype.newreal << std::endl;
    std::cout << net.tchar << std::endl;
    for (int i = 0; i < 10; i++) {
        std::cout << net.trealarr[i] << std::endl;
    }
    for (int i = 0; i < 5; i++) {
        std::cout << net.trealalloc[i] << std::endl;
    }
}

 

0 Kudos
jimdempseyatthecove
Honored Contributor III
1,648 Views

In your C++ t_nwork you have 

    char tchar[5];

Where tchar is (resolves to) the address of a 5 byte buffer as opposed to being the address of a pointer to a 5 byte buffer.

On the Fortran side t_nwork_ext has

    character :: tchar(5)

Where tchar is (resolves to) the address of a 5 byte buffer that is used as an array of size 5 of 1 byte characters. And t_nwork contains a pointer that gets set to the address of a 5 byte buffer that is used as an array of size 5 of 1 byte characters.

In Fortran code you have:

    net%tchar = 'John'C

Which assigns a 5 byte string of characters to the 1st character string (of 1 byte) in the array of characters.

 

The correction for this is to declare the character string as a scalar of length 5.

type t_nwork_ext
        ...
        character(len=5) ::      tchar
        ...
end type

type t_nwork
        ...
        character(len=5), pointer ::      tchar
        ...
end type

Jim Dempsey

 

 

0 Kudos
jimdempseyatthecove
Honored Contributor III
1,646 Views

Also consider:

module netf90_mod
    use iso_c_binding

    implicit none

!-----external structure, same as C
type :: t_newtype
        real(8) ::    newreal
end type

type t_nwork_ext
        real(8) ::    treal
        integer ::       tint
        logical ::      tlog
        real(8) ::    trealarr(10)
        character(len=5) ::      tchar
        type(C_PTR) :: p_trealalloc
        integer ::       l_trealalloc
        type(t_newtype) :: atype
end type

    contains
      subroutine nf90(net) bind(c)
      !DEC$ATTRIBUTES DLLEXPORT :: nf90
        use iso_c_binding
!DIR$ OBJCOMMENT LIB:"ifconsol.lib"
!DIR$ OBJCOMMENT LIB:"libifcoremd.lib"
!DIR$ OBJCOMMENT LIB:"libifportmd.lib"
!DIR$ OBJCOMMENT LIB:"libmmd.lib"
!DIR$ OBJCOMMENT LIB:"ifmodintr.lib"
        type(t_nwork_ext), intent(inout) :: net
        real(8), pointer :: trealalloc(:)

        integer :: i
        
        associate(treal => net%treal, tint => net%tint, tlog => net%tlog, trealarr => net%trealarr, atype => net%atype, tchar => net%tchar)
        call c_f_pointer(net%p_trealalloc, trealalloc, [net%l_trealalloc])
        
        write(6,*) "In nf90"
        write(6,*) treal
        write(6,*) tint
        write(6,*) tlog
        write(6,*) trealarr
        write(6,*) tchar
        write(6,*) atype%newreal
        do i=1,size(trealalloc)
            write(6,*) trealalloc(i)
        end do        
        ! now modify callers data (IOW perform output)
        
        treal = 4321.765
        tint = 456789
        tlog = 0
        tchar = 'John'C
        atype%newreal = 2.71828
        do i=1,size(trealarr)
            trealarr(i) = trealarr(i) * 2
        end do
        do i=1,size(trealalloc)
            trealalloc(i) = trealalloc(i) * 2
        end do
        end associate
      end subroutine

    end module

Jim Dempsey

0 Kudos
ferrad1
New Contributor I
1,643 Views

I see you have removed the internal type 'net', which is ok in this small example, however the full Fortran program (not called by C at the moment) has the internal structures with allocatable arrays.  My initial desire was to have a C mapping of these structures (ie. C <> F90 structures), but as allocatables would not map, I had to create this intermediary structure with _ext appended.  Removing the final internal structure is not possible as these are used extensively throughout the code, hence this internal <> external mapping.

0 Kudos
jimdempseyatthecove
Honored Contributor III
1,628 Views

>>the full Fortran program (not called by C at the moment) has the internal structures with allocatable arrays

You will need to decide as to if the allocations/deallocations occur on the Fortran side or on the C side. Keep these consistent. Try to eliminate unnecessary copying of data as well as unnecessary mapping.

 

An alternative to consider is to use the external scalars and non-allocatables without associate and then reference the c_ptr's via localized block/end block.

module netf90_mod
    use iso_c_binding

    implicit none

!-----external structure, same as C
type :: t_newtype
        real(8) ::    newreal
end type

type t_nwork_ext
        real(8) ::    treal
        integer ::       tint
        logical ::      tlog
        real(8) ::    trealarr(10)
        character(len=5) ::      tchar
        type(C_PTR) :: p_trealalloc
        integer ::       l_trealalloc
        type(t_newtype) :: atype
end type

    contains
      subroutine nf90(net) bind(c)
      !DEC$ATTRIBUTES DLLEXPORT :: nf90
        use iso_c_binding
!DIR$ OBJCOMMENT LIB:"ifconsol.lib"
!DIR$ OBJCOMMENT LIB:"libifcoremd.lib"
!DIR$ OBJCOMMENT LIB:"libifportmd.lib"
!DIR$ OBJCOMMENT LIB:"libmmd.lib"
!DIR$ OBJCOMMENT LIB:"ifmodintr.lib"
        type(t_nwork_ext), intent(inout) :: net

        integer :: i
        
        write(6,*) "In nf90"
        write(6,*) net%treal
        write(6,*) net%tint
        write(6,*) net%tlog
        write(6,*) net%trealarr
        write(6,*) net%tchar
        write(6,*) net%atype%newreal
        block
            real(8), pointer :: trealalloc(:)
            call c_f_pointer(net%p_trealalloc, trealalloc, [net%l_trealalloc])
            do i=1,size(trealalloc)
                write(6,*) trealalloc(i)
            end do    
        end block
        ! now modify callers data (IOW perform output)
        
        net%treal = 4321.765
        net%tint = 456789
        net%tlog = 0
        net%tchar = 'John'C
        net%atype%newreal = 2.71828
        do i=1,size(net%trealarr)
            net%trealarr(i) = net%trealarr(i) * 2
        end do
        block
            real(8), pointer :: trealalloc(:)
            call c_f_pointer(net%p_trealalloc, trealalloc, [net%l_trealalloc])
            do i=1,size(trealalloc)
                trealalloc(i) = trealalloc(i) * 2
            end do
        end block
      end subroutine

    end module

Unfortunately, (at least in the Fortran I have here), it appears that you cannot have a UDT function that returns a pointer to an array or pointer to real that can be used on the left hand side of =. However, it can return a pointer to a real(8) that can be used on lhs of =.

 

module netf90_mod
    use iso_c_binding

    implicit none

    !-----external structure, same as C
    type t_newtype
            real(8) ::    newreal
    end type

    type t_nwork_ext
        real(8) ::    treal
        integer ::       tint
        logical ::      tlog
        real(8) ::    trealarr(10)
        character(len=5) ::      tchar
        type(C_PTR) :: p_trealalloc
        integer ::       l_trealalloc
        type(t_newtype) :: atype
        contains
        procedure :: trealalloc => net_trealalloc
    end type

    contains
        function net_trealalloc(this, i) result(ret)
            import
            class(t_nwork_ext) :: this
            integer :: i
            real(8), pointer :: ret
            real(8), pointer :: trealalloc(:)
            call c_f_pointer(this%p_trealalloc, trealalloc, [this%l_trealalloc])
            ret => trealalloc(i)
        end  function net_trealalloc
    
      subroutine nf90(net) bind(c)
      !DEC$ATTRIBUTES DLLEXPORT :: nf90
        use iso_c_binding
!DIR$ OBJCOMMENT LIB:"ifconsol.lib"
!DIR$ OBJCOMMENT LIB:"libifcoremd.lib"
!DIR$ OBJCOMMENT LIB:"libifportmd.lib"
!DIR$ OBJCOMMENT LIB:"libmmd.lib"
!DIR$ OBJCOMMENT LIB:"ifmodintr.lib"
        type(t_nwork_ext), intent(inout) :: net

        integer :: i
        
        write(6,*) "In nf90"
        write(6,*) net%treal
        write(6,*) net%tint
        write(6,*) net%tlog
        write(6,*) net%trealarr
        write(6,*) net%tchar
        write(6,*) net%atype%newreal
        do i=1,net%l_trealalloc ! size(net%trealalloc)
            write(6,*) net%trealalloc(i)
        end do
        ! now modify callers data (IOW perform output)
        
        net%treal = 4321.765
        net%tint = 456789
        net%tlog = 0
        net%tchar = 'John'C
        net%atype%newreal = 2.71828
        do i=1,net%l_trealalloc ! size(net%trealarr)
            net%trealalloc(i) = net%trealalloc(i) * 2
        end do
      end subroutine

    end module

The only drawbacks of this are:

1) Higher execution overhead

2) The Debugger cannot view the entire array excepting for inside the contained procedure (after the call c_f_pointer).

Jim Dempsey

 

0 Kudos
ferrad1
New Contributor I
884 Views

Hello Jim,

I'm revisiting this thread as I need to implement this soon in a project.  I have seen in the example above that the length of the allocatable array is fixed on the C side (eg. 5).  However in my real example the length is determined in the Fortran code (The C side doesn't know the sizes).  I could always oversize it on the C side, and pass back the Fortran calculated length.  

My looks as follows at the moment.  C++:

 

 

#include <iostream>
#include <cstddef>
#include <vector>

using namespace std;

struct t_nwork {
        double   *trealalloc;
        int       l_trealalloc;
};

//Fortran subroutine definition
extern "C" {
    void netf90(t_nwork *net);
}

int main()
{
    t_nwork net;

    net.l_trealalloc = 5;
    net.trealalloc = new double[net.l_trealalloc];
    for (int i = 0; i < 5; i++ ){
      net.trealalloc[i] = (double) i * 3;
    }
    for (int i = 0; i < 5; i++ ){
      cout << i << " : " << net.trealalloc[i] << "\n";
    }

// call the Fortran function
    netf90(&net);

    for (int i = 0; i < 5; i++ ){
      cout << i << " : " << net.trealalloc[i] << "\n";
    }
}

 

 

F90:

 

 

module netf90_mod

    implicit none

!-----external structure, same as C
      type :: t_nwork_ext
        real(8), pointer    :: p_trealalloc
        integer             :: l_trealalloc
      end type

!-----internal structure, to be be populated from the interface structure above
      type :: t_nwork
        real(8), allocatable :: trealalloc(:)
      end type

    contains
      subroutine netf90(net_ext) bind(c)
      !DEC$ATTRIBUTES DLLEXPORT :: netf90
        use iso_c_binding

        type(t_nwork_ext), intent(inout) :: net_ext

        type(t_nwork) :: net
        integer :: i
        real(8) :: k
        pointer (p_k,k)

!-------copy data from external to internal structure

!-------allocatable array a bit tricky
        p_k = loc(net_ext%p_trealalloc)
        allocate(net%trealalloc(net_ext%l_trealalloc))
        do i = 1, net_ext%l_trealalloc
          net%trealalloc(i) = k
          p_k = p_k + sizeof(k)
        enddo
        
        write(6,*) net%trealalloc(1)
        write(6,*) net%trealalloc(2)
        write(6,*) net%trealalloc(3)
        write(6,*) net%trealalloc(4)
        write(6,*) net%trealalloc(5)

!-------make changes and send it back
        do i = 1, net_ext%l_trealalloc
          net%trealalloc(i) = net%trealalloc(i) * 1.5
        enddo

        p_k = loc(net_ext%p_trealalloc)
        do i = 1, net_ext%l_trealalloc
          k = net%trealalloc(i)
          p_k = p_k + sizeof(k)
        enddo

      end subroutine

end module

 

 

Adrian

0 Kudos
Reply