!-------------------------------------- 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 TRIMEGDX(KGPOSIT,CDBOUND,PLOWBOUND,PHIGHBOUND,KLEV) 1
#if defined (DOC)
*
*** s/r TRIMEGDX - To trim KLEV level from position KGPOSIT in GD so that
* PLOWBOUND <= GDX <= PHIGHBOUND
* . (applied to the analysis only for cosmetic purposes)
*
*Author : P. Gauthier *ARMA/AES Sept. 20, 1993
* .
*Revision:
* . Generalisation of TRIMES to TRIMEGDX
* . S. Pellerin *ARMA/SMC May 2000
* . Fix for F90 conversion
* . S. Pellerin *ARMA/SMC Nov. 2001
* . CDBOUND declaration bug fixed
**
*Arguments
* KGPOSIT : Position of the variable in vector GD.
* KLEV : Number of level of vector to clip.
* PHIGHBOUND : upper bound
* PLOWBOUND : lower bound
* CDBOUND : '<' means that GDX < PHIGHBOUND
* '>' means that GDX > PLOWBOUND
* other single character string means PLOWBOUND <= GDX <= PHIGHBOUND
*
*
#endif
C
IMPLICIT NONE
#include "pardim.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comgem.cdk"
#include "comgd0.cdk"
C
* Arguments
*
INTEGER KLEV,kgposit
REAL*8 PLOWBOUND, PHIGHBOUND
character :: cdbound
C
* Local variables
*
INTEGER JLEV, JLAT, JLON, ICOUNTLOW, ICOUNTHIGH, ILON
logical lllower,llupper
*
ICOUNTLOW = 0
ICOUNTHIGH = 0
*
if (CDBOUND .eq. '<') then
llupper = .true.
lllower = .false.
else if (CDBOUND .eq. '>') then
llupper = .false.
lllower = .true.
else
llupper = .true.
lllower = .true.
endif
c
DO JLEV = 1, KLEV
DO JLAT = 1, NJ
ILON = NILON(JLAT)
DO JLON = 1, ILON
IF(lllower.and.
$ GD(JLON,KGPOSIT+JLEV-1,JLAT).LT.PLOWBOUND) THEN
ICOUNTLOW = ICOUNTLOW + 1
GD(JLON,KGPOSIT+JLEV-1,JLAT) = PLOWBOUND
END IF
IF(llupper.and.
$ GD(JLON,KGPOSIT+JLEV-1,JLAT).GT.PHIGHBOUND) THEN
ICOUNTHIGH = ICOUNTHIGH + 1
GD(JLON,KGPOSIT+JLEV-1,JLAT) = PHIGHBOUND
END IF
END DO
END DO
END DO
*
WRITE(NULOUT,9100)PLOWBOUND,ICOUNTLOW,PHIGHBOUND,ICOUNTHIGH
9100 FORMAT(//,10x,'TRIMEGDX: Correction to the analysis',/
S ,15x,'NUMBER OF POINTS WITH GDX < ',G12.6,' :',I6,/
S ,15x,'NUMBER OF POINTS WITH GDX > ',G12.6,' :',I6)
*
RETURN
END