!-------------------------------------- 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/p v4d_pxpypole - Accumulate px,py positions in zones near north and south poles.  
*                     kind=1= Accumulation in V4DZ.CDK
*                     kind=2= Deallocations
*
#include "model_macros_f.h"
*

      subroutine v4d_pxpypole (px,py,npts,i1,i2,nk,jmin,jmax,degree,l_north,l_south,kind)  8,1
*
      use v4dzone
*
      implicit none
*
      integer npts,i1,i2,nk,jmin,jmax,degree,kind
*
      real px(npts),py(npts)
*
      logical l_north,l_south
*
*author Tanguay M. 
*
*revision
* v3_00 - Tanguay M.        - initial MPI version
* v3_11 - Tanguay M.        - select processors at north or south 
*
*object
*     see id section
*
*arguments
* Name         I/O        Description
*----------------------------------------------------------------
* px            I         Position x in INPUT grid
* py            I         Position y in INPUT grid
* npts          I         Number of positions
* i1-i2         I         Dimension x in INPUT grid
* nk            I         Dimension z in INPUT grid
* jmin          I         Lower  limit j
* jmax          I         Higher limit j
* degree        I         Degree of interpolation 
* kind          I         kind=1=Accumulation : kind=2=Deallocations 
*----------------------------------------------------------------
*
*implicits
**
      integer i,jleft,jright,ier,npos,status
*
      integer, pointer, dimension(:)   :: itmp
      real,    pointer, dimension(:)   :: xtmp,ytmp
*
*     --------------------------------------------------------------
*     Accumulate px,py positions in zones near north and south poles
*     --------------------------------------------------------------
      if(kind.eq.1) then
*
         V4dz_nzon(1) = 0
         V4dz_nzon(2) = 0
*
         if(npts.gt.0) then
*
            allocate ( xtmp(npts), STAT=status )
            allocate ( ytmp(npts), STAT=status )
            allocate ( itmp(npts), STAT=status )
*
*           Zone near north pole
*           --------------------
            if(l_north) then
*
               if(degree.eq.1) jleft = jmax
               if(degree.eq.3) jleft = jmax-1
*
*              Accumulate positions
*              --------------------
               npos = 0
               do i=1,npts
                  if(int(py(i)).gt.jleft) then
                     npos = npos + 1
                     xtmp(npos) = px(i)
                     ytmp(npos) = py(i)
                     itmp(npos) = i
                  endif
               enddo
*
*              Transfert positions
*              -------------------
               V4dz_nzon(1) = npos
               if(V4dz_nzon(1).gt.0) then
                  allocate ( V4dz_xzon1(V4dz_nzon(1)), STAT=status )
                  allocate ( V4dz_yzon1(V4dz_nzon(1)), STAT=status )
                  allocate ( V4dz_izon1(V4dz_nzon(1)), STAT=status )
*
                  do i=1,V4dz_nzon(1)
                     V4dz_xzon1(i) = xtmp(i)
                     V4dz_yzon1(i) = ytmp(i)
                     V4dz_izon1(i) = itmp(i)
                  enddo
               endif
*
            endif
*
*           Zone near south pole
*           --------------------
            if(l_south) then
*
               if(degree.eq.1) jright = jmin 
               if(degree.eq.3) jright = jmin+1 
*
*              Accumulate positions
*              --------------------
               npos = 0
               do i=1,npts
                  if(int(py(i)).lt.jright) then
                     npos = npos + 1
                     xtmp(npos) = px(i)
                     ytmp(npos) = py(i)
                     itmp(npos) = i
                  endif
               enddo
*
*              Transfert positions
*              -------------------
               V4dz_nzon(2) = npos
               if(V4dz_nzon(2).gt.0) then
                  allocate ( V4dz_xzon2(V4dz_nzon(2)), STAT=status )
                  allocate ( V4dz_yzon2(V4dz_nzon(2)), STAT=status )
                  allocate ( V4dz_izon2(V4dz_nzon(2)), STAT=status )
*
                  do i=1,V4dz_nzon(2)
                     V4dz_xzon2(i) = xtmp(i)
                     V4dz_yzon2(i) = ytmp(i)
                     V4dz_izon2(i) = itmp(i)
                  enddo
               endif
*
            endif
*
            deallocate( xtmp, STAT=status )
            deallocate( ytmp, STAT=status )
            deallocate( itmp, STAT=status )
*
         endif
*
*     --------------------------------------
*     Deallocations of ZONES internal arrays
*     --------------------------------------
      elseif(kind.eq.2) then
*
         if(V4dz_nzon(1).gt.0) then
            deallocate( V4dz_xzon1, STAT=status )
            deallocate( V4dz_yzon1, STAT=status )
            deallocate( V4dz_izon1, STAT=status )
         endif
         if(V4dz_nzon(2).gt.0) then
            deallocate( V4dz_xzon2, STAT=status )
            deallocate( V4dz_yzon2, STAT=status )
            deallocate( V4dz_izon2, STAT=status )
         endif
*
      endif
*
      return
      end