SUBROUTINE SUGWD(KULOUT,KLEV,PVAH,PVBH)

!**** *SUGWD* INITIALIZE COMMON YOEGWD CONTROLLING GRAVITY WAVE DRAG

!     PURPOSE.
!     --------
!           INITIALIZE YOEGWD, THE COMMON THAT CONTROLS THE
!           GRAVITY WAVE DRAG PARAMETRIZATION.

!**   INTERFACE.
!     ----------
!        CALL *SUGWD* FROM *SUPHEC*
!              -----        ------

!        EXPLICIT ARGUMENTS :
!        --------------------
!        KULOUT      : LOGICAL UNIT FOR THE OUTPUT
!        PVAH,PVBH   : VERTICAL COORDINATE TABLE
!        KLEV        : NUMBER OF MODEL LEVELS

!        IMPLICIT ARGUMENTS :
!        --------------------
!        COMMON YOEGWD

!     METHOD.
!     -------
!        SEE DOCUMENTATION

!     EXTERNALS.
!     ----------
!        NONE

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

!     AUTHOR.
!     -------
!        MARTIN MILLER             *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 90-01-01       ALSO : 95-01-20
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        P.Bechtold    14-Jan-2009 precompute levels for RF
!        P.Bechtold    04-Oct-2010 simplify precomp of NGWDLIM
!     ------------------------------------------------------------------

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

USE YOEPHY   , ONLY : LEPHYS
USE YOEGWD   , ONLY : NKTOPG   ,GFRCRIT  ,GRCRIT   ,&
 & GKDRAG   ,GKWAKE   ,&
 & GSSEC    ,GTSEC    ,GVSEC    ,NGWDLIM  ,GTENLIM ,&
 & NGWDTOP  ,GRFPLM
USE YOMSTA  , ONLY   : STPRE
USE YOMDYNCORE, ONLY : LDYNCORE
USE YOMLUN, ONLY: NULNAM

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KULOUT 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVAH(KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVBH(KLEV+1) 
!      ----------------------------------------------------------------

INTEGER(KIND=JPIM) :: JK

REAL(KIND=JPRB) :: ZPM1R(KLEV), ZPR, ZSIGT, ZPLIM
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "posnam.intfb.h"
#include "namgwd.h"

!*       1.    SET THE VALUES OF THE PARAMETERS
!              --------------------------------

IF (LHOOK) CALL DR_HOOK('SUGWD',0,ZHOOK_HANDLE)

ZSIGT=0.94_JPRB
ZPR  =80000._JPRB

!  As a security measure when running with few levels,
!  we force NKTOPG=KLEV to make sure it is defined

NKTOPG=KLEV

DO JK=KLEV,1,-1
  ZPM1R(JK)=0.5_JPRB*(PVAH(JK)+PVAH(JK+1)+ZPR*(PVBH(JK)+PVBH(JK+1)))
  IF((ZPM1R(JK)/ZPR) >= ZSIGT)THEN
    NKTOPG=JK
  ENDIF
ENDDO

GRFPLM=9.9_JPRB
NGWDTOP=1
DO JK=1,KLEV
  IF(ZPM1R(JK)<GRFPLM)THEN
    NGWDTOP=JK
  ENDIF
ENDDO

GKDRAG =0.3_JPRB
GKWAKE =1._JPRB
!  Revised gwd parameter values
GKDRAG =0.15_JPRB
GKWAKE =1.3_JPRB

GRCRIT =0.25_JPRB
GFRCRIT=0.5_JPRB

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

!*       2.    SET VALUES OF SECURITY PARAMETERS
!              ---------------------------------

GVSEC=0.10_JPRB
GSSEC=1.E-12_JPRB

GTSEC=1.E-07_JPRB

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

!*       3.    SET VALUES OF PARAMETERS FOR LIMITING
!*             THE WIND TENDENCIES IN STRATOSPHERE AND MESOSPHERE

! WIND TENDENCIES LIMITED ABOVE 50hPa
IF(KLEV > 19)THEN
  ZPLIM=5000._JPRB
ELSE
  ZPLIM=1000._JPRB
ENDIF

NGWDLIM=0
DO JK=KLEV,1,-1
  IF(STPRE(JK) >= ZPLIM) THEN
    NGWDLIM=JK
  ENDIF
ENDDO


! * Reset NGWDLIM in order to have NGWDLIM+1 < 1 if ECMWF physics is not called,
!   because the following test on PVBH(NGWDLIM+1) must NEVER generate an
!   abor1 when ECMWF physics is not called.
IF( LDYNCORE.OR..NOT.LEPHYS ) THEN
  NGWDLIM=0
ENDIF

WRITE(KULOUT,*) ' SUGWD: NGWDLIM=',NGWDLIM

! SECURITY CHECK
IF(PVBH(NGWDLIM+1) > 1.E-12_JPRB ) THEN
  CALL ABOR1(' SUGWD: level NGWDLIM not a pure pressure level. &
   & Decrease ZPLIM in SUGWD!')  
ENDIF

! WIND TENDENCIES LIMITED TO LESS OR EQUAL TO 20.m/s per hour
!  Recommend a value of at least 80.m/s per hour
GTENLIM=20.0_JPRB/3600.0_JPRB

CALL POSNAM(NULNAM,'NAMGWD')
READ (NULNAM,NAMGWD)

WRITE(KULOUT,*) ' SUGWD: GTENLIM=',GTENLIM

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