C$$$ MAIN PROGRAM DOCUMENTATION BLOCK
C
C MAIN PROGRAM: BUFR_COMBFR
C PRGMMR: KEYSER ORG: NP22 DATE: 2013-01-24
C
C ABSTRACT: CONCATENATES INDIVIDUAL BUFR FILES INTO A SINGLE BUFR FILE,
C AND FOR DUMP FILES (OPTIONALLY) GENERATES TWO DUMMY MESSAGES AT THE
C BEGINNING OF THE OUTPUT COMBINED DUMP FILE WHICH CONTAIN ONLY THE
C DUMP CENTER TIME AND THE CURRENT PROCESSING TIME ("DUMP" TIME) IN
C SECTION ONE. CURRENTLY THE MAXIMUM NUMBER OF FILES THAT CAN BE
C COMBINED IS 100. THE PATH NAMES OF THE FILES TO COMBINE ARE READ
C FROM STANDARD INPUT (UNIT 05) AND CONNECTED TO FORTRAN UNIT 20 VIA
C THE FORTRAN OPEN STATEMENT. THE OUTPUT FILE (UNIT 50) MUST BE
C CONNECTED EXTERNALLY.
C
C PROGRAM HISTORY LOG:
C 1996-09-06 J. WOOLLEN ORIGINAL VERSION FOR IMPLEMENTATION
C 1996-11-27 J. WOOLLEN MADE OUTPUT FILE BUFR TABLE CHOOSING MORE
C SECURE
C 1999-06-03 D. KEYSER MODIFIED TO PORT TO IBM SP AND RUN IN 4 OR 8
C BYTE STORAGE
C 2006-03-02 D. KEYSER ADDED OPTION TO WRITE "DUMMY" MESSAGES
C CONTAINING DUMP CENTER TIME AND PROCESSING TIME, RESP. INTO FIRST
C TWO MESSAGES OF OUTPUT COMBINED DUMP FILE (AFTER TABLE MSGS),
C WILL ONLY DO SO IF EXECUTING SCRIPT VARIABLE "DUMMY_MSGS" (READ
C IN VIA "GETENV") IS "YES" AND THE DUMP CENTER AND PROCESSING TIME
C IS SUCCESSFULLY READ FROM NEW UNIT 17 - NORMALLY THIS PROGRAM
C WILL PERFORM THIS FUNCTION ONLY WHEN IT IS EXECUTED BY DUMPJB IN
C THE DUMP PROCESSING {IT HAD BEEN DONE IN DUMPJB PROGRAM
C BUFR_DUMPMD, BUT SINCE THE LEVEL 2 RADAR DUMP PROCESSING NO
C LONGER EXECUTES THIS PROGRAM IN ORDER TO SAVE TIME (BECAUSE THERE
C IS SO MUCH DATA), IT HAS BEEN MOVED HERE FOR ALL DATA TYPES
C (MAKES MORE SENSE TO DO IT HERE SINCE DUMMY MESSAGES WILL ONLY BE
C WRITTEN ONCE TO A COMBINED DUMP FILE, IN BUFR_DUMPMD THEY WERE
C WRITTEN TO THE TOP OF EACH INDIVIDUAL DUMP FILE), THE EXCEPTION
C IS FOR CASES WHERE DUMPJB SCRIPT VARIABLE "FORM" IS SET TO "copy"
C (IN THIS CASE, THIS PROGRAM DOES NOT RUN SO BUFR_DUMPMD MUST
C WRITE THE DUMMY MESSAGES TO THE TOP OF THE DUMP FILE)}; MODIFIED
C TO WRITE AN EXTERNAL BUFR TABLE INTO THE COMBINED OUTPUT FILE
C WHEN UNIT 10 IS NOT EMPTY (IN THIS CASE UNIT 10 CONTAINS THE PATH
C TO THE EXTERNAL BUFR TABLE WHICH IS PRINTED TO STANDARD OUTPUT
C AND UNIT 15 CONTAINS THE EXTERNAL BUFR TABLE ITSELF), WHEN UNIT
C 10 IS EMPTY THE INTERNAL BUFR FILE IN THE FIRST FILE READ IS
C WRITTEN INTO THE COMBINED OUTPUT FILE (THE ONLY OPTION BEFORE
C THIS CHANGE) (NOTE: DUMPJB HAS NOT YET BEEN MODIFIED TO USE AN
C EXTERNAL BUFR TABLE, SO UNIT 10 IS ALWAYS EMPTY); IMPROVED
C DOCUMENTATION AND AUGMENTED STANDARD OUTPUT PRINT; REPLACED CALL
C TO BUFRLIB ROUTINE BORT WITH CALL TO W3LIB ROUTINE ERREXIT; NOW
C CALLS ERREXIT IF THE NUMBER OF INPUT FILES IS ZERO; INCREASED THE
C NUMBER OF FILES THAT CAN BE COMBINED FROM 29 TO 100.
C 2012-11-20 J. WOOLLEN INITIAL PORT TO WCOSS -- ADAPTED IBM/AIX
C GETENV SUBPROGRAM CALL TO INTEL/LINUX SYNTAX; ADDED ERR TRAP TO
C BUFRTAB_PATH READ
C 2013-01-13 J. WHITING READIED FOR IMPLEMENTATION ON WCOSS LINUX
C (UPDATED DOC-BLOCK, ETC.; NO LOGIC CHANGES)
C 2013-01-24 J. WOOLLEN ADJUST LOGIC TO FIND TABLES TO AVOID USING
C BUFRLIB ROUTINE MESGBF
C 2013-01-24 D. KEYSER A FEW MINOR MODS; USE INTRINSIC "TRIM"
C CHARACTER STRING FUNCTION TO ELIMINATE NEED TO OBTAIN NUMBER OF
C NON-BLANK CHARACTERS IN STRINGS; REPLACED GETENV WITH MORE
C STANDARD GET_ENVIRONMENT_VARIABLE.
C
C USAGE:
C INPUT FILES:
C UNIT 05 - STANDARD INPUT - RECORDS CONTAINING THE INPUT FILE
C NAMES FOR BUFR FILES BEING COMBINED INTO A SINGLE
C FILE - ANY RECORD BEGINNING WITH "fort" IS SKIPPED
C UNIT 10 - TEXT WHICH CONTAINS PATH TO THE EXTERNAL BUFR TABLE
C (PRINTED TO STANDARD OUTPUT) READ IN UNIT 15 (IF THIS
C IS EMPTY -- AND CURRENTLY IS ALWAYS IT! --, THE
C INTERNAL BUFR FILE IN THE FIRST FILE READ IS WRITTEN
C INTO THE COMBINED OUTPUT FILE)
C UNIT 15 - EXTERNAL BUFR TABLE (ONLY READ IF UNIT 10 IS NOT
C EMPTY -- CURRENTLY UNIT 10 IS ALWAYS EMPTY!!)
C UNIT 17 - IF PRESENT, FIRST RECORD CONTAINS YYYYMMDDHH<.HH> DATE
C OF THE DUMP CENTER TIME, SECOND RECORD CONTAINS THE
C YYYYMMDDHHMM DATE OF THE CURRENT WALLCLOCK TIME; THE
C ABSENCE OF THIS FILE IS A SIGNAL THAT THIS PROGRAM
C SHOULD NOT WRITE CENTER AND DUMP TIME DUMMY MESSAGES
C TO THE TOP OF THE OUTPUT COMBINED DUMP FILE
C UNIT 20 - THE VARIOUS BUFR FILES IN THE LIST TO BE COMBINED
C (CONNECTED INTERNALLY VIA FORTRAN OPEN STATEMENT)
C
C OUTPUT FILES:
C UNIT 50 - COMBINED BUFR FILE, POSSIBLY WITH CENTER TIME AND DUMP
C TIME DUMMY MESSAGES AT THE BEGINNING (TOP) (CONNECTED
C EXTERNALLY)
C
C SUBPROGRAMS CALLED:
C UNIQUE - NONE
C SYSTEM - GET_ENVIRONMENT_VARIABLE
C LIBRARY:
C W3NCO - W3TAGB W3TAGE ERREXIT
C BUFRLIB - DATELEN OPENBF COPYMG CLOSBF IREADMG
C OPENMG MINIMG
C
C EXIT STATES:
C COND = 0 - SUCCESSFUL RUN
C > 0 - ABNORMAL RUN
C
C REMARKS:
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 90
C MACHINE: WCOSS
C
C$$$
PROGRAM BUFR_COMBFR
PARAMETER (NFILES=100) ! Number of input files being considered
CHARACTER*500 BUFRTAB_PATH,FILI(NFILES),THIS_FILI
CHARACTER*8 SUBSET
CHARACTER*3 DUMMY_MSGS
REAL(8) CDATE,DDATE
INTEGER(8) LDATE_8,MDATE_8
INTEGER NCPY(NFILES)
LOGICAL COPY_DUMMY_MSGS
DATA LUNIN,LUNDX,LUNOT/20,15,50/
C----------------------------------------------------------------------
C----------------------------------------------------------------------
CALL W3TAGB('BUFR_COMBFR',2013,0024,0053,'NP22')
print *
print * ,'---> Welcome to BUFR_COMBFR - Version 01-24-2013'
print *
CALL DATELEN(10)
NFIL = 0
COPY_DUMMY_MSGS = .FALSE.
CALL GET_ENVIRONMENT_VARIABLE('DUMMY_MSGS',DUMMY_MSGS)
IF(DUMMY_MSGS.EQ.'YES') THEN
C Pgm expected to generate "Dummy" msgs containing center & dump times
C --------------------------------------------------------------------
READ(17,*,END=8,ERR=8) CDATE
READ(17,*,END=8,ERR=8) DDATE
PRINT *,'REQUESTED CENTER DATE IS ... ',CDATE
PRINT *,'DUMP PROCESSING DATE IS ... ',DDATE
LDATE_8 = INT(CDATE)*100_8 + NINT((CDATE-INT(CDATE))*60.)
MDATE_8 = DDATE
LMINS = MOD(LDATE_8,100_8)
MMINS = MOD(MDATE_8,100_8)
LDATE = LDATE_8/100
MDATE = MDATE_8/100
COPY_DUMMY_MSGS = .TRUE.
ENDIF
GO TO 9
8 CONTINUE
C Center and dump times not found in unit 17, "dummy" messages can't
C be generated
C ------------------------------------------------------------------
PRINT *
PRINT *, '+++ WARNING: CENTER AND/OR DUMP DATE NOT FOUND IN ',
$ 'UNIT 17 - "DUMMY" MESSAGES NOT WRITTEN TO TOP OF OUTPUT FILE'
PRINT *
9 CONTINUE
C READ THE LOCATIONS OF FILES TO COMBINE
C --------------------------------------
DO
READ(5,'(A)',END=1) THIS_FILI
IF(NFIL+1.GT.NFILES) THEN
PRINT *
PRINT *, '### BUFR_COMBFR: THE NUMBER OF INPUT FILES ',
$ 'EXCEEDS THE LIMIT OF ',NFILES,' -- STOP 99'
PRINT *
CALL W3TAGE('BUFR_COMBFR')
CALL ERREXIT(99)
ENDIF
FILI(NFIL+1) = THIS_FILI
IF(FILI(NFIL+1)(1:4).EQ.'fort') CYCLE
NFIL = NFIL+1
ENDDO
1 CONTINUE
IF(NFIL.EQ.0) THEN
PRINT *
PRINT *, '### BUFR_COMBFR: THE NUMBER OF INPUT FILES IS ZERO',
$ ' -- STOP 77'
PRINT *
CALL W3TAGE('BUFR_COMBFR')
CALL ERREXIT(77)
ENDIF
C DETERMINE WHERE TO GET BUFR TABLE TO WRITE INTO OUTPUT FILE
C -----------------------------------------------------------
READ(10,'(A)',END=3,err=3) BUFRTAB_PATH
C Come here if BUFR Table is found in an external file
C ----------------------------------------------------
PRINT 100, TRIM(BUFRTAB_PATH)
CALL OPENBF(LUNOT,'OUT',LUNDX)
GO TO 2
3 CONTINUE
C Come here if BUFR Table is NOT found in an external file (look for
C first input file that has an internal table and use this table)
C ------------------------------------------------------------------
DO N=1,NFIL
CALL CLOSBF(LUNIN)
OPEN(LUNIN,FILE=TRIM(FILI(N)),FORM='UNFORMATTED')
CALL OPENBF(LUNIN,'IN ',LUNIN)
IF(IREADMG(LUNIN,SUBSET,IDATE)==0) THEN
CALL OPENBF(LUNOT,'OUT',LUNIN)
CALL CLOSBF(LUNIN)
PRINT 101, TRIM(FILI(N))
GO TO 2
ENDIF
ENDDO
PRINT *
PRINT *, '+++ WARNING: CANNOT FIND A BUFR TABLE TO WRITE INTO ',
$ 'OUTPUT FILE - OUTPUT FILE MUST BE EMPTY!!'
PRINT *
2 CONTINUE
C COMBINE ALL MESSAGES FROM ALL INPUT FILES
C -----------------------------------------
NCPY = 0
DO N=1,NFIL
CALL CLOSBF(LUNIN)
OPEN(LUNIN,FILE=TRIM(FILI(N)),FORM='UNFORMATTED')
CALL OPENBF(LUNIN,'IN',LUNOT)
DO WHILE(IREADMG(LUNIN,SUBSET,IDATE).EQ.0)
IF(COPY_DUMMY_MSGS) THEN
C FIRST TIME IN LOOP (ONLY), GENERATE "DUMMY" MESSAGES CONTAINING
C CENTER AND DUMP TIMES AND WRITE TO OUTPUT COMBINED DUMP FILE
C ---------------------------------------------------------------
C First message in output file contains only dump center time in Sec 1
C --------------------------------------------------------------------
CALL OPENMG(LUNOT,SUBSET,LDATE)
CALL MINIMG(LUNOT,LMINS)
C Second message in output file contains only current time in Sec 1
C -----------------------------------------------------------------
CALL OPENMG(LUNOT,SUBSET,MDATE)
CALL MINIMG(LUNOT,MMINS)
CALL CLOSMG(LUNOT)
COPY_DUMMY_MSGS = .FALSE.
PRINT 102
ENDIF
CALL COPYMG(LUNIN,LUNOT)
NCPY(N) = NCPY(N) + 1
ENDDO
PRINT 103, NCPY(N),TRIM(FILI(N))
ENDDO
IF(COPY_DUMMY_MSGS) THEN
C Can only get here if code expected to generate and write out dummy
C messages and this didn't happen because no data messages were found
C in any of the input files - in this case output (dump) file must be
C empty, otherwise some codes reading it (e.g., IW3UNPBF) will fail
C when they cannot find values for the dump center & processing times
C --------------------------------------------------------------------
PRINT *
PRINT *, 'NO INPUT DATA MESSAGES FOUND - FORCE OUTPUT (DUMP) ',
$ 'FILE TO BE EMPTY'
PRINT *
ENDFILE 50
CALL SYSTEM('cp /dev/null fort.50')
END IF
PRINT *
PRINT *, 'PROGRAM COMPLETED SUCCESSFULLY'
PRINT *
CALL W3TAGE('BUFR_COMBFR')
STOP
100 FORMAT(/' --> Will write output file using external BUFR table'/
$ 5X,A/)
101 FORMAT(/' --> Will write output file using BUFR table internal ',
$ 'to'/5X,A/5X,'(the first non-empty input file)'/)
102 FORMAT(/' ==> "Dummy" messages containing dump center time and ',
$ 'wall-clock processing time successfully written to top of ',
$ 'output file'/)
103 FORMAT(//2X,'--',I7,' BUFR MESSAGES COPIED FROM INPUT FILE ',A,
$ ' TO COMBINED OUTPUT FILE')
END