I am writing some Fortran 90 code which dynamically allocates a user defined type instance and returns an ID (actually an array offset) for it to the C++ world. It maintains an array of these instances. This will be used to support multi C++ threads calling into the same Fortran code at the same time and each has their own separate data. The id can be used in calls from C++ to a Fortran function which will use the id to find and pass a pointer to the user defined type instance to other Fortran code.
!
! This module manages data instances so that multiple
! C++ instances can use it to call into the Fortran code.
!
MODULE SharedData
! We want dynamically allocated instances of this:
TYPE SharedDataChunk
! This will end up having a ton of data.
INTEGER ID
INTEGER NQTR,QTRLTY(100),QBASIS(100)
END TYPE
! Declare a dynamically allocated array to hold instances.
TYPE SharedDataChunkHolder
TYPE(SharedDataChunk), POINTER :: ptr
END TYPE
TYPE(SharedDataChunkHolder), DIMENSION(:), ALLOCATABLE :: SharedDataChunks
INTEGER SharedDataChunksSize
LOGICAL, DIMENSION(:), ALLOCATABLE :: SharedDataChunksAllocated
END MODULE
!-------------------------------------------------
!Sample Fortran function getting the user defined type as the first argument.
!DEC$ ATTRIBUTES STDCALL :: getshareddataid
INTEGER FUNCTION getshareddataid(sharedDataInstance)
USE SharedData
TYPE(SharedDataChunk), POINTER :: sharedDataInstance
INTEGER id
id = sharedDataInstance%ID
getshareddataid = id
END FUNCTION
!-------------------------------------------------
! Test function, called from C++ via an integer ID
! rather than a pointer.
!DEC$ ATTRIBUTES STDCALL :: getshareddataidfromid
INTEGER FUNCTION getshareddataidfromid(id)
USE SharedData
INTEGER id
TYPE(SharedDataChunk), POINTER :: c
INTERFACE
INTEGER FUNCTION getshareddataid(sharedDataInstance)
!DEC$ ATTRIBUTES STDCALL :: getshareddataid
USE SharedData
TYPE(SharedDataChunk), POINTER :: sharedDataInstance
END FUNCTION
END INTERFACE
! Find my instance data pointer
c => SharedDataChunks(id)%ptr
! And now use it to call other Fortran functions.
getshareddataidfromid = getshareddataid(c)
END FUNCTION
!-------------------------------------------------
!The caller is done and wants to release their instance data.
!DEC$ ATTRIBUTES STDCALL :: releaseshareddata
SUBROUTINE releaseshareddata(id)
USE SharedData
INTEGER id
IF (SharedDataChunksAllocated(id)) THEN
DEALLOCATE(SharedDataChunks(id)%ptr)
SharedDataChunksAllocated(id) = .FALSE.
ENDIF
END SUBROUTINE
!-------------------------------------------------
!Called (one thread at a time) to allocate instance data.
!DEC$ ATTRIBUTES STDCALL :: CreateSharedData
FUNCTION CreateSharedData(opt) RESULT(res)
USE SharedData
INTEGER opt
INTEGER res
INTEGER id
TYPE(SharedDataChunk), POINTER :: c
INTEGER arrayPos
INTEGER i
TYPE(SharedDataChunkHolder), DIMENSION(:), ALLOCATABLE :: CopySharedDataChunks
LOGICAL, DIMENSION(:), ALLOCATABLE :: CopySharedDataChunksAllocated
INTEGER NewSharedDataChunksSize
INTERFACE
INTEGER FUNCTION getshareddataid(sharedDataInstance)
!DEC$ ATTRIBUTES STDCALL :: getshareddataid
USE SharedData
TYPE(SharedDataChunk), POINTER :: sharedDataInstance
END FUNCTION
INTEGER FUNCTION getshareddataidfromid(id)
!DEC$ ATTRIBUTES STDCALL :: getshareddataidfromid
USE SharedData
INTEGER id
END FUNCTION
END INTERFACE
! Make sure we have an array to track all instances
IF (.NOT.ALLOCATED(SharedDataChunks)) THEN
! First call, allocate the arrays
SharedDataChunksSize = 10
ALLOCATE(SharedDataChunks(SharedDataChunksSize))
ALLOCATE(SharedDataChunksAllocated(SharedDataChunksSize))
SharedDataChunksAllocated(1:SharedDataChunksSize) = .FALSE.
arrayPos = 1
ELSE
! Find an unused slot in the array
arrayPos = 0;
DO i = 1, SharedDataChunksSize
IF (.NOT.SharedDataChunksAllocated(i)) THEN
arrayPos = i
EXIT
ENDIF
END DO
! If none found, increase the array size
IF (arrayPos.EQ.0) THEN
! Copy the old array first
ALLOCATE(CopySharedDataChunks(SharedDataChunksSize))
ALLOCATE(CopySharedDataChunksAllocated(SharedDataChunksSize))
CopySharedDataChunksAllocated(1:SharedDataChunksSize) = SharedDataChunksAllocated
DO i = 1, SharedDataChunksSize
CopySharedDataChunks(i)%ptr => SharedDataChunks(i)%ptr
END DO
! Allocate a larger array and copy the original
NewSharedDataChunksSize = SharedDataChunksSize + 10
DEALLOCATE(SharedDataChunks)
DEALLOCATE(SharedDataChunksAllocated)
ALLOCATE(SharedDataChunks(NewSharedDataChunksSize))
ALLOCATE(SharedDataChunksAllocated(NewSharedDataChunksSize))
SharedDataChunksAllocated(1:SharedDataChunksSize) = CopySharedDataChunksAllocated
DO i = 1, SharedDataChunksSize
SharedDataChunks(i)%ptr => CopySharedDataChunks(i)%ptr
END DO
! Free the copy we made
DEALLOCATE(CopySharedDataChunks)
DEALLOCATE(CopySharedDataChunksAllocated)
arrayPos = SharedDataChunksSize + 1
SharedDataChunksSize = NewSharedDataChunksSize
ENDIF
ENDIF
! Create an instance at the available array position:
ALLOCATE(SharedDataChunks(arrayPos)%ptr)
c => SharedDataChunks(arrayPos)%ptr
SharedDataChunksAllocated(arrayPos) = .TRUE.
c%id = arrayPos
! Now do any initialization
! Now test:
id = getshareddataid(c)
id = getshareddataidfromid(id)
! Return an id that can be used in future calls
res = id
END FUNCTION
Here is some sample C++ test code:
extern "C"
{
long __stdcall createshareddata(long option);
long __stdcall getshareddataidfromid(long id);
void __stdcall releaseshareddata(long id);
}
vodi Test()
{
long id = createshareddata(0);
long id2 = getshareddataidfromid(id);
releaseshareddata(id);
};
This all seems to work well, but since this is a little bleeding edge (at least in Fortran for me), comments and suggestions are welcome.
I realize I do not really need the SharedDataChunksAllocated array, but added it for convenience and since the ALLLOCATED function cant be used on arrays, at least not directly.
链接已复制
Hopefully the => operator in Fortran does what I think, which is to copy a pointer only and not its contents. In this code, only the line ALLOCATE(SharedDataChunks(arrayPos)%ptr) should actually allocate an instance of SharedDataChunk.
Yes, that is what => is for - it associates the pointer on the lefthand side with the righthand side.
But I do not get your remark about ALLOCATED() not working on arrays. Can you elaborate?
In theory line 72 instead of this:
IF (SharedDataChunksAllocated(id)) THEN
DEALLOCATE(SharedDataChunks(id)%ptr)
SharedDataChunksAllocated(id) = .FALSE.
ENDIFCould be:
IF (ALLOCATED(SharedDataChunks(id)%ptr)) THEN
DEALLOCATE(SharedDataChunks(id)%ptr)
SharedDataChunksAllocated(id) = .FALSE.
ENDIFBut that makes the compiler very unhappy, erroneously so in my opinion:
ifort.exe @kbclib.fcf ..\kbclibv2\FortranSource\instdata.f90
..\kbclibv2\FortranSource\instdata.f90(73): error #7397: The argument of the ALLOCATED inquiry intrinsic function should have the ALLOCATABLE attribute. [PTR]
IF (ALLOCATED(SharedDataChunks(id)%ptr)) THEN
-------------------------------------^
..\kbclibv2\FortranSource\instdata.f90(73): error #6547: The ARRAY argument of the ALLOCATED inquiry intrinsic function shall be an allocatable array. [PTR]
IF (ALLOCATED(SharedDataChunks(id)%ptr)) THEN
-------------------------------------^And you cannot declare that pointer allocatable either. But the code I have posted seems to nicely avoid this. The ALLOCATE and DEALLOCATE calls are happy to accept array arguments and seem to do the right thing.
Ah, but the component ptr is a pointer, not an allocatable. You need to use the ASSOCIATED() function instead.
Thank you, I did not know that! However, it crashes if that is used instead.
