NCEPLIBS-bufr  11.6.0
 All Data Structures Files Functions Variables Pages
nemspecs.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Get the scale factor, reference value and bit width
3 C> associated with a specified occurrence of a Table B mnemonic.
4 
5 C> Given a Table B mnemonic defined within a data subset, this
6 C> subroutine returns the scale factor, reference value and bit
7 C> width of a specified occurrence of that mnemonic within the
8 C> overall data subset definition, counting from the beginning
9 C> of the subset.
10 C>
11 C> <p>The values returned include the application of any Table C
12 C> operators (e.g. 2-01-YYY, 2-02-YYY, 2-03-YYY, 2-07-YYY,
13 C> 2-08-YYY) which may be in effect for the specified occurrence
14 C> of the mnemonic.
15 C>
16 C> @author J. Ator
17 C> @date 2014-10-02
18 C>
19 C> @param[in] LUNIT -- integer: Fortran logical unit number for
20 C> BUFR file
21 C> @param[in] NEMO -- character*(*): Table B mnemonic
22 C> @param[in] NNEMO -- integer: Ordinal occurrence of NEMO for
23 C> which information is to be returned,
24 C> counting from the beginning of the overall
25 C> subset definition
26 C> @param[out] NSCL -- integer: Scale factor in effect for
27 C> (NNEMO)th occurrence of NEMO
28 C> @param[out] NREF -- integer: Reference value in effect for
29 C> (NNEMO)th occurrence of NEMO
30 C> @param[out] NBTS -- integer: Bit width in effect for
31 C> (NNEMO)th occurrence of NEMO
32 C> @param[out] IRET -- integer: return code
33 C> - 0 = normal return
34 C> - -1 = NEMO could not be found, or some
35 C> other error occurred
36 C>
37 C> <p>A data subset must already be in scope within the BUFRLIB
38 C> internal arrays for LUNIT, either via a previous call to one
39 C> of the [subset-reading subroutines](@ref hierarchy)
40 C> (when reading BUFR data subsets) or via a previous call to one
41 C> of the [message-writing subroutines](@ref hierarchy)
42 C> (when writing BUFR data subsets).
43 C>
44 C> <b>Program history log:</b>
45 C> | Date | Programmer | Comments |
46 C> | -----|------------|----------|
47 C> | 2014-10-02 | J. Ator | Original version |
48 C> | 2014-12-10 | J. Ator | Use modules instead of COMMON blocks |
49 C>
50  SUBROUTINE nemspecs ( LUNIT, NEMO, NNEMO,
51  . nscl, nref, nbts, iret )
52 
53  USE moda_usrint
54  USE moda_msgcwd
55  USE moda_tables
56  USE moda_nrv203
57 
58  CHARACTER*10 tagn
59 
60  CHARACTER*(*) nemo
61 
62 C----------------------------------------------------------------------
63 C----------------------------------------------------------------------
64 
65  iret = -1
66 
67 C Get LUN from LUNIT.
68 
69  CALL status( lunit, lun, il, im )
70  IF ( il .EQ. 0 ) RETURN
71  IF ( inode(lun) .NE. inv(1,lun) ) RETURN
72 
73 C Starting from the beginning of the subset, locate the (NNEMO)th
74 C occurrence of NEMO.
75 
76  CALL fstag( lun, nemo, nnemo, 1, nidx, ierfst )
77  IF ( ierfst .NE. 0 ) RETURN
78 
79 C Confirm that NEMO is a Table B mnemonic.
80 
81  node = inv(nidx,lun)
82  IF ( ( typ(node) .NE. 'NUM' ) .AND. ( typ(node) .NE. 'CHR' ) )
83  . RETURN
84 
85 C Get the scale factor, reference value and bit width, including
86 C accounting for any Table C operators which may be in scope for
87 C this particular occurrence of NEMO.
88 
89  iret = 0
90 
91  nscl = isc(node)
92  nbts = ibt(node)
93  nref = irf(node)
94 
95  IF ( nnrv .GT. 0 ) THEN
96 
97 C There are nodes containing redefined reference values (from
98 C one or more 2-03-YYY operators) in the jump/link table, so we
99 C need to check if this node is one of them.
100 
101  tagn = ' '
102  CALL strsuc( nemo, tagn, ltn )
103  IF ( ( ltn .LE. 0 ) .OR. ( ltn .GT. 8 ) ) RETURN
104 
105  DO jj = 1, nnrv
106  IF ( ( node .NE. inodnrv(jj) ) .AND.
107  . ( tagn(1:8) .EQ. tagnrv(jj) ) .AND.
108  . ( node .GE. isnrv(jj) ) .AND.
109  . ( node .LE. ienrv(jj) ) ) THEN
110  nref = nrv(jj)
111  RETURN
112  END IF
113  END DO
114 
115  END IF
116 
117  RETURN
118  END
subroutine nemspecs(LUNIT, NEMO, NNEMO, NSCL, NREF, NBTS, IRET)
Given a Table B mnemonic defined within a data subset, this subroutine returns the scale factor...
Definition: nemspecs.f:50
This module contains array and variable declarations for use with any 2-03-YYY (change reference valu...
Definition: moda_nrv203.F:15
subroutine strsuc(STR1, STR2, LENS)
This subroutine removes leading and trailing blanks from a character string.
Definition: strsuc.f:23
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 fstag(LUN, UTAG, NUTAG, NIN, NOUT, IRET)
THIS SUBROUTINE FINDS THE (NUTAG)th OCCURRENCE OF MNEMONIC UTAG WITHIN THE CURRENT OVERALL SUBSET DEF...
Definition: fstag.f:40