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