SUBROUTINE CAVISO( KSY , KAI , KSB , KDR , KTP , KPL , KST )
!-----------------------------------------------------------------------
!   CAVISO : Visualisation des observations
!   ------
!     auteur       : Ph. Caille   01/92
!     modification : Ph. Caille   04/96  passage du CMAFOC au CMAFOC
!                    F. Taillefer 09/00  passage du CMAFOC a ODB (CY23)
!-----------------------------------------------------------------------

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

USE YOMCT0   , ONLY : LELAM
USE PARDIMO  , ONLY : JPNOTP
USE YOMANCS  , ONLY : NMDI     ,RMDI     ,RDEGREES
USE YOMCST   , ONLY : RG
USE YOMDIMO  , ONLY : NOBTOT
USE YOMLUN   , ONLY : NULOUT
USE YOMDB
USE YOMOBA   , ONLY : MNBOTP
USE YOMCOCTP , ONLY : NAIREP   
USE YOMVNMB  , ONLY : NVNUMB
USE QAKEKI   , ONLY : NDBPAF   ,NDBPACQ  ,NDBPAACQ ,NDBPAAU  ,&
 & NCQFCO   ,NCQFPC   ,NCQFPI   ,NCQFIN   ,NCQECO   ,&
 & NCQEPC   ,NCQEPI   ,NCQEIN   ,NCQKCO   ,NCQKPC   ,&
 & NCQKPI   ,NCQKIN   ,NCLNCO   ,NCLNPC   ,NCLNPI   ,&
 & NCLNIN   ,NCUPS    ,NCUUVT   ,NCUHU    ,NCUT2M   ,&
 & NCUH2M   ,NCUV10   ,NCUSN    ,NCUSST  

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KSY 
INTEGER(KIND=JPIM),INTENT(IN)    :: KAI 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSB 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDR 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPL 
INTEGER(KIND=JPIM)               :: KST ! UNDETERMINED INTENT
CHARACTER :: CLINDIC*8,CLOCOT*132,CLEBLAN*132
CHARACTER :: CLWAG1*3,CLWAG2*4,CLWAG3*19,CLWAG4*8,CLWAG5(3)*9
CHARACTER :: CLWAG6(3)*10,CLWAG7(2)*7,CLWAG8(2)*10
INTEGER(KIND=JPIM) :: IOBS(JPNOTP),ICQW(16),ICQU(8)
REAL(KIND=JPRB) :: ZVAL(10)

INTEGER(KIND=JPIM) :: IBODY, IBOX, ICQ, ID, IDAT, IETM, IFLG, IN, &
 & IRET, INFO(1), INBWAG, INLV, IONM, IOTP, IPHV, IRDFL, ISYN, IVNM, &
 & J1, J2, J3, JCQ, JVAL, IOCH_CDT, IOCH_INS, IOCH_RTR
REAL(KIND=JPRB) :: ZLAT, ZLON, ZMULTI, ZONM, ZINFO(1)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "openmp_obs.h"

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

IF (LHOOK) CALL DR_HOOK('CAVISO',0,ZHOOK_HANDLE)
CLEBLAN(  1: 40) = '                                        '
CLEBLAN( 41: 80) = '                                        '
CLEBLAN( 81:132) = '                                          '

IOBS( 1) = KSY
IOBS( 2) = KAI
IOBS( 3) = KSB
IOBS( 4) = KDR
IOBS( 5) = KTP
IOBS( 6) = KPL
IOBS( 7) = KST
IOBS( 8) = 0
IOBS( 9) = 0
IOBS(10) = 0

ZMULTI = 100000.

WRITE (NULOUT,201)

CALL GETDB('CAVISO', 0, IRET, INFO, 0, ZINFO, 0, KST, -1, -1, -1, -1, -1)

!-----------------------------------------------------------------------
!  - 1 -  Impressions
!         -----------

DO J1=1,JPNOTP
  IF (IOBS(J1)<0 .OR. IOBS(J1)>MNBOTP(J1)) IOBS(J1) = MNBOTP(J1)
ENDDO

!  boucle sur les types d'observations
DO J1 = 1,JPNOTP
  IF ( IOBS(J1) == 0 ) CYCLE
  WRITE (NULOUT,202) J1

!  boucle sur les observations
  IN=0
  DO J2 = 1,NOBTOT
    IF (IN >= IOBS(J1)) CYCLE
    IN = IN+1
    IOTP = ROBHDR(J2,MDBOTP)
    IF (IOTP /= J1) CYCLE

    CLINDIC = '99999999'

    IF (LELAM.AND.ROBHDR(J2,MDBTLA) == RMDI) CYCLE

    INBWAG = MLNKH2B(J2+1)-MLNKH2B(J2)

    CLINDIC = TRANSFER(ROBHDR(J2,MDBSID),CLINDIC)

    CLOCOT = CLEBLAN

!  impression de la locomotive
    CLOCOT(1:5)  = 'Loco '

    IF ( ROBHDR(J2,MDBONM) == RMDI .OR. &
       & ROBHDR(J2,MDBONM) == REAL(NMDI) ) THEN  
      CLOCOT(6:16) = '     ---   '
    ELSE
      ZONM = MOD( ROBHDR(J2,MDBONM) , ZMULTI )
      IONM = INT(ZONM)
      WRITE (CLOCOT(6:16),'(I11)') IONM
    ENDIF

    IBOX = ROBHDR(J2,MDBBOX)

    IF ( IBOX == NMDI ) THEN
      CLOCOT(17:20) = ' ---'
    ELSE
      WRITE (CLOCOT(17:20),'(I4)') IBOX
    ENDIF

    IF ( IOTP == NMDI ) THEN
      CLOCOT(21:24) = ' ---'
    ELSE
      WRITE (CLOCOT(21:23),'(I3)') IOTP
    ENDIF

    CLOCOT(25:37) = '             '
    IOCH_CDT = ROBHDR(J2,MDB_CODETYPE_AT_HDR)
    IOCH_INS = ROBHDR(J2,MDB_INSTTYPE_AT_HDR)
    IOCH_RTR = ROBHDR(J2,MDB_RETRTYPE_AT_HDR)

    WRITE (CLOCOT(34:36),'(I3)') IOCH_CDT
    IF ( IOTP == NAIREP ) THEN
      ISYN = KBITLU(IOCH_INS,11,5)
      IPHV = KBITLU(IOCH_INS,16,5)
      WRITE (CLOCOT(30:30),'(I1)') IPHV
      WRITE (CLOCOT(32:32),'(I1)') ISYN
    ELSE
      WRITE (CLOCOT(30:32),'(I3)') IOCH_INS
    ENDIF
    WRITE (CLOCOT(28:28),'(I1)') IOCH_RTR

    IF ( ROBHDR(J2,MDBLAT) == RMDI ) THEN
      CLOCOT(37:43) = '  ---  '
    ELSE
      ZLAT = ROBHDR(J2,MDBLAT) * RDEGREES
      WRITE (CLOCOT(37:43),'(F7.2)') ZLAT
    ENDIF

    IF ( ROBHDR(J2,MDBLON) == RMDI ) THEN
      CLOCOT(44:51) = '   ---  '
    ELSE
      ZLON = ROBHDR(J2,MDBLON) * RDEGREES
      WRITE (CLOCOT(44:51),'(F8.2)') ZLON
    ENDIF

    IDAT = ROBHDR(J2,MDBDAT)

    IF ( IDAT == NMDI ) THEN
      CLOCOT(52:60) = '   ---   '
    ELSE
      WRITE (CLOCOT(52:60),'(I9)') IDAT
    ENDIF

    IETM = ROBHDR(J2,MDBETM)

    IF ( IETM == NMDI ) THEN
      CLOCOT(61:67) = '   --- '
    ELSE
      WRITE (CLOCOT(61:67),'(I7)') IETM
    ENDIF

    IF ( CLINDIC == '99999999' ) THEN
      CLOCOT(69:76) = '   ---   '
    ELSE
      CLOCOT(69:76) = CLINDIC
    ENDIF

    IF ( ROBHDR(J2,MDBALT) == RMDI ) THEN
      CLOCOT(77:82) = '  --- '
    ELSE
      WRITE (CLOCOT(77:82),'(F6.0)') ROBHDR(J2,MDBALT)
    ENDIF

    INLV = INBWAG

    IF ( INLV == NMDI ) THEN
      CLOCOT(83:86) = ' ---'
    ELSE
      WRITE (CLOCOT(83:86),'(I4)') INLV
    ENDIF

    WRITE (NULOUT,203) J2,CLOCOT
    WRITE (NULOUT,204)

!  impression des wagons
    DO J3 = 1 , INBWAG
      IBODY = MLNKH2B(J2)+J3-1

      CLWAG1 = ' - '
      CLWAG2 = ' -- '
      CLWAG3 = ' --   --   --   -- '
      CLWAG4 = '  ----  '
      CLWAG5 = '   ---   '
      CLWAG6 = '     ---  '
      CLWAG7 = '  ---  '
      CLWAG8 = '     ---  '
      ICQU   = -1
      ICQW   = -1

      IVNM     = ROBODY(IBODY,MDBVNM)
      IRDFL    = ROBODY(IBODY,MDBRDFL)
      IFLG     = ROBODY(IBODY,MDBFLG)
      ZVAL( 1) = ROBODY(IBODY,MDBPPP)
      ZVAL( 2) = ROBODY(IBODY,MDBPRL)
      ZVAL( 3) = ROBODY(IBODY,MDBRBPIO)
      ZVAL( 4) = ROBODY(IBODY,MDBVAR)
      ZVAL( 5) = ROBODY(IBODY,MDBOMF)
      ZVAL( 6) = ROBODY(IBODY,MDBOMN)
      ZVAL( 7) = ROBODY(IBODY,MDBFOE)
      ZVAL( 8) = ROBODY(IBODY,MDBFGE)
      ZVAL( 9) = ROBODY(IBODY,MDB_QC_PGE)
      ZVAL(10) = ROBODY(IBODY,MDB_QC_L)

      IF ( IVNM == NVNUMB(3) .OR. IVNM == NVNUMB(4) ) THEN
        IF ( ZVAL(5) /= RMDI ) ZVAL(5) = ZVAL(5) / RG
        IF ( ZVAL(6) /= RMDI ) ZVAL(6) = ZVAL(6) / RG
        IF ( ZVAL(7) /= RMDI ) ZVAL(7) = ZVAL(7) / RG
        IF ( ZVAL(8) /= RMDI ) ZVAL(8) = ZVAL(8) / RG
      ENDIF

      IF ( IVNM == NMDI ) THEN
        CLWAG1 = ' - '
      ELSE
        WRITE (CLWAG1,'(I3)') IVNM
      ENDIF

      IF ( IRDFL == NMDI ) THEN
        CLWAG2 = ' ---'
      ELSE
        ICQW( 1) = KBITLU(IRDFL,NDBPAF,1)
        ICQW( 2) = KBITLU(IRDFL,NDBPACQ,1)
        ICQW( 3) = KBITLU(IRDFL,NDBPAACQ,1)
        ICQW( 4) = KBITLU(IRDFL,NDBPAAU,1)
        DO JCQ=1,4
          WRITE (CLWAG2(JCQ:JCQ),'(I1)') ICQW(JCQ)
        ENDDO
      ENDIF

      IF ( IFLG == NMDI ) THEN
        CLWAG3 = '        ---        '
      ELSE
        ICQW( 1) = KBITLU(IFLG,NCQFCO,1)
        ICQW( 2) = KBITLU(IFLG,NCQFPC,1)
        ICQW( 3) = KBITLU(IFLG,NCQFPI,1)
        ICQW( 4) = KBITLU(IFLG,NCQFIN,1)
        ICQW( 5) = KBITLU(IFLG,NCQKCO,1)
        ICQW( 6) = KBITLU(IFLG,NCQKPC,1)
        ICQW( 7) = KBITLU(IFLG,NCQKPI,1)
        ICQW( 8) = KBITLU(IFLG,NCQKIN,1)
        ICQW( 9) = KBITLU(IFLG,NCQECO,1)
        ICQW(10) = KBITLU(IFLG,NCQEPC,1)
        ICQW(11) = KBITLU(IFLG,NCQEPI,1)
        ICQW(12) = KBITLU(IFLG,NCQEIN,1)
        ICQW(13) = KBITLU(IFLG,NCLNCO,1)
        ICQW(14) = KBITLU(IFLG,NCLNPC,1)
        ICQW(15) = KBITLU(IFLG,NCLNPI,1)
        ICQW(16) = KBITLU(IFLG,NCLNIN,1)

        DO JCQ=1,4
          ID  = (JCQ-1)*5
          ICQ = (JCQ-1)*4
          IF (ID > 0) CLWAG3(ID:ID) = ' '
          WRITE (CLWAG3(ID+1:ID+1),'(I1)') ICQW(ICQ+1)
          WRITE (CLWAG3(ID+2:ID+2),'(I1)') ICQW(ICQ+2)
          WRITE (CLWAG3(ID+3:ID+3),'(I1)') ICQW(ICQ+3)
          WRITE (CLWAG3(ID+4:ID+4),'(I1)') ICQW(ICQ+4)
        ENDDO

      ENDIF

      IF ( IFLG == NMDI ) THEN
        CLWAG4 = '   ---  '
      ELSE
        ICQU( 1) = KBITLU(IFLG,NCUPS ,1)
        ICQU( 2) = KBITLU(IFLG,NCUUVT,1)
        ICQU( 3) = KBITLU(IFLG,NCUHU ,1)
        ICQU( 4) = KBITLU(IFLG,NCUT2M,1)
        ICQU( 5) = KBITLU(IFLG,NCUH2M,1)
        ICQU( 6) = KBITLU(IFLG,NCUV10,1)
        ICQU( 7) = KBITLU(IFLG,NCUSN ,1)
        ICQU( 8) = KBITLU(IFLG,NCUSST,1)

        DO JCQ=1,8
          WRITE (CLWAG4(JCQ:JCQ),'(I1)') ICQU(JCQ)
        ENDDO

      ENDIF

      DO JVAL = 1 , 3
        IF ( ZVAL(JVAL) /= RMDI ) WRITE (CLWAG5(JVAL),'(F9.1)') ZVAL(JVAL)
      ENDDO

      DO JVAL = 1 , 3
        IF ( ZVAL(JVAL+3) /= RMDI )&
         & WRITE (CLWAG6(JVAL),'(F10.2)') ZVAL(JVAL+3)
      ENDDO

      IF ( ZVAL(7) /= RMDI ) WRITE (CLWAG7(1),'(F7.2)') ZVAL(7)
      IF ( ZVAL(8) /= RMDI ) WRITE (CLWAG7(2),'(F7.2)') ZVAL(8)

      IF ( ZVAL( 9) /= RMDI ) WRITE (CLWAG8(1),'(F10.2)') ZVAL( 9)
      IF ( ZVAL(10) /= RMDI ) WRITE (CLWAG8(2),'(F10.2)') ZVAL(10)

      WRITE (NULOUT,205) CLWAG1,CLWAG2,CLWAG3,CLWAG4,&
       & CLWAG5,CLWAG6,CLWAG7,CLWAG8

    ENDDO

    WRITE (NULOUT,*) ' '
  ENDDO

ENDDO

WRITE (NULOUT,206)

CALL PUTDB('CAVISO', 0, IRET, INFO, 0, ZINFO, 0)

!--------------------------------------------------------------------------
!  - 2 -  Formats
!         -------

201 FORMAT(/,6X,25('*'),/,6X,'*    Debut de CAVISO    *',/,6X,25('*'),/)
202 FORMAT(/,' *********************************** ',/,&
 & ' *   Type d''observation numero ',I1,'   * ',/,&
 & ' *********************************** ',/)
203 FORMAT(11X,'Observation numero ',I4,//,11X,'ONM   BOX OTP ----OC',&
 & 'H----   LAT     LON     DAT     ETM    SID     ALT   NLV',&
 & /,A132,/)
204 FORMAT('VNM RDFL fina cq K cq E lino cod.uti.   PPP      PRL    ',&
 & '  PIO        VAR       OMF       OMN    FOE    FGE      ',&
 & 'FGC1      FGC2 ')
205 FORMAT(A3,1X,A4,1X,A19,1X,A8,3A9,3A10,2A7,2A10)
206 FORMAT(/,6X,23('*'),/,6X,'*    Fin de CAVISO    *',/,6X,23('*'),/)

!-----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('CAVISO',1,ZHOOK_HANDLE)
END SUBROUTINE CAVISO
