SUBROUTINE GWDRAG_WMSSTL(KIDIA , KFDIA , KLON   , KLEV   , PTSTEP , &
                     &   PTM15 , PUM15 , PVM15  , PAPM15 , PAPHM15, PGEO15, &
                     &   PTENU5, PTENV5, PFLUXU5, PFLUXV5, &
                     &   PTM1  , PUM1  , PVM1   , PAPM1  , PAPHM1 , PGEO1 , &
                     &   PTENU , PTENV , PFLUXU , PFLUXV)

!**** *GWDRAG_WMSSTL*  MASTER ROUTINE FOR NON-OROGRAPHIC GRAVITY WAVE DRAG
!                      SIMPLIFIED VERSION
!                      (Tangent linear)

!     PURPOSE
!     -------

!          THIS ROUTINE COMPUTES NON-OROGRAPHIC GRAVITY WAVE DRAG
!     AFTER SCINOCCA (2003) AND Mc LANDRESS AND SCINOCCIA (JAS 2005)
!     HYDROSTATIC NON-ROTATIONAL SIMPLIFIED VERSION OF THE 
!     WARNER AND MCINTYRE (1996) NON-OROGRAPHIC GRAVITY WAVE PARAMETERIZATION 
!     CONSTANTS HAVE BEEN OPTIMIZED FOLLOWING M. ERN ET AL. (ATMOS. CHEM. PHYS.
!     2006)
! 
!     LAUNCH SPECTRUM - GENERALIZED DESAUBIES 
!     INCLUDES A CRITICAL-LEVEL CORRECTION THAT PREVENTS THE 
!     MOMEMTUM DEPOSITION IN EACH AZIMUTH FROM DRIVING THE FLOW TO SPEEDS 
!     FASTER THAN THE PHASE SPEED OF THE WAVES, I.E. WHEN WAVES BREAK THEY DRAG
!     THE MEAN FLOW TOWARDS THEIR PHASE SPEED - NOT PAST IT.  

!**   INTERFACE.
!     ----------
!          *GWDRAG_WMSSTL* IS CALLED FROM *CALLPARTL*


!*      INPUT PARAMETERS (INTEGER):

!     *KIDIA*        START POINT
!     *KFDIA*        END POINT
!     *KLEV*         NUMBER OF LEVELS
!     *KLON*         NUMBER OF GRID POINTS PER PACKET

!*      INPUT PARAMETERS (REAL):

!     *PTSTEP*       MODEL TIME STEP

!  Trajectory  Perturbation  Description                                Unit
!  PTM15       PTM1          TEMPERATURE AT T-1                         K
!  PUM15       PUM1          X-VELOCITY COMPONENT AT T-1                m/s
!  PVM15       PVM1          Y-VELOCITY COMPONENT AT T-1                m/s
!  PAPM15      PAPM1         FULL MODEL LEVEL PRESSURE AT T-1           Pa
!  PAPHM15     PAPHM1        HALF MODEL LEVEL PRESSURE AT T-1           Pa
!  PGEO15      PGEO1         FULL MODEL LEVEL GEOPOTENTIAL
!  

!*      OUTPUT PARAMETERS (REAL):
!  Trajectory  Perturbation  Description                                Unit
!  PTENU5      PTENU         FULL-MODEL LEVEL ZONAL MOMENTUM TENDENCY
!  PTENV5      PTENV         FULL-MODEL LEVEL MERIDIONAL MOMENTUM 
!                            TENDENCY
!  PFLUXU5     PFLUXU        ZONAL COMPONENT OF VERTICAL MOMENTUM FLUX  Pa
!  PFLUXV5     PFLUXV        MERIDIONAL COMPONENT OF VERTICAL MOMENTUM 
!                            FLUX                                       Pa

!     AUTHOR
!     -------
!     M. Janiskova    ECMWF     14/07/2009 

!     MODIFICATIONS
!     -------------
  
! ------------------------------------------------------------------------------


USE PARKIND1,    ONLY : JPIM, JPRB
USE YOEGWWMS,    ONLY : GCSTAR, GFLUXLAUN, NLAUNCH
USE YOEGWDWMS,   ONLY : LREGWWMS
USE YOMCST,      ONLY : RG, RD, RCPD, RPI
USE YOMHOOK,     ONLY : LHOOK,   DR_HOOK
USE YOEGWD,      ONLY : GSSEC

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)  :: KIDIA, KFDIA
INTEGER(KIND=JPIM),INTENT(IN)  :: KLON
INTEGER(KIND=JPIM),INTENT(IN)  :: KLEV
REAL(KIND=JPRB)   ,INTENT(IN)  :: PTSTEP
REAL(KIND=JPRB)   ,INTENT(IN)  :: PUM15(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)  :: PVM15(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)  :: PTM15(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)  :: PAPM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)  :: PAPHM15(KLON,KLEV+1)
REAL(KIND=JPRB)   ,INTENT(IN)  :: PGEO15(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT) :: PTENU5(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT) :: PTENV5(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT) :: PFLUXU5(KLON,KLEV+1)
REAL(KIND=JPRB)   ,INTENT(OUT) :: PFLUXV5(KLON,KLEV+1)
REAL(KIND=JPRB)   ,INTENT(IN)  :: PUM1(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)  :: PVM1(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)  :: PTM1(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)  :: PAPM1(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)  :: PAPHM1(KLON,KLEV+1)
REAL(KIND=JPRB)   ,INTENT(IN)  :: PGEO1(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT) :: PTENU(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT) :: PTENV(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT) :: PFLUXU(KLON,KLEV+1)
REAL(KIND=JPRB)   ,INTENT(OUT) :: PFLUXV(KLON,KLEV+1)

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

!*       0.1   LOCAL VARIABLES
!              ---------------

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

INTEGER(KIND=JPIM), PARAMETER  :: IAZIDIM=4      !number of azimuths
INTEGER(KIND=JPIM), PARAMETER  :: INCDIM=20      !number of discretized 
                                        ! c spectral elements in launch spectrum

REAL(KIND=JPRB) :: ZUHM1(KLON,KLEV)            !half-model level zonal velocity
REAL(KIND=JPRB) :: ZVHM1(KLON,KLEV)            !half-model level meridional vel.
REAL(KIND=JPRB) :: ZBVFHM1(KLON,KLEV)          !half-model level Brunt-Vaisalla
                                               !                      frequency
REAL(KIND=JPRB) :: ZRHOHM1(KLON,KLEV)          !half-model level density
REAL(KIND=JPRB) :: ZUI(KLON,KLEV,IAZIDIM)      !intrinsic velocity
REAL(KIND=JPRB) :: ZUL(KLON,IAZIDIM)           !velocity in azimuthal direction
                                               !                at launch level
REAL(KIND=JPRB) :: ZBVFL(KLON)                 !buoyancy at launch level
REAL(KIND=JPRB) :: ZFCT(KLON,KLEV)
REAL(KIND=JPRB) :: ZFNORM(KLON)                !normalisation factor (A)
REAL(KIND=JPRB) :: ZTHM1(KLON,KLEV)            !temperature on half-model levels
REAL(KIND=JPRB) :: ZFLUX(KLON,INCDIM,IAZIDIM)  !momentum flux at each vertical 
                                               !             level and azimuth 
REAL(KIND=JPRB) :: ZPU(KLON,KLEV,IAZIDIM)      !momentum flux
REAL(KIND=JPRB) :: ZDFL(KLON,KLEV,IAZIDIM)
REAL(KIND=JPRB) :: ZCRT(KLON,KLEV,IAZIDIM)


REAL(KIND=JPRB) :: ZUHM15(KLON,KLEV)
REAL(KIND=JPRB) :: ZVHM15(KLON,KLEV)
REAL(KIND=JPRB) :: ZBVFHM15(KLON,KLEV)
REAL(KIND=JPRB) :: ZRHOHM15(KLON,KLEV)
REAL(KIND=JPRB) :: ZUI5(KLON,KLEV,IAZIDIM)
REAL(KIND=JPRB) :: ZUL5(KLON,IAZIDIM)
REAL(KIND=JPRB) :: ZBVFL5(KLON)
REAL(KIND=JPRB) :: ZFCT5(KLON,KLEV)
REAL(KIND=JPRB) :: ZFNORM5(KLON)
REAL(KIND=JPRB) :: ZTHM15(KLON,KLEV)
REAL(KIND=JPRB) :: ZFLUX5(KLON,INCDIM,IAZIDIM) 
REAL(KIND=JPRB) :: ZPU5(KLON,KLEV,IAZIDIM)
REAL(KIND=JPRB) :: ZDFL5(KLON,KLEV,IAZIDIM)
REAL(KIND=JPRB) :: ZCRT5(KLON,KLEV,IAZIDIM)

REAL(KIND=JPRB) :: ZCNGL(KLON)
REAL(KIND=JPRB) :: ZU, ZBVFL4
REAL(KIND=JPRB) :: ZFLUXS, ZDEP, ZULM, ZDFT
REAL(KIND=JPRB) :: ZATMP, ZDELP
REAL(KIND=JPRB) :: ZTHMI1, ZDELPI
REAL(KIND=JPRB) :: ZPRULM, ZTHMIB

REAL(KIND=JPRB) :: ZCNGL5(KLON)
REAL(KIND=JPRB) :: ZU5 , ZBVFL45
REAL(KIND=JPRB) :: ZFLUXS5, ZDEP5  , ZULM5, ZDFT5
REAL(KIND=JPRB) :: ZATMP5 , ZDELP5
REAL(KIND=JPRB) :: ZTHMI15, ZDELPI5, ZBVFHMI15, ZDIV15, ZPUI5, ZDFLI5
REAL(KIND=JPRB) :: ZPRULM5, ZTHMIB5

REAL(KIND=JPRB) :: ZCOSANG(IAZIDIM)            !cos of azimuth angle
REAL(KIND=JPRB) :: ZSINANG(IAZIDIM)            !sin of azimuth angle
REAL(KIND=JPRB) :: ZX(INCDIM)                  !coordinate transformation
REAL(KIND=JPRB) :: ZCI(INCDIM)                 !phase speed element
REAL(KIND=JPRB) :: ZACT(KLON,INCDIM,IAZIDIM)   !if=1, critical level encountered
REAL(KIND=JPRB) :: ZACC(KLON,INCDIM,IAZIDIM)
REAL(KIND=JPRB) :: ZDCI(INCDIM)

REAL(KIND=JPRB) :: ZCI_MIN(KLON,IAZIDIM)
REAL(KIND=JPRB) :: ZRADTODEG, ZMS_L, ZMS, ZPTWO
REAL(KIND=JPRB) :: ZCIMIN, ZCIMAX, ZGAM, ZPEXP
REAL(KIND=JPRB) :: ZCONS1,ZCONS2, ZEXP1
REAL(KIND=JPRB) :: ZANG, ZAZ_FCT, ZNORM, ZANG1
REAL(KIND=JPRB) :: ZXMAX, ZXMIN, ZXRAN, ZDX, ZX1, ZX2, ZTX
REAL(KIND=JPRB) :: ZCIN, ZCIN4, ZCINC
REAL(KIND=JPRB) :: Z0p5, Z0p0, ZRGPTS

INTEGER(KIND=JPIM) :: INC, JK, JL, IAZI

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

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

!*       INPUT PARAMETERS
!*       ---------------- 

ZRADTODEG=57.29577951_JPRB

!m_star
ZMS_L=2000.0_JPRB
ZMS=2*RPI/ZMS_L    
ZPTWO=2.0_JPRB          !assume GPTWO=2 in sugwwms.F90
                        !2*p, p is the exponent of omega 

!*       INITIALIZE FIELDS TO ZERO
!*       ------------------------- 

PTENU (:,:)=0.0_JPRB
PTENU5(:,:)=0.0_JPRB
PTENV (:,:)=0.0_JPRB
PTENV5(:,:)=0.0_JPRB

DO IAZI=1,IAZIDIM
  DO JK=1,KLEV
    DO JL=KIDIA,KFDIA
      ZPU  (JL,JK,IAZI)=0.0_JPRB
      ZPU5 (JL,JK,IAZI)=0.0_JPRB
      ZCRT (JL,JK,IAZI)=0.0_JPRB
      ZCRT5(JL,JK,IAZI)=0.0_JPRB
      ZDFL (JL,JK,IAZI)=0.0_JPRB
      ZDFL5(JL,JK,IAZI)=0.0_JPRB
    ENDDO
  ENDDO      
ENDDO         

DO JK=1,KLEV+1
  DO JL=KIDIA,KFDIA
    PFLUXU (JL,JK)=0.0_JPRB
    PFLUXU5(JL,JK)=0.0_JPRB
    PFLUXV (JL,JK)=0.0_JPRB
    PFLUXV5(JL,JK)=0.0_JPRB
  ENDDO
ENDDO


!*       INITIALIZE PARAMETERS FOR COORDINATE TRANSFORM
!*       ----------------------------------------------

! ZCIMIN,ZCIMAX - min,max intrinsic launch-level phase speed (c-U_o) (m/s)
! ZGAM - half=width of coordinate stretch

ZCIMIN=0.25_JPRB
ZCIMAX=100.0_JPRB
ZGAM=0.25_JPRB

ZPEXP=ZPTWO/2.0_JPRB

! set initial min ci in each column and azimuth (used for critical levels)

DO IAZI=1,IAZIDIM
  DO JL=KIDIA,KFDIA
    ZCI_MIN(JL,IAZI)=ZCIMIN
  ENDDO
ENDDO

   
!*       DEFINE HALF MODEL LEVEL WINDS AND TEMPERATURE
!*       -----------------------------------

DO JK=2,KLEV
  DO JL=KIDIA,KFDIA                                        
    ZTHM1 (JL,JK) = 0.5_JPRB*(PTM1 (JL,JK-1)+PTM1 (JL,JK)) 
    ZTHM15(JL,JK) = 0.5_JPRB*(PTM15(JL,JK-1)+PTM15(JL,JK)) 
    ZUHM1 (JL,JK) = 0.5_JPRB*(PUM1 (JL,JK-1)+PUM1 (JL,JK))
    ZUHM15(JL,JK) = 0.5_JPRB*(PUM15(JL,JK-1)+PUM15(JL,JK))
    ZVHM1 (JL,JK) = 0.5_JPRB*(PVM1 (JL,JK-1)+PVM1 (JL,JK))
    ZVHM15(JL,JK) = 0.5_JPRB*(PVM15(JL,JK-1)+PVM15(JL,JK))
  ENDDO
ENDDO
JK=1
DO JL=KIDIA,KFDIA                                        
  ZTHM1 (JL,JK) = PTM1 (JL,JK)
  ZTHM15(JL,JK) = PTM15(JL,JK)
  ZUHM1 (JL,JK) = PUM1 (JL,JK)
  ZUHM15(JL,JK) = PUM15(JL,JK)
  ZVHM1 (JL,JK) = PVM1 (JL,JK)
  ZVHM15(JL,JK) = PVM15(JL,JK)
ENDDO


!*       DEFINE STATIC STABILITY AND AIR DENSITY ON HALF MODEL LEVELS
!*       ------------------------------------------------------------

ZCONS1=1.0_JPRB/RD
ZCONS2=RG**2/RCPD
DO JK=KLEV,2,-1
  DO JL=KIDIA,KFDIA
    ZDELP  = PGEO1 (JL,JK)-PGEO1 (JL,JK-1)
    ZDELP5 = PGEO15(JL,JK)-PGEO15(JL,JK-1)
    ZDELPI5 = 1.0_JPRB/ZDELP5
    ZDELPI  = -ZDELP*ZDELPI5*ZDELPI5

    ZTHMI15 = 1.0_JPRB/ZTHM15(JL,JK)
    ZTHMI1  = -ZTHM1(JL,JK)*ZTHMI15*ZTHMI15
    ZTHMIB  = (PTM15(JL,JK)-PTM15(JL,JK-1))*ZTHMI1 &
     & + (PTM1 (JL,JK)-PTM1 (JL,JK-1))*ZTHMI15
    IF (LREGWWMS) THEN
      IF (PAPM15(JL,JK) > 15000.00_JPRB .AND. PAPM15(JL,JK)<70000.0_JPRB &
       & .AND.(PTM15(JL,JK)-PTM15(JL,JK-1))>3.5_JPRB) THEN
        ZTHMIB  = 0.0_JPRB
      ENDIF
    ENDIF 
    ZTHMIB5 = (PTM15(JL,JK)-PTM15(JL,JK-1))*ZTHMI15

!    ZRHOHM1 (JL,JK) = ZCONS1*(PAPHM15(JL,JK)*ZTHMI1+ZTHMI15*PAPHM1(JL,JK))
    ZRHOHM1 (JL,JK) = ZCONS1*(-ZTHMI15*ZTHMI15*PAPHM15(JL,JK)*ZTHM1(JL,JK) &
     & +ZTHMI15*PAPHM1(JL,JK))
    ZRHOHM15(JL,JK) = PAPHM15(JL,JK)*ZCONS1*ZTHMI15

    ZBVFHM1 (JL,JK) = ZCONS2*(ZTHMI1+RCPD*(ZTHMIB5*ZDELPI+ZDELPI5*ZTHMIB))
    ZBVFHM15(JL,JK) = ZCONS2 &
     & *(ZTHMI15+RCPD*ZTHMIB5*ZDELPI5)
    IF (ZBVFHM15(JL,JK) < GSSEC) THEN
      ZBVFHM1 (JL,JK) = 0.0_JPRB
      ZBVFHM15(JL,JK) = GSSEC
    ENDIF
    ZBVFHM15(JL,JK) = SQRT(ZBVFHM15(JL,JK))
    ZBVFHM1 (JL,JK) = 0.5_JPRB*ZBVFHM1(JL,JK)/ZBVFHM15(JL,JK)
  ENDDO
ENDDO

!*       SET UP AZIMUTH DIRECTIONS AND SOME TRIG FACTORS
!*       -----------------------------------------------     

ZANG=2*RPI/IAZIDIM
ZAZ_FCT=1.0

! get normalization factor to ensure that the same amount of momentum
! flux is directed (n,s,e,w) no mater how many azimuths are selected.
! note, however, the code below assumes a symmetric distribution of
! of azimuthal directions (ie 4,8,16,32,...)

ZNORM=0.0
DO IAZI=1,IAZIDIM
  ZANG1=(IAZI-1)*ZANG
  ZCOSANG(IAZI)=COS(ZANG1)
  ZSINANG(IAZI)=SIN(ZANG1)
  ZNORM=ZNORM+ABS(ZCOSANG(IAZI))
ENDDO
ZAZ_FCT=2._JPRB*ZAZ_FCT/ZNORM

!*       DEFINE COORDINATE TRANSFORM
!*       -----------------------------------------------     

! note that this is expresed in terms of the intrinsic phase speed
! at launch ci=c-u_o so that the transformation is identical at every
! launch site.
! See Eq. 28-30 of Scinocca 2003.
     
ZXMAX=1.0_JPRB/ZCIMIN
ZXMIN=1.0_JPRB/ZCIMAX

ZXRAN=ZXMAX-ZXMIN
ZDX=ZXRAN/REAL(INCDIM-1)
ZX1=ZXRAN/(EXP(ZXRAN/ZGAM)-1.0_JPRB)
ZX2=ZXMIN-ZX1

DO INC=1,INCDIM
  ZTX=REAL(INC-1)*ZDX+ZXMIN
  ZEXP1 = EXP((ZTX-ZXMIN)/ZGAM)
  ZX(INC)=ZX1*ZEXP1+ZX2                                 !Eq. 29 of Scinocca 2003
  ZCI(INC)=1.0_JPRB/ZX(INC)                             !Eq. 28 of Scinocca 2003
  ZDCI(INC)=ZCI(INC)**2*(ZX1/ZGAM)*ZEXP1*ZDX            !Eq. 30 of Scinocca 2003
ENDDO

!*   DEFINE INTRINSIC VELOCITY (RELATIVE TO LAUNCH LEVEL VELOCITY) U(Z)-U(Zo)
!    AND COEFFICINETS
!*   -------------------------------------------------------------------------

DO IAZI=1,IAZIDIM
  DO JL=KIDIA,KFDIA
    ZUL (JL,IAZI) = ZCOSANG(IAZI)*ZUHM1 (JL,NLAUNCH) &
     & + ZSINANG(IAZI)*ZVHM1 (JL,NLAUNCH)
    ZUL5(JL,IAZI) = ZCOSANG(IAZI)*ZUHM15(JL,NLAUNCH) &
     & + ZSINANG(IAZI)*ZVHM15(JL,NLAUNCH)
  ENDDO
ENDDO
DO JL=KIDIA,KFDIA
  ZBVFL (JL) = ZBVFHM1 (JL,NLAUNCH)
  ZBVFL5(JL) = ZBVFHM15(JL,NLAUNCH)
ENDDO

DO IAZI=1,IAZIDIM
  DO JK=2,NLAUNCH
    DO JL=KIDIA,KFDIA
      ZU  = ZCOSANG(IAZI)*ZUHM1 (JL,JK)+ZSINANG(IAZI)*ZVHM1 (JL,JK)
      ZU5 = ZCOSANG(IAZI)*ZUHM15(JL,JK)+ZSINANG(IAZI)*ZVHM15(JL,JK)
      ZUI (JL,JK,IAZI) = ZU -ZUL (JL,IAZI)
      ZUI5(JL,JK,IAZI) = ZU5-ZUL5(JL,IAZI)
    ENDDO
  ENDDO
ENDDO

!*       DEFINE RHO(Zo)/N(Zo)
!*       ------------------- 

DO JK=2,NLAUNCH
  DO JL=KIDIA,KFDIA
    ZBVFHMI15 = 1.0_JPRB/ZBVFHM15(JL,JK)
    ZFCT (JL,JK) = -ZRHOHM15(JL,JK)*ZBVFHMI15*ZBVFHMI15*ZBVFHM1(JL,JK) &
     & +ZBVFHMI15*ZRHOHM1(JL,JK)
    ZFCT5(JL,JK) = ZRHOHM15(JL,JK)*ZBVFHMI15
  ENDDO
ENDDO

!*       SET LAUNCH MOMENTUM FLUX SPECTRAL DENSITY
!*       ----------------------------------------- 

! Eq. (25) of Scinocca 2003 (not including the 'A' component), and with U-Uo=0
! do this for only one azimuth since it is identical to all azimuths, and
! it will be renormalized

! s=1 case : standard, NSLOPE in sugwwms.F90 supposed to be 1
DO INC=1,INCDIM
  ZCIN=ZCI(INC)
  ZCIN4=(ZMS*ZCIN)**4
  DO JL=KIDIA,KFDIA
    ZBVFL4  = 4.0_JPRB*ZBVFL(JL)*ZBVFL5(JL)**3
    ZBVFL45 = ZBVFL5(JL)**4

    ZDIV15 = 1.0_JPRB/(ZBVFL45+ZCIN4)
    ZFLUX (JL,INC,1) = ZCIN*((-ZFCT5(JL,NLAUNCH)*ZBVFL45*ZDIV15*ZDIV15 &
     & + ZFCT5(JL,NLAUNCH)*ZDIV15)*ZBVFL4 + ZBVFL45*ZDIV15*ZFCT(JL,NLAUNCH))
    ZFLUX5(JL,INC,1) = ZFCT5(JL,NLAUNCH)*ZBVFL45*ZCIN*ZDIV15
    ZACT(JL,INC,1)=1.0_JPRB
  ENDDO
ENDDO

!*       NORMALIZE LAUNCH MOMENTUM FLUX
!*       ------------------------------

! (rho x F^H = rho_o x F_p^total)

! integrate (ZFLUX x dX)
DO INC=1,INCDIM
  ZCINC=ZDCI(INC)
  DO JL=KIDIA,KFDIA
    ZPU (JL,NLAUNCH,1) = ZPU (JL,NLAUNCH,1)+ZFLUX (JL,INC,1)*ZCINC
    ZPU5(JL,NLAUNCH,1) = ZPU5(JL,NLAUNCH,1)+ZFLUX5(JL,INC,1)*ZCINC
  ENDDO
ENDDO

!*       NORMALIZE GFLUXLAUN TO INCLUDE SENSITIVITY TO PRECIPITATION
!*       -----------------------------------------------------------

! A=ZFNORM in Scinocca 2003.  A is independent of height.
DO JL=KIDIA,KFDIA       
  ZPUI5 = 1.0_JPRB/ZPU5(JL,NLAUNCH,1)
  ZFNORM (JL) = -GFLUXLAUN*ZPUI5*ZPUI5*ZPU(JL,NLAUNCH,1)
  ZFNORM5(JL) = GFLUXLAUN*ZPUI5
ENDDO

DO IAZI=1,IAZIDIM
  DO JL=KIDIA,KFDIA
    ZPU (JL,NLAUNCH,IAZI) = 0.0_JPRB
    ZPU5(JL,NLAUNCH,IAZI) = GFLUXLAUN
  ENDDO
ENDDO

!*       ADJUST CONSTANT ZFCT
!*       --------------------
DO JK=2,NLAUNCH
  DO JL=KIDIA,KFDIA
    ZFCT (JL,JK) = ZFNORM5(JL)*ZFCT(JL,JK)+ZFCT5(JL,JK)*ZFNORM(JL)
    ZFCT5(JL,JK) = ZFNORM5(JL)*ZFCT5(JL,JK)
  ENDDO
ENDDO

!*       RENORMALIZE EACH SPECTRAL ELEMENT IN ONE AZIMUTH
!*       ------------------------------------------------
DO INC=1,INCDIM
  DO JL=KIDIA,KFDIA
    ZFLUX (JL,INC,1) = ZFNORM5(JL)*ZFLUX(JL,INC,1)+ZFLUX5(JL,INC,1)*ZFNORM(JL)
    ZFLUX5(JL,INC,1) = ZFNORM5(JL)*ZFLUX5(JL,INC,1)
  ENDDO
ENDDO

!*       COPY ZFLUX INTO ALL OTHER AZIMUTHS
!*       --------------------------------

! ZACT=1 then no critical level
! ZACT=0 then critical level

DO IAZI=2,IAZIDIM
  DO INC=1,INCDIM
    DO JL=KIDIA,KFDIA
      ZFLUX (JL,INC,IAZI) = ZFLUX (JL,INC,1)
      ZFLUX5(JL,INC,IAZI) = ZFLUX5(JL,INC,1)
      ZACT(JL,INC,IAZI)=1.0_JPRB
      ZACC(JL,INC,IAZI)=1.0_JPRB
    ENDDO
  ENDDO
ENDDO

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

!*       BEGIN MAIN LOOP OVER LEVELS
!*       ---------------------------

!* begin IAZIDIM do-loop
!* --------------------

DO IAZI=1,IAZIDIM

!* begin JK do-loop
!* ----------------

  DO JK=NLAUNCH-1,2,-1

!* first do critical levels
!* ------------------------

    DO JL=KIDIA,KFDIA
!      IF (ZCI_MIN5(JL,IAZI) < ZUI5(JL,JK,IAZI)) THEN
!        ZCI_MIN (JL,IAZI) = ZUI (JL,JK,IAZI)
!        ZCI_MIN5(JL,IAZI) = ZUI5(JL,JK,IAZI)

!      IF (ZCI_MIN(JL,IAZI) < ZUI5(JL,JK,IAZI)) THEN
!        ZCI_MIN (JL,IAZI) = ZUI5(JL,JK,IAZI)
!      ENDIF

      ZCI_MIN(JL,IAZI)=MAX(ZCI_MIN(JL,IAZI),ZUI5(JL,JK,IAZI))
    ENDDO

!* set ZACT to zero if critical level encountered
!* ----------------------------------------------

    Z0p5=0.5_JPRB
    DO INC=1,INCDIM
      ZCIN=ZCI(INC)
      DO JL=KIDIA,KFDIA
        ZATMP  = 0.0_JPRB
        ZATMP5 = Z0p5+SIGN(Z0p5,ZCIN-ZCI_MIN(JL,IAZI))
        ZACC(JL,INC,IAZI)=ZACT(JL,INC,IAZI)-ZATMP5
        ZACT(JL,INC,IAZI)=ZATMP5
      ENDDO
    ENDDO

!* integrate to get critical-level contribution to mom deposition on this level,
!  i.e. ZACC=1
!* -----------------------------------------------------------------------------

    DO INC=1,INCDIM
      ZCINC=ZDCI(INC)
      DO JL=KIDIA,KFDIA
        ZDFL (JL,JK,IAZI) = ZDFL (JL,JK,IAZI) &
         & + ZACC(JL,INC,IAZI)*ZFLUX (JL,INC,IAZI)*ZCINC
        ZDFL5(JL,JK,IAZI) = ZDFL5(JL,JK,IAZI) &
         & + ZACC(JL,INC,IAZI)*ZFLUX5(JL,INC,IAZI)*ZCINC
      ENDDO
    ENDDO

!* get weighted average of phase speed in layer
!* --------------------------------------------

    DO JL=KIDIA,KFDIA
      IF (ZDFL5(JL,JK,IAZI) > 0.0_JPRB) THEN
        ZATMP  = ZCRT (JL,JK,IAZI)
        ZATMP5 = ZCRT5(JL,JK,IAZI)
        DO INC=1,INCDIM
          ZATMP  = ZATMP +ZCI(INC) &
           & * ZACC(JL,INC,IAZI)*ZFLUX (JL,INC,IAZI)*ZDCI(INC)
          ZATMP5 = ZATMP5+ZCI(INC) &
           & * ZACC(JL,INC,IAZI)*ZFLUX5(JL,INC,IAZI)*ZDCI(INC)
        ENDDO
        ZDFLI5 = 1.0_JPRB/ZDFL5(JL,JK,IAZI)
        ZCRT (JL,JK,IAZI) = -ZATMP5*ZDFLI5*ZDFLI5*ZDFL(JL,JK,IAZI)+ZDFLI5*ZATMP
        ZCRT5(JL,JK,IAZI) = ZATMP5*ZDFLI5
      ELSE
        ZCRT (JL,JK,IAZI) = ZCRT (JL,JK+1,IAZI)
        ZCRT5(JL,JK,IAZI) = ZCRT5(JL,JK+1,IAZI)
      ENDIF
    ENDDO

!* do saturation (Eq. (26) and (27) of Scinocca 2003)
!* -------------------------------------------------
!  case GPTWO=2=ZPTWO in sugwwms.F90

    DO INC=1,INCDIM
      ZCIN=ZCI(INC)
      ZCINC=1.0_JPRB/ZCIN
      DO JL=KIDIA,KFDIA
        ZFLUXS  = GCSTAR*ZCINC*(ZFCT(JL,JK)*(ZCIN-ZUI5(JL,JK,IAZI))**2 &
         & -2.0_JPRB*ZFCT5(JL,JK)*(ZCIN-ZUI5(JL,JK,IAZI))*ZUI(JL,JK,IAZI))
        ZFLUXS5 = GCSTAR*ZFCT5(JL,JK)*(ZCIN-ZUI5(JL,JK,IAZI))**2*ZCINC
        ZDEP  = ZACT(JL,INC,IAZI)*(ZFLUX (JL,INC,IAZI)-ZFLUXS )
        ZDEP5 = ZACT(JL,INC,IAZI)*(ZFLUX5(JL,INC,IAZI)-ZFLUXS5)
        IF (ZDEP5 > 0.0_JPRB) THEN
          IF (LREGWWMS .AND. INC >= INCDIM-2) THEN
            ZFLUX (JL,INC,IAZI) = 0.0_JPRB
          ELSE
            ZFLUX (JL,INC,IAZI) = ZFLUXS
          ENDIF
          ZFLUX5(JL,INC,IAZI) = ZFLUXS5
        ENDIF
      ENDDO
    ENDDO

!* integrate spectrum
!* ------------------            

    DO INC=1,INCDIM
      ZCINC=ZDCI(INC)
      DO JL=KIDIA,KFDIA
        ZPU (JL,JK,IAZI) = ZPU (JL,JK,IAZI) &
         & + ZACT(JL,INC,IAZI)*ZFLUX (JL,INC,IAZI)*ZCINC
        ZPU5(JL,JK,IAZI) = ZPU5(JL,JK,IAZI) &
         & + ZACT(JL,INC,IAZI)*ZFLUX5(JL,INC,IAZI)*ZCINC
      ENDDO
    ENDDO

!* end JK do-loop
!* --------------

  ENDDO

!* end IAZIDIM do-loop
!* ---------------

ENDDO

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

!*       MAKE CORRECTION FOR CRITICAL-LEVEL MOMENTUM DEPOSITION
!*       ------------------------------------------------------

Z0p0=0._JPRB
ZRGPTS=1.0_JPRB/(RG*PTSTEP)
DO IAZI=1,IAZIDIM
  DO JL=KIDIA,KFDIA
    ZCNGL (JL) = 0.0_JPRB
    ZCNGL5(JL) = 0.0_JPRB
  ENDDO
  DO JK=2,NLAUNCH
    DO JL=KIDIA,KFDIA
      ZULM  = ZCOSANG(IAZI)*PUM1 (JL,JK)+ZSINANG(IAZI)*PVM1 (JL,JK) &
       & - ZUL (JL,IAZI)
      ZULM5 = ZCOSANG(IAZI)*PUM15(JL,JK)+ZSINANG(IAZI)*PVM15(JL,JK) &
       & - ZUL5(JL,IAZI)
      ZDFL (JL,JK-1,IAZI) = ZDFL (JL,JK-1,IAZI)+ZCNGL (JL)
      ZDFL5(JL,JK-1,IAZI) = ZDFL5(JL,JK-1,IAZI)+ZCNGL5(JL)

      ZPRULM  = 2.0_JPRB*ZRGPTS*((PAPM15(JL,JK-1)-PAPM15(JL,JK)) &
       & * (ZCRT(JL,JK-1,IAZI)-ZULM) &
       & + (ZCRT5(JL,JK-1,IAZI)-ZULM5)*(PAPM1(JL,JK-1)-PAPM1(JL,JK)))
      ZPRULM5 = 2.0_JPRB*(PAPM15(JL,JK-1)-PAPM15(JL,JK)) &
       & * (ZCRT5(JL,JK-1,IAZI)-ZULM5)*ZRGPTS
      IF (ZDFL5(JL,JK-1,IAZI) > ZPRULM5) THEN
        ZDFT  = ZPRULM
        ZDFT5 = ZPRULM5
      ELSE
        ZDFT  = ZDFL (JL,JK-1,IAZI)
        ZDFT5 = ZDFL5(JL,JK-1,IAZI)
      ENDIF
      IF (ZDFT5 < Z0p0) THEN
        ZDFT  = 0.0_JPRB
        ZDFT5 = Z0p0
      ENDIF
      ZCNGL (JL) = (ZDFL (JL,JK-1,IAZI)-ZDFT )
      ZCNGL5(JL) = (ZDFL5(JL,JK-1,IAZI)-ZDFT5)
      ZPU (JL,JK,IAZI) = ZPU (JL,JK,IAZI)-ZCNGL (JL)
      ZPU5(JL,JK,IAZI) = ZPU5(JL,JK,IAZI)-ZCNGL5(JL)
    ENDDO
  ENDDO
ENDDO


!*       SUM CONTRIBUTION FOR TOTAL ZONAL AND MERIDIONAL FLUX
!*       ---------------------------------------------------

DO IAZI=1,IAZIDIM
  DO JK=NLAUNCH,2,-1
    DO JL=KIDIA,KFDIA
      PFLUXU (JL,JK) = PFLUXU (JL,JK)+ZPU (JL,JK,IAZI)*ZAZ_FCT*ZCOSANG(IAZI)
      PFLUXU5(JL,JK) = PFLUXU5(JL,JK)+ZPU5(JL,JK,IAZI)*ZAZ_FCT*ZCOSANG(IAZI)
      PFLUXV (JL,JK) = PFLUXV (JL,JK)+ZPU (JL,JK,IAZI)*ZAZ_FCT*ZSINANG(IAZI)
      PFLUXV5(JL,JK) = PFLUXV5(JL,JK)+ZPU5(JL,JK,IAZI)*ZAZ_FCT*ZSINANG(IAZI)
    ENDDO
  ENDDO
ENDDO


!*    UPDATE U AND V TENDENCIES
!*    ----------------------------   

DO JK=1,NLAUNCH
  DO JL=KIDIA, KFDIA
    ZDELP5 = 1.0_JPRB/(PAPHM15(JL,JK+1)-PAPHM15(JL,JK))
    ZDELP  = -(PAPHM1(JL,JK+1)-PAPHM1(JL,JK))*ZDELP5*ZDELP5
    PTENU (JL,JK) = RG*((PFLUXU5(JL,JK+1)-PFLUXU5(JL,JK))*ZDELP &
     & + ZDELP5*(PFLUXU(JL,JK+1)-PFLUXU(JL,JK)))
    PTENU5(JL,JK) = (PFLUXU5(JL,JK+1)-PFLUXU5(JL,JK))*RG*ZDELP5
    PTENV (JL,JK) = RG*((PFLUXV5(JL,JK+1)-PFLUXV5(JL,JK))*ZDELP &
     & + ZDELP5*(PFLUXV(JL,JK+1)-PFLUXV(JL,JK)))
    PTENV5(JL,JK) = (PFLUXV5(JL,JK+1)-PFLUXV5(JL,JK))*RG*ZDELP5

    IF (LREGWWMS .AND. PAPM15(JL,JK) > 20000.0_JPRB) THEN
      PTENU (JL,JK) = 0.0_JPRB
      PTENV (JL,JK) = 0.0_JPRB
    ENDIF
  ENDDO
ENDDO

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

IF (LHOOK) CALL DR_HOOK('GWDRAG_WMSSTL',1,ZHOOK_HANDLE)

END SUBROUTINE GWDRAG_WMSSTL
