SUBROUTINE SUVFPOS(CDCONF,KGT1,KAUX,KSPD,KSPB,KVDDIR,KSCDIR,KGT0,KGP,&
 & KVDDIRG,KSCDIRG,KVDINV,KSCINV,KVDINVG,KSCINVG,KUVMN)  

!**** *SUVFPOS*  - Initialize Full Post-Processing of dynamics

!     PURPOSE.
!     --------
!        To initialise and sort the list of the dynamic fields to post-process  lds
!        for a given level type of post-processing

!**   INTERFACE.
!     ----------
!       *CALL* *SUVFPOS*

!        EXPLICIT ARGUMENTS
!        --------------------
!            INPUT :
!        CDCONF: Configuration for vertical post-processing
!            OUTPUT:
!        KGT1  : number of post-processed fields to be fitted
!        KAUX  : number of post-processed fields to remain unfitted
!        KSPD  : number of derived pp. fields to be fited, given one subdom.
!        KSPB  : number of derived pp. fields to be fited
!        KVDDIR: number of vector fields in spectral arrays - direct transforms
!        KSCDIR: number of scalar fields in spectral arrays - direct transforms
!        KGT0  : number of fitted fields to be horizontally post-processed
!        KGP   : number of post-processed dynamic fields.
!        KVDDIRG: global number of vector fields in spectral arrays - direct transforms
!        KSCDIRG: global number of scalar fields in spectral arrays - direct transforms
!        KVDINV: number of vector fields in spectral arrays - inverse transforms
!        KSCINV: number of scalar fields in spectral arrays - inverse transforms
!        KVDINVG: global number of vector fields in spectral arrays - inverse transforms
!        KSCINVG: global number of scalar fields in spectral arrays - inverse transforms
!        KUVMN : number of pairs (U,V)<=>(Vor,Div)

!        IMPLICIT ARGUMENTS
!        --------------------
!           YOM4FPOS YOMVPOS

!     METHOD.
!     -------
!        SEE DOCUMENTATION

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

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

!     AUTHOR.
!     -------
!        RYAD EL KHATIB *METEO-FRANCE*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 94-04-08
!    R. El Khatib : 98-04-06  Tunable spectral packing + cleanups
!    D.Dent       : 99-05-06  support for log surface pressure    
!    R. El Khatib : 00-07-31  pointers for horizontally interpolated model fields moved from SUAFPDS
!    R. El Khatib : 00-08-18 derived type
!    D. Dent      : 00-04-12  support for computation of Montgomery geopotential
!    R. El Khatib : 01-04-05 cleaning on YOMVPOS
!    R. El Khatib : 01-08-07 Pruning options
!    R. El Khatib : 02-21-20 Fullpos B-level distribution + remove IO scheme
!    R. El Khatib : 03-04-17 Fullpos improvments
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

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

USE YOM4FPOS , ONLY : NOFPP    ,NOFPH    ,NOFPS    ,NOFPPV   ,&
 & NOFPTH   ,NCPFP    ,NCHFP    ,NCTFP    ,NCVFP    ,&
 & NCSFP    ,NAFPP    ,NAFPH    ,NAFPT    ,NAFPV    ,&
 & NAFPS    ,NIPFP    ,NIHFP    ,NITFP    ,NIVFP    ,&
 & NISFP    ,NPFP     ,NHFP     ,NTFP     ,NVFP     ,&
 & NSFP     ,NOFP2A   ,NC2FP    ,NI2FP    ,NOFP2F   ,&
 & NTFPP    ,NTFPH    ,NTFPTH   ,NTFPPV   ,NTFPS  
USE YOMVPOS  , ONLY : XFPLEV   ,NXFPLEV   ,QFPTYPE ,NFPOSDYN ,NFPTRDYN ,MYSFSET

IMPLICIT NONE

CHARACTER(LEN=1)  ,INTENT(IN)    :: CDCONF 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KGT1 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KAUX 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KSPD 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KSPB 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KVDDIR 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KSCDIR 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KGT0 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KGP 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KVDDIRG 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KSCDIRG 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KVDINV 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KSCINV 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KVDINVG 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KSCINVG 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KUVMN 
INTEGER(KIND=JPIM) :: J, IJ, JL, ISDIR, ISINV, INC
INTEGER(KIND=JPIM) :: IMOMDIR, IMOMDIRG, IMOMINV, IMOMINVG
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "updvpos.intfb.h"

!*       1. INITIALIZE THE LIST OF FIELDS TO POST-PROCESS

IF (LHOOK) CALL DR_HOOK('SUVFPOS',0,ZHOOK_HANDLE)
CALL UPDVPOS(CDCONF,&
 & NTFPP,NTFPH,NTFPTH,NTFPPV,NTFPS,NOFP2F,&
 & NOFPP,NOFPH,NOFPTH,NOFPPV,NOFPS,&
 & NAFPP,NAFPH,NAFPT,NAFPV,NAFPS,NOFP2A,&
 & NCPFP,NCHFP,NCTFP,NCVFP,NCSFP,NC2FP,&
 & NPFP,NHFP,NTFP,NVFP,NSFP,&
 & NIPFP,NIHFP,NITFP,NIVFP,NISFP,NI2FP,&
 & XFPLEV,NXFPLEV)  

!*       2. COMPUTE DIMENSIONS

!        2.1 Global dimensions for fitted/non-fitted fields in gp space

KGP  = 0
KAUX = 0
DO J=1,NFPOSDYN
  IJ=NFPTRDYN(J)
  KGP  = KGP  + QFPTYPE%ILEV(IJ)
  KAUX = KAUX + (1-MIN(QFPTYPE%ISF(IJ),1))*QFPTYPE%ILEV(IJ)
ENDDO

!        2.2 Global/Local dimensions

KGT1     = 0
KGT0     = 0
KSCDIRG  = 0
IMOMDIRG = 0
KSCINVG  = 0
IMOMINVG = 0
KSPD     = 0 
KSPB     = 0
KSCDIR   = 0
IMOMDIR  = 0
KSCINV   = 0
IMOMINV  = 0
KUVMN    = 0
DO J=1,NFPOSDYN
  IJ=NFPTRDYN(J)
  SELECT CASE (QFPTYPE%ISF(IJ))
  CASE (1:)
    ISDIR=MAX(0,(1-ABS(QFPTYPE%ILED(IJ))))
    IF (QFPTYPE%ILED(IJ)==1.OR.QFPTYPE%ILED(IJ)<0) THEN
      ISINV=0
    ELSE
      ISINV=1
    ENDIF
    DO JL=1,QFPTYPE%ILEV(IJ)
      INC      = QFPTYPE%ISPD(JL,IJ)
      KGT1     = KGT1     + QFPTYPE%ISKP(IJ)
      KSCDIRG  = KSCDIRG  + QFPTYPE%ISKP(IJ)*ISDIR
      IMOMDIRG = IMOMDIRG + QFPTYPE%ISKP(IJ)*(1-ISDIR)
      KGT0     = KGT0     + INC
      KSCINVG  = KSCINVG  + INC*ISINV
      IMOMINVG = IMOMINVG + INC*(1-ISINV)
      IF (QFPTYPE%ISET(JL,IJ)==MYSFSET) THEN
!         V-set local dimensions
        KSPD    = KSPD    + MAX(0,QFPTYPE%ISF(IJ)-2)
        KSCDIR  = KSCDIR  + QFPTYPE%ISKP(IJ)*ISDIR
        IMOMDIR = IMOMDIR + QFPTYPE%ISKP(IJ)*(1-ISDIR)
        KSPB    = KSPB    + INC
        KSCINV  = KSCINV  + INC*ISINV
        IMOMINV = IMOMINV + INC*(1-ISINV)
        KUVMN   = KUVMN   + MAX(0,-SIGN(1,QFPTYPE%ILED(IJ)))
      ENDIF
    ENDDO
  END SELECT
ENDDO
IF (MOD(IMOMDIRG,2) /= 0) THEN
  CALL ABOR1('SUVFPOS : INTERNAL ERROR ON DIR VECTOR FIELDS => SEE SUVPOS')
ELSEIF (MOD(IMOMINVG,2) /= 0) THEN
  CALL ABOR1('SUVFPOS : INTERNAL ERROR ON INV VECTOR FIELDS => SEE SUVPOS')
ELSE
  KVDDIRG = IMOMDIRG/2
  KVDINVG = IMOMINVG/2
ENDIF
IF (MOD(IMOMDIR,2) /= 0) THEN
  CALL ABOR1 &
   & ('SUVFPOS : INTERNAL ERROR ON LOCAL DIR VECTOR FIELDS => SEE SUVPOS')  
ELSEIF (MOD(IMOMINV,2) /= 0) THEN
  CALL ABOR1 &
   & ('SUVFPOS : INTERNAL ERROR ON LOCAL INV VECTOR FIELDS => SEE SUVPOS')  
ELSE
  KVDDIR = IMOMDIR/2
  KVDINV = IMOMINV/2
ENDIF

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