Skip to content

Commit

Permalink
Fix C->Fortran handover of LocalArray objects.
Browse files Browse the repository at this point in the history
  • Loading branch information
@theurich
theurich committed Oct 23, 2023
1 parent dbfec2f commit 29a503b
Showing 1 changed file with 48 additions and 22 deletions.
70 changes: 48 additions & 22 deletions src/Infrastructure/LocalArray/interface/ESMF_LocalArray_C.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,7 @@

#undef ESMF_METHOD
#define ESMF_METHOD "f_esmf_localarrayf90allocate"
subroutine f_esmf_localarrayf90allocate(array, rank, typekind, counts, &
subroutine f_esmf_localarrayf90allocate(arrayPtr, rank, typekind, counts, &
lbounds, ubounds, rc)
use ESMF_UtilTypesMod ! ESMF base class
use ESMF_BaseMod ! ESMF base class
Expand All @@ -39,50 +39,60 @@ subroutine f_esmf_localarrayf90allocate(array, rank, typekind, counts, &

implicit none

type(ESMF_LocalArray) :: array
type(ESMF_Pointer) :: arrayPtr
integer :: rank
type(ESMF_TypeKind_Flag) :: typekind
integer :: counts(rank)
integer :: lbounds(rank)
integer :: ubounds(rank)
integer :: rc

type(ESMF_LocalArray) :: array

array%this = arrayPtr
ESMF_INIT_SET_CREATED(array)

! Beware - these args are not in the same order
call ESMF_LocalArrConstrF90Ptr(array, counts, typekind, rank, &
lbounds, ubounds, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT)) return

end subroutine f_esmf_localarrayf90allocate


#undef ESMF_METHOD
#define ESMF_METHOD "f_esmf_localarrayf90deallocate"
subroutine f_esmf_localarrayf90deallocate(array, rank, typekind, rc)
subroutine f_esmf_localarrayf90deallocate(arrayPtr, rank, typekind, rc)
use ESMF_UtilTypesMod ! ESMF base class
use ESMF_BaseMod ! ESMF base class
use ESMF_LogErrMod ! ESMF error logging
use ESMF_LocalArrayMod

implicit none

type(ESMF_LocalArray) :: array
type(ESMF_Pointer) :: arrayPtr
integer :: rank
type(ESMF_TypeKind_Flag) :: typekind
integer :: rc

type(ESMF_LocalArray) :: array

array%this = arrayPtr
ESMF_INIT_SET_CREATED(array)

call ESMF_LocalArrayF90Deallocate(array, typekind, rank, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT)) return

end subroutine f_esmf_localarrayf90deallocate


#undef ESMF_METHOD
#define ESMF_METHOD "f_esmf_localarrayadjust"
subroutine f_esmf_localarrayadjust(array, rank, typekind, counts, &
subroutine f_esmf_localarrayadjust(arrayPtr, rank, typekind, counts, &
lbounds, ubounds, rc)
use ESMF_UtilTypesMod ! ESMF base class
use ESMF_BaseMod ! ESMF base class
Expand All @@ -91,26 +101,31 @@ subroutine f_esmf_localarrayadjust(array, rank, typekind, counts, &

implicit none

type(ESMF_LocalArray) :: array
type(ESMF_Pointer) :: arrayPtr
integer :: rank
type(ESMF_TypeKind_Flag) :: typekind
integer :: counts(rank)
integer :: lbounds(rank)
integer :: ubounds(rank)
integer :: rc

type(ESMF_LocalArray) :: array

array%this = arrayPtr
ESMF_INIT_SET_CREATED(array)

call ESMF_LocalArrayAdjust(array, counts, typekind, rank, &
lbounds, ubounds,rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT)) return

end subroutine f_esmf_localarrayadjust


#undef ESMF_METHOD
#define ESMF_METHOD "f_esmf_localarrayslice"
subroutine f_esmf_localarrayslice(array, trailingTensorSlice, rankIn, rankOut, rc)
subroutine f_esmf_localarrayslice(arrayPtr, trailingTensorSlice, rankIn, rankOut, rc)
use ESMF_UtilTypesMod ! ESMF base class
use ESMF_BaseMod ! ESMF base class
use ESMF_LogErrMod ! ESMF error logging
Expand All @@ -119,31 +134,38 @@ subroutine f_esmf_localarrayslice(array, trailingTensorSlice, rankIn, rankOut, r

implicit none

type(ESMF_LocalArray) :: array
type(ESMF_Pointer) :: arrayPtr
type(ESMF_InterArray) :: trailingTensorSlice
integer :: rankIn, rankOut
integer :: rc

type(ESMF_LocalArray) :: array

array%this = arrayPtr ! the incoming LocalArray
ESMF_INIT_SET_CREATED(array)

call ESMF_LocalArraySlice(array, trailingTensorSlice, rankIn, rankOut, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT)) return

arrayPtr = array%this ! the outgoing LocalArray

end subroutine f_esmf_localarrayslice


#undef ESMF_METHOD
#define ESMF_METHOD "f_esmf_localarraycopyf90ptr"
subroutine f_esmf_localarraycopyf90ptr(arrayInArg, arrayOutArg, datacopyflag, rc)
subroutine f_esmf_localarraycopyf90ptr(arrayInPtr, arrayOutPtr, datacopyflag, rc)
use ESMF_UtilTypesMod ! ESMF base class
use ESMF_BaseMod ! ESMF base class
use ESMF_LogErrMod ! ESMF error logging
use ESMF_LocalArrayMod

implicit none

type(ESMF_LocalArray) :: arrayInArg
type(ESMF_LocalArray) :: arrayOutArg
type(ESMF_Pointer) :: arrayInPtr
type(ESMF_Pointer) :: arrayOutPtr
type(ESMF_DataCopy_Flag) :: datacopyflag
integer :: rc

Expand All @@ -157,12 +179,11 @@ subroutine f_esmf_localarraycopyf90ptr(arrayInArg, arrayOutArg, datacopyflag, rc
! F90 variables are necessary to work on the F90 side and this glue code will
! copy the "this" member in the derived type which is the part that actually
! needs to be passed between C and F90.

arrayIn%this = arrayInArg%this ! only access "this" member
! need to set the valid init code

arrayIn%this = arrayInPtr
ESMF_INIT_SET_CREATED(arrayIn)
arrayOut%this = arrayOutArg%this ! only access "this" member

arrayOut%this = arrayOutPtr

! do the actual copy, allocating the required memory
call ESMF_LocalArrayCopyF90Ptr(arrayIn, arrayOut, datacopyflag=datacopyflag, &
Expand All @@ -176,7 +197,7 @@ end subroutine f_esmf_localarraycopyf90ptr

#undef ESMF_METHOD
#define ESMF_METHOD "f_esmf_localarrayctof90"
subroutine f_esmf_localarrayctof90(array, cptr, rank, typekind, counts, &
subroutine f_esmf_localarrayctof90(arrayPtr, cptr, rank, typekind, counts, &
lbounds, ubounds, rc)
use ESMF_UtilTypesMod ! ESMF base class
use ESMF_BaseMod ! ESMF base class
Expand All @@ -186,7 +207,7 @@ subroutine f_esmf_localarrayctof90(array, cptr, rank, typekind, counts, &

implicit none

type(ESMF_LocalArray) :: array
type(ESMF_Pointer) :: arrayPtr
type(C_PTR) :: cptr
integer :: rank
type(ESMF_TypeKind_Flag) :: typekind
Expand All @@ -195,11 +216,16 @@ subroutine f_esmf_localarrayctof90(array, cptr, rank, typekind, counts, &
integer :: ubounds(rank)
integer :: rc

type(ESMF_LocalArray) :: array

array%this = arrayPtr
ESMF_INIT_SET_CREATED(array)

! Beware - these args are not in the same order
call ESMF_LocalArrCToF90Ptr(array, cptr, counts, typekind, rank, &
lbounds, ubounds, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT)) return

end subroutine f_esmf_localarrayctof90

0 comments on commit 29a503b

Please sign in to comment.