Page 1 Source Listing BUFR_TRANSSND 2012-11-20 14:07 transsnd.f 1 C$$$ MAIN PROGRAM DOCUMENTATION BLOCK 2 C 3 C MAIN PROGRAM: BUFR_TRANSSND 4 C PRGMMR: MELCHIOR ORG: NP22 DATE: 2012-11-07 5 C 6 C ABSTRACT: READS IN GOES SOUNDINGS AND RADIANCES FROM NESDIS 7 C ORBIT-BY-ORBIT FILES IN WMO BUFR FORMAT, REFORMATS AND 8 C PACKS INTO A BUFR FILE WHICH CAN BE DATABASED BY TRANJB. 9 C 10 C PROGRAM HISTORY LOG: 11 C 1996-07-22 B. KATZ - ORIGINAL AUTHOR 12 C 1998-03-23 B. KATZ - REMOVED W3LOG CALLS 13 C 1998-12-01 B. KATZ - CHANGES FOR Y2K AND FORTRAN 90 COMPLIANCE, 14 C INCLUDING CHANGES TO FEED OUTPUT TO TRANJB SCRIPT, RATHER THAN 15 C WRITE DIRECTLY TO TANKS 16 C 1999-02-10 B. KATZ - REPLACED REFERENCE TO CLBUFR BY CALLS TO 17 C CLOSBF 18 C 1999-08-25 D. KEYSER - ADDED ERROR HANDLING WHEN NO OUTPUT IS 19 C CREATED SO THAT SUBSEQUENT TRANJB'S ARE SKIPPED. 20 C 2000-04-27 D. KEYSER - FIXED BAD DATE DIAGNOSTIC PRINT TO LIST 21 C VALUES FOR HOUR AND MINUTE AND PROPER VALUE FOR BUFR SUBSET 22 C 2000-11-09 D. KEYSER - ADDED ENCODING OF REPORT ID ("RPID"), SET TO 23 C "????????". SKIPS OVER "FILLER" REPORTS WHICH CONTAIN NO 24 C INFORMATION (INDICATED BY MISSING LAT/LON). 25 C 2001-03-30 D. KEYSER - NOW CHECKS YYYYMMDDHH OF EACH REPORT TO SEE 26 C IF A NEW OUTPUT MESSAGE SHOULD BE OPENED WITH THIS DATE, ENSURES 27 C THAT OUTPUT FILE BUFR MESSAGES CONTAIN ONLY REPORTS WITH SAME 28 C YYYYMMDDHH AS MESSAGE (THIS IS A REDUNDANT CHECK FOR UNCOMPRESSED 29 C FILES SINCE SUBSEQUENT BUFR_TRANJB PROGRAM ALSO DOES THIS, BUT 30 C THIS CHECK DOESN'T COST ANY TIME AND IT WILL BE IMPORTANT IF 31 C THESE FILES ARE EVER COMPRESSED); STREAMLINED CODE 32 C 2001-05-03 D. KEYSER - CORRECTED AN ERROR INTRODUCED IN PREVIOUS 33 C IMPLEMENTATION WHICH LED TO ALL REPORTS WITH AN ACTUAL HOUR PRIOR 34 C TO 00Z BEING ASSIGNED A YEAR, MONTH AND DAY 24-HOURS LATER THAN 35 C ACTUAL WHEN THE REPORTS WERE IN A FILE WITH AN HOUR QUALIFIER OF 36 C 00 (THE FIRST FILE OF THE NEXT, NEW DAY) (ALL SUCH REPORTS WERE 37 C LATER REJECTED IN THE BUFR_TRANJB DATE CHECKING ROUTINE) 38 C 2001-05-18 D. KEYSER - REFINED CONVERSION FROM GROUP YEAR, MONTH, 39 C DAY TO ACTUAL YEAR, MONTH, DAY: IF GROUP HOUR IS 00 OR 01 AND 40 C ACTUAL HOUR IS 22 OR 23, ACTUAL YEAR, MONTH AND DAY IS 1-DAY 41 C EARLIER THAN GROUP YEAR MONTH DAY, OTHERWISE THEY ARE THE SAME 42 C (PRIOR TO THIS THE DAY WAS REDUCED BY ONE ONLY WHEN THE GROUP 43 C HOUR WAS 00 AND THE ACTUAL HOUR WAS NOT 00, REPORTS WITH GROUP 44 C HOUR 01 AND ACTUAL HOUR 23 WERE ASSIGNED THE WRONG YEAR, MONTH 45 C AND DAY) 46 C 2006-02-02 D. KEYSER - REPLACED LOCAL MNEMONIC "PH2O" WITH WMO 47 C MNEMONIC "TPWT" (CORRESPONDING TO SIMULTANEOUS CHANGE IN BUFR 48 C TABLE IN UNIT 20); ADDED "DINU" (DETECTOR INSTRUMENT NUMBER) TO 49 C LIST OF PARAMETERS TRANSFERRED TO NCEP BUFR FILE (ONLY PRESENT IN 50 C GOES 1x1 REPORTS); REPLACED CALL TO BUFRLIB ROUTINE IREADIBM WITH 51 C CALL TO BUFRLIB ROUTINE IREADMG (IREADIBM OBSOLETE WITH 1/31/2006 52 C VERSION OF BUFRLIB) 53 C 2007-08-07 D. KEYSER - LIMITS NUMBER OF LINES THAT ARE PRINTED WHEN 54 C REPORT LAT/LON IS MISSING TO 100 (USED TO PRINT ALL REPORTS) 55 C 2012-11-07 S. Melchior - Changes to run on WCOSS (e.g., replaced all 56 C dimension declarations with real or real(8), explicitly declared 57 C variable rid; replaced W3LIB with more specific W3NCO). Page 2 Source Listing BUFR_TRANSSND 2012-11-20 14:07 transsnd.f 58 C 59 C USAGE: 60 C INPUT FILES: 61 C UNIT 05 - STANDARD INPUT. W3TRNARG PARSES ARGUMENTS FROM 62 C - STANDARD INPUT. 63 C UNIT 11 - NESDIS WMO BUFR FILE. 64 C UNIT 19 - FOREIGN BUFR TABLE FILE CONTAINING BUFR TABLES A, 65 C - B, AND D (FOR UNIT 11). 66 C UNIT 20 - BUFR TABLE FILE CONTAINING BUFR TABLES A, B, AND 67 C D (FOR UNIT 51). 68 C 69 C OUTPUT FILES: 70 C UNIT 06 - PRINTOUT 71 C UNIT 51 - POINTS TO THE OUTPUT BUFR FILE. TRANJB WILL PLACE 72 C THE BUFR MESSAGES INTO THE PROPER TANKS. 73 C 74 C SUBPROGRAMS CALLED: 75 C UNIQUE - REMTDY 76 C LIBRARY: 77 C W3NCO - W3TRNARG W3TAGB W3TAGE W3FS26 W3DOXDAT ERREXIT 78 C - W3MOVDAT 79 C BUFRLIB - OPENBF CLOSBF OPENMB UFBINT UFBREP WRITSB 80 C - IREADMG IREADSB DATELEN 81 C 82 C EXIT STATES: 83 C COND = 0 - SUCCESSFUL RUN 84 C = 1 - UNABLE TO PARSE INPUT ARGUMENTS IN W3TRNARG 85 C = 253 - NO REPORTS WRITTEN OUT 86 C 87 C ATTRIBUTES: 88 C LANGUAGE: FORTRAN 90 89 C MACHINE: NCEP WCOSS 90 C 91 C$$$ 92 PROGRAM BUFR_TRANSSND 93 94 real(8) DATES(5,2) 95 real(8) DATOUT(7) 96 real(8) XLOCAT(2),SATINF(7) 97 real(8) TEMPDB(2,41),TEMPDP(2,41) 98 real(8) BRIGHT(72) 99 real(8) BRTOUT(2,18) 100 real(8) SUNDRY(7) 101 real(8) PRECWT(5) 102 real(8) PRCOUT(4) 103 real(8) PRSHGT(2,41),RETOUT(4,41) 104 real(8) rid 105 real KDAT(8) 106 107 CHARACTER*8 SUBSET,SUBFGN,SID 108 109 CHARACTER*12 SUBDIR,TANKID 110 CHARACTER*80 APPCHR 111 CHARACTER*8 TLFLAG 112 113 EQUIVALENCE (RID,SID) 114 Page 3 Source Listing BUFR_TRANSSND 2012-11-20 14:07 transsnd.f 115 DATA LUNIN /11/ 116 DATA LINDX /19/ 117 DATA LUNDX /20/ 118 DATA LUNOT /51/ 119 DATA BMISS /10E10/ 120 121 DATA IDATE_prev/-99/,LDATE_prev/-99/ 122 123 C----------------------------------------------------------------------- 124 CALL W3TAGB('BUFR_TRANSSND',2012,0312,0082,'NP22') 125 PRINT *, ' ' 126 PRINT *, ' ==> Welcome to BUFR_TRANSSND -- Version 11/07/2012' 127 PRINT *, ' ' 128 CALL W3TRNARG(SUBDIR,LSUBDR,TANKID,LTNKID,APPCHR,LAPCHR, 129 1 TLFLAG,JDATE,KDATE,IERR) 130 IF(IERR.NE.0) THEN 131 WRITE(6,'('' UNABLE TO PARSE ARGS TO TRANSLATION ROUTINE - '', 132 1 '' RETURN CODE = '',I5)') IERR 133 CALL W3TAGE('BUFR_TRANSSND') 134 CALL ERREXIT(IERR) 135 ENDIF 136 SUBSET = 'NC'//SUBDIR(LSUBDR-2:LSUBDR)//TANKID(LTNKID-2:LTNKID) 137 C----------------------------------------------------------------------- 138 139 IRD = 0 140 IWT = 0 141 KTSKPT=0 142 IMSG_LALO = 0 143 144 CALL DATELEN(10) 145 146 ccccc CALL OPENBF(0,'QUIET',2) ! Uncomment for extra print from bufrlib 147 148 C OPEN AND READ THRU THE INPUT BUFR FILE 149 C -------------------------------------- 150 151 CALL OPENBF(LUNIN,'IN',LINDX) 152 ccccc CALL OPENBF(LUNOT,'OUT',LUNDX) 153 CALL OPENBF(LUNOT,'NODX',LUNDX) 154 155 C READ THROUGH THE MESSAGES/SUBSETS IN THE FILE 156 C --------------------------------------------- 157 158 DO WHILE(IREADMG(LUNIN,SUBFGN,IDATE).EQ.0) 159 ccccc print *,' IDATE ',idate 160 ccccc print *,' SUBFGN IS ',SUBFGN 161 IF(IDATE.NE.IDATE_prev) then 162 print *, ' ' 163 print *, 'OPENING INPUT MESSAGE WITH NEW DATE ',IDATE, 164 $ ' (SUBSET ',SUBFGN,')' 165 print *, ' ' 166 ENDIF 167 IDATE_prev = IDATE 168 DO WHILE(IREADSB(LUNIN).EQ.0) 169 170 C READ THE INTERNAL LAT/LON AND DATE AND CHECK FOR REALISM 171 C -------------------------------------------------------- Page 4 Source Listing BUFR_TRANSSND 2012-11-20 14:07 transsnd.f 172 173 CALL UFBINT(LUNIN,XLOCAT,2,1,IRET,'CLATH CLONH') 174 ccccc write(6,'('' latitude, longitude :'',1p2e12.4)') xlocat 175 ALAT = XLOCAT(1) 176 ALON = XLOCAT(2) 177 CALL UFBREP(LUNIN,DATES,5,2,IRET,'YEAR DOYR HOUR MINU SECO') 178 cppppp 179 cccc write(6,'('' INPUT GROUP DATE (YYYY DDD HH MM SS) :'', 180 cccc . 1x,2i4,2x,3i3.2)') nint(dates(1:5,1)) 181 cccc write(6,'('' INPUT PROCESSING DATE (YYYY DDD) :'', 182 cccc . 1x,2i4)') nint(dates(1:2,2)) 183 cccc write(6,'('' INPUT ACTUAL DATE (HH MM SS) :'', 184 cccc . 11x,3i3.2)') nint(dates(3:5,2)) 185 cppppp 186 IYRFIL = NINT(DATES(1,1)) 187 IDOYFIL = NINT(DATES(2,1)) 188 IHRFIL = NINT(DATES(3,1)) 189 IHR = NINT(DATES(3,2)) 190 MIN = NINT(DATES(4,2)) 191 ISEC = NINT(DATES(5,2)) 192 IRD = IRD+1 193 194 IF(MAX(ALAT,ALON) .GE. BMISS) THEN 195 IMSG_LALO=IMSG_LALO+1 196 IF(IMSG_LALO.LE.100) 197 $ PRINT '(" MISSING LAT/LON: SUBSET:",A8)', SUBSET 198 KTSKPT=KTSKPT+1 199 ELSE IF(IYRFIL .LT.0 .OR. 200 . IDOYFIL.LT.1 .OR. IDOYFIL.GT.366 .OR. 201 . IHRFIL .LT.0 .OR. IHRFIL .GT. 24 .OR. 202 . IHR .LT.0 .OR. IHR .GT. 24 .OR. 203 . MIN .LT.0 .OR. MIN .GT. 60 .OR. 204 . ISEC .LT.0 .OR. ISEC .GT. 60) THEN 205 PRINT '("BAD DATE:: GROUP(YYYY DDD HH):",2I4,I3.2, 206 . " ACTUAL(HH MM SS):",3I3.2," SUBSET:",A8)', 207 . IYRFIL,IDOYFIL,IHRFIL,IHR,MIN,ISEC,SUBSET 208 KTSKPT=KTSKPT+1 209 ELSE 210 211 C CONVERT INPUT GROUP DAY OF YEAR TO GROUP MONTH AND DAY 212 C ------------------------------------------------------ 213 214 CALL REMTDY(IYRFIL,IDOYFIL,MONFIL,IDAYFIL) 215 cppppp 216 cccc write(6,'('' CONVERTED GROUP DATE (MM DD) :'', 217 cccc . 5x,2i3.2)') monfil,idayfil 218 cppppp 219 220 C CONVERT GROUP YEAR, MONTH AND DAY TO ACTUAL VALUES 221 C - if group hour is 00 or 01 and actual hour is 222 C 22 or 23, actual year month and day is 1-day 223 C earlier than group year month day; otherwise 224 C they are the same 225 C -------------------------------------------------- 226 227 IF(IHRFIL.LE.01 .AND. IHR.GE.22) THEN 228 CALL W3MOVDAT((/-1.0,0.,0.,0.,0./),(/IYRFIL,MONFIL,IDAYFIL, Page 5 Source Listing BUFR_TRANSSND 2012-11-20 14:07 transsnd.f 229 . 0,0,0,0,0/),KDAT) 230 IYR = KDAT(1) 231 MON = KDAT(2) 232 IDAY = KDAT(3) 233 ELSE 234 IYR = IYRFIL 235 MON = MONFIL 236 IDAY = IDAYFIL 237 END IF 238 239 DATOUT(1) = IYR 240 DATOUT(2) = MON 241 DATOUT(3) = IDAY 242 DATOUT(4:6) = DATES(3:5,2) 243 cppppp 244 cccc write(6,'('' OUTPUT ACTUAL DATE (YYYY MM DD HH MM SS):'', 245 cccc . 1x,i4,5i3.2)') nint(datout(1:6)) 246 cppppp 247 SID = '????????' 248 DATOUT(7) = RID 249 250 CALL UFBINT(LUNIN,SATINF,7,1,IRET, 251 1 'SAID SIDU GSDP QMRK ACAV DINU TCSF') 252 ccccc write(6,'('' satid instr. data q.mk flds-of-view dectector #''/ 253 ccccc1 f6.1,8x,f6.1,6x,f6.1,6x,f6.1,6x,f6.1,6x,f6.1)') 254 ccccc2 (satinf(ii),ii=1,6) 255 256 CALL UFBREP(LUNIN,BRIGHT,1,72,IRET,'TMBR') 257 ccccc write(6,'('' brightness temperatures : ''/(1x,1p4e12.4))') 258 ccccc1 (bright(i),bright(i+18),bright(i+36),bright(i+54),i=1,18) 259 DO I = 1,18 260 BRTOUT(1,I) = I 261 ENDDO 262 BRTOUT(2,1:18) = BRIGHT(1:18) 263 264 CALL UFBINT(LUNIN,SUNDRY,7,1,IRET, 265 1 'SOEL ELEV GLFTI CLAM CDTP GCDTT TMSK') 266 ccccc write(6,'('' solar zenith sat. zenith cloud amt. cld top prs'' 267 ccccc1 '' cld top tmp skin temp''/1x,1p6e12.4)') sundry 268 269 CALL UFBREP(LUNIN,PRECWT,1,5,IRET,'TPWT') 270 ccccc write(6,'('' tot prch2o guess prch2o 3layr prch2o''/ 271 ccccc1 1x,1p5e12.4))') precwt 272 PRCOUT(1) = PRECWT(1) 273 PRCOUT(2:4) = PRECWT(3:5) 274 275 CALL UFBREP(LUNIN,PRSHGT,2,41,IRET,'PRLC HITE') 276 ccccc write(6,'('' pressure and geop height : ''/(1x,1p2e12.4))') prshgt 277 CALL UFBREP(LUNIN,TEMPDB,1,82,IRET,'TMDB') 278 CALL UFBREP(LUNIN,TEMPDP,1,82,IRET,'TMDP') 279 ccccc write(6,'('' temperature and dew point : ''/(1x,1p4e12.4))') 280 ccccc1 (tempdb(1,i),tempdp(1,i),tempdb(2,i),tempdp(2,i),i=1,41) 281 RETOUT(1,1:41) = PRSHGT(1,1:41) 282 RETOUT(2,1:41) = TEMPDB(1,1:41) 283 RETOUT(3,1:41) = TEMPDP(1,1:41) 284 RETOUT(4,1:41) = PRSHGT(2,1:41) 285 Page 6 Source Listing BUFR_TRANSSND 2012-11-20 14:07 transsnd.f 286 C CHECK REPORT DATE (YYYYMMDDHH) TO SEE IF A NEW OUTPUT MESSAGE 287 C SHOULD BE OPENED (TRANJB TAKES CARE OF THIS FOR UNCOMPRESSED 288 C FILES, BUT IT DOESN'T HURT TO HAVE REDUNDANCY BUILT IN HERE) 289 C ------------------------------------------------------------- 290 291 LDATE = IYRFIL*1000000+MON*10000+IDAY*100+IHR 292 ccccc print *,' LDATE ',ldate 293 ccccc print *,' SUBSET IS ',SUBSET 294 IF(LDATE.NE.LDATE_prev) then 295 print *, ' ' 296 print *, 'OPENING OUTPUT MESSAGE WITH NEW DATE ',LDATE, 297 $ ' (SUBSET ',SUBSET,')' 298 print *, ' ' 299 ENDIF 300 LDATE_prev = LDATE 301 CALL OPENMB(LUNOT,SUBSET,LDATE) 302 303 C WRITE A SUBSET 304 C -------------- 305 306 CALL UFBINT(LUNOT,DATOUT,7,1,IRET, 307 1 'YEAR MNTH DAYS HOUR MINU SECO RPID') 308 CALL UFBINT(LUNOT,XLOCAT,2,1,IRET,'CLAT CLON') 309 CALL UFBINT(LUNOT,SATINF,7,1,IRET, 310 1 'SAID SIDU GSDP QMRK ACAV DINU TCSF') 311 CALL UFBINT(LUNOT,SUNDRY,7,1,IRET, 312 1 'SOEL ELEV GLFTI CLAM CDTP GCDTT TMSK') 313 CALL UFBINT(LUNOT,BRTOUT,2,18,IRET,'CHNM TMBR') 314 CALL UFBINT(LUNOT,PRCOUT,4,1,IRET,'TPWT PH2O19 PH2O97 PH2O73') 315 CALL UFBINT(LUNOT,RETOUT,4,41,IRET,'PRLC TMDB TMDP HGHT') 316 CALL WRITSB(LUNOT) 317 318 IWT = IWT+1 319 320 ENDIF 321 ENDDO 322 ENDDO 323 324 C WHEN FINISHED MAKE SURE ALL BUFFERS ARE FLUSHED THEN EXIT 325 C --------------------------------------------------------- 326 327 CALL CLOSBF(LUNIN) 328 CALL CLOSBF(LUNOT) 329 IF(IMSG_LALO.GT.100) THEN 330 PRINT'(/I6," OCCURRENCES OF MISSING LAT/LON (ONLY FIRST 100 ", 331 $ "PRINTED) - SUBSET ",A8/)', IMSG_LALO,SUBSET 332 ENDIF 333 PRINT*,'*** PROCESSING ENDED NORMALLY ***' 334 PRINT*,'*** READ :',IRD 335 PRINT*,'*** WROT :',IWT 336 PRINT*,'*** SKIP :',KTSKPT 337 PRINT*,'*** PROCESSING ENDED NORMALLY ***' 338 IF(IWT.EQ.0) THEN 339 WRITE(6,2003) 340 2003 FORMAT(' NO REPORTS PROCESSED -- DISABLING ALL SUBSEQUENT ', 341 1 'PROCESSING.') 342 CALL W3TAGE('BUFR_TRANSSND') Page 7 Source Listing BUFR_TRANSSND 2012-11-20 14:07 transsnd.f 343 CALL ERREXIT(253) 344 ENDIF 345 CALL W3TAGE('BUFR_TRANSSND') 346 347 STOP 348 END ENTRY POINTS Name MAIN__ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 2003 Label 340 339 ALAT Local 175 R(8) 8 scalar 175,194 ALON Local 176 R(8) 8 scalar 176,194 APPCHR Local 110 CHAR 80 scalar 128 BMISS Local 119 R(8) 8 scalar 119,194 BRIGHT Local 98 R(8) 8 1 72 256,262 BRTOUT Local 99 R(8) 8 2 36 260,262,313 BUFR_TRANSSND Prog 92 CLOSBF Subr 327 327,328 DATELEN Subr 144 144 DATES Local 94 R(8) 8 2 10 177,186,187,188,189,190,191,242 DATOUT Local 95 R(8) 8 1 7 239,240,241,242,248,306 ERREXIT Subr 134 134,343 I Local 259 I(4) 4 scalar 259,260 IDATE Local 158 I(4) 4 scalar 158,161,163,167 IDATE_PREV Local 121 I(4) 4 scalar 121,161,167 IDAY Local 232 I(4) 4 scalar 232,236,241,291 IDAYFIL Local 214 I(4) 4 scalar 214,228,236 IDOYFIL Local 187 I(4) 4 scalar 187,200,207,214 IERR Local 129 I(4) 4 scalar 129,130,132,134 IHR Local 189 I(4) 4 scalar 189,202,207,227,291 IHRFIL Local 188 I(4) 4 scalar 188,201,207,227 IMSG_LALO Local 142 I(4) 4 scalar 142,195,196,329,331 IRD Local 139 I(4) 4 scalar 139,192,334 IREADMG Func 158 I(4) 4 scalar 158 IREADSB Func 168 I(4) 4 scalar 168 IRET Local 173 I(4) 4 scalar 173,177,250,256,264,269,275,277,27 8,306,308,309,311,313,314,315 ISEC Local 191 I(4) 4 scalar 191,204,207 IWT Local 140 I(4) 4 scalar 140,318,335,338 IYR Local 230 I(4) 4 scalar 230,234,239 IYRFIL Local 186 I(4) 4 scalar 186,199,207,214,228,234,291 JDATE Local 129 I(4) 4 scalar 129 KDAT Local 105 R(8) 8 1 8 229,230,231,232 KDATE Local 129 I(4) 4 scalar 129 KTSKPT Local 141 I(4) 4 scalar 141,198,208,336 LAPCHR Local 128 I(4) 4 scalar 128 LDATE Local 291 I(4) 4 scalar 291,294,296,300,301 Page 8 Source Listing BUFR_TRANSSND 2012-11-20 14:07 Symbol Table transsnd.f Name Object Declared Type Bytes Dimen Elements Attributes References LDATE_PREV Local 121 I(4) 4 scalar 121,294,300 LINDX Local 116 I(4) 4 scalar 116,151 LSUBDR Local 128 I(4) 4 scalar 128,136 LTNKID Local 128 I(4) 4 scalar 128,136 LUNDX Local 117 I(4) 4 scalar 117,153 LUNIN Local 115 I(4) 4 scalar 115,151,158,168,173,177,250,256,26 4,269,275,277,278,327 LUNOT Local 118 I(4) 4 scalar 118,153,301,306,308,309,311,313,31 4,315,316,328 MAX Func 194 scalar 194 MIN Local 190 I(4) 4 scalar 190,203,207 MON Local 231 I(4) 4 scalar 231,235,240,291 MONFIL Local 214 I(4) 4 scalar 214,228,235 NINT Func 186 scalar 186,187,188,189,190,191 OPENBF Subr 151 151,153 OPENMB Subr 301 301 PRCOUT Local 102 R(8) 8 1 4 272,273,314 PRECWT Local 101 R(8) 8 1 5 269,272,273 PRSHGT Local 103 R(8) 8 2 82 275,281,284 REMTDY Subr 214 214 RETOUT Local 103 R(8) 8 2 164 281,282,283,284,315 RID Local 104 R(8) 8 scalar 248 SATINF Local 96 R(8) 8 1 7 250,309 SID Local 107 CHAR 8 scalar 247 SUBDIR Local 109 CHAR 12 scalar 128,136 SUBFGN Local 107 CHAR 8 scalar 158,164 SUBSET Local 107 CHAR 8 scalar 136,197,207,297,301,331 SUNDRY Local 100 R(8) 8 1 7 264,311 TANKID Local 109 CHAR 12 scalar 128,136 TEMPDB Local 97 R(8) 8 2 82 277,282 TEMPDP Local 97 R(8) 8 2 82 278,283 TLFLAG Local 111 CHAR 8 scalar 129 UFBINT Subr 173 173,250,264,306,308,309,311,313,31 4,315 UFBREP Subr 177 177,256,269,275,277,278 W3MOVDAT Subr 228 228 W3TAGB Subr 124 124 W3TAGE Subr 133 133,342,345 W3TRNARG Subr 128 128 WRITSB Subr 316 316 XLOCAT Local 96 R(8) 8 1 2 173,175,176,308 Page 9 Source Listing BUFR_TRANSSND 2012-11-20 14:07 transsnd.f 349 350 C$$$ SUBPROGRAM DOCUMENTATION BLOCK 351 C 352 C SUBPROGRAM: REMTDY 353 C PRGMMR: SAGER ORG: NP12 DATE: 2001-03-20 354 C 355 C ABSTRACT: DETERMINES MONTH OF YEAR AND DAY OF MONTH GIVEN 356 C FOURT-DIGIT YEAR AND DAY OF YEAR. 357 C 358 C PROGRAM HISTORY LOG: 359 C 2001-03-20 L. SAGER -- ORIGINAL AUTHOR 360 C 361 C USAGE: CALL REMTDY(IYEAR,IDOY,MON,IDAY) 362 C INPUT ARGUMENT LIST: 363 C IYEAR - YEAR (YYYY) 364 C IDOY - DAY OF YEAR 365 C 366 C OUTPUT ARGUMENT LIST: 367 C MON - MONTH OF YEAR 368 C IDAY - DAY OF MONTH 369 C 370 C OUTPUT FILES: 371 C UNIT 06 - PRINTOUT 372 C 373 C REMARKS: THIS SUBROUTINE WILL WORK FROM 1583 A.D. TO 3300 A.D. 374 C 375 C ATTRIBUTES: 376 C LANGUAGE: FORTRAN 90 377 C MACHINE: NCEP WCOSS 378 C$$$ 379 SUBROUTINE REMTDY(IYEAR,IDOY,MON,IDAY) 380 381 INTEGER IDAT(8) 382 383 DATA IDAT /0,1,1,5*0/ 384 385 C First, calculate the Julian day on Jan. 1 of year. 386 387 ccccc print *,' remtdy iyear dayyr = ',iyear,idoy 388 IDAT(1) = IYEAR 389 CALL W3DOXDAT(IDAT,JDOW,JDOY,JDAY) 390 391 ccccc print *,' dox-dow doy day ',jdow,jdoy,jday 392 393 C Add the day-of-year from the sbuv report to Julian day. 394 395 jday = jday + idoy - 1 396 ccccc print *,' updated jday idoy are ',jday,idoy 397 398 C Call W3FS26 to get month/day from the Julian day for sbuv report. 399 400 CALL W3FS26(JDAY,IYEAR,MON,IDAY,IDAYWK,IDAYYR) 401 ccccc print *,' year, month, day = ',iyear,mon,iday 402 403 RETURN 404 END Page 10 Source Listing REMTDY 2012-11-20 14:07 Entry Points transsnd.f ENTRY POINTS Name remtdy_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References IDAT Local 381 I(4) 4 1 8 383,388,389 IDAY Dummy 379 I(4) 4 scalar ARG,INOUT 400 IDAYWK Local 400 I(4) 4 scalar 400 IDAYYR Local 400 I(4) 4 scalar 400 IDOY Dummy 379 I(4) 4 scalar ARG,INOUT 395 IYEAR Dummy 379 I(4) 4 scalar ARG,INOUT 388,400 JDAY Local 389 I(4) 4 scalar 389,395,400 JDOW Local 389 I(4) 4 scalar 389 JDOY Local 389 I(4) 4 scalar 389 MON Dummy 379 I(4) 4 scalar ARG,INOUT 400 REMTDY Subr 379 W3DOXDAT Subr 389 389 W3FS26 Subr 400 400 Page 11 Source Listing REMTDY 2012-11-20 14:07 transsnd.f 405 Page 12 Source Listing REMTDY 2012-11-20 14:07 Subprograms/Common Blocks transsnd.f SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References BUFR_TRANSSND Prog 92 REMTDY Subr 379 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 13 Source Listing REMTDY 2012-11-20 14:07 transsnd.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 : transsnd.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100