SUBROUTINE OPENBF(LUNIT,IO,LUNDX)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: OPENBF
C PRGMMR: WOOLLEN ORG: NP20 DATE: 1994-01-06
C
C ABSTRACT: THIS SUBROUTINE NORMALLY (I.E. EXCEPT WHEN INPUT ARGUMENT
C IO IS 'QUIET') IDENTIFIES A NEW LOGICAL UNIT TO THE BUFR ARCHIVE
C LIBRARY SOFTWARE FOR INPUT OR OUTPUT OPERATIONS. HOWEVER, THE
C FIRST TIME IT IS CALLED, IT ALSO FIGURES OUT SOME IMPORTANT
C INFORMATION ABOUT THE LOCAL MACHINE ON WHICH THE SOFTWARE IS BEING
C RUN (VIA A CALL TO BUFR ARCHIVE LIBRARY SUBROUTINE WRDLEN), AND IT
C ALSO INITIALIZES ARRAYS IN MANY BUFR ARCHIVE LIBRARY COMMON BLOCKS
C (VIA A CALL TO BUFR ARCHIVE LIBRARY SUBROUTINE BFRINI). UP TO 32
C LOGICAL UNITS CAN BE CONNECTED TO THE BUFR ARCHIVE LIBRARY SOFTWARE
C AT ANY ONE TIME.
C
C NOTE: IF IO IS PASSED IN AS 'QUIET', THEN OPENBF PERFORMS ONLY ONE
C FUNCTION - IT SIMPLY SETS THE "DEGREE OF PRINTOUT" SWITCH IPRT (IN
C COMMON BLOCK /QUIET/) TO THE VALUE OF INPUT ARGUMENT LUNDX,
C OVERRIDING ITS PREVIOUS VALUE. A DEFAULT IPRT VALUE OF 0 (I.E.
C "LIMITED PRINTOUT") IS SET DURING THE FIRST CALL TO THIS ROUTINE,
C BUT THIS OR ANY OTHER IPRT VALUE MAY BE SET AND RESET AS OFTEN AS
C DESIRED VIA SUCCESSIVE CALLS TO OPENBF WITH IO = 'QUIET'.
C IN ALL SUCH CASES, OPENBF SIMPLY (RE)SETS IPRT AND THEN RETURNS
C WITHOUT ACTUALLY OPENING ANY FILES. THE DEGREE OF PRINTOUT
C INCREASES AS IPRT INCREASES FROM "-1" TO "0" TO "1" TO "2".
C
C PROGRAM HISTORY LOG:
C 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR
C 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
C "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
C ROUTINE "BORT"
C 1999-11-18 J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
C OPENED AT ONE TIME INCREASED FROM 10 TO 32
C (NECESSARY IN ORDER TO PROCESS MULTIPLE
C BUFR FILES UNDER THE MPI)
C 2003-11-04 J. ATOR -- ADDED IO='NUL' OPTION IN ORDER TO PREVENT
C LATER WRITING TO BUFR FILE IN LUNIT (WAS IN
C DECODER VERSION); ADDED DOCUMENTATION
C 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
C INTERDEPENDENCIES
C 2003-11-04 D. KEYSER -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
C DOCUMENTATION; OUTPUTS MORE COMPLETE
C DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
C ABNORMALLY, UNUSUAL THINGS HAPPEN OR FOR
C INFORMATIONAL PURPOSES
C 2004-08-18 J. ATOR -- ADDED SAVE FOR IFIRST FLAG AND IO="NODX"
C OPTION
C 2005-11-29 J. ATOR -- ADDED COMMON /MSGFMT/ AND ICHKSTR CALL
C
C USAGE: CALL OPENBF (LUNIT, IO, LUNDX)
C INPUT ARGUMENT LIST:
C LUNIT - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
C (UNLESS IO IS 'QUIET', THEN A DUMMY)
C IO - CHARACTER*(*): FLAG INDICATING HOW LUNIT IS TO BE
C USED BY THE SOFTWARE:
C 'IN' = input operations
C 'OUT' = output operations
C 'APN' = same as 'OUT', except begin writing at end
C of file ("append")
C 'APX' = same as 'APN', except backspace before
C appending
C 'NODX' = same as 'OUT', except don't write dictionary
C (i.e. DX) table messages to LUNIT
C 'NUL' = same as 'OUT', except don't write any
C messages whatsoever to LUNIT (e.g. when
C subroutine WRITSA is to be used)
C 'QUIET' = LUNIT is ignored, this is an indicator
C that the value for IPRT in COMMON block
C /QUIET/ is being reset (see LUNDX)
C LUNDX - INTEGER: IF IO IS NOT 'QUIET':
C FORTRAN logical unit number containing
C dictionary table information to be used in
C reading/writing from/to LUNIT (depending
C on the case); may be set equal to LUNIT if
C dictionary table information is already
C embedded in LUNIT
C IF IO IS 'QUIET':
C Indicator for degree of printout:
C -1 = NO printout except for ABORT
C messages
C 0 = LIMITED printout (default)
C 1 = ALL warning messages are printed
C out
C 2 = ALL warning AND informational
C messages are printed out
C (Note: this does not change until OPENBF
C is again called with IO equal to
C 'QUIET')
C
C INPUT FILES:
C UNIT "LUNIT" - BUFR FILE
C
C OUTPUT FILES:
C UNIT 06 - STANDARD OUTPUT PRINT
C
C REMARKS:
C THIS ROUTINE CALLS: BFRINI BORT DXINIT ICHKSTR
C POSAPN POSAPX READDX STATUS
C WRDLEN WRITDX WTSTAT
C THIS ROUTINE IS CALLED BY: RDMGSB UFBINX UFBMEM UFBTAB
C Also called by application programs.
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C MACHINE: PORTABLE TO ALL PLATFORMS
C
C$$$
INCLUDE 'bufrlib.prm'
COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
. INODE(NFILES),IDATE(NFILES)
COMMON /STBFR / IOLUN(NFILES),IOMSG(NFILES)
COMMON /NULBFR/ NULL(NFILES)
COMMON /MSGFMT/ MGWRDS(NFILES)
COMMON /QUIET / IPRT
CHARACTER*(*) IO
CHARACTER*128 BORT_STR
CHARACTER*54 CPRINT(0:3)
CHARACTER*1 BSTR(4)
DATA IFIRST/0/
DATA CPRINT/
. 'No printout except for ABORT messages',
. 'Limited printout (default)',
. 'All warning messages are printed out',
. 'All warning and informational messages are printed out'/
SAVE IFIRST
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C If this is the first call to this subroutine, initialize
C IPRT in /QUIET/ as 0 (limited printout - except for abort
C messages)
IF(IFIRST.EQ.0) IPRT = 0
IF(IO.EQ.'QUIET') THEN
c .... override previous IPRT value (printout indicator)
IF(LUNDX.LT.-1) LUNDX = -1
IF(LUNDX.GT. 2) LUNDX = 2
IF(LUNDX.GE.0) THEN
PRINT*
PRINT*,'+++++++++++++++++BUFR ARCHIVE LIBRARY++++++++++++++++++++'
PRINT 101, IPRT,CPRINT(IPRT+1),LUNDX,CPRINT(LUNDX+1)
101 FORMAT(' BUFRLIB: OPENBF - THE DEGREE OF PRINTOUT INDICATOR IS ',
. 'BEING CHANGED FROM:'/15X,I3,' - ',A/25X,'to'/15X,I3,' - ',A)
PRINT*,'+++++++++++++++++BUFR ARCHIVE LIBRARY++++++++++++++++++++'
PRINT*
ENDIF
IPRT = LUNDX
ENDIF
IF(IFIRST.EQ.0) THEN
C If this is the first call to this subroutine, then call WRDLEN
C to figure out some important information about the local
C machine and call BFRINI to initialize some global variables.
C NOTE: WRDLEN must be called prior to calling BFRINI!
CALL WRDLEN
CALL BFRINI
IFIRST = 1
ENDIF
IF(IO.EQ.'QUIET') GOTO 100
C SEE IF A FILE CAN BE OPENED
C ---------------------------
CALL STATUS(LUNIT,LUN,IL,IM)
IF(LUN.EQ.0) GOTO 900
IF(IL .NE.0) GOTO 901
NULL(LUN) = 0
MGWRDS(LUN) = 0
C CHECK FOR NO BUFR DATA OR NO DATA AT ALL IN AN "IN" FILE
C --------------------------------------------------------
C Note that we only want to do this check if LUNIT=LUNDX, in order
C to allow for the possibility that input BUFR messages may be passed
C to the BUFR ARCHIVE LIBRARY software via an alternative method (e.g.
C a future call to subroutine READERME) rather than read directly from
C LUNIT, which is the usual method.
IF(IO.EQ.'IN' .AND. LUNIT.EQ.LUNDX) THEN
REWIND LUNIT
READ(LUNIT,END=200,ERR=902) (BSTR(I),I=1,4)
C Confirm that the BSTR array contains 'BUFR' encoded in
C CCITT IA5 (i.e. ASCII).
IF(ICHKSTR('BUFR',BSTR,4).NE.0) GOTO 903
ENDIF
C SET INITIAL OPEN DEFAULTS (CLEAR OUT A MSG CONTROL WORD PARTITION)
C ------------------------------------------------------------------
IF(IO.NE.'NUL') THEN
REWIND LUNIT
ENDIF
NMSG (LUN) = 0
NSUB (LUN) = 0
MSUB (LUN) = 0
INODE(LUN) = 0
IDATE(LUN) = 0
C DECIDE HOW TO SETUP THE DICTIONARY
C ----------------------------------
IF(IO.EQ.'IN') THEN
CALL WTSTAT(LUNIT,LUN,-1,0)
CALL READDX(LUNIT,LUN,LUNDX)
ELSE IF(IO.EQ.'OUT') THEN
CALL WTSTAT(LUNIT,LUN, 1,0)
CALL WRITDX(LUNIT,LUN,LUNDX)
ELSE IF(IO.EQ.'APN' .OR. IO.EQ.'APX'
. .OR. IO.EQ.'NODX'.OR. IO.EQ.'NUL') THEN
CALL WTSTAT(LUNIT,LUN, 1,0)
CALL READDX(LUNIT,LUN,LUNDX)
IF(IO.EQ.'APN') THEN
CALL POSAPN(LUNIT)
ELSE IF(IO.EQ.'APX') THEN
CALL POSAPX(LUNIT)
ELSE IF(IO.EQ.'NUL') THEN
NULL(LUN) = 1
ENDIF
ELSE
GOTO 904
ENDIF
GOTO 100
C FILE OPENED FOR INPUT IS EMPTY - LET READMG OR READERME GIVE
C THE BAD NEWS LATER
200 REWIND LUNIT
IF(IPRT.GE.0) THEN
PRINT*
PRINT*,'+++++++++++++++++++++++WARNING+++++++++++++++++++++++++'
PRINT*, 'BUFRLIB: OPENBF - INPUT BUFR FILE IN UNIT ',LUNIT,
. ' IS EMPTY'
PRINT*,'+++++++++++++++++++++++WARNING+++++++++++++++++++++++++'
PRINT*
ENDIF
CALL WTSTAT(LUNIT,LUN,-1,0)
C INITIALIZE THE DICTIONARY TABLE PARTITION
C -----------------------------------------
CALL DXINIT(LUN,0)
C EXITS
C -----
100 RETURN
900 WRITE(BORT_STR,'("BUFRLIB: OPENBF - THERE ARE ALREADY",I3,'//
. '" BUFR FILES OPENED, CANNOT OPEN FILE CONNECTED TO UNIT",I4)')
. NFILES,LUNIT
CALL BORT(BORT_STR)
901 WRITE(BORT_STR,'("BUFRLIB: OPENBF - THE FILE CONNECTED TO UNIT"'//
. ',I5," IS ALREADY OPEN")') LUNIT
CALL BORT(BORT_STR)
902 WRITE(BORT_STR,'("BUFRLIB: OPENBF - ERROR READING INPUT FILE '//
. 'CONNECTED TO UNIT",I4," WHEN CHECKING FOR ''BUFR'' IN FIRST 4'//
. ' BYTES OF RECORD")') LUNIT
CALL BORT(BORT_STR)
903 WRITE(BORT_STR,'("BUFRLIB: OPENBF - FIRST 4 BYTES READ FROM '//
. 'RECORD IN INPUT FILE CONNECTED TO UNIT",I4," NOT ''BUFR'', '//
. 'DOES NOT CONTAIN BUFR DATA")') LUNIT
CALL BORT(BORT_STR)
904 CALL BORT('BUFRLIB: OPENBF - SECOND (INPUT) ARGUMENT IS NOT ONE'//
. ' OF THE FOLLOWING: "IN", "OUT", "NODX", "NUL", "APN", "APX"'//
. ' OR "QUIET"')
END