NCEPLIBS-bufr  11.7.0
 All Data Structures Files Functions Variables Pages
cpdxmm.f
Go to the documentation of this file.
1 C> @file
2 C> Read embedded DX BUFR table into internal arrays.
3 
4 C> This subroutine reads an entire DX BUFR table from a specified
5 C> file into internal arrays.
6 C>
7 C> @author J. Ator
8 C> @date 2009-03-23
9 C>
10 C> @param[in] LUNIT -- integer: Fortran logical unit number for BUFR
11 C> file
12 C>
13 C> <b>Program history log:</b>
14 C> | Date | Programmer | Comments |
15 C> | -----|------------|----------|
16 C> | 2009-03-23 | J. Ator | Original author |
17 C> | 2012-09-15 | J. Woollen | Modified for C/I/O/BUFR interface; replace Fortran BACKSPACE with C backbufr() |
18 C> | 2014-12-10 | J. Ator | Use modules instead of COMMON blocks |
19 C>
20  SUBROUTINE cpdxmm( LUNIT )
21 
22  USE moda_mgwa
23  USE moda_msgmem
24 
25  COMMON /quiet/ iprt
26 
27  character*128 errstr
28 
29  LOGICAL done
30 
31 C-----------------------------------------------------------------------
32 C-----------------------------------------------------------------------
33 
34  IF ( ndxts .GE. mxdxts ) goto 900
35 
36  ict = 0
37  done = .false.
38  CALL status(lunit,lun,il,im)
39 
40 C Read a complete dictionary table from LUNIT, as a set of one or
41 C more DX dictionary messages.
42 
43  DO WHILE ( .NOT. done )
44  CALL rdmsgw( lunit, mgwa, ier )
45  IF ( ier .EQ. -1 ) THEN
46 
47 C Don't abort for an end-of-file condition, since it may be
48 C possible for a file to end with dictionary messages.
49 C Instead, backspace the file pointer and let the calling
50 C routine diagnose the end-of-file condition and deal with
51 C it as it sees fit.
52 
53  CALL backbufr(lun)
54  done = .true.
55  ELSE IF ( ier .EQ. -2 ) THEN
56  goto 901
57  ELSE IF ( idxmsg(mgwa) .NE. 1 ) THEN
58 
59 C This is a non-DX dictionary message. Assume we've reached
60 C the end of the dictionary table, and backspace LUNIT so that
61 C the next read (e.g. in the calling routine) will get this
62 C same message.
63 
64  CALL backbufr(lun)
65  done = .true.
66  ELSE IF ( iupbs3(mgwa,'NSUB') .EQ. 0 ) THEN
67 
68 C This is a DX dictionary message, but it doesn't contain any
69 C actual dictionary information. Assume we've reached the end
70 C of the dictionary table.
71 
72  done = .true.
73  ELSE
74 
75 C Store this message into MODULE MSGMEM.
76 
77  ict = ict + 1
78  IF ( ( ndxm + ict ) .GT. mxdxm ) goto 902
79  ipdxm(ndxm+ict) = ldxm + 1
80  lmem = nmwrd(mgwa)
81  IF ( ( ldxm + lmem ) .GT. mxdxw ) goto 903
82  DO j = 1, lmem
83  mdx(ldxm+j) = mgwa(j)
84  ENDDO
85  ldxm = ldxm + lmem
86  ENDIF
87  ENDDO
88 
89 C Update the table information within MODULE MSGMEM.
90 
91  IF ( ict .GT. 0 ) THEN
92  ifdxts(ndxts+1) = ndxm + 1
93  icdxts(ndxts+1) = ict
94  ipmsgs(ndxts+1) = msgp(0) + 1
95  ndxm = ndxm + ict
96  ndxts = ndxts + 1
97  IF ( iprt .GE. 2 ) THEN
98  CALL errwrt('+++++++++++++++++++++++++++++++++++++++++++++')
99  WRITE ( unit=errstr, fmt='(A,I3,A,I3,A)')
100  . 'BUFRLIB: CPDXMM - STORED NEW DX TABLE #', ndxts,
101  . ' CONSISTING OF ', ict, ' MESSAGES'
102  CALL errwrt(errstr)
103  CALL errwrt('+++++++++++++++++++++++++++++++++++++++++++++')
104  CALL errwrt(' ')
105  ENDIF
106  ENDIF
107 
108  RETURN
109  900 CALL bort('BUFRLIB: CPDXMM - MXDXTS OVERFLOW')
110  901 CALL bort('BUFRLIB: CPDXMM - UNEXPECTED READ ERROR')
111  902 CALL bort('BUFRLIB: CPDXMM - MXDXM OVERFLOW')
112  903 CALL bort('BUFRLIB: CPDXMM - MXDXW OVERFLOW')
113  END
function iupbs3(MBAY, S3MNEM)
This function returns a specified value from within Section 3 of a BUFR message.
Definition: iupbs3.f:34
function nmwrd(MBAY)
GIVEN AN INTEGER ARRAY CONTAINING SECTION ZERO FROM A BUFR MESSAGE, THIS FUNCTION DETERMINES A COUNT ...
Definition: nmwrd.f:27
void backbufr(f77int *nfile)
This subroutine backspaces a BUFR file by one BUFR message.
Definition: cread.c:84
subroutine cpdxmm(LUNIT)
This subroutine reads an entire DX BUFR table from a specified file into internal arrays...
Definition: cpdxmm.f:20
subroutine rdmsgw(LUNIT, MESG, IRET)
THIS SUBROUTINE READS THE NEXT BUFR MESSAGE FROM LOGICAL UNIT LUNIT AS AN ARRAY OF INTEGER WORDS...
Definition: rdmsgw.f:37
This module contains array and variable declarations used to store the contents of one or more BUFR f...
Definition: moda_msgmem.F:14
function idxmsg(MESG)
This function determines whether a given BUFR message contains DX BUFR tables information that was ge...
Definition: idxmsg.f:23
subroutine status(LUNIT, LUN, IL, IM)
This subroutine checks whether a specified Fortran logical unit number is currently connected to the ...
Definition: status.f:55
subroutine errwrt(STR)
This subroutine allows the user to specify a custom location for the logging of error and diagnostic ...
Definition: errwrt.f:41
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22