C$$$ MAIN PROGRAM DOCUMENTATION BLOCK C C MAIN PROGRAM: BUFR_AVGDATA C PRGMMR: Whiting ORG: EMC DATE: 2017-11-20 C C ABSTRACT: GENERATES A TABLE CONTAINING THE AVERAGE COUNTS FOR EACH C BUFR TYPE/SUBTYPE DUMPED IN A PARTICULAR NETWORK BY CYCLE OVER A C PERIOD OF TIME (NORMALLY 30-DAYS). ALL OF THE INDIVIDUAL DAYS' C COUNTS ARE READ IN. THE USH SCRIPT CONTROLS HOW MANY DAYS ARE C ACCUMULATED IN THESE INPUT FILES. THIS TABLE IS READ BY THE C PROGRAM BUFR_DATACOUNT. C C PROGRAM HISTORY LOG: C 2000-08-22 D. KEYSER ORIGINAL AUTHOR C 2001-01-05 D. KEYSER CORRECTED ERROR WHICH LED TO PREVIOUS C TYPE/SUBTYPE AVERAGE FOR SAME CYCLE BEING PRINTED IN UNIT 51 C WHEN THE NUMBER OF DAYS IN AVERAGE IS ZERO (CORRECTED AVERAGE C TO ALWAYS BE ZERO IN THIS CASE); CAN NOW GENERATE AVERAGE FOR C HOURLY DUMPS WHICH RUN AS PART OF A NEW MONITORING SYSTEM ("DUMP" C NETWORK), ACCUMULATED DUMP COUNT FILES (BY CYCLE) NOW OPENED BY C THIS PGM RATHER THAN BEING ASSIGNED TO UNIT NUMBERS IN USH C SCRIPT, GENERALIZED TO HANDLE 24 CYCLES FOR "DUMP" NETWORK AND C STILL 4 CYCLES FOR OTHER NETWORKS C 2001-05-16 D. KEYSER ADDED RUC2A, RUCS1 (EARLY CUTOFF SURFACE C RUC) AND RUCS2 (LATE CUTOFF SURFACE RUC), ALL 24 CYCLES C 2002-03-19 D. KEYSER INCREASED PARAMETER IMAX_BTYPE FROM 101 C TO 255 TO ACCOUNT FOR NEW MESONET DATA IN BUFR TYPE 255 C 2006-03-08 D. KEYSER REMOVED PROCESSING OF 1B SATELLITE REPORTS C WHICH WERE IN THE LONG-OBSOLETE IEEE DUMP STATUS FILE (THESE C HAVE LONG BEEN INCLUDED IN THE BUFR DUMP STATUS FILE ALONG WITH C ALL OTHER REPORTS); INPUT NAME LIST CHARACTER STRING IN VARIABLE C "NETWORK" IS NOW EXPECTED TO BE IN UPPER-CASE RATHER THAN IN C LOWER-CASE C 2006-07-14 D. KEYSER ADDED RTMA (REAL TIME MESOSCALE ANALYSIS), C ALL 24 CYCLES C 2011-10-15 D. A. KEYSER -- RAP (RAPID REFRESH) NETWORK REPLACES C RUC2A (RAPID UPDATE CYCLE) C 2013-01-10 D. A. KEYSER -- REMOVED RUCS1 (EARLY CUTOFF SURFACE RUC) C AND RUCS2 (LATE CUTOFF SURFACE RUC) AS THIS MODEL NO LONGER RUNS C IN PRODUCTION; ADDED URMA (UnRestricted Mesoscale Analysis) C 2013-03-20 JWhiting ported for use on WCOSS (linux) platforms: C Updated documentation (no logic changes necessary). C 2017-11-20 D. A. KEYSER -- ACCOUNTS FOR NAM NOW HAVING tm06 THROUGH C tm00 TIME MARKERS (ONLY tm00 IS EXPECTED HERE FOR THIS AND ALL C oTHER NETWORKS). C C USAGE: C INPUT FILES: C UNIT 05 - STANDARD INPUT (DATA CARDS - SEE NAMELIST C DOCUMENTATION BELOW) C UNIT 10 - TABLE CONTAINING MNEMONIC NAME (A6), BUFR TYPE (I3) C AND BUFR SUBTYPE (I3) FOR ALL CURRENTLY VALID BUFR C TYPES AND SUBTYPES (THIS IS GENERATED FROM THE C bufr_dumplist FILE, SEE SCRIPT), FMT:'(1X,A6,8X,I3,I3)' C UNIT 21 - TABLE CONTAINING BUFR TYPE (A3), BUFR SUBTYPE (A3) AND C DUMP COUNT (I7) FOR ALL OBSERVATIONS IN A CYCLE OVER A C SPECIFIED NUMBER OF DAYS (THIS IS GENERATED FROM AN C ARCHIVE OF THE INDIVIDUAL DAYS' DUMP STATUS FILES, SEE C SCRIPT), FORMAT: '(A3,1X,A3,1X,I7)', WITH THE STRING C 'EOF @@@' IN COLUMNS 1-7 SEPARATING TWO DIFFERENT DAYS C (EACH INDIVIDUAL FILE FOR A CYCLE IS CONNECTED TO THIS C UNIT) C C OUTPUT FILES: C UNIT 06 - PRINTOUT C UNIT 51 - TABLE CONTAINING AVERAGE COUNTS AND NUMBER OF DAYS BY C CYCLE TIME (4(1X,I7,'/',I3,1X)) FOR EACH BUFR TYPE C AND SUBTYPE READ IN FROM ALL VALID CYCLES IN UNIT 21, C FMT:'('#',3X,A6,2X,I3.3,'/',I3.3,4(1X,I7,'/',I3,1X))' C (MNEMONIC NAME, BUFR TYPE, BUFR SUBTYPE, 00Z AVERAGE/ C # OF DAYS, 06Z AVERAGE/# OF DAYS, 12Z AVERAGE/# OF C DAYS, 18Z AVERAGE/# OF DAYS); ALSO CONTAINS A HEADING C C SUBPROGRAMS CALLED: C LIBRARY: C W3NCO - W3TAGB W3TAGE ERREXIT C C EXIT STATES: C COND = 0 - SUCCESSFUL RUN, ALL DATA RECEIPT NORMAL C = 30 - FAILED RUN, ERROR READING SUBSET OF DUMPLIST FILE IN C UNIT 10 C = 31 - FAILED RUN, INVALID BUFR TYPE READ FROM SUBSET OF C DUMPLIST FILE IN UNIT 10 C = 32 - FAILED RUN, INVALID BUFR SUBTYPE READ FROM SUBSET OF C DUMPLIST FILE IN UNIT 10 C = 40 - FAILED RUN, ERROR READING SUBSET OF ACCUMULATED C DUMP STATUS FILES IN UNIT 21 C = 41 - FAILED RUN, INVALID BUFR TYPE READ FROM SUBSET OF C ACCUMULATED DUMP STATUS FILES IN UNIT 21 C = 42 - FAILED RUN, INVALID BUFR SUBTYPE READ FROM SUBSET OF C ACCUMULATED DUMP STATUS FILES IN UNIT 21 C C REMARKS: C VARIABLES IN NAMELIST "INPUT" READ IN MAIN PROGRAM C NETWORK - C*5, NETWORK {either 'NAM '(tm00), 'GFS ', C 'GDAS ', 'RAP', 'RTMA', 'URMA' or C 'DUMP'} C (NOTE: 'DUMP' is the dump monitoring network C which runs hourly) C CURRDATE - C*10, CURRENT DATE IN FORM "MM/DD/YYYY" C C ATTRIBUTES: C LANGUAGE: Intel Fortran C MACHINE: WCOSS (linux) C C$$$ PROGRAM BUFR_AVGDATA PARAMETER (IMAX_BTYPE=255) PARAMETER (IMAX_STYPE=255) PARAMETER (IMAX_BS_TYPE=(IMAX_BTYPE + 1) * (IMAX_STYPE + 1)) CHARACTER*21 filename CHARACTER*10 currdate CHARACTER*6 mnemon,mnemonic(000:imax_btype,000:imax_stype) CHARACTER*5 network CHARACTER*3 atype,asub CHARACTER*2 cyc INTEGER isum(000:imax_btype,000:imax_stype,0:23), $ icount(000:imax_btype,000:imax_stype,0:23), $ isum_day(000:imax_btype,000:imax_stype), $ icount_day(000:imax_btype,000:imax_stype), $ ivalid_st(000:imax_btype,000:imax_stype) REAL avg_count(0:23) NAMELIST/INPUT/NETWORK,CURRDATE DATA infile /21/ CALL W3TAGB('BUFR_AVGDATA',2017,0324,0079,'NP22') READ(5,INPUT) print *, ' ' print *, '##### Welcome to AVGDATA - Version 11/20/2017' print *, ' ' print *, ' --> Network is: ',network,' tm00' print *, ' ' ierr = 0 isum = 0 icount = 0 isum_day = 0 icount_day = 0 mnemonic = ' ' ivalid_st = 0 C Parse out information from the subset of the dumplist file C ---------------------------------------------------------- print *, ' ' print *,' ==> Parsing through the subset of the dumplist file' print *, ' ' DO WHILE (ierr .eq. 0) READ(10,101,end=10,err=997) mnemon,jtype,jsub 101 FORMAT(1x,a6,8x,i3,i3) IF(jtype.lt.0. .or. jtype.gt.imax_btype) THEN print *,' ### INVALID VALUE FOR BUFR TYPE IN SUBSET OF ', $ 'DUMPLIST FILE (=',jtype,') -- STOP 31' CALL W3TAGE('BUFR_AVGDATA') CALL ERREXIT(31) ELSE IF(jsub.lt.0. .or. jsub.gt.imax_stype) THEN print *,' ### INVALID VALUE FOR BUFR SUBTYPE IN SUBSET OF ', $ 'DUMPLIST FILE (=',jsub,') -- STOP 32' CALL W3TAGE('BUFR_AVGDATA') CALL ERREXIT(32) END IF mnemonic(jtype,jsub) = mnemon PRINT 103, mnemonic(jtype,jsub),jtype,jsub 103 FORMAT(32('-')/' mnemonic "',a6,'"'/' type ',i4.3,' subtype ', $ i4.3) END DO 10 CONTINUE print *, '--------------------------------' print *, ' ' C Parse out information from the subset of the accumulated C dump status files C -------------------------------------------------------- print *, ' ' print *,' ==> Parsing through the subsets of the accumulated ', $ 'dump status files' print *, ' ' if(network.eq.'DUMP'.or.network.eq.'RAP'.or.network.eq.'RTMA'.or. $ network.eq.'URMA') then icycle_iter = 1 else icycle_iter = 6 end if loop1: do icycle=0,23,icycle_iter write(cyc,'(i2.2)') icycle filename='accum.obs.counts.t'//cyc//'z' open(infile,file=filename,form='FORMATTED') loop2: do while (ierr .eq. 0) read(infile,*,end=20,err=998) atype,asub,jreps cppppp cdak print *, 'atype,asub,jreps = ',atype,asub,jreps cppppp if(atype.eq.'EOF'.and.asub.eq.'@@@') then C --> Finished reading counts for this cycle for a particular day C (this logic is needed if a type/subtype is ever split up) isum(:,:,icycle) = isum(:,:,icycle) + isum_day(:,:) icount(:,:,icycle) = icount(:,:,icycle) + icount_day(:,:) isum_day = 0 icount_day = 0 cycle loop2 end if read(atype,'(i3)') jtype read(asub ,'(i3)') jsub if(jtype.lt.0. .or. jtype.gt.imax_btype) then print *,' ### INVALID VALUE FOR BUFR TYPE IN SUBSET OF ', $ 'ACCUMULATED DUMP STATUS FILES FOR CYCLE ',cyc,'Z (=', $ jtype,') -- STOP 41' call w3tage('BUFR_AVGDATA') call errexit(41) else if(jsub.lt.0. .or. jsub.gt.imax_stype) THEN print *,' ### INVALID VALUE FOR BUFR SUBTYPE IN SUBSET ', $ 'OF ACCUMULATED DUMP STATUS FILES FOR CYCLE ',cyc, $ 'Z (=',jsub,') -- STOP 42' call w3tage('BUFR_AVGDATA') call errexit(42) end if isum_day(jtype,jsub) = isum_day(jtype,jsub) + jreps icount_day(jtype,jsub) = 1 ivalid_st(jtype,jsub) = 1 end do loop2 20 continue close(infile) end do loop1 C Generate the new 30-day average file C ------------------------------------ print *, ' ' print *,' ==> Ready to generate new 30-day average file for ', $ network,' network - tm00' print *, ' ' C --> Headings if(network.ne.'DUMP'.and.network.ne.'RAP'.and.network.ne.'RTMA' $ .and.network.ne.'URMA') then write(51,104) network,currdate 104 format(4x,69('-')/4x,'Mean dump counts at each cycle for ',a5, $ ' tm00 network, ','listed by'/5x,'BUFR message type/subtype.'// $ 4x,'Averages calculated through (and including): ',a10,' .'//4x, $ 'This file is generated by the program BUFR_AVGDATA.'/4x, $ 'This file is input to the program BUFR_DATACOUNT.'//4x, $ 'WARNING: LINES WITH "#" IN COLUMN 1 ARE READ BY ', $ 'BUFR_DATACOUNT'/13x,'PROGRAM. DO NOT CHANGE THE COLUMNAR ', $ 'POSITION OF ANY'/13x,'CHARACTERS IN THESE LINES!!!'//4x,69('-')/ $ 4x,'-----type------ ------00Z-- -------06Z-- -------12Z-- ', $ '-------18Z--'/4x,'mnemon typ sub',4(5x,'avg/days')/4x, $ '------ --- ---',4(' ------- --- ')) else write(51,5104) network,currdate 5104 format(4x,69('-')/4x,'Mean dump counts at each cycle for ',a5, $ ' network, ','listed by'/5x,'BUFR message type/subtype.'//4x, $ 'Averages calculated through (and including): ',a10,' .'//4x, $ 'This file is generated by the program BUFR_AVGDATA.'/4x, $ 'This file is input to the program BUFR_DATACOUNT.'//4x, $ 'WARNING: LINES WITH "#" IN COLUMN 1 ARE READ BY ', $ 'BUFR_DATACOUNT'/13x,'PROGRAM. DO NOT CHANGE THE COLUMNAR ', $ 'POSITION OF ANY'/13x,'CHARACTERS IN THESE LINES!!!'//4x,69('-')/ $ 4x,'-----type------ ------00Z-- -------01Z-- -------02Z-- ', $ '-------03Z-- -------04Z-- -------05Z-- -------06Z-- ', $ '-------07Z-- -------08Z-- -------09Z-- -------10Z-- ', $ '-------11Z-- -------12Z-- -------13Z-- -------14Z-- ', $ '-------15Z-- -------16Z-- -------17Z-- -------18Z-- ', $ '-------19Z-- -------20Z-- -------21Z-- -------22Z-- ', $ '-------23Z--'/4x,'mnemon typ sub',24(5x,'avg/days')/4x, $ '------ --- ---',24(' ------- --- ')) end if C --> Calculated averages LOOP5: DO jtype = 0,imax_btype new_jtype = 1 LOOP6: DO jsub = 0,imax_stype IF(mnemonic(jtype,jsub).eq.' ') CYCLE LOOP6 IF(ivalid_st(jtype,jsub).eq.0) CYCLE LOOP6 PRINT 105, jtype,jsub,mnemonic(jtype,jsub) 105 FORMAT(32('-')/' Type ',i3.3,2x,i3.3,' "',a6,'" located in ', $ 'subset of accumulated status files') avg_count = 0.0 do icycle=0,23,icycle_iter write(cyc,'(i2.2)') icycle if(icount(jtype,jsub,icycle).gt.0) avg_count(icycle)= $ real(isum(jtype,jsub,icycle))/real(icount(jtype,jsub,icycle)) PRINT 106, jtype,jsub,cyc,isum(jtype,jsub,icycle), $ icount(jtype,jsub,icycle),nint(avg_count(icycle)) 106 FORMAT(' -- for BUFR type =',i4.3,', subtype =',i4.3,', cycle = ', $ a2,'Z -- isum =',i10,', icount =',i4,'; average =',i7) end do if(new_jtype.eq.1) write(51,107) 107 format(1x) write(51,108) mnemonic(jtype,jsub),jtype,jsub,(nint $ (avg_count(icycle)),icount(jtype,jsub,icycle), $ icycle=0,23,icycle_iter) 108 format('#',3x,a6,2x,i3.3,'/',i3.3,24(1x,i7,'/',i3,1x)) new_jtype = 0 END DO LOOP6 END DO LOOP5 print *, '--------------------------------' print *, ' ' write(51,107) C All done C -------- print *, ' ' print *, ' ' print *,' ** AVGDATA COMPLETED SUCCESSFULLY **' print *, ' ' CALL W3TAGE('BUFR_AVGDATA') STOP C----------------------------------------------------------------------- 997 CONTINUE print *,' ### ERROR READING SUBSET OF DUMPLIST FILE IN UNIT 10 ', $ '-- STOP 30' CALL W3TAGE('BUFR_AVGDATA') CALL ERREXIT(30) C----------------------------------------------------------------------- 998 CONTINUE print *,' ### ERROR READING SUBSET OF ACCUMULATED DUMP STATUS', $ ' FILES IN FILE ',filename,' FOR CYCLE ',cyc,'Z -- STOP 40' CALL W3TAGE('BUFR_AVGDATA') CALL ERREXIT(40) C----------------------------------------------------------------------- END