SUBROUTINE CHDEVE2(PREPORT,KREPL,KSQN,KDATEV2)

!**** SUBROUTINE CHDEVE2 - SET A DATUM EVENT TO EVENT WORD NUMBER 2

!          HEIKKI JARVINEN   ECMWF          15/MAR/1995

!*    PURPOSE
!     -------

!        SET A DATUM EVENT TO EVENT WORD NUMBER 2

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

!     ***CALL CHDEVE2(PREPORT,KREPL,KSQN,KDATEV2)
!     WHERE PREPORT = CMA REPORT
!           KREPL   = CMA REPORT LENGTH
!           KSQN    = SEQUENCE NUMBER OF THE DATUM
!           KDATEV2 = DATUM EVENT NUMBER FOR EVENT WORD 2

!        CHDEVE2 IS CALLED BY SUBROUTINES

!*    METHOD
!     ------

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

!**   MODIFICATIONS  Ph. Caille 11/98  modif. getting body obs.dependant
!     -------------                    section

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

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

USE YOMLUN   , ONLY : NULOUT
USE YOMCMBDY , ONLY :    NCMESQN  ,NCMDEV2
USE YOMCMHDR , ONLY : NCMHLN   ,NCMBLN   ,NCMBFL   ,NCMBRL   ,&
 & NCMOTP   ,NCMOCH   ,NCMNLV   ,NCDTBP   ,NCDTOC  
USE YOMNMEV  , ONLY : ND2EVENT

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KREPL 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PREPORT(KREPL) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSQN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDATEV2 
INTEGER(KIND=JPIM) :: IBFL, IBLN, IBRL, ICDSQNO, ICDTYP, ICMOCH,&
 & IDEVEN2, IDEVLN2, IDEVNO2, IHLN, INLV, IOBSQNO, &
 & IOBTYP, IOFSET, IPOS, ISQN, J  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "cmoctmap.intfb.h"

#include "fcobs.h"
!*
!     ------------------------------------------------------------------

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

!*          1.0   INTIALIZE

IF (LHOOK) CALL DR_HOOK('CHDEVE2',0,ZHOOK_HANDLE)
IHLN = INTREA(PREPORT(NCMHLN))
IBLN = INTREA(PREPORT(NCMBLN))
IBFL = INTREA(PREPORT(NCMBFL))
IBRL = INTREA(PREPORT(NCMBRL))
INLV = INTREA(PREPORT(NCMNLV))

!*          1.1   FOR EXTENDED CMA

IF(KSQN <= INLV) THEN
  IPOS = IHLN + (KSQN-1)*IBLN
  ISQN = INTREA(PREPORT(IPOS+NCMESQN))
  IF(ISQN == KSQN) GOTO 2
ENDIF

!*          1.2   FOR COMPRESSED CMA

DO J = 1, INLV
  IPOS = IHLN + (J-1)*IBLN
  ISQN = INTREA(PREPORT(IPOS+NCMESQN))
  IF(ISQN == KSQN) GOTO 2
ENDDO

!*          1.3   SOMETHING IS WRONG

CALL ABOR1(' CHDEVE : SEQUENCE NUMBER NOT FOUND ')
!*
!     ------------------------------------------------------------------

!        2.       SET A DATUM EVENT TO EVENT WORD NUMBER 2
!                 ----------------------------------------

!*          2.1   OBERVATION AND CODE TYPES AND THEIR SEQUENCE NUMBERS

2 CONTINUE
IOBTYP = INTREA(PREPORT(NCMOTP))
ICMOCH = INTREA(PREPORT(NCMOCH))
ICDTYP = IBITS(ICMOCH,NCDTBP,NCDTOC)
CALL CMOCTMAP('CODETOSQ',NULOUT,IOBTYP,ICDTYP,IOBSQNO,ICDSQNO)

!*          2.2   GET DATUM EVENT WORD NO. 2

IOFSET = IPOS + IBFL + IBRL + NCMDEV2(ICDSQNO,IOBSQNO)
IDEVEN2 = INTREA(PREPORT(IOFSET))

!*          2.3   CHANGE DATUM EVENT

IDEVNO2 = ND2EVENT(KDATEV2,IOBSQNO)
IDEVLN2 = 1
IDEVEN2 = INSERT(IDEVEN2, IDEVLN2, IDEVNO2-1)
PREPORT(IOFSET) = REAINT(IDEVEN2)
!*
!     ------------------------------------------------------------------

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

