diff --git a/.github/workflows/Intel.yml b/.github/workflows/Intel.yml index 9a6bb776..6fd766ab 100644 --- a/.github/workflows/Intel.yml +++ b/.github/workflows/Intel.yml @@ -50,7 +50,7 @@ jobs: uses: actions/cache@v2 with: path: ~/data - key: data-1 + key: data-3 - name: build run: | diff --git a/.github/workflows/Linux.yml b/.github/workflows/Linux.yml index 66d66369..132fa83f 100644 --- a/.github/workflows/Linux.yml +++ b/.github/workflows/Linux.yml @@ -41,7 +41,7 @@ jobs: uses: actions/cache@v2 with: path: ~/data - key: data-1 + key: data-3 - name: build run: | diff --git a/.github/workflows/MacOS.yml b/.github/workflows/MacOS.yml index 3459304e..11c33093 100644 --- a/.github/workflows/MacOS.yml +++ b/.github/workflows/MacOS.yml @@ -37,7 +37,7 @@ jobs: uses: actions/cache@v2 with: path: ~/data - key: data-2 + key: data-3 - name: build-bufr run: | diff --git a/.github/workflows/developer.yml b/.github/workflows/developer.yml index ad49ed87..11337ef3 100644 --- a/.github/workflows/developer.yml +++ b/.github/workflows/developer.yml @@ -38,7 +38,7 @@ jobs: uses: actions/cache@v2 with: path: ~/data - key: data-1 + key: data-3 - name: build run: | diff --git a/src/makestab.f b/src/makestab.f index 3d07eb58..c6b73cd0 100644 --- a/src/makestab.f +++ b/src/makestab.f @@ -166,7 +166,7 @@ SUBROUTINE MAKESTAB C Reset any existing inventory pointers. IF(IOMSG(LUN).NE.0) THEN - IF(LUS(LUN).EQ.0) THEN + IF(LUS(LUN).LE.0) THEN INC = (NTAB+1)-MTAB(1,LUN) ELSE INC = MTAB(1,LUS(LUN))-MTAB(1,LUN) diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 7c70322c..7f353bf0 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -3,16 +3,6 @@ # # Rahul Mahajan, Jeff Ator, Ed Hartnett -# This function builds, links, and runs a test program. -function(create_test name kind) - add_executable(${name}_${kind} ${name}.F90) - set_target_properties(${name}_${kind} PROPERTIES COMPILE_FLAGS "${fortran_${kind}_flags}") - target_compile_definitions(${name}_${kind} PUBLIC -DKIND_${kind}) - target_link_libraries(${name}_${kind} PRIVATE bufr_4) - add_dependencies(${name}_${kind} bufr_4) - add_test(NAME ${name}_${kind} COMMAND ${name}_${kind}) -endfunction() - # Fetch test data from: https://ftp.emc.ncep.noaa.gov/static_files/public/bufr.tar set(BUFR_URL "https://ftp.emc.ncep.noaa.gov/static_files/public") if(${PROJECT_VERSION} VERSION_GREATER_EQUAL 11.6.0) @@ -65,25 +55,20 @@ add_custom_command( file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/testrun) -list(APPEND test_IN_srcs - test_IN_5.F - test_IN_6.F - test_IN_7.F - test_IN_8.F90 - ) - -list(APPEND test_OUT_2_srcs - test_OUT_2.F - ) - -list(APPEND test_OUT_other_srcs - test_OUT_1.F - test_OUT_3.F - test_OUT_4.F - test_OUT_5.F - test_OUT_6.F - test_OUT_7.F90 - ) +# This function builds, links, and runs an intest or outtest program. +function(create_test name kind num) + set(testID "${name}${num}_${kind}") + add_executable(${testID} ${name}${num}.F90) + set_target_properties(${testID} PROPERTIES COMPILE_FLAGS "${fortran_${kind}_flags}") + target_compile_definitions(${testID} PUBLIC -DKIND_${kind}) + target_link_libraries(${testID} PRIVATE bufr_4) + add_dependencies(${testID} bufr_4) + if(${name} MATCHES "^intest") + add_test(NAME ${testID} COMMAND ${testID}) + else() + add_test(NAME ${testID} COMMAND ${CMAKE_BINARY_DIR}/bin/test_outtest.sh ${testID} ${num}) + endif() +endfunction() list(APPEND test_c_interface_srcs test_c_interface.c @@ -92,8 +77,7 @@ list(APPEND test_c_interface_srcs # Install testing scripts list(APPEND test_scripts - test_wrapper_IN.sh - test_wrapper_OUT.sh + test_outtest.sh test_gettab.sh test_binv.sh test_sinv.sh @@ -111,73 +95,14 @@ foreach(test_script ${test_scripts}) ${CMAKE_BINARY_DIR}/bin/${test_script} ) endforeach() -function(bufr_add_test TESTNAME EXENAME) - add_test(NAME ${TESTNAME} - COMMAND ${CMAKE_BINARY_DIR}/bin/test_wrapper_OUT.sh ${EXENAME}) -endfunction() - -function(bufr_add_test_preAPX TESTNAME EXENAME) - add_test(NAME ${TESTNAME} - COMMAND ${CMAKE_BINARY_DIR}/bin/test_wrapper_OUT.sh ${EXENAME} "Y") -endfunction() - list(APPEND test_kinds 4 8 d) -set(fortran_8_defs INTSIZE_8) - -# Add tests which don't require output log processing. foreach(kind ${test_kinds}) - create_test(intest1 ${kind}) - create_test(intest2 ${kind}) - create_test(intest3 ${kind}) - create_test(intest4 ${kind}) -endforeach() - -# IN tests -foreach(test_src ${test_IN_srcs}) - string(REGEX REPLACE "(.F90|.F)" "" testPref ${test_src}) - foreach(kind ${test_kinds}) - set(test ${testPref}_${kind}) - set(test_exe ${test}.x) - add_executable(${test_exe} ${test_src}) - set_target_properties(${test_exe} PROPERTIES COMPILE_FLAGS - "${fortran_${kind}_flags}") - target_compile_definitions(${test_exe} PRIVATE "${fortran_${kind}_defs}") - add_dependencies(${test_exe} bufr_4) - target_link_libraries(${test_exe} PUBLIC bufr::bufr_4) - add_test(NAME ${test} COMMAND ${CMAKE_BINARY_DIR}/bin/test_wrapper_IN.sh ${test_exe}) + foreach(innum RANGE 1 9) + create_test(intest ${kind} ${innum}) endforeach() -endforeach() - -# OUT_2 tests; these use the bufr_add_test_preAPX function -foreach(test_src ${test_OUT_2_srcs}) - string(REPLACE ".F" "" testPref ${test_src}) - foreach(kind ${test_kinds}) - set(test ${testPref}_${kind}) - set(test_exe ${test}.x) - add_executable(${test_exe} ${test_src}) - set_target_properties(${test_exe} PROPERTIES COMPILE_FLAGS - "${fortran_${kind}_flags}") - target_compile_definitions(${test_exe} PRIVATE "${fortran_${kind}_defs}") - add_dependencies(${test_exe} bufr_4) - target_link_libraries(${test_exe} PRIVATE bufr::bufr_4) - bufr_add_test_preAPX(${test} ${test_exe}) - endforeach() -endforeach() - -# all other OUT tests -foreach(test_src ${test_OUT_other_srcs}) - string(REGEX REPLACE "(.F90|.F)" "" testPref ${test_src}) - foreach(kind ${test_kinds}) - set(test ${testPref}_${kind}) - set(test_exe ${test}.x) - add_executable(${test_exe} ${test_src}) - set_target_properties(${test_exe} PROPERTIES COMPILE_FLAGS - "${fortran_${kind}_flags}") - target_compile_definitions(${test_exe} PRIVATE "${fortran_${kind}_defs}") - add_dependencies(${test_exe} bufr_4) - target_link_libraries(${test_exe} PRIVATE bufr::bufr_4) - bufr_add_test(${test} ${test_exe}) + foreach(outnum RANGE 1 9) + create_test(outtest ${kind} ${outnum}) endforeach() endforeach() @@ -246,4 +171,3 @@ foreach(xb_num RANGE 1 2) "${CMAKE_BINARY_DIR}/utils/xbfmg ${xb_flags_${xb_num}}" "testfiles/data" "testfiles/testoutput/xbfmg" "${xb_case}") endforeach() - diff --git a/test/intest1.F90 b/test/intest1.F90 index 5b959889..27941bbf 100644 --- a/test/intest1.F90 +++ b/test/intest1.F90 @@ -3,7 +3,7 @@ ! Reads test file 'testfiles/IN_1' using CRBMG with ! OPENBF IO = 'SEC3'. ! -! Ed Hartnett, J. Ator, 2/3/23 +! Ed Hartnett, J. Ator, 2/3/2023 program intest1 implicit none integer mxbfd4, mxds3, nds3, ierme, imgdt @@ -18,7 +18,7 @@ program intest1 real*8 r8arr(mxr8pm, mxr8lv) integer ibfmg(mxbfd4) character smidstg*9, softvstg*12, cmgtag*8, & - bfmg(mxbf), cds3(mxds3)*6, tagpr*8, celem(2)*60, cunit(2)*22 + bfmg(mxbf), cds3(mxds3)*6, tagpr*8, celem*60, cunit*22 character*20 filnam / 'testfiles/IN_1' / character filost / 'r' / equivalence (bfmg(1), ibfmg(1)) @@ -32,10 +32,10 @@ program intest1 ! Open the test file. call cobfl(filnam, filost) - ! Specify format of section 1 date/time when reading. + ! Specify format of Section 1 date/time when reading. call datelen(10) - ! Specify the use of section 3 decoding. + ! Specify the use of Section 3 decoding. open (unit = 11, file = '/dev/null') call openbf(11, 'SEC3', 11) @@ -44,59 +44,61 @@ program intest1 ! Read a BUFR message from the test file into a memory array. call crbmg(bfmg, mxbf, nbyt, ierr) - if (ierr .ne. 0) stop 2 + if (ierr .ne. 0) stop 1 ! Read and check some values from Section 1. - if ((iupbs01(ibfmg, 'MTYP') .ne. 2) .or. & - (iupbs01(ibfmg, 'MTV') .ne. 14) .or. (iupbs01(ibfmg, 'LENM') .ne. 4169)) stop 3 + if (iupbs01(ibfmg, 'MTYP') .ne. 2) stop 2 + if (iupbs01(ibfmg, 'MTV') .ne. 14) stop 3 + if (iupbs01(ibfmg, 'LENM') .ne. 4169) stop 4 ! Read and check some values from Section 3. - if ((iupbs3(ibfmg, 'NSUB') .ne. 1) .or. & - (iupbs3(ibfmg, 'ICMP') .ne. 0)) stop 4 + if (iupbs3(ibfmg, 'NSUB') .ne. 1) stop 5 + if (iupbs3(ibfmg, 'ICMP') .ne. 0) stop 6 ! Read and check some data descriptors from Section 3. call upds3(ibfmg, mxds3, cds3, nds3) - IF (nds3 .ne. 8 .or. cds3(1) .ne. '309052' .or. cds3(5) .ne. '002095') stop 5 + IF (nds3 .ne. 8 .or. cds3(1) .ne. '309052' .or. cds3(5) .ne. '002095') stop 7 ! Pass the BUFR message from the memory array into the library. call readerme(ibfmg, 11, cmgtag, imgdt, ierme) - if (ierme .ne. 0 .or. cmgtag .ne. 'MSTTB001') stop 6 + if (ierme .ne. 0 .or. cmgtag .ne. 'MSTTB001') stop 8 ! Get and check the element names and units associated with some ! Table B mnemonics. - call nemdefs(11, 'VSIGX', celem(1), cunit(1), ierndv) - call nemdefs(11, 'SMID', celem(2), cunit(2), iernds) - if (ierndv .ne. 0 .or. iernds .ne. 0 .or. celem(1)(1:40) .ne. & - 'Extended vertical sounding significance ' .or. celem(2)(1:39) .ne. & - 'Ship or mobile land station identifier ' .or. cunit(1)(1:12) .ne. & - 'FLAG TABLE ' .or. cunit(2)(1:10) .ne. 'CCITT IA5 ') stop 7 + call nemdefs(11, 'VSIGX', celem, cunit, ierndv) + if (ierndv .ne. 0 .or. celem(1:40) .ne. 'Extended vertical sounding significance ' .or. & + cunit(1:12) .ne. 'FLAG TABLE ') stop 9 + call nemdefs(11, 'SMID', celem, cunit, iernds) + if (iernds .ne. 0 .or. celem(1:39) .ne. 'Ship or mobile land station identifier ' .or. & + cunit(1:10) .ne. 'CCITT IA5 ') stop 10 ! Read and check the Section 1 date-time. - if (imgdt .ne. 2012093012) stop 8 + if (imgdt .ne. 2012093012) stop 11 ! Read a data subset from the BUFR message. - if (ireadsb(11) .ne. 0 ) stop 9 + if (ireadsb(11) .ne. 0 ) stop 12 ! Get and check the parent of a Table B mnemonic. call gettagpr(11, 'PRLC', 192, tagpr, iertgp) - if (iertgp .ne. 0 .or. tagpr .ne. 'WSPLRAOB') stop 10 + if (iertgp .ne. 0 .or. tagpr .ne. 'WSPLRAOB') stop 13 ! Read and check some data values. - call ufbint(11, r8arr, MXR8PM, MXR8LV, nr8lv, 'CLONH A4ME HSMSL QCEVR') - IF (nr8lv .ne. 1 .or. NINT(r8arr(1,1)*100000) .ne. 10388797 .or. & - NINT(r8arr(2,1)) .ne. 7 .or. NINT(r8arr(3,1)) .ne. 14 .or. & - ibfms(r8arr(4,1)) .ne. 1) stop 11 + call ufbint(11, r8arr, mxr8pm, mxr8lv, nr8lv, 'CLONH A4ME HSMSL QCEVR') + IF (nr8lv .ne. 1 .or. nint(r8arr(1,1)*100000) .ne. 10388797 .or. & + nint(r8arr(2,1)) .ne. 7 .or. nint(r8arr(3,1)) .ne. 14 .or. & + ibfms(r8arr(4,1)) .ne. 1) stop 14 ! Read and check a sequence of data values. - call ufbseq(11, r8arr, MXR8PM, MXR8LV, nr8lv, 'TDWPRAOB') - IF (nr8lv .ne. 191 .or. NINT(r8arr(8,3)*100) .ne. 29416 .or. & - NINT(r8arr(10,11)*10) .ne. 55 .or. NINT(r8arr(2,12)) .ne. 2048 .or. & - NINT(r8arr(5,67)*100000) .ne. -1167 .or. NINT(r8arr(1,186)) .ne. 2523) stop 12 + call ufbseq(11, r8arr, mxr8pm, mxr8lv, nr8lv, 'TDWPRAOB') + IF (nr8lv .ne. 191 .or. nint(r8arr(8,3)*100) .ne. 29416 .or. & + nint(r8arr(10,11)*10) .ne. 55 .or. nint(r8arr(2,12)) .ne. 2048 .or. & + nint(r8arr(5,67)*100000) .ne. -1167 .or. nint(r8arr(1,186)) .ne. 2523) stop 15 ! Read and check some long character strings. call readlc(11, smidstg, 'SMID') + IF (smidstg(7:9) .ne. 'UAO') stop 16 call readlc(11, softvstg, 'SOFTV') - IF (smidstg(7:9) .ne. 'UAO' .or. softvstg(5:12) .ne. '5.8.5.10') stop 13 + IF (softvstg(5:12) .ne. '5.8.5.10') stop 17 ! Close the test file. call ccbfl() diff --git a/test/intest2.F90 b/test/intest2.F90 index 83ee9387..c038fdc8 100644 --- a/test/intest2.F90 +++ b/test/intest2.F90 @@ -3,7 +3,7 @@ ! Reads test file 'testfiles/IN_2' with OPENBF IO = IN and LUNIN != ! LUNDX. ! -! Ed Hartnett, J. Ator, 2/15/23 +! Ed Hartnett, J. Ator, 2/15/2023 program intest2 implicit none integer*4 ireadmg, iupvs01, nmsub, ibfms diff --git a/test/intest3.F90 b/test/intest3.F90 index 1e1ae3f7..c210d0a9 100644 --- a/test/intest3.F90 +++ b/test/intest3.F90 @@ -3,7 +3,7 @@ ! Reads test file 'testfiles/IN_3' using nested delayed ! replication, OPENBF IO = IN, and LUNIN = LUNDX. ! -! Ed Hartnett, J. Ator, 2/22/23 +! Ed Hartnett, J. Ator, 2/22/2023 program intest3 implicit none @@ -14,13 +14,12 @@ program intest3 parameter (mxr8lv = 50) integer isct, imgdt, ityr, itmo, itdy, ithr, itmi, ier, & - nr8lv, nr8rr, nr8rf, nr8rhr, nr8rh, nr8rdr, nr8rd, & - ierndh, iernds, ierndd + nr8lv, nr8rr, nr8rf, nr8rhr, nr8rh, nr8rdr, nr8rd real*8 r8arr(mxr8pm, mxr8lv), r8arf(mxr8pm, mxr8lv), r8arhr(1, mxr8lv), & r8arh(mxr8pm, mxr8lv), r8ardr(1, mxr8lv), r8ard (mxr8pm, mxr8lv) - character cmgtag*8, celem(3)*40, cunit(3)*20 + character cmgtag*8, celem*40, cunit*20 print *, 'Testing reading IN_3, using nested delayed replication, OPENBF IO = IN, and LUNIN = LUNDX' @@ -131,16 +130,18 @@ program intest3 enddo ! Verify that all available subsets were successfully read. - if ( isct .ne. 10 ) stop 102 + if ( isct .ne. 10 ) stop 112 ! Check some mnemonic definitions. - call nemdefs ( 11, 'HSMSL', celem(1), cunit(1), ierndh ) - call nemdefs ( 11, 'SHRV', celem(2), cunit(2), iernds ) - call nemdefs ( 11, 'DCHG', celem(3), cunit(3), ierndd ) - if ( ( ierndh .ne. 0 ) .or. ( iernds .ne. 0 ) .or. ( ierndd .ne. 0 ) .or. ( celem(1)(1:36) .ne. & - 'HEIGHT OF STATION GROUND ABOVE MSL ' ) .or. ( cunit(1)(1:9) .ne. 'METERS ' ) .or. & - ( celem(2)(1:24) .ne. 'SHEF DATA REVISION FLAG ' ) .or. ( cunit(2)(1:12) .ne. 'CODE TABLE ' ) .or. & - ( celem(3)(1:15) .ne. 'DISCHARGE ' ) .or. ( cunit(3)(1:20) .ne. 'METERS**3/SECOND ' ) ) stop 103 + call nemdefs ( 11, 'HSMSL', celem, cunit, ier ) + if ( ( ier .ne. 0 ) .or. ( celem(1:36) .ne. 'HEIGHT OF STATION GROUND ABOVE MSL ' ) .or. & + ( cunit(1:9) .ne. 'METERS ' ) ) stop 113 + call nemdefs ( 11, 'SHRV', celem, cunit, ier ) + if ( ( ier .ne. 0 ) .or. ( celem(1:24) .ne. 'SHEF DATA REVISION FLAG ' ) .or. & + ( cunit(1:12) .ne. 'CODE TABLE ' ) ) stop 114 + call nemdefs ( 11, 'DCHG', celem, cunit, ier ) + if ( ( ier .ne. 0 ) .or. ( celem(1:15) .ne. 'DISCHARGE ' ) .or. & + ( cunit(1:20) .ne. 'METERS**3/SECOND ' ) ) stop 115 print *, 'SUCCESS!' end program intest3 diff --git a/test/intest4.F90 b/test/intest4.F90 index b616b46f..f4b359ec 100644 --- a/test/intest4.F90 +++ b/test/intest4.F90 @@ -3,15 +3,15 @@ ! Reads test file 'testfiles/IN_4' using CRBMG with OPENBF IO = 'SEC3' ! using bitmap and marker operators. ! -! Ed Hartnett, J. Ator, 2/22/23 +! Ed Hartnett, J. Ator, 2/22/2023 program intest4 implicit none integer*4 ireadsb, iupbs01, iupbs3, ibfms integer*4 mxbf, nbyt, ierr - integer ier1,ier2, ier3, ierme, imgdt, nds3 - integer nr8lv, nr8lv2, ntag1, ntag2, ntag3 + integer ier, imgdt, nds3 + integer nr8lv, ntag integer mxbfd4, mxds3, mxr8lv, mxr8pm parameter (mxbf = 20000) @@ -20,17 +20,17 @@ program intest4 parameter (mxr8pm = 10) parameter (mxr8lv = 255) - real*8 r8arr (mxr8pm, mxr8lv), r8arr2 (mxr8pm, mxr8lv) + real*8 r8arr (mxr8pm, mxr8lv) integer ibfmg (mxbfd4) - character cmgtag*8, bfmg(mxbf), cds3(mxds3)*6, tag1*8, tag2*8, tag3*8 + character cmgtag*8, bfmg(mxbf), cds3(mxds3)*6, tag*8 character*20 filnam / 'testfiles/IN_4' / character filost / 'r' / equivalence (bfmg (1), ibfmg (1)) - print *, 'Testing reading IN_1, using CRBMG with OPENBF IO = SEC3, and using bitmap and marker operators.' + print *, 'Testing reading IN_4, using CRBMG with OPENBF IO = SEC3, and using bitmap and marker operators.' #ifdef KIND_8 call setim8b(.true.) @@ -70,8 +70,8 @@ program intest4 cds3(32) .ne. '237000' .or. cds3(44) .ne. '224255') stop 4 ! Pass the message into the library so that Section 4 data can be read. - call readerme(ibfmg, 11, cmgtag, imgdt, ierme) - If (ierme .ne. 0 .or. cmgtag .ne. 'MSTTB001' .or. imgdt .ne. 2016041815 ) stop 5 + call readerme(ibfmg, 11, cmgtag, imgdt, ier) + If (ier .ne. 0 .or. cmgtag .ne. 'MSTTB001' .or. imgdt .ne. 2016041815 ) stop 5 ! Read a data subset from the BUFR message. if (ireadsb(11) .ne. 0) stop 6 @@ -83,18 +83,18 @@ program intest4 ibfms(r8arr(4,1)) .ne. 1) stop 7 call ufbrep(11, r8arr, mxr8pm, mxr8lv, nr8lv, 'PCCF') - call ufbrep(11, r8arr2, mxr8pm, mxr8lv, nr8lv2, '224255') - if (nr8lv .ne. 180 .or. nint(r8arr(1,12)) .ne. 86 .or. nint(r8arr(1,15)) .ne. 38 .or. & - nint(r8arr(1,102)) .ne. 88 .or. nint(r8arr(1,141)) .ne. 10 .or. nr8lv2 .ne. 72 .or. & - nint(r8arr2(1,12)*10) .ne. 6 .or. nint(r8arr2(1,33)*10) .ne. 4) stop 8 + if ( nr8lv .ne. 180 .or. nint(r8arr(1,12)) .ne. 86 .or. nint(r8arr(1,15)) .ne. 38 .or. & + nint(r8arr(1,102)) .ne. 88 .or. nint(r8arr(1,141)) .ne. 10 ) stop 8 + call ufbrep(11, r8arr, mxr8pm, mxr8lv, nr8lv, '224255') + if ( nr8lv .ne. 72 .or. nint(r8arr(1,12)*10) .ne. 6 .or. nint(r8arr(1,33)*10) .ne. 4) stop 9 ! Check some bitmap and marker operator references in the data subset. - call gettagre(11, 'PCCF', 57, tag1, ntag1, ier1) - call gettagre(11, 'PCCF', 154, tag2, ntag2, ier2) - call gettagre(11, '224255', 65, tag3, ntag3, ier3) - if (ier1 .ne. 0 .or. ier2 .ne. 0 .or. ier3 .ne. 0 .or. tag1 .ne. 'TMBRST ' .or. & - ntag1 .ne. 7 .or. tag2 .ne. 'SPRD ' .or. ntag2 .ne. 4 .or. & - tag3 .ne. 'RDNE ' .or. ntag3 .ne. 10) stop 9 + call gettagre(11, 'PCCF', 57, tag, ntag, ier) + if ( ier .ne. 0 .or. ntag .ne. 7 .or. tag .ne. 'TMBRST ' ) stop 10 + call gettagre(11, 'PCCF', 154, tag, ntag, ier) + if ( ier .ne. 0 .or. ntag .ne. 4 .or. tag .ne. 'SPRD ' ) stop 11 + call gettagre(11, '224255', 65, tag, ntag, ier) + if ( ier .ne. 0 .or. ntag .ne. 10 .or. tag .ne. 'RDNE ' ) stop 12 ! Close the test file. call ccbfl() diff --git a/test/intest5.F90 b/test/intest5.F90 new file mode 100644 index 00000000..cacdba14 --- /dev/null +++ b/test/intest5.F90 @@ -0,0 +1,65 @@ +! This is a test for NCEPLIBS-bufr. +! +! Reads test file 'testfiles/IN_5', using UFBGET and UFBINX, and checking PREPBUFR code/flag table meaning strings +! +! J. Ator, 2/24/2023 +program intest5 + implicit none + + integer*4 ireadns + + integer, parameter :: mxr8pm = 6 + integer, parameter :: mxr8lv = 10 + + integer imgdt, lcmg, ier, nlv + + real*8 r8vals ( mxr8pm, mxr8lv ), r81dvals ( mxr8pm ) + + character cmgtag*8, cmeang*40 + + print *, 'Testing reading IN_5, using UFBGET and UFBINX, and checking PREPBUFR code/flag table meaning strings.' + +#ifdef KIND_8 + call setim8b ( .true. ) +#endif + + open ( unit = 11, file = 'testfiles/IN_5', form ='unformatted') + + call openbf ( 11, 'IN', 11 ) + + ! Set the directory location for the master tables. + call mtinfo ( '../tables', 90, 91 ) + + ! Specify that we want to read in the code and flag tables. + call codflg ( 'Y' ) + + ! Read a data subset. + if ( ireadns ( 11, cmgtag, imgdt ) .ne. 0 ) stop 1 + + ! Read and verify some 1-dimensional values from this data subset. + call ufbget ( 11, r81dvals, mxr8pm, nlv, 'XOB YOB DHR ELV T29 {PRSLEVEL}' ) + if ( ( nlv .ne. 0 ) .or. ( nint(r81dvals(1)*100) .ne. 12223 ) .or. ( nint(r81dvals(2)*100) .ne. -1795 ) .or. & + ( nint(r81dvals(3)) .ne. -1 ) .or. ( nint(r81dvals(4)) .ne. 9 ) .or. ( nint(r81dvals(5)) .ne. 11 ) .or. & + ( nint(r81dvals(6)) .ne. 44 ) ) stop 2 + + ! Retrieve and check some code/flag meaning strings. + call getcfmng ( 11, 'PRC', 106, ' ', -1, cmeang, lcmg, ier ) + if ( ( ier .ne. 1 ) .or. ( lcmg .ne. 8 ) .or. ( cmeang(1:lcmg) .ne. 'PPC ' ) ) stop 3 + call getcfmng ( 11, 'PRC', 106, 'PPC', 5, cmeang, lcmg, ier ) + if ( ( ier .ne. 0 ) .or. ( lcmg .ne. 34 ) .or. & + ( cmeang(1:lcmg) .ne. 'Surface pressure observation error' ) ) stop 4 + call getcfmng ( 11, 'GSES', 10, ' ', -1, cmeang, lcmg, ier ) + if ( ( ier .ne. 3 ) .or. ( lcmg .ne. 24 ) .or. ( cmeang(1:lcmg) .ne. 'GCLONG OGCE ORIGC ' ) ) stop 5 + call getcfmng ( 11, 'GSES', 10, 'GCLONG', 173, cmeang, lcmg, ier ) + if ( ( ier .ne. 0 ) .or. ( lcmg .ne. 20 ) .or. ( cmeang(1:lcmg) .ne. 'Stennis Space Center' ) ) stop 6 + + ! Read and verify some values from the 2nd data subset of the 2nd message. + call ufbinx ( 11, 2, 2, r8vals, mxr8pm, mxr8lv, nlv, 'CLAM CLTP' ) + if ( ( nlv .ne. 3 ) .or. ( nint(r8vals(1,1)) .ne. 7 ) .or. ( nint(r8vals(2,1)) .ne. 38 ) .or. & + ( nint(r8vals(2,2)) .ne. 61 ) .or. ( nint(r8vals(2,3)) .ne. 60 ) ) stop 7 + + ! Free the memory that was dynamically allocated when reading the code and flag tables. + call dlloctbf() + + print *, 'SUCCESS!' +end program intest5 diff --git a/test/intest6.F90 b/test/intest6.F90 new file mode 100644 index 00000000..c09cc222 --- /dev/null +++ b/test/intest6.F90 @@ -0,0 +1,59 @@ +! This is a test for NCEPLIBS-bufr. +! +! Reads test file 'testfiles/IN_6' using UFBMEM, RDMEMM, UFBMNS, and UFBTAM +! +! J. Ator, 2/23/2023 +program intest6 + implicit none + + integer*4 nmsub + + integer iyr, imon, iday, ihour, imgdt, ier, icnt, iunt, nsub + + integer mxr8pm, mxr8lv + parameter ( mxr8pm = 2 ) + parameter ( mxr8lv = 19000 ) + + real*8 r8vals (mxr8pm, mxr8lv) + + character cmgtag*8 + + print *, 'Testing reading IN_6 using UFBMEM, RDMEMM, UFBMNS, and UFBTAM' + +#ifdef KIND_8 + call setim8b ( .true. ) +#endif + + open ( unit = 21, file = 'testfiles/IN_6_infile1', form = 'unformatted') + open ( unit = 22, file = 'testfiles/IN_6_infile2', form = 'unformatted') + + ! Verify the Section 1 date-time in the first data message of one of the input files. + call datebf ( 22, iyr, imon, iday, ihour, imgdt ) + if ( ( imgdt .ne. 21031900 ) .or. ( iyr .ne. 21 ) .or. ( iday .ne. 19 ) ) stop 1 + + ! Rewind that input file. + rewind ( 22 ) + + ! Open both input files and read the contents into internal arrays. + call ufbmem ( 21, 0, icnt, iunt ) + if ( ( icnt .ne. 926 ) .or. ( iunt .ne. 21 ) ) stop 2 + call ufbmem ( 22, 1, icnt, iunt ) + if ( ( icnt .ne. 344 ) .or. ( iunt .ne. 21 ) ) stop 3 + + ! Locate message #167 within the internal arrays and verify some values. + call rdmemm ( 167, cmgtag, imgdt, ier ) + if ( ( cmgtag .ne. 'NC004002' ) .or. ( imgdt .ne. 21031713 ) .or. ( nmsub(iunt) .ne. 3 ) ) stop 4 + + ! Locate subset #18364 within the internal arrays and verify some values. + call ufbmns ( 18364, cmgtag, imgdt ) + if ( ( cmgtag .ne. 'NC002003' ) .or. ( imgdt .ne. 21031900 ) .or. ( nmsub(iunt) .ne. 2 ) ) stop 5 + + ! Scan for certain values across all of the data subsets in the internal arrays, and verify some of them. + call ufbtam ( r8vals, mxr8pm, mxr8lv, nsub, 'CLAT CLON' ) + if ( ( nsub .ne. 18447 ) .or. & + ( nint(r8vals(1,1285)*100) .ne. 4328 ) .or. ( nint(r8vals(2,1285)*100) .ne. -7910 ) .or. & + ( nint(r8vals(1,5189)*100) .ne. 3918 ) .or. ( nint(r8vals(2,5189)*100) .ne. 11638 ) .or. & + ( nint(r8vals(1,17961)*100) .ne. 3070 ) .or. ( nint(r8vals(2,17961)*100) .ne. 10383 ) ) stop 6 + + print *, 'SUCCESS!' +end program intest6 diff --git a/test/intest7.F90 b/test/intest7.F90 new file mode 100644 index 00000000..be52ffec --- /dev/null +++ b/test/intest7.F90 @@ -0,0 +1,152 @@ +! This is a test for NCEPLIBS-bufr. +! +! Reads test file 'testfiles/IN_7' containing 2-03-YYY changed reference values, using inline ERRWRT to +! check error messages, and using UFBPOS, UFBTAB, and VALX +! +! J. Ator, 2/23/2023 + +module Share_errstr + ! This module is needed in order to share information between the test program and subroutine errwrt, because + ! the latter is not called by the former but rather is called directly from within the BUFRLIB software. + + character*1500 errstr + + integer errstr_len +end module Share_errstr + +subroutine errwrt(str) + ! This subroutine supersedes the subroutine of the same name within the BUFRLIB software, so that we can + ! easily test the generation of error messages from within the library. + + use Share_errstr + + character*(*) str + + integer str_len + + str_len = len(str) + errstr ( errstr_len + 1 : errstr_len + str_len + 1 ) = str + errstr_len = errstr_len + str_len + + return +end subroutine errwrt + +program intest7 + use Share_errstr + + implicit none + + integer*4 isetprm, igetprm, ireadns, ibfms + + integer imgdt, iret, jdate, nr8v, idx, nsub + + integer mxr8pm, mxr8lv + parameter ( mxr8pm = 15 ) + parameter ( mxr8lv = 5 ) + + real*8 r8arr (mxr8pm, mxr8lv), r8val + + real valx + + character cmgtag*8 + + print *, 'Testing reading IN_7 containing 2-03-YYY changed reference values, using inline ERRWRT' + print *, 'to check error messages, and using UFBPOS, UFBTAB, and VALX' + +#ifdef KIND_8 + call setim8b ( .true. ) +#endif + + ! Check error messages in ISETPRM. + iret = isetprm ( 'MXNRV', 5 ) + if ( iret .ne. 0 ) stop 1 + errstr_len = 1 + iret = isetprm ( 'DUMMY', 20 ) + if ( ( iret .ne. -1 ) .or. & + ( index( errstr(1:errstr_len), 'ISETPRM - UNKNOWN INPUT PARAMETER DUMMY' ) .eq. 0 ) ) stop 2 + + ! Open the input file and DX table. + open ( unit = 11, file = 'testfiles/IN_7', form ='unformatted') + open ( unit = 12, file = 'testfiles/IN_7_bufrtab' ) + call openbf ( 11, 'IN', 12 ) + call openbf ( 11, 'QUIET', 1 ) + + ! Check error messages in IGETPRM. + iret = igetprm ( 'MXNRV' ) + if ( iret .ne. 5 ) stop 3 + errstr_len = 1 + iret = igetprm ( 'DUMMY' ) + if ( ( iret .ne. -1 ) .or. & + ( index( errstr(1:errstr_len), 'IGETPRM - UNKNOWN INPUT PARAMETER DUMMY' ) .eq. 0 ) ) stop 4 + + ! Read some data values from the 1st messaage, which uses the 2-03-YYY operator to change one of the + ! reference values. + if ( ireadns ( 11, cmgtag, imgdt ) .ne. 0 ) stop 5 + call ufbrep ( 11, r8arr, mxr8pm, mxr8lv, nr8v, 'TIDER' ) + if ( ( nr8v .ne. 2 ) .or. & + ( nint ( r8arr(1,1) ) .ne. -10000 ) .or. ( nint ( r8arr(1,2) ) .ne. 16 ) ) stop 6 + errstr_len = 1 + call ufbrep ( 11, r8val, 1, 1, nr8v, 'DUMMY' ) + idx = index( errstr(1:errstr_len), 'UFBREP - NO SPECIFIED VALUES READ IN' ) + if ( ( nr8v .ne. 0 ) .or. ( idx .eq. 0 ) ) stop 7 + errstr_len = 1 + call ufbrep ( 11, r8val, 0, 1, nr8v, 'TIDER' ) + idx = index( errstr(1:errstr_len), 'UFBREP - 3rd ARG. (INPUT) IS .LE. 0' ) + if ( ( nr8v .ne. 0 ) .or. ( idx .eq. 0 ) ) stop 8 + + ! Jump ahead to the 5th subset of the 23rd message and read some data values. + call ufbpos ( 11, 23, 5, cmgtag, jdate ) + call ufbint ( 11, r8arr, mxr8pm, mxr8lv, nr8v, 'CLATH CLONH TMDB SWRAD' ) + if ( ( nr8v .ne. 1 ) .or. & + ( nint ( r8arr(1,1)*100000 ) .ne. 2001191 ) .or. ( nint ( r8arr(2,1)*100000 ) .ne. -3785017 ) .or. & + ( nint ( r8arr(3,1)*100 ) .ne. 30035 ) .or. ( nint ( r8arr(4,1) ) .ne. 2187000 ) ) stop 9 + errstr_len = 1 + call ufbint ( 11, r8val, 1, 1, nr8v, 'DUMMY' ) + idx = index( errstr(1:errstr_len), 'UFBINT - NO SPECIFIED VALUES READ IN' ) + if ( ( nr8v .ne. 0 ) .or. ( idx .eq. 0 ) ) stop 10 + errstr_len = 1 + call ufbint ( 11, r8val, 1, 0, nr8v, 'TMDB' ) + idx = index( errstr(1:errstr_len), 'UFBINT - 4th ARG. (INPUT) IS .LE. 0' ) + if ( ( nr8v .ne. 0 ) .or. ( idx .eq. 0 ) ) stop 11 + + ! Jump ahead to the 2nd subset of the 30th message and read some data values. + call ufbpos ( 11, 30, 2, cmgtag, jdate ) + call ufbstp ( 11, r8arr, mxr8pm, mxr8lv, nr8v, 'CLAT CLON HSMSL' ) + if ( ( nr8v .ne. 1 ) .or. & + ( nint ( r8arr(1,1)*100 ) .ne. 3163 ) .or. ( nint ( r8arr(2,1)*100 ) .ne. -11017 ) .or. & + ( nint ( r8arr(3,1) ) .ne. 1205 ) ) stop 12 + errstr_len = 1 + call ufbstp ( 11, r8val, 1, 1, nr8v, 'DUMMY' ) + idx = index( errstr(1:errstr_len), 'UFBSTP - NO SPECIFIED VALUES READ IN' ) + if ( ( nr8v .ne. 0 ) .or. ( idx .eq. 0 ) ) stop 13 + errstr_len = 1 + call ufbstp ( 11, r8val, 1, 0, nr8v, 'CLON' ) + idx = index( errstr(1:errstr_len), 'UFBSTP - 4th ARG. (INPUT) IS .LE. 0' ) + if ( ( nr8v .ne. 0 ) .or. ( idx .eq. 0 ) ) stop 14 + + ! Jump backwards to the 88th subset of the 29th message and read some data values. + call ufbpos ( 11, 29, 88, cmgtag, jdate ) + call ufbseq ( 11, r8arr, mxr8pm, mxr8lv, nr8v, 'NC008023' ) + if ( ( nr8v .ne. 1 ) .or. & + ( nint ( r8arr(6,1)*100000 ) .ne. 2967000 ) .or. ( nint ( r8arr(7,1)*100000 ) .ne. -9512833 ) .or. & + ( nint ( r8arr(5,1) ) .ne. 482011039 ) ) stop 15 + errstr_len = 1 + call ufbseq ( 11, r8val, 1, 1, nr8v, 'DUMMY' ) + idx = index( errstr(1:errstr_len), 'UFBSEQ - NO SPECIFIED VALUES READ IN' ) + if ( ( nr8v .ne. 0 ) .or. ( idx .eq. 0 ) ) stop 16 + errstr_len = 1 + call ufbseq ( 11, r8val, 0, 1, nr8v, 'CLON' ) + idx = index( errstr(1:errstr_len), 'UFBSEQ - 3rd ARG. (INPUT) IS .LE. 0' ) + if ( ( nr8v .ne. 0 ) .or. ( idx .eq. 0 ) ) stop 17 + + ! Rewind the file and get a total count of the subsets. + call ufbtab ( -11, r8val, 1, 1, nsub, ' ' ) + if ( ( nsub .ne. 402 ) .or. ( ibfms ( r8val ) .ne. 1 ) ) stop 18 + + ! Test the error handling inside of VALX. + errstr_len = 1 + r8val = valx ( '75.DUMMY' ) + if ( ( index( errstr(1:errstr_len), 'VALX - ERROR READING STRING' ) .eq. 0 ) ) stop 19 + + print *, 'SUCCESS!' +end program intest7 diff --git a/test/intest8.F90 b/test/intest8.F90 new file mode 100644 index 00000000..030483cb --- /dev/null +++ b/test/intest8.F90 @@ -0,0 +1,73 @@ +! This is a test for NCEPLIBS-bufr. +! +! Reads test file 'testfiles/IN_8' using RDMGSB, UFBEVN, UFBQCD, and UFBQCP to read prepbufr file +! +! J. Ator, 2/24/2023 +program intest8 + implicit none + + integer, parameter :: mxr8pm = 15 + integer, parameter :: mxr8lv = 500 + integer, parameter :: mxr8en = 10 + + integer ibit(6), nib, ier, ilv, iqcd + + real*8 hdr(6,1), r8vals( mxr8pm, mxr8lv, mxr8en ), r8v + + character*8 mnem + + print *, 'Testing reading IN_8 using RDMGSB, UFBEVN, UFBQCD, and UFBQCP to read prepbufr file.' + +#ifdef KIND_8 + call setim8b ( .true. ) +#endif + + open ( unit = 11, file = 'testfiles/data/prepbufr', form ='unformatted' ) + + ! Read the 3rd subset from the 27th message of the prepbufr file and check some values. + call rdmgsb ( 11, 27, 3 ) + call ufbint ( 11, hdr, 6, 1, ier, 'XOB YOB ELV TYP T29 ITP' ) + if ( ( nint(hdr(1,1)*100) /= 30233 ) .or. ( nint(hdr(2,1)*100) /= -1900 ) .or. & + ( nint(hdr(3,1)) /= 142 ) .or. ( nint(hdr(4,1)) /= 120 ) .or. & + ( nint(hdr(5,1)) /= 11 ) .or. ( nint(hdr(6,1)) /= 80 ) ) stop 1 + + ! Get all of the moisture data from this subset and check some values. + call ufbevn ( 11, r8vals, mxr8pm, mxr8lv, mxr8en, ilv, 'QOB QQM QPC QRC' ) + if ( ( ilv /= 51 ) .or. & + ( nint(r8vals(1,2,2)) /= 17895 ) .or. ( nint(r8vals(2,2,2)) /= 2 ) .or. & + ( nint(r8vals(3,2,2)) /= 1 ) .or. ( nint(r8vals(4,2,2)) /= 100 ) .or. & + ( nint(r8vals(1,36,1)) /= 126 ) .or. ( nint(r8vals(2,36,1)) /= 9 ) .or. & + ( nint(r8vals(3,36,1)) /= 8 ) .or. ( nint(r8vals(4,36,1)) /= 1 ) .or. & + ( nint(r8vals(1,50,3)) /= 3 ) .or. ( nint(r8vals(2,50,3)) /= 15 ) .or. & + ( nint(r8vals(3,50,3)) /= 1 ) .or. ( nint(r8vals(4,50,3)) /= 100 ) ) stop 2 + + ! Now, get all of the temperature data from this subset which meets the conditions of being on + ! a level where the pressure is between 490mb and 44mb, and check some of those values. + call ufbevn ( 11, r8vals, MXR8PM, MXR8LV, MXR8EN, ilv, 'POB<490 POB>44 POB TOB TQM TPC TRC' ) + if ( ( ilv /= 33 ) .or. & + ( nint(r8vals(1,5,1)) /= 378 ) .or. ( nint(r8vals(2,5,1)*10) /= -149 ) .or. & + ( nint(r8vals(4,5,1)) /= 8 ) .or. ( nint(r8vals(2,5,2)*10) /= -151 ) .or. & + ( nint(r8vals(5,5,2)) /= 100 ) .or. ( nint(r8vals(1,29,1)*10) /= 699 ) .or. & + ( nint(r8vals(2,29,1)*10) /= -809 ) .or. ( nint(r8vals(3,29,1)) /= 2 ) ) stop 3 + + ! Other checks. + + call ufbqcd ( 11, 'RADCOR', iqcd ) + if ( iqcd /= 6 ) stop 4 + call ufbqcd ( 11, 'ACARSQC', iqcd ) + if ( iqcd /= 14 ) stop 5 + + call ufbqcp ( 11, 2, mnem ) + if ( mnem(1:7) .ne. 'SYNDATA' ) stop 6 + call ufbqcp ( 11, 8, mnem ) + if ( mnem(1:6) .ne. 'VIRTMP' ) stop 7 + + r8v = 224. + call upftbv ( 11, 'RSRD', r8v, 6, ibit, nib ) + if ( ( nib /= 3 ) .or. ( ibit(1) /= 2 ) .or. ( ibit(2) /= 3 ) .or. ( ibit(3) /= 4 ) ) stop 8 + r8v = 264192. + call upftbv ( 11, 'WVCQ', r8v, 6, ibit, nib ) + if ( ( nib /= 2 ) .or. ( ibit(1) /= 6 ) .or. ( ibit(2) /= 13 ) ) stop 9 + + print *, 'SUCCESS!' +end program intest8 diff --git a/test/intest9.F90 b/test/intest9.F90 new file mode 100644 index 00000000..49581b6c --- /dev/null +++ b/test/intest9.F90 @@ -0,0 +1,70 @@ +! This is a test for NCEPLIBS-bufr. +! +! Reads test file 'testfiles/IN_9' using UFBIN3 to read prepfits file. +! +! J. Ator, 3/1/2023 +program intest9 + implicit none + + integer*4 ireadmg, ireadsb + + integer, parameter :: mxr8pm = 15 + integer, parameter :: mxr8lv = 500 + integer, parameter :: mxr8en = 10 + + real*8 hdr(5,1), r8vals( mxr8pm, mxr8lv, mxr8en ) + + integer ier, iret, jret, ii, imgdt + + character*8 cmgtag + + print *, 'Testing reading IN_9 using UFBIN3 to read prepfits file.' + +#ifdef KIND_8 + call setim8b ( .true. ) +#endif + + open ( unit = 11, file = 'testfiles/IN_9', form ='unformatted' ) + + ! Read the 5th subset from the 1st message of the prepfits file and check some values. + call rdmgsb ( 11, 1, 5 ) + call ufbint ( 11, hdr, 5, 1, ier, 'XOB YOB ELV TYP T29' ) + if ( ( nint(hdr(1,1)*100) /= 25242 ) .or. ( nint(hdr(2,1)*100) /= 4907 ) .or. & + ( nint(hdr(3,1)) /= 798 ) .or. ( nint(hdr(4,1)) /= 284 ) .or. & + ( nint(hdr(5,1)) /= 512 ) ) stop 1 + call ufbin3 ( 11, r8vals, mxr8pm, mxr8lv, mxr8en, iret, jret, 'POB QOB TOB TDO' ) + if ( ( iret /= 2 ) .or. ( jret /= 1 ) .or. & + ( nint(r8vals(1,2,1)*10) /= 9137 ) .or. ( nint(r8vals(2,1,1)) /= 785 ) .or. & + ( nint(r8vals(3,1,1)*10) /= -159 ) .or. ( nint(r8vals(4,2,1)*10) /= -209 ) ) stop 2 + + ! Now, read the 1st subset from the 3rd message of the prepfits file and check some values. + do ii = 1, 2 + if ( ireadmg ( 11, cmgtag, imgdt ) /= 0 ) stop 3 + end do + if ( cmgtag .ne. 'ADPUPA ' ) stop 4 + if ( ireadsb (11) /= 0 ) stop 5 + call ufbin3 ( 11, r8vals, mxr8pm, mxr8lv, mxr8en, iret, jret, 'POB QOB UOB CAPE VENT' ) + if ( ( iret /= 49 ) .or. ( jret /= 1 ) .or. & + ( nint(r8vals(4,1,1)) /= 0 ) .or. ( nint(r8vals(5,1,1)) /= 12174 ) .or. & + ( nint(r8vals(1,9,1)*10) /= 2760 ) .or. ( nint(r8vals(2,9,1)) /= 47 ) .or. & + ( nint(r8vals(1,26,1)*10) /= 6748 ) .or. ( nint(r8vals(3,26,1)*10) /= 88 ) ) stop 6 + + ! Now, read the 7th subset from the 4th message of the prepfits file, and check some wind + ! values for levels where the pressure is between 800mb and 400mb. + if ( ireadmg ( 11, cmgtag, imgdt ) /= 0 ) stop 7 + if ( cmgtag .ne. 'VADWND ' ) stop 8 + do ii = 1, 7 + if ( ireadsb (11) /= 0 ) stop 9 + end do + call ufbint ( 11, hdr, 5, 1, ier, 'XOB YOB ELV TYP T29' ) + if ( ( nint(hdr(1,1)*100) /= 28299 ) .or. ( nint(hdr(2,1)*100) /= 3698 ) .or. & + ( nint(hdr(3,1)) /= 77 ) .or. ( nint(hdr(4,1)) /= 224 ) .or. & + ( nint(hdr(5,1)) /= 72 ) ) stop 10 + call ufbin3 ( 11, r8vals, mxr8pm, mxr8lv, mxr8en, iret, jret, 'POB<800 POB>400 POB UOB VOB' ) + if ( ( iret /= 9 ) .or. ( jret /= 1 ) .or. & + ( nint(r8vals(1,1,1)*10) /= 7818 ) .or. ( nint(r8vals(2,1,1)*10) /= 180 ) .or. & + ( nint(r8vals(1,7,1)*10) /= 5491 ) .or. ( nint(r8vals(3,7,1)*10) /= -67 ) .or. & + ( nint(r8vals(2,8,1)*10) /= 353 ) .or. ( nint(r8vals(3,8,1)*10) /= -69 ) ) stop 11 + + print *, 'SUCCESS!' +end program intest9 diff --git a/test/outtest1.F90 b/test/outtest1.F90 new file mode 100644 index 00000000..35f5c6ac --- /dev/null +++ b/test/outtest1.F90 @@ -0,0 +1,166 @@ +! This is a test for NCEPLIBS-bufr. +! +! Writes test file 'testfiles/OUT_1' using OPENBF IO = 'OUT' and LUNIN != LUNDX, +! and using 2-03-YYY to change reference values. +! +! J. Ator, 2/16/2023 +program outtest1 + implicit none + + real*8 r8ymd(3,1), r8ltl(2,1), r8flv(1,5), r8oth(10,1) + + integer*4 lcmgdf + + integer nsc(5), nrf(5), nbt(5), ierns(5) + integer nsa, nra, nba, iernsa, nsm, nrm, nbm, iernsm + integer iertgp, jj, nlv + + character acrn*10, libvrsn*8, tagpr*6 + + print *, 'Testing writing OUT_1 using OPENBF IO = OUT and LUNIN != LUNDX,' + print *, 'and using 2-03-YYY to change reference values' + +#ifdef KIND_8 + call setim8b ( .true. ) +#endif + + ! Get the library version number, and specify the use of big-endian blocking. + call bvers ( libvrsn ) + if ( lgt( libvrsn, '10.1.1' ) ) then + call setblock (1) + endif + + ! Open the BUFR table and output file. + + open ( unit = 11, file = 'out1.bufr', form ='unformatted') + open ( unit = 12, file = 'testfiles/OUT_1_bufrtab' ) + + call openbf ( 11, 'OUT', 12 ) + + ! Write a standard, compressed BUFR message with 3 subsets. Compression will be implemented using WRITCP. + + call stdmsg ('Y') + + ! First subset. + + call openmb ( 11, 'FR004029', 2012031212 ) + + ! Confirm there's exactly one long character string in the subset definition. + if ( lcmgdf ( 11, 'FR004029' ) .ne. 1 ) stop 1 + + ! Get and check the parent of a Table B mnemonic. + call gettagpr ( 11, 'MNTH', 1, tagpr, iertgp ) + if ( ( iertgp .ne. 0 ) .or. ( tagpr .ne. 'YYMMDD' ) ) stop 2 + + ! The output of the following calls will be checked below, after making additional calls to this same + ! subroutine to verify reference values that will be modified with the 2-03 operator. + + call nemspecs ( 11, 'ACRN', 1, nsa, nra, nba, iernsa ) + call nemspecs ( 11, 'MDEVG', 1, nsm, nrm, nbm, iernsm ) + + r8ymd(1,1) = 2012 + r8ymd(2,1) = 3 + r8ymd(3,1) = 12 + call ufbseq ( 11, r8ymd, 3, 1, nlv, 'YYMMDD' ) + r8ltl(1,1) = -35.77 + r8ltl(2,1) = 172.38 + call ufbseq ( 11, r8ltl, 2, 1, nlv, 'LTLONH' ) + + ! The r8flv array tests the 2-03 operator. r8flv(1,2) contains the new reference value, which is + ! applied to the FLVLST values in r8flv(1,3) and r8flv(1,4) when writing the message. + + r8flv(1,1) = 3500 + r8flv(1,2) = -1000 + r8flv(1,3) = 4000 + r8flv(1,4) = 5750 + r8flv(1,5) = 10722 + call ufbrep ( 11, r8flv, 1, 5, nlv, 'FLVLST') + + r8oth(1,1) = 13 + r8oth(2,1) = 45 + r8oth(3,1) = 235.77 + r8oth(4,1) = 1 + r8oth(5,1) = 5.322 + r8oth(6,1) = 1 + r8oth(7,1) = 3 + r8oth(8,1) = 5 + r8oth(9,1) = 35 + r8oth(10,1) = 10.7 + call ufbint ( 11, r8oth, 10, 1, nlv, 'HOUR MINU TMDB DGOT MDEVG ROLQ INTV DPOF WDIR WSPD' ) + + call writcp ( 11 ) + + ! We need to run the following check after the above call to WRITCP, because new reference values + ! aren't stored into a message (nor applied when packing any other values within that message) until + ! WRITCP internally calls WRITSB, which in turn calls WRTREE, which in turn calls IPKS. + do jj = 1, 5 + call nemspecs ( 11, 'FLVLST', jj, nsc(jj), nrf(jj), nbt(jj), ierns(jj) ) + end do + if ( ( iernsa .ne. 0 ) .or. ( iernsm .ne. 0 ) .or. ( nba .ne. 80 ) .or. ( nbm .ne. 17 ) .or. & + ( nsm .ne. 3 ) .or. ( ierns(1) .ne. 0 ) .or. ( nrf(1) .ne. -1024 ) .or. ( ierns(2) .ne. 0 ) .or. & + ( nrf(2) .ne. -1024 ) .or. ( nbt(2) .ne. 12 ) .or. ( ierns(3) .ne. 0 ) .or. ( nrf(3) .ne. -1000 ) & + .or. ( ierns(4) .ne. 0 ) .or. ( nrf(4) .ne. -1000 ) .or. ( ierns(5) .ne. 0 ) .or. & + ( nrf(5) .ne. -1024 ) .or. ( nbt(3) .ne. 16 ) .or. ( nbt(5) .ne. 16 ) ) stop 3 + + ! Write a long character string into the output. + acrn = 'TESTUPS008' + call writlc ( 11, acrn, 'ACRN' ) + + ! Second subset. + + call openmb ( 11, 'FR004029', 2012031212 ) + + call ufbseq ( 11, r8ymd, 3, 1, nlv, 'YYMMDD' ) + + r8ltl(2,1) = 172.42 + call ufbseq ( 11, r8ltl, 2, 1, nlv, 'LTLONH' ) + + r8flv(1,1) = 3600 + r8flv(1,4) = 5760 + r8flv(1,5) = 10730 + call ufbrep ( 11, r8flv, 1, 5, nlv, 'FLVLST') + + r8oth(2,1) = 48 + r8oth(3,1) = 234.69 + r8oth(5,1) = 5.001 + r8oth(8,1) = 3 + r8oth(9,1) = 30 + r8oth(10,1) = 12.2 + call ufbint ( 11, r8oth, 10, 1, nlv, 'HOUR MINU TMDB DGOT MDEVG ROLQ INTV DPOF WDIR WSPD') + + call writcp ( 11 ) + + acrn = 'TESTAAL225' + call writlc ( 11, acrn, 'ACRN' ) + + ! Third subset. + + call openmb ( 11, 'FR004029', 2012031212 ) + + call ufbseq ( 11, r8ymd, 3, 1, nlv, 'YYMMDD' ) + + r8ltl(2,1) = 172.44 + call ufbseq ( 11, r8ltl, 2, 1, nlv, 'LTLONH' ) + + r8flv(1,1) = 3610 + r8flv(1,2) = -1200 + r8flv(1,4) = 5775 + r8flv(1,5) = 10730 + call ufbrep ( 11, r8flv, 1, 5, nlv, 'FLVLST') + + r8oth(2,1) = 51 + r8oth(3,1) = 234.11 + r8oth(5,1) = 5.012 + r8oth(8,1) = 6 + r8oth(10,1) = 12.1 + call ufbint ( 11, r8oth, 10, 1, nlv, 'HOUR MINU TMDB DGOT MDEVG ROLQ INTV DPOF WDIR WSPD') + + call writcp ( 11 ) + + acrn = 'TESTSWA193' + call writlc ( 11, acrn, 'ACRN' ) + + ! Close the output file. + call closbf ( 11 ) + +end program outtest1 diff --git a/test/outtest2.F90 b/test/outtest2.F90 new file mode 100644 index 00000000..66a83b97 --- /dev/null +++ b/test/outtest2.F90 @@ -0,0 +1,110 @@ +! This is a test for NCEPLIBS-bufr. +! +! Writes test file 'testfiles/OUT_2' using using OPENBF IO = 'APX' and embedded tables +! +! J. Ator, 2/16/2023 +program outtest2 + implicit none + + integer*4 igetsc + + integer nsc, nrf, nbt, ierns, nlv + + real*8 r8ymd(3,1), r8ltl(2,1), r8oth(10,1) + real*8 rpid, pkftbv, xmiss, getbmiss + + character libvrsn*8, cpid*8 + + equivalence (rpid,cpid) + + print *, 'Testing writing OUT_2 using OPENBF IO = APX and embedded tables' + +#ifdef KIND_8 + call setim8b ( .true. ) +#endif + + ! Get the library version number. + call bvers ( libvrsn ) + if ( lgt( libvrsn, '10.1.1' ) ) then + ! Specify the use of big-endian blocking. + call setblock (1) + ! Modify the "missing" value. + xmiss = 9999. + call setbmiss (xmiss) + endif + + ! Open the input and output files. + open ( unit = 10, file = 'testfiles/OUT_2_preAPX' ) + open ( unit = 11, file = 'out2.bufr', form ='unformatted') + + ! Copy the input file to the output file. + call copybf ( 10, 11 ) + + ! Now, open the BUFR tables file and re-open the output file for appending. The re-open of the output + ! file is needed because the previous call to copybf will have already closed it. + open ( unit = 12, file = 'testfiles/OUT_2_bufrtab' ) + open ( unit = 11, file = 'out2.bufr', form ='unformatted') + + call openbf ( 11, 'APX', 12 ) + + ! Check for any abnormal internal return codes so far. + if ( igetsc ( 11 ) .ne. 0 ) stop 1 + + ! Specify an originating center number to use in Section 1 of the output message, and then prepare to + ! to write 2 subsets into the message using BUFR edition 4. + call pkvs01 ( 'OGCE', 160 ) + call pkvs01 ( 'BEN', 4 ) + + ! First subset. + + call openmb ( 11, 'NC031112', 2012101712 ) + + ! Check some mnemonic specifications. + call nemspecs ( 11, 'TMBRST', 1, nsc, nrf, nbt, ierns ) + if ( ( ierns .ne. 0 ) .or. ( nsc .ne. 3 ) .or. ( nbt .ne. 19 ) ) stop 2 + + r8ymd(1,1) = 2012 + r8ymd(2,1) = 10 + r8ymd(3,1) = 17 + call ufbint ( 11, r8ymd, 3, 1, nlv, 'YEAR MNTH DAYS' ) + r8ltl(1,1) = -22.67 + r8ltl(2,1) = 72.02 + call ufbint ( 11, r8ltl, 2, 1, nlv, 'CLATH CLONH' ) + + r8oth(1,1) = 13 + r8oth(2,1) = 45 + r8oth(3,1) = 216.744 + r8oth(4,1) = 85 + r8oth(5,1) = 110 + r8oth(6,1) = 17 + r8oth(7,1) = pkftbv(12,3) + pkftbv(12,9) + r8oth(8,1) = -0.661527 + call ufbint ( 11, r8oth, 10, 1, nlv, 'HOUR MINU TMBRST SAID SACYLN ORBN OBQL SLHD1') + + call writsb ( 11 ) + + ! Second subset. + + call openmb ( 11, 'NC031112', 2012101712 ) + + call ufbint ( 11, r8ymd, 3, 1, nlv, 'YEAR MNTH DAYS' ) + r8ltl(2,1) = 72.13 + call ufbint ( 11, r8ltl, 2, 1, nlv, 'CLATH CLONH' ) + + r8oth(2,1) = 48 + r8oth(3,1) = 214.003 + r8oth(8,1) = 0.002582 + call ufbint ( 11, r8oth, 10, 1, nlv, 'HOUR MINU TMBRST SAID SACYLN ORBN OBQL SLHD1') + + cpid = 'SUBSET#2' + call ufbint ( 11, rpid, 1, 1, nlv, 'RPID' ) + + ! Confirm the "missing" value is still the same value that was set previously via the call to setxmiss. + IF ( nint(xmiss) .ne. nint(getbmiss()) ) stop 3 + + call writsb ( 11 ) + + ! Close the output file. + call closbf ( 11 ) + +end program outtest2 diff --git a/test/outtest3.F90 b/test/outtest3.F90 new file mode 100644 index 00000000..28d96788 --- /dev/null +++ b/test/outtest3.F90 @@ -0,0 +1,166 @@ +! This is a test for NCEPLIBS-bufr. +! +! Writes test file 'testfiles/OUT_3' using ISETPRM and IGETPRM, using EXITBUFR with multiple allocations, +! and using 2-22, 2-36 and 2-37 operators. +! +! J. Ator, 2/17/2023 +program outtest3 + implicit none + + integer*4 isetprm, igetprm + + integer ii, nlv + + real*8 r8vals ( 11, 4 ), r8bitmap ( 26 ) + + print *, 'Testing writing OUT_3 using ISETPRM and IGETPRM, using EXITBUFR with multiple allocations,' + print *, 'and using 2-22, 2-36 and 2-37 operators.' + +#ifdef KIND_8 + call setim8b ( .true. ) +#endif + + ! First message. + + ! Set some custom array sizes. + if ( ( isetprm ( 'NFILES', 2 ) .ne. 0 ) .or. ( isetprm ( 'MXMSGL', 8000 ) .ne. 0 ) ) stop 1 + + ! Set some custom Section 1 values. + call pkvs01 ( 'MTV', 18 ) + call pkvs01 ( 'USN', 2 ) + + ! Open the BUFR table and output file. + open ( unit = 11, file = 'out3.bufr', form ='unformatted') + open ( unit = 12, file = 'testfiles/OUT_3_bufrtab' ) + call openbf ( 11, 'OUT', 12 ) + + ! Confirm the values from the previous isetprm settings. + if ( ( igetprm ( 'NFILES' ) .ne. 2 ) .or. ( igetprm ( 'MXMSGL' ) .ne. 8000 ) ) stop 2 + + ! Write a standard message. + call stdmsg ('Y') + + ! Store the data values. + + call openmb ( 11, 'FN005000', 2015030212 ) + + r8vals(1,1) = 2015 + r8vals(2,1) = 3 + r8vals(3,1) = 2 + r8vals(4,1) = 12 + r8vals(5,1) = 57 + r8vals(6,1) = -12.538 + r8vals(7,1) = 157.66 + r8vals(8,1) = 20170. + r8vals(9,1) = 37. + r8vals(10,1) = 2.1 + r8vals(11,1) = 244.5 + call ufbint ( 11, r8vals, 11, 1, nlv, 'YEAR MNTH DAYS HOUR MINU CLATH CLONH PRLC WDIR WSPD CCST' ) + + do ii = 1, 26 + r8bitmap(ii) = 0. + end do + r8bitmap(16) = 1. + r8bitmap(17) = 1. + r8bitmap(18) = 1. + r8bitmap(21) = 1. + call ufbrep ( 11, r8bitmap, 1, 26, nlv, 'DPRI' ) + + r8vals(1,1) = 7. + r8vals(2,1) = 51. + r8vals(1,2) = 254. + r8vals(2,2) = 1. + r8vals(1,3) = 254. + r8vals(2,3) = 3. + call ufbrep ( 11, r8vals, 11, 3, nlv, 'GCLONG GNAP' ) + + r8vals(1,1) = 97. + r8vals(1,2) = 96. + r8vals(1,3) = 93. + r8vals(1,4) = 93. + call ufbrep ( 11, r8vals, 11, 4, nlv, 'PCCF' ) + + r8vals(1,1) = 77. + r8vals(1,2) = 84. + r8vals(1,3) = 83. + r8vals(1,4) = 61. + call ufbrep ( 11, r8vals, 11, 4, nlv, 'NCTH' ) + + call writsb ( 11 ) + + ! Reset the library in order to be able to reallocate arrays. + call exitbufr + + ! Second message. + + ! Set some new custom array sizes. + if ( ( isetprm ( 'NFILES', 5 ) .ne. 0 ) .or. ( isetprm ( 'MXMSGL', 12000 ) .ne. 0 ) ) stop 3 + + ! Set some new custom Section 1 values. + call pkvs01 ( 'BEN', 4 ) + call pkvs01 ( 'MSBTI', 40 ) + call pkvs01 ( 'MTV', 17 ) + + ! Open the BUFR table, and re-open the output file for append. + open ( unit = 11, file = 'out3.bufr', form ='unformatted') + open ( unit = 12, file = 'testfiles/OUT_3_bufrtab' ) + call openbf ( 11, 'APX', 12 ) + + ! Confirm the values from the previous isetprm settings. + if ( ( igetprm ( 'NFILES' ) .ne. 5 ) .or. ( igetprm ( 'MXMSGL' ) .ne. 12000 ) ) stop 4 + + ! Write a standard message. + call stdmsg ('Y') + + ! Store the data values. + + call openmb ( 11, 'FN005010', 2015030215 ) + + r8vals(1,1) = 2015 + r8vals(2,1) = 3 + r8vals(3,1) = 2 + r8vals(4,1) = 15 + r8vals(5,1) = 44 + r8vals(6,1) = -12.538 + r8vals(7,1) = 157.66 + r8vals(8,1) = 19930. + r8vals(9,1) = 305. + r8vals(10,1) = 12.5 + r8vals(11,1) = 233.0 + call ufbint ( 11, r8vals, 11, 1, nlv, 'YEAR MNTH DAYS HOUR MINU CLATH CLONH PRLC WDIR WSPD CCST' ) + + do ii = 1, 26 + r8bitmap(ii) = 0. + end do + r8bitmap(16) = 1. + r8bitmap(17) = 1. + r8bitmap(18) = 1. + r8bitmap(26) = 1. + call ufbrep ( 11, r8bitmap, 1, 26, nlv, 'DPRI' ) + + r8vals(1,1) = 7. + r8vals(2,1) = 51. + r8vals(1,2) = 254. + r8vals(2,2) = 1. + r8vals(1,3) = 254. + r8vals(2,3) = 3. + call ufbrep ( 11, r8vals, 11, 3, nlv, 'GCLONG GNAP' ) + + r8vals(1,1) = 92. + r8vals(1,2) = 91. + r8vals(1,3) = 91. + r8vals(1,4) = 98. + call ufbrep ( 11, r8vals, 11, 4, nlv, 'PCCF' ) + + r8vals(1,1) = 3. + r8vals(1,2) = 4. + r8vals(1,3) = 4. + r8vals(1,4) = 3. + call ufbrep ( 11, r8vals, 11, 4, nlv, 'MAQC' ) + + call writsb ( 11 ) + + ! Close the output file. + call closbf ( 11 ) + +end program outtest3 diff --git a/test/outtest4.F90 b/test/outtest4.F90 new file mode 100644 index 00000000..4c6fcef8 --- /dev/null +++ b/test/outtest4.F90 @@ -0,0 +1,137 @@ +! This is a test for NCEPLIBS-bufr. +! +! Writes test file 'testfiles/OUT_4' using OPENBF IO = 'NODX' and IO = 'QUIET', and using STRCPT, WRDXTB and WRITSA +! +! J. Ator, 2/17/2023 +program outtest4 + implicit none + + integer*4 isetprm, ireadsb, igetmxby, icbfms + + integer mxval1, mxval2, mxlvl, mxbfmg + parameter ( mxval1 = 200 ) + parameter ( mxval2 = 12 ) + parameter ( mxlvl = 4490 ) + parameter ( mxbfmg = 50000 ) + + integer mgbf ( mxbfmg ), lmgbf, ibfdt, imgdt, iermg, iersb, nsub, nlv, nlv2 + + real*8 r8arr1 ( mxval1 ), r8arr2 ( mxval2, mxlvl ) + + character cmgtag*8, smid*9, dummystr*9 + + print *, 'Testing writing OUT_4 using OPENBF IO = NODX and IO = QUIET, and using STRCPT, WRDXTB and WRITSA' + +#ifdef KIND_8 + call setim8b ( .true. ) +#endif + + ! Set some custom array sizes. + IF ( ( isetprm ( 'NFILES', 4 ) .ne. 0 ) .or. ( isetprm ( 'MXMSGL', 400000 ) .ne. 0 ) .or. & + ( isetprm ( 'MAXSS', 250000 ) .ne. 0 ) .or. ( isetprm ( 'MAXMEM', 100000 ) .ne. 0 ) .or. & + ( isetprm ( 'MAXMSG', 100 ) .ne. 0 ) .or. ( isetprm ( 'MXDXTS', 5 ) .ne. 0 ) .or. & + ( isetprm ( 'MXCDV', 100 ) .ne. 0 ) .or. ( isetprm ( 'MXCSB', 100 ) .ne. 0 ) .or. & + ( isetprm ( 'MXLCC', 8 ) .ne. 0 ) ) stop 1 + + ! Open the BUFR input and output files. + + open ( unit = 11, file = 'testfiles/OUT_4_infile1' ) + open ( unit = 12, file = 'testfiles/OUT_4_infile2' ) + open ( unit = 13, file = 'out4.bufr', form ='unformatted' ) + + call openbf ( 11, 'IN', 11 ) + call openbf ( 12, 'SEC3', 12 ) + call openbf ( 13, 'NODX', 11 ) + call openbf ( 13, 'QUIET', -1 ) + + ! Set the location of the master BUFR tables. + call mtinfo ( '../tables', 90, 91 ) + + ! Set a custom maximum size for output BUFR messages. + call maxout ( mxbfmg*4 ) + + ! Confirm the value from the previous maxout setting. + if ( igetmxby ( ) .ne. mxbfmg*4 ) stop 2 + + ! The following call to STDMSG will ensure that subroutine STNDRD is called internally during the + ! subsequent calls to WRITSB and CLOSMG. + call stdmsg ('Y') + + ! Append a (tank) receipt time to Section 1 of each output message + call strcpt ( 'Y', 2020, 11, 4, 15, 29 ) + + ! Process 1 message with 1 data subset from infile1. + + call readmg ( 11, cmgtag, imgdt, iermg ) + if ( iermg .ne. 0 ) stop 3 + + call readsb ( 11, iersb ) + if ( iersb .ne. 0 ) stop 4 + + call openmb ( 13, 'NC007000', 2020022514 ) + + ! Copy values from the input message to the output message. + call ufbseq ( 11, r8arr1, mxval1, 1, nlv, 'NC007000' ) + call ufbseq ( 13, r8arr1, mxval1, 1, nlv, 'NC007000' ) + + call writsb ( 13 ) + + ! Close and write out the output message. + call closmg ( 13 ) + + ! Process 1 message with multiple data subsets from infile2. + + call readmg ( 12, cmgtag, imgdt, iermg ) + if ( iermg .ne. 0 ) stop 5 + + ! Turn off output message standardization. + call stdmsg ('N') + + ! Write DX table information for this message into the output file. + call wrdxtb ( 12, 13 ) + + ! Copy values from the input message to the output message for all data subsets. + + nsub = 0 + + do while ( ireadsb ( 12 ) .eq. 0 ) + + nsub = nsub + 1 + + call ufbseq ( 12, r8arr1, mxval1, 1, nlv, 'DATETMLN' ) + ibfdt = ( nint(r8arr1(2)) * 1000000 ) + ( nint(r8arr1(3)) * 10000 ) + ( nint(r8arr1(4)) * 100 ) & + + nint(r8arr1(5)) + call openmb ( 13, 'MSTTB001', ibfdt ) + call ufbseq ( 13, r8arr1, mxval1, 1, nlv, 'DATETMLN' ) + + write ( unit = smid, fmt = '(A,I1.1)' ) 'STATION#', nsub + if ( nsub .eq. 1 ) then + call readlc ( 12, dummystr, 'DUMMYSTR' ) + if ( icbfms( dummystr, 9 ) .eq. 0 ) smid = dummystr + end if + + call ufbseq ( 12, r8arr1, mxval1, 1, nlv, 'IDLSIPTM' ) + call ufbseq ( 13, r8arr1, mxval1, 1, nlv, 'IDLSIPTM' ) + call ufbseq ( 12, r8arr1, mxval1, 1, nlv, 'HAVCOLS' ) + call ufbseq ( 13, r8arr1, mxval1, 1, nlv, 'HAVCOLS' ) + call ufbseq ( 12, r8arr1, mxval1, 1, nlv, 'CLINRVSD' ) + call ufbseq ( 13, r8arr1, mxval1, 1, nlv, 'CLINRVSD' ) + call ufbseq ( 12, r8arr2, mxval2, mxlvl, nlv2, 'TDWPRAOB' ) + + call drfini ( 13, nlv2, 1, '(TDWPRAOB)' ) + call ufbseq ( 13, r8arr2, mxval2, nlv2, nlv, 'TDWPRAOB' ) + + call hold4wlc ( 13, smid, 'SMID' ) + call writsa ( 13, mxbfmg, mgbf, lmgbf ) + if ( nsub .eq. 1 ) then + call writlc ( 13, dummystr, 'DUMMYSTR' ) + end if + + end do + + call writsa ( -13, mxbfmg, mgbf, lmgbf ) + + ! Close the output file. + call closbf ( 13 ) + +end program outtest4 diff --git a/test/outtest5.F90 b/test/outtest5.F90 new file mode 100644 index 00000000..f36c5e3f --- /dev/null +++ b/test/outtest5.F90 @@ -0,0 +1,71 @@ +! This is a test for NCEPLIBS-bufr. +! +! Writes test file 'testfiles/OUT_5' using DUMPBF, GETABDB, UFDUMP, UFBDMP, and DXDUMP +! +! J. Ator, 2/17/2023 +program outtest5 + implicit none + + integer*4 ireadns + + integer jdate(5), jdump(5), ii, jtab, nsub, imgdt + + character cmgtag*8, tabdb(1000)*128 + + print *, 'Testing writing OUT_5 using DUMPBF, GETABDB, UFDUMP, UFBDMP, and DXDUMP' + +#ifdef KIND_8 + call setim8b ( .true. ) +#endif + + ! Open the output log (ASCII) file. + open ( unit = 13, file = 'out5.bufr' ) + + ! Make a "FIRST" call to subroutine OPENBF to dynamically allocate internal arrays. Otherwise, the below call to + ! subroutine DUMPBF will fail when trying to call subroutine STATUS, because subroutine OPENBF won't yet have been + ! called. + call openbf ( 13, 'FIRST', 13 ) + + ! Open the input (BUFR) file. Note that since we're about to call subroutine DUMPBF for this file, then we don't + ! need to first call subroutine OPENBF for this file, because subroutine DUMPBF will do that internally. + open ( unit = 11, file = 'testfiles/OUT_5_infile' ) + + ! Specify format of Section 1 date/time when reading. + call datelen ( 10 ) + + write ( 13, fmt = '(///,A)' ) '------------ DUMPBF ------------' + call dumpbf ( 11, jdate, jdump ) + write ( 13, fmt = '(A,5I5)' ) 'jdate =', (jdate(ii), ii=1,5) + write ( 13, fmt = '(A,5I5)' ) 'jdump =', (jdump(ii), ii=1,5) + + ! Subroutine DUMPBF will have just closed the input (BUFR) file with an internal call to subroutine CLOSBF (which + ! also does an internal Fortran CLOSE on the logical unit number), so we now need to reopen the file with a new + ! call to subroutine OPENBF. + open ( unit = 11, file = 'testfiles/OUT_5_infile' ) + call openbf ( 11, 'IN', 11 ) + + write ( 13, fmt = '(///,A)' ) '------------ GETABDB -----------' + call getabdb ( 11, tabdb, 1000, jtab ) + do ii = 1, jtab + write ( 13, fmt = '(A,I4,2A)' ) 'tabdb entry #', ii, ":", tabdb(ii) + end do + + ! Write out the internal DX BUFR table. + write ( 13, fmt = '(///,A,/)' ) '----------- DXDUMP -----------' + call dxdump ( 11, 13 ) + + ! Write out each data subset using both UFDUMP and UFBDMP. + nsub = 0 + do while ( ireadns ( 11, cmgtag, imgdt ) .eq. 0 ) + nsub = nsub + 1 + write ( 13, fmt = '(///,A,I1,A)' ) '------------------------------ SUBSET #', nsub, '------------------------------' + write ( 13, fmt = '(//,A)' ) '------------ UFDUMP ------------' + call ufdump ( 11, 13 ) + write ( 13, fmt = '(//,A)' ) '------------ UFBDMP ------------' + call ufbdmp ( 11, 13 ) + end do + + ! Close the output log (ASCII) file. + close ( 13 ) + +end program outtest5 diff --git a/test/outtest6.F90 b/test/outtest6.F90 new file mode 100644 index 00000000..86a8ab67 --- /dev/null +++ b/test/outtest6.F90 @@ -0,0 +1,109 @@ +! This is a test for NCEPLIBS-bufr. +! +! Writes test file 'testfiles/OUT_6' using OPENMG and UFBSTP, and storing integer values larger than 32 bits. +! +! J. Ator, 2/17/2023 +program outtest6 + implicit none + + real*8 r8f5fc(8,5), r8dbss(4,3), r8wind(2,1), r8val + + integer nlv, iersvb + + character ptidc*16 + + print *, 'Testing writing OUT_6 using OPENMG and UFBSTP, and storing integer values larger than 32 bits' + +#ifdef KIND_8 + call setim8b ( .true. ) +#endif + + ! Open the BUFR table and output file. + open ( unit = 11, file = 'out6.bufr', form ='unformatted') + open ( unit = 12, file = 'testfiles/OUT_6_bufrtab' ) + call openbf ( 11, 'OUT', 12 ) + + ! Open a new message for output. + call openmg ( 11, 'F5FCMESG', 2021022312 ) + + ! Set a custom minutes value in Section 1 of the message. + call minimg ( 11, 55 ) + + ! Store the subset data. + + r8wind ( 1, 1 ) = 290. + r8wind ( 2, 1 ) = 6.5 + call ufbint ( 11, r8wind, 2, 1, nlv, 'WDIR WSPD' ) + + r8val = 17. + call setvalnb ( 11, 'WDIR', 1, 'HOUR', 1, r8val, iersvb ) + r8val = 16. + call setvalnb ( 11, 'TMDB', 1, 'HOUR', -1, r8val, iersvb ) + + r8dbss ( 1, 1 ) = 1.0 + r8dbss ( 2, 1 ) = 34.1 + r8dbss ( 3, 1 ) = 284.7 + r8dbss ( 4, 1 ) = 5.0653 + r8dbss ( 1, 2 ) = 2.5 + r8dbss ( 2, 2 ) = 34.1 + r8dbss ( 3, 2 ) = 284.8 + r8dbss ( 4, 2 ) = 5.066 + r8dbss ( 1, 3 ) = 4.0 + r8dbss ( 2, 3 ) = 34.2 + r8dbss ( 3, 3 ) = 284.6 + r8dbss ( 4, 3 ) = 5.0644 + call ufbstp ( 11, r8dbss, 4, 3, nlv, 'DBSS SALN SST1 WCON' ) + + r8f5fc ( 1, 1 ) = 0.08593800 + r8f5fc ( 2, 1 ) = 0.00390625 + r8f5fc ( 3, 1 ) = 32.50110000_8 + r8f5fc ( 4, 1 ) = 0.8883 + r8f5fc ( 5, 1 ) = -0.3818 + r8f5fc ( 6, 1 ) = 0.6140 + r8f5fc ( 7, 1 ) = -0.6438 + r8f5fc ( 8, 1 ) = 3.11 + r8f5fc ( 1, 2 ) = 0.08984400 + r8f5fc ( 2, 2 ) = 0.00390625 + r8f5fc ( 3, 2 ) = 26.45480000_8 + r8f5fc ( 4, 2 ) = 0.8795 + r8f5fc ( 5, 2 ) = -0.4412 + r8f5fc ( 6, 2 ) = 0.5909 + r8f5fc ( 7, 2 ) = -0.7761 + r8f5fc ( 8, 2 ) = 3.12 + r8f5fc ( 1, 3 ) = 0.09375000 + r8f5fc ( 2, 3 ) = 0.00390625 + r8f5fc ( 3, 3 ) = 41.96410000_8 + r8f5fc ( 4, 3 ) = 0.9124 + r8f5fc ( 5, 3 ) = -0.3137 + r8f5fc ( 6, 3 ) = 0.7302 + r8f5fc ( 7, 3 ) = -0.5316 + r8f5fc ( 8, 3 ) = 3.13 + r8f5fc ( 1, 4 ) = 0.09765600 + r8f5fc ( 2, 4 ) = 0.00390625 + r8f5fc ( 3, 4 ) = 28.98830000_8 + r8f5fc ( 4, 4 ) = 0.8917 + r8f5fc ( 5, 4 ) = -0.3020 + r8f5fc ( 6, 4 ) = 0.7413 + r8f5fc ( 7, 4 ) = -0.4804 + r8f5fc ( 8, 4 ) = 3.14 + r8f5fc ( 1, 5 ) = 0.10156300 + r8f5fc ( 2, 5 ) = 0.00390628 + r8f5fc ( 3, 5 ) = 11.71090000_8 + r8f5fc ( 4, 5 ) = 0.8273 + r8f5fc ( 5, 5 ) = -0.2884 + r8f5fc ( 6, 5 ) = 0.4968 + r8f5fc ( 7, 5 ) = -0.4184 + r8f5fc ( 8, 5 ) = 3.15 + call drfini ( 11, 5, 1, '{F5FCRSEQ}' ) + call ufbseq ( 11, r8f5fc, 8, 5, nlv, 'F5FCRSEQ' ) + + call writsb ( 11 ) + + ! Write a long character string to the message. + ptidc = '300534061608630' + call writlc ( 11, ptidc, 'PTIDC' ) + + ! Close the output file. + call closbf ( 11 ) + +end program outtest6 diff --git a/test/outtest7.F90 b/test/outtest7.F90 new file mode 100644 index 00000000..7b58b1dc --- /dev/null +++ b/test/outtest7.F90 @@ -0,0 +1,96 @@ +! This is a test for NCEPLIBS-bufr. +! +! Writes test file 'testfiles/OUT_7' using UFBMEX, UFBRMS, UFBMMS, CPYMEM, ICOPYSB, FORTRAN_OPEN and FORTRAN_CLOSE, +! and reading integer values larger than 32 bits. +! +! J. Ator, 2/17/2023 +program outtest7 + implicit none + + integer*4 ireadmg, icopysb + + integer imesg(10), isub(3), iostat1, iostat2, icnt1, icnt2, idate, ier, ii, istart, nlv + + character cmgtag*8 + + real*8 r8vals(2,5) + + print *, 'Testing writing OUT_7 using UFBMEX, UFBRMS, UFBMMS, CPYMEM, ICOPYSB, FORTRAN_OPEN and FORTRAN_CLOSE, ' + print *, 'and reading integer values larger than 32 bits' + +#ifdef KIND_8 + call setim8b ( .true. ) +#endif + + ! Open the input files. + call fortran_open ( 'testfiles/OUT_7_infile1', 21, 'unformatted', 'rewind', iostat1 ) + call fortran_open ( 'testfiles/OUT_7_infile2', 22, 'unformatted', 'rewind', iostat2 ) + if ( ( iostat1 .ne. 0 ) .or. ( iostat2 .ne. 0 ) ) stop 1 + + ! Open the output file. + open ( unit = 23, file = 'testfiles/OUT_7_bufrtab') + open ( unit = 50, file = 'out7.bufr', form = 'unformatted') + call openbf ( 50, 'OUT', 23 ) + + ! Read the input files into internal memory arrays. + call ufbmex ( 21, 23, 0, icnt1, imesg ) + call ufbmex ( 22, 23, 1, icnt2, imesg ) + if ( ( icnt1 .ne. 1 ) .or. ( icnt2 .ne. 3 ) .or. & + ( imesg(1) .ne. 5 ) .or. ( imesg(2) .ne. 8 ) .or. ( imesg(3) .ne. 2 ) .or. ( imesg(4) .ne. 0 ) ) stop 2 + + ! Check some specified values within the 1st subset of the 4th message. + call ufbrms ( 4, 1, r8vals, 2, 5, nlv, 'SWDE A2CFDFS' ) + if ( ( nlv .ne. 5 ) .or. & + ( nint(r8vals(1,1)*10000000) .ne. 325011000 ) .or. ( nint(r8vals(1,2)*10000000) .ne. 264548000 ) .or. & + ( nint(r8vals(1,3)*10000000) .ne. 419641000 ) .or. ( nint(r8vals(1,4)*10000000) .ne. 289883000 ) .or. & + ( nint(r8vals(1,5)*10000000) .ne. 117109000 ) .or. ( nint(r8vals(2,1)*10000) .ne. 6140 ) .or. & + ( nint(r8vals(2,2)*10000) .ne. 5909 ) .or. ( nint(r8vals(2,3)*10000) .ne. 7302 ) .or. & + ( nint(r8vals(2,4)*10000) .ne. 7413 ) .or. ( nint(r8vals(2,5)*10000) .ne. 4968 ) ) stop 3 + + ! Check some specified values within the 633rd subset of the 2nd message. + call ufbmms ( 2, 633, cmgtag, idate ) + call ufbint ( 21, r8vals, 2, 5, nlv, 'CLATH CLONH' ) + if ( ( cmgtag .ne. 'NC008032' ) .or. ( idate .ne. 22053116 ) .or. ( nlv .ne. 1 ) .or. & + ( nint(r8vals(1,1)*100000) .ne. 4081139 ) .or. ( nint(r8vals(2,1)*100000) .ne. -7787666 ) ) stop 4 + + ! Copy the 3rd message to the output file. + call rdmemm ( 3, cmgtag, idate, ier ) + if ( ( ier .ne. 0 ) .or. ( cmgtag .ne. 'NC002104' ) ) stop 5 + call cpymem ( 50 ) + + ! Stop using the internal memory arrays, and instead now re-open the 1st input file as a regular file and + ! read the 1st message. + call closbf ( 21 ) + call fortran_open ( 'testfiles/OUT_7_infile1', 21, 'unformatted', 'rewind', iostat1 ) + call openbf ( 21, 'IN', 23 ) + if ( ireadmg ( 21, cmgtag, idate ) .ne. 0 ) stop 6 + + ! Open a new output message, then copy subsets #115, 288, and 530 from the 1st message to that output message. + + call openmg ( 50, 'NC005067', 22060102 ) + + isub(1) = 115 + isub(2) = 288 + isub(3) = 530 + + istart = 1 + do ii = 1, 3 + do while ( istart < isub(ii) ) + ! calling copysb (or icopysb) with the 2nd argument negative prevents writing to that output file, but + ! the read pointer in the input (1st argument) file is still advanced to the next subset + call copysb ( 21, -50, ier ) + istart = istart + 1 + end do + if ( ( icopysb ( 21, 50 ) ) .ne. 0 ) stop 7 + istart = istart + 1 + end do + + ! Close the input and output files. + call fortran_close ( 21, iostat1 ) + call fortran_close ( 22, iostat2 ) + if ( ( iostat1 .ne. 0 ) .or. ( iostat2 .ne. 0 ) ) stop 8 + + ! Close the output file. + call closbf ( 50 ) + +end program outtest7 diff --git a/test/outtest8.F90 b/test/outtest8.F90 new file mode 100644 index 00000000..289a0cc3 --- /dev/null +++ b/test/outtest8.F90 @@ -0,0 +1,74 @@ +! This is a test for NCEPLIBS-bufr. +! +! Writes test file 'testfiles/OUT_8 using UFBCPY and CWBMG. +! +! J. Ator, 2/24/2023 +program outtest8 + implicit none + + integer, parameter :: mxbf = 28000 + integer, parameter :: mxbfd4 = mxbf/4 + + integer ibfmg(mxbfd4), imgdt, mtyp, lenbmg + + integer*4 ireadns + integer*4 nbyt, ierw + + character bfmg(mxbf) + + character*20 filnam / 'out8.bufr' / + + character filost / 'w' / + + equivalence (bfmg(1), ibfmg(1)) + + character cmgtag*8 + + print *, 'Testing writing OUT_8 using UFBCPY and CWBMG' + +#ifdef KIND_8 + call setim8b ( .true. ) +#endif + + open ( unit = 11, file = 'testfiles/OUT_8_infile', form = 'unformatted') + + ! Verify the type of the first (and only) message in the input file. + call mesgbf ( 11, mtyp ) + if ( mtyp /= 1 ) stop 1 + + ! For this test we need to have an assigned logical unit for use with ufbcpy; however, we're not going to + ! actually write anything to that file, because instead we'll be using writsa and cwbmg to write to our + ! output file. So /dev/null is a good choice for this logical unit. + open ( unit = 12, file = '/dev/null' ) + + call openbf ( 11, 'IN', 11 ) + call openbf ( 12, 'NUL', 11 ) + + call maxout ( 25000 ) + + ! Copy all of the data subsets into an output message. + do while ( ireadns ( 11, cmgtag, imgdt ) .eq. 0 ) + call openmb ( 12, cmgtag, imgdt ) + call ufbcpy ( 11, 12 ) + call writsa ( 12, mxbfd4, ibfmg, lenbmg ) + end do + + ! Get the completed output message. + call writsa ( -12, mxbfd4, ibfmg, lenbmg ) + if ( lenbmg .eq. 0 ) stop 2 + + ! Open the output file. + call cobfl ( filnam, filost ) + + ! Write the output message to the output file. +#ifdef KIND_8 + nbyt = lenbmg * 8 +#else + nbyt = lenbmg * 4 +#endif + call cwbmg ( bfmg, nbyt, ierw ) + + ! Close the output file. + call ccbfl() + +end program outtest8 diff --git a/test/outtest9.F90 b/test/outtest9.F90 new file mode 100644 index 00000000..c6f0de01 --- /dev/null +++ b/test/outtest9.F90 @@ -0,0 +1,144 @@ +! This is a test for NCEPLIBS-bufr. +! +! Writes test file 'testfiles/OUT_9 using INVMRG, MRGINV, and UFBOVR. +! +! J. Ator, 3/1/2023 + +module Share_errstr + ! This module is needed in order to share information between the test program and subroutine errwrt, because + ! the latter is not called by the former but rather is called directly from within the BUFRLIB software. + + character*1500 errstr + + integer errstr_len +end module Share_errstr + +subroutine errwrt(str) + ! This subroutine supersedes the subroutine of the same name within the BUFRLIB software, so that we can + ! easily test the generation of error messages from within the library. + + use Share_errstr + + character*(*) str + + integer str_len + + str_len = len(str) + errstr ( errstr_len + 1 : errstr_len + str_len + 1 ) = str + errstr_len = errstr_len + str_len + + return +end subroutine errwrt + +program outtest9 + + use Share_errstr + + implicit none + + integer ii, jj, imgdt, ier + + integer*4 nmsub, icopysb + + real*8 r8arr1(4,1), r8arr2(4,2) + + character*8 cmgtag + + print *, 'Testing writing OUT_9 using INVMRG, MRGINV, and UFBOVR' + +#ifdef KIND_8 + call setim8b ( .true. ) +#endif + + open ( unit = 11, file = 'testfiles/OUT_9_infile1', form = 'unformatted' ) + open ( unit = 12, file = 'testfiles/OUT_9_infile2', form = 'unformatted' ) + open ( unit = 21, file = 'out9.bufr',form = 'unformatted' ) + + call openbf ( 11, 'IN', 11 ) + call openbf ( 12, 'IN', 11 ) + call openbf ( 21, 'OUT', 11 ) + + ! Use BUFR compression when writing to the output file. + call cmpmsg ('Y') + + ! Read the first BUFR message from each of the input files. + call readmg ( 11, cmgtag, imgdt, ier ) + if ( ier .ne. 0 ) stop 1 + call readmg ( 12, cmgtag, imgdt, ier ) + if ( ier .ne. 0 ) stop 2 + + ! Open a new BUFR message for output. + call openmb ( 21, cmgtag, imgdt ) + + ! Copy each data subset from the first message of infile1 to the output message, while merging in some additional data values + ! from each corresponding subset in the first message of infile2. + do ii = 1, 3 + + ! Read in the next corresponding subset from each file. + call readsb (11, ier) + if ( ier .ne. 0 ) stop 3 + call readsb (12, ier) + if ( ier .ne. 0 ) stop 4 + + ! Copy the first subset to the output message. + call invmrg (11, 21) + + ! Merge REHU from the second subset into the output message. + call ufbint (12, r8arr1, 4, 1, ier, 'REHU' ) + if ( ier .ne. 1 ) stop 5 + call ufbint (21, r8arr1, 4, 1, ier, 'REHU' ) + if ( ier .ne. 1 ) stop 6 + + ! Merge the PWEATHER data from the second subset into the output message. + call ufbint (11, r8arr2, 4, 2, ier, 'PRWE TPHR PSW1 PSW2' ) + if ( ier .ne. 1 ) stop 7 + call ufbint (12, r8arr1, 4, 1, ier, 'PRWE TPHR PSW1 PSW2' ) + if ( ier .ne. 1 ) stop 8 + do jj = 1, 4 + r8arr2(jj,2) = r8arr1(jj,1) + end do + call ufbovr (21, r8arr2, 4, 2, ier, 'PRWE TPHR PSW1 PSW2' ) + if ( ier .ne. 2 ) stop 9 + + ! Write the subset into the output message. + call writsb (21) + end do + + ! Close the first output message and write it to the output file. + call closmg (21) + + ! Check the invmrg output. + call mrginv + if ( ( index( errstr(1:errstr_len), 'NUMBER OF DRB EXPANSIONS = 3' ) .eq. 0 ) .or. & + ( index( errstr(1:errstr_len), 'NUMBER OF MERGES = 42' ) .eq. 0 ) ) stop 10 + + ! Read the second data message from infile1, which includes a new preceding DX BUFR table. + call readmg ( 11, cmgtag, imgdt, ier ) + if ( ier .ne. 0 ) stop 11 + + ! Copy the new DX BUFR table to the output file. + call wrdxtb (11, 21) + + ! Copy the data message to the output file. + call copymg (11, 21) + + ! Read the third data message from infile1. + call readmg ( 11, cmgtag, imgdt, ier ) + if ( ier .ne. 0 ) stop 12 + + ! Get a count of the number of data subsets in the message. + jj = nmsub(11) + if ( jj .ne. 660 ) stop 13 + + ! Open a new BUFR message for output. + call openmb ( 21, cmgtag, imgdt ) + + ! Copy the third data message subset-by-subset into the output file. + do ii = 1, jj + if ( icopysb (11, 21) .ne. 0 ) stop 14 + end do + + ! Close the output file. + call closbf(21) + +end program outtest9 diff --git a/test/test_IN_5.F b/test/test_IN_5.F deleted file mode 100644 index a60bd501..00000000 --- a/test/test_IN_5.F +++ /dev/null @@ -1,82 +0,0 @@ -C This is a test for NCEPLIBS-bufr. -C -C This tests a number of library routines and functionality -C involved in reading input BUFR messages, as noted in the -C comments and print statements below. -C -C Jeff Ator - -#ifdef INTSIZE_8 - INTEGER*4 IREADNS -#endif - - PARAMETER ( MXR8PM = 6 ) - PARAMETER ( MXR8LV = 50 ) - - CHARACTER cmgtag*8, - + cmeang1*40, cmeang2*40, cmeang3*40, cmeang4*40 - -C*---------------------------------------------------------------------- - - print *, '----------------------------------------------------' - print *, 'testing BUFRLIB: reading IN_5' - print *, ' using OPENBF IO = ''IN'' and LUNIN = LUNDX' - print *, ' using PREPBUFR and code/flag table meaning strings' - print *, '----------------------------------------------------' - -#ifdef INTSIZE_8 - CALL SETIM8B ( .true. ) -#endif - - OPEN ( UNIT = 11, FILE = 'testfiles/IN_5', FORM ='UNFORMATTED') - - CALL OPENBF ( 11, 'IN', 11 ) - - print *, ' OPENBF -> OK' - - CALL MTINFO ( '../tables', 90, 91 ) - print *, ' MTINFO -> OK' - - CALL CODFLG ( 'Y' ) - - print *, ' CODFLG -> OK' - - IF ( IREADNS ( 11, cmgtag, imgdt ) .ne. 0 ) THEN - - print *, ' IREADNS -> FAILED!!' - - ELSE - - print *, ' IREADNS -> OK' - -C* Retrieve and check some code/flag meaning strings. - - CALL GETCFMNG - + ( 11, 'PRC', 106, ' ', -1, cmeang1, lcmg1, ier1 ) - CALL GETCFMNG - + ( 11, 'PRC', 106, 'PPC', 5, cmeang2, lcmg2, ier2 ) - CALL GETCFMNG - + ( 11, 'GSES', 10, ' ', -1, cmeang3, lcmg3, ier3 ) - CALL GETCFMNG - + ( 11, 'GSES', 10, 'GCLONG', 173, cmeang4, lcmg4, ier4 ) - - IF ( ( ier1 .eq. 1 ) .and. ( lcmg1 .eq. 8 ) .and. - + ( cmeang1(1:lcmg1) .eq. 'PPC ' ) .and. - + ( ier2 .eq. 0 ) .and. ( lcmg2 .eq. 34 ) .and. - + ( cmeang2(1:lcmg2) .eq. - + 'Surface pressure observation error' ) .and. - + ( ier3 .eq. 3 ) .and. ( lcmg3 .eq. 24 ) .and. - + ( cmeang3(1:lcmg3) .eq. - + 'GCLONG OGCE ORIGC ' ) .and. - + ( ier4 .eq. 0 ) .and. ( lcmg4 .eq. 20 ) .and. - + ( cmeang4(1:lcmg4) .eq. - + 'Stennis Space Center' ) ) THEN - print *, ' GETCFMNG -> OK' - ELSE - print *, ' GETCFMNG -> FAILED!!' - ENDIF - - ENDIF - - STOP - END diff --git a/test/test_IN_6.F b/test/test_IN_6.F deleted file mode 100644 index 30c05e9c..00000000 --- a/test/test_IN_6.F +++ /dev/null @@ -1,81 +0,0 @@ -C This is a test for NCEPLIBS-bufr. -C -C This tests a number of library routines and functionality -C involved in reading input BUFR messages, as noted in the -C comments and print statements below. -C -C Jeff Ator - -#ifdef INTSIZE_8 - INTEGER*4 NMSUB -#endif - - CHARACTER cmgtag*8 - -C*---------------------------------------------------------------------- - - print *, '----------------------------------------------------' - print *, 'testing BUFRLIB: reading IN_6' - print *, ' using UFBMEM, RDMEMM and UFBMNS' - print *, '----------------------------------------------------' - -#ifdef INTSIZE_8 - CALL SETIM8B ( .true. ) -#endif - - OPEN ( UNIT = 21, FILE = 'testfiles/IN_6_infile1', - + FORM = 'UNFORMATTED') - OPEN ( UNIT = 22, FILE = 'testfiles/IN_6_infile2', - + FORM = 'UNFORMATTED') - - CALL DATEBF ( 22, iyr, imon, iday, ihour, imgdt ) - IF ( ( imgdt .eq. 21031900 ) .and. - + ( iyr .eq. 21 ) .and. ( iday .eq. 19 ) ) THEN - print *, ' DATEBF -> OK' - ELSE - print *, ' DATEBF -> FAILED!!' - END IF - REWIND ( 22 ) - -C* Open the input files. - - CALL UFBMEM ( 21, 0, icnt1, iunt1 ) - CALL UFBMEM ( 22, 1, icnt2, iunt2 ) - - IF ( ( icnt1 .eq. 926 ) .and. ( icnt2 .eq. 344 ) .and. - + ( iunt1 .eq. 21 ) .and. ( iunt2 .eq. 21 ) ) THEN - print *, ' UFBMEM -> OK' - ELSE - print *, ' UFBMEM -> FAILED!!' - END IF - -C* Read message #167 into internal arrays. - - CALL RDMEMM ( 167, cmgtag, imgdt, ier ) - - IF ( ( cmgtag .eq. 'NC004002' ) .and. - + ( imgdt .eq. 21031713 ) .and. - + ( NMSUB(iunt2) .eq. 3 ) ) THEN - print *, ' RDMEMM -> OK' - print *, ' NMSUB -> OK' - ELSE - print *, ' RDMEMM -> FAILED!!' - print *, ' NMSUB -> FAILED!!' - END IF - -C* Read subset #18364 into internal arrays. - - CALL UFBMNS ( 18364, cmgtag, imgdt ) - - IF ( ( cmgtag .eq. 'NC002003' ) .and. - + ( imgdt .eq. 21031900 ) .and. - + ( NMSUB(iunt2) .eq. 2 ) ) THEN - print *, ' UFBMNS -> OK' - print *, ' NMSUB -> OK' - ELSE - print *, ' UFBMNS -> FAILED!!' - print *, ' NMSUB -> FAILED!!' - END IF - - STOP - END diff --git a/test/test_IN_7.F b/test/test_IN_7.F deleted file mode 100644 index 496a5287..00000000 --- a/test/test_IN_7.F +++ /dev/null @@ -1,229 +0,0 @@ -C This is a test for NCEPLIBS-bufr. -C -C This tests a number of library routines and functionality -C involved in reading input BUFR messages, as noted in the -C comments and print statements below. -C -C Jeff Ator - - MODULE Share_errstr - -C> This module is needed in order to share information -C> between the test program and subroutine ERRWRT, because -C> the latter is not called by the former but rather is -C> called directly from within the BUFRLIB software. - - CHARACTER*1500 errstr - - INTEGER errstr_len - - END MODULE - -C>------------------------------------------------------------------- - - SUBROUTINE ERRWRT(str) - -C> This subroutine supersedes the subroutine of the same name -C> from the BUFRLIB software, so that we can easily test the -C> generation of error messages from within the library. - - USE Share_errstr - - CHARACTER*(*) str - - INTEGER str_len - - str_len = LEN(str) - errstr ( errstr_len + 1 : errstr_len + str_len + 1 ) = str - errstr_len = errstr_len + str_len - - RETURN - END - -C>------------------------------------------------------------------- - - USE Share_errstr - -#ifdef INTSIZE_8 - INTEGER*4 ISETPRM, IGETPRM, IREADNS -#endif - - PARAMETER ( MXR8PM = 15 ) - PARAMETER ( MXR8LV = 5 ) - - REAL*8 r8arr ( MXR8PM, MXR8LV ), r8val - - CHARACTER cmgtag*8 - - print *, '----------------------------------------------------' - print *, 'testing BUFRLIB: reading IN_7' - print *, ' using 2-03-YYY changed reference values' - print *, ' using inline ERRWRT to check error messages' - print *, ' using UFBPOS, UFBTAB, and VALX' - print *, '----------------------------------------------------' - -#ifdef INTSIZE_8 - CALL SETIM8B ( .true. ) -#endif - - iret1 = ISETPRM ( 'MXNRV', 5 ) - errstr_len = 1 - iret2 = ISETPRM ( 'DUMMY', 20 ) - IF ( ( iret1 .eq. 0 ) .and. ( iret2 .eq. -1 ) .and. - + ( INDEX( errstr(1:errstr_len), - + 'ISETPRM - UNKNOWN INPUT PARAMETER DUMMY' ) - + .ne. 0 ) ) THEN - print *, ' ISETPRM -> OK' - ELSE - print *, ' ISETPRM -> FAILED!!' - END IF - - OPEN ( UNIT = 11, FILE = 'testfiles/IN_7', FORM ='UNFORMATTED') - OPEN ( UNIT = 12, FILE = 'testfiles/IN_7_bufrtab' ) - - CALL OPENBF ( 11, 'IN', 12 ) - CALL OPENBF ( 11, 'QUIET', 1 ) - - iret1 = IGETPRM ( 'MXNRV' ) - errstr_len = 1 - iret2 = IGETPRM ( 'DUMMY' ) - IF ( ( iret1 .eq. 5 ) .and. ( iret2 .eq. -1 ) .and. - + ( INDEX( errstr(1:errstr_len), - + 'IGETPRM - UNKNOWN INPUT PARAMETER DUMMY' ) - + .ne. 0 ) ) THEN - print *, ' IGETPRM -> OK' - ELSE - print *, ' IGETPRM -> FAILED!!' - END IF - -C> Read some data values from the 1st messaage, which uses the -C> 2-03-YYY operator to change one of the reference values. - - IF ( IREADNS ( 11, cmgtag, imgdt ) .ne. 0 ) THEN - print *, ' IREADNS -> FAILED!!' - ELSE - print *, ' IREADNS -> OK' - CALL UFBREP ( 11, r8arr, MXR8PM, MXR8LV, nr8a, 'TIDER' ) - errstr_len = 1 - CALL UFBREP ( 11, r8val, 1, 1, nr8v, 'DUMMY' ) - idx1 = INDEX( errstr(1:errstr_len), - + 'UFBREP - NO SPECIFIED VALUES READ IN' ) - errstr_len = 1 - CALL UFBREP ( 11, r8val, 0, 1, nr8v2, 'TIDER' ) - idx2 = INDEX( errstr(1:errstr_len), - + 'UFBREP - 3rd ARG. (INPUT) IS .LE. 0' ) - IF ( ( nr8a .eq. 2 ) .and. - + ( nr8v .eq. 0 ) .and. ( nr8v2 .eq. 0 ) .and. - + ( idx1 .gt. 0 ) .and. ( idx2 .gt. 0 ) .and. - + ( NINT ( r8arr(1,1) ) .eq. -10000 ) .and. - + ( NINT ( r8arr(1,2) ) .eq. 16 ) ) THEN - print *, ' UFBREP -> OK' - ELSE - print *, ' UFBREP -> FAILED!!' - END IF - END IF - -C> Jump ahead to the 5th subset of the 23rd message and read -C> some data values. - - CALL UFBPOS ( 11, 23, 5, cmgtag, jdate ) - CALL UFBINT ( 11, r8arr, MXR8PM, MXR8LV, nr8a, - + 'CLATH CLONH TMDB SWRAD' ) - errstr_len = 1 - CALL UFBINT ( 11, r8val, 1, 1, nr8v, 'DUMMY' ) - idx1 = INDEX( errstr(1:errstr_len), - + 'UFBINT - NO SPECIFIED VALUES READ IN' ) - errstr_len = 1 - CALL UFBINT ( 11, r8val, 1, 0, nr8v2, 'TMDB' ) - idx2 = INDEX( errstr(1:errstr_len), - + 'UFBINT - 4th ARG. (INPUT) IS .LE. 0' ) - IF ( ( nr8a .eq. 1 ) .and. - + ( nr8v .eq. 0 ) .and. ( nr8v2 .eq. 0 ) .and. - + ( idx1 .gt. 0 ) .and. ( idx2 .gt. 0 ) .and. - + ( NINT ( r8arr(1,1)*100000 ) .eq. 2001191 ) .and. - + ( NINT ( r8arr(2,1)*100000 ) .eq. -3785017 ) .and. - + ( NINT ( r8arr(3,1)*100 ) .eq. 30035 ) .and. - + ( NINT ( r8arr(4,1) ) .eq. 2187000 ) ) THEN - print *, ' UFBPOS -> OK' - print *, ' UFBINT -> OK' - ELSE - print *, ' UFBPOS -> FAILED!!' - print *, ' UFBINT -> FAILED!!' - END IF - -C> Jump ahead to the 2nd subset of the 30th message and read -C> some data values. - - CALL UFBPOS ( 11, 30, 2, cmgtag, jdate ) - CALL UFBSTP ( 11, r8arr, MXR8PM, MXR8LV, nr8a, - + 'CLAT CLON HSMSL' ) - errstr_len = 1 - CALL UFBSTP ( 11, r8val, 1, 1, nr8v, 'DUMMY' ) - idx1 = INDEX( errstr(1:errstr_len), - + 'UFBSTP - NO SPECIFIED VALUES READ IN' ) - errstr_len = 1 - CALL UFBSTP ( 11, r8val, 1, 0, nr8v2, 'CLON' ) - idx2 = INDEX( errstr(1:errstr_len), - + 'UFBSTP - 4th ARG. (INPUT) IS .LE. 0' ) - IF ( ( nr8a .eq. 1 ) .and. - + ( nr8v .eq. 0 ) .and. ( nr8v2 .eq. 0 ) .and. - + ( idx1 .gt. 0 ) .and. ( idx2 .gt. 0 ) .and. - + ( NINT ( r8arr(1,1)*100 ) .eq. 3163 ) .and. - + ( NINT ( r8arr(2,1)*100 ) .eq. -11017 ) .and. - + ( NINT ( r8arr(3,1) ) .eq. 1205 ) ) THEN - print *, ' UFBPOS -> OK' - print *, ' UFBSTP -> OK' - ELSE - print *, ' UFBPOS -> FAILED!!' - print *, ' UFBSTP -> FAILED!!' - END IF - -C> Jump backwards to the 88th subset of the 29th message and read -C> some data values. - - CALL UFBPOS ( 11, 29, 88, cmgtag, jdate ) - CALL UFBSEQ ( 11, r8arr, MXR8PM, MXR8LV, nr8a, - + 'NC008023' ) - errstr_len = 1 - CALL UFBSEQ ( 11, r8val, 1, 1, nr8v, 'DUMMY' ) - idx1 = INDEX( errstr(1:errstr_len), - + 'UFBSEQ - NO SPECIFIED VALUES READ IN' ) - errstr_len = 1 - CALL UFBSEQ ( 11, r8val, 0, 1, nr8v2, 'CLON' ) - idx2 = INDEX( errstr(1:errstr_len), - + 'UFBSEQ - 3rd ARG. (INPUT) IS .LE. 0' ) - IF ( ( nr8a .eq. 1 ) .and. - + ( nr8v .eq. 0 ) .and. ( nr8v2 .eq. 0 ) .and. - + ( idx1 .gt. 0 ) .and. ( idx2 .gt. 0 ) .and. - + ( NINT ( r8arr(6,1)*100000 ) .eq. 2967000 ) .and. - + ( NINT ( r8arr(7,1)*100000 ) .eq. -9512833 ) .and. - + ( NINT ( r8arr(5,1) ) .eq. 482011039 ) ) THEN - print *, ' UFBPOS -> OK' - print *, ' UFBSEQ -> OK' - ELSE - print *, ' UFBPOS -> FAILED!!' - print *, ' UFBSEQ -> FAILED!!' - END IF - -C> Rewind the file and get a total count of the subsets. - - CALL UFBTAB ( -11, r8val, 1, 1, nsub, ' ' ) - IF ( ( nsub .eq. 402 ) .and. ( IBFMS ( r8val ) .eq. 1 ) ) THEN - print *, ' UFBTAB -> OK' - ELSE - print *, ' UFBTAB -> FAILED!!' - END IF - -C> Test the error handling inside of VALX. - - errstr_len = 1 - r8val = VALX ( '75.DUMMY' ) - IF ( ( INDEX( errstr(1:errstr_len), - + 'VALX - ERROR READING STRING' ) .ne. 0 ) ) THEN - print *, ' VALX -> OK' - ELSE - print *, ' VALX -> FAILED!!' - END IF - - STOP - END diff --git a/test/test_IN_8.F90 b/test/test_IN_8.F90 deleted file mode 100644 index b3f0431a..00000000 --- a/test/test_IN_8.F90 +++ /dev/null @@ -1,111 +0,0 @@ -! This is a test for NCEPLIBS-bufr. -! -! This tests a number of library routines and functionality -! involved in reading input BUFR messages, as noted in the -! comments and print statements below. -! -! Jeff Ator - -program test_IN_8 - - integer, parameter :: MXR8PM = 15 - integer, parameter :: MXR8LV = 500 - integer, parameter :: MXR8EN = 10 - - integer ibit1 ( 6 ), ibit2 ( 6 ) - - real*8 hdr ( 6, 1 ) - real*8 r8vals ( MXR8PM, MXR8LV, MXR8EN ) - real*8 r8v1, r8v2 - - character*8 mnem1, mnem2 - -!----------------------------------------------------------------------- - - print *, '----------------------------------------------------' - print *, 'testing BUFRLIB: reading IN_8' - print *, ' using RDMGSB, UFBEVN, UFBQCD, and UFBQCP to read prepbufr file' - print *, '----------------------------------------------------' - -#ifdef INTSIZE_8 - call setim8b ( .true. ) -#endif - - open ( unit = 11, file = 'testfiles/data/prepbufr', form ='unformatted' ) - -! read the 3rd subset from the 27th message of the prepbufr file and check some values - - call rdmgsb ( 11, 27, 3 ) - - call ufbint ( 11, hdr, 6, 1, ier, 'XOB YOB ELV TYP T29 ITP' ) - if ( ( NINT(hdr(1,1)*100) == 30233 ) .and. ( NINT(hdr(2,1)*100) == -1900 ) .and. & - ( NINT(hdr(3,1)) == 142 ) .and. ( NINT(hdr(4,1)) == 120 ) .and. & - ( NINT(hdr(5,1)) == 11 ) .and. ( NINT(hdr(6,1)) == 80 ) ) then - print *, ' RDMGSB -> OK' - else - print *, ' RDMGSB -> FAILED!!' - endif - -! get all of the moisture data from this subset and check some values - - call ufbevn ( 11, r8vals, MXR8PM, MXR8LV, MXR8EN, ilv, 'QOB QQM QPC QRC' ) - - if ( ( ilv == 51 ) .and. & - ( NINT(r8vals(1,2,2)) == 17895 ) .and. ( NINT(r8vals(2,2,2)) == 2 ) .and. & - ( NINT(r8vals(3,2,2)) == 1 ) .and. ( NINT(r8vals(4,2,2)) == 100 ) .and. & - ( NINT(r8vals(1,36,1)) == 126 ) .and. ( NINT(r8vals(2,36,1)) == 9 ) .and. & - ( NINT(r8vals(3,36,1)) == 8 ) .and. ( NINT(r8vals(4,36,1)) == 1 ) .and. & - ( NINT(r8vals(1,50,3)) == 3 ) .and. ( NINT(r8vals(2,50,3)) == 15 ) .and. & - ( NINT(r8vals(3,50,3)) == 1 ) .and. ( NINT(r8vals(4,50,3)) == 100 ) ) then - print *, ' UFBEVN -> OK' - else - print *, ' UFBEVN -> FAILED!!' - endif - -! now, get all of the temperature data from this subset which meets the conditions of being on -! a level where the pressure is between 490mb and 44mb, and check some of those values - - call ufbevn ( 11, r8vals, MXR8PM, MXR8LV, MXR8EN, ilv, 'POB<490 POB>44 POB TOB TQM TPC TRC' ) - - if ( ( ilv == 33 ) .and. & - ( NINT(r8vals(1,5,1)) == 378 ) .and. ( NINT(r8vals(2,5,1)*10) == -149 ) .and. & - ( NINT(r8vals(4,5,1)) == 8 ) .and. ( NINT(r8vals(2,5,2)*10) == -151 ) .and. & - ( NINT(r8vals(5,5,2)) == 100 ) .and. ( NINT(r8vals(1,29,1)*10) == 699 ) .and. & - ( NINT(r8vals(2,29,1)*10) == -809 ) .and. ( NINT(r8vals(3,29,1)) == 2 ) ) then - print *, ' UFBEVN w/conditions -> OK' - else - print *, ' UFBEVN w/conditions -> FAILED!!' - endif - -! other checks - - call ufbqcd ( 11, 'RADCOR', iqcd1 ) - call ufbqcd ( 11, 'ACARSQC', iqcd2 ) - if ( ( iqcd1 == 6 ) .and. ( iqcd2 == 14 ) ) then - print *, ' UFBQCD -> OK' - else - print *, ' UFBQCD -> FAILED!!' - endif - - call ufbqcp ( 11, 2, mnem1 ) - call ufbqcp ( 11, 8, mnem2 ) - if ( ( mnem1(1:7) .eq. 'SYNDATA' ) .and. ( mnem2(1:6) .eq. 'VIRTMP' ) ) then - print *, ' UFBQCP -> OK' - else - print *, ' UFBQCP -> FAILED!!' - endif - - r8v1 = 224. - call upftbv ( 11, 'RSRD', r8v1, 6, ibit1, nib1 ) - r8v2 = 264192. - call upftbv ( 11, 'WVCQ', r8v2, 6, ibit2, nib2 ) - if ( ( nib1 == 3 ) .and. ( ibit1(1) == 2 ) .and. ( ibit1(2) == 3 ) .and. ( ibit1(3) == 4 ) .and. & - ( nib2 == 2 ) .and. ( ibit2(1) == 6 ) .and. ( ibit2(2) == 13 ) ) then - print *, ' UPFTBV -> OK' - else - print *, ' UPFTBV -> FAILED!!' - endif - - stop - -end program test_IN_8 diff --git a/test/test_OUT_1.F b/test/test_OUT_1.F deleted file mode 100644 index f277dca3..00000000 --- a/test/test_OUT_1.F +++ /dev/null @@ -1,206 +0,0 @@ -C This is a test for NCEPLIBS-bufr. -C -C This tests a number of library routines and functionality -C involved in writing output BUFR messages, as noted in the -C comments and print statements below. -C -C Jeff Ator - - REAL*8 r8ymd ( 3, 1 ), - + r8ltl ( 2, 1 ), - + r8flv ( 1, 5 ), - + r8oth ( 10, 1 ) - -#ifdef INTSIZE_8 - INTEGER*4 LCMGDF -#endif - - INTEGER nsc(5), nrf(5), nbt(5), ierns(5) - - CHARACTER acrn*10, libvrsn*8, tagpr*6 - -C*---------------------------------------------------------------------- - - print *, '----------------------------------------------------' - print *, 'testing BUFRLIB: writing OUT_1' - print *, ' using OPENBF IO = ''OUT'' and LUNIN != LUNDX' - print *, ' using 2-03-YYY to change reference values' - print *, '----------------------------------------------------' - -#ifdef INTSIZE_8 - CALL SETIM8B ( .true. ) -#endif - - CALL BVERS ( libvrsn ) - IF ( LGT( libvrsn, '10.1.1' ) ) THEN -C* Specify the use of big-endian blocking. - print *, ' SETBLOCK' - CALL SETBLOCK (1) - ENDIF - -C* Open the BUFR table and output file. - - OPEN ( UNIT = 11, FILE = 'out1.bufr', FORM ='UNFORMATTED') - OPEN ( UNIT = 12, FILE = 'testfiles/OUT_1_bufrtab' ) - - CALL OPENBF ( 11, 'OUT', 12 ) - print *, ' OPENBF' - -C* Write a standard, compressed BUFR message with 3 subsets. -C* Compression will be implemented using WRITCP. - - CALL STDMSG ('Y') - print *, ' STDMSG' - -C* First subset. - - CALL OPENMB ( 11, 'FR004029', 2012031212 ) - print *, ' OPENMB' - - IF ( LCMGDF ( 11, 'FR004029' ) .eq. 1 ) THEN - print *, ' LCMGDF' - ELSE - CALL BORT ( 'LCMGDF FAILURE!' ) - ENDIF - - CALL GETTAGPR ( 11, 'MNTH', 1, tagpr, iertgp ) - IF ( ( iertgp .eq. 0 ) .and. ( tagpr .eq. 'YYMMDD' ) ) THEN - print *, ' GETTAGPR' - ELSE - CALL BORT ( 'GETTAGPR FAILURE!' ) - ENDIF - -C* The output of the following calls will be checked below, after -C* making additional calls to this same subroutine to verify -C* reference values that will be modified with the 2-03 operator. - - CALL NEMSPECS ( 11, 'ACRN', 1, nsa, nra, nba, iernsa ) - CALL NEMSPECS ( 11, 'MDEVG', 1, nsm, nrm, nbm, iernsm ) - - r8ymd(1,1) = 2012 - r8ymd(2,1) = 3 - r8ymd(3,1) = 12 - CALL UFBSEQ ( 11, r8ymd, 3, 1, nlv, 'YYMMDD' ) - r8ltl(1,1) = -35.77 - r8ltl(2,1) = 172.38 - CALL UFBSEQ ( 11, r8ltl, 2, 1, nlv, 'LTLONH' ) - print *, ' UFBSEQ' - -C* The r8flv array tests the 2-03 operator. r8flv(1,2) contains -C* the new reference value, which is applied to the FLVLST values -C* in r8flv(1,3) and r8flv(1,4) when writing the message. - - r8flv(1,1) = 3500 - r8flv(1,2) = -1000 - r8flv(1,3) = 4000 - r8flv(1,4) = 5750 - r8flv(1,5) = 10722 - CALL UFBREP ( 11, r8flv, 1, 5, nlv, 'FLVLST') - print *, ' UFBREP' - - r8oth(1,1) = 13 - r8oth(2,1) = 45 - r8oth(3,1) = 235.77 - r8oth(4,1) = 1 - r8oth(5,1) = 5.322 - r8oth(6,1) = 1 - r8oth(7,1) = 3 - r8oth(8,1) = 5 - r8oth(9,1) = 35 - r8oth(10,1) = 10.7 - CALL UFBINT ( 11, r8oth, 10, 1, nlv, - + 'HOUR MINU TMDB DGOT MDEVG ROLQ INTV DPOF WDIR WSPD') - print *, ' UFBINT' - - CALL WRITCP ( 11 ) - print *, ' WRITCP' - -C* We need to run the following check after the call to WRITCP, -C* because new reference values aren't stored into a message (nor -C* applied when packing any other values within that message) until -C* WRITCP calls WRITSB, which in turn calls WRTREE, which in turn -C* calls IPKS. - - DO jj = 1, 5 - CALL NEMSPECS ( 11, 'FLVLST', jj, nsc(jj), nrf(jj), - + nbt(jj), ierns(jj) ) - END DO - IF ( ( iernsa .eq. 0 ) .and. ( iernsm .eq. 0 ) .and. - + ( nba .eq. 80 ) .and. ( nbm .eq. 17 ) .and. - + ( nsm .eq. 3 ) .and. ( ierns(1) .eq. 0 ) .and. - + ( nrf(1) .eq. -1024 ) .and. ( ierns(2) .eq. 0 ) .and. - + ( nrf(2) .eq. -1024 ) .and. ( nbt(2) .eq. 12 ) .and. - + ( ierns(3) .eq. 0 ) .and. ( nrf(3) .eq. -1000 ) .and. - + ( ierns(4) .eq. 0 ) .and. ( nrf(4) .eq. -1000 ) .and. - + ( ierns(5) .eq. 0 ) .and. ( nrf(5) .eq. -1024 ) .and. - + ( nbt(3) .eq. 16 ) .and. ( nbt(5) .eq. 16 ) ) THEN - print *, ' NEMSPECS' - ELSE - CALL BORT ( 'NEMSPECS FAILURE!' ) - END IF - - acrn = 'TESTUPS008' - CALL WRITLC ( 11, acrn, 'ACRN' ) - print *, ' WRITLC' - -C* Second subset. - - CALL OPENMB ( 11, 'FR004029', 2012031212 ) - - CALL UFBSEQ ( 11, r8ymd, 3, 1, nlv, 'YYMMDD' ) - - r8ltl(2,1) = 172.42 - CALL UFBSEQ ( 11, r8ltl, 2, 1, nlv, 'LTLONH' ) - - r8flv(1,1) = 3600 - r8flv(1,4) = 5760 - r8flv(1,5) = 10730 - CALL UFBREP ( 11, r8flv, 1, 5, nlv, 'FLVLST') - - r8oth(2,1) = 48 - r8oth(3,1) = 234.69 - r8oth(5,1) = 5.001 - r8oth(8,1) = 3 - r8oth(9,1) = 30 - r8oth(10,1) = 12.2 - CALL UFBINT ( 11, r8oth, 10, 1, nlv, - + 'HOUR MINU TMDB DGOT MDEVG ROLQ INTV DPOF WDIR WSPD') - - CALL WRITCP ( 11 ) - - acrn = 'TESTAAL225' - CALL WRITLC ( 11, acrn, 'ACRN' ) - -C* Third subset. - - CALL OPENMB ( 11, 'FR004029', 2012031212 ) - - CALL UFBSEQ ( 11, r8ymd, 3, 1, nlv, 'YYMMDD' ) - - r8ltl(2,1) = 172.44 - CALL UFBSEQ ( 11, r8ltl, 2, 1, nlv, 'LTLONH' ) - - r8flv(1,1) = 3610 - r8flv(1,2) = -1200 - r8flv(1,4) = 5775 - r8flv(1,5) = 10730 - CALL UFBREP ( 11, r8flv, 1, 5, nlv, 'FLVLST') - - r8oth(2,1) = 51 - r8oth(3,1) = 234.11 - r8oth(5,1) = 5.012 - r8oth(8,1) = 6 - r8oth(10,1) = 12.1 - CALL UFBINT ( 11, r8oth, 10, 1, nlv, - + 'HOUR MINU TMDB DGOT MDEVG ROLQ INTV DPOF WDIR WSPD') - - CALL WRITCP ( 11 ) - - acrn = 'TESTSWA193' - CALL WRITLC ( 11, acrn, 'ACRN' ) - - CALL CLOSBF ( 11 ) - print *, ' CLOSBF' - - STOP - END diff --git a/test/test_OUT_2.F b/test/test_OUT_2.F deleted file mode 100644 index 39bdcaea..00000000 --- a/test/test_OUT_2.F +++ /dev/null @@ -1,134 +0,0 @@ -C This is a test for NCEPLIBS-bufr. -C -C This tests a number of library routines and functionality -C involved in writing output BUFR messages, as noted in the -C comments and print statements below. -C -C Jeff Ator - -#ifdef INTSIZE_8 - INTEGER*4 IGETSC -#endif - - REAL*8 r8ymd ( 3, 1 ), - + r8ltl ( 2, 1 ), - + r8oth ( 10, 1 ) - - CHARACTER libvrsn*8 - - REAL*8 rpid, PKFTBV, xmiss, GETBMISS - CHARACTER cpid*8 - EQUIVALENCE (rpid,cpid) - -C*---------------------------------------------------------------------- - - print *, '----------------------------------------------------' - print *, 'testing BUFRLIB: writing OUT_2' - print *, ' using OPENBF IO = ''APX'' and embedded tables' - print *, '----------------------------------------------------' - -#ifdef INTSIZE_8 - CALL SETIM8B ( .true. ) -#endif - - CALL BVERS ( libvrsn ) - print *, ' BVERS' - IF ( LGT( libvrsn, '10.1.1' ) ) THEN -C* Specify the use of big-endian blocking. - CALL SETBLOCK (1) - print *, ' SETBLOCK' -C* Modify the "missing" value. - xmiss = 9999. - CALL SETBMISS (xmiss) - print *, ' SETBMISS' - ENDIF - -C* Open the BUFR table and output file. - - OPEN ( UNIT = 11, FILE = 'out2.bufr', FORM ='UNFORMATTED') - OPEN ( UNIT = 12, FILE = 'testfiles/OUT_2_bufrtab' ) - - CALL OPENBF ( 11, 'APX', 12 ) - print *, ' OPENBF' - - IF ( IGETSC ( 11 ) .eq. 0 ) THEN - print *, ' IGETSC' - ELSE - CALL BORT ( 'IGETSC FAILURE!' ) - ENDIF - - CALL PKVS01 ( 'OGCE', 160 ) - print *, ' PKVS01' - -C* Write an edition 4 BUFR message with 2 subsets. - - CALL PKVS01 ( 'BEN', 4 ) - print *, ' CNVED4' - -C* First subset. - - CALL OPENMB ( 11, 'NC031112', 2012101712 ) - print *, ' OPENMB' - - CALL NEMSPECS ( 11, 'TMBRST', 1, nsc, nrf, nbt, ierns ) - IF ( ( ierns .eq. 0 ) .and. - + ( nsc .eq. 3 ) .and. ( nbt .eq. 19 ) ) THEN - print *, ' NEMSPECS' - ELSE - CALL BORT ( 'NEMSPECS FAILURE!' ) - END IF - - r8ymd(1,1) = 2012 - r8ymd(2,1) = 10 - r8ymd(3,1) = 17 - CALL UFBINT ( 11, r8ymd, 3, 1, nlv, 'YEAR MNTH DAYS' ) - r8ltl(1,1) = -22.67 - r8ltl(2,1) = 72.02 - CALL UFBINT ( 11, r8ltl, 2, 1, nlv, 'CLATH CLONH' ) - - r8oth(1,1) = 13 - r8oth(2,1) = 45 - r8oth(3,1) = 216.744 - r8oth(4,1) = 85 - r8oth(5,1) = 110 - r8oth(6,1) = 17 - r8oth(7,1) = PKFTBV(12,3) + PKFTBV(12,9) - print *, ' PKFTBV' - r8oth(8,1) = -0.661527 - CALL UFBINT ( 11, r8oth, 10, 1, nlv, - + 'HOUR MINU TMBRST SAID SACYLN ORBN OBQL SLHD1') - print *, ' UFBINT' - - CALL WRITSB ( 11 ) - print *, ' WRITSB' - -C* Second subset. - - CALL OPENMB ( 11, 'NC031112', 2012101712 ) - - CALL UFBINT ( 11, r8ymd, 3, 1, nlv, 'YEAR MNTH DAYS' ) - r8ltl(2,1) = 72.13 - CALL UFBINT ( 11, r8ltl, 2, 1, nlv, 'CLATH CLONH' ) - - r8oth(2,1) = 48 - r8oth(3,1) = 214.003 - r8oth(8,1) = 0.002582 - CALL UFBINT ( 11, r8oth, 10, 1, nlv, - + 'HOUR MINU TMBRST SAID SACYLN ORBN OBQL SLHD1') - - cpid = 'SUBSET#2' - CALL UFBINT ( 11, rpid, 1, 1, nlv, 'RPID' ) - - IF ( NINT(xmiss) .eq. NINT(GETBMISS()) ) THEN - print *, ' GETBMISS' - ELSE - CALL BORT ( 'GETBMISS FAILURE!' ) - ENDIF - - CALL WRITSB ( 11 ) - - CALL CLOSBF ( 11 ) - print *, ' CLOSBF' - - STOP - END diff --git a/test/test_OUT_3.F b/test/test_OUT_3.F deleted file mode 100644 index 02f72f36..00000000 --- a/test/test_OUT_3.F +++ /dev/null @@ -1,208 +0,0 @@ -C This is a test for NCEPLIBS-bufr. -C -C This tests a number of library routines and functionality -C involved in writing output BUFR messages, as noted in the -C comments and print statements below. -C -C Jeff Ator - -#ifdef INTSIZE_8 - INTEGER*4 ISETPRM, IGETPRM -#endif - - REAL*8 r8vals ( 11, 4 ), r8bitmap ( 26 ) - -C*---------------------------------------------------------------------- - - print *, '----------------------------------------------------' - print *, 'testing BUFRLIB: writing OUT_3' - print *, ' using dynamic allocation' - print *, ' using EXITBUFR with multiple allocations' - print *, ' using 2-22, 2-36 and 2-37 operators' - print *, '----------------------------------------------------' - -#ifdef INTSIZE_8 - CALL SETIM8B ( .true. ) -#endif - -C* First message. - - IF ( ( ISETPRM ( 'NFILES', 2 ) .eq. 0 ) .and. - + ( ISETPRM ( 'MXMSGL', 8000 ) .eq. 0 ) ) THEN - print *, ' ISETPRM' - ELSE - CALL BORT ( 'ISETPRM FAILURE!' ) - END IF - - CALL PKVS01 ( 'MTV', 18 ) - CALL PKVS01 ( 'USN', 2 ) - print *, ' PKVS01' - -C* Open the BUFR table and output file. - - OPEN ( UNIT = 11, FILE = 'out3.bufr', FORM ='UNFORMATTED') - OPEN ( UNIT = 12, FILE = 'testfiles/OUT_3_bufrtab' ) - - CALL OPENBF ( 11, 'OUT', 12 ) - print *, ' OPENBF' - - IF ( ( IGETPRM ( 'NFILES' ) .eq. 2 ) .and. - + ( IGETPRM ( 'MXMSGL' ) .eq. 8000 ) ) THEN - print *, ' IGETPRM' - ELSE - CALL BORT ( 'IGETPRM FAILURE!' ) - END IF - -C* Write a standard message. - - CALL STDMSG ('Y') - print *, ' STDMSG' - -C* Store the data values. - - CALL OPENMB ( 11, 'FN005000', 2015030212 ) - print *, ' OPENMB' - - r8vals(1,1) = 2015 - r8vals(2,1) = 3 - r8vals(3,1) = 2 - r8vals(4,1) = 12 - r8vals(5,1) = 57 - r8vals(6,1) = -12.538 - r8vals(7,1) = 157.66 - r8vals(8,1) = 20170. - r8vals(9,1) = 37. - r8vals(10,1) = 2.1 - r8vals(11,1) = 244.5 - CALL UFBINT ( 11, r8vals, 11, 1, nlv, - + 'YEAR MNTH DAYS HOUR MINU CLATH CLONH PRLC WDIR WSPD CCST' ) - print *, ' UFBINT' - - DO ii = 1, 26 - r8bitmap(ii) = 0. - END DO - r8bitmap(16) = 1. - r8bitmap(17) = 1. - r8bitmap(18) = 1. - r8bitmap(21) = 1. - CALL UFBREP ( 11, r8bitmap, 1, 26, nlv, 'DPRI' ) - - r8vals(1,1) = 7. - r8vals(2,1) = 51. - r8vals(1,2) = 254. - r8vals(2,2) = 1. - r8vals(1,3) = 254. - r8vals(2,3) = 3. - CALL UFBREP ( 11, r8vals, 11, 3, nlv, 'GCLONG GNAP' ) - - r8vals(1,1) = 97. - r8vals(1,2) = 96. - r8vals(1,3) = 93. - r8vals(1,4) = 93. - CALL UFBREP ( 11, r8vals, 11, 4, nlv, 'PCCF' ) - - r8vals(1,1) = 77. - r8vals(1,2) = 84. - r8vals(1,3) = 83. - r8vals(1,4) = 61. - CALL UFBREP ( 11, r8vals, 11, 4, nlv, 'NCTH' ) - print *, ' UFBREP' - - CALL WRITSB ( 11 ) - print *, ' WRITSB' - - CALL EXITBUFR - print *, ' EXITBUFR' - -C* Second message. - - IF ( ( ISETPRM ( 'NFILES', 5 ) .eq. 0 ) .and. - + ( ISETPRM ( 'MXMSGL', 12000 ) .eq. 0 ) ) THEN - print *, ' ISETPRM' - ELSE - CALL BORT ( 'ISETPRM FAILURE!' ) - END IF - - CALL PKVS01 ( 'BEN', 4 ) - CALL PKVS01 ( 'MSBTI', 40 ) - CALL PKVS01 ( 'MTV', 17 ) - print *, ' PKVS01' - -C* Open the BUFR table and output file. - - OPEN ( UNIT = 11, FILE = 'out3.bufr', FORM ='UNFORMATTED') - OPEN ( UNIT = 12, FILE = 'testfiles/OUT_3_bufrtab' ) - - CALL OPENBF ( 11, 'APX', 12 ) - print *, ' OPENBF' - - IF ( ( IGETPRM ( 'NFILES' ) .eq. 5 ) .and. - + ( IGETPRM ( 'MXMSGL' ) .eq. 12000 ) ) THEN - print *, ' IGETPRM' - ELSE - CALL BORT ( 'IGETPRM FAILURE!' ) - END IF - -C* Write a standard message. - - CALL STDMSG ('Y') - print *, ' STDMSG' - -C* Store the data values. - - CALL OPENMB ( 11, 'FN005010', 2015030215 ) - print *, ' OPENMB' - - r8vals(1,1) = 2015 - r8vals(2,1) = 3 - r8vals(3,1) = 2 - r8vals(4,1) = 15 - r8vals(5,1) = 44 - r8vals(6,1) = -12.538 - r8vals(7,1) = 157.66 - r8vals(8,1) = 19930. - r8vals(9,1) = 305. - r8vals(10,1) = 12.5 - r8vals(11,1) = 233.0 - CALL UFBINT ( 11, r8vals, 11, 1, nlv, - + 'YEAR MNTH DAYS HOUR MINU CLATH CLONH PRLC WDIR WSPD CCST' ) - print *, ' UFBINT' - - DO ii = 1, 26 - r8bitmap(ii) = 0. - END DO - r8bitmap(16) = 1. - r8bitmap(17) = 1. - r8bitmap(18) = 1. - r8bitmap(26) = 1. - CALL UFBREP ( 11, r8bitmap, 1, 26, nlv, 'DPRI' ) - - r8vals(1,1) = 7. - r8vals(2,1) = 51. - r8vals(1,2) = 254. - r8vals(2,2) = 1. - r8vals(1,3) = 254. - r8vals(2,3) = 3. - CALL UFBREP ( 11, r8vals, 11, 3, nlv, 'GCLONG GNAP' ) - - r8vals(1,1) = 92. - r8vals(1,2) = 91. - r8vals(1,3) = 91. - r8vals(1,4) = 98. - CALL UFBREP ( 11, r8vals, 11, 4, nlv, 'PCCF' ) - - r8vals(1,1) = 3. - r8vals(1,2) = 4. - r8vals(1,3) = 4. - r8vals(1,4) = 3. - CALL UFBREP ( 11, r8vals, 11, 4, nlv, 'MAQC' ) - print *, ' UFBREP' - - CALL WRITSB ( 11 ) - print *, ' WRITSB' - - CALL CLOSBF ( 11 ) - print *, ' CLOSBF' - - STOP - END diff --git a/test/test_OUT_4.F b/test/test_OUT_4.F deleted file mode 100644 index b49a0bff..00000000 --- a/test/test_OUT_4.F +++ /dev/null @@ -1,191 +0,0 @@ -C This is a test for NCEPLIBS-bufr. -C -C This tests a number of library routines and functionality -C involved in writing output BUFR messages, as noted in the -C comments and print statements below. -C -C Jeff Ator - -#ifdef INTSIZE_8 - INTEGER*4 ISETPRM, IREADSB, IGETMXBY, ICBFMS -#endif - - PARAMETER ( MXVAL1 = 200 ) - PARAMETER ( MXVAL2 = 12 ) - PARAMETER ( MXLVL = 4490 ) - - REAL*8 r8arr1 ( MXVAL1 ), r8arr2 ( MXVAL2, MXLVL ) - - PARAMETER ( MXBFMG = 50000 ) - - INTEGER mgbf ( MXBFMG ) - - CHARACTER cmgtag*8, smid*9, dummystr*9 - -C*---------------------------------------------------------------------- - - print *, '----------------------------------------------------' - print *, 'testing BUFRLIB: writing OUT_4' - print *, ' using dynamic allocation' - print *, ' using OPENBF IO = ''NODX'' and IO = ''QUIET''' - print *, ' using STRCPT, WRDXTB and WRITSA' - print *, '----------------------------------------------------' - -#ifdef INTSIZE_8 - CALL SETIM8B ( .true. ) -#endif - - IF ( ( ISETPRM ( 'NFILES', 4 ) .eq. 0 ) .and. - + ( ISETPRM ( 'MXMSGL', 400000 ) .eq. 0 ) .and. - + ( ISETPRM ( 'MAXSS', 250000 ) .eq. 0 ) .and. - + ( ISETPRM ( 'MAXMEM', 100000 ) .eq. 0 ) .and. - + ( ISETPRM ( 'MAXMSG', 100 ) .eq. 0 ) .and. - + ( ISETPRM ( 'MXDXTS', 5 ) .eq. 0 ) .and. - + ( ISETPRM ( 'MXCDV', 100 ) .eq. 0 ) .and. - + ( ISETPRM ( 'MXCSB', 100 ) .eq. 0 ) .and. - + ( ISETPRM ( 'MXLCC', 8 ) .eq. 0 ) ) THEN - print *, ' ISETPRM' - ELSE - CALL BORT ( 'ISETPRM FAILURE!' ) - END IF - -C* Open the BUFR input and output files. - - OPEN ( UNIT = 11, FILE = 'testfiles/OUT_4_infile1' ) - OPEN ( UNIT = 12, FILE = 'testfiles/OUT_4_infile2' ) - OPEN ( UNIT = 13, FILE = 'out4.bufr', FORM ='UNFORMATTED' ) - - CALL OPENBF ( 11, 'IN', 11 ) - CALL OPENBF ( 12, 'SEC3', 12 ) - CALL OPENBF ( 13, 'NODX', 11 ) - CALL OPENBF ( 13, 'QUIET', -1 ) - print *, ' OPENBF' - - CALL MTINFO ( '../tables', 90, 91 ) - print *, ' MTINFO' - - CALL MAXOUT ( MXBFMG*4 ) - print *, ' MAXOUT' - - IF ( IGETMXBY ( ) .eq. MXBFMG*4 ) THEN - print *, ' IGETMXBY' - ELSE - CALL BORT ( 'IGETMXBY FAILURE!' ) - ENDIF - -C* The following will ensure that subroutine STNDRD is called -C* internally during the subsequent calls to WRITSB and CLOSMG. - - CALL STDMSG ('Y') - print *, ' STDMSG' - -C* Append a (tank) receipt time to Section 1 of each output message - - CALL STRCPT ( 'Y', 2020, 11, 4, 15, 29 ) - print *, ' STRCPT' - -C* Process 1 message with 1 subset from infile1. - - CALL READMG ( 11, cmgtag, imgdt, iermg ) - - IF ( iermg .ne. 0 ) THEN - - CALL BORT ( 'READMG FAILURE!' ) - - ELSE - - print *, ' READMG' - - CALL READSB ( 11, iersb ) - - IF ( iersb .ne. 0 ) THEN - CALL BORT ( 'READSB FAILURE!' ) - ELSE - print *, ' READSB' - - CALL OPENMB ( 13, 'NC007000', 2020022514 ) - print *, ' OPENMB' - - CALL UFBSEQ ( 11, r8arr1, MXVAL1, 1, nlv, 'NC007000' ) - CALL UFBSEQ ( 13, r8arr1, MXVAL1, 1, nlv, 'NC007000' ) - print *, ' UFBSEQ' - - CALL WRITSB ( 13 ) - END IF - END IF - - CALL CLOSMG ( 13 ) - print *, ' CLOSMG' - -C* Process 1 message with 4 subset from infile2. - - CALL READMG ( 12, cmgtag, imgdt, iermg ) - -C* Turn off output message standardization. - - CALL STDMSG ('N') - -C* Write DX table information for this message into the -C* output file. - - CALL WRDXTB ( 12, 13 ) - print *, ' WRDXTB' - - IF ( iermg .ne. 0 ) THEN - - CALL BORT ( 'READMG FAILURE!' ) - - ELSE - - nsub = 0 - - DO WHILE ( IREADSB ( 12 ) .eq. 0 ) - - nsub = nsub + 1 - - CALL UFBSEQ ( 12, r8arr1, MXVAL1, 1, nlv, 'DATETMLN' ) - ibfdt = ( NINT(r8arr1(2)) * 1000000 ) + - + ( NINT(r8arr1(3)) * 10000 ) + - + ( NINT(r8arr1(4)) * 100 ) + NINT(r8arr1(5)) - CALL OPENMB ( 13, 'MSTTB001', ibfdt ) - CALL UFBSEQ ( 13, r8arr1, MXVAL1, 1, nlv, 'DATETMLN' ) - - WRITE ( UNIT = smid, FMT = '(A,I1.1)' ) 'STATION#', nsub - IF ( nsub .eq. 1 ) THEN - CALL READLC ( 12, dummystr, 'DUMMYSTR' ) - IF ( ICBFMS( dummystr, 9 ) .eq. 0 ) smid = dummystr - END IF - - CALL UFBSEQ ( 12, r8arr1, MXVAL1, 1, nlv, 'IDLSIPTM' ) - CALL UFBSEQ ( 13, r8arr1, MXVAL1, 1, nlv, 'IDLSIPTM' ) - CALL UFBSEQ ( 12, r8arr1, MXVAL1, 1, nlv, 'HAVCOLS' ) - CALL UFBSEQ ( 13, r8arr1, MXVAL1, 1, nlv, 'HAVCOLS' ) - CALL UFBSEQ ( 12, r8arr1, MXVAL1, 1, nlv, 'CLINRVSD' ) - CALL UFBSEQ ( 13, r8arr1, MXVAL1, 1, nlv, 'CLINRVSD' ) - CALL UFBSEQ ( 12, r8arr2, MXVAL2, MXLVL, nlv2, 'TDWPRAOB' ) - - CALL DRFINI ( 13, nlv2, 1, '(TDWPRAOB)' ) - CALL UFBSEQ ( 13, r8arr2, MXVAL2, nlv2, nlv, 'TDWPRAOB' ) - - CALL HOLD4WLC ( 13, smid, 'SMID' ) - CALL WRITSA ( 13, MXBFMG, mgbf, lmgbf ) - IF ( nsub .eq. 1 ) THEN - CALL WRITLC ( 13, dummystr, 'DUMMYSTR' ) - END IF - - END DO - - CALL WRITSA ( -13, MXBFMG, mgbf, lmgbf ) - - print *, ' ICBFMS' - print *, ' HOLD4WLC' - print *, ' DRFINI' - print *, ' WRITSA' - - END IF - - CALL CLOSBF ( 13 ) - print *, ' CLOSBF' - - STOP - END diff --git a/test/test_OUT_5.F b/test/test_OUT_5.F deleted file mode 100644 index 13c8236b..00000000 --- a/test/test_OUT_5.F +++ /dev/null @@ -1,96 +0,0 @@ -C This is a test for NCEPLIBS-bufr. -C -C This tests a number of library routines and functionality -C involved in writing output BUFR messages, as noted in the -C comments and print statements below. -C -C Jeff Ator - -#ifdef INTSIZE_8 - INTEGER*4 IREADNS -#endif - - INTEGER jdate(5), jdump(5) - - CHARACTER cmgtag*8, tabdb(1000)*128 - -C*---------------------------------------------------------------------- - - print *, '----------------------------------------------------' - print *, 'testing BUFRLIB: writing OUT_5' - print *, ' using DUMPBF and GETABDB' - print *, ' using UFDUMP, UFBDMP and DXDUMP' - print *, '----------------------------------------------------' - -#ifdef INTSIZE_8 - CALL SETIM8B ( .true. ) -#endif - -C* Open the output log (ASCII) file. - - OPEN ( UNIT = 13, FILE = 'out5.bufr' ) - -C* Make a "FIRST" call to subroutine OPENBF to dynamically -C* allocate internal arrays, in case this code is being run to -C* test a DA build. Otherwise, the below call to subroutine -C* DUMPBF will fail when trying to call subroutine STATUS, -C* because subroutine OPENBF won't yet have been called. - - CALL OPENBF ( 13, 'FIRST', 13 ) - -C* Open the input (BUFR) file. Note that since we're about to -C* call subroutine DUMPBF for this file, then we don't need to -C* first call subroutine OPENBF for this file, because subroutine -C* DUMPBF will do that internally. - - OPEN ( UNIT = 11, FILE = 'testfiles/OUT_5_infile' ) - - CALL DATELEN ( 10 ) - print *, ' DATELEN' - - WRITE ( 13, FMT = '(///,A)' ) '------------ DUMPBF ------------' - CALL DUMPBF ( 11, jdate, jdump ) - print *, ' DUMPBF' - WRITE ( 13, FMT = '(A,5I5)' ) 'jdate =', (jdate(ii), ii=1,5) - WRITE ( 13, FMT = '(A,5I5)' ) 'jdump =', (jdump(ii), ii=1,5) - -C* Subroutine DUMPBF will have just closed the input (BUFR) file -C* with an internal call to subroutine CLOSBF (which also does an -C* internal Fortran CLOSE on the logical unit number), so we now -C* need to reopen the file with a new call to subroutine OPENBF. - - OPEN ( UNIT = 11, FILE = 'testfiles/OUT_5_infile' ) - CALL OPENBF ( 11, 'IN', 11 ) - print *, ' OPENBF' - - WRITE ( 13, FMT = '(///,A)' ) '------------ GETABDB -----------' - CALL GETABDB ( 11, tabdb, 1000, jtab ) - print *, ' GETABDB' - DO ii = 1, jtab - WRITE ( 13, FMT = '(A,I4,2A)' ) - + 'tabdb entry #', ii, ":", tabdb(ii) - END DO - - WRITE ( 13, FMT = '(///,A,/)' ) '----------- DXDUMP -----------' - CALL DXDUMP ( 11, 13 ) - print *, ' DXDUMP' - - print *, ' IREADNS' - print *, ' UFDUMP' - print *, ' UFBDMP' - nsub = 0 - DO WHILE ( IREADNS ( 11, cmgtag, imgdt ) .eq. 0 ) - nsub = nsub + 1 - WRITE ( 13, FMT = '(///,A,I1,A)' ) - + '------------------------------ SUBSET #', nsub, - + '------------------------------' - WRITE ( 13, FMT = '(//,A)' ) - + '------------ UFDUMP ------------' - CALL UFDUMP ( 11, 13 ) - WRITE ( 13, FMT = '(//,A)' ) - + '------------ UFBDMP ------------' - CALL UFBDMP ( 11, 13 ) - END DO - - STOP - END diff --git a/test/test_OUT_6.F b/test/test_OUT_6.F deleted file mode 100644 index 369fc681..00000000 --- a/test/test_OUT_6.F +++ /dev/null @@ -1,123 +0,0 @@ -C This is a test for NCEPLIBS-bufr. -C -C This tests a number of library routines and functionality -C involved in writing output BUFR messages, as noted in the -C comments and print statements below. -C -C Jeff Ator - - REAL*8 r8f5fc ( 8, 5 ), r8dbss ( 4, 3 ), - + r8wind ( 2, 1 ), r8val - - CHARACTER ptidc*16 - -C*---------------------------------------------------------------------- - - print *, '----------------------------------------------------' - print *, 'testing BUFRLIB: writing OUT_6' - print *, ' using OPENMG and UFBSTP' - print *, ' storing integer values larger than 32 bits' - print *, '----------------------------------------------------' - -#ifdef INTSIZE_8 - CALL SETIM8B ( .true. ) -#endif - -C* Open the BUFR table and output file. - - OPEN ( UNIT = 11, FILE = 'out6.bufr', FORM ='UNFORMATTED') - OPEN ( UNIT = 12, FILE = 'testfiles/OUT_6_bufrtab' ) - - CALL OPENBF ( 11, 'OUT', 12 ) - print *, ' OPENBF' - - CALL OPENMG ( 11, 'F5FCMESG', 2021022312 ) - print *, ' OPENMG' - CALL MINIMG ( 11, 55 ) - print *, ' MINIMG' - -C* Store the subset data. - - r8wind ( 1, 1 ) = 290. - r8wind ( 2, 1 ) = 6.5 - print *, ' UFBINT' - CALL UFBINT ( 11, r8wind, 2, 1, nlv, 'WDIR WSPD' ) - - r8val = 17. - CALL SETVALNB ( 11, 'WDIR', 1, 'HOUR', 1, r8val, iersvb ) - r8val = 16. - CALL SETVALNB ( 11, 'TMDB', 1, 'HOUR', -1, r8val, iersvb ) - print *, ' SETVALNB' - - r8dbss ( 1, 1 ) = 1.0 - r8dbss ( 2, 1 ) = 34.1 - r8dbss ( 3, 1 ) = 284.7 - r8dbss ( 4, 1 ) = 5.0653 - r8dbss ( 1, 2 ) = 2.5 - r8dbss ( 2, 2 ) = 34.1 - r8dbss ( 3, 2 ) = 284.8 - r8dbss ( 4, 2 ) = 5.066 - r8dbss ( 1, 3 ) = 4.0 - r8dbss ( 2, 3 ) = 34.2 - r8dbss ( 3, 3 ) = 284.6 - r8dbss ( 4, 3 ) = 5.0644 - CALL UFBSTP ( 11, r8dbss, 4, 3, nlv, 'DBSS SALN SST1 WCON' ) - print *, ' UFBSTP' - - r8f5fc ( 1, 1 ) = 0.08593800 - r8f5fc ( 2, 1 ) = 0.00390625 - r8f5fc ( 3, 1 ) = 32.50110000_8 - r8f5fc ( 4, 1 ) = 0.8883 - r8f5fc ( 5, 1 ) = -0.3818 - r8f5fc ( 6, 1 ) = 0.6140 - r8f5fc ( 7, 1 ) = -0.6438 - r8f5fc ( 8, 1 ) = 3.11 - r8f5fc ( 1, 2 ) = 0.08984400 - r8f5fc ( 2, 2 ) = 0.00390625 - r8f5fc ( 3, 2 ) = 26.45480000_8 - r8f5fc ( 4, 2 ) = 0.8795 - r8f5fc ( 5, 2 ) = -0.4412 - r8f5fc ( 6, 2 ) = 0.5909 - r8f5fc ( 7, 2 ) = -0.7761 - r8f5fc ( 8, 2 ) = 3.12 - r8f5fc ( 1, 3 ) = 0.09375000 - r8f5fc ( 2, 3 ) = 0.00390625 - r8f5fc ( 3, 3 ) = 41.96410000_8 - r8f5fc ( 4, 3 ) = 0.9124 - r8f5fc ( 5, 3 ) = -0.3137 - r8f5fc ( 6, 3 ) = 0.7302 - r8f5fc ( 7, 3 ) = -0.5316 - r8f5fc ( 8, 3 ) = 3.13 - r8f5fc ( 1, 4 ) = 0.09765600 - r8f5fc ( 2, 4 ) = 0.00390625 - r8f5fc ( 3, 4 ) = 28.98830000_8 - r8f5fc ( 4, 4 ) = 0.8917 - r8f5fc ( 5, 4 ) = -0.3020 - r8f5fc ( 6, 4 ) = 0.7413 - r8f5fc ( 7, 4 ) = -0.4804 - r8f5fc ( 8, 4 ) = 3.14 - r8f5fc ( 1, 5 ) = 0.10156300 - r8f5fc ( 2, 5 ) = 0.00390628 - r8f5fc ( 3, 5 ) = 11.71090000_8 - r8f5fc ( 4, 5 ) = 0.8273 - r8f5fc ( 5, 5 ) = -0.2884 - r8f5fc ( 6, 5 ) = 0.4968 - r8f5fc ( 7, 5 ) = -0.4184 - r8f5fc ( 8, 5 ) = 3.15 - CALL DRFINI ( 11, 5, 1, '{F5FCRSEQ}' ) - print *, ' DRFINI' - CALL UFBSEQ ( 11, r8f5fc, 8, 5, nlv, 'F5FCRSEQ' ) - print *, ' UFBSEQ' - - CALL WRITSB ( 11 ) - print *, ' WRITSB' - - ptidc = '300534061608630' - CALL WRITLC ( 11, ptidc, 'PTIDC' ) - print *, ' WRITLC' - - CALL CLOSBF ( 11 ) - print *, ' CLOSBF' - - STOP - END diff --git a/test/test_OUT_7.F90 b/test/test_OUT_7.F90 deleted file mode 100644 index 37effe1e..00000000 --- a/test/test_OUT_7.F90 +++ /dev/null @@ -1,144 +0,0 @@ -! This is a test for NCEPLIBS-bufr. -! -! This tests a number of library routines and functionality -! involved in writing output BUFR messages, as noted in the -! comments and print statements below. -! -! Jeff Ator - -program test_OUT_7 - -#ifdef INTSIZE_8 - integer*4 ireadmg, icopysb -#endif - - character cmgtag*8 - - integer imesg(10), isub(3) - - real*8 r8vals(2,5) - -!----------------------------------------------------------------------- - - print *, '----------------------------------------------------' - print *, 'testing BUFRLIB: writing OUT_7' - print *, ' using UFBMEX, UFBRMS, UFBMMS, CPYMEM, and ICOPYSB' - print *, ' using FORTRAN_OPEN and FORTRAN_CLOSE' - print *, ' reading integer values larger than 32 bits' - print *, '----------------------------------------------------' - -#ifdef INTSIZE_8 - call setim8b ( .true. ) -#endif - -! Open the input and output files. - - call fortran_open ( 'testfiles/OUT_7_infile1', 21, 'unformatted', 'rewind', iostat1 ) - call fortran_open ( 'testfiles/OUT_7_infile2', 22, 'unformatted', 'rewind', iostat2 ) - - if ( ( iostat1 == 0 ) .and. ( iostat2 == 0 ) ) then - print *, ' FORTRAN_OPEN' - else - call bort ( 'FORTRAN_OPEN FAILURE!!') - end if - - open ( unit = 23, file = 'testfiles/OUT_7_bufrtab') - - open ( unit = 50, file = 'out7.bufr', form = 'unformatted') - call openbf ( 50, 'OUT', 23 ) - -! Read the input files into internal memory arrays. - - call ufbmex ( 21, 23, 0, icnt1, imesg ) - call ufbmex ( 22, 23, 1, icnt2, imesg ) - - if ( ( icnt1 == 1 ) .and. ( icnt2 == 3 ) .and. & - ( imesg(1) == 5 ) .and. ( imesg(2) == 8 ) .and. ( imesg(3) == 2 ) .and. ( imesg(4) == 0 ) ) then - print *, ' UFBMEX' - else - call bort ( 'UFBMEX FAILURE!!') - end if - -! Check some specified values within the 1st subset of the 4th message. - - call ufbrms ( 4, 1, r8vals, 2, 5, nlv, 'SWDE A2CFDFS' ) - - if ( ( nlv == 5 ) .and. & - ( nint(r8vals(1,1)*10000000) == 325011000 ) .and. ( nint(r8vals(1,2)*10000000) == 264548000 ) .and. & - ( nint(r8vals(1,3)*10000000) == 419641000 ) .and. ( nint(r8vals(1,4)*10000000) == 289883000 ) .and. & - ( nint(r8vals(1,5)*10000000) == 117109000 ) .and. ( nint(r8vals(2,1)*10000) == 6140 ) .and. & - ( nint(r8vals(2,2)*10000) == 5909 ) .and. ( nint(r8vals(2,3)*10000) == 7302 ) .and. & - ( nint(r8vals(2,4)*10000) == 7413 ) .and. ( nint(r8vals(2,5)*10000) == 4968 ) ) then - print *, ' UFBRMS' - else - call bort ( 'UFBRMS FAILURE!!') - end if - -! Check some specified values within the 633rd subset of the 2nd message. - - call ufbmms ( 2, 633, cmgtag, idate ) - - call ufbint ( 21, r8vals, 2, 5, nlv, 'CLATH CLONH' ) - - if ( ( cmgtag == 'NC008032' ) .and. ( idate == 22053116 ) .and. ( nlv == 1 ) .and. & - ( nint(r8vals(1,1)*100000) == 4081139 ) .and. ( nint(r8vals(2,1)*100000) == -7787666 ) ) then - print *, ' UFBMMS' - else - call bort ( 'UFBMMS FAILURE!!') - end if - -! Copy the 3rd message to the output file. - - call rdmemm ( 3, cmgtag, idate, ier ) - - if ( ( ier == 0 ) .and. ( cmgtag == 'NC002104' ) ) then - call cpymem ( 50 ) - print *, ' CPYMEM' - end if - -! Stop using the internal memory arrays, and instead now re-open the 1st input file as a regular file and -! read the 1st message. - - call closbf ( 21 ) - call fortran_open ( 'testfiles/OUT_7_infile1', 21, 'unformatted', 'rewind', iostat ) - call openbf ( 21, 'IN', 23 ) - if ( ireadmg ( 21, cmgtag, idate ) /= 0 ) call bort ( 'IREADMG FAILURE!!' ) - -! Open a new output message, then copy subsets #115, 288, and 530 from the 1st message to that output message. - - call openmg ( 50, 'NC005067', 22060102 ) - - isub(1) = 115 - isub(2) = 288 - isub(3) = 530 - - istart = 1 - do ii = 1, 3 - do while ( istart < isub(ii) ) - ! calling copysb (or icopysb) with the 2nd argument negative prevents writing to that output file, but - ! the read pointer in the input (1st argument) file is still advanced to the next subset - call copysb ( 21, -50, ier ) - istart = istart + 1 - end do - if ( ( icopysb ( 21, 50 ) ) /= 0 ) call bort ( 'ICOPYSB FAILURE!!' ) - istart = istart + 1 - end do - - print *, ' ICOPYSB' - -! Close the input and output files. - - call fortran_close ( 21, iostat1 ) - call fortran_close ( 22, iostat2 ) - - if ( ( iostat1 == 0 ) .and. ( iostat2 == 0 ) ) then - print *, ' FORTRAN_CLOSE' - else - call bort ( 'FORTRAN_CLOSE FAILURE!!') - end if - - call closbf ( 50 ) - - stop - -end program test_OUT_7 diff --git a/test/test_scripts/test_outtest.sh b/test/test_scripts/test_outtest.sh new file mode 100755 index 00000000..121e4e8f --- /dev/null +++ b/test/test_scripts/test_outtest.sh @@ -0,0 +1,30 @@ +#!/bin/bash + +# This is a test script for NCEPLIBS-bufr, to run each outtest executable and verify its output. +# +# Jeff Ator 2023-02-23 + +testID=$1 +num=$2 + +# run the executable + +cmd="./${testID}" +echo ${cmd} +eval ${cmd} +exit_code=$? +if test "${exit_code}" != "0"; then + exit ${exit_code} +fi + +# verify the output + +cmd="cmp -s out${num}.bufr testfiles/OUT_${num}" +echo ${cmd} +eval ${cmd} +exit_code=$? +if test "${exit_code}" != "0"; then + exit ${exit_code} +fi + +echo 'SUCCESS!' diff --git a/test/test_scripts/test_wrapper_IN.sh b/test/test_scripts/test_wrapper_IN.sh deleted file mode 100755 index 77b7e1f0..00000000 --- a/test/test_scripts/test_wrapper_IN.sh +++ /dev/null @@ -1,19 +0,0 @@ -#!/bin/bash -# This is a test for NCEPLIBS-bufr. -# Test script to run each test_IN code and verify its output. -# Jeff Ator 2022-02-18 - -set -eu - -exename=${1} - -outfile=$(echo ${exename} | cut -d. -f1).out - -cmd="./${exename} > ${outfile}" -eval ${cmd} -exit_code=$? -if test "${exit_code}" == "0"; then # cmd ran successfully - exit `grep -ic FAILED ${outfile}` # confirm all tests completed successfully -else - exit ${exit_code} # cmd did not run successfully -fi diff --git a/test/test_scripts/test_wrapper_OUT.sh b/test/test_scripts/test_wrapper_OUT.sh deleted file mode 100755 index bd5eda2e..00000000 --- a/test/test_scripts/test_wrapper_OUT.sh +++ /dev/null @@ -1,59 +0,0 @@ -#!/bin/bash -# This is a test for NCEPLIBS-bufr. -# Test script to run each test_OUT code and verify its output. -# Jeff Ator 2022-02-18 - -exename=$1 -preAPX=${2:-"NO"} - -testname=$(echo $exename | cut -d. -f1) -refname=$(echo $testname | cut -c6-10) -outname=$(echo ${refname//_} | tr '[:upper:]' '[:lower:]') - -# preAPX -if [[ ${preAPX} =~ [YyTt] ]]; then - echo "" - echo "===============================================================================" - echo "Copying test data" - echo "===============================================================================" - - cmd="cp testfiles/${refname}_preAPX ./${outname}.bufr" - echo ${cmd} - eval ${cmd} -fi - -# run the executable -echo "" -echo "===============================================================================" -echo "Running test executable" -echo "===============================================================================" - -cmd="./${exename}" -echo ${cmd} -eval ${cmd} -exit_code=$? -if test "${exit_code}" == "0"; then - echo -e "Test run succeed" -else - echo -e "Test run failed with error code: ${exit_code} \n" - exit ${exit_code} -fi - -# run compare -echo "" -echo "===============================================================================" -echo "Running comparison" -echo "===============================================================================" - -cmd="cmp -s ${outname}.bufr testfiles/${refname}" -echo ${cmd} -eval ${cmd} -exit_code=$? -if test "${exit_code}" == "0"; then - echo -e "Test compare succeed" -else - echo -e "Test compare failed with error code: ${exit_code}" - exit ${exit_code} -fi - -echo -e "PASSED"