NCEPLIBS-bufr  12.0.0
ufbpos.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Jump forwards or backwards to a specified data subset within
3 C> a BUFR file.
4 C>
5 C> @author J. Woollen @date 1995-11-22
6 
7 C> This subroutine repositions the file pointer to the beginning of a
8 C> specified data subset within a specified message of a BUFR file,
9 C> then reads that data subset into internal arrays so that it can be
10 C> further processed via subsequent calls to any of the
11 C> [values-reading subroutines](@ref hierarchy).
12 C>
13 C> The specified data subset may be before or after the current location
14 C> of the file pointer within the BUFR file.
15 C>
16 C> @remarks
17 C> - Logical unit LUNIT should have already been opened for input
18 C> operations via a previous call to subroutine openbf().
19 C> - The value specified for IREC should <b>not</b> include any messages
20 C> which contain DX BUFR tables information.
21 C>
22 C> @param[in] LUNIT -- integer: Fortran logical unit number for BUFR file
23 C> @param[in] IREC -- integer: Ordinal number of message to be read,
24 C> counting from the beginning of the BUFR file, but
25 C> not counting any messages which contain DX BUFR
26 C> tables information
27 C> @param[in] ISUB -- integer: Ordinal number of data subset to be
28 C> read from (IREC)th message, counting from the
29 C> beginning of the message
30 C> @param[out] SUBSET -- character*8: Table A mnemonic for type of BUFR
31 C> message that was read
32 C> (see [DX BUFR Tables](@ref dfbftab)
33 C> for further information about Table A mnemonics)
34 C> @param[out] JDATE -- integer: Date-time stored within Section 1 of
35 C> BUFR message that was read, in format of either
36 C> YYMMDDHH or YYYYMMDDHH, depending on the most
37 C> recent call to subroutine datelen()
38 C>
39 C> @author J. Woollen @date 1995-11-22
40  RECURSIVE SUBROUTINE ufbpos(LUNIT,IREC,ISUB,SUBSET,JDATE)
41 
42  use bufrlib
43 
44  USE modv_im8b
45 
46  USE moda_msgcwd
47  USE moda_bitbuf
48 
49  CHARACTER*128 bort_str
50  CHARACTER*8 subset
51 
52 C-----------------------------------------------------------------------
53 C----------------------------------------------------------------------
54 
55 C CHECK FOR I8 INTEGERS
56 C ---------------------
57 
58  IF(im8b) THEN
59  im8b=.false.
60 
61  CALL x84(lunit,my_lunit,1)
62  CALL x84(irec,my_irec,1)
63  CALL x84(isub,my_isub,1)
64  CALL ufbpos(my_lunit,my_irec,my_isub,subset,jdate)
65  CALL x48(jdate,jdate,1)
66 
67  im8b=.true.
68  RETURN
69  ENDIF
70 
71 C MAKE SURE A FILE IS OPEN FOR INPUT
72 C ----------------------------------
73 
74  CALL status(lunit,lun,il,im)
75  IF(il.EQ.0) GOTO 900
76  IF(il.GT.0) GOTO 901
77 
78  IF(irec.LE.0) GOTO 902
79  IF(isub.LE.0) GOTO 903
80 
81 C SEE WHERE POINTERS ARE CURRENTLY LOCATED
82 C ----------------------------------------
83 
84  CALL ufbcnt(lunit,jrec,jsub)
85 
86 C REWIND FILE IF REQUESTED POINTERS ARE BEHIND CURRENT POINTERS
87 C -------------------------------------------------------------
88 
89  IF(irec.LT.jrec .OR. (irec.EQ.jrec.AND.isub.LT.jsub)) THEN
90  CALL cewind_c(lun)
91  nmsg(lun) = 0
92  nsub(lun) = 0
93  CALL ufbcnt(lunit,jrec,jsub)
94  ENDIF
95 
96 C READ SUBSET #ISUB FROM MESSAGE #IREC FROM FILE
97 C ----------------------------------------------
98 
99  DO WHILE (irec.GT.jrec)
100  CALL readmg(lunit,subset,jdate,iret)
101  IF(iret.LT.0) GOTO 904
102  CALL ufbcnt(lunit,jrec,jsub)
103  ENDDO
104 
105  DO WHILE (isub.GT.jsub)
106  CALL readsb(lunit,iret)
107  IF(iret.NE.0) GOTO 905
108  CALL ufbcnt(lunit,jrec,jsub)
109  ENDDO
110 
111 C EXITS
112 C -----
113 
114  RETURN
115 900 CALL bort('BUFRLIB: UFBPOS - INPUT BUFR FILE IS CLOSED, IT MUST'//
116  . ' BE OPEN FOR INPUT')
117 901 CALL bort('BUFRLIB: UFBPOS - INPUT BUFR FILE IS OPEN FOR OUTPUT'//
118  . ', IT MUST BE OPEN FOR INPUT')
119 902 WRITE(bort_str,'("BUFRLIB: UFBPOS - REQUESTED MESSAGE NUMBER '//
120  . 'TO READ IN (",I5,") IS NOT VALID")') irec
121  CALL bort(bort_str)
122 903 WRITE(bort_str,'("BUFRLIB: UFBPOS - REQUESTED SUBSET NUMBER '//
123  . 'TO READ IN (",I5,") IS NOT VALID")') isub
124  CALL bort(bort_str)
125 904 WRITE(bort_str,'("BUFRLIB: UFBPOS - REQUESTED MESSAGE NUMBER '//
126  . 'TO READ IN (",I5,") EXCEEDS THE NUMBER OF MESSAGES IN THE '//
127  . 'FILE (",I5,")")') irec,jrec
128  CALL bort(bort_str)
129 905 WRITE(bort_str,'("BUFRLIB: UFBPOS - REQ. SUBSET NUMBER TO READ'//
130  . ' IN (",I3,") EXCEEDS THE NUMBER OF SUBSETS (",I3,") IN THE '//
131  . 'REQ. MESSAGE (",I5,")")') isub,ksub,irec
132  CALL bort(bort_str)
133  END
subroutine bort(STR)
Log one error message and abort application program.
Definition: bort.f:18
Wrap C NCEPLIBS-bufr functions so they can be called from within the Fortran part of the library.
Definition: bufrlib.F90:11
This module contains array and variable declarations used to store BUFR messages internally for multi...
This module contains declarations for arrays used to store information about the current BUFR message...
integer, dimension(:), allocatable nmsg
Current message pointer within logical unit.
integer, dimension(:), allocatable nsub
Current subset pointer within message.
This module declares and initializes the IM8B variable.
logical, public im8b
Status indicator to keep track of whether all future calls to BUFRLIB subroutines and functions from ...
recursive subroutine readmg(LUNXX, SUBSET, JDATE, IRET)
Reads the next BUFR message from logical unit ABS(LUNXX) into internal arrays.
Definition: readmg.f:52
recursive subroutine readsb(LUNIT, IRET)
Read the next data subset from a BUFR message.
Definition: readsb.f:33
recursive subroutine status(LUNIT, LUN, IL, IM)
Check whether a specified Fortran logical unit number is currently connected to the NCEPLIBS-bufr sof...
Definition: status.f:36
recursive subroutine ufbcnt(LUNIT, KMSG, KSUB)
Get the current message number and data subset number within a BUFR file.
Definition: ufbcnt.f:41
recursive subroutine ufbpos(LUNIT, IREC, ISUB, SUBSET, JDATE)
This subroutine repositions the file pointer to the beginning of a specified data subset within a spe...
Definition: ufbpos.f:41
subroutine x48(IIN4, IOUT8, NVAL)
Encode one or more 4-byte integer values as 8-byte integer values.
Definition: x48.F:19
subroutine x84(IIN8, IOUT4, NVAL)
Encode one or more 8-byte integer values as 4-byte integer values.
Definition: x84.F:19