SUBROUTINE SUGPQLIM

!**** *SUGPQLIM*  - Limit gridpoint Q to within 0-1 in relative humidity

!     Purpose.
!     --------
!                  Limit gridpoint Q to within 0-1 in relative humidity

!**   Interface.
!     ----------
!        *CALL* *SUGPQLIM(.....)*

!        Explicit arguments :
!        --------------------

!        Implicit arguments :
!        --------------------

!     Method.
!     -------
!        See documentation

!     Externals.  SPEREE - spectral to grid-point transform
!     ----------

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        Erik Andersson based on SUGPQLIM by Per Unden 
!        Mats Hamrud *ECMWF*

!     Modifications.
!     --------------
!        Original : 96-07-29
!        Per Unden: 97-03-04 Use Tetens formula with new constants
!        Mats Hamrud : 98-06-01 Adapt to new output format of SPEREE
!        Modified 98-08-10 by K. YESSAD: removal of LRPOLE option.
!         - removal of argument .FALSE. in 'CALL SPEREE'.
!        R. El Khatib : 01-08-07 Pruning options
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMLUN   , ONLY : NULOUT
USE YOMDIM   , ONLY : NFLEVG   ,NPROMA   ,NFLSUR   ,NGPBLKS 
USE YOMSP    , ONLY : SPT      ,SPSP
USE YOMCST   , ONLY : RV       ,RCPV     ,RETV     ,RCW      ,&
 & RCS      ,RLVTT    ,RLSTT    ,RTT      ,RALPW    ,&
 & RBETW    ,RGAMW    ,RALPS    ,RBETS    ,RGAMS    ,&
 & RALPD    ,RBETD    ,RGAMD  
USE YOETHF   , ONLY : R2ES     ,R3LES    ,R3IES    ,R4LES    ,&
 & R4IES    ,R5LES    ,R5IES    ,R5ALVCP  ,R5ALSCP  ,&
 & RTWAT_RTICE_R      ,RTWAT_RTICECU_R,&
 & RALVDCP  ,RALSDCP  ,RTWAT    ,RTICE    ,RTICECU  
USE YOMGEM   , ONLY : VBH      ,VAH      ,NGPTOT
USE YOMCT0   , ONLY : LSPRT
USE YOMCT0B  , ONLY : LECMWF
USE YOMGFL , ONLY : GFL
USE YOM_YGFL , ONLY : YQ

IMPLICIT NONE

REAL(KIND=JPRB) :: ZPRSHO(NPROMA,0:NFLEVG)
REAL(KIND=JPRB) :: ZPRSFO(NPROMA,NFLEVG)
REAL(KIND=JPRB) :: ZT(NPROMA,NFLEVG,NGPBLKS),ZZT(NGPTOT,NFLEVG)
REAL(KIND=JPRB) :: ZPS(NPROMA,NGPBLKS)
REAL(KIND=JPRB) :: ZQSAT(NPROMA)

INTEGER(KIND=JPIM) :: IBL, IBLOCK, ICOUNT, IEND, IKBEG, IKEND, IROF, IST, JK, JK1, JKGLO, JLEV, JROF

REAL(KIND=JPRB) :: ZESOP
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "gppre.intfb.h"
#include "specrt.intfb.h"
#include "speree.intfb.h"

#include "fcttrm.h"
#include "fcttre.h"

!     ------------------------------------------------------------------

!*       1.  CONVERT TO GRIDPOINT SPACE.
!            ---------------------------
!     SPECRTSM/DM is normally not called because LSPRT is set false
!     locally inside RDFPINC. Note, SPECRT is not exactly invertible.

IF (LHOOK) CALL DR_HOOK('SUGPQLIM',0,ZHOOK_HANDLE)
IF(LSPRT) THEN
  WRITE(NULOUT,*) ' Calling SPECRT(1) in SUGPQLIM'
  CALL SPECRT(1)
ENDIF

CALL SPEREE(NFLSUR,NFLEVG,SPT,ZZT)
DO JLEV=1,NFLEVG
  IROF=0
  DO JK=1,NGPTOT,NPROMA
    IBLOCK=(JK-1)/NPROMA+1
    IKBEG =  JK
    IKEND=MIN(NGPTOT,JK+NPROMA-1)
    ICOUNT=0
    DO JK1=IKBEG,IKEND
      IROF=IROF+1
      ICOUNT=ICOUNT+1
      ZT(ICOUNT,JLEV,IBLOCK)=ZZT(IROF,JLEV)
    ENDDO
  ENDDO
ENDDO
CALL SPEREE(1,1,SPSP,ZPS)

IF(LSPRT) THEN
  WRITE(NULOUT,*) ' Calling SPECRT(0) in SUGPQLIM'
  CALL SPECRT(0)
ENDIF

!     ------------------------------------------------------------------

!*       2.  ADD TO UPPER AIR GRIDPOINT WORKFILE.
!            ------------------------------------

DO JKGLO=1,NGPTOT,NPROMA
  IBL=(JKGLO-1)/NPROMA+1
  IST  = 1
  IEND = MIN(NPROMA,NGPTOT-JKGLO+1)

!*       3.1   FIND SURFACE PRESSURE

  DO JROF=IST,IEND
    ZPRSHO(JROF,NFLEVG)= EXP(ZPS(JROF,IBL))
  ENDDO

!*       3.2   COMPUTE PRESSURES OF ETA LEVELS

  CALL GPPRE(NPROMA,IST,IEND,NFLEVG,VAH,VBH,ZPRSHO,ZPRSFO)

!*       3.4  LIMIT GP Q TO SATURATION VALUE
!*            MAKE SURE GP Q IS POSITIVE
!             This is split in two loops in order to vectorize on Fj

  DO JLEV=1,NFLEVG
    IF(LECMWF) THEN
      DO JROF=IST,IEND
        ZQSAT(JROF)=FOEEWM(ZT(JROF,JLEV,IBL))/ZPRSFO(JROF,JLEV)
        ZQSAT(JROF)=MIN(0.5_JPRB,ZQSAT(JROF))
        ZQSAT(JROF)=ZQSAT(JROF)/(1.0_JPRB-RETV*ZQSAT(JROF))
      ENDDO
    ELSE
      DO JROF=IST,IEND
        ZESOP=ES(ZT(JROF,JLEV,IBL))/ZPRSFO(JROF,JLEV)
        ZQSAT(JROF)=FOQS(ZESOP)
      ENDDO
    ENDIF
    DO JROF=IST,IEND
      GFL(JROF,JLEV,YQ%MP,IBL) = MIN( GFL(JROF,JLEV,YQ%MP,IBL) , ZQSAT(JROF) )
      GFL(JROF,JLEV,YQ%MP,IBL) = MAX( GFL(JROF,JLEV,YQ%MP,IBL) , 0.0_JPRB )
    ENDDO
  ENDDO

ENDDO

!     ------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('SUGPQLIM',1,ZHOOK_HANDLE)
END SUBROUTINE SUGPQLIM
