From feb24416bacb4a524d179fdf266ebc767996637f Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Fri, 7 Apr 2023 03:10:46 -0600 Subject: [PATCH 1/3] fixed bort test for ufbcnt() --- src/ufbcnt.f | 21 ++++++++++++--------- test/test_bort.F90 | 5 ++++- 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/src/ufbcnt.f b/src/ufbcnt.f index dd49e486..08985677 100644 --- a/src/ufbcnt.f +++ b/src/ufbcnt.f @@ -4,6 +4,9 @@ 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 @@ -11,7 +14,7 @@ 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 not 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) diff --git a/test/test_bort.F90 b/test/test_bort.F90 index 0d55e53b..6b78e53b 100644 --- a/test/test_bort.F90 +++ b/test/test_bort.F90 @@ -448,7 +448,10 @@ 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 From 1d07a6db419db3ec19bdf8cd9342c07bc2a82a8c Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Fri, 7 Apr 2023 03:12:39 -0600 Subject: [PATCH 2/3] fixed bort test for ufbcpy() --- test/test_bort.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/test/test_bort.F90 b/test/test_bort.F90 index 6b78e53b..39d9100f 100644 --- a/test/test_bort.F90 +++ b/test/test_bort.F90 @@ -455,7 +455,10 @@ program test_bort 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) endif elseif (sub_name .eq. 'ufbcup') then if (test_case .eq. '1') then From be84839af4f3c7d48b8fff60439cf3b2adffc128 Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Fri, 7 Apr 2023 03:33:13 -0600 Subject: [PATCH 3/3] more bort testing --- src/ufbcpy.f | 10 ++-- src/ufbdmp.f | 41 ++++++++-------- src/ufbevn.f | 2 + src/ufbint.f | 2 + src/ufbrms.f | 3 ++ test/run_test_bort.sh | 13 +++++ test/test_bort.F90 | 107 ++++++++++++++++++++++++++++++++++++++---- 7 files changed, 146 insertions(+), 32 deletions(-) diff --git a/src/ufbcpy.f b/src/ufbcpy.f index 4e95be70..02a768e2 100644 --- a/src/ufbcpy.f +++ b/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) diff --git a/src/ufbdmp.f b/src/ufbdmp.f index 44a3b8c4..416142ab 100644 --- a/src/ufbdmp.f +++ b/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) diff --git a/src/ufbevn.f b/src/ufbevn.f index df777b4d..097d7c44 100644 --- a/src/ufbevn.f +++ b/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, diff --git a/src/ufbint.f b/src/ufbint.f index 13da2d82..27c6c4fc 100644 --- a/src/ufbint.f +++ b/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 diff --git a/src/ufbrms.f b/src/ufbrms.f index a69b0999..e81813ff 100644 --- a/src/ufbrms.f +++ b/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. diff --git a/test/run_test_bort.sh b/test/run_test_bort.sh index 716c482a..587dbab0 100644 --- a/test/run_test_bort.sh +++ b/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 diff --git a/test/test_bort.F90 b/test/test_bort.F90 index 39d9100f..0aaf77a9 100644 --- a/test/test_bort.F90 +++ b/test/test_bort.F90 @@ -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 @@ -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