SUBROUTINE RDFUFA(KUNTIN,CDPREF,CDFIELD,KDEB,KFIN,KINDEX,&
 & PFIELDBUF,KLEV,KLVX,KLVBOT,LDABORT,LDALL)  

!**** *RDFUFA*  - Read a gridpoint flux from *FA*

!     Purpose.
!     --------
!           To read a gridpoint flux from a file Arpege/Aladin
!           Mandatory abort or replace missing field by 0.
!           Possible reduction of vector fields by map factor.

!**   Interface.
!     ----------
!        *CALL* *RDFUFA(...)*

!        Explicit arguments : KUNTIN - file unit number
!        ------------------   CDFIELD - field name
!                             KDEB - first latitude to be read from file
!                             KFIN  - last latitude to be read from file
!                             KINDEX  - start index to read from fields in file
!                             PFIELDBUF - output array
!                             KLEV - field level to read
!                             KLVX - number of levels to read
!                             KLVBOT - value of "bottom" level ; -9 if unknown
!                             LDABORT - .TRUE. to abort is field is missing
!                             LDALL - .TRUE. if all levels requested

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

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

!     Externals.     FACILE - read ARPEGE file
!     ----------    

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS
!        Note de travail ARPEGE Nr 12 et 17

!     Author.
!     -------
!        R. El Khatib *METEO-FRANCE*

!     Modifications.
!     --------------
!        Original : 97-12-02 (From SUGRIDA/SUGRCFU)
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NDGLG    ,NDLON    ,NFLEVG
USE YOMGEM   , ONLY : NLOENG   ,NGPTOTG
USE YOMLUN   , ONLY : NULOUT

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KUNTIN 
CHARACTER         ,INTENT(IN)    :: CDPREF*(*) 
CHARACTER         ,INTENT(IN)    :: CDFIELD*(*) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDEB 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFIN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KINDEX 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFIELDBUF(NGPTOTG) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLVX 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLVBOT 
LOGICAL           ,INTENT(IN)    :: LDABORT 
LOGICAL           ,INTENT(IN)    :: LDALL 
REAL(KIND=JPRB) :: ZREALG(NDLON*(NDGLG+2))
CHARACTER :: CLPREF*4, CLSEARCH*16

INTEGER(KIND=JPIM) :: ILEN, ILEV, INDEX, IPOS, IREP, IROF, JGL, JLON
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

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

IF (LHOOK) CALL DR_HOOK('RDFUFA',0,ZHOOK_HANDLE)
IF (LDALL) THEN
  IF (KLVX == 1) THEN
!         Single flux
    ILEV=0
    CLPREF=CDPREF
    CLSEARCH=TRIM(CLPREF)//CDFIELD(1:)
  ELSEIF(KLVX == NFLEVG+1) THEN
!         All half levels
    ILEV=KLEV
    CLPREF='S   '
    WRITE(CLSEARCH,'(''S'',I3.3,A12)') ILEV,CDFIELD(1:12)
  ELSE
    WRITE(NULOUT,'('' ERROR KLVX = '',I3)') KLVX
    CALL ABOR1('RDFUFA : ABOR1 CALLED')
  ENDIF
ELSE
  IF (KLVX == 1) THEN
!         Bottom flux only
    IF (KLVBOT > 0) THEN
      ILEV=KLVBOT
      CLPREF='S   '
      WRITE(CLSEARCH,'(''S'',I3.3,A12)') ILEV,CDFIELD(1:12)
    ELSE
      ILEV=NFLEVG
      CLPREF='SURF'
      WRITE(CLSEARCH,'(A4,A12)') CLPREF,CDFIELD(1:12)
    ENDIF
  ELSEIF(KLVX == 2) THEN
!         Top & bottom fluxes      
    ILEV=KLEV
    IF (ILEV == 0) THEN
      CLPREF='SOMM'
    ELSE
      CLPREF='SURF'
    ENDIF
    WRITE(CLSEARCH,'(A4,A12)') CLPREF,CDFIELD(1:12)
  ELSE
    WRITE(NULOUT,'('' ERROR KLVX = '',I3)') KLVX
    CALL ABOR1('RDFUFA : ABOR1 CALLED')
  ENDIF
ENDIF
CALL LFINFO(IREP,KUNTIN,CLSEARCH,ILEN,IPOS)
IF (ILEN > 0) THEN
  CALL FACILE(IREP,KUNTIN,CLPREF,ILEV,CDFIELD,ZREALG,.FALSE.)
  IROF=1
  INDEX=KINDEX
  DO JGL=KDEB,KFIN
    DO JLON=1,NLOENG(JGL)
      PFIELDBUF(IROF) = ZREALG(INDEX+JLON)
      IROF=IROF+1
    ENDDO
    INDEX=INDEX+NLOENG(JGL)
  ENDDO
  WRITE(NULOUT,'(2X,A,'' READ FROM FILE '')') CLSEARCH
ELSEIF(.NOT.LDABORT) THEN
  PFIELDBUF(:)=0.0_JPRB
  WRITE(NULOUT,'(2X,A,'' MISSING FROM FILE => SET TO 0.'')') CLSEARCH
ELSE
  WRITE(NULOUT,'(2X,A,'' MISSING FROM FILE '')') CLSEARCH
  CALL ABOR1('RDFUFA : ABOR1 CALLED')
ENDIF

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

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