SUBROUTINE CONVENTIONAL_OB(KTSLOT, KPOOLNO)

!**** SUBROUTINE CONVENTIONAL_OB - PROCESS CONVENTIONAL OBS (NO SATOB)

!          DRASKO VASILJEVIC ECMWF          01/MAR/2001

!*    METHOD
!     ------

!        THE ODB IS SCANNED FOR ALL CONV OBSERVATIONS AND MAKECMA FUNCTIONS
!     ARE CARRIED OUT.

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

!     ***CALL*CONVENTIONAL_OB(KTSLOT)
!     WHERE KTSLOT = TIME SLOT

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

!        GETDB    - GET DB
!        PUTDB    - STORE DB
!        CMOCTMAP - GET OBS./CODE TYPE SEQUENCE NO.s
!        SYNOPIN  - PROCESS INPUT SYNOPs
!        AIREPIN  - PROCESS INPUT AIREPs
!        SATOBIN  - PROCESS INPUT SATOBs
!        SATAMIN  - PROCESS INPUT SATOBs
!        DRIBUIN  - PROCESS INPUT DRIBUs
!        TEMPIN   - PROCESS INPUT TEMPs
!        PILOTIN  - PROCESS INPUT PILOTs
!        EWPRFIN  - PROCESS INPUT EUROPEAN WIND PROFILERs
!        AWPRFIN  - PROCESS INPUT AMERICAN WIND PROFILERs
!        SSMIIN   - PROCESS INPUT SSMIs
!        TRMMIN   - PROCESS INPUT TRMMs
!        MERTSIN  - PROCESS INPUT SATEMs/TOVSs
!        RAD1CIN  - PROCESS INPUT LEVEL 1Cs
!        GEOSRIN  - PROCESS INPUT GEOS. radiaces
!        HIRTOIN  - PROCESS INPUT TOVS
!        PAOBIN   - PROCESS INPUT PAOBs
!        ERSIN    - PROCESS INPUT ERSs
!        NSCATIN  - PROCESS INPUT NSCATs
!        QSCATIN  - PROCESS INPUT QSCATs
!        ABOR1    - ABNORMAL TERMINATION

!        CONVENTIONAL_OB IS CALLED BY SUBROUTINE MKCMARPL

!**   MODIFICATIONS
!     -------------

!     22-Jan-2007 : Sami Saarinen, ECMWF : Testing GETDB's new variable argument list
!     03-Apr-2007 : Chris Payan, MF : access to subroutines under LMKCMARPL 2D
!         LMKCMARPL(CDTYPSQ,OBTYPSQ)==previous(.NOT.LLNOPROC)
!     ------------------------------------------------------------------

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

USE YOMDB
USE YOMCOCTP , ONLY : NSYNOP  ,NAIREP ,NDRIBU    &
 & ,NTEMP      ,NPILOT    ,NSATEM     ,NPAOB     &
 & ,NLDPCD     ,NSHPCD    ,NWPPCD     ,NEWPPCD   &
 & ,NDWLPCD    ,NSTOVS    ,NSTMCD                &     
 & ,NSYNOPSQ   ,NAIREPSQ  ,NDRIBUSQ              &
 & ,NTEMPSQ    ,NPILOTSQ  ,NSATEMSQ   ,NPAOBSQ   &
 & ,NLDPCDSQ   ,NSHPCDSQ  ,NWPPCDSQ   ,NEWPPCDSQ &
 & ,NDWLPCDSQ  ,NSTOVSSQ  ,NSTMCDSQ 
USE YOMLUN   , ONLY : NULOUT   
USE YOMOBS   , ONLY : LMKCMARPL ,LMFSCRE

IMPLICIT NONE

INTEGER(KIND=JPIM) ,INTENT(IN) :: KTSLOT 
INTEGER(KIND=JPIM) ,INTENT(IN) :: KPOOLNO
INTEGER(KIND=JPIM) :: INFO(1), IRET

INTEGER(KIND=JPIM) :: ILEN, IOBTYP, ICDTYPE, IOBS
INTEGER(KIND=JPIM) :: IOBSQNO,ICDSQNO
INTEGER(KIND=JPIM) ::  JOBS

LOGICAL :: LLMESAGE, LLTAKEN

REAL(KIND=JPRB) :: ZINFO(1)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!     ------------------------------------------------------------------
INTERFACE
#include "getdb.h"
#include "putdb.h"
END INTERFACE

#include "abor1.intfb.h"
#include "airepin.intfb.h"
#include "awprfin.intfb.h"
#include "cmoctmap.intfb.h"
#include "dribuin.intfb.h"
#include "dwlin.intfb.h"
#include "ewprfin.intfb.h"
#include "mertsin.intfb.h"
#include "paobin.intfb.h"
#include "pilotin.intfb.h"
#include "synopin.intfb.h"
#include "tempin.intfb.h"
#include "tempinmf.intfb.h"

#include "openmp_obs.h"

!*       1.       CONVENTIONAL OBS
!                 ----------------

!          1.1   INITIALIZE DB (LOCALL; ALL CONV REPs)

IF (LHOOK) CALL DR_HOOK('CONVENTIONAL_OB',0,ZHOOK_HANDLE)
IRET = 0
CALL GETDB('CONVENTIONAL',1,IRET,INFO,0,ZINFO,0,&
 & -1, KTSLOT, KPOOLNO, -1, -1, -1, &
!-- Replacing in SQLs' WHERE obstype IN ($synop, $airep, $dribu, $temp, $pilot, $paob) :
!   See SQLs : odb/ddl/conventional_rob(hdr|ody)_1.sql
 &  KOBSTYPE_V = (/NSYNOP, NAIREP, NDRIBU, NTEMP, NPILOT, NPAOB/))

IF(IRET == 0) THEN
  WRITE(NULOUT,'(''     NO REPORTS (CONVENTIONAL) AVAILABLE '')')
ELSE
  WRITE(NULOUT,'(''     REPORTS (CONVENTIONAL) FOUND: '',I10)') IRET
ENDIF
CALL FLUSH(NULOUT)
ILEN = IRET

!*          1.2   LOOP OVER ALL THE CONV OBSERVATIONS

OBS_LOOP_CONV: DO JOBS = 1, ILEN
  IOBS = JOBS
  IOBTYP  = ROBHDR(IOBS,MDBOTP)
  ICDTYPE = ROBHDR(IOBS,MDB_CODETYPE_AT_HDR)
  LLMESAGE= .FALSE.
  LLTAKEN = .FALSE.
  CALL CMOCTMAP('CODETOSQ',NULOUT,IOBTYP,ICDTYPE,IOBSQNO,ICDSQNO)

!*          1.2.1 SYNOP

  IF(IOBTYP == NSYNOP)        THEN
    IF(ANY(LMKCMARPL(:,NSYNOPSQ))) CALL SYNOPIN(IOBS,&
       & IOBTYP,ICDTYPE,IOBSQNO,ICDSQNO,&
       & LLMESAGE,LLTAKEN)  

!*          1.2.2 AIREP

  ELSEIF(IOBTYP == NAIREP)    THEN
    IF(ANY(LMKCMARPL(:,NAIREPSQ))) CALL AIREPIN(IOBS,&
       & IOBTYP,ICDTYPE,IOBSQNO,ICDSQNO,&
       & LLMESAGE,LLTAKEN)  

!*          1.2.4 DRIBU

  ELSEIF(IOBTYP == NDRIBU)    THEN
    IF(ANY(LMKCMARPL(:,NDRIBUSQ))) CALL DRIBUIN(IOBS,&
       & IOBTYP,ICDTYPE,IOBSQNO,ICDSQNO,&
       & LLMESAGE,LLTAKEN)  

!*          1.2.5 TEMP

  ELSEIF(IOBTYP == NTEMP)     THEN
    IF(ANY(LMKCMARPL(:,NTEMPSQ))) THEN
      IF(LMFSCRE(NTEMP))              THEN
        CALL TEMPINMF (IOBS,&
                     & IOBTYP,ICDTYPE,IOBSQNO,ICDSQNO,&
                     & LLMESAGE,LLTAKEN)
      ELSE
        CALL TEMPIN (IOBS,&
                     & IOBTYP,ICDTYPE,IOBSQNO,ICDSQNO,&
                     & LLMESAGE,LLTAKEN)
      ENDIF
    ENDIF

!*          1.2.6 PILOT

  ELSEIF(IOBTYP == NPILOT)     THEN
    IF    (ICDTYPE == NLDPCD)             THEN  
      IF(LMKCMARPL(NLDPCDSQ,NPILOTSQ))  CALL PILOTIN(IOBS,&
         & IOBTYP,ICDTYPE,IOBSQNO,ICDSQNO,&
         & LLMESAGE,LLTAKEN)  
    ELSEIF(ICDTYPE == NSHPCD)             THEN
      IF(LMKCMARPL(NSHPCDSQ,NPILOTSQ))  CALL PILOTIN(IOBS,&
         & IOBTYP,ICDTYPE,IOBSQNO,ICDSQNO,&
         & LLMESAGE,LLTAKEN)  
    ELSEIF(ICDTYPE == NEWPPCD)            THEN
      IF(LMKCMARPL(NEWPPCDSQ,NPILOTSQ)) CALL EWPRFIN(IOBS,&
         & IOBTYP,ICDTYPE,IOBSQNO,ICDSQNO,&
         & LLMESAGE,LLTAKEN)  
    ELSEIF(ICDTYPE == NWPPCD)             THEN
      IF(LMKCMARPL(NWPPCDSQ,NPILOTSQ))  CALL AWPRFIN(IOBS,&
         & IOBTYP,ICDTYPE,IOBSQNO,ICDSQNO,&
         & LLMESAGE,LLTAKEN)  
    ELSEIF(ICDTYPE == NDWLPCD)            THEN
      IF(LMKCMARPL(NDWLPCDSQ,NPILOTSQ))   CALL DWLIN(IOBS,&
         & IOBTYP,ICDTYPE,IOBSQNO,ICDSQNO,&
         & LLMESAGE,LLTAKEN)
    ELSE
      WRITE(NULOUT,'(''0ERROR IN SUBROUTINE CONVENTIONAL_OB'')')
      WRITE(NULOUT,'('' UNKNOWN PILOT CODE TYPE'',I10)') ICDTYPE
      CALL ABOR1(' CONVENTIONAL_OB; WRONG PILOT CODE TYPE ')
    ENDIF

!*          1.2.7 SATEM

! ELSEIF(IOBTYP == NSATEM )         THEN
!   IF    (ICDTYPE == NSTMCD)             THEN             
!     IF(LMKCMARPL(NSTMCDSQ,NSATEMSQ))  CALL MERTSIN(IOBS,&
!        & IOBTYP,ICDTYPE,IOBSQNO,ICDSQNO,&
!        & LLMESAGE,LLTAKEN)  
!   ELSEIF(ICDTYPE == NSTOVS)             THEN
!     IF(LMKCMARPL(NSTOVSSQ,NSATEMSQ))  CALL MERTSIN(IOBS,&
!        & IOBTYP,ICDTYPE,IOBSQNO,ICDSQNO,&
!        & LLMESAGE,LLTAKEN)  
!   ELSE
!     WRITE(NULOUT,'(''0ERROR IN SUBROUTINE CONVENTIONAL_OB'')')
!     WRITE(NULOUT,'('' UNKNOWN CONVENTIONAL SATEM CODE TYPE'',I10)') ICDTYPE
!     CALL ABOR1('SUBROUTINE CONVENTIONAL_OB; WRONG SATEM CODE TYPE ')
!   ENDIF

!*          1.2.8 PAOB

  ELSEIF(IOBTYP == NPAOB)     THEN
    IF(ANY(LMKCMARPL(:,NPAOBSQ))) CALL PAOBIN(IOBS,&
       & IOBTYP,ICDTYPE,IOBSQNO,ICDSQNO,&
       & LLMESAGE,LLTAKEN)  

!*          1.2.11UNKNOWN CONVENTIONAL OBS TYPE

  ELSE
    WRITE(NULOUT,'(''0ERROR IN SUBROUTINE CONVENTIONAL_OB'')')
    WRITE(NULOUT,'('' UNKNOWN CONVENTIONAL OBS TYPE'',I10)') IOBTYP
    CALL ABOR1('SUBROUTINE CONVENTIONAL_OB')
  ENDIF
ENDDO OBS_LOOP_CONV

!           1.3   PUT THE DB AWAY

CALL PUTDB('CONVENTIONAL',1,IRET,INFO,0,ZINFO,0)

!*          1.4   INITIALIZE DB (LOCAL; SATEMs)

IRET = 0
CALL GETDB('SATEM',1,IRET,INFO,0,ZINFO,0,&
 & -1, KTSLOT, KPOOLNO, -1, -1, -1)  
IF(IRET == 0) THEN
  WRITE(NULOUT,'(''     NO REPORTS (CONVENTIONAL SATEM) AVAILABLE '')')
ELSE
  WRITE(NULOUT,'(''     REPORTS (CONVENTIONAL SATEM) FOUND: '',I10)') IRET
ENDIF
CALL FLUSH(NULOUT)
ILEN = IRET

!*          1.5   LOOP OVER ALL CONV SATEM OBSERVATIONS

OBS_LOOP_SATEM: DO JOBS = 1, ILEN
  IOBS = JOBS
  IOBTYP  = ROBHDR(IOBS,MDBOTP)
  ICDTYPE = ROBHDR(IOBS,MDB_CODETYPE_AT_HDR)
  LLMESAGE= .FALSE.
  LLTAKEN = .FALSE.
  CALL CMOCTMAP('CODETOSQ',NULOUT,IOBTYP,ICDTYPE,IOBSQNO,ICDSQNO)

!*          1.5.1 SATEM

  IF(IOBTYP == NSATEM )         THEN
    IF    (ICDTYPE == NSTMCD)             THEN             
      IF(LMKCMARPL(NSTMCDSQ,NSATEMSQ))  CALL MERTSIN(IOBS,&
         & IOBTYP,ICDTYPE,IOBSQNO,ICDSQNO,&
         & LLMESAGE,LLTAKEN)  
    ELSEIF(ICDTYPE == NSTOVS)             THEN
      IF(LMKCMARPL(NSTOVSSQ,NSATEMSQ))  CALL MERTSIN(IOBS,&
         & IOBTYP,ICDTYPE,IOBSQNO,ICDSQNO,&
         & LLMESAGE,LLTAKEN)  
    ELSE
      WRITE(NULOUT,'(''0ERROR IN SUBROUTINE CONVENTIONAL_OB'')')
      WRITE(NULOUT,'('' UNKNOWN CONVENTIONAL SATEM CODE TYPE'',I10)') ICDTYPE
      CALL ABOR1('SUBROUTINE CONVENTIONAL_OB; WRONG SATEM CODE TYPE ')
    ENDIF
  ELSE
    WRITE(NULOUT,'(''0ERROR IN SUBROUTINE CONVENTIONAL_OB'')')
    WRITE(NULOUT,'('' UNKNOWN CONVENTIONAL SATEM OBS TYPE'',I10)') IOBTYP
    CALL ABOR1('SUBROUTINE CONVENTIONAL_OB')
  ENDIF
ENDDO OBS_LOOP_SATEM

!           1.6   PUT THE DB AWAY

CALL PUTDB('SATEM',1,IRET,INFO,0,ZINFO,0)

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

!        2.       RETURN
!                 ------

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