!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer, 
!                     version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms 
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer 
!version 3 or (at your option) any later version that should be found at: 
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html 
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; 
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software; 
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec), 
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
***s/r hzd_exhrdif - applies horizontal explicit diffusion
*
#include "model_macros_f.h"

      subroutine hzd_exhrdif ( F_u, F_v, F_psd, F_td, DIST_DIM, Nk ) 1,4
*
      implicit none
*
      integer DIST_DIM, Nk
*
      real     F_u(DIST_SHAPE,Nk),  F_v(DIST_SHAPE,Nk),
     %       F_psd(DIST_SHAPE,Nk), F_td(DIST_SHAPE,Nk)
*
*AUTHORs    C. Girard & M. Desgagne
*
*revision
* v3_21 - Desgagne M. - initial MPI version
* v3_30 - Desgagne M. - openMP precision in shared variables
*
*arguments
*  Name        I/O        Description
*----------------------------------------------------------------
*----------------------------------------------------------------
* 
*implicits
#include "glb_ld.cdk"
#include "hzd.cdk"
*
      integer nn, mm
      real*8 pt25,nu_dif,epsilon,khdim,lnr,visco
      parameter (epsilon = 1.0d-12, pt25=0.25d0)
      real smu  (LDIST_SHAPE,Nk),smv (LDIST_SHAPE,Nk),
     $     smpsd(LDIST_SHAPE,Nk),smtd(LDIST_SHAPE,Nk)
**
*     __________________________________________________________________
*
      nu_dif = 0.d0
      lnr    = 1.0d0 - exp(Hzd_lnr)
      if (Hzd_pwr.gt.0) nu_dif = pt25*lnr**(2.d0/Hzd_pwr)
      nu_dif = min(nu_dif,pt25-epsilon)
      if (nu_dif.lt.1.0e-10) return
*
      visco = min ( nu_dif, pt25 )
*
      call rpn_comm_xch_halo ( F_u  , LDIST_DIM, l_ni,l_nj,G_nk,
     $               G_halox,G_haloy,G_periodx,G_periody,l_ni,0 )
      call rpn_comm_xch_halo ( F_v  , LDIST_DIM, l_ni,l_nj,G_nk,
     $               G_halox,G_haloy,G_periodx,G_periody,l_ni,0 )
      call rpn_comm_xch_halo ( F_psd, LDIST_DIM, l_ni,l_nj,G_nk,
     $               G_halox,G_haloy,G_periodx,G_periody,l_ni,0 )
      call rpn_comm_xch_halo ( F_td , LDIST_DIM, l_ni,l_nj,G_nk,
     $               G_halox,G_haloy,G_periodx,G_periody,l_ni,0 )

      nn=Hzd_pwr/2
*
!$omp parallel shared( visco,nn )
      do mm=1,nn
*
         call hzd_nudeln (F_u  ,smu  ,LDIST_DIM,Nk,visco,1,0,mm,nn)
         call hzd_nudeln (F_v  ,smv  ,LDIST_DIM,Nk,visco,0,1,mm,nn)
         call hzd_nudeln (F_psd,smpsd,LDIST_DIM,Nk,visco,0,0,mm,nn)
         call hzd_nudeln (F_td ,smtd ,LDIST_DIM,Nk,visco,0,0,mm,nn)
*
         if(mm.ne.nn) then
!$omp single
            call rpn_comm_xch_halo( smu  , LDIST_DIM, l_ni,l_nj,G_nk,
     $                    G_halox,G_haloy,G_periodx,G_periody,l_ni,0 )
            call rpn_comm_xch_halo( smv  , LDIST_DIM, l_ni,l_nj,G_nk,
     $                    G_halox,G_haloy,G_periodx,G_periody,l_ni,0 )
            call rpn_comm_xch_halo( smpsd, LDIST_DIM, l_ni,l_nj,G_nk,
     $                    G_halox,G_haloy,G_periodx,G_periody,l_ni,0 )
            call rpn_comm_xch_halo( smtd , LDIST_DIM, l_ni,l_nj,G_nk,
     $                    G_halox,G_haloy,G_periodx,G_periody,l_ni,0 )
!$omp end single
         endif
*
      end do
!$omp end parallel
*     __________________________________________________________________
*
      return
      end