
!=======================================================================
!      Biharmonic friction and diffusion
!=======================================================================

 subroutine biha_hfric_u (nx_,ny_,nz_,diff_fe,diff_fn)
!---------------------------------------------------------------------------------
!      horizontal biharmonic friction for zonal momentum
!      no slip condition is possible
!---------------------------------------------------------------------------------
      use pyOM_module   
      implicit none
      integer :: i,j,k,js,je
      integer :: nx_,ny_,nz_
      real*8 :: diff_fe(nx_,ny_,nz_), diff_fn(nx_,ny_,nz_) 
      real*8 :: del2(nx,ny,nz),diff_tx,diff_ty,diffx
      DIFF_Tx(i,j,k) = (diff_fe(i,j,k)-diff_fe(i-1,j,k))/dx
      DIFF_Ty(i,j,k) = (diff_fn(i,j,k)-diff_fn(i,j-1,k))/dx

      js=max(2,js_pe); je = min(je_pe,ny-1)
      diffx = sqrt(abs(ahbi))
      diff_fe(:,js_pe:je_pe,:)=0.0;diff_fn(:,js_pe:je_pe,:)=0.0
      do k=1,nz
       do j=js,je
        do i=1,nx-1
         diff_fe(i,j,k)=diffx*(u(i+1,j,k,taum1)-u(i,j,k,taum1))/dx
        enddo
       enddo
      enddo
      call border_exchg3D(nx_,ny_,nz_,diff_fe,1); call setcyclic3D(nx_,ny_,nz_,diff_fe)
      do k=1,nz-1
       do j=js,je
        do i=1,nx
         diff_fn(i,j,k)=diffx*(u(i,j+1,k,taum1)-u(i,j,k,taum1))/dx*maskU(i,j+1,k)*maskU(i,j,k)
        enddo
       enddo
      enddo
      if (enable_noslip) then
       do j=js-1,je
         diff_fn(:,j,:)=diff_fn(:,j,:)-2*diffx*u(:,j,:,taum1)/dx  &
            *(1-maskU(:,j+1,:))*maskU(:,j,:)+2*diffx*u(:,j+1,:,taum1)/dx*(1-maskU(:,j,:))*maskU(:,j+1,:)
       enddo
      endif
      call border_exchg3D(nx_,ny_,nz_,diff_fn,1); call setcyclic3D(nx_,ny_,nz_,diff_fn)
      del2(:,js_pe:je_pe,:)=0.0
      do k=2,nz-1
       do j=js,je
        do i=2,nx-1
          del2(i,j,k) = (DIFF_Tx(i,j,k) + DIFF_Ty(i,j,k))*maskU(i,j,k)
        enddo
       enddo
      enddo
      call border_exchg3D(nx_,ny_,nz_,del2,1); call setcyclic3D(nx_,ny_,nz_,del2)
      diff_fe(:,js_pe:je_pe,:)=0.0;diff_fn(:,js_pe:je_pe,:)=0.0
      do k=2,nz-1
       do j=js,je
        do i=1,nx-1
         diff_fe(i,j,k) =diffx*(del2(i+1,j,k)-del2(i,j,k))/dx
        enddo
       enddo
      enddo
      call border_exchg3D(nx_,ny_,nz_,diff_fe,1); call setcyclic3D(nx_,ny_,nz_,diff_fe)
      do k=1,nz-1
       do j=js-1,je
        do i=2,nx-1
         diff_fn(i,j,k) = diffx*(del2(i,j+1,k) - del2(i,j,k))/dx*maskU(i,j+1,k)*maskU(i,j,k)
        enddo
       enddo
      enddo
      if (enable_noslip) then
       do j=js-1,je
         diff_fn(:,j,:)=diff_fn(:,j,:)-2*diffx*del2(:,j,:)/dx  &
          *(1-maskU(:,j+1,:))*maskU(:,j,:)+2*diffx*del2(:,j+1,:)/dx*(1-maskU(:,j,:))*maskU(:,j+1,:)
       enddo
      endif
      call border_exchg3D(nx_,ny_,nz_,diff_fn,1); call setcyclic3D(nx_,ny_,nz_,diff_fn)
      do k=2,nz-1
       do j=js,je
        do i=2,nx-1
         fu(i,j,k)=fu(i,j,k)-maskU(i,j,k)*(DIFF_Tx(i,j,k)+DIFF_Ty(i,j,k))
        enddo
       enddo
      enddo
 end subroutine biha_hfric_u




 subroutine biha_hfric_v (nx_,ny_,nz_,diff_fe,diff_fn)
!---------------------------------------------------------------------------------
!      horizontal biharmonic friction for meridional momentum
!      no slip condition is possible
!---------------------------------------------------------------------------------
      use pyOM_module   
      implicit none
      integer :: i,j,k,js,je
      integer :: nx_,ny_,nz_
      real*8 :: diff_fe(nx_,ny_,nz_), diff_fn(nx_,ny_,nz_) 
      real*8 :: del2(nx,ny,nz),diff_tx,diff_ty,diffx
      DIFF_Tx(i,j,k)=(diff_fe(i,j,k)-diff_fe(i-1,j,k))/dx
      DIFF_Ty(i,j,k)=(diff_fn(i,j,k)-diff_fn(i,j-1,k))/dx

      js=max(2,js_pe); je = min(je_pe,ny-1)
      diffx = sqrt(abs(ahbi))
      diff_fe(:,js_pe:je_pe,:)=0.0;diff_fn(:,js_pe:je_pe,:)=0.0
      do k=1,nz
       do j=js,je
        do i=1,nx-1
         diff_fe(i,j,k)=diffx*(v(i+1,j,k,taum1)-v(i,j,k,taum1))/dx*maskV(i,j,k)*maskV(i+1,j,k)
        enddo
       enddo
      enddo
      if (enable_noslip) then
       do j=js,je
       do i=1,nx-1
         diff_fe(i,j,:)=diff_fe(i,j,:)-2*diffx*v(i,j,:,taum1)/dx  &
           *(1-maskV(i+1,j,:))*maskV(i,j,:)+2*diffx*v(i+1,j,:,taum1)/dx*(1-maskV(i,j,:))*maskV(i+1,j,:)
       enddo
       enddo
      endif
      call border_exchg3D(nx_,ny_,nz_,diff_fe,1); call setcyclic3D(nx_,ny_,nz_,diff_fe)
      do k=1,nz-1
       do j=js,je
        do i=1,nx
         diff_fn(i,j,k)=diffx*(v(i,j+1,k,taum1)-v(i,j,k,taum1))/dx
        enddo
       enddo
      enddo
      call border_exchg3D(nx_,ny_,nz_,diff_fn,1); call setcyclic3D(nx_,ny_,nz_,diff_fn)
      del2(:,je_pe:je_pe,:)=0.0
      do k=2,nz-1
       do j=js,je
        do i=2,nx-1
         del2(i,j,k) = (DIFF_Tx(i,j,k) + DIFF_Ty(i,j,k))*maskV(i,j,k)
        enddo
       enddo
      enddo
      call border_exchg3D(nx_,ny_,nz_,del2,1); call setcyclic3D(nx_,ny_,nz_,del2)
      diff_fe(:,js_pe:je_pe,:)=0.0;diff_fn(:,js_pe:je_pe,:)=0.0
      do k=2,nz-1
       do j=js,je
        do i=1,nx-1
         diff_fe(i,j,k) =diffx*(del2(i+1,j,k)-del2(i,j,k))/dx*maskV(i+1,j,k)*maskV(i,j,k)
        enddo
       enddo
      enddo
      if (enable_noslip) then
       do j=js,je
       do i=1,nx-1
         diff_fe(i,j,:)=diff_fe(i,j,:)-2*diffx*del2(i,j,:)/dx*(1-maskV(i+1,j,:))*maskV(i,j,:) &
                     +2*diffx*del2(i+1,j,:)/dx*(1-maskV(i,j,:))*maskV(i+1,j,:)
       enddo
       enddo
      endif
      call border_exchg3D(nx_,ny_,nz_,diff_fe,1); call setcyclic3D(nx_,ny_,nz_,diff_fe)
      do k=1,nz-1
       do j=js,je
        do i=2,nx-1
         diff_fn(i,j,k) = diffx*(del2(i,j+1,k) - del2(i,j,k))/dx
        enddo
       enddo
      enddo
      call border_exchg3D(nx_,ny_,nz_,diff_fn,1); call setcyclic3D(nx_,ny_,nz_,diff_fn)
      do k=2,nz-1
       do j=js,je
        do i=2,nx-1
          fv(i,j,k)= fv(i,j,k)+maskV(i,j,k)*(-DIFF_Tx(i,j,k) - DIFF_Ty(i,j,k))
        enddo
       enddo
      enddo
 end subroutine biha_hfric_v





 subroutine biha_hfric_w (nx_,ny_,nz_,diff_fe,diff_fn)
!---------------------------------------------------------------------------------
!      horizontal biharmonic friction for vertical momentum
!---------------------------------------------------------------------------------
      use pyOM_module   
      implicit none
      integer :: i,j,k,js,je
      integer :: nx_,ny_,nz_
      real*8 :: diff_fe(nx_,ny_,nz_), diff_fn(nx_,ny_,nz_) 
      real*8 :: del2(nx,ny,nz),diff_tx,diff_ty,diffx
      DIFF_Tx(i,j,k)=(diff_fe(i,j,k)-diff_fe(i-1,j,k))/dx
      DIFF_Ty(i,j,k)=(diff_fn(i,j,k)-diff_fn(i,j-1,k))/dx

      js=max(2,js_pe); je = min(je_pe,ny-1)
      diffx = sqrt(abs(ahbi))
      diff_fe(:,js_pe:je_pe,:)=0.0;diff_fn(:,js_pe:je_pe,:)=0.0
      do k=1,nz
       do j=js,je
        do i=1,nx-1
         diff_fe(i,j,k)=diffx*(w(i+1,j,k,taum1)-w(i,j,k,taum1))/dx*maskW(i,j,k)*maskW(i+1,j,k)
        enddo
       enddo
      enddo
      call border_exchg3D(nx_,ny_,nz_,diff_fe,1); call setcyclic3D(nx_,ny_,nz_,diff_fe)
      do k=1,nz-1
       do j=js,je
        do i=1,nx
         diff_fn(i,j,k)=diffx*(w(i,j+1,k,taum1)-w(i,j,k,taum1))/dx*maskW(i,j,k)*maskW(i,j+1,k)
        enddo
       enddo
      enddo
      call border_exchg3D(nx_,ny_,nz_,diff_fn,1); call setcyclic3D(nx_,ny_,nz_,diff_fn)
      del2(:,je_pe:je_pe,:)=0.0
      do k=2,nz-1
       do j=js,je
        do i=2,nx-1
         del2(i,j,k) = (DIFF_Tx(i,j,k) + DIFF_Ty(i,j,k))*maskW(i,j,k)
        enddo
       enddo
      enddo
      call border_exchg3D(nx_,ny_,nz_,del2,1); call setcyclic3D(nx_,ny_,nz_,del2)
      diff_fe(:,js_pe:je_pe,:)=0.0;diff_fn(:,js_pe:je_pe,:)=0.0
      do k=2,nz-1
       do j=js,je
        do i=1,nx-1
         diff_fe(i,j,k) =diffx*(del2(i+1,j,k)-del2(i,j,k))/dx*maskW(i+1,j,k)*maskW(i,j,k)
        enddo
       enddo
      enddo
      call border_exchg3D(nx_,ny_,nz_,diff_fe,1); call setcyclic3D(nx_,ny_,nz_,diff_fe)
      do k=1,nz-1
       do j=js,je
        do i=2,nx-1
         diff_fn(i,j,k) = diffx*(del2(i,j+1,k) - del2(i,j,k))/dx*maskW(i,j+1,k)*maskW(i,j,k)
        enddo
       enddo
      enddo
      call border_exchg3D(nx_,ny_,nz_,diff_fn,1); call setcyclic3D(nx_,ny_,nz_,diff_fn)
      do k=2,nz-1
       do j=js,je
        do i=2,nx-1
          fw(i,j,k)= fw(i,j,k)+maskW(i,j,k)*(-DIFF_Tx(i,j,k) - DIFF_Ty(i,j,k))
        enddo
       enddo
      enddo
end subroutine biha_hfric_w



 subroutine biha_vfric_u (nx_,ny_,nz_,diff_ft)
!---------------------------------------------------------------------------------
!       vertical biharmonic friction for zonal momentum component 
!       result is added to ff
!---------------------------------------------------------------------------------
      use pyOM_module   
      implicit none
      integer :: i,j,k,js,je
      integer :: nx_,ny_,nz_
      real*8, dimension(nx_,ny_,nz_) :: diff_ft
      real*8 :: del2(nx,ny,nz),diff_tz,diffx
      DIFF_Tz(i,j,k)=(diff_ft(i,j,k)-diff_ft(i,j,k-1))/dz

      js=max(2,js_pe); je = min(je_pe,ny-1)
      diffx = sqrt(abs(Avbi))
      diff_ft(:,je_pe:je_pe,:)=0.0
      do k=1,nz-1
       do j=js,je
        do i=2,nx-1
         diff_ft(i,j,k)=diffx*(u(i,j,k+1,taum1)-u(i,j,k,taum1))/dz*masku(i,j,k)*masku(i,j,k+1)
        enddo
       enddo
      enddo
      del2(:,je_pe:je_pe,:)=0.0
      do k=2,nz-1
       do j=js,je
        do i=2,nx-1
          del2(i,j,k) = DIFF_Tz(i,j,k)*masku(i,j,k)
        enddo
       enddo
      enddo
      diff_ft(:,je_pe:je_pe,:)=0.0
      do k=2,nz-1
       do j=js,je
        do i=2,nx-1
         diff_ft(i,j,k) =diffx*(del2(i,j,k+1)-del2(i,j,k))/dz*masku(i,j,k+1)*masku(i,j,k)
        enddo
       enddo
      enddo
      do k=2,nz-1
       do j=js,je
        do i=2,nx-1
          fu(i,j,k)= fu(i,j,k)-masku(i,j,k)*DIFF_Tz(i,j,k) 
        enddo
       enddo
      enddo
 end subroutine biha_vfric_u



 subroutine biha_vfric_v (nx_,ny_,nz_,diff_ft)
!---------------------------------------------------------------------------------
!       vertical biharmonic friction for  momentum component n
!       result is added to ff
!---------------------------------------------------------------------------------
      use pyOM_module   
      implicit none
      integer :: i,j,k,js,je
      integer :: nx_,ny_,nz_
      real*8, dimension(nx_,ny_,nz_) :: diff_ft
      real*8 :: del2(nx,ny,nz),diff_tz,diffx
      DIFF_Tz(i,j,k)=(diff_ft(i,j,k)-diff_ft(i,j,k-1))/dz

      js=max(2,js_pe); je = min(je_pe,ny-1)
      diffx = sqrt(abs(Avbi))
      diff_ft(:,je_pe:je_pe,:)=0.0
      do k=1,nz-1
       do j=js,je
        do i=2,nx-1
         diff_ft(i,j,k)=diffx*(v(i,j,k+1,taum1)-v(i,j,k,taum1))/dz*maskV(i,j,k)*maskV(i,j,k+1)
        enddo
       enddo
      enddo
      del2(:,je_pe:je_pe,:)=0.0
      do k=2,nz-1
       do j=js,je
        do i=2,nx-1
          del2(i,j,k) = DIFF_Tz(i,j,k)*maskV(i,j,k)
        enddo
       enddo
      enddo
      diff_ft(:,je_pe:je_pe,:)=0.0
      do k=2,nz-1
       do j=js,je
        do i=2,nx-1
         diff_ft(i,j,k) =diffx*(del2(i,j,k+1)-del2(i,j,k))/dz*maskV(i,j,k+1)*maskV(i,j,k)
        enddo
       enddo
      enddo
      do k=2,nz-1
       do j=js,je
        do i=2,nx-1
          fv(i,j,k)= fv(i,j,k)-maskV(i,j,k)*DIFF_Tz(i,j,k) 
        enddo
       enddo
      enddo
 end subroutine biha_vfric_v


 subroutine biha_vfric_w (nx_,ny_,nz_,diff_ft)
!---------------------------------------------------------------------------------
!       vertical biharmonic friction for  momentum component n
!       result is added to ff
!---------------------------------------------------------------------------------
      use pyOM_module   
      implicit none
      integer :: i,j,k,js,je
      integer :: nx_,ny_,nz_
      real*8, dimension(nx_,ny_,nz_) :: diff_ft
      real*8 :: del2(nx,ny,nz),diff_tz,diffx
      DIFF_Tz(i,j,k)=(diff_ft(i,j,k)-diff_ft(i,j,k-1))/dz

      js=max(2,js_pe); je = min(je_pe,ny-1)
      diffx = sqrt(abs(Avbi))
      diff_ft(:,je_pe:je_pe,:)=0.0
      do k=1,nz-1
       do j=js,je
        do i=2,nx-1
         diff_ft(i,j,k)=diffx*(w(i,j,k+1,taum1)-w(i,j,k,taum1))/dz*maskW(i,j,k)*maskW(i,j,k+1)
        enddo
       enddo
      enddo
      del2(:,je_pe:je_pe,:)=0.0
      do k=2,nz-1
       do j=js,je
        do i=2,nx-1
          del2(i,j,k) = DIFF_Tz(i,j,k)*maskW(i,j,k)
        enddo
       enddo
      enddo
      diff_ft(:,je_pe:je_pe,:)=0.0
      do k=2,nz-1
       do j=js,je
        do i=2,nx-1
         diff_ft(i,j,k) =diffx*(del2(i,j,k+1)-del2(i,j,k))/dz*maskW(i,j,k+1)*maskW(i,j,k)
        enddo
       enddo
      enddo
      do k=2,nz-1
       do j=js,je
        do i=2,nx-1
          fw(i,j,k)= fw(i,j,k)-maskW(i,j,k)*DIFF_Tz(i,j,k) 
        enddo
       enddo
      enddo
 end subroutine biha_vfric_w




 subroutine biha_mix (nx_,ny_,nz_,diff_fe,diff_fn,diff_ft,var)
!---------------------------------------------------------------------------------
!      horizontal biharmonic diffusion of buoyancy
!      also vertical biha. diff. if requested
!---------------------------------------------------------------------------------
      use pyOM_module   
      implicit none
      integer :: i,j,k,js,je
      integer :: nx_,ny_,nz_
      real*8 :: var(nx_,ny_,nz_,3)
      real*8 :: diff_fe(nx_,ny_,nz_), diff_fn(nx_,ny_,nz_) 
      real*8 :: diff_ft(nx_,ny_,nz_)  ,diffz
      real*8 :: del2(nx,ny,nz),diff_tx,diff_ty,diffx,diff_tz
      DIFF_Tx(i,j,k)=(diff_fe(i,j,k)-diff_fe(i-1,j,k))/dx
      DIFF_Ty(i,j,k)=(diff_fn(i,j,k)-diff_fn(i,j-1,k))/dx
      DIFF_Tz(i,j,k)=(diff_ft(i,j,k)-diff_ft(i,j,k-1))/dz

      js=max(2,js_pe); je = min(je_pe,ny-1)
      diffx = sqrt(abs(Khbi))
      diffz = sqrt(abs(Kvbi))
      diff_fe(:,js_pe:je_pe,:)=0.0; diff_fn(:,js_pe:je_pe,:)=0.0
      do k=1,nz
       do j=js,je
        do i=1,nx-1
         diff_fe(i,j,k)=diffx*(var(i+1,j,k,taum1)-var(i,j,k,taum1))/dx*maskU(i,j,k)
        enddo
       enddo
      enddo
      call border_exchg3D(nx_,ny_,nz_,diff_fe,1); call setcyclic3D(nx_,ny_,nz_,diff_fe)
      do k=1,nz-1
       do j=js,je
        do i=1,nx
         diff_fn(i,j,k)=diffx*(var(i,j+1,k,taum1)-var(i,j,k,taum1))/dx*maskV(i,j,k)
        enddo
       enddo
      enddo
      call border_exchg3D(nx_,ny_,nz_,diff_fn,1); call setcyclic3D(nx_,ny_,nz_,diff_fn)
      del2(:,js_pe:je_pe,:)=0.0
      do k=2,nz-1
       do j=js,je
        do i=2,nx-1
          del2(i,j,k) = (DIFF_Tx(i,j,k) + DIFF_Ty(i,j,k))*maskT(i,j,k)
        enddo
       enddo
      enddo
      call border_exchg3D(nx_,ny_,nz_,del2,1); call setcyclic3D(nx_,ny_,nz_,del2)
      diff_fe(:,js_pe:je_pe,:)=0.0; diff_fn(:,js_pe:je_pe,:)=0.0
      do k=2,nz-1
       do j=js,je
        do i=1,nx-1
         diff_fe(i,j,k) =diffx*(del2(i+1,j,k)-del2(i,j,k))/dx*maskU(i,j,k)
        enddo
       enddo
      enddo
      call border_exchg3D(nx_,ny_,nz_,diff_fe,1); call setcyclic3D(nx_,ny_,nz_,diff_fe)
      do k=1,nz-1
       do j=js,je
        do i=2,nx-1
         diff_fn(i,j,k) = diffx*(del2(i,j+1,k) - del2(i,j,k))/dx*maskV(i,j,k)
        enddo
       enddo
      enddo
      call border_exchg3D(nx_,ny_,nz_,diff_fn,1); call setcyclic3D(nx_,ny_,nz_,diff_fn)
      do k=2,nz-1
       do j=js,je
        do i=2,nx-1
          var(i,j,k,taup1)= var(i,j,k,taup1)+c2dt*maskT(i,j,k)*(-DIFF_Tx(i,j,k) - DIFF_Ty(i,j,k))
        enddo
       enddo
      enddo
      if (enable_vert_biha_diffusion) then
       diff_ft(:,js_pe:je_pe,:)=0.0
       do k=1,nz-1
        do j=js,je
         do i=2,nx-1
          diff_ft(i,j,k)=diffz*(var(i,j,k+1,taum1)-var(i,j,k,taum1))/dz *maskW(i,j,k)
         enddo
        enddo
       enddo
       del2(:,js_pe:je_pe,:)=0.0
       do k=2,nz-1
        do j=js,je
         do i=2,nx-1
          del2(i,j,k) = DIFF_Tz(i,j,k)*maskT(i,j,k)
         enddo
        enddo
       enddo
       diff_ft(:,js_pe:je_pe,:)=0.0
       do k=2,nz-1
        do j=js,je
         do i=2,nx-1
          diff_ft(i,j,k) =diffz*(del2(i,j,k+1)-del2(i,j,k))/dz *maskW(i,j,k)
         enddo
        enddo
       enddo
       do k=2,nz-1
        do j=js,je
         do i=2,nx-1
          var(i,j,k,taup1)=var(i,j,k,taup1) -c2dt*maskT(i,j,k)*DIFF_Tz(i,j,k) 
         enddo
        enddo
       enddo
      endif
end subroutine biha_mix

