!-------------------------------------- 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 --------------------------------------
!



      SUBROUTINE PCNT_BOX(F_LOW, f_high,nprf,ilat,ilon,klat,klon,ireduc) 1

#if defined (DOC)
!***********************************************************************
!
!**ID PCNT_BOX -- COMPUTES A LOW_RESOLUTION FEATURE FROM HIGH RESOLUTION
!
!       AUTHOR:   L. GARAND (ARMA) AND A. BEAULNE (CMDA/SMC) June 2006
!
!       REVISION:
!
!       OBJECT:   COMPUTES A LOW RESOLUTION FEATURE FORM A HIGH
!                 RESOLUTION ONE BY AVERAGING.
!                 EXAMPLE: USE FOR PERCENTAGE OF WATER
!
!
!       ARGUMENTS:
!          INPUT:
!            -F_HIGH(KLON,KLAT)   : HIGH RESOLUTION FIELD 
!            -NPRF                : NUMBER OF PROFILES
!            -ILAT(NPRF)          : Y-COORDINATE OF PROFILE
!            -ILON(NPRF)          : X-COORDINATE OF PROFILE
!            -KLAT                : MAX VALUE OF LATITUDE INDICES
!            -KLON                : MAX VALUE OF LONGITUDE INDICES
!            -IREDUC              : MEANS A 2xIREDUC+1 BY 2xIREDUC+1 AVERAGING
!
!          OUTPUT:
!            -FLOW(NPRF)          : LOW RESOLUTION FIELD
!
!
!***********************************************************************
#endif

      IMPLICIT NONE

      INTEGER :: NPRF, ILAT(NPRF), ILON(NPRF), KLAT, KLON, IREDUC
      INTEGER :: NPLON, JDLO1, JDLO2, JLON1, JLON2
      INTEGER :: NX, ILAT1, ILAT2, ILON1, ILON2, JN, ii, jj
      REAL    :: F_LOW(NPRF), F_HIGH(KLON,KLAT)


      profiles : DO JN = 1,NPRF

         NPLON=0

! normal limits

         ilat1=max(ilat(JN)-IREDUC,1)
         ilat2=min(ilat(JN)+IREDUC,KLAT)
         ilon1=max(ilon(JN)-IREDUC,1)
         ilon2=min(ilon(JN)+IREDUC,KLON)

         IF(ilon1.ne.1.and.ilon2.ne.klon)go to 7

! border cases for longitudes

         JDLO1 = ILON(JN)-IREDUC
         JDLO2 = ILON(JN)+IREDUC

         IF ( JDLO1.LE.0 ) THEN
           NPLON=1
           JLON1= KLON+JDLO1
           JLON2= KLON
         ELSE IF ( JDLO2.gt.KLON ) THEN
           NPLON=1
           JLON1=1
           JLON2=JDLO2-KLON
         END IF

 7       continue

         NX=0
         F_LOW(JN)=0.

         DO JJ = ILAT1, ILAT2

           DO II = ILON1, ILON2
             NX=NX+1
             F_LOW(JN)=F_LOW(JN)+F_HIGH(II,JJ)         
           END DO

           IF (NPLON.eq.1) THEN
! additional cases at border 1-KLON
             DO II = JLON1, JLON2
               NX=NX+1
               F_LOW(JN)=F_LOW(JN)+F_HIGH(II,JJ)         
             END DO
           END IF

         END DO

         F_LOW(JN)=F_LOW(JN)/float(NX)

      END DO profiles


      END SUBROUTINE PCNT_BOX