diff --git a/src/r63w72.f b/src/r63w72.f index 05895c8f..8c369982 100644 --- a/src/r63w72.f +++ b/src/r63w72.f @@ -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 @@ -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 @@ -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 @@ -113,6 +111,6 @@ SUBROUTINE R63W72(KPDS,KGDS,IPDS,IGDS) IGDS(18+J)=KGDS(21+J) ENDDO ENDIF -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + RETURN END diff --git a/src/w3fi74.f b/src/w3fi74.f index cc3f3a83..c68c29a7 100644 --- a/src/w3fi74.f +++ b/src/w3fi74.f @@ -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) diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index e9067d7d..762a7e83 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -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() @@ -16,4 +16,5 @@ if(BUILD_D) w3emc_test(test_summary) w3emc_test(test_w3tagb) w3emc_test(test_w3fi71) + w3emc_test(test_w3fi74) endif() diff --git a/tests/test_summary.f90 b/tests/test_summary.F90 similarity index 100% rename from tests/test_summary.f90 rename to tests/test_summary.F90 diff --git a/tests/test_w3fi71.f90 b/tests/test_w3fi71.F90 similarity index 100% rename from tests/test_w3fi71.f90 rename to tests/test_w3fi71.F90 diff --git a/tests/test_w3fi74.F90 b/tests/test_w3fi74.F90 new file mode 100644 index 00000000..37ac14b9 --- /dev/null +++ b/tests/test_w3fi74.F90 @@ -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 diff --git a/tests/test_w3tagb.f90 b/tests/test_w3tagb.F90 similarity index 100% rename from tests/test_w3tagb.f90 rename to tests/test_w3tagb.F90