Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

more bort testing #441

Merged
merged 3 commits into from
Apr 7, 2023
Merged

more bort testing #441

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
feb2441
fixed bort test for ufbcnt()
edwardhartnett Apr 7, 2023
1d07a6d
fixed bort test for ufbcpy()
edwardhartnett Apr 7, 2023
be84839
more bort testing
edwardhartnett Apr 7, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
21 changes: 12 additions & 9 deletions src/ufbcnt.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)
Expand Down
10 changes: 6 additions & 4 deletions src/ufbcpy.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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>
Expand All @@ -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)
Expand Down
41 changes: 21 additions & 20 deletions src/ufbdmp.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand All @@ -27,26 +29,25 @@
C> application program (by typing 'q' then '&lt;Enter&gt;') 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)
Expand Down
2 changes: 2 additions & 0 deletions src/ufbevn.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
2 changes: 2 additions & 0 deletions src/ufbint.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
3 changes: 3 additions & 0 deletions src/ufbrms.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
13 changes: 13 additions & 0 deletions test/run_test_bort.sh
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
117 changes: 107 additions & 10 deletions test/test_bort.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down