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