Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Added test, renamed existing tests to F90, improved documentation #176

Merged
merged 4 commits into from
Feb 28, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
26 changes: 12 additions & 14 deletions src/r63w72.f
Original file line number Diff line number Diff line change
@@ -1,10 +1,10 @@
C> @file
C> @brief Convert w3fi63 parms to w3fi72 parms.
C> @brief Convert w3fi63() parms to w3fi72() parms.
C> @author Mark Iredell @date 1992-10-31

C> determines the integer pds and gds parameters
C> for the grib1 packing routine w3fi72 given the parameters
C> returned from the grib1 unpacking routine w3fi63.
C> Determines the integer PDS and GDS parameters
C> for the GRIB1 packing routine w3fi72() given the parameters
C> returned from the GRIB1 unpacking routine w3fi63().
C>
C> Program history log:
C> - Mark Iredell 1991-10-31
Expand All @@ -14,20 +14,18 @@
C> - Chris Caruso 1998-06-01 Y2K fix for year of century
C> - Diane Stoken 2005-05-06 Recognize level 236
C>
C> Usage: call r63w72(kpds,kgds,ipds,igds)
C>
C> @param[in] kpds integer (200) pds parameters from w3fi63
C> @param[in] kgds integer (200) gds parameters from w3fi63
C> @param[out] ipds integer (200) pds parameters for w3fi72
C> @param[out] igds integer (200) gds parameters for w3fi72
C>
C> @note kgds and igds extend beyond their dimensions here
C> if pl parameters are present.
C>
C> @param[in] kpds integer (200) PDS parameters from w3fi63().
C> @param[in] kgds integer (200) GDS parameters from w3fi63().
C> @param[out] ipds integer (200) PDS parameters for w3fi72().
C> @param[out] igds integer (200) GDS parameters for w3fi72().
C>
C> @author Mark Iredell @date 1992-10-31
SUBROUTINE R63W72(KPDS,KGDS,IPDS,IGDS)
DIMENSION KPDS(200),KGDS(200),IPDS(200),IGDS(200)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

C DETERMINE PRODUCT DEFINITION SECTION (PDS) PARAMETERS
IF(KPDS(23).NE.2) THEN
IPDS(1)=28 ! LENGTH OF PDS
Expand Down Expand Up @@ -70,7 +68,7 @@ SUBROUTINE R63W72(KPDS,KGDS,IPDS,IGDS)
IPDS(26)=0 ! PDS BYTE 29
IPDS(27)=0 ! PDS BYTE 30
ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

C DETERMINE GRID DEFINITION SECTION (GDS) PARAMETERS
IGDS(1)=KGDS(19) ! NUMBER OF VERTICAL COORDINATES
IGDS(2)=KGDS(20) ! VERTICAL COORDINATES
Expand Down Expand Up @@ -113,6 +111,6 @@ SUBROUTINE R63W72(KPDS,KGDS,IPDS,IGDS)
IGDS(18+J)=KGDS(21+J)
ENDDO
ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

RETURN
END
33 changes: 9 additions & 24 deletions src/w3fi74.f
Original file line number Diff line number Diff line change
@@ -1,33 +1,18 @@
C> @file
C> @brief CONSTRUCT GRID DEFINITION SECTION (GDS)
C> @brief Construct Grid Definition Section (GDS).
C> @author M. Farley @date 1992-07-07

C> This subroutine constructs a grib grid definition section.
C> This subroutine constructs a GRIB grid definition section.
C>
C> Program history log:
C> - M. Farley 1992-07-07
C> - Ralph Jones 1992-10-16 Add code to lat/lon section to do
C> gaussian grids.
C> - Ralph Jones 1993-03-29 Add save statement
C> - Ralph Jones 1993-08-24 Changes for grib grids 37-44
C> - Ralph Jones 1993-09-29 Changes for gaussian grid for document
C> change in w3fi71().
C> - Ralph Jones 1994-02-15 Changes for eta model grids 90-93
C> - Ralph Jones 1995-04-20 Change 200 and 201 to 201 and 202
C> - Mark Iredell 1995-10-31 Removed saves and prints
C> - M. Baldwin 1998-08-20 Add type 203
C> - Boi Vuong 2007-03-20 Add type 204
C> - George Gayno 2010-01-21 Add grid 205 - rotated lat/lon a,b,c,d staggers
C> @note Subprogram can be called from a multiprocessing environment.
C>
C> @param[in] IGDS Integer array supplied by w3fi71()
C> @param[in] IGDS Integer array supplied by w3fi71().
C> @param[in] ICOMP Table 7- resolution & component flag (bit 5)
C> for gds(17) wind components
C> @param[out] GDS Completed grib grid definition section
C> @param[out] LENGDS Length of gds
C> @param[out] NPTS Number of points in grid
C> @param[out] IGERR 1, grid representation type not valid
C>
C> @note Subprogram can be called from a multiprocessing environment.
C> for gds(17) wind components.
C> @param[out] GDS Completed grib grid definition section.
C> @param[out] LENGDS Length of gds.
C> @param[out] NPTS Number of points in grid.
C> @param[out] IGERR 1, grid representation type not valid.
C>
C> @author M. Farley @date 1992-07-07
SUBROUTINE W3FI74 (IGDS,ICOMP,GDS,LENGDS,NPTS,IGERR)
Expand Down
3 changes: 2 additions & 1 deletion tests/CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@ if(BUILD_D)

# This function builds and runs a test.
function(w3emc_test name)
add_executable(${name} ${name}.f90)
add_executable(${name} ${name}.F90)
target_link_libraries(${name} PRIVATE w3emc_d)
add_test(NAME ${name} COMMAND ${name})
endfunction()
Expand All @@ -16,4 +16,5 @@ if(BUILD_D)
w3emc_test(test_summary)
w3emc_test(test_w3tagb)
w3emc_test(test_w3fi71)
w3emc_test(test_w3fi74)
endif()
File renamed without changes.
File renamed without changes.
44 changes: 44 additions & 0 deletions tests/test_w3fi74.F90
Original file line number Diff line number Diff line change
@@ -0,0 +1,44 @@
! This is a test in the NCEPLIBS-w3emc project.
!
! Test the w3fi74() function.
!
! Ed Hartnett, 2/28/23
program test_w3fi74
implicit none
integer igrid
integer igds(200)
integer icomp
integer npts
character*1 gds(200)
integer lengds
integer ierr
integer i
character expected_gds(32)
expected_gds(:) = (/ char(0), char(0), char(32), char(0), &
char(255), char(5), char(2), char(178), char(2), &
char(198), char(128), char(144), char(35), char(131), &
char(92), char(34), char(0), char(129), char(56), &
char(128), char(0), char(49), char(156), char(0), &
char(49), char(156), char(128), char(64), char(0), &
char(0), char(0), char(0) /)

print *, "Testing w3fi74..."

! Fill the igds array. This call comes from test_w3fi71.F90.
igrid = 172
call w3fi71(igrid, igds, ierr)
if (ierr .ne. 0) stop 1

! Fill the igds array. This call comes from w3if72.f.
icomp = 0
npts = 4
call w3fi74(igds, icomp, gds, lengds, npts, ierr)
if (ierr .ne. 0) stop 1
if (lengds .ne. 32 .or. npts .ne. 489900) stop 2
do i = 1, 32
if (gds(i) .ne. expected_gds(i)) stop 4
!print *,'char(', ichar(gds(i)), '), '
end do

print *, "SUCCESS"
end program test_w3fi74
File renamed without changes.