SUBROUTINE GEOSRIN(KTSP ,&
 & KOBTYP,KCDTYP,KOBSQNO,KCDSQNO,&
 & LDMESAGE,LDTAKEN)  

!**** SUBROUTINE GEOSRIN - PROCESS INPUT GEOS RADIANCES

!        D. VASILJEVIC     ECMWF     13/12/00 (original 19/03/99)
!        R. MUNRO          ECMWF     16/05/99

!     PURPOSE
!     -------

!        PROCESS INPUT GEOS RADIANCES

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

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

!        GEOSRIN IS CALLED BY SUBROUTINE ????????

!     METHOD
!     ------

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

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

!     MODIFICATIONS
!     -------------
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      01-Dec-2003 CY28R1 Cleaning

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

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDB
USE YOMANCS  , ONLY : RMDI     ,RDEGREES ,RADIANS  ,EPSMAC   ,RUPMLIM  ,RDWMLIM  
USE YOMCST   , ONLY : RTT      
USE YOMVNMB  , ONLY : NVNUMB
USE YOMNMCOD , ONLY : NTOVCVC
USE YOMMKODB , ONLY : NMKCMVSE ,LTOTREM
USE YOETHF   , ONLY : RTICE    ,RTWAT    ,R2ES     ,R3IES    ,&
 & R3LES    ,R4IES    ,R4LES  
USE YOMLUN   , ONLY : NULOUT

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KTSP 
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 
!-----------------------------------------------------------------------

INTEGER(KIND=JPIM) :: IOBDATE, &
 & IOBTIME, IVNM, ISTID, INSTYP, IREPST  
INTEGER(KIND=JPIM) :: ITEMP, JT, &
 & ITTSTAT, ITTEVEN1, ITTEVEN2, ITTRDBFL, ITTANFLG, &
 & ITTPFLG, ITTFLG  
INTEGER(KIND=JPIM) :: IAUX, JALL, &
 & IAUSTAT, IAUEVEN1, IAUEVEN2, IAURDBFL, IAUANFLG, &
 & IAUPFLG, IAUFLG  , IAUVERCO  

LOGICAL :: LLFAIL, LLREMOVE

CHARACTER (LEN = 8) :: CLSTID

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

REAL(KIND=JPRB) :: ZTTPRES, ZTTPRL, ZT, &
 & ZTTOERR, ZTTPERR, ZTTFERR, ZTTRERR, &
 & ZTTFGER, ZTTFGCC1, ZTTFGCC2, &
 & ZTTFGDEP, ZTTANDEP  
REAL(KIND=JPRB) :: ZAU, ZAUPRES, ZAUPRL, &
 & ZAUPERR, ZAUOERR, ZAUFERR, ZAURERR, &
 & ZAUFGER, ZAUFGCC1, ZAUFGCC2, &
 & ZAUFGDEP, ZAUANDEP  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "getsete.intfb.h"
#include "obinstp.intfb.h"
#include "ppvafl.intfb.h"
#include "prlmchk.intfb.h"
#include "rad1cbe.intfb.h"

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

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

!        1.             PRESET
!                       ------

!*          1.1         GET OBS. PARAMETERS FROM "HEADER"

!*          1.1.0       BASIC ONES

IF (LHOOK) CALL DR_HOOK('GEOSRIN',0,ZHOOK_HANDLE)
ZLAT   = ROBHDR(KTSP ,MDBLAT) * RDEGREES
ZLON   = ROBHDR(KTSP ,MDBLON) * RDEGREES
IOBDATE= ROBHDR(KTSP ,MDBDAT)
IOBTIME= ROBHDR(KTSP ,MDBETM)
CLSTID = TRANSFER(ROBHDR(KTSP ,MDBSID), CLSTID)
ISTID  = 0
!READ(CLSTID(1:8),'(A8)') ISTID
IREPST = ROBHDR(KTSP,MDBRST)

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

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

!*          2.1         DEFINE INSTRUMENT TYPE

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

!*          2.2         SET INSTRUMENT TYPE INTO OBSERVATION
!                       CHARACTERISTICS

ROBHDR(KTSP,MDB_INSTTYPE_AT_HDR) = INSTYP
!*
!-----------------------------------------------------------------------

!        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       UPDATE REPORT STATUS

ROBHDR(KTSP ,MDBRST) = IREPST

!*          3.1.1       FAILED REPORT

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

!*          3.1.2       REMOVED REPORT

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

!*          3.2         BODY PARAMETERS

!*          3.2.1       WE ACCEPT: RADIANCE

ALL_DATA_LOOP: DO JALL = MLNKH2B(KTSP),MLNKH2B(KTSP+1)-1
  IF(ROBODY(JALL  ,MDBVNM) == NVNUMB( 50))        GO TO 322

!*          3.3.1.0     UNEXPECTED VARIABLE

  IAUX = JALL
  IVNM = ROBODY(IAUX  ,MDBVNM)
  WRITE(NULOUT,'('' GEOSRIN; UNEXPECTED VARIABLE: '',I10)') IVNM
  LDMESAGE = .TRUE.

!*          3.2.1.1     SET/GET

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

  ZAUPRES = ROBODY(IAUX,MDBPPP)
  IAUVERCO= ROBODY(IAUX,MDBVCO)

!*          3.2.1.2     VARIBLE

  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 RAD1CBE(IAUX    ,&
   & IVNM    ,IAUVERCO,ZAUPRES ,ZAUPRL  ,ZAU     ,&
   & ZAUOERR ,ZAUPERR ,ZAUFERR ,ZAURERR ,&
   & ZAUFGER ,ZAUFGCC1,ZAUFGCC2,&
   & ZAUFGDEP,ZAUANDEP,&
   & IAUSTAT ,IAUEVEN1,IAUEVEN2,IAURDBFL,IAUANFLG  )  

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

  322 CONTINUE

!*          3.2.1.1     VERTICAL COORDINATE

  3211 CONTINUE
  IF(ROBODY(JALL  ,MDBPPP) /= RMDI ) THEN
    IF(.NOT.(ROBODY(JALL ,MDBPPP) >= RDWMLIM.AND.&
     & ROBODY(JALL ,MDBPPP) <= RUPMLIM     )) GO TO 32111  
    ROBODY(JALL ,MDBPPP ) = RMDI
  ENDIF
  32111 CONTINUE
  IF(ROBODY(JALL  ,MDBPRL) /= RMDI ) THEN
    IF(.NOT.(ROBODY(JALL ,MDBPRL) >= RDWMLIM.AND.&
     & ROBODY(JALL ,MDBPRL) <= RUPMLIM     )) GO TO 3212  
    ROBODY(JALL ,MDBPRL ) = 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.3     ERROR STATISTICS

  3213 CONTINUE
  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 LOOP

ENDDO ALL_DATA_LOOP

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

!        4.             OBSERVATION BODY (OUTPUT TO ODB)
!                       --------------------------------

ZWEIGHT = 1.0_JPRB

!*          4.1         LOOK FOR DATA

!*          4.2         RADIANCES

T_LOOP: DO JT    = MLNKH2B(KTSP ),MLNKH2B(KTSP +1)-1
  IF(ROBODY(JT   ,MDBVNM) == NVNUMB( 50)) THEN
    ITEMP = JT
    IVNM  = NVNUMB( 50)

!*          4.2.0       SET/GET

    CALL GETSETE(ITEMP,&
     & ZTTPRES,ZTTPRL,ZT  ,&
     & ZTTFGER,ZTTFGCC1,ZTTFGCC2,&
     & ZTTPERR,ZTTOERR,ZTTFERR,ZTTRERR,&
     & ZTTFGDEP,ZTTANDEP,&
     & ITTSTAT,ITTEVEN1,ITTEVEN2,ITTRDBFL,ITTANFLG,&
     & ITTFLG,ITTPFLG)  

    ZTTPRES= ROBODY(ITEMP,MDBPPP)
    ZTTPRL = ROBODY(ITEMP,MDBPRL)

!*          4.2.2       VARIABLE

    ZT     = ROBODY(ITEMP,MDBVAR  )
    IF(ZT == RMDI ) THEN
      ITTSTAT = ICHSTAT_REJECT( ITTSTAT )
    ENDIF

!*          4.2.3       ERROR STATISTICS

    ZTTRERR = ROBODY(ITEMP,MDBRER)

!*          4.2.4       STATUS, EVENTS, FLAGS

    IF(NMKCMVSE( 50,KCDSQNO,KOBSQNO) == 0)  THEN
      ITTSTAT = ICHSTAT_REJECT( ITTSTAT )
    ENDIF
    CALL PPVAFL(ITTPFLG,ITTFLG,ITTRDBFL)

!*          4.2.5       DEPARTURES

!*          4.2.6       UPDATE BODY ENTRY

    CALL RAD1CBE(ITEMP   ,&
     & IVNM    ,NTOVCVC ,ZTTPRES ,ZTTPRL  ,ZT      ,&
     & ZTTOERR ,ZTTPERR ,ZTTFERR ,ZTTRERR ,&
     & ZTTFGER ,ZTTFGCC1,ZTTFGCC2,&
     & ZTTFGDEP,ZTTANDEP,&
     & ITTSTAT ,ITTEVEN1,ITTEVEN2,ITTRDBFL,ITTANFLG  )  
  ENDIF
ENDDO T_LOOP
!*
!-----------------------------------------------------------------------

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

5 CONTINUE

!*          5.1         UPDATE HEADER PARAMETERS (IF ANY)

!*          5.2         ODB REPORT CREATED SWITCH

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

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

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

!        7.             RETURN
!                       ------

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