SUBROUTINE WRXFU(KNUMER)

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMXFU   , ONLY : NFDXFU   ,NTYPXFU  ,TYPE_XFU
USE YOMDIM   , ONLY : NPROMA
USE YOMGEM   , ONLY : NGPTOT
USE YOMCT0   , ONLY : LRPLANE
USE YOMXFUB  , ONLY : XFUBUF
USE YOMGC    , ONLY : GM

!**** * WRXFU  * - ROUTINE TO EXTRAXCT AND WRITE INSTANTANEOUS FLUXES

!     PURPOSE.
!     --------
!        WRITES YOMYFU ON DISK

!**   INTERFACE.
!     ----------
!        *CALL* *WRXFU*

!     EXPLICIT ARGUMENTS :
!     --------------------
!         KNUMER : logical unit number of the file

!     IMPLICIT ARGUMENTS :
!     --------------------
!        COMMON  YOMYFU

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

!         FAIENC    (SEE MANIPULATION DE FICHIER ARPEGE)
!         EXTGPFT

!     REFERENCE.
!     ----------
!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS

!     AUTHOR.
!     -------
!        O.CLARY

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 06/92
!        Modified : 18/08/93 R. El Khatib (PBL temperature extrema)
!        Modified : 07/10/94 EB and DG (surface fluxes)
!        Modififed: 95-06-02 by R. El Khatib (GRNORM)
!        Modified : 95-10-22 by M.Hamrud (interface block for EXTGPFT)
!        Modified : 97-03-13 by JPh. Piedelievre (Distributed Memory)
!        Modified 98-08-10 by K. YESSAD: removal of LRPOLE option.
!          - removal of the last argument (.FALSE.) in 'CALL DIWRGRID'.
!    R. El Khatib : 99-12-28 remove poles rows
!        Modified : 00-03-29 R. El Khatib Indexes of convections & PBL calculations
!        Modified : 00-03 by R. El Khatib - derived types
!        Modified : 01-11 by S. Ivatek-Sahdan - bf - problem in ALADIN extension
!                        zone, all fluxes from NGPTOT_CAP+1 to NGPTOT => 0
!    R. El Khatib : 02-01-17 ALADIN E-zone treatment moved to cnt4.
!    R. El Khatib : 02-21-20 Cleaning
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning
!        -----------------------------------------------------------

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KNUMER 
REAL(KIND=JPRB) :: ZREAL(NGPTOT,NFDXFU)
REAL(KIND=JPRB) :: ZGP(NPROMA,NFDXFU)

CHARACTER(LEN=4) :: CLPREF(NFDXFU)
CHARACTER(LEN=16) :: CLSUFF(NFDXFU)
INTEGER(KIND=JPIM) :: ILEV(NFDXFU), IPAR(NFDXFU)

INTEGER(KIND=JPIM) :: IEND, JF, JROF, IST, JKGLO, IOFF, JL
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "sc2rdg.intfb.h"
#include "wrgp2fa.intfb.h"

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

!*       1.  PREPARATIONS

IF (LHOOK) CALL DR_HOOK('WRXFU',0,ZHOOK_HANDLE)
IOFF=0
DO JF=1,NTYPXFU
  DO JL=1,TYPE_XFU(JF)%ILEV
    CLPREF(IOFF+JL)=TYPE_XFU(JF)%CLPREF(JL)
    ILEV(IOFF+JL)=TYPE_XFU(JF)%INUMLEV(JL)
    CLSUFF(IOFF+JL)=TYPE_XFU(JF)%CLSUFF
    IPAR(IOFF+JL)=TYPE_XFU(JF)%IPARITY
  ENDDO
  IOFF=IOFF+TYPE_XFU(JF)%ILEV
ENDDO

!*       2.  READ THE BUFFER

IST=1
DO JKGLO=1,NGPTOT,NPROMA
  IEND=MIN(NPROMA,NGPTOT-JKGLO+1)
  CALL SC2RDG(XFUBUF,JKGLO,IST,IEND,ZGP)
  DO JF=1,NFDXFU
    DO JROF=IST,IEND
      ZREAL(JROF+JKGLO-1,JF)=ZGP(JROF,JF)
    ENDDO
  ENDDO
ENDDO

!       3.  DE-REDUCE VECTOR FIELDS

IF (LRPLANE) THEN
  DO JF=1,NFDXFU
    IF (IPAR(JF) == 1) THEN
      ZREAL(1:NGPTOT,JF)=ZREAL(1:NGPTOT,JF)*GM(1:NGPTOT)
    ENDIF
  ENDDO
ENDIF

!       4.   PACK & WRITE OUT TO FILE

CALL WRGP2FA(ZREAL,CLPREF,ILEV,CLSUFF,NFDXFU,KNUMER)
!     ----------------------------------------------------------------

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