Page 1 Source Listing BUFR_TRANGOESCLD 2012-11-20 14:02 trangoescld.f 1 C$$$ MAIN PROGRAM DOCUMENTATION BLOCK 2 C 3 C MAIN PROGRAM: BUFR_TRANGOESCLD 4 C PRGMMR: MELCHIOR ORG: NP22 DATE: 2012-11-07 5 C 6 C ABSTRACT: READS IN GOES CLOUD TOP DATA FROM NESDIS FLAT FILES IB WMO 7 C BUFR FORMAT, REFORMATS AND PACKS INTO AN NCEP BUFR FILE WHICH CAN 8 C BE DATABASED BY TRANJB. 9 C 10 C PROGRAM HISTORY LOG: 11 C 2001-04-12 L. SAGER - ORIGINAL AUTHOR 12 C 2001-07-31 D. KEYSER - ADDED GOES CLOUD TOP TEMP ("GDCTT") TO 13 C LIST OF VARIABLES READ IN AND WRITTEN OUT 14 C 2006-02-02 D. KEYSER - REPLACED CALL TO BUFRLIB ROUTINE IREADIBM 15 C WITH CALL TO BUFRLIB ROUTINE IREADMG (IREADIBM OBSOLETE WITH 16 C 1/31/2006 VERSION OF BUFRLIB) 17 C 2006-12-12 D. KEYSER - RENAMED FROM BUFR_TRAN1X1S TO 18 C BUFR_TRANGOESCLD SINCE THIS WILL NEVER PROCESS ANYTHING MORE THAN 19 C GOES CLOUD DATA (SFOV) 20 C 2012-11-07 S. Melchior - Changes to run on WCOSS (e.g., replaced 21 C dimension declarations with real(8), explicitly declared variable 22 C rid; replaced W3LIB with more specific W3NCO). 23 C 24 C USAGE: 25 C INPUT FILES: 26 C UNIT 05 - STANDARD INPUT. W3TRNARG PARSES ARGUMENTS FROM 27 C - STANDARD INPUT. 28 C UNIT 11 - WMO BUFR GOES CLOUD TOP DATA 29 C UNIT 19 - FOREIGN BUFR TABLE FILE CONTAINING BUFR TABLES A, 30 C - B, AND D (FOR UNIT 11). 31 C UNIT 20 - BUFR TABLE FILE CONTAINING BUFR TABLES A, B, AND 32 C D (FOR UNIT 51). 33 C 34 C OUTPUT FILES: 35 C UNIT 06 - PRINTOUT 36 C UNIT 51 - POINTS TO THE OUTPUT BUFR FILE. TRANJB WILL PLACE 37 C THE BUFR MESSAGES INTO THE PROPER TANKS. 38 C 39 C SUBPROGRAMS CALLED: 40 C UNIQUE - REMTDY 41 C LIBRARY: 42 C W3NCO - W3TRNARG W3TAGB W3TAGE W3FS26 W3DOXDAT ERREXIT 43 C BUFRLIB - OPENBF CLOSBF OPENMB UFBSEQ WRITSB IREADMG 44 C - IREADSB DATELEN 45 C 46 C EXIT STATES: 47 C COND = 0 - SUCCESSFUL RUN 48 C = 1 - UNABLE TO PARSE INPUT ARGUMENTS IN W3TRNARG 49 C = 99 - UNABLE TO DETERMINE SATELLITE ID FROM INPUT FILE 50 C = 253 - NO REPORTS WRITTEN OUT 51 C 52 C REMARKS: 53 C 54 C ---------------------------------------------------------------------- 55 C INPUT GOES CLOUD TOP SEQUENCE OF MNEMONICS (11) 56 C ---------------------------------------------------------------------- 57 C NC003000 | YEAR DOYR HOUR MINU SAID SIDU CLATH CLONH TOCC CDTP GCDTT Page 2 Source Listing BUFR_TRANGOESCLD 2012-11-20 14:02 trangoescld.f 58 C ---------------------------------------------------------------------- 59 C 60 C 61 C ATTRIBUTES: 62 C LANGUAGE: FORTRAN 90 63 C MACHINE: NCEP WCOSS 64 C 65 C$$$ 66 67 PROGRAM BUFR_TRANGOESCLD 68 69 PARAMETER (NDAT=11) 70 PARAMETER (NOUT=14) 71 72 real(8),dimension (NDAT) :: BUFRI 73 real(8) DATOUT(NOUT) 74 real(8) rid 75 INTEGER*8 IUFRI(NDAT) 76 EQUIVALENCE (IUFRI,BUFRI) 77 78 CHARACTER*8 SID 79 CHARACTER*8 SUBSET,TLFLAG,SUBFGN 80 CHARACTER*36 STROUT1,STROUT2 81 CHARACTER*80 APPCHR,SUBDIR,TANKID 82 83 84 DATA LUNIN /11/ 85 DATA LINDX /19/ 86 DATA LUNDX /20/ 87 DATA LUNOT /51/ 88 DATA BMISS /10E10/ 89 DATA SID /'????????'/ 90 DATA IDATE_prev/-99/,LDATE_prev/-99/ 91 92 DATA STROUT1 /'RPID YEAR MNTH DAYS HOUR MINU SECO '/ 93 DATA STROUT2 /'CLAT CLON SAID SIDU CDTP TOCC GCDTT '/ 94 95 EQUIVALENCE(SID,RID) 96 97 C----------------------------------------------------------------------- 98 CALL W3TAGB('BUFR_TRANGOESCLD',2012,0312,0081,'NP22') 99 PRINT *, ' ' 100 PRINT *, ' ==> Welcome to BUFR_TRANGOESCLD -- Version 11/07/2012' 101 PRINT *, ' ' 102 CALL W3TRNARG(SUBDIR,LSUBDR,TANKID,LTNKID,APPCHR,LAPCHR, 103 1 TLFLAG,JDATE,KDATE,IERR) 104 IF(IERR.NE.0) THEN 105 WRITE(6,'('' UNABLE TO PARSE ARGS TO TRANSLATION ROUTINE - '', 106 1 '' RETURN CODE = '',I5)') IERR 107 CALL W3TAGE('BUFR_TRANGOESCLD') 108 CALL ERREXIT(IERR) 109 ENDIF 110 SUBSET = 'NC'//SUBDIR(LSUBDR-2:LSUBDR)//TANKID(LTNKID-2:LTNKID) 111 C----------------------------------------------------------------------- 112 113 ipr = 0 114 IRD = 0 Page 3 Source Listing BUFR_TRANGOESCLD 2012-11-20 14:02 trangoescld.f 115 IWT = 0 116 KTSKPT=0 117 118 CALL DATELEN(10) 119 120 C OPEN AND READ THRU THE INPUT BUFR FILE 121 C -------------------------------------- 122 123 CALL OPENBF(LUNIN,'IN',LINDX) 124 ccccc CALL OPENBF(LUNOT,'OUT',LUNDX) 125 CALL OPENBF(LUNOT,'NODX',LUNDX) 126 127 C READ THROUGH THE MESSAGES/SUBSETS IN THE FILE 128 C --------------------------------------------- 129 icout = 0 130 DO WHILE(IREADMG(LUNIN,SUBFGN,IDATE).EQ.0) 131 IF(IDATE.NE.IDATE_prev) then 132 print *, ' ' 133 print *, 'OPENING INPUT MESSAGE WITH NEW DATE ',IDATE, 134 $ ' (SUBSET ',SUBFGN,')' 135 print *, ' ' 136 ENDIF 137 IDATE_prev = IDATE 138 DO WHILE(IREADSB(LUNIN).EQ.0) 139 140 C READ IN THE ENTIRE REPORT SEQUENCE 141 C ---------------------------------- 142 143 CALL UFBSEQ(LUNIN,BUFRI,NDAT,1,IRET,SUBFGN) 144 IRD=IRD+1 145 C IF(ipr .eq. 300) CALL UFBDMP(LUNIN) 146 147 ipr = ipr + 1 148 C IF(ipr .lt. 101) THEN 149 C print *,' ipr = ',ipr 150 C print *,' date ',(BUFRI(kk),kk=1,5) 151 C print 112,(IUFRI(kk),kk=1,5) 152 C112 FORMAT(5z18) 153 C print *,' data ',(BUFRI(kk),kk=6,NDAT) 154 C print 112,(IUFRI(kk),kk=6,NDAT) 155 C print *,' ' 156 C ENDIF 157 158 C 159 C CHECK FOR MISSING LAT LON 160 C 161 ALAT = BUFRI(7) 162 ALON = BUFRI(8) 163 IF(MAX(ALAT,ALON) .GE. BMISS) THEN 164 PRINT *,' ENCOUNTERED MISSING LAT/LON IN SUBSET ',SUBSET 165 KTSKPT = KTSKPT + 1 166 C 167 C CHECK THE INTERNAL DATE FOR REALISM 168 C ----------------------------------- 169 170 ELSE 171 IYR = NINT(BUFRI(1)) Page 4 Source Listing BUFR_TRANGOESCLD 2012-11-20 14:02 trangoescld.f 172 IDOY = NINT(BUFRI(2)) 173 IHR = NINT(BUFRI(3)) 174 MIN = NINT(BUFRI(4)) 175 ISEC = 0 ! Since ISEC aren't currently available set to 0 176 177 C CHECK FOR REPORT WITH VALID TIME STAMP 178 C -------------------------------------- 179 180 IF(IYR .LT.0 .OR. 181 . IDOY.LT.1 .OR. IDOY.GT.366 .OR. 182 . IHR .LT.0 .OR. IHR .GT. 24 .OR. 183 . MIN .LT.0 .OR. MIN .GT. 60 .OR. 184 . ISEC.LT.0 .OR. ISEC.GT. 60) THEN 185 PRINT '("BAD DATE:",2I4,3I3.2," SUBSET:",A8)', 186 . IYR,IDOY,IHR,MIN,ISEC,SUBSET 187 KTSKPT=KTSKPT+1 188 ELSE 189 190 C CONVERT INPUT DAY OF YEAR TO MONTH AND DAY 191 C ------------------------------------------ 192 CALL REMTDY(IYR,IDOY,MON,IDAY) 193 C write(6,'('' time stamp : '',6i4)') iyr,mon,iday,ihr,min,isec 194 195 C CHECK REPORT DATE (YYYYMMDDHH) TO SEE IF A NEW OUTPUT MESSAGE 196 C SHOULD BE OPENED (TRANJB TAKES CARE OF THIS FOR UNCOMPRESSED 197 C FILES, BUT IT DOESN'T HURT TO HAVE REDUNDANCY BUILT IN HERE) 198 C ------------------------------------------------------------- 199 200 LDATE = IYR*1000000+MON*10000+IDAY*100+IHR 201 C print *,' LDATE ',ldate 202 C print *,' SUBSET IS ',SUBSET 203 IF(LDATE.NE.LDATE_prev) then 204 print *, ' ' 205 print *, 'OPENING OUTPUT MESSAGE WITH NEW DATE ',LDATE, 206 $ ' (SUBSET ',SUBSET,')' 207 print *, ' ' 208 ENDIF 209 LDATE_prev = LDATE 210 CALL OPENMB(LUNOT,SUBSET,LDATE) 211 212 DATOUT(1) = RID 213 DATOUT(2) = IYR 214 DATOUT(3) = MON 215 DATOUT(4) = IDAY 216 DATOUT(5) = IHR 217 DATOUT(6) = MIN 218 DATOUT(7) = ISEC 219 DATOUT(8) = ALAT 220 DATOUT(9) = ALON 221 DATOUT(10) = BUFRI(5) 222 DATOUT(11) = BUFRI(6) 223 DATOUT(12) = BUFRI(10) 224 DATOUT(13) = BUFRI(9) 225 DATOUT(14) = BUFRI(11) 226 227 C WRITE A SUBSET 228 C -------------- Page 5 Source Listing BUFR_TRANGOESCLD 2012-11-20 14:02 trangoescld.f 229 230 CALL UFBINT(LUNOT,DATOUT,NOUT,1,IRET,STROUT1//STROUT2) 231 232 CALL WRITSB(LUNOT) 233 IWT=IWT+1 234 235 ENDIF 236 ENDIF 237 ENDDO 238 ENDDO 239 240 C WHEN FINISHED MAKE SURE ALL BUFFERS ARE FLUSHED THEN EXIT 241 C --------------------------------------------------------- 242 243 CALL CLOSBF(LUNIN) 244 CALL CLOSBF(LUNOT) 245 PRINT*,'*** PROCESSING ENDED NORMALLY ***' 246 PRINT*,'*** READ :',IRD 247 PRINT*,'*** WROT :',IWT 248 PRINT*,'*** SKIP :',KTSKPT 249 PRINT*,'*** PROCESSING ENDED NORMALLY ***' 250 IF(IWT.EQ.0) THEN 251 WRITE(6,2003) 252 2003 FORMAT(' NO REPORTS PROCESSED -- DISABLING ALL SUBSEQUENT ', 253 1 'PROCESSING.') 254 CALL W3TAGE('BUFR_TRANGOESCLD') 255 CALL ERREXIT(253) 256 ENDIF 257 CALL W3TAGE('BUFR_TRANGOESCLD') 258 259 STOP 260 END Page 6 Source Listing BUFR_TRANGOESCLD 2012-11-20 14:02 Entry Points trangoescld.f ENTRY POINTS Name MAIN__ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 2003 Label 252 251 ALAT Local 161 R(8) 8 scalar 161,163,219 ALON Local 162 R(8) 8 scalar 162,163,220 APPCHR Local 81 CHAR 80 scalar 102 BMISS Local 88 R(8) 8 scalar 88,163 BUFRI Local 72 R(8) 8 1 11 143,161,162,171,172,173,174,221,22 2,223,224,225 BUFR_TRANGOESCLD Prog 67 CLOSBF Subr 243 243,244 DATELEN Subr 118 118 DATOUT Local 73 R(8) 8 1 14 212,213,214,215,216,217,218,219,22 0,221,222,223,224,225,230 ERREXIT Subr 108 108,255 ICOUT Local 129 I(4) 4 scalar 129 IDATE Local 130 I(4) 4 scalar 130,131,133,137 IDATE_PREV Local 90 I(4) 4 scalar 90,131,137 IDAY Local 192 I(4) 4 scalar 192,200,215 IDOY Local 172 I(4) 4 scalar 172,181,186,192 IERR Local 103 I(4) 4 scalar 103,104,106,108 IHR Local 173 I(4) 4 scalar 173,182,186,200,216 IPR Local 113 I(4) 4 scalar 113,147 IRD Local 114 I(4) 4 scalar 114,144,246 IREADMG Func 130 I(4) 4 scalar 130 IREADSB Func 138 I(4) 4 scalar 138 IRET Local 143 I(4) 4 scalar 143,230 ISEC Local 175 I(4) 4 scalar 175,184,186,218 IUFRI Local 75 I(8) 8 1 11 IWT Local 115 I(4) 4 scalar 115,233,247,250 IYR Local 171 I(4) 4 scalar 171,180,186,192,200,213 JDATE Local 103 I(4) 4 scalar 103 KDATE Local 103 I(4) 4 scalar 103 KTSKPT Local 116 I(4) 4 scalar 116,165,187,248 LAPCHR Local 102 I(4) 4 scalar 102 LDATE Local 200 I(4) 4 scalar 200,203,205,209,210 LDATE_PREV Local 90 I(4) 4 scalar 90,203,209 LINDX Local 85 I(4) 4 scalar 85,123 LSUBDR Local 102 I(4) 4 scalar 102,110 LTNKID Local 102 I(4) 4 scalar 102,110 LUNDX Local 86 I(4) 4 scalar 86,125 LUNIN Local 84 I(4) 4 scalar 84,123,130,138,143,243 LUNOT Local 87 I(4) 4 scalar 87,125,210,230,232,244 MAX Func 163 scalar 163 MIN Local 174 I(4) 4 scalar 174,183,186,217 MON Local 192 I(4) 4 scalar 192,200,214 Page 7 Source Listing BUFR_TRANGOESCLD 2012-11-20 14:02 Symbol Table trangoescld.f Name Object Declared Type Bytes Dimen Elements Attributes References NDAT Param 69 I(4) 4 scalar 72,75,143 NINT Func 171 scalar 171,172,173,174 NOUT Param 70 I(4) 4 scalar 73,230 OPENBF Subr 123 123,125 OPENMB Subr 210 210 REMTDY Subr 192 192 RID Local 74 R(8) 8 scalar 212 SID Local 78 CHAR 8 scalar 89 STROUT1 Local 80 CHAR 36 scalar 92,230 STROUT2 Local 80 CHAR 36 scalar 93,230 SUBDIR Local 81 CHAR 80 scalar 102,110 SUBFGN Local 79 CHAR 8 scalar 130,134,143 SUBSET Local 79 CHAR 8 scalar 110,164,186,206,210 TANKID Local 81 CHAR 80 scalar 102,110 TLFLAG Local 79 CHAR 8 scalar 103 UFBINT Subr 230 230 UFBSEQ Subr 143 143 W3TAGB Subr 98 98 W3TAGE Subr 107 107,254,257 W3TRNARG Subr 102 102 WRITSB Subr 232 232 Page 8 Source Listing BUFR_TRANGOESCLD 2012-11-20 14:02 trangoescld.f 261 262 C$$$ SUBPROGRAM DOCUMENTATION BLOCK 263 C 264 C SUBPROGRAM: REMTDY 265 C PRGMMR: SAGER ORG: NP12 DATE: 2001-03-20 266 C 267 C ABSTRACT: DETERMINES MONTH OF YEAR AND DAY OF MONTH GIVEN 268 C FOURT-DIGIT YEAR AND DAY OF YEAR. 269 C 270 C PROGRAM HISTORY LOG: 271 C 2001-03-20 L. SAGER -- ORIGINAL AUTHOR 272 C 273 C USAGE: CALL REMTDY(IYEAR,IDOY,MON,IDAY) 274 C INPUT ARGUMENT LIST: 275 C IYEAR - YEAR (YYYY) 276 C IDOY - DAY OF YEAR 277 C 278 C OUTPUT ARGUMENT LIST: 279 C MON - MONTH OF YEAR 280 C IDAY - DAY OF MONTH 281 C 282 C OUTPUT FILES: 283 C UNIT 06 - PRINTOUT 284 C 285 C REMARKS: THIS SUBROUTINE WILL WORK FROM 1583 A.D. TO 3300 A.D. 286 C 287 C ATTRIBUTES: 288 C LANGUAGE: FORTRAN 90 289 C MACHINE: NCEP WCOSS 290 C 291 C$$$ 292 SUBROUTINE REMTDY(IYEAR,IDOY,MON,IDAY) 293 294 INTEGER IDAT(8) 295 296 DATA IDAT /0,1,1,5*0/ 297 298 C First, calculate the Julian day on Jan. 1 of year. 299 300 ccccc print *,' remtdy iyear dayyr = ',iyear,idoy 301 IDAT(1) = IYEAR 302 CALL W3DOXDAT(IDAT,JDOW,JDOY,JDAY) 303 304 ccccc print *,' dox-dow doy day ',jdow,jdoy,jday 305 306 C Add the day-of-year from the goes report to Julian day. 307 308 jday = jday + idoy - 1 309 ccccc print *,' updated jday idoy are ',jday,idoy 310 311 C Call W3FS26 to get month/day from the Julian day for goes report. 312 313 CALL W3FS26(JDAY,IYEAR,MON,IDAY,IDAYWK,IDAYYR) 314 ccccc print *,' year, month, day = ',iyear,mon,iday 315 316 RETURN 317 END Page 9 Source Listing REMTDY 2012-11-20 14:02 Entry Points trangoescld.f ENTRY POINTS Name remtdy_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References IDAT Local 294 I(4) 4 1 8 296,301,302 IDAY Dummy 292 I(4) 4 scalar ARG,INOUT 313 IDAYWK Local 313 I(4) 4 scalar 313 IDAYYR Local 313 I(4) 4 scalar 313 IDOY Dummy 292 I(4) 4 scalar ARG,INOUT 308 IYEAR Dummy 292 I(4) 4 scalar ARG,INOUT 301,313 JDAY Local 302 I(4) 4 scalar 302,308,313 JDOW Local 302 I(4) 4 scalar 302 JDOY Local 302 I(4) 4 scalar 302 MON Dummy 292 I(4) 4 scalar ARG,INOUT 313 REMTDY Subr 292 W3DOXDAT Subr 302 302 W3FS26 Subr 313 313 Page 10 Source Listing REMTDY 2012-11-20 14:02 trangoescld.f 318 Page 11 Source Listing REMTDY 2012-11-20 14:02 Subprograms/Common Blocks trangoescld.f SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References BUFR_TRANGOESCLD Prog 67 REMTDY Subr 292 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 nobyterecl -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 12 Source Listing REMTDY 2012-11-20 14:02 trangoescld.f -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 -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 64 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 : trangoescld.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100