NCEPLIBS-bufr  11.7.0
 All Data Structures Files Functions Variables Pages
ufbevn.f
Go to the documentation of this file.
1 C> @file
2 C> @author WOOLLEN @date 1994-01-06
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). OTHER THAN THE ADDITION OF A THIRD
17 C> DIMENSION AND THE READ ONLY RESTRICTION, THE CONTEXT AND USAGE OF
18 C> UFBEVN IS EXACTLY THE SAME AS FOR BUFR ARCHIVE LIBRARY SUBROUTINES
19 C> UFBINT, UFBREP AND UFBSEQ. THIS SUBROUTINE IS DESIGNED TO READ
20 C> EVENT INFORMATION FROM "PREPBUFR" TYPE BUFR FILES. PREPBUFR FILES
21 C> HAVE THE FOLLOWING BUFR TABLE EVENT STRUCTURE (NOTE SIXTEEN
22 C> CHARACTERS HAVE BEEN REMOVED FROM THE LAST COLUMN TO ALLOW THE
23 C> TABLE TO FIT IN THIS DOCBLOCK):
24 C>
25 C> | ADPUPA | HEADR {PLEVL}
26 C> |----------|---------------
27 C> | HEADR | SID XOB YOB DHR ELV TYP T29 TSB ITP SQN
28 C> | PLEVL | CAT <PINFO> <QINFO> <TINFO> <ZINFO> <WINFO>
29 C> | PINFO | [PEVN] <PBACKG> <PPOSTP>
30 C> | QINFO | [QEVN] TDO <QBACKG> <QPOSTP>
31 C> | TINFO | [TEVN] TVO <TBACKG> <TPOSTP>
32 C> | ZINFO | [ZEVN] <ZBACKG> <ZPOSTP>
33 C> | WINFO | [WEVN] <WBACKG> <WPOSTP>
34 C> | PEVN | POB PQM PPC PRC
35 C> | QEVN | QOB QQM QPC QRC
36 C> | TEVN | TOB TQM TPC TRC
37 C> | ZEVN | ZOB ZQM ZPC ZRC
38 C> | WEVN | UOB WQM WPC WRC VOB
39 C> | PBACKG | POE PFC
40 C> | QBACKG | QOE QFC
41 C> | TBACKG | TOE TFC
42 C> | ZBACKG | ZOE ZFC
43 C> | WBACKG | WOE UFC VFC
44 C> | PPOSTP | PAN
45 C> | QPOSTP | QAN
46 C> | TPOSTP | TAN
47 C> | ZPOSTP | ZAN
48 C> | WPOSTP | UAN VAN
49 C>
50 C> NOTE THAT THE EIGHT-BIT DELAYED REPLIATION EVENT SEQUENCES "[xxxx]"
51 C> ARE NESTED INSIDE ONE-BIT DELAYED REPLICATED SEQUENCES "<yyyy>".
52 C> THE ANALOGOUS BUFR ARCHIVE LIBRARY SUBROUTINE UFBIN3 DOES NOT WORK
53 C> PROPERLY ON THIS TYPE OF EVENT STRUCTURE. IT WORKS ONLY ON THE
54 C> EVENT STRUCTURE FOUND IN "PREPFITS" TYPE BUFR FILES (SEE UFBIN3 FOR
55 C> MORE DETAILS). IN TURN, UFBEVN DOES NOT WORK PROPERLY ON THE EVENT
56 C> STRUCTURE FOUND IN PREPFITS FILES (ALWAYS USE UFBIN3 IN THIS CASE).
57 C> ONE OTHER DIFFERENCE BETWEEN UFBEVN AND UFBIN3 IS THAT UFBEVN
58 C> STORES THE MAXIMUM NUMBER OF EVENTS FOUND FOR ALL DATA VALUES
59 C> SPECIFIED AMONGST ALL LEVELS RETURNED INTERNALLY IN COMMON BLOCK
60 C> /UFBN3C/. UFBIN3 RETURNS THIS VALUE AS AN ADDITIONAL OUTPUT
61 C> ARGUMENT.
62 C>
63 C> PROGRAM HISTORY LOG:
64 C> 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR
65 C> 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
66 C> "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
67 C> ROUTINE "BORT"; IMPROVED MACHINE
68 C> PORTABILITY
69 C> 1999-11-18 J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
70 C> OPENED AT ONE TIME INCREASED FROM 10 TO 32
71 C> (NECESSARY IN ORDER TO PROCESS MULTIPLE
72 C> BUFR FILES UNDER THE MPI)
73 C> 2003-11-04 J. WOOLLEN -- SAVES THE MAXIMUM NUMBER OF EVENTS FOUND
74 C> FOR ALL DATA VALUES SPECIFIED AMONGST ALL
75 C> LEVELS RETURNED AS VARIABLE MAXEVN IN NEW
76 C> COMMON BLOCK /UFBN3C/
77 C> 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
78 C> INTERDEPENDENCIES
79 C> 2003-11-04 D. KEYSER -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES)
80 C> INCREASED FROM 15000 TO 16000 (WAS IN
81 C> VERIFICATION VERSION); ADDED CALL TO BORT
82 C> IF BUFR FILE IS OPEN FOR OUTPUT; UNIFIED/
83 C> PORTABLE FOR WRF; ADDED DOCUMENTATION
84 C> (INCLUDING HISTORY); OUTPUTS MORE COMPLETE
85 C> DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
86 C> ABNORMALLY OR UNUSUAL THINGS HAPPEN
87 C> 2009-04-21 J. ATOR -- USE ERRWRT
88 C> 2014-12-10 J. ATOR -- USE MODULES INSTEAD OF COMMON BLOCKS
89 C>
90 C> USAGE: CALL UFBEVN (LUNIT, USR, I1, I2, I3, IRET, STR)
91 C> INPUT ARGUMENT LIST:
92 C> LUNIT - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
93 C> I1 - INTEGER: LENGTH OF FIRST DIMENSION OF USR (MUST BE AT
94 C> LEAST AS LARGE AS THE NUMBER OF BLANK-SEPARATED
95 C> MNEMONICS IN STR)
96 C> I2 - INTEGER: LENGTH OF SECOND DIMENSION OF USR
97 C> I3 - INTEGER: LENGTH OF THIRD DIMENSION OF USR (MAXIMUM
98 C> VALUE IS 255)
99 C> STR - CHARACTER*(*): STRING OF BLANK-SEPARATED TABLE B
100 C> MNEMONICS IN ONE-TO-ONE CORRESPONDENCE WITH FIRST
101 C> DIMENSION OF USR
102 C> - THERE ARE THREE "GENERIC" MNEMONICS NOT RELATED
103 C> TO TABLE B, THESE RETURN THE FOLLOWING
104 C> INFORMATION IN CORRESPONDING USR LOCATION:
105 C> 'NUL' WHICH ALWAYS RETURNS BMISS ("MISSING")
106 C> 'IREC' WHICH ALWAYS RETURNS THE CURRENT BUFR
107 C> MESSAGE (RECORD) NUMBER IN WHICH THIS
108 C> SUBSET RESIDES
109 C> 'ISUB' WHICH ALWAYS RETURNS THE CURRENT SUBSET
110 C> NUMBER OF THIS SUBSET WITHIN THE BUFR
111 C> MESSAGE (RECORD) NUMBER 'IREC'
112 C>
113 C> OUTPUT ARGUMENT LIST:
114 C> USR - REAL*8: (I1,I2,I3) STARTING ADDRESS OF DATA VALUES
115 C> READ FROM DATA SUBSET
116 C> IRET - INTEGER: NUMBER OF "LEVELS" OF DATA VALUES READ FROM
117 C> DATA SUBSET (MUST BE NO LARGER THAN I2)
118 C>
119 C> REMARKS:
120 C> APPLICATION PROGRAMS READING PREPFITS FILES SHOULD NOT CALL THIS
121 C> ROUTINE.
122 C>
123 C> THIS ROUTINE CALLS: BORT CONWIN ERRWRT GETWIN
124 C> NVNWIN NXTWIN STATUS STRING
125 C> THIS ROUTINE IS CALLED BY: None
126 C> Normally called only by application
127 C> programs.
128 C>
129  SUBROUTINE ufbevn(LUNIT,USR,I1,I2,I3,IRET,STR)
130 
131  USE modv_bmiss
132  USE moda_usrint
133  USE moda_msgcwd
134 
135  COMMON /usrstr/ nnod,ncon,nods(20),nodc(10),ivls(10),kons(10)
136  COMMON /ufbn3c/ maxevn
137  COMMON /quiet / iprt
138 
139  CHARACTER*(*) str
140  CHARACTER*128 errstr
141  dimension invn(255)
142  REAL*8 usr(i1,i2,i3)
143 
144 C----------------------------------------------------------------------
145 C----------------------------------------------------------------------
146 
147  maxevn = 0
148  iret = 0
149 
150 C CHECK THE FILE STATUS AND I-NODE
151 C --------------------------------
152 
153  CALL status(lunit,lun,il,im)
154  IF(il.EQ.0) goto 900
155  IF(il.GT.0) goto 901
156  IF(im.EQ.0) goto 902
157  IF(inode(lun).NE.inv(1,lun)) goto 903
158 
159  IF(i1.LE.0) THEN
160  IF(iprt.GE.0) THEN
161  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
162  errstr = .LE.'BUFRLIB: UFBEVN - 3rd ARG. (INPUT) IS 0, ' //
163  . 'SO RETURN WITH 6th ARG. (IRET) = 0; 7th ARG. (STR) ='
164  CALL errwrt(errstr)
165  CALL errwrt(str)
166  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
167  CALL errwrt(' ')
168  ENDIF
169  goto 100
170  ELSEIF(i2.LE.0) THEN
171  IF(iprt.GE.0) THEN
172  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
173  errstr = .LE.'BUFRLIB: UFBEVN - 4th ARG. (INPUT) IS 0, ' //
174  . 'SO RETURN WITH 6th ARG. (IRET) = 0; 7th ARG. (STR) ='
175  CALL errwrt(errstr)
176  CALL errwrt(str)
177  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
178  CALL errwrt(' ')
179  ENDIF
180  goto 100
181  ELSEIF(i3.LE.0) THEN
182  IF(iprt.GE.0) THEN
183  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
184  errstr = .LE.'BUFRLIB: UFBEVN - 5th ARG. (INPUT) IS 0, ' //
185  . 'SO RETURN WITH 6th ARG. (IRET) = 0; 7th ARG. (STR) ='
186  CALL errwrt(errstr)
187  CALL errwrt(str)
188  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
189  CALL errwrt(' ')
190  ENDIF
191  goto 100
192  ENDIF
193 
194 C PARSE OR RECALL THE INPUT STRING
195 C --------------------------------
196 
197  CALL string(str,lun,i1,0)
198 
199 C INITIALIZE USR ARRAY
200 C --------------------
201 
202  DO k=1,i3
203  DO j=1,i2
204  DO i=1,i1
205  usr(i,j,k) = bmiss
206  ENDDO
207  ENDDO
208  ENDDO
209 
210 C LOOP OVER COND WINDOWS
211 C ----------------------
212 
213  inc1 = 1
214  inc2 = 1
215 
216 1 CALL conwin(lun,inc1,inc2)
217  IF(nnod.EQ.0) THEN
218  iret = i2
219  goto 100
220  ELSEIF(inc1.EQ.0) THEN
221  goto 100
222  ELSE
223  DO i=1,nnod
224  IF(nods(i).GT.0) THEN
225  ins2 = inc1
226  CALL getwin(nods(i),lun,ins1,ins2)
227  IF(ins1.EQ.0) goto 100
228  goto 2
229  ENDIF
230  ENDDO
231  ins1 = inc1
232  ins2 = inc2
233  ENDIF
234 
235 C READ PUSH DOWN STACK DATA INTO 3D ARRAYS
236 C ----------------------------------------
237 
238 2 iret = iret+1
239  IF(iret.LE.i2) THEN
240  DO i=1,nnod
241  IF(nods(i).GT.0) THEN
242  nnvn = nvnwin(nods(i),lun,ins1,ins2,invn,i3)
243  maxevn = max(nnvn,maxevn)
244  DO n=1,nnvn
245  usr(i,iret,n) = val(invn(n),lun)
246  ENDDO
247  ENDIF
248  ENDDO
249  ENDIF
250 
251 C DECIDE WHAT TO DO NEXT
252 C ----------------------
253 
254  CALL nxtwin(lun,ins1,ins2)
255  IF(ins1.GT.0 .AND. ins1.LT.inc2) goto 2
256  IF(ncon.GT.0) goto 1
257 
258  IF(iret.EQ.0) THEN
259  IF(iprt.GE.1) THEN
260  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
261  errstr = 'BUFRLIB: UFBEVN - NO SPECIFIED VALUES READ IN, ' //
262  . 'SO RETURN WITH 6th ARG. (IRET) = 0; 7th ARG. (STR) ='
263  CALL errwrt(errstr)
264  CALL errwrt(str)
265  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
266  CALL errwrt(' ')
267  ENDIF
268  ENDIF
269 
270 C EXITS
271 C -----
272 
273 100 RETURN
274 900 CALL bort('BUFRLIB: UFBEVN - INPUT BUFR FILE IS CLOSED, IT MUST'//
275  . ' BE OPEN FOR INPUT')
276 901 CALL bort('BUFRLIB: UFBEVN - INPUT BUFR FILE IS OPEN FOR OUTPUT'//
277  . ', IT MUST BE OPEN FOR INPUT')
278 902 CALL bort('BUFRLIB: UFBEVN - A MESSAGE MUST BE OPEN IN INPUT '//
279  . 'BUFR FILE, NONE ARE')
280 903 CALL bort('BUFRLIB: UFBEVN - LOCATION OF INTERNAL TABLE FOR '//
281  . 'INPUT BUFR FILE DOES NOT AGREE WITH EXPECTED LOCATION IN '//
282  . 'INTERNAL SUBSET ARRAY')
283  END
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 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
function nvnwin(NODE, LUN, INV1, INV2, INVN, NMAX)
THIS FUNCTION LOOKS FOR AND RETURNS ALL OCCURRENCES OF A SPECIFIED NODE WITHIN THE PORTION OF THE CUR...
Definition: nvnwin.f:54
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 ufbevn(LUNIT, USR, I1, I2, I3, IRET, STR)
THIS SUBROUTINE READS SPECIFIED VALUES FROM THE CURRENT BUFR DATA SUBSET WITHIN INTERNAL ARRAYS...
Definition: ufbevn.f:129
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22