#include <misc.h>
!-----------------------------------------------------------------------
!BOP
! !ROUTINE: uv3s_update --  update u3s, v3s
!
! !INTERFACE:


   subroutine uv3s_update(dua, u3s, dva, v3s, dt5, im, jm,                 & 1,7
                          km, jfirst, jlast, ngus, ngun, ngvs, ngvn,       &
                          kfirst, klast)
! !USES:

      use shr_kind_mod, only: r8 => shr_kind_r8

#if defined( SPMD )
      use parutilitiesmodule, only : pargatherreal
      use mod_comm, only : mp_send3d, mp_recv3d
#endif
      use pmgrid, only : myid_y, npr_y, myid_z, npr_z, iam
      use history, only: outfld

      implicit none
! !INPUT PARAMETERS:
      integer, intent(in)  :: im      ! Dimensions longitude
      integer, intent(in)  :: jm      ! Dimensions latitude  (total)
      integer, intent(in)  :: km      ! Dimensions vertical (total)
      integer, intent(in)  :: jfirst  ! latitude strip start
      integer, intent(in)  :: jlast   ! latitude strip finish
      integer, intent(in)  :: ngus    ! ghost latitudes U south
      integer, intent(in)  :: ngun    ! ghost latitudes U north
      integer, intent(in)  :: ngvs    ! ghost latitudes V south
      integer, intent(in)  :: ngvn    ! ghost latitudes V north
      integer, intent(in)  :: kfirst  ! vertical strip start
      integer, intent(in)  :: klast   ! vertical strip finish
      real(r8),intent(in)  :: dua(im,kfirst:klast,jfirst:jlast)    ! dudt on A-grid 
      real(r8),intent(in)  :: dva(im,kfirst:klast,jfirst:jlast)    ! dvdt on A-grid 
      real(r8),intent(in)  :: dt5     ! weighting factor

! !INPUT/OUTPUT PARAMETERS:
      real(r8), intent(inout) :: u3s(im,jfirst-ngus:jlast+ngun,kfirst:klast)  ! U-Wind on D Grid
      real(r8), intent(inout) :: v3s(im,jfirst-ngvs:jlast+ngvn,kfirst:klast)  ! V-Wind on D Grid

! !DESCRIPTION:
!
!     This routine performs the update for the N-S staggered u-wind
!       and the E-W staggered v-wind
!
! !REVISION HISTORY:
!    WS   00.12.22 : Creation from d2a3d
!    SJL  01.01.20 : modifications
!    AAM  01.06.08 : Name change; folding in of v3s update and outfld calls
!    WS   02.04.25 : New mod_comm interfaces
!    WS   02.07.04 : Fixed 2D decomposition bug dest/src for mp_send3d
!    WS   03.07.22 : Removed strip3zatyt4 from use list (no longer used)
!
!EOP
!-----------------------------------------------------------------------
!BOC

      integer i, j, k

#if defined( SPMD )
   real(r8) duasouth(im,kfirst:klast)
   integer  dest, src
#endif
   real(r8) u3s_tmp(im,kfirst:klast), v3s_tmp(im,kfirst:klast)

#if defined( SPMD )
!
! Transfer dua(:,jlast) to the node directly to the north
!
      dest = iam+1
      src  = iam-1
      if ( mod(iam+1,npr_y) == 0 ) dest = -1
      if ( mod(iam,npr_y) == 0 ) src = -1
      call mp_send3d( dest, src, im, jm, km,                       &
                      1, im, kfirst, klast, jfirst, jlast,            &
                      1, im, kfirst, klast, jlast, jlast, dua )
      call mp_recv3d( src, im, jm, km,                              &
                      1, im, jfirst-1, jfirst-1, kfirst, klast,       &
                      1, im, jfirst-1, jfirst-1, kfirst, klast, duasouth )
#endif

!$omp parallel do private (i, j, k)

      do k = kfirst, klast

!
! Adjust D-grid winds by interpolating A-grid tendencies.
!

        do j = jfirst+1, jlast
          do i = 1, im
             u3s(i,j,k) = u3s(i,j,k) + dt5*(dua(i,k,j)+dua(i,k,j-1))
          enddo
        enddo

#if defined( SPMD )
        if ( jfirst .gt. 1 ) then
          do i = 1, im
             u3s(i,jfirst,k) = u3s(i,jfirst,k) +                         &
                         dt5*( dua(i,k,jfirst) + duasouth(i,k) )
          enddo
        endif
#endif

        do j = max(jfirst,2), min(jlast,jm-1)
           v3s(1,j,k) = v3s(1,j,k) + dt5*(dva(1,k,j)+dva(im,k,j))
           do i=2,im
              v3s(i,j,k) = v3s(i,j,k) + dt5*(dva(i,k,j)+dva(i-1,k,j))
           enddo
        enddo

      enddo

!$omp parallel do private (i, j, k, u3s_tmp, v3s_tmp)

      do j = jfirst, jlast
         do k = kfirst, klast
            do i = 1, im
               u3s_tmp(i,k) = u3s(i,j,k)
               v3s_tmp(i,k) = v3s(i,j,k)
            enddo
         enddo

         call outfld ('FU      ', dua(1,kfirst,j), im, j )
         call outfld ('FV      ', dva(1,kfirst,j), im, j )
         call outfld ('US      ', u3s_tmp, im, j )
         call outfld ('VS      ', v3s_tmp, im, j )

      enddo

      return
!EOC
      end
!-----------------------------------------------------------------------