SUBROUTINE DWLIN(KPILP,&
 & KOBTYP,KCDTYP,KOBSQNO,KCDSQNO,&
 & LDMESAGE,LDTAKEN)  

!**** SUBROUTINE DWLIN - PROCESS INPUT DWL (Doppler Wind Lidar) pseudo-PILOT

!        D. VASILJEVIC     ECMWF     13/12/00 (PILOTIN original 04/07/94)

!     PURPOSE
!     -------

!        PROCESS INPUT DWL (Doppler Wind Lidar)

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

!        CALL DWLIN(KPILP,
!                     KOBTYP,KCDTYP,KOBSQNO,KCDSQNO,
!                     LDMESAGE,LDTAKEN)
!     WHERE:
!            KPILP   = REPORT POINTER
!            KOBTYP  = OBS. TYPE
!            KCDTYP  = CODE TYPE
!            KOBSQNO = OBS. TYPE SQ. NO.
!            KCDSQNO = CODE TYPE SQ. NO.
!            LDMESAGE= OUTPUT MESSAGE SWITCH  
!            LDTAKEN = REPORT TAKEN ("ODB" REPORT UPDATED) SWITCH  

!        DWLIN IS CALLED BY SUBROUTINE CONVENTIONAL_OB

!     METHOD
!     ------

!     EXTERNALS
!     ---------

!        PRLMCHK  - PRELIMINARY CHECKS
!        GETSETE  - GET/SET BODY ENTRY
!        ERRSTAT  - OBS. ERROR
!        PILOTBE  - UPDATE PILOT BODY ENTRY
!        PPVAFL   - PRESSURE/VARIABLE FLAG RESET
!        OBINSTP  - INTSTRUMENT TYPE
!        OBSCHAR  - OBS. CHARACTERISTICS

!     MODIFICATIONS
!     -------------
!     2005-04-01   D. Tan - Original adaptation of PILOTIN
!     2005-04-01   D. Tan - Transfer satinst@hdr to instyp
!     2006-03-15   D. Tan - Changes from CY30R1 pilotin.F90
!     2006-03-16   D. Tan - Persistence error 20 m/s
!     2007-05-31   D. Tan - Convert height to geopotential
!     2009-06-30   M. Kolonko - Cleanings
!-----------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDB 
USE YOMCMBDY , ONLY :    &
 & NPSURBP  ,NPSUROC  
USE YOMANCS  , ONLY : NMDI     ,RMDI     ,RDEGREES ,RADIANS  ,EPSMAC   ,RUPMLIM  ,RDWMLIM  ,&
 & RSANMOMH ,RSBAROMH  
USE YOMVNMB  , ONLY : NVNUMB
USE YOMMKODB , ONLY : NMKCMVSE ,LTOTREM
USE YOMNMCOD , ONLY : NHEIGVC
USE YOMCST   , ONLY : RG       ,RTT
USE YOETHF   , ONLY : RTICE    ,RTWAT    ,R2ES     ,R3IES    ,&
 & R3LES    ,R4IES    ,R4LES  
USE YOMCOCTP , ONLY : NSHPCD
USE YOMLUN   , ONLY : NULOUT


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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KPILP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOBTYP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCDTYP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOBSQNO 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCDSQNO 
LOGICAL           ,INTENT(INOUT) :: LDMESAGE 
LOGICAL           ,INTENT(OUT)   :: LDTAKEN 
LOGICAL :: LLHLS

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

INTEGER(KIND=JPIM) :: IOBDATE, &
 & IOBTIME, IVNM, JWIND, JLE, &
 & ISTART, IEND, ISTID, INSTYP, &
 & IREPST, INOEPLE, INOEPL  

INTEGER(KIND=JPIM) :: IZ
INTEGER(KIND=JPIM) :: IAUX, JALL, &
 & IAUSTAT, IAUEVEN1, IAUEVEN2, IAURDBFL, IAUANFLG, &
 & IAUPFLG, IAUFLG  , IAUVERCO, IAULEVID  
INTEGER(KIND=JPIM) :: IHLS, &
             &IHLSSTAT, IHLSEVEN1, IHLSEVEN2, IHLSRDBFL, IHLSANFLG, &
             &IHLSPFLG, IHLSFLG, IHLSVERCO, IHLSLEVID, IHLSSURF

LOGICAL :: LLFAIL, LLREMOVE

CHARACTER (LEN = 8) :: CLSTID

REAL(KIND=JPRB) :: ZLAT, ZLON, ZALT, &
 & ZTIMDIF, &
 & ZWEIGHT, &
 & ZANMOMH, ZBAROMH  

REAL(KIND=JPRB) :: ZZZ
REAL(KIND=JPRB) :: ZAU, ZAUPRES, ZAUPRL, &
 & ZAUPERR, ZAUOERR, ZAUFERR, ZAURERR, &
 & ZAUFGER, ZAUFGCC1, ZAUFGCC2, &
 & ZAUFGDEP, ZAUANDEP  
REAL(KIND=JPRB) :: ZHLSPRES, ZHLSPRL, ZHLS, &
 &ZHLSPERR, ZHLSOERR, ZHLSFERR, ZHLSRERR, &
 &ZHLSFGER, ZHLSFGCC1, ZHLSFGCC2, &
 &ZHLSFGDEP, ZHLSANDEP
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "getsete.intfb.h"
#include "obinstp.intfb.h"
#include "pilotbe.intfb.h"
#include "ppvafl.intfb.h"
#include "prlmchk.intfb.h"
#include "finoerr.intfb.h"

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

#include "fcobs.h"
#include "stmfun_ifs.h"
#include "openmp_obs.h"
!*

!        1.             PRESET
!                       ------
IF (LHOOK) CALL DR_HOOK('DWLIN',0,ZHOOK_HANDLE)
ZLAT   = ROBHDR(KPILP,MDBLAT) * RDEGREES
ZLON   = ROBHDR(KPILP,MDBLON) * RDEGREES
ZALT   = ROBHDR(KPILP,MDBALT)
IOBDATE= ROBHDR(KPILP,MDBDAT)
IOBTIME= ROBHDR(KPILP,MDBETM)
CLSTID = TRANSFER(ROBHDR(KPILP,MDBSID), CLSTID)
ISTID  = 0
READ(CLSTID(1:8),'(A8)') ISTID
IREPST = ROBHDR(KPILP,MDBRST)
INOEPLE = 1 

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

!        2.             GENERAL OBSERVATION INFO.
!                       -------------------------

!*          2.1         DEFINE INSTRUMENT TYPE

INSTYP  = 0
CALL OBINSTP(ZLAT,ZLON,ISTID,&
 & KOBTYP,KCDTYP,&
 & INSTYP)  

! Trial REMOVE of Sec 2.2 for CY30R1
!! Overwrite INSTYP with satinst@hdr
!INSTYP=MOBHDR(KPILP,MDB_SATINST_AT_HDR)

!!*          2.2         SET INSTRUMENT TYPE INTO OBSERVATION
!!                       CHARACTERISTICS

!MOBHDR(KPILP,MDB_INSTTYPE_AT_HDR) = INSTYP

!!*          2.2b         SET CODE TYPE INTO OBSERVATION
!!                       CHARACTERISTICS
!! Only required if ODB has something different from NDWLPCD
!! E.g. input codetype is NLDPCD (Land Pilot), new is NDWLPCD.
!  MOBHDR(KPILP,MDB_CODETYPE_AT_HDR) = NDWLPCD
!  write(0,*)'DWLIN2.2b: Updated codetype =', MOBHDR(KPILP,MDB_CODETYPE_AT_HDR)
!!  CALL ABOR1(' DWLIN : COULD NOT UPDATE CODETYPE ')

!*          2.3         ANEMOMETER/BAROMETER HEIGHT

ZANMOMH  = RMDI
ZBAROMH  = RMDI
IF(KCDTYP == NSHPCD) then
  ZANMOMH  = RSANMOMH
  ZBAROMH  = RSBAROMH
ENDIF
ROBHDR(KPILP,MDBHOANP) = ZANMOMH
ROBHDR(KPILP,MDBHOBAP) = ZBAROMH

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

!        3.             PRELIMINARY CHECKS
!                       ------------------

!*          3.1         REPORT PARAMETERS

LLFAIL   = .FALSE.
LLREMOVE = .FALSE.
CALL PRLMCHK(KOBTYP,KCDTYP,ZLAT,ZLON,IOBDATE,IOBTIME,IREPST,ZTIMDIF,&
 & LDMESAGE,LLFAIL,LLREMOVE)  

!*          3.1.0       CHECK FOR MISSING ALTITUTE - OMIT FOR DWL PSEUDOPILOT

!IF(ZALT == RMDI) THEN
!  ROBHDR(KPILP,MDBREV1) = ICHEV1( ROBHDR(KPILP,MDBREV1),NR1EVENT(13))
!ENDIF

!*          3.1.1       UPDATE REPORT STATUS

ROBHDR(KPILP,MDBRST) = IREPST

!*          3.1.2       FAILED REPORT

IF(LLFAIL  ) THEN
  IF(LTOTREM) GO TO 7
ENDIF

!*          3.1.3       REMOVED REPORT

IF(LLREMOVE) THEN
  IF(LTOTREM) GO TO 7
ENDIF

!*          3.2         BODY PARAMETERS

!*          3.2.1       WE ACCEPT: HLoS (Horizontal Line-of-Sight wind component)

ALL_DATA_LOOP1: DO JALL = MLNKH2B(KPILP),MLNKH2B(KPILP+1)-1,INOEPLE
  INOEPL = 0
  LLHLS    = .FALSE.
  321 CONTINUE
  IF(INOEPL == INOEPLE ) THEN
    IF(LLHLS) CYCLE ALL_DATA_LOOP1  
    WRITE(NULOUT,'('' DWLIN; NO. OF ENTRIES PER LEVEL EXCEEDED: '')')
    WRITE(NULOUT,'(''          LLHLS: '',1(L1,1X))') &
     & LLHLS
    CALL ABOR1(' DWLIN : TOO MANY ENTRIES ')
  ELSE
    IF(     ROBODY(JALL+INOEPL,MDBVNM) == NVNUMB( 77)) THEN
      LLHLS    = .TRUE.
      GO TO 3217
    ELSE
      IAUX    = JALL + INOEPL
      IVNM    = ROBODY(IAUX  ,MDBVNM)
      WRITE(NULOUT,'('' DWLIN; UNEXPECTED VARIBALE: '',I10)') IVNM

!*          3.2.1.0     SET/GET

      CALL GETSETE(IAUX ,&
       & ZAUPRES,ZAUPRL,ZAU ,&
       & ZAUFGER,ZAUFGCC1,ZAUFGCC2,&
       & ZAUPERR,ZAUOERR,ZAUFERR,ZAURERR,&
       & ZAUFGDEP,ZAUANDEP,&
       & IAUSTAT,IAUEVEN1,IAUEVEN2,IAURDBFL,IAUANFLG,&
       & IAUFLG,IAUPFLG)  

      ! Note: no conversion of height (m) to geopotential (m2/s2) - yet.
      ZAUPRES = ROBODY(IAUX,MDBPPP)
      IAUVERCO= ROBODY(IAUX,MDBVCO)
      IAULEVID= ROBODY(IAUX,MDBPILID)

!*          3.2.1.2     VARIABLE

      ZAU     = ROBODY(IAUX,MDBVAR)

!*          3.2.1.3     ERROR STATISTICS

!*          3.2.1.4     STATUS, EVENTS, FLAGS

      IAUSTAT = ICHSTAT_REJECT( IAUSTAT )

!*          3.2.1.5     DEPARTURES

!*          3.2.1.6     UPDATE BODY ENTRY

      CALL PILOTBE(IAUX    ,&
       & IVNM    ,IAUVERCO,ZAUPRES ,ZAUPRL  ,ZAU     ,&
       & ZAUOERR ,ZAUPERR ,ZAUFERR ,ZAURERR ,&
       & ZAUFGER ,ZAUFGCC1,ZAUFGCC2,&
       & ZAUFGDEP,ZAUANDEP,&
       & IAUSTAT ,IAUEVEN1,IAUEVEN2,IAURDBFL,IAUANFLG,&
       & IAULEVID                                      )  
    ENDIF
  ENDIF

!*          3.2.1.7     GO CHECK IF LEVEL FINISHED:

  3217 CONTINUE
  INOEPL = INOEPL + 1
  GO TO 321
ENDDO ALL_DATA_LOOP1

!*          3.2.2       CHECK IF BUFR MISSING IND. FOR:
!                       1. VERTICAL COORDINATE
!                       2. VARIABLE
!                       3. ?

ALL_DATA_LOOP2: DO JALL = MLNKH2B(KPILP),MLNKH2B(KPILP+1)-1

!*          3.2.1.1     VERTICAL COORDINATE

  3211 CONTINUE
  IF(ROBODY(JALL  ,MDBPPP) /= RMDI ) THEN

!*          3.2.1.1a     Conversion from height (m) to geopotential (m2/s2)
    ROBODY(JALL  ,MDBPPP) = RG * ROBODY(JALL  ,MDBPPP)
    ROBODY(JALL  ,MDBVCO) = NHEIGVC

!*          3.2.1.1b     Check within limits
    IF(.NOT.(ROBODY(JALL ,MDBPPP) >= RDWMLIM.AND.&
     & ROBODY(JALL ,MDBPPP) <= RUPMLIM     )) GO TO 3212  
    ROBODY(JALL ,MDBPPP ) = RMDI
  ENDIF

!*          3.2.1.2     VARIABLE

  3212 CONTINUE
  IF(ROBODY(JALL  ,MDBVAR) /= RMDI ) THEN
    IF(.NOT.(ROBODY(JALL ,MDBVAR) >= RDWMLIM.AND.&
     & ROBODY(JALL ,MDBVAR) <= RUPMLIM     )) GO TO 3213  
    ROBODY(JALL ,MDBVAR ) = RMDI
  ENDIF

!*          3.2.1.4     ERROR STATISTICS

  3213 CONTINUE
!  Observation error may already be set so do not over-write.
!  ROBODY(JALL  ,MDBOER) = RMDI
  ROBODY(JALL  ,MDBRER) = RMDI
  ROBODY(JALL  ,MDBPER) = RMDI
  ROBODY(JALL  ,MDBFGE) = RMDI
  ROBODY(JALL  ,MDBFOE) = RMDI

!*          3.2.3       CLOSE ALL DATA LOOP2

ENDDO ALL_DATA_LOOP2

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

!        4.             OBSERVATION BODY (HLS WIND COMPONENT)
!                       -------------------------------------

4 CONTINUE
ZWEIGHT = 1.0_JPRB


!*          4.1         LOOK FOR DATA

!if(0 < 1 ) go to 6
HLS_DATA_LOOP: DO JWIND   = MLNKH2B(KPILP) , MLNKH2B(KPILP+1)-1 , INOEPLE

!*          4.1.1       PRESET

  ZHLS     = RMDI
  ZHLSPRES = RMDI
  IHLSFLG  = 0
  IHLSPFLG = 0
  IHLSVERCO= NMDI
  IHLSLEVID= NMDI

!*          4.1.2       GET POINTERS

  IHLS    = NMDI
  ISTART  = JWIND
  IEND    = ISTART + INOEPLE - 1
  DO JLE = ISTART , IEND
    IF(ROBODY(JLE,MDBVNM) == NVNUMB( 77))        IHLS  = JLE
  ENDDO

!*          4.2         HLoS WIND COMPONENT

  IF(IHLS == NMDI )    THEN
    WRITE(NULOUT,'('' DWLIN; HLS ENTRY MISSING '')')
    CALL ABOR1(' DWLIN : HLS MISSING ')
  ENDIF
  IVNM    = NVNUMB( 77)

!*          4.2.0       SET/GET

  CALL GETSETE(IHLS,&
   & ZHLSPRES,ZHLSPRL,ZHLS,&
   & ZHLSFGER,ZHLSFGCC1,ZHLSFGCC2,&
   & ZHLSPERR,ZHLSOERR,ZHLSFERR,ZHLSRERR,&
   & ZHLSFGDEP,ZHLSANDEP,&
   & IHLSSTAT,IHLSEVEN1,IHLSEVEN2,IHLSRDBFL,IHLSANFLG,&
   & IHLSFLG,IHLSPFLG)  

  ZHLSPRES = ROBODY(IHLS,MDBPPP  )
  IHLSVERCO= ROBODY(IHLS,MDBVCO  )
  IHLSLEVID= ROBODY(IHLS,MDBPILID)
  IHLSSURF = IBITS(IHLSLEVID,NPSURBP,NPSUROC)
  IF(ZHLSPRES == RMDI) THEN
    ZZZ = ROBODY(IZ ,MDBVAR)
    IF(ZZZ /= RMDI) THEN
      ZHLSPRES  = ZZZ
      IHLSVERCO = NHEIGVC
    ELSE
      IHLSSTAT = ICHSTAT_REJECT( IHLSSTAT )
    ENDIF
  ENDIF
  
!*          4.2.2       VARIABLE

  IF(ROBODY(IHLS  ,MDBVAR) /= RMDI ) THEN
    ZHLS    = ROBODY(IHLS  ,MDBVAR  )
  ELSE
    IHLSSTAT = ICHSTAT_REJECT( IHLSSTAT )
  ENDIF

!*          4.2.3       ERROR STATISTICS

!*          4.2.3a       PERSISTENCE ERROR

  ZHLSPERR  = 20._JPRB ! TODO: REMOVE eventually ! RMDI

!*          4.2.3b       OBSERVATION ERROR

  ZHLSOERR  = RMDI
  IF(ROBODY(IHLS   ,MDBOER) /= RMDI ) THEN
    ZHLSOERR    = ROBODY(IHLS  ,MDBOER)
  ENDIF

!*          4.2.3c       FINAL OBSERVATION ERROR

  ZHLSFERR = RMDI
  CALL FINOERR(ZHLSPERR,ZHLSOERR,ZHLSFERR)

!*          4.2.4       STATUS, EVENTS, FLAGS

  IF(NMKCMVSE( 77,KCDSQNO,KOBSQNO) == 0)  THEN
    IHLSSTAT = ICHSTAT_REJECT( IHLSSTAT )
  ENDIF
  CALL PPVAFL(IHLSPFLG,IHLSFLG,IHLSRDBFL)

!*          4.2.5       DEPARTURES

!*          4.2.6       UPDATE BODY ENTRY

  CALL PILOTBE(IHLS     ,&
   & IVNM    ,IHLSVERCO,ZHLSPRES ,ZHLSPRL  ,ZHLS    ,&
   & ZHLSOERR ,ZHLSPERR ,ZHLSFERR ,ZHLSRERR ,&
   & ZHLSFGER ,ZHLSFGCC1,ZHLSFGCC2,&
   & ZHLSFGDEP,ZHLSANDEP,&
   & IHLSSTAT ,IHLSEVEN1,IHLSEVEN2,IHLSRDBFL,IHLSANFLG,&
   & IHLSLEVID                                      )  

ENDDO HLS_DATA_LOOP

!*
!-----------------------------------------------------------------------
!        5.             OBSERVATION BODY (WIND)
!                       -----------------------

!5 CONTINUE
!ZWEIGHT = 1.0_JPRB

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

!        6.             FINISH OFF REPORT (re)CREATION
!                       ------------------------------

6 CONTINUE

!*          6.1         UPDATE HEADER PARAMETERS (IF ANY)

!*          6.2         ODB REPORT UPDATED SWITCH

LDTAKEN = .TRUE.
!*
!-----------------------------------------------------------------------

!        7.             IF OUTPUT MESSAGE; PRINT LAT/LON
!                       --------------------------------

7 CONTINUE
IF(LDMESAGE)           THEN
  WRITE(NULOUT,'('' LAT.     :'',F10.2)') ZLAT
  WRITE(NULOUT,'('' LON.     :'',F10.2)') ZLON
  CALL FLUSH(NULOUT)
ENDIF
!*
!-----------------------------------------------------------------------

!        8.             RETURN
!                       ------

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