SUBROUTINE UPDS3(MBAY,LCDS3,CDS3,NDS3) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C C SUBPROGRAM: UPDS3 C PRGMMR: ATOR ORG: NP12 DATE: 2003-11-04 C C ABSTRACT: THIS SUBROUTINE UNPACKS AND RETURNS THE DESCRIPTORS C CONTAINED WITHIN SECTION 3 OF A BUFR MESSAGE STORED IN ARRAY MBAY. C THE START OF THE BUFR MESSAGE (I.E. THE STRING "BUFR") MUST BE C ALIGNED ON THE FIRST FOUR BYTES OF MBAY. NOTE ALSO THAT THIS C SUBROUTINE DOES NOT RECURSIVELY RESOLVE SEQUENCE DESCRIPTORS THAT C APPEAR WITHIN SECTION 3; RATHER, WHAT IS RETURNED IS THE EXACT LIST C OF DESCRIPTORS AS IT APPEARS WITHIN SECTION 3. C C PROGRAM HISTORY LOG: C 2003-11-04 J. ATOR -- ORIGINAL AUTHOR (WAS IN DECODER VERSION) C 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE C INTERDEPENDENCIES C 2003-11-04 D. KEYSER -- UNIFIED/PORTABLE FOR WRF C 2004-08-18 J. ATOR -- REMOVED IFIRST CHECK, SINCE WRDLEN NOW C KEEPS TRACK OF WHETHER IT HAS BEEN CALLED C 2005-11-29 J. ATOR -- USE GETLENS C 2009-03-23 J. ATOR -- ADDED LCDS3 ARGUMENT AND CHECK C C USAGE: CALL UPDS3 (MBAY, LCDS3, CDS3, NDS3) C INPUT ARGUMENT LIST: C MBAY - INTEGER: *-WORD PACKED BINARY ARRAY CONTAINING BUFR C MESSAGE C LCDS3 - INTEGER: DIMENSIONED SIZE (IN INTEGER WORDS) OF CDS3; C USED BY THE SUBROUTINE TO ENSURE THAT IT DOES NOT C OVERFLOW THE CDS3 ARRAY C C OUTPUT ARGUMENT LIST: C CDS3 - CHARACTER*6: *-WORD ARRAY CONTAINING UNPACKED LIST OF C DESCRIPTORS (FIRST NDS3 WORDS FILLED) C NDS3 - INTEGER: NUMBER OF DESCRIPTORS RETURNED C C REMARKS: C THIS ROUTINE CALLS: ADN30 BORT IUPB GETLENS C WRDLEN C THIS ROUTINE IS CALLED BY: READS3 C Also called by application programs. C C ATTRIBUTES: C LANGUAGE: FORTRAN 77 C MACHINE: PORTABLE TO ALL PLATFORMS C C$$$ DIMENSION MBAY(*) CHARACTER*6 CDS3(*), ADN30 C----------------------------------------------------------------------- C----------------------------------------------------------------------- C Call subroutine WRDLEN to initialize some important information C about the local machine, just in case subroutine OPENBF hasn't C been called yet. CALL WRDLEN C Skip to the beginning of Section 3. CALL GETLENS(MBAY,3,LEN0,LEN1,LEN2,LEN3,L4,L5) IPT = LEN0 + LEN1 + LEN2 C Unpack the Section 3 descriptors. NDS3 = 0 DO JJ = 8,(LEN3-1),2 NDS3 = NDS3 + 1 IF(NDS3.GT.LCDS3) GOTO 900 CDS3(NDS3) = ADN30(IUPB(MBAY,IPT+JJ,16),6) ENDDO RETURN 900 CALL BORT('BUFRLIB: UPDS3 - OVERFLOW OF OUTPUT DESCRIPTOR '// . 'ARRAY; TRY A LARGER DIMENSION FOR THIS ARRAY') END