SUBROUTINE REORDO3AD(PF,PVOR,PDIV,PHGT,KVMO,KM,KDIR)

!**** *REORDO3AD* - Re-order fields for NMI.ADJOINT

!     Purpose.   To reorder the fields for NMI so that they are
!     --------   ordered by increasing M and vorticity, divergence
!                and height follow each other. KDIR=1 means set
!                up before NMI, KDIR= -1 means put values back
!                after NMI. The routine also non-dimensionalize
!                the variables.

!**   Interface.
!     ----------
!        *CALL* *REORDO3(PF,PVOR,PDIV,PHGT,KVMO,KM,KDIR)*

!        Explicit arguments :  PF - field set up for NMI
!        --------------------  PVOR - vorticity
!                              PDIV - divergence
!                              PHGT - geopotential
!                              KM   - WAVE NUMBER
!                              KDIR - +1: PF=OUTPUT  PVOR,PDIV,PHGT=INPUT
!                                     -1: PF=INPUT   PVOR,PDIV,PHGT=OUTPUT
!        Implicit arguments :  SIVP (YOMDYN)
!        --------------------

!     Method.
!     -------

!     Externals.   NONE.
!     ----------

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS
!      P.Courtier and J.F. Geleyn: A global model with varaible
!      resolution. Application to a shallow-water model.
!      Qua.J.Roi.Met.Soc. 1988.

!     Author.
!     -------
!        Mats Hamrud and Philippe Courtier  *ECMWF*

!     Modifications.
!     --------------
!            Original : 88-05-25
!   Jean-Noel Thepaut : 90-03-15    REORDA=>REORD3A
!     Dominique Giard : 92-01-20    see REORDO3
!     L. Isaksen      : 95-01-11    Macro tasked over wave number
!        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 YOMGEM   , ONLY : NSTTYP   ,RSTRET
USE YOMDIM   , ONLY : NCMAX    ,NXMAX
USE YOMNMIA  , ONLY : LRPIMP   ,LTRANS

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KM 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PF(6*(NXMAX+1-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)) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KVMO 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDIR 
INTEGER(KIND=JPIM) :: IJ, IMPVAL, IREVAL, JN

REAL(KIND=JPRB) :: ZCP1SC, ZFP0, ZGEO, ZOME2, ZZGEO
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

IF (LHOOK) CALL DR_HOOK('REORDO3AD',0,ZHOOK_HANDLE)
IF( (.NOT.LRPIMP).AND.LTRANS.AND.(NSTTYP == 1) ) THEN
  ZCP1SC=RSTRET+1.0_JPRB/RSTRET
  ZFP0=ZCP1SC**2/4._JPRB
ELSE
  ZFP0= 1.0_JPRB
ENDIF

IF (KDIR == 1) THEN
  ZZGEO=1.0_JPRB/(2.0_JPRB*ROMEGA*RA*SQRT(ZFP0*SIVP(KVMO)))
  ZOME2=1.0_JPRB/(2.0_JPRB*ROMEGA)
  IJ=-5
  IF(KM /= 0) THEN
    DO JN=KM,NXMAX
      IJ=IJ+6
      IREVAL=JN+1-KM
      IMPVAL=NCMAX+1-KM+IREVAL
      ZGEO=ZZGEO*SQRT(REAL(MAX(JN*(JN+1),1),JPRB))
      PVOR(IREVAL)= PF(IJ)  *ZOME2
      PVOR(IMPVAL)= PF(IJ+1)*ZOME2
      PDIV(IMPVAL)= PF(IJ+2)*ZOME2
      PDIV(IREVAL)=-PF(IJ+3)*ZOME2
      PHGT(IREVAL)= PF(IJ+4)*ZGEO
      PHGT(IMPVAL)= PF(IJ+5)*ZGEO
    ENDDO
  ELSE
    DO JN=KM,NXMAX
      IJ=IJ+6
      IREVAL=JN+1-KM
      ZGEO=ZZGEO*SQRT(REAL(MAX(JN*(JN+1),1),JPRB))
      PVOR(IREVAL)= PF(IJ)  *ZOME2
      PDIV(IREVAL)=-PF(IJ+3)*ZOME2
      PHGT(IREVAL)= PF(IJ+4)*ZGEO
    ENDDO
  ENDIF

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

!*          2.    COPY FROM "NMI" ARRAY TO SPECTRAL ARRAY.
!                 ----------------------------------------

ELSEIF (KDIR == -1) THEN
  ZZGEO=2.0_JPRB*ROMEGA*RA*SQRT(ZFP0*SIVP(KVMO))
  ZOME2=2.0_JPRB*ROMEGA
  IJ=-5
  IF(KM /= 0) THEN
    DO JN=KM,NXMAX
      IJ=IJ+6
      IREVAL=JN+1-KM
      IMPVAL=NCMAX+1-KM+IREVAL
      ZGEO=ZZGEO/SQRT(REAL(MAX(JN*(JN+1),1),JPRB))
      PF(IJ)  = PVOR(IREVAL)*ZOME2
      PF(IJ+1)= PVOR(IMPVAL)*ZOME2
      PF(IJ+2)= PDIV(IMPVAL)*ZOME2
      PF(IJ+3)=-PDIV(IREVAL)*ZOME2
      PF(IJ+4)= PHGT(IREVAL)*ZGEO
      PF(IJ+5)= PHGT(IMPVAL)*ZGEO
    ENDDO
  ELSE
    DO JN=KM,NXMAX
      IJ=IJ+6
      IREVAL=JN+1-KM
      ZGEO=ZZGEO/SQRT(REAL(MAX(JN*(JN+1),1),JPRB))
      PF(IJ)  =PVOR(IREVAL)*ZOME2
      PF(IJ+1)=0.0_JPRB
      PF(IJ+2)=0.0_JPRB
      PF(IJ+3)=-PDIV(IREVAL)*ZOME2
      PF(IJ+4)= PHGT(IREVAL)*ZGEO
      PF(IJ+5)=0.0_JPRB
    ENDDO
  ENDIF
ENDIF

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

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

