SUBROUTINE SULIMB

!**** *SULIMB  - Set up all the logistic for limb observations.
!****              

!     Purpose.
!     -------
!           Prepare the logistic parameters needed:
!     (1) For the radiative transfer model used in the computation of
!     limb radiances, and its adjoint;
!     (2) For the diagnostic cost function table.

!**   Interface.
!**   ---------
!**   *CALL* * SULIMB *
!**         The common YOMLIMB is an implicit output of SULIMB as
!**         it contains all the logical parameters, which are needed
!**         in the observation operators for clear limb radiances.

!     Author: Niels Bormann
!     Date  : 05/11/2004

!     Externals.
!     ----------
!              RTL_SETUP  - SET-UP ROUTINE OF THE RTLIMB-CODE

!     Modifications
!     -------------
!        Y.Tremolet    29-May-2008 Print Jo table by bins
!     ------------------------------------------------------------------

USE PARKIND1 , ONLY : JPIM, JPRB
USE PARDIMO  , ONLY : JPXVAR
USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
USE YOMLUN   , ONLY : NULOUT, NULERR
USE YOMLIMB  , ONLY : Y_LIMBGRP_TABLE, NLIMBGRP,  &
  &  IRTLIMB_LIST, NRTLIMB_LIST, MSENSOR_MIPAS, MSENSOR_MLS, &
  &  MMETOP_1,MMETOP_2,MMETOP_3,MCHAMP,MTERRASARX,MGRACE_A,MGRACE_B, &
  &  MCOSMIC_1,MCOSMIC_2,MCOSMIC_3,MCOSMIC_4,MCOSMIC_5,MCOSMIC_6
USE YOMANCS  , ONLY : NMDI
USE YOMCOCTP , ONLY : NLIMB, CCMOOTP, NGPSRO, NLRAD
USE YOMCT0   , ONLY : NPRINTLEV, LALLOPR
USE YOMCOSJO , ONLY : JOT, NJOTTSZ, NJOTISZ, NPRTBINS
USE YOMDB

IMPLICIT NONE

LOGICAL :: LLP, LLABORT

INTEGER(KIND=JPIM) :: IRET,INFO(1),ICDTYP,ICDTYP_LAST
INTEGER(KIND=JPIM) :: ILEN
INTEGER(KIND=JPIM) :: J, IK
INTEGER(KIND=JPIM) :: ISATID, ISENSOR  ! Counter variables
INTEGER(KIND=JPIM) :: IU
INTEGER(KIND=JPIM) :: JISERIES, JISATID

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

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

#include "rtl_setup.intfb.h"

#include "openmp_obs.h"

!===============================================================

IF (LHOOK) CALL DR_HOOK('SULIMB',0,ZHOOK_HANDLE)
LLP = NPRINTLEV >= 1 .OR. LALLOPR
IU = NULOUT

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

!*       1. SET UP LOGISTIC PARAMETERS FOR LIMB COMPUTATIONS
!           ------------------------------------------------

IRET = 0
NLIMBGRP=0
JOT(NLIMB)%size=0

!     1.1   ODB is asked to deliver a unique list of
!           satid, codetype and sensor, for obstype=limb.

CALL GSTATS(1797,0)
CALL GETDB('GETLIMBID', 0, IRET, INFO, 0, ZINFO,0,&
 & -1, -1, -1, -1, -1, -1)  
CALL GSTATS(1797,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(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
ENDDO
NLIMBGRP=ILEN

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

!     1.3   Fill in general values for Y_LIMBGRP_TABLE

IF( NLIMBGRP > 0 ) ALLOCATE(Y_LIMBGRP_TABLE(NLIMBGRP))

LLABORT = .FALSE.
DO J=1,NLIMBGRP
  ISATID  = ROBSU(J,MDB_SATID_AT_SAT)
  ICDTYP  = ROBSU(J,MDB_CODETYPE_AT_HDR)
  ISENSOR = ROBSU(J,MDBSSIA)

  Y_LIMBGRP_TABLE(J)%bufrsatid = ISATID
  Y_LIMBGRP_TABLE(J)%codetype  = ICDTYP
  Y_LIMBGRP_TABLE(J)%sensor    = ISENSOR
  Y_LIMBGRP_TABLE(J)%satgroup  = J

  Y_LIMBGRP_TABLE(J)%rtid         = NMDI
  Y_LIMBGRP_TABLE(J)%rtsubtype    = NMDI
  Y_LIMBGRP_TABLE(J)%rtseries     = NMDI
  Y_LIMBGRP_TABLE(J)%nmxchan      = 0
  Y_LIMBGRP_TABLE(J)%nlsat        = 0

  IF(ICDTYP /= NLRAD) THEN
    Y_LIMBGRP_TABLE(J)%rtcoef_pos = NMDI            ! No RT required
  ELSE
    Y_LIMBGRP_TABLE(J)%rtcoef_pos = J

!    IF (ISENSOR < 0 .OR. ISENSOR > MXSENSOR) THEN
    IF ( ISENSOR /= MSENSOR_MIPAS ) THEN
      WRITE(IU,*)'***ERROR IN SULIMB: ISENSOR=',ISENSOR,&
       & ' OUT OF RANGE IN Y_LIMBGRP_TABLE(J): J,bufrsatid,codetype=',&
       & J,ISATID,ICDTYP
      LLABORT = .TRUE.
      CYCLE
    ENDIF
  ENDIF

ENDDO

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

!     1.4   Fill JO-Table structure JOT

JOT(NLIMB)%size = NLIMBGRP
JOT(NLIMB)%name = CCMOOTP(NLIMB)
IF( NLIMBGRP > 0 ) ALLOCATE(JOT(NLIMB)%jost(NLIMBGRP))
NJOTTSZ = NJOTTSZ + NLIMBGRP*NJOTISZ

DO J=1,NLIMBGRP
  ALLOCATE(JOT(NLIMB)%jost(j)%cost (JPXVAR,NPRTBINS))
  ALLOCATE(JOT(NLIMB)%jost(j)%count(JPXVAR,NPRTBINS))
  ALLOCATE(JOT(NLIMB)%jost(j)%obimpact(JPXVAR,NPRTBINS))

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

ENDDO

!     1.5 Fill in the Y_LIMBGRP_TABLE 
!         Once there are more RTLIMB sounders available the following 
!         should be replaced with a call to a subroutine linking bufrsatid
!         with series and rtid used in RTLIMB (ie an updated version
!         of GETSATID)

IRTLIMB_LIST(1,1:3) = (/ 60,11, 1 /)          ! Envisat-1
IRTLIMB_LIST(2,1:3) = (/785, 9, 3 /)          ! EOS-Aura

DO J=1,NLIMBGRP
 
  IF( Y_LIMBGRP_TABLE(J)%codetype == NLRAD ) THEN
    DO IK=1, NRTLIMB_LIST

      IF(  Y_LIMBGRP_TABLE(J)%bufrsatid == IRTLIMB_LIST(IK,1) ) THEN 

        JISERIES = IRTLIMB_LIST(IK,2)
        JISATID  = IRTLIMB_LIST(IK,3)
        Y_LIMBGRP_TABLE(J)%rtseries  = JISERIES
        Y_LIMBGRP_TABLE(J)%rtid      = JISATID

        ISENSOR=Y_LIMBGRP_TABLE(J)%sensor

        SELECT CASE (JISERIES)
         CASE (11)
           JOT(NLIMB)%jost(J)%sname(1:8) = 'ENVISAT '
         CASE (9)
           JOT(NLIMB)%jost(J)%sname(1:8) = 'EOS     '
        END SELECT

        WRITE(JOT(NLIMB)%jost(J)%sname(9:10),'(I2)') &
           &  Y_LIMBGRP_TABLE(J)%rtid  
        JOT(NLIMB)%jost(J)%sname(18:24) = 'SENSOR='

        SELECT CASE (ISENSOR)
         CASE (MSENSOR_MIPAS)
           JOT(NLIMB)%jost(J)%sname(25:29) = 'MIPAS'
         CASE (MSENSOR_MLS)
           JOT(NLIMB)%jost(J)%sname(25:27) = 'MLS'
        END SELECT

      ENDIF
    ENDDO
  ELSEIF ( Y_LIMBGRP_TABLE(J)%codetype == NGPSRO ) THEN
!!!    JOT(NLIMB)%jost(J)%sname(1:5)  = 'GPSRO'


! setting the GPSRO names in the JOT tables


    SELECT CASE (Y_LIMBGRP_TABLE(J)%bufrsatid)  
    CASE (MMETOP_1)
    
      JOT(NLIMB)%jost(J)%sname(1:8) = 'METOP-1 '
      JOT(NLIMB)%jost(J)%sname(18:24) = 'SENSOR='              
      JOT(NLIMB)%jost(J)%sname(25:28) = 'GRAS'   
       
    CASE (MMETOP_2)
    
      JOT(NLIMB)%jost(J)%sname(1:8) = 'METOP-2 '
      JOT(NLIMB)%jost(J)%sname(18:24) = 'SENSOR='              
      JOT(NLIMB)%jost(J)%sname(25:28) = 'GRAS'   
       
    CASE (MMETOP_3)
    
      JOT(NLIMB)%jost(J)%sname(1:8) = 'METOP-3 '
      JOT(NLIMB)%jost(J)%sname(18:24) = 'SENSOR='              
      JOT(NLIMB)%jost(J)%sname(25:28) = 'GRAS'   

    CASE (MCHAMP)
      JOT(NLIMB)%jost(J)%sname(1:5)  = 'CHAMP'           

    CASE (MTERRASARX)
      JOT(NLIMB)%jost(J)%sname(1:10)  = 'TERRASAR-X'

    CASE (MGRACE_A)
      JOT(NLIMB)%jost(J)%sname(1:7)  = 'GRACE-A'           

    CASE (MGRACE_B)
      JOT(NLIMB)%jost(J)%sname(1:7)  = 'GRACE-B'           

    CASE (MCOSMIC_1)
      JOT(NLIMB)%jost(J)%sname(1:8)  = 'COSMIC-1'           

    CASE (MCOSMIC_2)
      JOT(NLIMB)%jost(J)%sname(1:8)  = 'COSMIC-2'           

    CASE (MCOSMIC_3)
      JOT(NLIMB)%jost(J)%sname(1:8)  = 'COSMIC-3'           

    CASE (MCOSMIC_4)
      JOT(NLIMB)%jost(J)%sname(1:8)  = 'COSMIC-4'           

    CASE (MCOSMIC_5)
      JOT(NLIMB)%jost(J)%sname(1:8)  = 'COSMIC-5'           

    CASE (MCOSMIC_6)
      JOT(NLIMB)%jost(J)%sname(1:8)  = 'COSMIC-6'           

    CASE DEFAULT 
      JOT(NLIMB)%jost(J)%sname(1:5)  = 'GPSRO'
    
    END SELECT    

  ENDIF

ENDDO
      
IF( NLIMBGRP > 0 ) THEN
  IF(ANY(Y_LIMBGRP_TABLE(:)%rtseries /= NMDI)) CALL RTL_SETUP
ENDIF

CALL GSTATS(1797,0)
CALL PUTDB('GETLIMBID', 0, IRET, INFO, 0, ZINFO, 0)
CALL GSTATS(1797,1)

!     1.6 PRINT the Y_LIMBGRP_TABLE

DO j=1,NLIMBGRP
  WRITE(IU,'(1x,2A,10(/A,I7))')&
   & ' JOT-sname: ',JOT(NLIMB)%jost(J)%sname,&
   & ' Y_LIMBGRP_TABLE%satgroup: ',  Y_LIMBGRP_TABLE(J)%satgroup,&
   & '                %codetype: ',  Y_LIMBGRP_TABLE(J)%codetype,&
   & '                %bufrsatid: ', Y_LIMBGRP_TABLE(J)%bufrsatid,&
   & '                %sensor: ',    Y_LIMBGRP_TABLE(J)%sensor,&
   & '                %rtid: ',      Y_LIMBGRP_TABLE(J)%rtid,&
   & '                %rtsubtype: ', Y_LIMBGRP_TABLE(J)%rtsubtype,&
   & '                %rtcoef_pos: ',Y_LIMBGRP_TABLE(J)%rtcoef_pos,&
   & '                %rtseries: ',  Y_LIMBGRP_TABLE(J)%rtseries,&
   & '                %nmxchan: ',   Y_LIMBGRP_TABLE(J)%nmxchan,&
   & '                %nlsat: ',     Y_LIMBGRP_TABLE(J)%nlsat
ENDDO

!     1.7 If bias correction needs to be specified, include it here



IF (LHOOK) CALL DR_HOOK('SULIMB',1,ZHOOK_HANDLE)

END SUBROUTINE SULIMB
