SUBROUTINE FLTMODEAD(KVMOD,KVMODPP,KUMVMO)

!**** *FLTMODEAD*  - PROJECTION ONTO SUBSETS OF NORMAL MODES . ADJOINT

!     Purpose.
!     --------
!                 Filtering of fields.

!**   Interface.
!     ----------
!        *CALL* *FLTMODEAD

!        Explicit arguments :   KVMOD   - number of vertical modes
!        --------------------   KVMODPP - number of vertical modes cal-
!                                         culated on this PE
!                               KUMVMO  - number of vertical modes for  
!                                         each B-set

!        Implicit arguments :  - spectral arrays SPVOR,SPDIV,SPT and SPSP
!        --------------------                              (via YOMSP comdeck)
!                              - Logical switches are in YOMNMI

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

!     Externals.
!     ----------
!              RDPINMI : reading help arrays for implicit NMI
!              MO3DPRJAD : projection 3D. ADJOINT

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

!     Author.
!     -------
!        BILL HECKLEY   *ECMWF*

!     Modifications.
!     --------------
!        Original : 90-06-12
!     P. MARQUET  : 91-04-01  MIXED NMI ON THE GEOGRAPHIC SPHERE (TRAGEO)
!     P. MARQUET  : 91-07-07  psi AND khi TRANSFORMATION FOR TRAGEO
!     F. Rabier   : 91-08-28  call to MO3DPRJ
!     D. Giard    : 92-01-20  see FLTMODE
!     ECMWF       : 93-??-??  NVMOD --> NVMODM ; call to RDPINMI
!     D. Giard    : 93-04-05  truncation NTMAX (see FLTMODE)
!     L. Isaksen  : 95-06-06  reordering of spectral arrays
!     D. Giard    : 95-09-06  corrections
!     L. Isaksen  : 96-02-20  Adapted for Message Passing
!     L. Isaksen  : 96-05-05  More flexible handling of vertical modes
!     E.Andersson : 96-07-08  Fujitsu vectorisation
!     D. Giard    : 99-07-19  LINITER moved from YOMNMIA to YOMINI
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NFLEVL   ,NSMAX    ,NSPEC2   ,NCPEC    ,&
 & NCPEC2   ,NTMAX    ,NTPEC2  
USE YOMLUN   , ONLY : NULOUT
USE YOMCT0   , ONLY : NPRTRV
USE YOMSP    , ONLY : SPVOR    ,SPDIV    ,SPT      ,SPSP
USE YOMLAP   , ONLY : NSTREL
USE YOMINI   , ONLY : LINITER
USE YOMNMIA  , ONLY : NVMODF   ,NVMODM   ,LRPIMP   ,&
 & LNPROJ   ,LRPROJ   ,LGPROJ  
USE YOMMP    , ONLY : NPSP

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KVMOD 
INTEGER(KIND=JPIM),INTENT(IN)    :: KVMODPP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KUMVMO(NPRTRV) 
REAL(KIND=JPRB) :: ZVORDI(NFLEVL,NTPEC2),ZDIVDI(NFLEVL,NTPEC2)
REAL(KIND=JPRB) :: ZTDI(NFLEVL,NTPEC2),ZSPDI(NTPEC2)
REAL(KIND=JPRB) :: ZC(NCPEC2,NVMODM),ZDIAG(NCPEC2,NVMODM)
REAL(KIND=JPRB) :: ZFP(NCPEC),ZFQ(NCPEC),ZB(NCPEC2),ZLOW(NCPEC2),ZUP(NCPEC2)

INTEGER(KIND=JPIM) :: I, IMODE, IMODES, ISPACE, J, JK
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "mo3dprjad.intfb.h"
#include "rdpinmi.intfb.h"

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

!*       1.    PREAMBLE.
!              ---------

!         1.0   SET LOCAL ARRAYS TO 0.

IF (LHOOK) CALL DR_HOOK('FLTMODEAD',0,ZHOOK_HANDLE)
ZVORDI(:,:)= 0.0_JPRB
ZDIVDI(:,:)= 0.0_JPRB
ZTDI  (:,:)= 0.0_JPRB

ZSPDI(:)= 0.0_JPRB

!         1.1   READ OF HELP ARRAYS FOR IMPLICIT NMI SCHEME

IF (LRPIMP) THEN
  IMODES = NVMODF
  CALL RDPINMI(IMODES,ZFP,ZFQ,ZB,ZLOW,ZUP,ZC,ZDIAG)
ENDIF

!         1.2  CHOOSE SUBSET OF HORIZONTAL MODES TO BE USED FOR PROJECTIONS

!        LINITER   LNPROJ   LRPROJ   LGPROJ      ISPACE   IMODE

!           T       ---      ---      ---          2        0
!           F        F       ---      ---          1        0
!           F        T        F        F           A B O R T
!           F        T        T        T           1        0
!           F        T        T        F           1        1
!           F        T        F        T           1        2

IF (LINITER) THEN
  IMODE  = 0
  ISPACE = 2
ELSE  IF (LNPROJ) THEN
  ISPACE = 1
  IF (LRPROJ) THEN
    IF (LGPROJ) THEN
      IMODE = 0
    ELSE
      IMODE = 1
    ENDIF
  ELSEIF (LGPROJ) THEN
    IMODE = 2
  ELSE
    WRITE(NULOUT,'('' *** PROJECTION REQUESTED BUT, BOTH '',&
     & ''LRPROJ AND LGPROJ SET FALSE ***'')')  
    CALL ABOR1('FLTMODEAD: ABOR1 CALLED')
  ENDIF
ELSE
  IMODE  = 0
  ISPACE = 1
ENDIF

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

!*       4.    UPDATE VARIABLES
!              ----------------

IF (NSMAX < NTMAX) THEN
  DO JK=1,NFLEVL
!OCL NOVREC
!OCL NOALIAS
    DO J=1,NSPEC2
      I=NSTREL(J)
      ZVORDI(JK,I)= ZVORDI(JK,I) + SPVOR(JK,J)
      SPVOR (JK,J)= 0.0_JPRB
      ZDIVDI(JK,I)= ZDIVDI(JK,I) + SPDIV(JK,J)
      SPDIV (JK,J)= 0.0_JPRB
      ZTDI  (JK,I)= ZTDI  (JK,I) + SPT  (JK,J)
      SPT   (JK,J)= 0.0_JPRB
    ENDDO
  ENDDO
  IF (NPSP == 1) THEN
!OCL NOVREC
!OCL NOALIAS
    DO J=1,NSPEC2
      I=NSTREL(J)
      ZSPDI(I)= ZSPDI(I) + SPSP(J)
      SPSP (J)= 0.0_JPRB
    ENDDO
  ENDIF
ELSE
  ZVORDI(1:NFLEVL,:)= ZVORDI(1:NFLEVL,:) + SPVOR(1:NFLEVL,:)
  SPVOR (1:NFLEVL,:)= 0.0_JPRB
  ZDIVDI(1:NFLEVL,:)= ZDIVDI(1:NFLEVL,:) + SPDIV(1:NFLEVL,:)
  SPDIV (1:NFLEVL,:)= 0.0_JPRB
  ZTDI  (1:NFLEVL,:)= ZTDI  (1:NFLEVL,:) + SPT  (1:NFLEVL,:)
  SPT   (1:NFLEVL,:)= 0.0_JPRB

  IF (NPSP == 1) THEN
    ZSPDI(:)= ZSPDI(:) + SPSP(:)
    SPSP (:)= 0.0_JPRB
  ENDIF
ENDIF

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

!*       3.    PROJECTION ON MODES
!              -------------------

CALL MO3DPRJAD(IMODE,ISPACE,KVMOD,KVMODPP,KUMVMO,ZVORDI,ZDIVDI,&
 & ZTDI,ZSPDI,ZC,ZB,ZUP,ZDIAG,ZLOW,ZFQ,ZFP)  

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

!*       2.    INITIALISATION OF FIELDS TO BE PROJECTED
!              ----------------------------------------

IF (NSMAX < NTMAX) THEN
  DO JK=1,NFLEVL
!OCL NOALIAS
    DO J=1,NSPEC2
      I=NSTREL(J)
      SPVOR (JK,J)= SPVOR(JK,J) + ZVORDI(JK,I)
      SPDIV (JK,J)= SPDIV(JK,J) + ZDIVDI(JK,I)
      SPT   (JK,J)= SPT  (JK,J) + ZTDI  (JK,I)
    ENDDO
  ENDDO

  IF (NPSP == 1) THEN
!OCL NOALIAS
    DO J=1,NSPEC2
      I=NSTREL(J)
      SPSP (J)= SPSP(J) + ZSPDI(I)
    ENDDO
  ENDIF
ELSE
  SPVOR (1:NFLEVL,:)= SPVOR(1:NFLEVL,:) + ZVORDI(1:NFLEVL,:)
  SPDIV (1:NFLEVL,:)= SPDIV(1:NFLEVL,:) + ZDIVDI(1:NFLEVL,:)
  SPT   (1:NFLEVL,:)= SPT  (1:NFLEVL,:) + ZTDI  (1:NFLEVL,:)

  IF (NPSP == 1) THEN
    SPSP (:)= SPSP(:) + ZSPDI(:)
  ENDIF
ENDIF

ZVORDI(:,:)= 0.0_JPRB
ZDIVDI(:,:)= 0.0_JPRB
ZTDI  (:,:)= 0.0_JPRB

IF (NPSP == 1) ZSPDI(:)= 0.0_JPRB

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

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