gatherFracFieldMesh Subroutine

private subroutine gatherFracFieldMesh(mesh, VM, fracField, petNo, petCnt, frac, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_Mesh) :: mesh
type(ESMF_VM) :: VM
type(ESMF_Field) :: fracField
integer :: petNo
integer :: petCnt
real(kind=ESMF_KIND_R8), pointer :: frac(:)
integer :: rc

Calls

proc~~gatherfracfieldmesh~~CallsGraph proc~gatherfracfieldmesh gatherFracFieldMesh esmf_fieldget esmf_fieldget proc~gatherfracfieldmesh->esmf_fieldget interface~esmf_vmgather ESMF_VMGather proc~gatherfracfieldmesh->interface~esmf_vmgather interface~esmf_vmgatherv ESMF_VMGatherV proc~gatherfracfieldmesh->interface~esmf_vmgatherv proc~esmf_vmgatherflogical2d ESMF_VMGatherFLogical2D interface~esmf_vmgather->proc~esmf_vmgatherflogical2d proc~esmf_vmgatheri4 ESMF_VMGatherI4 interface~esmf_vmgather->proc~esmf_vmgatheri4 proc~esmf_vmgatheri8 ESMF_VMGatherI8 interface~esmf_vmgather->proc~esmf_vmgatheri8 proc~esmf_vmgatherlogical ESMF_VMGatherLogical interface~esmf_vmgather->proc~esmf_vmgatherlogical proc~esmf_vmgatherr4 ESMF_VMGatherR4 interface~esmf_vmgather->proc~esmf_vmgatherr4 proc~esmf_vmgatherr8 ESMF_VMGatherR8 interface~esmf_vmgather->proc~esmf_vmgatherr8 proc~esmf_vmgathervi4 ESMF_VMGatherVI4 interface~esmf_vmgatherv->proc~esmf_vmgathervi4 proc~esmf_vmgathervi8 ESMF_VMGatherVI8 interface~esmf_vmgatherv->proc~esmf_vmgathervi8 proc~esmf_vmgathervr4 ESMF_VMGatherVR4 interface~esmf_vmgatherv->proc~esmf_vmgathervr4 proc~esmf_vmgathervr8 ESMF_VMGatherVR8 interface~esmf_vmgatherv->proc~esmf_vmgathervr8 interface~c_esmc_vmgather c_ESMC_VMGather proc~esmf_vmgatherflogical2d->interface~c_esmc_vmgather interface~c_esmc_vmgathernb c_ESMC_VMGatherNB proc~esmf_vmgatherflogical2d->interface~c_esmc_vmgathernb proc~esmf_imerr ESMF_IMErr proc~esmf_vmgatherflogical2d->proc~esmf_imerr proc~esmf_logfounderror ESMF_LogFoundError proc~esmf_vmgatherflogical2d->proc~esmf_logfounderror proc~esmf_vmgetinit ESMF_VMGetInit proc~esmf_vmgatherflogical2d->proc~esmf_vmgetinit proc~esmf_vmgatheri4->interface~c_esmc_vmgather proc~esmf_vmgatheri4->interface~c_esmc_vmgathernb proc~esmf_vmgatheri4->proc~esmf_imerr proc~esmf_vmgatheri4->proc~esmf_logfounderror proc~esmf_vmgatheri4->proc~esmf_vmgetinit proc~esmf_vmgatheri8->interface~c_esmc_vmgather proc~esmf_vmgatheri8->interface~c_esmc_vmgathernb proc~esmf_vmgatheri8->proc~esmf_imerr proc~esmf_vmgatheri8->proc~esmf_logfounderror proc~esmf_vmgatheri8->proc~esmf_vmgetinit proc~esmf_vmgatherlogical->interface~c_esmc_vmgather proc~esmf_vmgatherlogical->interface~c_esmc_vmgathernb proc~esmf_vmgatherlogical->proc~esmf_imerr proc~esmf_vmgatherlogical->proc~esmf_logfounderror proc~esmf_vmgatherlogical->proc~esmf_vmgetinit proc~esmf_vmgatherr4->interface~c_esmc_vmgather proc~esmf_vmgatherr4->interface~c_esmc_vmgathernb proc~esmf_vmgatherr4->proc~esmf_imerr proc~esmf_vmgatherr4->proc~esmf_logfounderror proc~esmf_vmgatherr4->proc~esmf_vmgetinit proc~esmf_vmgatherr8->interface~c_esmc_vmgather proc~esmf_vmgatherr8->interface~c_esmc_vmgathernb proc~esmf_vmgatherr8->proc~esmf_imerr proc~esmf_vmgatherr8->proc~esmf_logfounderror proc~esmf_vmgatherr8->proc~esmf_vmgetinit interface~c_esmc_vmgatherv c_ESMC_VMGatherV proc~esmf_vmgathervi4->interface~c_esmc_vmgatherv proc~esmf_vmgathervi4->proc~esmf_imerr proc~esmf_vmgathervi4->proc~esmf_logfounderror proc~esmf_vmgathervi4->proc~esmf_vmgetinit proc~esmf_vmgathervi8->interface~c_esmc_vmgatherv proc~esmf_vmgathervi8->proc~esmf_imerr proc~esmf_vmgathervi8->proc~esmf_logfounderror proc~esmf_vmgathervi8->proc~esmf_vmgetinit proc~esmf_vmgathervr4->interface~c_esmc_vmgatherv proc~esmf_vmgathervr4->proc~esmf_imerr proc~esmf_vmgathervr4->proc~esmf_logfounderror proc~esmf_vmgathervr4->proc~esmf_vmgetinit proc~esmf_vmgathervr8->interface~c_esmc_vmgatherv proc~esmf_vmgathervr8->proc~esmf_imerr proc~esmf_vmgathervr8->proc~esmf_logfounderror proc~esmf_vmgathervr8->proc~esmf_vmgetinit proc~esmf_imerr->proc~esmf_logfounderror proc~esmf_initcheckdeep ESMF_InitCheckDeep proc~esmf_imerr->proc~esmf_initcheckdeep esmf_breakpoint esmf_breakpoint proc~esmf_logfounderror->esmf_breakpoint proc~esmf_logrc2msg ESMF_LogRc2Msg proc~esmf_logfounderror->proc~esmf_logrc2msg proc~esmf_logwrite ESMF_LogWrite proc~esmf_logfounderror->proc~esmf_logwrite

Source Code

subroutine gatherFracFieldMesh(mesh, vm, fracField, petNo, petCnt, frac, rc)
  type(ESMF_Mesh) :: mesh
  type(ESMF_VM) :: VM
  integer :: petNo,petCnt
  type(ESMF_Field) :: fracField
  real (ESMF_KIND_R8), pointer :: frac(:)
  integer :: rc
  real (ESMF_KIND_R8), pointer :: localFrac(:)
  real (ESMF_KIND_R8), pointer :: mergedFrac(:)
  integer :: localrc
  integer :: localElemCount,i
  integer (ESMF_KIND_I4) :: localCount(1)
  integer (ESMF_KIND_I4),pointer :: globalCount(:),globalDispl(:)
  integer :: totalCount

  ! Get localFrac from field
  call ESMF_FieldGet(fracField, localDE=0, farrayPtr=localFrac,  rc=localrc)
  if (localrc /=ESMF_SUCCESS) then
     rc=localrc
     return
  endif

  localElemCount=size(localFrac)
  ! localFrac is gotten from the fracField above

  ! Allocate List of counts
  allocate(globalCount(petCnt))

  ! Get List of counts
  localCount(1)=localElemCount
  call ESMF_VMGather(vm,localCount,globalCount,count=1,rootPet=0,rc=localrc)
  if (localrc /=ESMF_SUCCESS) then
     rc=localrc
     return
  endif

  ! Calculate Displacements
  allocate(globalDispl(petCnt))
  if (petNo==0) then
     globalDispl(1)=0
     do i=2,petCnt
        globalDispl(i)=globalDispl(i-1)+globalCount(i-1)
     enddo
  else
     globalDispl=0
  endif


  ! Sum size
  if (petNo==0) then
     totalCount=0
     do i=1,petCnt
        totalCount=totalCount+globalCount(i)
     enddo
  else
     totalCount=1 ! Because I'm not sure what happens
     ! if array is not allocated in VM
  endif

  ! Allocate final area list
  allocate(frac(totalCount))

  ! Gather all areas
  call ESMF_VMGatherV(vm,sendData=localFrac, sendCount=localElemCount,&
       recvData=frac,recvCounts=globalCount,recvOffsets=globalDispl,&
       rootPet=0, rc=localrc)
  if (localrc /=ESMF_SUCCESS) then
     rc=localrc
     return
  endif

  deallocate(globalCount)
  deallocate(globalDispl)
  if (petNo .ne. 0) deallocate(frac)

end subroutine gatherFracFieldMesh