SUBROUTINE CP_FORCING( &
 ! --- INPUT -----------------------------------------------------------------
 & KST,KEND, &
 & PDT, &
 & PFORC, &
 & PUT0, PVT0, &
 ! --- OUTPUT ----------------------------------------------------------------  
 & PUT1,PVT1,PTT1,PQT1 )

!****CP_FORCING** -  Computes large scale forcing at time t from PFORC
!                    and force u,v,T and/or q at t+1

!     Purpose.
!     --------
!    Add large scale tendencies computed from prescribed 
!    large scale forcing to variables at time t+dt

!    This routine is validated only for SCUM (Single Column Unified Model)

!    The forcing are always computed at time t
!    (i.e. de-centred scheme in 2-TL and centred scheme in 3-TL ;
!    if predictor/corrector is used, the type of scheme change 
!    between predictor and corrector )

!    For each type of forcing (type XXX),
!    if only one forcing is present in PFORC (NXXX_NUM=1),
!    this forcing is applied at each time step
!    If a different forcing is prescibed every NXXX_TIME (in second), 
!    the forcing at time t is computed
!    by a linear interpolation between the two prescibed forcings 
!    surrounding time t

! For the time being, 3 types of forcing are available 
! (but more may be included easily later ...)

! 1. Geostrophic forcing (the presciption of a geostrophic wind and
!    a Coriolis parameter is equivalent 
!    to the presciption of a large scale pressure gradient force)

! 2. Large scale advection of temperature

! 3. Large scale advection of specific humidity

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

!        Explicit arguments :
!        --------------------
!         * INPUT:
!        KST       : first element of work
!        KEND      : last element of work
!        PDT       : For a leap-frog scheme (three time level scheme):
!                     'dt' at the first time-step, '2 dt' otherwise.
!                    For a 2TL SL scheme: timestep 'dt'.
!        PFORC     : forcings (the all part of GFL dedicated for forcing)
!        PUT0      : zonal wind at time t
!        PVT0      : meridional wind at time t

!         * OUTPUT:
!        PUT1      : zonal wind at time t+dt
!        PVT1      : meridional wind at time t+dt
!        PTT1      : temperature at time t+dt
!        PQT1      : specific humidity at time t+dt

!        Implicit arguments :   None.
!        --------------------

!     Method.
!     -------
!        See SCUM (Single Column Unified Model) documentation

!     Externals.    None.
!     ----------

!     Reference.
!     ----------
!        See SCUM documentation

!     Author.
!     -------
!        Sylvie Malardel

!     Modifications.
!     --------------
!        Original : 06-06-06
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
 
USE YOMDIM   , ONLY : NFLEVG ,NPROMA
USE YOM_YGFL , ONLY : NGFL_FORC
USE YOMRIP   , ONLY : RSTATI

USE YOMLSFORC, ONLY : LGEOST_UV_FRC, RCORIO_FORC, NGEOST_UV_TIME, &
 & NGEOST_U_DEB, NGEOST_U_NUM, NGEOST_V_DEB, NGEOST_V_NUM, &
 & LT_ADV_FRC, NT_ADV_TIME, NT_ADV_DEB,  NT_ADV_NUM, &
 & LQV_ADV_FRC, NQV_ADV_TIME, NQV_ADV_DEB,  NQV_ADV_NUM

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KST 
INTEGER(KIND=JPIM),INTENT(IN)    :: KEND 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDT
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFORC(NPROMA,NFLEVG,NGFL_FORC) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUT0(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVT0(NPROMA,NFLEVG)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PUT1(NPROMA,NFLEVG)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVT1(NPROMA,NFLEVG)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTT1(NPROMA,NFLEVG)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQT1(NPROMA,NFLEVG)

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

INTEGER(KIND=JPIM) :: JROF, JLEV  
INTEGER(KIND=JPIM) ::  IINDECH, IINDA, IINDB                              
REAL(KIND=JPRB)    :: ZA, ZB, ZFU, ZFV, ZFT, ZFQ
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

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

!* 1. Geostrophic forcing
!     ------------------- 

IF(LGEOST_UV_FRC) THEN

  IF (NGEOST_U_NUM == 1) THEN
    ! Constant forcing
    ! Zonal componant
    IINDA = NGEOST_U_DEB
    DO JROF=KST,KEND
      DO JLEV=1,NFLEVG
        ZFU = PFORC(JROF,JLEV,IINDA)
        PVT1(JROF,JLEV)=PVT1(JROF,JLEV)-RCORIO_FORC*(PUT0(JROF,JLEV)-ZFU)*PDT
      ENDDO
    ENDDO

  ELSEIF (NGEOST_U_NUM > 1) THEN
    ! time interpolation of the two forcings surrounding time t
    IINDECH= INT(RSTATI / NGEOST_UV_TIME)
    IINDA = NGEOST_U_DEB + IINDECH
    IINDB = NGEOST_U_DEB + IINDECH+1

    DO JROF=KST,KEND
      DO JLEV=1,NFLEVG
        ZA = ( PFORC(JROF,JLEV,IINDB)-PFORC(JROF,JLEV,IINDA) ) &
         &   / REAL(NGEOST_UV_TIME,JPRB)
        ZB = PFORC(JROF,JLEV,IINDA)
        ZFU = ZA*(RSTATI-REAL(IINDECH,JPRB)*REAL(NGEOST_UV_TIME,JPRB))+ZB
        PVT1(JROF,JLEV)=PVT1(JROF,JLEV)-RCORIO_FORC*(PUT0(JROF,JLEV)-ZFU)*PDT
      ENDDO
    ENDDO
  ENDIF

  IF (NGEOST_V_NUM == 1) THEN
    ! Constant forcing
    ! Meridional componant
    IINDA = NGEOST_V_DEB
    DO JROF=KST,KEND
      DO JLEV=1,NFLEVG
        ZFV = PFORC(JROF,JLEV,IINDA)
        PUT1(JROF,JLEV)=PUT1(JROF,JLEV)+RCORIO_FORC*(PVT0(JROF,JLEV)-ZFV)*PDT
      ENDDO
    ENDDO
  ELSEIF (NGEOST_V_NUM > 1) THEN
    ! time interpolation of the two forcings surrounding time t
    IINDA = NGEOST_V_DEB + IINDECH
    IINDB = NGEOST_V_DEB + IINDECH+1
    DO JROF=KST,KEND
      DO JLEV=1,NFLEVG
        ZA = ( PFORC(JROF,JLEV,IINDB)-PFORC(JROF,JLEV,IINDA) ) &
         &   / REAL(NGEOST_UV_TIME,JPRB)
        ZB = PFORC(JROF,JLEV,IINDA)
        ZFV = ZA*(RSTATI-REAL(IINDECH,JPRB)*REAL(NGEOST_UV_TIME,JPRB))+ZB
        PUT1(JROF,JLEV)=PUT1(JROF,JLEV)+RCORIO_FORC*(PVT0(JROF,JLEV)-ZFV)*PDT
      ENDDO
    ENDDO
  ENDIF

ENDIF

!* 2. Large scale advection of temperature
!     ------------------------------------

IF(LT_ADV_FRC) THEN

  IF (NT_ADV_NUM == 1) THEN
    ! constant forcing
    IINDA = NT_ADV_DEB
    DO JROF=KST,KEND
      DO JLEV=1,NFLEVG
        ZFT = PFORC(JROF,JLEV,IINDA)
        PTT1(JROF,JLEV)=PTT1(JROF,JLEV)+PDT*ZFT
      ENDDO
    ENDDO
  ELSEIF (NT_ADV_NUM > 1) THEN 
    ! time interpolation of the two forcings surrounding time t
    IINDECH= INT(RSTATI / NT_ADV_TIME)
    IINDA = NT_ADV_DEB + IINDECH
    IINDB = NT_ADV_DEB + IINDECH+1

    DO JROF=KST,KEND
      DO JLEV=1,NFLEVG
        ZA= ( PFORC(JROF,JLEV,IINDB)-PFORC(JROF,JLEV,IINDA) ) &
         &   / REAL(NT_ADV_TIME,JPRB)
        ZB= PFORC(JROF,JLEV,IINDA)
        ZFT = ZA*(RSTATI-REAL(IINDECH,JPRB)*REAL(NT_ADV_TIME,JPRB))+ZB
        PTT1(JROF,JLEV)=PTT1(JROF,JLEV)+PDT*ZFT
      ENDDO
    ENDDO
  ENDIF

ENDIF

!* 3. Large scale advection of specific humidity
!     ------------------------------------------

IF(LQV_ADV_FRC) THEN

  IF (NQV_ADV_NUM == 1) THEN
    ! Constant forcing
    IINDA = NQV_ADV_DEB
    DO JROF=KST,KEND
      DO JLEV=1,NFLEVG
        ZFQ = PFORC(JROF,JLEV,IINDA)
        PQT1(JROF,JLEV)=PQT1(JROF,JLEV)+PDT*ZFQ
      ENDDO
    ENDDO
  ELSEIF (NQV_ADV_NUM > 1) THEN
    ! time interpolation of the two forcings surrounding time t
    IINDECH= INT(RSTATI / NQV_ADV_TIME)
    IINDA = NQV_ADV_DEB + IINDECH
    IINDB = NQV_ADV_DEB + IINDECH+1

    DO JROF=KST,KEND
      DO JLEV=1,NFLEVG
        ZA= ( PFORC(JROF,JLEV,IINDB)-PFORC(JROF,JLEV,IINDA) ) &
         &   / REAL(NQV_ADV_TIME,JPRB)
        ZB= PFORC(JROF,JLEV,IINDA)
        ZFQ = ZA*(RSTATI-REAL(IINDECH,JPRB)*REAL(NQV_ADV_TIME,JPRB))+ZB
        PQT1(JROF,JLEV)=PQT1(JROF,JLEV)+PDT*ZFQ
      ENDDO
    ENDDO
  ENDIF

ENDIF

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

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