SUBROUTINE SPEIMPAD(PVOR,PDIV,PHGT,PVORM,PDIVM,PHGTM,KVMO,KM,KDIR)

!**** *SPEIMPAD*  RE-ORDER SPECTRAL FIELDS FOR IMPLICIT NMI . ADJOINT

!     PURPOSE. - TO REORDER THE FIELDS FOR IMPLICIT NMI SO THAT THEY ARE
!     --------   ORDERED BY INCREASING M. FOR EACH M, ALL REAL COMPONENTS
!                PRECEDE THE IMAGINARY COMPONENTS (FOR M=0 ZERO COMPONENTS
!                ARE NOT STORED). FOR EACH SET OF COMPONENTS (REAL OR IMA-
!                GINARY) THE SUBSET WITH SIMILAR PARITY FOR "N" AND "M"
!                PRECEDES THE SUBSET WITH OPPOSITE PARITIES.
!              -  KDIR= +1 MEANS SET UP BEFORE IMPLICIT NMI SCHEME.
!                 KDIR= -1 MEANS PUT VALUES BACK AFTER IMPLICIT NMI SCHEME.
!              - THE ROUTINE ALSO NON-DIMENSIONALIZES THE VARIABLES
!                (WITH RESPECT TO STATE VARIABLES AND TIME BECAUSE
!                PVOR, PDIV AND PHGT ARE TENDENCIES IN NMI SCHEME)

!**   INTERFACE.
!     ----------
!        *CALL* *SPEIMPAD(PVOR,PDIV,PHGT,PVORM,PDIVM,PHGTM,KVMO,KM,KDIR)

!        EXPLICIT ARGUMENTS :  PVOR  - VORTICITY     /
!        --------------------  PDIV  - DIVERGENCE    / SPECTRAL ORG.
!                              PHGT  - GEOPPOTENTIAL  /
!                              PVORM - VORTICITY     :
!                              PDIVM - DIVERGENCE    : IMPLICIT ORG.
!                              PHGTM - GEOPPOTENTIAL  :
!                              KVMO  - VERTICAL NORMAL MODE INDEX
!                              KM    - ZONAL WAVENUMBER INDEX
!                              KDIR  - SWITCH
!                                     IF KDIR=+1 THEN PVOR, PDIV, PHGT ARE
!                                     INPUT AND PVORM, PDIVM, PHGTM OUTPUT.
!                                     IF KDIR=-1 THEN PVOR, PDIV, PHGT ARE
!                                     OUTPUT AND PVORM, PDIVM, PHGTM INPUT.

!        IMPLICIT ARGUMENTS :  SIVP (YOMDYN)
!        --------------------

!     METHOD.
!     -------

!     EXTERNALS.   NONE.
!     ----------

!     REFERENCE.   NONE.
!     ----------

!     AUTHOR.
!     -------
!        FLORENCE RABIER                    *METEO FRANCE*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 91-10-23
!        L. Isaksen 95-01-11 Macro tasking over wavenumbers and modes
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

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

USE YOMCST   , ONLY : ROMEGA   ,RA
USE YOMDYN   , ONLY : SIVP
USE YOMDIM   , ONLY : NCMAX

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KM 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVOR(2*(NCMAX+1-KM)) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDIV(2*(NCMAX+1-KM)) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PHGT(2*(NCMAX+1-KM)) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVORM(2*(NCMAX+1-KM)) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDIVM(2*(NCMAX+1-KM)) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PHGTM(2*(NCMAX+1-KM)) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KVMO 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDIR 
INTEGER(KIND=JPIM) :: IJ, IMPVAL, IREVAL, JN

REAL(KIND=JPRB) :: ZGEO, ZOME4, ZZGEO
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

!*       1.    COPY FROM SPECTRAL ARRAYS TO "IMPLICIT NMI" ARRAYS.
!              ---------------------------------------------------

IF (LHOOK) CALL DR_HOOK('SPEIMPAD',0,ZHOOK_HANDLE)
IF (KDIR == 1) THEN
  ZOME4=1.0_JPRB/(4._JPRB*ROMEGA*ROMEGA)
  ZZGEO=1.0_JPRB/(4._JPRB*ROMEGA*ROMEGA*RA*SQRT(SIVP(KVMO)))
  IJ= 0

!*       1.1  REAL COMPONENTS : SAME PARITY (loop 112) AND
!*            THEN OPPOSITE PARITY (loop 114 if KM is not NCMAX)
  IF(KM /= 0) THEN
    DO JN=KM,NCMAX,2
      IJ=IJ+1
      IREVAL=JN+1-KM
      IMPVAL=NCMAX+1-KM+IREVAL
      ZGEO=ZZGEO*SQRT(REAL(MAX(JN*(JN+1),1),JPRB))
      PVOR(IMPVAL)=PVOR(IMPVAL)-ZOME4*PVORM(IJ)
      PVORM(IJ) = 0.0_JPRB
      PDIV(IREVAL)=PDIV(IREVAL)+ZOME4*PDIVM(IJ)
      PDIVM(IJ) = 0.0_JPRB
      PHGT(IMPVAL)=PHGT(IMPVAL)-ZGEO *PHGTM(IJ)
      PHGTM(IJ) = 0.0_JPRB
    ENDDO
    IF(KM /= NCMAX) THEN
      DO JN=KM+1,NCMAX,2
        IJ=IJ+1
        IREVAL=JN+1-KM
        IMPVAL=NCMAX+1-KM+IREVAL
        ZGEO=ZZGEO*SQRT(REAL(MAX(JN*(JN+1),1),JPRB))
        PVOR(IMPVAL)=PVOR(IMPVAL)-ZOME4*PVORM(IJ)
        PVORM(IJ) = 0.0_JPRB
        PDIV(IREVAL)=PDIV(IREVAL)+ZOME4*PDIVM(IJ)
        PDIVM(IJ) = 0.0_JPRB
        PHGT(IMPVAL)=PHGT(IMPVAL)-ZGEO *PHGTM(IJ)
        PHGTM(IJ) = 0.0_JPRB
      ENDDO
    ENDIF

!*       1.2  IMAGINARY COMPONENTS : SAME PARITY (loop 122) AND
!*            THEN OPPOSITE PARITY (loop 124 if KM is not NCMAX)
    DO JN=KM,NCMAX,2
      IJ=IJ+1
      IREVAL=JN+1-KM
      IMPVAL=NCMAX+1-KM+IREVAL
      ZGEO=ZZGEO*SQRT(REAL(MAX(JN*(JN+1),1),JPRB))
      PVOR(IREVAL)=PVOR(IREVAL)+ZOME4*PVORM(IJ)
      PVORM(IJ) = 0.0_JPRB
      PDIV(IMPVAL)=PDIV(IMPVAL)+ZOME4*PDIVM(IJ)
      PDIVM(IJ) = 0.0_JPRB
      PHGT(IREVAL)=PHGT(IREVAL)+ZGEO *PHGTM(IJ)
      PHGTM(IJ) = 0.0_JPRB
    ENDDO
    IF(KM /= NCMAX) THEN
      DO JN=KM+1,NCMAX,2
        IJ=IJ+1
        IREVAL=JN+1-KM
        IMPVAL=NCMAX+1-KM+IREVAL
        ZGEO=ZZGEO*SQRT(REAL(MAX(JN*(JN+1),1),JPRB))
        PVOR(IREVAL)=PVOR(IREVAL)+ZOME4*PVORM(IJ)
        PVORM(IJ) = 0.0_JPRB
        PDIV(IMPVAL)=PDIV(IMPVAL)+ZOME4*PDIVM(IJ)
        PDIVM(IJ) = 0.0_JPRB
        PHGT(IREVAL)=PHGT(IREVAL)+ZGEO *PHGTM(IJ)
        PHGTM(IJ) = 0.0_JPRB
      ENDDO
    ENDIF
  ELSE

!*       1.3  SPECIAL CASE " KM=0 " : EVEN PARITY (loop 132)
!*            AND THEN ODD PARITY (loop 134)
!*            (PDIVM is real, PVORM and PHGTM are pure imaginaries)
    DO JN=0,NCMAX,2
      IJ=IJ+1
      ZGEO=ZZGEO*SQRT(REAL(MAX(JN*(JN+1),1),JPRB))
      IREVAL=JN+1-KM
      PVOR(IREVAL)=PVOR(IREVAL)+ZOME4*PVORM(IJ)
      PVORM(IJ) = 0.0_JPRB
      PDIV(IREVAL)=PDIV(IREVAL)+ZOME4*PDIVM(IJ)
      PDIVM(IJ) = 0.0_JPRB
      PHGT(IREVAL)=PHGT(IREVAL)+ZGEO*PHGTM(IJ)
      PHGTM(IJ) = 0.0_JPRB
    ENDDO
    DO JN=1,NCMAX,2
      IJ=IJ+1
      IREVAL=JN+1-KM
      ZGEO=ZZGEO*SQRT(REAL(MAX(JN*(JN+1),1),JPRB))
      PVOR(IREVAL)=PVOR(IREVAL)+ZOME4*PVORM(IJ)
      PVORM(IJ) = 0.0_JPRB
      PDIV(IREVAL)=PDIV(IREVAL)+ZOME4*PDIVM(IJ)
      PDIVM(IJ) = 0.0_JPRB
      PHGT(IREVAL)=PHGT(IREVAL)+ZGEO*PHGTM(IJ)
      PHGTM(IJ) = 0.0_JPRB
    ENDDO
  ENDIF

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

!*       2.    COPY FROM "IMPLICIT NMI" ARRAYS TO SPECTRAL ARRAYS.
!              ---------------------------------------------------

ELSEIF (KDIR == -1) THEN
  ZOME4=4._JPRB*ROMEGA*ROMEGA
  ZZGEO=4._JPRB*ROMEGA*ROMEGA*RA*SQRT(SIVP(KVMO))
  IJ= 0

!*       2.1  REAL COMPONENTS : SAME PARITY (loop 212) AND
!*            THEN OPPOSITE PARITY (loop 214, if KM is not NCMAX)
  IF(KM /= 0) THEN
    DO JN=KM,NCMAX,2
      IJ=IJ+1
      ZGEO=ZZGEO/SQRT(REAL(MAX(JN*(JN+1),1),JPRB))
      IREVAL=JN+1-KM
      IMPVAL=NCMAX+1-KM+IREVAL
      PVORM(IJ) = PVORM(IJ) -ZOME4*PVOR(IMPVAL)
      PVOR(IMPVAL) = 0.0_JPRB
      PDIVM(IJ) = PDIVM(IJ) +ZOME4*PDIV(IREVAL)
      PDIV(IREVAL) = 0.0_JPRB
      PHGTM(IJ) = PHGTM(IJ) - ZGEO*PHGT(IMPVAL)
      PHGT(IMPVAL) = 0.0_JPRB
    ENDDO
    IF(KM /= NCMAX) THEN
      DO JN=KM+1,NCMAX,2
        IJ=IJ+1
        ZGEO=ZZGEO/SQRT(REAL(MAX(JN*(JN+1),1),JPRB))
        IREVAL=JN+1-KM
        IMPVAL=NCMAX+1-KM+IREVAL
        PVORM(IJ) = PVORM(IJ) -ZOME4*PVOR(IMPVAL)
        PVOR(IMPVAL) = 0.0_JPRB
        PDIVM(IJ) = PDIVM(IJ) +ZOME4*PDIV(IREVAL)
        PDIV(IREVAL) = 0.0_JPRB
        PHGTM(IJ) = PHGTM(IJ) - ZGEO*PHGT(IMPVAL)
        PHGT(IMPVAL) = 0.0_JPRB
      ENDDO
    ENDIF

!*       2.2  IMAGINARY COMPONENTS : SAME PARITY (loop 222)
!*            AND THEN OPPOSITE PARITY (loop 224 if JN is not NCMAX)
    DO JN=KM,NCMAX,2
      IJ=IJ+1
      ZGEO=ZZGEO/SQRT(REAL(MAX(JN*(JN+1),1),JPRB))
      IREVAL=JN+1-KM
      IMPVAL=NCMAX+1-KM+IREVAL
      PVORM(IJ) = PVORM(IJ) +ZOME4*PVOR(IREVAL)
      PVOR(IREVAL) = 0.0_JPRB
      PDIVM(IJ) = PDIVM(IJ) +ZOME4*PDIV(IMPVAL)
      PDIV(IMPVAL) = 0.0_JPRB
      PHGTM(IJ) = PHGTM(IJ) + ZGEO*PHGT(IREVAL)
      PHGT(IREVAL) = 0.0_JPRB
    ENDDO
    IF(KM /= NCMAX) THEN
      DO JN=KM+1,NCMAX,2
        IJ=IJ+1
        ZGEO=ZZGEO/SQRT(REAL(MAX(JN*(JN+1),1),JPRB))
        IREVAL=JN+1-KM
        IMPVAL=NCMAX+1-KM+IREVAL
        PVORM(IJ) = PVORM(IJ) +ZOME4*PVOR(IREVAL)
        PVOR(IREVAL) = 0.0_JPRB
        PDIVM(IJ) = PDIVM(IJ) +ZOME4*PDIV(IMPVAL)
        PDIV(IMPVAL) = 0.0_JPRB
        PHGTM(IJ) = PHGTM(IJ) + ZGEO*PHGT(IREVAL)
        PHGT(IREVAL) = 0.0_JPRB
      ENDDO
    ENDIF
  ELSE

!*       2.3  SPECIAL CASE " KM=0 " : EVEN PARITY (loop 232)
!*            AND THEN ODD PARITY (loop 234)
!*            (PDIVM is real, PVORM and PHGTM are pure imaginaries)
    DO JN=0,NCMAX,2
      IJ=IJ+1
      ZGEO=ZZGEO/SQRT(REAL(MAX(JN*(JN+1),1),JPRB))
      IREVAL=JN+1-KM
      PVORM(IJ) = PVORM(IJ) +ZOME4*PVOR(IREVAL)
      PVOR(IREVAL) = 0.0_JPRB
      PDIVM(IJ) = PDIVM(IJ) +ZOME4*PDIV(IREVAL)
      PDIV(IREVAL) = 0.0_JPRB
      PHGTM(IJ) = PHGTM(IJ) + ZGEO*PHGT(IREVAL)
      PHGT(IREVAL) = 0.0_JPRB
    ENDDO
    DO JN=1,NCMAX,2
      IJ=IJ+1
      ZGEO=ZZGEO/SQRT(REAL(MAX(JN*(JN+1),1),JPRB))
      IREVAL=JN+1-KM
      PVORM(IJ) = PVORM(IJ) +ZOME4*PVOR(IREVAL)
      PVOR(IREVAL) = 0.0_JPRB
      PDIVM(IJ) = PDIVM(IJ) +ZOME4*PDIV(IREVAL)
      PDIV(IREVAL) = 0.0_JPRB
      PHGTM(IJ) = PHGTM(IJ) + ZGEO*PHGT(IREVAL)
      PHGT(IREVAL) = 0.0_JPRB
    ENDDO
  ENDIF
ENDIF

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

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

