Dynamic array of user defined types

[Ben136KBC]

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.

[Ben136KBC]

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.

[Arjen_Markus]

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?

[Ben136KBC]

In theory line 72 instead of this:

  IF (SharedDataChunksAllocated(id)) THEN
    DEALLOCATE(SharedDataChunks(id)%ptr)
    SharedDataChunksAllocated(id) = .FALSE.
  ENDIF

Could be:

  IF (ALLOCATED(SharedDataChunks(id)%ptr)) THEN
    DEALLOCATE(SharedDataChunks(id)%ptr)
    SharedDataChunksAllocated(id) = .FALSE.
  ENDIF

But 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.

[Arjen_Markus]

Ah, but the component ptr is a pointer, not an allocatable. You need to use the ASSOCIATED() function instead.

[Ben136KBC]

Thank you, I did not know that! However, it crashes if that is used instead.