SUBROUTINE FPTSA_INV(PSCA,PVOR,PDIV,PUMEAN,PVMEAN)

!**** *FPTSA_INV * - Full-Pos Transfer Spectral Array - Inverse

!     Purpose
!     -------
!       To transfer the post-processing spectral array into the spectral
!       transforms arrays.

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

!     Explicit arguments : 
!     --------------------
!        PSCA   : scalar fields
!        PVOR   : vorticity fields
!        PDIV   : divergence fields
!        PUMEAN : U - mean wind (for LAM)
!        PVMEAN : V - mean wind (for LAM)

!     Externals.
!     ----------
!        None.

!     Reference.
!     ----------
!        Fullpos technical & users guide.

!     Author.
!     -------
!        Ryad El Khatib *METEO-FRANCE*

!     Modifications.
!     --------------
!        Original : 03-02-11 From TRANSINV_FP
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        R. El Khatib  20-Apr-2007 Optimisation.
!     ------------------------------------------------------------------

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

USE YOMVPOS  , ONLY : QFPTYPE  ,NFPOSDYN ,NFPTRDYN ,MYSFSET
USE YOMFPSP  , ONLY : SPBFP    ,UMEAN    ,VMEAN
USE YOMDIM   , ONLY : NSPEC2
USE YOMFPDIM , ONLY : NFPISCA  ,NFPIVEC  ,NFPUVMN  ,NFPSPB
USE YOMCT0   , ONLY : LALLOPR
USE YOMLUN   , ONLY : NULOUT

IMPLICIT NONE

REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSCA(:,:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVOR(:,:) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDIV(:,:) 
REAL(KIND=JPRB)   ,OPTIONAL,INTENT(INOUT) :: PUMEAN(:) 
REAL(KIND=JPRB)   ,OPTIONAL,INTENT(INOUT) :: PVMEAN(:) 
INTEGER(KIND=JPIM) :: J, INC, IJ, JLEV, JS, JF
INTEGER(KIND=JPIM) :: IARR(NFPSPB)
INTEGER(KIND=JPIM) :: IFLDVOR(NFPIVEC), IFLDDIV(NFPIVEC), IFLDSCA(NFPISCA)

INTEGER(KIND=JPIM) :: IVOR     ! last pointer of vorticity fields in PVOR
INTEGER(KIND=JPIM) :: IDIV     ! last pointer of divergence fields in PDIV
INTEGER(KIND=JPIM) :: ISCA     ! last pointer of scalar fields in PSCA
INTEGER(KIND=JPIM) :: ISPB     ! last pointer of scalar fields in SPBFP
INTEGER(KIND=JPIM) :: IMNU     ! last pointer of mean U
INTEGER(KIND=JPIM) :: IMNV     ! last pointer of mean V

LOGICAL :: LLAM       ! .TRUE. if limited area model

CHARACTER(LEN=33) :: CLFMT='(1X,''ARRAY '',A10,'' DEALLOCATED '')'
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

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

!      1. Select model

IF (LHOOK) CALL DR_HOOK('FPTSA_INV',0,ZHOOK_HANDLE)
LLAM=PRESENT(PUMEAN).AND.PRESENT(PVMEAN)

!      2. Set fields correspondences

IVOR=1
IDIV=1
ISCA=1
ISPB=1
IMNU=1
IMNV=1
DO J=1,NFPOSDYN
  IJ=NFPTRDYN(J)
  IF (QFPTYPE%ISF(IJ) >= 1) THEN
    SELECT CASE (QFPTYPE%ILED(IJ))
    CASE (1)
!       U  => put Vor
      DO JLEV=1, QFPTYPE%ILEV(IJ)
        IF (QFPTYPE%ISET(JLEV,IJ)==MYSFSET) THEN
          INC=QFPTYPE%ISPD(JLEV,IJ)
          DO JF=0,INC-1
            IFLDVOR(IVOR+JF)=ISPB+JF
            IARR(ISPB+JF)=1
          ENDDO
          ISPB=ISPB+INC
          IF (LLAM) THEN
            PUMEAN(IVOR:IVOR+INC-1)=UMEAN(IMNU:IMNU+INC-1)
            IMNU=IMNU+INC
          ENDIF
          IVOR=IVOR+INC
        ENDIF
      ENDDO
    CASE (:-1)
!       V => put Div
      DO JLEV=1, QFPTYPE%ILEV(IJ)
        IF (QFPTYPE%ISET(JLEV,IJ)==MYSFSET) THEN
          INC=QFPTYPE%ISPD(JLEV,IJ)
          DO JF=0,INC-1
            IFLDDIV(IDIV+JF)=ISPB+JF
            IARR(ISPB+JF)=-1
          ENDDO
          ISPB=ISPB+INC
          IF (LLAM) THEN
            PVMEAN(IDIV:IDIV+INC-1)=VMEAN(IMNV:IMNV+INC-1)
            IMNV=IMNV+INC
          ENDIF
          IDIV=IDIV+INC
        ENDIF
      ENDDO
    CASE (0,2,3)
!       "Scalar"
      DO JLEV=1, QFPTYPE%ILEV(IJ)
        IF (QFPTYPE%ISET(JLEV,IJ)==MYSFSET) THEN
          INC=QFPTYPE%ISPD(JLEV,IJ)
          DO JF=0,INC-1
            IFLDSCA(ISCA+JF)=ISPB+JF
            IARR(ISPB+JF)=0
          ENDDO 
          ISPB=ISPB+INC
          ISCA=ISCA+INC
        ENDIF
      ENDDO
    END SELECT
  ENDIF
ENDDO
IF (ISCA-1 /= NFPISCA) CALL ABOR1('FPTSA_INV : INTERNAL ERROR ISCA')
IF (IDIV+IVOR-2 /= 2*NFPIVEC) CALL ABOR1('FPTSA_INV : INTERNAL ERROR IDIV+IVOR')
IF (ISPB-1 /= NFPISCA+2*NFPIVEC) CALL ABOR1('FPTSA_INV : INTERNAL ERROR ISPB')
IF (LLAM) THEN
  IF (IMNU+IMNV-2 /= 2*NFPUVMN) CALL ABOR1 &
   & ('FPTSA_INV : INTERNAL ERROR IMNU/IMNV')  
ENDIF

!      3. Fill spectral post-processing arrays

DO J=1,NFPSPB
  IF (IARR(J)==1) THEN
    DO JF=1,NFPIVEC
      IF (J==IFLDVOR(JF)) THEN
        DO JS=1,NSPEC2
          PVOR(JF,JS)=SPBFP(J,JS)
        ENDDO
      ENDIF
    ENDDO
  ELSEIF (IARR(J)==-1) THEN
    DO JF=1,NFPIVEC
      IF (J==IFLDDIV(JF)) THEN
        DO JS=1,NSPEC2
          PDIV(JF,JS)=SPBFP(J,JS)
        ENDDO
      ENDIF
    ENDDO
  ELSEIF (IARR(J)==0) THEN
    DO JF=1,NFPISCA
      IF (J==IFLDSCA(JF)) THEN
        DO JS=1,NSPEC2
          PSCA(JF,JS)=SPBFP(J,JS)
        ENDDO
      ENDIF
    ENDDO
  ENDIF
ENDDO

!      4. Deallocate spectral post-processing arrays

DEALLOCATE(SPBFP)
IF (LALLOPR) WRITE(NULOUT,CLFMT) 'SPBFP    '
IF (LLAM) THEN
  DEALLOCATE(UMEAN,VMEAN)
  IF (LALLOPR) WRITE(NULOUT,CLFMT) 'UMEAN    '
  IF (LALLOPR) WRITE(NULOUT,CLFMT) 'VMEAN    '
ENDIF

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

IF (LHOOK) CALL DR_HOOK('FPTSA_INV',1,ZHOOK_HANDLE)

END SUBROUTINE FPTSA_INV
