SUBROUTINE NFLGDSE(KBODY,CDFLAG,KFLAG)

!**** SUBROUTINE NFLGDSE - SET DESIRED DATUM FLAG

!          HEIKKI JARVINEN   ECMWF          15/NOV/1995
!          DRASKO VASILJEVIC ECMWF          15/NOV/1999

!*    PURPOSE
!     -------

!        SET DESIRED DATUM FLAG (FINAL/F.G./DEPAR/VAR Q.C./BLACKLIST)

!**   INTERFACE
!     ---------

!     ***CALL NFLGDSE(KBODY,CDFLAG,KFLAG)
!     WHERE KBODY   = ROW NUMBER TO BODY WORD'S COLUMN MDBFLG
!           CDFLAG  = NAME OF THE DESIRED FLAG
!           KFLAG   = DESIRED VALUE OF THAT FLAG

!        NFLGDSE IS CALLED BY VARIOUS SUBROUTINES

!*    METHOD
!     ------

!        CRACK AND REPACK THE PACKED DATUM FLAG WORD

!*    EXTERNALS
!     ---------

!**   MODIFICATIONS
!     -------------
!        H. Jarvinen 12 Dec 1996 : A modified subroutine call
!        S. Saarinen 24 Feb 2005 : Changed the interface
!     ------------------------------------------------------------------

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

USE YOMCMBDY , ONLY : NCMAFFBP ,NCMAFFOC ,NCMAGFBP ,NCMAGFOC ,&
 & NCMADFBP ,NCMADFOC ,NCMAVFBP ,NCMAVFOC ,&
 & NCMABFBP ,NCMABFOC  
USE YOMLUN   , ONLY : NULERR
USE YOMSCREE , ONLY : NDFLMX   ,NDFLMN
USE YOMDB

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KBODY 
CHARACTER(LEN=5)  ,INTENT(IN)    :: CDFLAG 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLAG
INTEGER(KIND=JPIM) :: ICMFLG
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

#include "fcobs.h"

#include "openmp_obs.h"

!*
!     ------------------------------------------------------------------

!        1.       INITIALIZE
!                 ----------

!*
!     ------------------------------------------------------------------

!        2.       SET THE DESIRED DATUM FLAG
!                 --------------------------

!*          2.0   INTIALIZE AND TEST THE FLAG VALUE BEFORE INSERTING

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

2 CONTINUE

ICMFLG = ROBODY(KBODY,MDBFLG)

IF(KFLAG < NDFLMN .OR. KFLAG > NDFLMX) THEN
  WRITE(NULERR,'('' *** DATUM FLAG OUT OF RANGE '')')
  WRITE(NULERR,'(''     - flag value '',I4)') KFLAG
  WRITE(NULERR,'(''     - min.limit  '',I4)') NDFLMN
  WRITE(NULERR,'(''     - max.limit  '',I4)') NDFLMX
  CALL ABOR1('NFLGDSE: DATUM FLAG OUT OF RANGE')
ENDIF

!*          2.1   FINAL FLAG

IF(CDFLAG == 'FINAL') THEN
  CALL MVBITS(KFLAG,0,NCMAFFOC,ICMFLG,NCMAFFBP)

!*          2.2   FIRST GUESS FLAG

ELSEIF(CDFLAG == 'FIRST') THEN
  CALL MVBITS(KFLAG,0,NCMAGFOC,ICMFLG,NCMAGFBP)

!*          2.3   DEPARTURE FLAG

ELSEIF(CDFLAG == 'DEPAR') THEN
  CALL MVBITS(KFLAG,0,NCMADFOC,ICMFLG,NCMADFBP)

!*          2.4   VARIATIONAL QUALITY CONTROL FLAG

ELSEIF(CDFLAG == 'VARQC') THEN
  CALL MVBITS(KFLAG,0,NCMAVFOC,ICMFLG,NCMAVFBP)

!*          2.5   BLACKLIST FLAG

ELSEIF(CDFLAG == 'BLACK') THEN
  CALL MVBITS(KFLAG,0,NCMABFOC,ICMFLG,NCMABFBP)

!*          2.6   SOMETHING IS NOT QUITE RIGHT

ELSE
  WRITE(NULERR,'('' *** UNKNOWN KEYWORD '', A)') CDFLAG
  WRITE(NULERR,'(''     - TRY :   '')')
  WRITE(NULERR,'(''       FINAL/FIRST/DEPAR/VARQC/BLACK '')')
  CALL ABOR1('NFLGDSE: UNKNOWN KEYWORD')
ENDIF

!           2.7   UPDATE THE DATUM FLAG WORD

ROBODY(KBODY,MDBFLG) = ICMFLG

!*
!     ------------------------------------------------------------------

!        3.       RETURN
!                  ------
IF (LHOOK) CALL DR_HOOK('NFLGDSE',1,ZHOOK_HANDLE)
END SUBROUTINE NFLGDSE
