Skip to content

Commit

Permalink
more bort testing
Browse files Browse the repository at this point in the history
  • Loading branch information
@edwardhartnett
edwardhartnett committed Apr 7, 2023
1 parent 1d07a6d commit be84839
Show file tree
Hide file tree
Showing 7 changed files with 146 additions and 32 deletions.
10 changes: 6 additions & 4 deletions src/ufbcpy.f
View file
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
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 '<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)
Expand Down
2 changes: 2 additions & 0 deletions src/ufbevn.f
View file
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
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
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
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
107 changes: 99 additions & 8 deletions test/test_bort.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -459,34 +459,115 @@ program test_bort
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 @@ -513,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

0 comments on commit be84839

Please sign in to comment.