SUBROUTINE GPCTY_FORC( &
 ! --- INPUT -----------------------------------------------------------------
 & KST,KEND, &
 & PFORC, &
 & PRE0F, PTT0, PR0, & 
 ! --- OUTPUT ----------------------------------------------------------------            
 & PEVEL, PVVEL )

!****GPCTY_FORC** -  Computes large scale vertical velocities for hybrid coordinate
!                    from large scale forcing read in initial file and stored in PFORC
!                    (the only coded case is for a forcing given in term of w=Dz/DT)

!     Purpose.
!     --------
!      Computes the vertical velocities
!       "etadot (d prehyd / d eta)" on interlayers and
!       "(omega / prehyd)" on layers
!      from a given large scale w=Dz/DT prescribed as a forcing

!      These two terms are necessary to compute the large scale vertical advection
!      in 1D model (SCUM)

!      The computations of PVVEL and PEVEL in this routine 
!      overwrite the computations of GPCTY (which give PEVEL=PVVEL=0 in 1D)

!      1* The large scale vertical velocity w is computed from the values stored in PFORC
!         If only one large scale vertical velocity field is present in PFORC (NLSW_NUM=1)
!         this forcing is applied at each time step
!         If a different forcing is prescibed every NLSW_TIME (in second), w at time t
!         is computed by a linear interpolation between the two prescibed forcings 
!         surrounding time t

!      2* PVVEL is computed at full level with the hydrostatic simplified formulation
!         omega/p = - (g w) / (R T)
!         ZEVEL is computed at full levels as PVVEL* pressure at full levels (PRE0F)
!         ZEVEL is interpolated by a simple averaging from full to half levels (==> PEVEL)

!      Restrictions of use: the code is currently not available for:
!      * LRUBC=T
!      * NDPSFI=1
!      * LVERCOR=T

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

!        Explicit arguments :
!        --------------------
!         * INPUT:
!        KST       : first element of work
!        KEND      : last element of work
!        PFORC     : forcings (the all part of GFL dedicated for forcing)
!        PRE0F     : hydrostatic pressure "prehyd" on layers (full levels) at time t
!        PTT0      : temperature at time t (full levels)
!        PR0       : air constant "R" at t (full levels)
!         * OUTPUT:
!        PVVEL0    : "omega/prehyd" at t (full levels)
!        PEVEL0    : "etadot d prehyd / d eta" at t (half levels)
!                    not yet coded for LVERTFE=T (finite difference) 

!        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 YOMCST   , ONLY : RG
USE YOM_YGFL , ONLY : NGFL_FORC
USE YOMRIP   , ONLY : RSTATI
USE YOMCVER  , ONLY : LVERTFE

USE YOMLSFORC , ONLY : NLSW_NUM, NLSW_DEB, NLSW_TIME

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)       :: KST 
INTEGER(KIND=JPIM),INTENT(IN)       :: KEND 
REAL(KIND=JPRB)   ,INTENT(IN)       :: PFORC(NPROMA,NFLEVG,NGFL_FORC)
REAL(KIND=JPRB)   ,INTENT(IN)       :: PRE0F(NPROMA,NFLEVG)
REAL(KIND=JPRB)   ,INTENT(IN)       :: PTT0(NPROMA,NFLEVG)
REAL(KIND=JPRB)   ,INTENT(IN)       :: PR0(NPROMA,NFLEVG)
REAL(KIND=JPRB)   ,INTENT(INOUT)    :: PEVEL(NPROMA,0:NFLEVG)
REAL(KIND=JPRB)   ,INTENT(INOUT)    :: PVVEL(NPROMA,NFLEVG)

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

INTEGER(KIND=JPIM) :: JROF, JLEV     
INTEGER(KIND=JPIM) :: IINDECH, IINDA, IINDB                                     
REAL(KIND=JPRB)    :: ZEVEL(NPROMA,NFLEVG)
REAL(KIND=JPRB)    :: ZFW(NPROMA,NFLEVG)
REAL(KIND=JPRB)    :: ZA, ZB

REAL(KIND=JPRB)    :: ZHOOK_HANDLE

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

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

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

!*       1.    Computation of large scale w (m/s) for time t
!              ---------------------------------------------

IF(NLSW_NUM == 1) THEN

  ! Case of constant forcing
  IINDA = NLSW_DEB
  DO JROF=KST,KEND
    DO JLEV=1,NFLEVG
      ZFW(JROF,JLEV) =  PFORC(JROF,JLEV,IINDA)
    ENDDO
  ENDDO

ELSEIF(NLSW_NUM > 1) THEN

  ! Case of forcing varying in time : linear interpolation between two forcing times
  IINDECH= INT(RSTATI / NLSW_TIME)
  IINDA = NLSW_DEB + IINDECH
  IINDB = NLSW_DEB + IINDECH+1
  DO JROF=KST,KEND
    DO JLEV=1,NFLEVG
      ZA= ( PFORC(JROF,JLEV,IINDB)-PFORC(JROF,JLEV,IINDA) ) &
       & / REAL(NLSW_TIME,JPRB)
      ZB= PFORC(JROF,JLEV,IINDA)
      ZFW(JROF,JLEV) = ZA*(RSTATI-REAL(IINDECH,JPRB)*REAL(NLSW_TIME,JPRB))+ZB
    ENDDO
  ENDDO

ENDIF

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

!*       2.    Computation of large scale omega/p and m*eta_dot

! transformation of the w(m/s) given by the large scale forcing 
! into omega/p and m*eta_dot at full levels (simplified hydrostatic formulation)

DO JROF=KST,KEND
  DO JLEV=1,NFLEVG
    PVVEL(JROF,JLEV) = - ZFW(JROF,JLEV) * RG &
     & / ( PR0(JROF,JLEV) * PTT0(JROF,JLEV) )
    ZEVEL(JROF,JLEV) = - ZFW(JROF,JLEV) * RG * PRE0F(JROF,JLEV) &
     & / ( PR0(JROF,JLEV) * PTT0(JROF,JLEV) )
  ENDDO
ENDDO

! imposed values of m*eta_dot (PEVEL) at the surface and at the model top
! (the surface condition may be questionned for deltam=1)
! Assumes that LRUBC=F and NDPSFI=0.

DO JROF=KST,KEND
  PEVEL(JROF,NFLEVG) = 0._JPRB
  PEVEL(JROF,0) = 0._JPRB
ENDDO

IF (LVERTFE) THEN
  ! * PEVEL at full levels, simply copy ZEVEL into PEVEL.
  PEVEL(KST:KEND,1:NFLEVG)=ZEVEL(KST:KEND,1:NFLEVG) 
ELSE
  ! * PEVEL at half levels, for the time being a simple average between
  !   ZEVEL at full levels is done but this is probably not fully consistent
  !   with some other vertical discretisation, a cleaner solution must be
  !   studied in the future. 
  DO JROF=KST,KEND
    DO JLEV=2,NFLEVG
      PEVEL(JROF,JLEV-1) = 0.5_JPRB*( ZEVEL(JROF,JLEV)+ZEVEL(JROF,JLEV-1) )
    ENDDO
  ENDDO
ENDIF 

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

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