SUBROUTINE BIASCOR_ODB(LDBC   ,KNOPLEV,PPRES,PT,PTBC,                      &
 &                     CDIDENT,     KY,   KM,KD,  KH,PLAT,PLON,PALT,KRSTYP,&
 &                     KMISS  ,PMISS                                        )  

!**** *BIASCOR_ODB*

!       PURPOSE.
!      ----------

!         BIAS CORRECTION FOR RS TEMPERATURES

!       INTERFACE.
!      ------------

!         CALL BIASCOR_ODB(LDBC   ,KNOPLE,PPRES,PT,PTBC,
!     X                    CDIDENT,KM    ,KD   ,KH,PLAT,PLON,KRSTYP,
!     X                    KMISS  ,PMISS                             )

!        INPUT
!         KNOPLEV   NUMBER OF LEVELS
!         PPRES     ARRAY WITH PRESSURE VALUES
!         PT        ARRAY WITH T VALUES
!         CDIDENT   STATION IDENTIFIER
!         KY        YEAR
!         KM        MONTH
!         KD        DAY
!         KH        HOUR
!         PLAT      LATITUDE
!         PLON      LONGITUD
!         PALT      ALTITUDE
!         KRSTYP    RADIOSONDE TYPE (BUFR CODE TABLE 002011)
!         KMISS     MISSING VALUE FOR INTEGERS
!         PMISS     MISSING VALUE FOR REALS

!        OUTPUT
!         LDBC      LOGICAL TO STATE IF BIAS CORRECTION WAS SUCCESSFUL
!         PTBC      ARRAY WITH BIAS CORRECTED T VALUES

!       METHOD.
!      ---------

!        READ BIAS CORRECTION TABLES:
!            TABLE 1 : CROSS-REF STATION ID, SONDE NAME
!            TABLE 2 : ARRAY OF CORRECTIONS DEPENDING ON
!                      SOLAR ELEVATION AND PRESSURE LEVEL
!            TABLE 3 : CROSS-REF SONDE TYPE CODE, SONDE NAME
!        TRY FOR MATCH IN TABLE 3, IF NOT THEN TABLE 1
!        DETERMINE CORRECTION TO BE APPLIED FROM TABLE 2

!       EXTERNALS.
!      ------------

!        DIURNAL          CALCULATE SOLAR ELEVATION
!        PNTERP           INTERPOLATE TO PRESSURE LEVEL

!       REFERENCE.
!      ------------

!        RADIOSONDE BIAS CORRECTION
!        OD MEMORANDUM BY B. STRAUSS  22.12.92

!       AUTHOR.
!      ---------

!        D. VASILJEVIC  21/10/03 (ORIGINAL B. NORRIS JULY  1991)

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

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

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMANCS  , ONLY : RMDI
USE YOMRSTBIAS
USE YOMLUN   , ONLY : NULOUT

IMPLICIT NONE

!     DUMMY INTEGERs
INTEGER(KIND=JPIM),INTENT(IN)    :: KNOPLEV 
LOGICAL           ,INTENT(OUT)   :: LDBC 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPRES(KNOPLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KNOPLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTBC(KNOPLEV) 
CHARACTER(LEN=*)  ,INTENT(IN)    :: CDIDENT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KY 
INTEGER(KIND=JPIM),INTENT(IN)    :: KM 
INTEGER(KIND=JPIM),INTENT(IN)    :: KD 
INTEGER(KIND=JPIM),INTENT(IN)    :: KH 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLAT 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLON 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KRSTYP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KMISS 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PMISS 
INTEGER(KIND=JPIM) :: JBCSET, JSONDE, ICORBC, ILEVBC, ISONDE, JLEV
INTEGER(KIND=JPIM) :: I_YYYY_MM_DD , I_HH_MM_SS

!     DUMMY REALs
CHARACTER(LEN=8) ::  CLSNAMCT
CHARACTER(LEN=8) ::  CLPUNIT
LOGICAL :: LLNAMFND, LLPRINT, LL_DO_VALIDITY, LL_VALID

REAL(KIND=JPRB) :: ZP, ZPOS, ZADD, ZANGLEBC
REAL(KIND=JPRB) :: ZLAT, ZLON, ZALT, Z_IN_DATE_TIME

INTEGER(KIND=JPIM) :: ICOL, IHGH, ILOW
INTEGER(KIND=JPIM) :: ILEVBC_AUX(NO_T_BIAS_LEVELS)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "diurnal.intfb.h"
#include "pnterp.intfb.h"
#include "rs_bias_validity.intfb.h"

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

!                  0.  OPEN/READ RS BIAS DB (IF NOT ALREADY DONE)
!                      ------------------------------------------

IF (LHOOK) CALL DR_HOOK('BIASCOR_ODB',0,ZHOOK_HANDLE)
IF(.NOT.LRSTBIAS_READ) THEN
  CALL GET_RS_T_BIAS
  LRSTBIAS_READ = .TRUE.
ENDIF

LDBC           = .FALSE.
LLNAMFND       = .FALSE.
ILEVBC         = NO_T_BIAS_LEVELS
ICORBC         = NO_T_BIAS_CORRS
LLPRINT        = .TRUE.
LL_VALID       = .FALSE.
LL_DO_VALIDITY = .TRUE.
I_YYYY_MM_DD   = KY*10000 + KM*100 + KD
I_HH_MM_SS     = KH*10000
Z_IN_DATE_TIME = I_YYYY_MM_DD*1000000.0_JPRB + I_HH_MM_SS*1.0_JPRB

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

!                  1.  PRESET CORRECTION TO THE ORIGINAL
!                      ---------------------------------

IF(LLPRINT) THEN
  WRITE(NULOUT,'('' BIAS CORRECTION INPUT: '',A,1X,4(I4,1X),2(F9.2,1X),I11)')&
   & CDIDENT,KY,KM,KD,KH,PLAT,PLON,KRSTYP
  WRITE(NULOUT,'(''                        '',2(I8,1X),F15.0)')&
   & I_YYYY_MM_DD,I_HH_MM_SS,Z_IN_DATE_TIME
  CALL FLUSH(NULOUT)
ENDIF
DO JBCSET  = 1,KNOPLEV
  PTBC(JBCSET) = PT(JBCSET)
ENDDO

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

!                  2.  CALCULATE RS T BIAS CORRECTION
!                      ------------------------------

IF(ABS(KRSTYP) == KMISS) THEN
  IF(LLPRINT) THEN
    WRITE(NULOUT,'('' SONDE TYPE MISSING TRY TABLE 1 '')')
    CALL FLUSH(NULOUT)
  ENDIF
  GO TO 220
ENDIF

!        2.1           DETERMINE SONDE TYPE FROM "TABLE 3"

TABLE3_LOOP: DO JSONDE = 1,NO_T_BIAS_SONDES

!        2.1.1         SONDE TYPE PRESENT

  IF(KRSTYP == MSSTYBC(JSONDE)) THEN
    ISONDE   = JSONDE
    CLSNAMCT = CSTYPBC(JSONDE)

!        2.1.2         FIND OUT DATES AND TIMES VALID FOR
  
    CALL RS_BIAS_VALIDITY(Z_IN_DATE_TIME,ISONDE,LL_VALID)
    IF(.NOT.LL_VALID) THEN
      IF(LLPRINT) THEN
        WRITE(NULOUT,'('' SONDE TYPE FROM TABLE 3 FOUND; no valid dates GO ON LOOKING:'',&
         &I5,1X,A,1X,I11)') ISONDE,CLSNAMCT,KRSTYP
        CALL FLUSH(NULOUT)
      ENDIF

!        2.1.3         TAKE SONDE TYPE

    ELSE
      IF(CLSNAMCT /= '  nobias') THEN
        LLNAMFND =.TRUE.
        ISONDE   = JSONDE
        IF(LLPRINT) THEN
          WRITE(NULOUT,'('' SONDE TYPE (with bias info) FROM TABLE 3 FOUND:'',I5,1X,A,1X,I11,1X,L1)') &
           & ISONDE,CLSNAMCT,KRSTYP,LLNAMFND
          CALL FLUSH(NULOUT)
        ENDIF
      ELSE
        IF(LLPRINT) THEN
          WRITE(NULOUT,'('' SONDE TYPE (without bias info) FROM TABLE 3 FOUND:'',I5,1X,A,1X,I11,1X,L1)') &
           & ISONDE,CLSNAMCT,KRSTYP,LLNAMFND
          CALL FLUSH(NULOUT)
        ENDIF
      ENDIF
      GO TO 230
    ENDIF
  ENDIF
ENDDO TABLE3_LOOP
IF(LLPRINT) THEN
  WRITE(NULOUT,'('' SONDE TYPE NOT FOUND TRY TABLE 1 '')')
  CALL FLUSH(NULOUT)
ENDIF

!        2.2            DETERMINE SONDE TYPE FROM "TABLE 1"

220 CONTINUE
TABLE1_LOOP: DO JSONDE = 1,NO_T_BIAS_SONDES
  IF(CDIDENT /= '        ') THEN
    IF(CDIDENT == CSTIDBC(JSONDE)) THEN
      ISONDE   = JSONDE
      CLSNAMCT = CSTYPBC(JSONDE)

!        2.2.1         FIND OUT DATES AND TIMES VALID FOR

      CALL RS_BIAS_VALIDITY(Z_IN_DATE_TIME,ISONDE,LL_VALID)
      IF(.NOT.LL_VALID) THEN
        IF(LLPRINT) THEN
          WRITE(NULOUT,'('' SONDE TYPE FROM TABLE 1 FOUND; no valid dates GO ON LOOKING:'',&
           &I5,1X,A,1X,I11)') ISONDE,CLSNAMCT,KRSTYP
          CALL FLUSH(NULOUT)
        ENDIF

!        2.3.2         TAKE SONDE NAME

      ELSE
        LLNAMFND = .TRUE.

!        2.2.3          CHECK LAT, LON AND ALT
    
        IF(PLAT /= RMDI .AND. &
          &PLON /= RMDI .AND. &
          &PALT /= RMDI        ) THEN
          ZLAT = NINT(PLAT*100.0_JPRB)/100._JPRB
          ZLON = NINT(PLON*100.0_JPRB)/100._JPRB
          ZALT = NINT(PALT*100.0_JPRB)/100._JPRB
          IF(ZLAT /= RRSLAT(JSONDE) .OR.&
            &ZLON /= RRSLON(JSONDE) .OR.&
            &ZALT /= RRSALT(JSONDE)      ) THEN
            WRITE(NULOUT,'('' STATION DETAILS DISAGREE:'',A,1X,6(F10.2,1X))') &
              &CDIDENT,ZLAT,RRSLAT(JSONDE),ZLON,RRSLON(JSONDE),ZALT,RRSALT(JSONDE)
            CALL FLUSH(NULOUT)
          ENDIF
        ELSE
          WRITE(NULOUT,'('' STATION DETAILS MISSING:'',A,1X,6(F15.2,1X))') &
            &CDIDENT,PLAT,RRSLAT(JSONDE),PLON,RRSLON(JSONDE),PALT,RRSALT(JSONDE)
          CALL FLUSH(NULOUT)
        ENDIF
        IF(LLPRINT) THEN
          WRITE(NULOUT,'('' SONDE TYPE FROM TABLE 1 FOUND:'',I5,1X,A,1X,A  )') &
           & ISONDE,CLSNAMCT,CDIDENT  
          CALL FLUSH(NULOUT)
        ENDIF
        EXIT TABLE1_LOOP
      ENDIF
    ENDIF
  ENDIF
ENDDO TABLE1_LOOP

!        2.3            BIAS CORRECTION

230 CONTINUE
IF(LLNAMFND) THEN

!        2.3.1          CALCULATE SOLAR ELEVATION

  CALL DIURNAL(KM,KD,KH,PLAT,PLON,ZANGLEBC)
  IF(LLPRINT) THEN
    WRITE(NULOUT,'('' SOLAR ELEVATION:'',F10.3)') ZANGLEBC
    CALL FLUSH(NULOUT)
  ENDIF

!        2.3.2          CALCULATE CORRECT COLUMN OF "TABLE 2"

  ICOL = NINT(ZANGLEBC/5.0_JPRB) + 3
  IF(ICOL <      1) ICOL = 1
  IF(ICOL > ICORBC) ICOL = ICORBC
  IF(LLPRINT) THEN
    WRITE(NULOUT,'('' TABLE 2 COLUMN:'',I11)') ICOL
    CALL FLUSH(NULOUT)
  ENDIF

!        2.3.3          LOOP OVER INPUT P LEVELS

  LEVEL_LOOP: DO JLEV = 1 , KNOPLEV
    IF(PPRES(JLEV) /= PMISS .AND. &
      &PT   (JLEV) /= PMISS        ) THEN  

!        2.3.4          CALCULATE CORRECT ROW OF "TABLE 2"

      ZP            = PPRES(JLEV)
      CLPUNIT       = 'Pa'
      ILEVBC_AUX(:) = RLEVBC(:,ISONDE)
      CALL PNTERP(ILEVBC_AUX,ILEVBC,ZP,ZPOS,CLPUNIT)
      ILOW = ZPOS
      IHGH = ILOW + 1

!        2.3.5          CORRECTION

      IF(LLPRINT) THEN
         WRITE(NULOUT,'('' BIAS CORRECTION IN:'',&
         & 4(F12.9,1X))') &
         & RCORBC(ICOL,ILOW,ISONDE),(REAL(IHGH)-ZPOS),&
         & RCORBC(ICOL,IHGH,ISONDE),(ZPOS-REAL(ILOW))
        WRITE(NULOUT,'('' BIAS CORRECTION IN:'',&
         & 2(F12.9,1X))') &
         & RCORBC(ICOL,ILOW,ISONDE),RCORBC(ICOL,IHGH,ISONDE)
        WRITE(NULOUT,'('' BIAS CORRECTION IN:'',&
         & 6(F12.9,1X))') &
         & REAL(IHGH),ZPOS,(REAL(IHGH)-ZPOS),&
         & REAL(ILOW),ZPOS,(ZPOS-REAL(ILOW))  
        CALL FLUSH(NULOUT)
      ENDIF

      ZADD=RCORBC(ICOL,ILOW,ISONDE)*(REAL(IHGH)-ZPOS)+&
       & RCORBC(ICOL,IHGH,ISONDE)*(ZPOS-REAL(ILOW))  
      PTBC(JLEV) = PT(JLEV) + ZADD
      IF(LLPRINT) THEN
        WRITE(NULOUT,'('' BIAS CORRECTION RESULT:'',&
         & F10.2,1X,3(I5,1x),F12.9,1X,2(F10.2,1X))') &
         & ZP,ICOL,ILOW,IHGH,ZADD,PT(JLEV),PTBC(JLEV)  
        CALL FLUSH(NULOUT)
      ENDIF
    ENDIF
  ENDDO LEVEL_LOOP
  LDBC = .TRUE.

!        2.4            NO BIAS CORRECTION

ELSE
  IF(LLPRINT) THEN
    WRITE(NULOUT,'('' BIAS CORRECTION NOT DONE '')')
  ENDIF
  LDBC = .FALSE.
ENDIF

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

!                   4.  RETURN
!                       ------

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