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