NOAA-EMC · jbathegit · Jun 7, 2022 · Jun 7, 2022 · Jun 8, 2022
diff --git a/python/_bufrlib.pyf b/python/_bufrlib.pyf
@@ -241,13 +241,11 @@ subroutine cktaba(lun,subset,jdate,iret) ! in cktaba.f
     common /unptyp/ msgunp
     common /sc3bfr/ isc3,tamnem
 end subroutine cktaba
-subroutine closbf(lunit) ! in closbf.f
+subroutine closbf_body(lunit) ! in closbf.f90
     integer :: lunit
     real*8 :: bmiss
     integer dimension(32) :: null
-    common /bufrbmiss/ bmiss
-    common /nulbfr/ null
-end subroutine closbf
+end subroutine closbf_body
 subroutine closmg(lunin) ! in closmg.f
     integer :: lunin
     integer dimension(32) :: nmsg
@@ -1799,33 +1797,11 @@ subroutine nxtwin(lun,iwin,jwin) ! in nxtwin.f
     common /bufrbmiss/ bmiss
     common /usrint/ nval,inv,val
 end subroutine nxtwin
-subroutine openbf(lunit,io,lundx) ! in openbf.f
+subroutine openbf_body(lunit,io,lundx) ! in openbf.f90
     integer :: lunit
     character*(*) :: io
     integer :: lundx
-    integer dimension(32) :: nmsg
-    integer dimension(32) :: nsub
-    integer dimension(32) :: msub
-    integer dimension(32) :: inode
-    integer dimension(32) :: idate
-    real*8 :: bmiss
-    integer dimension(32) :: iscodes
-    integer dimension(32) :: null
-    integer dimension(32) :: iolun
-    integer dimension(32) :: iomsg
-    integer :: iprt
-    integer dimension(32) :: lus
-    integer dimension(32) :: isc3
-    character dimension(32,8),intent(c) :: tamnem
-    common /msgcwd/ nmsg,nsub,msub,inode,idate
-    common /bufrbmiss/ bmiss
-    common /stcode/ iscodes
-    common /nulbfr/ null
-    common /stbfr/ iolun,iomsg
-    common /quiet/ iprt
-    common /lushr/ lus
-    common /sc3bfr/ isc3,tamnem
-end subroutine openbf
+end subroutine openbf_body
 subroutine openbt(lundx,mtyp) ! in openbt.f
     integer :: lundx
     integer :: mtyp

diff --git a/python/ncepbufr/__init__.py b/python/ncepbufr/__init__.py
@@ -176,7 +176,7 @@ def __init__(self,filename,mode='r',table=None):
                 raise IOError(msg)
             if table is None:
                 # table embedded in bufr file
-                _bufrlib.openbf(self.lunit,self._ioflag,self.lunit)
+                _bufrlib.openbf_body(self.lunit,self._ioflag,self.lunit)
                 self.lundx = self.lunit # table unit number same as bufr unit number
             else:
                 try:
@@ -190,7 +190,7 @@ def __init__(self,filename,mode='r',table=None):
                         msg='error opening %s' % filename
                         raise IOError(msg)
                     _funits.remove(self.lundx)
-                _bufrlib.openbf(self.lunit,self._ioflag,self.lundx)
+                _bufrlib.openbf_body(self.lunit,self._ioflag,self.lundx)
         elif mode == 'w':
             try:
                 # share a bufr table with another instance
@@ -207,7 +207,7 @@ def __init__(self,filename,mode='r',table=None):
             if iret != 0:
                 msg='error opening %s' % filename
                 raise IOError(msg)
-            _bufrlib.openbf(self.lunit,self._ioflag,self.lundx)
+            _bufrlib.openbf_body(self.lunit,self._ioflag,self.lundx)
         # initialized message number counter
         self.msg_counter = 0
         '''current bufr message number'''
@@ -262,7 +262,7 @@ def close(self):
         """
         close the bufr file
         """
-        _bufrlib.closbf(self.lunit)
+        _bufrlib.closbf_body(self.lunit)
         # add fortran unit number back to pool
         bisect.insort_left(_funits,self.lunit)
         if self.lundx != self.lunit:

diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt
@@ -11,6 +11,8 @@ list(APPEND fortran_src
   moda_msglim.F moda_msgmem.F moda_mstabs.F moda_nmikrp.F moda_nrv203.F moda_nulbfr.F moda_rdmtb.F
   moda_rlccmn.F moda_s01cm.F moda_sc3bfr.F moda_stbfr.F moda_stcode.F moda_tababd.F moda_tables.F
   moda_ufbcpl.F moda_unptyp.F moda_usrbit.F moda_usrint.F moda_usrtmp.F moda_xtab.F
+  closbf.f90 openbf.f90
+  bufr_procedures.f90
   adn30.f atrcpt.f blocks.f bort.f bort2.f cadn30.f capit.f chekstab.f chrtrna.f cktaba.f closmg.f
   cmpmsg.f cmsgini.f cnved4.f codflg.f conwin.f copybf.f copymg.f copysb.f cpbfdx.f cpdxmm.f cpymem.f
   cpyupd.f datebf.f datelen.f digit.f drfini.f drstpl.f dumpbf.f dxdump.f dxinit.f dxmini.f elemdx.f
@@ -32,7 +34,7 @@ list(APPEND fortran_src
   ufbmem.f ufbmex.f ufbmms.f ufbmns.f ufbovr.f ufbpos.f ufbqcd.f ufbqcp.f ufbrep.f ufbrms.f ufbrp.f
   ufbrw.f ufbseq.f ufbsp.f ufbstp.f ufbtab.f ufbtam.f ufdump.f upb.f upbb.f upc.f upds3.f upftbv.f
   ups.f uptdd.f usrtpl.f valx.f wrcmps.f wrdxtb.f writcp.f writdx.f writlc.f writsa.f writsb.f
-  wrtree.f wtstat.f arallocf.f ardllocf.f closbf.f ireadmt.f irev.F isetprm.f openbf.f pkvs01.f
+  wrtree.f wtstat.f arallocf.f ardllocf.f ireadmt.f irev.F isetprm.f pkvs01.f
   wrdlen.F fortran_open.f90 fortran_close.f90 bufr_interface.f90 pkb8.f upb8.f up8.f)
 
 list(APPEND c_src

diff --git a/src/bufr_interface.f90 b/src/bufr_interface.f90
@@ -130,6 +130,8 @@ end subroutine close_c
 !> @param[in] table_file_id - c_int: table_file unit number
 !>
 subroutine openbf_c(bufr_unit, cio, table_file_id) bind(C, name='openbf_f')
+  use subroutine_openbf
+
   integer(c_int), value, intent(in) :: bufr_unit
   character(kind=c_char, len=1), intent(in) :: cio
   integer(c_int), value, intent(in) :: table_file_id
@@ -146,6 +148,8 @@ end subroutine openbf_c
 !> @param[in] bufr_unit - c_int: the fortran file unit number to close
 !>
 subroutine closbf_c(bufr_unit) bind(C, name='closbf_f')
+  use subroutine_closbf
+
   integer(c_int), value, intent(in) :: bufr_unit
 
   call closbf(bufr_unit)

diff --git a/src/bufr_procedures.f90 b/src/bufr_procedures.f90
@@ -0,0 +1,12 @@
+!> @file
+!> @brief Enable a number of BUFRLIB subprograms to be called via module interfaces from Fortran application programs.
+!>
+!> @author J. Ator
+!> @date 2022-06-01
+
+module bufr_procedures
+
+  use subroutine_closbf
+  use subroutine_openbf
+
+end module
diff --git a/src/closbf.f b/src/closbf.f
diff --git a/src/closbf.f90 b/src/closbf.f90
@@ -0,0 +1,100 @@
+!> @file
+!> @brief Close a previously opened system file and disconnect it from the BUFRLIB software.
+
+!> This subroutine closes the connection between logical unit LUNIT and the BUFRLIB software.
+!>
+!> @authors J. Woollen
+!> @authors J. Ator
+!> @date 1994-01-06
+!>
+!> <b>Usage:</b> call closbf( LUNIT )
+!>
+!> @param[in] LUNIT   -- integer: Fortran logical unit number for BUFR file
+!>
+!> @remarks
+!> - This subroutine will execute a Fortran "CLOSE" on logical unit LUNIT, even though subroutine openbf() didn't previously
+!> handle the corresponding Fortran "OPEN" of the same file.
+!> - It's a good idea to call this subroutine for every LUNIT that was opened to the software via openbf(); however, it's
+!> especially important to do so when writing/encoding a BUFR file, in order to ensure that all output is properly flushed to LUNIT.
+!>
+!> <b>Program history log:</b>
+!> | Date | Programmer | Comments |
+!> | -----|------------|----------|
+!> | 1994-01-06 | J. Woollen | Original author |
+!> | 2003-11-04 | J. Ator    | Don't close lunit if opened as a NULL file by openbf() |
+!> | 2003-11-04 | S. Bender  | Added remarks and routine interdependencies |
+!> | 2003-11-04 | D. Keyser  | Unified/portable for WRF; added history documentation |
+!> | 2012-09-15 | J. Woollen | Modified for C/I/O/BUFR interface; added call to closfb() to close C files |
+!> | 2014-12-10 | J. Ator    | Use modules instead of COMMON blocks |
+!> | 2020-07-16 | J. Ator    | Add sanity check to ensure that openbf() was previously called (needed for GSI) |
+!> | 2022-06-01 | J. Ator    | Converted to module to consolidate _4, _d, and _8 variations into one build |
+!> 
+
+module subroutine_closbf
+
+    private
+    public closbf
+
+    interface closbf
+        module procedure closbf_4_d, closbf_8
+    end interface
+
+    contains
+
+    subroutine closbf_4_d( lunit )
+!       used when call argument to closbf is a 4-byte integer
+
+        implicit none
+
+        integer(kind=4), intent(in) :: lunit
+
+        call closbf_body( lunit )
+
+    end subroutine closbf_4_d
+
+    subroutine closbf_8( lunit )
+!       used when call argument to closbf is a 8-byte integer
+
+        implicit none
+
+        integer(kind=8), intent(in) :: lunit
+
+        integer :: my_lunit
+
+        my_lunit = lunit
+
+        call closbf_body( my_lunit )
+
+    end subroutine closbf_8
+
+end module
+
+subroutine closbf_body( lunit )
+
+      USE MODA_NULBFR
+
+      CHARACTER*128 ERRSTR
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+
+      IF ( .NOT. ALLOCATED(NULL) ) THEN
+        CALL ERRWRT('++++++++++++++++++++WARNING++++++++++++++++++++++')
+        ERRSTR = 'BUFRLIB: CLOSBF WAS CALLED WITHOUT HAVING PREVIOUSLY CALLED OPENBF'
+        CALL ERRWRT(ERRSTR)
+        CALL ERRWRT('++++++++++++++++++++WARNING++++++++++++++++++++++')
+        RETURN
+      ENDIF
+
+      CALL STATUS(LUNIT,LUN,IL,IM)
+      IF(IL.GT.0 .AND. IM.NE.0) CALL CLOSMG(LUNIT)
+      IF(IL.NE.0 .AND. NULL(LUN).EQ.0) CALL CLOSFB(LUN)
+      CALL WTSTAT(LUNIT,LUN,0,0)
+
+!  Close Fortran unit if NULL(LUN) = 0
+!  -----------------------------------
+
+      IF(NULL(LUN).EQ.0) CLOSE(LUNIT)
+
+      RETURN
+end
diff --git a/src/copybf.f b/src/copybf.f
@@ -38,6 +38,9 @@ SUBROUTINE COPYBF(LUNIN,LUNOT)
 
       USE MODA_MGWA
 
+      use subroutine_closbf
+      use subroutine_openbf
+
 C-----------------------------------------------------------------------
 C-----------------------------------------------------------------------
 

diff --git a/src/datebf.f b/src/datebf.f
@@ -50,6 +50,9 @@ SUBROUTINE DATEBF(LUNIT,MEAR,MMON,MDAY,MOUR,IDATE)
 
       USE MODA_MGWA
 
+      use subroutine_closbf
+      use subroutine_openbf
+
       COMMON /QUIET / IPRT
 
       CHARACTER*128 ERRSTR

diff --git a/src/dumpbf.f b/src/dumpbf.f
@@ -81,6 +81,9 @@ SUBROUTINE DUMPBF(LUNIT,JDATE,JDUMP)
 
       USE MODA_MGWA
 
+      use subroutine_closbf
+      use subroutine_openbf
+
       COMMON /QUIET / IPRT
 
       DIMENSION     JDATE(5),JDUMP(5)

diff --git a/src/exitbufr.f b/src/exitbufr.f
@@ -41,6 +41,8 @@ SUBROUTINE EXITBUFR
 	USE MODA_STBFR
 	USE MODA_S01CM
 
+        use subroutine_closbf
+
 	COMMON /TABLEF/ CDMF
 
 	CHARACTER*1 CDMF

diff --git a/src/getbmiss.f b/src/getbmiss.f
@@ -29,6 +29,8 @@ REAL*8 FUNCTION GETBMISS()
 
       USE MODV_BMISS
 
+      use subroutine_openbf
+
 c-----------------------------------------------------------------------
 c-----------------------------------------------------------------------
 

diff --git a/src/igetmxby.f b/src/igetmxby.f
@@ -24,6 +24,8 @@ INTEGER FUNCTION IGETMXBY()
 
       USE MODA_BITBUF
 
+      use subroutine_openbf
+
 c-----------------------------------------------------------------------
 c-----------------------------------------------------------------------
 

diff --git a/src/mesgbc.f b/src/mesgbc.f
@@ -98,6 +98,9 @@ SUBROUTINE MESGBC(LUNIN,MESGTYP,ICOMP)
       USE MODA_BITBUF
       USE MODA_MGWA
 
+      use subroutine_closbf
+      use subroutine_openbf
+
 C-----------------------------------------------------------------------
 C-----------------------------------------------------------------------
 

diff --git a/src/mesgbf.f b/src/mesgbf.f
@@ -58,6 +58,9 @@ SUBROUTINE MESGBF(LUNIT,MESGTYP)
 
       USE MODA_MGWA
 
+      use subroutine_closbf
+      use subroutine_openbf
+
 C-----------------------------------------------------------------------
 C-----------------------------------------------------------------------