NCEPLIBS-bufr  11.7.0
 All Data Structures Files Functions Variables Pages
ufbget.f
Go to the documentation of this file.
1 C> @file
2 C> @author WOOLLEN @date 1994-01-06
3 
4 C> THIS SUBROUTINE UNPACKS AND RETURNS THE VALUES FOR ONE-
5 C> DIMENSIONAL DESCRIPTORS IN THE INPUT STRING WITHOUT ADVANCING THE
6 C> SUBSET POINTER.
7 C>
8 C> PROGRAM HISTORY LOG:
9 C> 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR
10 C> 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
11 C> "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
12 C> ROUTINE "BORT"; IMPROVED MACHINE
13 C> PORTABILITY
14 C> 1998-10-27 J. WOOLLEN -- MODIFIED TO CORRECT PROBLEMS CAUSED BY IN-
15 C> LINING CODE WITH FPP DIRECTIVES
16 C> 1999-11-18 J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
17 C> OPENED AT ONE TIME INCREASED FROM 10 TO 32
18 C> (NECESSARY IN ORDER TO PROCESS MULTIPLE
19 C> BUFR FILES UNDER THE MPI)
20 C> 2000-09-19 J. WOOLLEN -- MAXIMUM MESSAGE LENGTH INCREASED FROM
21 C> 10,000 TO 20,000 BYTES
22 C> 2002-05-14 J. WOOLLEN -- REMOVED OLD CRAY COMPILER DIRECTIVES
23 C> 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
24 C> INTERDEPENDENCIES
25 C> 2003-11-04 D. KEYSER -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES)
26 C> INCREASED FROM 15000 TO 16000 (WAS IN
27 C> VERIFICATION VERSION); UNIFIED/PORTABLE FOR
28 C> WRF; ADDED DOCUMENTATION (INCLUDING
29 C> HISTORY); OUTPUTS MORE COMPLETE DIAGNOSTIC
30 C> INFO WHEN ROUTINE TERMINATES ABNORMALLY
31 C> 2004-08-09 J. ATOR -- MAXIMUM MESSAGE LENGTH INCREASED FROM
32 C> 20,000 TO 50,000 BYTES
33 C> 2012-03-02 J. ATOR -- USE FUNCTION UPS
34 C> 2014-12-10 J. ATOR -- USE MODULES INSTEAD OF COMMON BLOCKS
35 C>
36 C> USAGE: CALL UFBGET (LUNIT, TAB, I1, IRET, STR)
37 C> INPUT ARGUMENT LIST:
38 C> LUNIT - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
39 C> I1 - INTEGER: LENGTH OF TAB
40 C> STR - CHARACTER*(*): STRING OF BLANK-SEPARATED TABLE B
41 C> MNEMONICS IN ONE-TO-ONE CORRESPONDENCE WITH THE WORDS
42 C> IN THE ARRAY TAB
43 C> - THERE ARE THREE "GENERIC" MNEMONICS NOT RELATED
44 C> TO TABLE B, THESE RETURN THE FOLLOWING
45 C> INFORMATION IN CORRESPONDING TAB LOCATION:
46 C> 'NUL' WHICH ALWAYS RETURNS BMISS ("MISSING")
47 C> 'IREC' WHICH ALWAYS RETURNS THE CURRENT BUFR
48 C> MESSAGE (RECORD) NUMBER IN WHICH THIS
49 C> SUBSET RESIDES
50 C> 'ISUB' WHICH ALWAYS RETURNS THE CURRENT SUBSET
51 C> NUMBER OF THIS SUBSET WITHIN THE BUFR
52 C> MESSAGE (RECORD) NUMBER 'IREC'
53 C>
54 C> OUTPUT ARGUMENT LIST:
55 C> TAB - REAL*8: (I1) STARTING ADDRESS OF DATA VALUES READ FROM
56 C> DATA SUBSET
57 C> IRET - INTEGER: RETURN CODE:
58 C> 0 = normal return
59 C> -1 = there are no more subsets in the BUFR
60 C> message
61 C>
62 C> REMARKS:
63 C> THIS ROUTINE CALLS: BORT INVWIN STATUS STRING
64 C> UPBB UPC UPS USRTPL
65 C> THIS ROUTINE IS CALLED BY: None
66 C> Normally called only by application
67 C> programs.
68 C>
69  SUBROUTINE ufbget(LUNIT,TAB,I1,IRET,STR)
70 
71  USE modv_bmiss
72  USE moda_usrint
73  USE moda_usrbit
74  USE moda_msgcwd
75  USE moda_bitbuf
76  USE moda_tables
77 
78  COMMON /usrstr/ nnod,ncon,nods(20),nodc(10),ivls(10),kons(10)
79 
80  CHARACTER*(*) str
81  CHARACTER*8 cval
82  equivalence(cval,rval)
83  REAL*8 rval,tab(i1),ups
84 
85 C-----------------------------------------------------------------------
86  mps(node) = 2**(ibt(node))-1
87 C-----------------------------------------------------------------------
88 
89  iret = 0
90 
91  DO i=1,i1
92  tab(i) = bmiss
93  ENDDO
94 
95 C MAKE SURE A FILE/MESSAGE IS OPEN FOR INPUT
96 C ------------------------------------------
97 
98  CALL status(lunit,lun,il,im)
99  IF(il.EQ.0) goto 900
100  IF(il.GT.0) goto 901
101  IF(im.EQ.0) goto 902
102 
103 C SEE IF THERE IS ANOTHER SUBSET IN THE MESSAGE
104 C ---------------------------------------------
105 
106  IF(nsub(lun).EQ.msub(lun)) THEN
107  iret = -1
108  goto 100
109  ENDIF
110 
111 C PARSE THE STRING
112 C ----------------
113 
114  CALL string(str,lun,i1,0)
115 
116 C EXPAND THE TEMPLATE FOR THIS SUBSET AS LITTLE AS POSSIBLE
117 C ---------------------------------------------------------
118 
119  n = 1
120  nbit(n) = 0
121  mbit(n) = mbyt(lun)*8 + 16
122  CALL usrtpl(lun,n,n)
123 
124 10 DO n=n+1,nval(lun)
125  node = inv(n,lun)
126  nbit(n) = ibt(node)
127  mbit(n) = mbit(n-1)+nbit(n-1)
128  IF(node.EQ.nods(nnod)) THEN
129  nval(lun) = n
130  goto 20
131  ELSEIF(itp(node).EQ.1) THEN
132  CALL upbb(ival,nbit(n),mbit(n),mbay(1,lun))
133  CALL usrtpl(lun,n,ival)
134  goto 10
135  ENDIF
136  ENDDO
137 20 CONTINUE
138 
139 C UNPACK ONLY THE NODES FOUND IN THE STRING
140 C -----------------------------------------
141 
142  DO i=1,nnod
143  node = nods(i)
144  invn = invwin(node,lun,1,nval(lun))
145  IF(invn.GT.0) THEN
146  CALL upbb(ival,nbit(invn),mbit(invn),mbay(1,lun))
147  IF(itp(node).EQ.1) THEN
148  tab(i) = ival
149  ELSEIF(itp(node).EQ.2) THEN
150  IF(ival.LT.mps(node)) tab(i) = ups(ival,node)
151  ELSEIF(itp(node).EQ.3) THEN
152  cval = ' '
153  kbit = mbit(invn)
154  CALL upc(cval,nbit(invn)/8,mbay(1,lun),kbit,.true.)
155  tab(i) = rval
156  ENDIF
157  ELSE
158  tab(i) = bmiss
159  ENDIF
160  ENDDO
161 
162 C EXITS
163 C -----
164 
165 100 RETURN
166 900 CALL bort('BUFRLIB: UFBGET - INPUT BUFR FILE IS CLOSED, IT MUST'//
167  . ' BE OPEN FOR INPUT')
168 901 CALL bort('BUFRLIB: UFBGET - INPUT BUFR FILE IS OPEN FOR OUTPUT'//
169  . ', IT MUST BE OPEN FOR INPUT')
170 902 CALL bort('BUFRLIB: UFBGET - A MESSAGE MUST BE OPEN IN INPUT '//
171  . 'BUFR FILE, NONE ARE')
172  END
subroutine upbb(NVAL, NBITS, IBIT, IBAY)
THIS SUBROUTINE UNPACKS AND RETURNS A BINARY INTEGER CONTAINED WITHIN NBITS BITS OF IBAY...
Definition: upbb.f:42
subroutine usrtpl(LUN, INVN, NBMP)
THIS SUBROUTINE STORES THE SUBSET TEMPLATE INTO INTERNAL SUBSET ARRAYS IN MODULE USRINT FOR CASES OF ...
Definition: usrtpl.f:51
This module declares and initializes the BMISS variable.
Definition: modv_BMISS.f90:9
subroutine upc(CHR, NCHR, IBAY, IBIT, CNVNULL)
THIS SUBROUTINE UNPACKS AND RETURNS A CHARACTER STRING OF LENGTH NCHR CONTAINED WITHIN NCHR BYTES OF ...
Definition: upc.f:49
subroutine ufbget(LUNIT, TAB, I1, IRET, STR)
THIS SUBROUTINE UNPACKS AND RETURNS THE VALUES FOR ONE- DIMENSIONAL DESCRIPTORS IN THE INPUT STRING W...
Definition: ufbget.f:69
subroutine string(STR, LUN, I1, IO)
THIS SUBROUTINE CHECKS TO SEE IF A USER-SPECIFIED CHARACTER STRING IS IN THE STRING CACHE (ARRAYS IN ...
Definition: string.f:58
This module contains array and variable declarations used to store the internal jump/link table...
Definition: moda_tables.F:13
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 bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22
function invwin(NODE, LUN, INV1, INV2)
THIS FUNCTION LOOKS FOR A SPECIFIED NODE WITHIN THE PORTION OF THE CURRENT SUBSET BUFFER BOUNDED BY T...
Definition: invwin.f:48
This module contains array and variable declarations used to store BUFR messages internally for multi...
Definition: moda_bitbuf.F:10
REAL *8 function ups(IVAL, NODE)
THIS FUNCTION UNPACKS A REAL*8 USER VALUE FROM A PACKED BUFR INTEGER BY APPLYING THE PROPER SCALE AND...
Definition: ups.f:31