! $Id: ESMF_ArrayScatter.cppF90,v 1.32 2011/06/30 21:30:51 theurich Exp $ ! ! Earth System Modeling Framework ! Copyright 2002-2011, University Corporation for Atmospheric Research, ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics ! Laboratory, University of Michigan, National Centers for Environmental ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, ! NASA Goddard Space Flight Center. ! Licensed under the University of Illinois-NCSA License. ! !============================================================================== ^define ESMF_FILENAME "ESMF_ArrayScatter.F90" !============================================================================== #if 0 !============================================================================== ! TKR overloading macros #endif #include "ESMF_TypeKindRankMacros.hcppF90" !============================================================================== ! ESMF ArrayScatter module module ESMF_ArrayScatterMod ! !============================================================================== ! ! This file contains the ArrayScatter() methods. ! !------------------------------------------------------------------------------ ! INCLUDES ^include "ESMF.h" !------------------------------------------------------------------------------ !BOPI ! !MODULE: ESMF_ArrayScatterMod - Provide TKR overloading for ESMF_ArrayScatter() ! ! !DESCRIPTION: ! ! The code in this file is part of the {\tt ESMF\_Array} class Fortran API. ! ! !------------------------------------------------------------------------------ ! !USES: use ESMF_UtilTypesMod ! ESMF utility types use ESMF_InitMacrosMod ! ESMF initializer macros use ESMF_BaseMod ! ESMF base class use ESMF_LogErrMod ! ESMF error handling use ESMF_LocalArrayMod use ESMF_ArraySpecMod use ESMF_VMMod use ESMF_DELayoutMod use ESMF_DistGridMod use ESMF_RHandleMod use ESMF_F90InterfaceMod ! ESMF Fortran-C++ interface helper ! class sub modules use ESMF_ArrayCreateMod ! contains the ESMF_Array derived type definition use ESMF_ArrayGetMod implicit none private !------------------------------------------------------------------------------ ! ! !PUBLIC MEMBER FUNCTIONS: ! - ESMF-public methods: public ESMF_ArrayScatter !EOPI !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ ! The following line turns the CVS identifier string into a printable variable. character(*), parameter, private :: version = & '$Id: ESMF_ArrayScatter.cppF90,v 1.32 2011/06/30 21:30:51 theurich Exp $' !============================================================================== ! ! INTERFACE BLOCKS ! !============================================================================== ! -------------------------- ESMF-public method ------------------------------- !BOPI ! !IROUTINE: ESMF_ArrayScatter -- Generic interface ! !INTERFACE: interface ESMF_ArrayScatter ! !PRIVATE MEMBER FUNCTIONS: ! TypeKindRankInterfaceMacro(ArrayScatter) module procedure ESMF_ArrayScatterNotRoot module procedure ESMF_ArrayScatterB !1st prototype module procedure ESMF_ArrayScatterNBRoot !1st prototype module procedure ESMF_ArrayScatterNB !1st prototype ! !DESCRIPTION: ! This interface provides a single entry point for the various ! types of {\tt ESMF\_ArrayScatter} functions. !EOPI end interface !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !=============================================================================== ! ArrayScatter() interfaces !=============================================================================== #define ArrayScatterDoc() \ ! -------------------------- ESMF-public method ----------------------------- @\ !BOP @\ ! @\ ! !IROUTINE: ESMF_ArrayScatter - Scatter a Fortran array across the ESMF_Array @\ ! @\ ! !INTERFACE: @\ ! subroutine ESMF_ArrayScatter(array, farray, rootPet, tile, vm, rc) @\ ! @\ ! !ARGUMENTS: @\ ! type(ESMF_Array), intent(inout) :: array @\ ! (ESMF_KIND_), intent(in), target :: farray() @\ ! integer, intent(in) :: rootPet @\ ! type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below @\ ! integer, intent(in), optional :: tile @\ ! type(ESMF_VM), intent(in), optional :: vm @\ ! integer, intent(out), optional :: rc @\ ! @\ ! !STATUS: @\ ! \apiStatusCompatible @\ ! @\ ! !DESCRIPTION: @\ ! Scatter the data of {\tt farray} located on {\tt rootPET} @\ ! across an {ESMF\_Array} object. A single {\tt farray} must be @\ ! scattered across a single DistGrid tile in Array. The optional {\tt tile} @\ ! argument allows selection of the tile. For Arrays defined on a single @\ ! tile DistGrid the default selection (tile 1) will be correct. The @\ ! shape of {\tt farray} must match the shape of the tile in Array. @\ ! @\ ! If the Array contains replicating DistGrid dimensions data will be @\ ! scattered across all of the replicated pieces. @\ ! @\ ! This version of the interface implements the PET-based blocking paradigm: @\ ! Each PET of the VM must issue this call exactly once for {\em all} of its @\ ! DEs. The call will block until all PET-local data objects are accessible. @\ ! @\ ! The arguments are: @\ ! \begin{description} @\ ! \item[array] @\ ! The {\tt ESMF\_Array} object across which data will be scattered. @\ ! \item[\{farray\}] @\ ! The Fortran array that is to be scattered. Only root @\ ! must provide a valid {\tt farray}, the other PETs may treat @\ ! {\tt farray} as an optional argument. @\ ! \item[rootPet] @\ ! PET that holds the valid data in {\tt farray}. @\ ! \item[{[tile]}] @\ ! The DistGrid tile in {\tt array} into which to scatter {\tt farray}. @\ ! By default {\tt farray} will be scattered into tile 1. @\ ! \item[{[vm]}] @\ ! Optional {\tt ESMF\_VM} object of the current context. Providing the @\ ! VM of the current context will lower the method|s overhead. @\ ! \item[{[rc]}] @\ ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. @\ ! \end{description} @\ ! @\ !EOP @\ !---------------------------------------------------------------------------- @\ #define ArrayScatterMacro(mtype, mtypekind, mrank, mdim, mlen, mrng, mloc) \ ! -------------------------- ESMF-public method ----------------------------- @\ ^undef ESMF_METHOD @\ ^define ESMF_METHOD "ESMF_ArrayScatter" @\ subroutine ESMF_ArrayScatter##mrank##D##mtypekind(array, farray, rootPet, & @\ keywordEnforcer, tile, vm, rc) @\ @\ type(ESMF_Array), intent(inout) :: array @\ mtype (ESMF_KIND_##mtypekind),dimension(mdim),intent(in),target :: farray @\ integer, intent(in) :: rootPet @\ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below @\ integer, intent(in), optional :: tile @\ type(ESMF_VM), intent(in), optional :: vm @\ integer, intent(out), optional :: rc @\ @\ ! Local variables @\ integer :: localrc ! local return code @\ integer :: counts(mrank) ! counts vector @\ integer :: lb(mrank) ! lb vector @\ integer :: i, localPet, count @\ type(ESMF_VM) :: vm_opt @\ mtype (ESMF_KIND_##mtypekind),dimension(mdim),pointer :: fptr @\ mtype (ESMF_KIND_##mtypekind),dimension(mdim),allocatable :: farray_dummy @\ @\ ! Initialize return code @\ localrc = ESMF_RC_NOT_IMPL @\ if (present(rc)) rc = ESMF_RC_NOT_IMPL @\ @\ ! Check init status of arguments @\ ESMF_INIT_CHECK_DEEP(ESMF_ArrayGetInit, array, rc) @\ ESMF_INIT_CHECK_DEEP(ESMF_VMGetInit, vm, rc) @\ @\ ! Obtain localPet @\ if (present(vm)) then @\ vm_opt = vm @\ else @\ call ESMF_VMGetCurrent(vm_opt, rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ endif @\ call ESMF_VMGet(vm_opt, localPet=localPet, rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ @\ if (localPet==rootPet) then @\ ! rootPet -> prepare counts vector @\ ! The following use of fptr is a bit of trickery to get all Fortran @\ ! compilers to cooperate. For some compilers the associated() test @\ ! will return .false. for farray of size 0. Some of those compilers @\ ! will produce a run-time error in size(fptr). Other compilers will @\ ! return .true. for the associated() test but return 0 in size(). @\ fptr => farray @\ if (associated(fptr,farray)) then @\ count = 1 ! initialize @\ do i=1, mrank @\ counts(i) = size(fptr, i) @\ count = count * counts(i) @\ enddo @\ else @\ count = 0 @\ endif @\ ! Since farray is an assumed shape dummy array the lower bounds in all @\ ! dimensions will start at 1 following the Fortran 90 standard. @\ lb = 1 ! @\ ! Call into the C++ interface, which will sort out optional arguments @\ if (count > 0) then @\ ! it is safe to use dummy argument farray @\ call c_ESMC_ArrayScatter(array, farray(mloc), & @\ ESMF_TYPEKIND_##mtypekind, mrank, counts, tile, rootPet, vm, & @\ localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ else @\ ! it is unsafe to use dummy argument farray @\ allocate(farray_dummy(mloc)) ! allocate a single element @\ call c_ESMC_ArrayScatter(array, farray_dummy(mloc), & @\ ESMF_TYPEKIND_##mtypekind, mrank, counts, tile, rootPet, vm, & @\ localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ deallocate(farray_dummy) @\ endif @\ else @\ ! not rootPet -> call through notRoot interface @\ call ESMF_ArrayScatter(array=array, tile=tile, rootPet=rootPet, & @\ vm=vm, rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ endif @\ @\ ! Return successfully @\ if (present(rc)) rc = ESMF_SUCCESS @\ @\ end subroutine ESMF_ArrayScatter##mrank##D##mtypekind @\ !---------------------------------------------------------------------------- @\ TypeKindRankDeclarationMacro(ArrayScatter) ! -------------------------- ESMF-public method ----------------------------- ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_ArrayScatter" subroutine ESMF_ArrayScatterNotRoot(array, rootPet, keywordEnforcer, tile, & vm, rc) type(ESMF_Array), intent(inout) :: array integer, intent(in) :: rootPet type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below integer, intent(in), optional :: tile type(ESMF_VM), intent(in), optional :: vm integer, intent(out), optional :: rc ! Local variables integer :: localrc ! local return code ! Initialize return code localrc = ESMF_RC_NOT_IMPL if (present(rc)) rc = ESMF_RC_NOT_IMPL ! Check init status of arguments ESMF_INIT_CHECK_DEEP(ESMF_ArrayGetInit, array, rc) ESMF_INIT_CHECK_DEEP(ESMF_VMGetInit, vm, rc) ! Call into the C++ interface, which will sort out optional arguments call c_ESMC_ArrayScatterNotRoot(array, tile, rootPet, vm, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Return successfully if (present(rc)) rc = ESMF_SUCCESS end subroutine ESMF_ArrayScatterNotRoot !---------------------------------------------------------------------------- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!! old-style newArray calls of 1st prototype calls !!!!!!!!!!!!!!!!! ! -------------------------- ESMF-public method ------------------------------- ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_ArrayScatterB()" !BOPI ! !IROUTINE: ESMF_ArrayScatter - Scatter a LocalArray across Array ! !INTERFACE: ! Private name; call using ESMF_ArrayScatter() subroutine ESMF_ArrayScatterB(array, larray, rootPET, vm, rc) ! ! !ARGUMENTS: type(ESMF_Array), intent(inout) :: array type(ESMF_LocalArray), intent(in) :: larray integer, intent(in) :: rootPET type(ESMF_VM), intent(in), optional :: vm integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Scatter the data of an {\tt ESMF\_LocalArray} located on {\tt rootPET} ! across an {ESMF\_Array} object. This version of the interface ! implements the PET-based blocking paradigm: Each PET of the VM must issue ! this call exactly once for {\em all} of its DEs. The call is ! PET-collective, meaning that all PETs must issue the call regardless ! whether {\tt array}|s DELayout associates DEs with a PET or not. The ! call will block until all PET-local data objects are accessible. ! ! The arguments are: ! \begin{description} ! \item[array] ! The {\tt ESMF\_Array} object across which data will be scattered. ! \item[{[larray]}] ! The {\tt ESMF\_LocalArray} object that is to be scattered. Only root ! must provide a valid larray. ! \item[rootPET] ! PET that holds the valid data in {\tt larray}. ! \item[{[vm]}] ! Optional {\tt ESMF\_VM} object of the current context. Providing the ! VM of the current context will lower the method|s overhead. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc ! local return code ! Assume failure until success if (present(rc)) rc = ESMF_RC_NOT_IMPL localrc = ESMF_RC_NOT_IMPL ! Call into the C++ interface, which will sort out optional arguments. ! call c_ESMC_ArrayScatterB(array, larray, rootPET, vm, localrc) ! Use LogErr to handle return code if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return end subroutine ESMF_ArrayScatterB !------------------------------------------------------------------------------ ! -------------------------- ESMF-public method ------------------------------- ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_ArrayScatterNBRoot()" !BOPI ! !IROUTINE: ESMF_ArrayScatter - Scatter a LocalArray across Array ! !INTERFACE: ! Private name; call using ESMF_ArrayScatter() subroutine ESMF_ArrayScatterNBRoot(array, larray, rootPET, commhandle, & vm, rc) ! ! !ARGUMENTS: type(ESMF_Array), intent(inout) :: array type(ESMF_LocalArray), intent(in), optional :: larray integer, intent(in) :: rootPET type(ESMF_CommHandle), intent(inout) :: commhandle type(ESMF_VM), intent(in), optional :: vm integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Scatter the data of an {\tt ESMF\_LocalArray} located on {\tt rootPET} ! across an {ESMF\_Array} object. This version of the interface ! implements the DE-based non-blocking paradigm. ! Although only {\tt rootPET} {\em must} issue this call, it is no error ! for other PETs to also call this routine. However, only {\tt rootPET} ! will receive a valid {\tt commhandle} which can be used in ! {\tt ESMF\_ArrayWait} to ensure that access to {\tt larray} is ! safe again. ! ! The arguments are: ! \begin{description} ! \item[array] ! The {\tt ESMF\_Array} object across which data will be scattered. ! \item[{[larray]}] ! The {\tt ESMF\_LocalArray} object that is to be scattered. Only root ! must provide a valid larray. ! \item[rootPET] ! PET that holds the valid data in {\tt larray}. ! \item[commhandle] ! Upon return {\tt commhandle} on {\tt rootPET} holds the ! {\tt ESMF\_CommHandle} associated with the non-blocking scatter ! operation. ! \item[{[vm]}] ! Optional {\tt ESMF\_VM} object of the current context. Providing the ! VM of the current context will lower the method|s overhead. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc ! local return code ! Assume failure until success if (present(rc)) rc = ESMF_RC_NOT_IMPL localrc = ESMF_RC_NOT_IMPL ! Call into the C++ interface, which will sort out optional arguments. ! call c_ESMC_ArrayScatterNBRoot(array, larray, rootPET, commhandle, vm,& ! localrc) ! Use LogErr to handle return code if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return end subroutine ESMF_ArrayScatterNBRoot !------------------------------------------------------------------------------ ! -------------------------- ESMF-public method ------------------------------- ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_ArrayScatterNB()" !BOPI ! !IROUTINE: ESMF_ArrayScatter - Scatter a LocalArray across Array ! !INTERFACE: ! Private name; call using ESMF_ArrayScatter() subroutine ESMF_ArrayScatterNB(array, larray, rootPET, de, vm, rc) ! ! !ARGUMENTS: type(ESMF_Array), intent(inout) :: array type(ESMF_LocalArray), intent(in) :: larray integer, intent(in) :: rootPET integer, intent(in) :: de type(ESMF_VM), intent(in), optional :: vm integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Scatter the data of an {\tt ESMF\_LocalArray} located on {\tt rootPET} ! across an {ESMF\_Array} object. This version of the interface ! implements the DE-based non-blocking paradigm. ! Each PET must issue this call once for {\em each} of its DEs. The call ! is non-blocking and will return immediatly. Use {\tt ESMF\_ArrayWait} ! to wait for the completion on a specific DE. No {\tt ESMF\_CommHandle} is ! necessary for the per DE-synchronization because the {\tt array} variable ! holds all required information and it is not allowed to have more than ! one pending communication call per DE per Array. ! ! The arguments are: ! \begin{description} ! \item[array] ! The {\tt ESMF\_Array} object across which data will be scattered. ! \item[{[larray]}] ! The {\tt ESMF\_LocalArray} object that is to be scattered. Only root ! must provide a valid larray. ! \item[rootPET] ! PET that holds the valid data in {\tt larray}. ! \item[de] ! DE for which this call is issued. ! \item[{[vm]}] ! Optional {\tt ESMF\_VM} object of the current context. Providing the ! VM of the current context will lower the method|s overhead. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc ! local return code ! Assume failure until success if (present(rc)) rc = ESMF_RC_NOT_IMPL localrc = ESMF_RC_NOT_IMPL ! Call into the C++ interface, which will sort out optional arguments. ! call c_ESMC_ArrayScatterNB(array, larray, rootPET, de, vm, localrc) ! Use LogErr to handle return code if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return end subroutine ESMF_ArrayScatterNB !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ end module ESMF_ArrayScatterMod