C  =====================================================================
C  pgm: SHDECB .. Decode shef .B format messages
C
C  use:     CALL SHDECB(KHAR,KHPOS,IREV,ICONT,QUO)
C
C  i/o: KHAR ...... last buffer char obtained - CHAR*1
C  i/o: KHPOS ..... last char loc: 2=eol,1=err-eol,0=eof,neg=err - INT
C   in: IREV ...... revision code (0 = no, 1 = yes) - INT
C   in: ICONT ..... continuation code (0 = no, 1 = yes) - INT
C   in: QUO ....... string for quotes, only carried thru this rtn in
C   in:             order to define its size in one place - CHAR*(*)
C
C  rqd: SH2BEG,SH2ST2,SHDOTB,SHERR,SHGETK,SHPCOD,SHPDEC,SHPOS
C  rqd: SHTYPA,SHSAVQ,SHSAVD,SHSAVI,SHSAVK,SHSAVL,SHSAVM,SHSAVP
C  rqd: SHSAVJ,SHSAVN,SHSAVA,SHSAVS
C
C  cmt: Hardwired for 200 fields (in stmt comparing "MREC .GE. 200").
C  =====================================================================
      SUBROUTINE SHDECB(KHAR,KHPOS,IREV,ICONT,QUO)

      EXTERNAL       SH2BEG,SH2ST2,SHDOTB,SHERR,SHGETK,SHSAVA,SHSAVS
      EXTERNAL       SHPCOD,SHPDEC,SHPOS,SHTYPA,SHSAVQ,SHSAVJ,SHSAVN
      EXTERNAL       SHSAVD,SHSAVI,SHSAVK,SHSAVL,SHSAVM,SHSAVP

      CHARACTER*1    KHAR,KKK
      CHARACTER*8    KHWRD,PARCOD,JKHID,PPP
      CHARACTER*(*)  QUO
      REAL           CODP
      INTEGER        KHPOS,IREV,ICONT,MREC,NOC,III

      SAVE           JKHID,MREC,CODP
C
C    ================================= RCS keyword statements ==========
      CHARACTER*68     RCSKW1,RCSKW2
      DATA             RCSKW1,RCSKW2 /                                 '
     .$Source: /fs/hseb/ob5/rfc/ofs/src/shefpars_driv/RCS/shdecb.f,v $
     . $',                                                             '
     .$Id: shdecb.f,v 1.6 2000/03/17 19:58:12 dws Exp $
     . $' /
C    ===================================================================
C

C                   If first line messg, set defaults, get pos data

      IF (ICONT .EQ. 0) THEN
        CALL SHSAVK('I',III,III,III,III,III,III,III)
        CALL SHSAVM('I',III,III,III,III,III,III,III,III)
        CALL SHSAVQ('I',III,KKK)
        CALL SHSAVD('I',III,III)
        CALL SHSAVI('I',III,III)
        CALL SHSAVP('I',III,PPP)
         MREC   = 0
        CALL SHPOS(KHAR,KHPOS,JKHID)
      ENDIF

C                   Get the date and data type elements, parameter code

   30 IF (KHPOS .LE. 2) GOTO 34

        CALL SHTYPA(KHAR,KHPOS)
        CALL SHPCOD(KHAR,KHPOS)
        CALL SHPDEC(KHAR,KHPOS,CODP)

C                   Save data for next field using "SHSAV" rtns

        CALL SHSAVP('G',III,PARCOD)
        IF (KHPOS.GT.2 .OR. PARCOD.NE.'        ') THEN
            IF (PARCOD .EQ. '        ') THEN
              CALL SHERR('E',50,KHPOS,KHAR)
            ELSEIF (KHPOS .NE. 1) THEN
              IF (MREC .GE. 200) THEN
                CALL SHERR('E',40,KHPOS,KHAR)
              ELSE
                MREC = MREC+1
                CALL SHSAVP('S',MREC,PPP)
                CALL SHSAVL('S',MREC,III,III,III,III,III,III)
                CALL SHSAVK('S',MREC,III,III,III,III,III,III)
                CALL SHSAVM('S',MREC,III,III,III,III,III,III,III)
                CALL SHSAVA('S',MREC,III)
                CALL SHSAVS('S',MREC,III)
                CALL SHSAVN('S',MREC,III)
                CALL SHSAVJ('S',MREC,III)
                CALL SHSAVD('S',MREC,III)
                CALL SHSAVI('S',MREC,III)
                CALL SHSAVQ('S',MREC,KKK)
              ENDIF

              CALL SHSAVP('I',III,PPP)
            ENDIF

            IF (KHAR .EQ. '/') THEN
              CALL SHGETK(KHAR,KHPOS)
            ELSEIF (KHPOS .GT. 2) THEN
              CALL SHERR('E',33,KHPOS,KHAR)
            ENDIF
        ENDIF

        GOTO 30
   34 CONTINUE

C                   Check next line to see if it contains body data

      IF (KHPOS .NE. 1) THEN
        CALL SH2BEG(KHAR,KHPOS)

        IF (KHPOS .EQ. 0) THEN
          CALL SHERR('W',46,KHPOS,KHAR)
        ELSEIF (MREC.GT.0 .AND. KHPOS.GT.0 .AND. KHAR.NE.'.') THEN
          CALL SHDOTB(KHAR,KHPOS,MREC,IREV,JKHID,QUO)

C                   If KHPOS=0 then eof, else have dot line so see
C                   if ".END" otherwise the ".END" line is missing.
C                   This is a fatal error if we have a dot line
C                   with a continuation code, else just a warning.

          IF (KHPOS .EQ. 0) THEN
            CALL SHERR('W',46,KHPOS,KHAR)
          ELSEIF (KHPOS .GT. 1) THEN
            CALL SHGETK(KHAR,KHPOS)
            CALL SH2ST2(KHAR,KHPOS,NOC,KHWRD)
            IF (KHWRD .EQ. 'END     ') THEN
              KHPOS = 2
              KHAR  = ':'
            ELSEIF (KHWRD(1:1).EQ.'B' .AND. KHWRD(2:2).NE.' ') THEN
              CALL SHERR('E',46,KHPOS,KHAR)
            ELSE
              CALL SHERR('W',46,KHPOS,KHAR)
              KHPOS = 3
              CALL SHGETK(KHAR,KHPOS)
            ENDIF
          ENDIF

        ELSEIF (MREC.EQ.0 .AND. KHAR.NE.'.') THEN
            CALL SHERR('W',82,KHPOS,KHAR)

        ENDIF
      ENDIF

      RETURN
      END