SUBROUTINE SURAD

!**** *SURAD  - Set up all the logistic for TOVS/SATEM cost function
!****           computation in the 3D VAR.

!     Purpose.
!     -------
!           Prepare the logistic parameters needed:
!     (1) For the radiative transfer model used in the computation of
!     TOVS radiances, and its adjoint;
!     (2) For the cost function computation in the radiance space:
!     these are basically the std deviations and correlation describing
!     the statistical structure of radiance errors.
!     (3) Same for SATEM thickness and PWC

!**   Interface.
!**   ---------
!**   *CALL* * SURAD *
!**         The common YOMTVRAD is an implicit output of SURAD because
!**         it contains all these logical parameters, which are needed
!**         in the observation operators for clear radiances (routines
!**         TOVCLR, RADTR and below..., and for thicknesses and PWC in
!**         routine SATEM.

!     Author: Jean Pailleux
!     Date  : 91-01-10

!     Externals.T

!     ----------
!              RTSETUP  - SET-UP ROUTINE OF THE RT-CODE
!              SUADVAR  - SET-UP ROUTINE FOR ADVAR
!              GETSATID - GET SATELLITE SERIES, ID'S AND SUBTYPES
!              MATRIXIN - MATRIX INVERSE

!     Modifications
!     -------------
!     Erik Andersson : 91-12-17 Use less chan. over land
!     Erik Andersson : 92-07-15 Thickness and PWC
!     Erik Andersson : 92-08-18 New version of RT-code
!     Erik Andersson : 92-09-17 SATEM thickn. vertical correlations
!     Erik Andersson : 93-03-18 Use SSU
!     Erik Andersson : 94-03-25 Optionally, use NESDIS above 100 hPa
!                               + reduced No of channels
!     Erik Andersson : 95-11-14 Deal with satellite ID in this routine
!                               only. Nowhere else!!
!     Heikki Jarvinen: 96-02-06 Setup ADVAR here
!     Per Unden      : 96-03-11 Set up default sat id:s when <2 present
!     Roger Saunders : 96-07-24 Restructure to allow more than 2 sats
!                               sat id part now done in GETSATID
!     Ph. Caille     : 96-10-08 Let SATEM Lannion in!
!     Erik Andersson : 96-10-16 Manage TOVS data usage through black list
!     Roger Saunders : 97-09-10 Added HIRS chan 8 for RTOVS
!     Rose Munro     : 97-11-26 Modified to accept multiple satellite
!                               series, id's and subtypes
!     Erik Andersson : 98-08-18 Moved TOVS allocations to SURAD
!     Erik Andersson : 98-08-18 TOVS control variable
!     Erik Andersson : 00-11-14 Satellite Data Groups and new Jo-Table
!     Jan Haseler    : 01-05-15 Real MDI for ERA40 satob method
!     Erik Andersson : 01-09-21 Allow RT-calculations for SATOBs
!     Antje Dethof   : 02-07-03 Add ozone sensors for MLS and ENVISAT
!     Antje Dethof   : 03-04-28 Tidy up JO-table entry for ozone data
!     G Kelly        : 03-11-23 rttov 8                                  
!     Dick Dee       : 03-10-22 Support variational bias correction
!     M.Hamrud      01-Oct-2003 CY28 Cleaning
!     P.Burton       : 29-09-04 LVARBC cleanup
!     Antje Dethof   : 05-May-09 Introduce GRG
!     A. Benedetti   : 2005-Mar-22 Add MODIS sensors for aerosol optical depth 
!     V. C. Bechtold : 30-09-05 Add NOAA-18 and ozone seviri sensor from METEOSAT-8 (msg)
!     Antje Dethof   : 20-02_2006 For reo3 data: use satid, codetype, sensor
!                                 and retrype info to get a unique list.
!                                 Data with averaging kernel info sorted into
!                                 seperate set.
!     T. Auligne     : 10-01-07 No reading of old bias files if running VarBC 
!     Rossana Dragani: 200701   Add OMI on AURA
!     Dick Dee       : 24-10-07 Remove VarBC related code
!     Rossana Dragani: 200803   Update MLS on AURA to comply with the WMO definitions
!     Peter Bauer    : 200712   Add MERIS on ENVISAT
!     V. Guidard     : 23-02-07 Add IASI
!     Y.Tremolet    29-May-2008 Print Jo table by bins
!     N Bormann      : 081002 - Attempt to remove awful hardcoding of 
!                               max channel numbers in rtsetup
!     A Fouilloux    :23/03/2010 Add a new codetype for meris (NTCWC)
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE PARDIMO  , ONLY : JPXVAR
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMLUN   , ONLY : NULOUT   ,NULERR
USE YOMDIMO  , ONLY : NMXTCH   ,NMXTCHU
USE YOMCT0   , ONLY : LSCREEN  ,LELAM
USE YOMVAR   , ONLY : LBGOBS   ,LVARBC
USE YOMTVRAD , ONLY : NVALCHAN ,NJPPF    ,&
 & MSATDIM  ,MSUBDIM  ,MBSATID  ,CHSENSOR ,&
 & MNSERIES ,MNSATID  ,MNSUBTYPE,SATGRP_TABLE,NSATGRP,&
 & MKSERIES ,MKSATID  ,MKSUBTYPE,MBSUBTYPE,&
 & TVTSBGE_LAND,TVTSBGE_SEA,TVTSBGE_ICE,CHSERIES,&
 & NSATOBGRP,SATOBGRP_TABLE,&
 & LRTCALC_HRETR,LCLD_RTCALC_ASSIM,LCLD_RTCALC_SCREEN,&
 & MSENSOR_CHANCOUNT  , MXSENSOR  ,&
 & MSENSOR_HIRS,MSENSOR_MSU,MSENSOR_SSU,&
 & MSENSOR_AMSUA,MSENSOR_AMSUB,MSENSOR_SSMI, NSENSOR_MERIS, &
 & MSENSOR_AIRS, MSENSOR_IASI, M__NumAIRSChans, M__NumIASIChans, &
 & AIRSCHAN, IASICHAN, AIRSCHAN_BACK, IASICHAN_BACK 
! BEN do not use for now, MSENSOR_MODIS
USE YOMDB
USE YOMCOSJO , ONLY : JOT      ,NJOTTSZ  ,NJOTISZ, NPRTBINS
USE YOMCOCTP , ONLY : NSATEM   ,CCMOOTP  ,NGTHRB   ,NSTRO3   ,NSSMI   , NTCWC
USE YOMANCS, ONLY  : NMDI

IMPLICIT NONE

INTEGER(KIND=JPIM) :: IRET,INFO(1),ICDTYP,ICDTYP_LAST,IL
INTEGER(KIND=JPIM) :: ISENSOR,ICH,JCH,ICH_COUNT
INTEGER(KIND=JPIM) :: JISERIES,JISATID,JISUBTYPE  ! Counter variables
INTEGER(KIND=JPIM) :: ISERIES   ! Satellite series number
INTEGER(KIND=JPIM), ALLOCATABLE :: ISATIDLIST(:,:)
INTEGER(KIND=JPIM), ALLOCATABLE :: ISAT(:,:)
LOGICAL :: LLABORT
INTEGER(KIND=JPIM) :: I,IDUM,ILEN,ISATID,IU,ISRCHEQ,IX,J,IS,ISATGRP_DIM,J1
REAL(KIND=JPRB) :: ZDUM(200),ZINFO(1)
INTEGER(KIND=JPIM), PARAMETER :: JPNWMO=18
INTEGER(KIND=JPIM) :: ISATWMO(JPNWMO,2)
INTEGER(KIND=JPIM), PARAMETER :: JPNBGE_GRPS=6
INTEGER(KIND=JPIM), PARAMETER :: JPBGISATID(JPNBGE_GRPS)=(/ 206,206,206,205,205,246/)
INTEGER(KIND=JPIM) :: JPBGSENSOR(JPNBGE_GRPS)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "getsatid.intfb.h"
#include "rtsetup.intfb.h"

#include "openmp_obs.h"

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

IU = NULOUT

ISATWMO(:,1)=(/702,703,704,705,708,706,707,200,201,202,203,204,205,206,207,208,209,210/)
ISATWMO(:,2)=(/  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 14, 15, 16, 17,18,19/)
JPBGSENSOR(:)=(/ MSENSOR_HIRS,MSENSOR_MSU,MSENSOR_SSU,MSENSOR_AMSUA,MSENSOR_AMSUB,MSENSOR_SSMI/)

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

!*       1. SET UP LOGISTIC PARAMETRES FOR TOVS RAD COMPUTATIONS.
!           -----------------------------------------------------
!     Background errors for Ts retrieval at TOVS points,
!     used when having TOVS Ts as part of control variable.
TVTSBGE_LAND=5.0_JPRB         ! 1D-Var used 4.5 K
TVTSBGE_SEA =1.0_JPRB         ! 1.64 was used in 1D-Var
TVTSBGE_ICE =5.0_JPRB         ! 1D-Var used 4.5 K

!*    1.1 Call of GETSATID which is the routine setting up the
!*        satellite series, id's and subtypes which are in CMA
!*        Variables stored in ifs/module/YOMTVRAD

IRET = 0
NSATGRP=0
JOT(NSATEM)%size=0

!     1.1.1 ODB is asked to deliver a unique list of
!           satid, codetype, sensor, and retrtype for obstype=satem.

CALL GSTATS(1784,0)
CALL GETDB('GETSATID', 0, IRET, INFO, 0, ZINFO,0,&
 & -1, -1, -1, -1, -1, -1)  
CALL GSTATS(1784,1)

!     1.1.2 The ROBSU-array may contain duplicates; one per PE
!           The duplicates are removed in this loop.
ILEN=0
IF(IRET > 0) THEN
  ILEN=1
  ICDTYP_LAST=ROBSU(ILEN,MDB_CODETYPE_AT_HDR)
ENDIF
DO J=2,IRET
  ICDTYP=ROBSU(J,MDB_CODETYPE_AT_HDR)
  IF (ICDTYP == NSTRO3 ) THEN
    IF(ROBSU(J,MDB_SATID_AT_SAT) /= ROBSU(ILEN,MDB_SATID_AT_SAT) .OR. &
       & ICDTYP                  /= ICDTYP_LAST .OR. &
       & ROBSU(J,MDBSSIA)        /= ROBSU(ILEN,MDBSSIA) .OR. &
       & ROBSU(J,MDB_RETRTYPE_AT_HDR) /= ROBSU(ILEN,MDB_RETRTYPE_AT_HDR)) THEN
      ILEN=ILEN+1
      ROBSU(ILEN,MDB_SATID_AT_SAT)=ROBSU(J,MDB_SATID_AT_SAT)
      ROBSU(ILEN,MDB_RETRTYPE_AT_HDR)    =ROBSU(J,MDB_RETRTYPE_AT_HDR)
      ROBSU(ILEN,MDB_CODETYPE_AT_HDR)    =ROBSU(J,MDB_CODETYPE_AT_HDR)
      ROBSU(ILEN,MDBSSIA)         =ROBSU(J,MDBSSIA)
      ICDTYP_LAST                 =ROBSU(ilen,MDB_CODETYPE_AT_HDR)
    ENDIF
  ELSE
    IF(ROBSU(J,MDB_SATID_AT_SAT) /= ROBSU(ILEN,MDB_SATID_AT_SAT) .OR. &
       & ICDTYP                    /= ICDTYP_LAST .OR. &
       & ROBSU(J,MDBSSIA)          /= ROBSU(ILEN,MDBSSIA) ) THEN
      ILEN=ILEN+1
      ROBSU(ILEN,MDB_SATID_AT_SAT)=ROBSU(J,MDB_SATID_AT_SAT)
      ROBSU(ILEN,MDB_CODETYPE_AT_HDR)    =ROBSU(J,MDB_CODETYPE_AT_HDR)
      ROBSU(ILEN,MDBSSIA)         =ROBSU(J,MDBSSIA)
      ICDTYP_LAST                 =ROBSU(ilen,MDB_CODETYPE_AT_HDR)
    ENDIF
  ENDIF
ENDDO
NSATGRP=ILEN

WRITE(IU,*)'SURAD: NSATGRP=',NSATGRP
IF (NSATGRP > 99) THEN
  WRITE(NULERR,*)'***PROGRAMMING ERROR IN SURAD: NSATGRP > 99'
  CALL ABORTDB('SURAD','NSATGRP > 99',NSATGRP)
ENDIF

IF(LBGOBS) THEN
  ISATGRP_DIM=NSATGRP+JPNBGE_GRPS
ELSE
  ISATGRP_DIM=NSATGRP
ENDIF

ALLOCATE(ISATIDLIST(MAX(ISATGRP_DIM+NSATOBGRP,1),2))
ISATIDLIST(:,:)=-9
ALLOCATE(SATGRP_TABLE(ISATGRP_DIM))
ALLOCATE(JOT(NSATEM)%jost(NSATGRP))
JOT(NSATEM)%size=NSATGRP
JOT(NSATEM)%name=CCMOOTP(NSATEM)
NJOTTSZ = NJOTTSZ + NSATGRP*NJOTISZ

LLABORT = .FALSE.
do j=1,ISATGRP_DIM
  IF( LBGOBS .and. (j > NSATGRP) ) THEN
   ISATID=JPBGISATID(j-NSATGRP )
   ICDTYP=NGTHRB
   ISENSOR=JPBGSENSOR(j-NSATGRP )
  ELSE
   ISATID=ROBSU(j,MDB_SATID_AT_SAT)
   ICDTYP=ROBSU(j,MDB_CODETYPE_AT_HDR)
   ISENSOR=ROBSU(j,MDBSSIA)
  ENDIF
  ISATIDLIST(j,1)=ISATID
  ISATIDLIST(j,2)=ICDTYP
  IF (ICDTYP == NSTRO3) THEN
    SATGRP_TABLE(J)%retrtype = ROBSU(j,MDB_RETRTYPE_AT_HDR)
   WRITE(IU,*) ' ISATIDLIST: ',j,ISATIDLIST(j,1),ISATIDLIST(j,2),ISENSOR,&
     & SATGRP_TABLE(J)%retrtype
  ELSE
    SATGRP_TABLE(J)%retrtype   = -9    
    WRITE(IU,*) ' ISATIDLIST: ',j,ISATIDLIST(j,1),ISATIDLIST(j,2),ISENSOR
  ENDIF

  SATGRP_TABLE(J)%bufrid   = ISATID
  SATGRP_TABLE(J)%codetype = ICDTYP
  SATGRP_TABLE(J)%sensor   = ISENSOR
  SATGRP_TABLE(J)%satgroup = j

  SATGRP_TABLE(J)%rtid         = -9
  SATGRP_TABLE(J)%rtseries     = -9
  SATGRP_TABLE(J)%rtsubtype    = -9
  SATGRP_TABLE(J)%rtid_ix      = -9
  SATGRP_TABLE(J)%rtseries_ix  = -9
  SATGRP_TABLE(J)%rtsubtype_ix = -9
  SATGRP_TABLE(J)%nrtchannels  = -9

  IF(ICDTYP /= NGTHRB .AND. ICDTYP /= NSSMI .AND. ICDTYP /= NTCWC) THEN
    SATGRP_TABLE(J)%rtcoef_pos = -9                 ! No RT required
    SATGRP_TABLE(J)%cld_rtcalc_screen=.FALSE.
    SATGRP_TABLE(J)%cld_rtcalc_assim=.FALSE.
  ELSEIF (ICDTYP == NTCWC) THEN
    SATGRP_TABLE(J)%rtcoef_pos = -9                 ! No RT required for MERIS TCWV
    SATGRP_TABLE(J)%cld_rtcalc_screen=.FALSE.
    SATGRP_TABLE(J)%cld_rtcalc_assim=.FALSE.
  ELSE
    SATGRP_TABLE(J)%rtcoef_pos=j
    IF (ISENSOR < 0 .OR. ISENSOR > MXSENSOR) THEN
      WRITE(IU,*)'***ERROR IN SURAD: ISENSOR=',ISENSOR,&
       & ' OUT OF RANGE IN SATGRP_TABLE(J): J,bufrid,codetype=',&
       & J,ISATID,ICDTYP
      LLABORT = .TRUE.
      CYCLE
    ENDIF
    SATGRP_TABLE(J)%cld_rtcalc_screen=LRTCALC_HRETR(ISENSOR) .AND. &
     &  LCLD_RTCALC_SCREEN(ISENSOR)
    SATGRP_TABLE(J)%cld_rtcalc_assim=LCLD_RTCALC_ASSIM(ISENSOR)
  ENDIF

enddo
IF (LLABORT) CALL ABORTDB('SURAD', 'ISENSOR(S) OUT OF RANGE', -1)

do J=1,NSATGRP
  ALLOCATE(JOT(NSATEM)%jost(j)%cost (JPXVAR,NPRTBINS))
  ALLOCATE(JOT(NSATEM)%jost(j)%count(JPXVAR,NPRTBINS))
  ALLOCATE(JOT(NSATEM)%jost(j)%obimpact(JPXVAR,NPRTBINS))

  ICDTYP=SATGRP_TABLE(J)%codetype
  ISATID = SATGRP_TABLE(J)%bufrid
  JOT(NSATEM)%jost(J)%codetype    = ICDTYP
  JOT(NSATEM)%jost(J)%cost(:,:)   = 0.0_JPRB
  JOT(NSATEM)%jost(J)%obserr(:)   = 0.0_JPRB
  JOT(NSATEM)%jost(J)%bgerr(:)    = 0.0_JPRB
  JOT(NSATEM)%jost(J)%obimpact(:,:) = 0.0_JPRB
  JOT(NSATEM)%jost(J)%count(:,:)    = 0
  JOT(NSATEM)%jost(J)%sname(1:32) = '                                '
  WRITE(JOT(NSATEM)%jost(J)%sname(12:16),'(I5)') SATGRP_TABLE(J)%bufrid  

! Ozone layer data
  IF(ICDTYP == NSTRO3) THEN
    IF(SATGRP_TABLE(J)%retrtype == 1) THEN
      JOT(NSATEM)%jost(J)%sname(1:8)='GRG AK  '
    ELSE
      JOT(NSATEM)%jost(J)%sname(1:8)='O3/MACC '
    ENDIF
    IX=ISRCHEQ(JPNWMO,ISATWMO(1,1),1,ISATID)
    IF(IX <= JPNWMO) THEN
      SATGRP_TABLE(J)%rtid=ISATWMO(IX,2)
    ELSE
      SATGRP_TABLE(J)%rtid=ISATID
    ENDIF

    WRITE(JOT(NSATEM)%jost(J)%sname(9:11),'(I3)') SATGRP_TABLE(J)%rtid
 
    JOT(NSATEM)%jost(J)%sname(18:24) = 'SENSOR='
    WRITE(JOT(NSATEM)%jost(J)%sname(25:28),'(I4)') SATGRP_TABLE(J)%sensor
    IF(SATGRP_TABLE(J)%sensor == 431) THEN
      JOT(NSATEM)%jost(J)%sname(18:32) = 'SENSOR=TOMS    '
    ELSEIF(SATGRP_TABLE(J)%sensor == 624) THEN
      JOT(NSATEM)%jost(J)%sname(18:32) = 'SENSOR=SBUV    '
    ELSEIF(SATGRP_TABLE(J)%sensor == 170) THEN
      JOT(NSATEM)%jost(J)%sname(18:32) = 'SENSOR=GOME    '
    ELSEIF(SATGRP_TABLE(J)%sensor == 387 .or. SATGRP_TABLE(J)%sensor == 386) THEN
      JOT(NSATEM)%jost(J)%sname(18:32) = 'SENSOR=MLS     '
    ELSEIF(SATGRP_TABLE(J)%sensor == 161) THEN
      JOT(NSATEM)%jost(J)%sname(18:32) = 'SENSOR=MIPAS'
    ELSEIF(SATGRP_TABLE(J)%sensor == 90) THEN
      JOT(NSATEM)%jost(J)%sname(18:32) = 'SENSOR=MOPITT'
    ELSEIF(SATGRP_TABLE(J)%sensor == 172) THEN
      JOT(NSATEM)%jost(J)%sname(18:32) = 'SENSOR=GOMOS'
    ELSEIF(SATGRP_TABLE(J)%sensor == 175) THEN
      JOT(NSATEM)%jost(J)%sname(18:32) = 'SENSOR=SCIA'
    ELSEIF(SATGRP_TABLE(J)%sensor == 394) THEN
      JOT(NSATEM)%jost(J)%sname(18:32) = 'SENSOR=OMI'
    ELSEIF(SATGRP_TABLE(J)%sensor == 220) THEN
      JOT(NSATEM)%jost(J)%sname(18:32) = 'SENSOR=GOME2'
    ELSEIF(SATGRP_TABLE(J)%sensor == 389) THEN
      JOT(NSATEM)%jost(J)%sname(18:32) = 'SENSOR=MODIS    '
    ELSEIF(SATGRP_TABLE(J)%sensor == 516) THEN
      JOT(NSATEM)%jost(J)%sname(1:8)='GOSAT   '
      JOT(NSATEM)%jost(J)%sname(18:32) = 'SENSOR=TANSO    '
    ELSEIF(SATGRP_TABLE(J)%sensor == 207) THEN
      JOT(NSATEM)%jost(J)%sname(18:32) = 'SENSOR=SEVIRI'
    ELSEIF(SATGRP_TABLE(J)%sensor == 221) THEN
      JOT(NSATEM)%jost(J)%sname(18:32) = 'SENSOR=IASI'
    ENDIF 
  ENDIF

!* TCWV data other than MW 1D-Var
  IF (ICDTYP == NTCWC) THEN
    JOT(NSATEM)%jost(J)%sname(1:12)='ENVISAT'
        
    SATGRP_TABLE(J)%rtid=ISATID
 
    WRITE(JOT(NSATEM)%jost(J)%sname(8:11),'(I3)') SATGRP_TABLE(J)%rtid
    
    JOT(NSATEM)%jost(J)%sname(18:24) = 'SENSOR='
    WRITE(JOT(NSATEM)%jost(J)%sname(25:28),'(I4)') SATGRP_TABLE(J)%sensor
    
    IF(SATGRP_TABLE(J)%sensor == 174) THEN
      JOT(NSATEM)%jost(J)%sname(18:32) = 'SENSOR=MERIS'
    ENDIF
  ENDIF
ENDDO

! List which AMV/SATOB satellites need RT calculations
DO J=1,NSATOBGRP
      IF(TRIM(SATOBGRP_TABLE(J)%obs_oper) == 'RT average' .OR. &
  & TRIM(SATOBGRP_TABLE(J)%obs_oper) == 'RT median'   .OR. &
  & TRIM(SATOBGRP_TABLE(J)%obs_oper) == 'RT max'      .OR. &
  & TRIM(SATOBGRP_TABLE(J)%obs_oper) == 'RT median Gauss average'.OR. &
  & TRIM(SATOBGRP_TABLE(J)%obs_oper) == 'RT median RT average'.OR. &
  & TRIM(SATOBGRP_TABLE(J)%obs_oper) == 'RT max Gauss average'.OR. &
  & TRIM(SATOBGRP_TABLE(J)%obs_oper) == 'RT max RT average') THEN
    IS=J+NSATGRP
    ISATIDLIST(IS,1)=SATOBGRP_TABLE(J)%bufrid
    ISATIDLIST(IS,2)=NGTHRB                   ! This is an expedient trick
    WRITE(IU,*) ' ISATIDLIST WVclear: J',J,IS,ISATIDLIST(IS,1),ISATIDLIST(IS,2)
  ENDIF
ENDDO

ILEN=SIZE(ISATIDLIST,DIM=1)
CALL GETSATID(ILEN,ISATIDLIST(1,1),ISATIDLIST(1,2))

!*    1.2 PRINT and fill in the SATGRP_TABLE
IF (ALLOCATED(ISATIDLIST)) DEALLOCATE(ISATIDLIST)

DO JISERIES = 1,MNSERIES
  ISERIES = MKSERIES(JISERIES)

  WRITE(IU,*) 'ASSIGNED ',CHSERIES(ISERIES),' SATELLITES',&
   & (MKSATID(JISERIES,JISATID),JISATID = 1, MNSATID(JISERIES))  
  WRITE(IU,*) 'ASSIGNED ',CHSERIES(ISERIES),' SUBTYPES',&
   & (MKSUBTYPE(JISERIES,JISUBTYPE),JISUBTYPE = 1,&
   & MNSUBTYPE(JISERIES))  

  DO JISUBTYPE = 1, MNSUBTYPE(JISERIES)
    DO JISATID = 1, MNSATID(JISERIES)

      DO J=1,ISATGRP_DIM
!       IF(LBGOBS .and. (j >  NSATGRP) ) THEN
!         SATGRP_TABLE(J)%rtid         = JPBGRTSATID(j-NSATGRP) ! Array removed
!         SATGRP_TABLE(J)%rtseries     = 1                   
!         IF( j == ISATGRP_DIM )SATGRP_TABLE(J)%rtseries = 2       
!         SATGRP_TABLE(J)%rtsubtype    = 3                                
!         IF( j == ISATGRP_DIM )SATGRP_TABLE(J)%rtsubtype    = 1
!         SATGRP_TABLE(J)%rtcoef_pos   = 1       
!         SATGRP_TABLE(J)%rtid_ix      = SATGRP_TABLE(J)%rtid 
!         SATGRP_TABLE(J)%rtseries_ix  = 1       
!         IF( j == ISATGRP_DIM )SATGRP_TABLE(J)%rtseries_ix = 2       
!         SATGRP_TABLE(J)%rtsubtype_ix = 3            
!         IF( j == ISATGRP_DIM )SATGRP_TABLE(J)%rtsubtype_ix = 1

!       ELSE

        IF(SATGRP_TABLE(J)%bufrid   == MBSATID(JISERIES,JISATID) .AND. &
           & SATGRP_TABLE(J)%codetype == MBSUBTYPE(JISERIES,JISUBTYPE)) THEN  

          SATGRP_TABLE(J)%rtid         = MKSATID(JISERIES,JISATID)
          SATGRP_TABLE(J)%rtseries     = MKSERIES(JISERIES)
          SATGRP_TABLE(J)%rtsubtype    = MKSUBTYPE(JISERIES,JISUBTYPE)
          SATGRP_TABLE(J)%rtid_ix      = JISATID
          SATGRP_TABLE(J)%rtseries_ix  = JISERIES
          SATGRP_TABLE(J)%rtsubtype_ix = JISUBTYPE

          IF(J<=NSATGRP) THEN
            ISENSOR=SATGRP_TABLE(J)%sensor
            JOT(NSATEM)%jost(J)%sname(1:8)=CHSERIES(ISERIES)(1:8)
            WRITE(JOT(NSATEM)%jost(J)%sname(9:10),'(I2)') &
             & SATGRP_TABLE(J)%rtid  
            JOT(NSATEM)%jost(J)%sname(18:24) = 'SENSOR='
            JOT(NSATEM)%jost(J)%sname(25:32) = CHSENSOR(ISENSOR)
          ENDIF
        ENDIF

!      ENDIF

      ENDDO
      
      DO J=1,NSATOBGRP
        IF( (SATOBGRP_TABLE(J)%obs_oper == 'RT average' .OR. &
        & SATOBGRP_TABLE(J)%obs_oper == 'RT median'     .OR. &
        & SATOBGRP_TABLE(J)%obs_oper == 'RT max'   .OR. &
        & SATOBGRP_TABLE(J)%obs_oper == 'RT median Gauss average'.OR. &
        & SATOBGRP_TABLE(J)%obs_oper == 'RT median RT average'.OR. &
        & SATOBGRP_TABLE(J)%obs_oper == 'RT max Gauss average'.OR. &
        & SATOBGRP_TABLE(J)%obs_oper == 'RT max RT average'  ).AND. &
        & SATOBGRP_TABLE(J)%bufrid   == MBSATID(JISERIES,JISATID) ) THEN  

          SATOBGRP_TABLE(J)%rtid       = MKSATID(JISERIES,JISATID)
          SATOBGRP_TABLE(J)%rtseries   = MKSERIES(JISERIES)
          SATOBGRP_TABLE(J)%rtsubtype  = MKSUBTYPE(JISERIES,JISUBTYPE)
          SATOBGRP_TABLE(J)%rtcoef_pos = -9    !  This needs setting properly!
          DO J1=1,ISATGRP_DIM
             IF(SATGRP_TABLE(J1)%bufrid   == MBSATID(JISERIES,JISATID) .AND. &
                & SATGRP_TABLE(J1)%codetype == MBSUBTYPE(JISERIES,JISUBTYPE)) THEN  
                SATOBGRP_TABLE(J)%rtcoef_pos = SATGRP_TABLE(J1)%rtcoef_pos
             ENDIF
          ENDDO
       ENDIF
      ENDDO

    ENDDO
  ENDDO
ENDDO

NMXTCH=MAXVAL(MSENSOR_CHANCOUNT)
NMXTCHU=NMXTCH
ALLOCATE(NVALCHAN(NMXTCH,ISATGRP_DIM))
NVALCHAN(:,:) = 0

DO J=1,ISATGRP_DIM
  ISENSOR=SATGRP_TABLE(J)%sensor
  IF(ISENSOR > MXSENSOR) CYCLE

  ICH_COUNT=MSENSOR_CHANCOUNT(ISENSOR)
  SATGRP_TABLE(J)%nrtchannels  = ICH_COUNT
  ALLOCATE(SATGRP_TABLE(J)%rtchan_list(ICH_COUNT))
  SELECT CASE (ISENSOR)
  CASE (MSENSOR_AIRS)
      NVALCHAN(1:M__NumAIRSChans,J) = AIRSCHAN
      SATGRP_TABLE(J)%rtchan_list(:)= AIRSCHAN
      AIRSCHAN_BACK(:) = -NMDI
      DO ICH = 1, M__NumAIRSChans
         AIRSCHAN_BACK(AIRSCHAN(ICH)) = ICH
      ENDDO
  CASE (MSENSOR_IASI)
      NVALCHAN(1:M__NumIASIChans,J) = IASICHAN
      SATGRP_TABLE(J)%rtchan_list(:)= IASICHAN
      IASICHAN_BACK(:) = -NMDI
      DO ICH = 1, M__NumIASIChans
         IASICHAN_BACK(IASICHAN(ICH)) = ICH
      ENDDO
  CASE DEFAULT 
     DO JCH=1,ICH_COUNT
        NVALCHAN(JCH,J) = JCH
        SATGRP_TABLE(J)%rtchan_list(JCH)=JCH
     ENDDO
  END SELECT
ENDDO

IF(MNSERIES /= 0)THEN
 CALL GSTATS(1766,0)
 CALL RTSETUP
 CALL GSTATS(1766,1)
ENDIF


!*          1.4 FIND OLD-STYLE SATEM SAT ID
IL=6
ALLOCATE(ISAT(IL,2))
ISAT(1:IL,1)=(/235,236,237,239,037,038/)
ISAT(1:IL,2)=(/ 10, 11, 12, 14, 12, 14/)
DO J=1,NSATGRP
  IX=ISRCHEQ(IL,ISAT(1,1),1,ROBSU(j,MDB_SATID_AT_SAT))
  IF(IX <= IL) THEN
    SATGRP_TABLE(J)%bufrid=ISAT(IX,1)
    SATGRP_TABLE(J)%rtid  =ISAT(IX,2)

    JOT(NSATEM)%jost(J)%sname(1:8)='SATEM   '
    WRITE(JOT(NSATEM)%jost(J)%sname(9:10),'(I2)') ISAT(IX,2)
  ENDIF
ENDDO

IF (ALLOCATED(ISAT)) DEALLOCATE(ISAT)

CALL GSTATS(1784,0)
CALL PUTDB('GETSATID', 0, IRET, INFO, 0, ZINFO, 0)
CALL GSTATS(1784,1)


do j=1,NSATGRP
  WRITE(IU,'(1x,2A,8(/A,I7),2(/A,L1))')&
   & ' JOT-sname: ',JOT(NSATEM)%jost(min(j,NSATGRP))%sname,&
   & ' SATGRP_TABLE%satgroup: ',  SATGRP_TABLE(J)%satgroup,&
   & '             %codetype: ',  SATGRP_TABLE(J)%codetype,&
   & '             %bufrid: ',    SATGRP_TABLE(J)%bufrid,&
   & '             %sensor: ',    SATGRP_TABLE(J)%sensor,&
   & '             %rtid: ',      SATGRP_TABLE(J)%rtid,&
   & '             %rtsubtype: ', SATGRP_TABLE(J)%rtsubtype,&
   & '             %rtcoef_pos: ',SATGRP_TABLE(J)%rtcoef_pos,&
   & '             %rtseries: ',  SATGRP_TABLE(J)%rtseries,&    
   & '             %cld_rtcalc_screen:',SATGRP_TABLE(J)%cld_rtcalc_screen,&
   & '             %cld_rtcalc_assim:',SATGRP_TABLE(J)%cld_rtcalc_assim
  IF(SATGRP_TABLE(J)%nrtchannels > 0 ) THEN
    WRITE(IU,'(1x,1(A,I7,/),A,15(30I5/))')&
     & '            %nrtchannels: ',SATGRP_TABLE(J)%nrtchannels,&
     & '             %rtchan_list: ',SATGRP_TABLE(J)%rtchan_list(:)  
  ENDIF
enddo

IF ((LELAM).OR.(.NOT. LVARBC)) THEN
  !*    1.3 Call of suadvar which is the routine setting up the
  !*        constants for the radiative transfer code and calls
  !*        to routines to set satellite specific parameters
  !*        will handle multiple satellite series, satid's and
  !*        subtypes etc
  IF (MNSERIES /= 0) THEN
  ! The first two arguments should be removed from SUADVAR.
  ! Also the last one can be removed.
    CALL GSTATS(1954,0)
    IF(LSCREEN) CALL SUADVAR(IDUM,ZDUM,MSATDIM,MSUBDIM,MNSERIES,&
     & MNSATID,MNSUBTYPE,MKSERIES,MKSATID,MKSUBTYPE,NJPPF)  
    CALL GSTATS(1954,1)
  ELSE
    WRITE(IU,*)'SURAD: NO SATEMS IN CMA'
  ENDIF
ENDIF
!     ------------------------------------------------------------------
9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)
9990 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)

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