SUBROUTINE GRIDFPOS(LDCFU,LDXFU,LDLAG)

!**** *GRIDFPOS*  - Full Post-Processing on grid point fields

!     PURPOSE.
!     --------
!        Performs horizontal post-processing on physical fields and
!        fluxes

!**   INTERFACE.
!     ----------
!       *CALL* *GRIDFPOS*

!        EXPLICIT ARGUMENTS
!        --------------------
!           LDLAG : Post-processing physics fields if called in lagged mode
!           LDCFU : Cumulated fluxes activated
!           LDXFU : Instantaneous fluxes activated

!        IMPLICIT ARGUMENTS
!        --------------------
!        NONE.

!     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 : 95-07-24 (off-line reproductibility)
!        Modified : 95-10-30 by M.Hamrud (Changed CLCONF format)
!    R. El Khatib : 95-11-21 (buffers for off-line reproductibility)
!    R. El Khatib : 96-07-19 (clean up call to maxgpfv)
!    R. El Khatib : 96-08-06 (preprocessing of precipitation fields)
!        Modified : K. YESSAD (MARCH 1997): parallelisation of FULL-POS.
!        Modified : 97-08-15 by N. Wedi (LDLAG)
!    R. El Khatib : 98-01-28 (Modularity : PREGPFPOS)
!    R. El Khatib : 98-09-11 (modify fluxes only if LFPOSHOR)
!        Modified : 98-09-16 by G. Radnoti   ezone computations
!    R. El Khatib : 99-02-19 (HEFPBUF allocated/released here) ; 
!                             FPEZO2H called with CLIOCONF
!    R. El Khatib : 00-07-27 Compute and save aux. buffer anytime
!                           Special conf 'G'
!    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 improvemnts
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!    R. El Khatib : 05-03-23 Option to subcontract surface field transformation
!                            to SURFEX
!       K. Yessad : 28-02-2007 DM-features optimisations in FULL-POS
!     ------------------------------------------------------------------

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

USE YOMLUN   , ONLY : NULOUT
USE YOMCT0   , ONLY : LFPART2  ,NSTOP    ,LARPEGEF ,LALLOPR  ,NPRINTLEV, &
 & LAROME, LSCREEN, NCONF
USE YOMFPC   , ONLY : WSXI     ,WDXI     ,WSXO     ,WDXO     ,NFPDOM   , &
 & NFPSURFEX
USE YOMDFPB  , ONLY : NLENHFPB ,HFPBUF   ,NSTAHFPB ,NELENHFP ,HEFPBUF  , &
 & NESTAHFP  
USE YOMPFPB  , ONLY : NLENGFPB ,GFPBUF   ,NSTAGFPB ,NELENGFP ,GEFPBUF  , &
 & NESTAGFP  
USE YOMPHY   , ONLY : LMPHYS
USE SURFACE_FIELDS_MIX  , ONLY : SP_SB, YSP_SB, SP_RR, YSP_RR
USE YOMFPG   , ONLY : NFPRGPL_DEP,LFPOSHOR ,LFPEZO   ,RFPLA    ,RFPLO    , &
 & RFPLA_DEP,RFPLO_DEP,LFPOSBUF
USE YOMFPEZO , ONLY : NFPROMEL ,NFPEBLKS
USE PTRFP4   , ONLY : YRQGFP
USE TYPE_FPRQPHYS, ONLY : ALLOCATE_FPRQPHY,INQUIRE_FPRQPHY
USE PTRFPB2  , ONLY : NFPVT0   ,MFPVT0
USE YOMCT3   , ONLY : NSTEP
USE YOMFPSC2 , ONLY : NFPROMA  ,NFPBLOCS
USE TRAJECTORY_MOD, ONLY: LTRAJSAVE
USE YOM4FPOS , ONLY : NCPHYFP  ,NAPHYFP  ,NIPHYFP  ,NFPOSPHY
USE YOMAFN   , ONLY : GFP_PHYDS
USE YOMFPDIM , ONLY : NFPBFIN  ,NFPBFOUT
USE YOMWFPB  , ONLY : WLAN04   ,WLAN12   ,WSEA04   ,WSEA12
USE YOMWFPDS , ONLY : LWLAN12  ,LWLAN04  ,LWSEA12  ,LWSEA04
USE YOMFPCT0 , ONLY : NFPCT0

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

IMPLICIT NONE

LOGICAL           ,INTENT(IN)    :: LDCFU 
LOGICAL           ,INTENT(IN)    :: LDXFU 
LOGICAL           ,INTENT(IN)    :: LDLAG 

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

CHARACTER (LEN = 9) ::  CLCONF
CHARACTER (LEN = 1) ::  CLIOCONF

INTEGER(KIND=JPIM) :: JF, JD, JU, JV, IUCOD, IVCOD

LOGICAL :: LLALLOC=.TRUE.
LOGICAL :: LLBEFORE              ! =.T. before in-line post-processing
LOGICAL :: LLXFU, LLPHY          ! To save model data before post-processing
LOGICAL :: LLTRAJSAVE
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "fpezo2h.intfb.h"
#include "fpmodcfu.intfb.h"
#include "fpmodxfu.intfb.h"
#include "maxgpfv.intfb.h"
#include "pregpfpos.intfb.h"
#include "scan2h.intfb.h"
#include "sufpsc2b.intfb.h"
#include "sufpsuw.intfb.h"
#include "wrhfp.intfb.h"
#include "wrmlfp.intfb.h"
#include "wrmlfpl.intfb.h"
#include "fp2sx1.intfb.h"

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

IF (LHOOK) CALL DR_HOOK('GRIDFPOS',0,ZHOOK_HANDLE)

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

LLTRAJSAVE=LTRAJSAVE
IF (NFPOSPHY > 0 .OR. NFPVT0 > 0) THEN

  LLPHY=.TRUE.
! Auxilary buffer can contain physical surface fields or instantaneous fluxes :
  LLXFU=LDXFU.OR.(NFPVT0 > 0)

!*       1. SAVE MODEL GRID-POINT DATA AND PACK CURRENT DATA
!           ------------------------------------------------

  LTRAJSAVE=.false.

  IF (LARPEGEF.AND.NSTOP > 0.AND..NOT.LFPART2) THEN
    LLBEFORE=.TRUE.
    CALL PREGPFPOS(LLBEFORE,LLPHY,LLXFU,LDCFU)
  ENDIF

!*       2. MODIFY PRECIPITATIONS FIELDS
!           ----------------------------

  IF (LFPOSHOR) THEN
    IF (LDCFU) THEN
      CALL FPMODCFU
    ENDIF
    IF (LDXFU) THEN
      CALL FPMODXFU
    ENDIF
  ENDIF

!*       3. COMPUTE MAX. VALUES RELATED TO SOIL MOISTURE
!           --------------------------------------------

!*       3.1 COMPUTE INPUT MAX. VALUES RELATED TO SOIL MOISTURE

  WSXI=1.0_JPRB
  WDXI=1.0_JPRB
  IF (LMPHYS.AND.(.NOT.(LAROME).OR.(LAROME.AND.(LSCREEN.OR.NCONF==131)))) THEN
    CALL MAXGPFV(SP_RR(:,YSP_RR%YW%MP0,:)  ,WSXI)
    CALL MAXGPFV(SP_SB(:,1,YSP_SB%YQ%MP0,:),WDXI)
  ENDIF
  WSXO=WSXI
  WDXO=WDXI

!*       4. SETUP SURFACE-DEPENDENT WEIGHTS-RELATED ARRAYS
!           ----------------------------------------------

  IF ((NSTOP == 0 .AND. NFPCT0 /= -1) .OR. LLALLOC) THEN
    IF (LWLAN12) THEN
      ALLOCATE(WLAN12(NFPRGPL_DEP,12))
      IF (LALLOPR) THEN
        WRITE(NULOUT,9990) 'WLAN12   ',SIZE(WLAN12),SHAPE(WLAN12)
      ENDIF
    ENDIF
    IF (LWLAN04) THEN
      ALLOCATE(WLAN04(NFPRGPL_DEP,4))
      IF (LALLOPR) THEN
        WRITE(NULOUT,9990) 'WLAN04   ',SIZE(WLAN04),SHAPE(WLAN04)
      ENDIF
    ENDIF
    IF (LWSEA12) THEN
      ALLOCATE(WSEA12(NFPRGPL_DEP,12))
      IF (LALLOPR) THEN
        WRITE(NULOUT,9990) 'WSEA12   ',SIZE(WSEA12),SHAPE(WSEA12)
      ENDIF
    ENDIF
    IF (LWSEA04) THEN
      ALLOCATE(WSEA04(NFPRGPL_DEP,4))
      IF (LALLOPR) THEN
        WRITE(NULOUT,9990) 'WSEA04   ',SIZE(WSEA04),SHAPE(WSEA04)
      ENDIF
    ENDIF
    LLALLOC=.FALSE.
    IF (LWLAN12.OR.LWLAN04.OR.LWSEA12.OR.LWSEA04) CALL SUFPSUW
  ENDIF
  IF (NSTOP == 0 .AND. NFPCT0 >= -1) THEN
    IF (LFPOSBUF) THEN
      DEALLOCATE(RFPLA,RFPLO)
      DEALLOCATE(RFPLA_DEP,RFPLO_DEP)
      IF (LALLOPR) THEN
        WRITE(NULOUT,9991) 'RFPLA     '
        WRITE(NULOUT,9991) 'RFPLO     '
        WRITE(NULOUT,9991) 'RFPLA_DEP '
        WRITE(NULOUT,9991) 'RFPLO_DEP '
      ENDIF
    ENDIF
  ENDIF

!*       5. PERFORM POST-PROCESSING ON AUXILARY FIELDS
!           ------------------------------------------

  IF (NFPVT0 > 0) THEN

!*       5.1 Setup request

    NFPBFIN =NFPVT0
    NFPBFOUT=NFPVT0

    CALL ALLOCATE_FPRQPHY(YRQGFP,NFPDOM,1,NFPBFOUT)
    IF (NPRINTLEV >= 1.OR. LALLOPR) THEN
      CALL INQUIRE_FPRQPHY(YRQGFP,'YRQGFP',NULOUT)
    ENDIF
    DO JF=1,NFPBFOUT
      YRQGFP%ICOD(JF)=MFPVT0(JF)
      YRQGFP%ILEV(JF)=1
      YRQGFP%IDOM(1,JF)=NFPDOM
      YRQGFP%IVEC(JF)=0
    ENDDO
    DO JF=1,NFPBFOUT
      DO JD=1,NFPDOM
        YRQGFP%IDMP(JD,1,JF)=JD
      ENDDO
    ENDDO
    DO JV=1,NFPBFOUT
      IVCOD=YRQGFP%ICOD(JV)
      IF (GFP_PHYDS(IVCOD)%IORDR < 0) THEN
        ! V => find U :
        DO JU=1,NFPBFOUT
          IUCOD=YRQGFP%ICOD(JU)
          IF (GFP_PHYDS(IUCOD)%IORDR > 0) THEN
            IF (GFP_PHYDS(IUCOD)%CLPAIR == GFP_PHYDS(IVCOD)%CLPAIR) THEN
              YRQGFP%IVEC(JU)=1
              YRQGFP%IVEC(JV)=-JU 
            ENDIF
          ENDIF
        ENDDO
      ENDIF
    ENDDO 

    CLCONF(1:9)='0000G0000'

 !*      5.2 Interpolations

    ALLOCATE(NSTAGFPB(NFPBLOCS))
    CALL SUFPSC2B(NFPBFOUT,NSTAGFPB,NLENGFPB,NFPROMA,NFPBLOCS)
    ALLOCATE(GFPBUF(NLENGFPB))
    IF (LALLOPR) THEN
      WRITE(NULOUT,9990) 'NSTAGFPB ',SIZE(NSTAGFPB),SHAPE(NSTAGFPB)
      WRITE(NULOUT,9990) 'GFPBUF   ',SIZE(GFPBUF),SHAPE(GFPBUF)
    ENDIF
    WRITE(NULOUT,'('' NSTEP ='',I6,'' SCAN2H  '',A5)') NSTEP,CLCONF(3:7)
    CALL SCAN2H(CLCONF)

!*       5.3 Biperiodicizations

    IF (LFPEZO) THEN
      ALLOCATE(NESTAGFP(NFPEBLKS))
      CALL SUFPSC2B(NFPBFOUT,NESTAGFP,NELENGFP,NFPROMEL,NFPEBLKS)
      ALLOCATE(GEFPBUF(NELENGFP))
      IF (LALLOPR) THEN
        WRITE(NULOUT,9990) 'NESTAGFP ',SIZE(NESTAGFP),SHAPE(NESTAGFP)
        WRITE(NULOUT,9990) 'GEFPBUF  ',SIZE(GEFPBUF),SHAPE(GEFPBUF)
      ENDIF
      WRITE(NULOUT,'('' NSTEP ='',I6,'' FPEZO2H '',A1)') NSTEP,CLCONF(5:5)
      CALL FPEZO2H(CLCONF(5:5))
    ENDIF

    IF (NFPSURFEX > 0) THEN
      ! Subcontract some surface fields
      IF (.NOT.LFPART2) CALL FP2SX1
    ENDIF

  ENDIF


!*       6. PERFORM POST-PROCESSING ON MAIN FIELDS
!           --------------------------------------

  IF (NFPOSPHY > 0) THEN

!*       6.1 Setup request

    NFPBFIN =NFPOSPHY
    NFPBFOUT=NFPOSPHY

    CALL ALLOCATE_FPRQPHY(YRQGFP,NFPDOM,1,NFPBFOUT)
    IF (NPRINTLEV >= 1.OR. LALLOPR) THEN
      CALL INQUIRE_FPRQPHY(YRQGFP,'YRQGFP',NULOUT)
    ENDIF
    DO JF=1,NFPBFOUT
      YRQGFP%ICOD(JF)=NCPHYFP(JF)
      YRQGFP%ILEV(JF)=1
      YRQGFP%IDOM(1,JF)=NAPHYFP(JF)
      YRQGFP%IVEC(JF)=0
    ENDDO
    DO JF=1,NFPBFOUT
      DO JD=1,NAPHYFP(JF)
        YRQGFP%IDMP(JD,1,JF)=NIPHYFP(JD,JF)
      ENDDO
    ENDDO
    DO JV=1,NFPBFOUT
      IVCOD=YRQGFP%ICOD(JV)
      IF (GFP_PHYDS(IVCOD)%IORDR < 0) THEN
        ! V => find U :
        DO JU=1,NFPBFOUT
          IUCOD=YRQGFP%ICOD(JU)
          IF (GFP_PHYDS(IUCOD)%IORDR > 0) THEN
            IF (GFP_PHYDS(IUCOD)%CLPAIR == GFP_PHYDS(IVCOD)%CLPAIR) THEN
              YRQGFP%IVEC(JU)=1
              YRQGFP%IVEC(JV)=-JU
            ENDIF
          ENDIF
        ENDDO
      ENDIF
    ENDDO

    CLCONF(1:9)='0000P0000'

!*       6.2 Interpolations

    ALLOCATE(NSTAHFPB(NFPBLOCS))
    CALL SUFPSC2B(NFPBFOUT,NSTAHFPB,NLENHFPB,NFPROMA,NFPBLOCS)
    ALLOCATE(HFPBUF(NLENHFPB))
    IF (LALLOPR) THEN
      WRITE(NULOUT,9990) 'NSTAHFPB ',SIZE(NSTAHFPB),SHAPE(NSTAHFPB)
      WRITE(NULOUT,9990) 'HFPBUF   ',SIZE(HFPBUF),SHAPE(HFPBUF)
    ENDIF
    WRITE(NULOUT,'('' NSTEP ='',I6,'' SCAN2H  '',A5)') NSTEP,CLCONF(3:7)
    CALL SCAN2H(CLCONF)
  
!*       6.3 Biperiodicization

    IF (LFPEZO) THEN
      ALLOCATE(NESTAHFP(NFPEBLKS))
      CALL SUFPSC2B(NFPBFOUT,NESTAHFP,NELENHFP,NFPROMEL,NFPEBLKS)
      ALLOCATE(HEFPBUF(NELENHFP))
      IF (LALLOPR) THEN
        WRITE(NULOUT,9990) 'NESTAHFP ',SIZE(NESTAHFP),SHAPE(NESTAHFP)
        WRITE(NULOUT,9990) 'HEFPBUF    ',SIZE(HEFPBUF),SHAPE(HEFPBUF)
      ENDIF
      WRITE(NULOUT,'('' NSTEP ='',I6,'' FPEZO2H '',A1)') NSTEP,CLCONF(5:5)
      CALL FPEZO2H(CLCONF(5:5))
    ENDIF

  ENDIF

!*       7. RELEASE SURFACE-DEPENDENT WEIGHTS-RELATED ARRAYS
!           ------------------------------------------------

  IF (NSTOP == 0 .AND. NFPCT0 >= -1) THEN
    IF (LWLAN12) THEN
      DEALLOCATE(WLAN12)
      IF (LALLOPR) THEN
        WRITE(NULOUT,9991) 'WLAN12   '
      ENDIF
    ENDIF
    IF (LWLAN04) THEN
      DEALLOCATE(WLAN04)
      IF (LALLOPR) THEN
        WRITE(NULOUT,9991) 'WLAN04   '
      ENDIF
    ENDIF
    IF (LWSEA12) THEN
      DEALLOCATE(WSEA12)
      IF (LALLOPR) THEN
        WRITE(NULOUT,9991) 'WSEA12   '
      ENDIF
    ENDIF
    IF (LWSEA04) THEN
      DEALLOCATE(WSEA04)
      IF (LALLOPR) THEN
        WRITE(NULOUT,9991) 'WSEA04   '
      ENDIF
    ENDIF
  ENDIF


!*       8. OUTPUT
!           ------

  IF (NFPOSPHY > 0) THEN

!*       8.1 Write out

    CLIOCONF='I'
    IF (LARPEGEF) THEN
      CALL WRHFP(CLIOCONF)
    ELSE
      IF( LDLAG ) THEN
        CALL WRMLFPL(CLIOCONF)
      ELSE
        CALL WRMLFP(CLIOCONF)
      ENDIF
    ENDIF

!*       8.2 Release buffers

    DEALLOCATE(HFPBUF,NSTAHFPB)
    IF (LALLOPR) THEN
      WRITE(NULOUT,9991) 'HFPBUF   '
      WRITE(NULOUT,9991) 'NSTAHFPB '
    ENDIF
    ! GFPBUF will be deallocated at the end of dynfpos 
    ! because it may be used in the dynamic part
    IF (LFPEZO) THEN
      DEALLOCATE(HEFPBUF,NESTAHFP)
      IF (LALLOPR) THEN
        WRITE(NULOUT,9991) 'HEFPBUF  '
        WRITE(NULOUT,9991) 'NESTAHFP '
      ENDIF
      IF (NFPVT0 > 0) THEN
        DEALLOCATE(GEFPBUF,NESTAGFP)
        IF (LALLOPR) THEN
          WRITE(NULOUT,9991) 'GEFPBUF  '
          WRITE(NULOUT,9991) 'NESTAGFP '
        ENDIF
      ENDIF
    ENDIF
  ENDIF

!*       9. RECOVER MODEL GRID-POINT DATA
!           -----------------------------

  IF (LARPEGEF.AND.NSTOP > 0.AND..NOT.LFPART2) THEN
    LLBEFORE=.FALSE.
    CALL PREGPFPOS(LLBEFORE,LLPHY,LLXFU,LDCFU)
  ENDIF
  LTRAJSAVE=LLTRAJSAVE

ENDIF
! ---------------------------------------------------------------------
9990 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)
9991 FORMAT(1X,'ARRAY ',A10,' DEALLOCATED ')

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