C$$$ MAIN PROGRAM DOCUMENTATION BLOCK
C
C MAIN PROGRAM: PREPOBS_PREPANOW
C PRGMMR: Whiting ORG: EMC DATE: 2014-10-17
C
C ABSTRACT: REPROCESSES THE DUMP OF "AIRNOW" OZONE CONCENTRATION AND
C PARTICULATE MATTER (PM) DATA INTO A PREPBUFR LOOK-A-LIKE FILE. USED
C BY VERIFICATION CODES TO GENERATE A "PREPFITS" COMPARISON FILES.
C
C PROGRAM HISTORY LOG:
C 2004-09-12 D. A. KEYSER -- ORIGINAL AUTHOR
C 2005-02-02 D. A. KEYSER -- MODIFIED TO HANDLE DUMP FILES CONTAINING
C NEW, NOT-YET-OPERATIONAL, SEPARATE 1-HOUR AND 8-HOUR
C BACKWARD-AVERAGED DATA WITH MESSAGE TYPES NC008021 AND
C NC008022, RESPECTIVELY, IT STILL PROPERLY HANDLES THE
C OPERATIONAL DUMP FILES CONTAINING COMBINED 1-HOUR AND 8-
C HOUR FORWARD-AVERAGED DATA WITH MESSAGE TYPE NC008020
C 2012-03-14 D. A. KEYSER - IN RESPONSE TO THE LATEST VERSION OF
C BUFRLIB WHICH CAN HANDLE EMBEDDED DICTIONARY MESSAGES::
C INCREASES DEGREE OF BUFRLIB PRINTOUT SUCH THAT CODE WILL
C PRINT A DIAGNOSTIC IF ANY EMBEDDED DICTIONARY MESSAGES ARE
C FOUND WHEN READING IN MESSAGES; REPLACES SINGLE CALL TO
C OPENMG AFTER OPENING INPUT AND OUTPUT BUFR FILES WITH CALL
C TO OPENMB IN INNER DO-LOOP WHERE INFORMATION FROM EACH
C SUBSET READ IN IS TRANSFERRED TO THE OUTPUT BUFR FILE,
C THIS FIXES A BUG WHICH HAD CAUSED A BUFRLIB ABORT HERE
C WHEN THE INPUT BUFR FILE CONTAINS EMBEDDED BUFR DICTIONARY
C MESSAGES (NOT SURE WHY!); REPLACED CALL TO BUFRLIB ROUTINE
C UFBSEQ WITH TWO CALLS TO UFBINT TO READ IN SUBSETS (UFBSEQ
C ASSUMES A PRE-DEFINED ORDER TO PARAMETERS IN A SUBSET,
C UFBINT DOES NOT)
C 2013-06-21 JWhiting - updated for use on WCOSS (linux) platforms:
C updated doc block and w3tagb args; no logic changes.
C 2014-10-17 JWhiting - added Particulate Matter (PM) processing
C ------
C
C USAGE:
C INPUT FILES:
C UNIT 21 - "AIRNOW" BUFR DATA DUMP FILE
C UNIT 25 - LOOK-A-LIKE PREPBUFR MNEMONIC BUFRTABLE (FOR ONLY
C AIRNOW DATA)
C UNIT 30 - CENTRAL DUMP AND PREPBUFR PROCESSING DATE IN FORM
C YYYYMMDDHH
C
C OUTPUT FILES:
C UNIT 06 - STANDARD OUTPUT PRINT
C UNIT 51 - LOOK-A-LIKE PREPBUFR FILE CONTAINING ONLY AIRNOW DATA
C
C SUBPROGRAMS CALLED:
C LIBRARY:
C W3NCO - W3TAGB W3DIFDAT W3TAGE
C BUFRLIB - DATELEN MESGBC OPENBF OPENMB UFBINT
C WRITSB CLOSBF
C
C EXIT STATES:
C COND = 0 - SUCCESSFUL RUN
C > 0 - ABNORMAL TERMINATION
C
C REMARKS:
C
C INPUT REPORT STRUCTURE FROM AIRNOW BUFR DATA DUMP FILE (RDATA_8):
C
C FOR MESSAGE TYPE NC008020 WHICH CONTAINS 1- AND 8-HOUR FORWARD
C AVERAGED DATA IN A SINGLE SUBSET:
C
C WORD MNEMONIC
C ---- --------
C 1 YEAR \
C 2 MNTH - starting time from which ozone concentration
C 3 DAYS - average is caluculated
C 4 HOUR /
C 5 PTID
C 6 CLATH
C 7 CLONH
C 8 TYPO
C 9 TSIG
C 10 TPHR - 1-hour average follows
C 11 QCIND - q.c. indicator
C 12 COPO - ozone concentration
C 13 TPHR - 8-hour average follows
C 14 QCIND - q.c. indicator
C 15 COPO - ozone concentration
C
C OUTPUT REPORT STRUCTURE IN AIRNOW LOOK-A-LIKE PREPBUFR FILE:
C WORD MNEMONIC
C ---- --------
C 1 SID
C 2 XOB
C 3 YOB
C 4 DHR - Observation time (i.e., starting time
C from which average is caluclated) minus
C cycle (central dump/PREPBUFR) time
C 5 TYP - PREPBUFR REPORT TYPE (101)
C 6 T29 - INPUT DUMP REPORT TYPE (591)
C 7 SQN
C 8 PROCN - Process number (for MPI) - always 0
C (program does not run in "pieces")
C 9 RPT
C 10 CAT - PREPBUFR data level category (always 6)
C 11 TYPO
C 12 TSIG
C 13 TPHR - 1-hour average follows
C 14 QCIND - q.c. indicator
C 15 COPO - ozone concentration
C 16 TPHR - 8-hour average follows
C 17 QCIND - q.c. indicator
C 18 COPO - ozone concentration
C
C
C FOR MESSAGE TYPE NC008021 WHICH CONTAINS ONLY 1-HOUR BACKWARD
C AVERAGED DATA IN A SINGLE SUBSET AND MESSAGE TYPE NC008022 WHICH
C CONTAINS ONLY 8-HOUR BACKWARD AVERAGED DATA IN A SINGLE SUBSET:
C
C WORD MNEMONIC
C ---- --------
C 1 YEAR \
C 2 MNTH - ending time from which ozone concentration
C 3 DAYS - average is caluculated
C 4 HOUR /
C 5 PTID
C 6 CLATH
C 7 CLONH
C 8 TYPO
C 9 TSIG
C 10 TPHR - 1-hour or 8-hour average follows
C 11 QCIND - q.c. indicator
C 12 COPO - ozone concentration
C
C OUTPUT REPORT STRUCTURE IN AIRNOW LOOK-A-LIKE PREPBUFR FILE:
C WORD MNEMONIC
C ---- --------
C 1 SID
C 2 XOB
C 3 YOB
C 4 DHR - Observation time (i.e., ending time
C from which average is caluclated) minus
C cycle (central dump/PREPBUFR) time
C 5 TYP - PREPBUFR REPORT TYPE (101)
C 6 T29 - INPUT DUMP REPORT TYPE (591)
C 7 SQN
C 8 PROCN - Process number (for MPI) - always 0
C (program does not run in "pieces")
C 9 RPT
C 10 CAT - PREPBUFR data level category (always 6)
C 11 TYPO
C 12 TSIG
C 13 TPHR - 1-hour or 8-hour average follows
C 14 QCIND - q.c. indicator
C 15 COPO - ozone concentration
C
C
C FOR MESSAGE TYPE NC008031 WHICH CONTAINS ONLY 1-HOUR BACKWARD
C AVERAGED DAILY PARTICULATE MATTER DATA IN A SINGLE SUBSET:
C
C WORD MNEMONIC
C ---- --------
C 1-11 same as for the ozone message types above
C 12 COPOPM - Concentration of Pollutant
C
C OUTPUT REPORT STRUCTURE IN AIRNOW LOOK-A-LIKE PREPBUFR FILE:
C WORD MNEMONIC
C ---- --------
C 1-15 same as for the ozone message types above
C 16 TPHR - 1-hour or 8-hour average follows
C 17 QCIND - q.c. indicator
C 18 COPOPM - Concentration of Pollutant
C
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 90
C MACHINE: IBM CCS
C
C$$$
PROGRAM PREPOBS_PREPANOW
CHARACTER*8 SUBOUT,SID,SUBSET, SUBPM
REAL(8) RDATA_8(15),RID,DHR,RPT,T29,TYP,CAT,PROCN,SQN
REAL(8) PDATA_8(3,2)
real(8) rd7_8 ! jaw db debug
character*3 s3 ! jaw db debug
DIMENSION IDAT(8),JDAT(8),RINC(5)
EQUIVALENCE (RID,SID),(RDATA_8(10),PDATA_8(1,1))
DATA SUBOUT/'AIRNOW '/,IREP/0/, SUBPM/'ANOWPM '/
DATA LUBFI/21/,LINDX/25/,LDATE/30/,LUBFO/51/,LUBPM/52/
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
CALL W3TAGB('PREPOBS_PREPANOW',2014,0290,0050,'EMC')
print *
print * ,'---> Welcome to PREPOBS_PREPANOW - Version 10-17-2014'
print *
READ(LDATE,'(I10)') IDATE
CALL DATELEN(10)
CALL MESGBC(LUBFI,MSGT,ICOMP)
IF(ICOMP.EQ.1) THEN
PRINT'(/"INPUT BUFR FILE MESSAGES C O M P R E S S E D"/'//
. '"FIRST MESSAGE TYPE FOUND IS",I5/)', MSGT
ELSE IF(ICOMP.EQ.0) THEN
PRINT'(/"INPUT BUFR FILE MESSAGES '//
. 'U N C O M P R E S S E D"/"FIRST MESSAGE TYPE FOUND IS",I5/)',
. MSGT
ELSE IF(ICOMP.EQ.-1) THEN
PRINT'(//"ERROR READING INPUT BUFR FILE - MESSAGE '//
. 'COMPRESSION UNKNOWN"/)'
ELSE IF(ICOMP.EQ.-3) THEN
PRINT'(/"INPUT BUFR FILE DOES NOT EXIST"/)'
ELSE IF(ICOMP.EQ.-2) THEN
PRINT'(/"INPUT BUFR FILE HAS NO DATA MESSAGES"/"FIRST '//
. 'MESSAGE TYPE FOUND IS",I5/)', MSGT
ENDIF
CALL OPENBF(LUBFI,'IN',LUBFI)
CALL OPENBF(0,'QUIET',1) ! incr. degree of diag. prnt from BUFRLIB
CALL OPENBF(LUBFO,'OUT',LINDX) ! Ozone output
CALL OPENBF(LUBPM,'OUT',LINDX) ! PM output
IDAT = 0
IDAT(1) = IDATE/1000000
IDAT(2) = MOD((IDATE/10000),100)
IDAT(3) = MOD((IDATE/100),100)
IDAT(5) = MOD(IDATE,100)
nmsg=0 ! debug
nsb=0 ! debug
DO WHILE(IREADMG(LUBFI,SUBSET,JDATE).EQ.0)
if ( nmsub(lubfi).ne.0 ) nmsg=nmsg+1 ! debug
npr=0 ! debug
DO WHILE(IREADSB(LUBFI).EQ.0)
npr=npr+1 ! debug
nsb=nsb+1 ! debug
cdak CALL UFBSEQ(LUBFI,RDATA_8,15,1,IRET,SUBSET)
CALL UFBINT(LUBFI,RDATA_8, 9,1,ILVL,
. 'YEAR MNTH DAYS HOUR PTID CLATH CLONH TYPO TSIG')
IF (SUBSET.NE.'NC008031') THEN
CALL UFBINT(LUBFI,PDATA_8,3,2,ILVL,'TPHR QCIND COPO')
ELSE
CALL UFBINT(LUBFI,PDATA_8,3,1,ILVL,'TPHR QCIND COPOPM')
ENDIF ! SUBSET NOT PM (NC008031)
cpppppppppp
cc print 100, ilvl,rdata_8
cc100 format(1x,'ILVL=',I3,'; RPTIN:',4F6.0,F11.0,2F8.2,2F4.0,2(2F4.0,
cc . F13.9))
cpppppppppp
C CONVERT REPORT TO PREPBUFR
C --------------------------
IF (SUBSET.NE.'NC008031') THEN
LUN = LUBFO ! Ozone output logical unit
CALL OPENMB(LUBFO,SUBOUT,IDATE)
ELSE
LUN = LUBPM ! PM output logical unit
CALL OPENMB(LUBPM,SUBPM,IDATE)
ENDIF ! SUBSET NOT PM (NC008031)
c Convert PLATFORM TRANSMITTER ID NUMBER to STNID (change dec to hex)
c -------------------------------------------------------------------
WRITE(SID,'(Z8.8)') NINT(RDATA_8(5))
CALL UFBINT(LUN ,RID,1,1,IRET,'SID')
c YEAR MNTH DAYS HOUR PTID CLATH CLONH TYPO TSIG TPHR QCIND COPO[PM]
if (npr.le.5 .and. .true.) then
s3=subset(6:8)
write(*,101) 'db: ',s3,nmsg,nsb,(int(rdata_8(i)),i=1,4)
write(*,102) int(rdata_8(5)), sid
endif ! npr <=5
c Convert REPORT DATE to OBSERVATION TIME MINUS CYCLE TIME and to
c observation time
c ---------------------------------------------------------------
JDAT = 0
JDAT(1:3) = RDATA_8(1:3)
JDAT(5) = RDATA_8(4)
CALL W3DIFDAT(JDAT,IDAT,2,RINC)
DHR = RINC(2)
CALL UFBINT(LUN ,DHR,1,1,IRET,'DHR')
RPT = RDATA_8(4)
CALL UFBINT(LUN ,RPT,1,1,IRET,'RPT')
c Convert HIGH-RES LAT/LON to LOW-RES LAT/LON (LON from -W, +E to E)
c -----------------------------------------------------------------
rd7_8 = rdata_8(7) ! debug
XOB = RDATA_8(7)
RDATA_8(7) = 360. - MOD(720.-XOB,360.)
IF(RDATA_8(7).EQ.360.0) RDATA_8(7) = 0.0
CALL UFBINT(LUN ,RDATA_8(6),2,1,IRET,'YOB XOB')
c Set DUMP report type & PREPBUFR report type
c DUMP report type: ozone = 591 particulate = 592
c PREPBUFR report type: ozone = 101 particulate = 102
c For all types, set Category, Process number and Sequence number:
c Category = 6 Process number = 0
c Sequence number = next report number
c ------------------------------------------------------------
IF (SUBSET.NE.'NC008031') THEN
T29 = 591 ! Ozone dump rpt type
TYP = 101 ! Ozone prepbufr rpt type
ELSE
T29 = 592 ! PM dump rpt type
TYP = 102 ! PM prepbufr rpt type
ENDIF ! SUBSET NOT PM (NC008031)
CAT = 6 ! Category
PROCN = 0 ! Process number
IREP = IREP + 1
SQN = IREP ! Sequence number
CALL UFBINT(LUN ,T29,1,1,IRET,'T29')
CALL UFBINT(LUN ,TYP,1,1,IRET,'TYP')
CALL UFBINT(LUN ,CAT,1,1,IRET,'CAT')
CALL UFBINT(LUN ,PROCN,1,1,IRET,'PROCN')
CALL UFBINT(LUN ,SQN,1,1,IRET,'SQN')
c Finally encode the observational data in PREPBUFR
c -------------------------------------------------
CALL UFBINT(LUN ,RDATA_8(8),2,1,IRET,'TYPO TSIG')
IF(SUBSET.EQ.'NC008020') THEN
NLEV = 2
ELSE
NLEV = 1
ENDIF
IF (SUBSET.NE.'NC008031') THEN
CALL UFBINT(LUBFO,PDATA_8,3,NLEV,IRET,'TPHR QCIND COPO')
ELSE
CALL UFBINT(LUBPM,PDATA_8,3,NLEV,IRET,'TPHR QCIND COPOPM')
ENDIF ! NOT PM MESSAGE TYPE (NC008031)
CALL WRITSB(LUN )
if (npr.le.5) then
write(*,103) rdata_8(6), rd7_8, rdata_8(7)
write(*,104) (int(rdata_8(j)),j=8,11)
write(*,105) rdata_8(12)*1d9
endif ! npr <= 5
101 format(a4,1x,a3,i4,i6,1x,i4,2i2.2,".",i2.2, $) ! s3, mg,sb,ymd.h
102 format( 1x,i9, 1x,a8, $) ! ptid, sid
103 format( 1x,f10.5,1x,f9.5, 1x,f7.2, $) ! lat, lon, xob
104 format( 4(1x,i2), $) ! typo,tsig,tphr,qcind
105 format( 1x,f6.2) ! copo | copopm
END DO ! WHILE IREADSB
END DO ! WHILE IREADMG
CALL CLOSBF(LUBFI)
CALL CLOSBF(LUBFO)
CALL CLOSBF(LUBPM)
CALL W3TAGE('PREPOBS_PREPANOW')
STOP
END