NCEPLIBS-bufr  11.5.0
 All Data Structures Files Functions Variables Pages
ufbrw.f
Go to the documentation of this file.
1 C> @file
2 C> @author WOOLLEN @date 1994-01-06
3 
4 C> THIS SUBROUTINE WRITES OR READS SPECIFIED VALUES TO OR FROM
5 C> THE CURRENT BUFR DATA SUBSET WITHIN INTERNAL ARRAYS, WITH THE
6 C> DIRECTION OF THE DATA TRANSFER DETERMINED BY THE CONTEXT OF IO
7 C> (I.E., IF IO INDICATES LUN POINTS TO A BUFR FILE THAT IS OPEN FOR
8 C> INPUT, THEN DATA VALUES ARE READ FROM THE INTERNAL DATA SUBSET;
9 C> OTHERWISE, DATA VALUES ARE WRITTEN TO THE INTERNAL DATA SUBSET).
10 C> THE DATA VALUES CORRESPOND TO INTERNAL ARRAYS REPRESENTING PARSED
11 C> STRINGS OF MNEMONICS WHICH ARE PART OF A DELAYED-REPLICATION
12 C> SEQUENCE, OR FOR WHICH THERE IS NO REPLICATION AT ALL.
13 C>
14 C> THIS SUBROUTINE SHOULD NEVER BE CALLED BY ANY APPLICATION PROGRAM;
15 C> INSTEAD, APPLICATION PROGRAMS SHOULD ALWAYS CALL BUFR ARCHIVE
16 C> LIBRARY SUBROUTINE UFBINT.
17 C>
18 C> PROGRAM HISTORY LOG:
19 C> 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR
20 C> 1996-12-11 J. WOOLLEN -- REMOVED A HARD ABORT FOR USERS WHO TRY TO
21 C> WRITE NON-EXISTING MNEMONICS
22 C> 1998-07-08 J. WOOLLEN -- IMPROVED MACHINE PORTABILITY
23 C> 1998-10-27 J. WOOLLEN -- MODIFIED TO CORRECT PROBLEMS CAUSED BY IN-
24 C> LINING CODE WITH FPP DIRECTIVES
25 C> 1999-11-18 J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
26 C> OPENED AT ONE TIME INCREASED FROM 10 TO 32
27 C> (NECESSARY IN ORDER TO PROCESS MULTIPLE
28 C> BUFR FILES UNDER THE MPI)
29 C> 2002-05-14 J. WOOLLEN -- REMOVED OLD CRAY COMPILER DIRECTIVES
30 C> 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
31 C> INTERDEPENDENCIES
32 C> 2003-11-04 D. KEYSER -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES)
33 C> INCREASED FROM 15000 TO 16000 (WAS IN
34 C> VERIFICATION VERSION); UNIFIED/PORTABLE FOR
35 C> WRF; ADDED DOCUMENTATION (INCLUDING
36 C> HISTORY)
37 C> 2007-01-19 J. ATOR -- USE FUNCTION IBFMS
38 C> 2009-03-31 J. WOOLLEN -- ADD DOCUMENTATION
39 C> 2009-04-21 J. ATOR -- USE ERRWRT; USE LSTJPB INSTEAD OF LSTRPS
40 C> 2014-12-10 J. ATOR -- USE MODULES INSTEAD OF COMMON BLOCKS
41 C>
42 C> USAGE: CALL UFBRW (LUN, USR, I1, I2, IO, IRET)
43 C> INPUT ARGUMENT LIST:
44 C> LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
45 C> USR - ONLY IF BUFR FILE OPEN FOR OUTPUT:
46 C> REAL*8: (I1,I2) STARTING ADDRESS OF DATA VALUES
47 C> WRITTEN TO DATA SUBSET
48 C> I1 - INTEGER: LENGTH OF FIRST DIMENSION OF USR
49 C> I2 - INTEGER: LENGTH OF SECOND DIMENSION OF USR
50 C> IO - INTEGER: STATUS INDICATOR FOR BUFR FILE ASSOCIATED
51 C> WITH LUN:
52 C> 0 = input file
53 C> 1 = output file
54 C>
55 C> OUTPUT ARGUMENT LIST:
56 C> USR - ONLY IF BUFR FILE OPEN FOR INPUT:
57 C> REAL*8: (I1,I2) STARTING ADDRESS OF DATA VALUES
58 C> READ FROM DATA SUBSET
59 C> IRET - INTEGER:
60 C> - IF BUFR FILE OPEN FOR INPUT: NUMBER OF "LEVELS" OF
61 C> DATA VALUES READ FROM DATA SUBSET (MUST BE NO
62 C> LARGER THAN I2)
63 C> -1 = NONE OF THE MNEMONICS IN THE STRING PASSED
64 C> TO UFBINT WERE FOUND IN THE SUBSET TEMPLATE
65 C> - IF BUFR FILE OPEN FOR OUTPUT: NUMBER OF "LEVELS"
66 C> OF DATA VALUES WRITTEN TO DATA SUBSET (SHOULD BE
67 C> SAME AS I2)
68 C> -1 = NONE OF THE MNEMONICS IN THE STRING PASSED
69 C> TO UFBINT WERE FOUND IN THE SUBSET TEMPLATE
70 C>
71 C> REMARKS:
72 C> THIS ROUTINE CALLS: CONWIN DRSTPL ERRWRT GETWIN
73 C> IBFMS INVWIN LSTJPB NEWWIN
74 C> NXTWIN
75 C> THIS ROUTINE IS CALLED BY: TRYBUMP UFBINT
76 C> Normally not called by any application
77 C> programs (they should call UFBINT).
78 C>
79  SUBROUTINE ufbrw(LUN,USR,I1,I2,IO,IRET)
80 
81  USE modv_bmiss
82  USE moda_usrint
83  USE moda_tables
84 
85  COMMON /usrstr/ nnod,ncon,nods(20),nodc(10),ivls(10),kons(10)
86  COMMON /quiet / iprt
87 
88  CHARACTER*128 errstr
89  REAL*8 usr(i1,i2)
90 
91 C----------------------------------------------------------------------
92 C----------------------------------------------------------------------
93 
94  iret = 0
95 
96 C LOOP OVER COND WINDOWS
97 C ----------------------
98 
99  inc1 = 1
100  inc2 = 1
101 
102 1 CALL conwin(lun,inc1,inc2)
103  IF(nnod.EQ.0) THEN
104  iret = i2
105  goto 100
106  ELSEIF(inc1.EQ.0) THEN
107  goto 100
108  ELSE
109  DO i=1,nnod
110  IF(nods(i).GT.0) THEN
111  ins2 = inc1
112  CALL getwin(nods(i),lun,ins1,ins2)
113  IF(ins1.EQ.0) goto 100
114  goto 2
115  ENDIF
116  ENDDO
117  iret = -1
118  goto 100
119  ENDIF
120 
121 C LOOP OVER STORE NODES
122 C ---------------------
123 
124 2 iret = iret+1
125 
126  IF(iprt.GE.2) THEN
127  CALL errwrt('++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
128  WRITE ( unit=errstr, fmt='(5(A,I7))' )
129  . 'BUFRLIB: UFBRW - IRET:INS1:INS2:INC1:INC2 = ',
130  . iret, ':', ins1, ':', ins2, ':', inc1, ':', inc2
131  CALL errwrt(errstr)
132  kk = ins1
133  DO WHILE ( ( ins2 - kk ) .GE. 5 )
134  WRITE ( unit=errstr, fmt='(5A10)' )
135  . (tag(inv(i,lun)),i=kk,kk+4)
136  CALL errwrt(errstr)
137  kk = kk+5
138  ENDDO
139  WRITE ( unit=errstr, fmt='(5A10)' )
140  . (tag(inv(i,lun)),i=kk,ins2)
141  CALL errwrt(errstr)
142  CALL errwrt('++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
143  CALL errwrt(' ')
144  ENDIF
145 
146 C WRITE USER VALUES
147 C -----------------
148 
149  IF(io.EQ.1 .AND. iret.LE.i2) THEN
150  DO i=1,nnod
151  IF(nods(i).GT.0) THEN
152  IF(ibfms(usr(i,iret)).EQ.0) THEN
153  invn = invwin(nods(i),lun,ins1,ins2)
154  IF(invn.EQ.0) THEN
155  CALL drstpl(nods(i),lun,ins1,ins2,invn)
156  IF(invn.EQ.0) THEN
157  iret = 0
158  goto 100
159  ENDIF
160  CALL newwin(lun,inc1,inc2)
161  val(invn,lun) = usr(i,iret)
162  ELSEIF(lstjpb(nods(i),lun,'RPS').EQ.0) THEN
163  val(invn,lun) = usr(i,iret)
164  ELSEIF(ibfms(val(invn,lun)).NE.0) THEN
165  val(invn,lun) = usr(i,iret)
166  ELSE
167  CALL drstpl(nods(i),lun,ins1,ins2,invn)
168  IF(invn.EQ.0) THEN
169  iret = 0
170  goto 100
171  ENDIF
172  CALL newwin(lun,inc1,inc2)
173  val(invn,lun) = usr(i,iret)
174  ENDIF
175  ENDIF
176  ENDIF
177  ENDDO
178  ENDIF
179 
180 C READ USER VALUES
181 C ----------------
182 
183  IF(io.EQ.0 .AND. iret.LE.i2) THEN
184  DO i=1,nnod
185  usr(i,iret) = bmiss
186  IF(nods(i).GT.0) THEN
187  invn = invwin(nods(i),lun,ins1,ins2)
188  IF(invn.GT.0) usr(i,iret) = val(invn,lun)
189  ENDIF
190  ENDDO
191  ENDIF
192 
193 C DECIDE WHAT TO DO NEXT
194 C ----------------------
195 
196  IF(io.EQ.1.AND.iret.EQ.i2) goto 100
197  CALL nxtwin(lun,ins1,ins2)
198  IF(ins1.GT.0 .AND. ins1.LT.inc2) goto 2
199  IF(ncon.GT.0) goto 1
200 
201 C EXIT
202 C ----
203 
204 100 RETURN
205  END
function lstjpb(NODE, LUN, JBTYP)
THIS FUNCTION SEARCHES BACKWARDS, BEGINNING FROM A GIVEN NODE WITHIN THE JUMP/LINK TABLE...
Definition: lstjpb.f:57
subroutine nxtwin(LUN, IWIN, JWIN)
GIVEN INDICES WITHIN THE INTERNAL JUMP/LINK TABLE WHICH POINT TO THE START AND END OF AN "RPC" WINDOW...
Definition: nxtwin.f:52
subroutine ufbrw(LUN, USR, I1, I2, IO, IRET)
THIS SUBROUTINE WRITES OR READS SPECIFIED VALUES TO OR FROM THE CURRENT BUFR DATA SUBSET WITHIN INTER...
Definition: ufbrw.f:79
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
INTEGER function ibfms(R8VAL)
This function provides a handy way to check whether a real*8 data value returned from a previous call...
Definition: ibfms.f:39
This module contains array and variable declarations used to store the internal jump/link table...
Definition: moda_tables.F:13
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 drstpl(INOD, LUN, INV1, INV2, INVN)
THIS SUBROUTINE IS CALLED BY BUFR ARCHIVE LIBRARY SUBROUTINE UFBRW WHENEVER IT CAN'T FIND A MNEMONIC ...
Definition: drstpl.f:57
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
subroutine newwin(LUN, IWIN, JWIN)
GIVEN AN INDEX WITHIN THE INTERNAL JUMP/LINK TABLE WHICH POINTS TO THE START OF AN "RPC" WINDOW (I...
Definition: newwin.f:51