!-------------------------------------- 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 adw_cliptraj - Clip SL hor. trajectories to either fit inside the 
*                    physical domain of the processor or to the
*                    actual maximum allowed COURRANT number (LAM)
*
#include "model_macros_f.h"
*

      subroutine adw_cliptraj ( F_x_in,  F_y_in, i0, in, j0, jn, mesg ) 15
      implicit none
*
      character*(*) mesg
      integer i0, in, j0, jn
      real    F_x_in ( * ), F_y_in ( * )
*
*author
*     Michel Desgagne        Spring 2008
*
*revision
* v3_31 - Desgagne M.  - Initial version
*
*object
*
*arguments
*______________________________________________________________________
*              |                                                 |     |
* NAME         | DESCRIPTION                                     | I/O |
*--------------|-------------------------------------------------|-----|
* F_x_in       | upstream positions (x-component                 | i/o |
* F_y_in       | upstream positions (y-component                 | i/o |
* i0,in        | x direction scope of operator                   |  i  |
* j0,jn        | y direction scope of operator                   |  i  |
*______________|_________________________________________________|_____|
*
*
*implicits
#include "ptopo.cdk"
#include "glb_ld.cdk"
#include "adw.cdk"
#include "lun.cdk"
#include "step.cdk"
*
      integer n, nij, i,j,k, ipos, jpos, cnt, kt, sum_cnt, sum_kt, err 
      real*8 eps
      real minposx,maxposx,minposy,maxposy,
     $     posxmin,posxmax,posymin,posymax
      common /clip_sum/ cnt, kt, sum_cnt, sum_kt
*
*     __________________________________________________________________
*
      nij  = l_ni*l_nj
*
      eps=1.0d-5
                   minposx= Adw_xx_8(2)                   + eps
      if (l_west)  minposx= Adw_xx_8(Adw_halox+5)         + eps
                   maxposx= Adw_xx_8(Adw_nit-1  )         - eps
      if (l_east)  maxposx= Adw_xx_8(Adw_nit-Adw_halox-4) - eps
                   minposy= Adw_yy_8(2)                   + eps
      if (l_south) minposy= Adw_yy_8(Adw_haloy+5)         + eps
                   maxposy= Adw_yy_8(Adw_njt-1)           - eps
      if (l_north) maxposy= Adw_yy_8(Adw_njt-Adw_haloy-4) - eps

      cnt=0
      kt =0
      if (Step_cliptraj_L) then !  Clipping to Step_maxcfl
         do k=1,l_nk
         do j=j0,jn
         do i=i0,in
            n = (k-1)*nij + ((j-1)*l_ni) + i
            ipos= i+Adw_halox
            jpos= j+Adw_haloy
            posxmin = Adw_xx_8(ipos-Step_maxcfl) + eps
            posxmax = Adw_xx_8(ipos+Step_maxcfl) - eps
            posymin = Adw_yy_8(jpos-Step_maxcfl) + eps
            posymax = Adw_yy_8(jpos+Step_maxcfl) - eps
            posxmin = max(posxmin, minposx)
            posxmax = min(posxmax, maxposx)
            posymin = max(posymin, minposy)
            posymax = min(posymax, maxposy)
	    if ( (F_x_in(n).lt.posxmin).or.(F_x_in(n).gt.posxmax).or.
     $           (F_y_in(n).lt.posymin).or.(F_y_in(n).gt.posymax) ) then
               cnt=cnt+1
               kt = kt+k
            endif
            F_x_in(n) = min(max(F_x_in(n),posxmin),posxmax)
            F_y_in(n) = min(max(F_y_in(n),posymin),posymax)
         enddo
         enddo
         enddo
      else                      ! Clipping to processor boundary
         do k=1,l_nk
         do j=j0,jn
         do i=i0,in
            n = (k-1)*nij + ((j-1)*l_ni) + i
	    if ( (F_x_in(n).lt.minposx).or.(F_x_in(n).gt.maxposx).or.
     $           (F_y_in(n).lt.minposy).or.(F_y_in(n).gt.maxposy) ) then
               cnt=cnt+1
               kt = kt+k
            endif
            F_x_in(n) = min(max(F_x_in(n),minposx),maxposx)
            F_y_in(n) = min(max(F_y_in(n),minposy),maxposy)
         enddo
         enddo
         enddo
      endif
*
      call rpn_comm_Allreduce(cnt,sum_cnt,2,"MPI_INTEGER",
     $                               "MPI_SUM","grid",err)
*
      nij = G_nk*(G_niu-2*pil_e+2)*(G_njv-2*pil_s+2)
      if ( (trim(mesg).ne."") .and. (Lun_out.gt.0) .and. (sum_cnt.gt.0))
     $ write(Lun_out,1001) sum_cnt,real(sum_cnt)/real(nij)*100.,
     $                     sum_kt/sum_cnt,mesg
*
 1001 format (' ADW trajtrunc: npts=',i5,', %='f6.2,', avg_k=',i3,2x,a)
*     __________________________________________________________________
*
      return
      end