SUBROUTINE MOPRJ(PVORI,PDIVI,PHGTI,PVORO,PDIVO,PHGTO,&
 & PCL,PBL,PUPL,PDIAGL,PLOWL,PFQ,PFP,&
 & KMO,KVMO,KM,KSPACE)  

!**** *MOPRJ* - ROUTINE TO PROJECT ON ROSSBY OR GRAVITY MODES,
!               FOR A SINGLE VERTICAL MODE (EXPLICIT, IMPLICIT OR MIXED SCHEME)

!     PURPOSE.   TO PROJECT VORTICITY,DIVERGENCE AND HEIGHT ON
!     --------   THE ROSSBY MODES OR THE GRAVITY MODES. KMO INDICATES
!                THE KIND OF PROJECTION REQUESTED IN HOUGH SPACE.
!                    KMO = 0 : NO PROJECTION REQUESTED
!                    KMO = 1 : PROJECT ON ROSSBY  MODES
!                    KMO = 2 : PROJECT ON GRAVITY MODES
!                    KMO = 3 : COMPUTE THE NMI INCREMENTS
!                              (PROJ. ON GRAV. MODES AND DIVIDE BY FREQ.)
!                    KMO = 4 : SAME AS 3 EXCEPT FOR THE PHYSICAL TENDENCIES

!**   INTERFACE.
!     ----------
!        *CALL* *MOPRJ(PVORI,PDIVI,PHGTI,PVORO,PDIVO,PHGTO,
!    1                 PCL,PBL,PUPL,PDIAGL,PLOWL,PFQ,PFP,
!    2                 KMO,KVMO,KM,KSPACE)*

!        EXPLICIT ARGUMENTS :
!        --------------------
!    PVORI     - VORTICITY     I
!    PDIVI     - DIVERGENCE    I - INPUT
!    PHGTI     - GEOPOTENTIAL  I
!    PVORO     - VORTICITY     O
!    PDIVO     - DIVERGENCE    O - OUTPUT
!    PHGTO     - GEOPOTENTIAL  O
!    PCL to PFP - HELP ARRAYS FOR IMPLICIT NMI
!    KMO       - SWITCH FOR PROJECTION REQUESTED
!    KVMO      - INDEX OF VERTICAL MODE
!    KM    - INDEX OF WAVE NUMBER
!    KSPACE- SWITCH FOR FINAL SPACE OF FIELDS
!       1 - Results in the spectral space (arrays PVORO, PDIVO and PHGTO)
!       2 - Results left in HOUGH space (diab. tend. : array FILT in YOMNMIB)

!        IMPLICIT ARGUMENTS :
!        --------------------
!    LRPIMP (YOMNMIA) : .T. if IMPLICIT or MIXED NMI req. (otherwise EXPLICIT)

!    LFLTBAL (YOMNMIA): .T. if Hough filtering in variational analysis
!    NLEX   (YOMNMIA) : IMPLICIT NMI above N=NLEX
!    LTYPGR (YOMNMIB) : .F. ==> ROSSBY, .T. ==> GRAVITY
!    LTYPDB (YOMNMIB) : .T. for diabatic components
!    LTYPTD (YOMNMIB) : .T. for  tidal   components
!    FREQ(2)(YOMNMIB) : Frequencies of HOUGH modes
!   used for CEP scheme only :
!    FILT   (YOMNMIB) : Filtered diabatic tendencies
!   used for EMERAUDE scheme only :

!     METHOD.   THE FIELDS ARE REORDERED AND NORMALIZED. WE GO INTO NORMAL
!     -------   MODE SPACE BY MULTIPLYING BY THE MATRIX CONSISTING OF THE
!               "STANDARD SPACE" EXPRESSED IN NORMAL MODES.THIS MATRIX HAS
!               BEEN PREVIOUSLY COMPUTED BY SUMODE3. AFTER THAT A FILTER IS
!               APPLIED TO THE NORMAL MODES (EXPLICIT NMI CASE), OR IMPLICIT
!               MACHENHAUER INCREMENTS ARE COMPUTED (IMPLICIT NMI CASE).
!               FINALLY WE GO BACK TO " STANDARD SPACE" AND PUT THE FIELD
!               BACK IN "PVOR-PDIV-PHGT" FORM (WITH MIXED SCHEME IF NEEDED).

!     EXTERNALS.
!     ----------  SPEHOU3 - SPECTRAL TO HOUGH TRANSFORM (NCMAX --> NXMAX)
!                 HOUSPE3 - HOUGH TO SPECTRAL TRANSFORM (NXMAX --> NCMAX)
!                 SPEIMP  - SPECTRAL TO "IMPLICIT" TRANSFORM (AND REVERSE)
!                 MULTF   - MULTIPLY BY IMPLICIT OPERATOR "F"
!                 SGTSL   - CRAY ROUTINE TO SOLVE TRIDIAG. LINEAR SYSTEMS
!                           (A LINPACK SUBROUTINE)

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

!     AUTHOR.
!     -------
!        CLIVE TEMPERTON *ECMWF*
!        -- BASED ON THE ROUTINE SCMPRJ WRITTEN BY
!        MATS HAMRUD AND PHILIPPE COURTIER  *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL     : 88-05-25   (SCMPRJ)
!        BILL HECKLEY : 88-12-07   SEPARATE CODE FOR HOUGH TO SPECTRAL
!                                  AND SPECTRAL TO HOUGH TRANSFORMS.
!        C. TEMPERTON : 90-01-09   SCMPRJ => MOPRJ
!        P. MARQUET   : 90-12-15   INTRODUCTION OF IMPLICIT NMI (T"NSMAX")
!        P. MARQUET   : 91-02-15   MIXED "EXPLICIT/IMPLICIT" (NXMAX and NCMAX)
!                     I          : 1. Transformation back to spectral space
!                     I 91-01-22 :    optional for filter scheme (LIFILT and
!        Bill HECKLEY I          :    KSPACE=2)
!           and       I    to    : 2. During NMI (KMO=3), add filtered diabatic
!        P.   MARQUET I          :    tendencies to adiabatic terms (LNMIDB).
!                     I 91-04-01 : 3. Option to exclude tidal signal from the
!                     I          :    initialisation scheme (KMO=2 and LEXTIDE).
!                     I          : 4. New arrays LTYPxx and new dim. of FREQ2
!        P. MARQUET   : 91-10-15   The treatment of tidal components is checked
!                                  The array TIDE is updated for the present run
!                                  (sections 1.2.1 and 1.2.2)
!        D. GIARD     : 92-10-30   EMERAUDE diabatic scheme
!        C. TEMPERTON : 93-11-01 : Changes to shape and contents of tidal file
!                                  (for ECMWF tidal treatment)
!        D. GIARD     : 94-02-08   restoring ARPEGE tidal file ; NOPTDIA
!        L. ISAKSEN   : 94-11-11   Move MACROTASKING TO A HIGHER LEVEL
!        D. GIARD and
!        L. ISAKSEN   : 95-02-08   Cleaning and local treatment of implicit help arrays
!        J.N THEPAUT  : 96-06-20   Introduction of KMO = 4.
!        L. ISAKSEN   : 95-06-06   Change interface to PFQ, PFP
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

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

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

USE YOMDIM   , ONLY : NCMAX    ,NXMAX
USE YOMCST   , ONLY : ROMEGA
USE YOMCT0   , ONLY : NPRINTLEV
USE YOMLUN   , ONLY : NULOUT   ,NULERR
USE YOMNMIA  , ONLY : NLEX     ,LRPIMP   ,LFLTBAL
USE YOMNMIB  , ONLY : LTYPGR   ,FREQ
USE YOMMP    , ONLY : MYPROC   ,MYSETW   ,NPROCM

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KM 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVORI(2*(NCMAX+1-KM)) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDIVI(2*(NCMAX+1-KM)) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PHGTI(2*(NCMAX+1-KM)) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVORO(2*(NCMAX+1-KM)) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDIVO(2*(NCMAX+1-KM)) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PHGTO(2*(NCMAX+1-KM)) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCL(2*(NCMAX+1-KM)) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBL(2*(NCMAX+1-KM)) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUPL(2*(NCMAX+1-KM)) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDIAGL(2*(NCMAX+1-KM)) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLOWL(2*(NCMAX+1-KM)) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFQ(KM:NCMAX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFP(KM:NCMAX) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KMO 
INTEGER(KIND=JPIM),INTENT(IN)    :: KVMO 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSPACE 
!***************************************************************
!**   LARGE IMPLICIT TRUNCATION ON THE REAL GEOGRAPHIC SPHERE **
!***************************************************************
REAL(KIND=JPRB) :: ZVORM(2*(NCMAX+1-KM)),ZDIVM(2*(NCMAX+1-KM)),ZHGTM(2*(NCMAX+1-KM))
REAL(KIND=JPRB) :: ZVOR (2*(NCMAX+1-KM)),ZDIV (2*(NCMAX+1-KM)),ZHGT (2*(NCMAX+1-KM))
REAL(KIND=JPRB) :: ZLOW(2*(NCMAX+1-KM)),ZDIAG(2*(NCMAX+1-KM)),&
 & ZUP(2*(NCMAX+1-KM)),ZW(2*(NCMAX+1-KM))  
!***************************************************************
!**   SMALL EXPLICIT TRUNCATION ON THE REAL GEOGRAPHIC SPHERE **
!***************************************************************
REAL(KIND=JPRB) :: ZVORO(2*(NCMAX+1-KM)),ZDIVO(2*(NCMAX+1-KM)),ZHGTO(2*(NCMAX+1-KM))
REAL(KIND=JPRB) :: ZF1(6*(NXMAX+1)),ZF2(6*(NXMAX+1))

INTEGER(KIND=JPIM) :: ICPEC, IJ, IMPVAL,&
 & INFO, IREVAL, IS, IXMVAL, IXPEC, &
 & J, JJ, JN  

LOGICAL :: LLPRINT

REAL(KIND=JPRB) ::  ZOME2
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "houspe3.intfb.h"
#include "multf.intfb.h"
#include "spehou3.intfb.h"
#include "speimp.intfb.h"

!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('MOPRJ',0,ZHOOK_HANDLE)
INFO=0
LLPRINT=KM == 1.OR.(MYPROC == 1.AND.KM == 0.AND.NPROCM(1) /= MYSETW)

!*    1.  EXPLICIT PROJECTIONS.
!         ---------------------

!*    *** BEGINING OF THE EXPLICIT PART ***
IF ( ((.NOT.LRPIMP) .OR. (LRPIMP.AND.NLEX /= 0)).AND.KM <= NXMAX) THEN

  IXMVAL=(KM*(NXMAX+1)-KM*(KM-1)/2)*6
  IXPEC=NXMAX+1-KM

!*    -- 1.0  TRANSFORM FROM SPECTRAL SPACE TO "HOUGH" SPACE
  CALL SPEHOU3(PVORI,PDIVI,PHGTI,ZF2,KVMO,KM)

!*    -- 1.3   NO PROJECTION.
  IF(KMO == 0)THEN
    IF(LLPRINT.AND.NPRINTLEV >= 1) WRITE(UNIT=NULOUT,FMT='(&
     & '' NO PROJECTION REQUESTED (EXPLICIT CASE)'',&
     & '', VERTICAL MODE NUMBER'',I4)') KVMO  
    DO J=1,6*IXPEC
      ZF1(J)=ZF2(J)
    ENDDO

!*    -- 1.4   PROJECTION ON ROSSBY MODES.
  ELSEIF(KMO == 1)THEN
    IF (.NOT.LFLTBAL.AND.LLPRINT) WRITE(UNIT=NULOUT,FMT='(&
     & '' PROJECTION ON ROSSBY MODES (EXPLICIT CASE)'',&
     & '', VERTICAL MODE NUMBER'',I4)') KVMO  
    DO J=1,6*IXPEC
      IF ( LTYPGR(IXMVAL+J,KVMO) ) THEN
        ZF1(J) = 0.0_JPRB
      ELSE
        ZF1(J) = ZF2(J)
      ENDIF
    ENDDO

!*    -- 1.5   PROJECTION ON GRAVITY MODES.

  ELSEIF(KMO == 2) THEN

!*       --> 1.5.3 PROJECTION ONTO THE GRAVITY MODES SUBSET OF THE TENDENCIES

    IF (.NOT.LFLTBAL.AND.LLPRINT.AND.NPRINTLEV >= 1)&
     & WRITE(UNIT=NULOUT,FMT='(&
     & '' PROJECTION ON GRAVITY MODES (EXPLICIT CASE)'',&
     & '', VERTICAL MODE NUMBER'',I4)') KVMO  
    DO J=1,6*IXPEC
      IF ( LTYPGR(IXMVAL+J,KVMO) ) THEN
        ZF1(J) = ZF2(J)
      ELSE
        ZF1(J) = 0.0_JPRB
      ENDIF
    ENDDO

!*    -- 1.6 PROJECTION ON GRAVITY MODES, DIVISION BY
!*           "2*OMEGA*FREQUENCY" AND MULTIPLICATION BY "i".
  ELSEIF(KMO == 3) THEN

!*       --> 1.6.3 RETAIN ONLY GRAVITY MODES AND DIVIDE BY "-i*FREQUENCY"
!*                 (Machenhauer step of the NMI sheme)
    IF (LLPRINT.AND.NPRINTLEV >= 1) WRITE(UNIT=NULOUT,FMT='(&
     & '' PROJ. ON GRAVITY MODES, DIVISION BY -i*FREQUENCY'',&
     & '' (EXPLICIT CASE), VERTICAL MODE NUMBER'',I4)') KVMO  

    ZOME2=2.0_JPRB*ROMEGA
!DIR$ IVDEP
!OCL NOVREC
    DO J=1,3*IXPEC
      IF ( LTYPGR(IXMVAL+2*J,KVMO) ) THEN
        ZF1(2*(J-1)+1)=- ZF2(2*(J-1)+2)/(ZOME2*FREQ(J+IXMVAL/2,KVMO))
        ZF1(2*(J-1)+2)=  ZF2(2*(J-1)+1)/(ZOME2*FREQ(J+IXMVAL/2,KVMO))
      ELSE
        ZF1(2*(J-1)+1) = 0.0_JPRB
        ZF1(2*(J-1)+2) = 0.0_JPRB
      ENDIF
    ENDDO

!*    -- 1.7 PROJECTION ON GRAVITY MODES, DIVISION BY
!*           "2*OMEGA*FREQUENCY" AND MULTIPLICATION BY "i"

  ELSEIF(KMO == 4) THEN

!*       --> 1.7.1 SET LARGEST SCALE MODES TENDENCIES TO 0.

!*       --> 1.7.2 RETAIN ONLY GRAVITY MODES AND DIVIDE BY "-i*FREQUENCY"
!*                 (Machenhauer step of the NMI sheme)
    IF (LLPRINT.AND.NPRINTLEV >= 1) WRITE(UNIT=NULOUT,FMT='(&
     & '' PROJ. ON NON PHYS. G. MODES, DIV. BY -i*FREQUENCY'',&
     & '' (EXPLICIT CASE), VERTICAL MODE NUMBER'',I4)') KVMO  

    ZOME2=2.0_JPRB*ROMEGA
!DIR$ IVDEP
!OCL NOVREC
    DO J=1,3*IXPEC
      IF ( LTYPGR(IXMVAL+2*J,KVMO) ) THEN
        ZF1(2*(J-1)+1)=- ZF2(2*(J-1)+2)/(ZOME2*FREQ(J+IXMVAL/2,KVMO))
        ZF1(2*(J-1)+2)=  ZF2(2*(J-1)+1)/(ZOME2*FREQ(J+IXMVAL/2,KVMO))
      ELSE
        ZF1(2*(J-1)+1) = 0.0_JPRB
        ZF1(2*(J-1)+2) = 0.0_JPRB
      ENDIF
    ENDDO

!*    *** END OF "KMO= 0, 1, 2, 3 or 4" ***
  ENDIF

!*    -- 1.8  TRANSFORM FROM "HOUGH" SPACE TO SPECTRAL SPACE.
  IF (KSPACE /= 2) THEN
    CALL HOUSPE3(ZF1,ZVORO,ZDIVO,ZHGTO,KVMO,KM)
  ENDIF

!*    *** END OF EXPLICIT PART ***
ENDIF

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

!     2.  IMPLICIT PROJECTIONS.
!         ---------------------

IJ=MIN(1,KM)
ICPEC=(NCMAX+1-KM)*(IJ+1)

IF (KM == 0) THEN
  IS=2
ELSE
  IS=1
ENDIF

!*    *** BEGINING OF THE IMPLICIT PART ***
IF(LRPIMP) THEN

!*    -- 2.0  TRANSFORM FROM SPECTRAL SPACE TO "IMPLICIT NMI" SPACE.
  CALL SPEIMP(PVORI,PDIVI,PHGTI,ZVORM,ZDIVM,ZHGTM,KVMO,KM,+1)

!*    -- 2.1   NO PROJECTION.
  IF (KMO == 0) THEN
    IF (LLPRINT.AND.NPRINTLEV >= 1) WRITE(UNIT=NULOUT,FMT='(&
     & '' NO PROJECTION REQUESTED (IMPLICIT CASE)'',&
     & '', VERTICAL MODE NUMBER'',I4)') KVMO  
    DO JJ=1,ICPEC
      ZVOR(JJ) = ZVORM(JJ)
      ZDIV(JJ) = ZDIVM(JJ)
      ZHGT(JJ) = ZHGTM(JJ)
    ENDDO
  ELSE

!*    -- 2.2   COMPUTE IMPLICIT INCREMENT OF DIVERGENCE "INC.DIV" :
!*            "(F*F + C*C)(INC.DIV) = - F(TEND.VOR) - C(TEND.HGT) "
!        (KMO = 1, 2 or 3)
    DO JJ=IS,ICPEC
      ZLOW (JJ) = PLOWL (JJ)
      ZDIAG(JJ) = PDIAGL(JJ)
      ZUP  (JJ) = PUPL  (JJ)
    ENDDO

    CALL MULTF(ZVORM,PFP,PFQ,ZDIV,KM)
    DO JJ=IS,ICPEC
      ZDIV(JJ) = - ZDIV(JJ) - PCL(JJ)*ZHGTM(JJ)
    ENDDO

    INFO=0
    CALL SGTSL(ICPEC-IS+1,ZLOW(IS),ZDIAG(IS),ZUP(IS),ZDIV(IS),INFO)
!        (before SGTSL : ZDIV is the right hand side of tridiag. system)
!        (after  SGTSL : ZDIV is the array of increments of divergence)
    IF (INFO /= 0) THEN
      WRITE(UNIT=NULERR,FMT='(&
       & ''ERROR IN SGTSL (TRIDIAG. SYSTEM 1) :  INFO ='',I6)') INFO  
      CALL ABOR1('PBL SOLVE TRIDIAG. SYSTEM 1 (SGTSL)')
    ENDIF
  ENDIF

!*    -- 2.3   COMPUTE IMPLICIT GRAVITY COMPONENTS OF TENDENCIES FOR :
!*                 VORTICITY     and     GEOPOTENTIAL
!*             " - F(INC.DIV) "  and   " - C(INC.DIV) "
  IF (KMO == 1.OR.KMO == 2) THEN
    CALL MULTF(ZDIV,PFP,PFQ,ZVOR,KM)
    DO JJ=1,ICPEC
      ZVOR(JJ) = - ZVOR(JJ)
      ZHGT(JJ) = - PCL(JJ) * ZDIV(JJ)
    ENDDO
  ENDIF

!*    -- 2.4   PROJECTION ON ROSSBY MODES
  IF (KMO == 1) THEN
    IF (.NOT.LFLTBAL.AND.LLPRINT.AND.NPRINTLEV >= 1)&
     & WRITE(UNIT=NULOUT,FMT='(&
     & '' PROJECTION ON ROSSBY MODES (IMPLICIT CASE)'',&
     & '', VERTICAL MODE NUMBER'',I4)') KVMO  
    DO JJ=1,ICPEC
      ZVOR(JJ) = ZVORM(JJ) - ZVOR(JJ)
      ZDIV(JJ) = 0.0_JPRB
      ZHGT(JJ) = ZHGTM(JJ) - ZHGT(JJ)
    ENDDO

!*    -- 2.5   PROJECTION ON GRAVITY MODES
  ELSEIF (KMO == 2) THEN
    IF (.NOT.LFLTBAL.AND.LLPRINT.AND.NPRINTLEV >= 1)&
     & WRITE(UNIT=NULOUT,FMT='(&
     & '' PROJECTION ON GRAVITY MODES (IMPLICIT CASE)'',&
     & '', VERTICAL MODE NUMBER'',I4)') KVMO  
    IF (KM == 0) ZDIV(1) = 0.0_JPRB
    DO JJ=IS,ICPEC
!        ZVOR(JJ) : computed in loop 232
      ZDIV(JJ) = ZDIVM(JJ)
!        ZHGT(JJ) : computed in loop 232
    ENDDO

!*    -- 2.6   COMPUTATION OF THE WORK ARRAY " ZW = C-1(INC.HGT) " :
!*            " (F*F + C*C)(ZW) = - B(INC.DIV) - TEND.DIV "
  ELSEIF (KMO >= 3) THEN
    IF (LLPRINT.AND.NPRINTLEV >= 1) WRITE(UNIT=NULOUT,FMT='(&
     & '' PROJ. ON GRAVITY MODES, DIVISION BY -i*FREQUENCY'',&
     & '' (IMPLICIT CASE), VERTICAL MODE NUMBER'',I4)') KVMO  
    DO JJ=IS,ICPEC
      ZLOW (JJ) = PLOWL (JJ)
      ZDIAG(JJ) = PDIAGL(JJ)
      ZUP  (JJ) = PUPL  (JJ)
      ZW(JJ)  = - PBL(JJ)*ZDIV(JJ) - ZDIVM(JJ)
    ENDDO
    CALL SGTSL(ICPEC-IS+1,ZLOW(IS),ZDIAG(IS),ZUP(IS),ZW(IS),INFO)
    IF (KM == 0) ZW(1) = 0.0_JPRB
!        (before SGTSL : ZW is the right hand side of tridiag. system)
!        (after  SGTSL : ZW is the worked array " C-1(INC.HGT) ")
    IF (INFO /= 0) THEN
      WRITE(UNIT=NULERR,FMT='(&
       & ''ERROR IN SGTSL (TRIDIAG. SYSTEM 2) :  INFO ='',I6)') INFO  
      CALL ABOR1('PBL SOLVE TRIDIAG. SYSTEM 2 (SGTSL)')
    ENDIF

!*    -- 2.7   COMPUTATION OF IMPLICIT INCREMENTS :
!*             " INC.VOR = F(ZW) "  and  " INC.HGT = C(ZW) ".
    CALL MULTF(ZW,PFP,PFQ,ZVOR,KM)
    DO JJ=1,ICPEC
!        ZDIV(JJ) : computed in loop 224
      ZHGT(JJ) = PCL(JJ)*ZW(JJ)
    ENDDO
  ENDIF

!*    -- 2.8  TRANSFORM FROM "IMPLICIT NMI" SPACE TO SPECTRAL SPACE.
  CALL SPEIMP(PVORO,PDIVO,PHGTO,ZVOR,ZDIV,ZHGT,KVMO,KM,-1)

!*       2.9   DIVISION BY "i" AND DIVISION BY "2*OMEGA"
!*       (except for KM=0 : divided by "+2*OMEGA" for VOR and HGT)
!*                          divided by "-2*OMEGA" for    DIV     )
!*       (in this section ZVORM, ZDIVM and ZHGTM are used as worked arrays)
  IF (KMO >= 3) THEN
    IF (KM == 0) THEN
      DO JN=0,NCMAX
        IREVAL=JN+1
        ZVORM(IREVAL) = + PVORO(IREVAL)
        ZDIVM(IREVAL) = - PDIVO(IREVAL)
        ZHGTM(IREVAL) = + PHGTO(IREVAL)
      ENDDO
    ELSE
      DO JN=KM,NCMAX
        IREVAL=JN+1-KM
        IMPVAL=NCMAX+1-KM+IREVAL
        ZVORM(IREVAL) = - PVORO(IMPVAL)
        ZVORM(IMPVAL) = + PVORO(IREVAL)
        ZDIVM(IREVAL) = - PDIVO(IMPVAL)
        ZDIVM(IMPVAL) = + PDIVO(IREVAL)
        ZHGTM(IREVAL) = - PHGTO(IMPVAL)
        ZHGTM(IMPVAL) = + PHGTO(IREVAL)
      ENDDO
    ENDIF
!*       computation of opposite of increments to
!*       update state variables in NNMI3 :
    ZOME2 = 1.0_JPRB/(2.0_JPRB*ROMEGA)
    DO JJ=1,ICPEC
      PVORO(JJ) = - ZVORM(JJ) * ZOME2
      PDIVO(JJ) = - ZDIVM(JJ) * ZOME2
      PHGTO(JJ) = - ZHGTM(JJ) * ZOME2
    ENDDO
  ENDIF

!*    *** END OF IMPLICIT PART ***
ENDIF

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

!*    3.  MIXING OF IMPLICIT (N > NLEX) AND  EXPLICIT (N = or < NLEX).
!         ------------------------------------------------------------

!     --------------------
IF(KSPACE /= 2) THEN
!     --------------------
  IF(LRPIMP) THEN
    IF(NLEX /= 0) THEN
!*          PVORO, PDIVO and PHGTO not changed for JJ>ILEFRE (i.e. for N>NLEX),
!*          but replaced by EXPLICIT increments for N<=NLEX.
      IF (.NOT.LFLTBAL.AND.LLPRINT.AND.NPRINTLEV >= 1)&
       & WRITE(UNIT=NULOUT,FMT='(&
       & ''  IMPLICIT AND EXPLICIT PARTS ARE MIXED, CUT-OFF='',&
       & I4,'', VERTICAL MODE NUMBER'',I4)') NLEX,KVMO  

      IF (KM == 0) THEN
        DO JJ=1,NLEX+1
          PVORO(JJ) = ZVORO(JJ)
          PDIVO(JJ) = ZDIVO(JJ)
          PHGTO(JJ) = ZHGTO(JJ)
        ENDDO
      ELSE
!OCL NOVREC
        DO JJ=1,NLEX+1-KM
          IJ=JJ+NCMAX+1-KM
          PVORO(JJ) = ZVORO(JJ)
          PVORO(IJ) = ZVORO(IJ)
          PDIVO(JJ) = ZDIVO(JJ)
          PDIVO(IJ) = ZDIVO(IJ)
          PHGTO(JJ) = ZHGTO(JJ)
          PHGTO(IJ) = ZHGTO(IJ)
        ENDDO
      ENDIF

    ENDIF
!*       case NLEX=0 : PVORO, PDIVO and PHGTO not changed (pure IMPLICIT scheme)
  ELSE
!*       PVORO, PDIVO and PHGTO replaced by pure EXPLICIT increments.
    DO JJ=1,ICPEC
      PVORO(JJ) = ZVORO(JJ)
      PDIVO(JJ) = ZDIVO(JJ)
      PHGTO(JJ) = ZHGTO(JJ)
    ENDDO
  ENDIF

!     -----
ENDIF
!     -----

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

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