SUBROUTINE MO3DPRJAD(KMODE,KSPACE,KVMOD,KVMODPP,KUMVMO,PVORDI,&
 & PDIVDI,PTDI,PSPDI,PC,PB,PUP,PDIAG,PLOW,PFQ,&
 & PFP)  

!**** *MO3DPRJAD*  - PROJECTION ONTO NORMAL MODES- ADJOINT

!     Purpose.
!     --------
!         Projection of fields, according to options (kmode,kspace)

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

!        Explicit arguments :
!        --------------------
!          KMODE : describes the mode of projection
!                  0 = NO PROJECTION REQUIRED
!                  1 = PROJECTION ON ROSSBY MODES
!                  2 = PROJECTION ON GRAVITY MODES
!                  3 = PROJECTION ON GRAV. MODES AND DIVIDE BY FREQ.
!                      ( COMPUTATION OF NMI INCREMENTS)

!          KSPACE: describes the projection space
!                  1 = PROJECTION IN SPECTRAL SPACE
!                  2 = PROJECTION IN HOUGH SPACE

!          KVMOD   : number of vertical modes
!          KVMODPP : number of vertical modes on this PE
!          KUMVMO  : number of vertical modes on each B-set

!          PVORDI,PDIVDI,PTDI,PSPDI    : spectral arrays
!          PC,PB,PUP,PDIAG,PLOW,PFQ,PFP: help arrays for implicit NMI

!        Implicit arguments :  Logical switches in YOMNMI
!        --------------------

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

!     Externals.
!     ----------  VTRANMAD  - MACRO TASKING INTERFACE FOR VERTICAL TRANSFORMS
!                 TRAGEOAD  - TRANSFORMS TO GEOGRAPHICAL SPHERE
!                 MOPRJMAD  - MACRO TASKING INTERFACE FOR VERTICAL PROJECTIONS

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

!     Author.
!     -------
!        F. Rabier      *Meteo France*

!     Modifications.
!     --------------
!        Original : 91-08-28
!        Modified : Bill Heckley 27:02:92 Vertical projection made optional
!        Modified : Bill Heckley 10:09:92 corrections to logic to agree with
!                                         direct code, cleaning.
!        Modified : Bill Heckley 02:02:93 Vertical projection now always done.
!                                Extra filtering control for variational
!                                analysis under control of LFLTBAL.
!        Modified : D. Giard 05:04:93 truncation NTMAX
!        Modified : D. Giard 08:04:93 ISPORTS=NSTTYP-1
!        Modified : E. Andersson 94:05:19 Multi-tasking MOPRJAD
!        Modified : D. Giard 94-07-26  previous opening of matrixes or not
!        Modified : L. Isaksen 95-01-11 Macro tasking over wavenumbers and modes
!        Modified : L. Isaksen 95-06-06 Reordering of spectral arrays
!        Modified : D. Giard   95-09-06 corrections 
!        Modified : L. Isaksen 96-02-20 Adapted for Message Passing
!        R. El Khatib : 01-08-07 Pruning options
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NFLEVL   ,NFLEVG   ,NSMAX    ,NCMAX    ,&
 & NCPEC    ,NCPEC2   ,NTMAX    ,NTPEC2   ,&
 & NUMTP    ,NUMCP  
USE YOMGEM   , ONLY : NSTTYP   ,RLOCEN
USE YOMLUN   , ONLY : NULOUT   ,NULCONT  ,NULROTC
USE YOMLAP   , ONLY : NACM0    ,NATM0    ,NCVALUE  ,NTVALUE  ,&
 & MYMS     ,RCAPDI   ,RCAPIN   ,RTAPDI   ,RTAPIN  
USE YOMNMIA  , ONLY : NVMODM   ,NVMODJB  ,LNMIRQ   ,LFLTBAL  ,&
 & LTRANS  
USE YOMCT0   , ONLY : NPRTRV
USE YOMMUL   , ONLY : N
USE YOMMP    , ONLY : NPTRCV   ,NCPEC2V

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KMODE 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSPACE 
INTEGER(KIND=JPIM),INTENT(IN)    :: KVMOD 
INTEGER(KIND=JPIM),INTENT(IN)    :: KVMODPP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KUMVMO(NPRTRV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVORDI(NFLEVL,NTPEC2) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDIVDI(NFLEVL,NTPEC2) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTDI(NFLEVL,NTPEC2) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPDI(NTPEC2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PC(NCPEC2,NVMODM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PB(NCPEC2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUP(NCPEC2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDIAG(NCPEC2,NVMODM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLOW(NCPEC2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFQ(NCPEC) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFP(NCPEC) 

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

!*******************************************************
!**  ARRAYS ON THE T"NTMAX" OF THE TRANSFORMED SPHERE **
!*******************************************************
REAL(KIND=JPRB) :: ZVDTT(NTPEC2,KVMODPP,3)
REAL(KIND=JPRB) :: ZVORDIG(NFLEVG,NCPEC2V),ZDIVDIG(NFLEVG,NCPEC2V)
REAL(KIND=JPRB) :: ZTDIG(NFLEVG,NCPEC2V),ZSPDIG(NCPEC2V)
!***********************************************************
!**  ARRAYS ON THE T"NCMAX" OF THE REAL GEOGRAPHIC SPHERE **
!***********************************************************
REAL(KIND=JPRB) :: ZVDTR(NCPEC2,KVMODPP,3)
REAL(KIND=JPRB) :: ZVDTR1(NCPEC2V,KVMOD,3)

INTEGER(KIND=JPIM) :: IBUFLEN, IDIRTR, IFIELD, IFLAG, IFLDSUR, IMODE, ISPORTS, ITYPFLD, &
 & IVMOD2, J, JK  

LOGICAL :: LLTRAGEO

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"
#include "moprjmad.intfb.h"
#include "trageoad.intfb.h"
#include "trmtov.intfb.h"
#include "trvtoh.intfb.h"
#include "vtranmad.intfb.h"

!      -----------------------------------------------------------------
!        The subroutine TRAGEO is likely to be used if LLTRAGEO=TRUE :
!                if NSMAX.NE.NCMAX or if NSTTYP.NE.1
!              -----------------------------------------------

!     LTRANS : NNMI is required and possible on the transformed sphere
!     LLTRAGEO : FALSE if already on the geographic sphere
IF (LHOOK) CALL DR_HOOK('MO3DPRJAD',0,ZHOOK_HANDLE)
LLTRAGEO = (NSMAX /= NCMAX) .OR. (NSTTYP /= 1)

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

!*    0.   INITIALISATION OF LOCAL ARRAYS
!          ------------------------------

IF (NPRTRV > 1) THEN
  ZVDTR1(:,:,:)=0.0_JPRB
ELSE
  ZVDTR(:,:,:)=0.0_JPRB
ENDIF

IF (LLTRAGEO.AND.(.NOT.LTRANS)) THEN
  ZVDTT(:,:,:)=0.0_JPRB
ENDIF

IF (LFLTBAL) THEN
  IMODE = 1
ELSE
  IMODE = 2
ENDIF

IF (KSPACE /= 2) THEN

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

!*    5.     PROJECTION ONTO VERTICAL MODES
!            ------------------------------

  IF (LTRANS.OR.(.NOT.LLTRAGEO)) THEN
    IF (NPRTRV > 1) THEN

!         Transposition from vertical spectral columns   :PxxxDI-->ZxxxDIG

      IBUFLEN=MAX((3*NFLEVL+1)*NCPEC2,(3*NFLEVG+1)*NCPEC2V)
      CALL TRMTOV(NCPEC2,NCPEC2V,NPTRCV,PVORDI,PDIVDI,PTDI,PSPDI,&
       & ZVORDIG,ZDIVDIG,ZTDIG,ZSPDIG,IBUFLEN,-1,IMODE)  

!         Vertical transform (on the current sphere)     :ZxxDIG-->ZVDTR1

      CALL VTRANMAD(NCPEC2V,ZVORDIG,ZDIVDIG,ZTDIG,ZSPDIG,&
       & ZVDTR1(1,1,1),ZVDTR1(1,1,2),ZVDTR1(1,1,3),&
       & KVMOD,+1,IMODE)  

!         Transposition from subset of normal modes      :ZVDTR1-->ZVDTR

      IBUFLEN=MAX(3*NCPEC2*KVMODPP,3*NCPEC2V*KVMOD)
      CALL TRVTOH(NCPEC2,NCPEC2V,NPTRCV,KVMOD,KVMODPP,KUMVMO,&
       & ZVDTR(1,1,1),ZVDTR(1,1,2),ZVDTR(1,1,3),&
       & ZVDTR1(1,1,1),ZVDTR1(1,1,2),ZVDTR1(1,1,3),&
       & IBUFLEN,-1)  
    ELSE

!           Vertical transform (on the current sphere)     :PxxDI-->ZVDTR

      CALL VTRANMAD(NCPEC2,PVORDI,PDIVDI,PTDI,PSPDI,&
       & ZVDTR(1,1,1),ZVDTR(1,1,2),ZVDTR(1,1,3),&
       & KVMOD,+1,IMODE)  
    ENDIF
  ELSE

!       Vertical transform (on the transformed sphere) :PxxDI-->ZVDTR

    CALL VTRANMAD(NTPEC2,PVORDI,PDIVDI,PTDI,PSPDI,&
     & ZVDTT(1,1,1),ZVDTT(1,1,2),ZVDTT(1,1,3),&
     & KVMOD,+1,IMODE)  

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

!*    4.   FROM GEOGRAPHIC TO TRANSFORMED SPHERE (ZVDTR --> ZVDTT)
!*         (include the case of a real geographic sphere with higher
!*         truncation - NCMAX - used to realize a LNMI or a NLNMI)
!          ---------------------------------------------------------

!*    4.3   Vort. and Div. (transformed sphere) are obtained using the
!*          Stream Fct and the Velocity Potential after TRAGEO.

    WRITE(NULOUT,'(''   COMPUTE VORTICITY AND DIVERGENCE'',&
     & '' ON THE TRANSFORMED SPHERE'' )')  
    DO JK=1,KVMODPP
      DO J=1,NTPEC2
        ZVDTT(J,JK,1)=RTAPDI(NTVALUE(J))*ZVDTT(J,JK,1)
        ZVDTT(J,JK,2)=RTAPDI(NTVALUE(J))*ZVDTT(J,JK,2)
      ENDDO
    ENDDO

!*    4.2   goto the transformed sphere : ZVDTR --> ZVDTT

    WRITE(NULOUT,'(''   CALL TO TRAGEO, DIR = -1 '' )')
    IFIELD  = KVMOD*3
    IFLDSUR = 2*INT(IFIELD/2) + 1
    ISPORTS = NSTTYP-1
    ITYPFLD = 2
    IDIRTR = -1
    CALL TRAGEOAD(NULROTC,NULCONT,NULOUT,&
     & IFIELD,IFLDSUR,NTMAX,NATM0,NTPEC2,NUMTP,&
     & NCMAX,NACM0,NCPEC2,NUMCP,MYMS,&
     & ISPORTS,ITYPFLD,IDIRTR,RLOCEN,0.0_JPRB,ZVDTT,ZVDTR)  

!*    4.1   Vort. and Div. on the real sphere are transformed into
!*          Stream Fct and Velocity Potential before the call to TRAGEO.

    WRITE(NULOUT,'(''  COMPUTE STREAM FUNCTION AND VELOCITY'',&
     & '' POTENTIAL ON THE REAL SPHERE'' )')  
    DO JK=1,KVMODPP
      DO J=1,NCPEC2
        ZVDTR(J,JK,1)=RCAPIN(NCVALUE(J))*ZVDTR(J,JK,1)
        ZVDTR(J,JK,2)=RCAPIN(NCVALUE(J))*ZVDTR(J,JK,2)
      ENDDO
    ENDDO

  ENDIF

ENDIF

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

!*    3.   PROJECT ONTO SELECTED MODES DEFINED BY LTYPDB AND KMODE
!          -------------------------------------------------------

!*    3.2   projection

IF (LNMIRQ) THEN
  WRITE(NULOUT,'('' ***** COMPUTE NMI INCREMENTS (MACHENHAUER) *****'')')
ENDIF

IF (LFLTBAL) THEN
  IVMOD2 = NVMODJB
ELSE
  IVMOD2 = KVMOD
ENDIF

N=-1
IFLAG=2

CALL MOPRJMAD(ZVDTR,PC,PB,PUP,PDIAG,PLOW,PFQ,PFP,KVMOD,KVMODPP,&
 & KMODE,KSPACE)  

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

!*    2.   GO FROM TRANSFORMED TO GEOGRAPHIC SPHERE (ZVDTT--> ZVDTR)
!*         (include the case of a real geographic sphere with  higher
!*         truncation -NCMAX- used to realize the LNMI or the NLNMI)
!          ----------------------------------------------------------

IF (LLTRAGEO.AND.(.NOT.LTRANS)) THEN

!*    2.3   Vort. and Div. on the real sphere are obtained using the
!*          Stream Fct and the Velocity Potential after  TRAGEO.

  WRITE(NULOUT,'(''   COMPUTE VORTICITY AND DIVERGENCE'',&
   & '' ON THE REAL SPHERE'' )')  
  DO JK=1,KVMODPP
    DO J=1,NCPEC2
      ZVDTR(J,JK,1)=RCAPDI(NCVALUE(J))*ZVDTR(J,JK,1)
      ZVDTR(J,JK,2)=RCAPDI(NCVALUE(J))*ZVDTR(J,JK,2)
    ENDDO
  ENDDO

!*    2.2   goto the real geographic sphere : ZVDTT --> ZVDTR

  WRITE(NULOUT,'(''   GOTO THE REAL GEOGRAPHIC SPHERE'' )')
  IDIRTR  = 1
  WRITE(NULOUT,'(''   CALL TO TRAGEO, IDIR = +1'' )')

  CALL ABOR1('MO3DPRJAD: LLTRAGEO DEAD')
!  CALL TRAGEOAD(NULROTC,NULDILA,NULOUT,&
!   &IFIELD,IFLDSUR,NTMAX,NATM0,NTPEC2,NUMTP,&
!   &NCMAX,NACM0,NCPEC2,NUMCP,MYMS,&
!   &ISPORTS,ITYPFLD,IDIRTR,RLOCEN,0.0_JPRB,ZVDTT,ZVDTR)

!*    2.1   Vort. and Div. (transformed sphere) are transformed into
!*          Stream Fct and Velocity Potential before the call to TRAGEO.

  WRITE(NULOUT,'(''   COMPUTE STREAM FUNCTION AND VELOCITY'',&
   & '' POTENTIAL ON THE TRANSFORMED SPHERE'' )')  
  DO JK=1,KVMODPP
    DO J=1,NTPEC2
      ZVDTT(J,JK,1)=RTAPIN(NTVALUE(J))*ZVDTT(J,JK,1)
      ZVDTT(J,JK,2)=RTAPIN(NTVALUE(J))*ZVDTT(J,JK,2)
    ENDDO
  ENDDO

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

!*    1.   PROJECT FIELDS ONTO VERTICAL MODES
!          ----------------------------------

!  vertical transform (on the transformed sphere)    :PxxDI-->ZVDTT

  CALL VTRANMAD(NTPEC2,PVORDI,PDIVDI,PTDI,PSPDI,&
   & ZVDTT(1,1,1),ZVDTT(1,1,2),ZVDTT(1,1,3),&
   & KVMOD,-1,IMODE)  
ELSE
  IF (NPRTRV > 1) THEN

!         Transposition to subset of normal modes   :ZVDTR1-->ZVDTR

    IBUFLEN=MAX(3*NCPEC2*KVMODPP,3*NCPEC2V*KVMOD)
    CALL TRVTOH(NCPEC2,NCPEC2V,NPTRCV,KVMOD,KVMODPP,KUMVMO,&
     & ZVDTR(1,1,1),ZVDTR(1,1,2),ZVDTR(1,1,3),&
     & ZVDTR1(1,1,1),ZVDTR1(1,1,2),ZVDTR1(1,1,3),&
     & IBUFLEN,+1)  

!         Vertical transform (on the current sphere)    :ZxxDIG-->ZVDTR1

    CALL VTRANMAD(NCPEC2V,ZVORDIG,ZDIVDIG,ZTDIG,ZSPDIG,&
     & ZVDTR1(1,1,1),ZVDTR1(1,1,2),ZVDTR1(1,1,3),&
     & KVMOD,-1,IMODE)  

!         Transposition to vertical spectral columns   :PxxxDI-->ZxxxDIG

    IBUFLEN=MAX((3*NFLEVL+1)*NCPEC2,(3*NFLEVG+1)*NCPEC2V)
    CALL TRMTOV(NCPEC2,NCPEC2V,NPTRCV,PVORDI,PDIVDI,PTDI,PSPDI,&
     & ZVORDIG,ZDIVDIG,ZTDIG,ZSPDIG,IBUFLEN,+1,IMODE)  
  ELSE

!         Vertical transform (on the current sphere)     :PxxDI-->ZVDTR

    CALL VTRANMAD(NCPEC2,PVORDI,PDIVDI,PTDI,PSPDI,&
     & ZVDTR(1,1,1),ZVDTR(1,1,2),ZVDTR(1,1,3),&
     & KVMOD,-1,IMODE)  
  ENDIF
ENDIF

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

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