From 29a503bb7f1deb16b69fe2c250735c5e39ffec90 Mon Sep 17 00:00:00 2001 From: Gerhard Theurich Date: Mon, 23 Oct 2023 19:39:17 +0000 Subject: [PATCH] Fix C->Fortran handover of LocalArray objects. --- .../interface/ESMF_LocalArray_C.F90 | 70 +++++++++++++------ 1 file changed, 48 insertions(+), 22 deletions(-) diff --git a/src/Infrastructure/LocalArray/interface/ESMF_LocalArray_C.F90 b/src/Infrastructure/LocalArray/interface/ESMF_LocalArray_C.F90 index e7a96527cb..eae4873598 100644 --- a/src/Infrastructure/LocalArray/interface/ESMF_LocalArray_C.F90 +++ b/src/Infrastructure/LocalArray/interface/ESMF_LocalArray_C.F90 @@ -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 @@ -39,7 +39,7 @@ 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) @@ -47,19 +47,24 @@ subroutine f_esmf_localarrayf90allocate(array, 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_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 @@ -67,22 +72,27 @@ subroutine f_esmf_localarrayf90deallocate(array, rank, typekind, rc) 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 @@ -91,7 +101,7 @@ 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) @@ -99,18 +109,23 @@ subroutine f_esmf_localarrayadjust(array, rank, typekind, counts, & 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 @@ -119,22 +134,29 @@ 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 @@ -142,8 +164,8 @@ subroutine f_esmf_localarraycopyf90ptr(arrayInArg, arrayOutArg, datacopyflag, rc 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 @@ -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, & @@ -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 @@ -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 @@ -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