Page 1 Source Listing GET_BITS
2025-03-12 18:23 GET_BITS.f
1 SUBROUTINE GET_BITS(IBM,SGDS,LEN,MG,G,ISCALE,GROUND,
2 & GMIN,GMAX,NBIT)
3 C$$$ SUBPROGRAM DOCUMENTATION BLOCK
4 C
5 C SUBPROGRAM: GET_BITS COMPUTE NUMBER OF BITS AND ROUND FIELD.
6 C PRGMMR: IREDELL ORG: W/NP23 DATE: 92-10-31
7 C
8 C ABSTRACT: THE NUMBER OF BITS REQUIRED TO PACK A GIVEN FIELD
9 C AT A PARTICULAR DECIMAL SCALING IS COMPUTED USING THE FIELD RANGE.
10 C THE FIELD IS ROUNDED OFF TO THE DECIMAL SCALING FOR PACKING.
11 C THE MINIMUM AND MAXIMUM ROUNDED FIELD VALUES ARE ALSO RETURNED.
12 C GRIB BITMAP MASKING FOR VALID DATA IS OPTIONALLY USED.
13 C
14 C PROGRAM HISTORY LOG:
15 C 92-10-31 IREDELL
16 C 95-04-14 BALDWIN - MODIFY FOLLOWING KEITH BRILL'S CODE
17 C TO USE SIG DIGITS TO COMPUTE DEC SCALE
18 C
19 C USAGE: CALL GET_BITS(IBM,ISGDS,LEN,MG,G,ISCALE,GROUND,GMIN,GMAX,NBIT)
20 C INPUT ARGUMENT LIST:
21 C IBM - INTEGER BITMAP FLAG (=0 FOR NO BITMAP)
22 C SGDS - MAXIMUM SIGNIFICANT DIGITS TO KEEP
23 C (E.G. SGDS=3.0 KEEPS 3 SIGNIFICANT DIGITS)
24 C OR BINARY PRECISION IF <0
25 C (E.G. SGDS=-2.0 KEEPS FIELD TO NEAREST 1/4
26 C -3.0 " " 1/8
27 C 2**SGDS PRECISION)
28 C LEN - INTEGER LENGTH OF THE FIELD AND BITMAP
29 C MG - INTEGER (LEN) BITMAP IF IBM=1 (0 TO SKIP, 1 TO KEEP)
30 C G - REAL (LEN) FIELD
31 C
32 C OUTPUT ARGUMENT LIST:
33 C ISCALE - INTEGER DECIMAL SCALING
34 C GROUND - REAL (LEN) FIELD ROUNDED TO DECIMAL SCALING
35 C GMIN - REAL MINIMUM VALID ROUNDED FIELD VALUE
36 C GMAX - REAL MAXIMUM VALID ROUNDED FIELD VALUE
37 C NBIT - INTEGER NUMBER OF BITS TO PACK
38 C
39 C SUBPROGRAMS CALLED:
40 C ISRCHNE - FIND FIRST VALUE IN AN ARRAY NOT EQUAL TO TARGET VALUE
41 C
42 C ATTRIBUTES:
43 C LANGUAGE: FORTRAN
44 C
45 C$$$
46 DIMENSION MG(LEN),G(LEN),GROUND(LEN)
47 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
48 C DETERMINE EXTREMES WHERE BITMAP IS ON
49 C
50 IF(IBM.EQ.0) THEN
51 GMAX=G(1)
52 GMIN=G(1)
53 DO I=2,LEN
54 GMAX=MAX(GMAX,G(I))
55 GMIN=MIN(GMIN,G(I))
56 ENDDO
57 ELSE
Page 2 Source Listing GET_BITS
2025-03-12 18:23 GET_BITS.f
58 I1=0
59 DO I=1,LEN
60 IF(MG(I).NE.0.AND.I1.EQ.0) I1=I
61 ENDDO
62 IF(I1.GT.0.AND.I1.LE.LEN) THEN
63 GMAX=G(I1)
64 GMIN=G(I1)
65 DO I=I1+1,LEN
66 IF(MG(I).NE.0) THEN
67 GMAX=MAX(GMAX,G(I))
68 GMIN=MIN(GMIN,G(I))
69 ENDIF
70 ENDDO
71 ELSE
72 GMAX=0.
73 GMIN=0.
74 ENDIF
75 ENDIF
76 C
77 C
78 C
79 CALL FNDBIT ( GMIN, GMAX, SGDS, NBIT, ISCALE, IRETT)
80 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
81 RETURN
82 END
ENTRY POINTS
Name
get_bits_
Page 3 Source Listing GET_BITS
2025-03-12 18:23 Symbol Table GET_BITS.f
SYMBOL CROSS REFERENCE
Name Object Declared Type Bytes Dimen Elements Attributes References
FNDBIT Subr 79 79
G Dummy 1 R(4) 4 1 0 ARG,INOUT 51,52,54,55,63,64,67,68
GET_BITS Subr 1
GMAX Dummy 2 R(4) 4 scalar ARG,INOUT 51,54,63,67,72,79
GMIN Dummy 2 R(4) 4 scalar ARG,INOUT 52,55,64,68,73,79
GROUND Dummy 1 R(4) 4 1 0 ARG,INOUT
I Local 53 I(4) 4 scalar 53,54,55,59,60,65,66,67,68
I1 Local 58 I(4) 4 scalar 58,60,62,63,64,65
IBM Dummy 1 I(4) 4 scalar ARG,INOUT 50
IRETT Local 79 I(4) 4 scalar 79
ISCALE Dummy 1 I(4) 4 scalar ARG,INOUT 79
LEN Dummy 1 I(4) 4 scalar ARG,INOUT 46,53,59,62,65
MAX Func 54 scalar 54,67
MG Dummy 1 I(4) 4 1 0 ARG,INOUT 60,66
MIN Func 55 scalar 55,68
NBIT Dummy 2 I(4) 4 scalar ARG,INOUT 79
SGDS Dummy 1 R(4) 4 scalar ARG,INOUT 79
Page 4 Source Listing FNDBIT
2025-03-12 18:23 GET_BITS.f
83 SUBROUTINE FNDBIT ( rmin, rmax, rdb, nmbts, iscale, iret )
84 C************************************************************************
85 C* FNDBIT *
86 C* *
87 C* This subroutine computes the number of packing bits given the *
88 C* maximum number of significant digits to preserve or the binary *
89 C* precision to store the data. The binary precision is given as a *
90 C* negative integer, ISCALE will always be zero in this case. *
91 C* *
92 C* The binary precision translates as follows: *
93 C* -1 => store data to nearest 1/2 *
94 C* -2 => store data to nearest 1/4 *
95 C* -3 => store data to nearest 1/8 *
96 C* *
97 C* Note that a fractional number of significant digits is allowed. *
98 C* *
99 C* FNDBIT ( AMIN, AMAX, RDB, NBITS, ISCALE, IRET ) *
100 C* *
101 C* Input parameters: *
102 C* AMIN REAL Minimum value *
103 C* AMAX REAL Maximum value *
104 C* RDB REAL Maximum # of significant digits *
105 C* OR binary precision if < 0 *
106 C* *
107 C* Output parameters: *
108 C* NBITS INTEGER Number of bits for packing *
109 C* ISCALE INTEGER Power of 10 scaling to use *
110 C* IRET INTEGER Return code *
111 C* 0 = normal return *
112 C** *
113 C* Log: *
114 C* K. Brill/NMC 06/92 *
115 C* K. Brill/EMC 12/95 Added binary precision *
116 C* M. Baldwin 10/96 Added fix for negative nmbts
117 C************************************************************************
118 C*
119 DATA rln2/0.69314718/
120 C-----------------------------------------------------------------------
121 iret = 0
122 icnt = 0
123 iscale = 0
124 range = rmax - rmin
125 IF ( range .le. 0.00 ) THEN
126 nmbts = 8
127 RETURN
128 END IF
129 C*
130 IF ( rdb .eq. 0.0 ) THEN
131 nmbts = 8
132 RETURN
133 ELSE IF ( rdb .gt. 0.0 ) THEN
134 ipo = INT (ALOG10 ( range ))
135 IF ( range .lt. 1.00 ) ipo = ipo - 1
136 po = float(ipo) - rdb + 1.
137 iscale = - INT ( po )
138 rr = range * 10. ** ( -po )
139 nmbts = INT ( ALOG ( rr ) / rln2 ) + 1
Page 5 Source Listing FNDBIT
2025-03-12 18:23 GET_BITS.f
140 ELSE
141 ibin = NINT ( -rdb )
142 rng2 = range * 2. ** ibin
143 nmbts = INT ( ALOG ( rng2 ) / rln2 ) + 1
144 END IF
145 C*
146 IF(NMBTS.LE.0) THEN
147 NMBTS=0
148 IF(ABS(RMIN).GE.1.) THEN
149 ISCALE=-INT(ALOG10(ABS(RMIN)))
150 ELSE IF (ABS(RMIN).LT.1.0.AND.ABS(RMIN).GT.0.0) THEN
151 ISCALE=-INT(ALOG10(ABS(RMIN)))+1
152 ELSE
153 ISCALE=0
154 ENDIF
155 ENDIF
156 RETURN
157 END
ENTRY POINTS
Name
fndbit_
SYMBOL CROSS REFERENCE
Name Object Declared Type Bytes Dimen Elements Attributes References
ABS Func 148 scalar 148,149,150,151
ALOG Func 139 scalar 139,143
ALOG10 Func 134 scalar 134,149,151
FLOAT Func 136 scalar 136
FNDBIT Subr 83
IBIN Local 141 I(4) 4 scalar 141,142
ICNT Local 122 I(4) 4 scalar 122
INT Func 134 scalar 134,137,139,143,149,151
IPO Local 134 I(4) 4 scalar 134,135,136
IRET Dummy 83 I(4) 4 scalar ARG,INOUT 121
ISCALE Dummy 83 I(4) 4 scalar ARG,INOUT 123,137,149,151,153
NINT Func 141 scalar 141
NMBTS Dummy 83 I(4) 4 scalar ARG,INOUT 126,131,139,143,146,147
PO Local 136 R(4) 4 scalar 136,137,138
RANGE Local 124 R(4) 4 scalar 124,125,134,135,138,142
RDB Dummy 83 R(4) 4 scalar ARG,INOUT 130,133,136,141
RLN2 Local 119 R(4) 4 scalar 119,139,143
RMAX Dummy 83 R(4) 4 scalar ARG,INOUT 124
RMIN Dummy 83 R(4) 4 scalar ARG,INOUT 124,148,149,150,151
RNG2 Local 142 R(4) 4 scalar 142,143
RR Local 138 R(4) 4 scalar 138,139
Page 6 Source Listing FNDBIT
2025-03-12 18:23 Subprograms/Common Blocks GET_BITS.f
SUBPROGRAMS/COMMON BLOCKS
Name Object Declared Type Bytes Dimen Elements Attributes References
FNDBIT Subr 83
GET_BITS Subr 1
COMPILER OPTIONS BEING USED
-align noall -align nonone
-align nocommons -align nodcommons
-align noqcommons -align nozcommons
-align records -align nosequence
-align norec1byte -align norec2byte
-align norec4byte -align norec8byte
-align norec16byte -align norec32byte
-align norec64byte -align noarray8byte
-align noarray16byte -align noarray32byte
-align noarray64byte -align noarray128byte
-align noarray256byte -altparam
-assume accuracy_sensitive -assume nobscc
-assume nobuffered_io -assume nobuffered_stdout
-assume byterecl -assume nocontiguous_assumed_shape
-assume nocontiguous_pointer -assume nocc_omp
-assume nocstring -assume nodummy_aliases
-assume nofpe_summary -assume noieee_fpe_flags
-assume nominus0 -assume noold_boz
-assume old_complex_align -assume old_unit_star
-assume old_inquire_recl -assume old_ldout_format
-assume old_ldout_zero -assume noold_logical_assign
-assume noold_logical_ldio -assume old_maxminloc
-assume old_xor -assume noprotect_allocates
-assume protect_constants -assume noprotect_parens
-assume split_common -assume source_include
-assume nostd_intent_in -assume std_minus0_rounding
-assume nostd_mod_proc_name -assume std_value
-assume realloc_lhs -assume underscore
-assume no2underscores -assume norecursion
no -auto -auto_scalar
no -bintext -ccdefault default
-check noarg_temp_created -check noassume
-check nobounds -check nocontiguous
-check noformat -check nooutput_conversion
-check nooverflow -check nopointers
-check noshape -check nostack
-check nouninitialized -check noudio_iostat
-coarray-num-procs 0 no -coarray-config-file
-convert big_endian -cross_reference
-D __INTEL_COMPILER=1910 -D __INTEL_COMPILER_UPDATE=3
-D __unix__ -D __unix
-D __linux__ -D __linux
-D __gnu_linux__ -D unix
-D linux -D __ELF__
-D __x86_64 -D __x86_64__
-D __amd64 -D __amd64__
Page 7 Source Listing FNDBIT
2025-03-12 18:23 GET_BITS.f
-D __INTEL_COMPILER_BUILD_DATE=20200925 -D __INTEL_OFFLOAD
-D __MMX__ -D __SSE__
-D __SSE_MATH__ -D __SSE2__
-D __SSE2_MATH__ -D __SSE3__
-D __SSSE3__ -D __SSE4_1__
-D __SSE4_2__ -D __POPCNT__
-D __PCLMUL__ -D __AES__
-D __AVX__ -D __F16C__
-D __AVX_I__ -D __RDRND__
-D __FMA__ -D __FP_FAST_FMA
-D __FP_FAST_FMAF -D __BMI__
-D __LZCNT__ -D __AVX2__
-D __haswell -D __haswell__
-D __tune_haswell__ -D __core_avx2
-D __core_avx2__ -D __tune_core_avx2__
-D __CRAY_X86_ROME -D __CRAYXT_COMPUTE_LINUX_TARGET
-double_size 64 no -d_lines
no -Qdyncom -error_limit 30
no -f66 no -f77rtl
no -fast -fpscomp nofilesfromcmd
-fpscomp nogeneral -fpscomp noioformat
-fpscomp noldio_spacing -fpscomp nologicals
-fixed no -fpconstant
-fpe3 -fprm nearest
no -ftz -fp_model noprecise
-fp_model fast -fp_model nostrict
-fp_model nosource -fp_model nodouble
-fp_model noextended -fp_model novery_fast
-fp_model noexcept -fp_model nono_except
-heap_arrays 0 no -threadprivate_compat
-g2 -iface nomixed_str_len_arg
-iface nono_mixed_str_len_arg -init noarrays
-init nohuge -init noinfinity
-init nominus_huge -init nominus_infinity
-init nominus_tiny -init nonan
-init nosnan -init notiny
-init nozero no -intconstant
-integer_size 32 no -mixed_str_len_arg
no -module -names lowercase
no -noinclude no -o
-offload-build=host -openmp-simd
-O2 no -pad_source
-real_size 32 no -recursive
-reentrancy threaded -vec=simd
-show nofullpath -show noinclude
-show map -show options
no -syntax_only no -threadcom
no -U no -vms
-w noall -w nonone
-w alignments -w nodeclarations
-w noexternals -w general
-w noignore_bounds -w noignore_loc
-w nointerfaces -w noshape
-w notruncated_source -w uncalled
-w uninitialized -w nounused
-w usage no -wrap-margins
Page 8 Source Listing FNDBIT
2025-03-12 18:23 GET_BITS.f
-includepath : /pe/intel/compilers_and_libraries_2020.4.304/linux/pstl/include/,/pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/,
.f90,./.f90,/opt/cray/pe/mpich/8.1.12/ofi/intel/19.0/include/.f90,/pe/intel/compilers_and_libraries_2020.4.304/linux/ipp/include/.f90,
/pe/intel/compilers_and_libraries_2020.4.304/linux/mkl/include/.f90,/pe/intel/compilers_and_libraries_2020.4.304/linux/pstl/include/.f90,
/pe/intel/compilers_and_libraries_2020.4.304/linux/pstl/stdlib/.f90,/pe/intel/compilers_and_libraries_2020.4.304/linux/tbb/include/.f90,
/pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/intel64/.f90,/pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/icc/.f90,
/pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/.f90,/usr/lib64/gcc/x86_64-suse-linux/7/include/.f90,
/usr/lib64/gcc/x86_64-suse-linux/7/include-fixed/.f90,/usr/include/.f90,/usr/include/.f90,/usr/include/.f90
-list filename : GET_BITS.lst
no -o
COMPILER: Intel(R) Fortran 19.1-1655