SUBROUTINE GPMPFC(&
 ! --- INPUT ---------------------------------------------------------
 & KST,KEN,KFLAG,PGM,&
 ! --- INPUT/OUTPUT --------------------------------------------------
 & PUT0,PVT0,PDIVT0,PTT0L,PTT0M,PSPDT0L,PSPDT0M,PSVDT0L,PSVDT0M,&
 & PGMVNHX0L,PGMVNHX0M,&
 & PUT9,PVT9,PDIVT9,PTT9L,PTT9M,PSPDT9L,PSPDT9M,PSVDT9L,PSVDT9M,&
 & PUT0L,PVT0L,PVORT0,&
 & PUT9L,PVT9L,PVORT9,&
 & PGFL)

!**** *GPMPFC* - Apply map factor to convert 
!                reduced variables -> geographical variables if kflag=0
!                or
!                geographical variables -> reduced variables if kflag=1

!     Purpose.
!     --------
!           Multiply or divide by map factor.

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

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

!      INPUT:
!      ------
!       KST       - start of work
!       KEN       - depth of work
!       KFLAG     - 0 -> multiply, 1-> divide
!       PGM       - map factor

!      INPUT/OUTPUT:
!      -------------
!       P.T0.     - timestep t for non-GFL variables
!       P.T9.     - timestep t-dt for non-GFL variables
!       PGFL      - GFL variables

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

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

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

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

!     Author.
!     -------
!        Mats Hamrud  *ECMWF*

! Modifications
! -------------
!   Original : 1994-01-18
!   Modified 1995-02-06 by C. Temperton: two-time-level scheme
!   Modified 1998-01-07 by E. Holm     : spectral ozone
!   Modified 2001-09-30 by P.Smolikova : variable d4 in NH
!   Modified 2002-07-02 by C. Fischer  : rename NHS variables T0/T9
!   Modified 2002-11-13 by K. YESSAD   : some cleanings + improve vectorization
!   Modified 2003-08    by M. HAMRUD   : GFL
!   01-Oct-2003 M. Hamrud  CY28 Cleaning
!   08-Jun-2004 J. Masek   NH cleaning (LVSLWBC)
!   01-Jul-2004 K. Yessad  Make clearer the tests for PC scheme.
!   09-Feb-2006 M. Deque : Dasux compilance
!   K. Yessad (Dec 2008): remove dummy CDLOCK
! End Modifications
!     ------------------------------------------------------------------

USE PARKIND1 , ONLY : JPIM     ,JPRB
USE YOMCT0   , ONLY : LTWOTL   ,LNHDYN   ,LPC_FULL
USE YOMDIM   , ONLY : NFLEVG   ,NPROMA   ,LVOR     ,LUVDER ,&
 & NPROMNH
USE YOMDYNA  , ONLY : LNHXDER
USE YOMDYN   , ONLY : NCURRENT_ITER
USE YOMHOOK  , ONLY : LHOOK    ,DR_HOOK
USE YOM_YGFL , ONLY : YGFL     ,YGFLC

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KST 
INTEGER(KIND=JPIM),INTENT(IN)    :: KEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLAG 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGM(NPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PUT0(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVT0(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDIVT0(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTT0L(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTT0M(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPDT0L(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPDT0M(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSVDT0L(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSVDT0M(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGMVNHX0L(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGMVNHX0M(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PUT9(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVT9(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDIVT9(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTT9L(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTT9M(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPDT9L(NPROMNH,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPDT9M(NPROMNH,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSVDT9L(NPROMNH,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSVDT9M(NPROMNH,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PUT0L(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVT0L(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVORT0(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PUT9L(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVT9L(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVORT9(NPROMA,NFLEVG) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGFL(NPROMA,NFLEVG,YGFL%NDIM) 

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

REAL(KIND=JPRB) :: ZGM(NPROMA)

INTEGER(KIND=JPIM) :: JLEV, JGFL,JROF
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"

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

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

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

!*       1. APPLY MAP FACTOR.
!           -----------------

IF(KFLAG == 0) THEN
  ZGM(KST:KEN) = PGM(KST:KEN)
ELSEIF(KFLAG == 1) THEN
  ZGM(KST:KEN) = 1.0_JPRB/PGM(KST:KEN)
ELSE
  CALL ABOR1('GPMPFC: ILLEGAL KFLAG')
ENDIF

DO JLEV=1,NFLEVG
  PUT0  (KST:KEN,JLEV) = PUT0  (KST:KEN,JLEV)      * ZGM(KST:KEN)
  PVT0  (KST:KEN,JLEV) = PVT0  (KST:KEN,JLEV)      * ZGM(KST:KEN)
  PDIVT0(KST:KEN,JLEV) = PDIVT0(KST:KEN,JLEV)      *(ZGM(KST:KEN)**2)
  PTT0L (KST:KEN,JLEV) = PTT0L (KST:KEN,JLEV)      * ZGM(KST:KEN)
  PTT0M (KST:KEN,JLEV) = PTT0M (KST:KEN,JLEV)      * ZGM(KST:KEN)
  IF ((NCURRENT_ITER == 0).OR.(NCURRENT_ITER > 0 .AND. LPC_FULL)) THEN
    PUT9  (KST:KEN,JLEV) = PUT9  (KST:KEN,JLEV)      * ZGM(KST:KEN)
    PVT9  (KST:KEN,JLEV) = PVT9  (KST:KEN,JLEV)      * ZGM(KST:KEN)
  ENDIF
  IF (.NOT.LTWOTL.AND. &
   & ((NCURRENT_ITER == 0).OR.(NCURRENT_ITER > 0 .AND. LPC_FULL))) THEN
    PDIVT9(KST:KEN,JLEV) = PDIVT9(KST:KEN,JLEV)   *(ZGM(KST:KEN)**2)
    PTT9L (KST:KEN,JLEV) = PTT9L (KST:KEN,JLEV)   * ZGM(KST:KEN)
    PTT9M (KST:KEN,JLEV) = PTT9M (KST:KEN,JLEV)   * ZGM(KST:KEN)
  ENDIF
  IF(LUVDER) THEN
    PUT0L (KST:KEN,JLEV) = PUT0L (KST:KEN,JLEV)   *(ZGM(KST:KEN)**2)
    PVT0L (KST:KEN,JLEV) = PVT0L (KST:KEN,JLEV)   *(ZGM(KST:KEN)**2)
  ENDIF
  IF(LVOR) THEN
    PVORT0(KST:KEN,JLEV) = PVORT0(KST:KEN,JLEV)   *(ZGM(KST:KEN)**2)
  ENDIF
  IF(LNHDYN) THEN
    PSPDT0L(KST:KEN,JLEV) = PSPDT0L(KST:KEN,JLEV)   * ZGM(KST:KEN)
    PSVDT0L(KST:KEN,JLEV) = PSVDT0L(KST:KEN,JLEV)   * ZGM(KST:KEN)
    PSPDT0M(KST:KEN,JLEV) = PSPDT0M(KST:KEN,JLEV)   * ZGM(KST:KEN)
    PSVDT0M(KST:KEN,JLEV) = PSVDT0M(KST:KEN,JLEV)   * ZGM(KST:KEN)
    IF (LNHXDER) THEN
      PGMVNHX0L(KST:KEN,JLEV)=PGMVNHX0L(KST:KEN,JLEV)*ZGM(KST:KEN)
      PGMVNHX0M(KST:KEN,JLEV)=PGMVNHX0M(KST:KEN,JLEV)*ZGM(KST:KEN)
    ENDIF
    IF (.NOT.LTWOTL.AND. &
     & ((NCURRENT_ITER == 0).OR.(NCURRENT_ITER > 0 .AND. LPC_FULL))) THEN
      PSPDT9L(KST:KEN,JLEV) = PSPDT9L(KST:KEN,JLEV) * ZGM(KST:KEN)
      PSPDT9M(KST:KEN,JLEV) = PSPDT9M(KST:KEN,JLEV) * ZGM(KST:KEN)
      PSVDT9L(KST:KEN,JLEV) = PSVDT9L(KST:KEN,JLEV) * ZGM(KST:KEN)
      PSVDT9M(KST:KEN,JLEV) = PSVDT9M(KST:KEN,JLEV) * ZGM(KST:KEN)
    ENDIF
  ENDIF
ENDDO

DO JGFL=1,YGFL%NUMFLDS
  IF(YGFLC(JGFL)%LCDERS) THEN
    DO JLEV=1,NFLEVG
      DO JROF=KST,KEN
        PGFL(JROF,JLEV,YGFLC(JGFL)%MPL) = &
         & PGFL(JROF,JLEV,YGFLC(JGFL)%MPL)* ZGM(JROF)  
        PGFL(JROF,JLEV,YGFLC(JGFL)%MPM) = &
         & PGFL(JROF,JLEV,YGFLC(JGFL)%MPM)* ZGM(JROF)  
      ENDDO
    ENDDO
  ENDIF
ENDDO

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

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