Skip to content

Commit

Permalink
adding test for tocgrib2 (#336)
Browse files Browse the repository at this point in the history 
* turned off some test code

* extra large file degri2 test

* extra large file degri2 test

* turned off some tests

* attempting tocgrib2 fix

* attempting tocgrib2 fix

* attempting tocgrib2 fix

* preparing for release

* yea!

* adjusting ci to new g2 version

* fixing tests

* adding test

* working on tocgrib2 testing

* more work on tocgrib2 testing

* more tocgrib2 testing

* working on tocgrib2 testing

* fixed test
  • Loading branch information
@edwardhartnett
edwardhartnett authored May 28, 2024
1 parent c408fea commit d777b3d
Show file tree
Hide file tree
Showing 6 changed files with 786 additions and 80 deletions.
27 changes: 13 additions & 14 deletions src/tocgrib/tocgrib.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -61,29 +61,28 @@ PROGRAM tocgrib

LOGICAL IW3PDS

HEXPDS=0
LUGB=11
LUGI=31
LUGO=51

! GET PARM FIELD WITH UP TO 100 CHARACTERS
! Parm field should contain the originating center part of
! the WMO Header.
HEXPDS = 0
LUGB = 11
LUGI = 31
LUGO = 51

! Get parm field with up to 100 characters. Parm field should
! contain the originating center part of the WMO Header.
CPARM = ' '
KWBX = 'KWBC'
CALL W3AS00(NPARM,CPARM,IER)
IF (IER.EQ.0) THEN
IF (NPARM.EQ.0.OR.CPARM(1:4).EQ.' ') THEN
CALL W3AS00(NPARM, CPARM, IER)
IF (IER .EQ. 0) THEN
IF (NPARM .EQ. 0 .OR. CPARM(1:4) .EQ. ' ') THEN
PRINT *,'THERE IS A PARM FIELD BUT IT IS EMPTY'
PRINT *,'OR BLANK, I WILL USE THE DEFAULT KWBC'
ELSE
KWBX(1:4) = CPARM(1:4)
END IF
ELSE IF (IER.EQ.2.OR.IER.EQ.3) THEN
PRINT *,'W3AS00 ERROR = ',IER
ELSE IF (IER .EQ. 2 .OR. IER .EQ. 3) THEN
PRINT *,'W3AS00 ERROR = ', IER
PRINT *,'THERE IS NO PARM FIELD, I USED DEFAULT KWBC'
ELSE
PRINT *,'W3AS00 ERROR = ',IER
PRINT *,'W3AS00 ERROR = ', IER
END IF
PRINT *,'NPARM = ',NPARM
PRINT *,'CPARM = ',CPARM(1:4)
Expand Down
130 changes: 66 additions & 64 deletions src/tocgrib2/tocgrib2.F90
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
!> @file
!> @brief Create new GRIB2 file with fields from an existing GRIB2 file.
!> @brief Create new GRIB2 file with fields from an existing GRIB2
!> file, with a TOC Flag Field separator block and WMO header.
!> @author Stephen Gilbert @date 2004-05-17

!> Program reads selected GRIB2 fields from a file, adds a TOC Flag
Expand All @@ -12,16 +13,16 @@
!> @note The "EXTRACT" variable in the namelist allows users to choose
!> whether they want the entire GRIB2 message containing the requested
!> field (extract=.false.), OR a GRIB2 message containing only the
!> requested field (extract=.true.). Both options return the same
!> requested field (extract=.true.). Both options return the same
!> message if the requested field is the only field in the GRIB2
!> message.
!>
!> ### Input Files
!> ## Input Files
!> - 5 namelist of grib fields and associated wmo headers.
!> - 11 input grib2 file.
!> - 31 corresponding input grib2 index file.
!>
!> ### Output Files (Including Scratch Files)
!> ## Output Files (Including Scratch Files)
!> - 6 standard fortran print file
!> - 51 output grib bulletin file in toc format
!>
Expand All @@ -33,30 +34,31 @@
!> - 30 - Some bulletins are missing
!>
!> @author Stephen Gilbert @date 2004-05-17
!> @author Alex Richert, Edward Hartnett
PROGRAM tocgrib2
use grib_mod
use pdstemplates
use gridtemplates
integer,dimension(200) :: IDS,GDT,PDT
integer :: DSCPL,GDTN,PDTN
integer :: nbul,nrec,mbul,dayofmonth,hourofday
integer,parameter :: lenhead=21,jrew=0
integer, dimension(200) :: IDS, GDT, PDT
integer :: DSCPL, GDTN, PDTN
integer :: nbul, nrec, mbul, dayofmonth, hourofday
integer, parameter :: lenhead=21, jrew=0

CHARACTER * 6 BULHED
CHARACTER * 80 DESC,WMOHEAD
CHARACTER * 200 fileb,filei,fileo
CHARACTER * 80 DESC, WMOHEAD
CHARACTER * 200 fileb, filei, fileo
CHARACTER * 6 envvar
CHARACTER * 4 KWBX
CHARACTER * 1 CSEP(80)
CHARACTER * 1 WMOHDR(lenhead)
character(len=1),pointer,dimension(:) :: gribm
character(len=1), pointer, dimension(:) :: gribm

logical :: extract=.false.
integer idxver
integer (kind = 8) :: itot8

interface
subroutine getgb2p2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
subroutine getgb2p2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt, &
extract, idxver, k, gribm, leng8, iret)
integer, intent(in) :: lugb, lugi, j, jdisc
integer, dimension(:) :: jids(*)
Expand All @@ -74,7 +76,7 @@ end subroutine getgb2p2
end interface
NAMELIST /GRIBIDS/DSCPL,IDS,GDTN,GDT,PDTN,PDT,DESC,WMOHEAD,EXTRACT

CALL W3TAGB('tocgrib2',2012,0916,0083,'NP11')
CALL W3TAGB('tocgrib2', 2012, 0916, 0083, 'NP11')

lugb=11 ! Input GRIB2 File
lugi=31 ! Input GRIB2 INdex File
Expand All @@ -83,34 +85,34 @@ end subroutine getgb2p2
! Read GRIB2 data and index file names from the FORT_nn
! environment variables, and open the files.
envvar='FORT '
write(envvar(5:6),fmt='(I2)') lugb
call getenv(envvar,fileb)
write(envvar(5:6),fmt='(I2)') lugi
call getenv(envvar,filei)
write(envvar(5:6), fmt='(I2)') lugb
call getenv(envvar, fileb)
write(envvar(5:6), fmt='(I2)') lugi
call getenv(envvar, filei)

call baopenr(lugb,fileb,iret1)
call baopenr(lugb, fileb, iret1)
if (iret1 .ne. 0) then
write(6,fmt='(" Error opening GRIB file: ",A200)') fileb
write(6,fmt='(" baopenr error = ",I5)') iret1
write(6, fmt='(" Error opening GRIB file: ", A200)') fileb
write(6, fmt='(" baopenr error = ", I5)') iret1
stop 10
endif

! Open GRIB2 index file. If doesn't open, use just the data
! file.
call baopenr(lugi,filei,iret2)
call baopenr(lugi, filei, iret2)
if (iret2 .ne. 0) then
lugi=0
endif

! Read output GRIB bulletin file name from FORTnn
! environment variable, and open file.
write(envvar(5:6),fmt='(I2)') lugo
call getenv(envvar,fileo)
call baopenw(lugo,fileo,iret1)
write(envvar(5:6), fmt='(I2)') lugo
call getenv(envvar, fileo)
call baopenw(lugo, fileo, iret1)
if (iret1 .ne. 0) then
write(6,fmt='(" Error opening output transmission file: ", &
write(6, fmt='(" Error opening output transmission file: ", &
A200)') fileo
write(6,fmt='(" baopenw error = ",I5)') iret1
write(6, fmt='(" baopenw error = ", I5)') iret1
stop 20
endif

Expand All @@ -130,69 +132,69 @@ end subroutine getgb2p2
WMOHEAD='TTAAnn CCCC'
EXTRACT=.false.

READ (*,GRIBIDS,iostat=ios,end=999)
READ (*, GRIBIDS, iostat=ios, end=999)
nrec = nrec + 1
if (ios .ne. 0) then
write(6,fmt='(" Error reading PDS from input file. iostat = " &
,i5)') ios
write(6, fmt='(" Error reading PDS from input file. iostat = " &
, i5)') ios
cycle
endif

! Echo input record
WRITE(6,FMT='(/,''***********************************'', &
WRITE(6, FMT='(/, ''***********************************'', &
''********************************************'')')
write(6,'(A,I0)') ' Start new record no. = ',nrec
write(6,'(73A)') ' DESC=',DESC(1:73)
write(6,'(11A)') ' WMOHEAD=',WMOHEAD(1:11)
write(6,'(A,I0)') ' GRIB2 DISCIPLINE= ',DSCPL
write(6,'(A,20(1x,I0))')' Section 1=', &
(IDS(j2),j2=1,13)
write(6, '(A, I0)') ' Start new record no. = ', nrec
write(6, '(73A)') ' DESC=', DESC(1:73)
write(6, '(11A)') ' WMOHEAD=', WMOHEAD(1:11)
write(6, '(A, I0)') ' GRIB2 DISCIPLINE= ', DSCPL
write(6, '(A, 20(1x, I0))')' Section 1=', &
(IDS(j2), j2=1, 13)
if (GDTN .ne. -1) then
write(6,'(A,I0,A,100(1x,I0))') ' GDT 3. ',GDTN,' =', &
(GDT(j2),j2=1,getgdtlen(GDTN))
write(6, '(A, I0, A, 100(1x, I0))') ' GDT 3. ', GDTN, ' =', &
(GDT(j2), j2=1, getgdtlen(GDTN))
endif
if (PDTN .ne. -1) then
write(6,'(A,I0,A,100(1x,I0))') ' PDT 4. ',PDTN,' =', &
(PDT(j2),j2=1,getpdtlen(PDTN))
write(6, '(A, I0, A, 100(1x, I0))') ' PDT 4. ', PDTN, ' =', &
(PDT(j2), j2=1, getpdtlen(PDTN))
endif

! Read and return packed GRIB field
idxver = 2
CALL GETGB2P2(lugb,lugi,jrew,DSCPL,IDS,PDTN,PDT, &
GDTN,GDT,extract,idxver,KREW,gribm,itot8,iret)
CALL GETGB2P2(lugb, lugi, jrew, DSCPL, IDS, PDTN, PDT, &
GDTN, GDT, extract, idxver, KREW, gribm, itot8, iret)
itot = int(itot8, kind(4))
IF (IRET.NE.0) THEN
IF (IRET.EQ.96)WRITE(6,'(A)')' GETGB2P: ERROR READING INDEX' &
IF (IRET.EQ.96)WRITE(6, '(A)')' GETGB2P: ERROR READING INDEX' &
//' FILE'
IF (IRET.EQ.97)WRITE(6,'(A)')' GETGB2P: ERROR READING GRIB' &
IF (IRET.EQ.97)WRITE(6, '(A)')' GETGB2P: ERROR READING GRIB' &
//' FILE'
IF (IRET.EQ.99)WRITE(6,'(A)')' GETGB2P: ERROR REQUEST NOT' &
IF (IRET.EQ.99)WRITE(6, '(A)')' GETGB2P: ERROR REQUEST NOT' &
//' FOUND'
cycle
END IF
WRITE (6,'(A,1x,I0)')' RECORD NO. OF GRIB RECORD IN INPUT ' &
WRITE (6, '(A, 1x, I0)')' RECORD NO. OF GRIB RECORD IN INPUT ' &
//'FILE = ', KREW
!
WRITE (6,'(A,I0)')' Size of GRIB Field = ',itot
WRITE (6, '(A, I0)')' Size of GRIB Field = ', itot

! MAKE Flag Field Separator block
iopt=2
insize=19
call mkfldsep(csep,iopt,insize,itot+lenhead,lenout)
! WRITE(6,'(A,80A)')' csep = ',csep
call mkfldsep(csep, iopt, insize, itot+lenhead, lenout)
! WRITE(6, '(A, 80A)')' csep = ', csep

! MAKE WMO HEADER
dayofmonth=mova2i(gribm(16+16))
hourofday=mova2i(gribm(16+17))
CALL MAKWMO (WMOHEAD(1:6),dayofmonth,hourofday, &
WMOHEAD(8:11),WMOHDR)
! WRITE(6,'(21A)') ' WMOHEADER= ',WMOHDR
CALL MAKWMO (WMOHEAD(1:6), dayofmonth, hourofday, &
WMOHEAD(8:11), WMOHDR)
! WRITE(6, '(21A)') ' WMOHEADER= ', WMOHDR

! write out Separator block, Abbreviated WMO Heading,
! write out Separator block, Abbreviated WMO Heading,
! and GRIB2 field to output file.
call wryte(lugo,lenout,csep)
call wryte(lugo,lenhead,WMOHDR)
call wryte(lugo,itot,gribm)
call wryte(lugo, lenout, csep)
call wryte(lugo, lenhead, WMOHDR)
call wryte(lugo, itot, gribm)
nbul=nbul+1
if (associated(gribm)) then
deallocate(gribm)
Expand All @@ -203,23 +205,23 @@ end subroutine getgb2p2

! CLOSING SECTION
999 if (nbul .EQ. 0) then
WRITE (6,FMT='('' SOMETHING WRONG WITH DATA CARDS...'', &
WRITE (6, FMT='('' SOMETHING WRONG WITH DATA CARDS...'', &
''NOTHING WAS PROCESSED'')')
! CALL W3TAGE('tocgrib2')
stop 19
else
call baclose (LUGB,iret)
call baclose (LUGI,iret)
call baclose (LUGO,iret)
WRITE (6,FMT='(//,'' ******** RECAP OF THIS EXECUTION '', &
''********'',/,5X,''READ '',I6,'' INDIVIDUAL IDS'', &
/,5X,''WROTE '',I6,'' BULLETINS OUT FOR TRANSMISSION'', &
call baclose (LUGB, iret)
call baclose (LUGI, iret)
call baclose (LUGO, iret)
WRITE (6, FMT='(//, '' ******** RECAP OF THIS EXECUTION '', &
''********'', /, 5X, ''READ '', I6, '' INDIVIDUAL IDS'', &
/, 5X, ''WROTE '', I6, '' BULLETINS OUT FOR TRANSMISSION'', &
//)') nrec, NBUL
endif
! TEST TO SEE IF ANY BULLETINS MISSING
mbul = nrec - nbul
IF (mbul .ne. 0) THEN
WRITE(6,'(A,1X,I0)')' BULLETINS MISSING = ',mbul
WRITE(6, '(A, 1X, I0)')' BULLETINS MISSING = ', mbul
! CALL W3TAGE('tocgrib2')
stop 30
END IF
Expand Down
9 changes: 7 additions & 2 deletions tests/CMakeLists.txt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -72,6 +72,8 @@ gu_copy_test_data(ref_gdaswave.t00z.wcoast.0p16.f000_2.grib2.idx)
gu_copy_test_data(ref_gfs.landmask.grib1)
gu_copy_test_data(ref_grid_172.landmask.grib1)
gu_copy_test_data(ref_grid_220.landmask.grib1)
gu_copy_test_data(tocgrib2.nml)
gu_copy_test_data(tocgrib2_bad.nml)
if(FTP_TEST_FILES)
gu_copy_test_data(ref_blend.t19z.core.f001.co.grib2.degrib2)
gu_copy_test_data(ref_cmc_geavg.t12z.pgrb2a.0p50.f000.degrib2)
Expand All @@ -90,8 +92,8 @@ if(FTP_TEST_FILES)
gu_copy_test_data(ref_fv3lam.t00z.prslev.f000.grib2.degrib2)
endif()
if(FTP_EXTRA_TEST_FILES)
# gu_copy_test_data(ref_rrfs.t12z.prslevfaa.f010.na3km.grib2.degrib2)
gu_copy_test_data(ref_GFSPRS.GrbF06.degrib2)
gu_copy_test_data(ref_rrfs.t12z.prslevfaa.f010.na3km.grib2.degrib2)
gu_copy_test_data(ref_rrfs.t18z.prslev.f000.grib2.degrib2)
gu_copy_test_data(ref_grib2.awips.rrfs.010)
endif()
Expand Down Expand Up @@ -128,7 +130,9 @@ if(FTP_TEST_FILES)
rap.t00z.awp130pgrbf00.grib2
seaice.t00z.grb.grib2
sgx_nwps_CG3_20221117_1200.grib2
aqm.t12z.max_8hr_o3.227.grib2)
aqm.t12z.max_8hr_o3.227.grib2
rrfs.t12z.prslevfaa.f010.na3km.grib2
)
foreach(THE_FILE IN LISTS FTP_TEST_FILES)
PULL_DATA(${G2_FTP_URL} ${THE_FILE})
endforeach()
Expand Down Expand Up @@ -165,5 +169,6 @@ if(FTP_TEST_FILES)
endif()
if(FTP_EXTRA_TEST_FILES)
gu_test(run_degrib2_extra_file_tests)
gu_test(run_tocgrib2_tests)
endif()
endif()
Loading

0 comments on commit d777b3d

Please sign in to comment.