Page 1 Source Listing BUFR1B 2012-11-20 14:01 bufr1b.f 1 C$$$ MAIN PROGRAM DOCUMENTATION BLOCK 2 C 3 C SUBPROGRAM: BUFR1B 4 C PRGMMR: KEYSER ORG: NP22 DATE: 2007-02-09 5 C 6 C ABSTRACT: GENERATES BUFR REPORT FROM TOVS/ATOVS 1B DATA AND ENCODES 7 C IT INTO OUTPUT BUFR FILE. 8 C 9 C PROGRAM HISTORY LOG: 10 C 2000-09-06 WOOLLEN -- ORIGINAL CODE 11 C 2002-02-11 WOOLLEN -- MODIFICATIONS AND CORRECTIONS TO OUTPUT BUFR 12 C DATASET: "SAID" (0-01-007) CORRECTED TO PROPER WMO CODE TABLE 13 C VALUE (WAS 14 FOR NOAA-14, ETC.), "SIID" (0-02-019) REPLACED 14 C "SIDU" (0-02-021) WHICH DIDN'T SEEM TO BE CORRECT, "HMSL" 15 C (0-07-002) CORRECTED TO PROPER UNITS OF METERS (WAS BEING 16 C STORED IN KM), "LSQL" (0-08-012) CORRECTED TO PROPER WMO CODE 17 C TABLE VALUE (0-LAND/1-SEA) (WAS BACKWARDS), "TMBR" (0-12-163) 18 C CORRECTED TO PROPER UNITS OF K (WAS BEING STORED AS 19 C K + 273.15), CHANNEL 20 "TMBR" SET TO MISSING FOR HIRS-2 AND 20 C HIRS-3 TYPES 21 C 2004-01-23 KEYSER -- BASED ON NEW NAMELIST SWITCH "COMPRESS", NOW 22 C HAS OPTION TO WRITE COMPRESSED BUFR MESSAGES USING WRITCP 23 C INSTEAD OF WRITSB (REMOVES THE NEED FOR THE DOWNSTREAM PROGRAM 24 C BUFR_COMPRESS) 25 C 2005-04-29 KEYSER -- MODIFIED TO HANDLE PROCESSING OF AMSU-A 26 C ANTENNA TEMPERATURE (Ta) REPORTS INTO MESSAGE TYPE NC021123 27 C 2005-06-21 KEYSER -- MODIFIED TO HANDLE PROCESSING OF MHS AND 28 C HIRS-4 BRIGHTNESS TEMPERATURE (Tb) REPORTS INTO MESSAGE TYPES 29 C NC021027 AND NC021028, RESPECTIVELY 30 C 2006-07-20 KEYSER -- MODIFIED TO ENCODE THE FOLLOWING NEW 31 C INFORMATION INTO OUTPUT BUFR FILE FOR AMSU-A, AMSU-B, MHS, 32 C HIRS-3 AND HIRS-4 REPORTS: ESTIMATED SOLAR AZIMUTH (MNEMONIC 33 C SOLAZI) AND ESTIMATED SATELLITE AZIMUTH (MNEMONIC BEARAZ) FOR 34 C EACH SUBSET (RETRIEVAL); MODIFIED TO ENCODE COLD SPACE 35 C TEMPERATURE CORRECTION (MNEMONIC CSTC) FOR EACH CHANNEL IN 36 C SUBSET FOR AMSU-A, AMSU-B AND MHS REPORTS; INPUT ARGUMENT ARRAY 37 C "RDATA" NOW CONTAINS HOUR-OF-DAY, MINUTE-OF-HOUR AND SECOND-OF- 38 C MINUTE RATHER THAN ONLY SECOND-OF-DAY (SINCE THE HOUR, MINUTE 39 C AND SECOND ARE ACTUALLY ENCODED INTO BUFR, SECOND NOW ROUNDED TO 40 C NEAREST WHOLE SECOND RATHER THAN TRUNCATED) 41 C 2007-02-09 KEYSER -- MODIFIED, IN RESPONSE TO MAIN PROGRAM CHANGE, 42 C TO EXPECT BUFR CODE TABLE VALUE 0-01-007 IN WORD 1 OF INPUT 43 C ARRAY "RDATA", THE BUFR VALUE FOR SATELLITE ID, RATHER THAN THE 44 C ACTUAL SATELLITE NUMBER AS BEFORE - SINCE THIS IS THEN ENCODED 45 C DIRECTLY INTO BUFR THE CODE IS SIMPLIFIED 46 C 47 C USAGE: CALL BUFR1B(LUBFR,SUBSET,NREAL,NCHAN,RDATA,NREP) 48 C 49 C INPUT ARGUMENTS: 50 C LUBFR - LOGICAL UNIT FOR BUFR FILE 51 C SUBSET - BUFR MESSAGE TYPE FOR TOVS/ATOVS INSTRUMENT/TEMPERATURE 52 C TYPE COMBINATION 53 C NREAL - NUMBER OF TOVS/ATOVS HEADER ELEMENTS 54 C NCHAN - NUMBER OF TOVS/ATOVS CHANNELS 55 C RDATA - REAL ARRAY WITH TOVS/ATOVS HEADER AND CHANNEL DATA 56 C NREP - NUMBER OF BUFR REPORTS WRITTEN PRIOR TO THIS CALL TO 57 C BUFR1B Page 2 Source Listing BUFR1B 2012-11-20 14:01 bufr1b.f 58 C 59 C OUTPUT ARGUMENTS: 60 C NREP - NUMBER OF BUFR REPORTS WRITTEN AFTER TO THIS CALL TO 61 C BUFR1B 62 C 63 C SUBPROGRAMS CALLED: 64 C 65 C LIBRARY: 66 C BUFRLIB - OPENMB WRITSB WRITCP UFBSEQ 67 C 68 C REMARKS: 69 C 70 C ATTRIBUTES: 71 C LANGUAGE: FORTRAN 90 72 C MACHINE: NCEP WCOSS 73 C 74 C$$$ 75 76 SUBROUTINE BUFR1B(LUBFR,SUBSET,NREAL,NCHAN,RDATA,NREP) 77 78 PARAMETER(NDAT=100) 79 80 CHARACTER*8 SUBSET,COMPRESS,PROCESS_Tb,PROCESS_Ta 81 REAL*4 RDATA(*) 82 REAL*8 BUFRF(NDAT) 83 84 LOGICAL HIRS 85 86 COMMON/SWITCHES/COMPRESS,PROCESS_Tb,PROCESS_Ta 87 88 DATA BMISS /10E10/ 89 90 C----------------------------------------------------------------------- 91 C----------------------------------------------------------------------- 92 93 C ISOLATE THE DATE/TIME OF THIS REPORT 94 C ------------------------------------ 95 96 IYR = RDATA(3) 97 IMO = RDATA(4) 98 IDY = RDATA(5) 99 IHR = RDATA(6) 100 101 C DETERMINE THE BUFR SATELLITE INSTRUMENT (CODE TABLE 0-02-019) BASED 102 C ON THE BUFR MESSAGE SUBTYPE 103 C ------------------------------------------------------------------ 104 105 HIRS = (SUBSET.EQ.'NC021021' .OR. SUBSET.EQ.'NC021025' .OR. 106 . SUBSET.EQ.'NC021028') 107 IF(SUBSET(7:8).EQ.'21') THEN 108 JCODE = 605 ! hirs-2 (NC021021) (Tb) 109 ELSE IF(SUBSET(7:8).EQ.'22') THEN 110 JCODE = 623 ! msu (NC021022) (Tb) 111 ELSE IF(SUBSET(7:8).EQ.'23') THEN 112 JCODE = 570 ! amsu-a (NC021023) (Tb) or (NC021123) (Ta) 113 ELSE IF(SUBSET(7:8).EQ.'24') THEN 114 JCODE = 574 ! amsu-b (NC021024) (Tb) Page 3 Source Listing BUFR1B 2012-11-20 14:01 bufr1b.f 115 ELSE IF(SUBSET(7:8).EQ.'25') THEN 116 JCODE = 606 ! hirs-3 (NC021025) (Tb) 117 ELSE IF(SUBSET(7:8).EQ.'27') THEN 118 JCODE = 203 ! mhs (NC021027) (Tb) 119 ELSE IF(SUBSET(7:8).EQ.'28') THEN 120 JCODE = 607 ! hirs-4 (NC021028) (Tb) 121 ELSE 122 WRITE(6,*) '** UNKNOWN SATELLITE INSTRUMENT', 123 . (RDATA(III),III=1,NREAL) 124 CALL W3TAGE('BUFR_TRANHIRS2') 125 CALL ERREXIT(7) 126 ENDIF 127 128 C FLIP THE SENSE OF THE LAND/SEA FLAG 129 C ----------------------------------- 130 131 IF(NINT(RDATA(9)).EQ.0) THEN 132 LANDSEA = 1 133 ELSE IF(NINT(RDATA(9)).EQ.1) THEN 134 LANDSEA = 0 135 ENDIF 136 137 C TRANSLATE THE 1B RECORD TO BUFR FORMAT 138 C 139 C AMSU-A, AMSU-B, MHS: 140 C -------------------------------------------------------------- 141 C NC021sss | YEAR MNTH DAYS HOUR MINU SECO 142 C NC021sss | CLAT CLON SAID SIID FOVN LSQL 143 C NC021sss | SAZA SOZA HOLS HMSL SOLAZI BEARAZ 144 C NC021sss | "BRITCSTC"xx 145 C BRITCSTC | CHNM TMBR CSTC 146 C -------------------------------------------------------------- 147 C where xx=15 for AMSU-A, =5 for AMSU-B/MHS 148 C 149 C HIRS-3, HIRS-4: 150 C -------------------------------------------------------------- 151 C NC021sss | YEAR MNTH DAYS HOUR MINU SECO 152 C NC021sss | CLAT CLON SAID SIID FOVN LSQL 153 C NC021sss | SAZA SOZA HOLS HMSL SOLAZI BEARAZ 154 C NC021sss | "BRIT"20 155 C BRITCSTC | CHNM TMBR 156 C -------------------------------------------------------------- 157 C 158 C HIRS-2, MSU: 159 C -------------------------------------------------------------- 160 C NC021sss | YEAR MNTH DAYS HOUR MINU SECO 161 C NC021sss | CLAT CLON SAID SIID FOVN LSQL 162 C NC021sss | SAZA SOZA HOLS HMSL 163 C NC021sss | "BRIT"xx 164 C BRIT | CHNM TMBR 165 C -------------------------------------------------------------- 166 C where xx=20 for HIRS-2, =4 for MSU 167 168 NPERCHAN = 2 169 MREAL = 17 170 171 BUFRF( 1) = IYR Page 4 Source Listing BUFR1B 2012-11-20 14:01 bufr1b.f 172 BUFRF( 2) = IMO 173 BUFRF( 3) = IDY 174 BUFRF( 4) = IHR 175 BUFRF( 5) = RDATA(7) 176 BUFRF( 6) = RDATA(8) 177 BUFRF( 7) = RDATA(11) 178 BUFRF( 8) = RDATA(12) 179 BUFRF( 9) = RDATA(1) 180 BUFRF(10) = JCODE 181 BUFRF(11) = RDATA(10) 182 BUFRF(12) = LANDSEA 183 BUFRF(13) = RDATA(13) 184 BUFRF(14) = RDATA(14) 185 BUFRF(15) = RDATA(15) 186 BUFRF(16) = RDATA(16)*1000. 187 IF(SUBSET(7:8).GE.'23') THEN 188 BUFRF(17) = RDATA(17) 189 BUFRF(18) = RDATA(18) 190 IF(.NOT.HIRS) NPERCHAN = 3 191 MREAL = 19 192 ENDIF 193 194 DO N=1,NCHAN 195 M = (N-1)*NPERCHAN 196 IF(SUBSET(7:8).EQ.'23' .OR. SUBSET(7:8).EQ.'24' .OR. 197 . SUBSET(7:8).EQ.'27') THEN 198 BUFRF(MREAL+M) = (N) 199 BUFRF(MREAL+1+M) = RDATA(NREAL-1+N*2) 200 BUFRF(MREAL+2+M) = RDATA(NREAL-0+N*2) 201 ELSE 202 BUFRF(MREAL+M) = (N) 203 BUFRF(MREAL+1+M) = RDATA(NREAL+N) 204 205 C HIRS-2, HIRS-3 AND HIRS-4 chn 20 temperature is always missing 206 C -------------------------------------------------------------- 207 208 IF(N.EQ.20 .AND. HIRS) BUFRF(MREAL+1+M) = BMISS 209 ENDIF 210 ENDDO 211 212 C WRITE THIS ARRAY INTO BUFR 213 C -------------------------- 214 215 IDATE = IYR*1000000+IMO*10000+IDY*100+IHR 216 CALL OPENMB(LUBFR,SUBSET,IDATE) 217 CALL UFBSEQ(LUBFR,BUFRF,NDAT,1,IRET,SUBSET) 218 NREP = NREP + 1 219 IF(COMPRESS.EQ.'YES' .OR. COMPRESS.EQ.'yes') THEN 220 CALL WRITCP(LUBFR) 221 ELSE 222 CALL WRITSB(LUBFR) 223 ENDIF 224 225 C EXIT HERE 226 C --------- 227 228 RETURN Page 5 Source Listing BUFR1B 2012-11-20 14:01 bufr1b.f 229 END ENTRY POINTS Name bufr1b_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References BMISS Local 88 R(4) 4 scalar 88,208 BUFR1B Subr 76 BUFRF Local 82 R(8) 8 1 100 171,172,173,174,175,176,177,178,17 9,180,181,182,183,184,185,186,188, 189,198,199,200,202,203,208,217 COMPRESS Scalar 80 CHAR 8 scalar COM 219 ERREXIT Subr 125 125 HIRS Local 84 L(4) 4 scalar 105,190,208 IDATE Local 215 I(4) 4 scalar 215,216 IDY Local 98 I(4) 4 scalar 98,173,215 IHR Local 99 I(4) 4 scalar 99,174,215 III Local 123 I(4) 4 scalar 123 IMO Local 97 I(4) 4 scalar 97,172,215 IRET Local 217 I(4) 4 scalar 217 IYR Local 96 I(4) 4 scalar 96,171,215 JCODE Local 108 I(4) 4 scalar 108,110,112,114,116,118,120,180 LANDSEA Local 132 I(4) 4 scalar 132,134,182 LUBFR Dummy 76 I(4) 4 scalar ARG,INOUT 216,217,220,222 M Local 195 I(4) 4 scalar 195,198,199,200,202,203,208 MREAL Local 169 I(4) 4 scalar 169,191,198,199,200,202,203,208 N Local 194 I(4) 4 scalar 194,195,198,199,200,202,203,208 NCHAN Dummy 76 I(4) 4 scalar ARG,INOUT 194 NDAT Param 78 I(4) 4 scalar 82,217 NINT Func 131 scalar 131,133 NPERCHAN Local 168 I(4) 4 scalar 168,190,195 NREAL Dummy 76 I(4) 4 scalar ARG,INOUT 123,199,200,203 NREP Dummy 76 I(4) 4 scalar ARG,INOUT 218 OPENMB Subr 216 216 PROCESS_TA Scalar 80 CHAR 8 scalar COM PROCESS_TB Scalar 80 CHAR 8 scalar COM RDATA Dummy 76 R(4) 4 1 0 ARG,INOUT 96,97,98,99,123,131,133,175,176,17 7,178,179,181,183,184,185,186,188, 189,199,200,203 SUBSET Dummy 76 CHAR 8 scalar ARG,INOUT 105,106,107,109,111,113,115,117,11 9,187,196,197,216,217 SWITCHES Common 86 24 UFBSEQ Subr 217 217 W3TAGE Subr 124 124 WRITCP Subr 220 220 WRITSB Subr 222 222 Page 6 Source Listing BUFR1B 2012-11-20 14:01 Subprograms/Common Blocks bufr1b.f SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References BUFR1B Subr 76 SWITCHES Common 86 24 COMPILER OPTIONS BEING USED -align nocommons -align nodcommons -align noqcommons -align records -align nosequence -align norec1byte -align norec2byte -align norec4byte -align norec8byte -align norec16byte -altparam -assume accuracy_sensitive -assume nobscc -assume nobuffered_io -assume byterecl -assume nocc_omp -assume nocstring -assume nodummy_aliases -assume nofpe_summary -assume noieee_fpe_flags -assume nominus0 -assume noold_boz -assume old_unit_star -assume noold_ldout_format -assume noold_logical_ldio -assume old_maxminloc -assume old_xor -assume protect_constants -assume noprotect_parens -assume split_common -assume source_include -assume nostd_intent_in -assume nostd_mod_proc_name -assume norealloc_lhs -assume underscore -assume no2underscores no -auto -auto_scalar no -bintext -ccdefault default -check noargs -check noarg_temp_created -check nobounds -check noformat -check nooutput_conversion -check nooverflow -check nopointers -check power -check noshape -check nounderflow -check nouninitialized -coarray-num-procs 0 no -coarray-config-file -convert big_endian -cross_reference -D __INTEL_COMPILER=1210 -D __unix__ -D __unix -D __linux__ -D __linux -D __gnu_linux__ -D unix -D linux -D __ELF__ -D __x86_64 -D __x86_64__ -D _MT -D __INTEL_COMPILER_BUILD_DATE=20120612 -D __i686 -D __i686__ -D __pentiumpro -D __pentiumpro__ -D __pentium4 -D __pentium4__ -D __tune_pentium4__ -D __SSE2__ -D __SSE__ -D __MMX__ -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 Page 7 Source Listing BUFR1B 2012-11-20 14:01 bufr1b.f -fpe3 -fprm nearest no -ftz -fp_model noprecise -fp_model nofast -fp_model strict -fp_model nosource -fp_model nodouble -fp_model noextended -fp_model novery_fast -fp_model noexcept -fp_model nono_except -fp_modbits nofp_contract -fp_modbits nono_fp_contract -fp_modbits nofenv_access -fp_modbits nono_fenv_access -fp_modbits nocx_limited_range -fp_modbits nono_cx_limited_range -fp_modbits noprec_div -fp_modbits nono_prec_div -fp_modbits noprec_sqrt -fp_modbits nono_prec_sqrt -fp_modbits noftz -fp_modbits no_ftz -fp_modbits nointrin_limited_range -fp_modbits nono_intrin_limited_range -fp_modbits notrunc_compares -fp_modbits nono_trunc_compares -fp_modbits noieee_nan_compares -fp_modbits nono_ieee_nan_compares -fp_modbits nohonor_f32_conversion -fp_modbits nono_honor_f32_conversion -fp_modbits nohonor_f64_conversion -fp_modbits nono_honor_f64_conversion -fp_modbits nono_x87_copy -fp_modbits nono_no_x87_copy -fp_modbits noexception_semantics -fp_modbits nono_exception_semantics -fp_modbits noprecise_libm_functions -fp_modbits nono_precise_libm_functions -heap_arrays 0 no -threadprivate_compat -g0 -iface nomixed_str_len_arg -iface nono_mixed_str_len_arg no -intconstant -integer_size 32 no -mixed_str_len_arg no -module -names lowercase no -noinclude -O2 no -pad_source -real_size 32 no -recursive -reentrancy none no -sharable_localsaves -vec=simd -show noinclude -show map -show options no -syntax_only no -threadcom no -U no -vms -w noall -w nonone -w alignments -w noargument_checking -w nodeclarations -w general -w noignore_bounds -w noignore_loc -w nointerfaces -w notruncated_source -w uncalled -w uninitialized -w nounused -w usage -includepath : /gpfs/tp2/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/,.f,./.f,/usrx/local/intel/composerxe/mkl/include/.f, /usrx/local/intel/composerxe/tbb/include/.f,/gpfs/tp2/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/intel64/.f, /gpfs/tp2/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/.f,/usr/local/include/.f,/usr/lib/gcc/x86_64-redhat-linux/4.4.6/include/.f, /usr/include/.f,/usr/include/.f -list filename : bufr1b.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100