SUBROUTINE SUVFPOSL

#ifdef DOC

!**** *SUVFPOSL*  - SETUP VERTICAL POST-PROCESSING / LAGGED PART

!     PURPOSE.
!     --------
!        TO INITIALIZE THE MODULE YOMFP4L WHICH CONTAINS THE VARIABLES AND ARRAYS
!        NEEDED TO WRITE OUT POST-PROCESSED FIELDS
!        ("LAGGED" BECAUSE THE WRTING OUT IS PERFORMED IN A NEXT STEPO SEQUENCE)

!**   INTERFACE.
!     ----------
!       *CALL* *SUVFPOSL*

!        EXPLICIT ARGUMENTS
!        ------------------

!        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 : 98-04-06  Tunable spectral packing
!    R. El Khatib : 00-08-25 remove arrays for packing
!    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
!     ------------------------------------------------------------------
#endif

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

USE YOMLUN   , ONLY : NULOUT
USE YOMCT0   , ONLY : NPRINTLEV,LALLOPR  ,LFPART2
USE YOMFPC   , ONLY : LTRACEFP ,NFPDOM   ,CFPFMT
USE YOMFPDIM , ONLY : NFPAUXB  ,NFPSPB   ,NFPDYNB
USE YOMVPOS  , ONLY : QFPTYPE  ,XFPLEV   ,NFPOSDYN ,NFPTRDYN
USE YOMFP4L
USE YOMAFN   , ONLY : TFP_DYNDS

IMPLICIT NONE

INTEGER(KIND=JPIM) :: IU, J, INC, IGP, ISPA, JL, JD, IJ
LOGICAL :: LLP, LLMODEL, LLSURF
LOGICAL,SAVE  :: LLFIRST=.TRUE.
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

!*       1. DIAGNOSTICS
!           -----------

IF (LHOOK) CALL DR_HOOK('SUVFPOSL',0,ZHOOK_HANDLE)
IU=NULOUT
LLP=(LTRACEFP.AND.NPRINTLEV >= 2).OR.LALLOPR
LLMODEL=(CFPFMT=='MODEL')

!*       2. DIMENSIONS
!           ----------

IF (LLMODEL) THEN
  NDYNFPL=NFPAUXB
  NFPSPBL=NFPSPB
  NFPSPBG=NFPDYNB-NFPAUXB
ELSE
  NDYNFPL=NFPDYNB
  NFPSPBL=0
  NFPSPBG=0
ENDIF

IF (LTRACEFP) THEN
  WRITE(NULOUT,'('' NFPSPBL = '',I5,'' NDYNFPL = '',I5,'' NFPSPBG = '',I5)') &
   & NFPSPBL,NDYNFPL,NFPSPBG  
ENDIF

!*       3. ALLOCATIONS
!           -----------

!        3.1 Allocate gp array descriptors

IF (.NOT.LLFIRST) THEN
  DEALLOCATE(NFLDFPL,LFPSRFL,RLEVFPL,NDOMFPL,NINDFPL)
ENDIF
ALLOCATE(NFLDFPL(NDYNFPL),LFPSRFL(NDYNFPL),RLEVFPL(NDYNFPL))
ALLOCATE(NDOMFPL(NDYNFPL),NINDFPL(NFPDOM,NDYNFPL))
IF (LLP) THEN
  WRITE(IU,9) 'NFLDFPL  ',SIZE(NFLDFPL),SHAPE(NFLDFPL) 
  WRITE(IU,9) 'LFPSRFL  ',SIZE(LFPSRFL),SHAPE(LFPSRFL)
  WRITE(IU,9) 'RLEVFPL  ',SIZE(RLEVFPL),SHAPE(RLEVFPL)
  WRITE(IU,9) 'NDOMFPL  ',SIZE(NDOMFPL),SHAPE(NDOMFPL)
  WRITE(IU,9) 'NINDFPL  ',SIZE(NINDFPL),SHAPE(NINDFPL)
ENDIF

!        3.2 Allocate sp array descriptors

IF (LLMODEL) THEN
  IF (.NOT.LLFIRST.AND..NOT.LFPART2) THEN
    DEALLOCATE(NFPSFLDG,LFPSSRFG,RFPSLEVG)
    DEALLOCATE(NFPSSETG,NFPSLOCG)
  ENDIF
  ALLOCATE(NFPSFLDG(NFPSPBG),LFPSSRFG(NFPSPBG),RFPSLEVG(NFPSPBG))
  ALLOCATE(NFPSSETG(NFPSPBG),NFPSLOCG(NFPSPBG))
  IF (LLP) THEN
    WRITE(IU,9) 'NFPSFLDG ',SIZE(NFPSFLDG),SHAPE(NFPSFLDG)
    WRITE(IU,9) 'LFPSSRFG ',SIZE(LFPSSRFG),SHAPE(LFPSSRFG)
    WRITE(IU,9) 'RFPSLEVG ',SIZE(RFPSLEVG),SHAPE(RFPSLEVG)
    WRITE(IU,9) 'NFPSSETG ',SIZE(NFPSSETG),SHAPE(NFPSSETG)
    WRITE(IU,9) 'NFPSLOCG ',SIZE(NFPSLOCG),SHAPE(NFPSLOCG)
  ENDIF
ENDIF

!        3.3 Signal not-first allocation

LLFIRST=.FALSE.

!*       4. FILL ARRAYS
!           -----------

IGP=1
ISPA=0
DO J=1, NFPOSDYN
  IJ=NFPTRDYN(J)
  INC=QFPTYPE%ILEV(IJ)
  LLSURF=TFP_DYNDS(IJ)%LLSRF
  IF ((QFPTYPE%ISF(IJ)>=1).AND.LLMODEL) THEN
!   Spectral array
    DO JL=1,INC
      ISPA=ISPA+1
      NFPSFLDG(ISPA)=IJ
      LFPSSRFG(ISPA)=LLSURF
      IF (LLSURF) THEN
        RFPSLEVG(ISPA)=0.0_JPRB
      ELSE
        RFPSLEVG(ISPA)=XFPLEV(QFPTYPE%ILVP(JL,IJ))
      ENDIF
      NFPSSETG(ISPA)=QFPTYPE%ISET(JL,IJ)      
      NFPSLOCG(ISPA)=QFPTYPE%ILOC(JL,IJ) 
    ENDDO
  ELSE
!   Gridpoint arrays
    NFLDFPL(IGP:IGP+INC-1)=IJ
    LFPSRFL(IGP:IGP+INC-1)=LLSURF
    IF (LLSURF) THEN
      RLEVFPL(IGP:IGP+INC-1)=0.0_JPRB
    ELSE
      DO JL=1,INC
        RLEVFPL(IGP+JL-1)=XFPLEV(QFPTYPE%ILVP(JL,IJ))
      ENDDO
    ENDIF
    DO JL=1,INC
      NDOMFPL(IGP+JL-1)=QFPTYPE%IDOM(JL,IJ)
    ENDDO
    DO JL=1,INC
      DO JD=1,QFPTYPE%IDOM(JL,IJ)
        NINDFPL(JD,IGP+JL-1)=QFPTYPE%IDMP(JD,JL,IJ)
      ENDDO
      DO JD=QFPTYPE%IDOM(JL,IJ)+1,NFPDOM
        NINDFPL(JD,IGP+JL-1)=0
      ENDDO
    ENDDO
    IGP=IGP+INC
  ENDIF 
ENDDO

IF (ISPA /= NFPSPBG) THEN
  WRITE(NULOUT,*) 'ISPA=', ISPA, 'NFPSPBG=',NFPSPBG
  CALL ABOR1('SUVFPOSL : INTERNAL ERROR ISPA/NFPSPBG')
ELSEIF (IGP-1 /= NDYNFPL) THEN
  WRITE(NULOUT,*) 'IGP=', IGP, 'NDYNFPL=',NDYNFPL
  CALL ABOR1('SUVFPOSL : INTERNAL ERROR IGP/NDYNFPL')
ENDIF

! ---------------------------------------------------------------------
9 FORMAT(1X,'ARRAY ',A10,' (RE)ALLOCATED ',3I8)

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