Merge pull request #441 from NOAA-EMC/ejh_bort

more bort testing

src/ufbcnt.f

@@ -4,14 +4,17 @@
 C>
 C> @author J. Woollen @date 1994-01-06
 
+C> Get the current message number and data subset number within
+C> a BUFR file.
+C>
 C> This subroutine returns the current location of the file pointer
 C> within a BUFR file, in terms of a message number counting from the
 C> beginning of the file, and a data subset number counting from the
 C> beginning of that message.
 C>
 C> @remarks
 C> - Logical unit LUNIT should have already been opened via a previous
-C> call to subroutine openbf().  If LUNIT was opened for input
+C> call to subroutine openbf(). If LUNIT was opened for input
 C> operations, then KMSG is incremented with each call to any of the
 C> [message-reading subroutines](@ref hierarchy), and KSUB is
 C> incremented with each call to any of the
@@ -24,14 +27,14 @@
 C> - The value returned for KMSG does <b>not</b> include any messages
 C> which contain DX BUFR tables information.
 C>
-C> @param[in] LUNIT -- integer: Fortran logical unit number for BUFR file
-C> @param[out] KMSG -- integer: Ordinal number of current message,
-C>                     counting from the beginning of the BUFR file, but
-C>                     not counting any messages which contain DX BUFR
-C>                     tables information
-C> @param[out] KSUB -- integer: Ordinal number of current data subset
-C>                     within (KMSG)th message, counting from the
-C>                     beginning of the message
+C> @param[in] LUNIT - integer: Fortran logical unit number for BUFR file.
+C> @param[out] KMSG - integer: Ordinal number of current message,
+C> counting from the beginning of the BUFR file, but
+C> not counting any messages which contain DX BUFR
+C> tables information.
+C> @param[out] KSUB - integer: Ordinal number of current data subset
+C> within (KMSG)th message, counting from the
+C> beginning of the message.
 C>
 C> @author J. Woollen @date 1994-01-06
       RECURSIVE SUBROUTINE UFBCNT(LUNIT,KMSG,KSUB)

src/ufbcpy.f

@@ -3,6 +3,8 @@
 C>
 C> @author J. Woollen @date 1994-01-06
 
+C> Copy a BUFR data subset.
+C>
 C> This subroutine copies a BUFR data subset from one Fortran logical
 C> unit to another.
 C>
@@ -22,10 +24,10 @@
 C> each of the logical units LUBIN and LUBOT must contain identical
 C> definitions for the data subset to be copied.
 C>
-C> @param[in] LUBIN   -- integer: Fortran logical unit number for
-C>                       source BUFR file
-C> @param[in] LUBOT   -- integer: Fortran logical unit number for
-C>                       target BUFR file
+C> @param[in] LUBIN - integer: Fortran logical unit number for
+C> source BUFR file.
+C> @param[in] LUBOT - integer: Fortran logical unit number for
+C> target BUFR file.
 C>
 C> @author J. Woollen @date 1994-01-06
       RECURSIVE SUBROUTINE UFBCPY(LUBIN,LUBOT)

src/ufbdmp.f

@@ -3,6 +3,8 @@
 C>
 C> @authors J. Woollen, J. Ator, D. Keyser @date 1994-01-06
 
+C> Print the contents of a data subset.
+C>
 C> This subroutine prints a verbose listing of the contents of a data
 C> subset, including all data values and replicated sequences, as well
 C> as jump/link table information and other internal subset pointers.
@@ -27,26 +29,25 @@
 C> application program (by typing 'q' then '<Enter>') or continue
 C> scrolling (by typing anything else).
 C>
-C> @param[in] LUNIN   -- integer: Absolute value is Fortran logical
-C>                       unit number for BUFR file
-C>                       - If LUNIN > 0, data values are printed to
-C>                         LUPRT using the format descriptor code
-C>                         'G15.6', meaning that all values will be
-C>                         printed (since the format adapts to the
-C>                         order of magnitude of each value), but
-C>                         values won't necessarily be lined up
-C>                         with the decimal point in the same column
-C>                       - If LUNIN < 0, data values are printed to
-C>                         LUPRT using the format descriptor code
-C>                         'F15.6', meaning that all values will be
-C>                         lined up with the decimal point in the
-C>                         same column, but values exceeding the
-C>                         format width of 15 characters will print
-C>                         as overflow (e.g. '***************')
-C> @param[in] LUPRT   -- integer: Fortran logical unit number for
-C>                       print output
-C>                       - 0 = Run interactively, printing to
-C>                             standard output
+C> @param[in] LUNIN - integer: Absolute value is Fortran logical
+C> unit number for BUFR file.
+C> - If LUNIN > 0, data values are printed to
+C>   LUPRT using the format descriptor code
+C>   'G15.6', meaning that all values will be
+C>   printed (since the format adapts to the
+C>   order of magnitude of each value), but
+C>   values won't necessarily be lined up
+C>   with the decimal point in the same column
+C> - If LUNIN < 0, data values are printed to
+C>   LUPRT using the format descriptor code
+C>   'F15.6', meaning that all values will be
+C>   lined up with the decimal point in the
+C>   same column, but values exceeding the
+C>   format width of 15 characters will print
+C>   as overflow (e.g. '***************')
+C> @param[in] LUPRT - integer: Fortran logical unit number for
+C> print output:
+C> - 0 = Run interactively, printing to standard output
 C>
 C> @authors J. Woollen, J. Ator, D. Keyser @date 1994-01-06
       RECURSIVE SUBROUTINE UFBDMP(LUNIN,LUPRT)

src/ufbevn.f

@@ -3,6 +3,8 @@
 C>
 C> @author J. Woollen @date 1994-01-06
 
+C> Read one or more data values from an NCEP prepbufr file.
+C>
 C> This subroutine reads one or more data values from the BUFR data
 C> subset that is currently open within the BUFRLIB internal arrays.
 C> It is specifically designed for use with NCEP prepbufr files,

src/ufbint.f

@@ -3,6 +3,8 @@
 C>
 C> @author J. Woollen @date 1994-01-06
 
+C> Read/write one or more data values from/to a data subset.
+C>
 C> This subroutine reads or writes one or more data values from or to
 C> the BUFR data subset that is currently open within the BUFRLIB
 C> internal arrays.  The direction of the data transfer is determined

src/ufbrms.f

@@ -4,6 +4,9 @@
 C>
 C> @author J. Woollen @date 1994-01-06
 
+C> Read one or more data values from a data subset in
+C> internal arrays.
+C>
 C> This subroutine provides a handy way to combine the functionality
 C> of subroutines rdmemm(), rdmems() and ufbint() within a single
 C> subroutine call.

test/run_test_bort.sh

@@ -162,33 +162,46 @@ for kind in "4" "d"; do
 
     # Check ufbcpy().
     (./test_bort_$kind ufbcpy 1) && exit 1
+    (./test_bort_$kind ufbcpy 2) && exit 1
+    (./test_bort_$kind ufbcpy 3) && exit 1
 
     # Check ufbcup().
     (./test_bort_$kind ufbcup 1) && exit 1
+    (./test_bort_$kind ufbcup 2) && exit 1
+    (./test_bort_$kind ufbcup 3) && exit 1
 
     # Check ufbdmp().
     (./test_bort_$kind ufbdmp 1) && exit 1
+    (./test_bort_$kind ufbdmp 2) && exit 1
+    (./test_bort_$kind ufbdmp 3) && exit 1
 
     # Check ufbevn().
     (./test_bort_$kind ufbevn 1) && exit 1
+    (./test_bort_$kind ufbevn 2) && exit 1
+    (./test_bort_$kind ufbevn 3) && exit 1
 
     # Check ufbget().
     (./test_bort_$kind ufbget 1) && exit 1
+    (./test_bort_$kind ufbget 2) && exit 1
+    (./test_bort_$kind ufbget 3) && exit 1
 
     # Check ufbint().
     (./test_bort_$kind ufbint 1) && exit 1
+    (./test_bort_$kind ufbint 2) && exit 1
 
     # Check ufbqcp().
     (./test_bort_$kind ufbqcp 1) && exit 1
 
     # Check ufbrep().
     (./test_bort_$kind ufbrep 1) && exit 1
+    (./test_bort_$kind ufbrep 2) && exit 1
 
     # Check ufbrms().
     (./test_bort_$kind ufbrms 1) && exit 1
 
     # Check ufbseq().
     (./test_bort_$kind ufbseq 1) && exit 1
+    (./test_bort_$kind ufbseq 2) && exit 1
 
     # Check ufbstp().
     (./test_bort_$kind ufbstp 1) && exit 1

test/test_bort.F90

@@ -448,39 +448,126 @@ program test_bort
   ! & 1, i1, 0) endif
   elseif (sub_name .eq. 'ufbcnt') then
      if (test_case .eq. '1') then
-        call ufbcnt(0, 1, 1)
+        call openbf(12, 'FIRST', 11)
+        open(unit = 11, file = 'testfiles/IN_2', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call ufbcnt(11, 1, 1)
      endif
   elseif (sub_name .eq. 'ufbcpy') then
      if (test_case .eq. '1') then
-        call ufbcpy(0, 0)
+        call openbf(12, 'FIRST', 11)
+        open(unit = 11, file = 'testfiles/IN_2', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call ufbcpy(11, 0)
+     elseif (test_case .eq. '2') then
+        open(unit = 12, file = 'testfiles/test_bort_OUT', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call openbf(12, 'OUT', 10)
+        call ufbcpy(12, 0)
+     elseif (test_case .eq. '3') then
+        open(unit = 12, file = 'testfiles/IN_2', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call openbf(12, 'IN', 10)
+        call ufbcpy(12, 0)
      endif
   elseif (sub_name .eq. 'ufbcup') then
      if (test_case .eq. '1') then
-        call ufbcup(0, 0)
+        call openbf(12, 'FIRST', 11)
+        open(unit = 11, file = 'testfiles/IN_2', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call ufbcup(11, 0)
+     elseif (test_case .eq. '2') then
+        open(unit = 12, file = 'testfiles/test_bort_OUT', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call openbf(12, 'OUT', 10)
+        call ufbcup(12, 0)
+     elseif (test_case .eq. '3') then
+        open(unit = 12, file = 'testfiles/IN_2', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call openbf(12, 'IN', 10)
+        call ufbcup(12, 0)
      endif
   elseif (sub_name .eq. 'ufbdmp') then
      if (test_case .eq. '1') then
-        call ufbdmp(0, 0)
+        call openbf(12, 'FIRST', 11)
+        open(unit = 11, file = 'testfiles/IN_2', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call ufbdmp(11, 0)
+     elseif (test_case .eq. '2') then
+        open(unit = 12, file = 'testfiles/test_bort_OUT', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call openbf(12, 'OUT', 10)
+        call ufbdmp(12, 0)
+     elseif (test_case .eq. '3') then
+        open(unit = 12, file = 'testfiles/IN_2', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call openbf(12, 'IN', 10)
+        call ufbdmp(12, 0)
      endif
   elseif (sub_name .eq. 'ufbevn') then
      if (test_case .eq. '1') then
-        call ufbevn(0, real_2d, 1, 2, 3, iret, 'c')
+        call openbf(12, 'FIRST', 11)
+        open(unit = 11, file = 'testfiles/IN_2', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call ufbevn(11, real_2d, 1, 2, 3, iret, 'c')
+     elseif (test_case .eq. '2') then
+        open(unit = 12, file = 'testfiles/test_bort_OUT', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call openbf(12, 'OUT', 10)
+        call ufbevn(12, real_2d, 1, 2, 3, iret, 'c')
+     elseif (test_case .eq. '3') then
+        open(unit = 12, file = 'testfiles/IN_2', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call openbf(12, 'IN', 10)
+        call ufbevn(12, real_2d, 1, 2, 3, iret, 'c')
      endif
   elseif (sub_name .eq. 'ufbget') then
      if (test_case .eq. '1') then
-        call ufbget(0, real_1d, 1, iret, 's')
+        call openbf(12, 'FIRST', 11)
+        open(unit = 11, file = 'testfiles/IN_2', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call ufbget(11, real_1d, 1, iret, 's')
+     elseif (test_case .eq. '2') then
+        open(unit = 12, file = 'testfiles/test_bort_OUT', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call openbf(12, 'OUT', 10)
+        call ufbget(12, real_1d, 1, iret, 's')
+     elseif (test_case .eq. '3') then
+        open(unit = 12, file = 'testfiles/IN_2', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call openbf(12, 'IN', 10)
+        call ufbget(12, real_1d, 1, iret, 's')
      endif
   elseif (sub_name .eq. 'ufbint') then
      if (test_case .eq. '1') then
-        call ufbint(0, real_2d, 1, 2, iret, 'c')
+        call openbf(12, 'FIRST', 11)
+        open(unit = 11, file = 'testfiles/IN_2', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call ufbint(11, real_2d, 1, 2, iret, 'c')
+     elseif (test_case .eq. '2') then
+        open(unit = 12, file = 'testfiles/IN_2', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call openbf(12, 'IN', 10)
+        call ufbint(12, real_2d, 1, 2, iret, 'c')
      endif
   elseif (sub_name .eq. 'ufbqcp') then
      if (test_case .eq. '1') then
-        call ufbqcp(0, 0, 'c')
+        call openbf(12, 'FIRST', 11)
+        open(unit = 11, file = 'testfiles/IN_2', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call ufbqcp(11, 0, 'c')
      endif
   elseif (sub_name .eq. 'ufbrep') then
      if (test_case .eq. '1') then
-        call ufbrep(0, real_2d, 1, 2, iret, 'c')
+        call openbf(12, 'FIRST', 11)
+        open(unit = 11, file = 'testfiles/IN_2', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call ufbrep(11, real_2d, 1, 2, iret, 'c')
+     elseif (test_case .eq. '2') then
+        open(unit = 12, file = 'testfiles/IN_2', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call openbf(12, 'IN', 10)
+        call ufbrep(12, real_2d, 1, 2, iret, 'c')
      endif
   elseif (sub_name .eq. 'ufbstp') then
      if (test_case .eq. '1') then
@@ -507,7 +594,17 @@ program test_bort
      endif
   elseif (sub_name .eq. 'ufbseq') then
      if (test_case .eq. '1') then
-        call ufbseq(0, real_2d, 1, 2, iret, 'c')
+        call openbf(12, 'FIRST', 11)
+        open(unit = 11, file = 'testfiles/IN_2', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call ufbseq(11, real_2d, 1, 2, iret, 'c')
+     elseif (test_case .eq. '2') then
+        open(unit = 12, file = 'testfiles/IN_2', form = 'UNFORMATTED', iostat = ios)
+        if (ios .ne. 0) stop 3
+        call openbf(12, 'IN', 10)
+        call ufbseq(12, real_2d, 1, 2, iret, 'c')
+     endif
+     if (test_case .eq. '1') then
      endif
   elseif (sub_name .eq. 'ufdump') then
      if (test_case .eq. '1') then