latlon_zmean Subroutine

subroutine latlon_zmean(q, qz, undef, grid, rc)

Arguments

Type IntentOptional Attributes Name
real, intent(inout) :: q(:,:)
real, intent(inout) :: qz(:)
real, intent(in) :: undef
type(ESMF_Grid), intent(inout) :: grid
integer, intent(out), optional :: rc

Calls

proc~~latlon_zmean~~CallsGraph proc~latlon_zmean latlon_zmean ESMF_VMGet ESMF_VMGet proc~latlon_zmean->ESMF_VMGet ESMF_VMGetCurrent ESMF_VMGetCurrent proc~latlon_zmean->ESMF_VMGetCurrent interface~mapl_grid_interior MAPL_GRID_INTERIOR proc~latlon_zmean->interface~mapl_grid_interior mpi_recv mpi_recv proc~latlon_zmean->mpi_recv mpi_send mpi_send proc~latlon_zmean->mpi_send proc~get_esmf_grid_layout get_esmf_grid_layout proc~latlon_zmean->proc~get_esmf_grid_layout proc~mapl_abort MAPL_abort proc~latlon_zmean->proc~mapl_abort proc~mapl_gridget MAPL_GridGet proc~latlon_zmean->proc~mapl_gridget proc~mapl_verify MAPL_Verify proc~latlon_zmean->proc~mapl_verify proc~get_esmf_grid_layout->ESMF_VMGet proc~get_esmf_grid_layout->ESMF_VMGetCurrent proc~get_esmf_grid_layout->proc~mapl_abort proc~get_esmf_grid_layout->proc~mapl_verify ESMF_GridGet ESMF_GridGet proc~get_esmf_grid_layout->ESMF_GridGet proc~mapl_distgridget MAPL_DistGridGet proc~get_esmf_grid_layout->proc~mapl_distgridget proc~mapl_getimsjms MAPL_GetImsJms proc~get_esmf_grid_layout->proc~mapl_getimsjms mpi_abort mpi_abort proc~mapl_abort->mpi_abort proc~mapl_gridget->proc~mapl_verify ESMF_AttributeGet ESMF_AttributeGet proc~mapl_gridget->ESMF_AttributeGet ESMF_DistGridGet ESMF_DistGridGet proc~mapl_gridget->ESMF_DistGridGet proc~mapl_gridget->ESMF_GridGet proc~mapl_gridget->proc~mapl_distgridget proc~mapl_gridget->proc~mapl_getimsjms proc~mapl_gridhasde MAPL_GridHasDE proc~mapl_gridget->proc~mapl_gridhasde proc~mapl_return MAPL_Return proc~mapl_gridget->proc~mapl_return proc~mapl_throw_exception MAPL_throw_exception proc~mapl_verify->proc~mapl_throw_exception proc~mapl_distgridget->proc~mapl_verify proc~mapl_distgridget->ESMF_DistGridGet proc~mapl_getimsjms->proc~mapl_verify proc~mapl_getimsjms->proc~mapl_return interface~mapl_assert MAPL_Assert proc~mapl_getimsjms->interface~mapl_assert interface~mapl_sort MAPL_Sort proc~mapl_getimsjms->interface~mapl_sort proc~mapl_gridhasde->proc~mapl_verify proc~mapl_gridhasde->ESMF_DistGridGet proc~mapl_gridhasde->ESMF_GridGet proc~mapl_gridhasde->proc~mapl_return ESMF_DELayoutGet ESMF_DELayoutGet proc~mapl_gridhasde->ESMF_DELayoutGet proc~mapl_return->proc~mapl_throw_exception at at proc~mapl_return->at insert insert proc~mapl_return->insert

Called by

proc~~latlon_zmean~~CalledByGraph proc~latlon_zmean latlon_zmean proc~latlon_zstar latlon_zstar proc~latlon_zstar->proc~latlon_zmean program~time_ave time_ave program~time_ave->proc~latlon_zstar

Source Code

   subroutine latlon_zmean ( q,qz,undef,grid,rc)
      real, intent(inout) ::  q(:,:)
      real, intent(inout) ::  qz(:)
      real, intent(in) :: undef
      type(ESMF_Grid), intent(inout) :: grid
      integer, optional, intent(out) :: rc

      integer :: im,jm,im_global,jm_global,local_dims(3),global_dims(3),status,nx,ny
      real, allocatable ::   qg(:,:)
      real, allocatable :: buf(:,:)
      real :: qsum
      integer :: mpistatus(mpi_status_size)
      integer, allocatable :: ims(:),jms(:)
      integer j,n,peid,peid0,i1,j1,in,jn,mypet,i_start,i_end,isum
      type(ESMF_VM) :: vm

      call ESMF_VMGetCurrent(vm,_RC)
      call ESMF_VMGet(vm,localPet=mypet,_RC)
      call MAPL_GridGet(grid,localCellCountPerDim=local_dims,globalCellCountPerDim=global_dims,_RC)
      im = local_dims(1)
      jm = local_dims(2)
      im_global = global_dims(1)
      jm_global = global_dims(2)
      call get_esmf_grid_layout(grid,nx,ny,ims,jms,_RC)
      call mapl_grid_interior(grid,i1,in,j1,jn)

      qz = 0.0
      allocate( qg(im_global,jm) )
      peid0 = (mypet/nx)*ny
      if (i1==1) then
         i_start = 1
         i_end = ims(1)
         qg(i_start:i_end,:)=q
         do n=1,nx-1
            allocate(buf(ims(n+1),jm))
            peid = mypet + n
            call mpi_recv(buf,ims(n+1)*jm,MPI_FLOAT,peid,peid,MPI_COMM_WORLD,mpistatus,status)
            _VERIFY(status)
            i_start=i_end+1
            i_end = i_start+ims(n)-1
            qg(i_start:i_end,:)=buf
            deallocate(buf)
         enddo
      else
         call mpi_send(q,im*jm,MPI_FLOAT,peid0,mypet,MPI_COMM_WORLD,status)
         _VERIFY(status)
      end if

! compute zonal mean
      if (i1 == 1) then
         do j=1,jm
            isum = count(qg(:,j) /= undef)
            qsum = sum(qg(:,j),mask=qg(:,j)/=undef)
            if (isum == 0) then
               qz(j)=undef
            else
               qz(j)=qsum/real(isum)
            end if
         enddo

! send mean back to other ranks
         do n=1,nx-1
            peid = peid0+n
            call mpi_send(qz,jm,MPI_FLOAT,peid,peid0,MPI_COMM_WORLD,status)
            _VERIFY(status)
         enddo
      else
         call mpi_recv(qz,jm,MPI_FLOAT,peid0,peid0,MPI_COMM_WORLD,mpistatus,status)
         _VERIFY(status)
      end if

      if (present(rc)) then
         rc=_SUCCESS
      endif

   end subroutine latlon_zmean