SUBROUTINE RAD1COBE(KOBS,KSATGRP,&
 & KDATOB,PLASAT,KSENSOR,KFOV,PBOA,PZEN,&
 & PPSAT,PTSAT,PHUSAT,PTSSAT,PUSSAT,PVSSAT,PRED)   


! ROUTINE.
! --------
!    RAD1COBE

! PURPOSE.
! --------
!    ROUTINE CALLED BY IFS OBSERVATION SCREENING MODULE TO 
!    ESTIMATE BIAS AND SDEV FOR LEVEL-1C RADIANCE OBSERVATIONS AND LOAD
!    INTO ODB FOR LATER USE BY ANALYSIS

! INPUT.
! ------
!    KSERIES/KSATID/KSUBTYPE descriptors                                       
!    PLASAT     - observation lattitude     
!    KSENSOR    - observation sensor indicator                     
!    KFOV       - observation field of view                        
!    ZBOA       - bearing_azimuth                                 
!    ZZEN       - zenith angle                                    
!    PPSAT      - array of model pressure profile (pa)
!    PTSAT      - array of model temperature profile (K)
!    PHUSAT     - array of model humidity profile (Kg/Kg)
!    PTSSAT     - model surface skin temperature (K)
!    PUSSAT     - model 10 m wind speed (u) (m/s)
!    PVSSAT     - model 10 m wind speed (v) (m/s)

! OUTPUT.
! -------
!    NONE

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

! AUTHOR.
! -------
!    Tony McNally (may 98) 

! MODIFICATIONS.
! --------------
!    Xu Li          00/05/23 : Add the load of VTPR into ROBODY
!    G. Kelly       01/05/15 : Add bearing_azimuth and zenith angle to getbias
!    M. Hamrud      03/10/01 : CY28 Cleaning
!    D. Dee         04/03/19 : Introduced AIRSCHAN

!    T. Auligne     10/01/07 : Do not calculate H&K bias if running VarBC
!    A. Collard     06/11/06 : Introduced IASICHAN
!    V. Guidard     07/02/28 : Introduced IASICHAN (after A. Collard)
!    Q. Lu          09/03/11 : Add FY3A IRAS, MWTS, MWHS and MWRI


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

USE YOMCT0B  , ONLY : LECMWF
USE YOMDIMO  , ONLY : NLSAT,    NPNSSV, NMXTCH
USE YOMTVRAD , ONLY : SATGRP_TABLE,&
 & MSENSOR_HIRS, MSENSOR_MSU, MSENSOR_SSU,&
 & MSENSOR_IRAS, MSENSOR_MWTS,MSENSOR_MWHS, MSENSOR_MWRI, & 
 & MSENSOR_AMSUA, MSENSOR_AMSUB, MSENSOR_MHS, MSENSOR_SSMI,MSENSOR_AMSRE,&
 & MSENSOR_AIRS,MSENSOR_IASI,MSENSOR_CHANOFFL,MXSENSOR, MSENSOR_TMI, &
 & MSENSOR_CHANCOUNT,AIRSCHAN,IASICHAN, M__NumAIRSChans, M__NumIASIChans, & 
 & M__MaxAIRSChans, M__MaxIASIChans, &
 & MSENSOR_MSG
USE YOMCOSJO , ONLY : ROERR_RAD1C
USE VARBC_RAD, ONLY : LBC_AMSUA, LBC_AMSUB, LBC_MHS, LBC_SSMI, LBC_HIRS, &
                 &    LBC_IRAS,  LBC_MWTS,  LBC_MWHS,LBC_MWRI
USE YOMANCS  , ONLY : RMDI
USE YOMVNMB  , ONLY : NVNUMB
USE YOMDB
USE YOMVAR   , ONLY : LVARBC
USE YOMOBS   , ONLY : LAMSUB_FULL

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KOBS 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSATGRP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDATOB 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLASAT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSENSOR 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFOV 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBOA 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PZEN 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPSAT(NLSAT) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSAT(NLSAT) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PHUSAT(NLSAT) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSSAT 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUSSAT 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVSSAT 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRED(8,1)
REAL(KIND=JPRB) :: ZAV(NLSAT,4,1), ZSSV(NPNSSV,1)
REAL(KIND=JPRB) :: ZDUMMY1D(132)
REAL(KIND=JPRB), ALLOCATABLE :: ZBIAS(:)
INTEGER(KIND=JPIM) :: IAIRSX(M__MaxAIRSChans)
INTEGER(KIND=JPIM) :: IIASIX(M__MaxIASIChans)  
INTEGER(KIND=JPIM), ALLOCATABLE :: ICH(:)

REAL(KIND=JPRB)    :: ZTPWC
INTEGER(KIND=JPIM) :: JC, IFAIL, IFOV, JL, ILSAT, &
 & IMXCH, ICHAN, JBODY, ISCPOS, &
 & IISERIES,IISATID,IISUBTYPE,IMXCHGET  
INTEGER(KIND=JPIM) :: ISENSORCH(0:MXSENSOR)
INTEGER(KIND=JPIM) :: ICHOFF
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "fcobs.h"

#include "openmp_obs.h"


IF (LHOOK) CALL DR_HOOK('RAD1COBE',0,ZHOOK_HANDLE)

IF (LVARBC) THEN
  ! Load biases and obs err. into ODB
  ! ---------------------------------
  DO JBODY= MLNKH2B(KOBS),MLNKH2B(KOBS+1)-1      ! loop body entries (20ir/4mw)
    IF(ROBODY(JBODY,MDBVNM) == NVNUMB(50)) THEN  ! Found radiance datum
      ICHAN = NINT(ROBODY(JBODY,MDBPPP))         ! Chan number from body
      ROBODY(JBODY,MDBOER) = ROERR_RAD1C(KSENSOR,ICHAN)  ! Obs error
      ROBODY(JBODY,MDBFOE) = ROERR_RAD1C(KSENSOR,ICHAN)  ! Final error
      ROBODY(JBODY,MDBTORB)= RMDI                        ! leads to rejection
    ENDIF
  ENDDO

ELSE

  ISENSORCH(:)=MSENSOR_CHANCOUNT(:)

  !For AIRS and IASI IMXCH is larger than 47
  SELECT CASE (KSENSOR)
  CASE (MSENSOR_AIRS)
    IMXCH = M__NumAIRSChans
    ISENSORCH(MSENSOR_AIRS)=M__NumAIRSChans
    DO JC = 1,M__NumAIRSCHANS
      IAIRSX(AIRSCHAN(JC)) = JC
    ENDDO
  CASE (MSENSOR_IASI)
    IMXCH = M__NumIASIChans
    ISENSORCH(MSENSOR_IASI)=M__NumIASIChans
    DO JC = 1,M__NumIASICHANS
      IIASIX(IASICHAN(JC)) = JC
    ENDDO
  CASE DEFAULT
    IMXCH=47
  END SELECT

  ALLOCATE(ICH(IMXCH))
  DO JC = 1,IMXCH
    ICH(JC)=JC
  ENDDO

  ILSAT=NLSAT
  ZAV  (:,:,:)=0.0_JPRB
  ZSSV (:,:)  =0.0_JPRB
  PRED (:,:)  =0.0_JPRB

!     1.0 Compute bias from model input
!     ---------------------------------
!     (must simulate 1DVAR input to utilize GETBIAS routine)

  ZTPWC = 0.0_JPRB
  DO JL = 1,ILSAT
    ZAV(JL,1,1)=PTSAT(JL)
    ZAV(JL,2,1)=PHUSAT(JL)
    IF (JL > 1) ZTPWC = ZTPWC + (PHUSAT(JL-1) + PHUSAT(JL)) * 0.5 &
     & * (PPSAT(JL) - PPSAT(JL-1)) / 9.81  
  ENDDO
  ZSSV(1,1)=PTSSAT

  ZDUMMY1D(:) = 0

  ZDUMMY1D(2)=KDATOB/10000
  ZDUMMY1D(3)=(KDATOB-nint(ZDUMMY1D(2))*10000)/100
  ZDUMMY1D(4)=mod( (KDATOB-nint(ZDUMMY1D(2))*10000) ,nint(ZDUMMY1D(3)*100) )
  ZDUMMY1D(8)=PLASAT

  IF(KSENSOR == MSENSOR_MSU   .OR. KSENSOR == MSENSOR_SSU   .OR. &
   & KSENSOR == MSENSOR_MWTS  .OR. KSENSOR == MSENSOR_MWHS  .OR. &
   & KSENSOR == MSENSOR_AMSUA .OR. KSENSOR == MSENSOR_AMSUB .OR. &
   & KSENSOR == MSENSOR_MHS   .OR. KSENSOR == MSENSOR_AIRS  .OR. &
   & KSENSOR == MSENSOR_IASI) THEN   
    ZDUMMY1D(131)=PBOA
    ZDUMMY1D(132)=PZEN

  ELSEIF(KSENSOR == MSENSOR_SSMI .OR. KSENSOR == MSENSOR_AMSRE .OR. &
   &     KSENSOR == MSENSOR_TMI .OR. KSENSOR == MSENSOR_MWRI) THEN 
    ZDUMMY1D(14)= PPSAT (NLSAT)
    ZDUMMY1D(15)= PTSSAT
    ZDUMMY1D(16)= ZTPWC
    ZDUMMY1D(17)= SQRT (PUSSAT * PUSSAT + PVSSAT * PVSSAT)

  ENDIF

!-- Special treatment for the DUMMY1D(13)-entry

  SELECT CASE (KSENSOR)
  CASE (MSENSOR_HIRS, MSENSOR_IRAS)           !rescale FOV to get HIRS scan correction
    IFOV= MAX(2,KFOV)
    IFOV= MIN(55,IFOV)
    ZDUMMY1D(13)= 1+(IFOV-2)/3
  CASE (MSENSOR_AMSUB, MSENSOR_MHS, MSENSOR_MWHS)          !rescale FOV to get AMSUB scan correction
    IF (.NOT.LAMSUB_FULL) THEN
      IFOV=NINT(KFOV/3.0_JPRB)
    ELSE
      IFOV=KFOV
    ENDIF
    IFOV=MAX(1,IFOV)
    IF (.NOT.LAMSUB_FULL) THEN
      IFOV=MIN(30,IFOV)
    ELSE
      IFOV=MIN(90,IFOV)
    ENDIF
    ZDUMMY1D(13)= IFOV
  CASE (MSENSOR_AIRS)           !rescale FOV to get AIRS scan correction
    IFOV=NINT(KFOV/3.0_JPRB)
    IFOV=MAX(1,IFOV)
    IFOV=MIN(30,IFOV)
    ZDUMMY1D(13)= IFOV
  CASE (MSENSOR_SSMI, MSENSOR_MWRI)
    ZDUMMY1D(13)= KFOV / 5 + 1
  CASE(MSENSOR_IASI) ! IASI scan correction
    IFOV=NINT(KFOV/4.0_JPRB)
    IFOV=MAX(1,IFOV)
    IFOV=MIN(30,IFOV)
    ZDUMMY1D(13)= IFOV
  CASE DEFAULT
    ZDUMMY1D(13)=KFOV
  END SELECT

  IISERIES  = SATGRP_TABLE(KSATGRP)%rtseries_ix
  IISATID   = SATGRP_TABLE(KSATGRP)%rtid_ix
  IISUBTYPE = SATGRP_TABLE(KSATGRP)%rtsubtype_ix

!     2.0 Load biases and obs err. into ODB
!     -------------------------------------

  IMXCHGET=ISENSORCH(KSENSOR)
  ALLOCATE(ZBIAS(NMXTCH))
  ZBIAS(:)       =0.0_JPRB

  ICHOFF=MSENSOR_CHANOFFL(KSENSOR)
  IF (LECMWF) THEN
    IF (KSENSOR /= MSENSOR_IASI) &
      & CALL GETBIAS(IISERIES,IISATID,IISUBTYPE,KSENSOR,ISCPOS,&
      & ZDUMMY1D,ZAV,ZSSV,IMXCH,IMXCHGET,ICH(1:IMXCHGET),ZBIAS,PRED,IFAIL,&
      & ICHOFF)   
  ELSE 
    IF (KSENSOR /= MSENSOR_AIRS) &
      & CALL GETBIAS(IISERIES,IISATID,IISUBTYPE,KSENSOR,ISCPOS,&
      & ZDUMMY1D,ZAV,ZSSV,IMXCH,IMXCHGET,ICH(1:IMXCHGET),ZBIAS,PRED,IFAIL,&
      & ICHOFF)  
  ENDIF

  IF (LECMWF.OR.((KSENSOR /= MSENSOR_AIRS).AND.(KSENSOR /= MSENSOR_IASI))) THEN
    IF (((KSENSOR == MSENSOR_AMSUA).AND.(LBC_AMSUA)) .OR. &
      & ((KSENSOR == MSENSOR_IRAS).AND.(LBC_IRAS)) .OR.   &
      & ((KSENSOR == MSENSOR_MWTS).AND.(LBC_MWTS)) .OR.   &
      & ((KSENSOR == MSENSOR_MWHS).AND.(LBC_MWHS)) .OR.   &
      & ((KSENSOR == MSENSOR_MWRI).AND.(LBC_MWRI)) .OR.   &
      & ((KSENSOR == MSENSOR_AMSUB).AND.(LBC_AMSUB)) .OR. &
      & ((KSENSOR == MSENSOR_MHS).AND.(LBC_MHS)) .OR. &
      & ((KSENSOR == MSENSOR_SSMI).AND.(LBC_SSMI)) .OR. &
      & ((KSENSOR == MSENSOR_HIRS).AND.(LBC_HIRS))) THEN
     ! Do nothing - VarBC takes care of bias
  ELSE
      CALL GETBIAS(IISERIES,IISATID,IISUBTYPE,KSENSOR,ISCPOS,&
       & ZDUMMY1D,ZAV,ZSSV,IMXCHGET,IMXCHGET,ICH(1:IMXCHGET),ZBIAS,PRED,IFAIL,&
       & ICHOFF)  
    ENDIF
  ENDIF

  IF ((.NOT.LECMWF) .AND. (KSENSOR == MSENSOR_MSG)) &
   & CALL GETBIAS(IISERIES,IISATID,IISUBTYPE,KSENSOR,ISCPOS,&
   & ZDUMMY1D,ZAV,ZSSV,IMXCHGET,IMXCHGET,ICH,ZBIAS,PRED,IFAIL,ICHOFF)

  DO JBODY= MLNKH2B(KOBS),MLNKH2B(KOBS+1)-1      ! loop body entries (20ir/4mw)
    IF(ROBODY(JBODY,MDBVNM) == NVNUMB(50)) THEN  ! Found radiance datum
      ICHAN = NINT(ROBODY(JBODY,MDBPPP))         ! Chan number from body
      IF (LECMWF.AND.(KSENSOR == MSENSOR_AIRS)) THEN
        ROBODY(JBODY,MDBTORB)=  ZBIAS(IAIRSX(ICHAN))        ! Bias estimate
      ELSEIF (LECMWF.AND.(KSENSOR == MSENSOR_IASI)) THEN
        ROBODY(JBODY,MDBTORB)=  ZBIAS(IIASIX(ICHAN))        ! Bias estimate
      ELSE
        IF (ICHAN > IMXCHGET) CYCLE
        IF(ZBIAS(ICHAN) <= -998.) THEN                      ! Missing bias coef
          ROBODY(JBODY,MDBTORB)= RMDI                       !  leads to rejection
        ELSE
          ROBODY(JBODY,MDBTORB)= ZBIAS(ICHAN)               ! Bias estimate
        ENDIF
      ENDIF
      ROBODY(JBODY,MDBOER) = ROERR_RAD1C(KSENSOR,ICHAN)     ! Obs error
      ROBODY(JBODY,MDBFOE) = ROERR_RAD1C(KSENSOR,ICHAN)     ! Final error
      ROBODY(JBODY,MDB_BIASCTRL_AT_BODY)=ROBODY(JBODY,MDBTORB)
    ENDIF
  ENDDO

  DEALLOCATE(ICH, ZBIAS)
ENDIF

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