var/external/bufr/upds3.f

   1       SUBROUTINE UPDS3(MBAY,LCDS3,CDS3,NDS3)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    UPDS3
   6 C   PRGMMR: ATOR             ORG: NP12       DATE: 2003-11-04
   7 C
   8 C ABSTRACT: THIS SUBROUTINE UNPACKS AND RETURNS THE DESCRIPTORS
   9 C   CONTAINED WITHIN SECTION 3 OF A BUFR MESSAGE STORED IN ARRAY MBAY.
  10 C   THE START OF THE BUFR MESSAGE (I.E. THE STRING "BUFR") MUST BE
  11 C   ALIGNED ON THE FIRST FOUR BYTES OF MBAY.  NOTE ALSO THAT THIS
  12 C   SUBROUTINE DOES NOT RECURSIVELY RESOLVE SEQUENCE DESCRIPTORS THAT
  13 C   APPEAR WITHIN SECTION 3; RATHER, WHAT IS RETURNED IS THE EXACT LIST
  14 C   OF DESCRIPTORS AS IT APPEARS WITHIN SECTION 3.
  15 C
  16 C PROGRAM HISTORY LOG:
  17 C 2003-11-04  J. ATOR    -- ORIGINAL AUTHOR (WAS IN DECODER VERSION)
  18 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  19 C                           INTERDEPENDENCIES
  20 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF
  21 C 2004-08-18  J. ATOR    -- REMOVED IFIRST CHECK, SINCE WRDLEN NOW
  22 C                           KEEPS TRACK OF WHETHER IT HAS BEEN CALLED
  23 C 2005-11-29  J. ATOR    -- USE GETLENS
  24 C 2009-03-23  J. ATOR    -- ADDED LCDS3 ARGUMENT AND CHECK
  25 C
  26 C USAGE:    CALL UPDS3 (MBAY, LCDS3, CDS3, NDS3)
  27 C   INPUT ARGUMENT LIST:
  28 C     MBAY     - INTEGER: *-WORD PACKED BINARY ARRAY CONTAINING BUFR
  29 C                MESSAGE
  30 C     LCDS3    - INTEGER: DIMENSIONED SIZE (IN INTEGER WORDS) OF CDS3;
  31 C                USED BY THE SUBROUTINE TO ENSURE THAT IT DOES NOT
  32 C                OVERFLOW THE CDS3 ARRAY
  33 C
  34 C   OUTPUT ARGUMENT LIST:
  35 C     CDS3     - CHARACTER*6: *-WORD ARRAY CONTAINING UNPACKED LIST OF
  36 C                DESCRIPTORS (FIRST NDS3 WORDS FILLED)
  37 C     NDS3     - INTEGER: NUMBER OF DESCRIPTORS RETURNED
  38 C
  39 C REMARKS:
  40 C    THIS ROUTINE CALLS:        ADN30    BORT     IUPB     GETLENS
  41 C                               WRDLEN
  42 C    THIS ROUTINE IS CALLED BY: READS3
  43 C                               Also called by application programs.
  44 C
  45 C ATTRIBUTES:
  46 C   LANGUAGE: FORTRAN 77
  47 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  48 C
  49 C$$$
  50
  51       DIMENSION MBAY(*)
  52
  53       CHARACTER*6 CDS3(*), ADN30
  54
  55 C-----------------------------------------------------------------------
  56 C-----------------------------------------------------------------------
  57
  58 C     Call subroutine WRDLEN to initialize some important information
  59 C     about the local machine, just in case subroutine OPENBF hasn't
  60 C     been called yet.
  61
  62       CALL WRDLEN
  63
  64 C     Skip to the beginning of Section 3.
  65
  66       CALL GETLENS(MBAY,3,LEN0,LEN1,LEN2,LEN3,L4,L5)
  67       IPT = LEN0 + LEN1 + LEN2
  68
  69 C     Unpack the Section 3 descriptors.
  70
  71       NDS3 = 0
  72       DO JJ = 8,(LEN3-1),2
  73          NDS3 = NDS3 + 1
  74          IF(NDS3.GT.LCDS3) GOTO 900
  75          CDS3(NDS3) = ADN30(IUPB(MBAY,IPT+JJ,16),6)
  76       ENDDO
  77
  78       RETURN
  79 900   CALL BORT('BUFRLIB: UPDS3 - OVERFLOW OF OUTPUT DESCRIPTOR '//
  80      . 'ARRAY; TRY A LARGER DIMENSION FOR THIS ARRAY')
  81       END