SUBROUTINE UPDVPOS(CDCONF,&
 & KTFPP,KTFPH,KTFPTH,KTFPPV,KTFPS,KOFP2F,&
 & KOFPP,KOFPH,KOFPTH,KOFPPV,KOFPS,&
 & KAFPP,KAFPH,KAFPT,KAFPV,KAFPS,KOFP2A,&
 & KCPFP,KCHFP,KCTFP,KCVFP,KCSFP,KC2FP,&
 & KPFP,KHFP,KTFP,KVFP,KSFP,&
 & KIPFP,KIHFP,KITFP,KIVFP,KISFP,KI2FP,&
 & PLEV,KFPLEV)  

!**** *UPDVPOS*  - UPDATE COMMON YOMVPOS

!     PURPOSE.
!     --------
!        Update common YOMVPOS which contains control variables
!        for vertical post-processing

!**   INTERFACE.
!     ----------
!       *CALL* *UPDVPOS*

!        EXPLICIT ARGUMENTS
!        --------------------
!        CDCONF    : configuration of work                     (input)
!     KTFPP  : total number of fields in P levels
!     KTFPH  : total number of fields in H levels
!     KTFPTH : total number of fields in THETA levels
!     KTFPPV : total number of fields in PV levels
!     KTFPS  : total number of fields in eta levels

!     KOFPP  : total number of P levels for each field
!     KOFPH  : total number of H levels for each field
!     KOFPTH : total number of THETA levels for each field
!     KOFPPV : total number of PV levels for each field
!     KOFPS  : total number of eta levels for each field

!     KAFPP  : total number of subdomains for each P level of each field
!     KAFPH  : total number of subdomains for each H level of each field
!     KAFPT  : total number of subdomains for each THETA level of each field
!     KAFPV  : total number of subdomains for each PV level of each field
!     KAFPS  : total number of subdomains for each eta level of each field

!     KOFP2F : total number of 2D fields
!     KOFP2A : total number of subdomains for each 2D field

!     KCPFP : field pointers in P levels
!     KCHFP : field pointers in H levels
!     KCTFP : field pointers in THETA levels
!     KCVFP : field pointers in PV levels
!     KCSFP : field pointers in eta levels

!     KPFP : P level pointers for each field
!     KHFP : H level pointers for each field
!     KTFP : THETA level pointers for each field
!     KVFP : PV level pointers for each field
!     KSFP : eta level pointers for each field

!     KIPFP : subdomain index for each P level of each field
!     KIHFP : subdomain index for each H level of each field
!     KITFP : subdomain index for each THETA level of each field
!     KIVFP : subdomain index for each PV level of each field
!     KISFP : subdomain index for each eta level of each field

!     KC2FP : 2-D field pointers
!     KI2FP : subdomain index for each 2D field

!     ==== 3D VARIABLES ===

!     PLEV    : values of post-processing levels
!     KFPLEV  : number of post-processing levels

!     ==== 2D VARIABLES ===

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

!     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 : 97-06-02  3 NH fields
!        R. El Khatib 98-08-14 Simplify scan controls
!    R. El Khatib : 98-12-11 Clean up pp of liquid water
!    D.Dent       : 99-05-06 support for log surface pressure 
!    R. El Khatib : 99-10-25 More flexibility for Ps/Log(Ps)
!    R. El Khatib : 99-11-16 internal control of Ps vs Ln(Ps) through
!                   LECMWF (should be controlled by NLOSP later)
!    R. El Khatib : 00-07-31 CONF(L,Y) renamed in (Z,E)
!    R. El Khatib : 00-08-18 derived type
!    D. Dent      : 00-04-12 Support for computation of Montgomery geopotential
!    R. El Khatib : 01-03-09 configuration for bi-dimensional fields revisited
!    R. El Khatib : 01-04-10 Enable post-processing of filtered spectra
!    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 YOMCT0B  , ONLY : LECMWF
USE YOMCT0   , ONLY : LFPART2
USE YOMFPC   , ONLY : NFPXLEV  ,CFPFMT   ,RFP3P    ,RFP3H    ,RFP3TH   ,&
 & RFP3PV   ,NRFP3S   ,NFPDOM   ,NFP2DF   ,&
 & NFP3DFS  ,NFP3DFP  ,NFP3DFT  ,NFP3DFH  ,NFP3DFV  ,&
 & NFP3P    ,NFP3H    ,NFP3TH   ,NFP3PV   ,NFP3S  

IMPLICIT NONE

CHARACTER(LEN=1)  ,INTENT(IN)    :: CDCONF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTFPP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTFPH 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTFPTH 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTFPPV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTFPS 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOFP2F 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOFPP(NFP3DFP) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOFPH(NFP3DFH) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOFPTH(NFP3DFT) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOFPPV(NFP3DFV) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOFPS(NFP3DFS) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KAFPP(NFP3P,NFP3DFP) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KAFPH(NFP3H,NFP3DFH) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KAFPT(NFP3TH,NFP3DFT) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KAFPV(NFP3PV,NFP3DFV) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KAFPS(NFP3S,NFP3DFS) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOFP2A(NFP2DF) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCPFP(NFP3DFP) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCHFP(NFP3DFH) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCTFP(NFP3DFT) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCVFP(NFP3DFV) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCSFP(NFP3DFS) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KC2FP(NFP2DF) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPFP(NFP3P,NFP3DFP) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KHFP(NFP3H,NFP3DFH) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTFP(NFP3TH,NFP3DFT) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KVFP(NFP3PV,NFP3DFV) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSFP(NFP3S,NFP3DFS) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIPFP(NFPDOM,NFP3P,NFP3DFP) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIHFP(NFPDOM,NFP3H,NFP3DFH) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KITFP(NFPDOM,NFP3TH,NFP3DFT) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIVFP(NFPDOM,NFP3PV,NFP3DFV) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KISFP(NFPDOM,NFP3S,NFP3DFS) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KI2FP(NFPDOM,NFP2DF) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PLEV(NFPXLEV) 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KFPLEV 
REAL(KIND=JPRB) :: ZRFP3S(NFP3S)

! LLSURF = .TRUE. to compute surface fields in this configuration
LOGICAL :: LLSURF

INTEGER(KIND=JPIM) :: JLEV

CHARACTER(LEN=1) :: CL2VH ! configuration for surface-independent 2D fields
CHARACTER(LEN=1) :: CL2CP ! configuration for surface-dependent 2D fields
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "suvpos.intfb.h"

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

!*       1.    SELECT SCAN FOR SURFACE FIELDS
!              ------------------------------

IF (LHOOK) CALL DR_HOOK('UPDVPOS',0,ZHOOK_HANDLE)
IF (CFPFMT == 'MODEL') THEN
  IF (NFP3S > 0) THEN
    CL2VH='S'
  ELSEIF(NFP3H > 0) THEN
    CL2VH='H'
  ELSEIF (NFP3P > 0 .OR. (NFP3TH == 0 .AND. NFP3PV == 0) ) THEN
    CL2VH='B'
  ELSEIF(NFP3TH > 0) THEN
    CL2VH='T'
  ELSEIF(NFP3PV > 0) THEN
    CL2VH='V'
  ENDIF
  CL2CP=CL2VH
ELSE
  IF (NFP3P > 0 .OR. (NFP3TH == 0 .AND. NFP3PV == 0) ) THEN
    CL2VH='B'
  ELSEIF(NFP3TH > 0) THEN
    CL2VH='T'
  ELSEIF(NFP3PV > 0) THEN
    CL2VH='V'
  ENDIF
  IF (NFP3H > 0 .OR. NFP3S == 0) THEN
    CL2CP='Z'
  ELSEIF(NFP3S > 0) THEN
    CL2CP='E'
  ENDIF
ENDIF

LLSURF = (CDCONF == CL2VH .OR. CDCONF == CL2CP)

! The following statements are there because of obscure historical reasons 
! At ECMWF we can't store spectral fields as level type surface so some 
! spectral fields (151 and 152) are arbitrarely stored at pressure level 1000mb
IF(LECMWF) THEN
  IF(.NOT. LFPART2) THEN
    IF(CFPFMT == 'MODEL' .AND. CDCONF == 'B') LLSURF=.TRUE.
  ENDIF
ENDIF

!*       2.    INITIALIZE REQUEST FOR A GIVEN LEVEL TYPE
!              -----------------------------------------

DO JLEV=1,NFP3S
  ZRFP3S(JLEV)=REAL(NRFP3S(JLEV),JPRB)
ENDDO

IF     (CDCONF == 'B') THEN
  CALL SUVPOS(CDCONF,RFP3P,NFP3P,KC2FP,KOFP2F,KCPFP,KTFPP,KPFP,KOFPP,&
   & PLEV,KFPLEV,KAFPP,KOFP2A,KIPFP,KI2FP,LLSURF)  
ELSEIF (CDCONF == 'H') THEN
  CALL SUVPOS(CDCONF,RFP3H,NFP3H,KC2FP,KOFP2F,KCHFP,KTFPH,KHFP,KOFPH,&
   & PLEV,KFPLEV,KAFPH,KOFP2A,KIHFP,KI2FP,LLSURF)  
ELSEIF (CDCONF == 'Z') THEN
  CALL SUVPOS(CDCONF,RFP3H,NFP3H,KC2FP,KOFP2F,KCHFP,KTFPH,KHFP,KOFPH,&
   & PLEV,KFPLEV,KAFPH,KOFP2A,KIHFP,KI2FP,LLSURF)  
ELSEIF (CDCONF == 'V') THEN
  CALL SUVPOS(CDCONF,RFP3PV,NFP3PV,KC2FP,KOFP2F,KCVFP,KTFPPV,KVFP,KOFPPV,&
   & PLEV,KFPLEV,KAFPV,KOFP2A,KIVFP,KI2FP,LLSURF)  
ELSEIF (CDCONF == 'T') THEN
  CALL SUVPOS(CDCONF,RFP3TH,NFP3TH,KC2FP,KOFP2F,KCTFP,KTFPTH,KTFP,KOFPTH,&
   & PLEV,KFPLEV,KAFPT,KOFP2A,KITFP,KI2FP,LLSURF)  
ELSEIF (CDCONF == 'E') THEN
  CALL SUVPOS(CDCONF,ZRFP3S,NFP3S,KC2FP,KOFP2F,KCSFP,KTFPS,KSFP,KOFPS,&
   & PLEV,KFPLEV,KAFPS,KOFP2A,KISFP,KI2FP,LLSURF)  
ELSEIF (CDCONF == 'S') THEN
  CALL SUVPOS(CDCONF,ZRFP3S,NFP3S,KC2FP,KOFP2F,KCSFP,KTFPS,KSFP,KOFPS,&
   & PLEV,KFPLEV,KAFPS,KOFP2A,KISFP,KI2FP,LLSURF)  
ELSEIF (CDCONF == 'M') THEN
! This is the internal configuration to select the model
! primitive variables for horizontal interpolations
! Note that many arguments are useless
  CALL SUVPOS(CDCONF,ZRFP3S,NFP3S,KC2FP,KOFP2F,KCSFP,KTFPS,KSFP,KOFPS,&
   & PLEV,KFPLEV,KAFPS,KOFP2A,KISFP,KI2FP,LLSURF)  
ELSE
  CALL ABOR1('UPDVPOS : UNKNOWN CDCONF')
ENDIF

!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('UPDVPOS',1,ZHOOK_HANDLE)
END SUBROUTINE UPDVPOS
