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

!**** *MOPRJMAD* 

!     PURPOSE.   MULTI-TASKING MOPRJ
!     --------

!**   INTERFACE.
!     ----------
!        *CALL* *MOPRJMAD(PVDTR,PC,PB,PUP,PDIAG,PLOW,PFQ,PFP,KMODE,
!    S                    KSPACE)

!        EXPLICIT ARGUMENTS :
!        --------------------
!           PVDTR - INPUT/OUTPUT
!           PC    - INPUT
!           PB    - INPUT
!           PUP   - INPUT
!           PDIAG - INPUT
!           PLOW  - INPUT
!           PFQ   - INPUT
!           PFP   - INPUT
!           KMODE - INPUT 
!           KSPACE- INPUT

!        IMPLICIT ARGUMENTS :
!        --------------------

!     METHOD.   NONE
!     -------

!     EXTERNALS.  MOPRJAD  - PROJECTION
!     ----------  ABOR1  - Self explanatory

!     AUTHOR.
!     -------
!        MATS HAMRUD AND ERIK ANDERSSON         *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL     : 94-05-17
!        Lars Isaksen : 95-01-11 Macro tasked over waves and modes
!        Lars Isaksen : 95-06-06 Reordering of spectral arrays, and
!                                change interface to PFP and PFQ
!        Lars Isaksen : 96-02-20 Adapted for Message Passing
!        F.   Veerse  : 97-11-18 Dimensions of ZVORI,ZDIVI,ZHGTI
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NCMAX    ,NCPEC    ,NCPEC2   ,NUMCP
USE YOMLAP   , ONLY : NACM0    ,MYMS
USE YOMNMIA  , ONLY : NVMODF   ,NVMODF1  ,NVMODF2  ,NVMODM   ,&
 & NVMODJB  ,LFLTBAL  
USE YOMMUL   , ONLY : N
USE YOMMP    , ONLY : MYSETV   ,NVMODIST

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KVMODPP 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVDTR(NCPEC2,KVMODPP,3) 
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) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KVMOD 
INTEGER(KIND=JPIM),INTENT(IN)    :: KMODE 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSPACE 
REAL(KIND=JPRB) :: ZVORI(2*(NCMAX+1)),ZDIVI(2*(NCMAX+1)),ZHGTI(2*(NCMAX+1))

INTEGER(KIND=JPIM) :: ICMVAL, ICMVAL1, IIK, IK, IKLOC, IM, IMNV,&
 & IVMOD, IVMOD2, IVMOD2P, JSP  

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

#include "moprjad.intfb.h"
#include "reordad.intfb.h"

IF (LHOOK) CALL DR_HOOK('MOPRJMAD',0,ZHOOK_HANDLE)
IF (LFLTBAL) THEN
  IVMOD2 = NVMODJB
  IVMOD  = NVMODF
ELSE
  IVMOD2 = KVMOD
  IVMOD  = KVMOD
ENDIF
IVMOD2P=KVMODPP

!        1.    GO INTO NORMAL MODE SPACE.
!              --------------------------

100 CONTINUE

N=N+1
IMNV=N
IF (IMNV < IVMOD2P*NUMCP) THEN
  IKLOC=IMNV/NUMCP+1
  IK=NVMODIST(IKLOC,MYSETV)
  IM=MYMS(MOD(IMNV,NUMCP)+1)

  ICMVAL=NACM0(IM)
  ICMVAL1=(NACM0(IM)-1)/2+1

  CALL REORDAD(PVDTR(1,IKLOC,1),PVDTR(1,IKLOC,2),PVDTR(1,IKLOC,3),&
   & ZVORI,ZDIVI,ZHGTI,IM,-1)  

! Progressively reduce amplitude of projections
  IF (LFLTBAL .AND.IK < IVMOD2.AND.IK >= NVMODF1+1) THEN
    ZEPS = REAL(NVMODF2-IK,JPRB)/REAL(NVMODF2-NVMODF1,JPRB)
    DO JSP=1,(NCMAX+1-IM)*(MIN(1,IM)+1)
      ZVORI(JSP) = ZVORI(JSP)*ZEPS
      ZDIVI(JSP) = ZDIVI(JSP)*ZEPS
      ZHGTI(JSP) = ZHGTI(JSP)*ZEPS
    ENDDO
  ENDIF

! Project
  IIK = MIN(IK,IVMOD)
  CALL MOPRJAD(ZVORI,ZDIVI,ZHGTI,ZVORI,ZDIVI,ZHGTI,&
   & PC(ICMVAL,IIK),PB(ICMVAL),PUP,&
   & PDIAG(ICMVAL,IIK),PLOW,PFQ(ICMVAL1),&
   & PFP(ICMVAL1),KMODE,IIK,IM,KSPACE)  

! Extract fields for (k,m)
  CALL REORDAD(PVDTR(1,IKLOC,1),PVDTR(1,IKLOC,2),PVDTR(1,IKLOC,3),&
   & ZVORI,ZDIVI,ZHGTI,IM,1)  

  GOTO 100

ENDIF

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

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