NCEPLIBS-bufr  11.7.0
 All Data Structures Files Functions Variables Pages
ufbin3.f
Go to the documentation of this file.
1 C> @file
2 C> @author WOOLLEN @date 2003-11-04
3 
4 C> THIS SUBROUTINE READS SPECIFIED VALUES FROM THE CURRENT
5 C> BUFR DATA SUBSET WITHIN INTERNAL ARRAYS. THE DATA VALUES
6 C> CORRESPOND TO MNEMONICS WHICH ARE PART OF A MULTIPLE-REPLICATION
7 C> SEQUENCE WITHIN ANOTHER MULTIPLE-REPLICATION SEQUENCE. THE INNER
8 C> SEQUENCE IS USUALLY ASSOCIATED WITH DATA "LEVELS" AND THE OUTER
9 C> SEQUENCE WITH DATA "EVENTS". THE BUFR FILE IN LOGICAL UNIT LUNIT
10 C> MUST HAVE BEEN OPENED FOR INPUT VIA A PREVIOUS CALL TO BUFR ARCHIVE
11 C> LIBRARY SUBROUTINE OPENBF. IN ADDITION, THE DATA SUBSET MUST HAVE
12 C> SUBSEQUENTLY BEEN READ INTO THE INTERNAL BUFR ARCHIVE LIBRARY
13 C> ARRAYS VIA CALLS TO BUFR ARCHIVE LIBRARY SUBROUTINE READMG OR
14 C> READERME FOLLOWED BY A CALL TO BUFR ARCHIVE LIBRARY SUBROUTINE
15 C> READSB (OR VIA A SINGLE CALL TO BUFR ARCHIVE LIBRARY
16 C> SUBROUTINE READNS). THIS SUBROUTINE IS DESIGNED TO READ EVENT
17 C> INFORMATION FROM "PREPFITS" TYPE BUFR FILES (BUT NOT FROM
18 C> "PREPBUFR" TYPE FILES!!). PREPFITS FILES HAVE THE FOLLOWING BUFR
19 C> TABLE EVENT STRUCTURE (NOTE SIXTEEN CHARACTERS HAVE BEEN REMOVED
20 C> FROM THE LAST COLUMN TO ALLOW THE TABLE TO FIT IN THIS DOCBLOCK):
21 C>
22 C> | ADPUPA | HEADR {PLEVL}
23 C> |----------|----------------
24 C> | HEADR | SID XOB YOB DHR ELV TYP T29 ITP
25 C> | PLEVL | CAT PRC PQM QQM TQM ZQM WQM CDTP_QM [OBLVL]
26 C> | OBLVL | SRC FHR <PEVN> <QEVN> <TEVN> <ZEVN> <WEVN> <CEVN>
27 C> | OBLVL | <CTPEVN>
28 C> | PEVN | POB PMO
29 C> | QEVN | QOB
30 C> | TEVN | TOB
31 C> | ZEVN | ZOB
32 C> | WEVN | UOB VOB
33 C> | CEVN | CAPE CINH LI
34 C> | CTPEVN | CDTP GCDTT TOCC
35 C>
36 C> NOTE THAT THE ONE-BIT DELAYED REPLICATED SEQUENCES "<xxxx>" ARE
37 C> NESTED INSIDE THE EIGHT-BIT DELAYED REPLIATION EVENT SEQUENCES
38 C> "[yyyy]". THE ANALOGOUS BUFR ARCHIVE LIBRARY SUBROUTINE UFBEVN
39 C> DOES NOT WORK PROPERLY ON THIS TYPE OF EVENT STRUCTURE. IT WORKS
40 C> ONLY ON THE EVENT STRUCTURE FOUND IN "PREPBUFR" TYPE BUFR FILES
41 C> (SEE UFBEVN FOR MORE DETAILS). IN TURN, UFBIN3 DOES NOT WORK
42 C> PROPERLY ON THE EVENT STRUCTURE FOUND IN PREPBUFR FILES (ALWAYS USE
43 C> UFBEVN IN THIS CASE). ONE OTHER DIFFERENCE BETWEEN UFBIN3 AND
44 C> UFBEVN IS THAT UFBIN3 RETURNS THE MAXIMUM NUMBER OF EVENTS FOUND
45 C> FOR ALL DATA VALUES SPECIFIED AS AN OUTPUT ARGUMENT (JRET). UFBEVN
46 C> DOES NOT DO THIS, BUT RATHER IT STORES THIS VALUE INTERNALLY IN
47 C> COMMON BLOCK /UFBN3C/.
48 C>
49 C> PROGRAM HISTORY LOG:
50 C> 2003-11-04 J. WOOLLEN -- ORIGINAL AUTHOR (WAS IN VERIFICATION
51 C> VERSION)
52 C> 2003-11-04 D. KEYSER -- UNIFIED/PORTABLE FOR WRF; ADDED
53 C> DOCUMENTATION; OUTPUTS MORE COMPLETE
54 C> DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
55 C> ABNORMALLY OR UNUSUAL THINGS HAPPEN
56 C> 2009-04-21 J. ATOR -- USE ERRWRT
57 C> 2014-12-10 J. ATOR -- USE MODULES INSTEAD OF COMMON BLOCKS
58 C>
59 C> USAGE: CALL UFBIN3 (LUNIT, USR, I1, I2, I3, IRET, JRET, STR)
60 C> INPUT ARGUMENT LIST:
61 C> LUNIT - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
62 C> I1 - INTEGER: LENGTH OF FIRST DIMENSION OF USR (MUST BE AT
63 C> LEAST AS LARGE AS THE NUMBER OF BLANK-SEPARATED
64 C> MNEMONICS IN STR)
65 C> I2 - INTEGER: LENGTH OF SECOND DIMENSION OF USR
66 C> I3 - INTEGER: LENGTH OF THIRD DIMENSION OF USR (MAXIMUM
67 C> VALUE IS 255)
68 C> STR - CHARACTER*(*): STRING OF BLANK-SEPARATED TABLE B
69 C> MNEMONICS IN ONE-TO-ONE CORRESPONDENCE WITH FIRST
70 C> DIMENSION OF USR
71 C> - THERE ARE THREE "GENERIC" MNEMONICS NOT RELATED
72 C> TO TABLE B, THESE RETURN THE FOLLOWING
73 C> INFORMATION IN CORRESPONDING USR LOCATION:
74 C> 'NUL' WHICH ALWAYS RETURNS BMISS ("MISSING")
75 C> 'IREC' WHICH ALWAYS RETURNS THE CURRENT BUFR
76 C> MESSAGE (RECORD) NUMBER IN WHICH THIS
77 C> SUBSET RESIDES
78 C> 'ISUB' WHICH ALWAYS RETURNS THE CURRENT SUBSET
79 C> NUMBER OF THIS SUBSET WITHIN THE BUFR
80 C> MESSAGE (RECORD) NUMBER 'IREC'
81 C>
82 C> OUTPUT ARGUMENT LIST:
83 C> USR - REAL*8: (I1,I2,I3) STARTING ADDRESS OF DATA VALUES
84 C> READ FROM DATA SUBSET
85 C> IRET - INTEGER: NUMBER OF "LEVELS" OF DATA VALUES READ FROM
86 C> DATA SUBSET (MUST BE NO LARGER THAN I2)
87 C> JRET - INTEGER: MAXIMUM NUMBER OF "EVENTS" FOUND FOR ALL DATA
88 C> VALUES SPECIFIED AMONGST ALL LEVELS READ FROM DATA
89 C> SUBSET (MUST BE NO LARGER THAN I3)
90 C>
91 C> REMARKS:
92 C> IMPORTANT: THIS ROUTINE SHOULD ONLY BE CALLED BY THE VERIFICATION
93 C> APPLICATION PROGRAM "GRIDTOBS", WHERE IT WAS PREVIOUSLY
94 C> AN IN-LINE SUBROUTINE. IN GENERAL, UFBIN3 DOES NOT
95 C> WORK PROPERLY IN OTHER APPLICATION PROGRAMS (I.E, THOSE
96 C> THAT ARE READING PREPBUFR FILES) AT THIS TIME. ALWAYS
97 C> USE UFBEVN INSTEAD!!
98 C>
99 C> THIS ROUTINE CALLS: BORT CONWIN ERRWRT GETWIN
100 C> NEVN NXTWIN STATUS STRING
101 C> THIS ROUTINE IS CALLED BY: None
102 C> SHOULD NOT BE CALLED BY ANY APPLICATION
103 C> PROGRAMS EXCEPT GRIDTOBS!!
104 C>
105  SUBROUTINE ufbin3(LUNIT,USR,I1,I2,I3,IRET,JRET,STR)
106 
107  USE modv_bmiss
108  USE moda_usrint
109  USE moda_msgcwd
110 
111  COMMON /usrstr/ nnod,ncon,nods(20),nodc(10),ivls(10),kons(10)
112  COMMON /quiet / iprt
113 
114  CHARACTER*(*) str
115  CHARACTER*128 errstr
116  REAL*8 usr(i1,i2,i3)
117 
118 C----------------------------------------------------------------------
119 C----------------------------------------------------------------------
120 
121  iret = 0
122  jret = 0
123 
124 C CHECK THE FILE STATUS AND I-NODE
125 C --------------------------------
126 
127  CALL status(lunit,lun,il,im)
128  IF(il.EQ.0) goto 900
129  IF(il.GT.0) goto 901
130  IF(im.EQ.0) goto 902
131  IF(inode(lun).NE.inv(1,lun)) goto 903
132 
133  IF(i1.LE.0) THEN
134  IF(iprt.GE.0) THEN
135  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
136  errstr = .LE.'BUFRLIB: UFBIN3 - 3rd ARG. (INPUT) IS 0, ' //
137  . 'SO RETURN WITH 6th AND 7th ARGS. (IRET, JRET) = 0; ' //
138  . '8th ARG. (STR) ='
139  CALL errwrt(errstr)
140  CALL errwrt(str)
141  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
142  CALL errwrt(' ')
143  ENDIF
144  goto 100
145  ELSEIF(i2.LE.0) THEN
146  IF(iprt.GE.0) THEN
147  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
148  errstr = .LE.'BUFRLIB: UFBIN3 - 4th ARG. (INPUT) IS 0, ' //
149  . 'SO RETURN WITH 6th AND 7th ARGS. (IRET, JRET) = 0; ' //
150  . '8th ARG. (STR) ='
151  CALL errwrt(errstr)
152  CALL errwrt(str)
153  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
154  CALL errwrt(' ')
155  ENDIF
156  goto 100
157  ELSEIF(i3.LE.0) THEN
158  IF(iprt.GE.0) THEN
159  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
160  errstr = .LE.'BUFRLIB: UFBIN3 - 5th ARG. (INPUT) IS 0, ' //
161  . 'SO RETURN WITH 6th AND 7th ARGS. (IRET, JRET) = 0; ' //
162  . '8th ARG. (STR) ='
163  CALL errwrt(errstr)
164  CALL errwrt(str)
165  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
166  CALL errwrt(' ')
167  ENDIF
168  goto 100
169  ENDIF
170 
171 C PARSE OR RECALL THE INPUT STRING
172 C --------------------------------
173 
174  CALL string(str,lun,i1,0)
175 
176 C INITIALIZE USR ARRAY
177 C --------------------
178 
179  DO k=1,i3
180  DO j=1,i2
181  DO i=1,i1
182  usr(i,j,k) = bmiss
183  ENDDO
184  ENDDO
185  ENDDO
186 
187 C LOOP OVER COND WINDOWS
188 C ----------------------
189 
190  inc1 = 1
191  inc2 = 1
192 
193 1 CALL conwin(lun,inc1,inc2)
194  IF(nnod.EQ.0) THEN
195  iret = i2
196  goto 100
197  ELSEIF(inc1.EQ.0) THEN
198  goto 100
199  ELSE
200  DO i=1,nnod
201  IF(nods(i).GT.0) THEN
202  ins2 = inc1
203  CALL getwin(nods(i),lun,ins1,ins2)
204  IF(ins1.EQ.0) goto 100
205  goto 2
206  ENDIF
207  ENDDO
208  ins1 = inc1
209  ins2 = inc2
210  ENDIF
211 
212 C READ PUSH DOWN STACK DATA INTO 3D ARRAYS
213 C ----------------------------------------
214 
215 2 iret = iret+1
216  IF(iret.LE.i2) THEN
217  DO i=1,nnod
218  nnvn = nevn(nods(i),lun,ins1,ins2,i1,i2,i3,usr(i,iret,1))
219  jret = max(jret,nnvn)
220  ENDDO
221  ENDIF
222 
223 C DECIDE WHAT TO DO NEXT
224 C ----------------------
225 
226  CALL nxtwin(lun,ins1,ins2)
227  IF(ins1.GT.0 .AND. ins1.LT.inc2) goto 2
228  IF(ncon.GT.0) goto 1
229 
230  IF(iret.EQ.0 .OR. jret.EQ.0) THEN
231  IF(iprt.GE.1) THEN
232  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
233  errstr = 'BUFRLIB: UFBIN3 - NO SPECIFIED VALUES READ IN, ' //
234  . 'SO RETURN WITH 6th AND/OR 7th ARGS. (IRET, JRET) = 0; ' //
235  . '8th ARG. (STR) ='
236  CALL errwrt(errstr)
237  CALL errwrt(str)
238  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
239  CALL errwrt(' ')
240  ENDIF
241  ENDIF
242 
243 C EXITS
244 C -----
245 
246 100 RETURN
247 900 CALL bort('BUFRLIB: UFBIN3 - INPUT BUFR FILE IS CLOSED, IT MUST'//
248  . ' BE OPEN FOR INPUT')
249 901 CALL bort('BUFRLIB: UFBIN3 - INPUT BUFR FILE IS OPEN FOR OUTPUT'//
250  . ', IT MUST BE OPEN FOR INPUT')
251 902 CALL bort('BUFRLIB: UFBIN3 - A MESSAGE MUST BE OPEN IN INPUT '//
252  . 'BUFR FILE, NONE ARE')
253 903 CALL bort('BUFRLIB: UFBIN3 - LOCATION OF INTERNAL TABLE FOR '//
254  . 'INPUT BUFR FILE DOES NOT AGREE WITH EXPECTED LOCATION IN '//
255  . 'INTERNAL SUBSET ARRAY')
256  END
function nevn(NODE, LUN, INV1, INV2, I1, I2, I3, USR)
THIS FUNCTION LOOKS FOR ALL STACKED DATA EVENTS FOR A SPECIFIED DATA VALUE AND LEVEL WITHIN THE PORTI...
Definition: nevn.f:54
subroutine nxtwin(LUN, IWIN, JWIN)
GIVEN INDICES WITHIN THE INTERNAL JUMP/LINK TABLE WHICH POINT TO THE START AND END OF AN &quot;RPC&quot; WINDOW...
Definition: nxtwin.f:52
subroutine getwin(NODE, LUN, IWIN, JWIN)
GIVEN A NODE INDEX WITHIN THE INTERNAL JUMP/LINK TABLE, THIS SUBROUTINE LOOKS WITHIN THE CURRENT SUBS...
Definition: getwin.f:81
This module declares and initializes the BMISS variable.
Definition: modv_BMISS.f90:9
subroutine ufbin3(LUNIT, USR, I1, I2, I3, IRET, JRET, STR)
THIS SUBROUTINE READS SPECIFIED VALUES FROM THE CURRENT BUFR DATA SUBSET WITHIN INTERNAL ARRAYS...
Definition: ufbin3.f:105
subroutine conwin(LUN, INC1, INC2)
THIS SUBROUTINE SEARCHES CONSECUTIVE SUBSET BUFFER SEGMENTS FOR AN ELEMENT IDENTIFIED IN THE USER STR...
Definition: conwin.f:64
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
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