MODULE varbc_allsky
!-----------------------------------------------------------------------
!   VARBC_ALLSKY - Module for variational bias correction (allsky radiance data)

!   Purpose. 
!   --------
!   Data structures and controls for variational bias correction (allsky radiance data)

!   Author.
!   -------
!   Dick Dee (ECMWF)

!   Modifications.
!   --------------
!   Original    2008/10/01
!   Qifeng Lu   2009/Mar/11 Add fy3a MWTS, MWHS and MWRI
!   10-Jun-2009    Alan Geer   Make allsky parameter estimation more responsive
!   23-Oct-2009    WB/AJG      Add TMI (& thickness) predictor to SSMIS chs

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

USE parkind1, ONLY : JPIM, JPRB
USE parcma  , ONLY : JPMXTOCH 
USE yomhook , ONLY : LHOOK, DR_HOOK
USE yomlun  , ONLY : NULOUT, NULNAM
USE yomancs , ONLY : RMDI 
USE yomcosjo, ONLY : JOT
USE yomcoctp, ONLY : NSATEM, NSSMI
USE yomtvrad, ONLY : SATGRP_TABLE, NSATGRP, MXSENSOR, &
                   & msensor_MSU, msensor_AMSUA, msensor_AMSUB, msensor_SSMI, &
                   & msensor_MHS, msensor_SSMIS, msensor_AMSRE, msensor_TMI, &
                   & msensor_MWTS,msensor_MWHS,  msensor_MWRI, &
                   & msensor_WINDSAT
USE varbc_pred, ONLY: NPREDCS_RAD

USE yomdb

IMPLICIT NONE

SAVE

PRIVATE
PUBLIC lbc_allsky
PUBLIC varbc_allsky_config, varbc_allsky_groups
PUBLIC varbc_allsky_varbcix, varbc_allsky_pred
PUBLIC varbc_allsky_min, varbc_allsky_groupdescr
PUBLIC lbc_amsua, lbc_amsub, lbc_mhs, lbc_ssmi 
PUBLIC lbc_mwts,  lbc_mwhs,  lbc_mwri

INTERFACE varbc_allsky_config
  MODULE PROCEDURE config
END INTERFACE varbc_allsky_config

INTERFACE varbc_allsky_groups
  MODULE PROCEDURE find_groups
END INTERFACE varbc_allsky_groups

INTERFACE varbc_allsky_groupdescr
  MODULE PROCEDURE groupdescr
END INTERFACE varbc_allsky_groupdescr

INTERFACE varbc_allsky_pred
  MODULE PROCEDURE get_predictors
END INTERFACE varbc_allsky_pred

INTERFACE varbc_allsky_varbcix
  MODULE PROCEDURE set_varbcix
END INTERFACE varbc_allsky_varbcix

INTERFACE varbc_allsky_min
  MODULE PROCEDURE get_min
END INTERFACE varbc_allsky_min

CHARACTER(LEN=*), PARAMETER :: modname = 'VarBC_ALLSKY'

! Table for available satellite/sensor combinations 
! -------------------------------------------------
TYPE type_sensors
  INTEGER(KIND=JPIM) :: nbufrid 
  INTEGER(KIND=JPIM) :: nsensor 
END TYPE type_sensors

INTEGER(KIND=JPIM), PARAMETER :: jpmxns = 1000   ! max number of sat/sensor combinations
TYPE(type_sensors) :: ysensors(1:jpmxns)

INTEGER(KIND=JPIM), PARAMETER :: jpmxnp = SIZE(NPREDCS_RAD) ! max number of parameters per group

! Table for settings by sensor/channel
! ------------------------------------
TYPE type_config
  INTEGER(KIND=JPIM) :: nparam            ! number of parameters
  INTEGER(KIND=JPIM) :: npredcs(jpmxnp)   ! list of predictors
  LOGICAL            :: llconst(jpmxnp)   ! flags for constant parameters
  REAL(KIND=JPRB)    :: zparams(jpmxnp)   ! a priori parameter values
  REAL(KIND=JPRB)    :: dfgdep            ! histogram range, for estimating the mode
  INTEGER(KIND=JPIM) :: ncstart           ! cold start option
  INTEGER(KIND=JPIM) :: nbgstdv           ! eqv #obs for background constraint
  LOGICAL            :: lreset            ! flag to reset parameters
  LOGICAL            :: llmode            ! flag for mode correction
  LOGICAL            :: llmaskrs          ! flag for radiosonde masking
END TYPE type_config

!-----------------------------------------------------------------------
! Namelist parameters
!-----------------------------------------------------------------------
TYPE(type_config)  :: yconfig(0:MXSENSOR,1:JPMXTOCH)
LOGICAL            :: lbc_allsky
LOGICAL            :: lbc_MSU,  lbc_AMSUA, lbc_AMSUB, lbc_SSMI,  &
                    & lbc_MWTS, lbc_MWHS,  lbc_MWRI, &
                    & lbc_MHS,  lbc_SSMIS, lbc_AMSRE, lbc_TMI,   &
                    & lbc_WINDSAT
INTEGER(KIND=JPIM) :: nbg_MSU,  nbg_AMSUA, nbg_AMSUB, nbg_SSMI,  & 
                    & nbg_MWTS, nbg_MWHS,  nbg_MWRI, &
                    & nbg_MHS,  nbg_SSMIS, nbg_AMSRE, nbg_TMI,   &
                    & nbg_WINDSAT
LOGICAL            :: lconst             ! Keep all VarBC parameters fixed
LOGICAL            :: lmode              ! Correct pdf mode rather than mean
LOGICAL            :: lmaskrs            ! Radiosonde vicinity masking

NAMELIST /NAMVARBC_ALLSKY/ yconfig, &
                      & lbc_allsky, &
                      & lbc_MSU,  lbc_AMSUA, lbc_AMSUB, lbc_SSMI,  &
                      & lbc_MWTS, lbc_MWHS,  lbc_MWRI, &
                      & lbc_MHS,  lbc_SSMIS, lbc_AMSRE, lbc_TMI,   & 
                      & lbc_WINDSAT,                               &
                      & nbg_MSU,  nbg_AMSUA, nbg_AMSUB, nbg_SSMI,  & 
                      & nbg_MHS,  nbg_SSMIS, nbg_AMSRE, nbg_TMI,   & 
                      & nbg_WINDSAT, lconst, lmode, lmaskrs 
!-----------------------------------------------------------------------

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

#include "abor1.intfb.h"
#include "posnam.intfb.h"

! ========
CONTAINS
! ========

SUBROUTINE config

!-----------------------------------------------------------------------
!   config - Configure allsky radiance VarBC

!   Interface.
!   ----------
!   CALL config

!   Author.
!   -------
!   Dick Dee (ECMWF)

!   Modifications.
!   --------------
!   Original    2008/03/01
!-----------------------------------------------------------------------

INTEGER(KIND=JPIM) :: is, ic
REAL(KIND=JPRB)    :: zhook_handle

CHARACTER(LEN=*), PARAMETER :: myname = modname//' (config)'

IF (lhook) CALL dr_hook(myname,0,zhook_handle)

WRITE(nulout,'(/,a)') myname//': Configuring allsky radiance VarBC'

! default settings:
! ----------------
DO is = 0, MXSENSOR
  DO ic = 1, JPMXTOCH
    yconfig(is,ic)%nparam     = 0  
    yconfig(is,ic)%npredcs(:) = 0
    yconfig(is,ic)%zparams(:) = RMDI
    yconfig(is,ic)%llconst(:) = .false.
    yconfig(is,ic)%ncstart    = 2
    yconfig(is,ic)%dfgdep     = 50.0_JPRB
    yconfig(is,ic)%nbgstdv    = 0
    yconfig(is,ic)%llmode     = .false. 
    yconfig(is,ic)%llmaskrs   = .false. 
  ENDDO
ENDDO

DO ic = 1, 4
  yconfig(msensor_MSU, ic)%nparam = 8
  yconfig(msensor_MSU, ic)%npredcs(1:8) = (/0,1,2,5,6,8,9,10/)
ENDDO

DO ic = 3, 14
  SELECT case (ic)
  case (3:4)
    yconfig(msensor_AMSUA, ic)%nparam = 4
    yconfig(msensor_AMSUA, ic)%npredcs(1:4) = (/0,8,9,10/)
  case (5:14)
    yconfig(msensor_AMSUA, ic)%nparam = 8
    yconfig(msensor_AMSUA, ic)%npredcs(1:8) = (/0,1,2,5,6,8,9,10/)
  END SELECT 
ENDDO

DO ic = 2, 5
  SELECT case (ic)
  case (2)
    yconfig(msensor_AMSUB, ic)%nparam = 4
    yconfig(msensor_AMSUB, ic)%npredcs(1:4) = (/0,8,9,10/)
  case (3:5)
    yconfig(msensor_AMSUB, ic)%nparam = 8
    yconfig(msensor_AMSUB, ic)%npredcs(1:8) = (/0,1,2,5,6,8,9,10/)
  END SELECT 
ENDDO

DO ic = 2, 5
  SELECT case (ic)
  case (2)
    yconfig(msensor_MHS, ic)%nparam = 4
    yconfig(msensor_MHS, ic)%npredcs(1:4) = (/0,8,9,10/)
  case (3:5)
    yconfig(msensor_MHS, ic)%nparam = 8
    yconfig(msensor_MHS, ic)%npredcs(1:8) = (/0,1,2,5,6,8,9,10/)
  END SELECT 
ENDDO

DO ic = 1, 7
  yconfig(msensor_SSMI, ic)%nparam = 7
  yconfig(msensor_SSMI, ic)%npredcs(1:7) = (/0,3,4,7,8,9,10/)
ENDDO

DO ic = 1, 24
  SELECT case (ic)
  case (1,3:11,19:24)
    yconfig(msensor_SSMIS, ic)%nparam = 10
    yconfig(msensor_SSMIS, ic)%npredcs(1:10) = (/0,1,2,5,6,8,9,10,11,14/)
  case (2)
    yconfig(msensor_SSMIS, ic)%nparam = 6
    yconfig(msensor_SSMIS, ic)%npredcs(1:6) = (/0,1,8,9,10,14/)
  case (12:18)
    yconfig(msensor_SSMIS, ic)%nparam = 8
    yconfig(msensor_SSMIS, ic)%npredcs(1:8) = (/0,3,4,7,8,9,10,11/) 
  END SELECT 
ENDDO

DO ic = 1, 12
  yconfig(msensor_AMSRE, ic)%nparam = 8
  yconfig(msensor_AMSRE, ic)%npredcs(1:8) = (/0,3,4,7,8,9,10,11/) 
ENDDO

DO ic = 1, 9
  yconfig(msensor_TMI, ic)%nparam = 9
  yconfig(msensor_TMI, ic)%npredcs(1:9) = (/0,3,4,7,8,9,10,11,14/) 
ENDDO

DO ic = 1, 4
  yconfig(msensor_MWTS, ic)%nparam = 9
  yconfig(msensor_MWTS, ic)%npredcs(1:9) = (/0,1,2,5,6,8,9,10,12/)
ENDDO

DO ic = 1, 5
  SELECT case (ic)
  case (1:2)
    yconfig(msensor_MWHS, ic)%nparam = 5
    yconfig(msensor_MWHS, ic)%npredcs(1:5) = (/0,8,9,10,12/)
  case (3:5)
    yconfig(msensor_MWHS, ic)%nparam = 9
    yconfig(msensor_MWHS, ic)%npredcs(1:9) = (/0,1,2,5,6,8,9,10,12/)
  END SELECT
ENDDO

DO ic = 1, 10
  yconfig(msensor_MWRI, ic)%nparam = 8
  yconfig(msensor_MWRI, ic)%npredcs(1:8) = (/0,3,4,7,8,9,10,11/)
ENDDO

DO ic = 1, 16
  SELECT case (ic)
  case (5,6,9,10,15,16)
    yconfig(msensor_WINDSAT, ic)%nparam = 1
    yconfig(msensor_WINDSAT, ic)%npredcs(1) = 0
  case (1:4,7,8,11:14)
    yconfig(msensor_WINDSAT, ic)%nparam = 8
    yconfig(msensor_WINDSAT, ic)%npredcs(1:8) = (/0,3,4,7,8,9,10,11/) 
  END SELECT 
ENDDO

! Switches by sensor:
! ------------------
lbc_MSU      = .true.
lbc_AMSUA    = .true.
lbc_AMSUB    = .true.
lbc_MHS      = .true.
lbc_SSMI     = .true.
lbc_SSMIS    = .true.
lbc_AMSRE    = .true.
lbc_TMI      = .true.
lbc_MWTS     = .true.
lbc_MWHS     = .true.
lbc_MWRI     = .true.
lbc_WINDSAT  = .true.

! Background error parameters by sensor:
! -------------------------------------
nbg_MSU      = 5000
nbg_AMSUA    = 5000
nbg_AMSUB    = 5000
nbg_MHS      = 5000
nbg_MWTS     = 2000
nbg_MWHS     = 2000
nbg_MWRI     = 2000
nbg_SSMI     = 2000 
nbg_SSMIS    = 2000 
nbg_AMSRE    = 2000 
nbg_TMI      = 2000 
nbg_WINDSAT  = 2000

! Panic button:
! ------------
lbc_allsky = .true. ! If this is false then no bias correction

! All parameters constant:
! -----------------------
lconst = .false.

! Correct mode rather than mean:
! -----------------------------
lmode = .false.

! Radiosonde vicinity masking:
! ---------------------------
lmaskrs = .false.

WRITE(nulout,'(a)') myname//': Reading namelist NAMVARBC_ALLSKY, first iteration'
CALL posnam(nulnam,'NAMVARBC_ALLSKY')
READ(nulnam,NAMVARBC_ALLSKY)

IF (.NOT. (lbc_allsky .AND. lbc_MSU  )) yconfig(msensor_MSU  ,:)%nparam = 0       
IF (.NOT. (lbc_allsky .AND. lbc_AMSUA)) yconfig(msensor_AMSUA,:)%nparam = 0  
IF (.NOT. (lbc_allsky .AND. lbc_AMSUB)) yconfig(msensor_AMSUB,:)%nparam = 0  
IF (.NOT. (lbc_allsky .AND. lbc_MHS  )) yconfig(msensor_MHS  ,:)%nparam = 0  
IF (.NOT. (lbc_allsky .AND. lbc_SSMI )) yconfig(msensor_SSMI ,:)%nparam = 0 
IF (.NOT. (lbc_allsky .AND. lbc_SSMIS)) yconfig(msensor_SSMIS,:)%nparam = 0 
IF (.NOT. (lbc_allsky .AND. lbc_AMSRE)) yconfig(msensor_AMSRE,:)%nparam = 0 
IF (.NOT. (lbc_allsky .AND. lbc_TMI  )) yconfig(msensor_TMI  ,:)%nparam = 0
IF (.NOT. (lbc_allsky .AND. lbc_MWTS )) yconfig(msensor_MWTS ,:)%nparam = 0
IF (.NOT. (lbc_allsky .AND. lbc_MWHS )) yconfig(msensor_MWHS ,:)%nparam = 0
IF (.NOT. (lbc_allsky .AND. lbc_MWRI )) yconfig(msensor_MWRI ,:)%nparam = 0
IF (.NOT. (lbc_allsky .AND. lbc_WINDSAT  )) yconfig(msensor_WINDSAT  ,:)%nparam = 0

yconfig(msensor_MSU  ,:)%nbgstdv = nbg_MSU     
yconfig(msensor_AMSUA,:)%nbgstdv = nbg_AMSUA   
yconfig(msensor_AMSUB,:)%nbgstdv = nbg_AMSUB   
yconfig(msensor_MHS  ,:)%nbgstdv = nbg_MHS     
yconfig(msensor_SSMI ,:)%nbgstdv = nbg_SSMI    
yconfig(msensor_SSMIS,:)%nbgstdv = nbg_SSMIS   
yconfig(msensor_AMSRE,:)%nbgstdv = nbg_AMSRE   
yconfig(msensor_TMI  ,:)%nbgstdv = nbg_TMI     
yconfig(msensor_MWTS ,:)%nbgstdv = nbg_MWTS
yconfig(msensor_MWHS ,:)%nbgstdv = nbg_MWHS
yconfig(msensor_MWRI ,:)%nbgstdv = nbg_MWRI
yconfig(msensor_WINDSAT  ,:)%nbgstdv = nbg_WINDSAT  

DO is = 0, MXSENSOR
  DO ic = 1, JPMXTOCH
    yconfig(is,ic)%llconst(:) = lconst
    yconfig(is,ic)%llmode     = lmode     
    yconfig(is,ic)%llmaskrs   = lmaskrs   
  ENDDO
ENDDO

! Override settings for individual channels/predictors:
! ----------------------------------------------------
WRITE(nulout,'(a)') myname//': Reading namelist NAMVARBC_ALLSKY, second iteration'
CALL posnam(nulnam,'NAMVARBC_ALLSKY')
READ(nulnam,NAMVARBC_ALLSKY)

IF (lhook) CALL dr_hook(myname,1,zhook_handle)

END SUBROUTINE config
!-----------------------------------------------------------------------

SUBROUTINE encode_groupkey (cdkey, kbufrid, ksensor, kchannl)

!-----------------------------------------------------------------------
! Encodes group description

! cdkey:  encoded string defining a group of radiance data

!-----------------------------------------------------------------------
CHARACTER(LEN=*)  , INTENT(OUT) :: cdkey
INTEGER(KIND=JPIM), INTENT(IN)  :: kbufrid, ksensor, kchannl

REAL(KIND=JPRB) :: zhook_handle

CHARACTER(LEN=*), PARAMETER :: myname = modname//' (encode_groupkey)'

IF (lhook) CALL dr_hook(myname,0,zhook_handle)

WRITE(cdkey,'(3(i0,x))') kbufrid, ksensor, kchannl

IF (lhook) CALL dr_hook(myname,1,zhook_handle)

END SUBROUTINE encode_groupkey
!-----------------------------------------------------------------------

SUBROUTINE decode_groupkey (cdkey, kbufrid, ksensor, kchannl)

!-----------------------------------------------------------------------
! Decodes group description

! cdkey:  encoded string defining a group of radiance data

!-----------------------------------------------------------------------
CHARACTER(LEN=*)  , INTENT(IN)  :: cdkey
INTEGER(KIND=JPIM), INTENT(OUT) :: kbufrid, ksensor, kchannl

REAL(KIND=JPRB) :: zhook_handle

CHARACTER(LEN=*), PARAMETER :: myname = modname//' (decode_groupkey)'

IF (lhook) CALL dr_hook(myname,0,zhook_handle)

READ(cdkey,*) kbufrid, ksensor, kchannl

IF (lhook) CALL dr_hook(myname,1,zhook_handle)

END SUBROUTINE decode_groupkey
!-----------------------------------------------------------------------

SUBROUTINE groupdescr (cdkey, cdescr)

!-----------------------------------------------------------------------
! Returns group description

! cdkey:      encoded string defining a group of radiance data
! cdescr:     string suitable for printing

!-----------------------------------------------------------------------
CHARACTER(LEN=*), INTENT(IN)  :: cdkey
CHARACTER(LEN=*), INTENT(OUT) :: cdescr

CHARACTER(LEN=80)  :: cldesc
INTEGER(KIND=JPIM) :: ibufrid, isensor, ichannl, j, ilen
REAL(KIND=JPRB)    :: zhook_handle

CHARACTER(LEN=*), PARAMETER :: myname = modname//' (groupdescr)'

IF (lhook) CALL dr_hook(myname,0,zhook_handle)

CALL decode_groupkey (cdkey, ibufrid, isensor, ichannl)

! Fallback string

WRITE(cldesc,'(a,4x,3(a,i0))') 'allsky radiance', &
          & ' satid=', ibufrid, ' sensor=', isensor, ' channel=', ichannl

! Try to get string from SATGRP_TABLE

DO j = 1, NSATGRP
  IF (SATGRP_TABLE(j)%codetype/=NSSMI ) CYCLE  
  IF (SATGRP_TABLE(j)%bufrid  /=ibufrid) CYCLE  
  IF (SATGRP_TABLE(j)%sensor  /=isensor) CYCLE 
  WRITE(cldesc,'(a,4x,a,4x,a,i0)') 'allsky radiance', &
          &  TRIM(JOT(NSATEM)%jost(j)%sname), 'channel=', ichannl 
ENDDO

ilen = LEN(cldesc)
IF (LEN(cdescr)<ilen) CALL ABOR1(myname//': Increase string length')

cdescr(1:ilen) = cldesc

IF (lhook) CALL dr_hook(myname,1,zhook_handle)

END SUBROUTINE groupdescr
!-----------------------------------------------------------------------

SUBROUTINE find_groups (cdkeys, kng)

!-----------------------------------------------------------------------
!   find_groups - Find data groups present in ODB requiring VarBC

!   Interface.
!   ----------
!   CALL find_groups (cdkeys, kng)

!       cdkeys(1:kng)    group descriptions

!   Author.
!   -------
!   Dick Dee (ECMWF)

!   Modifications.
!   --------------
!   Original    2008/03/01
!-----------------------------------------------------------------------

CHARACTER(LEN=*)  , INTENT(OUT) :: cdkeys(:)
INTEGER(KIND=JPIM), INTENT(OUT) :: kng

INTEGER(KIND=JPIM) :: ibufrid, isensor, ichannl
INTEGER(KIND=JPIM) :: is, ins
REAL(KIND=JPRB)    :: zhook_handle

CHARACTER(LEN=*), PARAMETER :: myname = modname//' (find_groups)'

IF (lhook) CALL dr_hook(myname,0,zhook_handle)

WRITE(nulout,'(a)') myname//': Looking for allsky radiance data groups..'

! Find all satellite/sensor combinations in the present data 
! ----------------------------------------------------------
CALL find_sensors (ins)

! Return group descriptions for VarBC
! -----------------------------------
kng = 0
IF (lbc_allsky .AND. ins>0) THEN

  DO is = 1, ins  ! Look at each sensor

    ibufrid = ysensors(is)%nbufrid
    isensor = ysensors(is)%nsensor

    DO ichannl = 1, JPMXTOCH

      IF (yconfig(isensor,ichannl)%nparam==0) CYCLE

!     This group requires bias correction; add it to the list of keys

      kng = kng + 1
      IF (kng>size(cdkeys)) CALL ABOR1(myname//': Insufficient allocation.')

      CALL encode_groupkey (cdkeys(kng), ibufrid, isensor, ichannl)

    ENDDO

  ENDDO

  WRITE(nulout,'(a,i3,a)') myname//': ', kng, ' allsky radiance data groups for VarBC'

ENDIF

IF (lhook) CALL dr_hook(myname,1,zhook_handle)

END SUBROUTINE find_groups
!-----------------------------------------------------------------------------

SUBROUTINE get_min ( cdkey, knparam, &
                   & ldconst, kbgstdv, ldmaskrs, ldmode, pdfgdep )

!-----------------------------------------------------------------------
!   get_min - Return parameters used in the minimisation for a particular 
!             group of radiance data

!   Author.
!   -------
!   Dick Dee (ECMWF)

!   Modifications.
!   --------------
!   Original    2008/03/01
!-----------------------------------------------------------------------

CHARACTER(LEN=*)  , INTENT(IN)  :: cdkey
INTEGER(KIND=JPIM), INTENT(IN)  :: knparam
INTEGER(KIND=JPIM), INTENT(OUT) :: kbgstdv
LOGICAL           , INTENT(OUT) :: ldconst(knparam), ldmaskrs, ldmode
REAL(KIND=JPRB)   , INTENT(OUT) :: pdfgdep

INTEGER(KIND=JPIM) :: ibufrid, isensor, ichannl
REAL(KIND=JPRB)    :: zhook_handle

CHARACTER(LEN=*), PARAMETER :: myname = modname//' (get_min)'

IF (lhook) CALL dr_hook(myname,0,zhook_handle)

CALL decode_groupkey (cdkey, ibufrid, isensor, ichannl)

if(isensor == -1 .or. ichannl == -1 )then
  IF (lhook) CALL dr_hook(myname,1,zhook_handle)
  return
endif

IF (knparam/=yconfig(isensor,ichannl)%nparam) THEN
  WRITE(nulout,'(a)'   ) myname//': Parameter mismatch!'
  WRITE(nulout,'(2a)'  ) ' groupkey=', cdkey
  WRITE(nulout,'(a,i0)') ' nparam=', knparam
  WRITE(nulout,'(a,i0)') ' yconfig(isensor,ichannl)%nparam=', yconfig(isensor,ichannl)%nparam  
  CALL ABOR1(myname//': Number of parameters does not match.')
ENDIF

ldconst(:) = yconfig(isensor,ichannl)%llconst(1:knparam)
kbgstdv    = yconfig(isensor,ichannl)%nbgstdv
ldmode     = yconfig(isensor,ichannl)%llmode
pdfgdep    = yconfig(isensor,ichannl)%dfgdep
ldmaskrs   = yconfig(isensor,ichannl)%llmaskrs

IF (lhook) CALL dr_hook(myname,1,zhook_handle)

END SUBROUTINE get_min
!-----------------------------------------------------------------------------

SUBROUTINE find_sensors (kns)

INTEGER(KIND=JPIM), INTENT(OUT) :: kns

! Finds all distinct bufrid/sensor combinations in ODB

INTEGER(KIND=JPIM) :: ibufrid, isensor
INTEGER(KIND=JPIM) :: iret, info(1), ic, j
REAL(KIND=JPRB)    :: zinfo(0)
REAL(KIND=JPRB)    :: zhook_handle

CHARACTER(LEN=*), PARAMETER :: myname = modname//' (find_sensors)'


#include "openmp_obs.h"

IF (lhook) CALL dr_hook(myname,0,zhook_handle)

WRITE(nulout,'(a)') &
 &   myname//': Checking ODB for available bufrid/sensor combinations'

CALL getdb('GETSATID', 0, iret, info, 0, zinfo, 0, &
          & -1, -1, -1, -1, -1, -1)  

! ROBSU(:,MDB_SATID_AT_SAT   ) contains bufrid
! ROBSU(:,MDBSSIA            ) contains sensor
! ROBSU(:,MDB_CODETYPE_AT_HDR) contains codetype

ic = 0
DO isensor = 0, MXSENSOR ! For each sensor, ..
  ibufrid = -1
  DO j = 1, NROWS_ROBSU ! .. find all distinct bufrid's
    IF (ROBSU(j,MDBSSIA            )/=isensor) CYCLE
    IF (ROBSU(j,MDB_CODETYPE_AT_HDR)/= NSSMI ) CYCLE
    IF (ROBSU(j,MDB_SATID_AT_SAT)   ==ibufrid) CYCLE ! duplicate
    ibufrid = ROBSU(j,MDB_SATID_AT_SAT)
    ic = ic + 1
    IF (ic>jpmxns) &
      & CALL ABOR1(myname//': Insufficient allocation - increase jpmxns')
    ysensors(ic)%nbufrid = ibufrid
    ysensors(ic)%nsensor = isensor
    WRITE(nulout,'(2(a,i0))') myname//': bufrid=', ibufrid, ' sensor=', isensor
  ENDDO
ENDDO
kns = ic

CALL putdb('GETSATID', 0, iret, info, 0, zinfo, 0)

IF (lhook) CALL dr_hook(myname,1,zhook_handle)

END SUBROUTINE find_sensors
!-----------------------------------------------------------------------------

SUBROUTINE get_predictors ( cdkey, knparam, &
                          & kpredcs, pparams, ldreset, kcstart, pdfgdep)

! Return list of predictors, a-priori parameter values, ..
 
CHARACTER(LEN=*)  , INTENT(IN)  :: cdkey
INTEGER(KIND=JPIM), INTENT(OUT) :: knparam, kcstart
LOGICAL           , INTENT(OUT) :: ldreset
INTEGER(KIND=JPIM), INTENT(OUT) :: kpredcs(jpmxnp)
REAL(KIND=JPRB)   , INTENT(OUT) :: pparams(jpmxnp)
REAL(KIND=JPRB)   , INTENT(OUT) :: pdfgdep

CHARACTER(LEN=*), PARAMETER :: myname = modname//' (get_predictors)'

INTEGER(KIND=JPIM) :: ibufrid, isensor, ichannl
REAL(KIND=JPRB)    :: zhook_handle

IF (lhook) CALL dr_hook(myname,0,zhook_handle)

CALL decode_groupkey (cdkey, ibufrid, isensor, ichannl)

IF ( (isensor>=0 .AND. isensor<=MXSENSOR) .AND. &
   & (ichannl>=1 .AND. ichannl<=JPMXTOCH) ) THEN

  knparam = yconfig(isensor,ichannl)%nparam
  IF (knparam>0) THEN
    kpredcs(1:knparam) = yconfig(isensor,ichannl)%npredcs(1:knparam)
    pparams(1:knparam) = yconfig(isensor,ichannl)%zparams(1:knparam)
  ENDIF 
  kcstart = yconfig(isensor,ichannl)%ncstart
  ldreset = yconfig(isensor,ichannl)%lreset
  pdfgdep = yconfig(isensor,ichannl)%dfgdep

ELSE

  WRITE(nulout,'(a)') myname//': Invalid key '//cdkey 
  knparam = 0

ENDIF

IF (lhook) CALL dr_hook(myname,1,zhook_handle)

END SUBROUTINE get_predictors
!-----------------------------------------------------------------------------

SUBROUTINE set_varbcix (cdkeys, kix, kng)

!-----------------------------------------------------------------------
!   set_varbcix - Set VarBC group indices in ODB

!   Author.
!   -------
!   Dick Dee (ECMWF)

!   Modifications.
!   --------------
!   Original    2008/03/01
!-----------------------------------------------------------------------

INTEGER(KIND=JPIM), INTENT(IN) :: kix(kng), kng
CHARACTER(LEN=*)  , INTENT(IN) :: cdkeys(kng)

INTEGER(KIND=JPIM) :: iret, ilen, jg, info(1), jobs, ilev, jlev
INTEGER(KIND=JPIM) :: ibufrid, isensor, ichannl
REAL(KIND=JPRB)    :: zinfo(0), zhook_handle

CHARACTER(LEN=*), PARAMETER :: myname = modname//' (set_varbcix)'


#include "openmp_obs.h"

IF (lhook) CALL dr_hook(myname,0,zhook_handle)

WRITE (nulout,'(/,a)') myname//': Setting VarBC group indices (varbc_ix@body) in ODB'

CALL GETDB('VARBC_ALLSKY',0,iret,info,0,zinfo,0, -1, -1, -1, -1, -1, -1)  

ilen = iret
DO jg = 1, kng

  CALL decode_groupkey (cdkeys(jg), ibufrid, isensor, ichannl)

  DO jobs = 1, ilen

    IF (ROBHDR(jobs,MDB_SATID_AT_SAT) == ibufrid .AND. &
      & ROBHDR(jobs,MDBSSIA         ) == isensor       ) THEN  

      DO jlev = MLNKH2B(jobs), MLNKH2B(jobs+1)-1
        ilev = NINT(ROBODY(jlev,MDBPPP))
        IF (ilev==ichannl) THEN
          ROBODY(jlev,MDB_VARBC_IX_AT_BODY) = kix(jg)
        ENDIF
      ENDDO

    ENDIF

  ENDDO
  
ENDDO

CALL PUTDB('VARBC_ALLSKY',0,iret,info,0,zinfo,0)

IF (lhook) CALL dr_hook(myname,1,zhook_handle)

END SUBROUTINE set_varbcix
!-----------------------------------------------------------------------------

END MODULE VARBC_allsky

