SUBROUTINE AM_LVSQ ( iubfma, iubfmn, mainsq, iret ) C************************************************************************ C* AM_LVSQ * C* * C* This routine gets and stores the multi-level data. * C* * C* AM_LVSQ ( IUBFMA, IUBFMN, MAINSQ, IRET ) * C* * C* Input parameters: * C* IUBFMA INTEGER Logical unit number of messages * C* file for BUFR input stream * C* IUBFMN INTEGER Logical unit number of messages * C* file for BUFR output stream * C* MAINSQ INTEGER YYY value of main Table D * C* descriptor in Section 3 of * C* most recent BUFR message read * C* from input stream * C* * C* Output parameters: * C* IRET INTEGER Return code: * C* 0 = normal return * C* * C** * C* Log: * C* J. Ator/NCEP 02/14 * C* J. Ator/NCEP 12/14 Add special processing for mainsq=1 * C* J. Ator/NCEP 08/15 Add special processing for mainsq=2 * C* M. Weiss/IMSG 04/21 Add special processing for BABJ (China) * C* AMDAR reports using mainsq=99 * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'BRIDGE.PRM' INCLUDE 'amcmn.cmn' C* REAL*8 r8lvsq ( MXMN, MXLV ), r8wk ( MXMN, MXLV ) C* CHARACTER wkstr*30 C*----------------------------------------------------------------------- iret = 0 C C* Get and store the aircraft level data. C IF ( ( mainsq .eq. 7 ) .or. ( mainsq .eq. 9 ) ) THEN CALL UFBSEQ ( iubfma, r8wk, MXMN, MXLV, nlv, 'ACFTLALO' ) IF ( nlv .gt. 0 ) THEN DO jj = 1, nlv DO ii = 1, 8 r8lvsq (ii,jj) = r8wk (ii,jj) END DO END DO END IF ELSE IF ( ( mainsq .eq. 6 ) .or. ( mainsq .eq. 8 ) ) THEN CALL UFBSEQ ( iubfma, r8wk, MXMN, MXLV, nlv, 'AMDARNOL' ) IF ( nlv .gt. 0 ) THEN DO jj = 1, nlv r8lvsq (1,jj) = r8wk (1,jj) r8lvsq (2,jj) = r8bfms r8lvsq (3,jj) = r8bfms r8lvsq (4,jj) = r8wk (2,jj) r8lvsq (5,jj) = r8wk (3,jj) r8lvsq (6,jj) = r8wk (4,jj) r8lvsq (7,jj) = r8wk (5,jj) r8lvsq (8,jj) = r8wk (6,jj) END DO END IF ELSE IF ( mainsq .eq. 1 ) THEN wkstr = 'HMSL WDIR WSPD TMDBST' ELSE IF ( mainsq .eq. 2 ) THEN wkstr = 'IALT WDIR WSPD TMDBST' ELSE wkstr = 'FLVLST WDIR WSPD TMDB' END IF CALL UFBINT ( iubfma, r8wk, MXMN, MXLV, nlv, wkstr ) IF ( nlv .eq. 1 ) THEN r8lvsq (1,nlv) = r8wk (1,1) r8lvsq (2,nlv) = r8bfms r8lvsq (3,nlv) = r8bfms r8lvsq (4,nlv) = r8wk (2,1) r8lvsq (5,nlv) = r8wk (3,1) r8lvsq (6,nlv) = r8bfms r8lvsq (7,nlv) = r8wk (4,1) r8lvsq (8,nlv) = r8bfms END IF IF ( mainsq .eq. 99 ) THEN CALL UFBINT ( iubfma, r8wk, MXMN, MXLV, nlv, 'CLATH CLONH' ) IF ( nlv .eq. 1 ) THEN r8lvsq (2,nlv) = r8wk (1,1) r8lvsq (3,nlv) = r8wk (2,1) END IF END IF END IF C CALL UFBINT( iubfma, r8wk, MXMN, MXLV, nlv2, 'MIXR') DO jj = 1, nlv IF ( jj .le. nlv2 ) THEN r8lvsq (9,jj) = r8wk (1,jj) ELSE r8lvsq (9,jj) = r8bfms END IF END DO C IF ( nlv .gt. 0 ) THEN CALL DRFINI ( iubfmn, nlv, 1, '{ADRBLSEQ}') CALL UFBSEQ ( iubfmn, r8lvsq, MXMN, nlv, nlv2, 'ADRBLSEQ' ) END IF C* RETURN END