From 08284c2e8ce1fc568c22332ac3721e0358aae11a Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Mon, 3 Jan 2022 06:22:26 -0700 Subject: [PATCH 1/7] adding test --- tests/run_cnvgrib_tests.sh | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/tests/run_cnvgrib_tests.sh b/tests/run_cnvgrib_tests.sh index e45211fd..44031e3c 100755 --- a/tests/run_cnvgrib_tests.sh +++ b/tests/run_cnvgrib_tests.sh @@ -14,7 +14,11 @@ echo "*** Running cnvgrib test" ../src/wgrib/wgrib test_gdaswave.t00z.wcoast.0p16.f000.grib1 &> test_gdaswave.t00z.wcoast.0p16.f000.grib1.inventory.txt # Check against expected output. -cmp test_gdaswave.t00z.wcoast.0p16.f000.grib1.inventory.txt ref_gdaswave_grib1_inventory.txt +cmp test_gdaswave.t00z.wcoast.0p16.f000.grib1.inventory.txt ref_gdaswave_grib1_inventory.txt + +# Convert GRIB1 output back to GRIB2. +../src/cnvgrib/cnvgrib -g12 test_gdaswave.t00z.wcoast.0p16.f000.grib1 test_gdaswave.t00z.wcoast.0p16.f000.grib2 + echo "*** SUCCESS!" exit 0 From fb30737b914a2e4e7cff5c35c94b8938ce5fa693 Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Mon, 3 Jan 2022 06:26:32 -0700 Subject: [PATCH 2/7] removed unneeded installs from CI workflow --- .github/workflows/build_and_test.yml | 2 -- 1 file changed, 2 deletions(-) diff --git a/.github/workflows/build_and_test.yml b/.github/workflows/build_and_test.yml index 52664b64..d2074a07 100644 --- a/.github/workflows/build_and_test.yml +++ b/.github/workflows/build_and_test.yml @@ -12,8 +12,6 @@ jobs: - name: install-dependencies run: | sudo apt-get update &> /dev/null - sudo apt-get install libmpich-dev - sudo apt-get install libnetcdf-dev libnetcdff-dev netcdf-bin pkg-config sudo apt-get install libpng-dev sudo apt-get install libjpeg-dev doxygen python3 -m pip install gcovr From 75444a616cb82365c174814c778cefe694b658dc Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Mon, 3 Jan 2022 06:47:43 -0700 Subject: [PATCH 3/7] more testing --- tests/CMakeLists.txt | 1 + .../ref_gdaswave.t00z.wcoast.0p16.f000.grib2.idx | Bin 0 -> 4456 bytes tests/run_cnvgrib_tests.sh | 6 ++++++ 3 files changed, 7 insertions(+) create mode 100644 tests/ref_gdaswave.t00z.wcoast.0p16.f000.grib2.idx diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 8ce44819..a5dc82a1 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -29,6 +29,7 @@ gu_copy_test_data(ref_gdaswave_grib1_inventory.txt) gu_copy_test_data(ref_gdaswave.grb2index.idx) gu_copy_test_data(ref_gdaswave.grbindex.grib1.idx) gu_copy_test_data(ref_gdaswave_2.grib1.idx) +gu_copy_test_data(ref_gdaswave.t00z.wcoast.0p16.f000.grib2.idx) # Run these shell tests. gu_test(run_cnvgrib_tests) diff --git a/tests/ref_gdaswave.t00z.wcoast.0p16.f000.grib2.idx b/tests/ref_gdaswave.t00z.wcoast.0p16.f000.grib2.idx new file mode 100644 index 0000000000000000000000000000000000000000..9271eb9ed5efe68ada593ee14caabd4fbecf6923 GIT binary patch literal 4456 zcmd6qO-vI(6oB8%(iU1o(4dJiy7dnuvhFTFA}CM`rH~M{C&Wa4q&CEe2n{7B#vVj5 z8Z}1cVvI3{a3L{XH1Wd0lXx^9J($SN1djd$d^7#o?u6ZP+Vmx}GqXE0ec!zI=5_p? zp>TV|FUy*oE)BY@tGZsJYBg%DtTr^&)i>2^a_4EitCtPpqM~Hltd5Nj=_8}V(J3zu z3Z04cG^M|4xEz-{{X`va)av!e8)Z2jorw3xh6g7SgOgDuuBtbb#HDM46LCcy(;Ae^ z_ybC8d}PQA06(x~ERLRY$wzB1SNuV=hyx@p^MQj))6nt2-l~WH`XH6!W3!vH$ zQb1-spuY3~-UI0(uoVcK>2~2VP_e`nLc-=mY7AHqo}Y1$5b_hYCb_<}!c2Gva0jx4 zxbFtx)66be5XPLeA9Hs5@Hy}kz4V+xSngtpKYP;9%5i(b>QLbj9=?KvuTnM?2m=No#-WL@?Snnx zfoTT`-8o*${(uQy%HlA%o4*&%QZi={ZZV%UG6N&4<#j6??+I)xsfUaTt)fzEmLWG6;9LNcsl+AG%xJ ASpWb4 literal 0 HcmV?d00001 diff --git a/tests/run_cnvgrib_tests.sh b/tests/run_cnvgrib_tests.sh index 44031e3c..70d5ac0e 100755 --- a/tests/run_cnvgrib_tests.sh +++ b/tests/run_cnvgrib_tests.sh @@ -19,6 +19,12 @@ cmp test_gdaswave.t00z.wcoast.0p16.f000.grib1.inventory.txt ref_gdaswave_grib1_i # Convert GRIB1 output back to GRIB2. ../src/cnvgrib/cnvgrib -g12 test_gdaswave.t00z.wcoast.0p16.f000.grib1 test_gdaswave.t00z.wcoast.0p16.f000.grib2 +# Create an index of a GRIB2 file. +../src/grb2index/grb2index test_gdaswave.t00z.wcoast.0p16.f000.grib2 test_gdaswave.t00z.wcoast.0p16.f000.grib2.idx + +# Check against expected output. First 120 bytes contain differences, +# so ignore them. +cmp -i 120 test_gdaswave.t00z.wcoast.0p16.f000.grib2.idx ref_gdaswave.t00z.wcoast.0p16.f000.grib2.idx echo "*** SUCCESS!" exit 0 From 210b7f8f7ac59ae294849f9c5751711019efe24c Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Mon, 3 Jan 2022 06:53:58 -0700 Subject: [PATCH 4/7] more testing --- tests/CMakeLists.txt | 1 + ...ef_gdaswave.t00z.wcoast.0p16.f000_2.grib2.idx | Bin 0 -> 4456 bytes tests/run_cnvgrib_tests.sh | 10 ++++++++++ 3 files changed, 11 insertions(+) create mode 100644 tests/ref_gdaswave.t00z.wcoast.0p16.f000_2.grib2.idx diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index a5dc82a1..50594f9b 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -30,6 +30,7 @@ gu_copy_test_data(ref_gdaswave.grb2index.idx) gu_copy_test_data(ref_gdaswave.grbindex.grib1.idx) gu_copy_test_data(ref_gdaswave_2.grib1.idx) gu_copy_test_data(ref_gdaswave.t00z.wcoast.0p16.f000.grib2.idx) +gu_copy_test_data(ref_gdaswave.t00z.wcoast.0p16.f000_2.grib2.idx) # Run these shell tests. gu_test(run_cnvgrib_tests) diff --git a/tests/ref_gdaswave.t00z.wcoast.0p16.f000_2.grib2.idx b/tests/ref_gdaswave.t00z.wcoast.0p16.f000_2.grib2.idx new file mode 100644 index 0000000000000000000000000000000000000000..b54be1eb27e62dc4464b79f961bd4d0691160cdf GIT binary patch literal 4456 zcmc)NO-K|`902hDd*iygYn%3Uh^X19EX`?V{3Xh&-- zsOy%VUK(uOHf_7cv}(*+-E3&8x0@_WZ$E5zcF{sCOcI%Wx*Z%jYhM`Z9~kwKLeXQf zqfP0v7P%dZI{QE!+o`o1%|=~M48#*XgZ+K+WZ%^RBVn4?jO4k?eer~04qFYzdGZH6 zwlO&31AuR2$;3{wbBQeX$ubMDZh~w{gpwElk)4eQyZ{&>?|1)JdWQbkp^??SN_tpK zS7OYQ!zY=a@SoqQvKw6~6I~x|3H*4U0zBbo3n{U^h!(>LgP&~aoztsDx=X|I08|G- z3+waQHb*kKWdC9*I}=^4!`VS&jdgr42`)c)K(#U+)ERdg{PE46nN__ ztZc(R)*xKyhp-A^_#Mj^mx`@4q!!lG;edvs4vmK{3jO)(u=QYyW-Hg>3>W&ukp}gT z(F;f@gl$0=g}(g4=;UUaEe?ovc!vwiB;oWVy?}&5xNXrzp~qRc{vT*9vn*Swm7-@{ zD9sk=(<^p`Qn;_jMPW&nko6vv8R_|acs!R-yQLN`kfD-=q7IFzLJF}UteWF>SR%I4 z6I@vCp%ee|e26RGI18(zg%oOnaQ8(be8KX?k}%ALq#p{x*e_?{j&T=-#aXSCzJP() zN@+igY*`YDZ*6Fb3)hGv4Nk_Lh1Opeg{4_SML&#u$R*TXa$!IcP7gT?oA(w{xUwHc zW^xLXT Date: Mon, 3 Jan 2022 07:05:15 -0700 Subject: [PATCH 5/7] whitespace cleanup of cnvgrib.F90 --- src/cnvgrib/cnvgrib.F90 | 214 ++++++++++++++++++++-------------------- 1 file changed, 107 insertions(+), 107 deletions(-) diff --git a/src/cnvgrib/cnvgrib.F90 b/src/cnvgrib/cnvgrib.F90 index 0dd39406..ff0e8867 100755 --- a/src/cnvgrib/cnvgrib.F90 +++ b/src/cnvgrib/cnvgrib.F90 @@ -28,29 +28,29 @@ !> @author Stephen Gilbert @date 2003-06-06 program cnvgrib - integer :: inver=0,outver=0,ipack=-1 - character(len=500) :: gfilein,gfileout,copt - character(len=2) :: master_table_ver,curmastertab_ver - INTEGER(4) NARG,IARGC, table_ver, mastertab - logical :: usemiss=.false., uvvect=.true. + integer :: inver = 0, outver = 0, ipack = -1 + character(len = 500) :: gfilein, gfileout, copt + character(len = 2) :: master_table_ver, curmastertab_ver + INTEGER(4) NARG, IARGC, table_ver, mastertab + logical :: usemiss = .false., uvvect = .true. ! ! Set current Master table version 2 ! - curmastertab_ver='2' - table_ver=2 - mastertab=21 ! WMO GRIB2 version 21 (released in May 2, 2018) + curmastertab_ver = '2' + table_ver = 2 + mastertab = 21 ! WMO GRIB2 version 21 (released in May 2, 2018) ! GET ARGUMENTS - NARG=IARGC() + NARG = IARGC() IF(NARG.lt.3) THEN ! may be a problem with args - IF(NARG.eq.0) THEN + IF(NARG .eq. 0) THEN !CALL ERRMSG('cnvgrib: Incorrect usage') call usage(0) CALL ERREXIT(2) ELSE ! look for -h "help" option - do j=1,NARG - call getarg(j,copt) - if (copt.eq.'-h' .or. copt.eq.'-help') then + do j = 1, NARG + call getarg(j, copt) + if (copt .eq. '-h' .or. copt .eq. '-help') then call usage(1) CALL ERREXIT(0) endif @@ -59,110 +59,110 @@ program cnvgrib CALL ERREXIT(2) ENDIF ELSE - j=1 + j = 1 do while (j.le.NARG-2) ! parse first narg-2 args - call getarg(j,copt) - j=j+1 + call getarg(j, copt) + j = j+1 selectcase(copt) case('-g12') - inver=1 - outver=2 + inver = 1 + outver = 2 case('-g21') - inver=2 - outver=1 + inver = 2 + outver = 1 case('-g22') - inver=2 - outver=2 + inver = 2 + outver = 2 case('-p0') - ipack=0 + ipack = 0 case('-p2') - ipack=2 + ipack = 2 case('-p31') - ipack=31 + ipack = 31 case('-p32') - ipack=32 + ipack = 32 case('-p40') - ipack=40 + ipack = 40 case('-p41') - ipack=41 + ipack = 41 case('-p40000') ! Obsolete - ipack=40000 + ipack = 40000 case('-p40010') ! Obsolete - ipack=40010 + ipack = 40010 case('-m') - usemiss=.true. - imiss=1 + usemiss = .true. + imiss = 1 case('-m0') - usemiss=.true. - imiss=0 + usemiss = .true. + imiss = 0 case('-nv') - uvvect=.false. + uvvect = .false. case('-mastertable_ver_1') - table_ver=1 - master_table_ver='1' + table_ver = 1 + master_table_ver = '1' case('-mastertable_ver_2') - table_ver=2 - master_table_ver='2' + table_ver = 2 + master_table_ver = '2' case('-mastertable_ver_3') - table_ver=3 - master_table_ver='3' + table_ver = 3 + master_table_ver = '3' case('-mastertable_ver_4') - table_ver=4 - master_table_ver='4' + table_ver = 4 + master_table_ver = '4' case('-mastertable_ver_5') - table_ver=5 - master_table_ver='5' + table_ver = 5 + master_table_ver = '5' case('-mastertable_ver_6') - table_ver=6 - master_table_ver='6' + table_ver = 6 + master_table_ver = '6' case('-mastertable_ver_7') - table_ver=7 - master_table_ver='7' + table_ver = 7 + master_table_ver = '7' case('-mastertable_ver_8') - table_ver=8 - master_table_ver='8' + table_ver = 8 + master_table_ver = '8' case('-mastertable_ver_9') - table_ver=9 - master_table_ver='9' + table_ver = 9 + master_table_ver = '9' case('-mastertable_ver_10') - table_ver=10 - master_table_ver='10' + table_ver = 10 + master_table_ver = '10' case('-mastertable_ver_11') - table_ver=11 - master_table_ver='11' + table_ver = 11 + master_table_ver = '11' case('-mastertable_ver_12') - table_ver=12 - master_table_ver='12' + table_ver = 12 + master_table_ver = '12' case('-mastertable_ver_13') - table_ver=13 - master_table_ver='13' + table_ver = 13 + master_table_ver = '13' case('-mastertable_ver_14') - table_ver=14 - master_table_ver='14' + table_ver = 14 + master_table_ver = '14' case('-mastertable_ver_15') - table_ver=15 - master_table_ver='15' + table_ver = 15 + master_table_ver = '15' case('-mastertable_ver_16') - table_ver=16 - master_table_ver='16' + table_ver = 16 + master_table_ver = '16' case('-mastertable_ver_17') - table_ver=17 - master_table_ver='17' + table_ver = 17 + master_table_ver = '17' case('-mastertable_ver_18') - table_ver=18 - master_table_ver='18' + table_ver = 18 + master_table_ver = '18' case('-mastertable_ver_19') - table_ver=19 - master_table_ver='19' + table_ver = 19 + master_table_ver = '19' case('-mastertable_ver_20') - table_ver=20 - master_table_ver='20' + table_ver = 20 + master_table_ver = '20' case('-mastertable_ver_21') - table_ver=21 - master_table_ver='21' + table_ver = 21 + master_table_ver = '21' case('-mastertable_ver_22') - table_ver=22 - master_table_ver='22' + table_ver = 22 + master_table_ver = '22' case default call usage(0) CALL ERREXIT(2) @@ -184,18 +184,18 @@ program cnvgrib ! ! get filenames from last two arguments ! - CALL GETARG(NARG-1,gfilein) - CALL GETARG(NARG,gfileout) + CALL GETARG(NARG-1, gfilein) + CALL GETARG(NARG, gfileout) ! ! If -p option specified, must be writing out grib2 ! - if ((ipack.ne.-1).and.(outver.eq.1)) then + if ((ipack .ne. -1).and.(outver .eq. 1)) then CALL ERRMSG('cnvgrib: -pxx option ignored when using -g21') endif ! ! Must have -g option ! - if ((inver.eq.0).or.(outver.eq.0)) then + if ((inver .eq. 0).or.(outver .eq. 0)) then CALL ERRMSG('cnvgrib: must use one -gxx option') call usage(0) CALL ERREXIT(2) @@ -204,28 +204,28 @@ program cnvgrib ! If -m or -m0 option specified, must be writing out grib2 ! and using DRT 5.2 or 5.3 ! - if ((usemiss).and.(ipack.ne.2 .AND. ipack.ne.31 .AND. & - ipack.ne.32)) then + if ((usemiss).and.(ipack .ne. 2 .AND. ipack .ne. 31 .AND. & + ipack .ne. 32)) then CALL ERRMSG('cnvgrib: -m or -m0 option ignored when not '// & 'using -p2, -p31 or -p32.') - usemiss=.false. + usemiss = .false. endif ENDIF ! ! Open input and output grib files ! -IFL1=10 -IFL2=50 -NCGB=LEN_TRIM(gfilein) -CALL BAOPENR(ifl1,gfilein(1:NCGB),IOS) -if (IOS.NE.0) then +IFL1 = 10 +IFL2 = 50 +NCGB = LEN_TRIM(gfilein) +CALL BAOPENR(ifl1, gfilein(1:NCGB), IOS) +if (IOS .NE. 0) then call errmsg('cnvgrib: cannot open input GRIB file '// & gfilein(1:NCGB)) call errexit(3) endif -NCGB=LEN_TRIM(gfileout) -CALL BAOPENW(ifl2,gfileout(1:NCGB),IOS) -if (IOS.NE.0) then +NCGB = LEN_TRIM(gfileout) +CALL BAOPENW(ifl2, gfileout(1:NCGB), IOS) +if (IOS .NE. 0) then call errmsg('cnvgrib: cannot open output GRIB file '// & gfileout(1:NCGB)) call errexit(4) @@ -233,21 +233,21 @@ program cnvgrib ! ! convert grib file ! -if ((inver.eq.1).AND.(outver.eq.2)) then - call cnv12(ifl1,ifl2,ipack,usemiss,imiss,uvvect, table_ver) -elseif ((inver.eq.2).AND.(outver.eq.1)) then - call cnv21(ifl1,ifl2) -elseif ((inver.eq.2).AND.(outver.eq.2)) then - call cnv22(ifl1,ifl2,ipack,usemiss,imiss,table_ver) +if ((inver .eq. 1).AND.(outver .eq. 2)) then + call cnv12(ifl1, ifl2, ipack, usemiss, imiss, uvvect, table_ver) +elseif ((inver .eq. 2).AND.(outver .eq. 1)) then + call cnv21(ifl1, ifl2) +elseif ((inver .eq. 2).AND.(outver .eq. 2)) then + call cnv22(ifl1, ifl2, ipack, usemiss, imiss, table_ver) else - print *,' Unknown conversion option.' + print *, ' Unknown conversion option.' call errexit(5) endif ! ! close grib files ! -CALL BACLOSE(ifl1,IOS) -CALL BACLOSE(ifl2,IOS) +CALL BACLOSE(ifl1, IOS) +CALL BACLOSE(ifl2, IOS) stop end program @@ -259,10 +259,10 @@ program cnvgrib !> !> @author Stephen Gilbert @date 2003-06-06 subroutine usage(iopt) -character(len=15) :: cnvgrib_ver="cnvgrib-v3.1.1" -integer,intent(in) :: iopt +character(len = 15) :: cnvgrib_ver = "cnvgrib-v3.1.1" +integer, intent(in) :: iopt -if (iopt.eq.0) then +if (iopt .eq. 0) then call errmsg (' ') call errmsg('Usage: cnvgrib [-h] {-g12|-g21|-g22} [-m|-m0]'// & ' [-nv] [-mastertable_ver_x]') @@ -274,7 +274,7 @@ subroutine usage(iopt) call errmsg (' ') endif -if (iopt.eq.1) then +if (iopt .eq. 1) then call errmsg (' ') call errmsg('cnvgrib: version '//cnvgrib_ver) call errmsg (' ') From 26be362e31b9da7154d09c32a16e9f5bb9f2248f Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Mon, 3 Jan 2022 07:11:00 -0700 Subject: [PATCH 6/7] whitespace cleanup --- src/cnvgrib/cnv12.F90 | 420 +++++++++++++++++++++--------------------- 1 file changed, 210 insertions(+), 210 deletions(-) diff --git a/src/cnvgrib/cnv12.F90 b/src/cnvgrib/cnv12.F90 index 6d802efd..8613de37 100755 --- a/src/cnvgrib/cnv12.F90 +++ b/src/cnvgrib/cnv12.F90 @@ -13,7 +13,7 @@ !> 2003-05-19 | Gilbert | Changed Master Table Version Number from 1 to 2. Added check for grib1 table version with params 191 and 192 for ensemble probs. !> 2007-03-26 | Gordon | Added check for ECMWF data to reference ECMWF Conversion tables. !> 2007-10-11 | Vuong | Added check for ensemble probs if the kpds > 28 -!> 2008-01-28 | Vuong | Fixed the V-GRD BY SETTING THE LPDS(22)=-1 and increase the array size MAXPTS +!> 2008-01-28 | Vuong | Fixed the V-GRD BY SETTING THE LPDS(22) = -1 and increase the array size MAXPTS !> 2008-05-14 | Vuong | Add option -m0 No explicit missing values included within data values !> 2010-12-02 | Vuong | Changed Master Table Version Number from 2 to 6. - Add option -mastertable_ver_x where x is mater table version 2 to 10 !> 2011-07-22 | Vuong | Changed variable kprob(1) to kpds(5) in calling routine param_g1_to_g2 @@ -44,316 +44,316 @@ !> @param table_ver Master Table version where x is number from 2 to 10. !> !> @author Stephen Gilbert @date 2003-06-11 -subroutine cnv12(ifl1,ifl2,ipack,usemiss,imiss,uvvect,table_ver) +subroutine cnv12(ifl1, ifl2, ipack, usemiss, imiss, uvvect, table_ver) use params use params_ecmwf - integer,intent(in) :: ifl1,ifl2,ipack - logical,intent(in) :: usemiss,uvvect + integer, intent(in) :: ifl1, ifl2, ipack + logical, intent(in) :: usemiss, uvvect - PARAMETER (MAXPTS=40000000,msk1=32000) - CHARACTER(len=1),allocatable,dimension(:) :: cgrib,cgribin - integer KPDS(200),KGDS(200),KPTR(200) - integer LPDS(200),LGDS(200),KENS(200),LENS(200) - integer KPROB(2),KCLUST(16),KMEMBR(80) + PARAMETER (MAXPTS = 40000000, msk1 = 32000) + CHARACTER(len = 1), allocatable, dimension(:) :: cgrib, cgribin + integer KPDS(200), KGDS(200), KPTR(200) + integer LPDS(200), LGDS(200), KENS(200), LENS(200) + integer KPROB(2), KCLUST(16), KMEMBR(80) real XPROB(2) - real,allocatable,dimension(:) :: FLD - real,allocatable,dimension(:) :: FLDV - real,allocatable,dimension(:) :: coordlist - integer :: listsec0(2)=(/0,2/),imiss - integer :: listsec1(13)=(/7,0,2,1,1,0,0,0,0,0,0,0,0/) - integer :: ideflist(MAXPTS),idefnum - integer :: igds(5)=(/0,0,0,0,0/),igdstmpl(200),ipdstmpl(200) + real, allocatable, dimension(:) :: FLD + real, allocatable, dimension(:) :: FLDV + real, allocatable, dimension(:) :: coordlist + integer :: listsec0(2) = (/0, 2/), imiss + integer :: listsec1(13) = (/7, 0, 2, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0/) + integer :: ideflist(MAXPTS), idefnum + integer :: igds(5) = (/0, 0, 0, 0, 0/), igdstmpl(200), ipdstmpl(200) integer :: ipdstmplv(200) - integer :: idrstmpl(200),idrstmplv(200) - integer :: currlen=0, table_ver - integer,parameter :: mingrib=500 - logical :: ensemble,ecmwf - Logical*1,allocatable,dimension(:) :: bmp,bmpv + integer :: idrstmpl(200), idrstmplv(200) + integer :: currlen = 0, table_ver + integer, parameter :: mingrib = 500 + logical :: ensemble, ecmwf + Logical*1, allocatable, dimension(:) :: bmp, bmpv ! - ICND=0 - IFLI1=0 + ICND = 0 + IFLI1 = 0 allocate(fld(maxpts)) allocate(coordlist(maxpts)) allocate(bmp(maxpts)) listsec1(3) = table_ver ! - iseek=0 + iseek = 0 do - call skgb(ifl1,iseek,msk1,lskip,lgrib) - if (lgrib.eq.0) exit ! end loop at EOF or problem + call skgb(ifl1, iseek, msk1, lskip, lgrib) + if (lgrib .eq. 0) exit ! end loop at EOF or problem if (lgrib.gt.currlen) then if (allocated(cgribin)) deallocate(cgribin) - allocate(cgribin(lgrib),stat=is) - currlen=lgrib - lcgrib=lgrib*2 - if (lcgrib .lt. mingrib) lcgrib=mingrib + allocate(cgribin(lgrib), stat = is) + currlen = lgrib + lcgrib = lgrib*2 + if (lcgrib .lt. mingrib) lcgrib = mingrib if (allocated(cgrib)) deallocate(cgrib) - allocate(cgrib(lcgrib),stat=is) + allocate(cgrib(lcgrib), stat = is) endif - call baread(ifl1,lskip,lgrib,lengrib,cgribin) - if (lgrib.eq.lengrib) then - call w3fi63(cgribin,KPDS,KGDS,BMP,FLD,KPTR,IRET) - numpts=KPTR(10) - if (iret.ne.0) then - print *,' cnvgrib: Error unpacking GRIB field.',iret - iseek=lskip+lgrib + call baread(ifl1, lskip, lgrib, lengrib, cgribin) + if (lgrib .eq. lengrib) then + call w3fi63(cgribin, KPDS, KGDS, BMP, FLD, KPTR, IRET) + numpts = KPTR(10) + if (iret .ne. 0) then + print *, ' cnvgrib: Error unpacking GRIB field.', iret + iseek = lskip+lgrib cycle endif else - print *,' cnvgrib: IO Error on input GRIB file.' + print *, ' cnvgrib: IO Error on input GRIB file.' cycle endif - iseek=lskip+lgrib - !print *,'kpds:',kpds(1:28) - !print *,'kpds:',kpds(1:45) - if ((kpds(5).eq.34).AND.uvvect) cycle ! V-comp already processed with U - listsec1(1)=kpds(1) - listsec1(2)=kpds(23) - listsec1(5)=1 - if (kpds(16).eq.1) listsec1(5)=0 - listsec1(6)=((kpds(21)-1)*100)+kpds(8) - listsec1(7)=kpds(9) - listsec1(8)=kpds(10) - listsec1(9)=kpds(11) - listsec1(10)=kpds(12) - listsec1(13)=1 - if (kpds(16).eq.1) listsec1(13)=0 - ensemble=.false. - if ((kpds(23).eq.2) .or. & - (kptr(3).gt.28 .and. kpds(19).eq.2 .and. & - (kpds(5).eq.191.or.kpds(5).eq.192))) then ! ensemble forecast - ensemble=.true. + iseek = lskip+lgrib + !print *, 'kpds:', kpds(1:28) + !print *, 'kpds:', kpds(1:45) + if ((kpds(5) .eq. 34).AND.uvvect) cycle ! V-comp already processed with U + listsec1(1) = kpds(1) + listsec1(2) = kpds(23) + listsec1(5) = 1 + if (kpds(16) .eq. 1) listsec1(5) = 0 + listsec1(6) = ((kpds(21)-1)*100)+kpds(8) + listsec1(7) = kpds(9) + listsec1(8) = kpds(10) + listsec1(9) = kpds(11) + listsec1(10) = kpds(12) + listsec1(13) = 1 + if (kpds(16) .eq. 1) listsec1(13) = 0 + ensemble = .false. + if ((kpds(23) .eq. 2) .or. & + (kptr(3).gt.28 .and. kpds(19) .eq. 2 .and. & + (kpds(5) .eq. 191 .or. kpds(5) .eq. 192))) then ! ensemble forecast + ensemble = .true. endif if (ensemble) then ! ensemble forecast - call gbyte(cgribin(9),ilast,0,24) - call pdseup(kens,kprob,xprob,kclust,kmembr,ilast,cgribin(9)) - if (kens(2).eq.1) listsec1(13)=3 - if (kens(2).eq.2.OR.kens(2).eq.3) listsec1(13)=4 - if (kens(2).eq.5) listsec1(13)=5 + call gbyte(cgribin(9), ilast, 0, 24) + call pdseup(kens, kprob, xprob, kclust, kmembr, ilast, cgribin(9)) + if (kens(2) .eq. 1) listsec1(13) = 3 + if (kens(2) .eq. 2 .OR. kens(2) .eq. 3) listsec1(13) = 4 + if (kens(2) .eq. 5) listsec1(13) = 5 endif - ecmwf=.false. - if (kpds(1).eq.98) ecmwf=.true. + ecmwf = .false. + if (kpds(1) .eq. 98) ecmwf = .true. if (ecmwf) then ! treat ecmwf data conversion seperately - call param_ecmwf_g1_to_g2(kpds(5),kpds(19),listsec0(1),idum, & + call param_ecmwf_g1_to_g2(kpds(5), kpds(19), listsec0(1), idum, & jdum) ! set discipline else - if (ensemble.and.(kpds(5).eq.191.or.kpds(5).eq.192).and. & - kpds(19).eq.2) then - !kprob(1)=61 - call param_g1_to_g2(kprob(1),kpds(19),listsec0(1),idum, & + if (ensemble.and.(kpds(5) .eq. 191 .or. kpds(5) .eq. 192).and. & + kpds(19) .eq. 2) then + !kprob(1) = 61 + call param_g1_to_g2(kprob(1), kpds(19), listsec0(1), idum, & jdum) ! set discipline else - call param_g1_to_g2(kpds(5),kpds(19),listsec0(1),idum, & + call param_g1_to_g2(kpds(5), kpds(19), listsec0(1), idum, & jdum) ! set discipline endif endif - call gribcreate(cgrib,lcgrib,listsec0,listsec1,ierr) - if (ierr.ne.0) then - write(6,*) ' ERROR creating new GRIB2 field = ',ierr + call gribcreate(cgrib, lcgrib, listsec0, listsec1, ierr) + if (ierr .ne. 0) then + write(6, *) ' ERROR creating new GRIB2 field = ', ierr cycle endif ! ! convert grid info - call gds2gdt(kgds,igds,igdstmpl,idefnum,ideflist,ierr) - if (ierr.ne.0) then + call gds2gdt(kgds, igds, igdstmpl, idefnum, ideflist, ierr) + if (ierr .ne. 0) then cycle endif - if (listsec1(1) .eq. 7) igdstmpl(1)=6 ! FOR NWS/NCEP - if ((listsec1(1) .eq. 7 .and. igds(5).eq.20 & ! For Snow Cover Analysis - .and. kpds(2).eq.25) .and. & ! Polar Stereographic Grid - (kpds(5).eq.91 .or. kpds(5).eq.238)) then - igdstmpl(1)=2 + if (listsec1(1) .eq. 7) igdstmpl(1) = 6 ! FOR NWS/NCEP + if ((listsec1(1) .eq. 7 .and. igds(5) .eq. 20 & ! For Snow Cover Analysis + .and. kpds(2) .eq. 25) .and. & ! Polar Stereographic Grid + (kpds(5) .eq. 91 .or. kpds(5) .eq. 238)) then + igdstmpl(1) = 2 end if - call addgrid(cgrib,lcgrib,igds,igdstmpl,200,ideflist, & - idefnum,ierr) - if (ierr.ne.0) then - write(6,*) ' ERROR adding GRIB2 grid = ',ierr + call addgrid(cgrib, lcgrib, igds, igdstmpl, 200, ideflist, & + idefnum, ierr) + if (ierr .ne. 0) then + write(6, *) ' ERROR adding GRIB2 grid = ', ierr cycle endif ! set PDS Template if (ensemble) then ! ensemble forecast - call pds2pdtens(kpds,kens,kprob,xprob,kclust,kmembr, & - ipdsnum,ipdstmpl,numcoord,coordlist,ierr) + call pds2pdtens(kpds, kens, kprob, xprob, kclust, kmembr, & + ipdsnum, ipdstmpl, numcoord, coordlist, ierr) else - call pds2pdt(kpds,ipdsnum,ipdstmpl,numcoord,coordlist,ierr) + call pds2pdt(kpds, ipdsnum, ipdstmpl, numcoord, coordlist, ierr) endif - if (ierr.ne.0) then + if (ierr .ne. 0) then cycle endif ! set bitmap flag - idrstmpl=0 - if (btest(kpds(4),6)) then - ibmap=0 - !fld=pack(fld,mask=bmp(1:numpts)) - !itemp=count(bmp(1:numpts)) - !numpts=itemp + idrstmpl = 0 + if (btest(kpds(4), 6)) then + ibmap = 0 + !fld = pack(fld, mask = bmp(1:numpts)) + !itemp = count(bmp(1:numpts)) + !numpts = itemp ! ! convert bitmap to "missing" values, if requested. ! - if ((usemiss) .AND. (ipack.eq.2 .OR. ipack.eq.31 .OR. & - ipack.eq.32)) then - ibmap=255 - rmiss=minval(fld(1:numpts)) + if ((usemiss) .AND. (ipack .eq. 2 .OR. ipack .eq. 31 .OR. & + ipack .eq. 32)) then + ibmap = 255 + rmiss = minval(fld(1:numpts)) if (rmiss .lt. -9999.0) then - rmiss=rmiss*10.0 + rmiss = rmiss*10.0 else - rmiss=-9999.0 + rmiss = -9999.0 endif - do i=1,numpts + do i = 1, numpts if (.NOT. bmp(i)) then - fld(i)=rmiss - bmp(i)=.true. + fld(i) = rmiss + bmp(i) = .true. endif enddo - idrstmpl(7)=imiss ! Missing value management - call mkieee(rmiss,idrstmpl(8),1) + idrstmpl(7) = imiss ! Missing value management + call mkieee(rmiss, idrstmpl(8), 1) endif else - ibmap=255 - idrstmpl(7)=0 ! No missing values + ibmap = 255 + idrstmpl(7) = 0 ! No missing values endif ! Set DRT info (packing info) - if (ipack.eq.0) then - idrsnum=0 - elseif (ipack.eq.2) then - idrsnum=2 - idrstmpl(6)=1 ! general group split - elseif (ipack.eq.31.OR.ipack.eq.32) then - idrsnum=ipack/10 - idrstmpl(6)=1 ! general group split - idrstmpl(17)=mod(ipack,10) ! order of s.d. - elseif (ipack.eq.40 .OR. ipack.eq.41 .OR. & - ipack.eq.40000 .OR. ipack.eq.40010) then - idrsnum=ipack - idrstmpl(6)=0 - idrstmpl(7)=255 - !idrstmpl(6)=1 - !idrstmpl(7)=15 + if (ipack .eq. 0) then + idrsnum = 0 + elseif (ipack .eq. 2) then + idrsnum = 2 + idrstmpl(6) = 1 ! general group split + elseif (ipack .eq. 31 .OR. ipack .eq. 32) then + idrsnum = ipack/10 + idrstmpl(6) = 1 ! general group split + idrstmpl(17) = mod(ipack, 10) ! order of s.d. + elseif (ipack .eq. 40 .OR. ipack .eq. 41 .OR. & + ipack .eq. 40000 .OR. ipack .eq. 40010) then + idrsnum = ipack + idrstmpl(6) = 0 + idrstmpl(7) = 255 + !idrstmpl(6) = 1 + !idrstmpl(7) = 15 else - idrsnum=3 - idrstmpl(17)=1 ! order of s.d. - idrstmpl(6)=1 ! general group split - if (kpds(5).eq.61) idrsnum=2 + idrsnum = 3 + idrstmpl(17) = 1 ! order of s.d. + idrstmpl(6) = 1 ! general group split + if (kpds(5) .eq. 61) idrsnum = 2 endif - idrstmpl(2)=KPTR(19) ! binary scale - idrstmpl(3)=kpds(22) ! decimal scale - !idrstmpl(2)=-4 ! binary scale - !idrstmpl(3)=0 ! decimal scale - call addfield(cgrib,lcgrib,ipdsnum,ipdstmpl,200, & - coordlist,numcoord,idrsnum,idrstmpl,200, & - fld,numpts,ibmap,bmp,ierr) - ! print *,'done with addfield' - if (ierr.ne.0) then - write(6,*) ' ERROR adding GRIB2 field = ',ierr + idrstmpl(2) = KPTR(19) ! binary scale + idrstmpl(3) = kpds(22) ! decimal scale + !idrstmpl(2) = -4 ! binary scale + !idrstmpl(3) = 0 ! decimal scale + call addfield(cgrib, lcgrib, ipdsnum, ipdstmpl, 200, & + coordlist, numcoord, idrsnum, idrstmpl, 200, & + fld, numpts, ibmap, bmp, ierr) + ! print *, 'done with addfield' + if (ierr .ne. 0) then + write(6, *) ' ERROR adding GRIB2 field = ', ierr cycle endif - if ((kpds(5).eq.33) .AND. uvvect) then + if ((kpds(5) .eq. 33) .AND. uvvect) then if (.not.allocated(fldv)) allocate(fldv(maxpts)) if (.not.allocated(bmpv)) allocate(bmpv(maxpts)) - LGDS=KGDS - LENS=KENS - LPDS=KPDS - LPDS(22)=-1 - LPDS(5)=34 - jsrch=0 - CALL GETGBE(IFL1,IFLI1,MAXPTS,jsrch,LPDS,LGDS,LENS,NUMPTSO, & - jsrch,KPDS,KGDS,KENS,BMPV,FLDV,ICND) - if (icnd.ne.0) then - write(6,*) ' ERROR READING/UNPACKING GRIB1 V = ',icnd + LGDS = KGDS + LENS = KENS + LPDS = KPDS + LPDS(22) = -1 + LPDS(5) = 34 + jsrch = 0 + CALL GETGBE(IFL1, IFLI1, MAXPTS, jsrch, LPDS, LGDS, LENS, NUMPTSO, & + jsrch, KPDS, KGDS, KENS, BMPV, FLDV, ICND) + if (icnd .ne. 0) then + write(6, *) ' ERROR READING/UNPACKING GRIB1 V = ', icnd exit endif - ipdstmplv=ipdstmpl + ipdstmplv = ipdstmpl if (ecmwf) then ! treat ecmwf data conversion seperately - ! print *,' param_ecmwf call 2' - call param_ecmwf_g1_to_g2(kpds(5),kpds(19),idum, & - ipdstmplv(1),ipdstmplv(2)) - ! print *,' done with call 2' + ! print *, ' param_ecmwf call 2' + call param_ecmwf_g1_to_g2(kpds(5), kpds(19), idum, & + ipdstmplv(1), ipdstmplv(2)) + ! print *, ' done with call 2' else - call param_g1_to_g2(kpds(5),kpds(19),idum,ipdstmplv(1), & + call param_g1_to_g2(kpds(5), kpds(19), idum, ipdstmplv(1), & ipdstmplv(2)) endif ! set bitmap flag - idrstmplv=0 - if (btest(kpds(4),6)) then - !fldv=pack(fldv,mask=bmpv(1:numpts)) + idrstmplv = 0 + if (btest(kpds(4), 6)) then + !fldv = pack(fldv, mask = bmpv(1:numpts)) if (ANY(bmp(1:igds(2)) .NEQV. bmpv(1:igds(2)))) then - !print *,'SAGT: BITMAP different' - ibmap=0 + !print *, 'SAGT: BITMAP different' + ibmap = 0 ! convert bitmap to "missing" values, if requested. - if ((usemiss) .AND. (ipack.eq.2 .OR. ipack.eq.31 .OR. & - ipack.eq.32)) then - ibmap=255 - rmiss=minval(fldv(1:numpts)) + if ((usemiss) .AND. (ipack .eq. 2 .OR. ipack .eq. 31 .OR. & + ipack .eq. 32)) then + ibmap = 255 + rmiss = minval(fldv(1:numpts)) if (rmiss .lt. -9999.0) then - rmiss=rmiss*10.0 + rmiss = rmiss*10.0 else - rmiss=-9999.0 + rmiss = -9999.0 endif - do i=1,numpts + do i = 1, numpts if (.NOT. bmpv(i)) then - fldv(i)=rmiss - bmpv(i)=.true. + fldv(i) = rmiss + bmpv(i) = .true. endif enddo - idrstmplv(7)=imiss ! Missing values management - call mkieee(rmiss,idrstmplv(8),1) + idrstmplv(7) = imiss ! Missing values management + call mkieee(rmiss, idrstmplv(8), 1) endif else - !print *,'SAGT: BITMAP SAME' - ibmap=254 + !print *, 'SAGT: BITMAP SAME' + ibmap = 254 endif else - ibmap=255 - idrstmplv(7)=0 ! No missing values + ibmap = 255 + idrstmplv(7) = 0 ! No missing values endif ! Set DRT info (packing info) - if (ipack.eq.0) then - idrsnum=0 - elseif (ipack.eq.2) then - idrsnum=2 - idrstmplv(6)=1 ! general group split - elseif (ipack.eq.31.OR.ipack.eq.32) then - idrsnum=ipack/10 - idrstmplv(6)=1 ! general group split - idrstmplv(17)=mod(ipack,10) ! order of s.d. - elseif (ipack.eq.40 .OR. ipack.eq.41 .OR. & - ipack.eq.40000 .OR. ipack.eq.40010) then - idrsnum=ipack - idrstmplv(6)=0 - idrstmplv(7)=255 - !idrstmplv(6)=1 - !idrstmplv(7)=15 + if (ipack .eq. 0) then + idrsnum = 0 + elseif (ipack .eq. 2) then + idrsnum = 2 + idrstmplv(6) = 1 ! general group split + elseif (ipack .eq. 31 .OR. ipack .eq. 32) then + idrsnum = ipack/10 + idrstmplv(6) = 1 ! general group split + idrstmplv(17) = mod(ipack, 10) ! order of s.d. + elseif (ipack .eq. 40 .OR. ipack .eq. 41 .OR. & + ipack .eq. 40000 .OR. ipack .eq. 40010) then + idrsnum = ipack + idrstmplv(6) = 0 + idrstmplv(7) = 255 + !idrstmplv(6) = 1 + !idrstmplv(7) = 15 else - idrsnum=3 - idrstmplv(17)=1 ! order of s.d. - idrstmplv(6)=1 ! general group split - if (kpds(5).eq.61) idrsnum=2 + idrsnum = 3 + idrstmplv(17) = 1 ! order of s.d. + idrstmplv(6) = 1 ! general group split + if (kpds(5) .eq. 61) idrsnum = 2 endif - idrstmplv(2)=KPTR(19) ! binary scale - idrstmplv(3)=kpds(22) ! decimal scale - !idrstmplv(2)=-4 ! binary scale - !idrstmplv(3)=0 ! decimal scale - call addfield(cgrib,lcgrib,ipdsnum,ipdstmplv,200, & - coordlist,numcoord,idrsnum,idrstmplv,200, & - fldv,numpts,ibmap,bmpv,ierr) - if (ierr.ne.0) then - write(6,*) ' ERROR adding second GRIB2 field = ',ierr + idrstmplv(2) = KPTR(19) ! binary scale + idrstmplv(3) = kpds(22) ! decimal scale + !idrstmplv(2) = -4 ! binary scale + !idrstmplv(3) = 0 ! decimal scale + call addfield(cgrib, lcgrib, ipdsnum, ipdstmplv, 200, & + coordlist, numcoord, idrsnum, idrstmplv, 200, & + fldv, numpts, ibmap, bmpv, ierr) + if (ierr .ne. 0) then + write(6, *) ' ERROR adding second GRIB2 field = ', ierr cycle endif endif ! End GRIB2 field - call gribend(cgrib,lcgrib,lengrib,ierr) - if (ierr.ne.0) then - write(6,*) ' ERROR ending new GRIB2 message = ',ierr + call gribend(cgrib, lcgrib, lengrib, ierr) + if (ierr .ne. 0) then + write(6, *) ' ERROR ending new GRIB2 message = ', ierr cycle endif - ! print *,' writing ',lengrib,' bytes...' - call wryte(ifl2,lengrib,cgrib) + ! print *, ' writing ', lengrib, ' bytes...' + call wryte(ifl2, lengrib, cgrib) enddo From 014593985d7793c1d8a76dda3d937c482fac883f Mon Sep 17 00:00:00 2001 From: Edward Hartnett Date: Mon, 3 Jan 2022 07:52:13 -0700 Subject: [PATCH 7/7] fixed some documentation --- src/cnvgrib/cnvgrib.F90 | 4 ++-- src/degrib2/degrib2.F90 | 4 ++-- src/degrib2/prlevel.F90 | 4 ++-- src/degrib2/prvtime.F90 | 4 ++-- src/grib2grib/grib2grib.f | 2 +- 5 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/cnvgrib/cnvgrib.F90 b/src/cnvgrib/cnvgrib.F90 index ff0e8867..fb773688 100755 --- a/src/cnvgrib/cnvgrib.F90 +++ b/src/cnvgrib/cnvgrib.F90 @@ -42,8 +42,8 @@ program cnvgrib ! GET ARGUMENTS NARG = IARGC() - IF(NARG.lt.3) THEN ! may be a problem with args - IF(NARG .eq. 0) THEN + IF (NARG .lt. 3) THEN ! may be a problem with args + IF (NARG .eq. 0) THEN !CALL ERRMSG('cnvgrib: Incorrect usage') call usage(0) CALL ERREXIT(2) diff --git a/src/degrib2/degrib2.F90 b/src/degrib2/degrib2.F90 index b6dd73f2..73b815eb 100755 --- a/src/degrib2/degrib2.F90 +++ b/src/degrib2/degrib2.F90 @@ -1,6 +1,6 @@ !> @file !> @brief Make an inventory of a GRIB2 file. -!> @author Vuong @date 2010-09-08 +!> @author Stephen Gilbert @date 2010-09-08 !> This program reads a GRIB2 file and makes an inventory. !> @@ -14,7 +14,7 @@ !> 2012-06-07 | Vuong | Changed PRINT statement to WRITE with format specifier !> 2017-01-21 | Vuong | Added to check for undefine values !> -!> @author Vuong @date 2010-09-08 +!> @author Stephen Gilbert @date 2010-09-08 program degrib2 use grib_mod use params diff --git a/src/degrib2/prlevel.F90 b/src/degrib2/prlevel.F90 index 821e03cc..8a39d66a 100755 --- a/src/degrib2/prlevel.F90 +++ b/src/degrib2/prlevel.F90 @@ -1,6 +1,6 @@ !> @file !> @brief -!> @author Vuong @date 2010-09-08 +!> @author Stephen Gilbert @date 2010-09-08 !> Print. !> @@ -8,7 +8,7 @@ !> @param[in] ipdtmpl !> @param[out] labbrev !> -!> @author Vuong @date 2010-09-08 +!> @author Stephen Gilbert @date 2010-09-08 subroutine prlevel(ipdtn,ipdtmpl,labbrev) integer,intent(in) :: ipdtn diff --git a/src/degrib2/prvtime.F90 b/src/degrib2/prvtime.F90 index b503a154..6ccfb51c 100755 --- a/src/degrib2/prvtime.F90 +++ b/src/degrib2/prvtime.F90 @@ -1,6 +1,6 @@ !> @file !> @brief -!> @author Vuong @date 2010-09-08 +!> @author Stephen Gilbert @date 2010-09-08 !> prvtime !> @@ -9,7 +9,7 @@ !> @param[in] listsec1 !> @param[out] tabbrev !> -!> @author Vuong @date 2010-09-08 +!> @author Stephen Gilbert @date 2010-09-08 subroutine prvtime(ipdtn,ipdtmpl,listsec1,tabbrev) integer,intent(in) :: ipdtn diff --git a/src/grib2grib/grib2grib.f b/src/grib2grib/grib2grib.f index 42313e25..156081eb 100755 --- a/src/grib2grib/grib2grib.f +++ b/src/grib2grib/grib2grib.f @@ -1,6 +1,6 @@ !> @file !> @brief Finds and extracts grib records from a grib file made -!> by gribawp1 for family of services. +!> by gribawp1 for WFO (AWIPS). !> @author Southall @date 96-05-21 !> Finds and extracts grib records from a grib file made