SUBROUTINE WRGRIDUA(KFILE)

!**** *WRGRIDUA*  - Write out grid-point fields (GFL) to FA file

!     Purpose.
!     --------
!        To write out grid-point fields (GFL) to FA file           

!**   Interface.
!     ----------
!        *CALL* *WRGRIDUA*

!        Explicit arguments :  
!        ------------------

!        KFILE : an indicator for which  file is to be read         

!        Implicit arguments :
!        ------------------

!     Method.
!     -------
!        See documentation

!     Externals.
!     ----------

!     Reference.
!     ----------
!        Revised data flow in IFS/Arpege (By Mats Hamrud)
!        Arpege/Aladin files package (J. Clochard, R. El Khatib, D. Paradis)

!     Author.
!     -------
!        *Meteo-France*

!     Modifications.
!     --------------
!        Original : 01-03-21 S. Ivatek-Sahdan
!        02-09-30 P. Smolikova - interface to INI2SCAN2M for d4 in NH
!        R. El Khatib 03-08-06 gfl.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!------------------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM   , ONLY : NFLEVG   ,NPROMA
USE YOMGEM   , ONLY : NGPTOT
USE YOM_YGFL , ONLY : YGFL     ,YGFLC
USE YOMGFL   , ONLY : GFL

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KFILE 
INTEGER(KIND=JPIM) :: JGFL, IGFL, JLEV, IOFF, JKGLO, IBL, IST, IEND, IGGP, JROF

INTEGER(KIND=JPIM) :: IGPFIELDS  ! max number of fields*levels to write to file

INTEGER(KIND=JPIM), ALLOCATABLE :: ILEV(:)           ! fields levels

CHARACTER(LEN=4),  ALLOCATABLE :: CLPREF(:) ! fields name prefix
CHARACTER(LEN=12), ALLOCATABLE :: CLSUFF(:) ! fields name suffix

REAL(KIND=JPRB), ALLOCATABLE :: ZGPFIELDS(:,:)       ! data fields to be written to file
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "wrgp2fa.intfb.h"

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

!        1.    SETUP DESCRIPTORS ARRAYS
!              ------------------------

IF (LHOOK) CALL DR_HOOK('WRGRIDUA',0,ZHOOK_HANDLE)
IGPFIELDS=YGFL%NUMGPFLDS*NFLEVG
ALLOCATE(CLPREF(IGPFIELDS),ILEV(IGPFIELDS),CLSUFF(IGPFIELDS))

IGFL=0
IGGP=0
DO JGFL=1,YGFL%NUMFLDS
  SELECT CASE (YGFLC(JGFL)%LGP)
  CASE(.TRUE.)
    IGGP=IGGP+1
    SELECT CASE (YGFLC(JGFL)%LREQOUT)
    CASE(.TRUE.)
      IGFL=IGFL+1
      IF (IGFL > YGFL%NUMGPFLDS) CALL ABOR1('WRGRIDUA : ERROR IGFL')
      IOFF=(IGFL-1)*NFLEVG
      DO JLEV=1,NFLEVG
        CLPREF(IOFF+JLEV)='S   '
        ILEV(IOFF+JLEV)=JLEV
        CLSUFF(IOFF+JLEV)=YGFLC(JGFL)%CNAME(1:12)
      ENDDO
    END SELECT
  END SELECT
ENDDO
IF (IGGP /= YGFL%NUMGPFLDS) CALL ABOR1('WRGRIDUA : ERROR IGGP')

!        3.    COPY GRIDPOINT FIELDS FROM BUFFER
!              ---------------------------------

IGGP=IGFL*NFLEVG
ALLOCATE(ZGPFIELDS(NGPTOT,IGGP))
DO JKGLO=1,NGPTOT,NPROMA
  IBL=(JKGLO-1)/NPROMA+1
  IST=1
  IEND=MIN(NPROMA,NGPTOT-JKGLO+1)
  IGFL=0
  DO JGFL=1,YGFL%NUMFLDS
    SELECT CASE (YGFLC(JGFL)%LGP)
    CASE(.TRUE.)
      SELECT CASE (YGFLC(JGFL)%LREQOUT)
      CASE(.TRUE.)
        IGFL=IGFL+1
        IOFF=(IGFL-1)*NFLEVG
        DO JLEV=1,NFLEVG
          DO JROF=IST,IEND
            ZGPFIELDS(JROF+JKGLO-1,IOFF+JLEV)=GFL(JROF,JLEV,YGFLC(JGFL)%MP,IBL)
          ENDDO
        ENDDO
      END SELECT
    END SELECT
  ENDDO
ENDDO

!*       3.    RESUME AND WRITE OUT GRID-POINT FIELDS
!              --------------------------------------

CALL WRGP2FA(ZGPFIELDS,CLPREF,ILEV,CLSUFF,IGGP,KFILE)
DEALLOCATE(CLPREF,ILEV,CLSUFF)
DEALLOCATE(ZGPFIELDS)
IF (LHOOK) CALL DR_HOOK('WRGRIDUA',1,ZHOOK_HANDLE)

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

END SUBROUTINE WRGRIDUA
