      SUBROUTINE STNDRD(LUNIT,MSGIN,LMSGOT,MSGOT)

C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    STNDRD
C   PRGMMR: ATOR             ORG: NP12       DATE: 2004-08-18
C
C ABSTRACT: THIS SUBROUTINE READS AN INPUT NCEP BUFR MESSAGE CONTAINED
C   WITHIN ARRAY MSGIN AND, USING THE BUFR TABLES INFORMATION ASSOCIATED
C   WITH LOGICAL UNIT LUNIT, OUTPUTS A "STANDARDIZED" VERSION OF THIS
C   SAME MESSAGE WITHIN ARRAY MSGOT.  THIS "STANDARDIZATION" INVOLVES
C   REMOVING ALL OCCURRENCES OF NCEP BUFRLIB-SPECIFIC BYTE COUNTERS AND
C   BIT PADS IN SECTION 4 AS WELL AS REPLACING THE TOP-LEVEL TABLE A FXY
C   NUMBER IN SECTION 3 WITH AN EQUIVALENT SEQUENCE OF LOWER-LEVEL
C   TABLE B, TABLE C, TABLE D AND/OR REPLICATION FXY NUMBERS WHICH
C   DIRECTLY CONSTITUTE THAT TABLE A FXY NUMBER AND WHICH THEMSELVES ARE
C   ALL WMO-STANDARD.  THE RESULT IS THAT THE OUTPUT MESSAGE IN MSGOT IS
C   NOW ENTIRELY COMPLIANT WITH WMO FM-94 BUFR REGULATIONS (I.E. IT IS
C   NOW "STANDARD"). IT IS IMPORTANT TO NOTE THAT THE SEQUENCE EXPANSION
C   WITHIN SECTION 3 MAY CAUSE THE FINAL "STANDARDIZED" BUFR MESSAGE TO
C   BE LONGER THAN THE ORIGINAL INPUT NCEP BUFR MESSAGE BY AS MANY AS
C   (MAXNC*2) BYTES (SEE 'bufrlib.prm' FOR AN EXPLANATION OF MAXNC), SO
C   THE USER MUST ALLOW FOR ENOUGH SPACE TO ACCOMODATE SUCH AN EXPANSION
C   WITHIN THE MSGOT ARRAY.
C
C PROGRAM HISTORY LOG:
C 2004-08-18  J. ATOR    -- ORIGINAL AUTHOR
C                           THIS SUBROUTINE IS MODELED AFTER SUBROUTINE
C                           STANDARD; HOWEVER, IT USES SUBROUTINE RESTD
C                           TO EXPAND SECTION 3 AS MANY LEVELS AS
C                           NECESSARY IN ORDER TO ATTAIN TRUE WMO
C                           STANDARDIZATION (WHEREAS STANDARD ONLY
C                           EXPANDED THE TOP-LEVEL TABLE A FXY NUMBER
C                           ONE LEVEL DEEP), AND IT ALSO CONTAINS AN
C                           EXTRA INPUT ARGUMENT LMSGOT WHICH PREVENTS
C                           OVERFLOW OF THE MSGOT ARRAY
C 2005-11-29  J. ATOR    -- USE GETLENS AND IUPBS01; ENSURE THAT BYTE 4
C                           OF SECTION 4 IS ZEROED OUT IN MSGOT; CHECK
C                           EDITION NUMBER OF BUFR MESSAGE BEFORE 
C                           PADDING TO AN EVEN BYTE COUNT
C 2009-03-23  J. ATOR    -- USE IUPBS3 AND NEMTBAX; DON'T ASSUME THAT
C                           COMPRESSED MESSAGES ARE ALREADY FULLY
C                           STANDARDIZED WITHIN SECTION 3
C
C USAGE:    CALL STNDRD (LUNIT, MSGIN, LMSGOT, MSGOT)
C   INPUT ARGUMENT LIST:
C     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
C     MSGIN    - INTEGER: *-WORD ARRAY CONTAINING BUFR MESSAGE IN NCEP
C                BUFR
C     LMSGOT   - INTEGER: DIMENSIONED SIZE (IN INTEGER WORDS) OF MSGOT;
C                USED BY THE SUBROUTINE TO ENSURE THAT IT DOES NOT
C                OVERFLOW THE MSGOT ARRAY
C
C   OUTPUT ARGUMENT LIST:
C     MSGOT    - INTEGER: *-WORD ARRAY CONTAINING INPUT BUFR MESSAGE
C                NOW IN STANDARDIZED BUFR
C
C REMARKS:
C    MSGIN AND MSGOT MUST BE SEPARATE ARRAYS.
C
C    THIS ROUTINE CALLS:        BORT     GETLENS  ISTDESC  IUPB
C                               IUPBS01  IUPBS3   MVB      NEMTBAX
C                               NUMTAB   PKB      PKC      RESTD
C                               STATUS   UPB      UPC
C    THIS ROUTINE IS CALLED BY: MSGWRT
C                               Also called by application programs.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 77
C   MACHINE:  PORTABLE TO ALL PLATFORMS
C
C$$$

      INCLUDE 'bufrlib.prm'

      DIMENSION ICD(MAXNC)

      COMMON /HRDWRD/ NBYTW,NBITW,IORD(8)

      DIMENSION MSGIN(*),MSGOT(*)

      CHARACTER*128 BORT_STR
      CHARACTER*8   SUBSET
      CHARACTER*4   SEVN
      CHARACTER*1   TAB

      LOGICAL FOUND

C-----------------------------------------------------------------------
C-----------------------------------------------------------------------

C  LUNIT MUST POINT TO AN OPEN BUFR FILE
C  -------------------------------------

      CALL STATUS(LUNIT,LUN,IL,IM)
      IF(IL.EQ.0) GOTO 900

C  IDENTIFY THE SECTION LENGTHS AND ADDRESSES IN MSGIN
C  ---------------------------------------------------

      CALL GETLENS(MSGIN,5,LEN0,LEN1,LEN2,LEN3,LEN4,LEN5)

      IAD3 = LEN0+LEN1+LEN2
      IAD4 = IAD3+LEN3

      LENN = LEN0+LEN1+LEN2+LEN3+LEN4+LEN5

      LENM = IUPBS01(MSGIN,'LENM')

      IF(LENN.NE.LENM) GOTO 901

      MBIT = (LENN-4)*8
      CALL UPC(SEVN,4,MSGIN,MBIT)
      IF(SEVN.NE.'7777') GOTO 902

C  COPY SECTIONS 0 THROUGH PART OF SECTION 3 INTO MSGOT
C  ----------------------------------------------------

      MXBYTO = (LMSGOT*NBYTW) - 8

      LBYTO = IAD3+7
      IF(LBYTO.GT.MXBYTO) GOTO 905
      CALL MVB(MSGIN,1,MSGOT,1,LBYTO)

C  REWRITE NEW SECTION 3 IN A "STANDARD" FORM
C  ------------------------------------------

C     LOCATE THE TOP-LEVEL TABLE A DESCRIPTOR

      FOUND = .FALSE.
      II = 10
      DO WHILE ((.NOT.FOUND).AND.(II.GE.8))
          ISUB = IUPB(MSGIN,IAD3+II,16)
          CALL NUMTAB(LUN,ISUB,SUBSET,TAB,ITAB)
          IF((ITAB.NE.0).AND.(TAB.EQ.'D')) THEN
              CALL NEMTBAX(LUN,SUBSET,MTYP,MSBT,INOD)
              IF(INOD.NE.0) FOUND = .TRUE.
          ENDIF
          II = II - 2
      ENDDO
      IF(.NOT.FOUND) GOTO 903

      IF (ISTDESC(ISUB).EQ.0) THEN

C         ISUB IS A NON-STANDARD TABLE A DESCRIPTOR AND NEEDS
C         TO BE EXPANDED INTO AN EQUIVALENT STANDARD SEQUENCE  

          CALL RESTD(LUN,ISUB,NCD,ICD)
      ELSE

C         ISUB IS ALREADY A STANDARD DESCRIPTOR, SO JUST COPY
C         IT "AS IS" INTO THE NEW SECTION 3 (I.E. NO EXPANSION
C         IS NECESSARY!)

          NCD = 1
          ICD(NCD) = ISUB
      ENDIF

C     USE THE EDITION NUMBER TO DETERMINE THE LENGTH OF THE
C     NEW SECTION 3

      LEN3 = 7+(NCD*2)
      IBEN = IUPBS01(MSGIN,'BEN')
      IF(IBEN.LT.4) THEN
          LEN3 = LEN3+1
      ENDIF
      LBYTO = LBYTO + LEN3 - 7
      IF(LBYTO.GT.MXBYTO) GOTO 905

C     STORE THE DESCRIPTORS INTO THE NEW SECTION 3

      IBIT = (IAD3+7)*8
      DO N=1,NCD
          CALL PKB(ICD(N),16,MSGOT,IBIT)
      ENDDO

C     DEPENDING ON THE EDITION NUMBER, PAD OUT THE NEW SECTION 3 WITH AN
C     ADDITIONAL ZEROED-OUT BYTE IN ORDER TO ENSURE AN EVEN BYTE COUNT

      IF(IBEN.LT.4) THEN
          CALL PKB(0,8,MSGOT,IBIT)
      ENDIF

C     STORE THE LENGTH OF THE NEW SECTION 3

      IBIT = IAD3*8
      CALL PKB(LEN3,24,MSGOT,IBIT)

C  NOW THE TRICKY PART - NEW SECTION 4
C  -----------------------------------

      IF(IUPBS3(MSGIN,'ICMP').EQ.1) THEN

C         THE DATA IN SECTION 4 IS COMPRESSED AND IS THEREFORE ALREADY
C         STANDARDIZED, SO COPY IT "AS IS" INTO THE NEW SECTION 4

          IF((LBYTO+LEN4+4).GT.MXBYTO) GOTO 905

          CALL MVB(MSGIN,IAD4+1,MSGOT,LBYTO+1,LEN4)

          JBIT = (LBYTO+LEN4)*8

      ELSE

          NAD4 = IAD3+LEN3

          IBIT = (IAD4+4)*8
          JBIT = (NAD4+4)*8

          LBYTO = LBYTO + 4

C         COPY THE SUBSETS, MINUS THE BYTE COUNTERS AND BIT PADS, INTO
C         THE NEW SECTION 4

          NSUB = IUPBS3(MSGIN,'NSUB')

          DO 10 I=1,NSUB
              CALL UPB(LSUB,16,MSGIN,IBIT)
              DO L=1,LSUB-2
                  CALL UPB(NVAL,8,MSGIN,IBIT)
                  LBYTO = LBYTO + 1
                  IF(LBYTO.GT.MXBYTO) GOTO 905
                  CALL PKB(NVAL,8,MSGOT,JBIT)
              ENDDO
              DO K=1,8
                  KBIT = IBIT-K-8
                  CALL UPB(KVAL,8,MSGIN,KBIT)
                  IF(KVAL.EQ.K) THEN
                     JBIT = JBIT-K-8
                     GOTO 10
                  ENDIF
              ENDDO
              GOTO 904
10        ENDDO

C         FROM THIS POINT ON, WE WILL NEED (AT MOST) 6 MORE BYTES OF
C         SPACE WITHIN MSGOT IN ORDER TO BE ABLE TO STORE THE ENTIRE
C         STANDARDIZED MESSAGE (I.E. WE WILL NEED (AT MOST) 2 MORE
C         ZEROED-OUT BYTES IN SECTION 4 PLUS THE 4 BYTES '7777' IN
C         SECTION 5), SO DO A FINAL MSGOT OVERFLOW CHECK NOW.

          IF(LBYTO+6.GT.MXBYTO) GOTO 905

C         PAD THE NEW SECTION 4 WITH ZEROES UP TO THE NEXT WHOLE BYTE
C         BOUNDARY.

          DO WHILE(.NOT.(MOD(JBIT,8).EQ.0))
             CALL PKB(0,1,MSGOT,JBIT)
          ENDDO

C         DEPENDING ON THE EDITION NUMBER, WE MAY NEED TO FURTHER PAD
C         THE NEW SECTION 4 WITH AN ADDITIONAL ZEROED-OUT BYTE IN ORDER
C         TO ENSURE THAT THE PADDING IS UP TO AN EVEN BYTE BOUNDARY.

          IF( (IBEN.LT.4) .AND. (MOD(JBIT/8,2).NE.0) ) THEN
             CALL PKB(0,8,MSGOT,JBIT)
          ENDIF

          IBIT = NAD4*8
          LEN4 = JBIT/8 - NAD4
          CALL PKB(LEN4,24,MSGOT,IBIT)
          CALL PKB(0,8,MSGOT,IBIT)
      ENDIF

C  FINISH THE NEW MESSAGE WITH AN UPDATED SECTION 0 BYTE COUNT
C  -----------------------------------------------------------

      IBIT = 32
      LENN = LEN0+LEN1+LEN2+LEN3+LEN4+LEN5
      CALL PKB(LENN,24,MSGOT,IBIT)

      CALL PKC('7777',4,MSGOT,JBIT)

C  EXITS
C  -----

      RETURN
900   CALL BORT('BUFRLIB: STNDRD - BUFR FILE IS CLOSED, IT MUST BE'//
     . ' OPEN')
901   WRITE(BORT_STR,'("BUFRLIB: STNDRD - INPUT MESSAGE LENGTH FROM'//
     . ' SECTION 0",I6," DOES NOT EQUAL SUM OF ALL INDIVIDUAL SECTION'//
     . ' LENGTHS (",I6,")")') LENM,LENN
      CALL BORT(BORT_STR)
902   WRITE(BORT_STR,'("BUFRLIB: STNDRD - INPUT MESSAGE DOES NOT '//
     . 'END WITH ""7777"" (ENDS WITH ",A)') SEVN
      CALL BORT(BORT_STR)
903   CALL BORT('BUFRLIB: STNDRD - TABLE A SUBSET DESCRIPTOR '//
     . 'NOT FOUND')
904   CALL BORT('BUFRLIB: STNDRD - BIT MISMATCH COPYING SECTION 4 '//
     . 'FROM INPUT TO OUTPUT (STANDARD) MESSAGE')
905   CALL BORT('BUFRLIB: STNDRD - OVERFLOW OF OUTPUT (STANDARD) '//
     . 'MESSAGE ARRAY; TRY A LARGER DIMENSION FOR THIS ARRAY')
      END
